diff --git a/sha3/config/tests.config b/sha3/config/tests.config new file mode 100644 index 0000000..351875b --- /dev/null +++ b/sha3/config/tests.config @@ -0,0 +1,23 @@ +[default] +bin = easycrypt +report = report.log + +[test-sha3] +okdirs = !proof +args = -I Jasmin:jasmin/eclib -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm + +[test-sponge] +okdirs = proof proof/smart_counter +args = -I proof -I proof/smart_counter + +[test-jsponge] +okdirs = proof/impl +args = -I Jasmin:jasmin/eclib -I proof -I proof/smart_counter + +[test-jperm] +okdirs = proof/impl/perm +args = -I Jasmin:jasmin/eclib -I proof -I proof/smart_counter -I proof/impl + +[test-libc] +okdirs = proof/impl/libc +args = -I Jasmin:jasmin/eclib -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm diff --git a/sha3/proof/.dir-locals.el b/sha3/proof/.dir-locals.el new file mode 100644 index 0000000..650cbbf --- /dev/null +++ b/sha3/proof/.dir-locals.el @@ -0,0 +1,4 @@ +((easycrypt-mode . + ((eval . + (cl-flet ((pre (s) (concat (locate-dominating-file buffer-file-name ".dir-locals.el") s))) + (setq easycrypt-load-path `(,(pre ".") ,(pre "smart_counter")))))))) diff --git a/sha3/proof/BlockSponge.ec b/sha3/proof/BlockSponge.ec new file mode 100644 index 0000000..2000adc --- /dev/null +++ b/sha3/proof/BlockSponge.ec @@ -0,0 +1,148 @@ +(*-------------------- Padded Block Sponge Construction ----------------*) + +require import AllCore Int Real List. +require (*--*) IRO Indifferentiability Gconcl. +require import Common SLCommon. + +(*------------------------- Indifferentiability ------------------------*) + +clone include Indifferentiability with + type p <- block * capacity, + type f_in <- block list * int, + type f_out <- block list + + rename + [module] "Indif" as "Experiment" + [module] "GReal" as "RealIndif" + [module] "GIdeal" as "IdealIndif". + +(*------------------------- Ideal Functionality ------------------------*) + +clone import IRO as BIRO with + type from <- block list, + type to <- block, + op valid <- valid_block, + op dto <- bdistr. + +(*------ Validity and Parsing/Formatting of Functionality Queries ------*) + +op format (p : block list) (n : int) = p ++ nseq (n - 1) b0. +op parse: block list -> (block list * int). + +axiom formatK bs: format (parse bs).`1 (parse bs).`2 = bs. +axiom parseK p n: 0 < n => valid_block p => parse (format p n) = (p,n). +axiom parse_nil: parse [] = ([],0). + +lemma parse_injective: injective parse. +proof. +by move=> bs1 bs2 eq_format; rewrite -formatK eq_format (@formatK bs2). +qed. + +lemma parse_valid p: valid_block p => parse p = (p,1). +proof. +move=>h;have{1}->:p=format p 1;2:smt(parseK). +by rewrite/format/=nseq0 cats0. +qed. + +(*---------------------------- Restrictions ----------------------------*) + +(** The counter for the functionnality counts the number of times the + underlying primitive is called inside the functionality. This + number is equal to the sum of the number of blocks the input + message contains and the number of additional blocks the squeezing + phase has to output. + *) + +module C = { + var c : int + proc init() = { + c <- 0; + } +}. + +module FC (F : DFUNCTIONALITY) = { + proc init () : unit = {} + + proc f (bl : block list, nb : int) = { + var z : block list <- []; + if (C.c + size bl + (max (nb - 1) 0) <= max_size) { + C.c <- C.c + size bl + (max (nb - 1) 0); + z <@ F.f(bl, nb); + } + return z; + } +}. + +module PC (P : DPRIMITIVE) = { + proc init() = {} + + proc f (a : state) = { + var z : state <- (b0, c0); + if (C.c + 1 <= max_size) { + z <@ P.f(a); + C.c <- C.c + 1; + } + return z; + } + + proc fi (a : state) = { + var z : state <- (b0, c0); + if (C.c + 1 <= max_size) { + z <@ P.fi(a); + C.c <- C.c + 1; + } + return z; + } +}. + +module DRestr (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + proc distinguish () : bool = { + var b : bool; + C.init(); + b <@ D(FC(F), PC(P)).distinguish(); + return b; + } +}. + + +(*----------------------------- Simulator ------------------------------*) + +module Last (F : DFUNCTIONALITY) : SLCommon.DFUNCTIONALITY = { + proc init() = {} + proc f (p : block list) : block = { + var z : block list <- []; + z <@ F.f(parse p); + return last b0 z; + } +}. + +module (Sim : SIMULATOR) (F : DFUNCTIONALITY) = Gconcl.S(Last(F)). + +(*------------------------- Sponge Construction ------------------------*) + +module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { + proc init() = {} + + proc f(xs : block list, n : int) : block list = { + var z <- []; + var (sa, sc) <- (b0, Capacity.c0); + var i <- 0; + + if (valid_block xs) { + (* absorption *) + while (xs <> []) { + (sa, sc) <@ P.f(sa +^ head b0 xs, sc); + xs <- behead xs; + } + (* squeezing *) + while (i < n) { + z <- rcons z sa; + i <- i + 1; + if (i < n) { + (sa, sc) <@ P.f(sa, sc); + } + } + } + return z; + } +}. diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec new file mode 100644 index 0000000..e836d4b --- /dev/null +++ b/sha3/proof/Common.ec @@ -0,0 +1,733 @@ +(*------------------- Common Definitions and Lemmas --------------------*) +require import Core Int IntDiv Real List Distr. +require import Ring StdRing StdOrder StdBigop BitEncoding DProd. +require (*--*) FinType BitWord PRP Monoid. +(*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv. + +pragma +implicits. + + +(* -------------------------------------------------------------------- *) +op r : { int | 2 <= r } as ge2_r. +op c : { int | 0 < c } as gt0_c. + +(* -------------------------------------------------------------------- *) + +lemma gt0_r : 0 < r. +proof. by apply/(ltr_le_trans 2)/ge2_r. qed. + +lemma ge0_r : 0 <= r. +proof. by apply/ltrW/gt0_r. qed. + +lemma ge0_c : 0 <= c. +proof. by apply/ltrW/gt0_c. qed. + +(* -------------------------------------------------------------------- *) +clone export BitWord as Capacity with + op n <- c + proof gt0_n by apply/gt0_c + + rename "word" as "capacity" + "Word" as "Capacity" + (* "dunifin" as "cdistr" *) + "zerow" as "c0". +export Capacity DCapacity. + +clone export BitWord as Block with + op n <- r + proof gt0_n by apply/gt0_r + + rename "word" as "block" + "Word" as "Block" + (* "dunifin" as "bdistr" *) + "zerow" as "b0". +export DBlock. + +op cdistr = DCapacity.dunifin. +op bdistr = DBlock.dunifin. + + +(* ------------------------- Auxiliary Lemmas ------------------------- *) + +lemma dvdz_close (n : int) : + r %| n => 0 < n < 2 * r => n = r. +proof. +move=> dvd_rn. +have [m] <- : exists m, m * r = n + by exists (n %/ r); by rewrite divzK. +move=> [gt0_m_tim_r m_tim_r_lt_2r]. +case: (m = 1)=> // /ltr_total [/ltz1 le0_m | gt1_m]. +rewrite pmulr_lgt0 1:gt0_r in gt0_m_tim_r. +have // : 0 < 0 by rewrite (@ltr_le_trans m). +rewrite ltr_pmul2r 1:gt0_r in m_tim_r_lt_2r. +rewrite -lez_add1r /= in gt1_m. +have // : 2 < 2 by rewrite (@ler_lt_trans m). +qed. + +lemma chunk_nil' ['a] r : BitChunking.chunk r [<:'a>] = []. +proof. by rewrite /chunk /= mkseq0. qed. + +lemma chunk_sing' r (xs : bool list) : + 0 < r => size xs = r => BitChunking.chunk r xs = [xs]. +proof. +move=> gt0_r sz_xs_eq_r. +by rewrite /bits2blocks /chunk sz_xs_eq_r divzz ltr0_neq0 1:gt0_r b2i1 + mkseq1 /= drop0 -sz_xs_eq_r take_size. +qed. + +lemma b0P : b0 = mkblock (nseq r false). +proof. +rewrite blockP=> i ge0_i_ltr; rewrite offunifE ge0_i_ltr /= getE ge0_i_ltr /=. +rewrite ofblockK 1:size_nseq 1:/#. +by rewrite nth_nseq. +qed. + +lemma bits2w_inj_eq (cs ds : bool list) : + size cs = r => size ds = r => mkblock cs = mkblock ds <=> cs = ds. +proof. by move=> s_cs_r s_ds_r; split=> //=; exact/mkblock_pinj. qed. + +lemma last_drop_all_but_last (y : 'a, xs : 'a list) : + xs = [] \/ drop (size xs - 1) xs = [last y xs]. +proof. +elim xs=> // z zs ih /=. +case (size zs <= 0)=> [le0_sz_zs | gt0_sz_zs]. +have sz_zs_eq0 : size zs = 0 + by rewrite (@ler_asym (size zs) 0); split=> // _; rewrite size_ge0. +by have -> : zs = [] by rewrite -size_eq0. +case (zs = [])=> // zs_non_nil. elim ih=> //. +by rewrite addzC (@last_nonempty y z). +qed. + +(*------------------------------ Primitive -----------------------------*) +clone export PRP as PRPt with + type D <- block * capacity. + +clone export StrongPRP as PRPSec. + +clone export RP as Perm with + op dD <- bdistr `*` cdistr + rename + [module type] "PRP" as "PRIMITIVE" + [module] "RP" as "Perm" + proof dD_ll. +realize dD_ll. +by apply/dprod_ll; rewrite Block.DBlock.dunifin_ll Capacity.DCapacity.dunifin_ll. +qed. + +(*---------------------- Needed Blocks Computation ---------------------*) + +lemma needed_blocks0 : (0 + r - 1) %/ r = 0. +proof. +rewrite -divz_eq0 1:gt0_r; smt(gt0_r). +qed. + +lemma needed_blocks_non_pos (n : int) : + n <= 0 => (n + r - 1) %/ r <= 0. +proof. +move=> le0_n. +rewrite (lez_trans ((r - 1) %/ r)) 1:leq_div2r 1:/# 1:ge0_r. +have -> // : (r - 1) %/ r = 0 + by rewrite -divz_eq0 1:gt0_r; smt(gt0_r). +qed. + +lemma needed_blocks_suff (n : int) : + n <= (n + r - 1) %/ r * r. +proof. +have -> : (n + r - 1) %/r * r = (n + r - 1) - (n + r - 1)%% r. ++ by rewrite {2}(@divz_eq (n + r - 1) r) #ring. +by rewrite -(@addzA n) -(@addzA n) lez_addl subz_ge0 -ltzS -(@addzA r) /= + ltz_pmod gt0_r. +qed. + +lemma needed_blocks_correct (n : int) : + 0 <= (n + r - 1) %/ r * r - n < r. +proof. +split=> [| _]. +by rewrite subz_ge0 needed_blocks_suff. +have -> : (n + r - 1) %/r * r = (n + r - 1) - (n + r - 1)%% r + by rewrite {2}(@divz_eq (n + r - 1) r) #ring. +have -> : n + r - 1 - (n + r - 1) %% r - n = r - 1 - (n + r - 1) %% r + by ring. +rewrite ltzE -(@ler_add2r (-r)) /=. +have -> : r - 1 - (n + r - 1) %% r + 1 - r = -(n + r - 1) %% r by ring. +by rewrite oppz_le0 modz_ge0 gtr_eqF 1:gt0_r. +qed. + +lemma needed_blocks_prod_r (n : int) : + (n * r + r - 1) %/ r = n. +proof. +rewrite -addzA divzMDl 1:gtr_eqF 1:gt0_r // divz_small //. +smt(gt0_r). +qed. + +lemma needed_blocks_eq_div_r (n : int) : + r %| n <=> n %/ r = (n + r - 1) %/ r. +proof. +split=> [r_dvd_n | eq_div]. +have {2}<- := divzK r n _; first trivial. +by rewrite needed_blocks_prod_r. +rewrite dvdzE. +rewrite {2}(@divz_eq n r) -!addrA @divzMDl 1:gtr_eqF 1:gt0_r // + -{1}(@addz0 (n %/ r)) in eq_div. +have eq_div_simp : (n %% r + (r - 1)) %/ r = 0 + by rewrite (@addzI (n %/ r) 0 ((n %% r + (r - 1)) %/ r)). +have [_ n_mod_r_plus_r_min1_lt_r] : 0 <= n %% r + (r - 1) < r + by rewrite divz_eq0 1:gt0_r. +have n_mod_r_plus_r_min1_lt_r_simp : n %% r <= 0 + by rewrite -(@lez_add2r (r - 1)) /= -ltzS -addzA /=. +by apply lez_anti; split=> // _; rewrite modz_ge0 1:gtr_eqF 1:gt0_r. +qed. + +lemma needed_blocks_succ_eq_div_r (n : int) : + ! r %| n <=> n %/ r + 1 = (n + r - 1) %/ r. +proof. +split=> [not_r_dvd_n | succ_eq_div]. +have {2}-> := divz_eq n r. +rewrite -!addrA divzMDl 1:gtr_eqF 1:gt0_r //; ring. +rewrite dvdzE in not_r_dvd_n. +have gt0_mod : 0 < n %% r + by rewrite ltz_def=> |>; rewrite modz_ge0 1:gtr_eqF 1:gt0_r. +have [r_le_n_mod_r_plus_r_min1 n_mod_r_plus_r_min1_lt_r] : + r <= n %% r + (r - 1) < r + r. + split=> [| _]. + by rewrite (@addrC r (-1)) addrA -{1}add0z lez_add2r -ltzS + -addrA addNz. + by rewrite (@addrC r (-1)) addrA ltz_add2r -(@ltz_add2r 1) -addrA /= + (@ltr_trans r) 1:ltz_pmod 1:gt0_r -{1}addz0 ler_lt_add 1:lezz ltr01. +have [m [-> [ge0_m lt_mr]]] : + exists (m : int), n %% r + (r - 1) = r + m /\ 0 <= m < r. + exists (n %% r + (r - 1) - r). + split; first ring. + split=> [| _]. + by rewrite -(@lez_add2r r) -addrA addNz. + by rewrite -(@ltz_add2r r) -addrA addNz. +rewrite -{1}(@mul1z r) divzMDl 1:gtr_eqF 1:gt0_r // + opprD addrA /=. +rewrite divz_small; [by rewrite ger0_norm 1:ge0_r | done]. +have not_eq_dvd : n %/ r <> (n + r - 1) %/ r by smt(). +by rewrite needed_blocks_eq_div_r. +qed. + +lemma needed_blocks_rel_div_r (n : int) : + n %/ r = (n + r - 1) %/ r \/ n %/ r + 1 = (n + r - 1) %/ r. +proof. +case: (r %| n)=> [r_dvd_n | not_r_dvd_n]. +left; by apply/needed_blocks_eq_div_r. +right; by apply/needed_blocks_succ_eq_div_r. +qed. + +(* ------------------------- Padding/Unpadding ------------------------ *) + +op num0 (n : int) = (-(n + 2)) %% r. + +op mkpad (n : int) = true :: rcons (nseq (num0 n) false) true. + +op pad (s : bool list) = s ++ mkpad (size s). + +op unpad (s : bool list) = + if !last false s then None else + let i = index true (behead (rev s)) in + if i + 1 = size s then None + else let n = size s - (i + 2) in + if i = num0 n then Some (take n s) else None. + +lemma rev_mkpad n : rev (mkpad n) = mkpad n. +proof. by rewrite /mkpad rev_cons rev_rcons rev_nseq. qed. + +lemma last_mkpad b n : last b (mkpad n) = true. +proof. by rewrite !(last_cons, last_rcons). qed. + +lemma head_mkpad b n : head b (mkpad n) = true. +proof. by []. qed. + +lemma last_pad b s : last b (pad s) = true. +proof. by rewrite last_cat last_mkpad. qed. + +lemma size_mkpad n : size (mkpad n) = num0 n + 2. +proof. +rewrite /mkpad /= size_rcons size_nseq ler_maxr. +by rewrite /num0 modz_ge0 gtr_eqF ?gt0_r. by ring. +qed. + +lemma size_pad_equiv (m : int) : + 0 <= m => m + num0 m + 2 = (m + 1) %/ r * r + r. +proof. +move=> ge0_m. +by rewrite /num0 modNz 1:/# 1:gt0_r -(@addrA _ 2) /= modzE #ring. +qed. + +lemma size_padE (s : bool list) : + size (pad s) = size s + num0 (size s) + 2. +proof. by rewrite /pad size_cat size_mkpad addrA. qed. + +lemma size_pad (s : bool list) : + size (pad s) = (size s + 1) %/ r * r + r. +proof. by rewrite size_padE size_pad_equiv 1:size_ge0. qed. + +lemma size_pad_dvd_r s : r %| size (pad s). +proof. by rewrite size_pad dvdzD 1:dvdz_mull dvdzz. qed. + +lemma dvd_r_num0 (m : int) : r %| (m + num0 m + 2). +proof. by rewrite /num0 /(%|) addrAC modzDmr subrr. qed. + +lemma num0_ge0 (m : int) : 0 <= num0 m. +proof. by rewrite /num0 modz_ge0 ?gtr_eqF ?gt0_r. qed. + +lemma num0_ltr (m : int) : num0 m < r. +proof. by rewrite /num0 ltz_pmod gt0_r. qed. + +lemma index_true_behead_mkpad n : + index true (behead (mkpad n)) = num0 n. +proof. +rewrite /mkpad -cats1 //= index_cat mem_nseq size_nseq. +by rewrite ler_maxr // /num0 modz_ge0 gtr_eqF ?gt0_r. +qed. + +lemma padE (s : bool list, n : int) : + 0 <= n < r => r %| (size s + n + 2) => + pad s = s ++ [true] ++ nseq n false ++ [true]. +proof. +move=> lt_0r dvdr; rewrite -!catA /pad /mkpad /= cats1 /num0. +by do! congr; rewrite -(dvdz_modzDr dvdr) modz_small 2:#ring /#. +qed. + +lemma padK : pcancel pad unpad. +proof. +move=> s @/unpad; rewrite last_pad /= rev_cat rev_mkpad. +pose i := index _ _. +have ^iE {1 2}->: i = (-(size s + 2)) %% r. + rewrite /i behead_cat //= index_cat {1}/mkpad /= mem_rcons /=. + by rewrite index_true_behead_mkpad. +pose b := _ = size _; case b => @/b - {b}. + rewrite modNz ?gt0_r ?ltr_spaddr ?size_ge0 //. + rewrite -(@addrA _ 2) size_pad (@addrC _ r) -!addrA => /addrI. + rewrite addrCA /= -subr_eq0 -opprD oppr_eq0 addrC -divz_eq. + by rewrite addz_neq0 ?size_ge0. +move=> sz {sz}; rewrite /num0. +have -> : size (pad s) - (i + 2) + 2 = size (pad s) - i by ring. +pose b := _ = _ %% r; case b=> @/b - {b}; last first. +have -> // : size s + 2 = size (pad s) - i + by rewrite /pad size_cat size_mkpad iE #ring. +move=> sz {sz} /=; rewrite iE -size_mkpad /pad size_cat addrK. +by rewrite take_cat /= take0 cats0. +qed. + +lemma unpadK : ocancel unpad pad. +proof. +move=> s @/unpad; case: (last false s)=> //=. +elim/last_ind: s=> //= s b ih {ih}; rewrite last_rcons => ->. +rewrite rev_rcons /= size_rcons -(inj_eq (addIr (-1))) /= ?addrK. +pose i := index _ _; case: (i = size s)=> // ne_is @/pad @/num0. +have lt_is: i < size s by rewrite ltr_neqAle ne_is -size_rev index_size. +have [ge0_i lt_siz_s_i] : 0 <= i < size s. + have le_siz_s_i : i <= size s by rewrite /i - size_rev index_size. + split=> [| _]; [rewrite index_ge0 | rewrite ltr_neqAle //]. +pose j := (size s + _ - _); case: (i = (-(j + 2)) %% r)=> iE; 2:done. (* => // iE. Loops in deploy-kms *) +apply/eq_sym; rewrite -{1}(@cat_take_drop j (rcons _ _)); congr. +have jE: j = size s - (i + 1) by rewrite /j #ring. +have [ge0_j lt_js]: 0 <= j < size s by move=> /#. +rewrite -cats1 drop_cat lt_js /= /mkpad -cats1 -cat_cons; congr=> //=. +rewrite size_take // size_cat /= ltr_spsaddr //= /num0 -iE. +have sz_js: size (drop j s) = i+1; last apply/(eq_from_nth false). ++ by rewrite size_drop //= ler_maxr ?subr_ge0 ?ltrW // /j #ring. ++ by rewrite sz_js /= addrC size_nseq ler_maxr. +rewrite sz_js => k [ge0_k lt_kSi]; rewrite nth_drop //. +move/ler_eqVlt: ge0_k => [<-|] /=. + by rewrite jE -nth_rev ?nth_index // -index_mem size_rev. +move=> lt0_k; rewrite gtr_eqF //= nth_nseq 1:/#. +have ->: j + k = (size s) - ((i-k) + 1) by rewrite /j #ring. +by rewrite -nth_rev 1:/# &(@negbRL _ true) &(before_index) /#. +qed. + +inductive unpad_spec (t : bool list) = + Unpad (s : bool list, n : int) of + (0 <= n < r) + & (r %| (size s + n + 2)) + & (t = s ++ [true] ++ nseq n false ++ [true]). + +lemma nosmt unpadP (t : bool list) : + unpad t <> None <=> unpad_spec t. +proof. +split=> [|[s n lt_nr dvd ->]]; last by rewrite -padE ?padK. +case _: (unpad t) => // s sE _. +have ->: t = pad s by rewrite -(unpadK t) sE. +apply/(Unpad s (num0 (size s))). + by rewrite num0_ge0 num0_ltr. by rewrite dvd_r_num0. +by rewrite -padE ?dvd_r_num0 // num0_ge0 num0_ltr. +qed. + +(*------------------------------ Chunking ------------------------------*) + +op chunk (bs : bool list) = BitChunking.chunk r bs. + +lemma size_chunk bs : size (chunk bs) = size bs %/ r. +proof. by apply/BitChunking.size_chunk/gt0_r. qed. + +lemma in_chunk_size bs b: mem (chunk bs) b => size b = r. +proof. by apply/BitChunking.in_chunk_size/gt0_r. qed. + +lemma chunkK bs : r %| size bs => flatten (chunk bs) = bs. +proof. by apply/BitChunking.chunkK/gt0_r. qed. + +lemma chunk_nil : chunk [] = []. +proof. by apply/(@chunk_nil' r). qed. + +lemma chunk_sing (xs : bool list) : size xs = r => chunk xs = [xs]. +proof. by apply/chunk_sing'/gt0_r. qed. + +lemma chunk_cat (xs ys : bool list) : + r %| size xs => chunk (xs ++ ys) = chunk xs ++ chunk ys. +proof. by apply/BitChunking.chunk_cat/gt0_r. qed. + +lemma chunk_padK : pcancel (chunk \o pad) (unpad \o flatten). +proof. by move=> s @/(\o); rewrite chunkK 1:size_pad_dvd_r padK. qed. + +lemma flattenK bs : + (forall b, mem bs b => size b = r) => chunk (flatten bs) = bs. +proof. by apply/BitChunking.flattenK/gt0_r. qed. + +(*--------------- Converting Between Block Lists and Bits --------------*) + +op blocks2bits (xs:block list) : bool list = flatten (map ofblock xs). + +lemma blocks2bits_nil : blocks2bits [] = []. +proof. by rewrite /blocks2bits /= flatten_nil. qed. + +lemma blocks2bits_sing (x : block) : blocks2bits [x] = ofblock x. +proof. by rewrite /blocks2bits /flatten /= cats0. qed. + +lemma blocks2bits_cat (xs ys : block list) : + blocks2bits (xs ++ ys) = blocks2bits xs ++ blocks2bits ys. +proof. by rewrite /blocks2bits map_cat flatten_cat. qed. + +lemma size_blocks2bits (xs : block list) : + size (blocks2bits xs) = r * size xs. +proof. +elim: xs=> [| x xs ih]; first by rewrite blocks2bits_nil. +rewrite -cat1s blocks2bits_cat blocks2bits_sing size_cat //. +rewrite size_cat size_block ih /= #ring. +qed. + +lemma size_blocks2bits_dvd_r (xs : block list) : r %| size(blocks2bits xs). +proof. by rewrite size_blocks2bits dvdz_mulr dvdzz. qed. + +op bits2blocks (xs : bool list) : block list = map mkblock (chunk xs). + +lemma bits2blocks_nil : bits2blocks [] = []. +proof. by rewrite /bits2blocks chunk_nil. qed. + +lemma bits2blocks_sing (xs : bool list) : + size xs = r => bits2blocks xs = [mkblock xs]. +proof. by move=> sz_xs_eq_r; rewrite /bits2blocks chunk_sing. qed. + +lemma bits2blocks_cat (xs ys : bool list) : r %| size xs => r %| size ys => + bits2blocks (xs ++ ys) = bits2blocks xs ++ bits2blocks ys. +proof. +move=> r_dvd_sz_xs r_dvd_sz_ys. +by rewrite /bits2blocks chunk_cat 2:map_cat. +qed. + +lemma blocks2bitsK : cancel blocks2bits bits2blocks. +proof. +move=> xs; rewrite /blocks2bits /bits2blocks flattenK. + by move=> b /mapP [x [_ ->]];rewrite size_block. +rewrite -map_comp -{2}(@map_id xs) /(\o) /=. +by apply eq_map=> @/idfun x /=; exact/mkblockK. +qed. + +lemma bits2blocksK (bs : bool list) : + r %| size bs => blocks2bits(bits2blocks bs) = bs. +proof. +move=> dvd_r_bs; rewrite /blocks2bits /bits2blocks -map_comp. +have map_tolistK : + forall (xss : bool list list), + (forall (xs : bool list), mem xss xs => size xs = r) => + map (ofblock \o mkblock) xss = xss. ++ elim=> [// | xs yss ih eqr_sz /=]; split. + by apply ofblockK; rewrite eqr_sz. + by apply/ih => zs mem_zss_zs; rewrite eqr_sz //=; right. +by rewrite map_tolistK; [apply in_chunk_size | exact chunkK]. +qed. + +(*-------------- Padding to Blocks / Unpadding from Blocks -------------*) + +op pad2blocks : bool list -> block list = bits2blocks \o pad. +op unpad_blocks : block list -> bool list option = unpad \o blocks2bits. + +lemma pad2blocksK : pcancel pad2blocks unpad_blocks. +proof. +move=> xs @/pad2blocks @/unpad_blocks @/(\o). +by rewrite bits2blocksK 1:size_pad_dvd_r padK. +qed. + +lemma unpadBlocksK : ocancel unpad_blocks pad2blocks. +proof. +move=> xs; rewrite /pad2blocks /unpad_blocks /(\o). +pose bs := blocks2bits xs. +case (unpad bs = None) => [-> // | unpad_bs_neq_None]. +have unpad_bs : unpad bs = Some(oget(unpad bs)) + by move: unpad_bs_neq_None; case (unpad bs). +rewrite unpad_bs /=. +have -> : pad(oget(unpad bs)) = bs + by rewrite - {2} (unpadK bs) unpad_bs. +by rewrite /bs blocks2bitsK. +qed. + +lemma pad2blocks_inj : injective pad2blocks. +proof. +apply /(pcan_inj pad2blocks unpad_blocks) /pad2blocksK. +qed. + +lemma size_pad2blocks s : + size (pad2blocks s) = (size s + 1) %/ r + 1. +proof. +rewrite /pad2blocks /bits2blocks /(\o) size_map size_chunk size_pad. +have -> : (size s + 1) %/ r * r + r = ((size s + 1) %/r + 1) * r + by rewrite mulzDl mul1r. +by rewrite mulzK 1:gtr_eqF 1:gt0_r. +qed. + +(*-------------------------- Extending/Stripping -----------------------*) + +op extend (xs : block list) (n : int) = + xs ++ nseq n b0. + +op strip (xs : block list) = + let i = find (fun x => x <> b0) (rev xs) in + (take (size xs - i) xs, i). + +lemma strip_ge0 (xs : block list) : + 0 <= (strip xs).`2. +proof. by rewrite /strip /= find_ge0. qed. + +lemma extendK (xs : block list) (n : int) : + last b0 xs <> b0 => 0 <= n => strip(extend xs n) = (xs, n). +proof. +move=> xs_ends_not_b0 ge0_n; rewrite /strip /extend /=. +rewrite rev_cat rev_nseq size_cat size_nseq ler_maxr // -addzA. +have head_rev_xs_neq_b0 : head b0 (rev xs) <> b0 by rewrite - last_rev revK //. +have -> : rev xs = head b0 (rev xs) :: behead (rev xs). + by rewrite head_behead //; case: (rev xs) head_rev_xs_neq_b0. +pose p := fun (x : block) => x <> b0. +have has_p_full : has p (nseq n b0 ++ head b0 (rev xs) :: behead (rev xs)) + by apply has_cat; right; simplify; left. +have not_has_p_nseq : ! has p (nseq n b0) by rewrite has_nseq. +have -> : find p (nseq n b0 ++ head b0 (rev xs) :: behead (rev xs)) = n. + rewrite find_cat not_has_p_nseq /= size_nseq ler_maxr //. + have -> // : p (head b0 (rev xs)) by trivial. +by rewrite (@addzC n) addNz /= take_size_cat. +qed. + +lemma stripK (xs : block list) : + extend (strip xs).`1 (strip xs).`2 = xs. +proof. +rewrite /extend /strip eq_sym /=; pose i := find _ _. +rewrite -{1}(@cat_take_drop (size xs - i) xs); congr. +have [ge0_i le_ixs]: 0 <= i <= size xs. + by rewrite find_ge0 -size_rev find_size. +have sz_drop: size (drop (size xs - i) xs) = i. + rewrite size_drop ?subr_ge0 // opprD opprK. + by rewrite addrA /= ler_maxr. +apply/(eq_from_nth b0) => [|j]; rewrite ?size_nseq ?ler_maxr //. +rewrite sz_drop=> -[ge0_j lt_ji]; rewrite nth_nseq //. +rewrite nth_drop ?subr_ge0 // -{1}revK nth_rev ?size_rev. + rewrite addr_ge0 ?subr_ge0 //= -ltr_subr_addr. + by rewrite ltr_add2l ltr_opp2. +have @/predC1 /= ->// := (before_find b0 (predC1 b0)). +pose s := (_ - _)%Int; rewrite -/i (_ : s = i - (j+1)) /s 1:#ring. +by rewrite subr_ge0 -ltzE lt_ji /= ltr_snaddr // oppr_lt0 ltzS. +qed. + +(*------------------------------ Validity ------------------------------*) + +(* in Sponge *) + +op valid_toplevel (_ : bool list) = true. + +(* in BlockSponge *) + +op valid_block (xs : block list) = unpad_blocks xs <> None. + +lemma valid_pad2blocks (bs : bool list) : + valid_block(pad2blocks bs). +proof. +by rewrite /valid_block pad2blocksK. +qed. + +inductive valid_block_spec (xs : block list) = + ValidBlock (s : bool list, n : int) of + (0 <= n < r) + & (blocks2bits xs = s ++ [true] ++ nseq n false ++ [true]). + +lemma nosmt valid_blockP (xs : block list) : + valid_block xs <=> valid_block_spec xs. +proof. +split=> [vb | [s n] [rng_n b2b] b2b_xs_eq]. +have [up _] := (unpadP (blocks2bits xs)). +rewrite vb /= in up; case: up=> [s n rng_n _ b2b]. +by apply (@ValidBlock xs s n). +rewrite /valid_block unpadP (@Unpad (blocks2bits xs) s n) //. +have <- : size (blocks2bits xs) = size s + n + 2 + by rewrite b2b_xs_eq 3!size_cat /= size_nseq ler_maxr /#ring. +by apply size_blocks2bits_dvd_r. +qed. + +lemma valid_block_ends_not_b0 (xs : block list) : + valid_block xs => last b0 xs <> b0. +proof. +move=> vb_xs; have bp := valid_blockP xs. +rewrite vb_xs /= in bp. +move: bp=> [s n] _ b2b_xs_eq. +case: (last b0 xs <> b0)=> [// | last_xs_eq_b0]. +rewrite negbK in last_xs_eq_b0. +have xs_non_nil : xs <> []. + by case: xs b2b_xs_eq last_xs_eq_b0 vb_xs. +elim (last_drop_all_but_last b0 xs)=> // drop_xs. +have xs_take_drop : xs = take (size xs - 1) xs ++ drop (size xs - 1) xs + by rewrite cat_take_drop. +rewrite drop_xs last_xs_eq_b0 b0P in xs_take_drop. +have last_b2b_xs_true : last true (blocks2bits xs) = true + by rewrite b2b_xs_eq cats1 last_rcons. +have last_b2b_xs_false : last true (blocks2bits xs) = false + by rewrite xs_take_drop blocks2bits_cat blocks2bits_sing ofblockK + 1:size_nseq 1:ler_maxr 1:ge0_r // last_cat + last_nseq 1:gt0_r. +by rewrite last_b2b_xs_true in last_b2b_xs_false. +qed. + +inductive valid_block_struct_spec (xs : block list) = + ValidBlockStruct1 (ys : block list, x : block, s : bool list, n : int) of + (xs = ys ++ [x]) + & (0 <= n) + & (ofblock x = s ++ [true] ++ nseq n false ++ [true]) +| ValidBlockStruct2 (ys : block list, y z : block) of + (xs = ys ++ [y; z]) + & (last false (ofblock y)) + & (ofblock z = nseq (r - 1) false ++ [true]). + +lemma nosmt valid_block_structP (xs : block list) : + valid_block xs <=> valid_block_struct_spec xs. +proof. +rewrite valid_blockP. +split=> [[s n] [ge0_n lt_nr] b2b_xs_eq | + [ys x s n xs_eq ge0_n w2b_x_eq | + ys y z xs_eq lst w2b_z_eq]]. +have sz_s_divz_eq : size s = size s %/ r * r + size s %% r + by apply divz_eq. +pose tke := take (size s %/ r * r) s; pose drp := drop (size s %/ r * r) s. +have sz_tke : size tke = size s %/ r * r. + rewrite size_take 1:mulr_ge0 1:divz_ge0 1:gt0_r 1:size_ge0 + 1:ge0_r. + case (size s %/ r * r < size s)=> // not_lt_sz_s. + rewrite -lezNgt in not_lt_sz_s; apply ler_asym; split=> // _. + by rewrite lez_floor gtr_eqF 1:gt0_r //. +have sz_drp : size drp = size s %% r. + rewrite size_drop 1:mulr_ge0 1:divz_ge0 1:gt0_r 1:size_ge0 + 1:ge0_r. + case (size s %/ r * r < size s)=> // not_lt_sz_s. + rewrite ler_maxr /#. + have eq : size s %/ r * r = size s. + rewrite -lezNgt in not_lt_sz_s; apply ler_asym; split=> //. + by rewrite lez_floor gtr_eqF 1:gt0_r //. + rewrite ler_maxl /#. +have sz_s_pad_dvd_r : r %| (size s + n + 2). + have <- : size (s ++ [true] ++ nseq n false ++ [true]) = size s + n + 2 + by rewrite !size_cat /= size_nseq ler_maxr 1:ge0_n #ring. + rewrite -b2b_xs_eq size_blocks2bits_dvd_r. +have sz_tke_dvd_r : r %| size tke by rewrite sz_tke dvdz_mull dvdzz. +have sz_drp_plus_n_plus_2_dvd_r : r %| (size drp + n + 2). + rewrite sz_drp dvdzE + -(@dvdz_modzDl (size s %/ r * r) (size s %% r + n + 2) r) + 1:dvdz_mull 1:dvdzz. + have -> : size s %/ r * r + (size s %% r + n + 2) = size s + n + 2. + rewrite {3}sz_s_divz_eq #ring. by rewrite -dvdzE. +have xs_eq : xs = bits2blocks(s ++ [true] ++ nseq n false ++ [true]) + by rewrite -blocks2bitsK b2b_xs_eq. +rewrite -(@cat_take_drop (size s %/ r * r) s) -!catA -/tke -/drp + bits2blocks_cat in xs_eq. ++ rewrite sz_tke_dvd_r. rewrite !size_cat /= size_nseq ler_maxr 1:ge0_n. ++ have -> : size drp + (1 + (n + 1)) = size drp + n + 2 by ring. ++ rewrite sz_drp_plus_n_plus_2_dvd_r. +case: (n = r - 1)=> [n_eq_r_min1 | n_neq_r_min1]. +have sz_drp_plus1_dvd_r : r %| (size drp + 1). + rewrite dvdzE -(@addz0 (size drp + 1)) -{1}(@modzz r). + have {1}-> : r = n + 1 by smt(). + rewrite modzDmr. + have -> : size drp + 1 + (n + 1) = size drp + n + 2 by ring. + by rewrite -dvdzE. +have sz_drp_plus1_eq_r : size drp + 1 = r. + rewrite (@dvdz_close (size drp + 1)) //. + split=> [| _]; first rewrite ltr_paddl 1:size_ge0 ltr01. + have -> : 2 * r = r + r by ring. + rewrite ltr_add // 1:sz_drp 1:ltz_pmod 1:gt0_r ltzE ge2_r. +apply (@ValidBlockStruct2 xs (bits2blocks tke) + (mkblock (drp ++ [true])) (mkblock (nseq n false ++ [true]))). +rewrite xs_eq (@catA drp [true]) bits2blocks_cat 1:size_cat // + 1:size_cat 1:size_nseq 1:ler_maxr 1:ge0_n /= 1:/# + (@bits2blocks_sing (drp ++ [true])) 1:size_cat // + (@bits2blocks_sing (nseq n false ++ [true])) + 1:size_cat 1:size_nseq /= 1:ler_maxr 1:ge0_n /#. +rewrite ofblockK 1:size_cat //= cats1 last_rcons. +rewrite n_eq_r_min1 ofblockK 1:size_cat //= size_nseq ler_maxr /#. +have lt_n_r_min1 : n < r - 1 by smt(). +move: xs_eq. +have sz_drp_plus_n_plus_2_eq_r : size drp + n + 2 = r. + rewrite (@dvdz_close (size drp + n + 2)) // sz_drp. + have n_plus2_rng : 2 <= n + 2 <= r by smt(). + rewrite -addrA; split=> [| _]. + rewrite ltr_paddl 1:modz_ge0 1:gtr_eqF 1:gt0_r // /#. + have ->: 2 * r = r + r by ring. + have -> : r + r = (r - 1) + (r + 1) by ring. + rewrite ler_lt_add 1:-ltzS 1:-addrA /= 1:ltz_pmod 1:gt0_r. + by rewrite -(@ltr_add2r (-2)) -2!addrA. +move=> xs_eq. +rewrite (@bits2blocks_sing + (drp ++ ([true] ++ (nseq n false ++ [true])))) + in xs_eq. ++ rewrite !size_cat /= size_nseq ler_maxr 1:ge0_n 1:sz_drp. ++ have -> : size s %% r + (1 + (n + 1)) = size s %%r + n + 2 by ring. ++ by rewrite -sz_drp. +apply (@ValidBlockStruct1 xs (bits2blocks tke) + (mkblock (drp ++ ([true] ++ (nseq n false ++ [true])))) + drp n)=> //. +by rewrite ofblockK 1:!size_cat /= 1:size_nseq 1:ler_maxr 1:ge0_n + 1:-sz_drp_plus_n_plus_2_eq_r 1:#ring -!catA cat1s. +have sz_w2b_x_eq_r : size (ofblock x) = r by apply size_block. +rewrite w2b_x_eq !size_cat /= size_nseq ler_maxr // in sz_w2b_x_eq_r. +have lt_nr : n < r by smt(size_ge0). +apply (@ValidBlock xs (blocks2bits ys ++ s) n)=> //. +by rewrite xs_eq blocks2bits_cat blocks2bits_sing w2b_x_eq -!catA. +move: xs_eq. have -> : [y; z] = [y] ++ [z] by trivial. move=> xs_eq. +have w2bits_y_eq : ofblock y = take (r - 1) (ofblock y) ++ [true]. + rewrite -{1}(@cat_take_drop (r - 1) (ofblock y)); congr. + elim (last_drop_all_but_last false (ofblock y))=> + [w2b_y_nil | drop_w2b_y_last]. + have not_lst_w2b_y : ! last false (ofblock y) by rewrite w2b_y_nil. + by rewrite w2b_y_nil. + rewrite lst in drop_w2b_y_last. + by rewrite -drop_w2b_y_last size_block. +apply (@ValidBlock xs (blocks2bits ys ++ (take (r - 1) (ofblock y))) + (r - 1)). +smt(ge2_r). +rewrite xs_eq 2!blocks2bits_cat 2!blocks2bits_sing -!catA; congr. +by rewrite {1}w2bits_y_eq -catA w2b_z_eq. +qed. + +(* in AbsorbSponge *) + +op valid_absorb (xs : block list) = valid_block((strip xs).`1). + +inductive valid_absorb_spec (xs : block list) = + ValidAbsorb (ys : block list, n : int) of + (valid_block ys) + & (0 <= n) + & (xs = ys ++ nseq n b0). + +lemma nosmt valid_absorbP (xs : block list) : + valid_absorb xs <=> valid_absorb_spec xs. +proof. +rewrite /valid_absorb; split=> [strp_xs_valid | [ys n] ge0_n vb_ys ->]. +by rewrite (@ValidAbsorb xs (strip xs).`1 (strip xs).`2) + 2:(@strip_ge0 xs) // -/(extend (strip xs).`1 (strip xs).`2) (@stripK xs). +by rewrite -/(extend ys n) extendK 1:valid_block_ends_not_b0. +qed. diff --git a/sha3/proof/IRO.eca b/sha3/proof/IRO.eca new file mode 100644 index 0000000..7c3af6a --- /dev/null +++ b/sha3/proof/IRO.eca @@ -0,0 +1,130 @@ +(* Infinite random oracle, mapping values of type [from] to infinite + sequences of values of type [to], each sampled uniformly and + independently. We obviously make it lazy. Inputs not satisfying + a validity predicate are mapped to the empty list *) + +require import Core Int Bool List FSet SmtMap. + +type to, from. + +op valid : from -> bool. +op dto : to distr. + +module type IRO = { + proc init() : unit + + (* f x, returning the first n elements of the result *) + proc f(x : from, n : int) : to list +}. + +pred prefix_closed (m : (from * int,to) fmap) = + forall x n, + (x,n) \in m => + (forall i, 0 <= i < n => + (x,i) \in m). + +pred prefix_closed' (m : (from * int,to) fmap) = + forall x n i, + (x,n) \in m => + 0 <= i < n => + (x,i) \in m. + +lemma prefix_closed_equiv m: prefix_closed m <=> prefix_closed' m. +proof. smt(). qed. + +(* official version: *) + +module IRO : IRO = { + var mp : (from * int, to) fmap + + proc init() = { + mp <- empty; + } + + proc fill_in(x, n) = { + var r; + + if ((x,n) \notin mp) { + r <$ dto; + mp.[(x,n)] <- r; + } + return oget mp.[(x,n)]; + } + + proc f(x, n) = { + var b, bs; + var i <- 0; + + bs <- []; + if (valid x) { + while (i < n) { + b <@ fill_in(x, i); + bs <- rcons bs b; + i <- i + 1; + } + } + + return bs; + } +}. + +(* version for AbsorbToBlocks.ec attempt *) + +module IRO' : IRO = { + var mp : (from * int, to) fmap + var visible : (from * int) fset + + proc resample_invisible() = { + var work, x, r; + + work <- fdom mp `\` visible; + while (work <> fset0) { + x <- pick work; + r <$ dto; + mp.[x] <- r; + work <- work `\` fset1 x; + } + } + + proc init() = { + mp <- empty; + visible <- fset0; + } + + proc fill_in(x,n) = { + var r; + + if ((x,n) \notin mp) { + r <$ dto; + mp.[(x,n)] <- r; + } + return oget mp.[(x,n)]; + } + + proc f(x, n) = { + var b, bs; + var i <- 0; + + bs <- []; + if (valid x) { + visible <- visible `|` fset1 (x,n); + while (i < n) { + b <@ fill_in(x,i); + bs <- rcons bs b; + i <- i + 1; + } + } + + return bs; + } + + proc f_lazy(x, i) = { + var b <- witness; + + if (valid x /\ 0 <= i) { + visible <- visible `|` fset1 (x,i); + b <@ fill_in(x,i); + } + return b; + } +}. diff --git a/sha3/proof/IndifRO_is_secure.ec b/sha3/proof/IndifRO_is_secure.ec new file mode 100644 index 0000000..2b9d332 --- /dev/null +++ b/sha3/proof/IndifRO_is_secure.ec @@ -0,0 +1,217 @@ +require import AllCore Distr SmtMap. +require (****) SecureRO Indifferentiability. + + +type block. +type f_in. +type f_out. + +op sampleto : f_out distr. +axiom sampleto_ll : is_lossless sampleto. +axiom sampleto_fu : is_funiform sampleto. +axiom sampleto_full : is_full sampleto. + +op limit : int. +axiom limit_gt0 : 0 < limit. + +op bound : real. + + +op bound_counter : int. +axiom bound_counter_ge0 : 0 <= bound_counter. + +op increase_counter : int -> f_in -> int. +axiom increase_counter_spec c m : c <= increase_counter c m. + + +clone import SecureRO as SRO with + type from <- f_in, + type to <- f_out, + + op bound <- limit, + op sampleto <- sampleto, + op increase_counter <- increase_counter, + op bound_counter <- bound_counter + + proof * by smt(sampleto_fu sampleto_ll sampleto_full limit_gt0 + increase_counter_spec bound_counter_ge0). + + +clone import Indifferentiability as Indiff0 with + type p <- block, + type f_in <- f_in, + type f_out <- f_out. + +module RO : FUNCTIONALITY = { + proc init = SRO.RO.RO.init + proc f = SRO.RO.RO.get +}. + +module FInit (F : DFUNCTIONALITY) = { + proc init () = {} + proc get = F.f + proc f = F.f + proc set (a : f_in, b: f_out) = {} + proc sample (a: f_in) = {} + proc rem (a : f_in) = {} +}. + +module GetF (F : SRO.RO.RO) = { + proc init = F.init + proc f = F.get +}. + +module SInit (F : SRO.RO.RO) (S : SIMULATOR) = { + proc init() = { + S(GetF(F)).init(); + F.init(); + } + proc get = F.get + proc set = F.set + proc rem = F.rem + proc sample = F.sample +}. + +module FM (C : CONSTRUCTION) (P : PRIMITIVE) = { + proc init () = { + P.init(); + C(P).init(); + } + proc get = C(P).f + proc f = C(P).f + proc set (a : f_in, b: f_out) = {} + proc sample (a: f_in) = {} + proc rem (a : f_in) = {} +}. + + +module DColl (A : AdvCollision) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + proc distinguish = Collision(A,FInit(F)).main +}. + +section Collision. + + declare module A <: AdvCollision {-Bounder, -SRO.RO.RO, -SRO.RO.FRO}. + + declare axiom D_ll (F <: Oracle {-A}) : + islossless F.get => islossless A(F).guess. + + lemma coll_resistant_if_indifferentiable + (C <: CONSTRUCTION{-A, -Bounder}) + (P <: PRIMITIVE{-C, -A, -Bounder}) &m : + (exists (S <: SIMULATOR{-Bounder, -A}), + (forall (F <: FUNCTIONALITY), islossless F.f => islossless S(F).init) /\ + `|Pr[GReal(C,P,DColl(A)).main() @ &m : res] - + Pr[GIdeal(RO,S,DColl(A)).main() @ &m : res]| <= bound) => + Pr[Collision(A,FM(C,P)).main() @ &m : res] <= + bound + ((limit * (limit - 1) + 2)%r / 2%r * mu1 sampleto witness). + proof. + move=>[] S [] S_ll Hbound. + have->: Pr[Collision(A, FM(C,P)).main() @ &m : res] = + Pr[GReal(C, P, DColl(A)).main() @ &m : res]. + + byequiv=>//=; proc; inline*; wp; sim. + by swap {1} [1..2] 2; sim. + have/#:Pr[GIdeal(RO, S, DColl(A)).main() @ &m : res] <= + (limit * (limit - 1) + 2)%r / 2%r * mu1 sampleto witness. + have->:Pr[GIdeal(RO, S, DColl(A)).main() @ &m : res] = + Pr[Collision(A, SRO.RO.RO).main() @ &m : res]. + + byequiv=>//=; proc; inline DColl(A, RO, S(RO)).distinguish; wp; sim. + inline*; swap{2} 1 1; wp. + call{1}(S_ll RO _); auto. + by proc; auto; smt(sampleto_ll). + exact(RO_is_collision_resistant A &m). + qed. + +end section Collision. + + +module DPre (A : AdvPreimage) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + var h : f_out + proc distinguish () = { + var b; + b <@ Preimage(A,FInit(F)).main(h); + return b; + } +}. + +section Preimage. + + declare module A <: AdvPreimage {-Bounder, -SRO.RO.RO, -SRO.RO.FRO, -DPre}. + + declare axiom D_ll (F <: Oracle{-A}) : + islossless F.get => islossless A(F).guess. + + lemma preimage_resistant_if_indifferentiable + (C <: CONSTRUCTION{-A, -Bounder, -DPre}) + (P <: PRIMITIVE{-C, -A, -Bounder, -DPre}) &m hash : + (DPre.h{m} = hash) => + (exists (S <: SIMULATOR{-Bounder, -A, -DPre}), + (forall (F <: FUNCTIONALITY), islossless F.f => islossless S(F).init) /\ + `|Pr[GReal(C,P,DPre(A)).main() @ &m : res] - + Pr[GIdeal(RO,S,DPre(A)).main() @ &m : res]| <= bound) => + Pr[Preimage(A,FM(C,P)).main(hash) @ &m : res] <= + bound + (limit + 1)%r * mu1 sampleto hash. + proof. + move=>init_hash [] S [] S_ll Hbound. + have->: Pr[Preimage(A, FM(C,P)).main(hash) @ &m : res] = + Pr[GReal(C, P, DPre(A)).main() @ &m : res]. + + byequiv=>//=; proc; inline*; wp; sp; wp; sim. + by swap {2} [1..2] 4; sim; auto; smt(). + have/#:Pr[GIdeal(RO, S, DPre(A)).main() @ &m : res] <= + (limit + 1)%r * mu1 sampleto hash. + have->:Pr[GIdeal(RO, S, DPre(A)).main() @ &m : res] = + Pr[Preimage(A, SRO.RO.RO).main(hash) @ &m : res]. + + byequiv=>//=; proc; inline DPre(A, RO, S(RO)).distinguish; wp; sim. + inline*; swap{2} 1 1; wp; sim; auto. + call{1} (S_ll RO _); auto. + by proc; auto; smt(sampleto_ll). + exact(RO_is_preimage_resistant A &m hash). + qed. + +end section Preimage. + + +module D2Pre (A : AdvSecondPreimage) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + var m2 : f_in + proc distinguish () = { + var b; + b <@ SecondPreimage(A,FInit(F)).main(m2); + return b; + } +}. + +section SecondPreimage. + + declare module A <: AdvSecondPreimage {-Bounder, -SRO.RO.RO, -SRO.RO.FRO, -D2Pre}. + + declare axiom D_ll (F <: Oracle{-A}) : + islossless F.get => islossless A(F).guess. + + lemma second_preimage_resistant_if_indifferentiable + (C <: CONSTRUCTION{-A, -Bounder, -D2Pre}) + (P <: PRIMITIVE{-C, -A, -Bounder, -D2Pre}) &m mess : + (D2Pre.m2{m} = mess) => + (exists (S <: SIMULATOR{-Bounder, -A, -D2Pre}), + (forall (F <: FUNCTIONALITY), islossless F.f => islossless S(F).init) /\ + `|Pr[GReal(C,P,D2Pre(A)).main() @ &m : res] - + Pr[GIdeal(RO,S,D2Pre(A)).main() @ &m : res]| <= bound) => + Pr[SecondPreimage(A,FM(C,P)).main(mess) @ &m : res] <= + bound + (limit + 1)%r * mu1 sampleto witness. + proof. + move=>init_mess [] S [] S_ll Hbound. + have->: Pr[SecondPreimage(A, FM(C,P)).main(mess) @ &m : res] = + Pr[GReal(C, P, D2Pre(A)).main() @ &m : res]. + + byequiv=>//=; proc; inline*; wp; sp; wp; sim. + by swap {2} [1..2] 3; sim; auto; smt(). + have/#:Pr[GIdeal(RO, S, D2Pre(A)).main() @ &m : res] <= + (limit + 1)%r * mu1 sampleto witness. + have->:Pr[GIdeal(RO, S, D2Pre(A)).main() @ &m : res] = + Pr[SecondPreimage(A, SRO.RO.RO).main(mess) @ &m : res]. + + byequiv=>//=; proc; inline D2Pre(A, RO, S(RO)).distinguish; wp; sim. + inline*; swap{2} 1 1; wp; sim; auto. + call{1} (S_ll RO _); auto. + by proc; auto; smt(sampleto_ll). + exact(RO_is_second_preimage_resistant A &m mess). + qed. + +end section SecondPreimage. diff --git a/sha3/proof/Indifferentiability.eca b/sha3/proof/Indifferentiability.eca new file mode 100644 index 0000000..842756c --- /dev/null +++ b/sha3/proof/Indifferentiability.eca @@ -0,0 +1,68 @@ +(** A primitive: the building block we assume ideal **) +type p. + +module type PRIMITIVE = { + proc init(): unit + proc f(x : p): p + proc fi(x : p): p +}. + +module type DPRIMITIVE = { + proc f(x : p): p + proc fi(x : p): p +}. + +(** A functionality: the target construction **) +type f_in, f_out. + +module type FUNCTIONALITY = { + proc init(): unit + proc f(x : f_in): f_out +}. + +module type DFUNCTIONALITY = { + proc f(x : f_in): f_out +}. + +(** A construction takes a primitive and builds a functionality. + A simulator takes a functionality and simulates the primitive. + A distinguisher gets oracle access to a primitive and a + functionality and returns a boolean (its guess as to whether it + is playing with constructed functionality and ideal primitive or + with ideal functionality and simulated primitive). **) +module type CONSTRUCTION (P : DPRIMITIVE) = { + proc init() : unit {} + proc f(x : f_in): f_out { P.f } +}. + +module type SIMULATOR (F : DFUNCTIONALITY) = { + proc init() : unit { } + proc f(x : p) : p { F.f } + proc fi(x : p) : p { F.f } +}. + +module type DISTINGUISHER (F : DFUNCTIONALITY, P : DPRIMITIVE) = { + proc distinguish(): bool +}. + +module Indif (F : FUNCTIONALITY, P : PRIMITIVE, D : DISTINGUISHER) = { + proc main(): bool = { + var b; + + P.init(); + F.init(); + b <@ D(F,P).distinguish(); + return b; + } +}. + +(* Using the name Real can be a bad idea, since it can clash with the theory Real *) +module GReal(C : CONSTRUCTION, P : PRIMITIVE) = Indif(C(P),P). +module GIdeal(F : FUNCTIONALITY, S : SIMULATOR) = Indif(F,S(F)). + +(* (C <: CONSTRUCTION) applied to (P <: PRIMITIVE) is indifferentiable + from (F <: FUNCTIONALITY) if there exists (S <: SIMULATOR) such + that, for all (D <: DISTINGUISHER), + | Pr[Real(P,C,D): res] - Pr[Ideal(F,S,D): res] | is small. + We avoid the existential by providing a concrete construction for S + and the `small` by providing a concrete bound. *) diff --git a/sha3/proof/OptionIndifferentiability.eca b/sha3/proof/OptionIndifferentiability.eca new file mode 100644 index 0000000..638e9e1 --- /dev/null +++ b/sha3/proof/OptionIndifferentiability.eca @@ -0,0 +1,61 @@ +(** A primitive: the building block we assume ideal **) +type p. + +module type OPRIMITIVE = { + proc init(): unit + proc f(x : p): p option + proc fi(x : p): p option +}. + +module type ODPRIMITIVE = { + proc f(x : p): p option + proc fi(x : p): p option +}. + +(** A functionality: the target construction **) +type f_in, f_out. + +module type OFUNCTIONALITY = { + proc init(): unit + proc f(x : f_in): f_out option +}. + +module type ODFUNCTIONALITY = { + proc f(x : f_in): f_out option +}. + +(** A construction takes a primitive and builds a functionality. + A simulator takes a functionality and simulates the primitive. + A distinguisher gets oracle access to a primitive and a + functionality and returns a boolean (its guess as to whether it + is playing with constructed functionality and ideal primitive or + with ideal functionality and simulated primitive). **) +module type OCONSTRUCTION (P : ODPRIMITIVE) = { + proc init() : unit {} + proc f(x : f_in): f_out option { P.f } +}. + +module type OSIMULATOR (F : ODFUNCTIONALITY) = { + proc init() : unit { } + proc f(x : p) : p option { F.f } + proc fi(x : p) : p option { F.f } +}. + +module type ODISTINGUISHER (F : ODFUNCTIONALITY, P : ODPRIMITIVE) = { + proc distinguish(): bool +}. + +module OIndif (F : OFUNCTIONALITY, P : OPRIMITIVE, D : ODISTINGUISHER) = { + proc main(): bool = { + var b; + + P.init(); + F.init(); + b <@ D(F,P).distinguish(); + return b; + } +}. + +(* Using the name Real can be a bad idea, since it can clash with the theory Real *) +module OGReal(C : OCONSTRUCTION, P : OPRIMITIVE) = OIndif(C(P),P). +module OGIdeal(F : OFUNCTIONALITY, S : OSIMULATOR) = OIndif(F,S(F)). diff --git a/sha3/proof/SHA3Indiff.ec b/sha3/proof/SHA3Indiff.ec new file mode 100644 index 0000000..85aed88 --- /dev/null +++ b/sha3/proof/SHA3Indiff.ec @@ -0,0 +1,319 @@ +require import AllCore List IntDiv StdOrder Distr SmtMap FSet. + +require import Common Sponge. import BIRO. +require (*--*) SLCommon Gconcl_list BlockSponge. + +(* FIX: would be nicer to define limit at top-level and then clone + BlockSponge with it - so BlockSponge would then clone lower-level + theories with it + +op limit : {int | 0 < limit} as gt0_max_limit. +*) +op limit : int = SLCommon.max_size. + + + +(* The last inlined simulator *) +type state = SLCommon.state. +op parse = BlockSponge.parse. +op valid = Gconcl_list.valid. + + +module Simulator (F : DFUNCTIONALITY) = { + var m : (state, state) fmap + var mi : (state, state) fmap + var paths : (capacity, block list * block) fmap + proc init() = { + m <- empty; + mi <- empty; + paths <- empty.[c0 <- ([],b0)]; + Gconcl_list.BIRO2.IRO.init(); + } + proc f (x : state) : state = { + var p,v,z,q,k,cs,y,y1,y2; + if (x \notin m) { + if (x.`2 \in paths) { + (p,v) <- oget paths.[x.`2]; + z <- []; + (q,k) <- parse (rcons p (v +^ x.`1)); + if (valid q) { + cs <@ F.f(oget (unpad_blocks q), k * r); + z <- bits2blocks cs; + } else { + z <@ Gconcl_list.BIRO2.IRO.f(q,k); + } + y1 <- last b0 z; + } else { + y1 <$ bdistr; + } + y2 <$ cdistr; + y <- (y1,y2); + m.[x] <- y; + mi.[y] <- x; + if (x.`2 \in paths) { + (p,v) <-oget paths.[x.`2]; + paths.[y2] <- (rcons p (v +^ x.`1),y.`1); + } + } else { + y <- oget m.[x]; + } + return y; + } + proc fi (x : state) : state = { + var y,y1,y2; + if (! x \in mi) { + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + mi.[x] <- y; + m.[y] <- x; + } else { + y <- oget mi.[x]; + } + return y; + } +}. + + + +(*---------------------------- Restrictions ----------------------------*) + +(** The counter for the functionality counts the number of times the + underlying primitive is called inside the functionality. This + number is equal to the sum of the number of blocks in the padding + of the input, plus the number of additional blocks the squeezing + phase has to output. + *) + +module Cntr = { + var c : int + + proc init() = { + c <- 0; + } +}. + +module FC (F : DFUNCTIONALITY) = { + proc init () : unit = {} + + (* ((size bs + 1) %/ r + 1) = size (pad2blocks bs): *) + + proc f (bs : bool list, n : int) : bool list = { + var z : bool list <- []; + if (Cntr.c + + ((size bs + 1) %/ r + 1) + + (max ((n + r - 1) %/ r - 1) 0) <= limit) { + Cntr.c <- + Cntr.c + + ((size bs + 1) %/ r + 1) + + (max ((n + r - 1) %/ r - 1) 0); + z <@ F.f(bs, n); + } + return z; + } +}. + +module PC (P : DPRIMITIVE) = { + proc init() = {} + + proc f (a : block * capacity) = { + var z : block * capacity <- (b0, c0); + if (Cntr.c + 1 <= limit) { + z <@ P.f(a); + Cntr.c <- Cntr.c + 1; + } + return z; + } + proc fi (a : block * capacity) = { + var z : block * capacity <- (b0, c0); + if (Cntr.c + 1 <= limit) { + z <@ P.fi(a); + Cntr.c <- Cntr.c + 1; + } + return z; + } +}. + +module DRestr (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + proc distinguish () : bool = { + var b : bool; + Cntr.init(); + b <@ D(FC(F),PC(P)).distinguish(); + return b; + } +}. + +section. + +declare module Dist <: + DISTINGUISHER {-Perm, -Gconcl_list.SimLast, -IRO, -Cntr, -BlockSponge.BIRO.IRO, -Simulator, -BlockSponge.C, -Gconcl.S, -SLCommon.F.RO, -SLCommon.F.FRO, -SLCommon.Redo, -SLCommon.C, -Gconcl_list.BIRO2.IRO, -Gconcl_list.F2.RO, -Gconcl_list.F2.FRO, -Gconcl_list.Simulator}. + +declare axiom Dist_lossless (F <: DFUNCTIONALITY {-Dist}) (P <: DPRIMITIVE {-Dist}) : + islossless P.f => islossless P.fi => islossless F.f => + islossless Dist(F,P).distinguish. + +lemma drestr_commute1 &m : + Pr[BlockSponge.RealIndif + (BlockSponge.Sponge, Perm, + LowerDist(DRestr(Dist))).main() @ &m : res] = + Pr[BlockSponge.RealIndif + (BlockSponge.Sponge, Perm, + BlockSponge.DRestr(LowerDist(Dist))).main() @ &m : res]. +proof. +byequiv=> //; proc. +seq 2 2 : (={glob Dist} /\ ={Perm.m, Perm.mi} ); first sim. +inline*; wp; sp. +call (_ : ={c}(Cntr, BlockSponge.C) /\ ={Perm.m, Perm.mi}). +proc; sp; if=> //; sp; sim. +proc; sp; if=> //; sp; sim. +proc=> /=. +inline BlockSponge.FC(BlockSponge.Sponge(Perm)).f. +wp; sp. +if=> //. +progress; smt(size_pad2blocks). +seq 1 1 : + (={n} /\ nb{2} = (n{2} + r - 1) %/ r /\ bl{2} = pad2blocks bs{1} /\ + Cntr.c{1} = BlockSponge.C.c{2} /\ ={Perm.m, Perm.mi}). +auto; progress; by rewrite size_pad2blocks. +inline RaiseFun(BlockSponge.Sponge(Perm)).f. +wp; sp. +call (_ : ={Perm.m, Perm.mi}); first sim. +auto. +auto; progress; by rewrite blocks2bits_nil. +qed. + +lemma drestr_commute2 &m : + Pr[BlockSponge.IdealIndif + (BlockSponge.BIRO.IRO, Gconcl_list.SimLast(Gconcl.S), + LowerDist(DRestr(Dist))).main() @ &m : res] = + Pr[BlockSponge.IdealIndif + (BlockSponge.BIRO.IRO, Gconcl_list.SimLast(Gconcl.S), + BlockSponge.DRestr(LowerDist(Dist))).main() @ &m : res]. +proof. +byequiv=> //; proc. +seq 2 2 : + (={glob Dist, BlockSponge.BIRO.IRO.mp, + glob Gconcl_list.SimLast(Gconcl.S)}); first sim. +inline*; wp; sp. +call + (_ : ={BlockSponge.BIRO.IRO.mp,Gconcl_list.BIRO2.IRO.mp} /\ + ={c}(Cntr, BlockSponge.C) /\ + ={glob Gconcl_list.SimLast(Gconcl.S)}). +proc; sp; if=> //; sim. +proc; sp; if=> //; sim. +proc=> /=. +inline BlockSponge.FC(BlockSponge.BIRO.IRO).f. +sp; wp. +if=> //. +progress; smt(size_pad2blocks). +seq 1 1 : + (={n} /\ nb{2} = (n{2} + r - 1) %/ r /\ bl{2} = pad2blocks bs{1} /\ + Cntr.c{1} = BlockSponge.C.c{2} /\ + ={BlockSponge.BIRO.IRO.mp, Gconcl_list.BIRO2.IRO.mp, + Gconcl.S.paths, Gconcl.S.mi, Gconcl.S.m}). +auto; progress. +rewrite size_pad2blocks //. +inline RaiseFun(BlockSponge.BIRO.IRO).f. +wp; sp. +call (_ : ={BlockSponge.BIRO.IRO.mp}); first sim. +auto. +by auto. +qed. + +op wit_pair : block * capacity = witness. + +local equiv equiv_sim_f (F <: DFUNCTIONALITY{-Gconcl.S, -Simulator}) : + RaiseSim(Gconcl_list.SimLast(Gconcl.S),F).f + ~ + Simulator(F).f + : + ={arg, glob F, glob Gconcl_list.BIRO2.IRO} /\ ={m, mi, paths}(Gconcl.S,Simulator) + ==> + ={res, glob F, glob Gconcl_list.BIRO2.IRO} /\ ={m, mi, paths}(Gconcl.S,Simulator). +proof. +proc;inline*;if;1,3:auto=>/#. +wp;conseq(:_==> ={y1, y2, glob F, glob Gconcl_list.BIRO2.IRO} + /\ ={m, mi, paths}(Gconcl.S,Simulator));progress;sim. +if;1,3:auto=>/#;wp;sp;if;1:(auto;smt(BlockSponge.parseK BlockSponge.formatK)); + last sim;smt(BlockSponge.parseK BlockSponge.formatK). +by sp;wp;rcondt{1}1;auto;call(: true);auto;smt(BlockSponge.parseK BlockSponge.formatK). +qed. + + +local equiv equiv_sim_fi (F <: DFUNCTIONALITY{-Gconcl.S, -Simulator}) : + RaiseSim(Gconcl_list.SimLast(Gconcl.S),F).fi + ~ + Simulator(F).fi + : + ={arg, glob F, glob Gconcl_list.BIRO2.IRO} /\ ={m, mi, paths}(Gconcl.S,Simulator) + ==> + ={res, glob F, glob Gconcl_list.BIRO2.IRO} /\ ={m, mi, paths}(Gconcl.S,Simulator). +proof. by proc;inline*;if;auto=>/#. qed. + +local lemma replace_simulator &m : + Pr[IdealIndif(IRO, RaiseSim(Gconcl_list.SimLast(Gconcl.S)), + DRestr(Dist)).main() @ &m : res] = + Pr[IdealIndif(IRO, Simulator, DRestr(Dist)).main() @ &m : res]. +proof. +byequiv=>//=;proc;inline*;sp;wp. +call(: ={glob IRO, glob DRestr, glob Gconcl_list.BIRO2.IRO} + /\ ={m, mi, paths}(Gconcl.S,Simulator));auto. ++ by proc;sp;if;auto;call(equiv_sim_f IRO);auto. ++ by proc;sp;if;auto;call(equiv_sim_fi IRO);auto. +by proc;sim. +qed. + + + +lemma security &m : + `|Pr[RealIndif(Sponge, Perm, DRestr(Dist)).main() @ &m : res] - + Pr[IdealIndif(IRO, Simulator, DRestr(Dist)).main() @ &m : res]| <= + (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. +proof. +rewrite -(replace_simulator &m). +rewrite exprSr 1:addz_ge0 1:ge0_r 1:ge0_c mulrC exprD_nneg 1:ge0_r 1:ge0_c. +have -> : + (limit ^ 2 - limit)%r / (2 * (2 ^ r * 2 ^ c))%r = + ((limit ^ 2 - limit)%r / 2%r) * (1%r / (2 ^ r)%r) * (1%r / (2 ^ c)%r). + by rewrite (fromintM 2); smt(). +rewrite/=. +have -> : + (4 * limit ^ 2)%r / (2 ^ c)%r = + limit%r * ((2 * limit)%r / (2 ^ c)%r) + limit%r * ((2 * limit)%r / (2 ^ c)%r). + have -> : 4 = 2 * 2 by trivial. + have {3}-> : 2 = 1 + 1 by trivial. + rewrite exprS // expr1 /#. +rewrite -/SLCommon.dstate /limit. +have->:=conclusion (Gconcl_list.SimLast(Gconcl.S)) (DRestr(Dist)) &m. +have//=:=(Gconcl_list.Real_Ideal (LowerDist(Dist)) _ &m). ++ move=>F P hp hpi hf'//=. + have hf:islossless RaiseFun(F).f. + - proc;call hf';auto. + exact(Dist_lossless (RaiseFun(F)) P hp hpi hf). +rewrite(drestr_commute1 &m) (drestr_commute2 &m). +have->:=Gconcl_list.Simplify_simulator (LowerDist(Dist)) _ &m. ++ move=>F P hp hpi hf'//=. + have hf:islossless RaiseFun(F).f. + - proc;call hf';auto. + exact(Dist_lossless (RaiseFun(F)) P hp hpi hf). +smt(). +qed. + + + + +end section. + +lemma SHA3Indiff + (Dist <: DISTINGUISHER{-Perm, -IRO, -BlockSponge.BIRO.IRO, -Cntr, -Simulator, -Gconcl_list.SimLast(Gconcl.S), -BlockSponge.C, -Gconcl.S, -SLCommon.F.RO, -SLCommon.F.FRO, -SLCommon.Redo, -SLCommon.C, -Gconcl_list.BIRO2.IRO, -Gconcl_list.F2.RO, -Gconcl_list.F2.FRO, -Gconcl_list.Simulator}) + &m : + (forall (F <: DFUNCTIONALITY {-Dist}) (P <: DPRIMITIVE {-Dist}), + islossless P.f => + islossless P.fi => + islossless F.f => + islossless Dist(F,P).distinguish) => + `|Pr[RealIndif(Sponge, Perm, DRestr(Dist)).main() @ &m : res] - + Pr[IdealIndif(IRO, Simulator, DRestr(Dist)).main() @ &m : res]| <= + (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. +proof. move=>h;apply (security Dist h &m). qed. + diff --git a/sha3/proof/SHA3OSecurity.ec b/sha3/proof/SHA3OSecurity.ec new file mode 100644 index 0000000..95fa0bc --- /dev/null +++ b/sha3/proof/SHA3OSecurity.ec @@ -0,0 +1,2634 @@ +(* Top-level Proof of SHA-3 Security *) + +require import AllCore Distr DList DBool List IntDiv Dexcepted DProd SmtMap FSet. +require import Common SLCommon Sponge SHA3_OIndiff. +require (****) SecureORO SecureHash. +(*****) import OIndif. + +require import PROM. + + +(* module SHA3 (P : DPRIMITIVE) = { *) +(* proc init() : unit = {} *) +(* proc f (bl : bool list, n : int) : bool list = { *) +(* var r : bool list; *) +(* r <@ Sponge(P).f(bl ++ [false; true], n); *) +(* return r; *) +(* } *) +(* }. *) + +op size_out : int. +axiom size_out_gt0 : 0 < size_out. + +op sigma : int = SHA3Indiff.limit. +axiom sigma_ge0 : 0 <= sigma. + +op limit : int = sigma. + +type f_out. + +op dout : f_out distr. +axiom dout_ll : is_lossless dout. +axiom dout_fu : is_funiform dout. +axiom dout_full : is_full dout. + + +op to_list : f_out -> bool list. +op of_list : bool list -> f_out option. +axiom spec_dout (l : f_out) : size (to_list l) = size_out. +axiom spec2_dout (l : bool list) : size l = size_out => of_list l <> None. +axiom to_list_inj : injective to_list. +axiom to_listK e l : to_list e = l <=> of_list l = Some e. + +axiom dout_equal_dlist : dmap dout to_list = dlist dbool size_out. + +lemma doutE1 x : mu1 dout x = inv (2%r ^ size_out). +proof. +have->:inv (2%r ^ size_out) = mu1 (dlist dbool size_out) (to_list x). ++ rewrite dlist1E. + - smt(size_out_gt0). + rewrite spec_dout/=. + pose p:= StdBigop.Bigreal.BRM.big _ _ _. + have->: p = StdBigop.Bigreal.BRM.big predT (fun _ => inv 2%r) (to_list x). + - rewrite /p =>{p}. + apply StdBigop.Bigreal.BRM.eq_bigr. + by move=> i; rewrite//= dbool1E. + rewrite StdBigop.Bigreal.BRM.big_const count_predT spec_dout=> {p}. + have:=size_out_gt0; move/ltzW. + move:size_out;apply intind=> //=. + - by rewrite RField.expr0 iter0 //= fromint1. + move=> i hi0 rec. + by rewrite RField.exprS//iterS// -rec; smt(). +rewrite -dout_equal_dlist dmap1E. +apply mu_eq. +by move=> l; rewrite /pred1/(\o); smt(to_listK). +qed. + + +(* module CSetSize (F : OCONSTRUCTION) (P : ODPRIMITIVE) = { *) +(* proc init = F(P).init *) +(* proc f (x : bool list) = { *) +(* var r, l; *) +(* r <@ F(P).f(x,size_out); *) +(* l <- (r <> None) ? of_list (oget r) : None; *) +(* return l; *) +(* } *) +(* }. *) + +(* module FSetSize (F : OFUNCTIONALITY) = { *) +(* proc init = F.init *) +(* proc f (x : bool list) = { *) +(* var r, l; *) +(* r <@ F.f(x,size_out); *) +(* l <- (r <> None) ? of_list (oget r) : None; *) +(* return l; *) +(* } *) +(* }. *) + +clone import SecureORO as SORO with + type from <- bool list, + type to <- f_out, + + op sampleto <- dout, + op bound <- sigma, + op increase_counter <- fun c m => c + ((size m + 1) %/ r + 1) + + max ((size_out + r - 1) %/ r - 1) 0 + + proof *. +realize bound_ge0 by exact(sigma_ge0). +realize sampleto_ll by exact(dout_ll). +realize sampleto_fu by exact(dout_fu). +realize sampleto_full by exact(dout_full). +realize increase_counter_spec by smt(List.size_ge0 divz_ge0 gt0_r). + + +clone import SecureHash as SH with + type from <- bool list, + type to <- f_out, + type block <- state, + op sampleto <- dout, + op bound <- sigma, + op increase_counter <- fun c m => c + ((size m + 1) %/ r + 1) + + max ((size_out + r - 1) %/ r - 1) 0 +proof *. +realize sampleto_ll by exact(dout_ll). +realize sampleto_fu by exact(dout_fu). +realize sampleto_full by exact(dout_full). +realize bound_ge0 by exact(sigma_ge0). +realize increase_counter_spec by smt(List.size_ge0 divz_ge0 gt0_r). + + +(* module FGetSize (F : ODFUNCTIONALITY) = { *) +(* proc f (x : bool list, i : int) = { *) +(* var r; *) +(* r <@ F.f(x); *) +(* return to_list r; *) +(* } *) +(* }. *) + +(* module SimSetSize (S : SIMULATOR) (F : Indiff0.DFUNCTIONALITY) = S(FGetSize(F)). *) + +(* module DFSetSize (F : DFUNCTIONALITY) = { *) +(* proc f (x : bool list) = { *) +(* var r; *) +(* r <@ F.f(x,size_out); *) +(* return oget (of_list r); *) +(* } *) +(* }. *) + +(* module (DSetSize (D : Indiff0.DISTINGUISHER) : DISTINGUISHER) *) +(* (F : DFUNCTIONALITY) (P : DPRIMITIVE) = D(DFSetSize(F),P). *) + + +module FSetSize (F : OFUNCTIONALITY) : OIndif.OFUNCTIONALITY = { + proc init = F.init + proc f (x : bool list) = { + var y, r; + y <@ F.f(x,size_out); + r <- (y <> None) ? of_list (oget y) : None; + return r; + } + proc get = f +}. + +module DFSetSize (F : ODFUNCTIONALITY) : OIndif.OFUNCTIONALITY = { + proc init () = {} + proc f (x : bool list) = { + var y, r; + y <@ F.f(x,size_out); + r <- (y <> None) ? of_list (oget y) : None; + return r; + } +}. + +module FIgnoreSize (F : OIndif.ODFUNCTIONALITY) : OFUNCTIONALITY = { + proc init () = {} + proc f (x : bool list, i : int) = { + var y, r; + y <@ F.f(x); + return omap to_list r; + } +}. + +module (OSponge : OIndif.OCONSTRUCTION) (P : OIndif.ODPRIMITIVE) = + FSetSize(CSome(Sponge,P)). + + +clone import Program as PBool with + type t <- bool, + op d <- dbool +proof *. + +clone import FullRO as Eager with + type in_t <- bool list * int, + type out_t <- bool, + op dout _ <- dbool, + type d_in_t <- unit, + type d_out_t <- bool. +import FullEager. + +section Preimage. + + declare module A <: SH.AdvPreimage {-Perm, -Counter, -Bounder, -F.RO, -F.FRO, -Redo, -C, -Gconcl.S, -BlockSponge.BIRO.IRO, -BlockSponge.C, -BIRO.IRO, -Gconcl_list.BIRO2.IRO, -Gconcl_list.F2.RO, -Gconcl_list.F2.FRO, -Gconcl_list.Simulator, -SHA3Indiff.Simulator, -SHA3Indiff.Cntr, -SORO.Bounder, -SORO.RO.RO, -RO, -FRO}. + + local module FInit (F : OIndif.ODFUNCTIONALITY) : OIndif.OFUNCTIONALITY = { + proc init () = {} + proc f = F.f + }. + + local module PInit (P : ODPRIMITIVE) : OPRIMITIVE = { + proc init () = {} + proc f = P.f + proc fi = P.fi + }. + + +local module OF (F : Oracle) : OIndif.ODFUNCTIONALITY = { + proc f = F.get +}. + + +local module Log = { + var m : (bool list * int, bool) fmap +}. + +local module ExtendOutputSize (F : Oracle) : ODFUNCTIONALITY = { + proc f (x : bool list, k : int) = { + var o, l, suffix, prefix, i, r; + l <- None; + prefix <- []; + suffix <- []; + o <@ F.get(x); + prefix <- take k (to_list (oget o)); + i <- size_out; + while (i < k) { + if ((x,i) \notin Log.m) { + r <$ {0,1}; + Log.m.[(x,i)] <- r; + } + suffix <- rcons suffix (oget Log.m.[(x,i)]); + i <- i + 1; + } + l <- Some (prefix ++ suffix); + return l; + } +}. + +local module OFC2 (F : Oracle) = OFC(ExtendOutputSize(F)). + +local module ExtendOutput (F : RF) = { + proc init () = { + Log.m <- empty; + F.init(); + } + proc f = ExtendOutputSize(F).f + proc get = f +}. + + local module (Dist_of_P1Adv (A : SH.AdvPreimage) : ODISTINGUISHER) (F : ODFUNCTIONALITY) (P : ODPRIMITIVE) = { + proc distinguish () = { + var hash, hash', m; + Log.m <- empty; + hash <$ dout; + m <@ A(DFSetSize(F),P).guess(hash); + hash' <@ DFSetSize(F).f(m); + return hash' = Some hash; + } + }. + + +local module (SORO_P1 (A : SH.AdvPreimage) : SORO.AdvPreimage) (F : Oracle) = { + proc guess (h : f_out) : bool list = { + var mi; + Log.m <- empty; + Counter.c <- 0; + OSimulator(ExtendOutputSize(F)).init(); + mi <@ A(DFSetSize(OFC2(F)),OPC(OSimulator(ExtendOutputSize(F)))).guess(h); + return mi; + } +}. + +local module RFList = { + var m : (bool list, f_out) fmap + proc init () = { + m <- empty; + } + proc get (x : bool list) : f_out option = { + var z; + if (x \notin m) { + z <$ dlist dbool size_out; + m.[x] <- oget (of_list z); + } + return m.[x]; + } + proc sample (x: bool list) = {} +}. + +local module RFWhile = { + proc init () = { + RFList.m <- empty; + } + proc get (x : bool list) : f_out option = { + var l, i, b; + if (x \notin RFList.m) { + i <- 0; + l <- []; + while (i < size_out) { + b <$ dbool; + l <- rcons l b; + i <- i + 1; + } + RFList.m.[x] <- oget (of_list l); + } + return RFList.m.[x]; + } + proc sample (x: bool list) = {} +}. + +local equiv rw_RF_List_While : + RFList.get ~ RFWhile.get : + ={arg, glob RFList} ==> ={res, glob RFWhile}. +proof. +proc; if; 1, 3: auto; wp. +conseq(:_==> z{1} = l{2})=> />. +transitivity{1} { + z <@ Sample.sample(size_out); + } + (true ==> ={z}) + (true ==> z{1} = l{2})=>/>. ++ by inline*; auto. +transitivity{1} { + z <@ LoopSnoc.sample(size_out); + } + (true ==> ={z}) + (true ==> z{1} = l{2})=>/>; last first. ++ inline*; auto; sim. + by while(={l, i} /\ n{1} = size_out); auto; smt(cats1). +by call(Sample_LoopSnoc_eq); auto. +qed. + + +op inv (m1 : (bool list * int, bool) fmap) (m2 : (bool list, f_out) fmap) = + (forall l i, (l,i) \in m1 => 0 <= i < size_out) /\ + (forall l i, (l,i) \in m1 => l \in m2) /\ + (forall l, l \in m2 => forall i, 0 <= i < size_out => (l,i) \in m1) /\ + (forall l i, (l,i) \in m1 => m1.[(l,i)] = Some (nth witness (to_list (oget m2.[l])) i)). + +local equiv eq_IRO_RFWhile : + BIRO.IRO.f ~ RFWhile.get : + arg{1} = (x{2}, size_out) /\ inv BIRO.IRO.mp{1} RFList.m{2} + ==> + res{2} = of_list res{1} /\ size res{1} = size_out /\ inv BIRO.IRO.mp{1} RFList.m{2}. +proof. +proc; inline*; sp. +rcondt{1} 1; 1: by auto. +if{2}; sp; last first. ++ alias{1} 1 mp = BIRO.IRO.mp. + conseq(:_==> BIRO.IRO.mp{1} = mp{1} /\ size bs{1} = i{1} /\ i{1} = size_out /\ + inv mp{1} RFList.m{2} /\ + bs{1} = take i{1} (to_list (oget RFList.m{2}.[x{1}])))=> />. + - move=> &l &r H0 H1 H2 H3 H4 bs_L mp_L H5 H6 H7 H8 H9. + rewrite take_oversize 1:spec_dout 1:H5 //. + rewrite eq_sym to_listK => ->. + by have:=H4; rewrite domE; smt(). + - smt(take_oversize spec_dout). + while{1}(BIRO.IRO.mp{1} = mp{1} /\ size bs{1} = i{1} /\ + 0 <= i{1} <= size_out /\ n{1} = size_out /\ + inv mp{1} RFList.m{2} /\ x{1} \in RFList.m{2} /\ + bs{1} = take i{1} (to_list (oget RFList.m{2}.[x{1}])))(size_out - i{1}); + auto=> />. + + sp; rcondf 1; auto=> />; 1: smt(). + move=> &h H0 H1 H2 H3 H4 H5 H6 H7 H8. + rewrite size_rcons //=; do!split; 1, 2, 4: smt(size_ge0). + rewrite (take_nth witness) 1:spec_dout 1:size_ge0//=. + rewrite - H7; congr; rewrite H5=> //=. + by apply H4=> //=. + smt(size_out_gt0 size_ge0 take0). +auto=> //=. +conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{1} /\ n{1} = size_out /\ + inv BIRO.IRO.mp{1} RFList.m{2}.[x{2} <- oget (of_list l{2})])=> />. ++ smt(get_setE spec2_dout). ++ smt(get_setE spec2_dout). +alias{1} 1 m = BIRO.IRO.mp; sp. +conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{1} /\ + n{1} = size_out /\ inv m{1} RFList.m{2} /\ + (forall j, (x{1}, j) \in BIRO.IRO.mp{1} => 0 <= j < i{1}) /\ + (forall l j, l <> x{1} => m{1}.[(l,j)] = BIRO.IRO.mp{1}.[(l,j)]) /\ + (forall j, 0 <= j < i{1} => (x{1}, j) \in BIRO.IRO.mp{1}) /\ + (forall j, 0 <= j < i{1} => BIRO.IRO.mp{1}.[(x{1},j)] = Some (nth witness bs{1} j))). ++ move=> /> &l &r H0 H1 H2 H3 H4 mp_L bs_L H5 H6 H7 H8 H9; do!split; ..-2 : smt(domE mem_set). + move=> l j Hin. + rewrite get_setE/=. + case: (l = x{r}) => [<<-|]. + - rewrite oget_some H9; 1:smt(); congr; congr. + by rewrite eq_sym to_listK; smt(spec2_dout). + move=> Hneq. + by rewrite -(H7 _ _ Hneq) H3; smt(domE). +while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ + n{1} = size_out /\ inv m{1} RFList.m{2} /\ + (forall j, (x{1}, j) \in BIRO.IRO.mp{1} => 0 <= j < i{1}) /\ + (forall l j, l <> x{1} => m{1}.[(l,j)] = BIRO.IRO.mp{1}.[(l,j)]) /\ + (forall j, 0 <= j < i{1} => (x{1}, j) \in BIRO.IRO.mp{1}) /\ + (forall j, 0 <= j < i{1} => BIRO.IRO.mp{1}.[(x{1},j)] = Some (nth witness bs{1} j))). ++ sp; rcondt{1} 1; auto=> />. + - smt(). + move=> &l &r H0 H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 rL _. + rewrite get_setE /= size_rcons /=; do!split; 1,2: smt(size_ge0). + - smt(mem_set). + - smt(get_setE). + - smt(mem_set). + - move=>j Hj0 Hjsize; rewrite get_setE/=nth_rcons. + case: (j = size bs{l})=>[->>//=|h]. + have/=Hjs:j < size bs{l} by smt(). + by rewrite Hjs/=H9//=. +by auto; smt(size_out_gt0). +qed. + +op eq_extend_size (m1 : (bool list * int, bool) fmap) (m2 : (bool list * int, bool) fmap) + (m3 : (bool list * int, bool) fmap) = + (* (forall x j, (x,j) \in m2 => 0 <= j < size_out) /\ *) + (* (forall x j, (x,j) \in m2 => forall k, 0 <= k < size_out => (x, k) \in m2) /\ *) + (forall x j, 0 <= j < size_out => m1.[(x,j)] = m2.[(x,j)]) /\ + (forall x j, size_out <= j => m1.[(x,j)] = m3.[(x,j)]) /\ + (forall x j, (x,j) \in m1 => 0 <= j). + +local module ExtendSample (F : OFUNCTIONALITY) = { + proc init = F.init + proc f (x : bool list, k : int) = { + var y; + if (k <= size_out) { + y <@ F.f(x,size_out); + y <- omap (take k) y; + } else { + y <@ F.f(x,k); + } + return y; + } +}. + + +local equiv eq_extend : + ExtendSample(FSome(BIRO.IRO)).f ~ ExtendOutputSize(FSetSize(FSome(BIRO.IRO))).f : + ={arg} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2} ==> + ={res} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}. +proof. +proc; inline*; auto; sp. +rcondt{2} 1; 1: auto. +if{1}; sp. +- rcondt{1} 1; auto. + rcondf{2} 8; 1: auto. + - conseq(:_==> true); 1: smt(). + by while(true); auto. + auto=> /=. + conseq(:_==> ={bs, k} /\ size bs{1} = size_out /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2})=> //=. + - smt(cats0 to_listK spec2_dout). + while(={k, bs, n, x2} /\ i{1} = i0{2} /\ n{1} = size_out /\ + 0 <= i{1} <= n{1} /\ size bs{1} = i{1} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). + - by sp; if; auto=> />; smt(domE get_setE size_rcons). + by auto=> />; smt(size_eq0 size_out_gt0). +rcondt{1} 1; 1: auto. +splitwhile{1} 1 : i0 < size_out; auto=> /=. +while( (i0, n0, x3){1} = (i, k, x){2} /\ bs0{1} = prefix{2} ++ suffix{2} /\ + size_out <= i{2} <= k{2} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). ++ sp; if; auto=> />; 1,3:smt(domE rcons_cat). + move=> &1 &2 out_le_i _ ih1 ih2 ih3 i_lt_k xi_notin_mp r _. + by rewrite !get_set_sameE /= rcons_cat //= #smt:(get_setE size_out_gt0). +auto=> //=. +conseq(:_==> ={i0} /\ size bs{2} = i0{1} /\ (i0, x3){1} = (n, x2){2} /\ + bs0{1} = bs{2} /\ size bs{2} = size_out /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). ++ move=> />; smt(cats0 take_oversize spec_dout to_listK spec2_dout). +while(={i0} /\ x3{1} = x2{2} /\ 0 <= i0{1} <= n{2} /\ n{2} = size_out /\ + bs0{1} = bs{2} /\ size bs{2} = i0{1} /\ size_out <= n0{1} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). ++ by sp; if; auto=> />; smt(size_rcons domE get_setE size_rcons mem_set). +by auto=> />; smt(size_out_gt0). +qed. + + +local lemma of_listK l : of_list (to_list l) = Some l. +proof. +by rewrite -to_listK. +qed. + +local module Fill_In (F : RO) = { + proc init = F.init + proc f (x : bool list, n : int) = { + var l, b, i; + i <- 0; + l <- []; + while (i < n) { + b <@ F.get((x,i)); + l <- rcons l b; + i <- i + 1; + } + while (i < size_out) { + F.sample((x,i)); + i <- i + 1; + } + return l; + } +}. + + +local equiv eq_eager_ideal : + BIRO.IRO.f ~ Fill_In(LRO).f : + ={arg} /\ BIRO.IRO.mp{1} = RO.m{2} ==> + ={res} /\ BIRO.IRO.mp{1} = RO.m{2}. +proof. +proc; inline*; sp; rcondt{1} 1; auto. +while{2}(bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2})(size_out - i{2}). ++ by auto=> />; smt(). +conseq(:_==> bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2}); 1: smt(). +while(={i, n, x} /\ bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2}). ++ sp; if{1}. + - by rcondt{2} 2; auto=> />. + by rcondf{2} 2; auto=> />; smt(dbool_ll). +by auto. +qed. + +local equiv eq_eager_ideal2 : + ExtendSample(FSome(BIRO.IRO)).f ~ FSome(Fill_In(RO)).f : + ={arg} /\ BIRO.IRO.mp{1} = RO.m{2} ==> + ={res} /\ BIRO.IRO.mp{1} = RO.m{2}. +proof. +proc; inline*; sp. +if{1}; sp. ++ rcondt{1} 1; auto=> /=/>. + conseq(:_==> take k{1} bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2}). + * by move=> /> /#. + case: (0 <= n{2}); last first. + + rcondf{2} 1; 1: by auto; smt(). + conseq(:_==> BIRO.IRO.mp{1} = RO.m{2} /\ ={i} /\ n{1} = size_out /\ x2{1} = x0{2})=> />. + - smt(take_le0). + while(={i} /\ x2{1} = x0{2} /\ n{1} = size_out /\ BIRO.IRO.mp{1} = RO.m{2}). + - sp; if{1}. + - by rcondt{2} 2; auto=> />. + by rcondf{2} 2; auto=> />; smt(dbool_ll). + by auto=> />. + splitwhile{1} 1 : i < k. + while(={i} /\ n{1} = size_out /\ x2{1} = x0{2} /\ BIRO.IRO.mp{1} = RO.m{2} /\ + take k{1} bs{1} = l{2} /\ size bs{1} = i{1} /\ k{1} <= i{1} <= size_out). + * sp; if{1}. + - by rcondt{2} 2; auto=> />; smt(dbool_ll cats1 take_cat cats0 take_size size_rcons). + by rcondf{2} 2; auto=> />; smt(dbool_ll cats1 take_cat cats0 take_size size_rcons). + conseq(:_==> ={i} /\ n{1} = size_out /\ x2{1} = x0{2} /\ BIRO.IRO.mp{1} = RO.m{2} /\ + bs{1} = l{2} /\ size bs{1} = i{1} /\ k{1} = i{1}). + + smt(take_size). + while(={i} /\ x2{1} = x0{2} /\ n{1} = size_out /\ k{1} = n{2} /\ + 0 <= i{1} <= k{1} <= size_out /\ bs{1} = l{2} /\ size bs{1} = i{1} /\ + BIRO.IRO.mp{1} = RO.m{2}). + + sp; if{1}. + - by rcondt{2} 2; auto=> />; smt(size_rcons). + by rcondf{2} 2; auto=> />; smt(size_rcons dbool_ll). + by auto=> />; smt(size_ge0 size_out_gt0). +rcondt{1} 1; auto. +rcondf{2} 2; 1: auto. ++ conseq(:_==> i = n)=> [/> /#|]. + by while(i <= n); auto=> />; smt(size_out_gt0). +while(i0{1} = i{2} /\ x3{1} = x0{2} /\ n0{1} = n{2} /\ bs0{1} = l{2} /\ + BIRO.IRO.mp{1} = RO.m{2}). ++ sp; if{1}. + - by rcondt{2} 2; auto=> />. + by rcondf{2} 2; auto; smt(dbool_ll). +by auto=> />. +qed. + +local module Dist (F : RO) = { + proc distinguish = SHA3_OIndiff.OIndif.OIndif(FSome(Fill_In(F)), + OSimulator(FSome(Fill_In(F))), ODRestr(Dist_of_P1Adv(A))).main +}. + +local module Game (F : RO) = { + proc distinguish () = { + var bo; + OSimulator(FSome(Fill_In(F))).init(); + Counter.c <- 0; + Log.m <- empty; + F.init(); + bo <@ Dist(F).distinguish(); + return bo; + } +}. + +local lemma eager_ideal &m : + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), + OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] = + Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + OSimulator(ExtendSample(FSome(BIRO.IRO))), + ODRestr(Dist_of_P1Adv(A))).main() @ &m : res]. +proof. +have->: + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), + OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] = + Pr[Game(LRO).distinguish() @ &m : res]. ++ byequiv=> //=; proc. + inline{2} 1; sp; inline{2} 1; sp; inline{2} 1; sp; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp; sim. + seq 2 2 : (={hash, m, glob OFC} /\ BIRO.IRO.mp{1} = RO.m{2}); last first. + - inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; sim; if; auto. + inline{1} 1; inline{2} 1; sp; sim. + by call eq_eager_ideal; auto. + call(: ={glob OFC, glob OSimulator} /\ BIRO.IRO.mp{1} = RO.m{2}); auto. + - proc; sp; if; auto. + inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. + if; 1: auto; sim; sp. + if; [1:by auto=> /> &1 &2 <- /> <- />]; sim. + * inline{1} 1; inline{2} 1; sp; sim. + by call eq_eager_ideal; auto=> /> &1 &2 <- /> <- />. + by move=> /> &1 &2 <- /> <- />. + - by proc; inline*; sim. + proc; sim. + inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. + inline{1} 1; inline{2} 1; sp; sim. + by call eq_eager_ideal; auto. +have->: + Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + OSimulator(ExtendSample(FSome(BIRO.IRO))), + ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] = + Pr[Game(RO).distinguish() @ &m : res]. ++ byequiv=>//=; proc. + inline{2} 1; sp; inline{2} 1; sp; inline{2} 1; sp; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp; sim. + seq 2 2 : (={hash, m, glob OFC} /\ BIRO.IRO.mp{1} = RO.m{2}); last first. + - inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; sim; if; auto. + by call eq_eager_ideal2; auto. + call(: ={glob OFC, glob OSimulator} /\ BIRO.IRO.mp{1} = RO.m{2}); auto. + - proc; sp; if; auto. + inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. + if; 1: auto; sim; sp. + if; [1:by auto=> /> &1 &2 <- /> <- />]; sim. + * by call eq_eager_ideal2; auto=> /> &1 &2 <- /> <- />. + by move=> /> &1 &2 <- /> <- />. + - by proc; inline*; sim. + proc; sim. + inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. + by call eq_eager_ideal2; auto. +rewrite eq_sym; byequiv=> //=; proc. +call(RO_LRO_D Dist _); first by rewrite dbool_ll. +by inline*; auto=> />. +qed. + +local lemma rw_ideal_2 &m: + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] <= + Pr[SORO.Preimage(SORO_P1(A), RFList).main() @ &m : res]. +proof. +have->:Pr[SORO.Preimage(SORO_P1(A), RFList).main() @ &m : res] = + Pr[SORO.Preimage(SORO_P1(A), RFWhile).main() @ &m : res]. ++ byequiv(: ={glob A} ==> _)=>//=; proc. + swap 1. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 2; inline{2} 2; sp. + swap[1..2] 3; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 5; inline{2} 5; wp. + seq 3 3 : (={mi, h, hash, glob A, glob SORO.Bounder, glob RFList}); last first. + - sp; if; auto; call(rw_RF_List_While); auto. + call(: ={glob SORO.Bounder, glob RFList, glob OSimulator, glob OPC, glob Log}); auto. + - proc; sp; if; auto. + inline{1} 1; inline{2} 1; sp; if; 1, 3: auto; sim. + if; 1: auto; sim; sp; sim; if; auto=> [/> &1 &2 <- /> <- />||]; sim. + + inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; if; auto=> />. + - by call(rw_RF_List_While); auto=> /> &1 &2 <- /> <- />. + by move=> /> &1 &2 <- /> <- />. + by move=> /> &1 &2 <- /> <- />. + - by sim. + proc; sim; inline{1} 1; inline{2} 1; sp; if; auto. + inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; if; auto; sim. + by call(rw_RF_List_While); auto. +rewrite (eager_ideal &m). +have->:Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + OSimulator(ExtendSample(FSome(BIRO.IRO))), + ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] = + Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + OSimulator(ExtendOutputSize(FSetSize(FSome(BIRO.IRO)))), + ODRestr(Dist_of_P1Adv(A))).main() @ &m : res]. ++ byequiv=> //=; proc; inline*; sp. + seq 2 2 : (={m, hash, glob OSimulator, glob OFC} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); last first. + - sp; if; auto; sp; if; auto; sp; rcondt{1}1; 1: auto. + * rcondt{2} 1; 1: auto. + while(={i, n, bs, x3} /\ size bs{1} = i{1} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2} /\ + n{1} = size_out /\ 0 <= i{1} <= n{1}); auto. + * by sp; if; auto=> />; smt(domE get_setE size_rcons). + move=> />; smt(size_out_gt0 take_oversize size_out_gt0). + * by auto; rcondf{1} 1; auto. + * rcondt{2} 1; 1: auto; move=> />; auto. + by while(={i0, n0}); auto; sp; if{1}; if{2}; auto; smt(dbool_ll). + call(: ={glob OSimulator, glob OFC} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); last first; auto. + + smt(mem_empty). + + proc; sp; if; auto. + inline{1} 1; inline{2} 1; sp; if; 1, 3: auto. + if; 1, 3: auto; sp. + if; [1:auto=> /> &1 &2 <- /> <- />]; last first. + - by conseq=> />; sim=> /> &1 &2 <- /> <- />. + wp=> />; 1: smt(). + rnd; auto=> />. + call(eq_extend); last by auto=> /> &1 &2 <- /> <- /> /#. + + by proc; sp; if; auto; inline{1} 1; inline{2} 1; sp; if; auto. + proc; sp; inline{1} 1; inline{2} 1; sp; if; auto. + inline*; sp. + rcondt{1} 1; 1: auto; rcondt{2} 1; 1: auto; sp. + rcondt{1} 1; 1: auto; rcondt{2} 1; 1: auto; sp; auto. + conseq(:_==> ={bs} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); + 1: by auto. + while(={i, n, x3, bs} /\ 0 <= i{1} <= size_out /\ n{1} = size_out /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). + + sp; if; auto=> />. + + smt(domE get_setE size_rcons). + + move=> + + + + + + + + + + _. + smt(domE get_set_sameE get_setE size_rcons). + smt(domE get_setE size_rcons). + by auto=> />; smt(size_out_gt0). +byequiv=> //=; proc. +inline{1} 1; inline{2} 2; sp. +inline{1} 1; inline{2} 3; swap{2}[1..2]1; sp. +inline{1} 1; inline{2} 3; sp. +inline{1} 1; sp. +inline{1} 1; sp. +swap{2} 1 1; sp; swap{2}[1..2]3; sp. +inline{1} 1; sp; auto. +seq 2 5 : (={glob A, glob OSimulator, glob Counter, glob Log, hash, m} /\ + inv BIRO.IRO.mp{1} RFList.m{2} /\ + SORO.Bounder.bounder{2} <= Counter.c{1}); last first. ++ inline{1} 1; inline{2} 1; sp; inline{1} 1; sp; auto. + if{1}; sp; last first. + - conseq(:_==> true)=> />. + inline*; if{2}; auto; sp; if{2}; auto. + by while{2}(true)(size_out - i{2}); auto=>/>; smt(dbool_ll). + rcondt{2} 1; 1: by auto=> />; smt(divz_ge0 gt0_r size_ge0). + inline{1} 1; sp; auto. + rcondt{1} 1; auto=> /=. + inline{1} 1; sp; auto. + by call(eq_IRO_RFWhile); auto; smt(take_oversize). +auto; call(: ={glob OSimulator, glob Counter, glob Log} /\ + inv BIRO.IRO.mp{1} RFList.m{2} /\ + SORO.Bounder.bounder{2} <= Counter.c{1}); auto; last first. ++ by inline*; auto; smt(mem_empty). ++ proc; sp; if; auto=> />; 1: smt(). + inline{1} 1; inline{2} 1; sp; auto. + if; 1, 3: auto; -1: smt(). + if; 1,3:auto=> /> + + + + + + + + + + + _ + _ /#. + sp; if; [1:by auto=> /> &1 &2 <- /> <-]; last first. + + by conseq (: ={y, glob OSimulator}); [|sim]=> /> &1 &2 <- /> <- /#. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + rcondt{2} 1; 1: by auto; smt(). + sp. + seq 3 2 : (={x0, x1, o1, k0, Log.m, suffix, glob OSimulator} /\ + inv BIRO.IRO.mp{1} RFList.m{2} /\ + SORO.Bounder.bounder{2} <= Counter.c{2} + 1); last first. + - by conseq(:_==> ={y, x1, glob OSimulator, Log.m}); 1: smt(); sim=> />. + inline{1} 1; auto. + by call(eq_IRO_RFWhile); auto=> /> &1 &2 + <- /> <- /#. ++ by proc; inline*; sp; if; auto; sp; if; auto=> />; smt(). +proc. +inline{1} 1; inline{2} 1; sp; if; auto=> /=. +inline{1} 1; inline{2} 1; sp. +rcondt{1} 1; 1: auto. +inline{1} 1; auto. +rcondf{2} 4; 1: auto. ++ inline*; auto; sp; if; auto; sp; if; auto=> />; conseq(:_==> true); 1: smt(). + by while(true); auto. +inline{2} 1; sp. +rcondt{2} 1; 1: by auto; smt(divz_ge0 gt0_r size_ge0). +auto; call eq_IRO_RFWhile; auto=> />. +move=> /> &l &r H0 H1 H2 H3 H5 H6 result_L mp_L m_R H7 H8 H9 H10 H11; split; 2: smt(divz_ge0 gt0_r size_ge0). +rewrite cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. +have h:=spec2_dout result_L H7. +have-> := some_oget _ h. +by rewrite /= eq_sym -to_listK. +qed. + +local lemma rw_ideal &m: + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] <= + Pr[SORO.Preimage(SORO_P1(A),RF(SORO.RO.RO)).main() @ &m : res]. +proof. +rewrite (StdOrder.RealOrder.ler_trans _ _ _ (rw_ideal_2 &m)). +byequiv(: ={glob A} ==> _) => //=; proc; inline*; sp; wp. +swap{2} 2; sp; swap{2}[1..2] 6; sp. +swap{1} 2; sp; swap{1}[1..2] 6; sp. +seq 2 2 : ( + Log.m{1} = empty /\ + SHA3Indiff.Simulator.m{1} = empty /\ + SHA3Indiff.Simulator.mi{1} = empty /\ + SHA3Indiff.Simulator.paths{1} = empty.[c0 <- ([], b0)] /\ + Gconcl_list.BIRO2.IRO.mp{1} = empty /\ + SORO.Bounder.bounder{1} = 0 /\ + RFList.m{1} = empty /\ + Counter.c{2} = 0 /\ + ={Log.m, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter} /\ + SORO.RO.RO.m{2} = empty /\ ={glob A, h, hash}); 1: auto=> />. +seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, + glob Log, mi, h, hash} /\ RFList.m{1} = SORO.RO.RO.m{2}). ++ call(: ={glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, glob Log} /\ + RFList.m{1} = SORO.RO.RO.m{2}); auto. + - proc; sp; if; 1, 3: auto; sp. + inline *; sp; sim. + if; 1: auto; sim. + if; 1: auto; sim. + sp; if; [2,3:sim]; [1,3:by auto=> /> &1 &2 <- /> <- />]. + sp; if; 1: auto; sim; -1: smt(). + sp; if{1}. + * rcondt{2} 2. + + by auto=> /> + + <- /> <- />. + auto. + rnd (fun l => oget (of_list l)) to_list; auto=> />. + move=> &l &r + <- /> <- /> - 7?; split; 1: smt(of_listK). + rewrite -dout_equal_dlist=> ?; split=> ?. + + by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). + move=> sample. + rewrite !get_setE/=dout_full/= => h. + rewrite eq_sym to_listK; apply some_oget. + apply spec2_dout. + by move:h; rewrite supp_dmap; smt(spec_dout). + by auto=> /> + + + <- /> <-; smt(dout_ll). + - by proc; inline*; sp; if; auto; sp; if; auto. + - proc; inline*; sp; if; auto; sp; if; auto; sp; sim. + if{1}. + * rcondt{2} 2; auto. + rnd (fun l => oget (of_list l)) to_list; auto=> />. + move=> &l *; split=> ?; 1: smt(of_listK). + rewrite -dout_equal_dlist; split=> ?. + * by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). + move=> sample. + rewrite supp_dmap dout_full/= =>/> a. + by rewrite get_setE/= dout_full/=; congr; rewrite of_listK oget_some. + by auto=> />; smt(dout_ll). +sp; if; 1, 3: auto; sp; wp 1 2. +if{1}. ++ wp=> />. + rnd (fun x => oget (of_list x)) to_list; auto=> />. + move=> &l c Hc Hnin; split. + - move=> ret Hret. + by have/= ->:= (to_listK ret (to_list ret)). + move=> h{h}; split. + - move=> ret Hret; rewrite -dout_equal_dlist. + rewrite dmapE /=; apply mu_eq=> //= x /=. + by rewrite /(\o) /pred1/=; smt(to_list_inj). + move=> h{h} l Hl. + rewrite dout_full /=. + have:= spec2_dout l. + have:=supp_dlist dbool size_out l _; 1: smt(size_out_gt0). + rewrite Hl/==> [#] -> h{h} /= H. + have H1:=some_oget _ H. + have:=to_listK (oget (of_list l)) l; rewrite {2}H1/= => -> /= {H H1}. + by rewrite get_setE/=. +by auto=> />; smt(dout_ll). +qed. + +local lemma leq_ideal &m : + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] <= (sigma + 1)%r / 2%r ^ size_out. +proof. +rewrite (StdOrder.RealOrder.ler_trans _ _ _ (rw_ideal &m)). +rewrite (StdOrder.RealOrder.ler_trans _ _ _ (RO_is_preimage_resistant (SORO_P1(A)) &m)). +by rewrite doutE1. +qed. + + + + local lemma rw_real &m : + Pr[Preimage(A, OSponge, PSome(Perm)).main() @ &m : res] = + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(Sponge(Poget(PSome(Perm)))), PSome(Perm), + ODRestr(Dist_of_P1Adv(A))).main() @ &m : res]. + proof. + byequiv=>//=; proc; inline*; sp; wp=> />. + swap{1} 4; sp. + seq 2 2 : (={glob A, glob Perm, hash, m} /\ Bounder.bounder{1} = Counter.c{2}). + + call(: ={glob Perm} /\ Bounder.bounder{1} = Counter.c{2})=> //=. +(** - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). **) +(** FIXME: two different instances of x{1} with InvalidGoalShape **) + - by proc; inline *; sp; if; auto; 2:sim=> />; smt(). + - by proc; inline*; sp; if; auto; 2:sim=> />; smt(). + - proc; inline*; sp; if; auto; sp=> />. + by conseq(:_==> ={z0, glob Perm})=> />; sim. + by auto. + by sp; if; auto=>/=; sim; auto. + qed. + +lemma Sponge_preimage_resistant &m: + (forall (F <: OIndif.ODFUNCTIONALITY) (P <: OIndif.ODPRIMITIVE), + islossless F.f => islossless P.f => islossless P.fi => islossless A(F,P).guess) => + Pr[Preimage(A, OSponge, PSome(Perm)).main() @ &m : res] <= + (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + + (4 * limit ^ 2)%r / (2 ^ c)%r + + (sigma + 1)%r / (2%r ^ size_out). +proof. +move=> A_ll. +rewrite (rw_real &m). +have := SHA3OIndiff (Dist_of_P1Adv(A)) &m _. ++ move=> F P Hp Hpi Hf; proc; inline*; sp; auto; call Hf; auto. + call(A_ll (DFSetSize(F)) P _ Hp Hpi); auto. + - proc; inline*; auto; call Hf; auto. + smt(dout_ll). +by have/#:=leq_ideal &m. +qed. + +end section Preimage. + + + +section SecondPreimage. + + + declare module A <: SH.AdvSecondPreimage {-Perm, -Counter, -Bounder, -F.RO, -F.FRO, -Redo, -C, -Gconcl.S, -BlockSponge.BIRO.IRO, -BlockSponge.C, -BIRO.IRO, -Gconcl_list.BIRO2.IRO, -Gconcl_list.F2.RO, -Gconcl_list.F2.FRO, -Gconcl_list.Simulator, -SHA3Indiff.Simulator, -SHA3Indiff.Cntr, -SORO.Bounder, -SORO.RO.RO, -SORO.RO.FRO, -RO, -FRO}. + + local module FInit (F : OIndif.ODFUNCTIONALITY) : OIndif.OFUNCTIONALITY = { + proc init () = {} + proc f = F.f + }. + + local module PInit (P : ODPRIMITIVE) : OPRIMITIVE = { + proc init () = {} + proc f = P.f + proc fi = P.fi + }. + + +local module OF (F : Oracle) : OIndif.ODFUNCTIONALITY = { + proc f = F.get +}. + + +local module Log = { + var m : (bool list * int, bool) fmap +}. + +local module ExtendOutputSize (F : Oracle) : ODFUNCTIONALITY = { + proc f (x : bool list, k : int) = { + var o, l, suffix, prefix, i, r; + l <- None; + prefix <- []; + suffix <- []; + o <@ F.get(x); + prefix <- take k (to_list (oget o)); + i <- size_out; + while (i < k) { + if ((x,i) \notin Log.m) { + r <$ {0,1}; + Log.m.[(x,i)] <- r; + } + suffix <- rcons suffix (oget Log.m.[(x,i)]); + i <- i + 1; + } + l <- Some (prefix ++ suffix); + return l; + } +}. + +local module OFC2 (F : Oracle) = OFC(ExtendOutputSize(F)). + +local module ExtendOutput (F : RF) = { + proc init () = { + Log.m <- empty; + F.init(); + } + proc f = ExtendOutputSize(F).f + proc get = f +}. + + local module (Dist_of_P2Adv (A : SH.AdvSecondPreimage) : ODISTINGUISHER) (F : ODFUNCTIONALITY) (P : ODPRIMITIVE) = { + var m : bool list + proc distinguish () = { + var hash, hash', m'; + Log.m <- empty; + m' <@ A(DFSetSize(F),P).guess(m); + hash <@ DFSetSize(F).f(m); + hash' <@ DFSetSize(F).f(m'); + return m <> m' /\ exists y, hash' = Some y /\ hash = Some y; + } + }. + + +local module (SORO_P2 (A : SH.AdvSecondPreimage) : SORO.AdvSecondPreimage) (F : Oracle) = { + proc guess (m : bool list) : bool list = { + var mi; + Log.m <- empty; + Counter.c <- 0; + Dist_of_P2Adv.m <- m; + OSimulator(ExtendOutputSize(F)).init(); + mi <@ A(DFSetSize(OFC2(F)),OPC(OSimulator(ExtendOutputSize(F)))).guess(m); + return mi; + } +}. + +local module RFList = { + var m : (bool list, f_out) fmap + proc init () = { + m <- empty; + } + proc get (x : bool list) : f_out option = { + var z; + if (x \notin m) { + z <$ dlist dbool size_out; + m.[x] <- oget (of_list z); + } + return m.[x]; + } + proc sample (x: bool list) = {} +}. + +local module RFWhile = { + proc init () = { + RFList.m <- empty; + } + proc get (x : bool list) : f_out option = { + var l, i, b; + if (x \notin RFList.m) { + i <- 0; + l <- []; + while (i < size_out) { + b <$ dbool; + l <- rcons l b; + i <- i + 1; + } + RFList.m.[x] <- oget (of_list l); + } + return RFList.m.[x]; + } + proc sample (x: bool list) = {} +}. + + +local equiv rw_RF_List_While : + RFList.get ~ RFWhile.get : + ={arg, glob RFList} ==> ={res, glob RFWhile}. +proof. +proc; if; 1, 3: auto; wp. +conseq(:_==> z{1} = l{2})=> />. +transitivity{1} { + z <@ PBool.Sample.sample(size_out); + } + (true ==> ={z}) + (true ==> z{1} = l{2})=>/>. ++ by inline*; auto. +transitivity{1} { + z <@ LoopSnoc.sample(size_out); + } + (true ==> ={z}) + (true ==> z{1} = l{2})=>/>; last first. ++ inline*; auto; sim. + by while(={l, i} /\ n{1} = size_out); auto; smt(cats1). +by call(Sample_LoopSnoc_eq); auto. +qed. + + +local equiv eq_IRO_RFWhile : + BIRO.IRO.f ~ RFWhile.get : + arg{1} = (x{2}, size_out) /\ inv BIRO.IRO.mp{1} RFList.m{2} + ==> + res{2} = of_list res{1} /\ size res{1} = size_out /\ inv BIRO.IRO.mp{1} RFList.m{2}. +proof. +proc; inline*; sp. +rcondt{1} 1; 1: by auto. +if{2}; sp; last first. ++ alias{1} 1 mp = BIRO.IRO.mp. + conseq(:_==> BIRO.IRO.mp{1} = mp{1} /\ size bs{1} = i{1} /\ i{1} = size_out /\ + inv mp{1} RFList.m{2} /\ + bs{1} = take i{1} (to_list (oget RFList.m{2}.[x{1}])))=> />. + - move=> &l &r H0 H1 H2 H3 H4 bs_L mp_L H5 H6 H7 H8 H9. + rewrite take_oversize 1:spec_dout 1:H5 //. + rewrite eq_sym to_listK => ->. + by have:=H4; rewrite domE; smt(). + - smt(take_oversize spec_dout). + while{1}(BIRO.IRO.mp{1} = mp{1} /\ size bs{1} = i{1} /\ + 0 <= i{1} <= size_out /\ n{1} = size_out /\ + inv mp{1} RFList.m{2} /\ x{1} \in RFList.m{2} /\ + bs{1} = take i{1} (to_list (oget RFList.m{2}.[x{1}])))(size_out - i{1}); + auto=> />. + + sp; rcondf 1; auto=> />; 1: smt(). + move=> &h H0 H1 H2 H3 H4 H5 H6 H7 H8. + rewrite size_rcons //=; do!split; 1, 2, 4: smt(size_ge0). + rewrite (take_nth witness) 1:spec_dout 1:size_ge0//=. + rewrite - H7; congr; rewrite H5=> //=. + by apply H4=> //=. + smt(size_out_gt0 size_ge0 take0). +auto=> //=. +conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{1} /\ n{1} = size_out /\ + inv BIRO.IRO.mp{1} RFList.m{2}.[x{2} <- oget (of_list l{2})])=> />. ++ smt(get_setE spec2_dout). ++ smt(get_setE spec2_dout). +alias{1} 1 m = BIRO.IRO.mp; sp. +conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{1} /\ + n{1} = size_out /\ inv m{1} RFList.m{2} /\ + (forall j, (x{1}, j) \in BIRO.IRO.mp{1} => 0 <= j < i{1}) /\ + (forall l j, l <> x{1} => m{1}.[(l,j)] = BIRO.IRO.mp{1}.[(l,j)]) /\ + (forall j, 0 <= j < i{1} => (x{1}, j) \in BIRO.IRO.mp{1}) /\ + (forall j, 0 <= j < i{1} => BIRO.IRO.mp{1}.[(x{1},j)] = Some (nth witness bs{1} j))). ++ move=> /> &l &r H0 H1 H2 H3 H4 mp_L bs_L H5 H6 H7 H8 H9; do!split; ..-2 : smt(domE mem_set). + move=> l j Hin. + rewrite get_setE/=. + case: (l = x{r}) => [<<-|]. + - rewrite oget_some H9; 1:smt(); congr; congr. + by rewrite eq_sym to_listK; smt(spec2_dout). + move=> Hneq. + by rewrite -(H7 _ _ Hneq) H3; smt(domE). +while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ + n{1} = size_out /\ inv m{1} RFList.m{2} /\ + (forall j, (x{1}, j) \in BIRO.IRO.mp{1} => 0 <= j < i{1}) /\ + (forall l j, l <> x{1} => m{1}.[(l,j)] = BIRO.IRO.mp{1}.[(l,j)]) /\ + (forall j, 0 <= j < i{1} => (x{1}, j) \in BIRO.IRO.mp{1}) /\ + (forall j, 0 <= j < i{1} => BIRO.IRO.mp{1}.[(x{1},j)] = Some (nth witness bs{1} j))). ++ sp; rcondt{1} 1; auto=> />. + - smt(). + move=> &l &r H0 H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 result_l _. + rewrite get_setE/=size_rcons/=; do!split; 1,2: smt(size_ge0). + - smt(mem_set). + - smt(get_setE). + - smt(mem_set). + - move=>j Hj0 Hjsize; rewrite get_setE/=nth_rcons. + case: (j = size bs{l})=>[->>//=|h]. + have/=Hjs:j < size bs{l} by smt(). + by rewrite Hjs/=H9//=. +by auto; smt(size_out_gt0). +qed. + + +local module ExtendSample (F : OFUNCTIONALITY) = { + proc init = F.init + proc f (x : bool list, k : int) = { + var y; + if (k <= size_out) { + y <@ F.f(x,size_out); + y <- omap (take k) y; + } else { + y <@ F.f(x,k); + } + return y; + } +}. + + +local equiv eq_extend : + ExtendSample(FSome(BIRO.IRO)).f ~ ExtendOutputSize(FSetSize(FSome(BIRO.IRO))).f : + ={arg} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2} ==> + ={res} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}. +proof. +proc; inline*; auto; sp. +rcondt{2} 1; 1: auto. +if{1}; sp. +- rcondt{1} 1; auto. + rcondf{2} 8; 1: auto. + - conseq(:_==> true); 1: smt(). + by while(true); auto. + auto=> /=. + conseq(:_==> ={bs, k} /\ size bs{1} = size_out /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2})=> //=. + - smt(cats0 to_listK spec2_dout). + while(={k, bs, n, x2} /\ i{1} = i0{2} /\ n{1} = size_out /\ + 0 <= i{1} <= n{1} /\ size bs{1} = i{1} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). + - by sp; if; auto=> />; smt(domE get_setE size_rcons). + by auto=> />; smt(size_eq0 size_out_gt0). +rcondt{1} 1; 1: auto. +splitwhile{1} 1 : i0 < size_out; auto=> /=. +while( (i0, n0, x3){1} = (i, k, x){2} /\ bs0{1} = prefix{2} ++ suffix{2} /\ + size_out <= i{2} <= k{2} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). ++ sp; if; auto=> />. + + smt(). + + move=> + + + + + + + + + + _; smt(domE get_setE size_out_gt0 rcons_cat). + smt(domE get_setE size_out_gt0 rcons_cat). +auto=> //=. +conseq(:_==> ={i0} /\ size bs{2} = i0{1} /\ (i0, x3){1} = (n, x2){2} /\ + bs0{1} = bs{2} /\ size bs{2} = size_out /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). ++ move=> />; smt(cats0 take_oversize spec_dout to_listK spec2_dout). +while(={i0} /\ x3{1} = x2{2} /\ 0 <= i0{1} <= n{2} /\ n{2} = size_out /\ + bs0{1} = bs{2} /\ size bs{2} = i0{1} /\ size_out <= n0{1} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). ++ by sp; if; auto=> />; smt(size_rcons domE get_setE size_rcons mem_set). +by auto=> />; smt(size_out_gt0). +qed. + + +local lemma of_listK l : of_list (to_list l) = Some l. +proof. +by rewrite -to_listK. +qed. + +local module Fill_In (F : RO) = { + proc init = F.init + proc f (x : bool list, n : int) = { + var l, b, i; + i <- 0; + l <- []; + while (i < n) { + b <@ F.get((x,i)); + l <- rcons l b; + i <- i + 1; + } + while (i < size_out) { + F.sample((x,i)); + i <- i + 1; + } + return l; + } +}. + + +local equiv eq_eager_ideal : + BIRO.IRO.f ~ Fill_In(LRO).f : + ={arg} /\ BIRO.IRO.mp{1} = RO.m{2} ==> + ={res} /\ BIRO.IRO.mp{1} = RO.m{2}. +proof. +proc; inline*; sp; rcondt{1} 1; auto. +while{2}(bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2})(size_out - i{2}). ++ by auto=> />; smt(). +conseq(:_==> bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2}); 1: smt(). +while(={i, n, x} /\ bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2}). ++ sp; if{1}. + - by rcondt{2} 2; auto=> />. + by rcondf{2} 2; auto=> />; smt(dbool_ll). +by auto. +qed. + +local equiv eq_eager_ideal2 : + ExtendSample(FSome(BIRO.IRO)).f ~ FSome(Fill_In(RO)).f : + ={arg} /\ BIRO.IRO.mp{1} = RO.m{2} ==> + ={res} /\ BIRO.IRO.mp{1} = RO.m{2}. +proof. +proc; inline*; sp. +if{1}; sp. ++ rcondt{1} 1; auto=> /=/>. + conseq(:_==> take k{1} bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2}). + * by move=> />; smt(). + case: (0 <= n{2}); last first. + + rcondf{2} 1; 1: by auto; smt(). + conseq(:_==> BIRO.IRO.mp{1} = RO.m{2} /\ ={i} /\ n{1} = size_out /\ x2{1} = x0{2})=> />. + - smt(take_le0). + while(={i} /\ x2{1} = x0{2} /\ n{1} = size_out /\ BIRO.IRO.mp{1} = RO.m{2}). + - sp; if{1}. + - by rcondt{2} 2; auto=> />. + by rcondf{2} 2; auto=> />; smt(dbool_ll). + by auto=> />. + splitwhile{1} 1 : i < k. + while(={i} /\ n{1} = size_out /\ x2{1} = x0{2} /\ BIRO.IRO.mp{1} = RO.m{2} /\ + take k{1} bs{1} = l{2} /\ size bs{1} = i{1} /\ k{1} <= i{1} <= size_out). + * sp; if{1}. + - by rcondt{2} 2; auto=> />; smt(dbool_ll cats1 take_cat cats0 take_size size_rcons). + by rcondf{2} 2; auto=> />; smt(dbool_ll cats1 take_cat cats0 take_size size_rcons). + conseq(:_==> ={i} /\ n{1} = size_out /\ x2{1} = x0{2} /\ BIRO.IRO.mp{1} = RO.m{2} /\ + bs{1} = l{2} /\ size bs{1} = i{1} /\ k{1} = i{1}). + + by move=> />; smt(take_size). + while(={i} /\ x2{1} = x0{2} /\ n{1} = size_out /\ k{1} = n{2} /\ + 0 <= i{1} <= k{1} <= size_out /\ bs{1} = l{2} /\ size bs{1} = i{1} /\ + BIRO.IRO.mp{1} = RO.m{2}). + + sp; if{1}. + - by rcondt{2} 2; auto=> />; smt(size_rcons). + by rcondf{2} 2; auto=> />; smt(size_rcons dbool_ll). + by auto=> />; smt(size_ge0 size_out_gt0). +rcondt{1} 1; auto. +rcondf{2} 2; 1: auto. ++ conseq(:_==> i = n); 1:by move=> />; smt(). + by while(i <= n); auto=> />; smt(size_out_gt0). +while(i0{1} = i{2} /\ x3{1} = x0{2} /\ n0{1} = n{2} /\ bs0{1} = l{2} /\ + BIRO.IRO.mp{1} = RO.m{2}). ++ sp; if{1}. + - by rcondt{2} 2; auto=> />. + by rcondf{2} 2; auto; smt(dbool_ll). +by auto=> />. +qed. + +local module Dist (F : RO) = { + proc distinguish = SHA3_OIndiff.OIndif.OIndif(FSome(Fill_In(F)), + OSimulator(FSome(Fill_In(F))), ODRestr(Dist_of_P2Adv(A))).main +}. + +local module Game (F : RO) = { + proc distinguish () = { + var bo; + OSimulator(FSome(Fill_In(F))).init(); + Counter.c <- 0; + Log.m <- empty; + F.init(); + bo <@ Dist(F).distinguish(); + return bo; + } +}. + +local lemma eager_ideal &m : + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), + OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_P2Adv(A))).main() @ &m : res] = + Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + OSimulator(ExtendSample(FSome(BIRO.IRO))), + ODRestr(Dist_of_P2Adv(A))).main() @ &m : res]. +proof. +have->: + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), + OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_P2Adv(A))).main() @ &m : res] = + Pr[Game(LRO).distinguish() @ &m : res]. ++ byequiv=> //=; proc. + inline{2} 1; sp; inline{2} 1; sp; inline{2} 1; sp; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp; sim. + seq 1 1 : (={m', glob Dist_of_P2Adv, glob OFC} /\ BIRO.IRO.mp{1} = RO.m{2}); last first. + - inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; sim; if; auto. + * inline{1} 1; inline{2} 1; sp; sim. + inline{1} 7; inline{2} 7; sim. + inline{1} 8; inline{2} 8; sim. + swap 3 -2; sp. + case: (increase_counter Counter.c{1} m'{1} size_out <= SHA3Indiff.limit). + + rcondt{1} 10; 1: auto. + - inline*; auto. + by sp; rcondt 1; auto; conseq(:_==> true); auto. + rcondt{2} 10; 1: auto. + - inline*; auto. + by conseq(:_==> true); auto. + sim. + inline{1} 10; inline{2} 10; sim. + call eq_eager_ideal; auto. + by call eq_eager_ideal; auto. + rcondf{1} 10; 1: auto. + - inline*; auto. + by sp; rcondt 1; auto; conseq(:_==> true); auto. + rcondf{2} 10; 1: auto. + - inline*; auto. + by conseq(:_==> true); auto. + by auto; call eq_eager_ideal; auto. + sp; inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; sim. + if; auto. + inline{1} 1; inline{2} 1; sp; sim. + by auto; call eq_eager_ideal; auto. + call(: ={glob OFC, glob OSimulator, glob Dist_of_P2Adv} /\ + BIRO.IRO.mp{1} = RO.m{2}); auto. + - proc; sp; if; auto. + inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. + if; 1: auto; sim; sp. + if; [1:auto; [1:by move=> /> + + <- /> <-]]; sim. + * inline{1} 1; inline{2} 1; sp; sim. + by call eq_eager_ideal; auto=> /> + + <- /> <- /#. + by move=> /> + + <- /> <- /#. + - by proc; inline*; sim. + proc; sim. + inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. + inline{1} 1; inline{2} 1; sp; sim. + by call eq_eager_ideal; auto. +have->: + Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + OSimulator(ExtendSample(FSome(BIRO.IRO))), + ODRestr(Dist_of_P2Adv(A))).main() @ &m : res] = + Pr[Game(RO).distinguish() @ &m : res]. ++ byequiv=> //=; proc. + inline{2} 1; sp; inline{2} 1; sp; inline{2} 1; sp; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp; sim. + seq 1 1 : (={m', glob Dist_of_P2Adv, glob OFC} /\ BIRO.IRO.mp{1} = RO.m{2}); last first. + - inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; sim; if; auto. + * inline{1} 6; inline{2} 6; sim. + inline{1} 7; inline{2} 7; sim. + swap 2 -1; sp. + case: (increase_counter Counter.c{1} m'{1} size_out <= SHA3Indiff.limit). + + rcondt{1} 9; 1: auto. + - inline*; auto. + by sp; rcondt 1; auto; conseq(:_==> true); auto. + rcondt{2} 9; 1: auto. + - inline*; auto. + by conseq(:_==> true); auto. + sim. + call eq_eager_ideal2; auto. + by call eq_eager_ideal2; auto. + rcondf{1} 9; 1: auto. + - inline*; auto. + by sp; rcondt 1; auto; conseq(:_==> true); auto. + rcondf{2} 9; 1: auto. + - inline*; auto. + by conseq(:_==> true); auto. + by auto; call eq_eager_ideal2; auto. + sp; inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; sim. + if; auto. + by auto; call eq_eager_ideal2; auto. + call(: ={glob OFC, glob OSimulator, glob Dist_of_P2Adv} /\ + BIRO.IRO.mp{1} = RO.m{2}); auto. + - proc; sp; if; auto. + inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. + if; 1: auto; sim; sp. + if; [1:auto; [1:by move=> /> + + <- /> <-]]; sim. + * by call eq_eager_ideal2; auto=> /> + + <- /> <- /#. + by move=> /> + + <- /> <- /#. + - by proc; inline*; sim. + proc; sim. + inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. + by call eq_eager_ideal2; auto. +rewrite eq_sym; byequiv=> //=; proc. +call(RO_LRO_D Dist _); first by rewrite dbool_ll. +by inline*; auto=> />. +qed. + + +local equiv toto : + DFSetSize(OFC(ExtendSample(FSome(BIRO.IRO)))).f ~ + DFSetSize(OFC(ExtendSample(FSome(BIRO.IRO)))).f : + ={glob OFC, arg} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2} ==> + ={glob OFC, res} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}. +proof. +proc; inline*; sp; if; auto; sp; if; auto; sp; (rcondt{1} 1; 1: auto; rcondt{2} 1; 1: auto)=>/=. ++ conseq(:_==> ={bs} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); auto. + while(={i, bs, n, x3} /\ 0 <= i{1} <= size_out /\ n{1} = size_out /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). + + by sp; if; auto=> /> => [|+ + + + + + + + + + _|]; smt(domE get_setE size_out_gt0). + by auto=> />; smt(size_out_gt0). +by conseq(:_==> true); auto; sim. +qed. + +local equiv titi mess c: + DFSetSize(OFC(ExtendSample(FSome(BIRO.IRO)))).f + ~ + SORO.Bounder(RFWhile).get + : + ={arg} /\ arg{1} = mess /\ Counter.c{1} = c /\ + SORO.Bounder.bounder{2} <= Counter.c{1} /\ + inv BIRO.IRO.mp{1} RFList.m{2} + ==> + if (increase_counter c mess size_out <= sigma) then + (exists y, res{1} = Some y /\ res{2} = Some y /\ + SORO.Bounder.bounder{2} <= Counter.c{1} /\ + Counter.c{1} = increase_counter c mess size_out /\ + inv BIRO.IRO.mp{1} RFList.m{2}) + else (res{1} = None). +proof. +proc; sp. +inline{1} 1; sp; auto. +if{1}. +- rcondt{2} 1; first by auto; smt(divz_ge0 gt0_r size_ge0). + sp; auto. + inline{1} 1; sp; auto. + sp; rcondt{1} 1; auto. + inline{1} 1; sp; auto. + call(eq_IRO_RFWhile); auto=> /> &1 &2 bounder_R H0 H1 H2 H3 H4 H5 result_R mp_L m_R H6 H7 H8 H9. + rewrite take_oversize 1:/# /=. + have:=spec2_dout _ H6. + move=>/(some_oget)-> /=; smt(divz_ge0 gt0_r size_ge0 spec2_dout). +move=>/=. +conseq(:_==> true); auto. +inline*; if{2}; auto; sp; if{2}; auto; sp. +by while{2}(true)(size_out - i{2}); auto; smt(dbool_ll). +qed. + +local lemma rw_ideal_2 &m (mess : bool list): + Dist_of_P2Adv.m{m} = mess => + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_P2Adv(A))).main() @ &m : res] <= + Pr[SORO.SecondPreimage(SORO_P2(A), RFList).main(mess) @ &m : res]. +proof. +move=> Heq. +have->:Pr[SORO.SecondPreimage(SORO_P2(A), RFList).main(mess) @ &m : res] = + Pr[SORO.SecondPreimage(SORO_P2(A), RFWhile).main(mess) @ &m : res]. ++ byequiv(: ={glob A, arg} /\ arg{1} = mess ==> _)=>//=; proc. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + seq 1 1 : (={mi, m1, glob A, glob SORO.Bounder, glob RFList, glob Dist_of_P2Adv}); last first. + - sp; inline{1} 2; inline{2} 2; inline{1} 1; inline{2} 1; sp; sim. + if; auto. + - sp; case: (SORO.Bounder.bounder{1} < sigma). + * rcondt{1} 5; 1: auto. + + by inline*; auto; conseq(:_==> true); auto. + rcondt{2} 5; 1: auto. + + by inline*; auto; conseq(:_==> true); auto. + call(rw_RF_List_While); auto. + by call(rw_RF_List_While); auto=> />. + rcondf{1} 5; 1: auto. + + by inline*; auto; conseq(:_==> true); auto. + rcondf{2} 5; 1: auto. + + by inline*; auto; conseq(:_==> true); auto. + by auto; call(rw_RF_List_While); auto. + by sp; if; auto; call(rw_RF_List_While); auto. + call(: ={glob SORO.Bounder, glob RFList, glob OSimulator, glob OPC, glob Log, + glob Dist_of_P2Adv}); auto. + - proc; sp; if; auto. + inline{1} 1; inline{2} 1; sp; if; 1, 3: auto; sim. + if; [1:by auto]; sim; sp; sim; if; auto=> /> => [+ + <- /> <- //||]; sim. + + inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; if; auto=> />. + - by call(rw_RF_List_While); auto=> /> + + <- /> <-. + by move=> /> + + <- /> <-. + by move=> /> + + <- /> <-. + - by sim. + proc; sim; inline{1} 1; inline{2} 1; sp; if; auto. + inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; if; auto; sim. + by call(rw_RF_List_While); auto. +rewrite (eager_ideal &m). +have->:Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + OSimulator(ExtendSample(FSome(BIRO.IRO))), + ODRestr(Dist_of_P2Adv(A))).main() @ &m : res] = + Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + OSimulator(ExtendOutputSize(FSetSize(FSome(BIRO.IRO)))), + ODRestr(Dist_of_P2Adv(A))).main() @ &m : res]. ++ byequiv=> //=; proc. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp; auto=> />. + call(toto); call(toto); auto. + conseq(:_==> ={m', glob Counter, Dist_of_P2Adv.m} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); 1: smt(). + call(: ={glob OSimulator, glob OFC, Dist_of_P2Adv.m} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); last first; auto. + + smt(mem_empty). + + proc; sp; if; auto. + inline{1} 1; inline{2} 1; sp; if; 1, 3: auto. + if; 1, 3: auto; sp. + if; [1:by auto=> /> + + <- /> <-]; last first. + - by conseq=> />; sim=> /> + + <- /> <-. + wp=> />; [1:by auto=> /> + + <- /> <-]. + rnd; auto. + by call(eq_extend); auto=> /> + + <- /> <- /#. + + by proc; sp; if; auto; inline{1} 1; inline{2} 1; sp; if; auto. + proc; sp; inline{1} 1; inline{2} 1; sp; if; auto. + inline*; sp. + rcondt{1} 1; 1: auto; rcondt{2} 1; 1: auto; sp. + rcondt{1} 1; 1: auto; rcondt{2} 1; 1: auto; sp; auto. + conseq(:_==> ={bs} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); + 1: by auto. + while(={i, n, x3, bs} /\ 0 <= i{1} <= size_out /\ n{1} = size_out /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). + - by sp; if; auto=> /> => [|+ + + + + + + + + + _|]; smt(domE get_setE size_rcons). + by auto=> />; smt(size_out_gt0). +byequiv=> //=; proc. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; sp; auto. +seq 1 1 : (={glob A, glob OFC, glob OSimulator, Log.m} /\ + m'{1} = mi{2} /\ m1{2} = Dist_of_P2Adv.m{1} /\ + inv BIRO.IRO.mp{1} RFList.m{2} /\ + SORO.Bounder.bounder{2} <= Counter.c{1}); last first. ++ sp; case: (increase_counter Counter.c{1} Dist_of_P2Adv.m{1} size_out <= SHA3Indiff.limit). + - exists * mi{2}, Dist_of_P2Adv.m{1}, Counter.c{1}; elim* => mess2 mess1 c. + call(titi mess2 (increase_counter c mess1 size_out))=> /=. + by call(titi mess1 c)=> />; auto; smt(). + inline*; sp. + rcondf{1} 1; 1: auto; sp. + conseq(:_==> true); auto. + seq 1 0 : true. + - if{1}; auto; sp; 1: if{1}; auto; sp. + - rcondt{1} 1; auto. + while{1}(true)(n1{1}-i1{1}); auto; -1: smt(). + by sp; if; auto; smt(dbool_ll). + rcondt{1} 1; 1: auto. + while{1}(true)(n2{1}-i2{1}); auto. + by sp; if; auto; smt(dbool_ll). + seq 0 1 : true. + - if{2}; auto; sp; if{2}; auto; sp. + by while{2}(true)(size_out-i{2}); auto; smt(dbool_ll). + sp; if{2}; auto; sp; if{2}; auto; sp. + by while{2}(true)(size_out-i0{2}); auto; smt(dbool_ll). +conseq(:_==> ={glob A, glob OFC, glob OSimulator, Log.m} /\ + m'{1} = mi{2} /\ + inv BIRO.IRO.mp{1} RFList.m{2} /\ SORO.Bounder.bounder{2} <= Counter.c{1}). ++ smt(). +auto; call(: ={glob OSimulator, glob Counter, glob Log} /\ + inv BIRO.IRO.mp{1} RFList.m{2} /\ + SORO.Bounder.bounder{2} <= Counter.c{1}); auto; last first. ++ by smt(mem_empty). ++ proc; sp; if; auto=> />; 1: smt(). + inline{1} 1; inline{2} 1; sp; auto. + if; 1, 3: auto; -1: smt(). + if; [1,3:auto]; [2:move=> /> + + + + + + + + + + + _ + _ - /#]. + sp; if; [1:by auto=> /> + + <- /> <-]; last first. + - conseq(:_==> ={y, glob OSimulator}). + + by auto=> /> + + <- /> <- /#. + by sim=> /> + + <- /> <-. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + rcondt{2} 1; 1: by auto; smt(). + sp. + seq 3 2 : (={x0, x1, o1, k0, Log.m, suffix, glob OSimulator} /\ + inv BIRO.IRO.mp{1} RFList.m{2} /\ + SORO.Bounder.bounder{2} <= Counter.c{2} + 1); last first. + - by conseq(:_==> ={y, x1, glob OSimulator, Log.m}); 1: smt(); sim=> />. + inline{1} 1; auto. + by call(eq_IRO_RFWhile); auto=> /> + + + <- /> <- /#. ++ by proc; inline*; sp; if; auto; sp; if; auto=> />; smt(). +proc. +inline{1} 1; inline{2} 1; sp; if; auto=> /=. +inline{1} 1; inline{2} 1; sp. +rcondt{1} 1; 1: auto. +inline{1} 1; auto. +rcondf{2} 4; 1: auto. ++ inline*; auto; sp; if; auto; sp; if; auto=> />; conseq(:_==> true); 1: smt(). + by while(true); auto. +inline{2} 1; sp. +rcondt{2} 1; 1: by auto; smt(divz_ge0 gt0_r size_ge0). +auto; call eq_IRO_RFWhile; auto=> />. +move=> &l &r H0 H1 H2 H3 H4 H5 result_L mp_L m_R H6 H7 H8 H9 H10; split; 2: smt(divz_ge0 gt0_r size_ge0). +rewrite cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. +have h:=spec2_dout result_L H6. +have-> := some_oget _ h. +by rewrite eq_sym -to_listK; congr. +qed. + +local lemma rw_ideal &m (mess : bool list): + Dist_of_P2Adv.m{m} = mess => + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_P2Adv(A))).main() @ &m : res] <= + Pr[SORO.SecondPreimage(SORO_P2(A),RF(SORO.RO.RO)).main(mess) @ &m : res]. +proof. +move=> Heq. +rewrite (StdOrder.RealOrder.ler_trans _ _ _ (rw_ideal_2 &m mess Heq)). +byequiv(: ={glob A} /\ ={arg} /\ arg{1} = mess ==> _) => //=; proc; inline*; sp; wp. +seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, + glob Log, mi, m1} /\ RFList.m{1} = SORO.RO.RO.m{2}). ++ call(: ={glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, glob Log} /\ + RFList.m{1} = SORO.RO.RO.m{2}); auto. + - proc; sp; if; 1, 3: auto; sp. + inline *; sp; sim. + if; 1: auto; sim. + if; 1: auto; sim. + sp; if; [1:by auto=> /> + + <- /> <-]; sim; 2:by auto=> /> + + <- /> <-. + sp; if; 1: auto; sim; -1: smt(). + sp; if{1}. + * rcondt{2} 2; auto; [1:by auto=> /> + + <- /> <-; smt(BlockSponge.parse_valid)]. + rnd (fun l => oget (of_list l)) to_list; auto=> />. + move=> /> &l &r + <- /> <- /> - 7?; split; 1: smt(of_listK). + rewrite -dout_equal_dlist=> ?; split=> ?. + + by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). + move=> sample. + rewrite !get_setE/=dout_full/= => h. + rewrite eq_sym to_listK; apply some_oget. + apply spec2_dout. + by move:h; rewrite supp_dmap; smt(spec_dout). + by auto=> /> + + + <- /> <-; smt(dout_ll). + - by proc; inline*; sp; if; auto; sp; if; auto. + - proc; inline*; sp; if; auto; sp; if; auto; sp; sim. + if{1}. + * rcondt{2} 2; auto. + rnd (fun l => oget (of_list l)) to_list; auto=> />. + move=> &l 4?; split=> ?; 1: smt(of_listK). + rewrite -dout_equal_dlist; split=> ?. + * by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). + move=> sample. + rewrite supp_dmap dout_full/= =>/> a. + by rewrite get_setE/= dout_full/=; congr; rewrite of_listK oget_some. + by auto=> />; smt(dout_ll). +sp. +seq 4 4 : (={SORO.Bounder.bounder, x0, m1, m2, hash1, y0} /\ y0{1} = None /\ + RFList.m{1} = SORO.RO.RO.m{2}); last first. ++ if; 1, 3: auto; sp. + if{1}. + - rcondt{2} 2; 1: auto. + auto; rnd (fun t => oget (of_list t)) to_list; auto=> />. + move=> &l c Hc Hnin; split. + - move=> ret Hret. + by have/= ->:= (to_listK ret (to_list ret)). + move=> h{h}; split. + - move=> ret Hret; rewrite -dout_equal_dlist. + rewrite dmapE /=; apply mu_eq=> //= x /=. + by rewrite /(\o) /pred1/=; smt(to_list_inj). + move=> h{h} l Hl. + rewrite dout_full /=. + have:= spec2_dout l. + have:=supp_dlist dbool size_out l _; 1: smt(size_out_gt0). + rewrite Hl/==> [#] -> h{h} /= H. + have H1:=some_oget _ H. + have:=to_listK (oget (of_list l)) l; rewrite {2}H1/= => -> /= {H H1}. + by rewrite get_setE/=; smt(). + by auto=> />; smt(dout_ll). +if; 1, 3: auto; sp. +if{1}. +- rcondt{2} 2; 1: auto. + auto; rnd (fun t => oget (of_list t)) to_list; auto=> />. + move=> &l c Hc Hnin; split. + - move=> ret Hret. + by have/= ->:= (to_listK ret (to_list ret)). + move=> h{h}; split. + - move=> ret Hret; rewrite -dout_equal_dlist. + rewrite dmapE /=; apply mu_eq=> //= x /=. + by rewrite /(\o) /pred1/=; smt(to_list_inj). + move=> h{h} l Hl. + rewrite dout_full /=. + have:= spec2_dout l. + have:=supp_dlist dbool size_out l _; 1: smt(size_out_gt0). + rewrite Hl/==> [#] -> h{h} /= H. + have H1:=some_oget _ H. + have:=to_listK (oget (of_list l)) l; rewrite {2}H1/= => -> /= {H H1}. + by rewrite get_setE/=; smt(). +by auto=> />; smt(dout_ll). +qed. + + +local lemma leq_ideal &m mess: + Dist_of_P2Adv.m{m} = mess => + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_P2Adv(A))).main() @ &m : res] <= (sigma + 1)%r / 2%r ^ size_out. +proof. +move=> Heq. +rewrite (StdOrder.RealOrder.ler_trans _ _ _ (rw_ideal &m mess Heq)). +rewrite (StdOrder.RealOrder.ler_trans _ _ _ (RO_is_second_preimage_resistant (SORO_P2(A)) &m mess)). +by rewrite doutE1. +qed. + +local lemma rw_real &m mess : + Dist_of_P2Adv.m{m} = mess => + Pr[SecondPreimage(A, OSponge, PSome(Perm)).main(mess) @ &m : res] = + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(Sponge(Poget(PSome(Perm)))), PSome(Perm), + ODRestr(Dist_of_P2Adv(A))).main() @ &m : res]. +proof. +move=> Heq. +byequiv=>//=; proc. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; sp; wp=> />. +seq 1 1 : (={glob A, glob Perm} /\ m1{1} = Dist_of_P2Adv.m{2} /\ + m2{1} = m'{2} /\ Bounder.bounder{1} = Counter.c{2}). ++ auto; call(: ={glob Perm} /\ Bounder.bounder{1} = Counter.c{2})=> //=. + - by proc; inline*; sp; if; auto; 2:sim=> />; smt(). + - by proc; inline*; sp; if; auto; 2:sim=> />; smt(). + - proc; inline*; sp; if; auto; sp=> />. + by conseq(:_==> ={z0, glob Perm})=> />; sim. + by auto; smt(). +conseq(:_==> m1{1} = Dist_of_P2Adv.m{2} /\ m2{1} = m'{2} /\ + hash1{1} = hash{2} /\ hash2{1} = hash'{2})=> //=; 1: smt(). +seq 1 1 : (m1{1} = Dist_of_P2Adv.m{2} /\ m2{1} = m'{2} /\ + hash1{1} = hash{2} /\ ={glob Perm} /\ Bounder.bounder{1} = Counter.c{2}); last first. ++ inline*; sp; if; auto; sp=> /=; sim. +inline*; sp; if; auto; swap{1} 9; auto; sp=> /=. +by conseq(:_==> m1{1} = Dist_of_P2Adv.m{2} /\ m2{1} = m'{2} /\ + of_list (oget (Some (take n{1} z0{1}))) = + of_list (oget (Some (take n{2} z0{2}))) /\ ={Perm.mi, Perm.m})=> //=; sim. +qed. + +local module TOTO = { + proc main (m : bool list) = { + var b; + Dist_of_P2Adv.m <- m; + b <@ SecondPreimage(A, OSponge, PSome(Perm)).main(m); + return b; + } +}. + +lemma Sponge_second_preimage_resistant &m mess: + (forall (F <: OIndif.ODFUNCTIONALITY) (P <: OIndif.ODPRIMITIVE), + islossless F.f => islossless P.f => islossless P.fi => islossless A(F,P).guess) => + Pr[SecondPreimage(A, OSponge, PSome(Perm)).main(mess) @ &m : res] <= + (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + + (4 * limit ^ 2)%r / (2 ^ c)%r + + (sigma + 1)%r / (2%r ^ size_out). +proof. +move=> A_ll. +have->:Pr[SecondPreimage(A, OSponge, PSome(Perm)).main(mess) @ &m : res] = + Pr[TOTO.main(mess) @ &m : res]. ++ by byequiv=> //=; proc; inline*; auto; sim. +byphoare(: arg = mess ==>_)=>//=; proc; sp. +call(: arg = mess /\ mess = Dist_of_P2Adv.m ==> res); auto. +bypr=> {&m} &m [#]->; rewrite eq_sym=> Heq. +rewrite (rw_real &m mess Heq). +have := SHA3OIndiff (Dist_of_P2Adv(A)) &m _. ++ move=> F P Hp Hpi Hf; proc; inline*; sp; auto; call Hf; auto; call Hf; auto. + call(A_ll (DFSetSize(F)) P _ Hp Hpi); auto. + proc; inline*; auto; call Hf; auto. +by have/#:=leq_ideal &m. +qed. + +end section SecondPreimage. + + + + +section Collision. + + + declare module A <: SH.AdvCollision {-Perm, -Counter, -Bounder, -F.RO, -F.FRO, -Redo, -C, -Gconcl.S, -BlockSponge.BIRO.IRO, -BlockSponge.C, -BIRO.IRO, -Gconcl_list.BIRO2.IRO, -Gconcl_list.F2.RO, -Gconcl_list.F2.FRO, -Gconcl_list.Simulator, -SHA3Indiff.Simulator, -SHA3Indiff.Cntr, -SORO.Bounder, -SORO.RO.RO, -SORO.RO.FRO, -RO, -FRO}. + + local module FInit (F : OIndif.ODFUNCTIONALITY) : OIndif.OFUNCTIONALITY = { + proc init () = {} + proc f = F.f + }. + + local module PInit (P : ODPRIMITIVE) : OPRIMITIVE = { + proc init () = {} + proc f = P.f + proc fi = P.fi + }. + + +local module OF (F : Oracle) : OIndif.ODFUNCTIONALITY = { + proc f = F.get +}. + + +local module Log = { + var m : (bool list * int, bool) fmap +}. + +local module ExtendOutputSize (F : Oracle) : ODFUNCTIONALITY = { + proc f (x : bool list, k : int) = { + var o, l, suffix, prefix, i, r; + l <- None; + prefix <- []; + suffix <- []; + o <@ F.get(x); + prefix <- take k (to_list (oget o)); + i <- size_out; + while (i < k) { + if ((x,i) \notin Log.m) { + r <$ {0,1}; + Log.m.[(x,i)] <- r; + } + suffix <- rcons suffix (oget Log.m.[(x,i)]); + i <- i + 1; + } + l <- Some (prefix ++ suffix); + return l; + } +}. + +local module OFC2 (F : Oracle) = OFC(ExtendOutputSize(F)). + +local module ExtendOutput (F : RF) = { + proc init () = { + Log.m <- empty; + F.init(); + } + proc f = ExtendOutputSize(F).f + proc get = f +}. + + local module (Dist_of_CollAdv (A : SH.AdvCollision) : ODISTINGUISHER) (F : ODFUNCTIONALITY) (P : ODPRIMITIVE) = { + var m : bool list + proc distinguish () = { + var hash1, hash2, m1, m2; + Log.m <- empty; + (m1, m2) <@ A(DFSetSize(F),P).guess(); + hash1 <@ DFSetSize(F).f(m1); + hash2 <@ DFSetSize(F).f(m2); + return m1 <> m2 /\ exists y, hash1 = Some y /\ hash2 = Some y; + } + }. + + +local module (SORO_Coll (A : SH.AdvCollision) : SORO.AdvCollision) (F : Oracle) = { + proc guess () = { + var mi; + Log.m <- empty; + Counter.c <- 0; + OSimulator(ExtendOutputSize(F)).init(); + mi <@ A(DFSetSize(OFC2(F)),OPC(OSimulator(ExtendOutputSize(F)))).guess(); + return mi; + } +}. + +local module RFList = { + var m : (bool list, f_out) fmap + proc init () = { + m <- empty; + } + proc get (x : bool list) : f_out option = { + var z; + if (x \notin m) { + z <$ dlist dbool size_out; + m.[x] <- oget (of_list z); + } + return m.[x]; + } + proc sample (x: bool list) = {} +}. + +local module RFWhile = { + proc init () = { + RFList.m <- empty; + } + proc get (x : bool list) : f_out option = { + var l, i, b; + if (x \notin RFList.m) { + i <- 0; + l <- []; + while (i < size_out) { + b <$ dbool; + l <- rcons l b; + i <- i + 1; + } + RFList.m.[x] <- oget (of_list l); + } + return RFList.m.[x]; + } + proc sample (x: bool list) = {} +}. + + +local equiv rw_RF_List_While : + RFList.get ~ RFWhile.get : + ={arg, glob RFList} ==> ={res, glob RFWhile}. +proof. +proc; if; 1, 3: auto; wp. +conseq(:_==> z{1} = l{2})=> />. +transitivity{1} { + z <@ PBool.Sample.sample(size_out); + } + (true ==> ={z}) + (true ==> z{1} = l{2})=>/>. ++ by inline*; auto. +transitivity{1} { + z <@ LoopSnoc.sample(size_out); + } + (true ==> ={z}) + (true ==> z{1} = l{2})=>/>; last first. ++ inline*; auto; sim. + by while(={l, i} /\ n{1} = size_out); auto; smt(cats1). +by call(Sample_LoopSnoc_eq); auto. +qed. + + +local equiv eq_IRO_RFWhile : + BIRO.IRO.f ~ RFWhile.get : + arg{1} = (x{2}, size_out) /\ inv BIRO.IRO.mp{1} RFList.m{2} + ==> + res{2} = of_list res{1} /\ size res{1} = size_out /\ inv BIRO.IRO.mp{1} RFList.m{2}. +proof. +proc; inline*; sp. +rcondt{1} 1; 1: by auto. +if{2}; sp; last first. ++ alias{1} 1 mp = BIRO.IRO.mp. + conseq(:_==> BIRO.IRO.mp{1} = mp{1} /\ size bs{1} = i{1} /\ i{1} = size_out /\ + inv mp{1} RFList.m{2} /\ + bs{1} = take i{1} (to_list (oget RFList.m{2}.[x{1}])))=> />. + - move=> &l &r H0 H1 H2 H3 H4 bs_L mp_L H5 H7 H8 H9 H10. + rewrite take_oversize 1:spec_dout 1:H5 //. + rewrite eq_sym to_listK => ->. + by have:=H4; rewrite domE; smt(). + - smt(take_oversize spec_dout). + while{1}(BIRO.IRO.mp{1} = mp{1} /\ size bs{1} = i{1} /\ + 0 <= i{1} <= size_out /\ n{1} = size_out /\ + inv mp{1} RFList.m{2} /\ x{1} \in RFList.m{2} /\ + bs{1} = take i{1} (to_list (oget RFList.m{2}.[x{1}])))(size_out - i{1}); + auto=> />. + + sp; rcondf 1; auto=> />; 1: smt(). + move=> &h H0 H1 H2 H3 H4 H5 H6 H7 H8. + rewrite size_rcons //=; do!split; 1, 2, 4: smt(size_ge0). + rewrite (take_nth witness) 1:spec_dout 1:size_ge0//=. + rewrite - H7; congr; rewrite H5=> //=. + by apply H4=> //=. + smt(size_out_gt0 size_ge0 take0). +auto=> //=. +conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{1} /\ n{1} = size_out /\ + inv BIRO.IRO.mp{1} RFList.m{2}.[x{2} <- oget (of_list l{2})])=> />. ++ smt(get_setE spec2_dout). ++ smt(get_setE spec2_dout). +alias{1} 1 m = BIRO.IRO.mp; sp. +conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{1} /\ + n{1} = size_out /\ inv m{1} RFList.m{2} /\ + (forall j, (x{1}, j) \in BIRO.IRO.mp{1} => 0 <= j < i{1}) /\ + (forall l j, l <> x{1} => m{1}.[(l,j)] = BIRO.IRO.mp{1}.[(l,j)]) /\ + (forall j, 0 <= j < i{1} => (x{1}, j) \in BIRO.IRO.mp{1}) /\ + (forall j, 0 <= j < i{1} => BIRO.IRO.mp{1}.[(x{1},j)] = Some (nth witness bs{1} j))). ++ move=> /> &l &r H0 H1 H2 H3 H4 mp_L bs_L H5 H6 H7 H8 H9; do!split; ..-2 : smt(domE mem_set). + move=> l j Hin. + rewrite get_setE/=. + case: (l = x{r}) => [<<-|]. + - rewrite oget_some H9; 1:smt(); congr; congr. + by rewrite eq_sym to_listK; smt(spec2_dout). + move=> Hneq. + by rewrite -(H7 _ _ Hneq) H3; smt(domE). +while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ + n{1} = size_out /\ inv m{1} RFList.m{2} /\ + (forall j, (x{1}, j) \in BIRO.IRO.mp{1} => 0 <= j < i{1}) /\ + (forall l j, l <> x{1} => m{1}.[(l,j)] = BIRO.IRO.mp{1}.[(l,j)]) /\ + (forall j, 0 <= j < i{1} => (x{1}, j) \in BIRO.IRO.mp{1}) /\ + (forall j, 0 <= j < i{1} => BIRO.IRO.mp{1}.[(x{1},j)] = Some (nth witness bs{1} j))). ++ sp; rcondt{1} 1; auto=> />. + - smt(). + move=> &l &r H0 H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 rL _. + rewrite get_setE/=size_rcons/=; do!split; 1,2: smt(size_ge0). + - smt(mem_set). + - smt(get_setE). + - smt(mem_set). + - move=>j Hj0 Hjsize; rewrite get_setE/=nth_rcons. + case: (j = size bs{l})=>[->>//=|h]. + have/=Hjs:j < size bs{l} by smt(). + by rewrite Hjs/=H9//=. +by auto; smt(size_out_gt0). +qed. + + +local module ExtendSample (F : OFUNCTIONALITY) = { + proc init = F.init + proc f (x : bool list, k : int) = { + var y; + if (k <= size_out) { + y <@ F.f(x,size_out); + y <- omap (take k) y; + } else { + y <@ F.f(x,k); + } + return y; + } +}. + + +local equiv eq_extend : + ExtendSample(FSome(BIRO.IRO)).f ~ ExtendOutputSize(FSetSize(FSome(BIRO.IRO))).f : + ={arg} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2} ==> + ={res} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}. +proof. +proc; inline*; auto; sp. +rcondt{2} 1; 1: auto. +if{1}; sp. +- rcondt{1} 1; auto. + rcondf{2} 8; 1: auto. + - conseq(:_==> true); 1: smt(). + by while(true); auto. + auto=> /=. + conseq(:_==> ={bs, k} /\ size bs{1} = size_out /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2})=> //=. + - smt(cats0 to_listK spec2_dout). + while(={k, bs, n, x2} /\ i{1} = i0{2} /\ n{1} = size_out /\ + 0 <= i{1} <= n{1} /\ size bs{1} = i{1} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). + - by sp; if; auto=> />; smt(domE get_setE size_rcons). + by auto=> />; smt(size_eq0 size_out_gt0). +rcondt{1} 1; 1: auto. +splitwhile{1} 1 : i0 < size_out; auto=> /=. +while( (i0, n0, x3){1} = (i, k, x){2} /\ bs0{1} = prefix{2} ++ suffix{2} /\ + size_out <= i{2} <= k{2} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). ++ by sp; if; auto=> /> => [|+ + + + + + + + + + _|]; smt(domE get_setE size_out_gt0 rcons_cat). +auto=> //=. +conseq(:_==> ={i0} /\ size bs{2} = i0{1} /\ (i0, x3){1} = (n, x2){2} /\ + bs0{1} = bs{2} /\ size bs{2} = size_out /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). ++ by auto=> />; smt(cats0 take_oversize spec_dout to_listK spec2_dout). +while(={i0} /\ x3{1} = x2{2} /\ 0 <= i0{1} <= n{2} /\ n{2} = size_out /\ + bs0{1} = bs{2} /\ size bs{2} = i0{1} /\ size_out <= n0{1} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). ++ by sp; if; auto=> /> => [|+ + + + + + + + + + + + _|]; smt(size_rcons domE get_setE size_rcons mem_set). +by auto=> />; smt(size_out_gt0). +qed. + + +local lemma of_listK l : of_list (to_list l) = Some l. +proof. +by rewrite -to_listK. +qed. + +local module Fill_In (F : RO) = { + proc init = F.init + proc f (x : bool list, n : int) = { + var l, b, i; + i <- 0; + l <- []; + while (i < n) { + b <@ F.get((x,i)); + l <- rcons l b; + i <- i + 1; + } + while (i < size_out) { + F.sample((x,i)); + i <- i + 1; + } + return l; + } +}. + + +local equiv eq_eager_ideal : + BIRO.IRO.f ~ Fill_In(LRO).f : + ={arg} /\ BIRO.IRO.mp{1} = RO.m{2} ==> + ={res} /\ BIRO.IRO.mp{1} = RO.m{2}. +proof. +proc; inline*; sp; rcondt{1} 1; auto. +while{2}(bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2})(size_out - i{2}). ++ by auto=> />; smt(). +conseq(:_==> bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2}); 1: smt(). +while(={i, n, x} /\ bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2}). ++ sp; if{1}. + - by rcondt{2} 2; auto=> />. + by rcondf{2} 2; auto=> />; smt(dbool_ll). +by auto. +qed. + +local equiv eq_eager_ideal2 : + ExtendSample(FSome(BIRO.IRO)).f ~ FSome(Fill_In(RO)).f : + ={arg} /\ BIRO.IRO.mp{1} = RO.m{2} ==> + ={res} /\ BIRO.IRO.mp{1} = RO.m{2}. +proof. +proc; inline*; sp. +if{1}; sp. ++ rcondt{1} 1; auto=> /=/>. + conseq(:_==> take k{1} bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2}). + * by auto=> />; smt(). + case: (0 <= n{2}); last first. + + rcondf{2} 1; 1: by auto; smt(). + conseq(:_==> BIRO.IRO.mp{1} = RO.m{2} /\ ={i} /\ n{1} = size_out /\ x2{1} = x0{2})=> />. + - smt(take_le0). + while(={i} /\ x2{1} = x0{2} /\ n{1} = size_out /\ BIRO.IRO.mp{1} = RO.m{2}). + - sp; if{1}. + - by rcondt{2} 2; auto=> />. + by rcondf{2} 2; auto=> />; smt(dbool_ll). + by auto=> />. + splitwhile{1} 1 : i < k. + while(={i} /\ n{1} = size_out /\ x2{1} = x0{2} /\ BIRO.IRO.mp{1} = RO.m{2} /\ + take k{1} bs{1} = l{2} /\ size bs{1} = i{1} /\ k{1} <= i{1} <= size_out). + * sp; if{1}. + - by rcondt{2} 2; auto=> />; smt(dbool_ll cats1 take_cat cats0 take_size size_rcons). + by rcondf{2} 2; auto=> />; smt(dbool_ll cats1 take_cat cats0 take_size size_rcons). + conseq(:_==> ={i} /\ n{1} = size_out /\ x2{1} = x0{2} /\ BIRO.IRO.mp{1} = RO.m{2} /\ + bs{1} = l{2} /\ size bs{1} = i{1} /\ k{1} = i{1}). + + smt(take_size). + while(={i} /\ x2{1} = x0{2} /\ n{1} = size_out /\ k{1} = n{2} /\ + 0 <= i{1} <= k{1} <= size_out /\ bs{1} = l{2} /\ size bs{1} = i{1} /\ + BIRO.IRO.mp{1} = RO.m{2}). + + sp; if{1}. + - by rcondt{2} 2; auto=> />; smt(size_rcons). + by rcondf{2} 2; auto=> />; smt(size_rcons dbool_ll). + by auto=> />; smt(size_ge0 size_out_gt0). +rcondt{1} 1; auto. +rcondf{2} 2; 1: auto. ++ conseq(:_==> i = n)=> />; 1:smt(). + by while(i <= n); auto=> />; smt(size_out_gt0). +while(i0{1} = i{2} /\ x3{1} = x0{2} /\ n0{1} = n{2} /\ bs0{1} = l{2} /\ + BIRO.IRO.mp{1} = RO.m{2}). ++ sp; if{1}. + - by rcondt{2} 2; auto=> />. + by rcondf{2} 2; auto; smt(dbool_ll). +by auto=> />. +qed. + +local module Dist (F : RO) = { + proc distinguish = SHA3_OIndiff.OIndif.OIndif(FSome(Fill_In(F)), + OSimulator(FSome(Fill_In(F))), ODRestr(Dist_of_CollAdv(A))).main +}. + +local module Game (F : RO) = { + proc distinguish () = { + var bo; + OSimulator(FSome(Fill_In(F))).init(); + Counter.c <- 0; + Log.m <- empty; + F.init(); + bo <@ Dist(F).distinguish(); + return bo; + } +}. + +local lemma eager_ideal &m : + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), + OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_CollAdv(A))).main() @ &m : res] = + Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + OSimulator(ExtendSample(FSome(BIRO.IRO))), + ODRestr(Dist_of_CollAdv(A))).main() @ &m : res]. +proof. +have->: + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), + OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_CollAdv(A))).main() @ &m : res] = + Pr[Game(LRO).distinguish() @ &m : res]. ++ byequiv=> //=; proc. + inline{2} 1; sp; inline{2} 1; sp; inline{2} 1; sp; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp; sim. + seq 1 1 : (={m1, m2, glob OFC} /\ BIRO.IRO.mp{1} = RO.m{2}); last first. + - inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; sim; if; auto. + * inline{1} 1; inline{2} 1; sp; sim. + inline{1} 7; inline{2} 7; sim. + inline{1} 8; inline{2} 8; sim. + swap 3 -2; sp. + case: (increase_counter Counter.c{1} m2{1} size_out <= SHA3Indiff.limit). + + rcondt{1} 10; 1: auto. + - inline*; auto. + by sp; rcondt 1; auto; conseq(:_==> true); auto. + rcondt{2} 10; 1: auto. + - inline*; auto. + by conseq(:_==> true); auto. + sim. + inline{1} 10; inline{2} 10; sim. + call eq_eager_ideal; auto. + by call eq_eager_ideal; auto. + rcondf{1} 10; 1: auto. + - inline*; auto. + by sp; rcondt 1; auto; conseq(:_==> true); auto. + rcondf{2} 10; 1: auto. + - inline*; auto. + by conseq(:_==> true); auto. + by auto; call eq_eager_ideal; auto. + sp; inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; sim. + if; auto. + inline{1} 1; inline{2} 1; sp; sim. + by auto; call eq_eager_ideal; auto. + call(: ={glob OFC, glob OSimulator} /\ + BIRO.IRO.mp{1} = RO.m{2}); auto. + - proc; sp; if; auto. + inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. + if; 1: auto; sim; sp. + if; [1:by auto=> /> + + <- /> <-]; sim. + * inline{1} 1; inline{2} 1; sp; sim. + by call eq_eager_ideal; auto=> /> + + <- /> <-. + by auto=> /> + + <- /> <-. + - by proc; inline*; sim. + proc; sim. + inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. + inline{1} 1; inline{2} 1; sp; sim. + by call eq_eager_ideal; auto. +have->: + Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + OSimulator(ExtendSample(FSome(BIRO.IRO))), + ODRestr(Dist_of_CollAdv(A))).main() @ &m : res] = + Pr[Game(RO).distinguish() @ &m : res]. ++ byequiv=> //=; proc. + inline{2} 1; sp; inline{2} 1; sp; inline{2} 1; sp; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp; sim. + seq 1 1 : (={m1, m2, glob OFC} /\ BIRO.IRO.mp{1} = RO.m{2}); last first. + - inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; sim; if; auto. + * inline{1} 6; inline{2} 6; sim. + inline{1} 7; inline{2} 7; sim. + swap 2 -1; sp. + case: (increase_counter Counter.c{1} m2{1} size_out <= SHA3Indiff.limit). + + rcondt{1} 9; 1: auto. + - inline*; auto. + by sp; rcondt 1; auto; conseq(:_==> true); auto. + rcondt{2} 9; 1: auto. + - inline*; auto. + by conseq(:_==> true); auto. + sim. + call eq_eager_ideal2; auto. + by call eq_eager_ideal2; auto. + rcondf{1} 9; 1: auto. + - inline*; auto. + by sp; rcondt 1; auto; conseq(:_==> true); auto. + rcondf{2} 9; 1: auto. + - inline*; auto. + by conseq(:_==> true); auto. + by auto; call eq_eager_ideal2; auto. + sp; inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; sim. + if; auto. + by auto; call eq_eager_ideal2; auto. + call(: ={glob OFC, glob OSimulator} /\ + BIRO.IRO.mp{1} = RO.m{2}); auto. + - proc; sp; if; auto. + inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. + if; 1: auto; sim; sp. + if; [1:by auto=> /> + + <- /> <-]; sim. + * by call eq_eager_ideal2; auto=> /> + + <- /> <-. + by auto=> /> + + <- /> <-. + - by proc; inline*; sim. + proc; sim. + inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. + by call eq_eager_ideal2; auto. +rewrite eq_sym; byequiv=> //=; proc. +call(RO_LRO_D Dist _); first by rewrite dbool_ll. +by inline*; auto=> />. +qed. + +local equiv toto : + DFSetSize(OFC(ExtendSample(FSome(BIRO.IRO)))).f ~ + DFSetSize(OFC(ExtendSample(FSome(BIRO.IRO)))).f : + ={glob OFC, arg} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2} ==> + ={glob OFC, res} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}. +proof. +proc; inline*; sp; if; auto; sp; if; auto; sp; (rcondt{1} 1; 1: auto; rcondt{2} 1; 1: auto)=>/=. ++ conseq(:_==> ={bs} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); auto. + while(={i, bs, n, x3} /\ 0 <= i{1} <= size_out /\ n{1} = size_out /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). + - by sp; if; auto=> /> => [|+ + + + + + + + + + _|]; smt(domE get_setE size_out_gt0). + by auto=> />; smt(size_out_gt0). +by conseq(:_==> true); auto; sim. +qed. + +local equiv titi mess c: + DFSetSize(OFC(ExtendSample(FSome(BIRO.IRO)))).f + ~ + SORO.Bounder(RFWhile).get + : + ={arg} /\ arg{1} = mess /\ Counter.c{1} = c /\ + SORO.Bounder.bounder{2} <= Counter.c{1} /\ + inv BIRO.IRO.mp{1} RFList.m{2} + ==> + if (increase_counter c mess size_out <= sigma) then + (exists y, res{1} = Some y /\ res{2} = Some y /\ + SORO.Bounder.bounder{2} <= Counter.c{1} /\ + Counter.c{1} = increase_counter c mess size_out /\ + inv BIRO.IRO.mp{1} RFList.m{2}) + else (res{1} = None). +proof. +proc; sp. +inline{1} 1; sp; auto. +if{1}. +- rcondt{2} 1; first by auto; smt(divz_ge0 gt0_r size_ge0). + sp; auto. + inline{1} 1; sp; auto. + sp; rcondt{1} 1; auto. + inline{1} 1; sp; auto. + call(eq_IRO_RFWhile); auto=> /> &1 &2 bounder_R H0 H1 H2 H3 H4 H5 result_L mp_L m_R H6 H7 H8 H9. + rewrite take_oversize 1:/# /=. + have:=spec2_dout _ H6. + move=>/(some_oget)-> /=; smt(divz_ge0 gt0_r size_ge0 spec2_dout). +move=>/=. +conseq(:_==> true); auto. +inline*; if{2}; auto; sp; if{2}; auto; sp. +by while{2}(true)(size_out - i{2}); auto; smt(dbool_ll). +qed. + +local lemma rw_ideal_2 &m : + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_CollAdv(A))).main() @ &m : res] <= + Pr[SORO.Collision(SORO_Coll(A), RFList).main() @ &m : res]. +proof. +have->:Pr[SORO.Collision(SORO_Coll(A), RFList).main() @ &m : res] = + Pr[SORO.Collision(SORO_Coll(A), RFWhile).main() @ &m : res]. ++ byequiv(: ={glob A, arg} ==> _)=>//=; proc. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + seq 1 1 : (={mi, glob A, glob SORO.Bounder, glob RFList}); last first. + - sp; inline{1} 2; inline{2} 2; inline{1} 1; inline{2} 1; sp; sim. + if; auto. + - sp; case: (SORO.Bounder.bounder{1} < sigma). + * rcondt{1} 5; 1: auto. + + by inline*; auto; conseq(:_==> true); auto. + rcondt{2} 5; 1: auto. + + by inline*; auto; conseq(:_==> true); auto. + call(rw_RF_List_While); auto. + by call(rw_RF_List_While); auto=> />. + rcondf{1} 5; 1: auto. + + by inline*; auto; conseq(:_==> true); auto. + rcondf{2} 5; 1: auto. + + by inline*; auto; conseq(:_==> true); auto. + by auto; call(rw_RF_List_While); auto. + by sp; if; auto; call(rw_RF_List_While); auto. + call(: ={glob SORO.Bounder, glob RFList, glob OSimulator, glob OPC, glob Log}); auto. + - proc; sp; if; auto. + inline{1} 1; inline{2} 1; sp; if; 1, 3: auto; sim. + if; [1:by auto]; sim; sp; sim; if; auto=> /> => [+ + <- /> <- //||]; sim. + + inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; if; auto=> />. + - by call(rw_RF_List_While); auto=> /> + + <- /> <-. + by auto=> /> + + <- /> <-. + by auto=> /> + + <- /> <-. + - by sim. + proc; sim; inline{1} 1; inline{2} 1; sp; if; auto. + inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; if; auto; sim. + by call(rw_RF_List_While); auto. +rewrite (eager_ideal &m). +have->:Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + OSimulator(ExtendSample(FSome(BIRO.IRO))), + ODRestr(Dist_of_CollAdv(A))).main() @ &m : res] = + Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + OSimulator(ExtendOutputSize(FSetSize(FSome(BIRO.IRO)))), + ODRestr(Dist_of_CollAdv(A))).main() @ &m : res]. ++ byequiv=> //=; proc. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp; auto=> />. + call(toto); call(toto); auto. + conseq(:_==> ={m1, m2, glob Counter} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); 1: smt(). + call(: ={glob OSimulator, glob OFC} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); last first; auto. + + smt(mem_empty). + + proc; sp; if; auto. + inline{1} 1; inline{2} 1; sp; if; 1, 3: auto. + if; 1, 3: auto; sp. + if; [1:by auto=> /> + + <- /> <-]; last first. + - by conseq=> />; sim=> /> + + <- /> <-. + wp=> />; 1: smt(). + rnd; auto. + by call(eq_extend); auto=> /> + + <- /> <- /#. + by proc; sp; if; auto; inline{1} 1; inline{2} 1; sp; if; auto. + proc; sp; inline{1} 1; inline{2} 1; sp; if; auto. + inline*; sp. + rcondt{1} 1; 1: auto; rcondt{2} 1; 1: auto; sp. + rcondt{1} 1; 1: auto; rcondt{2} 1; 1: auto; sp; auto. + conseq(:_==> ={bs} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); + 1: by auto. + while(={i, n, x3, bs} /\ 0 <= i{1} <= size_out /\ n{1} = size_out /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). + - by sp; if; auto=> /> => [|+ + + + + + + + + + _|]; smt(domE get_setE size_rcons). + by auto=> />; smt(size_out_gt0). +byequiv=> //=; proc. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; sp; auto. +seq 1 2 : (={glob A, glob OFC, glob OSimulator, Log.m, m1, m2} /\ + inv BIRO.IRO.mp{1} RFList.m{2} /\ + SORO.Bounder.bounder{2} <= Counter.c{1}); last first. ++ sp; case: (increase_counter Counter.c{1} m1{1} size_out <= SHA3Indiff.limit). + - exists * m2{2}, m1{1}, Counter.c{1}; elim* => mess2 mess1 c. + call(titi mess2 (increase_counter c mess1 size_out))=> /=. + by call(titi mess1 c)=> />; auto; smt(). + inline*; sp. + rcondf{1} 1; 1: auto; sp. + conseq(:_==> true); auto. + seq 1 0 : true. + - if{1}; auto; sp; 1: if{1}; auto; sp. + - rcondt{1} 1; auto. + while{1}(true)(n1{1}-i1{1}); auto; -1: smt(). + by sp; if; auto; smt(dbool_ll). + rcondt{1} 1; 1: auto. + while{1}(true)(n2{1}-i2{1}); auto. + by sp; if; auto; smt(dbool_ll). + seq 0 1 : true. + - if{2}; auto; sp; if{2}; auto; sp. + by while{2}(true)(size_out-i{2}); auto; smt(dbool_ll). + sp; if{2}; auto; sp; if{2}; auto; sp. + by while{2}(true)(size_out-i0{2}); auto; smt(dbool_ll). +conseq(:_==> ={glob A, glob OFC, glob OSimulator, Log.m, m1, m2} /\ + inv BIRO.IRO.mp{1} RFList.m{2} /\ SORO.Bounder.bounder{2} <= Counter.c{1}). +auto; call(: ={glob OSimulator, glob Counter, glob Log} /\ + inv BIRO.IRO.mp{1} RFList.m{2} /\ + SORO.Bounder.bounder{2} <= Counter.c{1}); auto; last first. ++ by smt(mem_empty). ++ proc; sp; if; auto=> />; 1: smt(). + inline{1} 1; inline{2} 1; sp; auto. + if; 1, 3: auto; -1: smt(). + if; [1,3:auto]; 2:by move=> /> + + + + + + + + + + + _ + _ /#. + sp; if; [1:by auto=> /> + + <- /> <-]; last first. + - by conseq(:_==> ={y, glob OSimulator}); [2:sim]; auto=> /> + + <- /> <- /#. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + rcondt{2} 1; 1: by auto; smt(). + sp. + seq 3 2 : (={x0, x1, o1, k0, Log.m, suffix, glob OSimulator} /\ + inv BIRO.IRO.mp{1} RFList.m{2} /\ + SORO.Bounder.bounder{2} <= Counter.c{2} + 1); last first. + - by conseq(:_==> ={y, x1, glob OSimulator, Log.m}); 1: smt(); sim=> />. + inline{1} 1; auto. + by call(eq_IRO_RFWhile); auto=> /> + + + <- /> <- /#. ++ by proc; inline*; sp; if; auto; sp; if; auto=> />; smt(). +proc. +inline{1} 1; inline{2} 1; sp; if; auto=> /=. +inline{1} 1; inline{2} 1; sp. +rcondt{1} 1; 1: auto. +inline{1} 1; auto. +rcondf{2} 4; 1: auto. ++ inline*; auto; sp; if; auto; sp; if; auto=> />; conseq(:_==> true); 1: smt(). + by while(true); auto. +inline{2} 1; sp. +rcondt{2} 1; 1: by auto; smt(divz_ge0 gt0_r size_ge0). +auto; call eq_IRO_RFWhile; auto=> />. +move=> &l &r H0 H1 H2 H3 H4 H5 result_L mp_L m_R H6 H7 H8 H9 H10; split; 2: smt(divz_ge0 gt0_r size_ge0). +rewrite cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. +have h:=spec2_dout result_L H6. +have-> := some_oget _ h. +by rewrite eq_sym -to_listK; congr. +qed. + +local lemma rw_ideal &m : + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_CollAdv(A))).main() @ &m : res] <= + Pr[SORO.Collision(SORO_Coll(A),RF(SORO.RO.RO)).main() @ &m : res]. +proof. +rewrite (StdOrder.RealOrder.ler_trans _ _ _ (rw_ideal_2 &m)). +byequiv(: ={glob A} ==> _) => //=; proc; inline*; sp; wp. +seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, + glob Log, mi} /\ RFList.m{1} = SORO.RO.RO.m{2}). ++ call(: ={glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, glob Log} /\ + RFList.m{1} = SORO.RO.RO.m{2}); auto. + - proc; sp; if; 1, 3: auto; sp. + inline *; sp; sim. + if; 1: auto; sim. + if; 1: auto; sim. + sp; if; [3:sim]; [1,3:by auto=> /> + + <- /> <-]. + sp; if; 1: auto; sim; -1: smt(). + sp; if{1}. + * rcondt{2} 2; auto; [1:by auto=> /> + + <- /> <-; smt(BlockSponge.parse_valid)]. + rnd (fun l => oget (of_list l)) to_list; auto=> />. + move=> /> &l &r + <- /> <- /> 6?; split; 1: smt(of_listK). + rewrite -dout_equal_dlist=> ?; split=> ?. + + by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). + move=> sample. + rewrite !get_setE/= dout_full/= => h. + rewrite eq_sym to_listK; apply some_oget. + apply spec2_dout. + by move:h; rewrite supp_dmap; smt(spec_dout). + by auto=> /> + + + <- /> <-; smt(dout_ll). + - by proc; inline*; sp; if; auto; sp; if; auto. + - proc; inline*; sp; if; auto; sp; if; auto; sp; sim. + if{1}. + * rcondt{2} 2; auto. + rnd (fun l => oget (of_list l)) to_list; auto=> />. + move=> &l 4?; split=> ?; 1: smt(of_listK). + rewrite -dout_equal_dlist; split=> ?. + * by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). + move=> sample. + rewrite supp_dmap dout_full/= =>/> a. + by rewrite get_setE/= dout_full/=; congr; rewrite of_listK oget_some. + by auto=> />; smt(dout_ll). +sp. +seq 4 4 : (={SORO.Bounder.bounder, x0, m1, m2, hash1, y0} /\ y0{1} = None /\ + RFList.m{1} = SORO.RO.RO.m{2}); last first. ++ if; 1, 3: auto; sp. + if{1}. + - rcondt{2} 2; 1: auto. + auto; rnd (fun t => oget (of_list t)) to_list; auto=> />. + move=> &l c Hc Hnin; split. + - move=> ret Hret. + by have/= ->:= (to_listK ret (to_list ret)). + move=> h{h}; split. + - move=> ret Hret; rewrite -dout_equal_dlist. + rewrite dmapE /=; apply mu_eq=> //= x /=. + by rewrite /(\o) /pred1/=; smt(to_list_inj). + move=> h{h} l Hl. + rewrite dout_full /=. + have:= spec2_dout l. + have:=supp_dlist dbool size_out l _; 1: smt(size_out_gt0). + rewrite Hl/==> [#] -> h{h} /= H. + have H1:=some_oget _ H. + have:=to_listK (oget (of_list l)) l; rewrite {2}H1/= => -> /= {H H1}. + by rewrite get_setE/=; smt(). + by auto=> />; smt(dout_ll). +if; 1, 3: auto; sp. +if{1}. +- rcondt{2} 2; 1: auto. + auto; rnd (fun t => oget (of_list t)) to_list; auto=> />. + move=> &l c Hc Hnin; split. + - move=> ret Hret. + by have/= ->:= (to_listK ret (to_list ret)). + move=> h{h}; split. + - move=> ret Hret; rewrite -dout_equal_dlist. + rewrite dmapE /=; apply mu_eq=> //= x /=. + by rewrite /(\o) /pred1/=; smt(to_list_inj). + move=> h{h} l Hl. + rewrite dout_full /=. + have:= spec2_dout l. + have:=supp_dlist dbool size_out l _; 1: smt(size_out_gt0). + rewrite Hl/==> [#] -> h{h} /= H. + have H1:=some_oget _ H. + have:=to_listK (oget (of_list l)) l; rewrite {2}H1/= => -> /= {H H1}. + by rewrite get_setE/=; smt(). +by auto=> />; smt(dout_ll). +qed. + +local lemma leq_ideal &m : + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_CollAdv(A))).main() @ &m : res] <= + (sigma * (sigma - 1) + 2)%r / 2%r / 2%r ^ size_out. +proof. +rewrite (StdOrder.RealOrder.ler_trans _ _ _ (rw_ideal &m)). +rewrite (StdOrder.RealOrder.ler_trans _ _ _ (RO_is_collision_resistant (SORO_Coll(A)) &m)). +by rewrite doutE1. +qed. + +local lemma rw_real &m : + Pr[Collision(A, OSponge, PSome(Perm)).main() @ &m : res] = + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(Sponge(Poget(PSome(Perm)))), PSome(Perm), + ODRestr(Dist_of_CollAdv(A))).main() @ &m : res]. +proof. +byequiv=>//=; proc. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; sp; wp=> />. +seq 1 1 : (={glob A, glob Perm, m1, m2} /\ Bounder.bounder{1} = Counter.c{2}). ++ auto; call(: ={glob Perm} /\ Bounder.bounder{1} = Counter.c{2})=> //=. + - by proc; inline*; sp; if; auto; 2:sim=> />; smt(). + - by proc; inline*; sp; if; auto; 2:sim=> />; smt(). + - proc; inline*; sp; if; auto; sp=> />. + by conseq(:_==> ={z0, glob Perm})=> />; sim. +conseq(:_==> ={hash1, hash2, m1, m2})=> //=; 1: smt(); sim. +seq 1 1 : (={m1, m2, hash1, glob Perm} /\ Bounder.bounder{1} = Counter.c{2}); last first. ++ inline*; sp; if; auto; sp=> /=; sim. +inline*; sp; if; auto; swap{1} 9; auto; sp=> /=. +by conseq(:_==> ={m1, m2} /\ of_list (oget (Some (take n{1} z0{1}))) = + of_list (oget (Some (take n{2} z0{2}))) /\ ={Perm.mi, Perm.m})=> //=; sim. +qed. + +lemma Sponge_collision_resistant &m : + (forall (F <: OIndif.ODFUNCTIONALITY) (P <: OIndif.ODPRIMITIVE), + islossless F.f => islossless P.f => islossless P.fi => islossless A(F,P).guess) => + Pr[Collision(A, OSponge, PSome(Perm)).main() @ &m : res] <= + (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + + (4 * limit ^ 2)%r / (2 ^ c)%r + + (sigma * (sigma - 1) + 2)%r / 2%r / 2%r ^ size_out. +proof. +move=> A_ll. +rewrite (rw_real &m). +have := SHA3OIndiff (Dist_of_CollAdv(A)) &m _. ++ move=> F P Hp Hpi Hf; proc; inline*; sp; auto; call Hf; auto; call Hf; auto. + call(A_ll (DFSetSize(F)) P _ Hp Hpi); auto. + proc; inline*; auto; call Hf; auto. +by have/#:=leq_ideal &m. +qed. + +end section Collision. diff --git a/sha3/proof/SHA3Security.ec b/sha3/proof/SHA3Security.ec new file mode 100644 index 0000000..3aedd21 --- /dev/null +++ b/sha3/proof/SHA3Security.ec @@ -0,0 +1,1274 @@ +(* Top-level Proof of SHA-3 Security *) + +require import AllCore Distr DList DBool List IntDiv Dexcepted DProd SmtMap FSet. +require import Common SLCommon Sponge SHA3Indiff. +(*---*) import StdOrder.IntOrder. +require (****) IndifRO_is_secure. + +module SHA3 (P : DPRIMITIVE) = { + proc init() : unit = {} + proc f (bl : bool list, n : int) : bool list = { + var r : bool list; + r <@ Sponge(P).f(bl ++ [false; true], n); + return r; + } +}. + +op size_out : int. +axiom size_out_gt0 : 0 < size_out. + +op sigma : int. +axiom sigma_gt0 : 0 < sigma. + +type f_out. + +op dout : f_out distr. +axiom dout_ll : is_lossless dout. +axiom dout_fu : is_funiform dout. +axiom dout_full : is_full dout. + + +op to_list : f_out -> bool list. +op of_list : bool list -> f_out option. +axiom spec_dout (l : f_out) : size (to_list l) = size_out. +axiom spec2_dout (l : bool list) : size l = size_out => of_list l <> None. +axiom to_list_inj : injective to_list. +axiom to_listK e l : to_list e = l <=> of_list l = Some e. + +axiom dout_equal_dlist : dmap dout to_list = dlist dbool size_out. + +lemma doutE1 x : mu1 dout x = inv (2%r ^ size_out). +proof. +have->:inv (2%r ^ size_out) = mu1 (dlist dbool size_out) (to_list x). ++ rewrite dlist1E. + - smt(size_out_gt0). + rewrite spec_dout/=. + pose p:= StdBigop.Bigreal.BRM.big _ _ _. + have->: p = StdBigop.Bigreal.BRM.big predT (fun _ => inv 2%r) (to_list x). + - rewrite /p =>{p}. + apply StdBigop.Bigreal.BRM.eq_bigr. + by move=> i; rewrite//= dbool1E. + rewrite StdBigop.Bigreal.BRM.big_const count_predT spec_dout=> {p}. + have:=size_out_gt0; move/ltzW. + move:size_out;apply intind=> //=. + - by rewrite RField.expr0 iter0 //= fromint1. + move=> i hi0 rec. + by rewrite RField.exprS //iterS// -rec; smt(). +rewrite -dout_equal_dlist dmap1E. +apply mu_eq. +by move=> l; rewrite /pred1/(\o); smt(to_listK). +qed. + +module CSetSize (F : CONSTRUCTION) (P : DPRIMITIVE) = { + proc init = F(P).init + proc f (x : bool list) = { + var r; + r <@ F(P).f(x,size_out); + return oget (of_list r); + } +}. + +module FSetSize (F : FUNCTIONALITY) = { + proc init = F.init + proc f (x : bool list) = { + var r; + r <@ F.f(x,size_out); + return oget (of_list r); + } +}. + +clone import IndifRO_is_secure as S with + type block <- block * capacity, + type f_in <- bool list, + type f_out <- f_out, + + op sampleto <- dout, + op bound <- (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + + (4 * limit ^ 2)%r / (2 ^ c)%r, + op limit <- sigma, + op bound_counter <- limit, + op increase_counter <- fun c m => c + ((size m + 1) %/ r + 1) + + max ((size_out + r - 1) %/ r - 1) 0 + + proof *. + + +realize bound_counter_ge0 by exact(SLCommon.max_ge0). +realize limit_gt0 by exact(sigma_gt0). +realize sampleto_ll by exact(dout_ll). +realize sampleto_fu by exact(dout_fu). +realize sampleto_full by exact(dout_full). +realize increase_counter_spec by smt(List.size_ge0 divz_ge0 gt0_r). + +module FGetSize (F : Indiff0.DFUNCTIONALITY) = { + proc f (x : bool list, i : int) = { + var r; + r <@ F.f(x); + return to_list r; + } +}. + +module SimSetSize (S : SIMULATOR) (F : Indiff0.DFUNCTIONALITY) = S(FGetSize(F)). + +module DFSetSize (F : DFUNCTIONALITY) = { + proc f (x : bool list) = { + var r; + r <@ F.f(x,size_out); + return oget (of_list r); + } +}. + +module (DSetSize (D : Indiff0.DISTINGUISHER) : DISTINGUISHER) + (F : DFUNCTIONALITY) (P : DPRIMITIVE) = D(DFSetSize(F),P). + + +section Preimage. + + declare module A <: SRO.AdvPreimage {-SRO.RO.RO, -SRO.RO.FRO, -SRO.Bounder, -Perm, -Gconcl_list.BIRO2.IRO, -Simulator, -Cntr, -BIRO.IRO, -F.RO, -F.FRO, -Redo, -C, -Gconcl.S, -BlockSponge.BIRO.IRO, -BlockSponge.C, -Gconcl_list.F2.RO, -Gconcl_list.F2.FRO, -Gconcl_list.Simulator, -DPre}. + + declare axiom A_ll (F <: SRO.Oracle {-A}) : islossless F.get => islossless A(F).guess. + + local lemma invm_dom_rng (m mi : (state, state) fmap) : + invm m mi => dom m = rng mi. + proof. + move=>h; rewrite fun_ext=> x; rewrite domE rngE /= eq_iff; have h2 := h x; split. + + move=> m_x_not_None; exists (oget m.[x]); rewrite -h2; move: m_x_not_None. + by case: (m.[x]). + by move=> [] a; rewrite -h2 => ->. + qed. + + local lemma invmC' (m mi : (state, state) fmap) : + invm m mi => invm mi m. + proof. by rewrite /#. qed. + + local lemma invmC (m mi : (state, state) fmap) : + invm m mi <=> invm mi m. + proof. by split;exact invmC'. qed. + + local lemma useful m mi a : + Prefix.invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). + proof. + move=>hinvm nin_dom. + have prod_ll:Distr.is_lossless (bdistr `*` cdistr). + + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. + apply dexcepted_ll=>//=;rewrite-prod_ll. + have->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. + rewrite Distr.mu_disjoint 1:predCI//=RField.addrC. + have/=->:=StdOrder.RealOrder.ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. + rewrite Distr.witness_support/predC. + move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. + have{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + move:a. + have:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. + have->//=:fdom m \subset frng m. + + by move=> x; rewrite mem_fdom mem_frng hyp. + smt(mem_fdom mem_frng). + qed. + + + local equiv equiv_sponge_perm c m : + FInit(CSetSize(Sponge, Perm)).get ~ FInit(DFSetSize(FC(Sponge(Perm)))).get : + ={arg, glob Perm} /\ invm Perm.m{1} Perm.mi{1} /\ + Cntr.c{2} = c /\ arg{2} = m /\ + (Cntr.c + ((size arg + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0 <= limit){2} ==> + ={res, glob Perm} /\ invm Perm.m{1} Perm.mi{1} /\ + Cntr.c{2} = c + ((size m + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0. + proof. + proc; inline FC(Sponge(Perm)).f; sp. + rcondt{2} 1; auto; sp. + call(: ={glob Perm} /\ invm Perm.m{1} Perm.mi{1})=>/=; auto; inline*. + while(={i, n, sa, sc, z, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + + sp; if; auto; sp; if; auto; progress. + rewrite invm_set //=. + by move:H4; rewrite supp_dexcepted. + sp; conseq(:_==> ={i, n, sa, sc, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + while(={xs, sa, sc, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + sp; if; auto; progress. + rewrite invm_set=>//=. + by move:H4; rewrite supp_dexcepted. + qed. + + + op same_ro (m1 : (bool list, f_out) fmap) (m2 : (bool list * int, bool) fmap) = + (forall m, m \in m1 => forall i, 0 <= i < size_out => (m,i) \in m2) + && (forall m, (exists i, 0 <= i < size_out /\ (m,i) \in m2) => m \in m1) + && (forall m, m \in m1 => to_list (oget m1.[m]) = map (fun i => oget m2.[(m,i)]) (range 0 size_out)). + + op same_ro2 (m1 : (bool list, bool list) fmap) (m2 : (bool list * int, bool) fmap) = + (forall m, m \in m1 => forall i, 0 <= i < size_out => (m,i) \in m2) + && (forall m, (exists i, 0 <= i < size_out /\ (m,i) \in m2) => m \in m1) + && (forall m, m \in m1 => oget m1.[m] = map (fun i => oget m2.[(m,i)]) (range 0 size_out)). + + clone import Program as Prog with + type t <- bool, + op d <- dbool + proof *. + + local equiv equiv_ro_iro c m : + FInit(RO).get ~ FInit(DFSetSize(FC(BIRO.IRO))).get : + ={arg} /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ + arg{2} = m /\ Cntr.c{2} = c /\ + (Cntr.c + ((size arg + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0 <= limit){2} + ==> ={res} /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ + Cntr.c{2} = c + ((size m + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0. + proof. + proc; inline *; sp; rcondt{2} 1; 1: auto. + swap{2} 1 5; sp; wp 2 1. + conseq(:_==> oget SRO.RO.RO.m{1}.[x{1}] = oget (of_list bs0{2}) /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); 1:by auto. + rcondt{2} 1; 1: auto. + case: (x{1} \in SRO.RO.RO.m{1}). + + rcondf{1} 2; auto. + exists* BIRO.IRO.mp{2}; elim* => mp. + while{2}(bs0{2} = map (fun j => oget BIRO.IRO.mp{2}.[(x0{2},j)]) (range 0 i{2}) + /\ n0{2} = size_out /\ x0{2} \in SRO.RO.RO.m{1} /\ 0 <= i{2} <= size_out + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ BIRO.IRO.mp{2} = mp) + (size_out - i{2}); auto. + - sp; rcondf 1; auto; 1: smt(). + progress. + * have/=<-:= map_rcons (fun (j : int) => oget BIRO.IRO.mp{hr}.[(x0{hr}, j)]) (range 0 i{hr}) i{hr}. + by rewrite !rangeSr //=. + * smt(). + * smt(). + * smt(). + progress. + - by rewrite range_geq. + - smt(size_out_gt0). + - smt(). + - exact(dout_ll). + - have[] h[#] h1 h2 := H. + have->:i_R = size_out by smt(). + have<-:=h2 _ H3. + smt(to_listK). + rcondt{1} 2; 1: auto; wp =>/=. + exists* BIRO.IRO.mp{2}; elim* => mp. + conseq(:_==> + same_ro SRO.RO.RO.m{1} mp /\ i{2} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} (to_list r{1}) = bs0{2} /\ + take i{2} (to_list r{1}) = map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress=>//=. + + by rewrite get_set_sameE /=; smt(to_listK take_oversize spec_dout). + + move:H8; rewrite mem_set=>[][]//=h; 1:rewrite H3=>//=. + - by have []h1 []h2 h3:= H2; have->//:=h1 _ h. + by move:h => <<-; rewrite H6 //=. + + rewrite mem_set//=; have[]//=h:= H5 _ _ H11; left. + have []h1 []->//=:= H2. + by exists i0=>//=. + + move:H7; rewrite take_oversize 1:spec_dout//= => H7. + move:H10; rewrite mem_set. + case(m \in SRO.RO.RO.m{1})=>//=h. + - rewrite get_set_neqE; 1:smt(). + have []h1 []h2 ->//=:= H2. + by apply eq_in_map=> j;rewrite mem_range=>[][]hj1 hj2/=; rewrite H4//=h1//=. + by move=><<-; rewrite get_set_eqE//=. + alias{1} 1 l = [<:bool>]. + transitivity {1} { + l <@ Sample.sample(size_out); + r <- oget (of_list l); + } + (={glob SRO.RO.RO, x} ==> ={glob SRO.RO.RO, r}) + (x{1} = x0{2} /\ i{2} = 0 /\ n0{2} = size_out /\ mp = BIRO.IRO.mp{2} /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ x{1} \notin SRO.RO.RO.m{1} /\ + bs0{2} = [] + ==> + same_ro SRO.RO.RO.m{1} mp /\ i{2} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} (to_list r{1}) = bs0{2} /\ + take i{2} (to_list r{1}) = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + smt(). + + inline*; sp; wp. + rnd to_list (fun x => oget (of_list x)); auto; progress. + - smt(spec_dout supp_dlist to_listK spec2_dout size_out_gt0). + - rewrite -dout_equal_dlist dmap1E; apply mu_eq=> x/=. + smt(to_listK). + - rewrite-dout_equal_dlist supp_dmap; smt(dout_full). + smt(to_listK). + wp=>/=. + conseq(:_==> i{2} = size_out /\ size l{1} = size_out /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in mp => (l0, j) \in BIRO.IRO.mp{2}) /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in mp => BIRO.IRO.mp{2}.[(l0, j)] = mp.[(l0, j)]) /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in BIRO.IRO.mp{2} => ((l0, j) \in mp) \/ (l0 = x0{2} /\ 0 <= j < i{2})) /\ + (forall (j : int), 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + take i{2} l{1} = bs0{2} /\ + take i{2} l{1} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + have[]//=h h1:=to_listK (oget (of_list l_L)) l_L; rewrite h1//==> {h1 h}. + smt(spec2_dout). + + have[]//=h h1:=to_listK (oget (of_list l_L)) l_L; rewrite h1//==> {h1 h}. + smt(spec2_dout). + transitivity{1} { + l <@ LoopSnoc.sample(size_out); + } + (={glob SRO.RO.RO} ==> ={glob SRO.RO.RO, l}) + (x{1} = x0{2} /\ i{2} = 0 /\ n0{2} = size_out /\ mp = BIRO.IRO.mp{2} /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ x0{2} \notin SRO.RO.RO.m{1} /\ + bs0{2} = [] + ==> + i{2} = size_out /\ size l{1} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} l{1} = bs0{2} /\ + take i{2} l{1} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + smt(). + + by call Sample_LoopSnoc_eq; auto. + inline*; sp; wp. + conseq(:_==> i{2} = size_out /\ size l0{1} = i{2} /\ + same_ro SRO.RO.RO.m{1} mp /\ x0{2} \notin SRO.RO.RO.m{1} /\ + (forall l j, (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall l j, (l,j) \in mp => BIRO.IRO.mp{2}.[(l, j)] = mp.[(l, j)]) /\ + (forall l j, (l, j) \in BIRO.IRO.mp{2} => ((l, j) \in mp) \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + l0{1} = bs0{2} /\ bs0{2} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress. + + smt(take_oversize). + + smt(take_oversize). + while(0 <= i{2} <= size_out /\ size l0{1} = i{2} /\ n0{2} = size_out /\ + ={i} /\ n{1} = n0{2} /\ + same_ro SRO.RO.RO.m{1} mp /\ x0{2} \notin SRO.RO.RO.m{1} /\ + (forall l j, (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall l j, (l,j) \in mp => BIRO.IRO.mp{2}.[(l, j)] = mp.[(l, j)]) /\ + (forall l j, (l, j) \in BIRO.IRO.mp{2} => ((l, j) \in mp) \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + l0{1} = bs0{2} /\ bs0{2} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})). + + sp; wp=> //=. + rcondt{2} 1; 1:auto; progress. + - have[]h1 [] h2 h3 := H1. + have:=h2 x0{hr}; rewrite H2/= negb_exists/= =>/(_ (size bs0{hr})). + rewrite size_ge0 H9/=; apply absurd =>/= h. + by have //=:= H5 _ _ h. + wp; rnd; auto; progress. + - smt(size_ge0). + - smt(). + - by rewrite size_cat/=. + - by rewrite mem_set; left; rewrite H3. + - rewrite get_setE (H4 _ _ H11). + have/#: !(l1, j) = (x0{2}, size bs0{2}). + move:H2; apply absurd=> //=[#] <<- ->>. + have[] h1 [] h2 h3 := H1. + by apply h2; smt(). + - move:H11; rewrite mem_set. + case((l1, j) \in BIRO.IRO.mp{2})=>//= h; 1: smt(). + by move=> [#] <<- ->> //=; rewrite size_ge0; smt(). + - rewrite mem_set. + case(j = size bs0{2})=>//=. + move=> h; rewrite h /=; have {H12} H13 {h} : j < size bs0{2} by smt(). + by apply H6. + - by rewrite cats1 get_set_sameE oget_some. + - rewrite get_set_sameE oget_some H7 rangeSr. + rewrite !size_map 1:size_ge0. + rewrite (size_map _ (range 0 (size bs0{2}))) size_range /=. + rewrite ler_maxr 1:size_ge0 map_rcons /=get_set_sameE oget_some; congr. + apply eq_in_map=> j. + rewrite mem_range /==> [] [] hj1 hj2. + by rewrite get_set_neqE //=; smt(). + auto; progress. + + smt(size_out_gt0). + + smt(). + + smt(). + + by rewrite range_geq. + smt(). + qed. + + lemma Sponge_preimage_resistant &m ha : + (DPre.h{m} = ha) => + Pr[SRO.Preimage(A, FM(CSetSize(Sponge), Perm)).main(ha) @ &m : res] <= + (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + + (4 * limit ^ 2)%r / (2 ^ c)%r + + (sigma + 1)%r / (2%r ^ size_out). + proof. + move=>init_ha. + rewrite -(doutE1 ha). + rewrite(preimage_resistant_if_indifferentiable A A_ll (CSetSize(Sponge)) Perm &m ha init_ha). + exists (SimSetSize(Simulator))=>//=; split. + + by move=> F _; proc; inline*; auto. + have->//:Pr[Indiff0.Indif(CSetSize(Sponge, Perm), Perm, DPre(A)).main() @ &m : res] = + Pr[RealIndif(Sponge, Perm, DRestr(DSetSize(DPre(A)))).main() @ &m : res]. + + byequiv=>//=; proc. + inline DPre(A, CSetSize(Sponge, Perm), Perm).distinguish. + inline SRO.Preimage(A, FInit(CSetSize(Sponge, Perm))).main. + inline DRestr(DSetSize(DPre(A)), Sponge(Perm), Perm).distinguish + DSetSize(DPre(A), FC(Sponge(Perm)), PC(Perm)).distinguish + SRO.Preimage(A, FInit(DFSetSize(FC(Sponge(Perm))))).main. + inline Perm.init CSetSize(Sponge, Perm).init Sponge(Perm).init + FC(Sponge(Perm)).init SRO.Counter.init Cntr.init + SRO.Bounder(FInit(CSetSize(Sponge, Perm))).init + SRO.Bounder(FInit(DFSetSize(FC(Sponge(Perm))))).init + FInit(CSetSize(Sponge, Perm)).init + FInit(DFSetSize(FC(Sponge(Perm)))).init; sp. + wp; sp; sim. + seq 1 1 : (={m, hash, glob DPre, glob SRO.Counter, glob Perm} + /\ invm Perm.m{1} Perm.mi{1} /\ DPre.h{1} = ha + /\ ={c}(SRO.Counter,Cntr)); last first. + - if; auto; sp. + exists* m{1}, SRO.Counter.c{1}; elim* => mess c. + by call(equiv_sponge_perm c mess); auto; smt(). + call(: ={glob SRO.Counter, glob Perm, glob DPre, glob SRO.Bounder} + /\ DPre.h{1} = ha + /\ invm Perm.m{1} Perm.mi{1} /\ ={c}(SRO.Counter,Cntr)). + + proc; sp; if; auto; sp; if; auto; sp. + exists * x{1}; elim* => m c1 c2 b1 b2. + by call(equiv_sponge_perm c1 m); auto; smt(). + auto; progress. + by rewrite /invm=> x y; rewrite 2!emptyE. + have->//:Pr[Indiff0.Indif(RO, SimSetSize(Simulator, RO), DPre(A)).main() @ &m : res] = + Pr[IdealIndif(BIRO.IRO, Simulator, DRestr(DSetSize(DPre(A)))).main() @ &m : res]. + + byequiv=>//=; proc. + inline Simulator(FGetSize(RO)).init RO.init Simulator(BIRO.IRO).init + BIRO.IRO.init Gconcl_list.BIRO2.IRO.init; sp. + inline DPre(A, RO, Simulator(FGetSize(RO))).distinguish. + inline DRestr(DSetSize(DPre(A)), BIRO.IRO, Simulator(BIRO.IRO)).distinguish + DSetSize(DPre(A), FC(BIRO.IRO), PC(Simulator(BIRO.IRO))).distinguish; wp; sim. + inline SRO.Bounder(FInit(DFSetSize(FC(BIRO.IRO)))).init + SRO.Bounder(FInit(RO)).init SRO.Counter.init FInit(RO).init + FInit(DFSetSize(FC(BIRO.IRO))).init Cntr.init; sp. + inline SRO.Preimage(A, FInit(RO)).main + SRO.Preimage(A, FInit(DFSetSize(FC(BIRO.IRO)))).main. + inline SRO.Counter.init SRO.Bounder(FInit(RO)).init + SRO.Bounder(FInit(DFSetSize(FC(BIRO.IRO)))).init + FInit(RO).init FInit(DFSetSize(FC(BIRO.IRO))).init ; sp; sim. + seq 1 1 : (={m, glob SRO.Counter, glob DPre, hash} + /\ ={c}(SRO.Counter,Cntr) /\ DPre.h{1} = hash{1} + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); last first. + - if; auto; sp. + exists * m{1}, SRO.Counter.c{1}; elim* => mess c. + by call(equiv_ro_iro c mess); auto; smt(). + conseq(:_==> ={m, glob SRO.Counter, glob SRO.Bounder, glob DPre} + /\ ={c}(SRO.Counter,Cntr) + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); progress. + call(: ={glob SRO.Counter, glob SRO.Bounder, glob DPre} + /\ ={c}(SRO.Counter,Cntr) + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); auto. + + proc; sp; if; auto; sp; if; auto; sp. + exists* x{1}; elim* => a c1 c2 b1 b2. + call(equiv_ro_iro c1 a); auto; smt(). + smt(mem_empty). + have->//=:= SHA3Indiff (DSetSize(DPre(A))) &m _. + move=> F P P_f_ll P_fi_ll F_ll; proc; inline*; auto; sp; auto. + seq 1 : true; auto. + + call (A_ll (SRO.Bounder(FInit(DFSetSize(F)))) _); auto. + by proc; inline*; sp; if; auto; sp; if; auto; sp; call F_ll; auto. + if; auto; sp. + by call F_ll; auto. + qed. + +end section Preimage. + + + +section SecondPreimage. + + declare module A <: SRO.AdvSecondPreimage {-SRO.RO.RO, -SRO.RO.FRO, -SRO.Bounder, -Perm, -Gconcl_list.BIRO2.IRO, -Simulator, -Cntr, -BIRO.IRO, -F.RO, -F.FRO, -Redo, -C, -Gconcl.S, -BlockSponge.BIRO.IRO, -BlockSponge.C, -Gconcl_list.F2.RO, -Gconcl_list.F2.FRO, -Gconcl_list.Simulator, -D2Pre}. + + declare axiom A_ll (F <: SRO.Oracle {-A}) : islossless F.get => islossless A(F).guess. + + local lemma invm_dom_rng (m mi : (state, state) fmap) : + invm m mi => dom m = rng mi. + proof. + move=>h; rewrite fun_ext=> x; rewrite domE rngE /= eq_iff; have h2 := h x; split. + + move=> m_x_not_None; exists (oget m.[x]); rewrite -h2; move: m_x_not_None. + by case: (m.[x]). + by move=> [] a; rewrite -h2 => ->. + qed. + + local lemma invmC' (m mi : (state, state) fmap) : + invm m mi => invm mi m. + proof. by rewrite /#. qed. + + local lemma invmC (m mi : (state, state) fmap) : + invm m mi <=> invm mi m. + proof. by split;exact invmC'. qed. + + local lemma useful m mi a : + Prefix.invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). + proof. + move=>hinvm nin_dom. + have prod_ll:Distr.is_lossless (bdistr `*` cdistr). + + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. + apply dexcepted_ll=>//=;rewrite-prod_ll. + have->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. + rewrite Distr.mu_disjoint 1:predCI//=RField.addrC. + have/=->:=StdOrder.RealOrder.ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. + rewrite Distr.witness_support/predC. + move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. + have{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + move:a. + have:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. + have->//=:fdom m \subset frng m. + + by move=> x; rewrite mem_fdom mem_frng hyp. + smt(mem_fdom mem_frng). + qed. + + + local equiv equiv_sponge_perm c m : + FInit(CSetSize(Sponge, Perm)).get ~ FInit(DFSetSize(FC(Sponge(Perm)))).get : + ={arg, glob Perm} /\ invm Perm.m{1} Perm.mi{1} /\ + Cntr.c{2} = c /\ arg{2} = m /\ + (Cntr.c + ((size arg + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0 <= limit){2} ==> + ={res, glob Perm} /\ invm Perm.m{1} Perm.mi{1} /\ + Cntr.c{2} = c + ((size m + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0. + proof. + proc; inline FC(Sponge(Perm)).f; sp. + rcondt{2} 1; auto; sp. + call(: ={glob Perm} /\ invm Perm.m{1} Perm.mi{1})=>/=; auto; inline*. + while(={i, n, sa, sc, z, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + + sp; if; auto; sp; if; auto; progress. + rewrite invm_set //=. + by move:H4; rewrite supp_dexcepted. + sp; conseq(:_==> ={i, n, sa, sc, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + while(={xs, sa, sc, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + sp; if; auto; progress. + rewrite invm_set=>//=. + by move:H4; rewrite supp_dexcepted. + qed. + + + clone import Program as Prog2 with + type t <- bool, + op d <- dbool + proof *. + + local equiv equiv_ro_iro c m : + FInit(RO).get ~ FInit(DFSetSize(FC(BIRO.IRO))).get : + ={arg} /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ + arg{2} = m /\ Cntr.c{2} = c /\ + (Cntr.c + ((size arg + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0 <= limit){2} + ==> ={res} /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ + Cntr.c{2} = c + ((size m + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0. + proof. + proc; inline *; sp; rcondt{2} 1; 1: auto. + swap{2} 1 5; sp; wp 2 1. + conseq(:_==> oget SRO.RO.RO.m{1}.[x{1}] = oget (of_list bs0{2}) /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); 1:by auto. + rcondt{2} 1; 1: auto. + case: (x{1} \in SRO.RO.RO.m{1}). + + rcondf{1} 2; auto. + exists* BIRO.IRO.mp{2}; elim* => mp. + while{2}(bs0{2} = map (fun j => oget BIRO.IRO.mp{2}.[(x0{2},j)]) (range 0 i{2}) + /\ n0{2} = size_out /\ x0{2} \in SRO.RO.RO.m{1} /\ 0 <= i{2} <= size_out + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ BIRO.IRO.mp{2} = mp) + (size_out - i{2}); auto. + - sp; rcondf 1; auto; 1: smt(). + progress. + * have/=<-:= map_rcons (fun (j : int) => oget BIRO.IRO.mp{hr}.[(x0{hr}, j)]) (range 0 i{hr}) i{hr}. + by rewrite !rangeSr //=. + * smt(). + * smt(). + * smt(). + progress. + - by rewrite range_geq. + - smt(size_out_gt0). + - smt(). + - exact(dout_ll). + - have[] h[#] h1 h2 := H. + have->:i_R = size_out by smt(). + have<-:=h2 _ H3. + smt(to_listK). + rcondt{1} 2; 1: auto; wp =>/=. + exists* BIRO.IRO.mp{2}; elim* => mp. + conseq(:_==> + same_ro SRO.RO.RO.m{1} mp /\ i{2} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} (to_list r{1}) = bs0{2} /\ + take i{2} (to_list r{1}) = map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress=>//=. + + by rewrite get_set_sameE /=; smt(to_listK take_oversize spec_dout). + + move:H8; rewrite mem_set=>[][]//=h; 1:rewrite H3=>//=. + - by have []h1 []h2 h3:= H2; have->//:=h1 _ h. + by move:h => <<-; rewrite H6 //=. + + rewrite mem_set//=; have[]//=h:= H5 _ _ H11; left. + have []h1 []->//=:= H2. + by exists i0=>//=. + + move:H7; rewrite take_oversize 1:spec_dout//= => H7. + move:H10; rewrite mem_set. + case(m \in SRO.RO.RO.m{1})=>//=h. + - rewrite get_set_neqE; 1:smt(). + have []h1 []h2 ->//=:= H2. + by apply eq_in_map=> j;rewrite mem_range=>[][]hj1 hj2/=; rewrite H4//=h1//=. + by move=><<-; rewrite get_set_eqE//=. + alias{1} 1 l = [<:bool>]. + transitivity {1} { + l <@ Sample.sample(size_out); + r <- oget (of_list l); + } + (={glob SRO.RO.RO, x} ==> ={glob SRO.RO.RO, r}) + (x{1} = x0{2} /\ i{2} = 0 /\ n0{2} = size_out /\ mp = BIRO.IRO.mp{2} /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ x{1} \notin SRO.RO.RO.m{1} /\ + bs0{2} = [] + ==> + same_ro SRO.RO.RO.m{1} mp /\ i{2} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} (to_list r{1}) = bs0{2} /\ + take i{2} (to_list r{1}) = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + smt(). + + inline*; sp; wp. + rnd to_list (fun x => oget (of_list x)); auto; progress. + - smt(spec_dout supp_dlist to_listK spec2_dout size_out_gt0). + - rewrite -dout_equal_dlist dmap1E; apply mu_eq=> x/=. + smt(to_listK). + - rewrite-dout_equal_dlist supp_dmap; smt(dout_full). + smt(to_listK). + wp=>/=. + conseq(:_==> i{2} = size_out /\ size l{1} = size_out /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in mp => (l0, j) \in BIRO.IRO.mp{2}) /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in mp => BIRO.IRO.mp{2}.[(l0, j)] = mp.[(l0, j)]) /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in BIRO.IRO.mp{2} => ((l0, j) \in mp) \/ (l0 = x0{2} /\ 0 <= j < i{2})) /\ + (forall (j : int), 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + take i{2} l{1} = bs0{2} /\ + take i{2} l{1} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + have[]//=h h1:=to_listK (oget (of_list l_L)) l_L; rewrite h1//==> {h1 h}. + smt(spec2_dout). + + have[]//=h h1:=to_listK (oget (of_list l_L)) l_L; rewrite h1//==> {h1 h}. + smt(spec2_dout). + transitivity{1} { + l <@ LoopSnoc.sample(size_out); + } + (={glob SRO.RO.RO} ==> ={glob SRO.RO.RO, l}) + (x{1} = x0{2} /\ i{2} = 0 /\ n0{2} = size_out /\ mp = BIRO.IRO.mp{2} /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ x0{2} \notin SRO.RO.RO.m{1} /\ + bs0{2} = [] + ==> + i{2} = size_out /\ size l{1} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} l{1} = bs0{2} /\ + take i{2} l{1} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + smt(). + + by call Sample_LoopSnoc_eq; auto. + inline*; sp; wp. + conseq(:_==> i{2} = size_out /\ size l0{1} = i{2} /\ + same_ro SRO.RO.RO.m{1} mp /\ x0{2} \notin SRO.RO.RO.m{1} /\ + (forall l j, (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall l j, (l,j) \in mp => BIRO.IRO.mp{2}.[(l, j)] = mp.[(l, j)]) /\ + (forall l j, (l, j) \in BIRO.IRO.mp{2} => ((l, j) \in mp) \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + l0{1} = bs0{2} /\ bs0{2} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress. + + smt(take_oversize). + + smt(take_oversize). + while(0 <= i{2} <= size_out /\ size l0{1} = i{2} /\ n0{2} = size_out /\ + ={i} /\ n{1} = n0{2} /\ + same_ro SRO.RO.RO.m{1} mp /\ x0{2} \notin SRO.RO.RO.m{1} /\ + (forall l j, (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall l j, (l,j) \in mp => BIRO.IRO.mp{2}.[(l, j)] = mp.[(l, j)]) /\ + (forall l j, (l, j) \in BIRO.IRO.mp{2} => ((l, j) \in mp) \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + l0{1} = bs0{2} /\ bs0{2} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})). + + sp; wp=> //=. + rcondt{2} 1; 1:auto; progress. + - have[]h1 [] h2 h3 := H1. + have:=h2 x0{hr}; rewrite H2/= negb_exists/= =>/(_ (size bs0{hr})). + rewrite size_ge0 H9/=; apply absurd =>/= h. + by have //=:= H5 _ _ h. + wp; rnd; auto; progress. + - smt(size_ge0). + - smt(). + - by rewrite size_cat/=. + - by rewrite mem_set; left; rewrite H3. + - rewrite get_setE (H4 _ _ H11). + have/#: !(l1, j) = (x0{2}, size bs0{2}). + move:H2; apply absurd=> //=[#] <<- ->>. + have[] h1 [] h2 h3 := H1. + by apply h2; smt(). + - move:H11; rewrite mem_set. + case((l1, j) \in BIRO.IRO.mp{2})=>//= h; 1: smt(). + by move=> [#] <<- ->> //=; rewrite size_ge0; smt(). + - rewrite mem_set. + case(j = size bs0{2})=>//=. + move=> h; rewrite h /=; have {H12} H12 {h} : j < size bs0{2} by smt(). + by apply H6. + - by rewrite cats1 get_set_sameE oget_some. + - rewrite get_set_sameE oget_some H7 rangeSr. + rewrite !size_map 1:size_ge0. + rewrite (size_map _ (range 0 (size bs0{2}))) size_range /=. + rewrite ler_maxr 1:size_ge0 map_rcons /=get_set_sameE oget_some; congr. + apply eq_in_map=> j. + rewrite mem_range /==> [] [] hj1 hj2. + by rewrite get_set_neqE //=; smt(). + auto; progress. + + smt(size_out_gt0). + + smt(). + + smt(). + + by rewrite range_geq. + smt(). + qed. + + lemma Sponge_second_preimage_resistant &m mess : + (D2Pre.m2{m} = mess) => + Pr[SRO.SecondPreimage(A, FM(CSetSize(Sponge), Perm)).main(mess) @ &m : res] <= + (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + + (4 * limit ^ 2)%r / (2 ^ c)%r + + (sigma + 1)%r / (2%r ^ size_out). + proof. + move=> init_mess. + rewrite -(doutE1 witness). + rewrite(second_preimage_resistant_if_indifferentiable A A_ll (CSetSize(Sponge)) Perm &m mess init_mess). + exists (SimSetSize(Simulator)); split. + + by move=> F _; proc; inline*; auto. + have->:Pr[Indiff0.Indif(CSetSize(Sponge, Perm), Perm, D2Pre(A)).main() @ &m : res] = + Pr[RealIndif(Sponge, Perm, DRestr(DSetSize(D2Pre(A)))).main() @ &m : res]. + + byequiv=>//=; proc. + inline Perm.init CSetSize(Sponge, Perm).init Sponge(Perm).init + FC(Sponge(Perm)).init; sp. + inline D2Pre(A, CSetSize(Sponge, Perm), Perm).distinguish. + inline DRestr(DSetSize(D2Pre(A)), Sponge(Perm), Perm).distinguish + DSetSize(D2Pre(A), FC(Sponge(Perm)), PC(Perm)).distinguish Cntr.init. + inline SRO.SecondPreimage(A, FInit(CSetSize(Sponge, Perm))).main + SRO.SecondPreimage(A, FInit(DFSetSize(FC(Sponge(Perm))))).main. + inline SRO.Bounder(FInit(CSetSize(Sponge, Perm))).init + SRO.Bounder(FInit(DFSetSize(FC(Sponge(Perm))))).init + SRO.Counter.init FInit(DFSetSize(FC(Sponge(Perm)))).init + FInit(CSetSize(Sponge, Perm)).init. + wp; sp; sim. + seq 1 1 : (={m1, m2, glob SRO.Counter, glob Perm} + /\ invm Perm.m{1} Perm.mi{1} + /\ ={c}(SRO.Counter,Cntr)); last first. + - if; auto; sp. + case(SRO.Counter.c{1} + ((size m2{1} + 1) %/ r + 1) + + max ((size_out + r - 1) %/ r - 1) 0 < limit); last first. + * rcondf{1} 2; 1: by auto; inline*; auto; conseq(: _ ==> true); auto. + rcondf{2} 2; 1: by auto; inline*; auto; conseq(: _ ==> true); auto. + auto; inline*; auto; sp; conseq(: _ ==> true); auto. + if{2}; sp; auto; sim. + while{1}(invm Perm.m{1} Perm.mi{1}) (((size_out + r - 1) %/ r)-i{1}). + + auto; sp; if; auto. + - sp; if ;auto; progress. + * exact (useful _ _ _ H H2). + * rewrite invm_set=>//=. + by move:H4; rewrite supp_dexcepted. + * smt(). + smt(). + smt(). + conseq(:_==> invm Perm.m{1} Perm.mi{1}); 1:smt(). + while{1}(invm Perm.m{1} Perm.mi{1})(size xs{1}). + + move=> _ z; auto; sp; if; auto; progress. + * exact (useful _ _ _ H H1). + * rewrite invm_set=>//=. + by move:H3; rewrite supp_dexcepted. + * smt(). + smt(). + auto; smt(size_ge0 size_eq0). + rcondt{1} 2; first by auto; inline*; auto; conseq(:_==> true); auto. + rcondt{2} 2; first by auto; inline*; auto; conseq(:_==> true); auto. + sim. + exists* m1{1}, m2{1}; elim* => a1 a2 c1 c2. + call (equiv_sponge_perm (c2 + ((size a1 + 1) %/ r + 1) + max ((size_out + r - 1) %/ r - 1) 0) a2). + auto; call (equiv_sponge_perm c2 a1); auto; progress. + smt(List.size_ge0 divz_ge0 gt0_r). + smt(List.size_ge0 divz_ge0 gt0_r). + call(: ={glob SRO.Counter, glob Perm, glob SRO.Bounder} + /\ invm Perm.m{1} Perm.mi{1} /\ ={c}(SRO.Counter,Cntr)). + + proc; sp; if; auto; sp; if; auto; sp. + exists * x{1}; elim* => m c1 c2 b1 b2. + by call(equiv_sponge_perm c1 m); auto; smt(). + inline*; auto; progress. + by rewrite /invm=> x y; rewrite 2!emptyE. + have->:Pr[Indiff0.Indif(RO, SimSetSize(Simulator, RO), D2Pre(A)).main() @ &m : res] = + Pr[IdealIndif(BIRO.IRO, Simulator, DRestr(DSetSize(D2Pre(A)))).main() @ &m : res]. + + byequiv=>//=; proc. + inline Simulator(FGetSize(RO)).init RO.init Simulator(BIRO.IRO).init + BIRO.IRO.init Gconcl_list.BIRO2.IRO.init; sp. + inline D2Pre(A, RO, Simulator(FGetSize(RO))).distinguish. + inline DRestr(DSetSize(D2Pre(A)), BIRO.IRO, Simulator(BIRO.IRO)).distinguish + DSetSize(D2Pre(A), FC(BIRO.IRO), PC(Simulator(BIRO.IRO))).distinguish; wp; sim. + inline SRO.Bounder(FInit(DFSetSize(FC(BIRO.IRO)))).init + SRO.Bounder(FInit(RO)).init SRO.Counter.init FInit(RO).init + FInit(DFSetSize(FC(BIRO.IRO))).init Cntr.init; sp. + inline SRO.SecondPreimage(A, FInit(RO)).main + SRO.SecondPreimage(A, FInit(DFSetSize(FC(BIRO.IRO)))).main. + inline SRO.Bounder(FInit(RO)).init + SRO.Bounder(FInit(DFSetSize(FC(BIRO.IRO)))).init SRO.Counter.init + FInit(RO).init FInit(DFSetSize(FC(BIRO.IRO))).init. + sp; sim. + seq 1 1 : (={m1, m2, glob SRO.Counter} + /\ ={c}(SRO.Counter,Cntr) + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); last first. + - if; auto; sp. + case: (SRO.Counter.c{1} + ((size m2{1} + 1) %/ r + 1) + + max ((size_out + r - 1) %/ r - 1) 0 < limit); last first. + * rcondf{1} 2; first by auto; inline*; auto. + rcondf{2} 2; first auto; inline*; auto; sp. + + rcondt 1; first by auto; smt(). + by sp; rcondt 1; auto; conseq(:_==> true); auto. + inline*;sp; auto. + rcondt{2} 1; first by auto; smt(). + conseq(:_==> true); first smt(dout_ll). + sp; rcondt{2} 1; auto; conseq(:_==> true); auto. + by while{2}(true)(n0{2}-i{2}); auto; 1:(sp; if; auto); smt(dbool_ll). + rcondt{1} 2; first by auto; inline*; auto. + rcondt{2} 2; first auto; inline*; auto; sp. + + rcondt 1; first by auto; smt(). + by sp; rcondt 1; auto; conseq(:_==> true); auto. + sim. + exists* m1{1}, m2{1}; elim*=> a1 a2 c1 c2. + call(equiv_ro_iro (c2 + ((size a1 + 1) %/ r + 1) + + max ((size_out + r - 1) %/ r - 1) 0) a2). + auto; call(equiv_ro_iro c2 a1); auto; smt(). + call(: ={glob SRO.Counter, glob SRO.Bounder} /\ ={c}(SRO.Counter,Cntr) + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); auto. + + proc; sp; if; auto; sp; if; auto; sp. + exists* x{1}; elim* => a c1 c2 b1 b2. + call(equiv_ro_iro c1 a); auto; smt(). + smt(mem_empty). + have->//=:= SHA3Indiff (DSetSize(D2Pre(A))) &m _. + move=> F P P_f_ll P_fi_ll F_ll; proc; inline*; auto; sp. + seq 1 : true; auto. + + call (A_ll (SRO.Bounder(FInit(DFSetSize(F)))) _); auto. + by proc; inline*; sp; if; auto; sp; if; auto; sp; call F_ll; auto. + if; auto; sp. + seq 1 : true; auto. + + by call F_ll; auto. + sp; if; auto; sp; call F_ll; auto. + qed. + +end section SecondPreimage. + + + +section Collision. + + declare module A <: SRO.AdvCollision {-SRO.RO.RO, -SRO.RO.FRO, -SRO.Bounder, -Perm, -Gconcl_list.BIRO2.IRO, -Simulator, -Cntr, -BIRO.IRO, -F.RO, -F.FRO, -Redo, -C, -Gconcl.S, -BlockSponge.BIRO.IRO, -BlockSponge.C, -Gconcl_list.F2.RO, -Gconcl_list.F2.FRO, -Gconcl_list.Simulator}. + + declare axiom A_ll (F <: SRO.Oracle {-A}) : islossless F.get => islossless A(F).guess. + + local lemma invm_dom_rng (m mi : (state, state) fmap) : + invm m mi => dom m = rng mi. + proof. + move=>h; rewrite fun_ext=> x; rewrite domE rngE /= eq_iff; have h2 := h x; split. + + move=> m_x_not_None; exists (oget m.[x]); rewrite -h2; move: m_x_not_None. + by case: (m.[x]). + by move=> [] a; rewrite -h2 => ->. + qed. + + local lemma invmC' (m mi : (state, state) fmap) : + invm m mi => invm mi m. + proof. by rewrite /#. qed. + + local lemma invmC (m mi : (state, state) fmap) : + invm m mi <=> invm mi m. + proof. by split;exact invmC'. qed. + + local lemma useful m mi a : + Prefix.invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). + proof. + move=>hinvm nin_dom. + have prod_ll:Distr.is_lossless (bdistr `*` cdistr). + + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. + apply dexcepted_ll=>//=;rewrite-prod_ll. + have->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. + rewrite Distr.mu_disjoint 1:predCI//=RField.addrC. + have/=->:=StdOrder.RealOrder.ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. + rewrite Distr.witness_support/predC. + move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. + have{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + move:a. + have:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. + have->//=:fdom m \subset frng m. + + by move=> x; rewrite mem_fdom mem_frng hyp. + smt(mem_fdom mem_frng). + qed. + + + local equiv equiv_sponge_perm c m : + FInit(CSetSize(Sponge, Perm)).get ~ FInit(DFSetSize(FC(Sponge(Perm)))).get : + ={arg, glob Perm} /\ invm Perm.m{1} Perm.mi{1} /\ + Cntr.c{2} = c /\ arg{2} = m /\ + (Cntr.c + ((size arg + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0 <= limit){2} ==> + ={res, glob Perm} /\ invm Perm.m{1} Perm.mi{1} /\ + Cntr.c{2} = c + ((size m + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0. + proof. + proc; inline FC(Sponge(Perm)).f; sp. + rcondt{2} 1; auto; sp. + call(: ={glob Perm} /\ invm Perm.m{1} Perm.mi{1})=>/=; auto; inline*. + while(={i, n, sa, sc, z, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + + sp; if; auto; sp; if; auto; progress. + rewrite invm_set //=. + by move:H4; rewrite supp_dexcepted. + sp; conseq(:_==> ={i, n, sa, sc, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + while(={xs, sa, sc, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + sp; if; auto; progress. + rewrite invm_set=>//=. + by move:H4; rewrite supp_dexcepted. + qed. + + clone import Program as Prog3 with + type t <- bool, + op d <- dbool + proof *. + + local equiv equiv_ro_iro c m : + FInit(RO).get ~ FInit(DFSetSize(FC(BIRO.IRO))).get : + ={arg} /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ + arg{2} = m /\ Cntr.c{2} = c /\ + (Cntr.c + ((size arg + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0 <= limit){2} + ==> ={res} /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ + Cntr.c{2} = c + ((size m + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0. + proof. + proc; inline *; sp; rcondt{2} 1; 1: auto. + swap{2} 1 5; sp; wp 2 1. + conseq(:_==> oget SRO.RO.RO.m{1}.[x{1}] = oget (of_list bs0{2}) /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); 1:by auto. + rcondt{2} 1; 1: auto. + case: (x{1} \in SRO.RO.RO.m{1}). + + rcondf{1} 2; auto. + exists* BIRO.IRO.mp{2}; elim* => mp. + while{2}(bs0{2} = map (fun j => oget BIRO.IRO.mp{2}.[(x0{2},j)]) (range 0 i{2}) + /\ n0{2} = size_out /\ x0{2} \in SRO.RO.RO.m{1} /\ 0 <= i{2} <= size_out + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ BIRO.IRO.mp{2} = mp) + (size_out - i{2}); auto. + - sp; rcondf 1; auto; 1: smt(). + progress. + * have/=<-:= map_rcons (fun (j : int) => oget BIRO.IRO.mp{hr}.[(x0{hr}, j)]) (range 0 i{hr}) i{hr}. + by rewrite !rangeSr //=. + * smt(). + * smt(). + * smt(). + progress. + - by rewrite range_geq. + - smt(size_out_gt0). + - smt(). + - exact(dout_ll). + - have[] h[#] h1 h2 := H. + have->:i_R = size_out by smt(). + have<-:=h2 _ H3. + smt(to_listK). + rcondt{1} 2; 1: auto; wp =>/=. + exists* BIRO.IRO.mp{2}; elim* => mp. + conseq(:_==> + same_ro SRO.RO.RO.m{1} mp /\ i{2} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} (to_list r{1}) = bs0{2} /\ + take i{2} (to_list r{1}) = map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress=>//=. + + by rewrite get_set_sameE /=; smt(to_listK take_oversize spec_dout). + + move:H8; rewrite mem_set=>[][]//=h; 1:rewrite H3=>//=. + - by have []h1 []h2 h3:= H2; have->//:=h1 _ h. + by move:h => <<-; rewrite H6 //=. + + rewrite mem_set //=; have [] //= h:= H5 _ _ H11; left. + have []h1 []->//=:= H2. + by exists i0=>//=. + + move:H7; rewrite take_oversize 1:spec_dout//= => H7. + move:H10; rewrite mem_set. + case(m \in SRO.RO.RO.m{1})=>//=h. + - rewrite get_set_neqE; 1:smt(). + have []h1 []h2 ->//=:= H2. + by apply eq_in_map=> j;rewrite mem_range=>[][]hj1 hj2/=; rewrite H4//=h1//=. + by move=><<-; rewrite get_set_eqE//=. + alias{1} 1 l = [<:bool>]. + transitivity {1} { + l <@ Sample.sample(size_out); + r <- oget (of_list l); + } + (={glob SRO.RO.RO, x} ==> ={glob SRO.RO.RO, r}) + (x{1} = x0{2} /\ i{2} = 0 /\ n0{2} = size_out /\ mp = BIRO.IRO.mp{2} /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ x{1} \notin SRO.RO.RO.m{1} /\ + bs0{2} = [] + ==> + same_ro SRO.RO.RO.m{1} mp /\ i{2} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} (to_list r{1}) = bs0{2} /\ + take i{2} (to_list r{1}) = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + smt(). + + inline*; sp; wp. + rnd to_list (fun x => oget (of_list x)); auto; progress. + - smt(spec_dout supp_dlist to_listK spec2_dout size_out_gt0). + - rewrite -dout_equal_dlist dmap1E; apply mu_eq=> x/=. + smt(to_listK). + - rewrite-dout_equal_dlist supp_dmap; smt(dout_full). + smt(to_listK). + wp=>/=. + conseq(:_==> i{2} = size_out /\ size l{1} = size_out /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in mp => (l0, j) \in BIRO.IRO.mp{2}) /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in mp => BIRO.IRO.mp{2}.[(l0, j)] = mp.[(l0, j)]) /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in BIRO.IRO.mp{2} => ((l0, j) \in mp) \/ (l0 = x0{2} /\ 0 <= j < i{2})) /\ + (forall (j : int), 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + take i{2} l{1} = bs0{2} /\ + take i{2} l{1} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + have[]//=h h1:=to_listK (oget (of_list l_L)) l_L; rewrite h1//==> {h1 h}. + smt(spec2_dout). + + have[]//=h h1:=to_listK (oget (of_list l_L)) l_L; rewrite h1//==> {h1 h}. + smt(spec2_dout). + transitivity{1} { + l <@ LoopSnoc.sample(size_out); + } + (={glob SRO.RO.RO} ==> ={glob SRO.RO.RO, l}) + (x{1} = x0{2} /\ i{2} = 0 /\ n0{2} = size_out /\ mp = BIRO.IRO.mp{2} /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ x0{2} \notin SRO.RO.RO.m{1} /\ + bs0{2} = [] + ==> + i{2} = size_out /\ size l{1} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} l{1} = bs0{2} /\ + take i{2} l{1} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + smt(). + + by call Sample_LoopSnoc_eq; auto. + inline*; sp; wp. + conseq(:_==> i{2} = size_out /\ size l0{1} = i{2} /\ + same_ro SRO.RO.RO.m{1} mp /\ x0{2} \notin SRO.RO.RO.m{1} /\ + (forall l j, (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall l j, (l,j) \in mp => BIRO.IRO.mp{2}.[(l, j)] = mp.[(l, j)]) /\ + (forall l j, (l, j) \in BIRO.IRO.mp{2} => ((l, j) \in mp) \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + l0{1} = bs0{2} /\ bs0{2} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress. + + smt(take_oversize). + + smt(take_oversize). + while(0 <= i{2} <= size_out /\ size l0{1} = i{2} /\ n0{2} = size_out /\ + ={i} /\ n{1} = n0{2} /\ + same_ro SRO.RO.RO.m{1} mp /\ x0{2} \notin SRO.RO.RO.m{1} /\ + (forall l j, (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall l j, (l,j) \in mp => BIRO.IRO.mp{2}.[(l, j)] = mp.[(l, j)]) /\ + (forall l j, (l, j) \in BIRO.IRO.mp{2} => ((l, j) \in mp) \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + l0{1} = bs0{2} /\ bs0{2} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})). + + sp; wp=> //=. + rcondt{2} 1; 1:auto; progress. + - have[]h1 [] h2 h3 := H1. + have:=h2 x0{hr}; rewrite H2/= negb_exists/= =>/(_ (size bs0{hr})). + rewrite size_ge0 H9/=; apply absurd =>/= h. + by have //=:= H5 _ _ h. + wp; rnd; auto; progress. + - smt(size_ge0). + - smt(). + - by rewrite size_cat/=. + - by rewrite mem_set; left; rewrite H3. + - rewrite get_setE (H4 _ _ H11). + have/#: !(l1, j) = (x0{2}, size bs0{2}). + move:H2; apply absurd=> //=[#] <<- ->>. + have[] h1 [] h2 h3 := H1. + by apply h2; smt(). + - move:H11; rewrite mem_set. + case((l1, j) \in BIRO.IRO.mp{2})=>//= h; 1: smt(). + by move=> [#] <<- ->> //=; rewrite size_ge0; smt(). + - rewrite mem_set. + case(j = size bs0{2})=>//=. + move=> h; rewrite h /=; have {H12} H12 {h} : j < size bs0{2} by smt(). + by apply H6. + - by rewrite cats1 get_set_sameE oget_some. + - rewrite get_set_sameE oget_some H7 rangeSr. + rewrite !size_map 1:size_ge0. + rewrite (size_map _ (range 0 (size bs0{2}))) size_range /=. + rewrite ler_maxr 1:size_ge0 map_rcons /=get_set_sameE oget_some; congr. + apply eq_in_map=> j. + rewrite mem_range /==> [] [] hj1 hj2. + by rewrite get_set_neqE //=; smt(). + auto; progress. + + smt(size_out_gt0). + + smt(). + + smt(). + + by rewrite range_geq. + smt(). + qed. + + lemma Sponge_coll_resistant &m : + Pr[SRO.Collision(A, FM(CSetSize(Sponge), Perm)).main() @ &m : res] <= + (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + + (4 * limit ^ 2)%r / (2 ^ c)%r + + (sigma * (sigma - 1) + 2)%r / 2%r / (2%r ^ size_out). + proof. + rewrite -(doutE1 witness). + rewrite (coll_resistant_if_indifferentiable A A_ll (CSetSize(Sponge)) Perm &m). + exists (SimSetSize(Simulator)); split. + + by move=> F _; proc; inline*; auto. + have->:Pr[Indiff0.Indif(CSetSize(Sponge, Perm), Perm, DColl(A)).main() @ &m : res] = + Pr[RealIndif(Sponge, Perm, DRestr(DSetSize(DColl(A)))).main() @ &m : res]. + + byequiv=>//=; proc. + inline Perm.init CSetSize(Sponge, Perm).init Sponge(Perm).init + FC(Sponge(Perm)).init; sp. + inline DColl(A, CSetSize(Sponge, Perm), Perm).distinguish. + inline DRestr(DSetSize(DColl(A)), Sponge(Perm), Perm).distinguish + DSetSize(DColl(A), FC(Sponge(Perm)), PC(Perm)).distinguish Cntr.init; wp; sp; sim. + seq 2 2 : (={m1, m2, glob SRO.Counter, glob Perm} + /\ invm Perm.m{1} Perm.mi{1} + /\ ={c}(SRO.Counter,Cntr)); last first. + - if; auto; sp. + case(SRO.Counter.c{1} + ((size m2{1} + 1) %/ r + 1) + + max ((size_out + r - 1) %/ r - 1) 0 < limit); last first. + * rcondf{1} 2; 1: by auto; inline*; auto; conseq(: _ ==> true); auto. + rcondf{2} 2; 1: by auto; inline*; auto; conseq(: _ ==> true); auto. + auto; inline*; auto; sp; conseq(: _ ==> true); auto. + if{2}; sp; auto; sim. + while{1}(invm Perm.m{1} Perm.mi{1}) (((size_out + r - 1) %/ r)-i{1}). + + auto; sp; if; auto. + - sp; if ;auto; progress. + * exact (useful _ _ _ H H2). + * rewrite invm_set=>//=. + by move:H4; rewrite supp_dexcepted. + * smt(). + smt(). + smt(). + conseq(:_==> invm Perm.m{1} Perm.mi{1}); 1:smt(). + while{1}(invm Perm.m{1} Perm.mi{1})(size xs{1}). + + move=> _ z; auto; sp; if; auto; progress. + * exact (useful _ _ _ H H1). + * rewrite invm_set=>//=. + by move:H3; rewrite supp_dexcepted. + * smt(). + smt(). + auto; smt(size_ge0 size_eq0). + rcondt{1} 2; first by auto; inline*; auto; conseq(:_==> true); auto. + rcondt{2} 2; first by auto; inline*; auto; conseq(:_==> true); auto. + sim. + exists* m1{1}, m2{1}; elim* => a1 a2 c1 c2. + call (equiv_sponge_perm (c2 + ((size a1 + 1) %/ r + 1) + max ((size_out + r - 1) %/ r - 1) 0) a2). + auto; call (equiv_sponge_perm c2 a1); auto; progress. + smt(List.size_ge0 divz_ge0 gt0_r). + smt(List.size_ge0 divz_ge0 gt0_r). + call(: ={glob SRO.Counter, glob Perm, glob SRO.Bounder} + /\ invm Perm.m{1} Perm.mi{1} /\ ={c}(SRO.Counter,Cntr)). + + proc; sp; if; auto; sp; if; auto; sp. + exists * x{1}; elim* => m c1 c2 b1 b2. + by call(equiv_sponge_perm c1 m); auto; smt(). + inline*; auto; progress. + by rewrite /invm=> x y; rewrite 2!emptyE. + have->:Pr[Indiff0.Indif(RO, SimSetSize(Simulator, RO), DColl(A)).main() @ &m : res] = + Pr[IdealIndif(BIRO.IRO, Simulator, DRestr(DSetSize(DColl(A)))).main() @ &m : res]. + + byequiv=>//=; proc. + inline Simulator(FGetSize(RO)).init RO.init Simulator(BIRO.IRO).init + BIRO.IRO.init Gconcl_list.BIRO2.IRO.init; sp. + inline DColl(A, RO, Simulator(FGetSize(RO))).distinguish. + inline DRestr(DSetSize(DColl(A)), BIRO.IRO, Simulator(BIRO.IRO)).distinguish + DSetSize(DColl(A), FC(BIRO.IRO), PC(Simulator(BIRO.IRO))).distinguish; wp; sim. + inline SRO.Bounder(FInit(DFSetSize(FC(BIRO.IRO)))).init + SRO.Bounder(FInit(RO)).init SRO.Counter.init FInit(RO).init + FInit(DFSetSize(FC(BIRO.IRO))).init Cntr.init; sp. + seq 1 1 : (={m1, m2, glob SRO.Counter} + /\ ={c}(SRO.Counter,Cntr) + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); last first. + - if; auto; sp. + case: (SRO.Counter.c{1} + ((size m2{1} + 1) %/ r + 1) + + max ((size_out + r - 1) %/ r - 1) 0 < limit); last first. + * rcondf{1} 2; first by auto; inline*; auto. + rcondf{2} 2; first auto; inline*; auto; sp. + + rcondt 1; first by auto; smt(). + by sp; rcondt 1; auto; conseq(:_==> true); auto. + inline*;sp; auto. + rcondt{2} 1; first by auto; smt(). + conseq(:_==> true); first smt(dout_ll). + sp; rcondt{2} 1; auto; conseq(:_==> true); auto. + by while{2}(true)(n0{2}-i{2}); auto; 1:(sp; if; auto); smt(dbool_ll). + rcondt{1} 2; first by auto; inline*; auto. + rcondt{2} 2; first auto; inline*; auto; sp. + + rcondt 1; first by auto; smt(). + by sp; rcondt 1; auto; conseq(:_==> true); auto. + sim. + exists* m1{1}, m2{1}; elim*=> a1 a2 c1 c2. + call(equiv_ro_iro (c2 + ((size a1 + 1) %/ r + 1) + + max ((size_out + r - 1) %/ r - 1) 0) a2). + auto; call(equiv_ro_iro c2 a1); auto; smt(). + call(: ={glob SRO.Counter, glob SRO.Bounder} /\ ={c}(SRO.Counter,Cntr) + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); auto. + + proc; sp; if; auto; sp; if; auto; sp. + exists* x{1}; elim* => a c1 c2 b1 b2. + call(equiv_ro_iro c1 a); auto; smt(). + smt(mem_empty). + have->//=:= SHA3Indiff (DSetSize(DColl(A))) &m _. + move=> F P P_f_ll P_fi_ll F_ll; proc; inline*; auto; sp. + seq 1 : true; auto. + + call (A_ll (SRO.Bounder(FInit(DFSetSize(F)))) _); auto. + by proc; inline*; sp; if; auto; sp; if; auto; sp; call F_ll; auto. + if; auto; sp. + seq 1 : true; auto. + + by call F_ll; auto. + sp; if; auto; sp; call F_ll; auto. + qed. + +end section Collision. + +module X (F : SRO.Oracle) = { + proc get (bl : bool list) = { + var r; + r <@ F.get(bl ++ [ false ; true ]); + return r; + } +}. + +module AdvCollisionSHA3 (A : SRO.AdvCollision) (F : SRO.Oracle) = { + proc guess () = { + var m1, m2; + (m1, m2) <@ A(X(F)).guess(); + return (m1 ++ [ false ; true ], m2 ++ [ false ; true ]); + } +}. + +section SHA3_Collision. + + declare module A <: SRO.AdvCollision {-SRO.RO.RO, -SRO.RO.FRO, -SRO.Bounder, -Perm, -Gconcl_list.BIRO2.IRO, -Simulator, -Cntr, -BIRO.IRO, -F.RO, -F.FRO, -Redo, -C, -Gconcl.S, -BlockSponge.BIRO.IRO, -BlockSponge.C, -Gconcl_list.F2.RO, -Gconcl_list.F2.FRO, -Gconcl_list.Simulator}. + + declare axiom A_ll (F <: SRO.Oracle {-A}) : islossless F.get => islossless A(F).guess. + + lemma SHA3_coll_resistant &m : + Pr[SRO.Collision(AdvCollisionSHA3(A), FM(CSetSize(Sponge), Perm)).main() @ &m : res] <= + (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + + (4 * limit ^ 2)%r / (2 ^ c)%r + + (sigma * (sigma - 1) + 2)%r / 2%r / (2%r ^ size_out). + proof. + apply (Sponge_coll_resistant (AdvCollisionSHA3(A)) _ &m). + by move=> F F_ll; proc; inline*; call(A_ll (X(F)) _); auto; proc; call F_ll; auto. + qed. + + +end section SHA3_Collision. diff --git a/sha3/proof/SHA3_OIndiff.ec b/sha3/proof/SHA3_OIndiff.ec new file mode 100644 index 0000000..34f6679 --- /dev/null +++ b/sha3/proof/SHA3_OIndiff.ec @@ -0,0 +1,259 @@ +require import AllCore List Int IntDiv StdOrder Distr SmtMap FSet. + +require import Common Sponge. import BIRO. +require (*--*) SLCommon Gconcl_list BlockSponge. +require import SHA3Indiff. + +(* FIX: would be nicer to define limit at top-level and then clone + BlockSponge with it - so BlockSponge would then clone lower-level + theories with it + +op limit : {int | 0 < limit} as gt0_max_limit. +*) + +require (****) OptionIndifferentiability. + +clone import OptionIndifferentiability as OIndif with + type p <- state, + type f_out <- bool list, + type f_in <- bool list * int +proof *. + + +module FSome (F : FUNCTIONALITY) : OFUNCTIONALITY = { + proc init = F.init + proc f (x: bool list * int) : bool list option = { + var z; + z <@ F.f(x); + return Some z; + } +}. + +module PSome (P : PRIMITIVE) : OPRIMITIVE = { + proc init = P.init + proc f (x : state) : state option = { + var z; + z <@ P.f(x); + return Some z; + } + proc fi (x: state) : state option = { + var z; + z <@ P.fi(x); + return Some z; + } +}. + +module Poget (P : ODPRIMITIVE) : DPRIMITIVE = { + proc f (x : state) : state = { + var z; + z <@ P.f(x); + return oget z; + } + proc fi (x: state) : state = { + var z; + z <@ P.fi(x); + return oget z; + } +}. + +module (CSome (C : CONSTRUCTION) : OCONSTRUCTION) (P : ODPRIMITIVE) = FSome(C(Poget(P))). + +module OSimulator (F : ODFUNCTIONALITY) = { + proc init() = { + Simulator.m <- empty; + Simulator.mi <- empty; + Simulator.paths <- empty.[c0 <- ([],b0)]; + Gconcl_list.BIRO2.IRO.init(); + } + proc f (x : state) : state option = { + var p,v,z,q,k,cs,y,y1,y2,o; + if (x \notin Simulator.m) { + if (x.`2 \in Simulator.paths) { + (p,v) <- oget Simulator.paths.[x.`2]; + z <- []; + (q,k) <- parse (rcons p (v +^ x.`1)); + if (valid q) { + o <@ F.f(oget (unpad_blocks q), k * r); + cs <- oget o; + z <- bits2blocks cs; + } else { + z <@ Gconcl_list.BIRO2.IRO.f(q,k); + } + y1 <- last b0 z; + } else { + y1 <$ bdistr; + } + y2 <$ cdistr; + y <- (y1,y2); + Simulator.m.[x] <- y; + Simulator.mi.[y] <- x; + if (x.`2 \in Simulator.paths) { + (p,v) <-oget Simulator.paths.[x.`2]; + Simulator.paths.[y2] <- (rcons p (v +^ x.`1),y.`1); + } + } else { + y <- oget Simulator.m.[x]; + } + return Some y; + } + proc fi (x : state) : state option = { + var y,y1,y2; + if (! x \in Simulator.mi) { + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + Simulator.mi.[x] <- y; + Simulator.m.[y] <- x; + } else { + y <- oget Simulator.mi.[x]; + } + return Some y; + } +}. + + +module Counter = { + var c : int + proc init () = { + c <- 0; + } +}. + +op increase_counter c (l : 'a list) n = + c + ((size l + 1) %/ r + 1) + max ((n + r - 1) %/ r - 1) 0. + + +module OFC (F : ODFUNCTIONALITY) = { + proc init () = { + Counter.init(); + } + proc f (l : bool list, k : int) : bool list option = { + var o <- None; + if (increase_counter Counter.c l k <= limit) { + o <@ F.f(l,k); + Counter.c <- increase_counter Counter.c l k; + } + return o; + } +}. + +module OPC (P : ODPRIMITIVE) = { + proc init () = {} + proc f (x : state) : state option = { + var o <- None; + if (Counter.c + 1 <= limit) { + o <@ P.f(x); + Counter.c <- Counter.c + 1; + } + return o; + } + proc fi (x : state) : state option = { + var o <- None; + if (Counter.c + 1 <= limit) { + o <@ P.fi(x); + Counter.c <- Counter.c + 1; + } + return o; + } +}. + + +module ODRestr (D : ODISTINGUISHER) (F : ODFUNCTIONALITY) (P : ODPRIMITIVE) = { + proc distinguish () = { + var b; + Counter.init(); + b <@ D(OFC(F),OPC(P)).distinguish(); + return b; + } +}. + +section. +declare module Dist <: + ODISTINGUISHER {-Perm, -Gconcl_list.SimLast, -IRO, -Cntr, -BlockSponge.BIRO.IRO, -Simulator, -BlockSponge.C, -Gconcl.S, -SLCommon.F.RO, -SLCommon.F.FRO, -SLCommon.Redo, -SLCommon.C, -Gconcl_list.BIRO2.IRO, -Gconcl_list.F2.RO, -Gconcl_list.F2.FRO, -Gconcl_list.Simulator}. + + +local module DFSome (F : DFUNCTIONALITY) : ODFUNCTIONALITY = { + proc f (x: bool list * int) : bool list option = { + var z; + z <@ F.f(x); + return Some z; + } +}. + +module DPSome (P : DPRIMITIVE) : ODPRIMITIVE = { + proc f (x : state) : state option = { + var z; + z <@ P.f(x); + return Some z; + } + proc fi (x: state) : state option = { + var z; + z <@ P.fi(x); + return Some z; + } +}. + +local module (OD (D : ODISTINGUISHER) : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + proc distinguish () = { + var b; + Counter.init(); + b <@ D(OFC(DFSome(F)),OPC(DPSome(P))).distinguish(); + return b; + } +}. + +lemma SHA3OIndiff + (Dist <: ODISTINGUISHER{-Counter, -Perm, -IRO, -BlockSponge.BIRO.IRO, -Cntr, -Simulator, -Gconcl_list.SimLast(Gconcl.S), -BlockSponge.C, -Gconcl.S, -SLCommon.F.RO, -SLCommon.F.FRO, -SLCommon.Redo, -SLCommon.C, -Gconcl_list.BIRO2.IRO, -Gconcl_list.F2.RO, -Gconcl_list.F2.FRO, -Gconcl_list.Simulator, -OSimulator}) + &m : + (forall (F <: ODFUNCTIONALITY) (P <: ODPRIMITIVE), + islossless P.f => + islossless P.fi => + islossless F.f => + islossless Dist(F,P).distinguish) => + `|Pr[OGReal(CSome(Sponge), PSome(Perm), ODRestr(Dist)).main() @ &m : res] - + Pr[OGIdeal(FSome(IRO), OSimulator, ODRestr(Dist)).main() @ &m : res]| <= + (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. +proof. +move=>h. +have->: Pr[OGReal(CSome(Sponge), PSome(Perm), ODRestr(Dist)).main() @ &m : res] = + Pr[RealIndif(Sponge, Perm, DRestr(OD(Dist))).main() @ &m : res]. ++ byequiv=>//=; proc; inline*; sim; sp. + call(: ={glob Perm, glob Counter} /\ ={c}(Counter,Cntr))=>/>; auto. + - proc; inline*; sp; auto; if; 1, 3: auto; sp. + by rcondt{2} 1; 1: auto; sp; if; auto. + - proc; inline*; sp; auto; if; auto; sp. + by rcondt{2} 1; 1: auto; sp; if; auto. + proc; inline*; sp; auto; sp; if; auto; sp. + rcondt{2} 1; auto; sp=>/>. + conseq(:_==> ={glob Perm} /\ n{1} = n0{2} /\ z0{1} = z1{2})=> />; sim. + while(={glob Perm, sa, sc, i} /\ (n,z0){1} = (n0,z1){2}); auto. + - by sp; if; auto; sp; if; auto. + conseq(:_==> ={glob Perm, sa, sc})=> />; sim. + by while(={glob Perm, sa, sc, xs}); auto; sp; if; auto=> />. +have->: Pr[OGIdeal(FSome(IRO), OSimulator, ODRestr(Dist)).main() @ &m : res] = + Pr[IdealIndif(IRO, Simulator, DRestr(OD(Dist))).main() @ &m : res]. ++ byequiv=>//=; proc; inline*; sim; sp. + call(: ={glob IRO, glob Simulator, glob Counter} /\ ={c}(Counter,Cntr)); auto. + - proc; inline*; auto; sp; if; auto; sp. + rcondt{2} 1; auto; sp; if; 1, 3: auto; sim; if; 1, 3: auto; sp; sim. + if; [1:by auto=> /> &1 &2 <- /> <- />|3:auto=> />]; sp. + * if; auto=> />. + conseq(:_==> ={IRO.mp} /\ bs0{1} = bs{2})=> />; sim=> />. + by move=> &1 &2 <- /> <- />. + by if; auto=> />; sim=> &1 &2 /> <- /> <- /= ->. + - proc; inline*; sp; auto; if; auto; sp. + by rcondt{2} 1; auto; sp; if; auto. + proc; inline*; sp; auto; if; auto; sp. + rcondt{2} 1; auto; sp; if; auto=> />. + by conseq(:_==> bs{1} = bs0{2} /\ ={IRO.mp, glob Simulator})=> />; sim. +apply (security (OD(Dist)) _ &m). +move=> F P hp hpi hf; proc; inline*; sp. +call (h (OFC(DFSome(F))) (OPC(DPSome(P))) _ _ _); auto. ++ by proc; inline*; sp; if; auto; call hp; auto. ++ by proc; inline*; sp; if; auto; call hpi; auto. +by proc; inline*; sp; if; auto; call hf; auto. +qed. + + + +end section. diff --git a/sha3/proof/SecureHash.eca b/sha3/proof/SecureHash.eca new file mode 100644 index 0000000..db62960 --- /dev/null +++ b/sha3/proof/SecureHash.eca @@ -0,0 +1,147 @@ +require import Int Real SmtMap FSet Distr. +require (****) OptionIndifferentiability. + +type from, to, block. + + +clone import OptionIndifferentiability as OIndif with + type p <- block, + type f_in <- from, + type f_out <- to +proof *. + + +op sampleto : to distr. + +op bound : int. +axiom bound_ge0 : 0 <= bound. + +axiom sampleto_ll: is_lossless sampleto. +axiom sampleto_full: is_full sampleto. +axiom sampleto_fu: is_funiform sampleto. + +(* clone import PROM.GenEager as RO with *) +(* type from <- from, *) +(* type to <- to, *) +(* op sampleto <- fun _ => sampleto *) +(* proof * by exact/sampleto_ll. *) + +op increase_counter (c : int) (m : from) : int. +axiom increase_counter_spec c m : c <= increase_counter c m. + + +(* module type RF = { *) +(* proc init() : unit *) +(* proc get(x : from) : to option *) +(* proc sample (x: from) : unit *) +(* }. *) + +(* module RF (R : RO) : RF = { *) +(* proc init = R.init *) +(* proc get (x : from) : to option = { *) +(* var y; *) +(* y <@ R.get(x); *) +(* return Some y; *) +(* } *) +(* proc sample = R.sample *) +(* }. *) + +module Bounder = { + var bounder : int + proc init () = { + bounder <- 0; + } +}. + +module FBounder (F : OFUNCTIONALITY) : OFUNCTIONALITY = { + proc init () : unit = { + Bounder.init(); + F.init(); + } + proc f(x : from) : to option = { + var y : to option <- None; + if (increase_counter Bounder.bounder x <= bound) { + Bounder.bounder <- increase_counter Bounder.bounder x; + y <@ F.f(x); + } + return y; + } +}. + + +module PBounder (P : OPRIMITIVE) : OPRIMITIVE = { + proc init () = { + P.init(); + Bounder.init(); + } + proc f (x : block) : block option = { + var y <- None; + if (Bounder.bounder < bound) { + y <@ P.f(x); + Bounder.bounder <- Bounder.bounder + 1; + } + return y; + } + proc fi (x : block) : block option = { + var y <- None; + if (Bounder.bounder < bound) { + y <@ P.fi(x); + Bounder.bounder <- Bounder.bounder + 1; + } + return y; + } +}. + +module type AdvPreimage (F : ODFUNCTIONALITY) (P : ODPRIMITIVE) = { + proc guess(h : to) : from +}. + +module Preimage (A : AdvPreimage, F : OCONSTRUCTION, P : OPRIMITIVE) = { + proc main () : bool = { + var m,hash,hash'; + hash <$ sampleto; + PBounder(P).init(); + FBounder(F(P)).init(); + m <@ A(FBounder(F(P)),PBounder(P)).guess(hash); + hash' <@ FBounder(F(P)).f(m); + return hash' = Some hash; + } +}. + + +(*-------------------------------------------------------------------------*) +module type AdvSecondPreimage (F : ODFUNCTIONALITY) (P : ODPRIMITIVE) = { + proc guess(m : from) : from +}. + +module SecondPreimage (A : AdvSecondPreimage, F : OCONSTRUCTION, P : OPRIMITIVE) = { + proc main (m1 : from) : bool = { + var m2, hash1, hash2; + PBounder(P).init(); + FBounder(F(P)).init(); + m2 <@ A(FBounder(F(P)),PBounder(P)).guess(m1); + hash1 <@ FBounder(F(P)).f(m1); + hash2 <@ FBounder(F(P)).f(m2); + return m1 <> m2 /\ exists y, Some y = hash1 /\ Some y = hash2; + } +}. + + +(*--------------------------------------------------------------------------*) +module type AdvCollision (F : ODFUNCTIONALITY) (P : ODPRIMITIVE) = { + proc guess() : from * from +}. + +module Collision (A : AdvCollision, F : OCONSTRUCTION, P : OPRIMITIVE) = { + proc main () : bool = { + var m1,m2,hash1,hash2; + PBounder(P).init(); + FBounder(F(P)).init(); + (m1,m2) <@ A(FBounder(F(P)),PBounder(P)).guess(); + hash1 <@ FBounder(F(P)).f(m1); + hash2 <@ FBounder(F(P)).f(m2); + return m1 <> m2 /\ exists y, Some y = hash1 /\ Some y = hash2; + } +}. + + diff --git a/sha3/proof/SecureORO.eca b/sha3/proof/SecureORO.eca new file mode 100644 index 0000000..ee3a014 --- /dev/null +++ b/sha3/proof/SecureORO.eca @@ -0,0 +1,492 @@ +require import Int Distr Real SmtMap FSet Mu_mem. +require (*--*) StdOrder. +(*---*) import StdOrder.IntOrder. +require (****) PROM FelTactic. + + +type from, to. + +op sampleto : to distr. + +op bound : int. +axiom bound_ge0 : 0 <= bound. + +axiom sampleto_ll: is_lossless sampleto. +axiom sampleto_full: is_full sampleto. +axiom sampleto_fu: is_funiform sampleto. + +clone import PROM.FullRO as RO with + type in_t <- from, + type out_t <- to, + op dout _ <- sampleto, + type d_in_t <- unit, + type d_out_t <- bool. +import FullEager. + +op increase_counter (c : int) (m : from) : int. +axiom increase_counter_spec c m : c <= increase_counter c m. + +module type RF = { + proc init() : unit + proc get(x : from) : to option + proc sample (x: from) : unit +}. + +module RF (R : RO) : RF = { + proc init = R.init + proc get (x : from) : to option = { + var y; + y <@ R.get(x); + return Some y; + } + proc sample = R.sample +}. + +module Bounder (F : RF) : RF = { + var bounder : int + proc init () : unit = { + bounder <- 0; + F.init(); + } + proc get(x : from) : to option = { + var y : to option <- None; + if (bounder < bound) { + bounder <- bounder + 1; + y <@ F.get(x); + } + return y; + } + proc sample = F.sample +}. + + +module type Oracle = { + proc get(x : from) : to option {} +}. + +module type AdvPreimage (F : Oracle) = { + proc guess(h : to) : from +}. + +module Preimage (A : AdvPreimage, F : RF) = { + proc main () : bool = { + var m,hash,hash'; + hash <$ sampleto; + Bounder(F).init(); + m <@ A(Bounder(F)).guess(hash); + hash' <@ Bounder(F).get(m); + return hash' = Some hash; + } +}. + +section Preimage. + + declare module A <: AdvPreimage {-RO, -Preimage}. + + local module FEL (A : AdvPreimage, F : RF) = { + proc main (hash : to) : from = { + var m; + Bounder(F).init(); + m <@ A(Bounder(F)).guess(hash); + return m; + } + }. + + local module Preimage2 (A : AdvPreimage, F : RF) = { + var hash : to + proc main () : bool = { + var m,hash'; + hash <$ sampleto; + m <@ FEL(A,F).main(hash); + hash' <@ Bounder(F).get(m); + return hash' = Some hash; + } + }. + + lemma RO_is_preimage_resistant &m : + Pr [ Preimage(A,RF(RO)).main() @ &m : res ] <= (bound + 1)%r * mu1 sampleto witness. + proof. + have->: Pr [ Preimage (A,RF(RO)).main() @ &m : res ] = + Pr [ Preimage2(A,RF(RO)).main() @ &m : res ]. + + by byequiv=> //=; proc; inline*; sim. + byphoare(: _ ==> _) => //=; proc. + seq 2 : (rng RO.m Preimage2.hash) (bound%r * mu1 sampleto witness) 1%r 1%r + (mu1 sampleto witness) + (card (fdom RO.m) <= Bounder.bounder <= bound). + + inline*; auto; call(: card (fdom RO.m) <= Bounder.bounder <= bound)=> //=. + - proc; inline*; auto; sp; if; 2:auto; wp. + wp; conseq(:_==> card (fdom RO.m) + 1 <= Bounder.bounder <= bound); 2: by auto;smt(). + move=> &h /> c H1 H2 c2 r x h1 h2; split; 2: smt(). + by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + by auto=> />; rewrite fdom0 fcards0; smt(bound_ge0). + + seq 1 : true 1%r (bound%r * mu1 sampleto witness) 0%r _; auto. + exists * Preimage2.hash; elim* => h. + call(: Preimage2.hash = h /\ h = arg ==> rng RO.m h)=> //. + bypr=> /> {&m} &m <<- <-. + pose h := Preimage2.hash{m}. + have H: forall &m h, + Pr[FEL(A, RF(RO)).main(h) @ &m : rng RO.m h] <= bound%r * mu1 sampleto witness; last first. + + exact(H &m h). + move=> {&m h} &m h. + fel 1 Bounder.bounder (fun _, mu1 sampleto witness) bound (rng RO.m h) + [Bounder(RF(RO)).get: (card (fdom RO.m) <= Bounder.bounder < bound)] + (card (fdom RO.m) <= Bounder.bounder <= bound) + =>//. + - rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. + rewrite ler_maxr //=; 1:smt(bound_ge0). + rewrite-RField.AddMonoid.iteropE-RField.intmulpE; 1: smt(bound_ge0). + by rewrite RField.intmulr; smt(). + - inline*; auto=> />. + rewrite mem_rng_empty /= fdom0 fcards0 /=; smt(bound_ge0). + - proc. + sp; if; auto; sp; inline*; sp; wp=> /=. + case: (x \in RO.m); wp => //=. + + by hoare; auto; smt(mu_bounded). + rnd (pred1 h); auto=> /> &h c H0 H1 H2 H3 H4 H5. + rewrite (sampleto_fu h witness) /= => ? ?. + rewrite rngE/= => [][] a; rewrite get_setE. + case: (a=x{h}) => [->>|] //=. + by move:H2; rewrite rngE /= negb_exists/= => /(_ a) //=. + - move=> c; proc; inline*; sp; if; sp. + + auto; progress. + + smt(). + + by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + + smt(). + + smt(). + + smt(). + + smt(). + by auto. + move=> b c; proc; sp; inline*; if; auto; progress. + - rewrite 2!rngE /= eq_iff; split=> [][] a. + + by rewrite get_setE; move: H4; rewrite domE /=; smt(). + move=> H8; exists a; rewrite get_setE; move: H4; rewrite domE /=; smt(). + - smt(). + - by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + - smt(). + - smt(). + - smt(). + - smt(). + + by inline*; auto. + + by inline*; auto. + + inline*; sp; wp. + if; sp; wp; last by hoare;auto;progress; smt(mu_bounded). + case: (x \in RO.m). + - hoare; auto; progress. + rewrite H3/=; move: H1; rewrite rngE /= negb_exists /=. + by have:=H3; rewrite domE; smt(). + rnd (pred1 Preimage2.hash); auto=> /> &hr *. + rewrite (sampleto_fu Preimage2.hash{hr} witness)/= => ??. + by rewrite get_setE /=; smt(). + smt(). + qed. + +end section Preimage. + +(*-------------------------------------------------------------------------*) +module type AdvSecondPreimage (F : Oracle) = { + proc guess(m : from) : from +}. + +module SecondPreimage (A : AdvSecondPreimage, F : RF) = { + proc main (m1 : from) : bool = { + var m2, hash1, hash2; + Bounder(F).init(); + m2 <@ A(Bounder(F)).guess(m1); + hash1 <@ Bounder(F).get(m1); + hash2 <@ Bounder(F).get(m2); + return m1 <> m2 /\ exists y, Some y = hash1 /\ Some y = hash2; + } +}. + +section SecondPreimage. + + + declare module A <: AdvSecondPreimage {-Bounder, -RO, -FRO}. + + local module FEL (A : AdvSecondPreimage, F : RF) = { + proc main (m1 : from) : from = { + var m2; + Bounder(F).init(); + Bounder(F).sample(m1); + m2 <@ A(Bounder(F)).guess(m1); + return m2; + } + }. + + local module SecondPreimage2 (A : AdvSecondPreimage, F : RF) = { + var m2 : from + proc main (m1 : from) : bool = { + var hash1,hash2; + m2 <@ FEL(A,F).main(m1); + hash1 <@ Bounder(F).get(m1); + hash2 <@ Bounder(F).get(m2); + return m1 <> m2 /\ exists y, Some y = hash1 /\ Some y = hash2; + } + }. + + local module D1 (A : AdvSecondPreimage, F : RO) = { + var m1 : from + proc distinguish () : bool = { + var b; + b <@ SecondPreimage2(A,RF(F)).main(m1); + return b; + } + }. + + local module SecondPreimage3 (A : AdvSecondPreimage, F : RO) = { + proc main (m1 : from) : bool = { + var b; + SecondPreimage2.m2 <- witness; + D1.m1 <- m1; + Bounder(RF(F)).init(); + b <@ D1(A,F).distinguish(); + return b; + } + }. + + + lemma RO_is_second_preimage_resistant &m (mess1 : from) : + Pr [ SecondPreimage(A,RF(RO)).main(mess1) @ &m : res ] + <= (bound + 1)%r * mu1 sampleto witness. + proof. + have->: Pr [ SecondPreimage(A,RF(RO)).main(mess1) @ &m : res ] = + Pr [ SecondPreimage(A,RF(LRO)).main(mess1) @ &m : res ]. + + by byequiv=> //=; proc; inline*; sim. + have->: Pr [ SecondPreimage(A,RF(LRO)).main(mess1) @ &m : res ] = + Pr [ SecondPreimage2(A,RF(LRO)).main(mess1) @ &m : res ]. + + by byequiv=> //=; proc; inline*; sim. + have->: Pr [ SecondPreimage2(A,RF(LRO)).main(mess1) @ &m : res ] = + Pr [ SecondPreimage2(A,RF(RO)).main(mess1) @ &m : res ]. + + have->: Pr [ SecondPreimage2(A,RF(LRO)).main(mess1) @ &m : res ] = + Pr [ SecondPreimage3(A,LRO).main(mess1) @ &m : res ]. + - by byequiv=> //=; proc; inline*; wp 15 -2; sim. + have->: Pr [ SecondPreimage3(A,LRO).main(mess1) @ &m : res ] = + Pr [ SecondPreimage3(A,RO).main(mess1) @ &m : res ]. + - rewrite eq_sym. + byequiv=>//=; proc. + call(RO_LRO_D (D1(A)) _); first by rewrite sampleto_ll. + by inline*; auto. + by byequiv=> //=; proc; inline*; wp -2 18; sim. + byphoare(: arg = mess1 ==> _)=>//=; proc. + seq 1 : (rng (rem RO.m mess1) (oget RO.m.[mess1])) + (bound%r * mu1 sampleto witness) 1%r + 1%r (mu1 sampleto witness) + (card (fdom RO.m) - 1 <= Bounder.bounder <= bound + /\ mess1 \in RO.m /\ mess1 = m1). + + inline*; auto; call(: card (fdom RO.m) - 1 <= Bounder.bounder <= bound + /\ mess1 \in RO.m). + - proc; inline*; auto; sp; if; last by auto; smt(). + auto=> /> &h c Hc Hdom Hc2 sample. + by rewrite sampleto_full/=!fdom_set !fcardU !fcard1;smt(mem_set fcard_ge0). + auto=> /> sample. + by rewrite mem_set mem_empty/= fdom_set fdom0 fset0U fcard1; smt(bound_ge0). + + call(: arg = mess1 ==> rng (rem RO.m mess1) (oget RO.m.[mess1])); auto. + bypr=> {&m} &m h; rewrite h. + fel 2 Bounder.bounder (fun _, mu1 sampleto witness) bound + (mess1 \in RO.m /\ rng (rem RO.m mess1) (oget RO.m.[mess1])) + [Bounder(RF(RO)).get: (card (fdom RO.m) - 1 <= Bounder.bounder < bound)] + (card (fdom RO.m) - 1 <= Bounder.bounder <= bound /\ mess1 \in RO.m)=> {h} + =>//. + + rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. + rewrite ler_maxr //=; 1:smt(bound_ge0). + rewrite-RField.AddMonoid.iteropE-RField.intmulpE; 1: smt(bound_ge0). + by rewrite RField.intmulr; smt(mu_bounded bound_ge0). + + inline*; auto=> />. + move=> r; rewrite mem_empty /= !mem_set mem_empty/= sampleto_full /=. + rewrite get_set_sameE//= fdom_set fdom0 fset0U fcard1 /= rngE /=; split; 2: smt(bound_ge0). + by rewrite negb_exists/= => a; rewrite remE get_setE //= emptyE; smt(). + + proc; inline*; sp; if; last by hoare; auto. + sp; case: (x \in RO.m)=> //=. + - by hoare; auto; smt(mu_bounded). + rcondt 2; 1: auto; wp=> /=. + conseq(:_ ==> pred1 (oget RO.m.[mess1]) r)=> />. + - move=> /> &h c H0c Hcb Hnrng Hmc _ Hdom1 Hdom2 sample. + rewrite mem_set Hdom1 /= get_set_neqE; 1: smt(). + have->: (rem RO.m{h}.[x{h} <- sample] mess1) = (rem RO.m{h} mess1).[x{h} <- sample]. + + by apply fmap_eqP=> y; rewrite remE 2!get_setE remE; smt(). + move: Hnrng; rewrite Hdom1 /= rngE /= negb_exists /= => Hnrng. + rewrite rngE/= => [][] mess; rewrite get_setE remE. + by have:= Hnrng mess; rewrite remE; smt(). + rnd; auto; progress. + by have ->:= sampleto_fu witness (oget RO.m{hr}.[mess1]). + + move=> c; proc; inline*; sp; if; auto; progress. + - smt(). + - by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + - smt(). + - smt(mem_set). + - smt(). + - smt(). + - smt(). + + move=> b c; proc; inline*; sp; if; auto; smt(). + + by inline*; auto. + + by auto. + + inline*; sp; auto. + if; sp; last first. + + sp; hoare; auto; if; auto. + case(Bounder.bounder < bound); last first. + - by rcondf 8; 1: auto; hoare; auto. + rcondt 8; 1: auto. + swap 11 -8; sp. + swap [7..11] -6; sp. + swap[5..6] 2; wp 6=> /=. + case: (SecondPreimage2.m2 \in RO.m). + - rcondf 5; 1: auto; hoare; auto=> /> &h d _ _ in_dom1 not_rng d_bound _ in_dom2. + move=> sample2 _ m1_in_RO sample1 _; rewrite negb_and/=. + move: not_rng; rewrite rngE /= negb_exists /= => /(_ SecondPreimage2.m2{h}). + rewrite remE; case: (SecondPreimage2.m2{h} = m1{h})=> //=. + by move: in_dom1 in_dom2; smt(). + rcondt 5; 1: auto; wp. + rnd (pred1 (oget RO.m.[x3])); auto. + move => /> &h d _ _ in_dom1 not_rng _ _ nin_dom2 sample2 _. + rewrite (sampleto_fu (oget RO.m{h}.[m1{h}]) witness) /= => _ sample1 _. + by rewrite get_set_sameE//=; smt(). + smt(). + qed. + +end section SecondPreimage. + + +(*--------------------------------------------------------------------------*) +module type AdvCollision (F : Oracle) = { + proc guess() : from * from +}. + +module Collision (A : AdvCollision, F : RF) = { + proc main () : bool = { + var m1,m2,hash1,hash2; + Bounder(F).init(); + (m1,m2) <@ A(Bounder(F)).guess(); + hash1 <@ Bounder(F).get(m1); + hash2 <@ Bounder(F).get(m2); + return m1 <> m2 /\ exists y, Some y = hash1 /\ Some y = hash2; + } +}. + +section Collision. + + declare module A <: AdvCollision {-RO, -FRO, -Bounder}. + + local module FEL (A : AdvCollision, F : RF) = { + proc main () : from * from = { + var m1,m2; + Bounder(F).init(); + (m1,m2) <@ A(Bounder(F)).guess(); + return (m1,m2); + } + }. + + local module Collision2 (A : AdvCollision) (F : RF) = { + proc main () : bool = { + var m1,m2,hash1,hash2; + (m1,m2) <@ FEL(A,F).main(); + hash1 <@ Bounder(F).get(m1); + hash2 <@ Bounder(F).get(m2); + return m1 <> m2 /\ exists y, Some y = hash1 /\ Some y = hash2; + } + }. + + op collision (m : ('a, 'b) fmap) = + exists m1 m2, m1 <> m2 /\ m1 \in m /\ m2 \in m /\ m.[m1] = m.[m2]. + + lemma RO_is_collision_resistant &m : + Pr [ Collision(A,RF(RO)).main() @ &m : res ] + <= ((bound * (bound - 1) + 2)%r / 2%r * mu1 sampleto witness). + proof. + have->: Pr [ Collision(A,RF(RO)).main() @ &m : res ] = + Pr [ Collision2(A,RF(RO)).main() @ &m : res ]. + + by byequiv=>//=; proc; inline*; sim. + byphoare=> //; proc. + seq 1 : (collision RO.m) + ((bound * (bound - 1))%r / 2%r * mu1 sampleto witness) 1%r + 1%r (mu1 sampleto witness) + (card (fdom RO.m) <= Bounder.bounder <= bound); first last; first last. + + auto. + + auto. + + inline*; sp. + if; sp; last first. + - by wp; conseq(:_==> false)=> />; hoare; auto. + case: (Bounder.bounder < bound); last first. + - rcondf 8; 1:auto; hoare; auto. + rcondt 8; 1: auto. + swap 11 -8. + swap [7..11] -6; sp. + swap [5..6] 1; wp 5=> /=. + swap 3 -1. + case: (m1 = m2). + - by hoare; auto. + case: (m1 \in RO.m); case: (m2 \in RO.m). + - rcondf 3; 1: auto; rcondf 4; 1: auto; hoare; auto. + move=> /> &h d _ _ Hcoll _ _ neq12 in_dom1 in_dom2 _ _ _ _. + move: Hcoll; rewrite /collision negb_exists /= => /(_ m1{h}). + rewrite negb_exists /= => /(_ m2{h}). + by rewrite neq12 in_dom1 in_dom2 /=; smt(). + - rcondf 3; 1: auto; rcondt 4; 1: auto; wp. + rnd (pred1 (oget RO.m.[x3])). + auto=> /> &h d Hmc Hcb Hcoll _ _ neq12 in_dom1 in_dom2 _ _; split. + * smt(sampleto_fu). + by move=> _ sample _; rewrite get_set_sameE; smt(). + - rcondt 3; 1: auto; rcondf 5; 1: (by auto; smt(mem_set)). + swap 1; wp=> /=; rnd (pred1 (oget RO.m.[m2])); auto. + move=> /> &h d _ _ Hcoll _ _ neq12 in_dom1 in_dom2 _ _; split. + * smt(sampleto_fu). + move=> _ sample _. + by rewrite get_set_sameE get_set_neqE 1:eq_sym. + rcondt 3; 1: auto; rcondt 5; 1: (by auto; smt(mem_set)). + swap 2 -1; swap 1; wp=> //=; rnd (pred1 r); auto. + move=> /> &h d _ _ Hcoll _ _ neq12 in_dom1 in_dom2 sample1 _; split. + * smt(sampleto_fu). + move=> _ sample2 _. + by rewrite get_set_sameE get_set_sameE; smt(). + + by move=> />; smt(mu_bounded). + + inline*; wp; call(: card (fdom RO.m) <= Bounder.bounder <= bound); auto. + - proc; inline*; sp; if; last by auto; smt(). + auto=> /> &h d Hbc Hcb sample _; split. + * by move=> nin_dom1; rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + by move=> in_dom1; smt(). + by move=> />; rewrite fdom0 fcards0; smt(bound_ge0). + call(: true ==> collision RO.m); auto; bypr=> /> {&m} &m. + fel 1 Bounder.bounder (fun i, i%r * mu1 sampleto witness) bound + (collision RO.m) + [Bounder(RF(RO)).get: (card (fdom RO.m) <= Bounder.bounder < bound)] + (card (fdom RO.m) <= Bounder.bounder <= bound)=> //. + + rewrite -StdBigop.Bigreal.BRA.mulr_suml RField.mulrAC. + rewrite StdOrder.RealOrder.ler_wpmul2r; 1: smt(mu_bounded). + by rewrite StdBigop.Bigreal.sumidE //; smt(bound_ge0). + + inline*; auto=> />. + rewrite fdom0 fcards0; split; 2: smt(bound_ge0). + rewrite /collision negb_exists /= => a; rewrite negb_exists /= => b. + by rewrite mem_empty. + + bypr=> /> {&m} &m; pose c := Bounder.bounder{m}; move=> H0c Hcbound Hcoll Hmc _. + byphoare(: !collision RO.m /\ card (fdom RO.m) <= c ==> _)=>//=. + proc; inline*; sp; if; last first. + - by hoare; auto; smt(mu_bounded). + case: (x \in RO.m). + - by hoare; auto; smt(mu_bounded). + rcondt 5; 1: auto; sp; wp=> /=. + conseq(:_==> r \in frng RO.m). + - move=> /> &h c2 Hcoll2 Hb2c Hc2b nin_dom sample m1 m2 neq. + rewrite 2!mem_set. + case: (m1 = x{h}) => //=. + * move=> <<-; rewrite eq_sym neq /= get_set_sameE get_set_neqE//= 1:eq_sym //. + by rewrite mem_frng rngE /= => _ ->; exists m2. + case: (m2 = x{h}) => //=. + * move=> <<- _ in_dom1. + by rewrite get_set_neqE // get_set_sameE mem_frng rngE/= => <-; exists m1. + move=> neq2 neq1 in_dom1 in_dom2; rewrite get_set_neqE // get_set_neqE //. + have:= Hcoll2; rewrite negb_exists /= => /(_ m1). + rewrite negb_exists /= => /(_ m2). + by rewrite neq in_dom1 in_dom2 /= => ->. + rnd; skip=> /> &h bounder _ h _. + rewrite (mu_mem (frng RO.m{h}) sampleto (mu1 sampleto witness)); 1: smt(sampleto_fu). + rewrite StdOrder.RealOrder.ler_wpmul2r //. + by rewrite le_fromint; smt(le_card_frng_fdom). + + move=> c; proc; inline*; auto; sp; if; last by auto; smt(). + auto=> /> &h h1 h2 _ sample _. + by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + move=> b c; proc; inline*; sp; if; auto. + move=> /> &h h1 h2 _ h3 sample _. + by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + qed. + + +end section Collision. diff --git a/sha3/proof/SecureRO.eca b/sha3/proof/SecureRO.eca new file mode 100644 index 0000000..c7df62a --- /dev/null +++ b/sha3/proof/SecureRO.eca @@ -0,0 +1,525 @@ +require import Int Distr Real SmtMap FSet Mu_mem. +require (*--*) StdOrder. +(*---*) import StdOrder.IntOrder. +require (****) PROM FelTactic. + + +type from, to. + +op sampleto : to distr. + +op bound : int. +axiom bound_gt0 : 0 < bound. + +axiom sampleto_ll: is_lossless sampleto. +axiom sampleto_full: is_full sampleto. +axiom sampleto_fu: is_funiform sampleto. + +clone import PROM.FullRO as RO with + type in_t <- from, + type out_t <- to, + op dout _ <- sampleto, + type d_in_t <- unit, + type d_out_t <- bool. +import FullEager. + +op increase_counter (c : int) (m : from) : int. +axiom increase_counter_spec c m : c <= increase_counter c m. + +op bound_counter : int. +axiom bound_counter_ge0 : 0 <= bound_counter. + +module Counter = { + var c : int + proc init() = { + c <- 0; + } +}. + +module type RF = { + proc init() : unit + proc get(x : from) : to +}. + +module Bounder (F : RF) : RF = { + var bounder : int + proc init () : unit = { + bounder <- 0; + Counter.init(); + F.init(); + } + proc get(x : from) : to = { + var y : to <- witness; + if (bounder < bound) { + bounder <- bounder + 1; + if (increase_counter Counter.c x < bound_counter) { + Counter.c <- increase_counter Counter.c x; + y <@ F.get(x); + } + } + return y; + } +}. + + +module type Oracle = { + proc get(x : from) : to {} +}. + +module type AdvPreimage (F : Oracle) = { + proc guess(h : to) : from +}. + +module Preimage (A : AdvPreimage, F : RF) = { + proc main (hash : to) : bool = { + var b,m,hash'; + Counter.init(); + Bounder(F).init(); + m <@ A(Bounder(F)).guess(hash); + if (increase_counter Counter.c m < bound_counter) { + hash' <@ F.get(m); + b <- hash = hash'; + } else b <- false; + return b; + } +}. + +section Preimage. + + declare module A <: AdvPreimage {-RO, -Preimage}. + + local module FEL (A : AdvPreimage, F : RF) = { + proc main (hash : to) : from = { + var m; + Bounder(F).init(); + m <@ A(Bounder(F)).guess(hash); + return m; + } + }. + + local module Preimage2 (A : AdvPreimage, F : RF) = { + proc main (hash : to) : bool = { + var b,m,hash'; + m <@ FEL(A,F).main(hash); + if (increase_counter Counter.c m < bound_counter) { + hash' <@ F.get(m); + b <- hash = hash'; + } else b <- false; + return b; + } + }. + + lemma RO_is_preimage_resistant &m (h : to) : + Pr [ Preimage(A,RO).main(h) @ &m : res ] <= (bound + 1)%r * mu1 sampleto h. + proof. + have->: Pr [ Preimage (A,RO).main(h) @ &m : res ] = + Pr [ Preimage2(A,RO).main(h) @ &m : res ]. + + by byequiv=> //=; proc; inline*; sim. + byphoare(: arg = h ==> _) => //=; proc. + seq 1 : (rng RO.m h) (bound%r * mu1 sampleto h) 1%r 1%r (mu1 sampleto h) + (card (fdom RO.m) <= Bounder.bounder <= bound /\ hash = h). + + inline*; auto; call(: card (fdom RO.m) <= Bounder.bounder <= bound)=> //=. + - proc; inline*; auto; sp; if; 2:auto; wp; sp. + if; last by auto; smt(). + wp; conseq(:_==> card (fdom RO.m) + 1 <= Bounder.bounder <= bound); 2: by auto;smt(). + move=> &h /> c H1 _ H2 c2 r x h1 h2; split; 2: smt(). + by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + by auto=> />; rewrite fdom0 fcards0; smt(bound_gt0). + + call(: true ==> rng RO.m h)=> //; bypr=> /> {&m} &m. + fel 1 Bounder.bounder (fun _, mu1 sampleto h) bound (rng RO.m h) + [Bounder(RO).get: (card (fdom RO.m) <= Bounder.bounder < bound)] + (card (fdom RO.m) <= Bounder.bounder <= bound) + =>//. + - rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. + rewrite ler_maxr //=; 1:smt(bound_gt0). + rewrite-RField.AddMonoid.iteropE-RField.intmulpE; 1: smt(bound_gt0). + by rewrite RField.intmulr; smt(). + - inline*; auto=> />. + by rewrite mem_rng_empty /= fdom0 fcards0 /=; smt(bound_gt0). + - proc. + sp; if; auto; sp; inline*; sp; wp=> /=. + if; last by hoare; auto; progress; smt(mu_bounded). + case: (x \in RO.m); wp => //=. + + by hoare; auto; smt(mu_bounded). + rnd (pred1 h); auto=> /> &h c ge0_c lt_c_bound h_notin_rngRO le_sRO_c le_c_bound Hcount x_notin_RO v _. + rewrite rngE=> /= - [] a; rewrite get_setE. + case: (a=x{h}) => [->>|] //=. + by move:h_notin_rngRO; rewrite rngE /= negb_exists/= => /(_ a) //=. + - move=> c; proc; inline*; sp; if; sp. + + if; auto; progress. + + smt(). + + by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + + smt(). + + smt(). + + smt(). + + smt(). + + smt(). + + smt(). + + smt(). + by auto. + move=> b c; proc; sp; if; auto; inline*; auto; sp; if; auto; progress. + - rewrite 2!rngE /= eq_iff; split=> [][] a. + + by rewrite get_setE; move: H5; rewrite domE /=; smt(). + move=> H8; exists a; rewrite get_setE; move: H5; rewrite domE /=; smt(). + - smt(). + - by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + - smt(). + - smt(). + - smt(). + - smt(). + - smt(). + - smt(). + smt(). + + by inline*; auto. + + by inline*; auto. + + inline*; sp; wp. + if; sp; wp; last by hoare;auto;progress; smt(mu_bounded). + case: (x \in RO.m). + - hoare; auto; progress. + rewrite H3/=; move: H1; rewrite rngE /= negb_exists /=. + by have:=H3; rewrite domE; smt(). + rnd (pred1 h); auto=> //= &hr [#]->>H0 H1<<-H2 H3 H4 H5 H6. + by rewrite H4 /= get_setE /=; smt(). + smt(). + qed. + +end section Preimage. + +(*-------------------------------------------------------------------------*) +module type AdvSecondPreimage (F : Oracle) = { + proc guess(m : from) : from +}. + +module SecondPreimage (A : AdvSecondPreimage, F : RF) = { + proc main (m1 : from) : bool = { + var b, m2, hash1, hash2; + Bounder(F).init(); + m2 <@ A(Bounder(F)).guess(m1); + if (increase_counter Counter.c m1 < bound_counter) { + Counter.c <- increase_counter Counter.c m1; + hash1 <@ F.get(m1); + if (increase_counter Counter.c m2 < bound_counter) { + Counter.c <- increase_counter Counter.c m2; + hash2 <@ F.get(m2); + b <- hash1 = hash2 /\ m1 <> m2; + } else b <- false; + } + else b <- false; + return b; + } +}. + +section SecondPreimage. + + + declare module A <: AdvSecondPreimage {-Bounder, -RO, -FRO}. + + local module FEL (A : AdvSecondPreimage, F : RO) = { + proc main (m1 : from) : from = { + var m2; + Bounder(F).init(); + F.sample(m1); + m2 <@ A(Bounder(F)).guess(m1); + return m2; + } + }. + + local module SecondPreimage2 (A : AdvSecondPreimage, F : RO) = { + var m2 : from + proc main (m1 : from) : bool = { + var b, hash1,hash2; + m2 <@ FEL(A,F).main(m1); + if (increase_counter Counter.c m1 < bound_counter) { + Counter.c <- increase_counter Counter.c m1; + hash1 <@ F.get(m1); + if (increase_counter Counter.c m2 < bound_counter) { + Counter.c <- increase_counter Counter.c m2; + hash2 <@ F.get(m2); + b <- hash1 = hash2 /\ m1 <> m2; + } else b <- false; + } + else b <- false; + return b; + } + }. + + local module D1 (A : AdvSecondPreimage, F : RO) = { + var m1 : from + proc distinguish () : bool = { + var b; + b <@ SecondPreimage2(A,F).main(m1); + return b; + } + }. + + local module SecondPreimage3 (A : AdvSecondPreimage, F : RO) = { + proc main (m1 : from) : bool = { + var b; + SecondPreimage2.m2 <- witness; + D1.m1 <- m1; + Bounder(F).init(); + b <@ D1(A,F).distinguish(); + return b; + } + }. + + + lemma RO_is_second_preimage_resistant &m (mess1 : from) : + Pr [ SecondPreimage(A,RO).main(mess1) @ &m : res ] + <= (bound + 1)%r * mu1 sampleto witness. + proof. + have->: Pr [ SecondPreimage(A,RO).main(mess1) @ &m : res ] = + Pr [ SecondPreimage(A,LRO).main(mess1) @ &m : res ]. + + by byequiv=> //=; proc; inline*; sim. + have->: Pr [ SecondPreimage(A,LRO).main(mess1) @ &m : res ] = + Pr [ SecondPreimage2(A,LRO).main(mess1) @ &m : res ]. + + by byequiv=> //=; proc; inline*; sim. + have->: Pr [ SecondPreimage2(A,LRO).main(mess1) @ &m : res ] = + Pr [ SecondPreimage2(A,RO).main(mess1) @ &m : res ]. + + have->: Pr [ SecondPreimage2(A,LRO).main(mess1) @ &m : res ] = + Pr [ SecondPreimage3(A,LRO).main(mess1) @ &m : res ]. + - by byequiv=> //=; proc; inline*; wp 15 -2; sim. + have->: Pr [ SecondPreimage3(A,LRO).main(mess1) @ &m : res ] = + Pr [ SecondPreimage3(A,RO).main(mess1) @ &m : res ]. + - rewrite eq_sym. + byequiv=>//=; proc. + call(RO_LRO_D (D1(A)) _); first by rewrite sampleto_ll. + by inline*; auto. + by byequiv=> //=; proc; inline*; wp -2 18; sim. + byphoare(: arg = mess1 ==> _)=>//=; proc. + seq 1 : (rng (rem RO.m mess1) (oget RO.m.[mess1])) + (bound%r * mu1 sampleto witness) 1%r + 1%r (mu1 sampleto witness) + (card (fdom RO.m) - 1 <= Bounder.bounder <= bound + /\ mess1 \in RO.m /\ mess1 = m1). + + inline*; auto; call(: card (fdom RO.m) - 1 <= Bounder.bounder <= bound + /\ mess1 \in RO.m). + - proc; inline*; auto; sp; if; sp; auto; if; last by auto; smt(). + auto=> /> &h c Hc _ Hdom Hc2 _ sample. + by rewrite sampleto_full/=!fdom_set !fcardU !fcard1;smt(mem_set fcard_ge0). + auto=> /> sample. + by rewrite mem_set mem_empty/= fdom_set fdom0 fset0U fcard1; smt(bound_gt0). + + call(: arg = mess1 ==> rng (rem RO.m mess1) (oget RO.m.[mess1])); auto. + bypr=> {&m} &m h; rewrite h. + fel 2 Bounder.bounder (fun _, mu1 sampleto witness) bound + (mess1 \in RO.m /\ rng (rem RO.m mess1) (oget RO.m.[mess1])) + [Bounder(RO).get: (card (fdom RO.m) - 1 <= Bounder.bounder < bound)] + (card (fdom RO.m) - 1 <= Bounder.bounder <= bound /\ mess1 \in RO.m)=> {h} + =>//. + + rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. + rewrite ler_maxr //=; 1:smt(bound_gt0). + rewrite-RField.AddMonoid.iteropE-RField.intmulpE; 1: smt(bound_gt0). + by rewrite RField.intmulr; smt(mu_bounded bound_gt0). + + inline*; auto=> /> r. + rewrite mem_empty /= !mem_set mem_empty/= sampleto_full /=. + rewrite get_set_sameE//= fdom_set fdom0 fset0U fcard1 /= rngE /=; split; 2: smt(bound_gt0). + by rewrite negb_exists/= => a; rewrite remE get_setE //= emptyE; smt(). + + proc; inline*; sp; if; last by hoare; auto. + sp; if; sp; last by hoare; auto; smt(mu_bounded). + case: (x0 \in RO.m)=> //=. + - by hoare; auto; smt(mu_bounded). + rcondt 2; 1: auto; wp=> /=. + conseq(:_ ==> pred1 (oget RO.m.[mess1]) r)=> />. + - move=> /> &h d c H0c Hcb Hnrng Hmc _ Hdom1 _ Hdom2 sample. + rewrite mem_set Hdom1 /= get_set_neqE; 1: smt(). + have->: (rem RO.m{h}.[x{h} <- sample] mess1) = (rem RO.m{h} mess1).[x{h} <- sample]. + + by apply fmap_eqP=> y; rewrite remE 2!get_setE remE; smt(). + move: Hnrng; rewrite Hdom1 /= rngE /= negb_exists /= => Hnrng. + rewrite rngE/= => [][] mess; rewrite get_setE remE. + by have:= Hnrng mess; rewrite remE; smt(). + rnd; auto; progress. + by have ->:= sampleto_fu witness (oget RO.m{hr}.[mess1]). + + move=> c; proc; inline*; sp; if; auto; sp; if; auto; progress. + - smt(). + - by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + - smt(). + - smt(mem_set). + - smt(). + - smt(). + - smt(). + - smt(). + - smt(). + - smt(). + + move=> b c; proc; inline*; sp; if; auto; sp; if; auto; smt(). + + by inline*; auto. + + by auto. + + inline*. + if; sp; last by hoare; auto; smt(mu_bounded). + rcondf 2; 1: auto. + case(increase_counter Counter.c SecondPreimage2.m2 < bound_counter); last first. + - by rcondf 3; 1: auto; hoare; auto; smt(mu_bounded). + rcondt 3; 1: auto. + swap 3 -2; sp. + case: (SecondPreimage2.m2 \in RO.m). + - rcondf 5; 1: auto; hoare; auto=> /> &h d _ _ in_dom1 not_rng _ _ in_dom2. + move=> sample2 _ sample1 _; rewrite negb_and/=. + move: not_rng; rewrite rngE /= negb_exists /= => /(_ SecondPreimage2.m2{h}). + rewrite remE; case: (SecondPreimage2.m2{h} = m1{h})=> //=. + by move: in_dom1 in_dom2; smt(). + rcondt 5; 1: auto; wp; rnd (pred1 hash1); auto. + move => /> &h d _ _ in_dom1 not_rng _ _ nin_dom2 sample2 _. + rewrite (sampleto_fu (oget RO.m{h}.[m1{h}]) witness) /= => sample1 _. + by rewrite get_set_sameE => ->. + smt(). + qed. + +end section SecondPreimage. + + +(*--------------------------------------------------------------------------*) +module type AdvCollision (F : Oracle) = { + proc guess() : from * from +}. + +module Collision (A : AdvCollision, F : RO) = { + proc main () : bool = { + var b,m1,m2,hash1,hash2; + Bounder(F).init(); + (m1,m2) <@ A(Bounder(F)).guess(); + if (increase_counter Counter.c m1 < bound_counter) { + Counter.c <- increase_counter Counter.c m1; + hash1 <@ F.get(m1); + if (increase_counter Counter.c m2 < bound_counter) { + Counter.c <- increase_counter Counter.c m2; + hash2 <@ F.get(m2); + b <- hash1 = hash2 /\ m1 <> m2; + } else b <- false; + } + else b <- false; + return b; + } +}. + +section Collision. + + declare module A <: AdvCollision {-RO, -FRO, -Bounder}. + + local module FEL (A : AdvCollision, F : RO) = { + proc main () : from * from = { + var m1,m2; + Bounder(F).init(); + (m1,m2) <@ A(Bounder(F)).guess(); + return (m1,m2); + } + }. + + local module Collision2 (A : AdvCollision) (F : RO) = { + proc main () : bool = { + var b,m1,m2,hash1,hash2; + (m1,m2) <@ FEL(A,F).main(); + if (increase_counter Counter.c m1 < bound_counter) { + Counter.c <- increase_counter Counter.c m1; + hash1 <@ F.get(m1); + if (increase_counter Counter.c m2 < bound_counter) { + Counter.c <- increase_counter Counter.c m2; + hash2 <@ F.get(m2); + b <- hash1 = hash2 /\ m1 <> m2; + } else b <- false; + } + else b <- false; + return b; + } + }. + + op collision (m : ('a, 'b) fmap) = + exists m1 m2, m1 <> m2 /\ m1 \in m /\ m2 \in m /\ m.[m1] = m.[m2]. + + lemma RO_is_collision_resistant &m : + Pr [ Collision(A,RO).main() @ &m : res ] + <= ((bound * (bound - 1) + 2)%r / 2%r * mu1 sampleto witness). + proof. + have->: Pr [ Collision(A,RO).main() @ &m : res ] = + Pr [ Collision2(A,RO).main() @ &m : res ]. + + by byequiv=>//=; proc; inline*; sim. + byphoare=> //; proc. + seq 1 : (collision RO.m) + ((bound * (bound - 1))%r / 2%r * mu1 sampleto witness) 1%r + 1%r (mu1 sampleto witness) + (card (fdom RO.m) <= Bounder.bounder <= bound); first last; first last. + + auto. + + auto. + + inline*. + if; sp; last first. + - by hoare; auto; smt(mu_bounded). + case: (increase_counter Counter.c m2 < bound_counter); last first. + - rcondf 4; 1:auto; hoare; auto; smt(mu_bounded). + rcondt 4; 1: auto. + swap 4 -3. + case: (m1 = m2). + - by hoare; auto. + case: (m1 \in RO.m); case: (m2 \in RO.m). + - rcondf 3; 1: auto; rcondf 6; 1: auto; hoare; auto. + move=> /> &h d _ _ Hcoll _ _ neq12 in_dom1 in_dom2 _ _ _ _. + move: Hcoll; rewrite /collision negb_exists /= => /(_ m1{h}). + rewrite negb_exists /= => /(_ m2{h}). + by rewrite neq12 in_dom1 in_dom2 /=; smt(). + - rcondf 3; 1: auto; rcondt 6; 1: auto; wp; rnd (pred1 hash1). + auto=> /> &h d Hmc Hcb Hcoll _ _ neq12 in_dom1 in_dom2 _ _; split. + * smt(sampleto_fu). + by move=> _ sample _; rewrite get_set_sameE; smt(). + - rcondt 3; 1: auto; rcondf 7; 1: (by auto; smt(mem_set)). + swap 6 -5; wp=> /=; rnd (pred1 (oget RO.m.[m2])); auto. + move=> /> &h d _ _ Hcoll _ _ neq12 in_dom1 in_dom2 _ _; split. + * smt(sampleto_fu). + move=> _ sample _. + by rewrite get_set_sameE get_set_neqE 1:eq_sym. + rcondt 3; 1: auto; rcondt 7; 1: (by auto; smt(mem_set)). + swap 2 -1; swap 6 -4; wp=> //=; rnd (pred1 r); auto. + move=> /> &h d _ _ Hcoll _ _ neq12 in_dom1 in_dom2 sample1 _; split. + * smt(sampleto_fu). + move=> _ sample2 _. + by rewrite get_set_sameE get_set_sameE; smt(). + + by move=> />; smt(mu_bounded). + + inline*; wp; call(: card (fdom RO.m) <= Bounder.bounder <= bound); auto. + - proc; inline*; sp; if; auto; sp; if; last by auto; smt(). + auto=> /> &h d Hbc _ Hcb _ sample _; split. + * by move=> nin_dom1; rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + by move=> in_dom1; smt(). + by move=> />; rewrite fdom0 fcards0; smt(bound_gt0). + call(: true ==> collision RO.m); auto; bypr=> /> {&m} &m. + fel 1 Bounder.bounder (fun i, i%r * mu1 sampleto witness) bound + (collision RO.m) + [Bounder(RO).get: (card (fdom RO.m) <= Bounder.bounder < bound)] + (card (fdom RO.m) <= Bounder.bounder <= bound)=> //. + + rewrite -StdBigop.Bigreal.BRA.mulr_suml RField.mulrAC. + rewrite StdOrder.RealOrder.ler_wpmul2r; 1: smt(mu_bounded). + by rewrite StdBigop.Bigreal.sumidE //; smt(bound_gt0). + + inline*; auto=> />. + rewrite fdom0 fcards0; split; 2: smt(bound_gt0). + rewrite /collision negb_exists /= => a; rewrite negb_exists /= => b. + by rewrite mem_empty. + + bypr=> /> {&m} &m; pose c := Bounder.bounder{m}; move=> H0c Hcbound Hcoll Hmc _. + byphoare(: !collision RO.m /\ card (fdom RO.m) <= c ==> _)=>//=. + proc; inline*; sp; if; last first. + - by hoare; auto; smt(mu_bounded). + sp; if; last by hoare; auto; smt(mu_bounded). + case: (x \in RO.m). + - by hoare; auto; smt(mu_bounded). + rcondt 4; 1: auto; sp; wp=> /=. + conseq(:_==> r \in frng RO.m). + - move=> /> &h d c2 Hcoll2 Hb2c Hc2b _ nin_dom sample m1 m2 neq. + rewrite 2!mem_set. + case: (m1 = x{h}) => //=. + * move=> <<-; rewrite eq_sym neq /= get_set_sameE get_set_neqE//= 1:eq_sym //. + by rewrite mem_frng rngE /= => _ ->; exists m2. + case: (m2 = x{h}) => //=. + * move=> <<- _ in_dom1. + by rewrite get_set_neqE // get_set_sameE mem_frng rngE/= => <-; exists m1. + move=> neq2 neq1 in_dom1 in_dom2; rewrite get_set_neqE // get_set_neqE //. + have:= Hcoll2; rewrite negb_exists /= => /(_ m1). + rewrite negb_exists /= => /(_ m2). + by rewrite neq in_dom1 in_dom2 /= => ->. + rnd; skip=> /> &h c0 bounder _ h _. + rewrite (mu_mem (frng RO.m{h}) sampleto (mu1 sampleto witness)); 1: smt(sampleto_fu). + rewrite StdOrder.RealOrder.ler_wpmul2r //. + by rewrite le_fromint; smt(le_card_frng_fdom). + + move=> c; proc; sp; if; auto; inline*; auto; sp; if; last by auto; smt(). + auto=> /> &h d h1 _ h2 sample _. + by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + move=> b c; proc; inline*; sp; if; auto; sp; if; auto; 2: smt(). + move=> /> &h h1 h2 _ h3 _ sample _. + by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + qed. + + +end section Collision. diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec new file mode 100644 index 0000000..7ad47bb --- /dev/null +++ b/sha3/proof/Sponge.ec @@ -0,0 +1,2163 @@ +(*------------------------- Sponge Construction ------------------------*) +require import Core Int IntDiv Real List FSet SmtMap. +require import Distr DBool DList. +require import Ring StdBigop StdOrder. import IntID IntOrder. +require import Common PROM. +require (*--*) IRO BlockSponge. + +(*------------------------- Indifferentiability ------------------------*) + +clone include Indifferentiability with + type p <- block * capacity, + type f_in <- bool list * int, + type f_out <- bool list + + rename + [module] "Indif" as "Experiment" + [module] "GReal" as "RealIndif" + [module] "GIdeal" as "IdealIndif". + +(*------------------------- Ideal Functionality ------------------------*) + +clone import IRO as BIRO with + type from <- bool list, + type to <- bool, + op valid <- valid_toplevel, + op dto <- dbool. + +(*------------------------- Sponge Construction ------------------------*) + +module StdSponge (P : DPRIMITIVE) = { + proc init() : unit = {} + + proc f(bs : bool list, n : int) : bool list = { + var z <- []; + var (sa, sc) <- (b0, Capacity.c0); + var finished <- false; + var xs <- pad2blocks bs; + + (* absorption *) + while (xs <> []) { + (sa, sc) <@ P.f(sa +^ head b0 xs, sc); + xs <- behead xs; + } + (* squeezing *) + while (!finished) { + z <- z ++ ofblock sa; + if (size z < n) { + (sa, sc) <@ P.f(sa, sc); + } else { + finished <- true; + } + } + + return take n z; + } +}. + +module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { + proc init() : unit = {} + + proc f(bs : bool list, n : int) : bool list = { + var z <- []; + var (sa, sc) <- (b0, Capacity.c0); + var i <- 0; + var xs <- pad2blocks bs; + + (* absorption *) + while (xs <> []) { + (sa, sc) <@ P.f(sa +^ head b0 xs, sc); + xs <- behead xs; + } + (* squeezing *) + while (i < (n + r - 1) %/ r) { + z <- z ++ ofblock sa; + i <- i + 1; + if (i < (n + r - 1) %/ r) { + (sa, sc) <@ P.f(sa, sc); + } + } + + return take n z; + } +}. + +lemma loop_cond i n: 0 <= i => 0 <= n => r * i < n <=> i < (n + r - 1) %/ r. +proof. +move=> ge0_i; elim: i ge0_i n=> /= [|i ge0_i ih n ge0_n]. ++ smt(gt0_n). +case: (r %| n). ++ move=> ^/dvdzE n_mod_r /needed_blocks_eq_div_r <-. + by rewrite -(ltr_pmul2r r gt0_r (i + 1)) divzE n_mod_r /#. +move=> r_ndvd_n. rewrite -ltr_subr_addr -(addzC (-1)). +rewrite -divzMDr 1:#smt:(gt0_r) Ring.IntID.mulN1r. +have ->: n + r - 1 - r = (n - r) + r - 1 by smt(). +case: (0 <= n - r)=> [n_ge_r|/ltzNge n_lt_r /#]. +by rewrite -ih /#. +qed. + +equiv Sponge_is_StdSponge (P <: DPRIMITIVE): + StdSponge(P).f ~ Sponge(P).f: ={glob P, bs, n} ==> ={glob P, res}. +proof. +proc; seq 5 5: (={glob P, z, sa, sc, xs, n} /\ !finished{1} /\ i{2} = 0 /\ z{1} = []). ++ while (={glob P, xs, sa, sc}); 2:by auto. + by auto; call (: true). +case: (n{1} <= 0). ++ rcondt{1} 1=> //=; rcondf{1} 2. + + by auto; smt(size_ge0). + rcondf{1} 3; 1:by auto. + rcondf{2} 1. + + by auto=> /> &hr /needed_blocks_non_pos /#. + by auto=> /> &1 &2 _ n_le0; rewrite !take_le0. +while ( ={glob P, z, n, sa, sc} + /\ (finished{1} <=> n{1} <= size z{1}) + /\ size z{1} = r * i{2} + /\ 0 < n{1} + /\ 0 <= i{2}). ++ sp; if=> />. + + move=> &2 i z; rewrite size_cat size_block=> -> gt0_n ge0_i /ltzNge gt_ri_n gt_i_nbl. + by rewrite -(mulzDr r i 1) loop_cond /#. + + call (: true); auto=> /> &2 i z; rewrite size_cat size_block=> -> gt0_n ge0_i /ltzNge gt_ri_n gt_i_nbl. + move=> ^ + /ltzNge -> /=; rewrite mulzDr /=. + by rewrite -(mulzDr r i 1) loop_cond /#. + + auto=> /> &2 i z; rewrite size_cat size_block=> -> gt0_n ge0_i /ltzNge gt_ri_n gt_i_nbl. + move=> ^ + /lezNgt -> /=; rewrite mulzDr /=. + by rewrite -(mulzDr r i 1) loop_cond /#. +by auto=> /> &1 &2 _ /ltrNge gt0_n; smt(gt0_r). +qed. + +(*------------- Simulator and Distinguisher Constructions --------------*) + +module LowerFun (F : DFUNCTIONALITY) : BlockSponge.DFUNCTIONALITY = { + proc f(xs : block list, n : int) = { + var cs, ds : bool list; + var obs : bool list option; + var ys : block list <- []; + + obs <- unpad_blocks xs; + if (obs <> None) { + cs <@ F.f(oget obs, n * r); (* size cs = n * r *) + ys <- bits2blocks cs; (* size ys = n *) + } + return ys; + } +}. + +module RaiseFun (F : BlockSponge.DFUNCTIONALITY) : DFUNCTIONALITY = { + proc f(bs : bool list, n : int) = { + var xs; + + xs <@ F.f(pad2blocks bs, (n + r - 1) %/ r); + return take n (blocks2bits xs); + } +}. + +module LowerDist (D : DISTINGUISHER, F : BlockSponge.DFUNCTIONALITY) = + D(RaiseFun(F)). + +module RaiseSim (S : BlockSponge.SIMULATOR, F : DFUNCTIONALITY) = + S(LowerFun(F)). + +(* Our main result will be: + + lemma conclusion + (BlockSim <: BlockSponge.SIMULATOR{-IRO, -BlockSponge.BIRO.IRO}) + (Dist <: DISTINGUISHER{-Perm, -BlockSim, -IRO, -BlockSponge.BIRO.IRO}) + &m : + `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m : res] - + Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res]| = + `|Pr[BlockSponge.RealIndif + (BlockSponge.Sponge, Perm, LowerDist(Dist)).main() @ &m : res] - + Pr[BlockSponge.IdealIndif + (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main() @ &m : res]| +*) + +(*------------------------------- Proof --------------------------------*) + +(* Proving the Real side + + Pr[RealIndif(Sponge, Perm, Dist).main() @ &m : res] = + Pr[BlockSponge.RealIndif + (BlockSponge.Sponge, Perm, LowerDist(Dist)).main() @ &m : res] + + is easy (see lemma RealIndif_Sponge_BlockSponge) + + And we split the proof of the Ideal side (IdealIndif_IRO_BlockIRO) + + Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = + Pr[BlockSponge.IdealIndif + (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res]. + + into three steps, involving Hybrid IROs, which, in addition to + an init procedure, have the procedure + + (* hashing block lists, giving n bits *) + proc f(x : block list, n : int) : bool list + + We have lazy (HybridIROLazy) and eager (HybridIROEager) Hybrid + IROs, both of which work with a finite map from block list * int to + bool. In both versions, as in BlockSponge.BIRO.IRO, f returns [] if + x isn't a valid block list. + + In the lazy version, f consults/randomly updates just those + elements of the map's domain needed to produce the needed bits. But + the eager version goes further, consulting/randomly updating enough + extra domain elements so that a multiple of r domain elements are + consulted/randomly updated (those extra bits are discarded) + + We have a parameterized module RaiseHybridIRO for turning a Hybrid + IRO into a FUNCTIONALITY in the obvious way, and we have a + parameterized module LowerHybridIRO for turning a Hybrid IRO into a + DFUNCTIONALITY in the obivous way. We split the proof of the Ideal + side into three steps: + + Step 1: + + Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = + Pr[Experiment + (RaiseHybridIRO(HybridIROLazy), + BlockSim(LowerHybridIRO(HybridIROLazy)), + Dist).main() @ &m : res] + + This step is proved using a lazy invariant relating the + maps of the bit-based IRO and HybridIROLazy + + Step 2: + + Pr[Experiment + (RaiseHybridIRO(HybridIROLazy), + BlockSim(LowerHybridIRO(HybridIROLazy)), + Dist).main() @ &m : res] = + Pr[Experiment + (RaiseHybridIRO(HybridIROEager), + BlockSim(LowerHybridIRO(HybridIROEager)), + Dist).main() @ &m : res] + + This step is proved using the eager sampling lemma provided by + PROM. + + Step 3: + + Pr[Experiment + (RaiseHybridIRO(HybridIROEager), + BlockSim(LowerHybridIRO(HybridIROEager)), + Dist).main() @ &m : res] = + Pr[BlockSponge.IdealIndif + (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res] + + This step is proved using an invariant relating the maps of + HybridIROEager and the block-based IRO. Its proof is the most + involved, and uses the Program abstract theory of DList to show the + equivalence of randomly choosing a block and forming a block out + of r randomly chosen bits *) + +(*------------------- abstract theory of Hybrid IROs -------------------*) + +abstract theory HybridIRO. + +module type HYBRID_IRO = { + (* initialization *) + proc init() : unit + + (* hashing block lists, giving n bits *) + proc f(x : block list, n : int) : bool list +}. + +(* distinguisher for Hybrid IROs *) + +module type HYBRID_IRO_DIST(HI : HYBRID_IRO) = { + proc distinguish() : bool {HI.f} +}. + +(* experiments for Hybrid IROs *) + +module HybridIROExper(HI : HYBRID_IRO, D : HYBRID_IRO_DIST) = { + proc main() : bool = { + var b : bool; + HI.init(); + b <@ D(HI).distinguish(); + return b; + } +}. + +(* lazy implementation of Hybrid IROs *) + +module HybridIROLazy : HYBRID_IRO = { + var mp : (block list * int, bool) fmap + + proc init() : unit = { + mp <- empty; + } + + proc fill_in(xs : block list, i : int) = { + var r; + + if (! dom mp (xs, i)) { + r <$ dbool; + mp.[(xs, i)] <- r; + } + return oget mp.[(xs, i)]; + } + + proc f(xs : block list, n : int) = { + var b, bs; + var i <- 0; + + bs <- []; + if (valid_block xs) { + while (i < n) { + b <@ fill_in(xs, i); + bs <- rcons bs b; + i <- i + 1; + } + } + return bs; + } +}. + +(* eager implementation of Hybrid IROs *) + +module HybridIROEager : HYBRID_IRO = { + (* same as lazy implementation, except for indicated part *) + var mp : (block list * int, bool) fmap + + proc init() : unit = { + mp <- empty; + } + + proc fill_in(xs : block list, i : int) = { + var r; + + if (! dom mp (xs, i)) { + r <$ dbool; + mp.[(xs, i)] <- r; + } + return oget mp.[(xs, i)]; + } + + proc f(xs : block list, n : int) = { + var b, bs; + var m <- ((n + r - 1) %/ r) * r; (* eager part *) + var i <- 0; + + bs <- []; + if (valid_block xs) { + while (i < n) { + b <@ fill_in(xs, i); + bs <- rcons bs b; + i <- i + 1; + } + while (i < m) { (* eager part *) + fill_in(xs, i); + i <- i + 1; + } + } + return bs; + } +}. + +(* we are going to use PROM.GenEager to prove: + +lemma HybridIROExper_Lazy_Eager + (D <: HYBRID_IRO_DIST{-HybridIROEager, -HybridIROLazy}) &m : + Pr[HybridIROExper(HybridIROLazy, D).main() @ &m : res] = + Pr[HybridIROExper(HybridIROEager, D).main() @ &m : res]. +*) + +section. + +declare module D <: HYBRID_IRO_DIST {-HybridIROEager, -HybridIROLazy}. + +local clone import PROM.FullRO as ERO with + type in_t <- block list * int, + type out_t <- bool, + op dout _ <- dbool, + type d_in_t <- unit, + type d_out_t <- bool. + +local module EROExper(O : ERO.RO, D : ERO.RO_Distinguisher) = { + proc main() : bool = { + var b : bool; + O.init(); + b <@ D(O).distinguish(); + return b; + } +}. + +local lemma LRO_RO (D <: ERO.RO_Distinguisher{-ERO.RO, -ERO.FRO}) &m : + Pr[EROExper(LRO, D).main() @ &m : res] = + Pr[EROExper(ERO.RO, D).main() @ &m : res]. +proof. +byequiv=> //; proc. +seq 1 1 : (={glob D, ERO.RO.m}); first sim. +by symmetry; call (FullEager.RO_LRO_D D _); auto; rewrite dbool_ll. +qed. + +(* make a Hybrid IRO out of a random oracle *) + +local module HIRO(RO : ERO.RO) : HYBRID_IRO = { + proc init() : unit = { + RO.init(); + } + + proc f(xs, n) = { + var b, bs; + var m <- ((n + r - 1) %/ r) * r; + var i <- 0; + + bs <- []; + if (valid_block xs) { + while (i < n) { + b <@ RO.get(xs, i); + bs <- rcons bs b; + i <- i + 1; + } + while (i < m) { + RO.sample(xs, i); + i <- i + 1; + } + } + return bs; + } +}. + +local lemma HybridIROLazy_HIRO_LRO_init : + equiv[HybridIROLazy.init ~ HIRO(LRO).init : + true ==> HybridIROLazy.mp{1} = ERO.RO.m{2}]. +proof. proc; inline*; auto. qed. + +local lemma HybridIROLazy_fill_in_LRO_get : + equiv[HybridIROLazy.fill_in ~ LRO.get : + (xs, i){1} = x{2} /\ HybridIROLazy.mp{1} = ERO.RO.m{2} ==> + ={res} /\ HybridIROLazy.mp{1} = ERO.RO.m{2}]. +proof. +proc=> /=. +case ((dom HybridIROLazy.mp{1}) (xs{1}, i{1})). +rcondf{1} 1; first auto. rcondf{2} 2; first auto. +rnd{2}; auto; progress; apply dbool_ll. +rcondt{1} 1; first auto. rcondt{2} 2; first auto. +wp; rnd; auto. +qed. + +local lemma HybridIROLazy_HIRO_LRO_f : + equiv[HybridIROLazy.f ~ HIRO(LRO).f : + ={xs, n} /\ HybridIROLazy.mp{1} = ERO.RO.m{2} ==> + ={res} /\ HybridIROLazy.mp{1} = ERO.RO.m{2}]. +proof. +proc; inline LRO.sample; sp=> /=. +if=> //. +while{2} (true) (m{2} - i{2}). +progress; auto; progress; smt(). +while (={xs, n, i, bs} /\ HybridIROLazy.mp{1} = ERO.RO.m{2}). +wp; call HybridIROLazy_fill_in_LRO_get; auto. +auto; progress; smt(). +qed. + +local lemma HIRO_RO_HybridIROEager_init : + equiv[HIRO(ERO.RO).init ~ HybridIROEager.init : + true ==> ={res} /\ ERO.RO.m{1} = HybridIROEager.mp{2}]. +proof. proc; inline*; auto. qed. + +local lemma RO_get_HybridIROEager_fill_in : + equiv[ERO.RO.get ~ HybridIROEager.fill_in : + x{1} = (xs, i){2} /\ ERO.RO.m{1} = HybridIROEager.mp{2} ==> + ={res} /\ ERO.RO.m{1} = HybridIROEager.mp{2}]. +proof. +proc=> /=. +case (dom HybridIROEager.mp{2} (xs{2}, i{2})). +rcondf{1} 2; first auto. rcondf{2} 1; first auto. +rnd{1}; auto; progress; apply dbool_ll. +rcondt{1} 2; first auto. rcondt{2} 1; first auto. +wp; rnd; auto. +qed. + +local lemma RO_sample_HybridIROEager_fill_in : + equiv[ERO.RO.sample ~ HybridIROEager.fill_in : + x{1} = (xs, i){2} /\ ERO.RO.m{1} = HybridIROEager.mp{2} ==> + ERO.RO.m{1} = HybridIROEager.mp{2}]. +proof. +proc=> /=; inline ERO.RO.get; sp. +case (dom HybridIROEager.mp{2} (xs{2}, i{2})). +rcondf{1} 2; first auto. rcondf{2} 1; first auto. +rnd{1}; auto; progress; apply dbool_ll. +rcondt{1} 2; first auto. rcondt{2} 1; first auto. +wp; rnd; auto. +qed. + +local lemma HIRO_RO_HybridIROEager_f : + equiv[HIRO(ERO.RO).f ~ HybridIROEager.f : + ={xs, n} /\ ERO.RO.m{1} = HybridIROEager.mp{2} ==> + ={res} /\ ERO.RO.m{1} = HybridIROEager.mp{2}]. +proof. +proc; first sp=> /=. +if=> //. +while (={i, m, xs} /\ ERO.RO.m{1} = HybridIROEager.mp{2}). +wp; call RO_sample_HybridIROEager_fill_in; auto. +while (={i, n, xs, bs} /\ ERO.RO.m{1} = HybridIROEager.mp{2}). +wp; call RO_get_HybridIROEager_fill_in; auto. +auto. +qed. + +(* make distinguisher for random oracles out of HIRO and D *) + +local module RODist(RO : ERO.RO) = { + proc distinguish() : bool = { + var b : bool; + b <@ D(HIRO(RO)).distinguish(); + return b; + } +}. + +local lemma Exper_HybridIROLazy_LRO &m : + Pr[HybridIROExper(HybridIROLazy, D).main() @ &m : res] = + Pr[EROExper(LRO, RODist).main() @ &m : res]. +proof. +byequiv=> //; proc; inline*; wp. +seq 1 1 : (={glob D} /\ HybridIROLazy.mp{1} = ERO.RO.m{2}); first auto. +call (_ : HybridIROLazy.mp{1} = ERO.RO.m{2}). +conseq HybridIROLazy_HIRO_LRO_f. +auto. +qed. + +local lemma Exper_RO_HybridIROEager &m : + Pr[EROExper(ERO.RO, RODist).main() @ &m : res] = + Pr[HybridIROExper(HybridIROEager, D).main() @ &m : res]. +proof. +byequiv=> //; proc; inline*; wp. +seq 1 1 : (={glob D} /\ ERO.RO.m{1} = HybridIROEager.mp{2}); first auto. +call (_ : ERO.RO.m{1} = HybridIROEager.mp{2}). +conseq HIRO_RO_HybridIROEager_f. +auto. +qed. + +lemma HybridIROExper_Lazy_Eager' &m : + Pr[HybridIROExper(HybridIROLazy, D).main() @ &m : res] = + Pr[HybridIROExper(HybridIROEager, D).main() @ &m : res]. +proof. +by rewrite (Exper_HybridIROLazy_LRO &m) + (LRO_RO RODist &m) + (Exper_RO_HybridIROEager &m). +qed. + +end section. + +lemma HybridIROExper_Lazy_Eager + (D <: HYBRID_IRO_DIST{-HybridIROEager, -HybridIROLazy}) &m : + Pr[HybridIROExper(HybridIROLazy, D).main() @ &m : res] = + Pr[HybridIROExper(HybridIROEager, D).main() @ &m : res]. +proof. by apply (HybridIROExper_Lazy_Eager' D &m). qed. + +(* turn a Hybrid IRO implementation (lazy or eager) into top-level + ideal functionality *) + +module RaiseHybridIRO (HI : HYBRID_IRO) : FUNCTIONALITY = { + proc init() = { + HI.init(); + } + + proc f(bs : bool list, n : int) = { + var cs; + cs <@ HI.f(pad2blocks bs, n); + return cs; + } +}. + +(* turn a Hybrid IRO implementation (lazy or eager) into lower-level + ideal distinguisher functionality *) + +module LowerHybridIRO (HI : HYBRID_IRO) : BlockSponge.DFUNCTIONALITY = { + proc f(xs : block list, n : int) = { + var bs, ys; + bs <@ HI.f(xs, n * r); + ys <- bits2blocks bs; + return ys; + } +}. + +(* invariant relating maps of BIRO.IRO and HybridIROLazy *) + +pred lazy_invar + (mp1 : (bool list * int, bool) fmap, + mp2 : (block list * int, bool) fmap) = + (forall (bs : bool list, n : int), + dom mp1 (bs, n) <=> dom mp2 (pad2blocks bs, n)) /\ + (forall (xs : block list, n), + dom mp2 (xs, n) => valid_block xs) /\ + (forall (bs : bool list, n : int), + dom mp1 (bs, n) => + oget mp1.[(bs, n)] = oget mp2.[(pad2blocks bs, n)]). + +lemma lazy_invar0 : lazy_invar empty empty. +proof. +split; first smt(mem_empty). +split; first smt(mem_empty). +smt(mem_empty). +qed. + +lemma lazy_invar_mem_pad2blocks_l2r + (mp1 : (bool list * int, bool) fmap, + mp2 : (block list * int, bool) fmap, + bs : bool list, i : int) : + lazy_invar mp1 mp2 => dom mp1 (bs, i) => + dom mp2 (pad2blocks bs, i). +proof. smt(). qed. + +lemma lazy_invar_mem_pad2blocks_r2l + (mp1 : (bool list * int, bool) fmap, + mp2 : (block list * int, bool) fmap, + bs : bool list, i : int) : + lazy_invar mp1 mp2 => dom mp2 (pad2blocks bs, i) => + dom mp1 (bs, i). +proof. smt(). qed. + +lemma lazy_invar_vb + (mp1 : (bool list * int, bool) fmap, + mp2 : (block list * int, bool) fmap, + xs : block list, n : int) : + lazy_invar mp1 mp2 => dom mp2 (xs, n) => + valid_block xs. +proof. smt(). qed. + +lemma lazy_invar_lookup_eq + (mp1 : (bool list * int, bool) fmap, + mp2 : (block list * int, bool) fmap, + bs : bool list, n : int) : + lazy_invar mp1 mp2 => dom mp1 (bs, n) => + oget mp1.[(bs, n)] = oget mp2.[(pad2blocks bs, n)]. +proof. smt(). qed. + +lemma lazy_invar_upd_mem_dom_iff + (mp1 : (bool list * int, bool) fmap, + mp2 : (block list * int, bool) fmap, + bs cs : bool list, n m : int, b : bool) : + lazy_invar mp1 mp2 => + dom mp1.[(bs, n) <- b] (cs, m) <=> + dom mp2.[(pad2blocks bs, n) <- b] (pad2blocks cs, m). +proof. +move=> li; split=> [mem_upd_mp1 | mem_upd_mp2]. +rewrite mem_set; rewrite mem_set in mem_upd_mp1. +case: ((cs, m) = (bs, n))=> [cs_m_eq_bs_n | cs_m_neq_bs_n]. +right; by elim cs_m_eq_bs_n=> -> ->. +left; smt(). +rewrite mem_set; rewrite mem_set in mem_upd_mp2. +case: ((cs, m) = (bs, n))=> [// | cs_m_neq_bs_n]. +elim mem_upd_mp2=> [/# | [p2b_cs_p2b_bs eq_mn]]. +have /# : cs = bs by apply pad2blocks_inj. +qed. + +lemma lazy_invar_upd2_vb + (mp1 : (bool list * int, bool) fmap, + mp2 : (block list * int, bool) fmap, + bs : bool list, xs : block list, n m : int, b : bool) : + lazy_invar mp1 mp2 => + dom mp2.[(pad2blocks bs, n) <- b] (xs, m) => + valid_block xs. +proof. +move=> li mem_upd_mp2. +rewrite mem_set in mem_upd_mp2. +elim mem_upd_mp2=> [/# | [-> _]]. +apply valid_pad2blocks. +qed. + +lemma lazy_invar_upd_lu_eq + (mp1 : (bool list * int, bool) fmap, + mp2 : (block list * int, bool) fmap, + bs cs : bool list, n m : int, b : bool) : + lazy_invar mp1 mp2 => + dom mp1.[(bs, n) <- b] (cs, m) => + oget mp1.[(bs, n) <- b].[(cs, m)] = + oget mp2.[(pad2blocks bs, n) <- b].[(pad2blocks cs, m)]. +proof. +move=> li mem_upd_mp1. +case: ((cs, m) = (bs, n))=> [[-> ->] | cs_m_neq_bs_n]. ++ by rewrite !get_set_sameE. +rewrite mem_set in mem_upd_mp1. +elim mem_upd_mp1=> [mem_mp1 | [-> ->]]. ++ case: ((pad2blocks bs, n) = (pad2blocks cs, m))=> + [[p2b_bs_p2b_cs ->>] | p2b_bs_n_neq_p2b_cs_m]. + + move: (pad2blocks_inj _ _ p2b_bs_p2b_cs)=> ->>. + by move: cs_m_neq_bs_n=> //=. + rewrite !get_set_neqE 1:// 1:eq_sym //. + by move: li=> [] _ [] _ /(_ _ _ mem_mp1). +by rewrite !get_set_sameE. +qed. + +lemma LowerFun_IRO_HybridIROLazy_f : + equiv[LowerFun(IRO).f ~ LowerHybridIRO(HybridIROLazy).f : + ={xs, n} /\ lazy_invar IRO.mp{1} HybridIROLazy.mp{2} ==> + ={res} /\ lazy_invar IRO.mp{1} HybridIROLazy.mp{2}]. +proof. +proc=> /=; inline HybridIROLazy.f. +seq 0 1 : + (={n} /\ xs{1} = xs0{2} /\ + lazy_invar IRO.mp{1} HybridIROLazy.mp{2}); first auto. +case (valid_block xs{1}). +rcondt{1} 3; first auto. rcondt{2} 4; first auto. +inline*. rcondt{1} 7; first auto. +seq 6 3 : + (={i, n0} /\ bs{1} = bs0{2} /\ + lazy_invar IRO.mp{1} HybridIROLazy.mp{2} /\ + pad2blocks x{1} = xs0{2}). +auto; progress. + have {2}<- := unpadBlocksK xs0{2}; first + by rewrite (some_oget (unpad_blocks xs0{2})). +wp. +while + (={i, n0} /\ bs{1} = bs0{2} /\ + lazy_invar IRO.mp{1} HybridIROLazy.mp{2} /\ + pad2blocks x{1} = xs0{2}). +sp; auto. +if. +progress; + [by apply (lazy_invar_mem_pad2blocks_l2r IRO.mp{1} + HybridIROLazy.mp{2} x{1} i{2}) | + by apply (lazy_invar_mem_pad2blocks_r2l IRO.mp{1} + HybridIROLazy.mp{2} x{1} i{2})]. +wp; rnd; auto=> |> &1 &2 inv i_lt_n0 xi_notin_m r _. +rewrite !get_set_sameE //=; split=> [bs n|]. ++ exact/(lazy_invar_upd_mem_dom_iff _ _ _ _ _ _ _ inv). +split=> [xs n|bs n]. ++ by move=>/(lazy_invar_upd2_vb _ _ _ _ _ _ _ inv). +by move=>/(lazy_invar_upd_lu_eq _ _ _ _ _ _ _ inv). +auto; progress [-delta]. +by rewrite (lazy_invar_lookup_eq IRO.mp{1} HybridIROLazy.mp{2} x{1} i{2}). +auto. +rcondf{1} 3; first auto. rcondf{2} 4; first auto. +auto; progress; by rewrite bits2blocks_nil. +qed. + +lemma IRO_RaiseHybridIRO_HybridIROLazy_f : + equiv[IRO.f ~ RaiseHybridIRO(HybridIROLazy).f : + ={n} /\ x{1} = bs{2} /\ + lazy_invar IRO.mp{1} HybridIROLazy.mp{2} ==> + ={res} /\ lazy_invar IRO.mp{1} HybridIROLazy.mp{2}]. +proof. +proc=> /=; inline*. +rcondt{1} 3; first auto. +rcondt{2} 5; first auto; progress; apply valid_pad2blocks. +seq 2 4 : + (={i, n} /\ n{1} = n0{2} /\ xs{2} = pad2blocks x{1} /\ bs{1} = bs0{2} /\ + lazy_invar IRO.mp{1} HybridIROLazy.mp{2}); first auto. +wp. +while + (={i, n} /\ n{1} = n0{2} /\ xs{2} = pad2blocks x{1} /\ bs{1} = bs0{2} /\ + lazy_invar IRO.mp{1} HybridIROLazy.mp{2}). +wp; sp. +if. +progress; + [by apply (lazy_invar_mem_pad2blocks_l2r IRO.mp{1} + HybridIROLazy.mp{2} x{1} i{2}) | + by apply (lazy_invar_mem_pad2blocks_r2l IRO.mp{1} + HybridIROLazy.mp{2} x{1} i{2})]. +wp; rnd; auto=> |> &1 &2 inv i_lt_n0 xi_notin_m r _. +rewrite !get_set_sameE=> //=; split=> [bs n|]. ++ exact/(lazy_invar_upd_mem_dom_iff _ _ _ _ _ _ _ inv). +split=> [xs n|bs n]. ++ by move=>/(lazy_invar_upd2_vb _ _ _ _ _ _ _ inv). +by move=>/(lazy_invar_upd_lu_eq _ _ _ _ _ _ _ inv). +auto; progress [-delta]; + by rewrite (lazy_invar_lookup_eq IRO.mp{1} HybridIROLazy.mp{2} x{1} i{2}). +auto. +qed. + +(* invariant relating maps of BlockSponge.BIRO.IRO and HybridIROEager *) + +pred eager_invar + (mp1 : (block list * int, block) fmap, + mp2 : (block list * int, bool) fmap) = + (forall (xs : block list, i : int), + dom mp1 (xs, i) => + 0 <= i /\ + (forall (j : int), i * r <= j < (i + 1) * r => + mp2.[(xs, j)] = + Some(nth false (ofblock (oget mp1.[(xs, i)])) (j - i * r)))) /\ + (forall (xs : block list, j : int), + dom mp2 (xs, j) => dom mp1 (xs, j %/ r)). + +pred block_bits_all_in_dom + (xs : block list, i : int, mp : (block list * int, bool) fmap) = + forall (j : int), i <= j < i + r => dom mp (xs, j). + +pred block_bits_all_out_dom + (xs : block list, i : int, mp : (block list * int, bool) fmap) = + forall (j : int), i <= j < i + r => ! dom mp (xs, j). + +pred block_bits_dom_all_in_or_out + (xs : block list, i : int, mp : (block list * int, bool) fmap) = + block_bits_all_in_dom xs i mp \/ block_bits_all_out_dom xs i mp. + +lemma eager_inv_mem_mp1_ge0 + (mp1 : (block list * int, block) fmap, + mp2 : (block list * int, bool) fmap, + xs : block list, i : int) : + eager_invar mp1 mp2 => dom mp1 (xs, i) => 0 <= i. +proof. move=> [ei1 ei2] mem_mp1_i; smt(). qed. + +lemma eager_inv_mem_mp2_ge0 + (mp1 : (block list * int, block) fmap, + mp2 : (block list * int, bool) fmap, + xs : block list, j : int) : + eager_invar mp1 mp2 => dom mp2 (xs, j) => 0 <= j. +proof. +move=> [ei1 ei2] mem_mp2_j. +have mem_mp1_j_div_r : dom mp1 (xs, j %/ r) by smt(). +have ge0_j_div_r : 0 <= j %/ r by smt(). +smt(divz_ge0 gt0_r). +qed. + +lemma eager_invar0 : eager_invar empty empty. +proof. split; smt(mem_empty). qed. + +lemma eager_inv_imp_block_bits_dom + (mp1 : (block list * int, block) fmap, + mp2 : (block list * int, bool) fmap, + xs : block list, i : int) : + 0 <= i => r %| i => eager_invar mp1 mp2 => + block_bits_dom_all_in_or_out xs i mp2. +proof. +move=> ge0_i r_dvd_i [ei1 ei2]. +case: (dom mp1 (xs, i %/ r))=> [mem_mp1 | not_mem_mp1]. +have ei1_xs_i_div_r := ei1 xs (i %/ r). +have [_ mp2_eq_block_bits] := ei1_xs_i_div_r mem_mp1. +left=> j j_rng. +have mp2_eq_block_bits_j := mp2_eq_block_bits j _. + by rewrite divzK // mulzDl /= divzK. +rewrite domE /#. +right=> j j_rng. +case: (dom mp2 (xs, j))=> // mem_mp2 /=. +have mem_mp1 := ei2 xs j mem_mp2. +have [k] [k_ran j_eq_i_plus_k] : exists k, 0 <= k < r /\ j = i + k + by exists (j - i); smt(). +have /# : (i + k) %/r = i %/ r + by rewrite divzDl // (divz_small k r) 1:ger0_norm 1:ge0_r. +qed. + +lemma eager_inv_mem_dom1 + (mp1 : (block list * int, block) fmap, + mp2 : (block list * int, bool) fmap, + xs : block list, i : int) : + eager_invar mp1 mp2 => dom mp1 (xs, i) => + block_bits_all_in_dom xs (i * r) mp2. +proof. +move=> [ei1 _] mem j j_ran. +have [ge0_i eq_mp2_block_i] := ei1 xs i mem. +rewrite domE. +have /# := eq_mp2_block_i j _; smt(). +qed. + +lemma eager_inv_not_mem_dom1 + (mp1 : (block list * int, block) fmap, + mp2 : (block list * int, bool) fmap, + xs : block list, i : int) : + eager_invar mp1 mp2 => 0 <= i => ! dom mp1 (xs, i) => + block_bits_all_out_dom xs (i * r) mp2. +proof. +move=> [_ ei2] ge0_i not_mem_mp1_i j j_ran. +case (dom mp2 (xs, j))=> // mem_mp2_j. +have mem_mp1_j_div_r := ei2 xs j mem_mp2_j. +have /# : j %/ r = i. +have [k] [k_ran ->] : exists k, 0 <= k < r /\ j = i * r + k + by exists (j - i * r); smt(). +by rewrite divzDl 1:dvdz_mull 1:dvdzz (divz_small k r) + 1:ger0_norm 1:ge0_r //= mulzK 1:gtr_eqF 1:gt0_r. +qed. + +lemma block_bits_dom_first_in_imp_all_in + (xs : block list, i : int, mp : (block list * int, bool) fmap) : + block_bits_dom_all_in_or_out xs i mp => dom mp (xs, i) => + block_bits_all_in_dom xs i mp. +proof. smt(). qed. + +lemma block_bits_dom_first_out_imp_all_out + (xs : block list, i : int, mp : (block list * int, bool) fmap) : + block_bits_dom_all_in_or_out xs i mp => ! dom mp (xs, i) => + block_bits_all_out_dom xs i mp. +proof. smt(). qed. + +lemma Lower_HybridIROEager_f : + equiv[LowerHybridIRO(HybridIROEager).f ~ HybridIROEager.f : + ={xs, HybridIROEager.mp} /\ n{1} * r = n{2} ==> + res{1} = bits2blocks res{2} /\ ={HybridIROEager.mp}]. +proof. +proc=> /=; inline*. +seq 5 3 : + (={i, HybridIROEager.mp} /\ xs0{1} = xs{2} /\ + bs0{1} = bs{2} /\ n0{1} = n{2} /\ m{1} = n0{1} /\ m{2} = n{2}). +auto; progress; first 2 by rewrite needed_blocks_prod_r. +if=> //; wp. +while + (={i, HybridIROEager.mp} /\ xs0{1} = xs{2} /\ + bs0{1} = bs{2} /\ n0{1} = n{2} /\ m{1} = n0{1} /\ + m{2} = n{2}). +sp; wp; if=> //; wp; rnd; auto. +while + (={i, HybridIROEager.mp} /\ xs0{1} = xs{2} /\ + bs0{1} = bs{2} /\ n0{1} = n{2} /\ m{1} = n0{1} /\ + m{2} = n{2})=> //. +sp; wp; if=> //; wp; rnd; auto. +auto. +qed. + +(* module needed for applying transitivity tactic in connection + with HybridIROEager *) + +module HybridIROEagerTrans = { + (* getting next block of bits; assuming m = i + r and size bs = i *) + + proc next_block(xs, i, m : int, bs) = { + var b; + + while (i < m) { + b <@ HybridIROEager.fill_in(xs, i); + bs <- rcons bs b; + i <- i + 1; + } + return (bs, i); + } + + (* version of next_block split into cases; assuming m = i + r, + size bs = i and block_bits_dom_all_in_or_out xs i HybridIROEager.mp *) + + proc next_block_split(xs, i, m : int, bs) = { + var b, j, cs; + + if (dom HybridIROEager.mp (xs, i)) { + while (i < m) { + b <- oget HybridIROEager.mp.[(xs, i)]; + bs <- rcons bs b; + i <- i + 1; + } + } else { + j <- 0; cs <- []; + while (j < r) { + b <$ dbool; + cs <- rcons cs b; + j <- j + 1; + } + bs <- bs ++ cs; + while (i < m) { + HybridIROEager.mp.[(xs, i)] <- nth true bs i; + i <- i + 1; + } + } + return (bs, i); + } + + (* loop getting n * r bits of hash *) + + proc loop(n : int, xs : block list) : int * bool list = { + var b : bool; var i <- 0; var bs <- []; + while (i < n * r) { + b <@ HybridIROEager.fill_in(xs, i); + bs <- rcons bs b; + i <- i + 1; + } + return (i, bs); + } +}. + +(* predicate saying two (block list * int, bool) maps are the same + except (perhaps) on a range of bits for a single block list *) + +pred eager_eq_except + (xs : block list, i j : int, + mp1 mp2 : (block list * int, bool) fmap) = + forall (ys : block list, k : int), + ys <> xs \/ k < i \/ j <= k => mp1.[(ys, k)] = mp2.[(ys, k)]. + +lemma eager_eq_except_mem_iff + (xs ys : block list, i j k : int, + mp1 mp2 : (block list * int, bool) fmap) : + eager_eq_except xs i j mp1 mp2 => + ys <> xs \/ k < i \/ j <= k => + dom mp1 (ys, k) <=> dom mp2 (ys, k). +proof. smt(domE). qed. + +lemma eager_eq_except_upd1_eq_in + (xs : block list, i j k : int, y : bool, + mp1 mp2 : (block list * int, bool) fmap) : + eager_eq_except xs i j mp1 mp2 => i <= k => k < j => + eager_eq_except xs i j mp1.[(xs, k) <- y] mp2. +proof. +move=> eee le_ik lt_kj ys l disj. +have ne : (xs, k) <> (ys, l) by smt(). +smt(get_setE). +qed. + +lemma eager_eq_except_upd2_eq_in + (xs : block list, i j k : int, y : bool, + mp1 mp2 : (block list * int, bool) fmap) : + eager_eq_except xs i j mp1 mp2 => i <= k => k < j => + eager_eq_except xs i j mp1 mp2.[(xs, k) <- y]. +proof. +move=> eee le_ik lt_kj ys l disj. +have ne : (xs, k) <> (ys, l) by smt(). +smt(get_setE). +qed. + +lemma eager_eq_except_maps_eq + (xs : block list, i j : int, y : bool, + mp1 mp2 : (block list * int, bool) fmap) : + i <= j => eager_eq_except xs i j mp1 mp2 => + (forall (k : int), + i <= k < j => mp1.[(xs, k)] = mp2.[(xs, k)]) => + mp1 = mp2. +proof. +move=> lt_ij eee ran_k. +apply fmap_eqP=> p. +have [ys k] -> /# : exists ys k, p = (ys, k) + by exists p.`1 p.`2; smt(). +qed. + +lemma eager_invar_eq_except_upd1 + (mp1 : (block list * int, block) fmap, + mp2 : (block list * int, bool) fmap, + mp2' : (block list * int, bool) fmap, + xs : block list, i : int, y : block) : + 0 <= i => eager_invar mp1 mp2 => + eager_eq_except xs (i * r) ((i + 1) * r) mp2 mp2' => + (forall (j : int), + i * r <= j < (i + 1) * r => + mp2'.[(xs, j)] = Some (nth false (ofblock y) (j - i * r))) => + eager_invar mp1.[(xs, i) <- y] mp2'. +proof. +move=> ge0_i [ei1 ei2] ee mp2'_ran_eq. +split=> [ys k mem_mp1_upd_xs_i_y_ys_k | ys k mem_dom_mp2'_ys_k]. +case: (xs = ys)=> [eq_xs_ys | ne_xs_ys]. +case: (k = i)=> [eq_k_i | ne_k_i]. +split; first smt(). +move=> j j_ran. +by rewrite -eq_xs_ys eq_k_i get_set_sameE mp2'_ran_eq -eq_k_i. +rewrite domE in mem_mp1_upd_xs_i_y_ys_k. +have xs_i_ne_ys_k : (xs, i) <> (ys, k) by smt(). +have mem_mp1_ys_k : dom mp1 (ys, k) by smt(get_setE). +split; first smt(eager_inv_mem_mp2_ge0). +move=> j j_ran; rewrite get_setE. +have -> /= : (ys, k) <> (xs, i) by smt(). +have [_ ei1_ys_k_snd] := ei1 ys k mem_mp1_ys_k. +have <- : + mp2.[(ys, j)] = + Some (nth false (ofblock (oget mp1.[(ys, k)])) (j - k * r)) + by rewrite ei1_ys_k_snd. +have /# : j < i * r \/ (i + 1) * r <= j. + have [lt_ki | lt_ik] : k < i \/ i < k by smt(). + left. + have le_k_add1_i : k + 1 <= i + by rewrite addzC lez_add1r. + by rewrite (ltr_le_trans ((k + 1) * r)) 1:/# ler_pmul2r 1:gt0_r. + right. + have le_i_add1_k : i + 1 <= k + by rewrite addzC lez_add1r. + rewrite (lez_trans (k * r)) 1:ler_pmul2r 1:gt0_r // /#. +rewrite domE in mem_mp1_upd_xs_i_y_ys_k. +have xs_i_ne_ys_k : (xs, i) <> (ys, k) by smt(). +have mem_mp1_ys_k : dom mp1 (ys, k) by smt(get_setE). +split; first smt(eager_inv_mem_mp2_ge0). +move=> j j_ran; rewrite get_setE. +have -> /= : (ys, k) <> (xs, i) by smt(). +have [_ ei1_ys_k_snd] := ei1 ys k mem_mp1_ys_k. +have <- /# : + mp2.[(ys, j)] = + Some (nth false (ofblock (oget mp1.[(ys, k)])) (j - k * r)) + by rewrite ei1_ys_k_snd. +rewrite domE. +case: (xs = ys)=> [-> | ne_xs_ys]. +case: (k < i * r)=> [lt_k_i_tim_r | not_lt_k_i_tim_r]. +smt(get_setE eager_eq_except_mem_iff). +case: ((i + 1) * r <= k)=> [i_add1_tim_r_le_k | not_i_add1_tim_r_le_k]. +smt(get_setE eager_eq_except_mem_iff). +have le_i_tim_r_k : i * r <= k by smt(). +have lt_k_i_add1_tim_r : k < (i + 1) * r by smt(). +have -> // : i = k %/ r. + apply eqz_leq; split. + by rewrite lez_divRL 1:gt0_r. + by rewrite -ltzS ltz_divLR 1:gt0_r. +smt(get_setE eager_eq_except_mem_iff). +smt(get_setE eager_eq_except_mem_iff). +qed. + +lemma HybridIROEagerTrans_next_block_split : + equiv + [HybridIROEagerTrans.next_block ~ HybridIROEagerTrans.next_block_split : + ={i, m, xs, bs, HybridIROEager.mp} /\ m{1} = i{1} + r /\ + size bs{1} = i{1} /\ + block_bits_dom_all_in_or_out xs{1} i{1} HybridIROEager.mp{1} ==> + ={res, HybridIROEager.mp}]. +proof. +proc=> /=. +case (dom HybridIROEager.mp{2} (xs{2}, i{2})). +(* dom HybridIROEager.mp{2} (xs{2}, i{2}) *) +rcondt{2} 1; first auto. +conseq + (_ : + ={i, m, xs, bs, HybridIROEager.mp} /\ i{1} <= m{1} /\ + (forall (j : int), + i{1} <= j < m{1} => + dom HybridIROEager.mp{1} (xs{1}, j)) ==> + _). +progress; smt(gt0_r). +while + (={i, m, xs, bs, HybridIROEager.mp} /\ i{1} <= m{1} /\ + (forall (j : int), + i{1} <= j < m{1} => + dom HybridIROEager.mp{1} (xs{1}, j))). +wp; inline*. +rcondf{1} 3; first auto; smt(). +auto; smt(). +auto. +(* ! dom HybridIROEager.mp{2} (xs{2}, i{2}) *) +rcondf{2} 1; first auto. +sp; exists* i{1}; elim*=> i'. +conseq + (_ : + ={i, m, xs, bs, HybridIROEager.mp} /\ i{1} = i' /\ + i' + r = m{1} /\ size bs{1} = i' /\ cs{2} = [] /\ j{2} = 0 /\ + (forall (j : int), + i' <= j < i' + r => + ! dom HybridIROEager.mp{1} (xs{1}, j)) ==> + _). +progress; smt(gt0_r). +seq 1 2 : + (={m, xs} /\ i{2} = i' /\ i{1} = i' + r /\ bs{1} = bs{2} /\ + size bs{1} = i' + r /\ m{1} = i' + r /\ + (forall (k : int), + i' <= k < i' + r => + HybridIROEager.mp{1}.[(xs{1}, k)] = Some(nth true bs{1} k)) /\ + eager_eq_except xs{1} i' (i' + r) HybridIROEager.mp{1} HybridIROEager.mp{2}). +wp. +while + (={m, xs} /\ i{2} = i' /\ m{1} = i' + r /\ i' <= i{1} <= i' + r /\ + 0 <= j{2} <= r /\ i{1} - i' = j{2} /\ + size bs{1} = i{1} /\ bs{1} = bs{2} ++ cs{2} /\ + (forall (k : int), + i' <= k < i{1} => + HybridIROEager.mp{1}.[(xs{1}, k)] = Some(nth true bs{1} k)) /\ + (forall (k : int), + i{1} <= k < i' + r => + ! dom HybridIROEager.mp{1} (xs{1}, k)) /\ + eager_eq_except xs{1} i' (i' + r) HybridIROEager.mp{1} HybridIROEager.mp{2}). +inline*; rcondt{1} 3; first auto; smt(). +sp; wp; rnd; skip; progress. +smt(size_cat). smt(size_cat). smt(size_cat). +smt(size_rcons size_cat). smt(size_cat). +rewrite -cats1; smt(size_cat). +rewrite -2!cats1 catA; congr; congr. +by rewrite get_set_sameE oget_some. +rewrite nth_rcons /=. +case: (k = size (bs{2} ++ cs{2}))=> [-> /= | ne_k_size_bs_cat_cs]. +by rewrite get_set_sameE oget_some. +have -> /= : k < size(bs{2} ++ cs{2}) by smt(). +rewrite get_setE ne_k_size_bs_cat_cs /= /#. +rewrite -mem_fdom fdom_set in_fsetU1 mem_fdom negb_or. +have lt_sz_k : size (bs{2} ++ cs{2}) < k; smt(). +by apply eager_eq_except_upd1_eq_in. +smt(size_cat). smt(size_cat). +skip; progress; smt(gt0_r cats0 size_cat). +conseq + (_ : + ={xs, bs, m} /\ i{2} = i' /\ i{1} = i' + r /\ m{1} = i' + r /\ + size bs{1} = i' + r /\ + (forall (k : int), + i' <= k < i' + r => + HybridIROEager.mp{1}.[(xs{1}, k)] = Some (nth true bs{1} k)) /\ + eager_eq_except xs{1} i' (i' + r) + HybridIROEager.mp{1} HybridIROEager.mp{2} ==> + _)=> //. +while{2} + (={xs, bs, m} /\ i' <= i{2} <= i' + r /\ i{1} = i' + r /\ + m{1} = i' + r /\ size bs{1} = i' + r /\ + (forall (k : int), + i' <= k < i{2} => + HybridIROEager.mp{1}.[(xs{1}, k)] = HybridIROEager.mp{2}.[(xs{1}, k)]) /\ + (forall (k : int), + i{2} <= k < i' + r => + HybridIROEager.mp{1}.[(xs{1}, k)] = Some (nth true bs{1} k)) /\ + eager_eq_except xs{1} i' (i' + r) + HybridIROEager.mp{1} HybridIROEager.mp{2}) + (m{2} - i{2}). +progress; auto; progress; + [smt() | smt(gt0_r) | smt(get_setE) | smt() | + by apply eager_eq_except_upd2_eq_in | smt()]. +skip; progress; + [smt(gt0_r) | smt() | smt() | smt() | smt(eager_eq_except_maps_eq)]. +qed. + +(* module needed for applying transitivity tactic in connection + with BlockSponge.BIRO.IRO *) + +module BlockSpongeTrans = { + (* getting next block; assumes size bs = i *) + + proc next_block(x, i, bs) = { + var b; + + b <@ BlockSponge.BIRO.IRO.fill_in(x, i); + bs <- rcons bs b; + i <- i + 1; + return (bs, i); + } + + (* loop getting n blocks *) + + proc loop(n : int, xs : block list) : int * block list = { + var b : block; var i <- 0; var bs <- []; + while (i < n) { + b <@ BlockSponge.BIRO.IRO.fill_in(xs, i); + bs <- rcons bs b; + i <- i + 1; + } + return (i, bs); + } +}. + +(* use Program abstract theory of DList *) + +clone Program as Prog with + type t = bool, + op d = {0,1} +proof *. +(* nothing to be proved *) + +lemma PrLoopSnoc_sample &m (bs : bool list) : + Pr[Prog.LoopSnoc.sample(r) @ &m : res = bs] = + mu (dlist {0,1} r) (pred1 bs). +proof. +have -> : + Pr[Prog.LoopSnoc.sample(r) @ &m : res = bs] = + Pr[Prog.Sample.sample(r) @ &m : res = bs]. + byequiv=> //. + symmetry. + conseq (_ : ={n} ==> ={res})=> //. + apply Prog.Sample_LoopSnoc_eq. +apply (Prog.pr_Sample r &m bs). +qed. + +lemma iter_mul_one_half_pos (n : int) : + 0 < n => iter n (( * ) (1%r / 2%r)) 1%r = inv(2 ^ n)%r. +proof. +move=> gt0_n. +have -> /# // : + forall (n : int), + 0 <= n => 0 < n => iter n (( * ) (1%r / 2%r)) 1%r = inv (2 ^ n)%r. +elim=> [// | i ge0_i IH _]. +case: (i = 0)=> [-> /= | ne_i0]. +rewrite iter1 expr1 /#. +by rewrite iterS // IH 1:/# exprS // fromintM RField.invfM. +qed. + +(* module for adapting PrLoopSnoc_sample to block generation *) + +module BlockGen = { + proc loop() : block = { + var b : bool; var j : int; var cs : bool list; + j <- 0; cs <- []; + while (j < r) { + b <$ {0,1}; + cs <- rcons cs b; + j <- j + 1; + } + return mkblock cs; + } + + proc direct() : block = { + var w : block; + w <$ bdistr; + return w; + } +}. + +lemma BlockGen_loop_direct : + equiv[BlockGen.loop ~ BlockGen.direct : true ==> ={res}]. +proof. +bypr res{1} res{2}=> // &1 &2 w. +have -> : Pr[BlockGen.direct() @ &2 : res = w] = 1%r / (2 ^ r)%r. + byphoare=> //. + proc; rnd; skip; progress. + rewrite DBlock.dunifinE. + have -> : (transpose (=) w) = (pred1 w) by rewrite /pred1. + by rewrite DBlock.Support.enum_spec block_card. +have -> : + Pr[BlockGen.loop() @ &1 : res = w] = + Pr[Prog.LoopSnoc.sample(r) @ &1 : res = ofblock w]. + byequiv=> //; proc. + seq 2 2 : + (r = n{2} /\ j{1} = i{2} /\ j{1} = 0 /\ + cs{1} = l{2} /\ cs{1} = []); + first auto. + while + (r = n{2} /\ j{1} = i{2} /\ cs{1} = l{2} /\ j{1} <= r /\ + size cs{1} = j{1}). + wp; rnd; skip. + progress; smt(cats1 gt0_r size_rcons). + skip=> &m1 &m2 [# <- <- -> <- ->]. + split; first smt(gt0_r). + move=> cs j i ds not_lt_jr not_lt_ir [# _ eq_ji -> le_jr sz_cs_eq_j]. + have sz_ds_eq_r : size ds = r by smt(). + progress; [by rewrite ofblockK | by rewrite mkblockK]. +rewrite (PrLoopSnoc_sample &1 (ofblock w)). +rewrite dlist1E 1:ge0_r size_block /=. +have -> : + (fun (x : bool) => mu1 {0,1} x) = + (fun (x : bool) => 1%r / 2%r). +apply fun_ext=> x; by rewrite dbool1E. +by rewrite Bigreal.BRM.big_const count_predT size_block + iter_mul_one_half_pos 1:gt0_r. +qed. + +lemma HybridIROEagerTrans_BlockSpongeTrans_next_block (i2 : int) : + equiv + [HybridIROEagerTrans.next_block ~ BlockSpongeTrans.next_block : + i2 = i{2} /\ 0 <= i{2} /\ xs{1} = x{2} /\ i{1} = i{2} * r /\ + m{1} - i{1} = r /\ bs{1} = blocks2bits bs{2} /\ size bs{2} = i{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + res{1}.`1 = blocks2bits res{2}.`1 /\ + res{1}.`2 = res{2}.`2 * r /\ res{2}.`2 = i2 + 1 /\ + size res{2}.`1 = i2 + 1 /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}]. +proof. +transitivity + HybridIROEagerTrans.next_block_split + (={i, m, xs, bs, HybridIROEager.mp} /\ m{1} = i{1} + r /\ + size bs{1} = i{1} /\ + block_bits_dom_all_in_or_out xs{1} i{1} HybridIROEager.mp{1} ==> + ={res, HybridIROEager.mp}) + (i2 = i{2} /\ 0 <= i{2} /\ xs{1} = x{2} /\ i{1} = i{2} * r /\ + m{1} - i{1} = r /\ size bs{2} = i2 /\ bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + res{1}.`1 = blocks2bits res{2}.`1 /\ + res{1}.`2 = res{2}.`2 * r /\ res{2}.`2 = i2 + 1 /\ + size res{2}.`1 = i2 + 1 /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. +move=> |> &1 &2 ge0_i2 -> i1_eq_i2_tim_r m_min_i1_eq_r -> sz_bs_eq_i2 ei. +exists HybridIROEager.mp{1} (x{2}, i{1}, m{1}, blocks2bits bs{2})=> |>. +split; first smt(). +split; first smt(size_blocks2bits). +apply + (eager_inv_imp_block_bits_dom BlockSponge.BIRO.IRO.mp{2} + HybridIROEager.mp{1} x{2} i{1})=> //. +rewrite i1_eq_i2_tim_r mulr_ge0 // ge0_r. +rewrite i1_eq_i2_tim_r dvdz_mull dvdzz. +apply HybridIROEagerTrans_next_block_split. +proc=> /=; inline*; sp; wp. +case (dom BlockSponge.BIRO.IRO.mp{2} (x0{2}, n{2})). +(* dom BlockSponge.BIRO.IRO.mp{2} (x0{2}, n{2}) *) +rcondf{2} 1; first auto. +rcondt{1} 1; first auto; progress [-delta]. +have bb_all_in : + block_bits_all_in_dom x{m} (size bs{m} * r) HybridIROEager.mp{hr} + by apply (eager_inv_mem_dom1 BlockSponge.BIRO.IRO.mp{m}). +smt(gt0_r). +simplify; exists* i{1}; elim*=> i1; exists* bs{1}; elim*=> bs1. +conseq + (_ : + i1 = i{1} /\ 0 <= i2 /\ i1 = i2 * r /\ m{1} - i1 = r /\ + bs1 = bs{1} /\ size bs{2} = i2 /\ size bs1 = i1 /\ + bs1 = blocks2bits bs{2} /\ + dom BlockSponge.BIRO.IRO.mp{2} (xs{1}, i2) /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + bs{1} = + blocks2bits (rcons bs{2} (oget BlockSponge.BIRO.IRO.mp{2}.[(xs{1}, i2)])) /\ + i{1} = (i2 + 1) * r /\ size bs{2} = i2 /\ size bs{1} = (i2 + 1) * r /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}); + [progress; smt(size_blocks2bits) | progress; by rewrite size_rcons | idtac]. +while{1} + (i1 <= i{1} <= m{1} /\ i1 = i2 * r /\ size bs{1} = i{1} /\ m{1} - i1 = r /\ + bs{1} = + bs1 ++ + take (i{1} - i1) + (ofblock (oget(BlockSponge.BIRO.IRO.mp{2}.[(xs{1}, i2)]))) /\ + dom BlockSponge.BIRO.IRO.mp{2} (xs{1}, i2) /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) + (m{1} - i{1}). +move=> &m z. +auto=> + |> &hr i2_tim_r_le_sz_bs sz_bs_le_m m_min_i2_tim_r_eq_r bs_eq + mem_blk_mp_xs_i2 ei sz_bs_lt_m. +split. split. split=> [| _]; smt(). split; first by rewrite -cats1 size_cat. +rewrite -cats1 {1}bs_eq -catA; congr. +have -> : size bs{hr} + 1 - i2 * r = size bs{hr} - i2 * r + 1 by algebra. +rewrite (take_nth false) 1:size_block; first smt(size_ge0). +rewrite -cats1; congr; congr. +have some_form_mp_hr_lookup_eq : + HybridIROEager.mp{hr}.[(xs{hr}, size bs{hr})] = + Some (nth false (ofblock (oget BlockSponge.BIRO.IRO.mp{m}.[(xs{hr}, i2)])) + (size bs{hr} - i2 * r)). + have [ei1 _] := ei. + have [_ ei1_xs_i2] := ei1 xs{hr} i2 mem_blk_mp_xs_i2. + by rewrite ei1_xs_i2 1:/#. +by rewrite some_form_mp_hr_lookup_eq oget_some. +smt(). +skip=> + &1 &2 + [# <- ge0_i2 i1_eq_i2_tim_r m_min_i1_eq_r <- sz_bs2_eq_i2 + sz_b2b_bs2_eq_i1 ->> mem_dom_mp2_xs_i2 ei]. +split. split. split=> [// | _]; rewrite i1_eq_i2_tim_r; smt(ge0_r). +split=> //. split; first smt(). split=> //. +split; first by rewrite /= take0 cats0. split=> //. +move=> bs1 i1'. +split=> [| not_i1'_lt_m]; first smt(). +move=> [# i1_le_i1' i1'_le_m _ sz_bs1_eq_i1' _ bs1_eq mem_mp2_xs_i2 _]. +split. +have i1'_eq_m : i1' = m{1} by smt(). +rewrite bs1_eq -cats1 blocks2bits_cat i1'_eq_m m_min_i1_eq_r blocks2bits_sing. +pose blk := (oget BlockSponge.BIRO.IRO.mp{2}.[(xs{1}, i2)]). +have -> : r = size (ofblock blk) by rewrite size_block. +by rewrite take_size. +split; smt(). +(* ! dom BlockSponge.BIRO.IRO.mp{2} (x0{2}, n{2}) *) +rcondt{2} 1; first auto. rcondf{1} 1; first auto; progress [-delta]. +have bb_all_not_in : + block_bits_all_out_dom x{m} (size bs{m} * r) HybridIROEager.mp{hr} + by apply (eager_inv_not_mem_dom1 BlockSponge.BIRO.IRO.mp{m}). +smt(gt0_r). +simplify. +conseq + (_ : + x0{2} = x{2} /\ n{2} = i{2} /\ i2 = i{2} /\ 0 <= i{2} /\ xs{1} = x{2} /\ + i{1} = i{2} * r /\ m{1} - i{1} = r /\ size bs{2} = i2 /\ + bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + _)=> //. +alias{2} 1 with w. +seq 3 1 : + (xs{1} = x0{2} /\ n{2} = i2 /\ i{2} = i2 /\ 0 <= i2 /\ + i{1} = i2 * r /\ m{1} - i{1} = r /\ size bs{2} = i2 /\ + size cs{1} = r /\ mkblock cs{1} = w{2} /\ bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). +conseq (_ : true ==> cs{1} = ofblock w{2}); first + progress; [by rewrite size_block | by rewrite mkblockK]. +transitivity{2} + { w <@ BlockGen.loop(); } + (true ==> cs{1} = ofblock w{2}) + (true ==> ={w})=> //. +inline BlockGen.loop; sp; wp. +while (={j, cs} /\ 0 <= j{1} <= r /\ size cs{1} = j{1}). +wp; rnd; skip; progress; smt(size_ge0 size_rcons). +skip; progress. +smt(gt0_r). +have sz_cs_R_eq_r : size cs_R = r by smt(). +by rewrite ofblockK. +transitivity{2} + { w <@ BlockGen.direct(); } + (true ==> ={w}) + (true ==> ={w})=> //. +call BlockGen_loop_direct; auto. +inline BlockGen.direct; sim. +wp; simplify; sp; elim*=> bs_l. +exists* HybridIROEager.mp{1}; elim*=> mp1; exists* i{1}; elim*=> i1. +conseq + (_ : + xs{1} = x0{2} /\ 0 <= i2 /\ i{1} = i1 /\ i1 = i2 * r /\ + m{1} - i1 = r /\ + bs{1} = blocks2bits bs{2} ++ ofblock w{2} /\ size bs{2} = i2 /\ + size bs{1} = i1 + r /\ mp1 = HybridIROEager.mp{1} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + bs{1} = blocks2bits bs{2} ++ ofblock w{2} /\ + i{1} = (i2 + 1) * r /\ + eager_invar BlockSponge.BIRO.IRO.mp{2}.[(x0{2}, i2) <- w{2}] + HybridIROEager.mp{1}). +progress; + [by rewrite ofblockK | rewrite size_cat size_blocks2bits /#]. +progress; + [by rewrite -cats1 blocks2bits_cat blocks2bits_sing get_set_sameE + oget_some ofblockK | + by rewrite size_rcons]. +while{1} + (0 <= i1 /\ m{1} - i1 = r /\ size bs{1} = i1 + r /\ + i1 <= i{1} <= m{1} /\ + eager_eq_except xs{1} i1 (i1 + r) mp1 HybridIROEager.mp{1} /\ + (forall (j : int), + i1 <= j < i{1} => + HybridIROEager.mp{1}.[(xs{1}, j)] = Some(nth false bs{1} j))) + (m{1} - i{1}). +progress; auto. +move=> + |> &hr ge0_i1 m_min_i1_eq_r sz_bs_eq_i1_plus_r il_le_i _ ee + mp_ran_eq lt_im. +split. split; first smt(). +split; first smt(eager_eq_except_upd2_eq_in). +move=> j i1_le_j j_lt_i_add1. +case: (i{hr} = j)=> [-> | ne_ij]. +rewrite get_setE /=; smt(nth_onth onth_nth). +rewrite get_setE. +have -> /= : (xs{hr}, j) <> (xs{hr}, i{hr}) by smt(). +rewrite mp_ran_eq /#. +smt(). +skip=> + &1 &2 [# -> ge0_i2 -> i1_eq_i2_tim_r m_min_i1_eq_r + bs1_eq sz_bs2_eq_i2 sz_bs1_eq_i1_add_r -> ei]. +have ge0_i1 : 0 <= i1 by rewrite i1_eq_i2_tim_r divr_ge0 // ge0_r. +split. split=> //. split; first smt(ge0_r). +split; first smt(). split; smt(ge0_r). +move=> mp_L i_L. +split; first smt(). +move=> not_i_L_lt_m [# _ _ _ i1_le_i_L i_L_le_m ee mp_L_ran_eq]. +split; first smt(). +split; first smt(). +apply (eager_invar_eq_except_upd1 BlockSponge.BIRO.IRO.mp{2} + HybridIROEager.mp{1} mp_L x0{2} i2 w{2})=> //. +by rewrite mulzDl /= -i1_eq_i2_tim_r. +move=> j j_ran. +rewrite mp_L_ran_eq 1:/#; congr; rewrite bs1_eq nth_cat. +have -> : size(blocks2bits bs{2}) = i2 * r + by rewrite size_blocks2bits /#. +have -> // : j < i2 * r = false by smt(). +qed. + +lemma HybridIROEagerTrans_BlockSpongeTrans_loop (n' : int) : + equiv + [HybridIROEagerTrans.loop ~ BlockSpongeTrans.loop : + ={xs, n} /\ n' = n{1} /\ 0 <= n' /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + res{1}.`1 = n' * r /\ res{2}.`1 = n' /\ + size res{2}.`2 = n' /\ res{1}.`2 = blocks2bits res{2}.`2 /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}]. +proof. +case (0 <= n'); last first=> [not_ge0_n' | ge0_n']. +proc=> /=; exfalso. +proc=> /=. +move: ge0_n'; elim n'=> [| n' ge0_n' IH]. +sp. rcondf{1} 1; auto. rcondf{2} 1; auto. +splitwhile{1} 3 : (i < (n - 1) * r); splitwhile{2} 3 : (i < n - 1). +seq 3 3 : + (={xs, n} /\ n{1} = n' + 1 /\ i{1} = n' * r /\ i{2} = n' /\ + size bs{2} = n' /\ bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). +conseq + (_ : + ={xs, n} /\ n' + 1 = n{1} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + i{1} = n' * r /\ i{2} = n' /\ size bs{2} = n' /\ + bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. +transitivity{1} + { i <- 0; bs <- []; + while (i < n * r) { + b <@ HybridIROEager.fill_in(xs, i); + bs <- rcons bs b; + i <- i + 1; + } + } + (={xs, HybridIROEager.mp} /\ n{1} = n' + 1 /\ n{2} = n' ==> + ={bs, i, HybridIROEager.mp}) + (={xs} /\ n{1} = n' /\ n{2} = n' + 1 /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + i{1} = n' * r /\ i{2} = n' /\ size bs{2} = n' /\ + bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. +progress; exists HybridIROEager.mp{1} n' xs{2}=> //. +while (={xs, i, bs, HybridIROEager.mp} /\ n{1} = n' + 1 /\ n{2} = n'). +wp. call (_ : ={HybridIROEager.mp}). if=> //; wp; rnd; auto. +skip; progress; smt(ge0_r). +auto; smt(). +transitivity{2} + { i <- 0; bs <- []; + while (i < n) { + b <@ BlockSponge.BIRO.IRO.fill_in(xs, i); + bs <- rcons bs b; + i <- i + 1; + } + } + (={xs, n} /\ n{1} = n' /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + i{1} = n' * r /\ i{2} = n' /\ size bs{2} = n' /\ + bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) + (={xs,BlockSponge.BIRO.IRO.mp} /\ n{1} = n' /\ n{2} = n' + 1 ==> + ={i, bs, BlockSponge.BIRO.IRO.mp})=> //. +progress; exists BlockSponge.BIRO.IRO.mp{2} n{1} xs{2}=> //. +conseq IH=> //. +while + (={xs, bs, i, BlockSponge.BIRO.IRO.mp} /\ n{1} = n' /\ n{2} = n' + 1). +wp. call (_ : ={BlockSponge.BIRO.IRO.mp}). if=> //; wp; rnd; auto. +auto; smt(). +auto; smt(). +unroll{2} 1. rcondt{2} 1; first auto; progress; smt(). +rcondf{2} 4. auto. call (_ : true). if=> //. auto. +transitivity{1} + { (bs, i) <@ HybridIROEagerTrans.next_block(xs, i, (n' + 1) * r, bs); } + (={xs, i, bs, HybridIROEager.mp} /\ n{1} = n' + 1 ==> + ={i, bs, HybridIROEager.mp}) + (={xs} /\ i{1} = n' * r /\ i{2} = n' /\ + size bs{2} = n' /\ bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + i{1} = (n' + 1) * r /\ i{2} = n' + 1 /\ size bs{2} = n' + 1 /\ + bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. +progress; + exists HybridIROEager.mp{1} (blocks2bits bs{2}) (size bs{2} * r) xs{2}=> //. +inline HybridIROEagerTrans.next_block; sp; wp. +while + (xs{1} = xs0{2} /\ i{1} = i0{2} /\ n{1} = n' + 1 /\ + m{2} = (n' + 1) * r /\ bs{1} = bs0{2} /\ + ={HybridIROEager.mp}). +wp. call (_ : ={HybridIROEager.mp}). if=> //; wp; rnd; auto. +auto. auto. +transitivity{2} + { (bs, i) <@ BlockSpongeTrans.next_block(xs, i, bs); } + (={xs} /\ i{1} = n' * r /\ i{2} = n' /\ + size bs{2} = n' /\ bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + i{1} = (n' + 1) * r /\ i{2} = n' + 1 /\ size bs{2} = n' + 1 /\ + bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) + (={xs, bs, i, BlockSponge.BIRO.IRO.mp} ==> + ={xs, bs, i, BlockSponge.BIRO.IRO.mp})=> //. +progress; exists BlockSponge.BIRO.IRO.mp{2} bs{2} (size bs{2}) xs{2}=> //. +call (HybridIROEagerTrans_BlockSpongeTrans_next_block n'). +skip; progress; smt(). +inline BlockSpongeTrans.next_block. +wp; sp. call (_ : ={BlockSponge.BIRO.IRO.mp}). if=> //; wp; rnd; skip; smt(). +auto. +qed. + +lemma HybridIROEager_f_BlockIRO_f (n1 : int) (x2 : block list) : + equiv[HybridIROEager.f ~ BlockSponge.BIRO.IRO.f : + n1 = n{1} /\ x2 = x{2} /\ xs{1} = x{2} /\ + n{2} = (n{1} + r - 1) %/ r /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + (valid_block x2 => + (n1 <= 0 => res{1} = [] /\ res{2} = []) /\ + (0 < n1 => + res{1} = take n1 (blocks2bits res{2}) /\ + size res{2} = (n1 + r - 1) %/ r)) /\ + (! valid_block x2 => res{1} = [] /\ res{2} = [])]. +proof. +proc=> /=. +seq 3 2 : + (n1 = n{1} /\ xs{1} = x{2} /\ x2 = x{2} /\ + n{2} = (n{1} + r - 1) %/ r /\ n{2} * r = m{1} /\ + i{1} = 0 /\ i{2} = 0 /\ bs{1} = [] /\ bs{2} = [] /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). +auto; progress. +if=> //. +case (n1 < 0). +rcondf{1} 1; first auto; progress; smt(). +rcondf{2} 1; first auto; progress; + by rewrite -lezNgt needed_blocks_non_pos ltzW. +rcondf{1} 1; first auto; progress; + by rewrite -lezNgt pmulr_lle0 1:gt0_r needed_blocks_non_pos ltzW. +by auto; progress; smt(needed_blocks0). +(* 0 <= n1 *) +conseq + (_ : + xs{1} = x{2} /\ n1 = n{1} /\ 0 <= n1 /\ n{2} = (n{1} + r - 1) %/ r /\ + n{2} * r = m{1} /\ n{1} <= m{1} /\ + i{1} = 0 /\ i{2} = 0 /\ bs{1} = [] /\ bs{2} = [] /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + bs{1} = take n1 (blocks2bits bs{2}) /\ + size bs{2} = (n1 + r - 1) %/ r /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). +progress; [smt() | apply/needed_blocks_suff]. +move=> |> &1 &2 ? ? ? mp1 mp2 bs ? ? ?; + smt(size_eq0 needed_blocks0 take0). +splitwhile{1} 1 : i < (n1 %/ r) * r. splitwhile{2} 1 : i < n1 %/ r. +seq 1 1 : + (xs{1} = x{2} /\ n1 = n{1} /\ 0 <= n1 /\ n{2} = (n1 + r - 1) %/ r /\ + n{2} * r = m{1} /\ n{1} <= m{1} /\ i{1} = n1 %/ r * r /\ + i{2} = n1 %/ r /\ size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). +(* we have zero or more blocks to add on the right, and + r times that number of bits to add on the left; + we will work up to applying HybridIROEagerTrans_BlockSpongeTrans_loop *) +conseq + (_ : + xs{1} = x{2} /\ n1 = n{1} /\ 0 <= n1 /\ n{2} = (n1 + r - 1) %/ r /\ + i{1} = 0 /\ i{2} = 0 /\ bs{1} = [] /\ bs{2} = [] /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ + size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. +transitivity{1} + { while (i < n1 %/ r * r) { + b <@ HybridIROEager.fill_in(xs, i); + bs <- rcons bs b; + i <- i + 1; + } + } + (={i, bs, xs, HybridIROEager.mp} /\ n1 = n{1} /\ 0 <= n1 ==> + ={i, bs, xs, HybridIROEager.mp}) + (xs{1} = x{2} /\ n1 = n{1} /\ 0 <= n1 /\ n{2} = (n1 + r - 1) %/ r /\ + i{1} = 0 /\ i{2} = 0 /\ bs{1} = [] /\ bs{2} = [] /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ + size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. +progress; exists HybridIROEager.mp{1} [] 0 n{1} x{2}=> //. +while (={i, bs, xs, HybridIROEager.mp} /\ n1 = n{1} /\ 0 <= n1). +wp. call (_ : ={HybridIROEager.mp}). if=> //; auto. +auto; progress; smt(leq_trunc_div ge0_r). +auto; progress; smt(leq_trunc_div ge0_r). +(transitivity{2} + { while (i < n1 %/ r) { + b <@ BlockSponge.BIRO.IRO.fill_in(x, i); + bs <- rcons bs b; + i <- i + 1; + } + } + (xs{1} = x{2} /\ n1 = n{1} /\ 0 <= n1 /\ n{2} = (n1 + r - 1) %/ r /\ + i{1} = 0 /\ i{2} = 0 /\ bs{1} = [] /\ bs{2} = [] /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ size bs{2} = i{2} /\ + bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) + (={i, x, bs, BlockSponge.BIRO.IRO.mp} /\ n{2} = (n1 + r - 1) %/ r ==> + ={i, x, bs, BlockSponge.BIRO.IRO.mp})=> //; + first progress; + exists BlockSponge.BIRO.IRO.mp{2} [] 0 ((n{1} + r - 1) %/ r) x{2}=> //); + first last. +while + (={i, x, bs, BlockSponge.BIRO.IRO.mp} /\ n{2} = (n1 + r - 1) %/ r). +wp. call (_ : ={BlockSponge.BIRO.IRO.mp}). if=> //; auto. +auto; progress; + have /# : n1 %/ r <= (n1 + r - 1) %/ r + by rewrite leq_div2r; smt(gt0_r). +auto; progress; + have /# : n1 %/ r <= (n1 + r - 1) %/ r + by rewrite leq_div2r; smt(gt0_r). +conseq + (_ : + xs{1} = x{2} /\ 0 <= n1 /\ + i{1} = 0 /\ i{2} = 0 /\ bs{1} = [] /\ bs{2} = [] /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ + size bs{2} = n1 %/ r /\ bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. +transitivity{1} + { (i, bs) <@ HybridIROEagerTrans.loop(n1 %/ r, xs); } + (={xs, HybridIROEager.mp} /\ n{2} = n1 %/ r /\ i{1} = 0 /\ bs{1} = [] ==> + ={i, xs, bs, HybridIROEager.mp}) + (xs{1} = x{2} /\ 0 <= n1 /\ i{2} = 0 /\ bs{2} = [] /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ + size bs{2} = n1 %/ r /\ bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. +progress; exists HybridIROEager.mp{1} (n1 %/ r) x{2}=> //. +inline HybridIROEagerTrans.loop; sp; wp. +while + (={HybridIROEager.mp} /\ i{1} = i0{2} /\ bs{1} = bs0{2} /\ + xs{1} = xs0{2} /\ n0{2} = n1 %/ r). +wp. call (_ : ={HybridIROEager.mp}). if=> //; wp; rnd; auto. +auto. auto. +(transitivity{2} + { (i, bs) <@ BlockSpongeTrans.loop(n1 %/ r, x); } + (xs{1} = x{2} /\ 0 <= n1 /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ + size bs{2} = n1 %/ r /\ bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) + (={x, BlockSponge.BIRO.IRO.mp} /\ i{2} = 0 /\ bs{2} = [] ==> + ={i, x, bs, BlockSponge.BIRO.IRO.mp})=> //; + first progress; exists BlockSponge.BIRO.IRO.mp{2} x{2}=> //); + last first. +inline BlockSpongeTrans.loop; sp; wp. +while + (={BlockSponge.BIRO.IRO.mp} /\ i0{1} = i{2} /\ n0{1} = n1 %/ r /\ + xs{1} = x{2} /\ bs0{1} = bs{2}). +wp. call (_ : ={BlockSponge.BIRO.IRO.mp}). if=> //; wp; rnd; auto. +auto. auto. +call (HybridIROEagerTrans_BlockSpongeTrans_loop (n1 %/ r)). +skip; progress; smt(divz_ge0 gt0_r). +(* either nothing more to do on either side, or a single block to add + on the right side, and less than r bits to add on the left side *) +conseq + (_ : + n1 = n{1} /\ 0 <= n1 /\ xs{1} = x{2} /\ n{2} = (n1 + r - 1) %/ r /\ + n{2} * r = m{1} /\ n{1} <= m{1} /\ i{1} = n1 %/ r * r /\ + i{2} = n1 %/ r /\ size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + (i{2} = n{2} \/ i{2} + 1 = n{2}) ==> + bs{1} = take n1 (blocks2bits bs{2}) /\ size bs{2} = n{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) => //. +progress; by apply/needed_blocks_rel_div_r. +case (i{2} = n{2}). (* so i{1} = n{1} and i{1} = m{1} *) +rcondf{2} 1; first auto; progress; smt(). +rcondf{1} 1; first auto; progress; smt(). +rcondf{1} 1; first auto; progress; smt(). +auto=> |> &1 &2 ? ? sz_eq ? ? need_blks_eq. +split. +have -> : n1 = size (blocks2bits bs{2}) + by rewrite size_blocks2bits sz_eq -mulzC divzK 1:needed_blocks_eq_div_r. +by rewrite take_size. +by rewrite sz_eq need_blks_eq. +(* i{2} <> n{2}, so i{2} + 1 = n{2}, m{1} - i{1} = r and i{1} <= m{1} *) +rcondt{2} 1; first auto; progress; smt(). +rcondf{2} 4. +auto; call (_ : true); [if=> //; auto; progress; smt() | auto; smt()]. +conseq + (_ : + n1 = n{1} /\ 0 <= n1 /\ xs{1} = x{2} /\ 0 <= i{2} /\ i{1} = i{2} * r /\ + n{1} <= m{1} /\ m{1} - i{1} = r /\ i{1} <= n{1} /\ + bs{1} = blocks2bits bs{2} /\ size bs{1} = i{1} /\ size bs{2} = i{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + bs{1} = take n1 (blocks2bits bs{2}) /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) + _ + (_ : size bs = n - 1 ==> size bs = n)=> //. +progress; smt(divz_ge0 gt0_r lez_floor size_blocks2bits). +wp. call (_ : true). auto. skip; smt(size_rcons). +transitivity{1} + { while (i < m) { + b <@ HybridIROEager.fill_in(xs, i); + bs <- rcons bs b; + i <- i + 1; + } + } + (={bs, m, i, xs, HybridIROEager.mp} /\ n1 = n{1} /\ i{1} <= n1 /\ + n1 <= m{1} /\ size bs{1} = i{1} ==> + ={HybridIROEager.mp} /\ bs{1} = take n1 bs{2}) + (xs{1} = x{2} /\ 0 <= i{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ + size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). +progress; + exists HybridIROEager.mp{1} (blocks2bits bs{2}) + (size bs{2} * r) m{1} x{2}=> //. +progress; smt(take_cat). +splitwhile{2} 1 : i < n1. +seq 1 1 : + (={HybridIROEager.mp, xs, bs, i, m} /\ i{1} = n1 /\ n1 <= m{1} /\ + size bs{1} = n1). +while + (={HybridIROEager.mp, xs, bs, i, m} /\ n{1} = n1 /\ n1 <= m{1} /\ + i{1} <= n1 /\ size bs{1} = i{1}). +wp; call (_ : ={HybridIROEager.mp}); first if => //; wp; rnd; auto. +skip; smt(size_rcons). +skip; smt(). +while + (={HybridIROEager.mp, xs, i, m} /\ n1 <= m{1} /\ + n1 <= i{1} <= m{1} /\ n1 <= size bs{2} /\ + bs{1} = take n1 bs{2}). +wp; call (_ : ={HybridIROEager.mp}); first if => //; wp; rnd; auto. +skip; progress; + [smt() | smt() | smt(size_rcons) | + rewrite -cats1 take_cat; + smt(size_rcons take_oversize cats1 cats0)]. +skip; smt(take_size). +(* now we can use HybridIROEagerTrans_BlockSpongeTrans_next_block *) +transitivity{1} + { (bs, i) <@ HybridIROEagerTrans.next_block(xs, i, m, bs); + } + (={i, m, xs, bs, HybridIROEager.mp} ==> + ={i, m, xs, bs, HybridIROEager.mp}) + (xs{1} = x{2} /\ 0 <= i{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ + size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. +progress [-delta]; + exists HybridIROEager.mp{1} (blocks2bits bs{2}) (size bs{2} * r) + m{1} x{2}=> //. +inline HybridIROEagerTrans.next_block; sim. +(transitivity{2} + { (bs, i) <@ BlockSpongeTrans.next_block(x, i, bs); + } + (xs{1} = x{2} /\ 0 <= i{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ + size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) + (={bs, i, x, BlockSponge.BIRO.IRO.mp} ==> + ={bs, i, x, BlockSponge.BIRO.IRO.mp})=> //; + first progress [-delta]; + exists BlockSponge.BIRO.IRO.mp{2} bs{2} (size bs{2}) x{2}=> //); + last first. +inline BlockSpongeTrans.next_block; sim. +exists* i{2}; elim*=> i2. +call (HybridIROEagerTrans_BlockSpongeTrans_next_block i2). +auto. +qed. + +lemma HybridIROEager_BlockIRO_f : + equiv[LowerHybridIRO(HybridIROEager).f ~ BlockSponge.BIRO.IRO.f : + xs{1} = x{2} /\ ={n} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + ={res} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}]. +proof. +transitivity + HybridIROEager.f + (={xs, HybridIROEager.mp} /\ n{2} = n{1} * r /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + res{1} = bits2blocks res{2} /\ ={HybridIROEager.mp}) + (xs{1} = x{2} /\ n{1} = n{2} * r /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + res{1} = (blocks2bits res{2}) /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). +move=> |> &1 &2 ? n_eq inv. +exists HybridIROEager.mp{1} BlockSponge.BIRO.IRO.mp{2} (xs{1}, n{1} * r). +move=> |>; by rewrite n_eq. +progress; apply blocks2bitsK. +by conseq Lower_HybridIROEager_f=> |> &1 &2 ? -> ?. +exists* n{1}; elim*=> n1; exists* xs{1}; elim*=> xs'. +conseq (HybridIROEager_f_BlockIRO_f n1 xs')=> //. +move=> |> &1 &2 ? -> inv; by rewrite needed_blocks_prod_r. +move=> |> &1 &2 ? n1_eq ? res1 res2 ? ? ? vb_imp not_vb_imp. +case: (valid_block xs{1})=> [vb_xs1 | not_vb_xs1]. +have [le0_n1_imp gt0_n1_imp] := vb_imp vb_xs1. +case: (n{1} <= 0)=> [le0_n1 /# | not_le0_n1]. +have gt0_n1 : 0 < n{1} by smt(). +have [-> sz_res2] := gt0_n1_imp gt0_n1. +have -> : n{1} = size(blocks2bits res2) + by rewrite size_blocks2bits sz_res2 n1_eq + needed_blocks_prod_r mulzC. +by rewrite take_size. +by have [-> ->] := not_vb_imp not_vb_xs1. +qed. + +end HybridIRO. + +(* now we use HybridIRO to prove the main result *) + +section. + +declare module BlockSim <: BlockSponge.SIMULATOR {-IRO, -BlockSponge.BIRO.IRO}. +declare module Dist <: DISTINGUISHER {-Perm, -BlockSim, -IRO, -BlockSponge.BIRO.IRO}. + +local clone HybridIRO as HIRO. + +(* working toward the Real side of the main result *) + +local lemma Sponge_Raise_BlockSponge_f : + equiv[Sponge(Perm).f ~ RaiseFun(BlockSponge.Sponge(Perm)).f : + ={bs, n, glob Perm} ==> ={res, glob Perm}]. +proof. +proc; inline BlockSponge.Sponge(Perm).f. +conseq (_ : ={bs, n, glob Perm} ==> _)=> //. +swap{2} [3..5] -2. +seq 4 4 : + (={n, glob Perm, sa, sc, i} /\ xs{1} = xs0{2} /\ z{1} = [] /\ z{2} = [] /\ + valid_block xs0{2}). +auto; progress; apply valid_pad2blocks. +rcondt{2} 2; auto. swap{2} 1 1. +seq 1 1 : + (={n, glob Perm, sa, sc, i} /\ xs{1} = xs0{2} /\ z{1} = [] /\ z{2} = []). +while (={glob Perm, sa, sc, i} /\ xs{1} = xs0{2} /\ z{1} = [] /\ z{2} = []). +wp. call (_ : ={glob Perm}). sim. auto. auto. +seq 0 1 : + (={n, glob Perm, sa, sc, i} /\ blocks2bits z{2} = z{1} /\ + n0{2} = (n{1} + r - 1) %/ r); first auto. +while (={n, glob Perm, i, sa, sc} /\ blocks2bits z{2} = z{1} /\ + n0{2} = (n{1} + r - 1) %/ r). +case (i{1} + 1 < (n{1} + r - 1) %/ r). +rcondt{1} 3; first auto. rcondt{2} 3; first auto. +call (_ : ={glob Perm}); first sim. +auto; progress; by rewrite -cats1 blocks2bits_cat blocks2bits_sing. +rcondf{1} 3; first auto. rcondf{2} 3; first auto. +auto; progress; by rewrite -cats1 blocks2bits_cat blocks2bits_sing. +auto. +qed. + +(* the Real side of main result *) +local lemma RealIndif_Sponge_BlockSponge &m : + Pr[RealIndif(Sponge, Perm, Dist).main() @ &m : res] = + Pr[BlockSponge.RealIndif + (BlockSponge.Sponge, Perm, LowerDist(Dist)).main() @ &m : res]. +proof. +byequiv=> //; proc. +seq 2 2 : (={glob Dist, glob Perm}); first sim. +call (_ : ={glob Perm}); first 2 sim. +conseq Sponge_Raise_BlockSponge_f=> //. +auto. +qed. + +(* working toward the Ideal side of the main result *) + +(* first step of Ideal side: express in terms of Experiment and + HIRO.HybridIROLazy *) + +local lemma Ideal_IRO_Experiment_HybridLazy &m : + Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = + Pr[Experiment + (HIRO.RaiseHybridIRO(HIRO.HybridIROLazy), + BlockSim(HIRO.LowerHybridIRO(HIRO.HybridIROLazy)), + Dist).main() @ &m : res]. +proof. +byequiv=> //; proc. +seq 2 2 : + (={glob Dist, glob BlockSim} /\ IRO.mp{1} = empty /\ + HIRO.HybridIROLazy.mp{2} = empty). +inline*; wp; call (_ : true); auto. +call + (_ : + ={glob Dist, glob BlockSim} /\ + IRO.mp{1} = empty /\ HIRO.HybridIROLazy.mp{2} = empty ==> + ={res}). +proc + (={glob BlockSim} /\ + HIRO.lazy_invar IRO.mp{1} HIRO.HybridIROLazy.mp{2})=> //. +progress [-delta]; apply HIRO.lazy_invar0. +proc (HIRO.lazy_invar IRO.mp{1} HIRO.HybridIROLazy.mp{2})=> //; + apply HIRO.LowerFun_IRO_HybridIROLazy_f. +proc (HIRO.lazy_invar IRO.mp{1} HIRO.HybridIROLazy.mp{2})=> //; + apply HIRO.LowerFun_IRO_HybridIROLazy_f. +by conseq HIRO.IRO_RaiseHybridIRO_HybridIROLazy_f. +auto. +qed. + +(* working toward middle step of Ideal side: using Experiment, and + taking HIRO.HybridIROLazy to HIRO.HybridIROEager + + we will employ HIRO.HybridIROExper_Lazy_Eager *) + +(* make a Hybrid IRO distinguisher from BlockSim and Dist (HI.f is + used by BlockSim, and HI.g is used by HIRO.RaiseHybridIRO; + HI.init is unused -- see the SIMULATOR module type) *) + +local module (HybridIRODist : HIRO.HYBRID_IRO_DIST) (HI : HIRO.HYBRID_IRO) = { + proc distinguish() : bool = { + var b : bool; + BlockSim(HIRO.LowerHybridIRO(HI)).init(); + b <@ + Dist(HIRO.RaiseHybridIRO(HI), + BlockSim(HIRO.LowerHybridIRO(HI))).distinguish(); + return b; + } +}. + +(* initial bridging step *) + +local lemma Experiment_HybridIROExper_Lazy &m : + Pr[Experiment + (HIRO.RaiseHybridIRO(HIRO.HybridIROLazy), + BlockSim(HIRO.LowerHybridIRO(HIRO.HybridIROLazy)), + Dist).main() @ &m : res] = + Pr[HIRO.HybridIROExper(HIRO.HybridIROLazy, HybridIRODist).main() @ &m : res]. +proof. +byequiv=> //; proc; inline*. +seq 2 2 : (={glob Dist, glob BlockSim, HIRO.HybridIROLazy.mp}). +swap{2} 1 1; wp; call (_ : true); auto. +sim. +qed. + +(* final bridging step *) + +local lemma HybridIROExper_Experiment_Eager &m : + Pr[HIRO.HybridIROExper(HIRO.HybridIROEager, HybridIRODist).main() @ + &m : res] = + Pr[Experiment + (HIRO.RaiseHybridIRO(HIRO.HybridIROEager), + BlockSim(HIRO.LowerHybridIRO(HIRO.HybridIROEager)), + Dist).main() @ &m : res]. +proof. +byequiv=> //; proc; inline*. +seq 2 2 : (={glob Dist, glob BlockSim, HIRO.HybridIROEager.mp}). +swap{2} 1 1; wp; call (_ : true); auto. +sim. +qed. + +(* middle step of Ideal side: using Experiment, and taking HIRO.HybridIROLazy + to HIRO.HybridIROEager *) + +local lemma Experiment_Hybrid_Lazy_Eager &m : + Pr[Experiment + (HIRO.RaiseHybridIRO(HIRO.HybridIROLazy), + BlockSim(HIRO.LowerHybridIRO(HIRO.HybridIROLazy)), + Dist).main() @ &m : res] = + Pr[Experiment + (HIRO.RaiseHybridIRO(HIRO.HybridIROEager), + BlockSim(HIRO.LowerHybridIRO(HIRO.HybridIROEager)), + Dist).main() @ &m : res]. +proof. +by rewrite (Experiment_HybridIROExper_Lazy &m) + (HIRO.HybridIROExper_Lazy_Eager HybridIRODist &m) + (HybridIROExper_Experiment_Eager &m). +qed. + +(* working toward last step of Ideal side *) + +local lemma RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f : + equiv[HIRO.RaiseHybridIRO(HIRO.HybridIROEager).f ~ + RaiseFun(BlockSponge.BIRO.IRO).f : + ={bs, n} /\ ={glob BlockSim} /\ + HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1} ==> + ={res} /\ ={glob BlockSim} /\ + HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1}]. +proof. +proc=> /=. +exists* n{1}; elim*=> n'. +exists* (pad2blocks bs{2}); elim*=> xs2. +call (HIRO.HybridIROEager_f_BlockIRO_f n' xs2). +skip=> |> &1 &2 ? res1 res2 mp1 mp2 ? vb_imp not_vb_imp. +case: (valid_block (pad2blocks bs{2}))=> [vb | not_vb]. +have [le0_n2_imp gt0_n2_imp] := vb_imp vb. +case: (n' <= 0)=> [le0_n' /# | not_le0_n']. +have gt0_n' : 0 < n' by smt(). +by have [-> _] := gt0_n2_imp gt0_n'. +have [-> ->] := not_vb_imp not_vb; by rewrite blocks2bits_nil. +qed. + +(* last step of Ideal side: express in terms of Experiment and + HIRO.HybridIROEager *) + +local lemma Experiment_HybridEager_Ideal_BlockIRO &m : + Pr[Experiment + (HIRO.RaiseHybridIRO(HIRO.HybridIROEager), + BlockSim(HIRO.LowerHybridIRO(HIRO.HybridIROEager)), + Dist).main() @ &m : res] = + Pr[BlockSponge.IdealIndif + (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res]. +proof. +byequiv=> //; proc. +seq 2 2 : + (={glob Dist, glob BlockSim} /\ HIRO.HybridIROEager.mp{1} = empty /\ + BlockSponge.BIRO.IRO.mp{2} = empty). +inline*; wp; call (_ : true); auto. +call + (_ : + ={glob Dist, glob BlockSim} /\ + HIRO.HybridIROEager.mp{1} = empty /\ BlockSponge.BIRO.IRO.mp{2} = empty ==> + ={res}). +proc + (={glob BlockSim} /\ + HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1})=> //. +progress [-delta]; apply HIRO.eager_invar0. +proc (HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} + HIRO.HybridIROEager.mp{1})=> //; + conseq HIRO.HybridIROEager_BlockIRO_f=> //. +proc (HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} + HIRO.HybridIROEager.mp{1})=> //; + conseq HIRO.HybridIROEager_BlockIRO_f=> //. +conseq RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f=> //. +auto. +qed. + +(* the Ideal side of main result *) + +local lemma IdealIndif_IRO_BlockIRO &m : + Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = + Pr[BlockSponge.IdealIndif + (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res]. +proof. +by rewrite (Ideal_IRO_Experiment_HybridLazy &m) + (Experiment_Hybrid_Lazy_Eager &m) + (Experiment_HybridEager_Ideal_BlockIRO &m). +qed. + +lemma conclu &m : + `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m : res] - + Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res]| = + `|Pr[BlockSponge.RealIndif + (BlockSponge.Sponge, Perm, LowerDist(Dist)).main() @ &m : res] - + Pr[BlockSponge.IdealIndif + (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main() @ &m : res]|. +proof. +by rewrite (RealIndif_Sponge_BlockSponge &m) (IdealIndif_IRO_BlockIRO &m). +qed. + +end section. + +(*----------------------------- Conclusion -----------------------------*) + +lemma conclusion + (BlockSim <: BlockSponge.SIMULATOR{-IRO, -BlockSponge.BIRO.IRO}) + (Dist <: DISTINGUISHER{-Perm, -BlockSim, -IRO, -BlockSponge.BIRO.IRO}) + &m : + `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m : res] - + Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res]| = + `|Pr[BlockSponge.RealIndif + (BlockSponge.Sponge, Perm, LowerDist(Dist)).main() @ &m : res] - + Pr[BlockSponge.IdealIndif + (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main() @ &m : res]|. +proof. by apply (conclu BlockSim Dist &m). qed. diff --git a/sha3/proof/impl/.dir-locals.el b/sha3/proof/impl/.dir-locals.el new file mode 100644 index 0000000..60e4dfd --- /dev/null +++ b/sha3/proof/impl/.dir-locals.el @@ -0,0 +1,4 @@ +((easycrypt-mode . + ((eval . + (cl-flet ((pre (s) (concat (locate-dominating-file buffer-file-name ".dir-locals.el") s))) + (setq easycrypt-load-path `(,(pre "..") ,(pre ".") ,(pre "../smart_counter")))))))) diff --git a/sha3/proof/impl/Array24.ec b/sha3/proof/impl/Array24.ec new file mode 100644 index 0000000..8982b77 --- /dev/null +++ b/sha3/proof/impl/Array24.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array24 with op size <- 24. diff --git a/sha3/proof/impl/Array25.ec b/sha3/proof/impl/Array25.ec new file mode 100644 index 0000000..30bcb17 --- /dev/null +++ b/sha3/proof/impl/Array25.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array25 with op size <- 25. diff --git a/sha3/proof/impl/Array5.ec b/sha3/proof/impl/Array5.ec new file mode 100644 index 0000000..8dc7b36 --- /dev/null +++ b/sha3/proof/impl/Array5.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array5 with op size <- 5. diff --git a/sha3/proof/impl/EclibExtra.ec b/sha3/proof/impl/EclibExtra.ec new file mode 100644 index 0000000..578ab37 --- /dev/null +++ b/sha3/proof/impl/EclibExtra.ec @@ -0,0 +1,447 @@ +(* Miscellaneous results on some constructions from the EC and Jasmin libraries *) +require import Core Int IntDiv List. +require BitEncoding. +(*---*) import IntExtra. + +from Jasmin require JUtils. + +lemma foldl_map ['a 'b 'c] (h:'a->'b) (f:'c ->'b->'c) (z:'c) l: + foldl f z (List.map h l) = foldl (fun b a => f b (h a)) z l. +proof. +elim: l f z => //= x xs IH f z. +by rewrite IH. +qed. + +lemma nth_inside ['a] d1 d2 (l: 'a list) i: + 0 <= i < size l => + nth d1 l i = nth d2 l i. +proof. +elim: l i => /=; first smt(). +move=> x xs IH i Hi; case: (i=0) => E //. +by rewrite IH /#. +qed. + +lemma nth0 (d:'a) l: nth d l 0 = head d l by case: l. + +lemma take_take n1 n2 (l: 'a list): + take n1 (take n2 l) = take (min n1 n2) l. +proof. elim: l n1 n2 => //= x xs IH n1 n2; smt(). qed. + +lemma nth_nseq_dflt (d:'s) n i: nth d (nseq n d) i = d. +proof. +case: (0 <= i < n) => E; first by rewrite nth_nseq. +rewrite nth_out // size_nseq /#. +qed. + +lemma nseq_add ['a] (x:'a) n1 n2: + 0 <= n1 => 0 <= n2 => nseq (n1+n2) x = nseq n1 x ++ nseq n2 x. +proof. +move=> Hn1 Hn2; elim/natind: n1 Hn1. + by move=> n ??; rewrite (: n=0) 1:/# nseq0. +by move=> n Hn IH H; rewrite nseqS // (addzC n) -addzA addzC nseqS 1:/# IH //. +qed. + +lemma take_nseq ['a] n1 n2 (x: 'a): + take n1 (nseq n2 x) = nseq (min n1 n2) x. +proof. +elim/natind: n2 n1. + move=> n Hn n1; rewrite !nseq0_le //. + by have [? ?]:= min_is_lb n1 n; apply (lez_trans n). +move=> n Hn IH n1; case: (n1 <= 0) => /=. + move=> ?; rewrite take_le0 // nseq0_le //. + by have [? ?]:= min_is_lb n1 (n+1); apply (lez_trans n1). +rewrite -ltzNge=> ?; rewrite nseqS // take_cons H /=. +have ->: min n1 (n + 1) = (min (n1-1) n)+1. + rewrite /min; case: (n1 < n+1) => ?. + by have ->/=: n1 - 1 < n by smt(). + by have ->/=: !(n1 - 1 < n) by smt(). +by rewrite nseqS /min /#. +qed. + +lemma drop_nseq ['a] n1 n2 (x: 'a): + 0 <= n1 => drop n1 (nseq n2 x) = nseq (n2-n1) x. +proof. +elim/natind: n1 n2. + move=> n Hn n2 Hn'; have ->: n=0 by smt(). + by rewrite drop0. +move=> n Hn IH n2 Hn'. +case: (n2 <= 0) => /= ?. + by rewrite !nseq0_le // /#. +have ->: n2 = n2 - 1 + 1 by smt(). +by rewrite nseqS 1:/# drop_cons ltzS Hn /= IH //; congr; smt(). +qed. + +lemma dropS ['a] (l: 'a list) n: + 0 <= n => + drop (n + 1) l = behead (drop n l). +proof. +elim: l n => [|x xs] //= IH n Hn. +have ->/=: !(n+1 <= 0) by smt(). +case: (n=0). + by move=> -> /=; rewrite drop0. +move=> ?; have ->/=: !(n<=0) by smt(). +by rewrite -IH /#. +qed. + +lemma drop_drop ['a] (l: 'a list) n1 n2: + 0 <= n1 => 0 <= n2 => + drop n1 (drop n2 l) = drop (n1+n2) l. +proof. +elim/natind: n1. + by move=> n Hn; rewrite drop_le0 /#. +move=> n Hn IH H1 H2. +by rewrite dropS // IH // -dropS /#. +qed. + +(* a variant of [size_take] that is more convenient in some cases *) +lemma size_take' ['a] n (s: 'a list): + 0 <= n => size (take n s) = if n <= size s then n else size s. +proof. +move=> Hn; rewrite size_take //. +case: (n = size s) => E; first by rewrite E. +case: (n <= size s) => H. + by rewrite (: n < size s) /#. +by rewrite (: ! n < size s) /#. +qed. + +(* likewise for [take_cat] *) +lemma take_cat' ['a] n (s1 s2: 'a list): + take n (s1++s2) = if n <= size s1 then take n s1 else s1 ++ take (n-size s1) s2. +proof. +rewrite take_cat //. +case: (n = size s1) => E. + by rewrite !E /= take0 cats0 take_size. +case: (n <= size s1) => H. + by rewrite (: n < size s1) /#. +by rewrite (: ! n < size s1) /#. +qed. + +(* [eq_mkseq'] is a more refined version of [eq_mkseq] *) +lemma eq_mkseq' ['a] (f g : int -> 'a) n: + (forall (x : int), 0 <= x < n => f x = g x) => mkseq f n = mkseq g n. +proof. +elim/natind: n f g => /=. + by move=> n Hn f g H; rewrite !mkseq0_le. +move=> n Hn IH f g H. +rewrite !(addzC n) !mkseq_add //; congr. + by rewrite !mkseq1 H /#. +apply IH => x Hx /=. +by rewrite H /#. +qed. + +lemma size_behead ['a] (l:'a list): + size (behead l) = max 0 (size l - 1). +proof. by case: l => [|x xs] /=; rewrite /max //=; smt(size_ge0). qed. + +lemma behead_map ['a 'b] (f:'a->'b) (l:'a list): + behead (map f l) = map f (behead l) +by elim: l. + +lemma behead_mkseq ['a] (f : int -> 'a) n: + behead (mkseq f n) = mkseq (fun i=> f (1+i)) (n-1). +proof. +elim/natind: n => /=. + by move=> n Hn; rewrite !mkseq0_le /#. +by move=> n Hn IH; rewrite addzC mkseq_add // mkseq1. +qed. + +lemma take_mkseq ['a] n (f: int -> 'a) k: + 0 <= n => take n (mkseq f k) = mkseq f (min n k). +proof. +elim/natind: n => //=. + move=> n Hn1 Hn2; have ->: n=0 by smt(). + by rewrite take0 mkseq0_le /#. +move => n Hn IH H. +case: (n < k) => E. + rewrite min_lel 1:/#. + rewrite (take_nth (f n)); first by rewrite size_mkseq /#. + rewrite IH // mkseqS // min_lel 1:/#; congr. + by rewrite nth_mkseq. +by rewrite min_ler 1:/# take_oversize // size_mkseq /#. +qed. + +lemma drop_mkseq ['a] n (f: int -> 'a) k: + 0 <= n <= k => drop n (mkseq f k) = mkseq (fun i => f (i+n)) (k-n). +proof. +elim/natind: n => //=. + move=> n Hn1 Hn2; have ->: n=0 by smt(). + by rewrite drop0. +move => n Hn IH H. +rewrite dropS // IH 1:/# behead_mkseq /= Ring.IntID.opprD addzA. +by apply eq_mkseq => x /=; congr; ring. +qed. + +lemma behead_chunk ['a] n (l:'a list): + behead (BitEncoding.BitChunking.chunk n l) + = BitEncoding.BitChunking.chunk n (drop n l). +proof. +case: (size l < n). + move=> ?; rewrite drop_oversize 1:/#. + rewrite /BitEncoding.BitChunking.chunk behead_mkseq. + rewrite divz_small /=; first smt(size_ge0). + by rewrite mkseq0_le //= mkseq0. +case: (0 < n); last first. +rewrite -!lezNgt => ??. + by rewrite drop_le0 // !BitEncoding.BitChunking.chunk_le0. +rewrite -lezNgt => ??. +rewrite /BitEncoding.BitChunking.chunk behead_mkseq /=. +rewrite size_drop // 1:/# max_ler 1:/#. +have ->: (size l - n) %/ n = size l %/ n - 1. + have ->: size l = (size l - n) + 1*n by ring. + by rewrite divzMDr /#. +by apply eq_mkseq' => x Hx /=; rewrite drop_drop /#. +qed. + +lemma drop_chunk n k (l: 'a list): + 0 < k => + drop n (BitEncoding.BitChunking.chunk k l) + = BitEncoding.BitChunking.chunk k (drop (k*n) l). +proof. +move=> Hk; elim/natind: n l. + by move=> n Hn l; rewrite !drop_le0 /#. +move=> n Hn IH l; rewrite dropS // IH behead_chunk drop_drop 1,2:/#. +by congr; congr; ring. +qed. + +lemma chunk_take_eq ['a] n (l:'a list): + 0 < n => + BitEncoding.BitChunking.chunk n l + = BitEncoding.BitChunking.chunk n (take (size l %/ n * n) l). +proof. +move=> Hn; rewrite /BitEncoding.BitChunking.chunk. +have ->: (size (take (size l %/ n * n) l) %/ n) = (size l %/ n). + rewrite size_take'; first smt(size_ge0). + by rewrite lez_floor 1:/# /= mulzK 1:/#. +apply eq_mkseq' => x Hx /=. +rewrite -{1}(cat_take_drop (size l %/ n * n)). +rewrite drop_cat size_take'; first smt(size_ge0). +rewrite lez_floor 1:/# /= mulzC StdOrder.IntOrder.ltr_pmul2r 1:/#. +move: (Hx); move=> [? ->] /=. +have E: n <= size (drop (x * n) (take (size l %/ n * n) l)). + rewrite size_drop 1:/# max_ler; last first. + rewrite size_take' 1:/# lez_floor 1:/# /= -Ring.IntID.mulrBl. + by rewrite -{1}mulz1 {1}mulzC StdOrder.IntOrder.ler_pmul2r // -ltzS /#. + rewrite size_take' 1:/# lez_floor 1:/# /=. + smt(size_ge0). +by rewrite take_cat' E. +qed. + +op chunkfillsize (n sz:int) = (-sz)%%n. + +lemma chunkfillsize_cmp n sz: + 0 < n => 0 <= chunkfillsize n sz < n. +proof. move=> Hn; rewrite /chunkfillsize; smt(JUtils.modz_cmp). qed. + +lemma chunkfillsizeP n sz k: + 0 < n => chunkfillsize n (n*k+sz) = chunkfillsize n sz. +proof. +move=> Hn; rewrite /chunkfillsize. +by rewrite -modzNm mulzC modzMDl modzNm. +qed. + +lemma chunkfillsizeE' n sz: + 0 < n => 0 < sz => chunkfillsize n sz = n - 1 - (sz-1) %% n +by move=> ??; rewrite /chunkfillsize modNz. + +lemma divz_minus1 m d: + 0 < d => 0 <= m => ! d %| m => (m-1) %/ d = m %/ d. +proof. +move=> Hd Hm Hdvd. +rewrite {1}(divz_eq m d) -addzA divzMDl 1:/#; ring. +rewrite divz_small //; apply JUtils.bound_abs; split. + by move: Hdvd; rewrite dvdzE; smt(JUtils.modz_cmp). +by move=> ?; smt(JUtils.modz_cmp). +qed. + +lemma chunkfillsizeE n sz: + 0 < n => 0 <= sz => chunkfillsize n sz = if n %| sz then 0 else n - sz%%n. +proof. +move=> Hn Hsz'. +case: (n %| sz) . + rewrite /chunkfillsize dvdzE -modzNm => ->; smt(). +move=> ?. +have Hsz : 0 < sz by smt(dvdz0). +rewrite chunkfillsizeE' //. +have ->: n - 1 - (sz - 1) %% n = n - (1 + (sz - 1) %% n) by ring. +congr; congr. +by rewrite !modzE divz_minus1 //; ring. +qed. + +op chunkfill ['a] (d:'a) n l = l ++ nseq (chunkfillsize n (size l)) d. + +lemma chunkfill_nil ['a] (d:'a) n: + chunkfill d n [] = []. +proof. by rewrite /chunkfill /chunkfillsize. qed. + +hint simplify chunkfill_nil. + +lemma dvd_chunkfill ['a] (d:'a) n l: + 0 < n => n %| size l => chunkfill d n l = l. +proof. +by move=> Hn Hsz; rewrite /chunkfill chunkfillsizeE // ?size_ge0 !Hsz /= cats0. +qed. + +lemma size_chunkfill ['a] (d:'a) n l: + 0 < n => + size (chunkfill d n l) = (size l - 1) %/ n * n + n. +proof. +move=> Hn; rewrite /chunkfill size_cat size_nseq max_ler //. + smt(chunkfillsize_cmp). +case: (size l = 0) => E. + by rewrite !E /= /chunkfillsize /= divNz //=; ring. +rewrite chunkfillsizeE' //; first smt(size_ge0). +have ->: size l + (n - 1 - (size l - 1) %% n) = (size l-1) + n - (size l-1) %% n + by ring. +rewrite {1}(divz_eq (size l - 1) n); ring. +qed. + +lemma chunkfillP ['a] (d:'a) n l: + 0 < n => + n %| size (chunkfill d n l). +proof. +move=> Hn; rewrite size_chunkfill //. +rewrite (: (size l - 1) %/ n * n + n = ((size l - 1) %/ n + 1) * n) 1:/#. +by rewrite dvdzE modzMl. +qed. + +lemma chunkfillK ['a] (d:'a) n l: + 0 < n => + chunkfill d n (chunkfill d n l) = chunkfill d n l. +proof. +move=> Hn; rewrite {1}/chunkfill chunkfillsizeE // ?size_ge0. +by rewrite !chunkfillP //= cats0. +qed. + +lemma chunkfill_cat (d:'a) n l1 l2: + 0 < n => n %| size l1 => chunkfill d n (l1++l2) = l1 ++ chunkfill d n l2. +proof. +move=> H0 Hsz; rewrite /chunkfill -!catA; congr; congr; congr. +move: Hsz; rewrite size_cat dvdzP => [[k]]. +rewrite mulzC => ->. +by rewrite chunkfillsizeP. +qed. + +lemma chunkfillK' l (d:'a) n: + 0 < n => n %| size l => chunkfill d n l = l. +proof. +rewrite /chunkfill => Hn Hsz. +move: (Hsz); rewrite dvdzP => [[k E]]. +rewrite chunkfillsizeE //; first smt(size_ge0). +by rewrite !Hsz /= cats0. +qed. + +lemma chunkfillsize_ge0 k n: 0 < k => 0 <= chunkfillsize k n. +proof. by rewrite /chunkfillsize /#. qed. + +lemma drop_chunkfill n (d:'a) k l: + 0 < k => 0 <= n => + drop (k*n) (chunkfill d k l) = chunkfill d k (drop (k*n) (chunkfill d k l)). +proof. +move=> Hk Hn; have := chunkfillP d k l Hk. +rewrite /chunkfill size_cat size_nseq max_ler; first smt(chunkfillsize_ge0). +move=> Hdvd; pose S:= chunkfillsize _ (size (drop _ _)). +have ->: S = 0; last by rewrite nseq0 cats0. +rewrite /S -(chunkfillsizeP _ _ n) // size_drop 1:/# addzC /max size_cat size_nseq. +rewrite max_ler; first by apply chunkfillsize_ge0. +case: (0 < size l + chunkfillsize k (size l) - k * n) => E. + rewrite Ring.IntID.subrK chunkfillsizeE; first 2 smt(size_ge0 chunkfillsize_ge0). + by rewrite !Hdvd. +by rewrite addzC chunkfillsizeP. +qed. + +lemma nth_chunkfill k (d:'a) n l: + 0 < n => nth d (chunkfill d n l) k = nth d l k. +proof. +move=> Hn; rewrite /chunkfill nth_cat. +case: (k < size l) => E //. +case: (0 <= k - size l < chunkfillsize n (size l)) => ?. + by rewrite nth_nseq // nth_out /#. +rewrite nth_out. + by rewrite size_nseq max_ler // chunkfillsize_ge0. +by rewrite nth_out /#. +qed. + +lemma size_chunkfilled (d:'a) k l: + 0 < k => + size (BitEncoding.BitChunking.chunk k (chunkfill d k l)) + = (size l - 1) %/ k + 1. +proof. +move=> Hk; rewrite BitEncoding.BitChunking.size_chunk //. +by rewrite size_chunkfill // divzMDl 1:/# divzz (:k<>0) 1:/#. +qed. + +lemma head_chunkfilled (d:'a) k l: + head [] (BitEncoding.BitChunking.chunk k (chunkfill d k l)) + = take k (chunkfill d k l). +proof. +case: (0 < k) => Hk; last first. + by rewrite take_le0 1:/# BitEncoding.BitChunking.chunk_le0 1:/#. +case: (0 < size l) => Hsz; last first. + have ->: l=[] by smt(size_ge0). + by rewrite chunkfill_nil /= /BitEncoding.BitChunking.chunk /= mkseq0. +rewrite -nth0 /BitEncoding.BitChunking.chunk nth_mkseq /=. + by rewrite size_chunkfill // /#. +by rewrite drop0. +qed. + +lemma nth_chunkfilled (d:'a) k l (i:int): + 0 < k => + 0 <= i < (size l - 1) %/ k + 1 => + nth [] (BitEncoding.BitChunking.chunk k (chunkfill d k l)) i + = take k (drop (k*i) (chunkfill d k l)). +proof. +move=> Hk Hi. +rewrite {1}(:i = i+0) // -nth_drop 1,2:/# drop_chunk // nth0. +by rewrite drop_chunkfill // 1:/# head_chunkfilled. +qed. + +lemma nth_chunkfilled' dl (d:'a) k l (i:int): + 0 < k => + 0 <= i < (size l - 1) %/ k + 1 => + nth dl (BitEncoding.BitChunking.chunk k (chunkfill d k l)) i + = mkseq (fun j => nth d l (k*i+j)) k. +proof. +move=> Hk Hi. +rewrite -(nth_inside []); first by rewrite size_chunkfilled. +rewrite (nth_chunkfilled d k l i) //. +have Hsz: size (take k (drop (k * i) (chunkfill d k l))) = k. + rewrite size_take' 1:/# size_drop 1:/# size_chunkfill //. + rewrite max_ler; first smt(size_ge0). + have: k <= (size l - 1) %/ k * k + k - k * i. + by move: Hi => [?]; rewrite ltzE => [?] /#. + smt(). +apply (eq_from_nth d); first by rewrite Hsz size_mkseq /#. +rewrite Hsz => j Hj. +rewrite nth_take 1,2:/# nth_drop 1,2:/# nth_chunkfill 1:/#. +by rewrite nth_mkseq. +qed. + +lemma take_map2 ['a 'b 'c] (f:'a -> 'b -> 'c) n l1 l2: + take n (JUtils.map2 f l1 l2) = JUtils.map2 f (take n l1) (take n l2). +proof. +elim: l1 l2 n => [|x xs IH] [|y ys] n //=; case:(n<=0) => // E. +by rewrite IH. +qed. + +lemma drop_map2 ['a 'b 'c] (f:'a -> 'b -> 'c) n l1 l2: + drop n (JUtils.map2 f l1 l2) = JUtils.map2 f (drop n l1) (drop n l2). +proof. +elim: l1 l2 n => [|x xs IH] [|y ys] n //=; case:(n<=0) => // E. + by case: (drop (n - 1) ys) => [|_ _]. + by case: (drop (n - 1) xs) => [|_ _]. +by rewrite IH. +qed. + +lemma map2_nseq0r ['a 'b] (f:'a -> 'b -> 'a) x0 n l: + size l = n => + (forall y, f y x0 = y) => + JUtils.map2 f l (nseq n x0) = l. +proof. +elim/natind: n l. + move=> n Hn l Hl H. + have E: n=0 by smt(size_ge0). + by move: Hl; rewrite E size_eq0 nseq0 => ->. +move=> n Hn IH [|x xs] //=; first smt(). +by move=> Hsz H; rewrite nseqS //= H IH /#. +qed. + diff --git a/sha3/proof/impl/JWordList.ec b/sha3/proof/impl/JWordList.ec new file mode 100644 index 0000000..056faec --- /dev/null +++ b/sha3/proof/impl/JWordList.ec @@ -0,0 +1,781 @@ +(* List of Jasmin Words *) +require import AllCore List Int IntDiv. +from Jasmin require import JMemory JWord JUtils. + + +require import EclibExtra. + + +(*******************************************************************************) +(* W8 lists *) +(*******************************************************************************) + +op w8L2bits (l: W8.t list) : bool list = + flatten (map W8.w2bits l). + +lemma w8L2bits_nil: w8L2bits [] = [] by done. + +hint simplify w8L2bits_nil. + +lemma w8L2bits_cons x xs: w8L2bits (x::xs) = W8.w2bits x ++ w8L2bits xs. +proof. by rewrite /w8L2bits map_cons flatten_cons. qed. + +lemma w8L2bits_cat l1 l2: + w8L2bits (l1++l2) = w8L2bits l1 ++ w8L2bits l2. +proof. by elim: l1 => //= x xs IH; rewrite !w8L2bits_cons IH. qed. + +lemma size_w8L2bits x: + size (w8L2bits x) = 8 * size x. +proof. +by rewrite /w8L2bits size_flatten -map_comp /(\o) /= StdBigop.Bigint.sumzE +StdBigop.Bigint.BIA.big_mapT /(\o) /= StdBigop.Bigint.big_constz count_predT_eq. +qed. + +(*hint simplify size_w8L2bits.*) + +lemma take_w8L2bits n l: + take (8*n) (w8L2bits l) = w8L2bits (take n l). +proof. +elim/natind: n l => //=. + move=> n Hn l; rewrite !take_le0 //. + by apply StdOrder.IntOrder.mulr_ge0_le0. +move=> n Hn IH [|x xs] //=. +have ->/=: ! (n+1 <= 0) by rewrite -ltzNge ltzS. +rewrite !w8L2bits_cons take_cat. +have ->/=: ! (8 * (n + 1) < size (w2bits x)) by rewrite W8.size_w2bits /#. +by rewrite mulzDr /= IH. +qed. + +lemma drop_w8L2bits n l: + drop (8*n) (w8L2bits l) = w8L2bits (drop n l). +proof. +elim/natind: n l => //=. + move=> n Hn l; rewrite !drop_le0 //. + by apply StdOrder.IntOrder.mulr_ge0_le0. +move=> n Hn IH [|x xs] //=. +have ->/=: ! (n+1 <= 0) by rewrite -ltzNge ltzS. +rewrite !w8L2bits_cons drop_cat. +have ->/=: ! (8 * (n + 1) < size (w2bits x)) by rewrite W8.size_w2bits /#. +by rewrite mulzDr /= IH. +qed. + +lemma w8L2bits_u64 w: w8L2bits (W8u8.to_list w) = W64.w2bits w. +proof. by rewrite /w8L2bits. qed. + + +op bits2w8L (bs: bool list) : W8.t list = + map W8.bits2w (BitEncoding.BitChunking.chunk 8 (chunkfill false 8 bs)). + +lemma bits2w8L_nil: bits2w8L [] = []. +proof. +rewrite /bits2w8L chunkfill_nil. +by rewrite /BitEncoding.BitChunking.chunk /= mkseq0. +qed. + +hint simplify bits2w8L_nil. + +lemma size_bits2w8L' bs: + size (bits2w8L bs) = (size bs - 1) %/ 8 + 1. +proof. +rewrite /bits2w8L size_map BitEncoding.BitChunking.size_chunk //. +rewrite size_chunkfill //. +rewrite {3}(:8 = 1*8) 1:/# -mulzDl. +by rewrite -(addz0 (((size bs - 1) %/ 8 + 1) * 8)) divzMDl. +qed. + +lemma size_bits2w8L bs: + 8 %| size bs => size (bits2w8L bs) = size bs %/ 8. +proof. by rewrite dvdzP size_bits2w8L' => [[k ->]]; smt(). qed. + +lemma bits2w8LK bs: + 8 %| size bs => w8L2bits (bits2w8L bs) = bs. +proof. +move=> Hsz. +rewrite /w8L2bits -map_comp dvd_chunkfill //. +have : forall (x : bool list), + x \in BitEncoding.BitChunking.chunk 8 bs => + idfun x = W8.w2bits (W8.bits2w x). + move=> x Hx; beta. + rewrite W8.bits2wK //. + by apply (BitEncoding.BitChunking.in_chunk_size _ _ _ _ Hx). +rewrite List.eq_in_map => <-. +by rewrite map_id BitEncoding.BitChunking.chunkK // Hsz. +qed. + +lemma bits2w8LK' bs: + w8L2bits (bits2w8L bs) = chunkfill false 8 bs. +proof. +rewrite /bits2w8L -chunkfillK //. +by rewrite bits2w8LK ?chunkfillP // chunkfillK. +qed. + +lemma w8L2bits_inj: injective w8L2bits. +proof. +rewrite /w8L2bits; elim. + by move=> [|y ys]. +move=> x xs IH; elim => //. +move=> y ys IH2. +rewrite !map_cons !flatten_cons. +rewrite eqseq_cat. + by rewrite !size_w2bits. +move=> [/W8.w2bits_inj <- ?]; congr. +by apply IH. +qed. + +lemma w8L2bitsK: cancel w8L2bits bits2w8L. +proof. +move=> k; apply w8L2bits_inj. +by rewrite bits2w8LK // size_w8L2bits dvdz_mulr. +qed. + +lemma w8L2bits_xor l1 l2: + w8L2bits (JUtils.map2 W8.(`^`) l1 l2) + = map2 Bool.(^^) (w8L2bits l1) (w8L2bits l2). +proof. +elim: l1 l2 => //=. + by move=> [|y ys]; rewrite w8L2bits_nil // w8L2bits_cons. +move=> x xs IH1; elim => //=. + rewrite map2C; first by move=> b1 b2; ring. + by rewrite w8L2bits_cons. +move=> y ys IH2. +rewrite !w8L2bits_cons map2_cat. + by rewrite !size_w2bits. +by rewrite IH1. +qed. + +lemma w8L2bits_nseq0 n: + 0 <= n => + w8L2bits (nseq n W8.zero) = nseq (8*n) false. +proof. +elim/natind: n => /=. + by move=> n Hn1 Hn2; rewrite !nseq0_le 1,2:/#. +move=> n Hn IH H; rewrite nseqS // w8L2bits_cons IH //. +by rewrite addzC mulzDr mulz1 nseq_add /#. +qed. + + +(*******************************************************************************) +(* W64 lists *) +(*******************************************************************************) + +op w64L2bits (l: W64.t list) : bool list = + flatten (map W64.w2bits l). + +lemma size_w64L2bits l: + size (w64L2bits l) = 64 * size l. +proof. +by rewrite /w64L2bits size_flatten -map_comp /(\o) /= StdBigop.Bigint.sumzE +StdBigop.Bigint.BIA.big_mapT /(\o) /= StdBigop.Bigint.big_constz count_predT_eq. +qed. + +(*hint simplify size_w64L2bits.*) + +op bits2w64L (bs: bool list) : W64.t list = + map W64.bits2w (BitEncoding.BitChunking.chunk 64 (chunkfill false 64 bs)). + +lemma bits2w64L_nil: bits2w64L [] = []. +proof. +rewrite /bits2w64L chunkfill_nil. +by rewrite /BitEncoding.BitChunking.chunk /= mkseq0. +qed. + +lemma size_bits2w64L' bs: + size (bits2w64L bs) = (size bs - 1) %/ 64 + 1. +proof. +rewrite /bits2w64L size_map BitEncoding.BitChunking.size_chunk //. +rewrite size_chunkfill //. +rewrite {3}(:64 = 1*64) 1:/# -mulzDl. +by rewrite -(addz0 (((size bs - 1) %/ 64 + 1) * 64)) divzMDl. +qed. + +lemma size_bits2w64L bs: + 64 %| size bs => size (bits2w64L bs) = size bs %/ 64. +proof. by rewrite dvdzP size_bits2w64L' => [[k ->]]; smt(). qed. + +hint simplify bits2w64L_nil. + +lemma bits2w64LK bs: + 64 %| size bs => w64L2bits (bits2w64L bs) = bs. +proof. +move=> Hsz. +rewrite /w64L2bits -map_comp dvd_chunkfill //. +have : forall (x : bool list), + x \in BitEncoding.BitChunking.chunk 64 bs => + idfun x = (fun x => w2bits ((bits2w x))%W64) x. + move=> x Hx; beta. + rewrite W64.bits2wK //. + by apply (BitEncoding.BitChunking.in_chunk_size _ _ _ _ Hx). +rewrite List.eq_in_map => <-. +by rewrite map_id BitEncoding.BitChunking.chunkK // Hsz. +qed. + +lemma bits2w64LK' bs: + w64L2bits (bits2w64L bs) = chunkfill false 64 bs. +proof. +rewrite /bits2w64L -chunkfillK //. +by rewrite bits2w64LK ?chunkfillP // chunkfillK. +qed. + +lemma w64L2bits_inj: injective w64L2bits. +proof. +rewrite /w64L2bits; elim. + by move=> [|y ys]. +move=> x xs IH; elim => //. +move=> y ys IH2. +rewrite !map_cons !flatten_cons. +rewrite eqseq_cat. + by rewrite !size_w2bits. +move=> [/W64.w2bits_inj <- ?]; congr. +by apply IH. +qed. + +lemma w64L2bitsK: cancel w64L2bits bits2w64L. +proof. +move=> k; apply w64L2bits_inj. +by rewrite bits2w64LK // size_w64L2bits dvdz_mulr. +qed. + +lemma w64L2bits_nil: w64L2bits [] = [] by done. + +lemma w64L2bits_cons x xs: w64L2bits (x::xs) = W64.w2bits x ++ w64L2bits xs. +proof. by rewrite /w64L2bits map_cons flatten_cons. qed. + +lemma w64L2bits_cat l1 l2: + w64L2bits (l1++l2) = w64L2bits l1 ++ w64L2bits l2. +proof. +elim: l1 => //=. + by rewrite w64L2bits_nil. +by move=> x xs IH; rewrite !w64L2bits_cons IH. +qed. + +lemma take_w64L2bits n l: + take (64*n) (w64L2bits l) = w64L2bits (take n l). +proof. +elim/natind: n l => //=. + move=> n Hn l; rewrite !take_le0 //. + by apply StdOrder.IntOrder.mulr_ge0_le0. +move=> n Hn IH [|x xs] /=. + by rewrite w64L2bits_nil. +have ->/=: ! (n+1 <= 0) by rewrite -ltzNge ltzS. +rewrite !w64L2bits_cons take_cat. +have ->/=: ! (64 * (n + 1) < size (w2bits x)) by rewrite W64.size_w2bits /#. +by rewrite mulzDr /= IH. +qed. + +lemma drop_w64L2bits n l: + drop (64*n) (w64L2bits l) = w64L2bits (drop n l). +proof. +elim/natind: n l => //=. + move=> n Hn l; rewrite !drop_le0 //. + by apply StdOrder.IntOrder.mulr_ge0_le0. +move=> n Hn IH [|x xs] /=. + by rewrite w64L2bits_nil. +have ->/=: ! (n+1 <= 0) by rewrite -ltzNge ltzS. +rewrite !w64L2bits_cons drop_cat. +have ->/=: ! (64 * (n + 1) < size (w2bits x)) by rewrite W64.size_w2bits /#. +by rewrite mulzDr /= IH. +qed. + +lemma nth_w64L2bits l i: + 0 <= i < 64 * size l => + nth false (w64L2bits l) i + = nth false (W64.w2bits (nth W64.zero l (i %/ 64))) (i%%64). +proof. +move=> Hi; rewrite /w64L2bits (BitEncoding.BitChunking.nth_flatten _ 64). + by rewrite allP; move=> x /mapP [y [Hy ->]]. +rewrite (nth_map W64.zero) //. +apply divz_cmp => //. +by rewrite mulzC. +qed. + +lemma w64L2bits_xor l1 l2: + w64L2bits (JUtils.map2 W64.(`^`) l1 l2) + = map2 Bool.(^^) (w64L2bits l1) (w64L2bits l2). +proof. +elim: l1 l2 => //=. + by move=> [|y ys]; rewrite w64L2bits_nil // w64L2bits_cons. +move=> x xs IH1; elim => //=. + rewrite w64L2bits_nil map2C; first by move=> b1 b2; ring. + by rewrite w64L2bits_cons. +move=> y ys IH2. +rewrite !w64L2bits_cons map2_cat. + by rewrite !size_w2bits. +by rewrite IH1. +qed. + +lemma w64L2bits_nseq0 n: + 0 <= n => + w64L2bits (nseq n W64.zero) = nseq (64*n) false. +proof. +elim/natind: n => /=. + by move=> n Hn1 Hn2; rewrite !nseq0_le 1,2:/# w64L2bits_nil. +move=> n Hn IH H; rewrite nseqS // w64L2bits_cons IH //. +by rewrite addzC mulzDr mulz1 nseq_add /#. +qed. + +(*******************************************************************************) +(* W8 lists => W64 lists *) +(*******************************************************************************) + +op w8L2w64L (l: W8.t list) : W64.t list = + map W8u8.pack8 (BitEncoding.BitChunking.chunk 8 (chunkfill W8.zero 8 l)). + +lemma w8L2w64L_nil: w8L2w64L [] = []. +proof. by rewrite /w8L2w64L chunkfill_nil /BitEncoding.BitChunking.chunk mkseq0. qed. + +hint simplify w8L2w64L_nil. + +lemma w8L2w64L_cat l1 l2: + 8 %| size l1 => w8L2w64L (l1++l2) = w8L2w64L l1 ++ w8L2w64L l2. +proof. +move=> Hsz; rewrite /w8L2w64L chunkfill_cat //. +rewrite BitEncoding.BitChunking.chunk_cat // map_cat. +by rewrite (chunkfillK' l1) //. +qed. + +lemma w8L2w64L_singl xs: + 0 < size xs <= 8 => w8L2w64L xs = [pack8 xs]. +proof. +move=> Hsz; rewrite /w8L2w64L /BitEncoding.BitChunking.chunk. +have ->: size (chunkfill W8.zero 8 xs) %/ 8 = 1. + rewrite size_chunkfill // /#. +rewrite mkseq1 /= drop0 take_oversize. + rewrite size_chunkfill //; smt(size_ge0). +rewrite !pack8E; apply W64.init_ext => x Hx /=. +by congr; rewrite !W8u8.Pack.get_of_list 1,2:/# nth_chunkfill. +qed. + +lemma w8L2w64L_cons l: + 0 < size l => + w8L2w64L l = W8u8.pack8 (take 8 l) :: w8L2w64L (drop 8 l). +proof. +move=> Hsz0; rewrite -{1}(cat_take_drop 8 l). +case: (size l <= 8) => Hsz. + by rewrite !drop_oversize //= cats0 take_oversize // w8L2w64L_singl // E /=. +rewrite w8L2w64L_cat. + by rewrite size_take // (: 8 < size l) 1:/# /= dvdzz. +by rewrite w8L2w64L_singl // size_take // /#. +qed. + +lemma drop_w8L2w64L n l: + drop n (w8L2w64L l) = w8L2w64L (drop (8*n) l). +proof. +elim/natind: n l => //=. + by move=> n Hn l; rewrite !drop_le0 // /#. +move=> n Hn IH l. +rewrite -drop_drop //. +move: l => [|x xs] //. +rewrite {1}(w8L2w64L_cons (x::xs) _) /= 1:[smt(size_ge0)] drop0. +rewrite (:! 8 * (n + 1) <= 0) 1:/# /= IH drop_drop 1:/# //. +by congr; congr; ring. +qed. + +lemma size_w8L2w64L l: + size (w8L2w64L l) = (size l - 1) %/ 8 + 1. +proof. +rewrite /w8L2w64L size_map BitEncoding.BitChunking.size_chunk //. +rewrite size_chunkfill //. +by rewrite -{3}(mul1z 8) -mulzDl mulzK. +qed. + +lemma size_w8L2w64L' l: + 8 %| size l => size (w8L2w64L l) = size l %/ 8. +proof. by rewrite size_w8L2w64L dvdz_eq => E; smt(). qed. + +lemma take_w8L2w64L n l: + take n (w8L2w64L l) = w8L2w64L (take (8*n) l). +proof. +rewrite -{1}(cat_take_drop (8*n) l). +case: (0 <= 8*n) => Hsz0; last by rewrite !take_le0 /#. +case: (8*n <= size l) => E. + rewrite w8L2w64L_cat. + rewrite size_take' 1:/# E /= /#. + rewrite take_cat' !size_w8L2w64L size_take' // !E /=. + rewrite (:n <= (8 * n - 1) %/ 8 + 1) 1:/# /= take_oversize //. + by rewrite size_w8L2w64L size_take' // E /= /#. +rewrite drop_oversize 1:/# cats0 take_oversize //. +by rewrite size_w8L2w64L size_take' /#. +qed. + +lemma nth_w8L2w64L (l : W8.t list) (i : int): + nth W64.zero (w8L2w64L l) i + = pack8_t (W8u8.Pack.init (fun j => l.[8*i + j])). +proof. +rewrite /w8L2w64L. +case: (0 <= i /\ i < (size l-1) %/ 8 + 1) => E; last first. + rewrite nth_out; first by rewrite size_map size_chunkfilled /#. + rewrite -(W8u8.Pack.init_ext (fun j => W8.zero)). + move=> j Hj /=; rewrite nth_out// 1:/#. + rewrite -(W8u8.unpack8K W64.zero); congr. + apply W8u8.Pack.ext_eq => j Hj. + by rewrite !W8u8.Pack.initiE //= W8u8.get_zero. +rewrite (nth_map []) /=; first by rewrite size_chunkfilled /#. +rewrite nth_chunkfilled' // 1:/#. +congr; apply W8u8.Pack.ext_eq => j Hj. +rewrite W8u8.Pack.initiE //=. +by rewrite W8u8.Pack.get_of_list //= nth_mkseq //. +qed. + + +(*******************************************************************************) +(* W64 lists => W8 lists *) +(*******************************************************************************) + + +op w64L2w8L (l: W64.t list) : W8.t list = + flatten (map W8u8.to_list l). + +lemma w64L2w8L_nil: + w64L2w8L [] = []. +proof. by rewrite /w64L2w8L. qed. + +hint simplify w64L2w8L_nil. + +lemma w64L2w8L_cons x xs: + w64L2w8L (x::xs) = W8u8.to_list x ++ w64L2w8L xs. +proof. by rewrite /w64L2w8L map_cons flatten_cons. qed. + +lemma size_w64L2w8L (l: W64.t list): + size (w64L2w8L l) = 8 * size l. +proof. +elim: l => //= x xs IH. +by rewrite w64L2w8L_cons size_cat IH W8u8.Pack.size_to_list; ring. +qed. + +(*hint simplify size_w64L2w8L.*) + +lemma w64L2w8L2bits l: + w8L2bits (w64L2w8L l) = w64L2bits l. +proof. +elim: l; first by rewrite /w64L2w8L /flatten. +move=> x xs IH. +rewrite /w64L2w8L map_cons flatten_cons w64L2bits_cons w8L2bits_cat; congr. +by rewrite /w8L2bits /flatten. +qed. + +lemma w64L2w8L_singl x: w64L2w8L [x] = W8u8.to_list x by rewrite /w64L2w8L. + +lemma w64L2w8L_cat l1 l2: + w64L2w8L (l1++l2) = w64L2w8L l1 ++ w64L2w8L l2. +proof. +elim: l1 => //= x xs IH. +by rewrite !w64L2w8L_cons IH catA. +qed. + +lemma take_w64L2w8L n l: + take (8*n) (w64L2w8L l) = w64L2w8L (take n l). +proof. +elim: l n => //= x xs IH n. +case: (n <= 0) => E /=; first by rewrite take_le0 /#. +rewrite !w64L2w8L_cons -IH take_cat W8u8.Pack.size_to_list. +by rewrite (:!8*n<8) /#. +qed. + +lemma nth_w64L2w8L (l : W64.t list) (i : int): + nth W8.zero (w64L2w8L l) i + = nth W64.zero l (i %/ 8) \bits8 (i %% 8). +proof. +rewrite /w64L2w8L. +have Hsz: all (fun (s : W8.t list) => size s = 8) + (map (fun (w : W64.t) => (to_list w)%W8u8) l). + by rewrite allP => x /mapP [y [Hy ->]]. +rewrite (BitEncoding.BitChunking.nth_flatten W8.zero 8) //. +move: Hsz; rewrite allP => Hsz. +case: (0 <= i %/ 8 < size l) => E; last first. + rewrite nth_out; first rewrite nth_out ?size_map /#. + by rewrite nth_out // W8u8.get_zero /#. +rewrite (nth_map W64.zero) //; beta. +by rewrite W8u8.Pack.get_to_list W8u8.get_unpack8 /#. +qed. + +lemma w8L2w64LK (l: W8.t list): + 8 %| size l => w64L2w8L (w8L2w64L l) = l. +proof. +move=> Hsz. +rewrite /w64L2w8L /w8L2w64L -map_comp dvd_chunkfill //. +have : forall (x : W8.t list), + x \in BitEncoding.BitChunking.chunk 8 l => + idfun x = W8u8.to_list (pack8 x). + move=> x Hx; beta. + rewrite W8u8.pack8K // of_listK //. + by apply (BitEncoding.BitChunking.in_chunk_size _ _ _ _ Hx). +rewrite List.eq_in_map => <-. +by rewrite map_id BitEncoding.BitChunking.chunkK // Hsz. +qed. + +lemma w8Lw64LK' l: + w64L2w8L (w8L2w64L l) = chunkfill W8.zero 8 l. +proof. +rewrite /w8L2w64L -chunkfillK //. +by rewrite w8L2w64LK ?chunkfillP // chunkfillK. +qed. + +lemma w64L2w8L_inj: injective w64L2w8L. +proof. +rewrite /w64L2w8L; elim. + by move=> [|y ys]. +move=> x xs IH; elim => //. +move=> y ys IH2. +rewrite !map_cons !flatten_cons. +rewrite eqseq_cat //; beta. +move=> [/W8u8.Pack.to_list_inj E ?]; congr; last by apply IH. +by rewrite -unpack8K E. +qed. + +lemma w64L2w8LK: cancel w64L2w8L w8L2w64L. +proof. +move=> k; apply w64L2w8L_inj. +by rewrite w8L2w64LK // size_w64L2w8L dvdz_mulr. +qed. + +(*******************************************************************************) +(* MEMORY OPERATIONS *) +(*******************************************************************************) + +lemma stores_singl mem out x: stores mem out [x] = storeW8 mem out x. +proof. by rewrite storeW8E /stores. qed. + +lemma stores_cat mem out l1 l2: + stores mem out (l1++l2) = stores (stores mem out l1) (out + size l1) l2. +proof. +elim: l1 mem out => //= x xs IH mem out. +by rewrite !stores_cons IH addzA. +qed. + +lemma stores_cons' mem out x xs: + stores mem out (x::xs) = stores (storeW8 mem out x) (out+1) xs. +proof. by rewrite -cat1s stores_cat stores_singl. qed. + +lemma stores_rcons mem out x xs: + stores mem out (rcons xs x) = storeW8 (stores mem out xs) (out + size xs) x. +proof. by rewrite -cats1 stores_cat stores_singl. qed. + +lemma stores_u64 mem out x: + stores mem out (W8u8.to_list x) = storeW64 mem out x by rewrite storeW64E. + + +(* name alias to [stores] to avoid uncontrolled evaluation... *) +op stores8 mem out l = stores mem out l +axiomatized by stores8E. + +lemma stores8_nil mem out: stores8 mem out [] = mem. +proof. by rewrite stores8E. qed. + +lemma stores8_singl mem out x: stores8 mem out [x] = storeW8 mem out x. +proof. by rewrite stores8E storeW8E /stores. qed. + +hint simplify stores8_nil, stores8_singl. + +lemma stores8_cat mem out l1 l2: + stores8 mem out (l1++l2) = stores8 (stores8 mem out l1) (out + size l1) l2. +proof. by rewrite !stores8E stores_cat. qed. + +lemma stores8_cons' mem out x xs: + stores8 mem out (x::xs) = stores8 (storeW8 mem out x) (out+1) xs. +proof. by rewrite !stores8E stores_cons'. qed. + +lemma stores8_rcons mem out x xs: + stores8 mem out (rcons xs x) = storeW8 (stores8 mem out xs) (out + size xs) x. +proof. by rewrite !stores8E stores_rcons. qed. + +lemma stores8_u64 mem out x: + stores8 mem out (W8u8.to_list x) = storeW64 mem out x. +proof. by rewrite stores8E storeW64E. qed. + + +(* as well for [store64]... *) +op stores64 (m: global_mem_t) (a:address) (w: W64.t list): global_mem_t = + foldl (fun (m0 : global_mem_t) (i : int) => storeW64 m0 (a + 8*i) (nth W64.zero w i)) + m (iota_ 0 (size w)) +axiomatized by stores64E. + +lemma stores64_nil mem a: stores64 mem a [] = mem. +proof. by rewrite stores64E. qed. + +lemma stores64_singl mem a x: stores64 mem a [x] = storeW64 mem a x. +proof. by rewrite stores64E. qed. + +hint simplify stores64_nil, stores64_singl. + +lemma stores64_cat mem out l1 l2: + stores64 mem out (l1 ++ l2) + = stores64 (stores64 mem out l1) (out + 8*size l1) l2. +proof. +rewrite !stores64E size_cat iota_add; first 2 smt(size_ge0). +rewrite (addzC 0) iota_addl foldl_cat foldl_map /=. +have ->: foldl (fun (m0 : global_mem_t) (i : int) => + storeW64 m0 (out + 8 * i) (nth W64.zero (l1 ++ l2) i)) mem + (iota_ 0 (size l1)) + = foldl (fun (m0 : global_mem_t) (i : int) => + storeW64 m0 (out + 8 * i) (nth W64.zero l1 i)) mem + (iota_ 0 (size l1)). + apply foldl_in_eq => mem' x; rewrite mem_iota => |> *. + by rewrite nth_cat H0. +apply foldl_in_eq => mem' x; rewrite mem_iota => |> *. +case: (x=0) => E. + by rewrite E /= nth_cat ltzz. +rewrite nth_cat (:! size l1 + x < size l1) 1:/# /=; congr; first smt(). +congr; smt(). +qed. + +lemma stores64_cons mem a x xs: + stores64 mem a (x::xs) = stores64 (storeW64 mem a x) (a+8) xs. +proof. by rewrite -cat1s stores64_cat. qed. + +lemma stores64_rcons mem out xs x: + stores64 mem out (rcons xs x) + = storeW64 (stores64 mem out xs) (out + 8*size xs) x. +proof. by rewrite -cats1 stores64_cat. qed. + +lemma stores64_stores8 mem out l: + stores64 mem out l = stores8 mem out (w64L2w8L l). +proof. +rewrite stores8E; elim/last_ind: l mem out => //= xs x IH mem out. +rewrite stores64_rcons IH -cats1 w64L2w8L_cat stores_cat w64L2w8L_singl. +by rewrite stores_u64 size_w64L2w8L. +qed. + + +(** [memread] reads a list of bytes from memory *) +op memread (m: global_mem_t) (a: address) (sz: int): W8.t list = + mkseq (fun i => m.[a + i]) sz. + +lemma size_memread mem a sz: + 0 <= sz => size (memread mem a sz) = sz +by rewrite size_mkseq /#. + +lemma drop_memread n mem ptr k: + 0 <= n <= k => + drop n (memread mem ptr k) = memread mem (ptr+n) (k-n). +proof. +move=> Hn; rewrite drop_mkseq //=. +by apply eq_mkseq => x; smt(). +qed. + +lemma nth_memread mem in_ inlen i: + 0 <= i < inlen => + nth W8.zero (memread mem in_ inlen) i + = loadW8 mem (in_ + i)%Int. +proof. by move=> Hi; rewrite nth_mkseq. qed. + +lemma memread0 mem in_: memread mem in_ 0 = [] by done. + +lemma memread1 mem in_: memread mem in_ 1 = [loadW8 mem in_] by done. + +hint simplify memread0, memread1. + +lemma memread_add mem in_ x y: + 0 <= x => 0 <= y => + memread mem in_ (x+y)%Int = memread mem in_ x ++ memread mem (in_ + x) y. +proof. +move=> Hx Hy; rewrite /memread mkseq_add //; congr. +by apply eq_mkseq => z /=; rewrite addzA. +qed. + +lemma memreadS mem in_ x: + 0 <= x => + memread mem in_ (x+1)%Int = rcons (memread mem in_ x) (loadW8 mem (in_+x)). +proof. by move=> Hx; rewrite memread_add //= cats1. qed. + +lemma take_memread n mem ptr k: + 0 <= n => + take n (memread mem ptr k) = memread mem ptr (min n k). +proof. by move=> Hn; rewrite /memread take_mkseq. qed. + +lemma loadW8_memread mem in_ inlen i: + 0 <= i < inlen => + loadW8 mem (in_ + i)%Int + = nth W8.zero (memread mem in_ inlen) i. +proof. +rewrite /loadW8 /memread => Hi. +by rewrite nth_mkseq. +qed. + +lemma loadW8_memread' mem in_ off inlen i: + (off <= i < off + inlen)%Int => + loadW8 mem (in_ + i)%Int + = nth W8.zero (memread mem (in_ + off) inlen) (i-off). +proof. +rewrite /loadW8 /memread => Hi. +by rewrite nth_mkseq /#. +qed. + + +lemma nth_memread_u64 mem in_ inlen i: + 0 <= i => 8*i+8 <= inlen => + loadW64 mem (in_+8*i) = nth W64.zero (w8L2w64L (memread mem in_ inlen)) i. +proof. +move=> ??; rewrite nth_w8L2w64L. +rewrite /loadW64 W8u8.pack8E pack8E; apply W64.init_ext => x Hx /=. +congr; rewrite W8u8.Pack.initiE 1:/# /= /memread. +by rewrite W8u8.Pack.initiE 1:/# /= nth_mkseq /#. +qed. + + +lemma memread_split off mem a sz: + 0 <= off <= sz => + memread mem a sz = memread mem a off ++ memread mem (a+off) (sz-off). +proof. +move=> Hoff; have ->: sz = off + (sz-off) by ring. +rewrite /memread mkseq_add 1,2:/#; congr. +rewrite (:off + (sz - off) - off = sz-off) 1:/#. +by apply eq_mkseq => i /#. +qed. + + + +(** [memread64] reads a list of [n] (full) 64-bit words from memory *) +op memread64 (m: global_mem_t) (a: address) (n: int): W64.t list = + mkseq (fun i => loadW64 m (a+8*i)) n. + +lemma memread64_0 mem in_: memread64 mem in_ 0 = [] by done. + +lemma memread64_1 mem in_: memread64 mem in_ 1 = [loadW64 mem in_] by done. + +hint simplify memread64_0, memread64_1. + +lemma size_memread64 mem a sz: + 0 <= sz => size (memread64 mem a sz) = sz +by rewrite size_mkseq /#. + +lemma nth_memread64 m a sz i: + 0 <= i < sz => + nth W64.zero (memread64 m a sz) i = loadW64 m (a+8*i). +proof. by move=> Hsz; rewrite nth_mkseq //. qed. + +lemma memread64E m a sz: + memread64 m a sz = w8L2w64L (memread m a (8*sz)). +proof. +apply (eq_from_nth W64.zero). + by rewrite size_mkseq size_w8L2w64L size_mkseq /#. +rewrite size_mkseq => i Hi. +rewrite nth_w8L2w64L nth_memread64 1:/# /loadW64; congr. +apply W8u8.Pack.init_ext => j Hj /=. +by rewrite nth_mkseq /#. +qed. + +lemma memread_split64 mem a sz: + 0 <= sz => + memread mem a sz + = w64L2w8L (memread64 mem a (sz %/ 8)) + ++ memread mem (a + sz %/8 * 8) (sz %% 8). +proof. +move=> Hsz; rewrite (memread_split (sz %/ 8*8)) 1:/#; congr. + by rewrite memread64E w8L2w64LK ?size_memread /#. +by rewrite modzE. +qed. + +lemma memread64_add mem in_ x y: + 0 <= x => 0 <= y => + memread64 mem in_ (x+y)%Int = memread64 mem in_ x ++ memread64 mem (in_ + 8*x) y. +proof. +move=> Hx Hy; rewrite /memread64 mkseq_add //; congr. +by apply eq_mkseq => z /=; congr; ring. +qed. + +lemma memread64S mem in_ i: + 0 <= i => + memread64 mem in_ (i+1) + = rcons (memread64 mem in_ i) (loadW64 mem (in_ + 8*i)). +proof. by move=> Hi; rewrite memread64_add // memread64_1 cats1. qed. + diff --git a/sha3/proof/impl/Spec1600.ec b/sha3/proof/impl/Spec1600.ec new file mode 100644 index 0000000..7724a00 --- /dev/null +++ b/sha3/proof/impl/Spec1600.ec @@ -0,0 +1,959 @@ +(****************************************************************************** + Spec1600.ec: + + Byte-oriented and statefull specification of the sponge construction. +******************************************************************************) +require import AllCore List Int IntDiv. +from Jasmin require import JArray JMemory JModel JWord JWord_array JUtils. + +require import EclibExtra JWordList. + + +op rate :int. +axiom rate_bnds: 0 < rate < 1600. +axiom rate_w64: 64 %| rate. + +require Sponge1600. + +clone import Sponge1600 as Spnge1600 + with op rate = rate + proof rate_bnds by apply rate_bnds + proof rate_w64 by apply rate_w64. + +import Common1600 Block Capacity. + + +(* Additional results on bit-level constructions *) + +lemma num0_block_suffix n k: + num0 (k * rate + n) = num0 n. +proof. by rewrite /num0 -modzNm -addzA modzMDl modzNm. qed. + +lemma mkpad_rate n: + 0 <= n => mkpad (r + n) = mkpad n. +proof. +move=> Hn; rewrite /mkpad /=; congr; congr. +by rewrite (num0_block_suffix n 1). +qed. + +lemma chunk_r (m: bool list): + size m = r => chunk m = [m]. +proof. +have Hr: r <> 0 by smt(rate_bnds). +move=> Hsz; rewrite /chunk Hsz divzz /= Hr /b2i mkseq1 /= drop0. +by rewrite -Hsz take_size. +qed. + +lemma pad2blocksE m: + r <= size m => + pad2blocks m = mkblock (take r m) :: pad2blocks (drop r m). +proof. +move=> Hm. +have Hsz: size (take r m) = r by rewrite size_take; smt(rate_bnds). +rewrite -{1}(cat_take_drop r) /pad2blocks /(\o) /bits2blocks /pad. +rewrite -catA chunk_cat ?Hsz ?dvdzz map_cat chunk_r //. +by rewrite /= size_cat Hsz mkpad_rate; smt(size_ge0). +qed. + +lemma mkblock_xor l1 l2: + size l1 = r => size l2 = r => + mkblock l1 +^ mkblock l2 = mkblock (map2 Bool.(^^) l1 l2). +proof. +move=> *; rewrite /(+^) /offun; congr. +rewrite -(eq_mkseq (fun i => Bool.(^^) (nth false l1 i) (nth false l2 i))). + move=> i /=; rewrite !Block.getE. + case: (0 <= i < r) => E. + rewrite eq_sym. rewrite !ofblockK //. + rewrite (nth_inside witness false). smt(). + rewrite (nth_inside witness false). smt(). + done. + rewrite nth_out. smt(). + rewrite nth_out. smt(). + done. +apply (eq_from_nth false). + rewrite size_mkseq size_map2 H H0 max_ler. + smt(rate_bnds). + by rewrite min_ler. +rewrite size_mkseq max_ler. smt(rate_bnds). +move=> i Hi. +rewrite nth_mkseq //=. +by rewrite (nth_map2 false false) /#. +qed. + +op block0star1 = mkblock (nseq (rate-1) false ++ [true]). + +lemma block0star1P m: + size m <= r-2 => + mkblock (m++mkpad (size m)) + = mkblock (m++[true]++nseq (r-size m-1) false) +^ block0star1. +proof. +move=> Hm. +rewrite /mkpad mkblock_xor. + by rewrite !size_cat size_nseq max_ler //= 1:/#; ring. + by rewrite size_cat size_nseq max_ler; smt(rate_bnds). +have E: num0 (size m) = r - size m - 2. + rewrite /num0 -(modzMDl 1) modz_small. + by apply bound_abs; smt(rate_bnds size_ge0). + by ring. +congr; apply (eq_from_nth false). + rewrite !size_cat /= size_rcons size_nseq max_ler E; first smt(size_ge0). + rewrite size_map2 min_ler. + by rewrite !size_cat !size_nseq !max_ler; smt(rate_bnds size_ge0). + by rewrite size_cat size_nseq max_ler /=; smt(rate_bnds). +move=> i; rewrite !size_cat /= size_rcons size_nseq max_ler ?num0_ge0 E. +rewrite -!cats1 (: size m + (1 + (r - size m - 2 + 1)) = r) 1:/# => Hi. +case: (i=r-1) => [->|?]. + rewrite nth_cat /= nth_cat. + rewrite (:! r - 1 < size m) 1:/# /=. + rewrite (:! r - 1 - size m - 1 < size (nseq (r - size m - 2) false)) /=. + by rewrite size_nseq max_ler /#. + rewrite (:r - 1 - size m <> 0) 1:/# /=. + rewrite (:r - 1 - size m - 1 - size (nseq (r - size m - 2) false) = 0) /=. + by rewrite size_nseq max_ler /#. + rewrite (nth_map2 false false). + rewrite min_ler. + by rewrite size_cat size_nseq max_ler 1:/# !size_cat /= size_nseq max_ler /#. + by rewrite size_cat size_nseq max_ler /#. + rewrite !nth_cat size_cat /=. + rewrite (:! r - 1 < size m + 1) 1:/# /=. + rewrite nth_nseq 1:/# /= size_nseq max_ler 1:/# ltzz /=. + by ring. +rewrite (nth_map2 false false). + rewrite min_ler. + by rewrite size_cat size_nseq max_ler 1:/# !size_cat /= size_nseq max_ler /#. + by rewrite size_cat size_nseq max_ler /#. +have ->: nth false (nseq (Top.rate - 1) false ++ [true]) i = false. + rewrite nth_cat size_nseq max_ler 1:/# (: i < r-1) 1:/# /=. + by rewrite nth_nseq /#. +rewrite Bool.xor_false nth_cat. +case: (i < size m) => I1. + by rewrite -catA nth_cat I1. +rewrite eq_sym -catA nth_cat I1 /=; case: (i-size m <> 0) => I2 //=. +rewrite nth_cat size_nseq max_ler 1:/#. +rewrite (:i - size m - 1 < r - size m - 2) 1:/# /=. +by rewrite !nth_nseq /#. +qed. + + + + +(* 1600bit state *) +require import Array25 WArray200. + +(* State is defined as an array of 25 64-bit words. But it can also be + viewed as an array of 200 bytes (which is the preferred view in this + specification). *) +type state = W64.t Array25.t. +abbrev state200 (st: state) : WArray200.t = WArray200.init64 ("_.[_]" st). +abbrev state25 (st200: WArray200.t) : state = Array25.init (WArray200.get64 st200). + +(* set/get individual bytes *) +abbrev w64_set8 (w: W64.t) i (b: W8.t) = W8u8.pack8_t (W8u8.unpack8 w).[i <- b]. +abbrev state_get8 (st: state) i = (state200 st).[i]. +abbrev state_set8 (st: state) i x = state25 (state200 st).[i <- x]. + +lemma state_get8E st i: + 0 <= i < 200 => + state_get8 st i = st.[i %/ 8] \bits8 (i %% 8). +proof. by move=> Hi; rewrite initE Hi. qed. + +lemma state_set8E st i x: + 0 <= i < 200 => + state_set8 st i x + = st.[i %/ 8 <- w64_set8 st.[i %/ 8] (i %% 8) x]. +proof. +move=> Hi; apply Array25.ext_eq => j Hj. +rewrite initiE // get64E get_set_if. +rewrite (: 0 <= i %/ 8 < 25 ) 1:/# /=. +rewrite -(W8u8.Pack.init_ext + (fun (k:int) => if j=i%/8 then w64_set8 st.[i%/8] (i%%8) x \bits8 k + else st.[j] \bits8 k)). + move=> k Hk /=. + rewrite get_setE // state_get8E 1:/#. + case: (8 * j + k = i) => E /=. + rewrite (:j=i%/8) 1:/# /= pack8bE 1:/#. + by rewrite get_setE 1:/# (:i%%8=k) 1:/#. + case: (j=i%/8) => E2. + rewrite -!E2 /w64_set8 /=. + rewrite pack8bE // get_set_if. + by rewrite (:!k = i %% 8) 1:/# /= W8u8.get_unpack8 //; congr; smt(). + by congr; [congr|]; smt(). +case: (j=i%/8) => E. + by rewrite -{2}(W8u8.unpack8K (w64_set8 _ _ _)) /unpack8; congr. +by rewrite -(W8u8.unpack8K st.[j]); congr. +qed. + + +lemma state200K: cancel state200 state25. +proof. +move=> x; apply Array25.ext_eq => i Hi. +rewrite initiE // get64E /= -(W8u8.unpack8K x.[i]); congr. +apply W8u8.Pack.init_ext => k Hk /=. +by rewrite state_get8E 1:/#; congr; [congr|]; smt(). +qed. + +lemma state25K: cancel state25 state200. +proof. +move=> x; apply WArray200.ext_eq => i Hi. +rewrite state_get8E //. +rewrite initiE 1:/# get64E pack8bE 1:/#. +by rewrite initiE 1:/# /=; congr; smt(). +qed. + +(* conversion between different list representations for state *) +abbrev state2w8L (st: state): W8.t list = to_list (state200 st). +op state2bits (st: state): bool list = w8L2bits (state2w8L st). +op w8L2state (l: W8.t list): state = state25 (WArray200.of_list l). + +lemma size_state2bits (st: state): + size (state2bits st) = 1600. +proof. by rewrite /state2bits size_w8L2bits size_to_list. qed. + +abbrev state2w64L (st: state): W64.t list = to_list st. +op w64L2state (l: W64.t list): state = Array25.of_list W64.zero l. + +(* we can go back and forward on the various representations *) +lemma w8L2w64L2state l: + w8L2state l = w64L2state (w8L2w64L l). +proof. +apply Array25.ext_eq => i Hi. +rewrite initiE // get64E Array25.get_of_list //. +rewrite nth_w8L2w64L; congr. +apply W8u8.Pack.init_ext=> /= x Hx. +by rewrite get_of_list /#. +qed. + +lemma w64L2w8L2state l: + w64L2state l = w8L2state (w64L2w8L l). +proof. +apply Array25.ext_eq => i Hi. +rewrite Array25.get_of_list //. +rewrite Array25.initE Hi /= get64E /=. +rewrite -(W8u8.Pack.init_ext ((\bits8) (nth W64.zero l i))) /=. +move=> j Hj; rewrite WArray200.get_of_list 1:/# nth_w64L2w8L; congr. ++ congr; smt(). ++ smt(). ++ by rewrite (W8u8.unpack8K (nth W64.zero l i)). +qed. + +lemma state2w8L2w64L st: + state2w8L st = w64L2w8L (state2w64L st). +proof. by rewrite /init64 /w64L2w8L /flatten /Array25.to_list /mkseq. qed. + +lemma state2w64L2w8L st: + state2w64L st = w8L2w64L (state2w8L st). +proof. by rewrite state2w8L2w64L w64L2w8LK. qed. + +lemma state_get8P st i: + state_get8 st i = (state2w8L st).[i]. +proof. by rewrite /state2w8L get_to_list. qed. + + + +(* rate expressed in 8 and 64bit words *) +op rate64 = rate %/ 64. +op rate8 = 8*rate64. + +lemma rate64P: 64 * rate64 = rate. +proof. by move: rate_w64; rewrite /rate64 mulzC dvdz_eq. qed. + +lemma rate64_bnds: 0 < rate64 < 25. +proof. move: rate_bnds; rewrite -rate64P /#. qed. + +lemma rate8P: 8 * rate8 = rate. +proof. by rewrite /rate8 /= -mulzA rate64P. qed. + +lemma rate8_bnds: 0 < rate8 < 200. +proof. move: rate_bnds; rewrite -rate8P /#. qed. + + +(* project state into block+capacity *) +op state_r (st: state) : block = + mkblock (take r (state2bits st)). + +op w8L2block (l: W8.t list) : block = + mkblock (w8L2bits (take rate8 l ++ nseq (rate8-size l) W8.zero)). + +op state_c (st: state) : capacity = + mkcapacity (drop r (state2bits st)). + + + + + +(* Initial state *) +op st0 : state = Array25.create W64.zero. + +lemma st0E: + st0 = state25 (WArray200.create W8.zero). +proof. +apply Array25.ext_eq => i Hi. +rewrite /st0 createE !initiE // get64E; beta. +rewrite -(W8u8.unpack8K W64.zero); congr. +apply W8u8.Pack.init_ext => k Hk; beta. +by rewrite WArray200.initiE 1:/# /= W8u8.get_zero. +qed. + +lemma state2bits0: state2bits st0 = nseq 1600 false. +proof. +rewrite st0E /state2bits /state2w8L state25K. +by rewrite /w8L2bits. +qed. + +lemma st0_r: state_r st0 = b0. +proof. +rewrite /state_r state2bits0 b0P take_nseq min_lel //. +apply ltzW; smt(rate_bnds). +qed. + +lemma c0P: c0 = mkcapacity (nseq c false). +proof. +rewrite capacityP=> i Hi. +by rewrite offunifE Hi /= getE Hi /= ofcapacityK 1:size_nseq 1:/# nth_nseq. +qed. + +lemma st0_c: state_c st0 = c0. +proof. rewrite /state_c c0P state2bits0 drop_nseq; smt(rate_bnds). qed. + + + +(* state addition *) + + +op addstate (st1 st2: state) : state = + Array25.map2 W64.(`^`) st1 st2. + +abbrev addstate8 (st: state) (l: W8.t list) : state = addstate st (w8L2state l). +abbrev state_xor8 (st: state) i x = state_set8 st i (state_get8 st i `^` x). +abbrev addstate64 (st: state) (l: W64.t list) : state = addstate st (w64L2state l). + +lemma addstate8_w64L st l: + addstate8 st (w64L2w8L l) = addstate64 st l. +proof. by rewrite -w64L2w8L2state. qed. + +lemma addstate64_w8L st l: + addstate64 st (w8L2w64L l) = addstate8 st l. +proof. by rewrite -w8L2w64L2state. qed. + +lemma addstate_getE st1 st2 i: + 0 <= i < 25 => + (addstate st1 st2).[i] = st1.[i] `^` st2.[i]. +proof. by move=> Hi; rewrite map2iE. qed. + +lemma addstate64_getE st l i: + 0 <= i < 25 => + (addstate64 st l).[i] = st.[i] `^` nth W64.zero l i. +proof. +by move=> Hi; rewrite /addstate map2iE // (Array25.get_of_list W64.zero). +qed. + +lemma addstate64_getE_out st l i: + size l <= i => + (addstate64 st l).[i] = st.[i]. +proof. +move=> Hsz; case: (0 <= i < 25) => E. + by rewrite addstate64_getE // nth_out /#. +by rewrite !get_out. +qed. + +lemma addstate8_get8E st l i: + 0 <= i < 200 => + state_get8 (addstate8 st l) i + = (st.[i %/ 8] \bits8 (i %% 8)) `^` nth W8.zero l i. +proof. +move=> Hi. +rewrite state_get8E // -addstate64_w8L addstate64_getE 1:/#. +rewrite nth_w8L2w64L W8u8.xorb8E pack8bE 1:/#; congr. +by rewrite initiE 1:/# /= /#. +qed. + +lemma addstate8_get8E_out st l i: + size l <= i => + state_get8 (addstate8 st l) i = state_get8 st i. +proof. +move=> Hsz; case: (0 <= i < 200) => E. + by rewrite addstate8_get8E // nth_out 1:/# state_get8E. +by rewrite !get_out. +qed. + +lemma addstate64_rcons st l x: + size l < 25 => + addstate64 st (rcons l x) = (addstate64 st l).[size l <- st.[size l] `^` x]. +proof. +move=> Hsz; apply Array25.ext_eq => i Hi. +rewrite addstate64_getE // get_set_if (:0 <= size l < 25) /=; first smt(size_ge0). +case: (i=size l) => E; first by rewrite nth_rcons E. +rewrite addstate64_getE //; congr. +case: (i < size l) => H; first by rewrite nth_rcons H. +by rewrite !nth_out ?size_rcons /#. +qed. + +lemma addstate64_rconsE i st l x: + i = size l => + i < 25 => + addstate64 st (rcons l x) = (addstate64 st l).[i <- st.[i] `^` x]. +proof. by move=> ->; apply addstate64_rcons. qed. + +lemma to_list_addstate8 st l: + state2w8L (addstate8 st l) + = map2 W8.(`^`) (state2w8L st) (l++nseq (200-size l) W8.zero). +proof. +apply (eq_from_nth W8.zero). + rewrite size_map2 !size_to_list min_lel //. + rewrite size_cat size_nseq; smt(size_ge0). +rewrite size_to_list => i Hi. +rewrite WArray200.get_to_list (nth_map2 W8.zero W8.zero). + rewrite size_to_list size_cat size_nseq; smt(size_ge0). +rewrite addstate8_get8E 1://; congr. + by rewrite get_to_list state_get8E. +case: (i < size l) => E; first by rewrite nth_cat E. +rewrite nth_out 1:/# nth_cat. +by rewrite (:! i < size l) 1:/# /= nth_nseq_dflt. +qed. + +lemma addstate8_rcons st l x: + size l < 200 => + addstate8 st (rcons l x) = state_xor8 (addstate8 st l) (size l) x. +proof. +move=> Hsz. +rewrite -(state200K (addstate8 _ _)); congr; congr. +apply WArray200.to_list_inj. +rewrite to_list_addstate8. +apply (eq_from_nth W8.zero). + by rewrite !size_to_list size_map2 size_cat size_rcons size_nseq /#. +rewrite size_map2 size_to_list size_cat size_rcons size_nseq min_lel 1:/#. +move=> i Hi. +rewrite get_to_list get_set_if (:0 <= size l < 200); first smt(size_ge0). +rewrite (nth_map2 W8.zero W8.zero). + rewrite size_to_list size_cat size_rcons size_nseq /#. +rewrite get_to_list nth_cat /= size_rcons. +case: (i=size l) => E. + rewrite (:i H. + by rewrite (: i < size l+1) 1:/# /= nth_rcons H. +by rewrite (:!i < size l+1) 1:/# /= nth_nseq_dflt nth_out 1:/#. +qed. + +lemma addstate8_rconsE i st l x: + i = size l => + i < 200 => + addstate8 st (rcons l x) = state_xor8 (addstate8 st l) i x. +proof. by move=> ->; apply addstate8_rcons. qed. + + +lemma addstate64_nil st: addstate64 st [] = st. +proof. +by apply Array25.ext_eq => i Hi; rewrite addstate_getE // get_of_list //. +qed. + +lemma addstate8_nil st: addstate8 st [] = st. +proof. by rewrite -w64L2w8L_nil addstate8_w64L addstate64_nil. qed. + + +lemma addstate8_r st l: + state_r (addstate8 st l) = state_r st +^ w8L2block l. +proof. +rewrite /state_r /state2bits /w8L2block mkblock_xor. + rewrite size_take; first smt(rate_bnds). + by rewrite size_w8L2bits WArray200.size_to_list /= (: r < 1600); smt(rate_bnds). + rewrite size_w8L2bits size_cat size_nseq size_take; first smt(rate64_bnds). + case: (rate8 < size l) => E. + by rewrite max_lel; smt(size_ge0 rate64P). + by rewrite max_ler 1:/#; smt(rate64P). +congr; rewrite to_list_addstate8. +have ->: (w8L2bits (take rate8 l ++ nseq (rate8 - size l) W8.zero)) + = take r (w8L2bits (l ++ nseq (rate8 - size l) W8.zero)). + rewrite -rate8P take_w8L2bits take_cat'. + case: (rate8 <= size l) => E. + by rewrite nseq0_le 1:/# cats0. + by rewrite take_oversize 1:/# take_nseq min_ler. +rewrite w8L2bits_xor take_map2; congr. +rewrite -rate8P !take_w8L2bits; congr. +rewrite !take_cat; case: (rate8 < size l) => //= E; congr. +by rewrite !take_nseq; smt(rate8_bnds). +qed. + +lemma addstate_c st l: + size l <= rate8 => + state_c (addstate8 st l) = state_c st. +proof. +move=> Hsz; rewrite /state_c /state2bits /w8L2block; congr. +rewrite -rate8P !drop_w8L2bits; congr. +rewrite to_list_addstate8 !drop_map2 drop_cat. +rewrite (:!rate8 < size l) 1:/#; iota. +rewrite drop_nseq; first smt(rate64_bnds). +rewrite map2_nseq0r //. +by rewrite size_drop; smt(rate64_bnds). +qed. + + + + + + + +(* We treat the sponge permutation as an abstract function. It acts + as a bridge between the idealized permutation used in the security + proof (RO), and the concrete Keccak-F[1600] instantiation adopted + in the implementation. *) +op sponge_permutation : state -> state. + + + + + + + +(* [match_state] relates the bit-level and word-level state representations *) +op match_state x st = x = (state_r st, state_c st). + +lemma match_state_r (x:block*capacity) st: + match_state x st => x.`1 = state_r st +by move=> ->. + +lemma match_state_c (x:block*capacity) st: + match_state x st => x.`2 = state_c st +by move=> ->. + + + + + + + +(* messages, padding, etc. *) +type mess_t = W8.t list. + +(* [aborb_split] reads a the contents of a full block into a list + of bytes (return also the remaining bytes). *) +op absorb_split (m: W8.t list): W8.t list * W8.t list = + (take rate8 m, drop rate8 m). + +lemma size_absorb_split1 m: + rate8 <= size m => size (absorb_split m).`1 = rate8. +proof. move=> Hm; rewrite /absorb_split /= size_take'; smt(rate_bnds). qed. + +lemma size_absorb_split2 m: + rate8 <= size m => size (absorb_split m).`2 = size m - rate8. +proof. move=> Hm; rewrite /absorb_split /= size_drop; smt(rate_bnds). qed. + +lemma absorb_splitP mbits m: + rate8 <= size m => + w8L2block (absorb_split m).`1 = head b0 (pad2blocks (w8L2bits m ++ mbits)). +proof. +move=> Hm. +have Hsz8: size (take rate8 m) = rate8. + rewrite size_take; first smt(rate8_bnds). + case: (size m = rate8) => E. + by rewrite -E ltzz. + by have ->: rate8 < size m by smt(). +rewrite pad2blocksE /=. + by move: Hm; rewrite size_cat size_w8L2bits -rate8P; smt(size_ge0). +rewrite /w8L2block Hsz8 /= cats0; congr. +rewrite take_cat size_w8L2bits. +case: (size m = rate8) => E. + rewrite !E !rate8P ltzz /r /Spnge1600.rate take0 cats0 -Hsz8 take_size. + by rewrite /absorb_split /= -E take_size. +have ->/=: r < 8 * size m. + by apply (StdOrder.IntOrder.ler_lt_trans (8*rate8)); smt(rate8P). +by rewrite -Hsz8 take_size /absorb_split /= -rate8P take_w8L2bits. +qed. + +lemma addfullblockP mbits blk st m: + rate8 <= size m => + blk = state_r st => + state_r (addstate8 st (absorb_split m).`1) + = blk +^ head b0 (pad2blocks (w8L2bits m ++ mbits)). +proof. +move=> Hm Hst; rewrite /absorb_split /= addstate8_r -Hst; congr. +by rewrite -absorb_splitP. +qed. + + +(* [trail_byte] adds the first padding 1-bit to [mbits], which include + both the "domain-separatioen" bits as well as additional suffix bits + (e.g. "01" for SHA-3; "11" for RawSHAKE; "1111" for SHAKE). The last + 1-bit of the padding (the "rate" bit), is only added when adding to + the state. + Remark: the standard FIPS-202 specifies two domain bits, possibly + prefixed by up to two additional suffix bits. Nonetheless, we + only assume a weaker requirenment: that those bits together with + the two mandatory bits of the padding fit in a single byte + (i.e. [size mbits < 6]). *) +op trail_byte (mbits: bool list) : W8.t = W8.bits2w (mbits++[true]). + + + +(* [absorb_final] reads the final block and adds the first padding bit *) +op absorb_final (lbyte: W8.t) (m: W8.t list): W8.t list = + m++[lbyte]. + + +lemma finalblockP mbits m: + size mbits < 6 => + size m < rate8 => + w8L2block (absorb_final (trail_byte mbits) m) +^ block0star1 = + head b0 (pad2blocks (w8L2bits m ++ mbits)). +proof. +move=> Hmbits Hm. +rewrite /pad2blocks /(\o) /pad /bits2blocks /= chunk_r /=. + rewrite !size_cat size_mkpad size_w8L2bits !addzA. + rewrite (size_pad_equiv (8 * size m + size mbits)); first smt(size_ge0). + by rewrite divz_small; first apply bound_abs; smt(size_ge0). +rewrite block0star1P /w8L2block; first rewrite size_cat size_w8L2bits /#. +congr; congr. +rewrite take_oversize /absorb_final /trail_byte; first by rewrite size_cat /#. +have ->: nseq (r - size (w8L2bits m ++ mbits) - 1) false + = (nseq (chunkfillsize 8 (size (mbits ++ [true]))) false + ++ nseq (r - 8*size m - 8) false). + rewrite -!nseq_add; first 2 smt(chunkfillsize_cmp size_ge0). + congr; rewrite !size_cat size_w8L2bits /= chunkfillsizeE' 1:/#; first smt(size_ge0). + ring; rewrite /= modz_small; smt(size_ge0). +rewrite catA w8L2bits_cat; congr; last first. + rewrite w8L2bits_nseq0. + rewrite size_cat /=; smt(size_ge0). + by rewrite mulzDr rate8P size_cat /=; congr; ring. +rewrite w8L2bits_cat -!catA; congr. +rewrite /w8L2bits /flatten /chunkfill chunkfillsizeE' 1:/# size_cat /=; first smt(size_ge0). +rewrite modz_small; first smt(size_ge0). +pose L:= (nth false _ 0 :: _). +apply (eq_from_nth false). + by rewrite !size_cat /= size_nseq max_ler /#. +rewrite (:size L=8) //. +move=> i Hi; have: i \in iota_ 0 8 by smt(). +move=> {Hi} Hi. +rewrite -cat1s !nth_cat /= nth_nseq_if. +move: i Hi; rewrite /L -List.allP /= => {L}. +move: mbits Hmbits => [|x0 [|x1 [|x2 [|x3 [|x4 [|x5 xs]]]]]] //=. +smt(size_ge0). +qed. + +op addfinalbit (st: state): state = + state_xor8 st (rate8-1) (W8.of_int 128). + +op block0star1_st = addfinalbit st0. + +lemma addfinalbitE st: + addfinalbit st = addstate8 st (nseq (rate8-1) W8.zero ++ [W8.of_int 128]). +proof. +have Rbnds := rate8_bnds. +rewrite -(state200K (addstate8 _ _)) /addfinalbit; congr; congr. +apply ext_eq => i Hi; rewrite addstate8_get8E // get_set_if. +rewrite (:0 <= rate8 - 1 < 200) 1:/# nth_cat size_nseq max_ler 1:/# /=. +case: (i=rate8-1) => E; first by rewrite E /= state_get8E /#. +case: (i < rate8-1) => H. + by rewrite nth_nseq 1:/# W8.xorw0 state_get8E. +by rewrite Ring.IntID.subr_eq0 E /= state_get8E. +qed. + +lemma addfinalbitP st: + state_r (addfinalbit st) = state_r st +^ block0star1. +proof. +have Rbnds := rate8_bnds. +rewrite addfinalbitE addstate8_r /block0star1 /w8L2block; congr; congr. +rewrite w8L2bits_cat take_oversize. + by rewrite size_cat size_nseq /#. +rewrite size_cat size_nseq max_ler 1:/# /= cats0. +rewrite w8L2bits_cat w8L2bits_nseq0 1:/#. +rewrite (: r-1 = 8*(rate8-1) + 7) 1:-rate8P 1:/#. +rewrite nseq_add 1,2:/# -catA; congr. +rewrite -(W8.shlMP 1 7) // /w8L2bits /=. +have P: forall i, W8.one.[i] = (i=0). + move=> i; rewrite of_intE /= /int2bs /= /mkseq /= bits2wE /=. + case: (0 <= i < 8) => E. + by rewrite initiE //. + by rewrite W8.get_out // /#. +by rewrite /flatten /= !P /#. +qed. + +op addfinalblock st l = addfinalbit (addstate8 st l). + +lemma addfinalblock_r mbits st m: + size mbits < 6 => + size m < rate8 => + state_r (addfinalblock st (absorb_final (trail_byte mbits) m)) + = state_r st +^ head b0 (pad2blocks (w8L2bits m ++ mbits)). +proof. +move=> Hmbits Hm. +rewrite /addfinalblock addfinalbitP !addstate8_r -Block.xorwA; congr. +by apply finalblockP. +qed. + +lemma addfinalbit_c st: + state_c (addfinalbit st) = state_c st. +proof. +rewrite addfinalbitE addstate_c // size_cat size_nseq /=; smt(rate8_bnds). +qed. + +(* [squeezestate] extracts a [rate64] 64bit words from the state *) +op squeezestate (st: state): W8.t list = + take rate8 (state2w8L st). + +lemma size_squeezestate st: + size (squeezestate st) = rate8. +proof. rewrite /squeezestate size_take'; smt(rate64_bnds). qed. + +op squeezestate64 (st: state) = take rate64 (state2w64L st). + +lemma size_squeezestate64 st: + size (squeezestate64 st) = rate64. +proof. rewrite /squeezestate64 size_take' ?size_to_list; smt(rate64_bnds). qed. + +lemma squeezestateE st: + squeezestate st = w64L2w8L (squeezestate64 st). +proof. +by rewrite /squeezestate /squeezestate64 /rate8 state2w8L2w64L take_w64L2w8L. +qed. + + +lemma size_pad2blocks8 mbits m: + size mbits < 6 => + size (pad2blocks (w8L2bits m ++ mbits)) = size m %/ rate8 + 1. +proof. +rewrite size_pad2blocks size_cat size_w8L2bits -rate8P => ?; congr. +rewrite -addzA. +have := (divmod_mul rate8 8 (size m) (size mbits + 1) _ _); +by smt(size_ge0 rate8_bnds). +qed. + +lemma behead_pad2blocks m: + r <= size m => + behead (pad2blocks m) = pad2blocks (drop r m). +proof. +rewrite /pad2blocks /bits2blocks /pad /(\o) behead_map => ?. +rewrite behead_chunk; congr. +rewrite drop_cat. +case: (r = size m) => E. + rewrite !E drop0 drop_size /= /mkpad. + have ->: size m = 1*r + 0 by smt(). + by rewrite num0_block_suffix. +have ->/=: r < size m by smt(). +rewrite size_drop; first smt(rate_bnds). +rewrite max_ler; first smt(size_ge0). +have {1}->: size m = 1*r + (size m - r) by ring. +by rewrite /mkpad num0_block_suffix. +qed. + +lemma behead_pad2blocks8 mbits m: + rate8 <= size m => + behead (pad2blocks (w8L2bits m ++ mbits)) = + pad2blocks (w8L2bits (absorb_split m).`2 ++ mbits). +proof. +move=> ?; rewrite behead_pad2blocks. + by rewrite size_cat size_w8L2bits -rate8P; smt(size_ge0). +rewrite /absorb_split /= drop_cat size_w8L2bits -rate8P. +rewrite StdOrder.IntOrder.ltr_pmul2l //. +case: (rate8 = size m) => E. + by rewrite E /= drop0 drop_size w8L2bits_nil. +have ->/=: rate8 < size m by smt(). +by rewrite -drop_w8L2bits mulzC. +qed. + +lemma size_pad2blocks8_ge x m mbits: + size mbits < 6 => + x <= size (pad2blocks (w8L2bits m ++ mbits)) <=> x*rate8 - rate8 <= size m. +proof. +move=> Hmbits; rewrite size_pad2blocks8 //. +rewrite (: x <= size m %/ rate8 + 1 = x-1 <= size m %/ rate8) 1:/#. +by rewrite lez_divRL; smt(rate8_bnds). +qed. + +lemma needed_blocks8P n x: + x < (8*n + r - 1) %/ r <=> 0 < n - x*rate8. +proof. +rewrite ltzE lez_divRL; first smt(rate_bnds). +rewrite mulzDl /= !(addzC _ r) -addzA lez_add2l. +rewrite -rate8P (mulzC 8) -mulzA mulzC -(lez_add2l 1) !(addzC 1) /= -ltzE. +by rewrite StdOrder.IntOrder.ltr_pmul2l /#. +qed. + + + +(**************************************************************************** + Byte-oriented statefull specification of the sponge construction +****************************************************************************) +module Spec = { + proc f(trail_byte: W8.t, m: W8.t list, outlen: int) : W8.t list = { + var result,l,st; + result <- []; + st <- st0; + (* ABSORB *) + while (rate8 <= size m){ + (l, m) <- absorb_split m; + st <- addstate8 st l; + st <- sponge_permutation st; + } + st <- addfinalblock st (absorb_final trail_byte m); + (* SQUEEZE *) + while (rate8 < outlen){ + st <- sponge_permutation st; + l <- squeezestate st; + result <- result ++ l; + outlen = outlen - rate8; + } + st <- sponge_permutation st; + l <- squeezestate st; + result <- result ++ take outlen l; + return result; + } +}. + + +(**************************************************************************** + Equivalence between the bit-level and byte-level specs. +****************************************************************************) +section. + +declare module IdealizedPerm: DPRIMITIVE. +axiom perm_correct st: + phoare [ IdealizedPerm.f: + match_state x st + ==> + match_state res (sponge_permutation st) ] = 1%r. + +lemma spec_correct mbits: +equiv [ Sponge(IdealizedPerm).f ~ Spec.f : + bs{1} = w8L2bits m{2} ++ mbits /\ + n{1} = 8*outlen{2} /\ + trail_byte{2} = trail_byte mbits /\ size mbits < 6 + ==> res{1} = w8L2bits res{2}]. +proof. +have Rbnds:= rate8_bnds. +proc; simplify; exists* outlen{2}; elim* => outlen2. +swap {1} 1 1; swap {1} [2..3] 2. +swap {2} 1 3. +splitwhile {1} 3: (1 < size xs). +(* ABSORB intermediate blocks *) +seq 3 2: (#[/1,3:]pre /\ match_state (sa,sc){1} st{2} /\ + xs{1} = (pad2blocks (w8L2bits m ++ mbits)){2} /\ + size xs{1} = 1). + sp; while (#[/5,7:]pre /\ match_state (sa,sc){1} st{2} /\ + xs{1} = pad2blocks (w8L2bits m{2} ++ mbits) /\ + outlen2 = outlen{2} /\ 1<=size xs{1}). + wp 1 2; ecall {1} (perm_correct st{2}); wp; skip; progress. + + by rewrite (match_state_r _ _ H0) eq_sym; apply addfullblockP. + + by move: H0; rewrite addstate_c /match_state //= size_absorb_split1. + + by rewrite H6. + + by rewrite H6. + + by rewrite behead_pad2blocks8. + + by rewrite size_behead size_pad2blocks8 // max_ler /= lez_divRL /#. + + rewrite size_absorb_split2 //. + have: 3 <= size (pad2blocks (w8L2bits m{2} ++ mbits)). + move: H8; rewrite size_behead max_ler. + by rewrite size_pad2blocks8 //= lez_divRL /#. + smt(). + by rewrite size_pad2blocks8_ge /#. + + have : 2 <= size (pad2blocks (w8L2bits m{2} ++ mbits)). + by rewrite size_pad2blocks8_ge // /#. + by pose L:= pad2blocks _; move: L => [|x1 [|x2 xs]]. + + have : 2 < size (pad2blocks (w8L2bits m{2} ++ mbits)). + rewrite size_pad2blocks8 //. + apply (StdOrder.IntOrder.ltr_le_trans (2+1)) => //. + apply lez_add2r; rewrite lez_divRL /= 1:/#. + move: H7; rewrite /absorb_split /= size_drop 1:/#. + by rewrite max_ler /#. + by pose L:= pad2blocks _; move: L => [|x1 [|x2 [|x3 xs]]] => //= /#. + skip => |> *; progress. + + by rewrite st0_r. + + by rewrite st0_c. + + rewrite size_pad2blocks8 //; smt(size_ge0 divz_ge0 rate8_bnds). + + by move: H1; rewrite ltzE /= size_pad2blocks8_ge /#. + + have: 2 <= size (pad2blocks (w8L2bits m{2} ++ mbits)). + by rewrite size_pad2blocks8_ge /#. + smt(). + + by rewrite ltzE /= size_pad2blocks8_ge /#. + + rewrite size_pad2blocks8 // divz_small //. + by apply bound_abs; smt(size_ge0). +(* ABSORB final block *) +unroll {1} 1; rcondt {1} 1. + move=> *; skip => |> *. + move: H1; case: (xs{hr}=[]); smt(). +rcondf {1} 3. + move=> *; wp; call (_:true); skip => |> ???. + move: (pad2blocks _) => [|??] //= ?. + by rewrite -size_eq0 /#. +(* SQUEEZE *) +case: (0 < outlen2); last first. + (* corner case: no output *) + rcondf {2} 3; first by move=> *; wp; skip => |> *; smt(rate8_bnds). + rcondf {1} 5. + move=> *; wp; call (_:true); skip => |> *. + case: (8 * outlen{m} + r - 1 < 0) => ?. + rewrite -lezNgt; apply ltzW. + rewrite ltzNge divz_ge0; first smt(rate_bnds). + smt(). + rewrite divz_small //. + by apply bound_abs; smt(rate_bnds). + wp 1 2; ecall {1} (perm_correct st{2}); wp; skip; progress. + + rewrite (match_state_r _ _ H0) addfinalblock_r //. + by move: H1; rewrite size_pad2blocks8 // /#. + + rewrite /addfinalblock addfinalbitE addstate_c. + by rewrite size_cat size_nseq /= /#. + rewrite addstate_c /absorb_final. + by move: H1; rewrite size_pad2blocks8 // size_cat /#. + by rewrite (match_state_c _ _ H0). + + by rewrite take_le0 /#. +splitwhile {1} 5: (i+1 < (n + r - 1) %/ r). +seq 5 3: (#[/3:5]pre /\ n{1} = 8*outlen2 /\ + outlen{2} = outlen2 - rate8*i{1} /\ + match_state (sa,sc){1} (sponge_permutation st{2}) /\ + z{1} = w8L2bits result{2} /\ + size result{2} = rate8 * i{1} /\ + i{1}+1 = (n{1} + r - 1) %/ r). + (* SQUEEZE intermediate blocks *) + while (#[:-1]post /\ i{1}+1 <= (n{1} + r - 1) %/ r). + rcondt {1} 3. + by move=> ?; wp; skip; progress. + ecall {1} (perm_correct st{2}); wp; skip; progress. + + smt(). + + by rewrite H7. + + by rewrite H7. + + rewrite w8L2bits_cat (match_state_r _ _ H6) /state_r ofblockK. + by rewrite size_take 1:/# size_state2bits /#. + by congr; rewrite -rate8P /squeezestate /state2bits -take_w8L2bits; congr. + + by rewrite size_cat size_squeezestate /#. + + smt(). + + by move: H9; rewrite needed_blocks8P /#. + + by rewrite needed_blocks8P /#. + wp 1 1; ecall {1} (perm_correct st{2}); wp; skip; auto => |> *; progress. + + rewrite (match_state_r _ _ H0) addfinalblock_r //. + by move: H1; rewrite size_pad2blocks8 // /#. + + rewrite /addfinalblock addfinalbitE addstate_c. + by rewrite size_cat size_nseq /= /#. + rewrite addstate_c /absorb_final. + by move: H1; rewrite size_pad2blocks8 // size_cat /#. + by rewrite (match_state_c _ _ H0). + + by rewrite H4. + + by rewrite H4. + + have ->: 1 = 0+1 by done. + by rewrite -ltzE needed_blocks8P /=. + + by move: H5; rewrite needed_blocks8P /#. + + by rewrite needed_blocks8P /#. + + by rewrite needed_blocks8P /#. + + smt(). +(* SQUEEZE final block *) +rcondt {1} 1; first by move=> ?; wp; skip; progress; smt(). +rcondf {1} 3; first by move=> ?; wp; skip; progress; smt(). +rcondf {1} 3; first by move=> ?; wp; skip; progress; smt(). +wp; skip; progress. +rewrite w8L2bits_cat take_cat'. +rewrite (:!8 * outlen2 <= size (w8L2bits result{2})) /=. + by rewrite size_w8L2bits H1 -mulzA rate8P /#. +congr; rewrite (match_state_r _ _ H0) /squeezestate ofblockK. + by rewrite size_take 1:/# size_state2bits /#. +rewrite take_take min_lel /state2bits. + by rewrite size_w8L2bits H1 -mulzA rate8P /#. +rewrite size_w8L2bits. +have ->: 8 * outlen2 - 8 * size result{2} = 8*(outlen2 -size result{2}) by ring. +rewrite take_w8L2bits; congr. +rewrite take_take min_lel. + by rewrite (: i{1}=i{1}+1-1) 1:/# mulzDr H2 -rate8P /#. +congr; smt(). +qed. + + +end section. + + diff --git a/sha3/proof/impl/Sponge1600.ec b/sha3/proof/impl/Sponge1600.ec new file mode 100644 index 0000000..99bd7d3 --- /dev/null +++ b/sha3/proof/impl/Sponge1600.ec @@ -0,0 +1,68 @@ +(*------------------------- Sponge Construction ------------------------*) + +(* Specialization of the Sponge Construction for a 1600bit state *) + + +require import Core Int IntDiv Real List FSet SmtMap. +(*---*) import IntExtra. +require import Distr DBool DList. +require import StdBigop StdOrder. import IntOrder. + + +op rate :int. +axiom rate_bnds: 0 < rate < 1600. +axiom rate_w64: 64 %| rate. + +lemma rate_ge2: 2 <= rate. +proof. +case: (rate = 1) => E. + by rewrite E; smt(rate_w64). +by smt (rate_bnds). +qed. + +require Common. +clone export Common as Common1600 + with op r = rate, + op c = 1600-r + proof ge2_r by apply rate_ge2 + proof gt0_c by smt (rate_bnds). + +require Indifferentiability. +clone include Indifferentiability with + type p <- block * capacity, + type f_in <- bool list * int, + type f_out <- bool list + + rename + [module] "Indif" as "Experiment" + [module] "GReal" as "RealIndif" + [module] "GIdeal" as "IdealIndif". + +(*------------------------- Sponge Construction ------------------------*) +module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { + proc init() : unit = {} + + proc f(bs : bool list, n : int) : bool list = { + var z <- []; + var (sa, sc) <- (b0, Capacity.c0); + var i <- 0; + var xs <- pad2blocks bs; + + (* absorption *) + while (xs <> []) { + (sa, sc) <@ P.f(sa +^ head b0 xs, sc); + xs <- behead xs; + } + (* squeezing *) + while (i < (n + r - 1) %/ r) { + z <- z ++ ofblock sa; + i <- i + 1; + if (i < (n + r - 1) %/ r) { + (sa, sc) <@ P.f(sa, sc); + } + } + + return take n z; + } +}. + diff --git a/sha3/proof/impl/WArray192.ec b/sha3/proof/impl/WArray192.ec new file mode 100644 index 0000000..c8564c5 --- /dev/null +++ b/sha3/proof/impl/WArray192.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray192 with op size <- 192. diff --git a/sha3/proof/impl/WArray200.ec b/sha3/proof/impl/WArray200.ec new file mode 100644 index 0000000..99b887c --- /dev/null +++ b/sha3/proof/impl/WArray200.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray200 with op size <- 200. diff --git a/sha3/proof/impl/WArray40.ec b/sha3/proof/impl/WArray40.ec new file mode 100644 index 0000000..003b6e2 --- /dev/null +++ b/sha3/proof/impl/WArray40.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray40 with op size <- 40. diff --git a/sha3/proof/impl/keccak_1600_corr.ec b/sha3/proof/impl/keccak_1600_corr.ec new file mode 100644 index 0000000..af2f020 --- /dev/null +++ b/sha3/proof/impl/keccak_1600_corr.ec @@ -0,0 +1,483 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array25 WArray200 EclibExtra JWordList. + +require import Spec1600 Keccak_1600_ref. + + + +(* Bounded memory assumption (established by the safety analysis) *) +abbrev good_ptr (ptr: W64.t) len = + to_uint ptr + len < W64.modulus. +op inv_ptr (in_0 inlen out outlen: W64.t) = + good_ptr in_0 (to_uint inlen) /\ good_ptr out (to_uint outlen). + + + +(* lemmata... *) +lemma to_uintS_lt (x y:W64.t) : + to_uint x < to_uint y => + to_uint (x + W64.one) = to_uint x + 1. +proof. +move=> H; rewrite to_uintD_small of_uintK modz_small //. +move: (W64.to_uint_cmp y); smt(). +qed. + +(* ...for readability *) +abbrev upd8 (f: W8.t -> W8.t -> W8.t) (st:state) (i:int) (x:W8.t) = + state25 (set8 (state200 st) i (f (get8 (state200 st) i) x)). + +lemma upd8_state_xor8 i st l x: + i = size l => + 0 <= i < 200 => +(* state25 (set8 (state200 (addstate8 st l)) i + (get8 (state200 (addstate8 st l)) i `^` x)) *) + upd8 W8.(`^`) (addstate8 st l) i x + = state_xor8 (addstate8 st l) i x. +proof. by move=> Hsz Hi; rewrite /get8 addstate8_get8E_out // /#. qed. + +(* SPECIFICATION OF LEAF-FUNCTIONS *) + +lemma st0_spec_h: + hoare [ M.st0 : true ==> res = st0 ] . +proof. +proc; sp. +while (0 <= i <= 25 /\ forall k, 0 <= k < i => state.[k]=W64.zero). + wp; skip; progress; first 2 smt(). + case: (k < i{hr}) => E. + by rewrite set_neqiE 1,2:/# H1 /#. + by rewrite set_eqiE /#. +skip; progress; first smt(). +move: H2; have ->: i0 = 25 by smt(). +by move=> H2; apply Array25.ext_eq => ??; rewrite (H2 x) // /st0 createiE. +qed. + +lemma st0_spec_ll: islossless M.st0. +proof. +islossless; while true (25 - i). + by move=> ?; wp; skip => ? [??] /#. +by skip => ??? /#. +qed. + +lemma st0_spec: + phoare [ M.st0 : true ==> res = st0 ] = 1%r. +proof. by conseq st0_spec_ll st0_spec_h. qed. + + +lemma add_full_block_spec_h st in_ inlen_ r8_: + hoare [ M.add_full_block: + state = st + /\ in_0 = in_ + /\ inlen = inlen_ + /\ r8 = r8_ + /\ good_ptr in_0 rate8 + /\ to_uint r8 = rate8 + ==> + res.`1 = addstate64 st (memread64 Glob.mem (to_uint in_) rate64) + /\ res.`2 = in_ + r8_ + /\ res.`3 = inlen_ - r8_ + ]. +proof. +have Rbnds:= rate64_bnds. +have Wbnds:= W64.to_uint_cmp. +proc; simplify; wp; sp. +while (#[4:]pre /\ to_uint r64 = rate64 /\ to_uint i <= rate64 /\ + state = addstate8 st + (absorb_split (memread Glob.mem (to_uint in_) (8*to_uint i))).`1). + wp; skip; rewrite ultE; progress. + + by rewrite to_uintD_small of_uintK modz_small /#. + + rewrite (to_uintS_lt _ _ H3). + rewrite /absorb_split /= !take_memread 1,2:/# !min_ler 1,2:/#. + rewrite -!addstate64_w8L -!memread64E memread64S 1:/#. + rewrite (addstate64_rconsE (to_uint i{hr})) ?size_memread64 1..3:/#. + rewrite addstate64_getE_out ?size_memread64 // 1:/#. + rewrite to_uintD_small to_uintM of_uintK !modz_small //; smt(). +skip; progress. ++ by rewrite to_uint_shr /#. ++ smt(). ++ by rewrite /absorb_split /= addstate8_nil. ++ have ->: to_uint i0 = rate64. + by move: H1; rewrite -W64.uleNgt uleE to_uint_shr of_uintK //= /#. + move: H5; rewrite /absorb_split /= take_oversize. + by rewrite size_mkseq; smt(). + by move=>?; rewrite memread64E -addstate64_w8L. +qed. + +lemma add_full_block_spec_ll: islossless M.add_full_block. +proof. +proc; wp; sp; while true (to_uint r64-to_uint i). + move=> ?; wp; skip; progress. + move: H; rewrite ultE => ?. + rewrite to_uintD_small of_uintK modz_small //. + by move: (W64.to_uint_cmp r64{hr}) => /#. + smt(). +skip; progress. +by rewrite ultE /#. +qed. + +lemma add_full_block_spec st in_ inlen_ r8_: + phoare [ M.add_full_block: + state = st + /\ in_0 = in_ + /\ inlen = inlen_ + /\ r8 = r8_ + /\ good_ptr in_0 rate8 + /\ to_uint r8 = rate8 + ==> + res.`1 = addstate64 st (memread64 Glob.mem (to_uint in_) rate64) + /\ res.`2 = (in_ + r8_)%W64 + /\ res.`3 = inlen_ - r8_ + ] = 1%r. +proof. +by conseq add_full_block_spec_ll (add_full_block_spec_h st in_ inlen_ r8_). +qed. + + +lemma add_final_block_spec_h st (in_ inlen_: W64.t) trail_byte_: + hoare [ M.add_final_block: + state = st + /\ in_0 = in_ + /\ inlen = inlen_ + /\ trail_byte = trail_byte_ + /\ to_uint r8 = rate8 + /\ to_uint inlen_ < rate8 + /\ good_ptr in_0 (to_uint inlen_) + ==> + res = addfinalbit + (addstate8 st + (absorb_final (W8.of_int (to_uint trail_byte_)) + (memread Glob.mem (to_uint in_) (to_uint inlen_)))) + ]. +proof. +have Rbnds:= rate64_bnds. +have Wbnds:= W64.to_uint_cmp. +proc; simplify. +seq 4: (to_uint i = to_uint inlen_ %/ 8 /\ + state = addstate64 st + (memread64 Glob.mem (to_uint in_) (to_uint inlen_ %/ 8)) /\ + #[2:]pre /\ to_uint inlen8 = to_uint inlen_ %/ 8 ). + while (#[/3:]post /\ to_uint i <= to_uint inlen8 /\ + state = addstate64 st (memread64 Glob.mem (to_uint in_) (to_uint i))). + wp; skip; rewrite !ultE; progress. + by rewrite (to_uintS_lt _ _ H4) /#. + rewrite (to_uintS_lt _ _ H4) memread64S 1:/# addstate64_rcons size_memread64 1..3:/#. + rewrite addstate64_getE_out ?size_memread64 // 1:/#. + by rewrite to_uintD_small to_uintM of_uintK !modz_small // /#. + wp; skip; progress. + + by rewrite to_uint_shr /#. + + by rewrite to_uint_shr 1:/# /= divz_ge0 //= /#. + + by rewrite addstate64_nil. + + move: H7; rewrite to_uint_shr 1:/# /= => ?. + by move: H2; rewrite ultE to_uint_shr /#. + + move: H7; rewrite to_uint_shr 1:/# /= => ?. + move: H2; rewrite ultE to_uint_shr 1:/# /= => ?. + by rewrite (: to_uint i0 = to_uint inlen{hr} %/ 8) /#. +exists* (addstate64 st + (memread64 Glob.mem (to_uint in_) (to_uint inlen_ %/ 8))); elim* => st'. +seq 2: (#[/1,4:-1]pre /\ + to_uint i = to_uint inlen_ /\ + state = addstate8 st + (memread Glob.mem (to_uint in_) (to_uint inlen_))). + while (#[/:-2]post /\ to_uint inlen_ %/ 8 * 8 <= to_uint i <= to_uint inlen_ /\ + to_uint inlen_ %/ 8 = to_uint i %/ 8 /\ + state = addstate8 st (memread Glob.mem (to_uint in_) (to_uint i))). + wp; skip; rewrite ultE => ?[[[?]]]; progress. + + by rewrite (to_uintS_lt _ _ H6) /#. + + by rewrite (to_uintS_lt _ _ H6) /#. + + by rewrite (to_uintS_lt _ _ H6) /#. + + rewrite (to_uintS_lt _ _ H6). + rewrite memreadS 1:/# addstate8_rcons size_memread 1..3:/#. + rewrite upd8_state_xor8 ?size_memread 1..3:/#. + by rewrite to_uintD_small /#. + wp; skip => ?[?]; progress. + + by rewrite to_uint_shl of_uintK (modz_small 3) //= modz_small /#. + + by rewrite to_uint_shl //= /#. + + by rewrite to_uint_shl //= /#. + + congr; rewrite memread64E to_uint_shl of_uintK modz_small //= 1:/#. + by rewrite -H0 (mulzC 8) w8L2w64L2state. + + by move: H5; rewrite -W64.uleNgt uleE /#. + + by move: H5; rewrite -W64.uleNgt uleE /#. +exists* (addstate8 st (memread Glob.mem (to_uint in_) (to_uint inlen_))). +elim*=> st''. +seq 1: (#[/:-1]pre /\ + state = state_xor8 st'' (to_uint inlen_) trail_byte_). + wp; skip => ?[?[[?]]]; progress. + rewrite upd8_state_xor8 ?size_memread 1..3:/#. + by rewrite H H4. +wp; skip => ?[[?[?]]] |> *. +rewrite /addfinalbit /absorb_final H /state_xor_u8 /state_xor8. +have ->: (to_uint (r8{hr} - W64.one)) = rate8-1. + by rewrite to_uintB ?uleE /#. +by rewrite cats1 -(addstate8_rconsE) 1:size_memread /#. +qed. + +lemma add_final_block_spec_ll: islossless M.add_final_block. +proof. +islossless. + while true (to_uint inlen - to_uint i). + move=> ?; wp; skip; progress. + move: H; rewrite ultE ltzE=> ?; rewrite to_uintD_small of_uintK modz_small //. + by move: (W64.to_uint_cmp inlen{hr}); smt(). + smt(). + by skip; progress; rewrite ultE /#. +while true (to_uint inlen8 - to_uint i). + move=> ?; wp; skip; progress; rewrite to_uintD_small. + by move: H (W64.to_uint_cmp inlen8{hr}); rewrite ultE ltzE; smt(). + by move: H; rewrite ultE /#. +by skip; progress; rewrite ultE /#. +qed. + +lemma add_final_block_spec st (in_ inlen_: W64.t) trail_byte_: + phoare [ M.add_final_block: + state = st + /\ in_0 = in_ + /\ inlen = inlen_ + /\ trail_byte = trail_byte_ + /\ to_uint r8 = rate8 + /\ to_uint inlen_ < rate8 + /\ good_ptr in_0 (to_uint inlen_) + ==> + res = addfinalbit + (addstate8 st + (absorb_final (W8.of_int (to_uint trail_byte_)) + (memread Glob.mem (to_uint in_) (to_uint inlen_)))) + ] = 1%r. +proof. +by conseq add_final_block_spec_ll (add_final_block_spec_h st in_ inlen_ trail_byte_). +qed. + + +lemma xtr_full_block_spec_h mem st out_ outlen_: + hoare [ M.xtr_full_block: + Glob.mem = mem + /\ state = st + /\ out = out_ + /\ outlen = outlen_ + /\ rate8 <= to_uint outlen + /\ to_uint rate = rate8 + /\ good_ptr out_ rate8 + ==> + Glob.mem = stores64 mem (to_uint out_) (squeezestate64 st) + /\ to_uint res.`1 = to_uint out_ + rate8 + /\ to_uint res.`2 = to_uint outlen_ - rate8 + ]. +proof. +have Rbnds:= rate64_bnds. +have Wbnds:= W64.to_uint_cmp. +proc; simplify. +wp; while (state = st /\ out = out_ /\ outlen = outlen_ /\ + good_ptr out_ rate8 /\ to_uint r64 = rate64 /\ + 0 <= to_uint i <= to_uint r64 /\ + Glob.mem = stores64 mem (to_uint out_) (take (to_uint i) + (squeezestate64 st))). + wp; skip; rewrite ultE => |> *. + rewrite (to_uintS_lt _ _ H3); progress; first 2 smt(). + rewrite (take_nth W64.zero); first by rewrite size_squeezestate64 /#. + rewrite stores64_rcons; congr. + rewrite to_uintD_small to_uintM_small of_uintK modz_small // 1..3:/#. + by rewrite size_take 1:/# size_squeezestate64 /#. + rewrite /squeezestate64 nth_take 1,2:/# -get_to_list. + by apply nth_inside; rewrite size_to_list /#. +wp; skip => |> *; progress. ++ by rewrite to_uint_shr of_uintK modz_small // /#. ++ by rewrite to_uint_shr of_uintK modz_small // /#. ++ by rewrite take0. ++ have ->: to_uint i0 = rate64. + by move: H2; rewrite -W64.uleNgt uleE to_uint_shr /#. + by rewrite take_take min_ler //. ++ by rewrite to_uintD_small H0. ++ by rewrite to_uintB ?uleE /#. +qed. + +lemma xtr_full_block_spec_ll: islossless M.xtr_full_block. +proof. +islossless. +while true (to_uint r64 - to_uint i). + move=> ?; wp; skip; progress. + move: H; rewrite ultE => ?. + rewrite to_uintD_small of_uintK modz_small // 2:/#. + by have /# := W64.to_uint_cmp r64{hr}. +by skip; progress; rewrite ultE /#. +qed. + +lemma xtr_full_block_spec mem st out_ outlen_: + phoare [ M.xtr_full_block: + Glob.mem = mem + /\ state = st + /\ out = out_ + /\ outlen = outlen_ + /\ rate8 <= to_uint outlen + /\ to_uint rate = rate8 + /\ good_ptr out_ rate8 + ==> + Glob.mem = stores64 mem (to_uint out_) (squeezestate64 st) + /\ to_uint res.`1 = to_uint out_ + rate8 + /\ to_uint res.`2 = to_uint outlen_ - rate8 + ] = 1%r. +proof. +by conseq xtr_full_block_spec_ll (xtr_full_block_spec_h mem st out_ outlen_). +qed. + + +lemma xtr_bytes_spec_h mem st out_ outlen_: + hoare [ M.xtr_bytes: + Glob.mem = mem + /\ state = st + /\ out = out_ + /\ outlen = outlen_ + /\ to_uint outlen_ <= rate8 + /\ good_ptr out_ (to_uint outlen_) + ==> + Glob.mem = stores8 mem (to_uint out_) (take (to_uint outlen_) + (squeezestate st)) ]. +proof. +have Rbnds:= rate64_bnds. +have Wbnds:= W64.to_uint_cmp. +proc; simplify. +while (#[2,-2:]pre /\ outlen_ = outlen /\ out_ = out /\ + to_uint outlen_ %/ 8 * 8 <= to_uint i <= to_uint outlen_ /\ + Glob.mem = stores8 mem (to_uint out_) (take (to_uint i) + (squeezestate st))). + wp; skip; rewrite !ultE => |> *. + rewrite (to_uintS_lt _ _ H3); progress; first 2 smt(). + rewrite (take_nth W8.zero) ?size_squeezestate 1:/#. + rewrite stores8_rcons; congr. + by rewrite to_uintD_small 1:/# size_take ?size_squeezestate /#. + by rewrite state_get8P nth_take /#. +wp; while (#[2:]pre /\ 0 <= to_uint i <= to_uint outlen_ %/ 8 /\ out = out_ /\ + to_uint outlen8 = to_uint outlen %/ 8 /\ + Glob.mem = stores64 mem (to_uint out_) (take (to_uint i) + (squeezestate64 st))). + wp; skip; rewrite !ultE => |> *. + rewrite (to_uintS_lt _ _ H4). + have ->: to_uint (out{hr} + W64.of_int 8 * i{hr}) + = to_uint out{hr} + 8 * to_uint i{hr}. + by rewrite to_uintD_small to_uintM_small of_uintK modz_small //= /#. + progress; first 2 smt(). + + rewrite (take_nth W64.zero) ?size_squeezestate64 1:/#. + rewrite stores64_rcons; congr. + by rewrite size_take ?size_squeezestate64 /#. + rewrite nth_take 1,2:/# -Array25.get_to_list. + by apply nth_inside; rewrite Array25.size_to_list /#. +wp; skip => |> *; progress. ++ smt(). ++ by rewrite to_uint_shr of_uintK modz_small //. ++ by rewrite take0. ++ move: H1; rewrite ultE to_uint_shr of_uintK modz_small //= => ?. + by rewrite to_uint_shl of_uintK modz_small //= /#. ++ by rewrite to_uint_shl of_uintK modz_small //= /#. ++ rewrite to_uint_shl of_uintK modz_small //= 1:/#. + rewrite stores64_stores8; congr. + have ->: to_uint i0 = to_uint outlen{hr} %/ 8. + by move: H1; rewrite ultE to_uint_shr of_uintK //= /#. + by rewrite squeezestateE (mulzC _ 8) take_w64L2w8L. ++ by move: H5; rewrite ultE //= /#. +qed. + +lemma xtr_bytes_spec_ll: islossless M.xtr_bytes. +proof. +islossless. + while true (to_uint outlen - to_uint i). + move=> ?; wp; skip => ?; rewrite ultE; progress. + rewrite to_uintD_small 2:/#. + move: (W64.to_uint_cmp outlen{hr}); smt(). + by skip; progress; rewrite ultE /#. +while true (to_uint outlen8 - to_uint i). + move=> ?; wp; skip => ?; rewrite ultE; progress. + rewrite to_uintD_small 2:/#. + move: (W64.to_uint_cmp outlen8{hr}); smt(). +by skip; progress; rewrite ultE /#. +qed. + +lemma xtr_bytes_spec mem st out_ outlen_: + phoare [ M.xtr_bytes: + Glob.mem = mem + /\ state = st + /\ out = out_ + /\ outlen = outlen_ + /\ to_uint outlen_ <= rate8 + /\ good_ptr out_ (to_uint outlen_) + ==> + Glob.mem = stores8 mem (to_uint out_) (take (to_uint outlen_) + (squeezestate st)) + ] = 1%r. +proof. by conseq xtr_bytes_spec_ll (xtr_bytes_spec_h mem st out_ outlen_). qed. + + +(* MAIN RESULT *) + +section. + +axiom permutation_instantiation mem st: + phoare [ M.__keccak_f1600_ref: + state = st /\ Glob.mem = mem + ==> + Glob.mem = mem /\ res = sponge_permutation st ] = 1%r. + +lemma spec_correct mem out_: +equiv [ Spec.f ~ M.__keccak_1600 : + Glob.mem{2} = mem /\ inv_ptr in_0{2} inlen{2} s_out{2} s_outlen{2} /\ + m{1} = (memread mem (to_uint in_0) (to_uint inlen)){2} /\ + s_out{2} = out_ /\ + outlen{1} = W64.to_uint s_outlen{2} /\ + to_uint s_trail_byte{2} < 64 (* at most 6 bits... *) /\ + to_uint trail_byte{1} = to_uint s_trail_byte{2} /\ + to_uint rate{2} = rate8 + ==> + Glob.mem{2} = stores8 mem (W64.to_uint out_) res{1} + ]. +proof. +have Rbnds:= rate64_bnds. +have Wbnds:= W64.to_uint_cmp. +proc; simplify; wp. +ecall {2} (xtr_bytes_spec Glob.mem{2} state{2} out{2} outlen{2}); simplify. +wp; ecall {2} (permutation_instantiation Glob.mem{2} state{2}); simplify. +wp; while (st{1}=state{2} /\ to_uint rate{2}=rate8 /\ + to_uint s_out{2} = to_uint out_ + size result{1} /\ + to_uint outlen{2} = to_uint s_outlen{2} /\ + outlen{1} = to_uint s_outlen{2} /\ good_ptr s_out{2} (to_uint s_outlen{2}) /\ + Glob.mem{2} = stores8 mem (to_uint out_) result{1}). + wp; ecall {2} (xtr_full_block_spec Glob.mem{2} state{2} out{2} outlen{2}); simplify. + wp; ecall {2} (permutation_instantiation Glob.mem{2} state{2}); simplify. + wp; skip; rewrite !ultE; progress; first 2 smt(). + + by rewrite size_cat H8 H0 size_squeezestate /#. + + smt(). + + smt(). + + by rewrite H0 stores8_cat stores64_stores8 -squeezestateE. + + by rewrite !ultE /#. + + by move: H10; rewrite ultE /#. +wp; ecall {2} (add_final_block_spec state{2} in_0{2} inlen{2} trail_byte{2}); simplify. +wp; while (st{1}=state{2} /\ to_uint rate{2} = rate8 /\ + m{1} = memread Glob.mem{2} (to_uint in_0{2}) (to_uint inlen{2}) /\ + good_ptr in_0{2} (to_uint inlen{2}) /\ + s_out{2} = out_ /\ outlen{1}=to_uint s_outlen{2} ). + wp; ecall {2} (permutation_instantiation Glob.mem{2} state{2}); simplify. + wp; ecall {2} (add_full_block_spec state{2} in_0{2} inlen{2} rate{2}); simplify. + wp; skip; rewrite uleE; progress; first smt(). + + rewrite H5; congr; congr. + rewrite /absorb_split /= memread64E -w8L2w64L2state; congr. + by rewrite take_memread 1:/# min_lel /#. + + rewrite /absorb_split /= drop_memread 1:/# H6 to_uintD_small ?H 1:/#. + by rewrite H7 to_uintB ?uleE 1:/# H4. + + by rewrite H6 H7 to_uintD_small 1:/# to_uintB ?uleE /#. + + rewrite uleE H7 to_uintB ?uleE 1:/#. + by move: H8; rewrite size_absorb_split2 size_mkseq /#. + + move: H8; rewrite H7 uleE to_uintB ?uleE 1:/# => *. + by rewrite size_absorb_split2 1:/# size_memread /#. +wp; call {2} st0_spec; wp; skip; rewrite /inv_ptr => |> *; progress. ++ move: H4; rewrite size_mkseq uleE /max. + by case: (0 < to_uint inlen{2}); smt(). ++ move: H4; rewrite uleE H3 => ?. + by rewrite size_memread /#. ++ by move: H5; rewrite uleE /#. ++ rewrite /addfinalblock; congr; congr; congr; congr. + by apply W8.word_modeqP; rewrite to_uint_truncateu8 modz_mod H2. ++ by rewrite ultE H6. ++ by move: H9; rewrite ultE H6. ++ by move: H10; rewrite ultE H11 /#. ++ by rewrite H12 -stores8_cat. +qed. + +end section. + diff --git a/sha3/proof/impl/keccak_1600_ref.ec b/sha3/proof/impl/keccak_1600_ref.ec new file mode 100644 index 0000000..d7392c6 --- /dev/null +++ b/sha3/proof/impl/keccak_1600_ref.ec @@ -0,0 +1,443 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array5 Array24 Array25. +require import WArray40 WArray192 WArray200. + + + +module M = { + proc index (x:int, y:int) : int = { + + var r:int; + + r <- ((x %% 5) + (5 * (y %% 5))); + return (r); + } + + proc theta (a:W64.t Array25.t) : W64.t Array25.t = { + var aux_1: bool; + var aux_0: bool; + var aux: int; + var aux_2: W64.t; + + var x:int; + var c:W64.t Array5.t; + var y:int; + var d:W64.t Array5.t; + var _0:bool; + var _1:bool; + c <- witness; + d <- witness; + x <- 0; + while (x < 5) { + c.[x] <- (W64.of_int 0); + y <- 0; + while (y < 5) { + c.[x] <- (c.[x] `^` a.[(x + (5 * y))]); + y <- y + 1; + } + x <- x + 1; + } + x <- 0; + while (x < 5) { + d.[x] <- c.[((x + 1) %% 5)]; + (aux_1, aux_0, aux_2) <- x86_ROL_64 d.[x] (W8.of_int 1); + _0 <- aux_1; + _1 <- aux_0; + d.[x] <- aux_2; + d.[x] <- (d.[x] `^` c.[((x + 4) %% 5)]); + x <- x + 1; + } + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + a.[(x + (5 * y))] <- (a.[(x + (5 * y))] `^` d.[x]); + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc keccakRhoOffsets (i:int) : int = { + var aux: int; + + var r:int; + var x:int; + var y:int; + var t:int; + var z:int; + + r <- 0; + x <- 1; + y <- 0; + t <- 0; + while (t < 24) { + if ((i = (x + (5 * y)))) { + r <- ((((t + 1) * (t + 2)) %/ 2) %% 64); + } else { + + } + z <- (((2 * x) + (3 * y)) %% 5); + x <- y; + y <- z; + t <- t + 1; + } + return (r); + } + + proc rho (a:W64.t Array25.t) : W64.t Array25.t = { + var aux_1: bool; + var aux_0: bool; + var aux: int; + var aux_2: W64.t; + + var x:int; + var y:int; + var i:int; + var z:int; + var _0:bool; + var _1:bool; + + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + i <@ index (x, y); + z <@ keccakRhoOffsets (i); + (aux_1, aux_0, aux_2) <- x86_ROL_64 a.[i] (W8.of_int z); + _0 <- aux_1; + _1 <- aux_0; + a.[i] <- aux_2; + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc pi (a:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var i:int; + var t:W64.t; + var b:W64.t Array25.t; + var y:int; + var x:int; + b <- witness; + i <- 0; + while (i < 25) { + t <- a.[i]; + b.[i] <- t; + i <- i + 1; + } + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + t <- b.[(x + (5 * y))]; + i <@ index (y, ((2 * x) + (3 * y))); + a.[i] <- t; + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc chi (a:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var x:int; + var y:int; + var i:int; + var c:W64.t Array5.t; + c <- witness; + y <- 0; + while (y < 5) { + x <- 0; + while (x < 5) { + i <@ index ((x + 1), y); + c.[x] <- a.[i]; + c.[x] <- (invw c.[x]); + i <@ index ((x + 2), y); + c.[x] <- (c.[x] `&` a.[i]); + i <@ index (x, y); + c.[x] <- (c.[x] `^` a.[i]); + x <- x + 1; + } + x <- 0; + while (x < 5) { + a.[(x + (5 * y))] <- c.[x]; + x <- x + 1; + } + y <- y + 1; + } + return (a); + } + + proc iota_0 (a:W64.t Array25.t, c:W64.t) : W64.t Array25.t = { + + + + a.[0] <- (a.[0] `^` c); + return (a); + } + + proc keccakP1600_round (state:W64.t Array25.t, c:W64.t) : W64.t Array25.t = { + + + + state <@ theta (state); + state <@ rho (state); + state <@ pi (state); + state <@ chi (state); + state <@ iota_0 (state, c); + return (state); + } + + proc keccakRoundConstants () : W64.t Array24.t = { + + var constants:W64.t Array24.t; + var t:W64.t; + constants <- witness; + t <- (W64.of_int 1); + constants.[0] <- t; + t <- (W64.of_int 32898); + constants.[1] <- t; + t <- (W64.of_int 9223372036854808714); + constants.[2] <- t; + t <- (W64.of_int 9223372039002292224); + constants.[3] <- t; + t <- (W64.of_int 32907); + constants.[4] <- t; + t <- (W64.of_int 2147483649); + constants.[5] <- t; + t <- (W64.of_int 9223372039002292353); + constants.[6] <- t; + t <- (W64.of_int 9223372036854808585); + constants.[7] <- t; + t <- (W64.of_int 138); + constants.[8] <- t; + t <- (W64.of_int 136); + constants.[9] <- t; + t <- (W64.of_int 2147516425); + constants.[10] <- t; + t <- (W64.of_int 2147483658); + constants.[11] <- t; + t <- (W64.of_int 2147516555); + constants.[12] <- t; + t <- (W64.of_int 9223372036854775947); + constants.[13] <- t; + t <- (W64.of_int 9223372036854808713); + constants.[14] <- t; + t <- (W64.of_int 9223372036854808579); + constants.[15] <- t; + t <- (W64.of_int 9223372036854808578); + constants.[16] <- t; + t <- (W64.of_int 9223372036854775936); + constants.[17] <- t; + t <- (W64.of_int 32778); + constants.[18] <- t; + t <- (W64.of_int 9223372039002259466); + constants.[19] <- t; + t <- (W64.of_int 9223372039002292353); + constants.[20] <- t; + t <- (W64.of_int 9223372036854808704); + constants.[21] <- t; + t <- (W64.of_int 2147483649); + constants.[22] <- t; + t <- (W64.of_int 9223372039002292232); + constants.[23] <- t; + return (constants); + } + + proc __keccak_f1600_ref (state:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var constants:W64.t Array24.t; + var round:int; + constants <- witness; + constants <@ keccakRoundConstants (); + round <- 0; + while (round < 24) { + state <@ keccakP1600_round (state, constants.[round]); + round <- round + 1; + } + return (state); + } + + proc st0 () : W64.t Array25.t = { + var aux: int; + + var state:W64.t Array25.t; + var i:int; + state <- witness; + i <- 0; + while (i < 25) { + state.[i] <- (W64.of_int 0); + i <- i + 1; + } + return (state); + } + + proc add_full_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, + r8:W64.t) : W64.t Array25.t * W64.t * W64.t = { + + var r64:W64.t; + var i:W64.t; + var t:W64.t; + + r64 <- r8; + r64 <- (r64 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult r64)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); + i <- (i + (W64.of_int 1)); + } + in_0 <- (in_0 + r8); + inlen <- (inlen - r8); + return (state, in_0, inlen); + } + + proc add_final_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, + trail_byte:W8.t, r8:W64.t) : W64.t Array25.t = { + + var inlen8:W64.t; + var i:W64.t; + var t:W64.t; + var c:W8.t; + + inlen8 <- inlen; + inlen8 <- (inlen8 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult inlen8)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); + i <- (i + (W64.of_int 1)); + } + i <- (i `<<` (W8.of_int 3)); + + while ((i \ult inlen)) { + c <- (loadW8 Glob.mem (W64.to_uint (in_0 + i))); + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` c))); + i <- (i + (W64.of_int 1)); + } + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` trail_byte))); + i <- r8; + i <- (i - (W64.of_int 1)); + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` (W8.of_int 128)))); + return (state); + } + + proc xtr_full_block (state:W64.t Array25.t, out:W64.t, outlen:W64.t, + rate:W64.t) : W64.t * W64.t = { + + var r64:W64.t; + var i:W64.t; + var t:W64.t; + + r64 <- rate; + r64 <- (r64 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult r64)) { + t <- state.[(W64.to_uint i)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; + i <- (i + (W64.of_int 1)); + } + out <- (out + rate); + outlen <- (outlen - rate); + return (out, outlen); + } + + proc xtr_bytes (state:W64.t Array25.t, out:W64.t, outlen:W64.t) : unit = { + + var outlen8:W64.t; + var i:W64.t; + var t:W64.t; + var c:W8.t; + + outlen8 <- outlen; + outlen8 <- (outlen8 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult outlen8)) { + t <- state.[(W64.to_uint i)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; + i <- (i + (W64.of_int 1)); + } + i <- (i `<<` (W8.of_int 3)); + + while ((i \ult outlen)) { + c <- (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)); + Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + i)) c; + i <- (i + (W64.of_int 1)); + } + return (); + } + + proc __keccak_1600 (s_out:W64.t, s_outlen:W64.t, in_0:W64.t, inlen:W64.t, + s_trail_byte:W64.t, rate:W64.t) : unit = { + + var state:W64.t Array25.t; + var s_in:W64.t; + var s_inlen:W64.t; + var s_rate:W64.t; + var t:W64.t; + var trail_byte:W8.t; + var outlen:W64.t; + var out:W64.t; + state <- witness; + state <@ st0 (); + + while ((rate \ule inlen)) { + (state, in_0, inlen) <@ add_full_block (state, in_0, inlen, rate); + s_in <- in_0; + s_inlen <- inlen; + s_rate <- rate; + state <@ __keccak_f1600_ref (state); + inlen <- s_inlen; + in_0 <- s_in; + rate <- s_rate; + } + t <- s_trail_byte; + trail_byte <- (truncateu8 t); + state <@ add_final_block (state, in_0, inlen, trail_byte, rate); + outlen <- s_outlen; + + while ((rate \ult outlen)) { + s_outlen <- outlen; + s_rate <- rate; + state <@ __keccak_f1600_ref (state); + out <- s_out; + outlen <- s_outlen; + rate <- s_rate; + (out, outlen) <@ xtr_full_block (state, out, outlen, rate); + s_outlen <- outlen; + s_out <- out; + } + state <@ __keccak_f1600_ref (state); + out <- s_out; + outlen <- s_outlen; + xtr_bytes (state, out, outlen); + return (); + } +}. + diff --git a/sha3/proof/impl/libc/.dir-locals.el b/sha3/proof/impl/libc/.dir-locals.el new file mode 100644 index 0000000..4161845 --- /dev/null +++ b/sha3/proof/impl/libc/.dir-locals.el @@ -0,0 +1,4 @@ +((easycrypt-mode . + ((eval . + (cl-flet ((pre (s) (concat (locate-dominating-file buffer-file-name ".dir-locals.el") s))) + (setq easycrypt-load-path `(,(pre "../perm"))))))))) diff --git a/sha3/proof/impl/libc/Array24.ec b/sha3/proof/impl/libc/Array24.ec new file mode 100644 index 0000000..8982b77 --- /dev/null +++ b/sha3/proof/impl/libc/Array24.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array24 with op size <- 24. diff --git a/sha3/proof/impl/libc/Array25.ec b/sha3/proof/impl/libc/Array25.ec new file mode 100644 index 0000000..30bcb17 --- /dev/null +++ b/sha3/proof/impl/libc/Array25.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array25 with op size <- 25. diff --git a/sha3/proof/impl/libc/Array28.ec b/sha3/proof/impl/libc/Array28.ec new file mode 100644 index 0000000..24bf4f6 --- /dev/null +++ b/sha3/proof/impl/libc/Array28.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array28 with op size <- 28. diff --git a/sha3/proof/impl/libc/Array5.ec b/sha3/proof/impl/libc/Array5.ec new file mode 100644 index 0000000..8dc7b36 --- /dev/null +++ b/sha3/proof/impl/libc/Array5.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array5 with op size <- 5. diff --git a/sha3/proof/impl/libc/Array7.ec b/sha3/proof/impl/libc/Array7.ec new file mode 100644 index 0000000..33f6cc6 --- /dev/null +++ b/sha3/proof/impl/libc/Array7.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array7 with op size <- 7. diff --git a/sha3/proof/impl/libc/Array9.ec b/sha3/proof/impl/libc/Array9.ec new file mode 100644 index 0000000..8759457 --- /dev/null +++ b/sha3/proof/impl/libc/Array9.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array9 with op size <- 9. diff --git a/sha3/proof/impl/libc/WArray192.ec b/sha3/proof/impl/libc/WArray192.ec new file mode 100644 index 0000000..c8564c5 --- /dev/null +++ b/sha3/proof/impl/libc/WArray192.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray192 with op size <- 192. diff --git a/sha3/proof/impl/libc/WArray200.ec b/sha3/proof/impl/libc/WArray200.ec new file mode 100644 index 0000000..99b887c --- /dev/null +++ b/sha3/proof/impl/libc/WArray200.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray200 with op size <- 200. diff --git a/sha3/proof/impl/libc/WArray224.ec b/sha3/proof/impl/libc/WArray224.ec new file mode 100644 index 0000000..f9d6745 --- /dev/null +++ b/sha3/proof/impl/libc/WArray224.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray224 with op size <- 224. diff --git a/sha3/proof/impl/libc/WArray288.ec b/sha3/proof/impl/libc/WArray288.ec new file mode 100644 index 0000000..86ac7cc --- /dev/null +++ b/sha3/proof/impl/libc/WArray288.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray288 with op size <- 288. diff --git a/sha3/proof/impl/libc/WArray40.ec b/sha3/proof/impl/libc/WArray40.ec new file mode 100644 index 0000000..003b6e2 --- /dev/null +++ b/sha3/proof/impl/libc/WArray40.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray40 with op size <- 40. diff --git a/sha3/proof/impl/libc/keccak_1600_avx2.ec b/sha3/proof/impl/libc/keccak_1600_avx2.ec new file mode 100644 index 0000000..2ca5070 --- /dev/null +++ b/sha3/proof/impl/libc/keccak_1600_avx2.ec @@ -0,0 +1,1051 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array7 Array9 Array28. +require import WArray224 WArray288. + +abbrev g_zero = W64.of_int 0. + + +module M = { + proc __keccak_f1600_avx2 (state:W256.t Array7.t, _rhotates_left:W64.t, + _rhotates_right:W64.t, _iotas:W64.t) : W256.t Array7.t = { + + var rhotates_left:W64.t; + var rhotates_right:W64.t; + var iotas:W64.t; + var r:W32.t; + var zf:bool; + var c00:W256.t; + var c14:W256.t; + var t:W256.t Array9.t; + var d14:W256.t; + var d00:W256.t; + var _0:bool; + var _1:bool; + var _2:bool; + t <- witness; + rhotates_left <- (_rhotates_left + (W64.of_int 96)); + rhotates_right <- (_rhotates_right + (W64.of_int 96)); + iotas <- _iotas; + r <- (W32.of_int 24); + c00 <- x86_VPSHUFD_256 state.[2] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + c14 <- (state.[5] `^` state.[3]); + t.[2] <- (state.[4] `^` state.[6]); + c14 <- (c14 `^` state.[1]); + c14 <- (c14 `^` t.[2]); + t.[4] <- x86_VPERMQ c14 + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 2)))); + c00 <- (c00 `^` state.[2]); + t.[0] <- x86_VPERMQ c00 + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + t.[1] <- (c14 \vshr64u256 (W8.of_int 63)); + t.[2] <- (c14 \vadd64u256 c14); + t.[1] <- (t.[1] `|` t.[2]); + d14 <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + d00 <- (t.[1] `^` t.[4]); + d00 <- x86_VPERMQ d00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + c00 <- (c00 `^` state.[0]); + c00 <- (c00 `^` t.[0]); + t.[0] <- (c00 \vshr64u256 (W8.of_int 63)); + t.[1] <- (c00 \vadd64u256 c00); + t.[1] <- (t.[1] `|` t.[0]); + state.[2] <- (state.[2] `^` d00); + state.[0] <- (state.[0] `^` d00); + d14 <- x86_VPBLENDD_256 d14 t.[1] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[4] <- x86_VPBLENDD_256 t.[4] c00 + (W8.of_int (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + d14 <- (d14 `^` t.[4]); + t.[3] <- x86_VPSLLV_4u64 state.[2] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 0) - 96))))); + state.[2] <- x86_VPSRLV_4u64 state.[2] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 0) - 96))))); + state.[2] <- (state.[2] `|` t.[3]); + state.[3] <- (state.[3] `^` d14); + t.[4] <- x86_VPSLLV_4u64 state.[3] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 2) - 96))))); + state.[3] <- x86_VPSRLV_4u64 state.[3] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 2) - 96))))); + state.[3] <- (state.[3] `|` t.[4]); + state.[4] <- (state.[4] `^` d14); + t.[5] <- x86_VPSLLV_4u64 state.[4] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 3) - 96))))); + state.[4] <- x86_VPSRLV_4u64 state.[4] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 3) - 96))))); + state.[4] <- (state.[4] `|` t.[5]); + state.[5] <- (state.[5] `^` d14); + t.[6] <- x86_VPSLLV_4u64 state.[5] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 4) - 96))))); + state.[5] <- x86_VPSRLV_4u64 state.[5] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 4) - 96))))); + state.[5] <- (state.[5] `|` t.[6]); + state.[6] <- (state.[6] `^` d14); + t.[3] <- x86_VPERMQ state.[2] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + t.[4] <- x86_VPERMQ state.[3] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + t.[7] <- x86_VPSLLV_4u64 state.[6] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 5) - 96))))); + t.[1] <- x86_VPSRLV_4u64 state.[6] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 5) - 96))))); + t.[1] <- (t.[1] `|` t.[7]); + state.[1] <- (state.[1] `^` d14); + t.[5] <- x86_VPERMQ state.[4] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + t.[6] <- x86_VPERMQ state.[5] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + t.[8] <- x86_VPSLLV_4u64 state.[1] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 1) - 96))))); + t.[2] <- x86_VPSRLV_4u64 state.[1] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 1) - 96))))); + t.[2] <- (t.[2] `|` t.[8]); + t.[7] <- x86_VPSRLDQ_256 t.[1] (W8.of_int 8); + t.[0] <- ((invw t.[1]) `&` t.[7]); + state.[3] <- x86_VPBLENDD_256 t.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- x86_VPBLENDD_256 t.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- x86_VPBLENDD_256 state.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- x86_VPBLENDD_256 state.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- x86_VPBLENDD_256 state.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[5] <- x86_VPBLENDD_256 state.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[3] <- ((invw state.[3]) `&` t.[8]); + state.[5] <- ((invw state.[5]) `&` t.[7]); + state.[6] <- x86_VPBLENDD_256 t.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- (state.[3] `^` t.[3]); + state.[6] <- x86_VPBLENDD_256 state.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- (state.[5] `^` t.[5]); + state.[6] <- x86_VPBLENDD_256 state.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[6] <- ((invw state.[6]) `&` t.[8]); + state.[6] <- (state.[6] `^` t.[6]); + state.[4] <- x86_VPERMQ t.[1] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + t.[8] <- x86_VPBLENDD_256 state.[4] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[1] <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + state.[1] <- x86_VPBLENDD_256 state.[1] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[1] <- ((invw state.[1]) `&` t.[8]); + state.[2] <- x86_VPBLENDD_256 t.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[2] <- x86_VPBLENDD_256 state.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[2] <- x86_VPBLENDD_256 state.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[2] <- ((invw state.[2]) `&` t.[7]); + state.[2] <- (state.[2] `^` t.[2]); + t.[0] <- x86_VPERMQ t.[0] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + state.[3] <- x86_VPERMQ state.[3] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + state.[5] <- x86_VPERMQ state.[5] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + state.[6] <- x86_VPERMQ state.[6] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + state.[4] <- x86_VPBLENDD_256 t.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[4] <- x86_VPBLENDD_256 state.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[4] <- x86_VPBLENDD_256 state.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[4] <- ((invw state.[4]) `&` t.[7]); + state.[0] <- (state.[0] `^` t.[0]); + state.[1] <- (state.[1] `^` t.[1]); + state.[4] <- (state.[4] `^` t.[4]); + state.[0] <- + (state.[0] `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int ((32 * 0) - 0)))))); + iotas <- (iotas + (W64.of_int 32)); + ( _0, _1, _2, zf, r) <- x86_DEC_32 r; + while ((! zf)) { + c00 <- x86_VPSHUFD_256 state.[2] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + c14 <- (state.[5] `^` state.[3]); + t.[2] <- (state.[4] `^` state.[6]); + c14 <- (c14 `^` state.[1]); + c14 <- (c14 `^` t.[2]); + t.[4] <- x86_VPERMQ c14 + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 2)))); + c00 <- (c00 `^` state.[2]); + t.[0] <- x86_VPERMQ c00 + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + t.[1] <- (c14 \vshr64u256 (W8.of_int 63)); + t.[2] <- (c14 \vadd64u256 c14); + t.[1] <- (t.[1] `|` t.[2]); + d14 <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + d00 <- (t.[1] `^` t.[4]); + d00 <- x86_VPERMQ d00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + c00 <- (c00 `^` state.[0]); + c00 <- (c00 `^` t.[0]); + t.[0] <- (c00 \vshr64u256 (W8.of_int 63)); + t.[1] <- (c00 \vadd64u256 c00); + t.[1] <- (t.[1] `|` t.[0]); + state.[2] <- (state.[2] `^` d00); + state.[0] <- (state.[0] `^` d00); + d14 <- x86_VPBLENDD_256 d14 t.[1] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[4] <- x86_VPBLENDD_256 t.[4] c00 + (W8.of_int (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + d14 <- (d14 `^` t.[4]); + t.[3] <- x86_VPSLLV_4u64 state.[2] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 0) - 96))))); + state.[2] <- x86_VPSRLV_4u64 state.[2] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 0) - 96))))); + state.[2] <- (state.[2] `|` t.[3]); + state.[3] <- (state.[3] `^` d14); + t.[4] <- x86_VPSLLV_4u64 state.[3] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 2) - 96))))); + state.[3] <- x86_VPSRLV_4u64 state.[3] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 2) - 96))))); + state.[3] <- (state.[3] `|` t.[4]); + state.[4] <- (state.[4] `^` d14); + t.[5] <- x86_VPSLLV_4u64 state.[4] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 3) - 96))))); + state.[4] <- x86_VPSRLV_4u64 state.[4] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 3) - 96))))); + state.[4] <- (state.[4] `|` t.[5]); + state.[5] <- (state.[5] `^` d14); + t.[6] <- x86_VPSLLV_4u64 state.[5] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 4) - 96))))); + state.[5] <- x86_VPSRLV_4u64 state.[5] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 4) - 96))))); + state.[5] <- (state.[5] `|` t.[6]); + state.[6] <- (state.[6] `^` d14); + t.[3] <- x86_VPERMQ state.[2] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + t.[4] <- x86_VPERMQ state.[3] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + t.[7] <- x86_VPSLLV_4u64 state.[6] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 5) - 96))))); + t.[1] <- x86_VPSRLV_4u64 state.[6] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 5) - 96))))); + t.[1] <- (t.[1] `|` t.[7]); + state.[1] <- (state.[1] `^` d14); + t.[5] <- x86_VPERMQ state.[4] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + t.[6] <- x86_VPERMQ state.[5] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + t.[8] <- x86_VPSLLV_4u64 state.[1] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 1) - 96))))); + t.[2] <- x86_VPSRLV_4u64 state.[1] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 1) - 96))))); + t.[2] <- (t.[2] `|` t.[8]); + t.[7] <- x86_VPSRLDQ_256 t.[1] (W8.of_int 8); + t.[0] <- ((invw t.[1]) `&` t.[7]); + state.[3] <- x86_VPBLENDD_256 t.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- x86_VPBLENDD_256 t.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- x86_VPBLENDD_256 state.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- x86_VPBLENDD_256 state.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- x86_VPBLENDD_256 state.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[5] <- x86_VPBLENDD_256 state.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[3] <- ((invw state.[3]) `&` t.[8]); + state.[5] <- ((invw state.[5]) `&` t.[7]); + state.[6] <- x86_VPBLENDD_256 t.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- (state.[3] `^` t.[3]); + state.[6] <- x86_VPBLENDD_256 state.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- (state.[5] `^` t.[5]); + state.[6] <- x86_VPBLENDD_256 state.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[6] <- ((invw state.[6]) `&` t.[8]); + state.[6] <- (state.[6] `^` t.[6]); + state.[4] <- x86_VPERMQ t.[1] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + t.[8] <- x86_VPBLENDD_256 state.[4] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[1] <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + state.[1] <- x86_VPBLENDD_256 state.[1] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[1] <- ((invw state.[1]) `&` t.[8]); + state.[2] <- x86_VPBLENDD_256 t.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[2] <- x86_VPBLENDD_256 state.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[2] <- x86_VPBLENDD_256 state.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[2] <- ((invw state.[2]) `&` t.[7]); + state.[2] <- (state.[2] `^` t.[2]); + t.[0] <- x86_VPERMQ t.[0] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + state.[3] <- x86_VPERMQ state.[3] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + state.[5] <- x86_VPERMQ state.[5] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + state.[6] <- x86_VPERMQ state.[6] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + state.[4] <- x86_VPBLENDD_256 t.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[4] <- x86_VPBLENDD_256 state.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[4] <- x86_VPBLENDD_256 state.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[4] <- ((invw state.[4]) `&` t.[7]); + state.[0] <- (state.[0] `^` t.[0]); + state.[1] <- (state.[1] `^` t.[1]); + state.[4] <- (state.[4] `^` t.[4]); + state.[0] <- + (state.[0] `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int ((32 * 0) - 0)))))); + iotas <- (iotas + (W64.of_int 32)); + ( _0, _1, _2, zf, r) <- x86_DEC_32 r; + } + return (state); + } + + proc keccak_init () : W256.t Array7.t = { + var aux: int; + + var state:W256.t Array7.t; + var i:int; + state <- witness; + state.[0] <- x86_VPBROADCAST_4u64 g_zero; + i <- 1; + while (i < 7) { + state.[i] <- state.[0]; + i <- i + 1; + } + return (state); + } + + proc init_s_state () : W64.t Array28.t = { + var aux: int; + + var s_state:W64.t Array28.t; + var zero:W256.t; + var i:int; + s_state <- witness; + zero <- x86_VPBROADCAST_4u64 g_zero; + i <- 0; + while (i < 7) { + s_state = + Array28.init + (WArray224.get64 (WArray224.set256 (WArray224.init64 (fun i => s_state.[i])) i zero)); + i <- i + 1; + } + return (s_state); + } + + proc add_full_block (state:W256.t Array7.t, s_state:W64.t Array28.t, + a_jagged:W64.t, in_0:W64.t, inlen:W64.t, rate:W64.t) : + W256.t Array7.t * W64.t Array28.t * W64.t * W64.t = { + var aux: int; + + var rate8:W64.t; + var j:W64.t; + var t:W64.t; + var l:W64.t; + var i:int; + + rate8 <- rate; + rate8 <- (rate8 `>>` (W8.of_int 3)); + j <- (W64.of_int 0); + + while ((j \ult rate8)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * j)))); + l <- + (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + s_state.[(W64.to_uint l)] <- t; + j <- (j + (W64.of_int 1)); + } + t <- s_state.[0]; + s_state.[1] <- t; + s_state.[2] <- t; + s_state.[3] <- t; + i <- 0; + while (i < 7) { + state.[i] <- + (state.[i] `^` (get256 (WArray224.init64 (fun i => s_state.[i])) i)); + i <- i + 1; + } + in_0 <- (in_0 + rate); + inlen <- (inlen - rate); + return (state, s_state, in_0, inlen); + } + + proc add_final_block (state:W256.t Array7.t, s_state:W64.t Array28.t, + a_jagged:W64.t, in_0:W64.t, inlen:W64.t, + trail_byte:W8.t, rate:W64.t) : W256.t Array7.t = { + var aux: int; + + var inlen8:W64.t; + var j:W64.t; + var t:W64.t; + var l:W64.t; + var c:W8.t; + var i:int; + + s_state <@ init_s_state (); + inlen8 <- inlen; + inlen8 <- (inlen8 `>>` (W8.of_int 3)); + j <- (W64.of_int 0); + + while ((j \ult inlen8)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * j)))); + l <- + (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + s_state.[(W64.to_uint l)] <- t; + j <- (j + (W64.of_int 1)); + } + l <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + l <- (l `<<` (W8.of_int 3)); + j <- (j `<<` (W8.of_int 3)); + + while ((j \ult inlen)) { + c <- (loadW8 Glob.mem (W64.to_uint (in_0 + j))); + s_state = + Array28.init + (WArray224.get64 (WArray224.set8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l) c)); + j <- (j + (W64.of_int 1)); + l <- (l + (W64.of_int 1)); + } + s_state = + Array28.init + (WArray224.get64 (WArray224.set8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l) trail_byte)); + j <- rate; + j <- (j - (W64.of_int 1)); + j <- (j `>>` (W8.of_int 3)); + l <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + l <- (l `<<` (W8.of_int 3)); + j <- rate; + j <- (j - (W64.of_int 1)); + j <- (j `&` (W64.of_int 7)); + l <- (l + j); + s_state = + Array28.init + (WArray224.get64 (WArray224.set8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l) ( + (get8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l)) `^` (W8.of_int 128)))); + t <- s_state.[0]; + s_state.[1] <- t; + s_state.[2] <- t; + s_state.[3] <- t; + i <- 0; + while (i < 7) { + state.[i] <- + (state.[i] `^` (get256 (WArray224.init64 (fun i => s_state.[i])) i)); + i <- i + 1; + } + return (state); + } + + proc xtr_full_block (state:W256.t Array7.t, a_jagged:W64.t, out:W64.t, + len:W64.t) : W64.t = { + var aux: int; + + var i:int; + var s_state:W64.t Array28.t; + var len8:W64.t; + var j:W64.t; + var l:W64.t; + var t:W64.t; + s_state <- witness; + i <- 0; + while (i < 7) { + s_state = + Array28.init + (WArray224.get64 (WArray224.set256 (WArray224.init64 (fun i => s_state.[i])) i + state.[i])); + i <- i + 1; + } + len8 <- len; + len8 <- (len8 `>>` (W8.of_int 3)); + j <- (W64.of_int 0); + + while ((j \ult len8)) { + l <- + (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + t <- s_state.[(W64.to_uint l)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * j))) t; + j <- (j + (W64.of_int 1)); + } + out <- (out + len); + return (out); + } + + proc xtr_bytes (state:W256.t Array7.t, a_jagged:W64.t, out:W64.t, len:W64.t) : + W64.t = { + var aux: int; + + var i:int; + var s_state:W64.t Array28.t; + var len8:W64.t; + var j:W64.t; + var l:W64.t; + var t:W64.t; + var c:W8.t; + s_state <- witness; + i <- 0; + while (i < 7) { + s_state = + Array28.init + (WArray224.get64 (WArray224.set256 (WArray224.init64 (fun i => s_state.[i])) i + state.[i])); + i <- i + 1; + } + len8 <- len; + len8 <- (len8 `>>` (W8.of_int 3)); + j <- (W64.of_int 0); + + while ((j \ult len8)) { + l <- + (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + t <- s_state.[(W64.to_uint l)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * j))) t; + j <- (j + (W64.of_int 1)); + } + l <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + j <- (j `<<` (W8.of_int 3)); + l <- (l `<<` (W8.of_int 3)); + + while ((j \ult len)) { + c <- (get8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l)); + Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + j)) c; + j <- (j + (W64.of_int 1)); + l <- (l + (W64.of_int 1)); + } + out <- (out + len); + return (out); + } + + proc absorb (state:W256.t Array7.t, rhotates_left:W64.t, + rhotates_right:W64.t, iotas:W64.t, a_jagged:W64.t, in_0:W64.t, + inlen:W64.t, trail_byte:W8.t, rate:W64.t) : W256.t Array7.t = { + + var s_state:W64.t Array28.t; + s_state <- witness; + s_state <@ init_s_state (); + + while ((rate \ule inlen)) { + (state, s_state, in_0, inlen) <@ add_full_block (state, s_state, + a_jagged, in_0, inlen, rate); + state <@ __keccak_f1600_avx2 (state, rhotates_left, rhotates_right, + iotas); + } + state <@ add_final_block (state, s_state, a_jagged, in_0, inlen, + trail_byte, rate); + return (state); + } + + proc squeeze (state:W256.t Array7.t, rhotates_left:W64.t, + rhotates_right:W64.t, iotas:W64.t, a_jagged:W64.t, out:W64.t, + outlen:W64.t, rate:W64.t) : unit = { + + + + + while ((rate \ult outlen)) { + state <@ __keccak_f1600_avx2 (state, rhotates_left, rhotates_right, + iotas); + out <@ xtr_full_block (state, a_jagged, out, rate); + outlen <- (outlen - rate); + } + state <@ __keccak_f1600_avx2 (state, rhotates_left, rhotates_right, + iotas); + out <@ xtr_bytes (state, a_jagged, out, outlen); + return (); + } + + proc __keccak_1600 (out:W64.t, outlen:W64.t, rhotates_left:W64.t, + rhotates_right:W64.t, iotas:W64.t, a_jagged:W64.t, + in_0:W64.t, inlen:W64.t, trail_byte:W8.t, rate:W64.t) : unit = { + + var state:W256.t Array7.t; + state <- witness; + state <@ keccak_init (); + state <@ absorb (state, rhotates_left, rhotates_right, iotas, a_jagged, + in_0, inlen, trail_byte, rate); + squeeze (state, rhotates_left, rhotates_right, iotas, a_jagged, out, + outlen, rate); + return (); + } +}. + diff --git a/sha3/proof/impl/libc/keccak_1600_avx2_CT.ec b/sha3/proof/impl/libc/keccak_1600_avx2_CT.ec new file mode 100644 index 0000000..13cc51f --- /dev/null +++ b/sha3/proof/impl/libc/keccak_1600_avx2_CT.ec @@ -0,0 +1,2544 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array7 Array9 Array28. +require import WArray224 WArray288. + +abbrev g_zero = W64.of_int 0. + + +module M = { + var leakages : leakages_t + + proc __keccak_f1600_avx2 (state:W256.t Array7.t, _rhotates_left:W64.t, + _rhotates_right:W64.t, _iotas:W64.t) : W256.t Array7.t = { + var aux_5: bool; + var aux_4: bool; + var aux_3: bool; + var aux_2: bool; + var aux_0: W32.t; + var aux: W64.t; + var aux_1: W256.t; + + var rhotates_left:W64.t; + var rhotates_right:W64.t; + var iotas:W64.t; + var r:W32.t; + var zf:bool; + var c00:W256.t; + var c14:W256.t; + var t:W256.t Array9.t; + var d14:W256.t; + var d00:W256.t; + var _0:bool; + var _1:bool; + var _2:bool; + t <- witness; + leakages <- LeakAddr([]) :: leakages; + aux <- (_rhotates_left + (W64.of_int 96)); + rhotates_left <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (_rhotates_right + (W64.of_int 96)); + rhotates_right <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- _iotas; + iotas <- aux; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (W32.of_int 24); + r <- aux_0; + leakages <- LeakAddr([2]) :: leakages; + aux_1 <- x86_VPSHUFD_256 state.[2] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + c00 <- aux_1; + leakages <- LeakAddr([3; 5]) :: leakages; + aux_1 <- (state.[5] `^` state.[3]); + c14 <- aux_1; + leakages <- LeakAddr([6; 4]) :: leakages; + aux_1 <- (state.[4] `^` state.[6]); + leakages <- LeakAddr([2]) :: leakages; + t.[2] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- (c14 `^` state.[1]); + c14 <- aux_1; + leakages <- LeakAddr([2]) :: leakages; + aux_1 <- (c14 `^` t.[2]); + c14 <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- x86_VPERMQ c14 + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 2)))); + leakages <- LeakAddr([4]) :: leakages; + t.[4] <- aux_1; + leakages <- LeakAddr([2]) :: leakages; + aux_1 <- (c00 `^` state.[2]); + c00 <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- x86_VPERMQ c00 + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + leakages <- LeakAddr([0]) :: leakages; + t.[0] <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (c14 \vshr64u256 (W8.of_int 63)); + leakages <- LeakAddr([1]) :: leakages; + t.[1] <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (c14 \vadd64u256 c14); + leakages <- LeakAddr([2]) :: leakages; + t.[2] <- aux_1; + leakages <- LeakAddr([2; 1]) :: leakages; + aux_1 <- (t.[1] `|` t.[2]); + leakages <- LeakAddr([1]) :: leakages; + t.[1] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + d14 <- aux_1; + leakages <- LeakAddr([4; 1]) :: leakages; + aux_1 <- (t.[1] `^` t.[4]); + d00 <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- x86_VPERMQ d00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + d00 <- aux_1; + leakages <- LeakAddr([0]) :: leakages; + aux_1 <- (c00 `^` state.[0]); + c00 <- aux_1; + leakages <- LeakAddr([0]) :: leakages; + aux_1 <- (c00 `^` t.[0]); + c00 <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (c00 \vshr64u256 (W8.of_int 63)); + leakages <- LeakAddr([0]) :: leakages; + t.[0] <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (c00 \vadd64u256 c00); + leakages <- LeakAddr([1]) :: leakages; + t.[1] <- aux_1; + leakages <- LeakAddr([0; 1]) :: leakages; + aux_1 <- (t.[1] `|` t.[0]); + leakages <- LeakAddr([1]) :: leakages; + t.[1] <- aux_1; + leakages <- LeakAddr([2]) :: leakages; + aux_1 <- (state.[2] `^` d00); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([0]) :: leakages; + aux_1 <- (state.[0] `^` d00); + leakages <- LeakAddr([0]) :: leakages; + state.[0] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- x86_VPBLENDD_256 d14 t.[1] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + d14 <- aux_1; + leakages <- LeakAddr([4]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[4] c00 + (W8.of_int (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([4]) :: leakages; + t.[4] <- aux_1; + leakages <- LeakAddr([4]) :: leakages; + aux_1 <- (d14 `^` t.[4]); + d14 <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_left + (W64.of_int ((32 * 0) - 96)))); + 2]) :: leakages; + aux_1 <- x86_VPSLLV_4u64 state.[2] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 0) - 96))))); + leakages <- LeakAddr([3]) :: leakages; + t.[3] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_right + (W64.of_int ((32 * 0) - 96)))); + 2]) :: leakages; + aux_1 <- x86_VPSRLV_4u64 state.[2] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 0) - 96))))); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([3; 2]) :: leakages; + aux_1 <- (state.[2] `|` t.[3]); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([3]) :: leakages; + aux_1 <- (state.[3] `^` d14); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_left + (W64.of_int ((32 * 2) - 96)))); + 3]) :: leakages; + aux_1 <- x86_VPSLLV_4u64 state.[3] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 2) - 96))))); + leakages <- LeakAddr([4]) :: leakages; + t.[4] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_right + (W64.of_int ((32 * 2) - 96)))); + 3]) :: leakages; + aux_1 <- x86_VPSRLV_4u64 state.[3] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 2) - 96))))); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([4; 3]) :: leakages; + aux_1 <- (state.[3] `|` t.[4]); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([4]) :: leakages; + aux_1 <- (state.[4] `^` d14); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_left + (W64.of_int ((32 * 3) - 96)))); + 4]) :: leakages; + aux_1 <- x86_VPSLLV_4u64 state.[4] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 3) - 96))))); + leakages <- LeakAddr([5]) :: leakages; + t.[5] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_right + (W64.of_int ((32 * 3) - 96)))); + 4]) :: leakages; + aux_1 <- x86_VPSRLV_4u64 state.[4] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 3) - 96))))); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([5; 4]) :: leakages; + aux_1 <- (state.[4] `|` t.[5]); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([5]) :: leakages; + aux_1 <- (state.[5] `^` d14); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_left + (W64.of_int ((32 * 4) - 96)))); + 5]) :: leakages; + aux_1 <- x86_VPSLLV_4u64 state.[5] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 4) - 96))))); + leakages <- LeakAddr([6]) :: leakages; + t.[6] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_right + (W64.of_int ((32 * 4) - 96)))); + 5]) :: leakages; + aux_1 <- x86_VPSRLV_4u64 state.[5] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 4) - 96))))); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([6; 5]) :: leakages; + aux_1 <- (state.[5] `|` t.[6]); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([6]) :: leakages; + aux_1 <- (state.[6] `^` d14); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([2]) :: leakages; + aux_1 <- x86_VPERMQ state.[2] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + leakages <- LeakAddr([3]) :: leakages; + t.[3] <- aux_1; + leakages <- LeakAddr([3]) :: leakages; + aux_1 <- x86_VPERMQ state.[3] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + leakages <- LeakAddr([4]) :: leakages; + t.[4] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_left + (W64.of_int ((32 * 5) - 96)))); + 6]) :: leakages; + aux_1 <- x86_VPSLLV_4u64 state.[6] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 5) - 96))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_right + (W64.of_int ((32 * 5) - 96)))); + 6]) :: leakages; + aux_1 <- x86_VPSRLV_4u64 state.[6] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 5) - 96))))); + leakages <- LeakAddr([1]) :: leakages; + t.[1] <- aux_1; + leakages <- LeakAddr([7; 1]) :: leakages; + aux_1 <- (t.[1] `|` t.[7]); + leakages <- LeakAddr([1]) :: leakages; + t.[1] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- (state.[1] `^` d14); + leakages <- LeakAddr([1]) :: leakages; + state.[1] <- aux_1; + leakages <- LeakAddr([4]) :: leakages; + aux_1 <- x86_VPERMQ state.[4] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + leakages <- LeakAddr([5]) :: leakages; + t.[5] <- aux_1; + leakages <- LeakAddr([5]) :: leakages; + aux_1 <- x86_VPERMQ state.[5] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + leakages <- LeakAddr([6]) :: leakages; + t.[6] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_left + (W64.of_int ((32 * 1) - 96)))); + 1]) :: leakages; + aux_1 <- x86_VPSLLV_4u64 state.[1] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 1) - 96))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_right + (W64.of_int ((32 * 1) - 96)))); + 1]) :: leakages; + aux_1 <- x86_VPSRLV_4u64 state.[1] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 1) - 96))))); + leakages <- LeakAddr([2]) :: leakages; + t.[2] <- aux_1; + leakages <- LeakAddr([8; 2]) :: leakages; + aux_1 <- (t.[2] `|` t.[8]); + leakages <- LeakAddr([2]) :: leakages; + t.[2] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- x86_VPSRLDQ_256 t.[1] (W8.of_int 8); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([7; 1]) :: leakages; + aux_1 <- ((invw t.[1]) `&` t.[7]); + leakages <- LeakAddr([0]) :: leakages; + t.[0] <- aux_1; + leakages <- LeakAddr([6; 2]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([2; 4]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([4; 3]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([3; 2]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([4; 3]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([5; 8]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[8] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([2; 5]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([6; 7]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[7] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([5; 3]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([6; 8]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[8] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([6; 5]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([4; 7]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[7] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([8; 3]) :: leakages; + aux_1 <- ((invw state.[3]) `&` t.[8]); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([7; 5]) :: leakages; + aux_1 <- ((invw state.[5]) `&` t.[7]); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([2; 5]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([5; 3]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([3; 3]) :: leakages; + aux_1 <- (state.[3] `^` t.[3]); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([3; 6]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([4; 8]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[8] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([5; 5]) :: leakages; + aux_1 <- (state.[5] `^` t.[5]); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([4; 6]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([2; 8]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[8] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([8; 6]) :: leakages; + aux_1 <- ((invw state.[6]) `&` t.[8]); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([6; 6]) :: leakages; + aux_1 <- (state.[6] `^` t.[6]); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- x86_VPERMQ t.[1] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([0; 4]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[4] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + leakages <- LeakAddr([1]) :: leakages; + state.[1] <- aux_1; + leakages <- LeakAddr([0; 1]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[1] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([1]) :: leakages; + state.[1] <- aux_1; + leakages <- LeakAddr([8; 1]) :: leakages; + aux_1 <- ((invw state.[1]) `&` t.[8]); + leakages <- LeakAddr([1]) :: leakages; + state.[1] <- aux_1; + leakages <- LeakAddr([5; 4]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([4; 6]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([6; 2]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([3; 7]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([3; 2]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([5; 7]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[7] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([7; 2]) :: leakages; + aux_1 <- ((invw state.[2]) `&` t.[7]); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([2; 2]) :: leakages; + aux_1 <- (state.[2] `^` t.[2]); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([0]) :: leakages; + aux_1 <- x86_VPERMQ t.[0] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + leakages <- LeakAddr([0]) :: leakages; + t.[0] <- aux_1; + leakages <- LeakAddr([3]) :: leakages; + aux_1 <- x86_VPERMQ state.[3] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([5]) :: leakages; + aux_1 <- x86_VPERMQ state.[5] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([6]) :: leakages; + aux_1 <- x86_VPERMQ state.[6] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([3; 6]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([6; 5]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([5; 4]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([2; 7]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[7] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([2; 4]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([3; 7]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([7; 4]) :: leakages; + aux_1 <- ((invw state.[4]) `&` t.[7]); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([0; 0]) :: leakages; + aux_1 <- (state.[0] `^` t.[0]); + leakages <- LeakAddr([0]) :: leakages; + state.[0] <- aux_1; + leakages <- LeakAddr([1; 1]) :: leakages; + aux_1 <- (state.[1] `^` t.[1]); + leakages <- LeakAddr([1]) :: leakages; + state.[1] <- aux_1; + leakages <- LeakAddr([4; 4]) :: leakages; + aux_1 <- (state.[4] `^` t.[4]); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (iotas + (W64.of_int ((32 * 0) - 0)))); + 0]) :: leakages; + aux_1 <- (state.[0] `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int ((32 * 0) - 0)))))); + leakages <- LeakAddr([0]) :: leakages; + state.[0] <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux <- (iotas + (W64.of_int 32)); + iotas <- aux; + leakages <- LeakAddr([]) :: leakages; + (aux_5, aux_4, aux_3, aux_2, aux_0) <- x86_DEC_32 r; + _0 <- aux_5; + _1 <- aux_4; + _2 <- aux_3; + zf <- aux_2; + r <- aux_0; + leakages <- LeakCond((! zf)) :: LeakAddr([]) :: leakages; + + while ((! zf)) { + leakages <- LeakAddr([2]) :: leakages; + aux_1 <- x86_VPSHUFD_256 state.[2] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + c00 <- aux_1; + leakages <- LeakAddr([3; 5]) :: leakages; + aux_1 <- (state.[5] `^` state.[3]); + c14 <- aux_1; + leakages <- LeakAddr([6; 4]) :: leakages; + aux_1 <- (state.[4] `^` state.[6]); + leakages <- LeakAddr([2]) :: leakages; + t.[2] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- (c14 `^` state.[1]); + c14 <- aux_1; + leakages <- LeakAddr([2]) :: leakages; + aux_1 <- (c14 `^` t.[2]); + c14 <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- x86_VPERMQ c14 + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 2)))); + leakages <- LeakAddr([4]) :: leakages; + t.[4] <- aux_1; + leakages <- LeakAddr([2]) :: leakages; + aux_1 <- (c00 `^` state.[2]); + c00 <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- x86_VPERMQ c00 + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + leakages <- LeakAddr([0]) :: leakages; + t.[0] <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (c14 \vshr64u256 (W8.of_int 63)); + leakages <- LeakAddr([1]) :: leakages; + t.[1] <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (c14 \vadd64u256 c14); + leakages <- LeakAddr([2]) :: leakages; + t.[2] <- aux_1; + leakages <- LeakAddr([2; 1]) :: leakages; + aux_1 <- (t.[1] `|` t.[2]); + leakages <- LeakAddr([1]) :: leakages; + t.[1] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + d14 <- aux_1; + leakages <- LeakAddr([4; 1]) :: leakages; + aux_1 <- (t.[1] `^` t.[4]); + d00 <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- x86_VPERMQ d00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + d00 <- aux_1; + leakages <- LeakAddr([0]) :: leakages; + aux_1 <- (c00 `^` state.[0]); + c00 <- aux_1; + leakages <- LeakAddr([0]) :: leakages; + aux_1 <- (c00 `^` t.[0]); + c00 <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (c00 \vshr64u256 (W8.of_int 63)); + leakages <- LeakAddr([0]) :: leakages; + t.[0] <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (c00 \vadd64u256 c00); + leakages <- LeakAddr([1]) :: leakages; + t.[1] <- aux_1; + leakages <- LeakAddr([0; 1]) :: leakages; + aux_1 <- (t.[1] `|` t.[0]); + leakages <- LeakAddr([1]) :: leakages; + t.[1] <- aux_1; + leakages <- LeakAddr([2]) :: leakages; + aux_1 <- (state.[2] `^` d00); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([0]) :: leakages; + aux_1 <- (state.[0] `^` d00); + leakages <- LeakAddr([0]) :: leakages; + state.[0] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- x86_VPBLENDD_256 d14 t.[1] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + d14 <- aux_1; + leakages <- LeakAddr([4]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[4] c00 + (W8.of_int (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([4]) :: leakages; + t.[4] <- aux_1; + leakages <- LeakAddr([4]) :: leakages; + aux_1 <- (d14 `^` t.[4]); + d14 <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_left + (W64.of_int ((32 * 0) - 96)))); + 2]) :: leakages; + aux_1 <- x86_VPSLLV_4u64 state.[2] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 0) - 96))))); + leakages <- LeakAddr([3]) :: leakages; + t.[3] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_right + (W64.of_int ((32 * 0) - 96)))); + 2]) :: leakages; + aux_1 <- x86_VPSRLV_4u64 state.[2] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 0) - 96))))); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([3; 2]) :: leakages; + aux_1 <- (state.[2] `|` t.[3]); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([3]) :: leakages; + aux_1 <- (state.[3] `^` d14); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_left + (W64.of_int ((32 * 2) - 96)))); + 3]) :: leakages; + aux_1 <- x86_VPSLLV_4u64 state.[3] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 2) - 96))))); + leakages <- LeakAddr([4]) :: leakages; + t.[4] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_right + (W64.of_int ((32 * 2) - 96)))); + 3]) :: leakages; + aux_1 <- x86_VPSRLV_4u64 state.[3] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 2) - 96))))); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([4; 3]) :: leakages; + aux_1 <- (state.[3] `|` t.[4]); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([4]) :: leakages; + aux_1 <- (state.[4] `^` d14); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_left + (W64.of_int ((32 * 3) - 96)))); + 4]) :: leakages; + aux_1 <- x86_VPSLLV_4u64 state.[4] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 3) - 96))))); + leakages <- LeakAddr([5]) :: leakages; + t.[5] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_right + (W64.of_int ((32 * 3) - 96)))); + 4]) :: leakages; + aux_1 <- x86_VPSRLV_4u64 state.[4] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 3) - 96))))); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([5; 4]) :: leakages; + aux_1 <- (state.[4] `|` t.[5]); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([5]) :: leakages; + aux_1 <- (state.[5] `^` d14); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_left + (W64.of_int ((32 * 4) - 96)))); + 5]) :: leakages; + aux_1 <- x86_VPSLLV_4u64 state.[5] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 4) - 96))))); + leakages <- LeakAddr([6]) :: leakages; + t.[6] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_right + (W64.of_int ((32 * 4) - 96)))); + 5]) :: leakages; + aux_1 <- x86_VPSRLV_4u64 state.[5] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 4) - 96))))); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([6; 5]) :: leakages; + aux_1 <- (state.[5] `|` t.[6]); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([6]) :: leakages; + aux_1 <- (state.[6] `^` d14); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([2]) :: leakages; + aux_1 <- x86_VPERMQ state.[2] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + leakages <- LeakAddr([3]) :: leakages; + t.[3] <- aux_1; + leakages <- LeakAddr([3]) :: leakages; + aux_1 <- x86_VPERMQ state.[3] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + leakages <- LeakAddr([4]) :: leakages; + t.[4] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_left + (W64.of_int ((32 * 5) - 96)))); + 6]) :: leakages; + aux_1 <- x86_VPSLLV_4u64 state.[6] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 5) - 96))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_right + (W64.of_int ((32 * 5) - 96)))); + 6]) :: leakages; + aux_1 <- x86_VPSRLV_4u64 state.[6] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 5) - 96))))); + leakages <- LeakAddr([1]) :: leakages; + t.[1] <- aux_1; + leakages <- LeakAddr([7; 1]) :: leakages; + aux_1 <- (t.[1] `|` t.[7]); + leakages <- LeakAddr([1]) :: leakages; + t.[1] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- (state.[1] `^` d14); + leakages <- LeakAddr([1]) :: leakages; + state.[1] <- aux_1; + leakages <- LeakAddr([4]) :: leakages; + aux_1 <- x86_VPERMQ state.[4] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + leakages <- LeakAddr([5]) :: leakages; + t.[5] <- aux_1; + leakages <- LeakAddr([5]) :: leakages; + aux_1 <- x86_VPERMQ state.[5] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + leakages <- LeakAddr([6]) :: leakages; + t.[6] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_left + (W64.of_int ((32 * 1) - 96)))); + 1]) :: leakages; + aux_1 <- x86_VPSLLV_4u64 state.[1] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 1) - 96))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_right + (W64.of_int ((32 * 1) - 96)))); + 1]) :: leakages; + aux_1 <- x86_VPSRLV_4u64 state.[1] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 1) - 96))))); + leakages <- LeakAddr([2]) :: leakages; + t.[2] <- aux_1; + leakages <- LeakAddr([8; 2]) :: leakages; + aux_1 <- (t.[2] `|` t.[8]); + leakages <- LeakAddr([2]) :: leakages; + t.[2] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- x86_VPSRLDQ_256 t.[1] (W8.of_int 8); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([7; 1]) :: leakages; + aux_1 <- ((invw t.[1]) `&` t.[7]); + leakages <- LeakAddr([0]) :: leakages; + t.[0] <- aux_1; + leakages <- LeakAddr([6; 2]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([2; 4]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([4; 3]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([3; 2]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([4; 3]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([5; 8]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[8] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([2; 5]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([6; 7]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[7] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([5; 3]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([6; 8]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[8] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([6; 5]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([4; 7]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[7] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([8; 3]) :: leakages; + aux_1 <- ((invw state.[3]) `&` t.[8]); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([7; 5]) :: leakages; + aux_1 <- ((invw state.[5]) `&` t.[7]); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([2; 5]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([5; 3]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([3; 3]) :: leakages; + aux_1 <- (state.[3] `^` t.[3]); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([3; 6]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([4; 8]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[8] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([5; 5]) :: leakages; + aux_1 <- (state.[5] `^` t.[5]); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([4; 6]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([2; 8]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[8] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([8; 6]) :: leakages; + aux_1 <- ((invw state.[6]) `&` t.[8]); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([6; 6]) :: leakages; + aux_1 <- (state.[6] `^` t.[6]); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- x86_VPERMQ t.[1] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([0; 4]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[4] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + leakages <- LeakAddr([1]) :: leakages; + state.[1] <- aux_1; + leakages <- LeakAddr([0; 1]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[1] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([1]) :: leakages; + state.[1] <- aux_1; + leakages <- LeakAddr([8; 1]) :: leakages; + aux_1 <- ((invw state.[1]) `&` t.[8]); + leakages <- LeakAddr([1]) :: leakages; + state.[1] <- aux_1; + leakages <- LeakAddr([5; 4]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([4; 6]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([6; 2]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([3; 7]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([3; 2]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([5; 7]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[7] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([7; 2]) :: leakages; + aux_1 <- ((invw state.[2]) `&` t.[7]); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([2; 2]) :: leakages; + aux_1 <- (state.[2] `^` t.[2]); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([0]) :: leakages; + aux_1 <- x86_VPERMQ t.[0] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + leakages <- LeakAddr([0]) :: leakages; + t.[0] <- aux_1; + leakages <- LeakAddr([3]) :: leakages; + aux_1 <- x86_VPERMQ state.[3] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([5]) :: leakages; + aux_1 <- x86_VPERMQ state.[5] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([6]) :: leakages; + aux_1 <- x86_VPERMQ state.[6] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([3; 6]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([6; 5]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([5; 4]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([2; 7]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[7] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([2; 4]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([3; 7]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([7; 4]) :: leakages; + aux_1 <- ((invw state.[4]) `&` t.[7]); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([0; 0]) :: leakages; + aux_1 <- (state.[0] `^` t.[0]); + leakages <- LeakAddr([0]) :: leakages; + state.[0] <- aux_1; + leakages <- LeakAddr([1; 1]) :: leakages; + aux_1 <- (state.[1] `^` t.[1]); + leakages <- LeakAddr([1]) :: leakages; + state.[1] <- aux_1; + leakages <- LeakAddr([4; 4]) :: leakages; + aux_1 <- (state.[4] `^` t.[4]); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (iotas + (W64.of_int ((32 * 0) - 0)))); + 0]) :: leakages; + aux_1 <- (state.[0] `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int ((32 * 0) - 0)))))); + leakages <- LeakAddr([0]) :: leakages; + state.[0] <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux <- (iotas + (W64.of_int 32)); + iotas <- aux; + leakages <- LeakAddr([]) :: leakages; + (aux_5, aux_4, aux_3, aux_2, aux_0) <- x86_DEC_32 r; + _0 <- aux_5; + _1 <- aux_4; + _2 <- aux_3; + zf <- aux_2; + r <- aux_0; + leakages <- LeakCond((! zf)) :: LeakAddr([]) :: leakages; + + } + return (state); + } + + proc keccak_init () : W256.t Array7.t = { + var aux_0: int; + var aux: W256.t; + + var state:W256.t Array7.t; + var i:int; + state <- witness; + leakages <- LeakAddr([]) :: leakages; + aux <- x86_VPBROADCAST_4u64 g_zero; + leakages <- LeakAddr([0]) :: leakages; + state.[0] <- aux; + leakages <- LeakFor(1,7) :: LeakAddr([]) :: leakages; + i <- 1; + while (i < 7) { + leakages <- LeakAddr([0]) :: leakages; + aux <- state.[0]; + leakages <- LeakAddr([i]) :: leakages; + state.[i] <- aux; + i <- i + 1; + } + return (state); + } + + proc init_s_state () : W64.t Array28.t = { + var aux_0: int; + var aux: W256.t; + + var s_state:W64.t Array28.t; + var zero:W256.t; + var i:int; + s_state <- witness; + leakages <- LeakAddr([]) :: leakages; + aux <- x86_VPBROADCAST_4u64 g_zero; + zero <- aux; + leakages <- LeakFor(0,7) :: LeakAddr([]) :: leakages; + i <- 0; + while (i < 7) { + leakages <- LeakAddr([]) :: leakages; + aux <- zero; + leakages <- LeakAddr([i]) :: leakages; + s_state = + Array28.init + (WArray224.get64 (WArray224.set256 (WArray224.init64 (fun i => s_state.[i])) i aux)); + i <- i + 1; + } + return (s_state); + } + + proc add_full_block (state:W256.t Array7.t, s_state:W64.t Array28.t, + a_jagged:W64.t, in_0:W64.t, inlen:W64.t, rate:W64.t) : + W256.t Array7.t * W64.t Array28.t * W64.t * W64.t = { + var aux_0: int; + var aux: W64.t; + var aux_1: W256.t; + + var rate8:W64.t; + var j:W64.t; + var t:W64.t; + var l:W64.t; + var i:int; + + leakages <- LeakAddr([]) :: leakages; + aux <- rate; + rate8 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (rate8 `>>` (W8.of_int 3)); + rate8 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (W64.of_int 0); + j <- aux; + + leakages <- LeakCond((j \ult rate8)) :: LeakAddr([]) :: leakages; + + while ((j \ult rate8)) { + leakages <- LeakAddr([(W64.to_uint (in_0 + ((W64.of_int 8) * j)))]) :: leakages; + aux <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * j)))); + t <- aux; + leakages <- LeakAddr([(W64.to_uint (a_jagged + ((W64.of_int 8) * j)))]) :: leakages; + aux <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + l <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- t; + leakages <- LeakAddr([(W64.to_uint l)]) :: leakages; + s_state.[(W64.to_uint l)] <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (j + (W64.of_int 1)); + j <- aux; + leakages <- LeakCond((j \ult rate8)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([0]) :: leakages; + aux <- s_state.[0]; + t <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- t; + leakages <- LeakAddr([1]) :: leakages; + s_state.[1] <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- t; + leakages <- LeakAddr([2]) :: leakages; + s_state.[2] <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- t; + leakages <- LeakAddr([3]) :: leakages; + s_state.[3] <- aux; + leakages <- LeakFor(0,7) :: LeakAddr([]) :: leakages; + i <- 0; + while (i < 7) { + leakages <- LeakAddr([i; i]) :: leakages; + aux_1 <- (state.[i] `^` (get256 + (WArray224.init64 (fun i => s_state.[i])) i)); + leakages <- LeakAddr([i]) :: leakages; + state.[i] <- aux_1; + i <- i + 1; + } + leakages <- LeakAddr([]) :: leakages; + aux <- (in_0 + rate); + in_0 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (inlen - rate); + inlen <- aux; + return (state, s_state, in_0, inlen); + } + + proc add_final_block (state:W256.t Array7.t, s_state:W64.t Array28.t, + a_jagged:W64.t, in_0:W64.t, inlen:W64.t, + trail_byte:W8.t, rate:W64.t) : W256.t Array7.t = { + var aux_2: int; + var aux_1: W8.t; + var aux_0: W64.t; + var aux_3: W256.t; + var aux: W64.t Array28.t; + + var inlen8:W64.t; + var j:W64.t; + var t:W64.t; + var l:W64.t; + var c:W8.t; + var i:int; + + leakages <- LeakAddr([]) :: leakages; + aux <@ init_s_state (); + s_state <- aux; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- inlen; + inlen8 <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (inlen8 `>>` (W8.of_int 3)); + inlen8 <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (W64.of_int 0); + j <- aux_0; + + leakages <- LeakCond((j \ult inlen8)) :: LeakAddr([]) :: leakages; + + while ((j \ult inlen8)) { + leakages <- LeakAddr([(W64.to_uint (in_0 + ((W64.of_int 8) * j)))]) :: leakages; + aux_0 <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * j)))); + t <- aux_0; + leakages <- LeakAddr([(W64.to_uint (a_jagged + ((W64.of_int 8) * j)))]) :: leakages; + aux_0 <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + l <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- t; + leakages <- LeakAddr([(W64.to_uint l)]) :: leakages; + s_state.[(W64.to_uint l)] <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (j + (W64.of_int 1)); + j <- aux_0; + leakages <- LeakCond((j \ult inlen8)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([(W64.to_uint (a_jagged + ((W64.of_int 8) * j)))]) :: leakages; + aux_0 <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + l <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (l `<<` (W8.of_int 3)); + l <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (j `<<` (W8.of_int 3)); + j <- aux_0; + + leakages <- LeakCond((j \ult inlen)) :: LeakAddr([]) :: leakages; + + while ((j \ult inlen)) { + leakages <- LeakAddr([(W64.to_uint (in_0 + j))]) :: leakages; + aux_1 <- (loadW8 Glob.mem (W64.to_uint (in_0 + j))); + c <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- c; + leakages <- LeakAddr([(W64.to_uint l)]) :: leakages; + s_state = + Array28.init + (WArray224.get64 (WArray224.set8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l) aux_1)); + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (j + (W64.of_int 1)); + j <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (l + (W64.of_int 1)); + l <- aux_0; + leakages <- LeakCond((j \ult inlen)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([]) :: leakages; + aux_1 <- trail_byte; + leakages <- LeakAddr([(W64.to_uint l)]) :: leakages; + s_state = + Array28.init + (WArray224.get64 (WArray224.set8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l) aux_1)); + leakages <- LeakAddr([]) :: leakages; + aux_0 <- rate; + j <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (j - (W64.of_int 1)); + j <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (j `>>` (W8.of_int 3)); + j <- aux_0; + leakages <- LeakAddr([(W64.to_uint (a_jagged + ((W64.of_int 8) * j)))]) :: leakages; + aux_0 <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + l <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (l `<<` (W8.of_int 3)); + l <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- rate; + j <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (j - (W64.of_int 1)); + j <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (j `&` (W64.of_int 7)); + j <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (l + j); + l <- aux_0; + leakages <- LeakAddr([(W64.to_uint l)]) :: leakages; + aux_1 <- ((get8 (WArray224.init64 (fun i => s_state.[i])) + (W64.to_uint l)) `^` (W8.of_int 128)); + leakages <- LeakAddr([(W64.to_uint l)]) :: leakages; + s_state = + Array28.init + (WArray224.get64 (WArray224.set8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l) aux_1)); + leakages <- LeakAddr([0]) :: leakages; + aux_0 <- s_state.[0]; + t <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- t; + leakages <- LeakAddr([1]) :: leakages; + s_state.[1] <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- t; + leakages <- LeakAddr([2]) :: leakages; + s_state.[2] <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- t; + leakages <- LeakAddr([3]) :: leakages; + s_state.[3] <- aux_0; + leakages <- LeakFor(0,7) :: LeakAddr([]) :: leakages; + i <- 0; + while (i < 7) { + leakages <- LeakAddr([i; i]) :: leakages; + aux_3 <- (state.[i] `^` (get256 + (WArray224.init64 (fun i => s_state.[i])) i)); + leakages <- LeakAddr([i]) :: leakages; + state.[i] <- aux_3; + i <- i + 1; + } + return (state); + } + + proc xtr_full_block (state:W256.t Array7.t, a_jagged:W64.t, out:W64.t, + len:W64.t) : W64.t = { + var aux: int; + var aux_1: W64.t; + var aux_0: W256.t; + + var i:int; + var s_state:W64.t Array28.t; + var len8:W64.t; + var j:W64.t; + var l:W64.t; + var t:W64.t; + s_state <- witness; + leakages <- LeakFor(0,7) :: LeakAddr([]) :: leakages; + i <- 0; + while (i < 7) { + leakages <- LeakAddr([i]) :: leakages; + aux_0 <- state.[i]; + leakages <- LeakAddr([i]) :: leakages; + s_state = + Array28.init + (WArray224.get64 (WArray224.set256 (WArray224.init64 (fun i => s_state.[i])) i aux_0)); + i <- i + 1; + } + leakages <- LeakAddr([]) :: leakages; + aux_1 <- len; + len8 <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (len8 `>>` (W8.of_int 3)); + len8 <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (W64.of_int 0); + j <- aux_1; + + leakages <- LeakCond((j \ult len8)) :: LeakAddr([]) :: leakages; + + while ((j \ult len8)) { + leakages <- LeakAddr([(W64.to_uint (a_jagged + ((W64.of_int 8) * j)))]) :: leakages; + aux_1 <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + l <- aux_1; + leakages <- LeakAddr([(W64.to_uint l)]) :: leakages; + aux_1 <- s_state.[(W64.to_uint l)]; + t <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- t; + leakages <- LeakAddr([(W64.to_uint (out + ((W64.of_int 8) * j)))]) :: leakages; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * j))) aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (j + (W64.of_int 1)); + j <- aux_1; + leakages <- LeakCond((j \ult len8)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (out + len); + out <- aux_1; + return (out); + } + + proc xtr_bytes (state:W256.t Array7.t, a_jagged:W64.t, out:W64.t, len:W64.t) : + W64.t = { + var aux: int; + var aux_2: W8.t; + var aux_1: W64.t; + var aux_0: W256.t; + + var i:int; + var s_state:W64.t Array28.t; + var len8:W64.t; + var j:W64.t; + var l:W64.t; + var t:W64.t; + var c:W8.t; + s_state <- witness; + leakages <- LeakFor(0,7) :: LeakAddr([]) :: leakages; + i <- 0; + while (i < 7) { + leakages <- LeakAddr([i]) :: leakages; + aux_0 <- state.[i]; + leakages <- LeakAddr([i]) :: leakages; + s_state = + Array28.init + (WArray224.get64 (WArray224.set256 (WArray224.init64 (fun i => s_state.[i])) i aux_0)); + i <- i + 1; + } + leakages <- LeakAddr([]) :: leakages; + aux_1 <- len; + len8 <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (len8 `>>` (W8.of_int 3)); + len8 <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (W64.of_int 0); + j <- aux_1; + + leakages <- LeakCond((j \ult len8)) :: LeakAddr([]) :: leakages; + + while ((j \ult len8)) { + leakages <- LeakAddr([(W64.to_uint (a_jagged + ((W64.of_int 8) * j)))]) :: leakages; + aux_1 <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + l <- aux_1; + leakages <- LeakAddr([(W64.to_uint l)]) :: leakages; + aux_1 <- s_state.[(W64.to_uint l)]; + t <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- t; + leakages <- LeakAddr([(W64.to_uint (out + ((W64.of_int 8) * j)))]) :: leakages; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * j))) aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (j + (W64.of_int 1)); + j <- aux_1; + leakages <- LeakCond((j \ult len8)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([(W64.to_uint (a_jagged + ((W64.of_int 8) * j)))]) :: leakages; + aux_1 <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + l <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (j `<<` (W8.of_int 3)); + j <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (l `<<` (W8.of_int 3)); + l <- aux_1; + + leakages <- LeakCond((j \ult len)) :: LeakAddr([]) :: leakages; + + while ((j \ult len)) { + leakages <- LeakAddr([(W64.to_uint l)]) :: leakages; + aux_2 <- (get8 (WArray224.init64 (fun i => s_state.[i])) + (W64.to_uint l)); + c <- aux_2; + leakages <- LeakAddr([]) :: leakages; + aux_2 <- c; + leakages <- LeakAddr([(W64.to_uint (out + j))]) :: leakages; + Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + j)) aux_2; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (j + (W64.of_int 1)); + j <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (l + (W64.of_int 1)); + l <- aux_1; + leakages <- LeakCond((j \ult len)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (out + len); + out <- aux_1; + return (out); + } + + proc absorb (state:W256.t Array7.t, rhotates_left:W64.t, + rhotates_right:W64.t, iotas:W64.t, a_jagged:W64.t, in_0:W64.t, + inlen:W64.t, trail_byte:W8.t, rate:W64.t) : W256.t Array7.t = { + var aux_2: W64.t; + var aux_1: W64.t; + var aux: W64.t Array28.t; + var aux_0: W256.t Array7.t; + + var s_state:W64.t Array28.t; + s_state <- witness; + leakages <- LeakAddr([]) :: leakages; + aux <@ init_s_state (); + s_state <- aux; + + leakages <- LeakCond((rate \ule inlen)) :: LeakAddr([]) :: leakages; + + while ((rate \ule inlen)) { + leakages <- LeakAddr([]) :: leakages; + (aux_0, aux, aux_2, aux_1) <@ add_full_block (state, s_state, a_jagged, + in_0, inlen, rate); + state <- aux_0; + s_state <- aux; + in_0 <- aux_2; + inlen <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_0 <@ __keccak_f1600_avx2 (state, rhotates_left, rhotates_right, + iotas); + state <- aux_0; + leakages <- LeakCond((rate \ule inlen)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([]) :: leakages; + aux_0 <@ add_final_block (state, s_state, a_jagged, in_0, inlen, + trail_byte, rate); + state <- aux_0; + return (state); + } + + proc squeeze (state:W256.t Array7.t, rhotates_left:W64.t, + rhotates_right:W64.t, iotas:W64.t, a_jagged:W64.t, out:W64.t, + outlen:W64.t, rate:W64.t) : unit = { + var aux_0: W64.t; + var aux: W256.t Array7.t; + + + + + leakages <- LeakCond((rate \ult outlen)) :: LeakAddr([]) :: leakages; + + while ((rate \ult outlen)) { + leakages <- LeakAddr([]) :: leakages; + aux <@ __keccak_f1600_avx2 (state, rhotates_left, rhotates_right, + iotas); + state <- aux; + leakages <- LeakAddr([]) :: leakages; + aux_0 <@ xtr_full_block (state, a_jagged, out, rate); + out <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (outlen - rate); + outlen <- aux_0; + leakages <- LeakCond((rate \ult outlen)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([]) :: leakages; + aux <@ __keccak_f1600_avx2 (state, rhotates_left, rhotates_right, iotas); + state <- aux; + leakages <- LeakAddr([]) :: leakages; + aux_0 <@ xtr_bytes (state, a_jagged, out, outlen); + out <- aux_0; + return (); + } + + proc __keccak_1600 (out:W64.t, outlen:W64.t, rhotates_left:W64.t, + rhotates_right:W64.t, iotas:W64.t, a_jagged:W64.t, + in_0:W64.t, inlen:W64.t, trail_byte:W8.t, rate:W64.t) : unit = { + var aux: W256.t Array7.t; + + var state:W256.t Array7.t; + state <- witness; + leakages <- LeakAddr([]) :: leakages; + aux <@ keccak_init (); + state <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <@ absorb (state, rhotates_left, rhotates_right, iotas, a_jagged, + in_0, inlen, trail_byte, rate); + state <- aux; + leakages <- LeakAddr([]) :: leakages; + squeeze (state, rhotates_left, rhotates_right, iotas, a_jagged, out, + outlen, rate); + return (); + } +}. + +op eq_reg (mem1 mem2 : global_mem_t, ptr len : int) = + forall i, ptr <= i <= ptr + len - 8 => + loadW64 mem1 i = loadW64 mem2 i. + +op disj_reg(ptr1 len1 ptr2 len2 : W64.t) = + (to_uint (ptr1 + len1) < to_uint ptr2 \/ to_uint (ptr2 + len2) < to_uint ptr1). + +lemma mem_sep (mem : global_mem_t) (ptr1 o1 x : W64.t) (ptr2 : int): + 0 <= ptr2 < W64.modulus - 8 /\ + to_uint ptr1 + to_uint o1 + 8 < W64.modulus /\ + disj_reg (ptr1 + o1) (W64.of_int 8) (W64.of_int ptr2) (W64.of_int 8) => + loadW64 (storeW64 mem (to_uint (ptr1 + o1)) x) ptr2 = + loadW64 mem ptr2. +progress. +rewrite storeW64E. +rewrite /loadW64. +congr. +apply W8u8.Pack.init_ext. +move => x0 hxc0. +beta. +rewrite (get_storesE mem (to_uint (ptr1 + o1)) (((to_list x))%W8u8) (ptr2 + x0)). +rewrite (_: to_uint (ptr1 + o1) <= ptr2 + x0 < + to_uint (ptr1 + o1) + size ((to_list x))%W8u8 = false) => //=. +have bound : ( ptr2 + x0 < to_uint (ptr1 + o1) \/ to_uint (ptr1 + o1) + 8 <=ptr2 + x0); last by smt(). +elim H2. +rewrite !to_uintD_small. smt(@W64). smt(@W64). smt(@W64). +rewrite !of_uintK => />. +smt(@W64). +rewrite !to_uintD_small. smt(@W64). smt(@W64). +progress. +move : H2. rewrite !of_uintK => />. +smt(@W64). +qed. + +equiv ct : + M.__keccak_1600 ~ M.__keccak_1600 : + ={M.leakages,out,outlen,rhotates_left,rhotates_right,iotas,a_jagged,in_0,inlen,rate} /\ + to_uint out{2} + to_uint (outlen{2} + W64.of_int 8) < W64.modulus /\ + to_uint a_jagged{2} + 224 < W64.modulus /\ 0 < to_uint rate{2} < 200 /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_jagged{1}) 224 /\ + disj_reg out{1} (outlen{1} + W64.of_int 8) a_jagged{1} (W64.of_int 224) /\ + disj_reg out{2} (outlen{2} + W64.of_int 8) a_jagged{2} (W64.of_int 224) /\ + to_uint outlen{2} + 8 < W64.modulus ==> ={M.leakages}. +proc. +call (_: ={rhotates_left,rhotates_right,iotas,a_jagged,out,outlen,rate,M.leakages} /\ to_uint rate{2} < 200 /\ + to_uint out{2} + to_uint (outlen{2} + W64.of_int 8) < W64.modulus /\ + to_uint a_jagged{2} + 224 < W64.modulus /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_jagged{1}) 224 /\ + disj_reg out{1} (outlen{1} + W64.of_int 8) a_jagged{1} (W64.of_int 224) /\ + disj_reg out{2} (outlen{2} + W64.of_int 8) a_jagged{2} (W64.of_int 224) /\ + to_uint outlen{2} + 8 < W64.modulus ==> ={M.leakages}). +proc. +wp; call(_: ={a_jagged,out,len,M.leakages} /\ + to_uint len{2} <= 200 /\ + to_uint out{2} + to_uint (len{2} + W64.of_int 8) < W64.modulus /\ + to_uint a_jagged{2} + 224 < W64.modulus /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_jagged{1}) 224 /\ + disj_reg out{1} (len{1} + W64.of_int 8) a_jagged{1} (W64.of_int 224) /\ + disj_reg out{2} (len{2} + W64.of_int 8) a_jagged{2} (W64.of_int 224) ==> ={M.leakages}). +proc. +wp; while (={j,len,M.leakages,out,l}). +by auto => />. +wp; while (={j,M.leakages,out,a_jagged,len8,len} /\ + to_uint len8{2} <= 25 /\ to_uint j{2} <= to_uint len8{2} /\ + to_uint out{2} + to_uint (len{2} + W64.of_int 8) < W64.modulus /\ + to_uint a_jagged{2} + 224 < W64.modulus /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_jagged{1}) 224 /\ + disj_reg out{1} (len{1} + W64.of_int 8) a_jagged{1} (W64.of_int 224) /\ + disj_reg out{2} (len{2} + W64.of_int 8) a_jagged{2} (W64.of_int 224) /\ + 0 <= to_uint len8{2} < 26 /\ to_uint len8{1} = to_uint len{1} %/ 8). +auto => />. +rewrite /eq_reg /disj_reg. +progress. +congr. +move : H8; rewrite ultE => *. +by apply H3;rewrite to_uintD_small;by smt(@W64). +by smt(@W64). +rewrite (mem_sep Glob.mem{1} out{2} + (((of_int 8)%W64 * j{2})) + (s_state{1}.[to_uint + (loadW64 Glob.mem{1} + (to_uint (a_jagged{2} + (of_int 8)%W64 * j{2})))])). +split. +smt(@W64). +split. +smt(@W64). +rewrite /disj_reg. +elim H4. +rewrite !to_uintD_small => />. smt(@W64). smt(@W64). smt(@W64). smt(@W64). smt(@W64). smt(@W64). smt(@W64). +move => H4. +left. +rewrite !to_uintM_small. smt(@W64). +rewrite of_uintK => />. +move : H8; rewrite ultE. +rewrite H7. +move => *. +have hh : (8 * to_uint j{2} < to_uint len{2}). +smt(@W64). +rewrite of_uintK => //=. +rewrite (_: i0 %% 18446744073709551616 = i0). +smt(@W64). +smt(@W64). + +rewrite !to_uintD_small. +smt(@W64). +smt(@W64). +smt(@W64). +smt(@W64). +smt(@W64). +smt(@W64). + +rewrite (mem_sep Glob.mem{2} out{2} + (((of_int 8)%W64 * j{2})) + (s_state{2}.[to_uint + (loadW64 Glob.mem{2} + (to_uint (a_jagged{2} + (of_int 8)%W64 * j{2})))])). +split. +smt(@W64). +split. +smt(@W64). +rewrite /disj_reg. +elim H4. +rewrite !to_uintD_small => />. smt(@W64). smt(@W64). smt(@W64). smt(@W64). smt(@W64). smt(@W64). smt(@W64). +move => H4. +left. +rewrite !to_uintM_small. smt(@W64). +rewrite of_uintK => />. +move : H8; rewrite ultE. +rewrite H7. +move => *. +have hh : (8 * to_uint j{2} < to_uint len{2}). +smt(@W64). +rewrite of_uintK => //=. +rewrite (_: i0 %% 18446744073709551616 = i0). +smt(@W64). +smt(@W64). + +rewrite !to_uintD_small. +smt(@W64). +smt(@W64). +smt(@W64). +smt(@W64). +smt(@W64). +smt(@W64). + +apply H3. smt(@W64). +unroll for {1} 4. +unroll for {2} 4. +auto => />. +progress. +rewrite shr_div => />. +by smt(). +rewrite shr_div => />. +by smt(@W64). +rewrite shr_div => />. +by smt(@W64). +rewrite shr_div => />. +by smt(@W64). +by rewrite shr_div => />. + +move : H8; rewrite /eq_reg => *. +rewrite H8 =>//=. +by rewrite to_uintD_small; by smt(@W64). +wp;call(_: ={M.leakages,_rhotates_left,_rhotates_right,_iotas} ==> ={M.leakages}). +proc. +by sim. + +wp;while(={M.leakages,rate,outlen,rhotates_left,rhotates_right,iotas,a_jagged,out} /\ + to_uint rate{2} < 200 /\ + to_uint out{2} + to_uint (outlen{2} + W64.of_int 8) < W64.modulus /\ + to_uint a_jagged{2} + 224 < W64.modulus /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_jagged{1}) 224 /\ + disj_reg out{1} (outlen{1} + W64.of_int 8) a_jagged{1} (W64.of_int 224) /\ + disj_reg out{2} (outlen{2} + W64.of_int 8) a_jagged{2} (W64.of_int 224) /\ + to_uint outlen{2} + 8 < W64.modulus). + +(* bug report, cannot use a_jagged for elim symbol *) +exists* a_jagged{1}, outlen{1}, rate{1}, out{1}. +elim* => a_j ol rt ot. +wp; call(_: ={a_jagged,out,len,M.leakages} /\ + to_uint len{2} < 200 /\ a_jagged{1} = a_j /\ len{1} = rt /\ out{1} = ot /\ + to_uint out{2} + to_uint (len{2} + W64.of_int 8) < W64.modulus /\ + to_uint a_jagged{2} + 224 < W64.modulus /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_jagged{1}) 224 /\ + disj_reg out{1} (ol{1} + W64.of_int 8) a_jagged{1} (W64.of_int 224) /\ + disj_reg out{2} (ol{2} + W64.of_int 8) a_jagged{2} (W64.of_int 224) /\ len{1} \ult ol /\ + to_uint out{2} + (to_uint ol + 8) < W64.modulus + ==> ={M.leakages,res} /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_j) 224 /\ + res{1} = ot + rt). +proc. +wp; while (={j,M.leakages,out,a_jagged,len8,len} /\ out{1} = ot /\ + a_jagged{1} = a_j /\ to_uint len8{1} = to_uint rt %/ 8 /\ + to_uint len8{2} < 25 /\ to_uint j{2} <= to_uint len8{2} /\ + to_uint out{2} + to_uint (len{2} + W64.of_int 8)< W64.modulus /\ + to_uint a_jagged{2} + 224 < W64.modulus /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_jagged{1}) 224 /\ + disj_reg out{1} (ol{1} + W64.of_int 8) a_jagged{1} (W64.of_int 224) /\ + disj_reg out{2} (ol{2} + W64.of_int 8) a_jagged{2} (W64.of_int 224) /\ + 0 <= to_uint len8{2} < 26 /\ to_uint len8{1} = to_uint len{1} %/ 8 + /\ len{1} \ult ol /\ to_uint out{2} + (to_uint ol + 8) < W64.modulus). +auto => />. +rewrite /eq_reg /disj_reg. +progress. +congr. +move : H9; rewrite ultE => *. +by apply H4;rewrite to_uintD_small; smt(@W64). +by smt(@W64). +rewrite (mem_sep Glob.mem{1} out{2} + (((of_int 8)%W64 * j{2})) + (s_state{1}.[to_uint + (loadW64 Glob.mem{1} + (to_uint (a_jagged{2} + (of_int 8)%W64 * j{2})))])). +split. +smt(@W64). +split. +smt(@W64). +rewrite /disj_reg. +elim H5. +rewrite !to_uintD_small => />. smt(@W64). smt(@W64). smt(@W64). smt(@W64). smt(@W64). smt(@W64). +move => H5. +left. +rewrite !to_uintM_small. smt(@W64). +rewrite of_uintK => />. +move : H11; rewrite ultE. +rewrite H8. +move => *. +have hh : (8 * to_uint j{2} < to_uint len{2}). +smt(@W64). +rewrite of_uintK => //=. +rewrite (_: i0 %% 18446744073709551616 = i0). +smt(@W64). +smt(@W64). + +rewrite !to_uintD_small. +smt(@W64). +smt(@W64). +smt(@W64). +smt(@W64). +smt(@W64). +smt(@W64). + + +rewrite (mem_sep Glob.mem{2} out{2} + (((of_int 8)%W64 * j{2})) + (s_state{2}.[to_uint + (loadW64 Glob.mem{2} + (to_uint (a_jagged{2} + (of_int 8)%W64 * j{2})))])). +split. +smt(@W64). +split. +smt(@W64). +rewrite /disj_reg. +elim H5. +rewrite !to_uintD_small => />. smt(@W64). smt(@W64). smt(@W64). smt(@W64). smt(@W64). smt(@W64). +move => H5. +left. +rewrite !to_uintM_small. smt(@W64). +rewrite of_uintK => />. +move : H11; rewrite ultE. +rewrite H8. +move => *. +have hh : (8 * to_uint j{2} < to_uint len{2}). +smt(@W64). +rewrite of_uintK => //=. +rewrite (_: i0 %% 18446744073709551616 = i0). +smt(@W64). +smt(@W64). + +rewrite !to_uintD_small. +smt(@W64). +smt(@W64). +smt(@W64). +smt(@W64). +smt(@W64). +smt(@W64). + +apply H4. smt(@W64). +unroll for {1} 4. +unroll for {2} 4. +auto => />. +progress. +by rewrite shr_div => />. +rewrite shr_div => />. +by smt(@W64). +rewrite shr_div => />. +by smt(@W64). +rewrite shr_div => />. +by smt(@W64). +rewrite shr_div => />. +by smt(@W64). +by rewrite shr_div => />. + +wp;call(_: ={M.leakages,_rhotates_left,_rhotates_right,_iotas} ==> ={M.leakages}). +proc. +by sim. + +auto => />. +progress. +move : H5; rewrite ultE => *. +move : H0. +rewrite !to_uintD_small => />. smt(@W64). smt(@W64). +move : H5; rewrite ultE => *. +move : H0. +rewrite !to_uintD_small => />. smt(@W64). + +move : H3; rewrite /disj_reg => *. +elim H3. +move => *. +left. +rewrite (_: (out{2} + rate{2} + (outlen{2} - rate{2} + (of_int 8)%W64)) = + (out{2} + outlen{2} + (of_int 8)%W64)). by ring. +smt(@W64). +move => *. +right. +rewrite (_: to_uint (out{2} + rate{2}) = to_uint out{2} + to_uint rate{2}). +rewrite to_uintD_small. smt(@W64). +smt(@W64). +smt(@W64). + +move : H3; rewrite /disj_reg => *. +elim H3. +move => *. +left. +rewrite (_: (out{2} + rate{2} + (outlen{2} - rate{2} + (of_int 8)%W64)) = + (out{2} + outlen{2} + (of_int 8)%W64)). by ring. +smt(@W64). +move => *. +right. +rewrite (_: to_uint (out{2} + rate{2}) = to_uint out{2} + to_uint rate{2}). +rewrite to_uintD_small. smt(@W64). +smt(@W64). +smt(@W64). +smt(@W64). + +auto => />. +progress. +smt(@W64). + +wp;call(_: ={rhotates_left, rhotates_right,iotas,a_jagged, in_0, inlen,rate,M.leakages} /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_jagged{1}) 224 /\ + to_uint a_jagged{2} + 224 < W64.modulus /\ 0 < to_uint rate{2} < 200 + ==> + ={M.leakages}). +proc. +wp; call(_: ={a_jagged,in_0,inlen,rate,M.leakages} /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_jagged{1}) 224 /\ + to_uint a_jagged{2} + 224 < W64.modulus /\ 0 < to_uint rate{2} < 200 /\ + to_uint inlen{2} < to_uint rate{2} + ==> ={M.leakages}). +proc. +while(={i,M.leakages}). +by auto => />. +wp;while(={j,in_0,inlen,M.leakages,l}). +by auto => />. + +wp;while(={j,in_0,inlen8,M.leakages,a_jagged} /\ + to_uint inlen8{2} <= 25 /\ to_uint j{2} <= to_uint inlen8{2} /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_jagged{1}) 224 /\ + to_uint a_jagged{2} + 224 < W64.modulus /\ to_uint rate{2} < 200). + auto => />. +rewrite /eq_reg /disj_reg. +progress. +congr. +move : H4; rewrite ultE => *. +by apply H1;rewrite to_uintD_small;by smt(@W64). +by smt(@W64). + +auto => />. +progress. +congr. +move : (H11); rewrite /eq_reg => *. +rewrite H14 => //=. +rewrite to_uintD_small. smt(@W64). smt(@W64). +move : (H11); rewrite /eq_reg => * //=. +congr. +congr. +congr. +rewrite H16 => //=. + +split; last first. +have hh : (to_uint ((of_int 8)%W64 * (rate{2} - W64.one `>>` (of_int 3)%W8)) < 216). +rewrite to_uintM_small. + +have hh: (to_uint (rate{2} - W64.one `>>` (of_int 3)%W8) < 200). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). + +rewrite to_uintD_small. +have hh : (to_uint ((of_int 8)%W64 * (rate{2} - W64.one `>>` (of_int 3)%W8)) < 216). +rewrite to_uintM_small. + +have hh: (to_uint (rate{2} - W64.one `>>` (of_int 3)%W8) < 200). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). +by smt(@W64). + +move : (H11); rewrite /eq_reg => * //=. +congr. +congr. +congr. +rewrite H16 => //=. + +split; last first. +have hh : (to_uint ((of_int 8)%W64 * (rate{2} - W64.one `>>` (of_int 3)%W8)) < 216). +rewrite to_uintM_small. + +have hh: (to_uint (rate{2} - W64.one `>>` (of_int 3)%W8) < 200). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). + +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). + +rewrite to_uintD_small. +have hh : (to_uint ((of_int 8)%W64 * (rate{2} - W64.one `>>` (of_int 3)%W8)) < 216). +rewrite to_uintM_small. + +have hh: (to_uint (rate{2} - W64.one `>>` (of_int 3)%W8) < 200). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). +by smt(@W64). + +inline *. +unroll for {1} 8. +unroll for {2} 8. + +auto => />. +progress. +rewrite shr_div => />. +smt(@W64). +rewrite shr_div => />. +smt(@W64). + +move : (H); rewrite /eq_reg => * //=. +congr. +rewrite H7 => //=. + +rewrite to_uintD_small. +by smt(@W64). +by smt(@W64). + +congr. +move : (H); rewrite /eq_reg => * //=. +congr. +rewrite H8 => //=. + +split. +rewrite to_uintD_small. +have hh : (to_uint ((of_int 8)%W64 * (rate{2} - W64.one `>>` (of_int 3)%W8)) < 224). +rewrite to_uintM_small. + +have hh: (to_uint (rate{2} - W64.one `>>` (of_int 3)%W8) < 200). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). +by smt(@W64). + + +progress. + +have hh : (to_uint ((of_int 8)%W64 * (rate{2} - W64.one `>>` (of_int 3)%W8)) < 216). +rewrite to_uintM_small. + +have hh: (to_uint (rate{2} - W64.one `>>` (of_int 3)%W8) < 200). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). + +congr. +move : (H); rewrite /eq_reg => * //=. +congr. +rewrite H8 => //=. + +split. +rewrite to_uintD_small. +have hh : (to_uint ((of_int 8)%W64 * (rate{2} - W64.one `>>` (of_int 3)%W8)) < 216). +rewrite to_uintM_small. + +have hh: (to_uint (rate{2} - W64.one `>>` (of_int 3)%W8) < 200). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). +by smt(@W64). + + +progress. + +have hh : (to_uint ((of_int 8)%W64 * (rate{2} - W64.one `>>` (of_int 3)%W8)) < 216). +rewrite to_uintM_small. + +have hh: (to_uint (rate{2} - W64.one `>>` (of_int 3)%W8) < 200). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). + +wp; while (={M.leakages,rate,inlen,a_jagged,in_0,rhotates_left,rhotates_right,iotas} /\ + to_uint a_jagged{2} + 224 < W64.modulus /\ 0 < to_uint rate{2} < 200 /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_jagged{1}) 224). +wp;call(_: ={M.leakages,_rhotates_left,_rhotates_right,_iotas} ==> ={M.leakages}). +proc. +by sim. +exists* rate{2}, inlen{2}. +elim* => rt il. +wp;call(_: ={M.leakages,rate,inlen,a_jagged,in_0} /\ + rate{2} = rt /\ inlen{2} = il /\ + to_uint a_jagged{2} + 224 < W64.modulus /\ 0 < to_uint rate{2} < 200 /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_jagged{1}) 224 ==> + res{1}.`3 = res{2}.`3 /\ res{1}.`4 = res{2}.`4 /\ ={M.leakages} /\ + res{1}.`4 = il - rt). +proc. +wp; while (={M.leakages,i}). +by auto => />. +wp; while (={j,rate8,M.leakages,a_jagged,in_0} /\ to_uint rate8{2} < 25 /\ + to_uint a_jagged{2} + 224 < W64.modulus /\ 0 < to_uint rate{2} < 200 /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_jagged{1}) 224). +auto => />. +progress. +congr. +move : H3;rewrite /eq_reg => H3. +rewrite H3. +rewrite to_uintD_small => />. +smt(@W64). +smt(@W64). +rewrite to_uintD_small => />. +smt(@W64). + +auto => />. +progress. +rewrite shr_div => />. +smt(@W64). + +auto => />. +progress. +rewrite !uleE. +smt(@W64). +rewrite !uleE. +smt(@W64). +rewrite !uleE. +smt(@W64). + +inline *. +unroll for {1} 9. +unroll for {2} 9. +auto => />. +progress. +move : H3; rewrite uleE; smt(@W64). + +inline *. +unroll for {1} 10. +unroll for {2} 10. +by auto => />. +qed. diff --git a/sha3/proof/impl/libc/keccak_1600_avx2_modular.ec b/sha3/proof/impl/libc/keccak_1600_avx2_modular.ec new file mode 100644 index 0000000..ba4ce2d --- /dev/null +++ b/sha3/proof/impl/libc/keccak_1600_avx2_modular.ec @@ -0,0 +1,1383 @@ +require import AllCore List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array4 Array7 Array9 Array25 Array28. +require import WArray224 WArray288. + +abbrev g_zero = W64.of_int 0. + +require import Keccak_f1600_avx2_prevec. + +require import Keccak_f1600_avx2. + +module Mmod = { + include Keccak_f1600_avx2.M + + proc keccak_init () : W256.t Array7.t = { + var aux: int; + + var state:W256.t Array7.t; + var i:int; + state <- witness; + state.[0] <- x86_VPBROADCAST_4u64 g_zero; + i <- 1; + while (i < 7) { + state.[i] <- state.[0]; + i <- i + 1; + } + return (state); + } + + proc init_s_state () : W64.t Array28.t = { + var aux: int; + + var s_state:W64.t Array28.t; + var zero:W256.t; + var i:int; + s_state <- witness; + zero <- x86_VPBROADCAST_4u64 g_zero; + i <- 0; + while (i < 7) { + s_state = + Array28.init + (WArray224.get64 (WArray224.set256 (WArray224.init64 (fun i => s_state.[i])) i zero)); + i <- i + 1; + } + return (s_state); + } + + proc add_full_block (state:W256.t Array7.t, s_state:W64.t Array28.t, + a_jagged:W64.t, in_0:W64.t, inlen:W64.t, rate:W64.t) : + W256.t Array7.t * W64.t Array28.t * W64.t * W64.t = { + var aux: int; + + var rate8:W64.t; + var j:W64.t; + var t:W64.t; + var l:W64.t; + var i:int; + + rate8 <- rate; + rate8 <- (rate8 `>>` (W8.of_int 3)); + j <- (W64.of_int 0); + + while ((j \ult rate8)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * j)))); + l <- + (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + s_state.[(W64.to_uint l)] <- t; + j <- (j + (W64.of_int 1)); + } + t <- s_state.[0]; + s_state.[1] <- t; + s_state.[2] <- t; + s_state.[3] <- t; + i <- 0; + while (i < 7) { + state.[i] <- + (state.[i] `^` (get256 (WArray224.init64 (fun i => s_state.[i])) i)); + i <- i + 1; + } + in_0 <- (in_0 + rate); + inlen <- (inlen - rate); + return (state, s_state, in_0, inlen); + } + + proc add_final_block (state:W256.t Array7.t, s_state:W64.t Array28.t, + a_jagged:W64.t, in_0:W64.t, inlen:W64.t, + trail_byte:W8.t, rate:W64.t) : W256.t Array7.t = { + var aux: int; + + var inlen8:W64.t; + var j:W64.t; + var t:W64.t; + var l:W64.t; + var c:W8.t; + var i:int; + + s_state <@ init_s_state (); + inlen8 <- inlen; + inlen8 <- (inlen8 `>>` (W8.of_int 3)); + j <- (W64.of_int 0); + + while ((j \ult inlen8)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * j)))); + l <- + (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + s_state.[(W64.to_uint l)] <- t; + j <- (j + (W64.of_int 1)); + } + l <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + l <- (l `<<` (W8.of_int 3)); + j <- (j `<<` (W8.of_int 3)); + + while ((j \ult inlen)) { + c <- (loadW8 Glob.mem (W64.to_uint (in_0 + j))); + s_state = + Array28.init + (WArray224.get64 (WArray224.set8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l) c)); + j <- (j + (W64.of_int 1)); + l <- (l + (W64.of_int 1)); + } + s_state = + Array28.init + (WArray224.get64 (WArray224.set8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l) trail_byte)); + j <- rate; + j <- (j - (W64.of_int 1)); + j <- (j `>>` (W8.of_int 3)); + l <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + l <- (l `<<` (W8.of_int 3)); + j <- rate; + j <- (j - (W64.of_int 1)); + j <- (j `&` (W64.of_int 7)); + l <- (l + j); + s_state = + Array28.init + (WArray224.get64 (WArray224.set8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l) ( + (get8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l)) `^` (W8.of_int 128)))); + t <- s_state.[0]; + s_state.[1] <- t; + s_state.[2] <- t; + s_state.[3] <- t; + i <- 0; + while (i < 7) { + state.[i] <- + (state.[i] `^` (get256 (WArray224.init64 (fun i => s_state.[i])) i)); + i <- i + 1; + } + return (state); + } + + proc xtr_full_block (state:W256.t Array7.t, a_jagged:W64.t, out:W64.t, + len:W64.t) : W64.t = { + var aux: int; + + var i:int; + var s_state:W64.t Array28.t; + var len8:W64.t; + var j:W64.t; + var l:W64.t; + var t:W64.t; + s_state <- witness; + i <- 0; + while (i < 7) { + s_state = + Array28.init + (WArray224.get64 (WArray224.set256 (WArray224.init64 (fun i => s_state.[i])) i + state.[i])); + i <- i + 1; + } + len8 <- len; + len8 <- (len8 `>>` (W8.of_int 3)); + j <- (W64.of_int 0); + + while ((j \ult len8)) { + l <- + (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + t <- s_state.[(W64.to_uint l)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * j))) t; + j <- (j + (W64.of_int 1)); + } + out <- (out + len); + return (out); + } + + proc xtr_bytes (state:W256.t Array7.t, a_jagged:W64.t, out:W64.t, len:W64.t) : + W64.t = { + var aux: int; + + var i:int; + var s_state:W64.t Array28.t; + var len8:W64.t; + var j:W64.t; + var l:W64.t; + var t:W64.t; + var c:W8.t; + s_state <- witness; + i <- 0; + while (i < 7) { + s_state = + Array28.init + (WArray224.get64 (WArray224.set256 (WArray224.init64 (fun i => s_state.[i])) i + state.[i])); + i <- i + 1; + } + len8 <- len; + len8 <- (len8 `>>` (W8.of_int 3)); + j <- (W64.of_int 0); + + while ((j \ult len8)) { + l <- + (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + t <- s_state.[(W64.to_uint l)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * j))) t; + j <- (j + (W64.of_int 1)); + } + l <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + j <- (j `<<` (W8.of_int 3)); + l <- (l `<<` (W8.of_int 3)); + + while ((j \ult len)) { + c <- (get8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l)); + Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + j)) c; + j <- (j + (W64.of_int 1)); + l <- (l + (W64.of_int 1)); + } + out <- (out + len); + return (out); + } + + proc absorb (state:W256.t Array7.t, rhotates_left:W64.t, + rhotates_right:W64.t, iotas:W64.t, a_jagged:W64.t, in_0:W64.t, + inlen:W64.t, trail_byte:W8.t, rate:W64.t) : W256.t Array7.t = { + + var s_state:W64.t Array28.t; + s_state <- witness; + s_state <@ init_s_state (); + + while ((rate \ule inlen)) { + (state, s_state, in_0, inlen) <@ add_full_block (state, s_state, + a_jagged, in_0, inlen, rate); + state <@ __keccak_f1600_avx2 (state, rhotates_left, rhotates_right, + iotas); + } + state <@ add_final_block (state, s_state, a_jagged, in_0, inlen, + trail_byte, rate); + return (state); + } + + proc squeeze (state:W256.t Array7.t, rhotates_left:W64.t, + rhotates_right:W64.t, iotas:W64.t, a_jagged:W64.t, out:W64.t, + outlen:W64.t, rate:W64.t) : unit = { + + + + + while ((rate \ult outlen)) { + state <@ __keccak_f1600_avx2 (state, rhotates_left, rhotates_right, + iotas); + out <@ xtr_full_block (state, a_jagged, out, rate); + outlen <- (outlen - rate); + } + state <@ __keccak_f1600_avx2 (state, rhotates_left, rhotates_right, + iotas); + out <@ xtr_bytes (state, a_jagged, out, outlen); + return (); + } + + proc __keccak_1600 (out:W64.t, outlen:W64.t, rhotates_left:W64.t, + rhotates_right:W64.t, iotas:W64.t, a_jagged:W64.t, + in_0:W64.t, inlen:W64.t, trail_byte:W8.t, rate:W64.t) : unit = { + + var state:W256.t Array7.t; + state <- witness; + state <@ keccak_init (); + state <@ absorb (state, rhotates_left, rhotates_right, iotas, a_jagged, + in_0, inlen, trail_byte, rate); + squeeze (state, rhotates_left, rhotates_right, iotas, a_jagged, out, + outlen, rate); + return (); + } +}. + +require import Keccak_1600_avx2. + +equiv modfgood : + Mmod.__keccak_f1600_avx2 ~ M.__keccak_f1600_avx2: + ={Glob.mem,arg} ==> ={Glob.mem,res}. +proof. by sim. qed. + +equiv modgood : + Mmod.__keccak_1600 ~ M.__keccak_1600 : + ={Glob.mem,arg} ==> ={Glob.mem,res}. +proof. by sim. qed. + +require Keccak_1600_ref_modular. + +lemma set_get_def (v : W64.t Array28.t) (w : W256.t) i j : + 0 <= i < 7 => 0 <= j < 28 => + WArray224.get64 + (WArray224.set256 (WArray224.init64 ("_.[_]" v)) i w) j = + if 4 * i <= j < 4 * i + 4 then w \bits64 (j %% 4) + else v.[j]. +proof. + move=> hx hs; rewrite set256E !get64E. + rewrite -(W8u8.unpack8K (if 4 * i <= j < 4 * i + 4 then w \bits64 j %% 4 else v.[j]));congr. + apply W8u8.Pack.ext_eq => k hk. + rewrite W8u8.get_unpack8 //= W8u8.Pack.initiE //= initiE 1:/# /=. + have -> : (32 * i <= 8 * j + k < 32 * (i + 1)) = (4 * i <= j < 4 * i + 4) by smt(). + case : (4 * i <= j < 4 * i + 4) => h. + + by rewrite W256_bits64_bits8 1:// /#. + by rewrite /init64 initiE /#. +qed. + +lemma set_get_eq (v : W64.t Array28.t) (w : W256.t) i j : + 0 <= i < 7 => 0 <= j < 28 => 4 * i <= j < 4 * i + 4 => + WArray224.get64 + (WArray224.set256 (WArray224.init64 ("_.[_]" v)) i w) j = w \bits64 (j %% 4). +proof. by move=> h1 h2 h3; rewrite set_get_def // h3. qed. + +lemma set_get_diff (v : W64.t Array28.t) (w : W256.t) i j : + 0 <= i < 7 => 0 <= j < 28 => !(4 * i <= j < 4 * i + 4 ) => + WArray224.get64 + (WArray224.set256 (WArray224.init64 ("_.[_]" v)) i w) j = v.[j]. +proof. by move=> h1 h2 h3; rewrite set_get_def // h3. qed. + +(* my @A_jagged = ([0,0], [1,0], [1,1], [1,2], [1,3], # [0][0..4] + [2,2], [6,0], [3,1], [4,2], [5,3], # [1][0..4] + [2,0], [4,0], [6,1], [5,2], [3,3], # [2][0..4] + [2,3], [3,0], [5,1], [6,2], [4,3], # [3][0..4] + [2,1], [5,0], [4,1], [3,2], [6,3]); # [4][0..4] + @A_jagged = map(8*($$_[0]*4+$$_[1]), @A_jagged); # ... and now linear *) + +op A_jagged = (witness + .[0 <- 0 %/ 8] + .[1 <- 32 %/ 8] + .[2 <- 40 %/ 8] + .[3 <- 48 %/ 8] + .[4 <- 56 %/ 8] + .[5 <- 80 %/ 8] + .[6 <- 192 %/ 8] + .[7 <- 104 %/ 8] + .[8 <- 144 %/ 8] + .[9 <- 184 %/ 8] + .[10 <- 64 %/ 8] + .[11 <- 128 %/ 8] + .[12 <- 200 %/ 8] + .[13 <- 176 %/ 8] + .[14 <- 120 %/ 8] + .[15 <- 88 %/ 8] + .[16 <- 96 %/ 8] + .[17 <- 168 %/ 8] + .[18 <- 208 %/ 8] + .[19 <- 152 %/ 8] + .[20 <- 72 %/ 8] + .[21 <- 160 %/ 8] + .[22 <- 136 %/ 8] + .[23 <- 112 %/ 8] + .[24 <- 216 %/ 8] + )%Array25. + +op good_jag (mem : global_mem_t, _jag : int) = + forall off, 0 <= off < 25 => + loadW64 mem (_jag + (8 * off)) = W64.of_int A_jagged.[off]. + +lemma jagged_bound k : 0 <= k < 25 => 0 <= A_jagged.[k] < 28. +proof. + by move: k; apply (Array25.allP A_jagged (fun i => 0 <= i < 28)); cbv delta. +qed. + +lemma to_uintK_jagged k : 0 <= k < 25 => to_uint (W64.of_int A_jagged.[k]) = A_jagged.[k]. +proof. + move=> hk; rewrite to_uint_small //; smt (jagged_bound). +qed. + +op A_jagged_inv = + (witness + .[A_jagged.[0 ] <- 0 ] + .[A_jagged.[1 ] <- 1 ] + .[A_jagged.[2 ] <- 2 ] + .[A_jagged.[3 ] <- 3 ] + .[A_jagged.[4 ] <- 4 ] + .[A_jagged.[5 ] <- 5 ] + .[A_jagged.[6 ] <- 6 ] + .[A_jagged.[7 ] <- 7 ] + .[A_jagged.[8 ] <- 8 ] + .[A_jagged.[9 ] <- 9 ] + .[A_jagged.[10] <- 10] + .[A_jagged.[11] <- 11] + .[A_jagged.[12] <- 12] + .[A_jagged.[13] <- 13] + .[A_jagged.[14] <- 14] + .[A_jagged.[15] <- 15] + .[A_jagged.[16] <- 16] + .[A_jagged.[17] <- 17] + .[A_jagged.[18] <- 18] + .[A_jagged.[19] <- 19] + .[A_jagged.[20] <- 20] + .[A_jagged.[21] <- 21] + .[A_jagged.[22] <- 22] + .[A_jagged.[23] <- 23] + .[A_jagged.[24] <- 24])%Array28. + +lemma jagged_inj i j : 0 <= i < 25 => 0 <= j < 25 => A_jagged.[i] = A_jagged.[j] => i = j. +proof. + have : forall k, 0 <= k < 25 => k = A_jagged_inv.[A_jagged.[k]]. + + move=> k; have <- := mema_iota 0 25 k; move: k. + by rewrite -(List.allP (fun k => k = A_jagged_inv.[A_jagged.[k]])); cbv delta. + by move=> hk hi hj heq;rewrite (hk i) // (hk j) // heq. +qed. + +lemma jagged_diff off: 0 <= off < 25 => ! A_jagged.[off] \in [1;2;3]. +proof. + by move: off; apply (Array25.allP A_jagged (fun i => ! i \in [1;2;3])); cbv delta. +qed. + +lemma get256_64 (t : WArray224.t) i : 0 <= i < 7 => get256 t i = + W4u64.pack4 [ get64 t (4*i); get64 t (4*i+1); get64 t (4*i+2); get64 t (4*i+3)]. +proof. + move=> hi. + apply W4u64.wordP => k hk. + have -> : pack4 [get64 t (4 * i); get64 t (4 * i + 1); get64 t (4 * i + 2); get64 t (4 * i + 3)] = + W4u64.pack4_t (W4u64.Pack.init (fun k => get64 t (4 * i + k))). + + apply W4u64.wordP => *; rewrite !pack4bE // of_listE !initiE //= /#. + rewrite WArray224.get256E bits64_W32u8 hk /= pack4bE // initiE //=. + do 8! rewrite initiE 1:/# /=. + rewrite WArray224.get64E; apply W8u8.wordP => j hj. + rewrite of_listE !W8u8.pack8bE // !initiE //= /#. +qed. + +lemma get64_init64 (t:W64.t Array28.t) k : 0 <= k < 28 => get64 (WArray224.init64 ("_.[_]" t)) k = t.[k]. +proof. + move=> hk. + rewrite /init64 WArray224.get64E; apply W8u8.wordP => i hi. + rewrite W8u8.pack8bE // initiE //= initiE 1:/# /= /#. +qed. + +op jagged_zeros_W64_p (sts : W64.t Array28.t, P: int -> bool) = + forall off, 0 <= off < 25 => + P off => sts.[A_jagged.[off]] = W64.zero. + +op jagged_zeros_W64 (sts : W64.t Array28.t, rate : int) = jagged_zeros_W64_p sts (fun off => rate <= off < 25). + +lemma state_xor_jagged (state0 state1:W64.t Array25.t) s_state2 P : + jagged_zeros_W64_p s_state2 P => + (forall (k : int), + 0 <= k < 25 => + state1.[k] = if !P k then state0.[k] `^` s_state2.[A_jagged.[k]] else state0.[k]) => +pack4 [state0.[0]; state0.[0]; state0.[0]; state0.[0]] `^` +get256 ((init64 ("_.[_]" s_state2.[1 <- s_state2.[0]].[2 <- s_state2.[0]].[3 <- s_state2.[0]])))%WArray224 0 = +pack4 [state1.[0]; state1.[0]; state1.[0]; state1.[0]] /\ +pack4 [state0.[1]; state0.[2]; state0.[3]; state0.[4]] `^` +get256 ((init64 ("_.[_]" s_state2.[1 <- s_state2.[0]].[2 <- s_state2.[0]].[3 <- s_state2.[0]])))%WArray224 1 = +pack4 [state1.[1]; state1.[2]; state1.[3]; state1.[4]] /\ +pack4 [state0.[10]; state0.[20]; state0.[5]; state0.[15]] `^` +get256 ((init64 ("_.[_]" s_state2.[1 <- s_state2.[0]].[2 <- s_state2.[0]].[3 <- s_state2.[0]])))%WArray224 2 = +pack4 [state1.[10]; state1.[20]; state1.[5]; state1.[15]] /\ +pack4 [state0.[16]; state0.[7]; state0.[23]; state0.[14]] `^` +get256 ((init64 ("_.[_]" s_state2.[1 <- s_state2.[0]].[2 <- s_state2.[0]].[3 <- s_state2.[0]])))%WArray224 3 = +pack4 [state1.[16]; state1.[7]; state1.[23]; state1.[14]] /\ +pack4 [state0.[11]; state0.[22]; state0.[8]; state0.[19]] `^` +get256 ((init64 ("_.[_]" s_state2.[1 <- s_state2.[0]].[2 <- s_state2.[0]].[3 <- s_state2.[0]])))%WArray224 4 = +pack4 [state1.[11]; state1.[22]; state1.[8]; state1.[19]] /\ +pack4 [state0.[21]; state0.[17]; state0.[13]; state0.[9]] `^` +get256 ((init64 ("_.[_]" s_state2.[1 <- s_state2.[0]].[2 <- s_state2.[0]].[3 <- s_state2.[0]])))%WArray224 5 = +pack4 [state1.[21]; state1.[17]; state1.[13]; state1.[9]] /\ +pack4 [state0.[6]; state0.[12]; state0.[18]; state0.[24]] `^` +get256 ((init64 ("_.[_]" s_state2.[1 <- s_state2.[0]].[2 <- s_state2.[0]].[3 <- s_state2.[0]])))%WArray224 6 = +pack4 [state1.[6]; state1.[12]; state1.[18]; state1.[24]]. +proof. + move=> H2 H4. + rewrite !get256_64 // !get64_init64 //=. + rewrite /rev /=. + have -> /= : state0.[0] `^` s_state2.[0] = state1.[0]. + + rewrite H4 //; case: (!P 0) => h /=. + + by rewrite /A_jagged. + by have := H2 0; rewrite /A_jagged /= => ->. + split. + + do !congr; rewrite H4 //. + + case: (!P 1) => h; first by rewrite /A_jagged. + by have := H2 1; rewrite /A_jagged /= => ->. + + case: (!P 2) => h; first by rewrite /A_jagged. + by have := H2 2; rewrite /A_jagged /= => ->. + + case: (!P 3) => h; first by rewrite /A_jagged. + by have := H2 3; rewrite /A_jagged /= => ->. + case: (!P 4) => h; first by rewrite /A_jagged. + by have := H2 4; rewrite /A_jagged /= => ->. + split. + + do !congr; rewrite H4 //. + + case: (!P 10) => h; first by rewrite /A_jagged. + by have := H2 10; rewrite /A_jagged /= => ->. + + case: (!P 20) => h; first by rewrite /A_jagged. + by have := H2 20; rewrite /A_jagged /= => ->. + + case: (!P 5) => h; first by rewrite /A_jagged. + by have := H2 5; rewrite /A_jagged /= => ->. + case: (!P 15) => h; first by rewrite /A_jagged. + by have := H2 15; rewrite /A_jagged /= => ->. + split. + + do !congr; rewrite H4 //. + + case: (!P 16) => h; first by rewrite /A_jagged. + by have := H2 16; rewrite /A_jagged /= => ->. + + case: (!P 7) => h; first by rewrite /A_jagged. + by have := H2 7; rewrite /A_jagged /= => ->. + + case: (!P 23) => h; first by rewrite /A_jagged. + by have := H2 23; rewrite /A_jagged /= => ->. + case: (!P 14) => h; first by rewrite /A_jagged. + by have := H2 14; rewrite /A_jagged /= => ->. + split. + + do !congr; rewrite H4 //. + + case: (!P 11) => h; first by rewrite /A_jagged. + by have := H2 11; rewrite /A_jagged /= => ->. + + case: (!P 22) => h; first by rewrite /A_jagged. + by have := H2 22; rewrite /A_jagged /= => ->. + + case: (!P 8) => h; first by rewrite /A_jagged. + by have := H2 8; rewrite /A_jagged /= => ->. + case: (!P 19) => h; first by rewrite /A_jagged. + by have := H2 19; rewrite /A_jagged /= => ->. + split. + + do !congr; rewrite H4 //. + + case: (!P 21) => h; first by rewrite /A_jagged. + by have := H2 21; rewrite /A_jagged /= => ->. + + case: (!P 17) => h; first by rewrite /A_jagged. + by have := H2 17; rewrite /A_jagged /= => ->. + + case: (!P 13) => h; first by rewrite /A_jagged. + by have := H2 13; rewrite /A_jagged /= => ->. + case: (!P 9) => h; first by rewrite /A_jagged. + by have := H2 9; rewrite /A_jagged /= => ->. + do !congr; rewrite H4 //. + + case: (!P 6) => h; first by rewrite /A_jagged. + by have := H2 6; rewrite /A_jagged /= => ->. + + case: (!P 12) => h; first by rewrite /A_jagged. + by have := H2 12; rewrite /A_jagged /= => ->. + + case: (!P 18) => h; first by rewrite /A_jagged. + by have := H2 18; rewrite /A_jagged /= => ->. + case: (!P 24) => h; first by rewrite /A_jagged. + by have := H2 24; rewrite /A_jagged /= => ->. +qed. + +(* probably should be Jasmin semantics lemmas *) +lemma aux (v : W64.t): pack8_t ((init (fun (j : int) => v \bits8 j)))%W8u8.Pack = v + by move => *; rewrite (_: v = pack8_t (unpack8 v)); [apply W8u8.unpack8K | congr]. + +equiv add_full_block_corr rr : + Keccak_1600_ref_modular.Mmod.add_full_block ~ Mmod.add_full_block : + to_uint rate{2} < 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ + jagged_zeros_W64 s_state{2} (to_uint rate{2} %/ 8) /\ to_uint rate{2} = rr /\ + good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ to_uint rate{2} <= to_uint inlen{2} /\ + ={Glob.mem} /\ em_states state{2} state{1} /\ ={in_0,inlen,rate} + ==> + jagged_zeros_W64 res{2}.`2 (rr %/ 8) /\ + em_states res{2}.`1 res{1}.`1 /\ + res{1}.`2 = res{2}.`3 /\ res{1}.`3 = res{2}.`4 /\ + to_uint res{2}.`3 + to_uint res{2}.`4 < W64.modulus. +proof. + proc => /=. + exlim state{1} => state0. + seq 4 4 : + ( to_uint rate{2} < 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ + jagged_zeros_W64 s_state{2} (to_uint rate{2} %/ 8) /\ + to_uint rate{2} = rr /\ + good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ to_uint rate{2} <= to_uint inlen{2} /\ + (em_states state{2} state0) /\ ={Glob.mem, in_0, inlen, rate} /\ + forall k, 0 <= k < 25 => + state{1}.[k] = if k < to_uint rate{2} %/ 8 then state0.[k] `^` s_state{2}.[A_jagged.[k]] + else state0.[k]). + + while ( + to_uint rate{2} < 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ + jagged_zeros_W64 s_state{2} (to_uint rate{2} %/ 8) /\ + to_uint rate{2} = rr /\ + good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ to_uint rate{2} <= to_uint inlen{2} /\ + (em_states state{2} state0) /\ ={Glob.mem, in_0, inlen, rate} /\ i{1} = j{2} /\ + rate64{1} = rate8{2} /\ to_uint rate8{2} = to_uint rate{2} %/ 8 /\ to_uint i{1} <= to_uint rate8{2} /\ + forall k, 0 <= k < 25 => + state{1}.[k] = if k < to_uint j{2} then state0.[k] `^` s_state{2}.[A_jagged.[k]] + else state0.[k]). + + wp; skip => /> &1 &2 hr200 hj200 hin0 hj0 hgj hle hem; rewrite !W64.ultE => hr8 hjr8 hs hjr. + have heq : to_uint (W64.of_int 8 * j{2}) = 8 * to_uint j{2}. + + by rewrite W64.to_uintM_small //= /#. + rewrite to_uintD_small heq /= 1:/#. + rewrite to_uintD_small heq /= 1:/#. + rewrite to_uintD_small /=; 1: smt(W64.to_uint_cmp). + have ? : 0 <= to_uint j{2} < 25 by smt (W64.to_uint_cmp). + split. + + move=> k hk1 hk2. + rewrite hgj 1:// to_uintK_jagged 1:// Array28.set_neqiE 1:jagged_bound 1://; smt (jagged_inj). + split; 1: smt(). + move=> k hk1 hk2; rewrite hgj 1:// to_uintK_jagged 1://. + rewrite hs 1:// /=. + case (k < to_uint j{2} + 1) => hh. + + case (k = to_uint j{2}) => [->> | hne]. + + by rewrite Array25.set_eqiE 1,2:// Array28.set_eqiE 1:jagged_bound. + rewrite Array25.set_neqiE 1,2:// Array28.set_neqiE 1:jagged_bound //; smt (jagged_inj). + rewrite Array25.set_neqiE 1:// 1:/# hs 1:// /#. + wp; skip => |> &1 &2 *; split. + + by rewrite /(`>>`) /= to_uint_shr //=; smt (W64.to_uint_cmp). + by move=> state_ j_ s_state_; rewrite !W64.ultE => /#. + unroll for{2} ^while; wp; skip => |> &1 &2. + rewrite /em_states => /> /= *; split. + + rewrite /jagged_zeros_W64 => off h1 h2. + by rewrite !Array28.set_neqiE //; 1..3: smt (jagged_diff); rewrite H2. + split. + + apply Array7.all_eq_eq; rewrite /Array7.all_eq /index /=. + apply (state_xor_jagged _ _ _ (fun (off : int) => to_uint rate{2} %/ 8 <= off < 25)) => //= /#. + rewrite W64.to_uintD_small 1:/#. + rewrite W64.to_uintB 1:W64.uleE // /#. +qed. + +phoare init_s_stateP : [Mmod.init_s_state : true ==> forall ofs, 0 <= ofs < 28 => res.[ofs] = W64.of_int 0] = 1%r. +proof. + proc => /=. + unroll for ^while; wp; skip => /> ofs h1 h2. + do 7!(rewrite Array28.initiE 1:// set_get_def 1,2://). + rewrite /x86_VPBROADCAST_4u64 /= pack4bE 1:/# /= W4u64.Pack.get_of_list 1:/# /= /#. +qed. + +lemma get64_set8 (t: W64.t Array28.t) i k w : + 0 <= i < 224 => 0 <= k < 28 => + get64 (set8 (init64 ("_.[_]" t))%WArray224 i w) k = + if 8 * k <= i < 8 * k + 8 then + W8u8.pack8_t (W8u8.Pack.init (fun j => if j = i%%8 then w else t.[k] \bits8 j)) + else t.[k]. +proof. + move=> hi hk; apply W8u8.wordP => j hj. + rewrite get64E W8u8.pack8bE 1:// initiE 1:// /= /set8. + case: (8 * k <= i < 8 * k + 8) => h. + + rewrite W8u8.pack8bE 1:// initiE 1:// /= /init64. + rewrite WArray224.get_setE 1://. + case: (8 * k + j = i) => [<<- /#| hne]. + rewrite initiE 1:/# /=; smt(). + rewrite set_neqiE 1:// 1:/# /init64 initiE /= /#. +qed. + +lemma get64_set8_200 (t: W64.t Array25.t) i k w : + 0 <= i < 200 => 0 <= k < 25 => + WArray200.WArray200.get64 (WArray200.WArray200.set8 (WArray200.WArray200.init64 ("_.[_]" t)) i w) k = + if 8 * k <= i < 8 * k + 8 then + W8u8.pack8_t (W8u8.Pack.init (fun j => if j = i%%8 then w else t.[k] \bits8 j)) + else t.[k]. +proof. + move=> hi hk; apply W8u8.wordP => j hj. + rewrite WArray200.WArray200.get64E W8u8.pack8bE 1:// initiE 1:// /= /set8. + case: (8 * k <= i < 8 * k + 8) => h. + + rewrite W8u8.pack8bE 1:// initiE 1:// /= /init64. + rewrite WArray200.WArray200.get_setE 1://. + case: (8 * k + j = i) => [<<- /#| hne]. + rewrite WArray200.WArray200.initiE 1:/# /=; smt(). + rewrite WArray200.WArray200.set_neqiE 1:// 1:/# /init64 WArray200.WArray200.initiE /= /#. +qed. + +equiv add_final_block_corr : + Keccak_1600_ref_modular.Mmod.add_final_block ~ Mmod.add_final_block : + to_uint rate{2} < 200 /\ + to_uint a_jagged{2} + 200 < W64.modulus /\ + to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ + good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ + ={Glob.mem, trail_byte} /\ em_states state{2} state{1} /\ ={in_0,inlen} /\ to_uint inlen{2} < to_uint rate{2} /\ r8{1} = rate{2} + ==> + em_states res{2} res{1}. +proof. + proc => /=. + exlim state{1} => state0. + seq 4 5 : + ( to_uint rate{2} < 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ + jagged_zeros_W64 s_state{2} (to_uint inlen{2} %/8) /\ + good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ + (em_states state{2} state0) /\ ={Glob.mem, trail_byte, in_0, inlen} /\ to_uint inlen{2} < to_uint rate{2} /\ r8{1} = rate{2} /\ + i{1} = j{2} /\ to_uint j{2} = to_uint inlen{2} %/ 8 /\ + forall k, 0 <= k < 25 => + state{1}.[k] = if k < to_uint inlen{2} %/ 8 then state0.[k] `^` s_state{2}.[A_jagged.[k]] + else state0.[k]). + + while ( + to_uint rate{2} < 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ + jagged_zeros_W64 s_state{2} (to_uint inlen{2} %/8) /\ + good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ + (em_states state{2} state0) /\ ={Glob.mem, trail_byte, in_0, inlen, inlen8} /\ i{1} = j{2} /\ to_uint inlen{2} < to_uint rate{2} /\ r8{1} = rate{2} /\ + to_uint inlen8{2} = to_uint inlen{2} %/ 8 /\ to_uint i{1} <= to_uint inlen8{2} /\ + forall k, 0 <= k < 25 => + state{1}.[k] = if k < to_uint j{2} then state0.[k] `^` s_state{2}.[A_jagged.[k]] + else state0.[k]). + + wp; skip => /> &1 &2 hr200 hj200 hin0 hj0 hgj hem; rewrite !W64.ultE => hr8 hjr8 hjr hs _hh. + have heq : to_uint (W64.of_int 8 * j{2}) = 8 * to_uint j{2}. + + by rewrite W64.to_uintM_small //= /#. + rewrite to_uintD_small heq /= 1:/#. + rewrite to_uintD_small heq /= 1:/#. + rewrite to_uintD_small /=; 1: smt(W64.to_uint_cmp). + have ? : 0 <= to_uint j{2} < 25 by smt (W64.to_uint_cmp). + split. + + move=> k hk1 hk2. + rewrite hgj 1:// to_uintK_jagged 1:// Array28.set_neqiE 1:jagged_bound 1://; smt (jagged_inj). + split; 1: smt(). + rewrite hgj 1:// to_uintK_jagged 1:// => k hk1 hk2. + rewrite hs 1:// /=. + case (k < to_uint j{2} + 1) => hh. + + case (k = to_uint j{2}) => [->> | hne]. + + by rewrite Array25.set_eqiE 1,2:// Array28.set_eqiE 1:jagged_bound. + rewrite Array25.set_neqiE 1,2:// Array28.set_neqiE 1:jagged_bound //; smt (jagged_inj). + rewrite Array25.set_neqiE 1:// 1:/# hs 1:// /#. + wp; call{2} init_s_stateP; skip => |> &1 &2 *; split. + + split. + + by move=> off ??; rewrite H5 2://; apply jagged_bound. + rewrite /(`>>`) /= to_uint_shr //=. + split; 1: smt (W64.to_uint_cmp). + move=> k hk1 hk2; rewrite H5; 1: by apply jagged_bound. + by rewrite W64.xorw0. + by move=> state_ j_ s_state_; rewrite !W64.ultE => /#. + seq 6 15 : + (to_uint rate{2} < 200 /\ + jagged_zeros_W64_p s_state{2} + (fun (off : int) => (to_uint inlen{2} %/8 + 1) <= off < 25 /\ off <> (to_uint rate{2} - 1) %/ 8) /\ + (em_states state{2} state0) /\ + forall k, 0 <= k < 25 => + state{1}.[k] = if k < to_uint inlen{2} %/ 8 + 1 \/ k = (to_uint rate{2} - 1) %/ 8 then state0.[k] `^` s_state{2}.[A_jagged.[k]] + else state0.[k]); last first. + + unroll for{2} ^while; wp; skip => |> &1 &2. + rewrite /em_states => /> /= *. + apply Array7.all_eq_eq; rewrite /Array7.all_eq /index /=. + apply (state_xor_jagged _ _ _ _ H0); smt(). + wp. + seq 0 2: (#pre /\ to_uint l{2} = 8 * A_jagged.[to_uint inlen{2} %/ 8]). + + wp; skip => /> &1 &2 *. + have heq : to_uint (W64.of_int 8 * j{2}) = 8 * to_uint j{2}. + + by rewrite W64.to_uintM_small //= /#. + have ?: 0 <= to_uint j{2} < 25 by smt(W64.to_uint_cmp). + rewrite to_uintD_small heq /= 1:/# H3 1://. + rewrite /(`<<`) /= W64.shlMP 1:// /= -W64.of_intM W64.to_uintM_small to_uintK_jagged //=; 1: smt(jagged_bound). + by rewrite H6; ring. + while ( + to_uint rate{2} < 200 /\ + to_uint a_jagged{2} + 200 < W64.modulus /\ + to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ + jagged_zeros_W64 s_state{2} (to_uint inlen{2} %/8 + 1) /\ + (forall k, to_uint l{2} <= k < 8 * A_jagged.[to_uint inlen{2} %/ 8] + 8 => + s_state{2}.[k %/ 8] \bits8 (k %% 8) = W8.zero) /\ + ={Glob.mem, trail_byte, in_0, inlen} /\ + to_uint inlen{2} < to_uint rate{2} /\ + i{1} = j{2} /\ + to_uint l{2} = 8 * A_jagged.[to_uint inlen{2} %/ 8] + (to_uint j{2} - 8 * (to_uint inlen{2} %/ 8)) /\ + 8 * (to_uint inlen{2} %/ 8) <= to_uint j{2} <= to_uint inlen{2} /\ + forall (k : int), + 0 <= k < 25 => + state{1}.[k] = if k < to_uint inlen{2} %/ 8 + 1 then state0.[k] `^` s_state{2}.[A_jagged.[k]] else state0.[k]). + + wp; skip => /> &1 &2; rewrite W64.ultE => *. + rewrite !W64.to_uintD_small /=. + + smt(). + smt(W64.to_uint_cmp jagged_bound). + smt(). + split. + + move=> k hk1 hk2. + rewrite initiE; 1: by apply jagged_bound. + rewrite get64_set8; 1,2: smt(W64.to_uint_cmp jagged_bound). + smt(W64.to_uint_cmp jagged_inj). + split. + + move=> k hk1 hk2;rewrite initiE; 1: smt(W64.to_uint_cmp jagged_bound). + rewrite get64_set8; 1, 2: smt(W64.to_uint_cmp jagged_bound). + case: (8 * (k %/ 8) <= to_uint l{2} < 8 * (k %/ 8) + 8); last by smt(). + move=> ?; rewrite W8u8.pack8bE 1:/# initiE /= /#. + split; 1:ring H5. + split; 1: smt(). + move=> k hk1 hk2. + rewrite initiE; 1: by apply jagged_bound. + rewrite initiE 1:// get64_set8. + + smt(W64.to_uint_cmp jagged_bound). + by apply jagged_bound. + rewrite get64_set8_200 //. + + smt(W64.to_uint_cmp). + case: (8 * k <= to_uint j{2} < 8 * k + 8) => h; last first. + have -> : (! 8 * A_jagged.[k] <= to_uint l{2} < 8 * A_jagged.[k] + 8); + [ by rewrite H5; smt(jagged_inj @W64) | by smt() ]. + have -> /= : k < to_uint inlen{2} %/ 8 + 1 by smt(). + case: (8 * A_jagged.[k] <= to_uint l{2} < 8 * A_jagged.[k] + 8) => h1. + + apply W8u8.wordP => i hi. + rewrite /= !W8u8.pack8bE 1,2:// !initiE 1,2:// /=. + have -> : to_uint j{2} %% 8 = to_uint l{2} %% 8 by smt(). + case: (i = to_uint l{2} %% 8) => [->> | hne]; last first. + rewrite (H8 k); first by smt(). + by have -> : (k < to_uint inlen{2} %/ 8 + 1); smt(jagged_inj @W64). + rewrite /WArray200.WArray200.get8 /WArray200.WArray200.init64 WArray200.WArray200.initiE /=; first by smt (). + rewrite xorwC xorwC;congr. + rewrite (H8 (to_uint j{2} %/ 8)); first by smt(). + have -> : (to_uint j{2} %/ 8 < to_uint inlen{2} %/ 8 + 1); first by smt(@W64 jagged_inj). + simplify. + rewrite (_: to_uint j{2} %% 8 = to_uint l{2} %% 8); first by smt(). + rewrite (_: to_uint j{2} %/ 8 = k). smt(@W64). + rewrite (_: (s_state{2}.[A_jagged.[k]] \bits8 to_uint l{2} %% 8) = W8.zero); last by smt(). + rewrite (_: A_jagged.[k] = to_uint l{2} %/ 8); first by smt(@W64). + by apply (H3 (to_uint l{2})); smt(). + apply W8u8.wordP => i hi. + rewrite /= !W8u8.pack8bE 1,2:// !initiE 1,2:// /=. + case: (i = to_uint j{2} %% 8) => [->> | hne]; last by smt (@W64). + rewrite /WArray200.WArray200.get8 /WArray200.WArray200.init64 WArray200.WArray200.initiE /=; smt (@W64). + wp; skip => /> &1 &2 *. + split. + + rewrite /(`<<`) /= W64.to_uint_shl 1:// /=. + rewrite modz_small; 1: smt(W64.to_uint_cmp). + split; first by smt(). + split. + move => k kb1 kb2. + move : H2; rewrite /jagged_zeros_W64 /jagged_zeros_W64_p => *. + rewrite (_: s_state{2}.[k %/ 8] = W64.zero); first by smt(@W64). + by rewrite get_zero //=. + split; first by smt(). + split; first by smt(). + move => k kb1 kb2. + case (k < to_uint inlen{2} %/ 8 + 1); last by smt(). + rewrite (H7 k); first by smt(). + move => kb. + case (k = to_uint inlen{2} %/ 8); last by smt(@W64). + move => Ke. + rewrite (_: k < to_uint inlen{2} %/ 8 = false); first by smt(). + simplify. + rewrite (_: s_state{2}.[A_jagged.[k]] = W64.zero); last by smt(). + move : H2; rewrite /jagged_zeros_W64 /jagged_zeros_W64_p => *. + by apply (H2 k); smt(). + move=> ????; rewrite W64.ultE => *. + have heq: to_uint (rate{2} - W64.one `>>` W8.of_int 3) = (to_uint rate{2} - 1) %/ 8. + + rewrite /(`>>`) W64.to_uint_shr /= 1://. + rewrite W64.to_uintB 1:uleE //=; smt(W64.to_uint_cmp). + have heq1 : to_uint (W64.of_int 8 * (rate{2} - W64.one `>>` W8.of_int 3)) = + 8 * ((to_uint rate{2} - 1) %/ 8). + + rewrite to_uintM_small /= heq //; smt(W64.to_uint_cmp). + have -> : loadW64 Glob.mem{2} (to_uint (a_jagged{2} + (of_int 8)%W64 * (rate{2} - W64.one `>>` (of_int 3)%W8))) = + W64.of_int (A_jagged.[(to_uint rate{2} - 1) %/ 8]). + + rewrite W64.to_uintD_small /= heq1. smt(W64.to_uint_cmp). + rewrite H3 //; smt(W64.to_uint_cmp). + have heq2: to_uint ((rate{2} - W64.one) `&` W64.of_int 7) = (to_uint rate{2} - 1) %% 8. + + rewrite (W64.to_uint_and_mod 3) //=. + rewrite W64.to_uintB 1:uleE //=; smt(W64.to_uint_cmp). + have heq3 : to_uint ((W64.of_int A_jagged.[(to_uint rate{2} - 1) %/ 8]) `<<` W8.of_int 3) = + 8 * A_jagged.[(to_uint rate{2} - 1) %/ 8]. + + rewrite /(`<<`) /= W64.to_uint_shl 1:// /=. + smt (modz_small to_uintK_jagged W64.to_uint_cmp jagged_bound). + have heq4: to_uint (((W64.of_int A_jagged.[(to_uint rate{2} - 1) %/ 8]) `<<` W8.of_int 3) + (rate{2} - W64.one) `&` W64.of_int 7) = + 8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8. + + rewrite W64.to_uintD_small heq2 heq3 //; smt(W64.to_uint_cmp jagged_bound). + split. + + move=> k hk1 hk2. + rewrite Array28.initiE; 1: by apply jagged_bound. + rewrite heq4 get64_set8; 1,2: smt(W64.to_uint_cmp jagged_bound). + rewrite (_: 8 * A_jagged.[k] <= + 8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8 < + 8 * A_jagged.[k] + 8 = false) //=; first by smt(@W64 jagged_bound jagged_inj). + rewrite Array28.initiE; 1: by apply jagged_bound. + rewrite get64_set8; 1,2: smt(W64.to_uint_cmp jagged_bound). + case (8 * A_jagged.[k] <= to_uint l_R < 8 * A_jagged.[k] + 8) => [ht | hf]; first by smt(@W64 jagged_bound jagged_inj). + by apply (H11 k); smt (@W64 jagged_bound jagged_inj). + move=> k hk1 hk2. + have -> : to_uint (rate{2} - W64.one) = to_uint rate{2} - 1. + + rewrite W64.to_uintB 1:uleE /=; smt(W64.to_uint_cmp). + rewrite Array28.initiE; 1: by apply jagged_bound. + rewrite heq4 get64_set8; 1,2: smt(W64.to_uint_cmp jagged_bound). + rewrite Array25.initiE 1:// get64_set8_200. + + smt(W64.to_uint_cmp). + + done. + case (k < to_uint inlen{2} %/ 8 + 1 \/ k = (to_uint rate{2} - 1) %/ 8) => [ht | hf]. + + case (k = (to_uint rate{2} - 1) %/ 8) => [hht | hhf]. + rewrite (_: 8 * k <= to_uint rate{2} - 1 < 8 * k + 8 = true); first + by smt (@W64 jagged_bound jagged_inj). + rewrite (_: 8 * A_jagged.[k] <= + 8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8 < + 8 * A_jagged.[k] + 8 = true); first by smt (@W64 jagged_bound jagged_inj). + simplify. + rewrite (_: state0.[k] = state_L.[k] `^` s_state_R.[A_jagged.[k]]). + rewrite H16; first by smt (@W64 jagged_bound jagged_inj). + case (k < to_uint inlen{2} %/ 8 + 1) => [hhhht | hhhhf]. + rewrite -(W64.xorwA); smt (@W64 jagged_bound jagged_inj). + rewrite (_ : s_state_R.[A_jagged.[k]] = W64.zero). + by apply (H11 k); smt (@W64 jagged_bound jagged_inj). + by smt (@W64 jagged_bound jagged_inj). + rewrite (_: + state_L.[k] `^` s_state_R.[A_jagged.[k]] = + pack8_t + ((init + (fun (j : int) => + (state_L.[k] `^` s_state_R.[A_jagged.[k]]) \bits8 j)))%W8u8.Pack). + apply W8u8.wordP => i hi. + rewrite (_: + (pack8_t + ((init + (fun (j : int) => state_L.[k] `^` + s_state_R.[A_jagged.[k]] \bits8 j)))%W8u8.Pack \bits8 i) = + state_L.[k] `^` s_state_R.[A_jagged.[k]] \bits8 i); last by congr. + by rewrite aux. + rewrite xorb8u8E map2E. + congr. congr. apply fun_ext => ii. + case (! 0 <= ii < 8) => [hti | hfi]. + + rewrite (_: (ii = (to_uint rate{2} - 1) %% 8) = false); first by smt(). + simplify. + rewrite (W8u8.get_out _ ii); first by apply hti. + rewrite (W8u8.Pack.get_out _ ii); first by apply hti. + by rewrite (W8u8.Pack.get_out _ ii); first by apply hti. + + case (ii = (to_uint rate{2} - 1) %% 8) => [hhit | hhif]. + rewrite (W8u8.Pack.initiE); first by apply hfi. + rewrite (W8u8.Pack.initiE); first by apply hfi. + rewrite (WArray200.WArray200.initiE); first by smt(). + simplify. + rewrite (WArray200.WArray200.initiE); first by smt(@W64 jagged_bound jagged_inj). + have -> : (ii = + (8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8) %% + 8); first by smt (@W64 jagged_bound jagged_inj). + rewrite /get8 /init64. + rewrite (WArray224.initiE); first by smt(@W64 jagged_bound jagged_inj). + simplify. + rewrite W8.xorwA. congr. + rewrite -(xorb8E). + rewrite -(xorb8E). + have -> : ((8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8) %% + 8 = (to_uint rate{2} - 1) %% 8); first by smt(@W64 jagged_bound jagged_inj). + congr. + rewrite Array25.initiE; first by smt(). + rewrite Array28.initiE; first by smt(jagged_bound). + rewrite get64_set8_200; first 2 by smt(@W64 jagged_bound jagged_inj). + rewrite get64_set8; first 2 by smt(@W64 jagged_bound jagged_inj). + case : (8 * ((to_uint rate{2} - 1) %/ 8) <= to_uint j_R < + 8 * ((to_uint rate{2} - 1) %/ 8) + 8) => [ hjt | hjf]. + + have -> : (8 * + ((8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8) %/ + 8) <= + to_uint l_R < + 8 * + ((8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8) %/ + 8) + + 8 ); first by smt(@W64 jagged_bound jagged_inj). + simplify. + rewrite -(aux (state_L.[k] `^` s_state_R.[A_jagged.[k]])). + rewrite xorb8u8E map2E. + congr. congr. apply fun_ext => iii. + case (! 0 <= iii < 8) => [hiiit | hiiif]. + + rewrite !W8u8.Pack.get_out; first 2 by apply hiiit. + have -> : (! iii = to_uint j_R %% 8); first by smt(). + simplify. by rewrite W8u8.get_out; first by apply hiiit. + + rewrite !initiE; first 2 by apply hiiif. simplify. + case (iii = to_uint j_R %% 8) => [hhjt | hhjf]. + + have -> : (iii = to_uint l_R %% 8); first by smt(@W64 jagged_bound jagged_inj). + simplify. congr. + rewrite (_: (s_state_R.[A_jagged.[k]] \bits8 to_uint l_R %% 8) = W8.zero). + rewrite (_: A_jagged.[k] = to_uint l_R %/ 8); first by smt(@W64 jagged_bound jagged_inj). apply H12; by smt(@W64 jagged_bound jagged_inj). + by smt(@W8 @W64 jagged_bound jagged_inj). + + have -> : (iii <> to_uint l_R %% 8); first by smt(@W64 jagged_bound jagged_inj). + simplify. rewrite -hht. + rewrite (_: (8 * A_jagged.[k] + (to_uint rate{2} - 1) %% 8) %/ 8 = A_jagged.[k]); first by smt(@W64 jagged_bound jagged_inj). by rewrite -(W8.xorwA); smt(@W64). + + + have -> : (! 8 * + ((8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8) %/ + 8) <= + to_uint l_R < + 8 * + ((8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8) %/ + 8) + + 8); first by smt(@W64 jagged_bound jagged_inj). + simplify. rewrite -hht. + rewrite (_: (8 * A_jagged.[k] + (to_uint rate{2} - 1) %% 8) %/ 8 = A_jagged.[k]); + first by smt(). + by rewrite -(W64.xorwA); smt(@W64). + + + rewrite (W8u8.Pack.initiE); first by apply hfi. + rewrite (W8u8.Pack.initiE); first by apply hfi. + rewrite (WArray200.WArray200.initiE); first by smt(@W64). + simplify. + have -> : (ii <> + (8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8) %% + 8); first by smt (@W64 jagged_bound jagged_inj). + rewrite /get8 /init64. + rewrite (WArray224.initiE); first by smt(@W64 jagged_bound jagged_inj). + simplify. + rewrite -(xorb8E). + rewrite -(xorb8E). + rewrite Array25.initiE; first by smt(). + rewrite Array28.initiE; first by smt(jagged_bound). + rewrite get64_set8_200; first 2 by smt(@W64 jagged_bound jagged_inj). + rewrite get64_set8; first 2 by smt(@W64 jagged_bound jagged_inj). + case : (8 * k <= to_uint j_R < 8 * k + 8) => [ hjt | hjf]. + + have -> : (8 * A_jagged.[k] <= to_uint l_R < 8 * A_jagged.[k] + 8); first by smt(@W64 jagged_bound jagged_inj). + simplify. + rewrite -xorb8E. + rewrite -(aux (state_L.[k] `^` s_state_R.[A_jagged.[k]])). + rewrite -xorb8E xorb8u8E map2E. + congr. congr. congr. apply fun_ext => iii. + case (! 0 <= iii < 8) => [hiiit | hiiif]. + + rewrite !W8u8.Pack.get_out; first 2 by apply hiiit. + have -> : (! iii = to_uint j_R %% 8); first by smt(). + simplify. by rewrite W8u8.get_out; first by apply hiiit. + + rewrite !initiE; first 2 by apply hiiif. simplify. + case (iii = to_uint j_R %% 8) => [hhjt | hhjf]. + + have -> : (iii = to_uint l_R %% 8); first by smt(@W64 jagged_bound jagged_inj). + simplify. congr. + rewrite (_: (s_state_R.[A_jagged.[k]] \bits8 to_uint l_R %% 8) = W8.zero). + rewrite (_: A_jagged.[k] = to_uint l_R %/ 8); first by smt(@W64 jagged_bound jagged_inj). apply H12; by smt(@W64 jagged_bound jagged_inj). + by smt(@W8 @W64 jagged_bound jagged_inj). + + have -> : (iii <> to_uint l_R %% 8); first by smt(@W64 jagged_bound jagged_inj). + simplify. + by rewrite -(W8.xorwA); smt(@W64). + + have -> : (! 8 * A_jagged.[k] <= to_uint l_R < 8 * A_jagged.[k] + 8); first by smt(@W64 jagged_bound jagged_inj). + simplify. + rewrite -(xorb8E). + rewrite -(xorb8E). + congr. + by rewrite -(W64.xorwA); smt(@W64). + rewrite (_: 8 * k <= to_uint rate{2} - 1 < 8 * k + 8 = false); first + by smt (@W64 jagged_bound jagged_inj). + rewrite (_: 8 * A_jagged.[k] <= + 8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8 < + 8 * A_jagged.[k] + 8 = false); first by smt (@W64 jagged_bound jagged_inj). + simplify. + rewrite (_: state0.[k] = state_L.[k] `^` s_state_R.[A_jagged.[k]]). + rewrite H16; first by smt (@W64 jagged_bound jagged_inj). + case (k < to_uint inlen{2} %/ 8 + 1); last by smt (@W64 jagged_bound jagged_inj). + by rewrite -(W64.xorwA); smt (@W64 jagged_bound jagged_inj). + rewrite !initiE; first 2 by smt (@W64 jagged_bound jagged_inj). + rewrite get64_set8_200; first 2 by smt(W64.to_uint_cmp jagged_bound). + rewrite get64_set8; first 2 by smt(W64.to_uint_cmp jagged_bound). + rewrite (_: + state_L.[k] `^` s_state_R.[A_jagged.[k]] = + pack8_t + ((init + (fun (j : int) => + (state_L.[k] `^` s_state_R.[A_jagged.[k]]) \bits8 j)))%W8u8.Pack). + apply W8u8.wordP => i hi. + rewrite (_: + (pack8_t + ((init + (fun (j : int) => state_L.[k] `^` + s_state_R.[A_jagged.[k]] \bits8 j)))%W8u8.Pack \bits8 i) = + state_L.[k] `^` s_state_R.[A_jagged.[k]] \bits8 i); last by congr. + by rewrite aux. + case (k < to_uint inlen{2} %/ 8) => [kht | khf]. + rewrite (_: 8 * k <= to_uint j_R < 8 * k + 8 = false); first by smt (@W64 jagged_bound jagged_inj). + rewrite (_: 8 * A_jagged.[k] <= to_uint l_R < 8 * A_jagged.[k] + 8 = false); first by smt (@W64 jagged_bound jagged_inj). simplify. + rewrite (aux (state_L.[k] `^` s_state_R.[A_jagged.[k]])). + by rewrite -W64.xorwA; smt(@W64). + rewrite (_: k = to_uint inlen{2} %/ 8); first by smt(). + rewrite (_:8 * (to_uint inlen{2} %/ 8) <= to_uint j_R < + 8 * (to_uint inlen{2} %/ 8) + 8 = true); first by smt (@W64 jagged_bound jagged_inj). + rewrite (_: 8* A_jagged.[to_uint inlen{2} %/ 8] <= to_uint l_R < + 8 * A_jagged.[to_uint inlen{2} %/ 8] + 8 = true); + first by smt (@W64 jagged_bound jagged_inj). + simplify. + (******) + apply W8u8.wordP => i hi. + case (i = 0) => />. + rewrite /get8 bits8E. + case (0 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. + rewrite (_:to_uint l_R %% 8 = 0); first by smt (@W64 jagged_bound jagged_inj). + simplify. congr. rewrite (_: A_jagged.[to_uint inlen{2} %/ 8] = to_uint l_R %/8). rewrite H13. + rewrite (_: to_uint j_R = 8 * to_uint inlen{2} %/ 8); first by smt(). by smt(). + move : (H12 (to_uint l_R)). + rewrite (_:to_uint l_R %% 8 = 0); first by smt (@W64 jagged_bound jagged_inj). + move => *. rewrite H17. + by smt (@W8 @W64 jagged_bound jagged_inj). + rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). + rewrite (_:(0 = to_uint l_R %% 8) = false); first by smt (@W64 jagged_bound jagged_inj). simplify. + by rewrite -W8.xorwA W8.xorwK; smt(@W8). + case (i = 1) => />. + rewrite /get8 bits8E. + case (1 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. + rewrite (_:to_uint l_R %% 8 = 1); first by smt (@W64 jagged_bound jagged_inj). + simplify. congr. rewrite (_: A_jagged.[to_uint inlen{2} %/ 8] = to_uint l_R %/8). rewrite H13. + rewrite (_: to_uint j_R = 8 * to_uint inlen{2} %/ 8); first by smt(). by smt(). + move : (H12 (to_uint l_R)). + rewrite (_:to_uint l_R %% 8 = 1); first by smt (@W64 jagged_bound jagged_inj). + move => *. rewrite H17. + by smt (@W8 @W64 jagged_bound jagged_inj). + rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). + rewrite (_:(1 = to_uint l_R %% 8) = false); first by smt (@W64 jagged_bound jagged_inj). simplify. + by rewrite -W8.xorwA W8.xorwK; smt(@W8). + case (i = 2) => />. + rewrite /get8 bits8E. + case (2 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. + rewrite (_:to_uint l_R %% 8 = 2); first by smt (@W64 jagged_bound jagged_inj). + simplify. congr. rewrite (_: A_jagged.[to_uint inlen{2} %/ 8] = to_uint l_R %/8). rewrite H13. + rewrite (_: to_uint j_R = 8 * to_uint inlen{2} %/ 8); first by smt(). by smt(). + move : (H12 (to_uint l_R)). + rewrite (_:to_uint l_R %% 8 = 2); first by smt (@W64 jagged_bound jagged_inj). + move => *. rewrite H17. + by smt (@W8 @W64 jagged_bound jagged_inj). + rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). + rewrite (_:(2 = to_uint l_R %% 8) = false); first by smt (@W64 jagged_bound jagged_inj). simplify. + by rewrite -W8.xorwA W8.xorwK; smt(@W8). + case (i = 3) => />. + rewrite /get8 bits8E. + case (3 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. + rewrite (_:to_uint l_R %% 8 = 3); first by smt (@W64 jagged_bound jagged_inj). + simplify. congr. rewrite (_: A_jagged.[to_uint inlen{2} %/ 8] = to_uint l_R %/8). rewrite H13. + rewrite (_: to_uint j_R = 8 * to_uint inlen{2} %/ 8); first by smt(). by smt(). + move : (H12 (to_uint l_R)). + rewrite (_:to_uint l_R %% 8 = 3); first by smt (@W64 jagged_bound jagged_inj). + move => *. rewrite H17. + by smt (@W8 @W64 jagged_bound jagged_inj). + rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). + rewrite (_:(3 = to_uint l_R %% 8) = false); first by smt (@W64 jagged_bound jagged_inj). simplify. + by rewrite -W8.xorwA W8.xorwK; smt(@W8). + case (i = 4) => />. + rewrite /get8 bits8E. + case (4 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. + rewrite (_:to_uint l_R %% 8 = 4); first by smt (@W64 jagged_bound jagged_inj). + simplify. congr. rewrite (_: A_jagged.[to_uint inlen{2} %/ 8] = to_uint l_R %/8). rewrite H13. + rewrite (_: to_uint j_R = 8 * to_uint inlen{2} %/ 8); first by smt(). by smt(). + move : (H12 (to_uint l_R)). + rewrite (_:to_uint l_R %% 8 = 4); first by smt (@W64 jagged_bound jagged_inj). + move => *. rewrite H17. + by smt (@W8 @W64 jagged_bound jagged_inj). + rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). + rewrite (_:(4 = to_uint l_R %% 8) = false); first by smt (@W64 jagged_bound jagged_inj). simplify. + by rewrite -W8.xorwA W8.xorwK; smt(@W8). + case (i = 5) => />. + rewrite /get8 bits8E. + case (5 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. + rewrite (_:to_uint l_R %% 8 = 5); first by smt (@W64 jagged_bound jagged_inj). + simplify. congr. rewrite (_: A_jagged.[to_uint inlen{2} %/ 8] = to_uint l_R %/8). rewrite H13. + rewrite (_: to_uint j_R = 8 * to_uint inlen{2} %/ 8); first by smt(). by smt(). + move : (H12 (to_uint l_R)). + rewrite (_:to_uint l_R %% 8 = 5); first by smt (@W64 jagged_bound jagged_inj). + move => *. rewrite H17. + by smt (@W8 @W64 jagged_bound jagged_inj). + rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). + rewrite (_:(5 = to_uint l_R %% 8) = false); first by smt (@W64 jagged_bound jagged_inj). simplify. + by rewrite -W8.xorwA W8.xorwK; smt(@W8). + case (i = 6) => />. + rewrite /get8 bits8E. + case (6 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. + rewrite (_:to_uint l_R %% 8 = 6); first by smt (@W64 jagged_bound jagged_inj). + simplify. congr. rewrite (_: A_jagged.[to_uint inlen{2} %/ 8] = to_uint l_R %/8). rewrite H13. + rewrite (_: to_uint j_R = 8 * to_uint inlen{2} %/ 8); first by smt(). by smt(). + move : (H12 (to_uint l_R)). + rewrite (_:to_uint l_R %% 8 = 6); first by smt (@W64 jagged_bound jagged_inj). + move => *. rewrite H17. + by smt (@W8 @W64 jagged_bound jagged_inj). + rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). + rewrite (_:(6 = to_uint l_R %% 8) = false); first by smt (@W64 jagged_bound jagged_inj). simplify. + by rewrite -W8.xorwA W8.xorwK; smt(@W8). + case (i = 7) => />. + rewrite /get8 bits8E. + case (7 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. + rewrite (_:to_uint l_R %% 8 = 7); first by smt (@W64 jagged_bound jagged_inj). + simplify. congr. rewrite (_: A_jagged.[to_uint inlen{2} %/ 8] = to_uint l_R %/8). rewrite H13. + rewrite (_: to_uint j_R = 8 * to_uint inlen{2} %/ 8); first by smt(). by smt(). + move : (H12 (to_uint l_R)). + rewrite (_:to_uint l_R %% 8 = 7); first by smt (@W64 jagged_bound jagged_inj). + move => *. rewrite H17. + by smt (@W8 @W64 jagged_bound jagged_inj). + rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). + rewrite (_:(7 = to_uint l_R %% 8) = false); first by smt (@W64 jagged_bound jagged_inj). simplify. + by rewrite -W8.xorwA W8.xorwK; smt(@W8). + by smt(). + (*****) + rewrite (_: 8 * k <= to_uint rate{2} - 1 < 8 * k + 8 = false); first + by smt (@W64 jagged_bound jagged_inj). + simplify. + rewrite initiE; first by smt(). + rewrite get64_set8_200; first 2 by smt(W64.to_uint_cmp jagged_bound). + by smt(W64.to_uint_cmp jagged_bound). +qed. + +require import Keccak_f1600_scalar_table. + +op disj_ptr (p1 : address) (len1:int) (p2: address) ( len2:int) = + p1 + len1 <= p2 \/ p2 + len2 <= p1. + +op good_ptr (p : address) (len:int) = p + len < W64.modulus. + +lemma loadW64_storeW64_diff mem i j w: + j + 8 <= i \/ i + 8 <= j => + loadW64 (storeW64 mem i w) j = loadW64 mem j. +proof. + move=> hij; apply W8u8.wordP => k hk. + rewrite /loadW64 !W8u8.pack8bE 1,2:// !initiE 1,2:// /= storeW64E get_storesE /= /#. +qed. + + +lemma get_em_states state1 state2 j: + 0 <= j < 25 => + em_states state2 state1 => + state1.[j] = (state2.[A_jagged.[j] %/ 4] \bits64 A_jagged.[j] %% 4). +proof. + rewrite /em_states => hj ->. + rewrite get_of_list; 1:smt (jagged_bound). + rewrite /index /= /A_jagged /=. + rewrite -(mema_iota 0 25 j) in hj. + move: j hj. + by apply List.allP; cbv delta. +qed. + +equiv extr_full_block_corr _outlen _rate _out _iotas rl rr jag : + Keccak_1600_ref_modular.Mmod.xtr_full_block ~ Mmod.xtr_full_block : + disj_ptr jag 200 _out _outlen /\ + disj_ptr _iotas 800 _out _outlen /\ + disj_ptr rl 200 _out _outlen /\ + disj_ptr rr 200 _out _outlen /\ + to_uint len{2} < 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ + _out + _outlen < W64.modulus /\ _rate <= _outlen /\ + good_jag Glob.mem{2} jag /\ + good_io4x Glob.mem{2} _iotas /\ + good_rhol Glob.mem{2} rl /\ good_rhor Glob.mem{2} rr /\ + to_uint rate{1} = _rate /\ to_uint outlen{1} = _outlen /\ to_uint out{1} = _out /\ jag = to_uint a_jagged{2} /\ + em_states state{2} state{1} /\ ={Glob.mem,out} /\ rate{1} = len{2} ==> + good_io4x Glob.mem{2} _iotas /\ + good_rhol Glob.mem{2} rl /\ good_rhor Glob.mem{2} rr /\ + good_jag Glob.mem{2} jag /\ + to_uint res{1}.`1 = _out + _rate /\ + to_uint res{1}.`2 = _outlen - _rate /\ ={Glob.mem} /\ res{1}.`1 = res{2}. +proof. + proc. + seq 0 3 : (#pre /\ + s_state{2} = Array28.init (fun i => state{2}.[i %/ 4] \bits64 i %%4)). + + unroll for{2} ^while; wp; skip => /> *. + apply Array28.tP => i hi /=. + rewrite !initiE //. + do 6! (rewrite set_get_def 1,2:// initiE 1://). + by rewrite set_get_def 1,2:// /= /#. + wp. + while (#pre /\ rate64{1} = len8{2} /\ i{1} = j{2} /\ to_uint rate64{1} = to_uint rate{1} %/8). + + wp; skip => /> *. + rewrite ultE in H13. + have heq1 : to_uint (W64.of_int 8 * j{2}) = 8 * to_uint j{2}. + + rewrite W64.to_uintM_small //= 1:/#. + have -> : to_uint (out{2} + (of_int 8)%W64 * j{2}) = to_uint out{2} + 8 * to_uint j{2}. + + rewrite W64.to_uintD_small heq1 /=; smt (W64.to_uint_cmp). + have -> : to_uint (a_jagged{2} + W64.of_int 8 * j{2}) = to_uint a_jagged{2} + 8 * to_uint j{2}. + + rewrite W64.to_uintD_small heq1 /=; smt (W64.to_uint_cmp). + split; 1: smt (loadW64_storeW64_diff W64.to_uint_cmp). + split; 1: smt (loadW64_storeW64_diff W64.to_uint_cmp). + split; 1: smt (loadW64_storeW64_diff W64.to_uint_cmp). + split; 1: smt (loadW64_storeW64_diff W64.to_uint_cmp). + congr. + have ? : 0 <= to_uint j{2} < 25 by smt(W64.to_uint_cmp). + rewrite H7 1:// to_uintK_jagged 1:// initiE /=; 1: by apply jagged_bound. + by apply get_em_states. + wp; skip => /> *. + rewrite /(`>>`) /= W64.to_uint_shr 1:// /= => *. + by rewrite W64.to_uintD_small 1:/# W64.to_uintB 1:W64.uleE. +qed. + +require import IntExtra. + +equiv extr_bytes_corr : + Keccak_1600_ref_modular.Mmod.xtr_bytes ~ Mmod.xtr_bytes : + disj_ptr (to_uint a_jagged{2}) 200 (to_uint out{1}) (to_uint outlen{1}) /\ + to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint outlen{1} < 200 /\ + good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ + to_uint out{1} + to_uint outlen{1} < W64.modulus /\ + em_states state{2} state{1} /\ ={Glob.mem,out} /\ outlen{1} = len{2} ==> + ={Glob.mem}. +proof. + proc => /=. + seq 0 3 : (#pre /\ + s_state{2} = Array28.init (fun i => state{2}.[i %/ 4] \bits64 i %%4)). + + unroll for{2} ^while; wp; skip => /> *. + apply Array28.tP => i hi /=. + rewrite !initiE //. + do 6! (rewrite set_get_def 1,2:// initiE 1://). + by rewrite set_get_def 1,2:// /= /#. + wp. + seq 4 4: (#pre /\ i{1} = j{2} /\ to_uint j{2} = to_uint len{2} %/ 8). + + while (#pre /\ i{1} = j{2} /\ to_uint outlen8{1} = to_uint outlen{1} %/ 8 /\ outlen8{1} = len8{2} /\ + to_uint j{2} <= to_uint len8{2}). + + wp; skip => |> &1 &2; rewrite !W64.ultE => *. + have heq1 : to_uint (W64.of_int 8 * j{2}) = 8 * to_uint j{2}. + + rewrite W64.to_uintM_small //= 1:/#. + have -> : to_uint (out{2} + (of_int 8)%W64 * j{2}) = to_uint out{2} + 8 * to_uint j{2}. + + rewrite W64.to_uintD_small heq1 /=; smt (W64.to_uint_cmp). + have -> : to_uint (a_jagged{2} + W64.of_int 8 * j{2}) = to_uint a_jagged{2} + 8 * to_uint j{2}. + + rewrite W64.to_uintD_small heq1 /=; smt (W64.to_uint_cmp). + split. + + split; 1: smt (loadW64_storeW64_diff W64.to_uint_cmp). + congr. + have ? : 0 <= to_uint j{2} < 25 by smt(W64.to_uint_cmp). + rewrite H2 1:// to_uintK_jagged 1:// initiE /=; 1: by apply jagged_bound. + by apply get_em_states. + by rewrite W64.to_uintD_small /= /#. + wp; skip => /> *. + rewrite /(`>>`) /= W64.to_uint_shr 1:// /=. + split; 1: smt(W64.to_uint_cmp). + by move => ??; rewrite ultE /(`>>`) /= W64.to_uint_shr 1:// /= /#. + while ( + to_uint outlen{1} < 200 /\ + em_states state{2} state{1} /\ ={Glob.mem, out} /\ outlen{1} = len{2} /\ + s_state{2} = Array28.init (fun (i0 : int) => state{2}.[i0 %/ 4] \bits64 i0 %% 4) /\ + i{1} = j{2} /\ 8 * (to_uint len{2} %/8) <= to_uint j{2} /\ + to_uint l{2} = 8 * A_jagged.[to_uint len{2} %/ 8] + (to_uint j{2} - 8 * (to_uint len{2} %/8))). + + wp; skip => /> &1 &2; rewrite W64.ultE => *. + split; last first. + + rewrite W64.to_uintD_small /=; 1: smt(jagged_bound W64.to_uint_cmp). + rewrite W64.to_uintD_small /=; smt(jagged_bound W64.to_uint_cmp). + congr. + have hj : 0 <= to_uint j{2} < 200 by smt(W64.to_uint_cmp). + rewrite /get8 /init64 WArray200.WArray200.initiE 1:// initiE /=; 1: smt(jagged_bound W64.to_uint_cmp). + rewrite initiE /=; 1: smt(jagged_bound W64.to_uint_cmp). + rewrite (get_em_states _ _ _ _ H0); 1: smt(W64.to_uint_cmp). + smt(W64.to_uint_cmp). + wp; skip => />. + rewrite /disj_ptr /good_jag /em_states. move => *. + rewrite !to_uint_shl; first 2 by smt(@W64). + split; first by smt(@W64). + rewrite to_uintD_small; first by smt(@W64). + rewrite -H5. + rewrite (_: to_uint ((of_int 8)%W64 * j{2}) = 8 * to_uint j{2}); first by smt(@W64). + rewrite H2; first by smt(@W64). + rewrite of_uintK. auto => />. + by smt(@W64 jagged_bound). +qed. + +equiv modcorrect : + Keccak_1600_ref_modular.Mmod.__keccak_1600 ~ Mmod.__keccak_1600 : + disj_ptr (to_uint a_jagged{2}) 200 (to_uint out{2}) (to_uint outlen{2}) /\ + disj_ptr (to_uint iotas{2}) 800 (to_uint out{2}) (to_uint outlen{2}) /\ + disj_ptr (to_uint rhotates_left{2}) 200 (to_uint out{2}) (to_uint outlen{2}) /\ + disj_ptr (to_uint rhotates_right{2}) 200 (to_uint out{2}) (to_uint outlen{2}) /\ + to_uint rate{2} < 200 /\ + to_uint a_jagged{2} + 200 < W64.modulus /\ + to_uint in_0{1} + to_uint inlen{1} < W64.modulus /\ + to_uint rhotates_left{2} + 192 < W64.modulus /\ + to_uint rhotates_right{2} + 192 < W64.modulus /\ + to_uint iotas{2} + 768 < W64.modulus /\ + to_uint out{2} + to_uint outlen{2} < W64.modulus /\ + good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ + good_io4x Glob.mem{2} (to_uint iotas{2}) /\ + good_rhol Glob.mem{2} (to_uint rhotates_left{2}) /\ + good_rhor Glob.mem{2} (to_uint rhotates_right{2}) /\ + in_0{1} = in_0{2} /\ inlen{1} = inlen{2} /\ s_out{1} = out{2} /\ s_outlen{1} = outlen{2} /\ rate{1} = rate{2} /\ truncateu8 s_trail_byte{1} = trail_byte{2} /\ + ={Glob.mem} + ==> + ={Glob.mem}. +proof. + proc => /=. + seq 2 2 : (#pre /\ em_states state{2} state{1}). + + inline *. unroll for {1} 4. unroll for {2} 5. + wp;skip;auto => />. + move => *; rewrite /x86_VPBROADCAST_4u64 /is4u6 /is4u64 => />. + by rewrite /em_states; apply Array7.all_eq_eq. + inline Mmod.absorb. + swap {2} [6..7] -5. + seq 0 3 : (#pre /\ in_00{2} = in_0{1} /\ inlen0{2} = inlen{1} /\ em_states state0{2} state{1}); first by auto => />. + sp 0 6. + seq 0 2 : (#pre /\ forall i, 0 <= i < 28 => s_state{2}.[i] = W64.zero). + + inline *. + unroll for {2} 5. + wp; skip => /> *. + do 7! (rewrite initiE // set_get_def //). + rewrite /x86_VPBROADCAST_4u64 /= W4u64.pack4bE 1:/#. + by rewrite W4u64.Pack.get_of_list 1:/# /= /#. + seq 1 1 : (#{/~em_states state{2} state{1}}{~in_0{1} = in_0{2}}{~inlen{1} = inlen{2}} + {~s_state{2}} + {~forall (i : int), 0 <= i < 28 => s_state{2}.[i] = Keccak_1600_avx2.g_zero} + {~to_uint in_0{2} + to_uint inlen{2} < 18446744073709551616}pre /\ + to_uint inlen{1} < to_uint rate{1}). + + while (#{/~to_uint inlen{1} < to_uint rate{1}} post /\ + jagged_zeros_W64 s_state{2} (to_uint rate0{2} %/ 8)); last first. + + skip => />; smt(jagged_bound W64.uleE). + wp. + ecall (avx2corr state{1} Glob.mem{2}). + wp. + ecall (add_full_block_corr (to_uint rate0{2})). + skip => |> &1 &2. + rewrite W64.uleE => * /#. + seq 3 2 : (#{/~em_states state0{2} state{1}}pre /\ + em_states state{2} state{1}). + + wp; call add_final_block_corr; auto => />. + inline Mmod.squeeze. + swap {2} [2..5] -1; swap {2} 8 -7. + sp 0 5. + seq 1 3 : (#{/~em_states state{2} state{1}}{~out{2}} + {~s_outlen{1} = outlen{2}}pre /\ + disj_ptr (to_uint a_jagged{2}) 200 (to_uint out0{2}) (to_uint outlen0{2}) /\ + disj_ptr (to_uint iotas{2}) 800 (to_uint out0{2}) (to_uint outlen0{2}) /\ + disj_ptr (to_uint rhotates_left{2}) 200 (to_uint out0{2}) (to_uint outlen0{2}) /\ + disj_ptr (to_uint rhotates_right{2}) 200 (to_uint out0{2}) (to_uint outlen0{2}) /\ + to_uint out0{2} + to_uint outlen0{2} < 18446744073709551616 /\ + out0{2} = s_out{1} /\ outlen0{2} = outlen{1} /\ + em_states state1{2} state{1} /\ + good_io4x Glob.mem{2} (to_uint iotas{2}) /\ + good_rhol Glob.mem{2} (to_uint rhotates_left{2}) /\ + good_rhor Glob.mem{2} (to_uint rhotates_right{2})); + first by auto => />. + call extr_bytes_corr; wp. + ecall (avx2corr state{1} Glob.mem{2}); wp. + while #pre. + + swap {1} 4 2. + wp. + ecall (extr_full_block_corr (to_uint outlen0{2}) (to_uint rate{2}) (to_uint out0{2}) (to_uint iotas{2}) + (to_uint rhotates_left{2}) (to_uint rhotates_right{2}) (to_uint a_jagged{2})). + wp; ecall (avx2corr state{1} Glob.mem{2}); auto => /> &1 &2 *. + split; 1: smt (W64.ultE). + move=> ? [o l] /> ?;rewrite !W64.ultE => *. + rewrite W64.to_uint_eq W64.to_uintB 1:uleE 1://; smt(W64.to_uint_cmp). + skip => /> &1 &2 *. smt(W64.ultE). +qed. diff --git a/sha3/proof/impl/libc/keccak_1600_ref.ec b/sha3/proof/impl/libc/keccak_1600_ref.ec new file mode 100644 index 0000000..a5884e8 --- /dev/null +++ b/sha3/proof/impl/libc/keccak_1600_ref.ec @@ -0,0 +1,443 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array5 Array24 Array25. +require import WArray40 WArray192 WArray200. + + + +module M = { + proc index (x:int, y:int) : int = { + + var r:int; + + r <- ((x %% 5) + (5 * (y %% 5))); + return (r); + } + + proc theta (a:W64.t Array25.t) : W64.t Array25.t = { + var aux_1: bool; + var aux_0: bool; + var aux: int; + var aux_2: W64.t; + + var x:int; + var c:W64.t Array5.t; + var y:int; + var d:W64.t Array5.t; + var _0:bool; + var _1:bool; + c <- witness; + d <- witness; + x <- 0; + while (x < 5) { + c.[x] <- (W64.of_int 0); + y <- 0; + while (y < 5) { + c.[x] <- (c.[x] `^` a.[(x + (5 * y))]); + y <- y + 1; + } + x <- x + 1; + } + x <- 0; + while (x < 5) { + d.[x] <- c.[((x + 1) %% 5)]; + (aux_1, aux_0, aux_2) <- x86_ROL_64 d.[x] (W8.of_int 1); + _0 <- aux_1; + _1 <- aux_0; + d.[x] <- aux_2; + d.[x] <- (d.[x] `^` c.[((x + 4) %% 5)]); + x <- x + 1; + } + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + a.[(x + (5 * y))] <- (a.[(x + (5 * y))] `^` d.[x]); + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc keccakRhoOffsets (i:int) : int = { + var aux: int; + + var r:int; + var x:int; + var y:int; + var t:int; + var z:int; + + r <- 0; + x <- 1; + y <- 0; + t <- 0; + while (t < 24) { + if ((i = (x + (5 * y)))) { + r <- ((((t + 1) * (t + 2)) %/ 2) %% 64); + } else { + + } + z <- (((2 * x) + (3 * y)) %% 5); + x <- y; + y <- z; + t <- t + 1; + } + return (r); + } + + proc rho (a:W64.t Array25.t) : W64.t Array25.t = { + var aux_1: bool; + var aux_0: bool; + var aux: int; + var aux_2: W64.t; + + var x:int; + var y:int; + var i:int; + var z:int; + var _0:bool; + var _1:bool; + + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + i <@ index (x, y); + z <@ keccakRhoOffsets (i); + (aux_1, aux_0, aux_2) <- x86_ROL_64 a.[i] (W8.of_int z); + _0 <- aux_1; + _1 <- aux_0; + a.[i] <- aux_2; + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc pi (a:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var i:int; + var t:W64.t; + var b:W64.t Array25.t; + var y:int; + var x:int; + b <- witness; + i <- 0; + while (i < 25) { + t <- a.[i]; + b.[i] <- t; + i <- i + 1; + } + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + t <- b.[(x + (5 * y))]; + i <@ index (y, ((2 * x) + (3 * y))); + a.[i] <- t; + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc chi (a:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var x:int; + var y:int; + var i:int; + var c:W64.t Array5.t; + c <- witness; + y <- 0; + while (y < 5) { + x <- 0; + while (x < 5) { + i <@ index ((x + 1), y); + c.[x] <- a.[i]; + c.[x] <- (invw c.[x]); + i <@ index ((x + 2), y); + c.[x] <- (c.[x] `&` a.[i]); + i <@ index (x, y); + c.[x] <- (c.[x] `^` a.[i]); + x <- x + 1; + } + x <- 0; + while (x < 5) { + a.[(x + (5 * y))] <- c.[x]; + x <- x + 1; + } + y <- y + 1; + } + return (a); + } + + proc iota_0 (a:W64.t Array25.t, c:W64.t) : W64.t Array25.t = { + + + + a.[0] <- (a.[0] `^` c); + return (a); + } + + proc keccakP1600_round (state:W64.t Array25.t, c:W64.t) : W64.t Array25.t = { + + + + state <@ theta (state); + state <@ rho (state); + state <@ pi (state); + state <@ chi (state); + state <@ iota_0 (state, c); + return (state); + } + + proc keccakRoundConstants () : W64.t Array24.t = { + + var constants:W64.t Array24.t; + var t:W64.t; + constants <- witness; + t <- (W64.of_int 1); + constants.[0] <- t; + t <- (W64.of_int 32898); + constants.[1] <- t; + t <- (W64.of_int 9223372036854808714); + constants.[2] <- t; + t <- (W64.of_int 9223372039002292224); + constants.[3] <- t; + t <- (W64.of_int 32907); + constants.[4] <- t; + t <- (W64.of_int 2147483649); + constants.[5] <- t; + t <- (W64.of_int 9223372039002292353); + constants.[6] <- t; + t <- (W64.of_int 9223372036854808585); + constants.[7] <- t; + t <- (W64.of_int 138); + constants.[8] <- t; + t <- (W64.of_int 136); + constants.[9] <- t; + t <- (W64.of_int 2147516425); + constants.[10] <- t; + t <- (W64.of_int 2147483658); + constants.[11] <- t; + t <- (W64.of_int 2147516555); + constants.[12] <- t; + t <- (W64.of_int 9223372036854775947); + constants.[13] <- t; + t <- (W64.of_int 9223372036854808713); + constants.[14] <- t; + t <- (W64.of_int 9223372036854808579); + constants.[15] <- t; + t <- (W64.of_int 9223372036854808578); + constants.[16] <- t; + t <- (W64.of_int 9223372036854775936); + constants.[17] <- t; + t <- (W64.of_int 32778); + constants.[18] <- t; + t <- (W64.of_int 9223372039002259466); + constants.[19] <- t; + t <- (W64.of_int 9223372039002292353); + constants.[20] <- t; + t <- (W64.of_int 9223372036854808704); + constants.[21] <- t; + t <- (W64.of_int 2147483649); + constants.[22] <- t; + t <- (W64.of_int 9223372039002292232); + constants.[23] <- t; + return (constants); + } + + proc __keccak_f1600_ref (state:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var constants:W64.t Array24.t; + var round:int; + constants <- witness; + constants <@ keccakRoundConstants (); + round <- 0; + while (round < 24) { + state <@ keccakP1600_round (state, constants.[round]); + round <- round + 1; + } + return (state); + } + + proc st0 () : W64.t Array25.t = { + var aux: int; + + var state:W64.t Array25.t; + var i:int; + state <- witness; + i <- 0; + while (i < 25) { + state.[i] <- (W64.of_int 0); + i <- i + 1; + } + return (state); + } + + proc add_full_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, + r8:W64.t) : W64.t Array25.t * W64.t * W64.t = { + + var r64:W64.t; + var i:W64.t; + var t:W64.t; + + r64 <- r8; + r64 <- (r64 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult r64)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); + i <- (i + (W64.of_int 1)); + } + in_0 <- (in_0 + r8); + inlen <- (inlen - r8); + return (state, in_0, inlen); + } + + proc add_final_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, + trail_byte:W8.t, r8:W64.t) : W64.t Array25.t = { + + var inlen8:W64.t; + var i:W64.t; + var t:W64.t; + var c:W8.t; + + inlen8 <- inlen; + inlen8 <- (inlen8 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult inlen8)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); + i <- (i + (W64.of_int 1)); + } + i <- (i `<<` (W8.of_int 3)); + + while ((i \ult inlen)) { + c <- (loadW8 Glob.mem (W64.to_uint (in_0 + i))); + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` c))); + i <- (i + (W64.of_int 1)); + } + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` trail_byte))); + i <- r8; + i <- (i - (W64.of_int 1)); + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` (W8.of_int 128)))); + return (state); + } + + proc xtr_full_block (state:W64.t Array25.t, out:W64.t, outlen:W64.t, + rate:W64.t) : W64.t * W64.t = { + + var rate64:W64.t; + var i:W64.t; + var t:W64.t; + + rate64 <- rate; + rate64 <- (rate64 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult rate64)) { + t <- state.[(W64.to_uint i)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; + i <- (i + (W64.of_int 1)); + } + out <- (out + rate); + outlen <- (outlen - rate); + return (out, outlen); + } + + proc xtr_bytes (state:W64.t Array25.t, out:W64.t, outlen:W64.t) : unit = { + + var outlen8:W64.t; + var i:W64.t; + var t:W64.t; + var c:W8.t; + + outlen8 <- outlen; + outlen8 <- (outlen8 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult outlen8)) { + t <- state.[(W64.to_uint i)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; + i <- (i + (W64.of_int 1)); + } + i <- (i `<<` (W8.of_int 3)); + + while ((i \ult outlen)) { + c <- (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)); + Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + i)) c; + i <- (i + (W64.of_int 1)); + } + return (); + } + + proc __keccak_1600 (s_out:W64.t, s_outlen:W64.t, in_0:W64.t, inlen:W64.t, + s_trail_byte:W64.t, rate:W64.t) : unit = { + + var state:W64.t Array25.t; + var s_in:W64.t; + var s_inlen:W64.t; + var s_rate:W64.t; + var t:W64.t; + var trail_byte:W8.t; + var outlen:W64.t; + var out:W64.t; + state <- witness; + state <@ st0 (); + + while ((rate \ule inlen)) { + (state, in_0, inlen) <@ add_full_block (state, in_0, inlen, rate); + s_in <- in_0; + s_inlen <- inlen; + s_rate <- rate; + state <@ __keccak_f1600_ref (state); + inlen <- s_inlen; + in_0 <- s_in; + rate <- s_rate; + } + t <- s_trail_byte; + trail_byte <- (truncateu8 t); + state <@ add_final_block (state, in_0, inlen, trail_byte, rate); + outlen <- s_outlen; + + while ((rate \ult outlen)) { + s_outlen <- outlen; + s_rate <- rate; + state <@ __keccak_f1600_ref (state); + out <- s_out; + outlen <- s_outlen; + rate <- s_rate; + (out, outlen) <@ xtr_full_block (state, out, outlen, rate); + s_outlen <- outlen; + s_out <- out; + } + state <@ __keccak_f1600_ref (state); + out <- s_out; + outlen <- s_outlen; + xtr_bytes (state, out, outlen); + return (); + } +}. + diff --git a/sha3/proof/impl/libc/keccak_1600_ref_modular.ec b/sha3/proof/impl/libc/keccak_1600_ref_modular.ec new file mode 100644 index 0000000..0c7edac --- /dev/null +++ b/sha3/proof/impl/libc/keccak_1600_ref_modular.ec @@ -0,0 +1,232 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array5 Array24 Array25. +require import WArray40 WArray192 WArray200. + +require import Keccak_f1600_ref. + + +module Mmod = { + include Keccak_f1600_ref.M + + proc st0 () : W64.t Array25.t = { + var aux: int; + + var state:W64.t Array25.t; + var i:int; + state <- witness; + i <- 0; + while (i < 25) { + state.[i] <- (W64.of_int 0); + i <- i + 1; + } + return (state); + } + + proc add_full_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, + rate:W64.t) : W64.t Array25.t * W64.t * W64.t = { + + var rate64:W64.t; + var i:W64.t; + var t:W64.t; + + rate64 <- rate; + rate64 <- (rate64 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult rate64)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); + i <- (i + (W64.of_int 1)); + } + in_0 <- (in_0 + rate); + inlen <- (inlen - rate); + return (state, in_0, inlen); + } + + proc add_final_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, + trail_byte:W8.t, r8:W64.t) : W64.t Array25.t = { + + var inlen8:W64.t; + var i:W64.t; + var t:W64.t; + var c:W8.t; + + inlen8 <- inlen; + inlen8 <- (inlen8 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult inlen8)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); + i <- (i + (W64.of_int 1)); + } + i <- (i `<<` (W8.of_int 3)); + + while ((i \ult inlen)) { + c <- (loadW8 Glob.mem (W64.to_uint (in_0 + i))); + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` c))); + i <- (i + (W64.of_int 1)); + } + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` trail_byte))); + i <- r8; + i <- (i - (W64.of_int 1)); + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` (W8.of_int 128)))); + return (state); + } + + proc xtr_full_block (state:W64.t Array25.t, out:W64.t, outlen:W64.t, + rate:W64.t) : W64.t * W64.t = { + + var rate64:W64.t; + var i:W64.t; + var t:W64.t; + + rate64 <- rate; + rate64 <- (rate64 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult rate64)) { + t <- state.[(W64.to_uint i)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; + i <- (i + (W64.of_int 1)); + } + out <- (out + rate); + outlen <- (outlen - rate); + return (out, outlen); + } + + proc xtr_bytes (state:W64.t Array25.t, out:W64.t, outlen:W64.t) : unit = { + + var outlen8:W64.t; + var i:W64.t; + var t:W64.t; + var c:W8.t; + + outlen8 <- outlen; + outlen8 <- (outlen8 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult outlen8)) { + t <- state.[(W64.to_uint i)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; + i <- (i + (W64.of_int 1)); + } + i <- (i `<<` (W8.of_int 3)); + + while ((i \ult outlen)) { + c <- (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)); + Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + i)) c; + i <- (i + (W64.of_int 1)); + } + return (); + } + + proc __keccak_1600 (s_out:W64.t, s_outlen:W64.t, in_0:W64.t, inlen:W64.t, + s_trail_byte:W64.t, rate:W64.t) : unit = { + + var state:W64.t Array25.t; + var s_in:W64.t; + var s_inlen:W64.t; + var s_rate:W64.t; + var t:W64.t; + var trail_byte:W8.t; + var outlen:W64.t; + var out:W64.t; + state <- witness; + state <@ st0 (); + + while ((rate \ule inlen)) { + (state, in_0, inlen) <@ add_full_block (state, in_0, inlen, rate); + s_in <- in_0; + s_inlen <- inlen; + s_rate <- rate; + state <@ __keccak_f1600_ref (state); + inlen <- s_inlen; + in_0 <- s_in; + rate <- s_rate; + } + t <- s_trail_byte; + trail_byte <- (truncateu8 t); + state <@ add_final_block (state, in_0, inlen, trail_byte, rate); + outlen <- s_outlen; + + while ((rate \ult outlen)) { + s_outlen <- outlen; + s_rate <- rate; + state <@ __keccak_f1600_ref (state); + out <- s_out; + outlen <- s_outlen; + rate <- s_rate; + (out, outlen) <@ xtr_full_block (state, out, outlen, rate); + s_out <- out; + } + s_outlen <- outlen; + state <@ __keccak_f1600_ref (state); + out <- s_out; + outlen <- s_outlen; + xtr_bytes (state, out, outlen); + return (); + } + +}. + + +require import Keccak_1600_ref. + +equiv modfgood : + Mmod.__keccak_f1600_ref ~ M.__keccak_f1600_ref: + ={Glob.mem,arg} ==> ={Glob.mem,res}. +proc. +while (#post /\ ={constants,round}). +wp. +call(_: ={Glob.mem}). +call(_: ={Glob.mem}); first by sim. +call(_: ={Glob.mem}); first by sim. +call(_: ={Glob.mem}); first by sim. +call(_: ={Glob.mem}); first by sim. +call(_: ={Glob.mem}). +seq 4 4 : (#pre /\ ={c}); first by sim. +seq 2 2 : (#pre /\ ={d}). +unroll for {1} 2. +unroll for {2} 2. +auto => />. move => &1 &2. apply Array5.ext_eq. smt(@Array5). +by sim. +by auto => />. +by auto => />. +by inline *; auto => />. +qed. + +equiv modgood : + Mmod.__keccak_1600 ~ M.__keccak_1600 : + ={Glob.mem,arg} ==> ={Glob.mem,res}. +proc. +call(_: ={Glob.mem}); first by sim. +wp;call(modfgood). +wp. +while(#post /\ ={rate,s_out,outlen,rate}). +wp;call(_: ={Glob.mem}); first by sim. +wp;call(modfgood). +by wp;skip;auto => />. +wp;call(_: ={Glob.mem}); first by sim. +wp. +while(#post /\ ={rate,in_0,inlen,s_outlen,s_out,rate}). +wp. +call(modfgood). +wp;call(_: ={Glob.mem}); first by sim. +by wp;skip;auto => />. +by inline *;auto => />;sim. +qed. + diff --git a/sha3/proof/impl/libc/keccak_1600_scalar.ec b/sha3/proof/impl/libc/keccak_1600_scalar.ec new file mode 100644 index 0000000..d33a9c7 --- /dev/null +++ b/sha3/proof/impl/libc/keccak_1600_scalar.ec @@ -0,0 +1,448 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array5 Array25. +require import WArray40 WArray200. + +module M = { + proc index (x:int, y:int) : int = { + + var r:int; + + r <- ((5 * (x %% 5)) + (y %% 5)); + return (r); + } + + proc keccak_rho_offsets (i:int) : int = { + var aux: int; + + var r:int; + var x:int; + var y:int; + var t:int; + var z:int; + + r <- 0; + x <- 1; + y <- 0; + t <- 0; + while (t < 24) { + if ((i = (x + (5 * y)))) { + r <- ((((t + 1) * (t + 2)) %/ 2) %% 64); + } else { + + } + z <- (((2 * x) + (3 * y)) %% 5); + x <- y; + y <- z; + t <- t + 1; + } + return (r); + } + + proc rhotates (x:int, y:int) : int = { + + var r:int; + var i:int; + + i <@ index (x, y); + r <@ keccak_rho_offsets (i); + return (r); + } + + proc rOL64 (x:W64.t, c:int) : W64.t = { + + var y:W64.t; + var _0:bool; + var _1:bool; + + if ((c = 0)) { + y <- x; + } else { + ( _0, _1, y) <- x86_ROL_64 x (W8.of_int c); + } + return (y); + } + + proc theta_sum (a:W64.t Array25.t) : W64.t Array5.t = { + var aux: int; + + var c:W64.t Array5.t; + var i:int; + var j:int; + c <- witness; + i <- 0; + while (i < 5) { + c.[i] <- a.[((5 * (0 %% 5)) + (i %% 5))]; + i <- i + 1; + } + j <- 1; + while (j < 5) { + i <- 0; + while (i < 5) { + c.[i] <- (c.[i] `^` a.[((5 * (j %% 5)) + (i %% 5))]); + i <- i + 1; + } + j <- j + 1; + } + return (c); + } + + proc theta_rol (c:W64.t Array5.t) : W64.t Array5.t = { + var aux_1: bool; + var aux_0: bool; + var aux: int; + var aux_2: W64.t; + + var d:W64.t Array5.t; + var i:int; + var _0:bool; + var _1:bool; + d <- witness; + i <- 0; + while (i < 5) { + d.[i] <- c.[((i + 1) %% 5)]; + (aux_1, aux_0, aux_2) <- x86_ROL_64 d.[i] (W8.of_int 1); + _0 <- aux_1; + _1 <- aux_0; + d.[i] <- aux_2; + d.[i] <- (d.[i] `^` c.[((i + 4) %% 5)]); + i <- i + 1; + } + return (d); + } + + proc rol_sum (d:W64.t Array5.t, a:W64.t Array25.t, offset:int) : W64.t Array5.t = { + var aux: int; + + var c:W64.t Array5.t; + var j:int; + var j1:int; + var k:int; + var t:W64.t; + c <- witness; + j <- 0; + while (j < 5) { + j1 <- ((j + offset) %% 5); + k <@ rhotates (j, j1); + t <- a.[((5 * (j %% 5)) + (j1 %% 5))]; + t <- (t `^` d.[j1]); + t <@ rOL64 (t, k); + c.[j] <- t; + j <- j + 1; + } + return (c); + } + + proc set_row (r:W64.t Array25.t, row:int, c:W64.t Array5.t, iota_0:W64.t) : + W64.t Array25.t = { + var aux: int; + + var j:int; + var j1:int; + var j2:int; + var t:W64.t; + + j <- 0; + while (j < 5) { + j1 <- ((j + 1) %% 5); + j2 <- ((j + 2) %% 5); + t <- ((invw c.[j1]) `&` c.[j2]); + if (((row = 0) /\ (j = 0))) { + t <- (t `^` iota_0); + } else { + + } + t <- (t `^` c.[j]); + r.[((5 * (row %% 5)) + (j %% 5))] <- t; + j <- j + 1; + } + return (r); + } + + proc round2x (a:W64.t Array25.t, r:W64.t Array25.t, iotas:W64.t, o:int) : + W64.t Array25.t * W64.t Array25.t = { + + var iota_0:W64.t; + var c:W64.t Array5.t; + var d:W64.t Array5.t; + c <- witness; + d <- witness; + iota_0 <- (loadW64 Glob.mem (W64.to_uint (iotas + (W64.of_int o)))); + c <@ theta_sum (a); + d <@ theta_rol (c); + c <@ rol_sum (d, a, 0); + r <@ set_row (r, 0, c, iota_0); + c <@ rol_sum (d, a, 3); + r <@ set_row (r, 1, c, iota_0); + c <@ rol_sum (d, a, 1); + r <@ set_row (r, 2, c, iota_0); + c <@ rol_sum (d, a, 4); + r <@ set_row (r, 3, c, iota_0); + c <@ rol_sum (d, a, 2); + r <@ set_row (r, 4, c, iota_0); + return (a, r); + } + + proc __keccak_f1600_scalar (a:W64.t Array25.t, iotas:W64.t) : W64.t Array25.t * + W64.t = { + + var zf:bool; + var r:W64.t Array25.t; + var _0:bool; + var _1:bool; + var _2:bool; + var _3:bool; + r <- witness; + (a, r) <@ round2x (a, r, iotas, 0); + (r, a) <@ round2x (r, a, iotas, 8); + iotas <- (iotas + (W64.of_int 16)); + ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + while ((! zf)) { + (a, r) <@ round2x (a, r, iotas, 0); + (r, a) <@ round2x (r, a, iotas, 8); + iotas <- (iotas + (W64.of_int 16)); + ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + } + iotas <- (iotas - (W64.of_int 192)); + return (a, iotas); + } + + proc spill_2 (a:W64.t, b:W64.t) : W64.t * W64.t = { + + var sa:W64.t; + var sb:W64.t; + + sa <- a; + sb <- b; + return (sa, sb); + } + + proc spill_3 (a:W64.t, b:W64.t, c:W64.t) : W64.t * W64.t * W64.t = { + + var sa:W64.t; + var sb:W64.t; + var sc:W64.t; + + sa <- a; + sb <- b; + sc <- c; + return (sa, sb, sc); + } + + proc load_2 (sa:W64.t, sb:W64.t) : W64.t * W64.t = { + + var a:W64.t; + var b:W64.t; + + a <- sa; + b <- sb; + return (a, b); + } + + proc load_3 (sa:W64.t, sb:W64.t, sc:W64.t) : W64.t * W64.t * W64.t = { + + var a:W64.t; + var b:W64.t; + var c:W64.t; + + a <- sa; + b <- sb; + c <- sc; + return (a, b, c); + } + + proc keccak_init () : W64.t Array25.t = { + + var state:W64.t Array25.t; + var t:W64.t; + var i:W64.t; + var _0:bool; + var _1:bool; + var _2:bool; + var _3:bool; + var _4:bool; + state <- witness; + ( _0, _1, _2, _3, _4, t) <- set0_64 ; + i <- (W64.of_int 0); + + while ((i \ult (W64.of_int 25))) { + state.[(W64.to_uint i)] <- t; + i <- (i + (W64.of_int 1)); + } + return (state); + } + + proc add_full_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, + rate:W64.t) : W64.t Array25.t * W64.t * W64.t = { + + var rate64:W64.t; + var i:W64.t; + var t:W64.t; + + rate64 <- rate; + rate64 <- (rate64 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult rate64)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); + i <- (i + (W64.of_int 1)); + } + in_0 <- (in_0 + rate); + inlen <- (inlen - rate); + return (state, in_0, inlen); + } + + proc add_final_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, + trail_byte:W8.t, rate:W64.t) : W64.t Array25.t = { + + var inlen8:W64.t; + var i:W64.t; + var t:W64.t; + var c:W8.t; + + inlen8 <- inlen; + inlen8 <- (inlen8 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult inlen8)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); + i <- (i + (W64.of_int 1)); + } + i <- (i `<<` (W8.of_int 3)); + + while ((i \ult inlen)) { + c <- (loadW8 Glob.mem (W64.to_uint (in_0 + i))); + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` c))); + i <- (i + (W64.of_int 1)); + } + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` trail_byte))); + i <- rate; + i <- (i - (W64.of_int 1)); + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` (W8.of_int 128)))); + return (state); + } + + proc absorb (state:W64.t Array25.t, iotas:W64.t, in_0:W64.t, inlen:W64.t, + s_trail_byte:W64.t, rate:W64.t) : W64.t Array25.t * W64.t * + W64.t = { + + var s_in:W64.t; + var s_inlen:W64.t; + var s_rate:W64.t; + var t:W64.t; + var trail_byte:W8.t; + + + while ((rate \ule inlen)) { + (state, in_0, inlen) <@ add_full_block (state, in_0, inlen, rate); + (s_in, s_inlen, s_rate) <@ spill_3 (in_0, inlen, rate); + (state, iotas) <@ __keccak_f1600_scalar (state, iotas); + (in_0, inlen, rate) <@ load_3 (s_in, s_inlen, s_rate); + } + t <- s_trail_byte; + trail_byte <- (truncateu8 t); + state <@ add_final_block (state, in_0, inlen, trail_byte, rate); + return (state, iotas, rate); + } + + proc xtr_full_block (state:W64.t Array25.t, out:W64.t, outlen:W64.t, + rate:W64.t) : W64.t * W64.t = { + + var rate64:W64.t; + var i:W64.t; + var t:W64.t; + + rate64 <- rate; + rate64 <- (rate64 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult rate64)) { + t <- state.[(W64.to_uint i)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; + i <- (i + (W64.of_int 1)); + } + out <- (out + rate); + outlen <- (outlen - rate); + return (out, outlen); + } + + proc xtr_bytes (state:W64.t Array25.t, out:W64.t, outlen:W64.t) : W64.t = { + + var outlen8:W64.t; + var i:W64.t; + var t:W64.t; + var c:W8.t; + + outlen8 <- outlen; + outlen8 <- (outlen8 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult outlen8)) { + t <- state.[(W64.to_uint i)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; + i <- (i + (W64.of_int 1)); + } + i <- (i `<<` (W8.of_int 3)); + + while ((i \ult outlen)) { + c <- (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)); + Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + i)) c; + i <- (i + (W64.of_int 1)); + } + out <- (out + outlen); + return (out); + } + + proc squeeze (state:W64.t Array25.t, iotas:W64.t, s_out:W64.t, + outlen:W64.t, rate:W64.t) : unit = { + + var s_outlen:W64.t; + var s_rate:W64.t; + var out:W64.t; + + + while ((rate \ult outlen)) { + (s_outlen, s_rate) <@ spill_2 (outlen, rate); + (state, iotas) <@ __keccak_f1600_scalar (state, iotas); + (out, outlen, rate) <@ load_3 (s_out, s_outlen, s_rate); + (out, outlen) <@ xtr_full_block (state, out, outlen, rate); + s_out <- out; + } + s_outlen <- outlen; + (state, iotas) <@ __keccak_f1600_scalar (state, iotas); + (out, outlen) <@ load_2 (s_out, s_outlen); + out <@ xtr_bytes (state, out, outlen); + return (); + } + + proc __keccak_1600 (s_out:W64.t, s_outlen:W64.t, iotas:W64.t, in_0:W64.t, + inlen:W64.t, s_trail_byte:W64.t, rate:W64.t) : unit = { + + var state:W64.t Array25.t; + var outlen:W64.t; + state <- witness; + state <@ keccak_init (); + (state, iotas, rate) <@ absorb (state, iotas, in_0, inlen, s_trail_byte, + rate); + outlen <- s_outlen; + squeeze (state, iotas, s_out, outlen, rate); + return (); + } +}. + diff --git a/sha3/proof/impl/libc/keccak_1600_scalar_CT.ec b/sha3/proof/impl/libc/keccak_1600_scalar_CT.ec new file mode 100644 index 0000000..08817aa --- /dev/null +++ b/sha3/proof/impl/libc/keccak_1600_scalar_CT.ec @@ -0,0 +1,1564 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array5 Array25. +require import WArray40 WArray200. + +require import Keccak_1600_scalar. + +module M = { + var leakages : leakages_t + + proc index (x:int, y:int) : int = { + var aux: int; + + var r:int; + + leakages <- LeakAddr([]) :: leakages; + aux <- ((5 * (x %% 5)) + (y %% 5)); + r <- aux; + return (r); + } + + proc keccak_rho_offsets (i:int) : int = { + var aux: int; + + var r:int; + var x:int; + var y:int; + var t:int; + var z:int; + + leakages <- LeakAddr([]) :: leakages; + aux <- 0; + r <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- 1; + x <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- 0; + y <- aux; + leakages <- LeakFor(0,24) :: LeakAddr([]) :: leakages; + t <- 0; + while (t < 24) { + leakages <- LeakCond((i = (x + (5 * y)))) :: LeakAddr([]) :: leakages; + if ((i = (x + (5 * y)))) { + leakages <- LeakAddr([]) :: leakages; + aux <- ((((t + 1) * (t + 2)) %/ 2) %% 64); + r <- aux; + } else { + + } + leakages <- LeakAddr([]) :: leakages; + aux <- (((2 * x) + (3 * y)) %% 5); + z <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- y; + x <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- z; + y <- aux; + t <- t + 1; + } + return (r); + } + + proc rhotates (x:int, y:int) : int = { + var aux: int; + + var r:int; + var i:int; + + leakages <- LeakAddr([]) :: leakages; + aux <@ index (x, y); + i <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <@ keccak_rho_offsets (i); + r <- aux; + return (r); + } + + proc rOL64 (x:W64.t, c:int) : W64.t = { + var aux_1: bool; + var aux_0: bool; + var aux: W64.t; + + var y:W64.t; + var _0:bool; + var _1:bool; + + leakages <- LeakCond((c = 0)) :: LeakAddr([]) :: leakages; + if ((c = 0)) { + leakages <- LeakAddr([]) :: leakages; + aux <- x; + y <- aux; + } else { + leakages <- LeakAddr([]) :: leakages; + (aux_1, aux_0, aux) <- x86_ROL_64 x (W8.of_int c); + _0 <- aux_1; + _1 <- aux_0; + y <- aux; + } + return (y); + } + + proc theta_sum (a:W64.t Array25.t) : W64.t Array5.t = { + var aux: int; + var aux_0: W64.t; + + var c:W64.t Array5.t; + var i:int; + var j:int; + c <- witness; + leakages <- LeakFor(0,5) :: LeakAddr([]) :: leakages; + i <- 0; + while (i < 5) { + leakages <- LeakAddr([((5 * (0 %% 5)) + (i %% 5))]) :: leakages; + aux_0 <- a.[((5 * (0 %% 5)) + (i %% 5))]; + leakages <- LeakAddr([i]) :: leakages; + c.[i] <- aux_0; + i <- i + 1; + } + leakages <- LeakFor(1,5) :: LeakAddr([]) :: leakages; + j <- 1; + while (j < 5) { + leakages <- LeakFor(0,5) :: LeakAddr([]) :: leakages; + i <- 0; + while (i < 5) { + leakages <- LeakAddr([((5 * (j %% 5)) + (i %% 5)); i]) :: leakages; + aux_0 <- (c.[i] `^` a.[((5 * (j %% 5)) + (i %% 5))]); + leakages <- LeakAddr([i]) :: leakages; + c.[i] <- aux_0; + i <- i + 1; + } + j <- j + 1; + } + return (c); + } + + proc theta_rol (c:W64.t Array5.t) : W64.t Array5.t = { + var aux_2: bool; + var aux_1: bool; + var aux: int; + var aux_0: W64.t; + + var d:W64.t Array5.t; + var i:int; + var _0:bool; + var _1:bool; + d <- witness; + leakages <- LeakFor(0,5) :: LeakAddr([]) :: leakages; + i <- 0; + while (i < 5) { + leakages <- LeakAddr([((i + 1) %% 5)]) :: leakages; + aux_0 <- c.[((i + 1) %% 5)]; + leakages <- LeakAddr([i]) :: leakages; + d.[i] <- aux_0; + leakages <- LeakAddr([i]) :: leakages; + (aux_2, aux_1, aux_0) <- x86_ROL_64 d.[i] (W8.of_int 1); + _0 <- aux_2; + _1 <- aux_1; + leakages <- LeakAddr([i]) :: leakages; + d.[i] <- aux_0; + leakages <- LeakAddr([((i + 4) %% 5); i]) :: leakages; + aux_0 <- (d.[i] `^` c.[((i + 4) %% 5)]); + leakages <- LeakAddr([i]) :: leakages; + d.[i] <- aux_0; + i <- i + 1; + } + return (d); + } + + proc rol_sum (d:W64.t Array5.t, a:W64.t Array25.t, offset:int) : W64.t Array5.t = { + var aux: int; + var aux_0: W64.t; + + var c:W64.t Array5.t; + var j:int; + var j1:int; + var k:int; + var t:W64.t; + c <- witness; + leakages <- LeakFor(0,5) :: LeakAddr([]) :: leakages; + j <- 0; + while (j < 5) { + leakages <- LeakAddr([]) :: leakages; + aux <- ((j + offset) %% 5); + j1 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <@ rhotates (j, j1); + k <- aux; + leakages <- LeakAddr([((5 * (j %% 5)) + (j1 %% 5))]) :: leakages; + aux_0 <- a.[((5 * (j %% 5)) + (j1 %% 5))]; + t <- aux_0; + leakages <- LeakAddr([j1]) :: leakages; + aux_0 <- (t `^` d.[j1]); + t <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <@ rOL64 (t, k); + t <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- t; + leakages <- LeakAddr([j]) :: leakages; + c.[j] <- aux_0; + j <- j + 1; + } + return (c); + } + + proc set_row (r:W64.t Array25.t, row:int, c:W64.t Array5.t, iota_0:W64.t) : + W64.t Array25.t = { + var aux: int; + var aux_0: W64.t; + + var j:int; + var j1:int; + var j2:int; + var t:W64.t; + + leakages <- LeakFor(0,5) :: LeakAddr([]) :: leakages; + j <- 0; + while (j < 5) { + leakages <- LeakAddr([]) :: leakages; + aux <- ((j + 1) %% 5); + j1 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- ((j + 2) %% 5); + j2 <- aux; + leakages <- LeakAddr([j2; j1]) :: leakages; + aux_0 <- ((invw c.[j1]) `&` c.[j2]); + t <- aux_0; + leakages <- LeakCond(((row = 0) /\ (j = 0))) :: LeakAddr([]) :: leakages; + if (((row = 0) /\ (j = 0))) { + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (t `^` iota_0); + t <- aux_0; + } else { + + } + leakages <- LeakAddr([j]) :: leakages; + aux_0 <- (t `^` c.[j]); + t <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- t; + leakages <- LeakAddr([((5 * (row %% 5)) + (j %% 5))]) :: leakages; + r.[((5 * (row %% 5)) + (j %% 5))] <- aux_0; + j <- j + 1; + } + return (r); + } + + proc round2x (a:W64.t Array25.t, r:W64.t Array25.t, iotas:W64.t, o:int) : + W64.t Array25.t * W64.t Array25.t = { + var aux: W64.t; + var aux_0: W64.t Array5.t; + var aux_1: W64.t Array25.t; + + var iota_0:W64.t; + var c:W64.t Array5.t; + var d:W64.t Array5.t; + c <- witness; + d <- witness; + leakages <- LeakAddr([(W64.to_uint (iotas + (W64.of_int o)))]) :: leakages; + aux <- (loadW64 Glob.mem (W64.to_uint (iotas + (W64.of_int o)))); + iota_0 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux_0 <@ theta_sum (a); + c <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <@ theta_rol (c); + d <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <@ rol_sum (d, a, 0); + c <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_1 <@ set_row (r, 0, c, iota_0); + r <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_0 <@ rol_sum (d, a, 3); + c <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_1 <@ set_row (r, 1, c, iota_0); + r <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_0 <@ rol_sum (d, a, 1); + c <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_1 <@ set_row (r, 2, c, iota_0); + r <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_0 <@ rol_sum (d, a, 4); + c <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_1 <@ set_row (r, 3, c, iota_0); + r <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_0 <@ rol_sum (d, a, 2); + c <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_1 <@ set_row (r, 4, c, iota_0); + r <- aux_1; + return (a, r); + } + + proc __keccak_f1600_scalar (a:W64.t Array25.t, iotas:W64.t) : W64.t Array25.t * + W64.t = { + var aux_6: bool; + var aux_5: bool; + var aux_4: bool; + var aux_3: bool; + var aux_2: bool; + var aux_1: W64.t; + var aux_0: W64.t Array25.t; + var aux: W64.t Array25.t; + + var zf:bool; + var r:W64.t Array25.t; + var _0:bool; + var _1:bool; + var _2:bool; + var _3:bool; + r <- witness; + leakages <- LeakAddr([]) :: leakages; + (aux_0, aux) <@ round2x (a, r, iotas, 0); + a <- aux_0; + r <- aux; + leakages <- LeakAddr([]) :: leakages; + (aux_0, aux) <@ round2x (r, a, iotas, 8); + r <- aux_0; + a <- aux; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (iotas + (W64.of_int 16)); + iotas <- aux_1; + leakages <- LeakAddr([]) :: leakages; + (aux_6, aux_5, aux_4, aux_3, aux_2) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + _0 <- aux_6; + _1 <- aux_5; + _2 <- aux_4; + _3 <- aux_3; + zf <- aux_2; + leakages <- LeakCond((! zf)) :: LeakAddr([]) :: leakages; + + while ((! zf)) { + leakages <- LeakAddr([]) :: leakages; + (aux_0, aux) <@ round2x (a, r, iotas, 0); + a <- aux_0; + r <- aux; + leakages <- LeakAddr([]) :: leakages; + (aux_0, aux) <@ round2x (r, a, iotas, 8); + r <- aux_0; + a <- aux; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (iotas + (W64.of_int 16)); + iotas <- aux_1; + leakages <- LeakAddr([]) :: leakages; + (aux_6, aux_5, aux_4, aux_3, aux_2) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + _0 <- aux_6; + _1 <- aux_5; + _2 <- aux_4; + _3 <- aux_3; + zf <- aux_2; + leakages <- LeakCond((! zf)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (iotas - (W64.of_int 192)); + iotas <- aux_1; + return (a, iotas); + } + + proc spill_2 (a:W64.t, b:W64.t) : W64.t * W64.t = { + var aux: W64.t; + + var sa:W64.t; + var sb:W64.t; + + leakages <- LeakAddr([]) :: leakages; + aux <- a; + sa <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- b; + sb <- aux; + return (sa, sb); + } + + proc spill_3 (a:W64.t, b:W64.t, c:W64.t) : W64.t * W64.t * W64.t = { + var aux: W64.t; + + var sa:W64.t; + var sb:W64.t; + var sc:W64.t; + + leakages <- LeakAddr([]) :: leakages; + aux <- a; + sa <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- b; + sb <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- c; + sc <- aux; + return (sa, sb, sc); + } + + proc load_2 (sa:W64.t, sb:W64.t) : W64.t * W64.t = { + var aux: W64.t; + + var a:W64.t; + var b:W64.t; + + leakages <- LeakAddr([]) :: leakages; + aux <- sa; + a <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- sb; + b <- aux; + return (a, b); + } + + proc load_3 (sa:W64.t, sb:W64.t, sc:W64.t) : W64.t * W64.t * W64.t = { + var aux: W64.t; + + var a:W64.t; + var b:W64.t; + var c:W64.t; + + leakages <- LeakAddr([]) :: leakages; + aux <- sa; + a <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- sb; + b <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- sc; + c <- aux; + return (a, b, c); + } + + proc keccak_init () : W64.t Array25.t = { + var aux_3: bool; + var aux_2: bool; + var aux_1: bool; + var aux_0: bool; + var aux: bool; + var aux_4: W64.t; + + var state:W64.t Array25.t; + var t:W64.t; + var i:W64.t; + var _0:bool; + var _1:bool; + var _2:bool; + var _3:bool; + var _4:bool; + state <- witness; + leakages <- LeakAddr([]) :: leakages; + (aux_3, aux_2, aux_1, aux_0, aux, aux_4) <- set0_64 ; + _0 <- aux_3; + _1 <- aux_2; + _2 <- aux_1; + _3 <- aux_0; + _4 <- aux; + t <- aux_4; + leakages <- LeakAddr([]) :: leakages; + aux_4 <- (W64.of_int 0); + i <- aux_4; + + leakages <- LeakCond((i \ult (W64.of_int 25))) :: LeakAddr([]) :: leakages; + + while ((i \ult (W64.of_int 25))) { + leakages <- LeakAddr([]) :: leakages; + aux_4 <- t; + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + state.[(W64.to_uint i)] <- aux_4; + leakages <- LeakAddr([]) :: leakages; + aux_4 <- (i + (W64.of_int 1)); + i <- aux_4; + leakages <- LeakCond((i \ult (W64.of_int 25))) :: LeakAddr([]) :: leakages; + + } + return (state); + } + + proc add_full_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, + rate:W64.t) : W64.t Array25.t * W64.t * W64.t = { + var aux: W64.t; + + var rate64:W64.t; + var i:W64.t; + var t:W64.t; + + leakages <- LeakAddr([]) :: leakages; + aux <- rate; + rate64 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (rate64 `>>` (W8.of_int 3)); + rate64 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (W64.of_int 0); + i <- aux; + + leakages <- LeakCond((i \ult rate64)) :: LeakAddr([]) :: leakages; + + while ((i \ult rate64)) { + leakages <- LeakAddr([(W64.to_uint (in_0 + ((W64.of_int 8) * i)))]) :: leakages; + aux <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + t <- aux; + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + aux <- (state.[(W64.to_uint i)] `^` t); + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + state.[(W64.to_uint i)] <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (i + (W64.of_int 1)); + i <- aux; + leakages <- LeakCond((i \ult rate64)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([]) :: leakages; + aux <- (in_0 + rate); + in_0 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (inlen - rate); + inlen <- aux; + return (state, in_0, inlen); + } + + proc add_final_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, + trail_byte:W8.t, rate:W64.t) : W64.t Array25.t = { + var aux_0: W8.t; + var aux: W64.t; + + var inlen8:W64.t; + var i:W64.t; + var t:W64.t; + var c:W8.t; + + leakages <- LeakAddr([]) :: leakages; + aux <- inlen; + inlen8 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (inlen8 `>>` (W8.of_int 3)); + inlen8 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (W64.of_int 0); + i <- aux; + + leakages <- LeakCond((i \ult inlen8)) :: LeakAddr([]) :: leakages; + + while ((i \ult inlen8)) { + leakages <- LeakAddr([(W64.to_uint (in_0 + ((W64.of_int 8) * i)))]) :: leakages; + aux <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + t <- aux; + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + aux <- (state.[(W64.to_uint i)] `^` t); + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + state.[(W64.to_uint i)] <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (i + (W64.of_int 1)); + i <- aux; + leakages <- LeakCond((i \ult inlen8)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([]) :: leakages; + aux <- (i `<<` (W8.of_int 3)); + i <- aux; + + leakages <- LeakCond((i \ult inlen)) :: LeakAddr([]) :: leakages; + + while ((i \ult inlen)) { + leakages <- LeakAddr([(W64.to_uint (in_0 + i))]) :: leakages; + aux_0 <- (loadW8 Glob.mem (W64.to_uint (in_0 + i))); + c <- aux_0; + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + aux_0 <- ((get8 (WArray200.init64 (fun i => state.[i])) + (W64.to_uint i)) `^` c); + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) aux_0)); + leakages <- LeakAddr([]) :: leakages; + aux <- (i + (W64.of_int 1)); + i <- aux; + leakages <- LeakCond((i \ult inlen)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + aux_0 <- ((get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` trail_byte); + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) aux_0)); + leakages <- LeakAddr([]) :: leakages; + aux <- rate; + i <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (i - (W64.of_int 1)); + i <- aux; + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + aux_0 <- ((get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` (W8.of_int 128)); + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) aux_0)); + return (state); + } + + proc absorb (state:W64.t Array25.t, iotas:W64.t, in_0:W64.t, inlen:W64.t, + s_trail_byte:W64.t, rate:W64.t) : W64.t Array25.t * W64.t * + W64.t = { + var aux_3: W8.t; + var aux_2: W64.t; + var aux_1: W64.t; + var aux_0: W64.t; + var aux: W64.t Array25.t; + + var s_in:W64.t; + var s_inlen:W64.t; + var s_rate:W64.t; + var t:W64.t; + var trail_byte:W8.t; + + + leakages <- LeakCond((rate \ule inlen)) :: LeakAddr([]) :: leakages; + + while ((rate \ule inlen)) { + leakages <- LeakAddr([]) :: leakages; + (aux, aux_2, aux_1) <@ add_full_block (state, in_0, inlen, rate); + state <- aux; + in_0 <- aux_2; + inlen <- aux_1; + leakages <- LeakAddr([]) :: leakages; + (aux_2, aux_1, aux_0) <@ spill_3 (in_0, inlen, rate); + s_in <- aux_2; + s_inlen <- aux_1; + s_rate <- aux_0; + leakages <- LeakAddr([]) :: leakages; + (aux, aux_2) <@ __keccak_f1600_scalar (state, iotas); + state <- aux; + iotas <- aux_2; + leakages <- LeakAddr([]) :: leakages; + (aux_2, aux_1, aux_0) <@ load_3 (s_in, s_inlen, s_rate); + in_0 <- aux_2; + inlen <- aux_1; + rate <- aux_0; + leakages <- LeakCond((rate \ule inlen)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([]) :: leakages; + aux_2 <- s_trail_byte; + t <- aux_2; + leakages <- LeakAddr([]) :: leakages; + aux_2 <- t; + trail_byte <- (truncateu8 aux_2); + leakages <- LeakAddr([]) :: leakages; + aux <@ add_final_block (state, in_0, inlen, trail_byte, rate); + state <- aux; + return (state, iotas, rate); + } + + proc xtr_full_block (state:W64.t Array25.t, out:W64.t, outlen:W64.t, + rate:W64.t) : W64.t * W64.t = { + var aux: W64.t; + + var rate64:W64.t; + var i:W64.t; + var t:W64.t; + + leakages <- LeakAddr([]) :: leakages; + aux <- rate; + rate64 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (rate64 `>>` (W8.of_int 3)); + rate64 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (W64.of_int 0); + i <- aux; + + leakages <- LeakCond((i \ult rate64)) :: LeakAddr([]) :: leakages; + + while ((i \ult rate64)) { + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + aux <- state.[(W64.to_uint i)]; + t <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- t; + leakages <- LeakAddr([(W64.to_uint (out + ((W64.of_int 8) * i)))]) :: leakages; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (i + (W64.of_int 1)); + i <- aux; + leakages <- LeakCond((i \ult rate64)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([]) :: leakages; + aux <- (out + rate); + out <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (outlen - rate); + outlen <- aux; + return (out, outlen); + } + + proc xtr_bytes (state:W64.t Array25.t, out:W64.t, outlen:W64.t) : W64.t = { + var aux_0: W8.t; + var aux: W64.t; + + var outlen8:W64.t; + var i:W64.t; + var t:W64.t; + var c:W8.t; + + leakages <- LeakAddr([]) :: leakages; + aux <- outlen; + outlen8 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (outlen8 `>>` (W8.of_int 3)); + outlen8 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (W64.of_int 0); + i <- aux; + + leakages <- LeakCond((i \ult outlen8)) :: LeakAddr([]) :: leakages; + + while ((i \ult outlen8)) { + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + aux <- state.[(W64.to_uint i)]; + t <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- t; + leakages <- LeakAddr([(W64.to_uint (out + ((W64.of_int 8) * i)))]) :: leakages; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (i + (W64.of_int 1)); + i <- aux; + leakages <- LeakCond((i \ult outlen8)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([]) :: leakages; + aux <- (i `<<` (W8.of_int 3)); + i <- aux; + + leakages <- LeakCond((i \ult outlen)) :: LeakAddr([]) :: leakages; + + while ((i \ult outlen)) { + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + aux_0 <- (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)); + c <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- c; + leakages <- LeakAddr([(W64.to_uint (out + i))]) :: leakages; + Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + i)) aux_0; + leakages <- LeakAddr([]) :: leakages; + aux <- (i + (W64.of_int 1)); + i <- aux; + leakages <- LeakCond((i \ult outlen)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([]) :: leakages; + aux <- (out + outlen); + out <- aux; + return (out); + } + + proc squeeze (state:W64.t Array25.t, iotas:W64.t, s_out:W64.t, + outlen:W64.t, rate:W64.t) : unit = { + var aux_2: W64.t; + var aux_0: W64.t; + var aux: W64.t; + var aux_1: W64.t Array25.t; + + var s_outlen:W64.t; + var s_rate:W64.t; + var out:W64.t; + + + leakages <- LeakCond((rate \ult outlen)) :: LeakAddr([]) :: leakages; + + while ((rate \ult outlen)) { + leakages <- LeakAddr([]) :: leakages; + (aux_2, aux_0) <@ spill_2 (outlen, rate); + s_outlen <- aux_2; + s_rate <- aux_0; + leakages <- LeakAddr([]) :: leakages; + (aux_1, aux_2) <@ __keccak_f1600_scalar (state, iotas); + state <- aux_1; + iotas <- aux_2; + leakages <- LeakAddr([]) :: leakages; + (aux_2, aux_0, aux) <@ load_3 (s_out, s_outlen, s_rate); + out <- aux_2; + outlen <- aux_0; + rate <- aux; + leakages <- LeakAddr([]) :: leakages; + (aux_2, aux_0) <@ xtr_full_block (state, out, outlen, rate); + out <- aux_2; + outlen <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_2 <- out; + s_out <- aux_2; + leakages <- LeakCond((rate \ult outlen)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([]) :: leakages; + aux_2 <- outlen; + s_outlen <- aux_2; + leakages <- LeakAddr([]) :: leakages; + (aux_1, aux_2) <@ __keccak_f1600_scalar (state, iotas); + state <- aux_1; + iotas <- aux_2; + leakages <- LeakAddr([]) :: leakages; + (aux_2, aux_0) <@ load_2 (s_out, s_outlen); + out <- aux_2; + outlen <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_2 <@ xtr_bytes (state, out, outlen); + out <- aux_2; + return (); + } + + proc __keccak_1600 (s_out:W64.t, s_outlen:W64.t, iotas:W64.t, in_0:W64.t, + inlen:W64.t, s_trail_byte:W64.t, rate:W64.t) : unit = { + var aux_1: W64.t; + var aux_0: W64.t; + var aux: W64.t Array25.t; + + var state:W64.t Array25.t; + var outlen:W64.t; + state <- witness; + leakages <- LeakAddr([]) :: leakages; + aux <@ keccak_init (); + state <- aux; + leakages <- LeakAddr([]) :: leakages; + (aux, aux_1, aux_0) <@ absorb (state, iotas, in_0, inlen, s_trail_byte, + rate); + state <- aux; + iotas <- aux_1; + rate <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- s_outlen; + outlen <- aux_1; + leakages <- LeakAddr([]) :: leakages; + squeeze (state, iotas, s_out, outlen, rate); + return (); + } +}. + +equiv ct: + M.__keccak_1600 ~ M.__keccak_1600 : + ={inlen,s_outlen,M.leakages,rate,in_0,s_out,iotas} ==> ={M.leakages}. +proc. + +(* Squeeze *) +call(_: ={outlen, s_out, M.leakages,iotas,rate} ==> ={M.leakages}). + +proc. +wp;call(_: ={outlen, out,M.leakages} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,arg} ==> ={M.leakages,res}). +proc. +by sim. + +(* Squeeze last f *) +wp;call(_: ={M.leakages,iotas} ==> ={M.leakages} /\ res{1}.`2 = res{2}.`2). +proc. + +wp;while (={zf,iotas,M.leakages}). + +(* Squeeze last f loop round2x 2 *) +wp;call(_: ={M.leakages,iotas,o} ==> ={M.leakages}). +proc. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +by auto => />. + +(* Squeeze last f last f loop round2x 1 *) +wp;call(_: ={M.leakages,iotas,o} ==> ={M.leakages}). +proc. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +by auto => />. + +by auto => />. + + +(* Squeeze last f last f first round2x 2 *) +wp;call(_: ={M.leakages,iotas,o} ==> ={M.leakages}). +proc. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +by auto => />. + +(* Squeeze last f first round2x 1 *) +wp;call(_: ={M.leakages,iotas,o} ==> ={M.leakages}). +proc. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. + +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. + +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. + +by auto => />. + +by auto => />. + +wp;while (={rate,s_out,outlen,iotas,M.leakages}); last by auto => />. + +wp;call(_: ={outlen, out,rate,M.leakages} ==> ={M.leakages,res}). +proc. +by sim. +wp;call(_: ={M.leakages,arg} ==> ={M.leakages,res}). +proc. +by sim. + +(* Squeeze first f *) +wp;call(_: ={M.leakages,iotas} ==> ={M.leakages} /\ res{1}.`2 = res{2}.`2). +proc. + +wp;while (={zf,iotas,M.leakages}). + +(* Squeeze first f loop round2x 2 *) +wp;call(_: ={M.leakages,iotas,o} ==> ={M.leakages}). +proc. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +by auto => />. + +(* Squeeze first f last f loop round2x 1 *) +wp;call(_: ={M.leakages,iotas,o} ==> ={M.leakages}). +proc. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +by auto => />. + +by auto => />. + + +(* Squeeze last f last f first round2x 2 *) +wp;call(_: ={M.leakages,iotas,o} ==> ={M.leakages}). +proc. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +by auto => />. + +(* Squeeze last f first round2x 1 *) +wp;call(_: ={M.leakages,iotas,o} ==> ={M.leakages}). +proc. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. + +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. + +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. + +by auto => />. + +by auto => />. + +wp;call(_: ={M.leakages,arg} ==> ={M.leakages,res}). +proc. +by sim. + +by auto => />. + +(* Initialization *) + +wp;call(_: ={M.leakages,iotas,rate,in_0,inlen} ==> ={M.leakages} /\ res{1}.`2 = res{2}.`2 /\ res{1}.`3 = res{2}.`3); last by inline *;wp; while (={i,M.leakages}) => //=; auto => />. + +(* Absorb *) +proc. +wp;call(_: ={M.leakages,rate,in_0,inlen} ==> ={M.leakages}). +proc. +by sim. +wp;while (={rate,inlen,in_0,iotas,M.leakages}). +wp;call(_: ={M.leakages,arg} ==> ={M.leakages,res}). +proc. +by sim. + +(* Absorb f *) +wp;call(_: ={M.leakages,iotas} ==> ={M.leakages} /\ res{1}.`2 = res{2}.`2). +proc. + +auto => />. +progress. + +wp;while (={zf,iotas,M.leakages}). + +(* Absorb f loop round2x 2 *) +wp;call(_: ={M.leakages,iotas,o} ==> ={M.leakages}). +proc. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +by auto => />. + +(* Absorb f loop round2x 1 *) +wp;call(_: ={M.leakages,iotas,o} ==> ={M.leakages}). +proc. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +by auto => />. + +by auto => />. + + +(* Absorb f first round2x 2 *) +wp;call(_: ={M.leakages,iotas,o} ==> ={M.leakages}). +proc. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +by auto => />. + +(* Absorb f first round2x 1 *) +wp;call(_: ={M.leakages,iotas,o} ==> ={M.leakages}). +proc. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +by auto => />. + +by auto => />. + + +wp;call(_: ={M.leakages,arg} ==> ={M.leakages,res}). +proc. +by sim. + + +wp;call(_: ={M.leakages,in_0,inlen,rate} ==> ={M.leakages} /\ res{1}.`2 = res{2}.`2 /\ res{1}.`3 = res{2}.`3). +proc. +wp;while(={i,rate64,M.leakages,in_0}). +by sim. +by auto => />. + +by auto => />. + +by auto => />. + +qed. diff --git a/sha3/proof/impl/libc/keccak_1600_scalar_modular.ec b/sha3/proof/impl/libc/keccak_1600_scalar_modular.ec new file mode 100644 index 0000000..02447c7 --- /dev/null +++ b/sha3/proof/impl/libc/keccak_1600_scalar_modular.ec @@ -0,0 +1,349 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array5 Array24 Array25. +require import WArray40 WArray200. + +require import Keccak_1600_scalar. +require Keccak_f1600_scalar. +require Keccak_1600_ref_modular. +require Keccak_f1600_ref_op. + +module Mmod = { + include Keccak_f1600_scalar.M + + proc spill_2 (a:W64.t, b:W64.t) : W64.t * W64.t = { + + var sa:W64.t; + var sb:W64.t; + + sa <- a; + sb <- b; + return (sa, sb); + } + + proc spill_3 (a:W64.t, b:W64.t, c:W64.t) : W64.t * W64.t * W64.t = { + + var sa:W64.t; + var sb:W64.t; + var sc:W64.t; + + sa <- a; + sb <- b; + sc <- c; + return (sa, sb, sc); + } + + proc load_2 (sa:W64.t, sb:W64.t) : W64.t * W64.t = { + + var a:W64.t; + var b:W64.t; + + a <- sa; + b <- sb; + return (a, b); + } + + proc load_3 (sa:W64.t, sb:W64.t, sc:W64.t) : W64.t * W64.t * W64.t = { + + var a:W64.t; + var b:W64.t; + var c:W64.t; + + a <- sa; + b <- sb; + c <- sc; + return (a, b, c); + } + + proc keccak_init () : W64.t Array25.t = { + + var state:W64.t Array25.t; + var t:W64.t; + var i:W64.t; + var _0:bool; + var _1:bool; + var _2:bool; + var _3:bool; + var _4:bool; + state <- witness; + ( _0, _1, _2, _3, _4, t) <- set0_64 ; + i <- (W64.of_int 0); + + while ((i \ult (W64.of_int 25))) { + state.[(W64.to_uint i)] <- t; + i <- (i + (W64.of_int 1)); + } + return (state); + } + + proc add_full_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, + rate:W64.t) : W64.t Array25.t * W64.t * W64.t = { + + var rate64:W64.t; + var i:W64.t; + var t:W64.t; + + rate64 <- rate; + rate64 <- (rate64 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult rate64)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); + i <- (i + (W64.of_int 1)); + } + in_0 <- (in_0 + rate); + inlen <- (inlen - rate); + return (state, in_0, inlen); + } + + proc add_final_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, + trail_byte:W8.t, rate:W64.t) : W64.t Array25.t = { + + var inlen8:W64.t; + var i:W64.t; + var t:W64.t; + var c:W8.t; + + inlen8 <- inlen; + inlen8 <- (inlen8 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult inlen8)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); + i <- (i + (W64.of_int 1)); + } + i <- (i `<<` (W8.of_int 3)); + + while ((i \ult inlen)) { + c <- (loadW8 Glob.mem (W64.to_uint (in_0 + i))); + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` c))); + i <- (i + (W64.of_int 1)); + } + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` trail_byte))); + i <- rate; + i <- (i - (W64.of_int 1)); + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` (W8.of_int 128)))); + return (state); + } + + proc absorb (state:W64.t Array25.t, iotas:W64.t, in_0:W64.t, inlen:W64.t, + s_trail_byte:W64.t, rate:W64.t) : W64.t Array25.t * W64.t * + W64.t = { + + var s_in:W64.t; + var s_inlen:W64.t; + var s_rate:W64.t; + var t:W64.t; + var trail_byte:W8.t; + + + while ((rate \ule inlen)) { + (state, in_0, inlen) <@ add_full_block (state, in_0, inlen, rate); + (s_in, s_inlen, s_rate) <@ spill_3 (in_0, inlen, rate); + (state, iotas) <@ __keccak_f1600_scalar (state, iotas); + (in_0, inlen, rate) <@ load_3 (s_in, s_inlen, s_rate); + } + t <- s_trail_byte; + trail_byte <- (truncateu8 t); + state <@ add_final_block (state, in_0, inlen, trail_byte, rate); + return (state, iotas, rate); + } + + proc xtr_full_block (state:W64.t Array25.t, out:W64.t, outlen:W64.t, + rate:W64.t) : W64.t * W64.t = { + + var rate64:W64.t; + var i:W64.t; + var t:W64.t; + + rate64 <- rate; + rate64 <- (rate64 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult rate64)) { + t <- state.[(W64.to_uint i)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; + i <- (i + (W64.of_int 1)); + } + out <- (out + rate); + outlen <- (outlen - rate); + return (out, outlen); + } + + proc xtr_bytes (state:W64.t Array25.t, out:W64.t, outlen:W64.t) : W64.t = { + + var outlen8:W64.t; + var i:W64.t; + var t:W64.t; + var c:W8.t; + + outlen8 <- outlen; + outlen8 <- (outlen8 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult outlen8)) { + t <- state.[(W64.to_uint i)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; + i <- (i + (W64.of_int 1)); + } + i <- (i `<<` (W8.of_int 3)); + + while ((i \ult outlen)) { + c <- (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)); + Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + i)) c; + i <- (i + (W64.of_int 1)); + } + out <- (out + outlen); + return (out); + } + + proc squeeze (state:W64.t Array25.t, iotas:W64.t, s_out:W64.t, + outlen:W64.t, rate:W64.t) : unit = { + + var s_outlen:W64.t; + var s_rate:W64.t; + var out:W64.t; + + + while ((rate \ult outlen)) { + (s_outlen, s_rate) <@ spill_2 (outlen, rate); + (state, iotas) <@ __keccak_f1600_scalar (state, iotas); + (out, outlen, rate) <@ load_3 (s_out, s_outlen, s_rate); + (out, outlen) <@ xtr_full_block (state, out, outlen, rate); + s_out <- out; + } + s_outlen <- outlen; + (state, iotas) <@ __keccak_f1600_scalar (state, iotas); + (out, outlen) <@ load_2 (s_out, s_outlen); + out <@ xtr_bytes (state, out, outlen); + return (); + } + + proc __keccak_1600 (s_out:W64.t, s_outlen:W64.t, iotas:W64.t, in_0:W64.t, + inlen:W64.t, s_trail_byte:W64.t, rate:W64.t) : unit = { + + var state:W64.t Array25.t; + var outlen:W64.t; + state <- witness; + state <@ keccak_init (); + (state, iotas, rate) <@ absorb (state, iotas, in_0, inlen, s_trail_byte, + rate); + outlen <- s_outlen; + squeeze (state, iotas, s_out, outlen, rate); + return (); + } + +}. + +equiv modgood : + Mmod.__keccak_1600 ~ M.__keccak_1600 : + ={Glob.mem,arg} ==> ={Glob.mem,res}. +proc. +by sim. +qed. + +require Keccak_f1600_scalar_table. + +op disj_ptr (p1 : address) (len1:int) (p2: address) ( len2:int) = + p1 + len1 <= p2 \/ p2 + len2 <= p1. + +op good_ptr (p : address) (len:int) = p + len < W64.modulus. + +lemma loadW64_storeW64_diff mem i j w: + j + 8 <= i \/ i + 8 <= j => + loadW64 (storeW64 mem i w) j = loadW64 mem j. +proof. + move=> hij; apply W8u8.wordP => k hk. + rewrite /loadW64 !W8u8.pack8bE 1,2:// !initiE 1,2:// /= storeW64E get_storesE /= /#. +qed. + +equiv eq_xtr_full_block iotas0: + Keccak_1600_ref_modular.Mmod.xtr_full_block ~ Mmod.xtr_full_block : + ={Glob.mem, state, out, outlen, rate} /\ + disj_ptr (to_uint out{1}) (to_uint outlen{1}) iotas0 224 /\ + good_ptr (to_uint out{1}) (to_uint outlen{1}) /\ rate{1} \ult outlen{1} /\ + Keccak_f1600_scalar_table.good_iotas Glob.mem{1} iotas0 + ==> + ={Glob.mem, res} /\ + disj_ptr (to_uint res{1}.`1) (to_uint res{2}.`2) iotas0 224 /\ + good_ptr (to_uint res{1}.`1) (to_uint res{2}.`2) /\ + Keccak_f1600_scalar_table.good_iotas Glob.mem{1} iotas0. +proof. + proc; wp => /=. + while (#pre /\ ={i,rate64} /\ 0 <= to_uint i{1} /\ 0 <= 8 * to_uint rate64{1} <= to_uint rate{1}). + + wp; skip => /> &2. + rewrite !ultE /good_ptr /disj_ptr /= => h1 h2 h3 h4 h5 h6 h7 h8; split. + + move=> x hx; rewrite loadW64_storeW64_diff; last by rewrite h4. + have h : to_uint (W64.of_int 8 * i{2}) = 8 * to_uint i{2}. + + rewrite W64.to_uintM_small /=; smt (W64.to_uint_cmp). + rewrite W64.to_uintD_small h /=; smt(). + rewrite W64.to_uintD_small /=; smt (W64.to_uint_cmp). + wp; skip => /> &2. + rewrite /W64.(`>>`) /= W64.to_uint_shr 1:// /good_ptr /disj_ptr /= !ultE => h1 h2 h3 h4. + split; 1: smt(W64.to_uint_cmp). + by move=> mem *; rewrite W64.to_uintD_small /= 1:/# W64.to_uintB 1:uleE /#. +qed. + +equiv modcorrect : + Keccak_1600_ref_modular.Mmod.__keccak_1600 ~ Mmod.__keccak_1600 : + Keccak_f1600_scalar_table.good_iotas Glob.mem{1} (to_uint iotas{2}) /\ + 0 <= to_uint iotas{2} < W64.modulus - 24 * 8 /\ + (to_uint iotas{2} - 8 * 8) %% 256 = 0 /\ + disj_ptr (to_uint s_out{1}) (to_uint s_outlen{1}) (to_uint iotas{2}) 224 /\ + good_ptr (to_uint s_out{1}) (to_uint s_outlen{1}) /\ + in_0{1} = in_0{2} /\ inlen{1} = inlen{2} /\ s_out{1} = s_out{2} /\ s_outlen{1} = s_outlen{2} /\ rate{1} = rate{2} /\ + s_trail_byte{1} = s_trail_byte{2} /\ ={Glob.mem} ==> ={Glob.mem}. +proof. +proc => /=. +seq 2 2 : (#pre /\ ={state}). + call(_:true); last by auto. ++ while (#post /\ to_uint i{2} = i{1} /\ i{2} \ule W64.of_int 25 /\ t{2} = W64.zero). + + auto => /> &2; rewrite !ultE !uleE/= => *. + rewrite W64.to_uintD_small /= 1,2:/#. + by auto => />; rewrite set0_64E => />. +seq 4 1 : #{/~in_0{1} = in_0{2}}{~inlen{1} = inlen{2}}pre. ++ inline Mmod.absorb. + swap {2} [5..6] -2; swap {2} [2..4] -1; sp 0 3. + seq 0 3 : (#{/~state{1} = state{2}}{/~in_0{1} = in_0{2}}{~inlen{1} = inlen{2}}pre /\ state0{2} = state{1} /\ inlen0{2} = inlen{1} /\ in_00{2} = in_0{1}); first by auto => />. + seq 1 1 : #pre. + + while (#post); last by auto. + inline Mmod.load_3 Mmod.spill_3; wp. + exlim Glob.mem{2}, iotas0{2} => memm _iotas. + call (Keccak_f1600_scalar_table.scalarcorr_op (to_uint _iotas) memm). + wp; call (_: ={Glob.mem}); first by sim. + by auto => />; smt(@W64). + wp; call (_: ={Glob.mem}); first by sim. + by auto => />. +inline Mmod.squeeze. +swap {2} 6 -2; swap {2} [3..4] -2; sp 0 2. +seq 1 4 : (#{/~state{1} = state{2}}{~s_out{1} = s_out{2}}{~s_outlen{1} = s_outlen{2}}{~disj_ptr _ _ _ _}{~good_ptr _ _} pre /\ + state0{2} = state{1} /\ outlen0{2} = outlen{1} /\ s_out0{2} = s_out{1} /\ + disj_ptr (to_uint s_out{1}) (to_uint outlen{1}) (to_uint iotas{2}) 224 /\ + good_ptr (to_uint s_out{1}) (to_uint outlen{1}) /\ + Keccak_f1600_scalar_table.good_iotas Glob.mem{1} (to_uint iotas{2})); first by auto => />. +seq 1 1 : #pre. ++ while (#post); last by auto. + inline Mmod.load_3 Mmod.spill_2. + wp; ecall (eq_xtr_full_block (to_uint iotas{2})). + wp; ecall (Keccak_f1600_scalar_table.scalarcorr_op (to_uint iotas{2}) Glob.mem{1}). + by wp;skip => /> *; rewrite W64.to_uint_eq. +seq 2 2 : (#pre /\ s_outlen{1} = s_outlen0{2}). ++ ecall (Keccak_f1600_scalar_table.scalarcorr_op (to_uint iotas0{2}) Glob.mem{2}). + by wp;skip=> />; smt(@W64). +inline *. +sim. +qed. diff --git a/sha3/proof/impl/perm/Array2.ec b/sha3/proof/impl/perm/Array2.ec new file mode 100644 index 0000000..3a89b1c --- /dev/null +++ b/sha3/proof/impl/perm/Array2.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array2 with op size <- 2. diff --git a/sha3/proof/impl/perm/Array24.ec b/sha3/proof/impl/perm/Array24.ec new file mode 100644 index 0000000..8982b77 --- /dev/null +++ b/sha3/proof/impl/perm/Array24.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array24 with op size <- 24. diff --git a/sha3/proof/impl/perm/Array25.ec b/sha3/proof/impl/perm/Array25.ec new file mode 100644 index 0000000..30bcb17 --- /dev/null +++ b/sha3/proof/impl/perm/Array25.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array25 with op size <- 25. diff --git a/sha3/proof/impl/perm/Array4.ec b/sha3/proof/impl/perm/Array4.ec new file mode 100644 index 0000000..bc0e12e --- /dev/null +++ b/sha3/proof/impl/perm/Array4.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array4 with op size <- 4. diff --git a/sha3/proof/impl/perm/Array5.ec b/sha3/proof/impl/perm/Array5.ec new file mode 100644 index 0000000..8dc7b36 --- /dev/null +++ b/sha3/proof/impl/perm/Array5.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array5 with op size <- 5. diff --git a/sha3/proof/impl/perm/Array6.ec b/sha3/proof/impl/perm/Array6.ec new file mode 100644 index 0000000..d010a15 --- /dev/null +++ b/sha3/proof/impl/perm/Array6.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array6 with op size <- 6. diff --git a/sha3/proof/impl/perm/Array7.ec b/sha3/proof/impl/perm/Array7.ec new file mode 100644 index 0000000..33f6cc6 --- /dev/null +++ b/sha3/proof/impl/perm/Array7.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array7 with op size <- 7. diff --git a/sha3/proof/impl/perm/Array9.ec b/sha3/proof/impl/perm/Array9.ec new file mode 100644 index 0000000..8759457 --- /dev/null +++ b/sha3/proof/impl/perm/Array9.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array9 with op size <- 9. diff --git a/sha3/proof/impl/perm/Array96.ec b/sha3/proof/impl/perm/Array96.ec new file mode 100644 index 0000000..619dabe --- /dev/null +++ b/sha3/proof/impl/perm/Array96.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array96 with op size <- 96. diff --git a/sha3/proof/impl/perm/LoopTransform.ec b/sha3/proof/impl/perm/LoopTransform.ec new file mode 100644 index 0000000..af09f3c --- /dev/null +++ b/sha3/proof/impl/perm/LoopTransform.ec @@ -0,0 +1,249 @@ +require import AllCore StdOrder IntDiv IntExtra. +from Jasmin require import JUtils. + +abbrev [-printing] floor (n k:int) = (n %/ k) * k. + +lemma lt_floorE (k i n:int) : 0 < k => k %| i => i < floor n k <=> i + k <= floor n k. +proof. + move => hk /dvdzP [q] ->. + rewrite (IntOrder.ltr_pmul2r k hk) ltzE -(IntOrder.ler_pmul2r k hk) /#. +qed. + +lemma floor_le n k : 0 < k => floor n k <= n. +proof. rewrite {2}(divz_eq n k); smt (modz_cmp). qed. + +lemma le_floor (k i n:int) : 0 < k => k %| i => i <= n => i <= floor n k. +proof. + rewrite {1}(divz_eq n k)=> hk /dvdzP [q] ->. + case (q * k <= floor n k) => // /ltzNge; rewrite IntOrder.ltr_pmul2r // => /ltzE. + rewrite -(IntOrder.ler_pmul2r k hk); smt (modz_cmp). +qed. + +lemma le_floorE (k i n:int) : 0 < k => k %| i => i <= n <=> i <= floor n k. +proof. move => hk kd; smt (divz_eq modz_cmp le_floor). qed. + +abstract theory ExactIter. +type t. + +op c : int. +axiom c_gt0 : 0 < c. +op step : int. +axiom step_gt0 : 0 < step. + +module type AdvLoop = { + proc body(t:t, i:int) : t +}. + +module Loop(B:AdvLoop) = { + proc loop1 (t:t, n:int) = { + var i; + i = 0; + while (i < n) { + t <@ B.body(t,i); + i <- i + 1; + } + return t; + } + + proc loopk (t:t, n:int, k:int) = { + var i, j; + i = 0; + while (i < n) { + j = 0; + while (j < k) { + t <@ B.body(t, k * i + j); + j <- j + 1; + } + i <- i + 1; + } + return t; + } + + proc loopc (t:t, n:int) = { + var i, j; + i = 0; + while (i < n) { + j = 0; + while (j < c) { + t <@ B.body(t, c * i + j); + j <- j + 1; + } + i <- i + 1; + } + return t; + } + +}. + +module ILoop(B:AdvLoop) = { + proc loop1 (t:t, n:int) = { + var i; + i = 0; + while (i < n) { + t <@ B.body(t,i); + i <- i + step; + } + return t; + } + + proc loopk (t:t, n:int, k:int) = { + var i, j; + i = 0; + while (i + step * k <= n) { + j = 0; + while (j < k) { + t <@ B.body(t, i); + i <- i + step; + j <- j + 1; + } + } + while (i < n) { + t <@ B.body(t,i); + i <- i + step; + } + return t; + } + + proc loopc (t:t, n:int) = { + var i, j; + i = 0; + while (i + step * c <= n) { + j = 0; + while (j < c) { + t <@ B.body(t, i); + i <- i + step; + j <- j + 1; + } + } + while (i < n) { + t <@ B.body(t,i); + i <- i + step; + } + return t; + } + +}. + +section. + +declare module B:AdvLoop. + +equiv loop1_loopk : Loop(B).loop1 ~ Loop(B).loopk : + ={t, glob B} /\ n{1} = (k * n){2} /\ 0 < k{2} ==> ={res, glob B}. +proof. + proc. + async while [ (fun r => i%r < r), (i{1}+k{2})%r ] + [ (fun r => i%r < r), (i{2} + 1)%r ] + ( (i < n){1}) + (true) : + (={t, glob B} /\ (0 <= i <= n){2} /\ 0 < k{2} /\ n{1} = (k * n){2} /\ i{1} = k{2} * i{2}). + + smt(). + smt (). + done. + + move=> &m2; exfalso; smt(). + + move=> &m1; exfalso; smt(). + + move=> v1 v2. + rcondt{2} 1; 1: by auto => /> /#. + rcondf{2} 4; 1: by auto; conseq (_: true);auto. + exlim i{2} => i2. + wp;while (={t,glob B} /\ i{1} = k{2}*i{2} + j{2} /\ 0 <= i{2} < n{2} /\ + 0 <= j{2} <= k{2} /\ v1 = (k{2} * i2 + k{2})%r /\ i{2} = i2 /\ n{1} = (k * n){2}). + + wp;call (_: true);skip => /> &2 h0i hin h0j hjk. + rewrite !RealExtra.lt_fromint => h1 h2 h3. + have := IntOrder.ler_wpmul2l k{2} _ i{2} (n{2} - 1); smt(). + by wp;skip => /> /#. + + rcondf 1; skip => /#. + + rcondf 1; skip => /#. + by auto. +qed. + +equiv loopk_loopc : Loop(B).loopk ~ Loop(B).loopc : ={n,t, glob B} /\ k{1} = c ==> ={res, glob B}. +proof. + proc => /=. + while (={glob B, i, t, n} /\ k{1} = c);2: by auto. + wp;while (={glob B, i, j, t, n} /\ k{1} = c);2: by auto. + by wp;call (_:true);skip. +qed. + +equiv loop1_loopc : + Loop(B).loop1 ~ Loop(B).loopc : + ={t, glob B} /\ n{1} = (c * n){2} ==> ={res, glob B}. +proof. + transitivity Loop(B).loopk + (={t, glob B} /\ n{1} = c * n{2} /\ k{2} = c ==> ={res, glob B}) + (={n,t, glob B} /\ k{1} = c ==> ={res, glob B}). + + by move=> &1 &2 /> 2!->; exists (glob B){2} (t{2}, n{2}, c). + + done. + + conseq loop1_loopk; smt (c_gt0). + apply loopk_loopc. +qed. + +equiv Iloop1_loopk : ILoop(B).loop1 ~ ILoop(B).loopk : ={t, glob B, n} /\ 0 < k{2}==> ={res, glob B}. +proof. + proc => /=; exlim k{2} => k0. + case: (n{2} < 0). + + rcondf{2} 2; 1: by move=> &m1; wp; skip => &m2 />; smt (step_gt0). + by sim; wp; skip. + splitwhile{1} 2 : (i < floor n (step * k0)). + seq 2 2: (={glob B, t, n, i}); last by sim;wp;skip. + async while [ (fun r => i%r < r), (i{1} + step * k{2})%r ] + [ (fun r => i%r < r), (i{2} + step * k{2})%r ] + ( (i < floor n (step * k0)){1}) + (true) : + (={t, glob B, i, n} /\ k{2} = k0 /\ 0 < k{2} /\ (step * k0) %| i{1}). + + move=> />;smt (lt_floorE floor_le step_gt0). + + move=> /> &2 h1 h2 [[]// | h3]. + have h4 := le_floorE (step * k{2}) (i{2} + step * k{2}) n{2} _ _. + + smt (step_gt0). + by apply dvdzD => //; apply dvdzz. + smt (step_gt0). + + done. + + by move=> &m2; exfalso => /#. + + by move=> &m1; exfalso => /#. + + move=> v1 v2. + rcondt{2} 1. + + move=> &1;skip => /> *; smt (step_gt0 lt_floorE floor_le). + rcondf{2} 3. + + move=> &1. + while (j <= k /\ i = i{1} + step * j). + + by wp; call (_:true); skip => /#. + by wp; skip => />; smt (step_gt0). + exlim i{1} => i0. + while (={t, i, glob B, n} /\ i{1} = i0 + step * j{2} /\ v1 = (i0 + step * k{2})%r /\ + k{2} = k0 /\ (step * k0) %| i0 /\ 0 < k{2} /\ 0 <= j{2} <= k{2} /\ + v1 <= (floor n{1} (step * k{2}))%r). + + wp; call (_: true); skip => &1 &2 [#] 7!->> h2 h3 h4 h1. + rewrite le_fromint /= !lt_fromint=> h5 h6 h7 h8 h9 ???? [#] 2!->> /=. + split. smt(). + have <- := IntOrder.ltr_pmul2l step step_gt0 (j{2} + 1) k0. + smt (floor_le step_gt0). + wp; skip => &1 &2 [#] 6!->> h1 h2 h3 h4 2!->> /=. + rewrite le_fromint lt_fromint h2 h1 -lt_floorE /= 2://; 1:smt (step_gt0). + (do! (split => *)); 1..-2: smt(step_gt0). + by case: H1 => [?] [-> ?]; rewrite dvdzD 1:/# (_ : j_R = k0) 1:/# dvdzz. + + rcondf 1; skip => /#. + + rcondf 1; skip => /#. + by auto. +qed. + +equiv Iloopk_loopc : ILoop(B).loopk ~ ILoop(B).loopc : ={n,t, glob B} /\ k{1} = c ==> ={res, glob B}. +proof. + proc => /=; sim. + while (={glob B, i, t, n} /\ k{1} = c);2: by auto. + wp;while (={glob B, i, j, t, n} /\ k{1} = c);2: by auto. + by wp;call (_:true);skip. +qed. + +equiv Iloop1_loopc : + ILoop(B).loop1 ~ ILoop(B).loopc : + ={t, glob B, n} ==> ={res, glob B}. +proof. + transitivity ILoop(B).loopk + (={t, glob B} /\ n{1} = n{2} /\ k{2} = c ==> ={res, glob B}) + (={n,t, glob B} /\ k{1} = c ==> ={res, glob B}). + + by move=> &1 &2 /> 2!->; exists (glob B){2} (t{2}, n{2}, c). + + done. + + conseq Iloop1_loopk; smt (c_gt0). + apply Iloopk_loopc. +qed. + +end section. + +end ExactIter. diff --git a/sha3/proof/impl/perm/Ops.ec b/sha3/proof/impl/perm/Ops.ec new file mode 100644 index 0000000..07a8aad --- /dev/null +++ b/sha3/proof/impl/perm/Ops.ec @@ -0,0 +1,728 @@ +require import List Int IntExtra IntDiv CoreMap. + +from Jasmin require import JModel. +require import Array2 Array4 Array5. +require import WArray128 WArray160. + +type t2u64 = W64.t Array2.t. +type t4u64 = W64.t Array4.t. + +hint simplify W8.of_intwE @0. + +lemma pack2_bits32 (w: W64.t): + pack2 [w \bits32 0; w \bits32 1] = w. +proof. by apply W2u32.allP. qed. + +lemma pack2_bits32_red (w1 w2: W64.t): + w1 = w2 => + pack2 [w1 \bits32 0; w2 \bits32 1] = w1. +proof. by move=> ->; apply pack2_bits32. qed. + +hint simplify pack2_bits32_red @0. + +module Ops = { + proc itruncate_4u64_2u64(t : t4u64) : t2u64 = { + return Array2.of_list witness [ t.[0]; t.[1] ]; + } + proc set_160(vv : t4u64 Array5.t, i : int, o : int, v : W64.t) : t4u64 Array5.t = { + return vv.[i <- vv.[i].[o <- v]]; + } + proc get_160(vv : t4u64 Array5.t, i : int, o : int) : W64.t = { + return vv.[i].[o]; + } + proc get_128(vv : t4u64 Array4.t, i : int, o : int) : W64.t = { + return vv.[i].[o]; + } + + proc iVPBROADCAST_4u64(v : W64.t) : t4u64 = { + var r : t4u64; + r.[0] <-v; + r.[1] <-v; + r.[2] <-v; + r.[3] <-v; + return r; + } + + proc iVPMULU_256 (x y:t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- mulu64 x.[0] y.[0]; + r.[1] <- mulu64 x.[1] y.[1]; + r.[2] <- mulu64 x.[2] y.[2]; + r.[3] <- mulu64 x.[3] y.[3]; + return r; + } + + proc ivadd64u256(x y:t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0] + y.[0]; + r.[1] <- x.[1] + y.[1]; + r.[2] <- x.[2] + y.[2]; + r.[3] <- x.[3] + y.[3]; + return r; + } + + proc iload4u64 (mem:global_mem_t, p:W64.t) : t4u64 = { + var r : t4u64; + r.[0] <- loadW64 mem (to_uint p); + r.[1] <- loadW64 mem (to_uint (p + W64.of_int 8)); + r.[2] <- loadW64 mem (to_uint (p + W64.of_int 16)); + r.[3] <- loadW64 mem (to_uint (p + W64.of_int 24)); + return r; + } + + proc iVPERM2I128(x y:t4u64, p : W8.t) : t4u64 = { + var r : t4u64; + r <- witness; + r.[0] <- + let n = 0 in + if p.[n + 3] then W64.of_int 0 + else + let w = if p.[n+1] then y else x in + if p.[n] then w.[2] else w.[0]; + r.[1] <- + let n = 0 in + if p.[n + 3] then W64.of_int 0 + else + let w = if p.[n+1] then y else x in + if p.[n] then w.[3] else w.[1]; + r.[2] <- + let n = 4 in + if p.[n + 3] then W64.of_int 0 + else + let w = if p.[n+1] then y else x in + if p.[n] then w.[2] else w.[0]; + r.[3] <- + let n = 4 in + if p.[n + 3] then W64.of_int 0 + else + let w = if p.[n+1] then y else x in + if p.[n] then w.[3] else w.[1]; + + return r; + } + + proc iVPERMQ(x :t4u64, p : W8.t) : t4u64 = { + var r : t4u64; + r <- witness; + r.[0] <- x.[ (to_uint p ) %% 4 ]; + r.[1] <- x.[ (to_uint p %/ 4) %% 4 ]; + r.[2] <- x.[ (to_uint p %/ 16) %% 4 ]; + r.[3] <- x.[ (to_uint p %/ 64) %% 4 ]; + return r; + } + + proc iVPSRLDQ_256(x:t4u64, p : W8.t) : t4u64 = { + var r : t4u64; + r <- witness; + + r.[0] <- + if to_uint p = 8 then x.[1] + else let i = min (to_uint p) 16 in + if i < 8 then (x.[0] `>>>` 8 * i) `|` (x.[1] `<<<` (64 - 8 * i)) + else x.[1] `>>>` 8 * (i - 8); + + r.[1] <- + let i = min (to_uint p) 16 in + if i < 8 then x.[1] `>>>` 8 * i + else W64.zero; + + r.[2] <- + if to_uint p = 8 then x.[3] + else let i = min (to_uint p) 16 in + if i < 8 then (x.[2] `>>>` 8 * i) `|` (x.[3] `<<<` (64 - 8 * i)) + else x.[3] `>>>` 8 * (i - 8); + + r.[3] <- + let i = min (to_uint p) 16 in + if i < 8 then x.[3] `>>>` 8 * i + else W64.zero; + + return r; + } + + proc iVPUNPCKH_4u64(x y:t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- x.[1]; + r.[1] <- y.[1]; + r.[2] <- x.[3]; + r.[3] <- y.[3]; + return r; + } + + proc iVPUNPCKL_4u64 (x y:t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0]; + r.[1] <- y.[0]; + r.[2] <- x.[2]; + r.[3] <- y.[2]; + return r; + } + + proc iVEXTRACTI128(x:t4u64, p : W8.t) : t2u64 = { + var r : t2u64; + r <- witness; + r.[0] <- if p.[0] then x.[2] else x.[0]; + r.[1] <- if p.[0] then x.[3] else x.[1]; + return r; + } + + proc iVPEXTR_64(x:t2u64, p : W8.t) : W64.t = { + return x.[to_uint p]; + } + + proc ivshr64u256 (x: t4u64, y: W8.t) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0] `>>` y; + r.[1] <- x.[1] `>>` y; + r.[2] <- x.[2] `>>` y; + r.[3] <- x.[3] `>>` y; + return r; + } + + proc ivshl64u256 (x: t4u64, y: W8.t) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0] `<<` y; + r.[1] <- x.[1] `<<` y; + r.[2] <- x.[2] `<<` y; + r.[3] <- x.[3] `<<` y; + return r; + } + + + proc iVPSRLV_4u64 (x: t4u64, y: t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0] `>>>` W64.to_uint y.[0]; + r.[1] <- x.[1] `>>>` W64.to_uint y.[1]; + r.[2] <- x.[2] `>>>` W64.to_uint y.[2]; + r.[3] <- x.[3] `>>>` W64.to_uint y.[3]; + return r; + } + + proc iVPSLLV_4u64 (x: t4u64, y: t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0] `<<<` W64.to_uint y.[0]; + r.[1] <- x.[1] `<<<` W64.to_uint y.[1]; + r.[2] <- x.[2] `<<<` W64.to_uint y.[2]; + r.[3] <- x.[3] `<<<` W64.to_uint y.[3]; + return r; + } + + proc iland4u64 (x y:t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0] `&` y.[0]; + r.[1] <- x.[1] `&` y.[1]; + r.[2] <- x.[2] `&` y.[2]; + r.[3] <- x.[3] `&` y.[3]; + return r; + } + + proc ilor4u64 (x y:t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0] `|` y.[0]; + r.[1] <- x.[1] `|` y.[1]; + r.[2] <- x.[2] `|` y.[2]; + r.[3] <- x.[3] `|` y.[3]; + return r; + } + + proc ilandn4u64(x y:t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- invw x.[0] `&` y.[0]; + r.[1] <- invw x.[1] `&` y.[1]; + r.[2] <- invw x.[2] `&` y.[2]; + r.[3] <- invw x.[3] `&` y.[3]; + return r; + } + + proc ilxor4u64(x y:t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0] `^` y.[0]; + r.[1] <- x.[1] `^` y.[1]; + r.[2] <- x.[2] `^` y.[2]; + r.[3] <- x.[3] `^` y.[3]; + return r; + } + + proc iVPBLENDD_256(x y:t4u64, p : W8.t) : W64.t Array4.t = { + var r : t4u64; + r <- witness; + r.[0] <- + if p.[0] = p.[1] then + let w = if p.[0] then y else x in + w.[0] + else + let w0 = if p.[0] then y else x in + let w1 = if p.[1] then y else x in + W2u32.pack2 [w0.[0] \bits32 0; w1.[0] \bits32 1]; + r.[1] <- + if p.[2] = p.[3] then + let w = if p.[2] then y else x in + w.[1] + else + let w0 = if p.[2] then y else x in + let w1 = if p.[3] then y else x in + W2u32.pack2 [w0.[1] \bits32 0; w1.[1] \bits32 1]; + r.[2] <- + if p.[4] = p.[5] then + let w = if p.[4] then y else x in + w.[2] + else + let w0 = if p.[4] then y else x in + let w1 = if p.[5] then y else x in + W2u32.pack2 [w0.[2] \bits32 0; w1.[2] \bits32 1]; + r.[3] <- + if p.[6] = p.[7] then + let w = if p.[6] then y else x in + w.[3] + else + let w0 = if p.[6] then y else x in + let w1 = if p.[7] then y else x in + W2u32.pack2 [w0.[3] \bits32 0; w1.[3] \bits32 1]; + + return r; + } + + + proc iVPSHUFD_256 (x :t4u64, p : W8.t) : t4u64 = { + var r : t4u64; + r <- witness; + r.[0] <- + let m = W8.to_uint p in + let p1 = (m %/ (2^(2*0)))%%4 in + let p2 = (m %/ (2^(2*1)))%%4 in + if p1 %/ 2 = p2 %/ 2 /\ p1 %% 2 = 0 /\ p2 %% 2 = 1 then + x.[p1 %/ 2] + else + pack2 [x.[p1 %/ 2] \bits32 p1 %% 2; x.[p2 %/ 2] \bits32 p2 %% 2]; + + r.[1] <- + let m = W8.to_uint p in + let p1 = (m %/ (2^(2*2)))%%4 in + let p2 = (m %/ (2^(2*3)))%%4 in + if p1 %/ 2 = p2 %/ 2 /\ p1 %% 2 = 0 /\ p2 %% 2 = 1 then + x.[p1 %/ 2] + else + pack2 [x.[p1 %/ 2] \bits32 p1 %% 2; x.[p2 %/ 2] \bits32 p2 %% 2]; + + r.[2] <- + let m = W8.to_uint p in + let p1 = (m %/ (2^(2*0)))%%4 in + let p2 = (m %/ (2^(2*1)))%%4 in + if p1 %/ 2 = p2 %/ 2 /\ p1 %% 2 = 0 /\ p2 %% 2 = 1 then + x.[p1 %/ 2 + 2] + else + pack2 [x.[p1 %/ 2 + 2] \bits32 p1 %% 2; x.[p2 %/ 2 + 2] \bits32 p2 %% 2]; + + r.[3] <- + let m = W8.to_uint p in + let p1 = (m %/ (2^(2*2)))%%4 in + let p2 = (m %/ (2^(2*3)))%%4 in + if p1 %/ 2 = p2 %/ 2 /\ p1 %% 2 = 0 /\ p2 %% 2 = 1 then + x.[p1 %/ 2 + 2] + else + pack2 [x.[p1 %/ 2 + 2] \bits32 p1 %% 2; x.[p2 %/ 2 + 2] \bits32 p2 %% 2]; + return r; + } +}. + +type vt2u64 = W128.t. +type vt4u64 = W256.t. + + +module OpsV = { + proc itruncate_4u64_2u64(t : vt4u64) : vt2u64 = { + return truncateu128 t; + } + proc set_160(vv : vt4u64 Array5.t, i : int, o : int, v : W64.t) : vt4u64 Array5.t = { + return Array5.init + (WArray160.get256 (WArray160.set64 (WArray160.init256 (fun i2 => vv.[i2])) (o+4*i) v)); + } + proc get_160(vv : vt4u64 Array5.t, i : int, o : int) : W64.t = { + return (get64 (WArray160.init256 (fun i2 => vv.[i2])) (o+4*i)); + } + proc get_128(vv : vt4u64 Array4.t, i : int, o : int) : W64.t = { + return (get64 (WArray128.init256 (fun i2 => vv.[i2])) (o+4*i)); + } + + proc iVPBROADCAST_4u64(v : W64.t) : vt4u64 = { + return x86_VPBROADCAST_4u64 v; + } + + proc iVPMULU_256 (x y:vt4u64) : vt4u64 = { + return x86_VPMULU_256 x y; + } + + proc ivadd64u256(x y:vt4u64) : vt4u64 = { + return x86_VPADD_4u64 x y; + } + + proc iload4u64 (mem:global_mem_t, p:W64.t) : vt4u64 = { + return loadW256 mem (to_uint p); + } + + proc iVPERM2I128(x y:vt4u64, p : W8.t) : vt4u64 = { + return x86_VPERM2I128 x y p; + } + + proc iVPERMQ(x :vt4u64, p : W8.t) : vt4u64 = { + return x86_VPERMQ x p; + } + + proc iVPSRLDQ_256(x:vt4u64, p : W8.t) : vt4u64 = { + return x86_VPSRLDQ_256 x p; + } + + proc iVPUNPCKH_4u64(x y:vt4u64) : vt4u64 = { + return x86_VPUNPCKH_4u64 x y; + } + + proc iVPUNPCKL_4u64 (x y:vt4u64) : vt4u64 = { + return x86_VPUNPCKL_4u64 x y; + } + + proc iVEXTRACTI128(x:vt4u64, p : W8.t) : vt2u64 = { + return x86_VEXTRACTI128 x p; + } + + proc iVPEXTR_64(x:vt2u64, p : W8.t) : W64.t = { + return x86_VPEXTR_64 x p; + } + + + proc ivshr64u256 (x: vt4u64, y: W8.t) : vt4u64 = { + return x86_VPSRL_4u64 x y; + } + + proc ivshl64u256 (x: vt4u64, y: W8.t) : vt4u64 = { + return x86_VPSLL_4u64 x y; + } + + proc iVPSRLV_4u64 (x: vt4u64, y: vt4u64) : vt4u64 = { + return x86_VPSRLV_4u64 x y; + } + + proc iVPSLLV_4u64 (x: vt4u64, y: vt4u64) : vt4u64 = { + return x86_VPSLLV_4u64 x y; + } + + proc iland4u64 (x y: vt4u64) : vt4u64 = { + return x `&` y; + } + + proc ilor4u64 (x y: vt4u64) : vt4u64 = { + return x `|` y; + } + + proc ilandn4u64(x y: vt4u64) : vt4u64 = { + return x86_VPANDN_256 x y; + } + + proc ilxor4u64(x y: vt4u64) : vt4u64 = { + return x `^` y; + } + + proc iVPBLENDD_256(x y:vt4u64, p : W8.t) : vt4u64 = { + return x86_VPBLENDD_256 x y p; + } + + proc iVPSHUFD_256 (x :vt4u64, p : W8.t) : vt4u64 = { + return x86_VPSHUFD_256 x p; + } + +}. + +op is2u64 (x : t2u64) (xv: vt2u64) = xv = W2u64.pack2 [x.[0]; x.[1]]. +op is4u64 (x : t4u64) (xv: vt4u64) = xv = W4u64.pack4 [x.[0]; x.[1]; x.[2]; x.[3]]. + +equiv eq_itruncate_4u64_2u64 : Ops.itruncate_4u64_2u64 ~ OpsV.itruncate_4u64_2u64 : is4u64 t{1} t{2} ==> is2u64 res{1} res{2}. +proof. + proc; skip => &1 &2; rewrite /is2u64 /is4u64 => -> /=. + apply (Core.can_inj _ _ W128.to_uintK). + rewrite to_uint_truncateu128. + rewrite - (W128.to_uint_small (to_uint (pack4 [t{1}.[0]; t{1}.[1]; t{1}.[2]; t{1}.[3]]) %% W128.modulus)). + + by apply modz_cmp. + congr; apply W128.wordP => i hi. + rewrite W128.of_intwE hi W2u64.pack2wE 1:// /=. + rewrite /int_bit /= modz_mod. + have /= -> := modz_pow2_div 128 i; 1:smt(). + rewrite (modz_dvd_pow 1 (128 - i) _ 2) 1:/# /=. + have -> : (to_uint (pack4 [t{1}.[0]; t{1}.[1]; t{1}.[2]; t{1}.[3]]) %/ (IntExtra.(^) 2 i) %% 2 <> 0) = + (pack4 [t{1}.[0]; t{1}.[1]; t{1}.[2]; t{1}.[3]]).[i]. + + rewrite -{2}(W256.to_uintK (pack4 [t{1}.[0]; t{1}.[1]; t{1}.[2]; t{1}.[3]])) W256.of_intwE /int_bit (modz_small _ W256.modulus) 2:/#. + by have /= := W256.to_uint_cmp (pack4 [t{1}.[0]; t{1}.[1]; t{1}.[2]; t{1}.[3]]);rewrite /(`|_|). + rewrite W4u64.pack4wE 1:/#. + case: (i < 64) => hi'. + + by rewrite divz_small 1:/#. + have -> // : i %/ 64 = 1. + have -> : i = (i -64) + 1 * 64 by done. + rewrite divzMDr 1://; smt(divz_small). +qed. + +op is4u64_5 (x:t4u64 Array5.t) (xv:vt4u64 Array5.t) = + xv = Array5.init (fun i => W4u64.pack4 [x.[i].[0]; x.[i].[1]; x.[i].[2]; x.[i].[3]]). + +op is4u64_4 (x:t4u64 Array4.t) (xv:vt4u64 Array4.t) = + xv = Array4.init (fun i => W4u64.pack4 [x.[i].[0]; x.[i].[1]; x.[i].[2]; x.[i].[3]]). + +lemma get8_pack4u64 ws j: + W4u64.pack4_t ws \bits8 j = + if 0 <= j < 32 then ws.[j %/ 8] \bits8 (j %% 8) else W8.zero. +proof. + rewrite pack4E W8.wordP => i hi. + rewrite bits8E /= initE hi /= initE. + have -> /= : (0 <= j * 8 + i < 256) <=> (0 <= j < 32) by smt(). + case : (0 <= j < 32) => hj //=. + rewrite bits8E /= initE. + have -> : (j * 8 + i) %/ 64 = j %/ 8. + + rewrite {1}(divz_eq j 8) mulzDl mulzA /= -addzA divzMDl //. + by rewrite (divz_small _ 64) //; smt (modz_cmp). + rewrite hi /=;congr. + rewrite {1}(divz_eq j 8) mulzDl mulzA /= -addzA modzMDl modz_small //; smt (modz_cmp). +qed. + +lemma Array5_get_set_eq (t:'a Array5.t) i a: 0 <= i < 5 => t.[i <- a].[i] = a. +proof. by move=> hi;rewrite Array5.get_setE. qed. + +equiv eq_set_160 : Ops.set_160 ~ OpsV.set_160 : is4u64_5 vv{1} vv{2} /\ ={i,o,v} /\ 0 <= i{1} < 5 /\ 0 <= o{1} < 4 ==> is4u64_5 res{1} res{2}. +proof. + proc; skip; rewrite /is4u64_5 => /> &1 &2 h1 h2 h3 h4. + apply Array5.tP => k hk. + rewrite !Array5.initiE 1,2:// /=. + rewrite /init256 set64E get256E -(W32u8.unpack8K (W4u64.pack4 _)); congr. + apply W32u8.Pack.packP => j hj. + rewrite W32u8.Pack.initiE 1:// get_unpack8 1:// /= WArray160.initiE 1:/# /=. + rewrite WArray160.initiE 1:/# /=. + rewrite (mulzC 32) modzMDl divzMDl 1:// divz_small 1:// modz_small 1:// /= Array5.initiE 1:// /=. + rewrite !get8_pack4u64 hj /=. + have /= <- := W4u64.Pack.init_of_list (fun i => vv{1}.[k].[i]). + have /= <- := W4u64.Pack.init_of_list (fun j => vv{1}.[i{2} <- vv{1}.[i{2}].[o{2} <- v{2}]].[k].[j]). + have ? : 0 <= j %/ 8 < 4 by rewrite ltz_divLR // lez_divRL. + rewrite !W4u64.Pack.initiE 1,2:// /=. + rewrite Array5.get_setE 1://. + case: (k = i{2}) => [->> | /#]. + rewrite Array4.get_setE 1://;smt(edivzP). +qed. + +equiv eq_get_160 : Ops.get_160 ~ OpsV.get_160 : is4u64_5 vv{1} vv{2} /\ ={i,o} /\ 0 <= i{1} < 5 /\ 0 <= o{1} < 4 ==> ={res}. +proof. + proc;skip;rewrite /is4u64_5 => /> &1 &2 h1 h2 h3 h4. + rewrite /init256 get64E -(W8u8.unpack8K vv{1}.[i{2}].[o{2}]);congr. + apply W8u8.Pack.packP => j hj. + rewrite W8u8.Pack.initiE 1:// initiE 1:// /= initiE 1:/# /=. + have -> : (8 * (o{2} + 4 * i{2}) + j) = (o{2} * 8 + j) + i{2} * 32 by ring. + have ? : 0 <= o{2} * 8 + j < `|32| by smt(). + rewrite modzMDr divzMDr 1:// divz_small 1:// modz_small 1:// /=. + rewrite Array5.initiE 1:// /= get8_pack4u64. + have /= <- := W4u64.Pack.init_of_list (fun j => vv{1}.[i{2}].[j]). + rewrite divzMDl 1:// divz_small 1:// modzMDl /= initiE 1:// modz_small 1:// /#. +qed. + +equiv eq_get_128 : Ops.get_128 ~ OpsV.get_128 : is4u64_4 vv{1} vv{2} /\ ={i,o} /\ 0 <= i{1} < 4 /\ 0 <= o{1} < 4 ==> ={res}. +proof. + proc;skip;rewrite /is4u64_4 => /> &1 &2 h1 h2 h3 h4. + rewrite /init256 get64E -(W8u8.unpack8K vv{1}.[i{2}].[o{2}]);congr. + apply W8u8.Pack.packP => j hj. + rewrite W8u8.Pack.initiE 1:// initiE 1:// /= initiE 1:/# /=. + have -> : (8 * (o{2} + 4 * i{2}) + j) = (o{2} * 8 + j) + i{2} * 32 by ring. + have ? : 0 <= o{2} * 8 + j < `|32| by smt(). + rewrite modzMDr divzMDr 1:// divz_small 1:// modz_small 1:// /=. + rewrite Array4.initiE 1:// /= get8_pack4u64. + have /= <- := W4u64.Pack.init_of_list (fun j => vv{1}.[i{2}].[j]). + rewrite divzMDl 1:// divz_small 1:// modzMDl /= initiE 1:// modz_small 1:// /#. +qed. + +equiv eq_iVPBROADCAST_4u64 : Ops.iVPBROADCAST_4u64 ~ OpsV.iVPBROADCAST_4u64 : ={v} ==> is4u64 res{1} res{2}. +proof. by proc => /=;wp;skip;rewrite /is4u64. qed. + +equiv eq_iVPMULU_256 : Ops.iVPMULU_256 ~ OpsV.iVPMULU_256 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc;wp;skip;rewrite /is4u64 => /> &1; rewrite /x86_VPMULU_256. qed. + +equiv eq_ivadd64u256: Ops.ivadd64u256 ~ OpsV.ivadd64u256 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc;wp;skip;rewrite /is4u64 /x86_VPADD_4u64. qed. + +equiv eq_iload4u64: Ops.iload4u64 ~ OpsV.iload4u64 : ={mem, p} /\ to_uint p{1} + 32 <= W64.modulus ==> is4u64 res{1} res{2}. +proof. + proc; wp; skip; rewrite /is4u64 => /> &2 hp. + rewrite /loadW256 -(W32u8.unpack8K (W4u64.pack4 _));congr. + apply W32u8.Pack.packP => j hj. + rewrite initiE 1:// W32u8.get_unpack8 1:// /= get8_pack4u64 hj /=. + have /= <- := W4u64.Pack.init_of_list (fun j => loadW64 mem{2} (to_uint (p{2} + W64.of_int (8 * j)))). + have ? : 0 <= j %/ 8 < 4 by rewrite ltz_divLR // lez_divRL. + have ? := modz_cmp j 8. + rewrite initiE 1:// /loadW64 /= pack8bE 1:// initiE 1:// /=. + have heq : to_uint (W64.of_int (8 * (j %/ 8))) = 8 * (j %/ 8). + + by rewrite of_uintK modz_small 2:// /= /#. + rewrite to_uintD_small heq 1:/#; smt (edivzP). +qed. + +equiv eq_iVPERM2I128 : Ops.iVPERM2I128 ~ OpsV.iVPERM2I128 : + is4u64 x{1} x{2} /\ is4u64 y{1} y{2} /\ ={p} ==> is4u64 res{1} res{2}. +proof. + proc; wp; skip; rewrite /is4u64 => /> &1 &2; cbv delta. + rewrite -(W8.to_uintK' p{2}) !of_intwE /=. + apply W2u128.allP => /=. + case: (W8.int_bit (to_uint p{2}) 3) => ?. + + split; 1: by apply W2u64.allP; cbv delta. + case: (W8.int_bit (to_uint p{2}) 7) => ?; 1: by apply W2u64.allP; cbv delta. + by case: (W8.int_bit (to_uint p{2}) 5) => ?; case: (W8.int_bit (to_uint p{2}) 4). + split. + + by case: (W8.int_bit (to_uint p{2}) 1) => ?; case: (W8.int_bit (to_uint p{2}) 0). + case: (W8.int_bit (to_uint p{2}) 7) => ?; 1: by apply W2u64.allP; cbv delta. + by case: (W8.int_bit (to_uint p{2}) 5) => ?; case: (W8.int_bit (to_uint p{2}) 4). +qed. + +lemma pack4_bits64 (x:t4u64) (i:int): 0 <= i < 4 => + pack4 [x.[0]; x.[1]; x.[2]; x.[3]] \bits64 i = x.[i]. +proof. by have /= <- [#|] -> := mema_iota 0 4. qed. + +equiv eq_iVPERMQ : Ops.iVPERMQ ~ OpsV.iVPERMQ : is4u64 x{1} x{2} /\ ={p} ==> is4u64 res{1} res{2}. +proof. + proc; wp; skip; rewrite /is4u64 => /> &1 &2. + by rewrite /x86_VPERMQ /= !pack4_bits64 ?modz_cmp. +qed. + +lemma lsr_2u64 (w1 w2:W64.t) (x:int) : 0 <= x <= 64 => + pack2 [w1; w2] `>>>` x = pack2 [(w1 `>>>` x) `|` (w2 `<<<` 64 - x); w2 `>>>` x]. +proof. + move=> hx;apply W128.wordP => i hi. + rewrite pack2wE 1://. + rewrite W128.shrwE hi /=. + case: (i < 64) => hi1. + + have [-> ->] /=: i %/ 64 = 0 /\ i %% 64 = i by smt(edivzP). + rewrite pack2wE 1:/#. + have -> : 0 <= i < 64 by smt(). + case: (i + x < 64) => hix. + + have [-> ->] /= : (i + x) %/ 64 = 0 /\ (i + x) %% 64 = i + x by smt(edivzP). + by rewrite (W64.get_out w2) 1:/#. + have [-> ->] /= : (i + x) %/ 64 = 1 /\ (i + x) %% 64 = i - (64 - x) by smt(edivzP). + by rewrite (W64.get_out w1) 1:/#. + have [-> ->] /= : i %/ 64 = 1 /\ i %% 64 = i - 64 by smt(edivzP). + case (i + x < 128) => hix;last by rewrite W128.get_out 1:/# W64.get_out 1:/#. + rewrite pack2wE 1:/#. + have -> /= : 0 <= i - 64 < 64 by smt(). + by have [-> ->] : (i + x) %/ 64 = 1 /\ (i + x) %% 64 = i - 64 + x by smt(edivzP). +qed. + +lemma lsr_2u64_64 (w1 w2:W64.t) (x:int) : 64 <= x <= 128 => + pack2 [w1; w2] `>>>` x = pack2 [(w2 `>>>` (x - 64)); W64.zero]. +proof. + move=> hx;apply W128.wordP => i hi. + rewrite pack2wE 1://. + rewrite W128.shrwE hi /=. + case: (i < 64) => hi1. + + have [-> ->] /=: i %/ 64 = 0 /\ i %% 64 = i by smt(edivzP). + case: (i + x < 128) => ?. + + rewrite pack2wE 1:/#. + by have -> /= /# : (i + x) %/ 64 = 1 by smt(). + by rewrite W128.get_out 1:/# W64.get_out 1:/#. + have [-> ->] /= : i %/ 64 = 1 /\ i %% 64 = i - 64 by smt(edivzP). + by rewrite W128.get_out 1:/#. +qed. + +lemma lsr_0 (w:W64.t) : w `<<<` 0 = w. +proof. by apply W64.wordP => i hi; rewrite W64.shlwE hi. qed. + +equiv eq_iVPSRLDQ_256: Ops.iVPSRLDQ_256 ~ OpsV.iVPSRLDQ_256 : + is4u64 x{1} x{2} /\ ={p} ==> is4u64 res{1} res{2}. +proof. + proc; wp; skip; rewrite /is4u64 => /> &1 &2; cbv delta. + case: (to_uint p{2} = 8) => [-> | ?] /=. + + by rewrite !lsr_2u64 //= !lsr_0. + pose i := if to_uint p{2} < 16 then to_uint p{2} else 16. + case: (i < 8) => ?. + + rewrite !lsr_2u64 //=; smt (W8.to_uint_cmp). + by rewrite !lsr_2u64_64 1,2:/# /= /#. +qed. + +equiv eq_iVPUNPCKH_4u64: Ops.iVPUNPCKH_4u64 ~ OpsV.iVPUNPCKH_4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc; wp; skip; rewrite /is4u64 => />; cbv delta. qed. + +equiv eq_iVPUNPCKL_4u64: Ops.iVPUNPCKL_4u64 ~ OpsV.iVPUNPCKL_4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc; wp; skip; rewrite /is4u64 => />; cbv delta. qed. + +equiv eq_iVEXTRACTI128: Ops.iVEXTRACTI128 ~ OpsV.iVEXTRACTI128 : + is4u64 x{1} x{2} /\ ={p} ==> is2u64 res{1} res{2}. +proof. + proc; wp; skip;rewrite /is4u64 /is2u64 /x86_VEXTRACTI128 => /> &1 &2. + by case: (p{2}.[0]) => ?; cbv delta. +qed. + +equiv eq_iVPEXTR_64: Ops.iVPEXTR_64 ~ OpsV.iVPEXTR_64 : is2u64 x{1} x{2} /\ ={p} /\ (p{1} = W8.of_int 0 \/ p{2} = W8.of_int 1)==> res{1} = res{2}. +proof. by proc; skip; rewrite /is2u64 /x86_VPEXTR_64 => /> &1 &2 [] -> /=. qed. + +equiv eq_ivshr64u256: Ops.ivshr64u256 ~ OpsV.ivshr64u256 : is4u64 x{1} x{2} /\ ={y} ==> is4u64 res{1} res{2}. +proof. by proc; wp; skip; rewrite /is4u64 /x86_VPSRL_4u64. qed. + +equiv eq_ivshl64u256: Ops.ivshl64u256 ~ OpsV.ivshl64u256 : is4u64 x{1} x{2} /\ ={y} ==> is4u64 res{1} res{2}. +proof. by proc; wp; skip; rewrite /is4u64 /x86_VPSLL_4u64. qed. + +equiv eq_iland4u64: Ops.iland4u64 ~ OpsV.iland4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc; wp; skip; rewrite /is4u64. qed. + +equiv eq_ilor4u64: Ops.ilor4u64 ~ OpsV.ilor4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc; wp; skip; rewrite /is4u64. qed. + +equiv eq_ilandn4u64 : Ops.ilandn4u64 ~ OpsV.ilandn4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc; wp; skip; rewrite /is4u64 => />; cbv delta. qed. + +equiv eq_ilxor4u64: Ops.ilxor4u64 ~ OpsV.ilxor4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc; wp; skip; rewrite /is4u64. qed. + +equiv eq_iVPSRLV_4u64 : Ops.iVPSRLV_4u64 ~ OpsV.iVPSRLV_4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc;wp; skip; rewrite /is4u64 => />; cbv delta. qed. + +equiv eq_iVPSLLV_4u64 : Ops.iVPSLLV_4u64 ~ OpsV.iVPSLLV_4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc;wp; skip; rewrite /is4u64 => />; cbv delta. qed. + +equiv eq_iVPBLENDD_256 : Ops.iVPBLENDD_256 ~ OpsV.iVPBLENDD_256 : + is4u64 x{1} x{2} /\ is4u64 y{1} y{2} /\ ={p} + ==> + is4u64 res{1} res{2}. +proof. + proc; wp; skip; rewrite /is4u64 /x86_VPBLENDD_256 => /> &1 &2 /=. + apply W8u32.allP => /=. + split; 1: by case: (p{2}.[0] = p{2}.[1]); case: (p{2}.[0]). + split; 1: by case: (p{2}.[0] = p{2}.[1]) => [->|]; case: (p{2}.[1]). + split; 1: by case: (p{2}.[2] = p{2}.[3]); case: (p{2}.[2]). + split; 1: by case: (p{2}.[2] = p{2}.[3]) => [->|];case: (p{2}.[3]). + split; 1: by case: ( p{2}.[4] = p{2}.[5]); case: (p{2}.[4]). + split; 1: by case: ( p{2}.[4] = p{2}.[5]) => [->|]; case: (p{2}.[5]). + split; 1: by case: (p{2}.[6] = p{2}.[7]); case: (p{2}.[6]). + by case: (p{2}.[6] = p{2}.[7]) => [->|]; case: (p{2}.[7]). +qed. + +equiv eq_iVPSHUFD_256 : Ops.iVPSHUFD_256 ~ OpsV.iVPSHUFD_256 : + is4u64 x{1} x{2} /\ ={p} ==> is4u64 res{1} res{2}. +proof. + proc; wp; skip; rewrite /is4u64 => /> &1 &2; apply W8u32.allP; cbv delta. + have heq0 : forall (w: t4u64) i, 0 <= i < 2 => (W2u64.Pack.of_list [w.[0]; w.[1]]).[i] = w.[i]. + + by move=> w i /(mema_iota 0 2) /= [#|] -> /=. + have heq1 : forall (w: t4u64) i, 0 <= i < 2 => (W2u64.Pack.of_list [w.[2]; w.[3]]).[i] = w.[i+2]. + + by move=> w i /(mema_iota 0 2) /= [#|] -> /=. + have hmod : forall x, 0 <= x %%4 %/2 < 2 by smt(). + do !(rewrite bits32_W2u64_red 1:modz_cmp 1:// heq0 1:hmod /=). + do !(rewrite bits32_W2u64_red 1:modz_cmp 1:// heq1 1:hmod /=). + split. + + by case: (to_uint p{2} %% 4 %/ 2 = to_uint p{2} %/ 4 %% 4 %/ 2 /\ + to_uint p{2} %% 4 %% 2 = 0 /\ to_uint p{2} %/ 4 %% 4 %% 2 = 1) => [ [# -> ->] |]. + split. + + by case: (to_uint p{2} %% 4 %/ 2 = to_uint p{2} %/ 4 %% 4 %/ 2 /\ + to_uint p{2} %% 4 %% 2 = 0 /\ to_uint p{2} %/ 4 %% 4 %% 2 = 1) => [ [# -> _ ->] |]. + split. + + by case: (to_uint p{2} %/ 16 %% 4 %/ 2 = to_uint p{2} %/ 64 %% 4 %/ 2 /\ + to_uint p{2} %/ 16 %% 4 %% 2 = 0 /\ to_uint p{2} %/ 64 %% 4 %% 2 = 1) => [[# -> ->] |]. + split. + + by case: (to_uint p{2} %/ 16 %% 4 %/ 2 = to_uint p{2} %/ 64 %% 4 %/ 2 /\ + to_uint p{2} %/ 16 %% 4 %% 2 = 0 /\ to_uint p{2} %/ 64 %% 4 %% 2 = 1) => [[# -> _ ->] |]. + split. + + by case: (to_uint p{2} %% 4 %/ 2 = to_uint p{2} %/ 4 %% 4 %/ 2 /\ + to_uint p{2} %% 4 %% 2 = 0 /\ to_uint p{2} %/ 4 %% 4 %% 2 = 1) => [[# -> ->]|]. + split. + + by case: (to_uint p{2} %% 4 %/ 2 = to_uint p{2} %/ 4 %% 4 %/ 2 /\ + to_uint p{2} %% 4 %% 2 = 0 /\ to_uint p{2} %/ 4 %% 4 %% 2 = 1) => [[# -> _ ->]|]. + split. + + by case: (to_uint p{2} %/ 16 %% 4 %/ 2 = to_uint p{2} %/ 64 %% 4 %/ 2 /\ + to_uint p{2} %/ 16 %% 4 %% 2 = 0 /\ to_uint p{2} %/ 64 %% 4 %% 2 = 1) => [[# -> ->]|]. + by case: (to_uint p{2} %/ 16 %% 4 %/ 2 = to_uint p{2} %/ 64 %% 4 %/ 2 /\ + to_uint p{2} %/ 16 %% 4 %% 2 = 0 /\ to_uint p{2} %/ 64 %% 4 %% 2 = 1) => [[# -> _ ->]|]. +qed. diff --git a/sha3/proof/impl/perm/WArray128.ec b/sha3/proof/impl/perm/WArray128.ec new file mode 100644 index 0000000..3c9d689 --- /dev/null +++ b/sha3/proof/impl/perm/WArray128.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray128 with op size <- 128. diff --git a/sha3/proof/impl/perm/WArray160.ec b/sha3/proof/impl/perm/WArray160.ec new file mode 100644 index 0000000..05cce71 --- /dev/null +++ b/sha3/proof/impl/perm/WArray160.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray160 with op size <- 160. diff --git a/sha3/proof/impl/perm/WArray192.ec b/sha3/proof/impl/perm/WArray192.ec new file mode 100644 index 0000000..c8564c5 --- /dev/null +++ b/sha3/proof/impl/perm/WArray192.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray192 with op size <- 192. diff --git a/sha3/proof/impl/perm/WArray200.ec b/sha3/proof/impl/perm/WArray200.ec new file mode 100644 index 0000000..99b887c --- /dev/null +++ b/sha3/proof/impl/perm/WArray200.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray200 with op size <- 200. diff --git a/sha3/proof/impl/perm/WArray224.ec b/sha3/proof/impl/perm/WArray224.ec new file mode 100644 index 0000000..f9d6745 --- /dev/null +++ b/sha3/proof/impl/perm/WArray224.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray224 with op size <- 224. diff --git a/sha3/proof/impl/perm/WArray288.ec b/sha3/proof/impl/perm/WArray288.ec new file mode 100644 index 0000000..86ac7cc --- /dev/null +++ b/sha3/proof/impl/perm/WArray288.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray288 with op size <- 288. diff --git a/sha3/proof/impl/perm/WArray40.ec b/sha3/proof/impl/perm/WArray40.ec new file mode 100644 index 0000000..003b6e2 --- /dev/null +++ b/sha3/proof/impl/perm/WArray40.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray40 with op size <- 40. diff --git a/sha3/proof/impl/perm/keccak_f1600_avx2.ec b/sha3/proof/impl/perm/keccak_f1600_avx2.ec new file mode 100644 index 0000000..dcbfa9c --- /dev/null +++ b/sha3/proof/impl/perm/keccak_f1600_avx2.ec @@ -0,0 +1,1001 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array7 Array9. +require import WArray224 WArray288. + + + +module M = { + proc __keccak_f1600_avx2 (state:W256.t Array7.t, _rhotates_left:W64.t, + _rhotates_right:W64.t, _iotas:W64.t) : W256.t Array7.t = { + + var rhotates_left:W64.t; + var rhotates_right:W64.t; + var iotas:W64.t; + var r:W32.t; + var zf:bool; + var c00:W256.t; + var c14:W256.t; + var t:W256.t Array9.t; + var d14:W256.t; + var d00:W256.t; + var _0:bool; + var _1:bool; + var _2:bool; + t <- witness; + rhotates_left <- (_rhotates_left + (W64.of_int 96)); + rhotates_right <- (_rhotates_right + (W64.of_int 96)); + iotas <- _iotas; + r <- (W32.of_int 24); + c00 <- x86_VPSHUFD_256 state.[2] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + c14 <- (state.[5] `^` state.[3]); + t.[2] <- (state.[4] `^` state.[6]); + c14 <- (c14 `^` state.[1]); + c14 <- (c14 `^` t.[2]); + t.[4] <- x86_VPERMQ c14 + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 2)))); + c00 <- (c00 `^` state.[2]); + t.[0] <- x86_VPERMQ c00 + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + t.[1] <- (c14 \vshr64u256 (W8.of_int 63)); + t.[2] <- (c14 \vadd64u256 c14); + t.[1] <- (t.[1] `|` t.[2]); + d14 <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + d00 <- (t.[1] `^` t.[4]); + d00 <- x86_VPERMQ d00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + c00 <- (c00 `^` state.[0]); + c00 <- (c00 `^` t.[0]); + t.[0] <- (c00 \vshr64u256 (W8.of_int 63)); + t.[1] <- (c00 \vadd64u256 c00); + t.[1] <- (t.[1] `|` t.[0]); + state.[2] <- (state.[2] `^` d00); + state.[0] <- (state.[0] `^` d00); + d14 <- x86_VPBLENDD_256 d14 t.[1] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[4] <- x86_VPBLENDD_256 t.[4] c00 + (W8.of_int (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + d14 <- (d14 `^` t.[4]); + t.[3] <- x86_VPSLLV_4u64 state.[2] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 0) - 96))))); + state.[2] <- x86_VPSRLV_4u64 state.[2] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 0) - 96))))); + state.[2] <- (state.[2] `|` t.[3]); + state.[3] <- (state.[3] `^` d14); + t.[4] <- x86_VPSLLV_4u64 state.[3] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 2) - 96))))); + state.[3] <- x86_VPSRLV_4u64 state.[3] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 2) - 96))))); + state.[3] <- (state.[3] `|` t.[4]); + state.[4] <- (state.[4] `^` d14); + t.[5] <- x86_VPSLLV_4u64 state.[4] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 3) - 96))))); + state.[4] <- x86_VPSRLV_4u64 state.[4] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 3) - 96))))); + state.[4] <- (state.[4] `|` t.[5]); + state.[5] <- (state.[5] `^` d14); + t.[6] <- x86_VPSLLV_4u64 state.[5] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 4) - 96))))); + state.[5] <- x86_VPSRLV_4u64 state.[5] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 4) - 96))))); + state.[5] <- (state.[5] `|` t.[6]); + state.[6] <- (state.[6] `^` d14); + t.[3] <- x86_VPERMQ state.[2] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + t.[4] <- x86_VPERMQ state.[3] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + t.[7] <- x86_VPSLLV_4u64 state.[6] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 5) - 96))))); + t.[1] <- x86_VPSRLV_4u64 state.[6] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 5) - 96))))); + t.[1] <- (t.[1] `|` t.[7]); + state.[1] <- (state.[1] `^` d14); + t.[5] <- x86_VPERMQ state.[4] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + t.[6] <- x86_VPERMQ state.[5] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + t.[8] <- x86_VPSLLV_4u64 state.[1] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 1) - 96))))); + t.[2] <- x86_VPSRLV_4u64 state.[1] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 1) - 96))))); + t.[2] <- (t.[2] `|` t.[8]); + t.[7] <- x86_VPSRLDQ_256 t.[1] (W8.of_int 8); + t.[0] <- ((invw t.[1]) `&` t.[7]); + state.[3] <- x86_VPBLENDD_256 t.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- x86_VPBLENDD_256 t.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- x86_VPBLENDD_256 state.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- x86_VPBLENDD_256 state.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- x86_VPBLENDD_256 state.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[5] <- x86_VPBLENDD_256 state.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[3] <- ((invw state.[3]) `&` t.[8]); + state.[5] <- ((invw state.[5]) `&` t.[7]); + state.[6] <- x86_VPBLENDD_256 t.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- (state.[3] `^` t.[3]); + state.[6] <- x86_VPBLENDD_256 state.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- (state.[5] `^` t.[5]); + state.[6] <- x86_VPBLENDD_256 state.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[6] <- ((invw state.[6]) `&` t.[8]); + state.[6] <- (state.[6] `^` t.[6]); + state.[4] <- x86_VPERMQ t.[1] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + t.[8] <- x86_VPBLENDD_256 state.[4] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[1] <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + state.[1] <- x86_VPBLENDD_256 state.[1] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[1] <- ((invw state.[1]) `&` t.[8]); + state.[2] <- x86_VPBLENDD_256 t.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[2] <- x86_VPBLENDD_256 state.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[2] <- x86_VPBLENDD_256 state.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[2] <- ((invw state.[2]) `&` t.[7]); + state.[2] <- (state.[2] `^` t.[2]); + t.[0] <- x86_VPERMQ t.[0] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + state.[3] <- x86_VPERMQ state.[3] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + state.[5] <- x86_VPERMQ state.[5] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + state.[6] <- x86_VPERMQ state.[6] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + state.[4] <- x86_VPBLENDD_256 t.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[4] <- x86_VPBLENDD_256 state.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[4] <- x86_VPBLENDD_256 state.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[4] <- ((invw state.[4]) `&` t.[7]); + state.[0] <- (state.[0] `^` t.[0]); + state.[1] <- (state.[1] `^` t.[1]); + state.[4] <- (state.[4] `^` t.[4]); + state.[0] <- + (state.[0] `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int ((32 * 0) - 0)))))); + iotas <- (iotas + (W64.of_int 32)); + ( _0, _1, _2, zf, r) <- x86_DEC_32 r; + while ((! zf)) { + c00 <- x86_VPSHUFD_256 state.[2] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + c14 <- (state.[5] `^` state.[3]); + t.[2] <- (state.[4] `^` state.[6]); + c14 <- (c14 `^` state.[1]); + c14 <- (c14 `^` t.[2]); + t.[4] <- x86_VPERMQ c14 + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 2)))); + c00 <- (c00 `^` state.[2]); + t.[0] <- x86_VPERMQ c00 + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + t.[1] <- (c14 \vshr64u256 (W8.of_int 63)); + t.[2] <- (c14 \vadd64u256 c14); + t.[1] <- (t.[1] `|` t.[2]); + d14 <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + d00 <- (t.[1] `^` t.[4]); + d00 <- x86_VPERMQ d00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + c00 <- (c00 `^` state.[0]); + c00 <- (c00 `^` t.[0]); + t.[0] <- (c00 \vshr64u256 (W8.of_int 63)); + t.[1] <- (c00 \vadd64u256 c00); + t.[1] <- (t.[1] `|` t.[0]); + state.[2] <- (state.[2] `^` d00); + state.[0] <- (state.[0] `^` d00); + d14 <- x86_VPBLENDD_256 d14 t.[1] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[4] <- x86_VPBLENDD_256 t.[4] c00 + (W8.of_int (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + d14 <- (d14 `^` t.[4]); + t.[3] <- x86_VPSLLV_4u64 state.[2] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 0) - 96))))); + state.[2] <- x86_VPSRLV_4u64 state.[2] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 0) - 96))))); + state.[2] <- (state.[2] `|` t.[3]); + state.[3] <- (state.[3] `^` d14); + t.[4] <- x86_VPSLLV_4u64 state.[3] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 2) - 96))))); + state.[3] <- x86_VPSRLV_4u64 state.[3] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 2) - 96))))); + state.[3] <- (state.[3] `|` t.[4]); + state.[4] <- (state.[4] `^` d14); + t.[5] <- x86_VPSLLV_4u64 state.[4] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 3) - 96))))); + state.[4] <- x86_VPSRLV_4u64 state.[4] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 3) - 96))))); + state.[4] <- (state.[4] `|` t.[5]); + state.[5] <- (state.[5] `^` d14); + t.[6] <- x86_VPSLLV_4u64 state.[5] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 4) - 96))))); + state.[5] <- x86_VPSRLV_4u64 state.[5] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 4) - 96))))); + state.[5] <- (state.[5] `|` t.[6]); + state.[6] <- (state.[6] `^` d14); + t.[3] <- x86_VPERMQ state.[2] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + t.[4] <- x86_VPERMQ state.[3] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + t.[7] <- x86_VPSLLV_4u64 state.[6] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 5) - 96))))); + t.[1] <- x86_VPSRLV_4u64 state.[6] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 5) - 96))))); + t.[1] <- (t.[1] `|` t.[7]); + state.[1] <- (state.[1] `^` d14); + t.[5] <- x86_VPERMQ state.[4] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + t.[6] <- x86_VPERMQ state.[5] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + t.[8] <- x86_VPSLLV_4u64 state.[1] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 1) - 96))))); + t.[2] <- x86_VPSRLV_4u64 state.[1] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 1) - 96))))); + t.[2] <- (t.[2] `|` t.[8]); + t.[7] <- x86_VPSRLDQ_256 t.[1] (W8.of_int 8); + t.[0] <- ((invw t.[1]) `&` t.[7]); + state.[3] <- x86_VPBLENDD_256 t.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- x86_VPBLENDD_256 t.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- x86_VPBLENDD_256 state.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- x86_VPBLENDD_256 state.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- x86_VPBLENDD_256 state.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[5] <- x86_VPBLENDD_256 state.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[3] <- ((invw state.[3]) `&` t.[8]); + state.[5] <- ((invw state.[5]) `&` t.[7]); + state.[6] <- x86_VPBLENDD_256 t.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- (state.[3] `^` t.[3]); + state.[6] <- x86_VPBLENDD_256 state.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- (state.[5] `^` t.[5]); + state.[6] <- x86_VPBLENDD_256 state.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[6] <- ((invw state.[6]) `&` t.[8]); + state.[6] <- (state.[6] `^` t.[6]); + state.[4] <- x86_VPERMQ t.[1] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + t.[8] <- x86_VPBLENDD_256 state.[4] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[1] <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + state.[1] <- x86_VPBLENDD_256 state.[1] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[1] <- ((invw state.[1]) `&` t.[8]); + state.[2] <- x86_VPBLENDD_256 t.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[2] <- x86_VPBLENDD_256 state.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[2] <- x86_VPBLENDD_256 state.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[2] <- ((invw state.[2]) `&` t.[7]); + state.[2] <- (state.[2] `^` t.[2]); + t.[0] <- x86_VPERMQ t.[0] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + state.[3] <- x86_VPERMQ state.[3] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + state.[5] <- x86_VPERMQ state.[5] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + state.[6] <- x86_VPERMQ state.[6] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + state.[4] <- x86_VPBLENDD_256 t.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[4] <- x86_VPBLENDD_256 state.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[4] <- x86_VPBLENDD_256 state.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[4] <- ((invw state.[4]) `&` t.[7]); + state.[0] <- (state.[0] `^` t.[0]); + state.[1] <- (state.[1] `^` t.[1]); + state.[4] <- (state.[4] `^` t.[4]); + state.[0] <- + (state.[0] `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int ((32 * 0) - 0)))))); + iotas <- (iotas + (W64.of_int 32)); + ( _0, _1, _2, zf, r) <- x86_DEC_32 r; + } + return (state); + } +}. + + +require Keccak_f1600_avx2_openssl. + +op flat_state (st : W256.t Array7.t) + (axx : W256.t * W256.t * W256.t * W256.t * W256.t * W256.t * W256.t ) = + st.[0] = axx.`1 /\ + st.[1] = axx.`2 /\ + st.[2] = axx.`3 /\ + st.[3] = axx.`4 /\ + st.[4] = axx.`5 /\ + st.[5] = axx.`6 /\ + st.[6] = axx.`7. + +equiv avx2_avx2_openssl : + Keccak_f1600_avx2_openssl.M.__keccak_f1600_avx2_openssl ~ M.__keccak_f1600_avx2 : + ={Glob.mem,_rhotates_left,_rhotates_right, _iotas} /\ + flat_state state{2} (arg{1}.`1,arg{1}.`2,arg{1}.`3,arg{1}.`4,arg{1}.`5,arg{1}.`6,arg{1}.`7) ==> + ={Glob.mem} /\ flat_state res{2} res{1}. + proc. + seq 112 112 : (#pre /\ ={zf,iotas,rhotates_left,rhotates_right,t} /\ i{1} = r{2}). + seq 30 30 : (#pre /\ ={d14,t,iotas,rhotates_left,rhotates_right} /\ i{1} = r{2}). + by wp;skip; rewrite /flat_state; auto => />. + seq 30 30 : #pre. + by wp;skip; rewrite /flat_state; auto => />. + seq 30 30 : #pre. + by wp;skip; rewrite /flat_state; auto => />. + by wp;skip; rewrite /flat_state; auto => />. + while (#pre). + seq 30 30 : (#pre /\ ={d14}). + by wp;skip; rewrite /flat_state; auto => />. + seq 30 30 : #pre. + by wp;skip; rewrite /flat_state; auto => />. + seq 30 30 : #pre. + by wp;skip; rewrite /flat_state; auto => />. + by wp;skip; rewrite /flat_state; auto => />. + by auto => />. +qed. + +require import Array4 Array25. +require Keccak_f1600_ref_op. +require Keccak_f1600_ref. +require Keccak_f1600_ref_table. +require import Keccak_f1600_avx2_prevec. +require Keccak_f1600_avx2_prevec_vops. + +require import Ops. + +op em_states (state : W256.t Array7.t) (st : W64.t Array25.t) = + state = + Array7.of_list witness [pack4 [st.[index 0 0]; st.[index 0 0]; st.[index 0 0]; st.[index 0 0]]; + pack4 [st.[index 0 1]; st.[index 0 2]; st.[index 0 3]; st.[index 0 4]]; + pack4 [st.[index 2 0]; st.[index 4 0]; st.[index 1 0]; st.[index 3 0]]; + pack4 [st.[index 3 1]; st.[index 1 2]; st.[index 4 3]; st.[index 2 4]]; + pack4 [st.[index 2 1]; st.[index 4 2]; st.[index 1 3]; st.[index 3 4]]; + pack4 [st.[index 4 1]; st.[index 3 2]; st.[index 2 3]; st.[index 1 4]]; + pack4 [st.[index 1 1]; st.[index 2 2]; st.[index 3 3]; st.[index 4 4]]]. + +lemma avx2corr st mem : + equiv [ Keccak_f1600_ref.M.__keccak_f1600_ref ~ M.__keccak_f1600_avx2 : + W64.to_uint _rhotates_left{2} + 192 < W64.modulus /\ + W64.to_uint _rhotates_right{2} + 192 < W64.modulus /\ + W64.to_uint _iotas{2} + 768 < W64.modulus /\ Glob.mem{2} = mem /\ + Keccak_f1600_avx2_prevec.good_io4x mem (W64.to_uint _iotas{2}) /\ + good_rhol mem (to_uint _rhotates_left{2}) /\ + good_rhor mem (to_uint _rhotates_right{2}) /\ + em_states state{2} state{1} /\ st = state{1} ==> + Glob.mem{2} = mem /\ em_states res{2} res{1} ]. +proof. + +transitivity Keccak_f1600_ref_table.Mreftable.__keccak_f1600_ref + (={Glob.mem, state} ==> ={Glob.mem, res}) + (W64.to_uint _rhotates_left{2} + 192 < W64.modulus /\ + W64.to_uint _rhotates_right{2} + 192 < W64.modulus /\ + W64.to_uint _iotas{2} + 768 < W64.modulus /\ Glob.mem{2} = mem /\ + Keccak_f1600_avx2_prevec.good_io4x mem (W64.to_uint _iotas{2}) /\ + good_rhol mem (to_uint _rhotates_left{2}) /\ + good_rhor mem (to_uint _rhotates_right{2}) /\ + em_states state{2} state{1} /\ st = state{1} ==> + Glob.mem{2} = mem /\ em_states res{2} res{1}). ++ smt(). + done. ++ transitivity Keccak_f1600_ref_op.Mrefop.__keccak_f1600_ref + (={Glob.mem, state} ==> ={Glob.mem, res}) + (={Glob.mem, state} ==> ={Glob.mem, res}) => //. + + smt(). + + by apply Keccak_f1600_ref_op.ref_refop. + by conseq Keccak_f1600_ref_table.ref_reftable. +transitivity Mavx2_prevec.__KeccakF1600 + (to_uint _rhotates_left{2} + 192 < W64.modulus /\ + to_uint _rhotates_right{2} + 192 < W64.modulus /\ + to_uint _iotas{2} + 768 < W64.modulus /\ + Glob.mem{2} = mem /\ + good_io4x mem (to_uint _iotas{2}) /\ + good_rhol mem (to_uint _rhotates_left{2}) /\ + good_rhor mem (to_uint _rhotates_right{2}) /\ + equiv_states ((of_list witness [st.[index 0 0]; st.[index 0 0]; st.[index 0 0]; st.[index 0 0]]))%Array4 + ((of_list witness [st.[index 0 1]; st.[index 0 2]; st.[index 0 3]; st.[index 0 4]]))%Array4 + ((of_list witness [st.[index 2 0]; st.[index 4 0]; st.[index 1 0]; st.[index 3 0]]))%Array4 + ((of_list witness [st.[index 3 1]; st.[index 1 2]; st.[index 4 3]; st.[index 2 4]]))%Array4 + ((of_list witness [st.[index 2 1]; st.[index 4 2]; st.[index 1 3]; st.[index 3 4]]))%Array4 + ((of_list witness [st.[index 4 1]; st.[index 3 2]; st.[index 2 3]; st.[index 1 4]]))%Array4 + ((of_list witness [st.[index 1 1]; st.[index 2 2]; st.[index 3 3]; st.[index 4 4]]))%Array4 st /\ + a00{2} = (of_list witness [st.[index 0 0]; st.[index 0 0]; st.[index 0 0]; st.[index 0 0]])%Array4 /\ + a01{2} = (of_list witness [st.[index 0 1]; st.[index 0 2]; st.[index 0 3]; st.[index 0 4]])%Array4 /\ + a20{2} = (of_list witness [st.[index 2 0]; st.[index 4 0]; st.[index 1 0]; st.[index 3 0]])%Array4 /\ + a31{2} = (of_list witness [st.[index 3 1]; st.[index 1 2]; st.[index 4 3]; st.[index 2 4]])%Array4 /\ + a21{2} = (of_list witness [st.[index 2 1]; st.[index 4 2]; st.[index 1 3]; st.[index 3 4]])%Array4 /\ + a41{2} = (of_list witness [st.[index 4 1]; st.[index 3 2]; st.[index 2 3]; st.[index 1 4]])%Array4 /\ + a11{2} = (of_list witness [st.[index 1 1]; st.[index 2 2]; st.[index 3 3]; st.[index 4 4]])%Array4 /\ + state{1} = st + ==> + Glob.mem{2} = mem /\ + equiv_states res{2}.`1 res{2}.`2 res{2}.`3 res{2}.`4 res{2}.`5 res{2}.`6 res{2}.`7 res{1}) + + (W64.to_uint _rhotates_left{2} + 192 < W64.modulus /\ + W64.to_uint _rhotates_right{2} + 192 < W64.modulus /\ + W64.to_uint _iotas{2} + 768 < W64.modulus /\ ={Glob.mem, _rhotates_left, _rhotates_right, _iotas} /\ + Keccak_f1600_avx2_prevec.good_io4x mem (W64.to_uint _iotas{2}) /\ + good_rhol mem (to_uint _rhotates_left{2}) /\ + good_rhor mem (to_uint _rhotates_right{2}) /\ + state{2} = Array7.of_list witness [pack4 (Array4.to_list a00{1}); + pack4 (Array4.to_list a01{1}); + pack4 (Array4.to_list a20{1}); + pack4 (Array4.to_list a31{1}); + pack4 (Array4.to_list a21{1}); + pack4 (Array4.to_list a41{1}); + pack4 (Array4.to_list a11{1})] /\ + a00{1} = (of_list witness [st.[index 0 0]; st.[index 0 0]; st.[index 0 0]; st.[index 0 0]])%Array4 /\ + a01{1} = (of_list witness [st.[index 0 1]; st.[index 0 2]; st.[index 0 3]; st.[index 0 4]])%Array4 /\ + a20{1} = (of_list witness [st.[index 2 0]; st.[index 4 0]; st.[index 1 0]; st.[index 3 0]])%Array4 /\ + a31{1} = (of_list witness [st.[index 3 1]; st.[index 1 2]; st.[index 4 3]; st.[index 2 4]])%Array4 /\ + a21{1} = (of_list witness [st.[index 2 1]; st.[index 4 2]; st.[index 1 3]; st.[index 3 4]])%Array4 /\ + a41{1} = (of_list witness [st.[index 4 1]; st.[index 3 2]; st.[index 2 3]; st.[index 1 4]])%Array4 /\ + a11{1} = (of_list witness [st.[index 1 1]; st.[index 2 2]; st.[index 3 3]; st.[index 4 4]])%Array4 + ==> + ={Glob.mem} /\ + let (a00, a01, a20, a31, a21, a41, a11) = res{1} in + res{2} = + Array7.of_list witness [pack4 (Array4.to_list a00); + pack4 (Array4.to_list a01); + pack4 (Array4.to_list a20); + pack4 (Array4.to_list a31); + pack4 (Array4.to_list a21); + pack4 (Array4.to_list a41); + pack4 (Array4.to_list a11)]). ++ move=> &1 &2 [#] ??? <<- ???. + rewrite /em_states => h1 <<-. + rewrite h1. + exists Glob.mem{2}. + by exists (Array4.of_list witness [st.[index 0 0]; st.[index 0 0]; st.[index 0 0]; st.[index 0 0]], + Array4.of_list witness [st.[index 0 1]; st.[index 0 2]; st.[index 0 3]; st.[index 0 4]], + Array4.of_list witness [st.[index 2 0]; st.[index 4 0]; st.[index 1 0]; st.[index 3 0]], + Array4.of_list witness [st.[index 3 1]; st.[index 1 2]; st.[index 4 3]; st.[index 2 4]], + Array4.of_list witness [st.[index 2 1]; st.[index 4 2]; st.[index 1 3]; st.[index 3 4]], + Array4.of_list witness [st.[index 4 1]; st.[index 3 2]; st.[index 2 3]; st.[index 1 4]], + Array4.of_list witness [st.[index 1 1]; st.[index 2 2]; st.[index 3 3]; st.[index 4 4]], + _rhotates_left{2}, _rhotates_right{2}, _iotas{2}) => />. ++ move=> &1 &m &2 />. + case: ( res{m} ) => a00 a01 a20 a31 a21 a41 a11 /=. + rewrite /to_list /em_states /= /mkseq /=. + by move=> 29! ->. ++ apply (Keccak_f1600_avx2_prevec.correct_perm + (Array4.of_list witness [st.[index 0 0]; st.[index 0 0]; st.[index 0 0]; st.[index 0 0]]) + (Array4.of_list witness [st.[index 0 1]; st.[index 0 2]; st.[index 0 3]; st.[index 0 4]]) + (Array4.of_list witness [st.[index 2 0]; st.[index 4 0]; st.[index 1 0]; st.[index 3 0]]) + (Array4.of_list witness [st.[index 3 1]; st.[index 1 2]; st.[index 4 3]; st.[index 2 4]]) + (Array4.of_list witness [st.[index 2 1]; st.[index 4 2]; st.[index 1 3]; st.[index 3 4]]) + (Array4.of_list witness [st.[index 4 1]; st.[index 3 2]; st.[index 2 3]; st.[index 1 4]]) + (Array4.of_list witness [st.[index 1 1]; st.[index 2 2]; st.[index 3 3]; st.[index 4 4]]) + st mem). + +transitivity Keccak_f1600_avx2_prevec_vops.Mavx2_prevec_vops.__KeccakF1600 + (={Glob.mem} /\ Keccak_f1600_avx2_prevec_vops.match_ins arg{1} arg{2}==> + ={Glob.mem} /\ Keccak_f1600_avx2_prevec_vops.match_states res{1} res{2}) + +( to_uint _rhotates_left{2} + 192 < W64.modulus /\ + to_uint _rhotates_right{2} + 192 < W64.modulus /\ + to_uint _iotas{2} + 768 < W64.modulus /\ + ={Glob.mem, _rhotates_left, _rhotates_right, _iotas} /\ + good_io4x mem (to_uint _iotas{2}) /\ + good_rhol mem (to_uint _rhotates_left{2}) /\ + good_rhor mem (to_uint _rhotates_right{2}) /\ + state{2} = + Array7.of_list witness [arg.`1; arg.`2; arg.`3; arg.`4; arg.`5; arg.`6; arg.`7]{1} ==> + ={Glob.mem} /\ + res{2} = Array7.of_list witness [res.`1; res.`2; res.`3; res.`4; res.`5; res.`6; res.`7]{1}). ++ move=> /> *. + exists Glob.mem{2}. + exists (pack4 [st.[index 0 0]; st.[index 0 0]; st.[index 0 0]; st.[index 0 0]], + pack4 [st.[index 0 1]; st.[index 0 2]; st.[index 0 3]; st.[index 0 4]], + pack4 [st.[index 2 0]; st.[index 4 0]; st.[index 1 0]; st.[index 3 0]], + pack4 [st.[index 3 1]; st.[index 1 2]; st.[index 4 3]; st.[index 2 4]], + pack4 [st.[index 2 1]; st.[index 4 2]; st.[index 1 3]; st.[index 3 4]], + pack4 [st.[index 4 1]; st.[index 3 2]; st.[index 2 3]; st.[index 1 4]], + pack4 [st.[index 1 1]; st.[index 2 2]; st.[index 3 3]; st.[index 4 4]], + _rhotates_left{2}, _rhotates_right{2}, _iotas{2}) => />. + by rewrite H8 H9 H10 H11 H12 H13 H14 H15 /is4u64=> />. ++ move=> &1 &m &2 /= [#] ->. + rewrite /Keccak_f1600_avx2_prevec_vops.match_states /is4u64 => [#]. + by case: (res{1}) => a00 a01 a20 a31 a21 a41 a11 /= 7!-> [#] -> ->. ++ by apply Keccak_f1600_avx2_prevec_vops.prevec_vops_prevec. +transitivity Keccak_f1600_avx2_openssl.M.__keccak_f1600_avx2_openssl + (={Glob.mem, arg} ==> ={Glob.mem, res}) + ( to_uint _rhotates_left{2} + 192 < W64.modulus /\ + to_uint _rhotates_right{2} + 192 < W64.modulus /\ + to_uint _iotas{2} + 768 < W64.modulus /\ + ={Glob.mem,_rhotates_left, _rhotates_right, _iotas} /\ + good_io4x mem (to_uint _iotas{2}) /\ + good_rhol mem (to_uint _rhotates_left{2}) /\ + good_rhor mem (to_uint _rhotates_right{2}) /\ + state{2} = (of_list witness [a00{1}; a01{1}; a20{1}; a31{1}; a21{1}; a41{1}; a11{1}])%Array7 ==> + ={Glob.mem} /\ + res{2} = (of_list witness [res{1}.`1; res{1}.`2; res{1}.`3; res{1}.`4; res{1}.`5; res{1}.`6; res{1}.`7])%Array7). ++ smt(). + done. ++ apply Keccak_f1600_avx2_prevec_vops.prevec_vops_openssl. +conseq avx2_avx2_openssl. ++ by move => /> *; rewrite H8 /=. +move=> /> &1 &2 ?????????? [/=] /> *. +by apply Array7.all_eq_eq;cbv delta. +qed. diff --git a/sha3/proof/impl/perm/keccak_f1600_avx2_openssl.ec b/sha3/proof/impl/perm/keccak_f1600_avx2_openssl.ec new file mode 100644 index 0000000..49ff1cb --- /dev/null +++ b/sha3/proof/impl/perm/keccak_f1600_avx2_openssl.ec @@ -0,0 +1,347 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array9. +require import WArray288. + + + +module M = { + proc __keccak_f1600_avx2_openssl (a00:W256.t, a01:W256.t, a20:W256.t, + a31:W256.t, a21:W256.t, a41:W256.t, + a11:W256.t, _rhotates_left:W64.t, + _rhotates_right:W64.t, _iotas:W64.t) : + W256.t * W256.t * W256.t * W256.t * W256.t * W256.t * W256.t = { + + var rhotates_left:W64.t; + var rhotates_right:W64.t; + var iotas:W64.t; + var i:W32.t; + var zf:bool; + var c00:W256.t; + var c14:W256.t; + var t:W256.t Array9.t; + var d14:W256.t; + var d00:W256.t; + var _0:bool; + var _1:bool; + var _2:bool; + t <- witness; + rhotates_left <- (_rhotates_left + (W64.of_int 96)); + rhotates_right <- (_rhotates_right + (W64.of_int 96)); + iotas <- _iotas; + i <- (W32.of_int 24); + c00 <- x86_VPSHUFD_256 a20 (W8.of_int 78); + c14 <- (a41 `^` a31); + t.[2] <- (a21 `^` a11); + c14 <- (c14 `^` a01); + c14 <- (c14 `^` t.[2]); + t.[4] <- x86_VPERMQ c14 (W8.of_int 147); + c00 <- (c00 `^` a20); + t.[0] <- x86_VPERMQ c00 (W8.of_int 78); + t.[1] <- (c14 \vshr64u256 (W8.of_int 63)); + t.[2] <- (c14 \vadd64u256 c14); + t.[1] <- (t.[1] `|` t.[2]); + d14 <- x86_VPERMQ t.[1] (W8.of_int 57); + d00 <- (t.[1] `^` t.[4]); + d00 <- x86_VPERMQ d00 (W8.of_int 0); + c00 <- (c00 `^` a00); + c00 <- (c00 `^` t.[0]); + t.[0] <- (c00 \vshr64u256 (W8.of_int 63)); + t.[1] <- (c00 \vadd64u256 c00); + t.[1] <- (t.[1] `|` t.[0]); + a20 <- (a20 `^` d00); + a00 <- (a00 `^` d00); + d14 <- x86_VPBLENDD_256 d14 t.[1] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + t.[4] <- x86_VPBLENDD_256 t.[4] c00 + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + d14 <- (d14 `^` t.[4]); + t.[3] <- x86_VPSLLV_4u64 a20 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96))))); + a20 <- x86_VPSRLV_4u64 a20 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((0 * 32) - 96))))); + a20 <- (a20 `|` t.[3]); + a31 <- (a31 `^` d14); + t.[4] <- x86_VPSLLV_4u64 a31 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96))))); + a31 <- x86_VPSRLV_4u64 a31 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96))))); + a31 <- (a31 `|` t.[4]); + a21 <- (a21 `^` d14); + t.[5] <- x86_VPSLLV_4u64 a21 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96))))); + a21 <- x86_VPSRLV_4u64 a21 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96))))); + a21 <- (a21 `|` t.[5]); + a41 <- (a41 `^` d14); + t.[6] <- x86_VPSLLV_4u64 a41 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96))))); + a41 <- x86_VPSRLV_4u64 a41 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96))))); + a41 <- (a41 `|` t.[6]); + a11 <- (a11 `^` d14); + t.[3] <- x86_VPERMQ a20 (W8.of_int 141); + t.[4] <- x86_VPERMQ a31 (W8.of_int 141); + t.[7] <- x86_VPSLLV_4u64 a11 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96))))); + t.[1] <- x86_VPSRLV_4u64 a11 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96))))); + t.[1] <- (t.[1] `|` t.[7]); + a01 <- (a01 `^` d14); + t.[5] <- x86_VPERMQ a21 (W8.of_int 27); + t.[6] <- x86_VPERMQ a41 (W8.of_int 114); + t.[8] <- x86_VPSLLV_4u64 a01 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96))))); + t.[2] <- x86_VPSRLV_4u64 a01 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96))))); + t.[2] <- (t.[2] `|` t.[8]); + t.[7] <- x86_VPSRLDQ_256 t.[1] (W8.of_int 8); + t.[0] <- ((invw t.[1]) `&` t.[7]); + a31 <- x86_VPBLENDD_256 t.[2] t.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + t.[8] <- x86_VPBLENDD_256 t.[4] t.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + a41 <- x86_VPBLENDD_256 t.[3] t.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + t.[7] <- x86_VPBLENDD_256 t.[2] t.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + a31 <- x86_VPBLENDD_256 a31 t.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + a41 <- x86_VPBLENDD_256 a41 t.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + a31 <- x86_VPBLENDD_256 a31 t.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + a41 <- x86_VPBLENDD_256 a41 t.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + a31 <- x86_VPANDN_256 a31 t.[8]; + a41 <- x86_VPANDN_256 a41 t.[7]; + a11 <- x86_VPBLENDD_256 t.[5] t.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + t.[8] <- x86_VPBLENDD_256 t.[3] t.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + a31 <- (a31 `^` t.[3]); + a11 <- x86_VPBLENDD_256 a11 t.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + a41 <- (a41 `^` t.[5]); + a11 <- x86_VPBLENDD_256 a11 t.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + a11 <- x86_VPANDN_256 a11 t.[8]; + a11 <- (a11 `^` t.[6]); + a21 <- x86_VPERMQ t.[1] (W8.of_int 30); + t.[8] <- x86_VPBLENDD_256 a21 a00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + a01 <- x86_VPERMQ t.[1] (W8.of_int 57); + a01 <- x86_VPBLENDD_256 a01 a00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + a01 <- x86_VPANDN_256 a01 t.[8]; + a20 <- x86_VPBLENDD_256 t.[4] t.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + t.[7] <- x86_VPBLENDD_256 t.[6] t.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + a20 <- x86_VPBLENDD_256 a20 t.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + a20 <- x86_VPBLENDD_256 a20 t.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + a20 <- x86_VPANDN_256 a20 t.[7]; + a20 <- (a20 `^` t.[2]); + t.[0] <- x86_VPERMQ t.[0] (W8.of_int 0); + a31 <- x86_VPERMQ a31 (W8.of_int 27); + a41 <- x86_VPERMQ a41 (W8.of_int 141); + a11 <- x86_VPERMQ a11 (W8.of_int 114); + a21 <- x86_VPBLENDD_256 t.[6] t.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + t.[7] <- x86_VPBLENDD_256 t.[5] t.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + a21 <- x86_VPBLENDD_256 a21 t.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + a21 <- x86_VPBLENDD_256 a21 t.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + a21 <- x86_VPANDN_256 a21 t.[7]; + a00 <- (a00 `^` t.[0]); + a01 <- (a01 `^` t.[1]); + a21 <- (a21 `^` t.[4]); + a00 <- + (a00 `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int 0))))); + iotas <- (iotas + (W64.of_int 32)); + ( _0, _1, _2, zf, i) <- x86_DEC_32 i; + while ((! zf)) { + c00 <- x86_VPSHUFD_256 a20 (W8.of_int 78); + c14 <- (a41 `^` a31); + t.[2] <- (a21 `^` a11); + c14 <- (c14 `^` a01); + c14 <- (c14 `^` t.[2]); + t.[4] <- x86_VPERMQ c14 (W8.of_int 147); + c00 <- (c00 `^` a20); + t.[0] <- x86_VPERMQ c00 (W8.of_int 78); + t.[1] <- (c14 \vshr64u256 (W8.of_int 63)); + t.[2] <- (c14 \vadd64u256 c14); + t.[1] <- (t.[1] `|` t.[2]); + d14 <- x86_VPERMQ t.[1] (W8.of_int 57); + d00 <- (t.[1] `^` t.[4]); + d00 <- x86_VPERMQ d00 (W8.of_int 0); + c00 <- (c00 `^` a00); + c00 <- (c00 `^` t.[0]); + t.[0] <- (c00 \vshr64u256 (W8.of_int 63)); + t.[1] <- (c00 \vadd64u256 c00); + t.[1] <- (t.[1] `|` t.[0]); + a20 <- (a20 `^` d00); + a00 <- (a00 `^` d00); + d14 <- x86_VPBLENDD_256 d14 t.[1] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + t.[4] <- x86_VPBLENDD_256 t.[4] c00 + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + d14 <- (d14 `^` t.[4]); + t.[3] <- x86_VPSLLV_4u64 a20 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96))))); + a20 <- x86_VPSRLV_4u64 a20 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((0 * 32) - 96))))); + a20 <- (a20 `|` t.[3]); + a31 <- (a31 `^` d14); + t.[4] <- x86_VPSLLV_4u64 a31 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96))))); + a31 <- x86_VPSRLV_4u64 a31 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96))))); + a31 <- (a31 `|` t.[4]); + a21 <- (a21 `^` d14); + t.[5] <- x86_VPSLLV_4u64 a21 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96))))); + a21 <- x86_VPSRLV_4u64 a21 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96))))); + a21 <- (a21 `|` t.[5]); + a41 <- (a41 `^` d14); + t.[6] <- x86_VPSLLV_4u64 a41 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96))))); + a41 <- x86_VPSRLV_4u64 a41 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96))))); + a41 <- (a41 `|` t.[6]); + a11 <- (a11 `^` d14); + t.[3] <- x86_VPERMQ a20 (W8.of_int 141); + t.[4] <- x86_VPERMQ a31 (W8.of_int 141); + t.[7] <- x86_VPSLLV_4u64 a11 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96))))); + t.[1] <- x86_VPSRLV_4u64 a11 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96))))); + t.[1] <- (t.[1] `|` t.[7]); + a01 <- (a01 `^` d14); + t.[5] <- x86_VPERMQ a21 (W8.of_int 27); + t.[6] <- x86_VPERMQ a41 (W8.of_int 114); + t.[8] <- x86_VPSLLV_4u64 a01 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96))))); + t.[2] <- x86_VPSRLV_4u64 a01 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96))))); + t.[2] <- (t.[2] `|` t.[8]); + t.[7] <- x86_VPSRLDQ_256 t.[1] (W8.of_int 8); + t.[0] <- ((invw t.[1]) `&` t.[7]); + a31 <- x86_VPBLENDD_256 t.[2] t.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + t.[8] <- x86_VPBLENDD_256 t.[4] t.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + a41 <- x86_VPBLENDD_256 t.[3] t.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + t.[7] <- x86_VPBLENDD_256 t.[2] t.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + a31 <- x86_VPBLENDD_256 a31 t.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + a41 <- x86_VPBLENDD_256 a41 t.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + a31 <- x86_VPBLENDD_256 a31 t.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + a41 <- x86_VPBLENDD_256 a41 t.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + a31 <- x86_VPANDN_256 a31 t.[8]; + a41 <- x86_VPANDN_256 a41 t.[7]; + a11 <- x86_VPBLENDD_256 t.[5] t.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + t.[8] <- x86_VPBLENDD_256 t.[3] t.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + a31 <- (a31 `^` t.[3]); + a11 <- x86_VPBLENDD_256 a11 t.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + a41 <- (a41 `^` t.[5]); + a11 <- x86_VPBLENDD_256 a11 t.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + a11 <- x86_VPANDN_256 a11 t.[8]; + a11 <- (a11 `^` t.[6]); + a21 <- x86_VPERMQ t.[1] (W8.of_int 30); + t.[8] <- x86_VPBLENDD_256 a21 a00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + a01 <- x86_VPERMQ t.[1] (W8.of_int 57); + a01 <- x86_VPBLENDD_256 a01 a00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + a01 <- x86_VPANDN_256 a01 t.[8]; + a20 <- x86_VPBLENDD_256 t.[4] t.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + t.[7] <- x86_VPBLENDD_256 t.[6] t.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + a20 <- x86_VPBLENDD_256 a20 t.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + a20 <- x86_VPBLENDD_256 a20 t.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + a20 <- x86_VPANDN_256 a20 t.[7]; + a20 <- (a20 `^` t.[2]); + t.[0] <- x86_VPERMQ t.[0] (W8.of_int 0); + a31 <- x86_VPERMQ a31 (W8.of_int 27); + a41 <- x86_VPERMQ a41 (W8.of_int 141); + a11 <- x86_VPERMQ a11 (W8.of_int 114); + a21 <- x86_VPBLENDD_256 t.[6] t.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + t.[7] <- x86_VPBLENDD_256 t.[5] t.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + a21 <- x86_VPBLENDD_256 a21 t.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + a21 <- x86_VPBLENDD_256 a21 t.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + a21 <- x86_VPANDN_256 a21 t.[7]; + a00 <- (a00 `^` t.[0]); + a01 <- (a01 `^` t.[1]); + a21 <- (a21 `^` t.[4]); + a00 <- + (a00 `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int 0))))); + iotas <- (iotas + (W64.of_int 32)); + ( _0, _1, _2, zf, i) <- x86_DEC_32 i; + } + return (a00, a01, a20, a31, a21, a41, a11); + } +}. + diff --git a/sha3/proof/impl/perm/keccak_f1600_avx2_prevec.ec b/sha3/proof/impl/perm/keccak_f1600_avx2_prevec.ec new file mode 100644 index 0000000..5b33a47 --- /dev/null +++ b/sha3/proof/impl/perm/keccak_f1600_avx2_prevec.ec @@ -0,0 +1,913 @@ +require import AllCore List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array4 Array9 Array24 Array25 Array96. +require import WArray288. + +require import Keccak_f1600_ref_table. +require import Keccak_f1600_ref_op. +import Ops. + +op lift2array(x : W256.t) : W64.t Array4.t = + Array4.init (fun (n : int) => x \bits64 n). + +op good_rhotates_right : int Array24.t = ( + witness + .[4* 0+0 <- 64 - 3].[4* 0+1 <- 64 - 18].[4* 0+2 <- 64 - 36].[4* 0+3 <- 64 - 41] + .[4* 1+0 <- 64 - 1].[4* 1+1 <- 64 - 62].[4* 1+2 <- 64 - 28].[4* 1+3 <- 64 - 27] + .[4* 2+0 <- 64 - 45].[4* 2+1 <- 64 - 6].[4* 2+2 <- 64 - 56].[4* 2+3 <- 64 - 39] + .[4* 3+0 <- 64 - 10].[4* 3+1 <- 64 - 61].[4* 3+2 <- 64 - 55].[4* 3+3 <- 64 - 8] + .[4* 4+0 <- 64 - 2].[4* 4+1 <- 64 - 15].[4* 4+2 <- 64 - 25].[4* 4+3 <- 64 - 20] + .[4* 5+0 <- 64 - 44].[4* 5+1 <- 64 - 43].[4* 5+2 <- 64 - 21].[4* 5+3 <- 64 - 14])%Array24. + + +op good_rhotates_left : int Array24.t = ( + witness + .[4* 0+0 <- 3].[4* 0+1 <- 18].[4* 0+2 <- 36].[4* 0+3 <- 41] + .[4* 1+0 <- 1].[4* 1+1 <- 62].[4* 1+2 <- 28].[4* 1+3 <- 27] + .[4* 2+0 <- 45].[4* 2+1 <- 6].[4* 2+2 <- 56].[4* 2+3 <- 39] + .[4* 3+0 <- 10].[4* 3+1 <- 61].[4* 3+2 <- 55].[4* 3+3 <- 8] + .[4* 4+0 <- 2].[4* 4+1 <- 15].[4* 4+2 <- 25].[4* 4+3 <- 20] + .[4* 5+0 <- 44].[4* 5+1 <- 43].[4* 5+2 <- 21].[4* 5+3 <- 14])%Array24. + + +op good_iotas4x : W64.t Array96.t = ( + witness + .[4* 0+0 <- W64.one ].[4* 0+1 <- W64.one ].[4* 0+2 <- W64.one ].[4* 0+3 <- W64.one ] + .[4* 1+0 <- W64.of_int 32898 ].[4* 1+1 <- W64.of_int 32898 ].[4* 1+2 <- W64.of_int 32898 ].[4* 1+3 <- W64.of_int 32898 ] + .[4* 2+0 <- W64.of_int 9223372036854808714].[4* 2+1 <- W64.of_int 9223372036854808714].[4* 2+2 <- W64.of_int 9223372036854808714].[4* 2+3 <- W64.of_int 9223372036854808714] + .[4* 3+0 <- W64.of_int 9223372039002292224].[4* 3+1 <- W64.of_int 9223372039002292224].[4* 3+2 <- W64.of_int 9223372039002292224].[4* 3+3 <- W64.of_int 9223372039002292224] + .[4* 4+0 <- W64.of_int 32907 ].[4* 4+1 <- W64.of_int 32907 ].[4* 4+2 <- W64.of_int 32907 ].[4* 4+3 <- W64.of_int 32907 ] + .[4* 5+0 <- W64.of_int 2147483649 ].[4* 5+1 <- W64.of_int 2147483649 ].[4* 5+2 <- W64.of_int 2147483649 ].[4* 5+3 <- W64.of_int 2147483649 ] + .[4* 6+0 <- W64.of_int 9223372039002292353].[4* 6+1 <- W64.of_int 9223372039002292353].[4* 6+2 <- W64.of_int 9223372039002292353].[4* 6+3 <- W64.of_int 9223372039002292353] + .[4* 7+0 <- W64.of_int 9223372036854808585].[4* 7+1 <- W64.of_int 9223372036854808585].[4* 7+2 <- W64.of_int 9223372036854808585].[4* 7+3 <- W64.of_int 9223372036854808585] + .[4* 8+0 <- W64.of_int 138 ].[4* 8+1 <- W64.of_int 138 ].[4* 8+2 <- W64.of_int 138 ].[4* 8+3 <- W64.of_int 138 ] + .[4* 9+0 <- W64.of_int 136 ].[4* 9+1 <- W64.of_int 136 ].[4* 9+2 <- W64.of_int 136 ].[4* 9+3 <- W64.of_int 136 ] + .[4*10+0 <- W64.of_int 2147516425 ].[4*10+1 <- W64.of_int 2147516425 ].[4*10+2 <- W64.of_int 2147516425 ].[4*10+3 <- W64.of_int 2147516425 ] + .[4*11+0 <- W64.of_int 2147483658 ].[4*11+1 <- W64.of_int 2147483658 ].[4*11+2 <- W64.of_int 2147483658 ].[4*11+3 <- W64.of_int 2147483658 ] + .[4*12+0 <- W64.of_int 2147516555 ].[4*12+1 <- W64.of_int 2147516555 ].[4*12+2 <- W64.of_int 2147516555 ].[4*12+3 <- W64.of_int 2147516555 ] + .[4*13+0 <- W64.of_int 9223372036854775947].[4*13+1 <- W64.of_int 9223372036854775947].[4*13+2 <- W64.of_int 9223372036854775947].[4*13+3 <- W64.of_int 9223372036854775947] + .[4*14+0 <- W64.of_int 9223372036854808713].[4*14+1 <- W64.of_int 9223372036854808713].[4*14+2 <- W64.of_int 9223372036854808713].[4*14+3 <- W64.of_int 9223372036854808713] + .[4*15+0 <- W64.of_int 9223372036854808579].[4*15+1 <- W64.of_int 9223372036854808579].[4*15+2 <- W64.of_int 9223372036854808579].[4*15+3 <- W64.of_int 9223372036854808579] + .[4*16+0 <- W64.of_int 9223372036854808578].[4*16+1 <- W64.of_int 9223372036854808578].[4*16+2 <- W64.of_int 9223372036854808578].[4*16+3 <- W64.of_int 9223372036854808578] + .[4*17+0 <- W64.of_int 9223372036854775936].[4*17+1 <- W64.of_int 9223372036854775936].[4*17+2 <- W64.of_int 9223372036854775936].[4*17+3 <- W64.of_int 9223372036854775936] + .[4*18+0 <- W64.of_int 32778 ].[4*18+1 <- W64.of_int 32778 ].[4*18+2 <- W64.of_int 32778 ].[4*18+3 <- W64.of_int 32778 ] + .[4*19+0 <- W64.of_int 9223372039002259466].[4*19+1 <- W64.of_int 9223372039002259466].[4*19+2 <- W64.of_int 9223372039002259466].[4*19+3 <- W64.of_int 9223372039002259466] + .[4*20+0 <- W64.of_int 9223372039002292353].[4*20+1 <- W64.of_int 9223372039002292353].[4*20+2 <- W64.of_int 9223372039002292353].[4*20+3 <- W64.of_int 9223372039002292353] + .[4*21+0 <- W64.of_int 9223372036854808704].[4*21+1 <- W64.of_int 9223372036854808704].[4*21+2 <- W64.of_int 9223372036854808704].[4*21+3 <- W64.of_int 9223372036854808704] + .[4*22+0 <- W64.of_int 2147483649 ].[4*22+1 <- W64.of_int 2147483649 ].[4*22+2 <- W64.of_int 2147483649 ].[4*22+3 <- W64.of_int 2147483649 ] + .[4*23+0 <- W64.of_int 9223372039002292232].[4*23+1 <- W64.of_int 9223372039002292232].[4*23+2 <- W64.of_int 9223372039002292232].[4*23+3 <- W64.of_int 9223372039002292232])%Array96. + +module Mavx2_prevec = { + + proc __KeccakF1600 (a00:W64.t Array4.t, a01:W64.t Array4.t, a20:W64.t Array4.t, a31:W64.t Array4.t, + a21:W64.t Array4.t, a41:W64.t Array4.t, a11:W64.t Array4.t, + _rhotates_left:W64.t, _rhotates_right:W64.t, + _iotas:W64.t) : W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * + W64.t Array4.t * W64.t Array4.t * W64.t Array4.t = { + + var rhotates_left:W64.t; + var rhotates_right:W64.t; + var iotas:W64.t; + var i:W32.t; + var zf:bool; + var c00:W64.t Array4.t; + var c14:W64.t Array4.t; + var t:W64.t Array4.t Array9.t; + var d14:W64.t Array4.t; + var d00:W64.t Array4.t; + var _0:bool; + var _1:bool; + var _2:bool; + t <- witness; + rhotates_left <- (_rhotates_left + (W64.of_int 96)); + rhotates_right <- (_rhotates_right + (W64.of_int 96)); + iotas <- _iotas; + i <- (W32.of_int 24); + c00 <@ Ops.iVPSHUFD_256(a20,(W8.of_int 78)); + c14 <@ Ops.ilxor4u64(a41,a31); + t.[2] <@ Ops.ilxor4u64(a21,a11); + c14 <@ Ops.ilxor4u64(c14,a01); + c14 <@ Ops.ilxor4u64(c14,t.[2]); + t.[4] <- Ops.iVPERMQ(c14,(W8.of_int 147)); + c00 <@ Ops.ilxor4u64(c00,a20); + t.[0] <- Ops.iVPERMQ(c00,(W8.of_int 78)); + t.[1] <- Ops.ivshr64u256(c14, (W8.of_int 63)); + t.[2] <- Ops.ivadd64u256(c14, c14); + t.[1] <@ Ops.ilor4u64(t.[1],t.[2]); + d14 <- Ops.iVPERMQ(t.[1],(W8.of_int 57)); + d00 <@ Ops.ilxor4u64(t.[1],t.[4]); + d00 <- Ops.iVPERMQ(d00,(W8.of_int 0)); + c00 <@ Ops.ilxor4u64(c00,a00); + c00 <@ Ops.ilxor4u64(c00,t.[0]); + t.[0] <- Ops.ivshr64u256(c00, (W8.of_int 63)); + t.[1] <- Ops.ivadd64u256(c00, c00); + t.[1] <@ Ops.ilor4u64(t.[1],t.[0]); + a20 <@ Ops.ilxor4u64(a20,d00); + a00 <@ Ops.ilxor4u64(a00,d00); + d14 <- Ops.iVPBLENDD_256(d14,t.[1], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[4] <- Ops.iVPBLENDD_256(t.[4],c00, + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + d14 <@ Ops.ilxor4u64(d14,t.[4]); + t.[3] <@ Ops.iVPSLLV_4u64(a20, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96)))))); + a20 <@ Ops.iVPSRLV_4u64(a20, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right+ (W64.of_int ((0 * 32) - 96)))))); + a20 <@ Ops.ilor4u64(a20,t.[3]); + a31 <@ Ops.ilxor4u64(a31,d14); + t.[4] <@ Ops.iVPSLLV_4u64(a31, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96)))))); + a31 <@ Ops.iVPSRLV_4u64(a31, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96)))))); + a31 <@ Ops.ilor4u64(a31,t.[4]); + a21 <@ Ops.ilxor4u64(a21,d14); + t.[5] <@ Ops.iVPSLLV_4u64(a21, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96)))))); + a21 <@ Ops.iVPSRLV_4u64(a21, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96)))))); + a21 <@ Ops.ilor4u64(a21,t.[5]); + a41 <@ Ops.ilxor4u64(a41,d14); + t.[6] <@ Ops.iVPSLLV_4u64(a41, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96)))))); + a41 <@ Ops.iVPSRLV_4u64(a41, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96)))))); + a41 <@ Ops.ilor4u64(a41,t.[6]); + a11 <@ Ops.ilxor4u64(a11,d14); + t.[3] <- Ops.iVPERMQ(a20,(W8.of_int 141)); + t.[4] <- Ops.iVPERMQ(a31,(W8.of_int 141)); + t.[7] <@ Ops.iVPSLLV_4u64(a11, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96)))))); + t.[1] <@ Ops.iVPSRLV_4u64(a11, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96)))))); + t.[1] <@ Ops.ilor4u64(t.[1],t.[7]); + a01 <@ Ops.ilxor4u64(a01,d14); + t.[5] <- Ops.iVPERMQ(a21,(W8.of_int 27)); + t.[6] <- Ops.iVPERMQ(a41,(W8.of_int 114)); + t.[8] <@ Ops.iVPSLLV_4u64(a01, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96)))))); + t.[2] <@ Ops.iVPSRLV_4u64(a01, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96)))))); + t.[2] <@ Ops.ilor4u64(t.[2],t.[8]); + t.[7] <@ Ops.iVPSRLDQ_256(t.[1],(W8.of_int 8)); + t.[0] <@ Ops.ilandn4u64(t.[1],t.[7]); + a31 <@ Ops.iVPBLENDD_256(t.[2],t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[8] <@ Ops.iVPBLENDD_256(t.[4],t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a41 <@ Ops.iVPBLENDD_256(t.[3], t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[7] <@ Ops.iVPBLENDD_256(t.[2], t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a31 <@ Ops.iVPBLENDD_256(a31 ,t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[8] <@ Ops.iVPBLENDD_256(t.[8], t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a41 <@ Ops.iVPBLENDD_256(a41, t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[7] <@ Ops.iVPBLENDD_256(t.[7], t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a31 <@ Ops.iVPBLENDD_256(a31, t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[8] <@ Ops.iVPBLENDD_256(t.[8], t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a41 <@ Ops.iVPBLENDD_256(a41, t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[7] <@ Ops.iVPBLENDD_256(t.[7], t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a31 <@ Ops.ilandn4u64(a31,t.[8]); + a41 <@ Ops.ilandn4u64(a41,t.[7]); + a11 <@ Ops.iVPBLENDD_256(t.[5],t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[8] <@ Ops.iVPBLENDD_256(t.[3], t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a31 <@ Ops.ilxor4u64(a31,t.[3]); + a11 <@ Ops.iVPBLENDD_256(a11,t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[8] <@ Ops.iVPBLENDD_256(t.[8],t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a41 <@ Ops.ilxor4u64(a41,t.[5]); + a11 <@ Ops.iVPBLENDD_256(a11, t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[8] <@ Ops.iVPBLENDD_256(t.[8], t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a11 <@ Ops.ilandn4u64(a11,t.[8]); + a11 <@ Ops.ilxor4u64(a11,t.[6]); + a21 <@ Ops.iVPERMQ(t.[1],(W8.of_int 30)); + t.[8] <@ Ops.iVPBLENDD_256(a21, a00, + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a01 <@ Ops.iVPERMQ(t.[1],(W8.of_int 57)); + a01 <@ Ops.iVPBLENDD_256(a01, a00, + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a01 <@ Ops.ilandn4u64(a01,t.[8]); + a20 <@ Ops.iVPBLENDD_256(t.[4], t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[7] <@ Ops.iVPBLENDD_256(t.[6], t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a20 <@ Ops.iVPBLENDD_256(a20, t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[7] <@ Ops.iVPBLENDD_256(t.[7], t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a20 <@ Ops.iVPBLENDD_256(a20, t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[7] <@ Ops.iVPBLENDD_256(t.[7], t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a20 <@ Ops.ilandn4u64(a20,t.[7]); + a20 <@ Ops.ilxor4u64(a20,t.[2]); + t.[0] <@ Ops.iVPERMQ(t.[0],(W8.of_int 0)); + a31 <@ Ops.iVPERMQ(a31,(W8.of_int 27)); + a41 <@ Ops.iVPERMQ(a41,(W8.of_int 141)); + a11 <@ Ops.iVPERMQ(a11,(W8.of_int 114)); + a21 <@ Ops.iVPBLENDD_256(t.[6], t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[7] <@ Ops.iVPBLENDD_256(t.[5], t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a21 <@ Ops.iVPBLENDD_256(a21, t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[7] <@ Ops.iVPBLENDD_256(t.[7], t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a21 <@ Ops.iVPBLENDD_256(a21, t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[7] <@ Ops.iVPBLENDD_256(t.[7], t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a21 <@ Ops.ilandn4u64(a21,t.[7]); + a00 <@ Ops.ilxor4u64(a00,t.[0]); + a01 <@ Ops.ilxor4u64(a01,t.[1]); + a21 <@ Ops.ilxor4u64(a21,t.[4]); + a00 <@ Ops.ilxor4u64(a00, lift2array + (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int 0))))); + iotas <- (iotas + (W64.of_int 32)); + ( _0, _1, _2, zf, i) <- x86_DEC_32 i; + while ((! zf)) { + c00 <@ Ops.iVPSHUFD_256(a20,(W8.of_int 78)); + c14 <@ Ops.ilxor4u64(a41,a31); + t.[2] <@ Ops.ilxor4u64(a21,a11); + c14 <@ Ops.ilxor4u64(c14,a01); + c14 <@ Ops.ilxor4u64(c14,t.[2]); + t.[4] <@ Ops.iVPERMQ(c14,(W8.of_int 147)); + c00 <@ Ops.ilxor4u64(c00,a20); + t.[0] <@ Ops.iVPERMQ(c00,(W8.of_int 78)); + t.[1] <@ Ops.ivshr64u256(c14, (W8.of_int 63)); + t.[2] <@ Ops.ivadd64u256(c14, c14); + t.[1] <@ Ops.ilor4u64(t.[1],t.[2]); + d14 <@ Ops.iVPERMQ(t.[1],(W8.of_int 57)); + d00 <@ Ops.ilxor4u64(t.[1],t.[4]); + d00 <@ Ops.iVPERMQ(d00,(W8.of_int 0)); + c00 <@ Ops.ilxor4u64(c00,a00); + c00 <@ Ops.ilxor4u64(c00,t.[0]); + t.[0] <@ Ops.ivshr64u256(c00, (W8.of_int 63)); + t.[1] <@ Ops.ivadd64u256(c00, c00); + t.[1] <@ Ops.ilor4u64(t.[1],t.[0]); + a20 <@ Ops.ilxor4u64(a20,d00); + a00 <@ Ops.ilxor4u64(a00,d00); + d14 <@ Ops.iVPBLENDD_256(d14,t.[1], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[4] <@ Ops.iVPBLENDD_256(t.[4],c00, + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + d14 <@ Ops.ilxor4u64(d14,t.[4]); + t.[3] <@ Ops.iVPSLLV_4u64(a20, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96)))))); + a20 <@ Ops.iVPSRLV_4u64(a20, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right+ (W64.of_int ((0 * 32) - 96)))))); + a20 <@ Ops.ilor4u64(a20,t.[3]); + a31 <@ Ops.ilxor4u64(a31,d14); + t.[4] <@ Ops.iVPSLLV_4u64(a31, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96)))))); + a31 <@ Ops.iVPSRLV_4u64(a31, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96)))))); + a31 <@ Ops.ilor4u64(a31,t.[4]); + a21 <@ Ops.ilxor4u64(a21,d14); + t.[5] <@ Ops.iVPSLLV_4u64(a21, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96)))))); + a21 <@ Ops.iVPSRLV_4u64(a21, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96)))))); + a21 <@ Ops.ilor4u64(a21,t.[5]); + a41 <@ Ops.ilxor4u64(a41,d14); + t.[6] <@ Ops.iVPSLLV_4u64(a41, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96)))))); + a41 <@ Ops.iVPSRLV_4u64(a41, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96)))))); + a41 <@ Ops.ilor4u64(a41,t.[6]); + a11 <@ Ops.ilxor4u64(a11,d14); + t.[3] <- Ops.iVPERMQ(a20,(W8.of_int 141)); + t.[4] <- Ops.iVPERMQ(a31,(W8.of_int 141)); + t.[7] <@ Ops.iVPSLLV_4u64(a11, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96)))))); + t.[1] <@ Ops.iVPSRLV_4u64(a11, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96)))))); + t.[1] <@ Ops.ilor4u64(t.[1],t.[7]); + a01 <@ Ops.ilxor4u64(a01,d14); + t.[5] <- Ops.iVPERMQ(a21,(W8.of_int 27)); + t.[6] <- Ops.iVPERMQ(a41,(W8.of_int 114)); + t.[8] <@ Ops.iVPSLLV_4u64(a01, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96)))))); + t.[2] <@ Ops.iVPSRLV_4u64(a01, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96)))))); + t.[2] <@ Ops.ilor4u64(t.[2],t.[8]); + t.[7] <@ Ops.iVPSRLDQ_256(t.[1],(W8.of_int 8)); + t.[0] <@ Ops.ilandn4u64(t.[1],t.[7]); + a31 <@ Ops.iVPBLENDD_256(t.[2], t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[8] <@ Ops.iVPBLENDD_256(t.[4], t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a41 <@ Ops.iVPBLENDD_256(t.[3], t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[7] <@ Ops.iVPBLENDD_256(t.[2], t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a31 <@ Ops.iVPBLENDD_256(a31, t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[8] <@ Ops.iVPBLENDD_256(t.[8], t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a41 <@ Ops.iVPBLENDD_256(a41, t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[7] <@ Ops.iVPBLENDD_256(t.[7], t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a31 <@ Ops.iVPBLENDD_256(a31, t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[8] <@ Ops.iVPBLENDD_256(t.[8], t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a41 <@ Ops.iVPBLENDD_256(a41, t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[7] <@ Ops.iVPBLENDD_256(t.[7], t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a31 <@ Ops.ilandn4u64(a31,t.[8]); + a41 <@ Ops.ilandn4u64(a41,t.[7]); + a11 <@ Ops.iVPBLENDD_256(t.[5], t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[8] <@ Ops.iVPBLENDD_256(t.[3], t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a31 <@ Ops.ilxor4u64(a31,t.[3]); + a11 <@ Ops.iVPBLENDD_256(a11, t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[8] <@ Ops.iVPBLENDD_256(t.[8], t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a41 <@ Ops.ilxor4u64(a41,t.[5]); + a11 <@ Ops.iVPBLENDD_256(a11, t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[8] <@ Ops.iVPBLENDD_256(t.[8], t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a11 <@ Ops.ilandn4u64(a11,t.[8]); + a11 <@ Ops.ilxor4u64(a11,t.[6]); + a21 <@ Ops.iVPERMQ(t.[1],(W8.of_int 30)); + t.[8] <@ Ops.iVPBLENDD_256(a21, a00, + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a01 <@ Ops.iVPERMQ(t.[1],(W8.of_int 57)); + a01 <@ Ops.iVPBLENDD_256(a01 ,a00, + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a01 <@ Ops.ilandn4u64(a01,t.[8]); + a20 <@ Ops.iVPBLENDD_256(t.[4], t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[7] <@ Ops.iVPBLENDD_256(t.[6], t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a20 <@ Ops.iVPBLENDD_256(a20, t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[7] <@ Ops.iVPBLENDD_256(t.[7], t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a20 <@ Ops.iVPBLENDD_256(a20, t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[7] <@ Ops.iVPBLENDD_256(t.[7], t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a20 <@ Ops.ilandn4u64(a20,t.[7]); + a20 <@ Ops.ilxor4u64(a20,t.[2]); + t.[0] <@ Ops.iVPERMQ(t.[0],(W8.of_int 0)); + a31 <@ Ops.iVPERMQ(a31,(W8.of_int 27)); + a41 <@ Ops.iVPERMQ(a41,(W8.of_int 141)); + a11 <@ Ops.iVPERMQ(a11,(W8.of_int 114)); + a21 <@ Ops.iVPBLENDD_256(t.[6], t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[7] <@ Ops.iVPBLENDD_256(t.[5], t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a21 <@ Ops.iVPBLENDD_256(a21, t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[7] <@ Ops.iVPBLENDD_256(t.[7] ,t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a21 <@ Ops.iVPBLENDD_256(a21, t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[7] <@ Ops.iVPBLENDD_256(t.[7], t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a21 <@ Ops.ilandn4u64(a21,t.[7]); + a00 <@ Ops.ilxor4u64(a00,t.[0]); + a01 <@ Ops.ilxor4u64(a01,t.[1]); + a21 <@ Ops.ilxor4u64(a21,t.[4]); + a00 <@ Ops.ilxor4u64(a00, lift2array + (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int 0))))); + iotas <- (iotas + (W64.of_int 32)); + ( _0, _1, _2, zf, i) <- x86_DEC_32 i; + } + return (a00, a01, a20, a31, a21, a41, a11); + } +}. + +(* + ($a00, # [0][0] [0][0] [0][0] [0][0] + $a01, # [0][4] [0][3] [0][2] [0][1] + $a20, # [3][0] [1][0] [4][0] [2][0] + $a31, # [2][4] [4][3] [1][2] [3][1] + $a21, # [3][4] [1][3] [4][2] [2][1] + $a41, # [1][4] [2][3] [3][2] [4][1] + $a11) = # [4][4] [3][3] [2][2] [1][1] +*) + +op index x y = 5*x+y. + +op equiv_states (a00 a01 a20 a31 a21 a41 a11 : W64.t Array4.t, st : W64.t Array25.t) : bool = + a00.[3] = st.[index 0 0] /\ a00.[2] = st.[index 0 0] /\ a00.[1] = st.[index 0 0] /\ a00.[0] = st.[index 0 0] /\ + a01.[3] = st.[index 0 4] /\ a01.[2] = st.[index 0 3] /\ a01.[1] = st.[index 0 2] /\ a01.[0] = st.[index 0 1] /\ + a20.[3] = st.[index 3 0] /\ a20.[2] = st.[index 1 0] /\ a20.[1] = st.[index 4 0] /\ a20.[0] = st.[index 2 0] /\ + a31.[3] = st.[index 2 4] /\ a31.[2] = st.[index 4 3] /\ a31.[1] = st.[index 1 2] /\ a31.[0] = st.[index 3 1] /\ + a21.[3] = st.[index 3 4] /\ a21.[2] = st.[index 1 3] /\ a21.[1] = st.[index 4 2] /\ a21.[0] = st.[index 2 1] /\ + a41.[3] = st.[index 1 4] /\ a41.[2] = st.[index 2 3] /\ a41.[1] = st.[index 3 2] /\ a41.[0] = st.[index 4 1] /\ + a11.[3] = st.[index 4 4] /\ a11.[2] = st.[index 3 3] /\ a11.[1] = st.[index 2 2] /\ a11.[0] = st.[index 1 1]. + +op equiv_states_chi (a00 a01 a20 a31 a21 a41 a11 : W64.t Array4.t, st : W64.t Array25.t) : bool = + a00.[3] = st.[index 0 0] /\ a00.[2] = st.[index 0 0] /\ a00.[1] = st.[index 0 0] /\ a00.[0] = st.[index 0 0] /\ + a01.[3] = st.[index 0 4] /\ a01.[2] = st.[index 0 3] /\ a01.[1] = st.[index 0 2] /\ a01.[0] = st.[index 0 1] /\ + a20.[3] = st.[index 3 0] /\ a20.[2] = st.[index 1 0] /\ a20.[1] = st.[index 4 0] /\ a20.[0] = st.[index 2 0] /\ + a31.[3] = st.[index 3 1] /\ a31.[2] = st.[index 1 2] /\ a31.[1] = st.[index 4 3] /\ a31.[0] = st.[index 2 4] /\ + a21.[3] = st.[index 3 4] /\ a21.[2] = st.[index 1 3] /\ a21.[1] = st.[index 4 2] /\ a21.[0] = st.[index 2 1] /\ + a41.[3] = st.[index 3 2] /\ a41.[2] = st.[index 1 4] /\ a41.[1] = st.[index 4 1] /\ a41.[0] = st.[index 2 3] /\ + a11.[3] = st.[index 3 3] /\ a11.[2] = st.[index 1 1] /\ a11.[1] = st.[index 4 4] /\ a11.[0] = st.[index 2 2]. + +lemma dec : forall (x : W32.t), + 0 < to_uint x <= 24 => + to_uint (x86_DEC_32 x).`5 = to_uint x - 1. +proof. + move=> x hx;cbv delta. + by rewrite W32.to_uintB ?uleE //= /#. +qed. + +lemma decK (x : W32.t): (x86_DEC_32 x).`5 + W32.one = x. +proof. rewrite /x86_DEC_32 /= /rflags_of_aluop_nocf32 /= => *; ring. qed. + +lemma dec0 (x : W32.t): 0 < to_uint x <= 24 => + (x86_DEC_32 x).`4 <=> to_uint (x86_DEC_32 x).`5 = 0. +proof. by move=> hx;cbv delta; rewrite W32.to_uint_eq. qed. + +lemma rolcomp (x : W64.t): + (x86_ROL_64 x W8.one).`3 = (x `>>` W8.of_int 63) `|` (x + x). +proof. +rewrite x86_ROL_64_E /= rol_xor_shft //= (_: x + x = x `<<` W8.one). ++ by rewrite /(`<<`) W64.to_uint_eq to_uint_shl //= to_uintD //= /#. +rewrite /(`<<`) /(`>>`) /= xorE orE !map2E. +apply W64.init_ext => /> ?; smt (W64.get_out). +qed. + +lemma commor (x y : W64.t): x `|` y = y `|` x. +proof. by rewrite orE !map2E; apply W64.init_ext => /> ???; rewrite orbC. qed. + +lemma rol0 x: (x86_ROL_64 x W8.zero).`3 = x. +proof. rewrite x86_ROL_64_E rol_xor =>/>; exact/lsr_0. qed. + +lemma roln x n: 0 <= n < 64 => + (x86_ROL_64 x (W8.of_int n)).`3 = + (x `>>>` (64 - n)) `|` (x `<<<` n). +move => H. +case (n = 0) => HH. ++ by rewrite HH rol0 => />; smt(lsr_0). +rewrite x86_ROL_64_E /= rol_xor_shft /= 1:/#. +rewrite /(`<<`) /(`>>`) => />. +have n256 : n %% 256 = n by smt(). +have n64 : n %% 64 = n by smt(). +have n64_ : (64 - n) %% 256 = 64 - n by smt(). +have n64_m: (64 - n) %% 64 = 64 - n by smt(). +rewrite !(n256, n64, n64_, n64_m). +rewrite xorE orE !map2E => />. +apply W64.init_ext => /> ???; smt (W64.get_out). +qed. + +op good_io4x (mem : global_mem_t, _iotas : int) = + forall off, 0 <= off < 4 * 24 => + loadW64 mem (_iotas + (off * 8)) = good_iotas4x.[off]. + +op good_rhol (mem : global_mem_t, _rhotates_left : int) = + forall off, 0 <= off < 24 => + loadW64 mem (_rhotates_left + (off * 8)) = W64.of_int good_rhotates_left.[off]. + +op good_rhor (mem : global_mem_t, _rhotates_right : int) = + forall off, 0 <= off < 24 => + loadW64 mem ( _rhotates_right + (off * 8)) = W64.of_int good_rhotates_right.[off]. + +(* TODO: move this in JMemory *) +lemma loadW256_bits64 m p i : 0 <= i < 4 => + loadW256 m p \bits64 i = loadW64 m (p + i * 8). +proof. + move=> hi; rewrite /loadW256 /loadW64. + apply W64.wordP => j hj. + rewrite bits64iE // pack8wE // initiE; 1:by apply divz_cmp. + rewrite pack32wE; 1:by apply W4u64.in_bound. + rewrite initiE /=; 1:by apply divz_cmp => //=;apply W4u64.in_bound. + have -> : i * 64 = (i * 8) * 8 by ring. + by rewrite modzMDl divzMDl // -addzA. +qed. + +lemma load4u64 mem p : + pack4 + [loadW64 mem p; + loadW64 mem (p + 8); + loadW64 mem (p + 16); + loadW64 mem (p + 24)] = + loadW256 mem p. +proof. + have -> : W4u64.Pack.of_list + [loadW64 mem p; loadW64 mem (p + 8); + loadW64 mem (p + 16); loadW64 mem (p + 24)] = + W4u64.Pack.init (fun i => loadW64 mem (p + i * 8)). + + by apply W4u64.Pack.all_eqP; rewrite /all_eq. + apply (can_inj _ _ W4u64.unpack64K); apply W4u64.Pack.packP => i hi. + by rewrite pack4K initiE //= get_unpack64 // loadW256_bits64. +qed. + +lemma loadlift_rhor : forall (mem : global_mem_t) (x : W64.t) (off : int), + to_uint x + 192 < W64.modulus => + good_rhor mem (to_uint x) => 0 <= off < 6 => + lift2array + (loadW256 mem (to_uint (x + W64.of_int (8 * 4 * off)))) = + (witness + .[0 <- W64.of_int good_rhotates_right.[4*off + 0]] + .[1 <- W64.of_int good_rhotates_right.[4*off + 1]] + .[2 <- W64.of_int good_rhotates_right.[4*off + 2]] + .[3 <- W64.of_int good_rhotates_right.[4*off + 3]])%Array4. +proof. + move=> mem x off /= hx hgood hoff. + rewrite -load4u64 /lift2array; apply Array4.tP => i hi. + rewrite Array4.initiE 1:// /= W4u64.pack4bE 1:// W4u64.Pack.get_of_list 1://. + have h32: to_uint (W64.of_int (32 * off)) = 32 * off. + + by rewrite W64.to_uint_small /= /#. + have -> : to_uint (x + W64.of_int (32 * off)) = to_uint x + 32 * off. + + by rewrite W64.to_uintD_small h32 // /#. + smt (Array4.get_setE). +qed. + + +(* these are the same as above *) +lemma loadlift_rhol : forall (mem : global_mem_t) (x : W64.t) (off : int), + to_uint x + 192 < W64.modulus => + good_rhol mem (to_uint x) => 0 <= off < 6 => + lift2array + (loadW256 mem (to_uint (x + W64.of_int (8 * 4 * off)))) = + (witness + .[0 <- W64.of_int good_rhotates_left.[4*off + 0]] + .[1 <- W64.of_int good_rhotates_left.[4*off + 1]] + .[2 <- W64.of_int good_rhotates_left.[4*off + 2]] + .[3 <- W64.of_int good_rhotates_left.[4*off + 3]])%Array4. +proof. + move=> mem x off /= hx hgood hoff. + rewrite -load4u64 /lift2array; apply Array4.tP => i hi. + rewrite Array4.initiE 1:// /= W4u64.pack4bE 1:// W4u64.Pack.get_of_list 1://. + have h32: to_uint (W64.of_int (32 * off)) = 32 * off. + + by rewrite W64.to_uint_small /= /#. + have -> : to_uint (x + W64.of_int (32 * off)) = to_uint x + 32 * off. + + by rewrite W64.to_uintD_small h32 // /#. + smt (Array4.get_setE). +qed. + +lemma loadlift_iotas : forall (mem : global_mem_t) (x : W64.t) (off : int), + to_uint x + 768 < W64.modulus => + good_io4x mem (to_uint x) => 0 <= off < 24 => + lift2array + (loadW256 mem (to_uint (x + W64.of_int (8 * 4 * off)))) = + (witness + .[0 <- good_iotas4x.[off * 4 + 0]] + .[1 <- good_iotas4x.[off * 4 + 1]] + .[2 <- good_iotas4x.[off * 4 + 2]] + .[3 <- good_iotas4x.[off * 4 + 3]])%Array4. +proof. + move=> mem x off /= hx hgood hoff. + rewrite -load4u64 /lift2array; apply Array4.tP => i hi. + rewrite Array4.initiE 1:// /= W4u64.pack4bE 1:// W4u64.Pack.get_of_list 1://. + have h32: to_uint (W64.of_int (32 * off)) = 32 * off. + + by rewrite W64.to_uint_small /= /#. + have -> : to_uint (x + W64.of_int (32 * off)) = to_uint x + 32 * off. + + by rewrite W64.to_uintD_small h32 // /#. + have -> : to_uint x + 32 * off + 24 = to_uint x + (4 * off + 3) * 8 by ring. + have -> : to_uint x + 32 * off + 16 = to_uint x + (4 * off + 2) * 8 by ring. + have -> : to_uint x + 32 * off + 8 = to_uint x + (4 * off + 1) * 8 by ring. + have -> : 32 * off = (4 * off) * 8 by ring. + move : (hgood (off * 4 + i) _) => />. smt(@W64). smt (Array4.get_setE). +qed. + +op conversion(o1 o2 : int) : int = + let (x,y) = + ((witness + .[0 <- (2,0)] + .[1 <- (4,0)] + .[2 <- (1,0)] + .[3 <- (3,0)] + .[4 <- (0,1)] + .[5 <- (0,2)] + .[6 <- (0,3)] + .[7 <- (0,4)] + .[8 <- (3,1)] + .[9 <- (1,2)] + .[10 <- (4,3)] + .[11 <- (2,4)] + .[12 <- (2,1)] + .[13 <- (4,2)] + .[14 <- (1,3)] + .[15 <- (3,4)] + .[16 <- (4,1)] + .[17 <- (3,2)] + .[18 <- (2,3)] + .[19 <- (1,4)] + .[20 <- (1,1)] + .[21 <- (2,2)] + .[22 <- (3,3)] + .[23 <- (4,4)])%Array24).[o1*4 + o2] in (5*x + y). + +lemma lift_roln mem rl rr o1 o2 x: + W64.to_uint rl + 192 < W64.modulus => + W64.to_uint rr + 192 < W64.modulus => + 0 <= o1 < 6 => 0 <= o2 < 4 => + good_rhol mem (W64.to_uint rl) => + good_rhor mem (W64.to_uint rr) => + (x `>>>` + (to_uint + (lift2array + (loadW256 mem + (to_uint (rr + W64.of_int 96 + W64.of_int (8 * 4 * o1 - 96))))).[o2]))%W64 `|` + (x `<<<` + (to_uint + (lift2array + (loadW256 mem + (to_uint (rl + W64.of_int 96 + W64.of_int (8 * 4 * o1 - 96))))).[o2]))%W64 + = (x86_ROL_64 x ((of_int (rhotates (conversion o1 o2))))%W8).`3. +proof. +move => hl192 hr192 ho1 ho2 hgl hgr. +rewrite (loadlift_rhol mem (rl) o1 hl192) 1,2://. +rewrite (loadlift_rhor mem (rr) o1 hr192) 1,2://. +rewrite /good_rhotates_right /good_rhotates_left /rhotates /conversion; cbv delta. +move: ho1 ho2 => /(mema_iota 0 6) ho1 /(mema_iota 0 4). +by move: ho1 => /= [#|] -> [#|] ->; cbv delta; rewrite roln. +qed. + +lemma correct_perm _a00 _a01 _a20 _a31 _a21 _a41 _a11 st mem: + equiv [ Mreftable.__keccak_f1600_ref ~ Mavx2_prevec.__KeccakF1600 : + to_uint _rhotates_left{2} + 192 < W64.modulus /\ + to_uint _rhotates_right{2} + 192 < W64.modulus /\ + to_uint _iotas{2} + 768 < W64.modulus /\ + Glob.mem{2} = mem /\ good_io4x mem (to_uint _iotas{2}) /\ + good_rhol mem (to_uint _rhotates_left{2}) /\ good_rhor mem (to_uint _rhotates_right{2}) /\ + equiv_states _a00 _a01 _a20 _a31 _a21 _a41 _a11 st /\ + a00{2} = _a00 /\ a01{2} = _a01 /\ a20{2} = _a20 /\ a31{2} = _a31 /\ + a21{2} = _a21 /\ a41{2} = _a41 /\ a11{2} = _a11 /\ state{1} = st ==> + Glob.mem{2} = mem /\ + equiv_states res{2}.`1 res{2}.`2 res{2}.`3 res{2}.`4 res{2}.`5 res{2}.`6 res{2}.`7 res{1}]. +proof. +proc. +unroll {1} 3. +rcondt {1} 3; first by move => *; inline *; auto => />. + +seq 0 1 : #pre; first by auto => />. +inline Mreftable.keccakRoundConstants. +sp 2 4. + +seq 1 105 : (#{/~a00{2}}{~a01{2}}{~a20{2}}{~a31{2}}{~a21{2}}{~a41{2}}{~a11{2}}{~state{1}}pre /\ Glob.mem{2} = mem /\ + good_io4x mem (to_uint _iotas{2}) /\ + good_rhol mem (to_uint _rhotates_left{2}) /\ + good_rhor mem (to_uint _rhotates_right{2}) /\ + to_uint _rhotates_left{2} + 192 < W64.modulus /\ + to_uint _rhotates_right{2} + 192 < W64.modulus /\ + to_uint _iotas{2} + 768 < W64.modulus /\ + equiv_states a00{2} a01{2} a20{2} a31{2} a21{2} a41{2} a11{2} state{1}). + +seq 0 0 : (#pre /\ (constants{1}.[round{1}])%Array24 = W64.of_int 1). +by auto => />; rewrite /iotas;smt(). + +inline Mreftable.keccakP1600_round. + +sp 2 0. +inline Mreftable.theta. +sp 1 0. + +swap {2} [20..21] 3. +swap {2} 28 -3. +swap {2} 32 -6. +swap {2} 36 -9. +swap {2} 40 -12. +swap {2} 46 -17. + +seq 9 29 : (#{/~state{1}}post /\ c{1} = W64.of_int 1 /\ + equiv_states a00{2} a01{2} a20{2} a31{2} a21{2} a41{2} a11{2} state0{1}). ++ conseq />. + do 13!(unroll for {1} ^while). + inline *. wp;skip => &1 &2 [#] 9!->>. + move=> ??? ->> ???? 7!<<- ->> h. + cbv int_bit index W8.int_bit. + by smt(W64.xorwA W64.xorwC W64.xorw0 W64.xorwK rolcomp commor). + +(* Rho PI *) +inline Mreftable.rho Mreftable.pi. + +seq 11 22 : (#{/~ state{1}}post /\ c{1} = W64.of_int 1 /\ + equiv_states_chi a00{2} t{2}.[1] t{2}.[2] t{2}.[3] t{2}.[4] t{2}.[5] t{2}.[6] state0{1}). +conseq />. +do 13!(unroll for {1} ^while). +inline *; wp; skip => &1 &2 [#] 7!->> 8? ->> ?. +cbv index rhotates. +split; first by smt(rol0). +split; first by smt(rol0). +split; first by smt(rol0). +split; first by smt(rol0). +split. ++ have /= -> := lift_roln _ _ _ 5 3 a11{2}.[3] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 5 2 a11{2}.[2] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 5 1 a11{2}.[1] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 5 0 a11{2}.[0] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 1 3 a01{2}.[3] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 1 2 a01{2}.[2] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 1 1 a01{2}.[1] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 1 0 a01{2}.[0] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 0 2 a20{2}.[2] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 0 0 a20{2}.[0] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 0 3 a20{2}.[3] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 0 1 a20{2}.[1] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 2 2 a31{2}.[2] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 2 0 a31{2}.[0] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 2 3 a31{2}.[3] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 2 1 a31{2}.[1] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 3 0 a21{2}.[0] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 3 1 a21{2}.[1] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 3 2 a21{2}.[2] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 3 3 a21{2}.[3] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 4 1 a41{2}.[1] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 4 3 a41{2}.[3] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 4 0 a41{2}.[0] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). +have /= -> := lift_roln _ _ _ 4 2 a41{2}.[2] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). + +(* Chi *) +inline Mreftable.chi. +conseq />. +seq 5 53 : (#{~state0{1}}pre /\ + equiv_states a00{2} a01{2} a20{2} a31{2} a21{2} a41{2} a11{2} state0{1}). ++ conseq />. + do 11!(unroll for {1} ^while). + inline *; wp; skip => &1 &2 [#] 7!->> 8? ->> ?. + cbv delta. + smt (W64.xorwC W64.andwC). + +inline *; wp;skip => &1 &2 [#] 7!->> 8? ->> ?. +cbv index. +have /= -> /= := loadlift_iotas _ _ 0 H6 H1 _; 1:done. +rewrite /good_iotas4x /= /#. + +seq 1 2 : (#{/~iotas{2}}{~round{1}}{~i{2}}{~st}pre /\ + iotas{2} = _iotas{2} + W64.of_int (round{1} * 32) /\ + to_uint i{2} = 24 - round{1} /\ + ((to_uint i{2} = 0) <> round{1} < 24) /\ + (x86_DEC_32 (i{2} + W32.of_int 1)).`4 = zf{2} /\ + 0 < round{1} /\ + to_uint i{2} <= 24 /\ + constants{1} = Keccak_f1600_ref_op.iotas). ++ auto => /> *. + by rewrite dec 1:// /= decK. + +while (#pre). + +inline Mreftable.keccakP1600_round. + + +sp 2 0. +inline Mreftable.theta. +sp 1 0. + +swap {2} [20..21] 3. +swap {2} 28 -3. +swap {2} 32 -6. +swap {2} 36 -9. +swap {2} 40 -12. +swap {2} 46 -17. + +seq 9 29 : (#{/~state{1}}post /\ c{1} = constants{1}.[round{1}] /\ round{1} < 24 /\ + equiv_states a00{2} a01{2} a20{2} a31{2} a21{2} a41{2} a11{2} state0{1}). ++ conseq />. + do 13!(unroll for {1} ^while). + inline *; wp;skip. + move => &1 &2 [#] 7!->> 8? ->> ?? <<- ?????. + cbv delta. + rewrite !rolcomp /(`>>`) /=. + smt(W64.xorwA W64.xorwC W64.xorw0 W64.xorwK commor). + +(* Rho PI *) +inline Mreftable.rho Mreftable.pi. +seq 11 22 : (#{/~ state{1}}post /\ c{1} = constants{1}.[round{1}] /\ round{1} < 24 /\ + equiv_states_chi a00{2} t{2}.[1] t{2}.[2] t{2}.[3] t{2}.[4] t{2}.[5] t{2}.[6] state0{1}). +conseq />. +do 13!(unroll for {1} ^while). +inline *; wp;skip. +move => &1 &2 [#] 4!->> _ ?????? ->> ?? <<- ???? ->> ??. +cbv index rhotates. +split; first by smt(rol0). +split; first by smt(rol0). +split; first by smt(rol0). +split; first by smt(rol0). +split. ++ have /= -> := lift_roln _ _ _ 5 3 a11{2}.[3] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 5 2 a11{2}.[2] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 5 1 a11{2}.[1] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 5 0 a11{2}.[0] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 1 3 a01{2}.[3] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 1 2 a01{2}.[2] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 1 1 a01{2}.[1] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 1 0 a01{2}.[0] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 0 2 a20{2}.[2] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 0 0 a20{2}.[0] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 0 3 a20{2}.[3] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 0 1 a20{2}.[1] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 2 2 a31{2}.[2] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 2 0 a31{2}.[0] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 2 3 a31{2}.[3] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 2 1 a31{2}.[1] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 3 0 a21{2}.[0] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 3 1 a21{2}.[1] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 3 2 a21{2}.[2] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 3 3 a21{2}.[3] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 4 1 a41{2}.[1] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 4 3 a41{2}.[3] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). +split. ++ have /= -> := lift_roln _ _ _ 4 0 a41{2}.[0] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). +have /= -> := lift_roln _ _ _ 4 2 a41{2}.[2] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). + +(* Chi *) +inline Mreftable.chi. +seq 5 53 : (#{~state0{1}}pre /\ + equiv_states a00{2} a01{2} a20{2} a31{2} a21{2} a41{2} a11{2} state0{1}). +conseq />. +do 11!(unroll for {1} ^while). +inline *; wp; skip => &1 &2 [#] 4!->> ???? ??? ->> ?? <<- ???? ->> ??. +cbv delta. +smt (W64.xorwC W64.andwC). + +(* iota *) + +seq 2 1 : (#{/~ state0{1}}pre /\ + equiv_states a00{2} a01{2} a20{2} a31{2} a21{2} a41{2} a11{2} + state{1}). +conseq />. +inline *; wp; skip => &1 &2 [#] 4!->> ???? ??? ->> ?? <<- ???? ->> ??. +cbv. +have -> : round{1} * 32 = 8*4*round{1}; 1: ring. +have -> /= := loadlift_iotas _ _ (round{1}) H5 H0; 1: smt(). +cbv index. +have -> : good_iotas4x.[round{1} * 4 + 3] = iotas.[round{1}]. ++ have : 1 <= round{1} < 24 by smt(). + by move /(mema_iota 1 23) => /> [#|] ->; cbv delta. +have -> : good_iotas4x.[round{1} * 4 + 2] = iotas.[round{1}]. ++ have : 1 <= round{1} < 24 by smt(). + by move /(mema_iota 1 23) => /> [#|] ->; cbv delta. +have -> : good_iotas4x.[round{1} * 4 + 1] = iotas.[round{1}]. ++ have : 1 <= round{1} < 24 by smt(). + by move /(mema_iota 1 23) => /> [#|] ->; cbv delta. +have -> : good_iotas4x.[round{1} * 4] = iotas.[round{1}]. ++ have : 1 <= round{1} < 24 by smt(). + by move /(mema_iota 1 23) => /> [#|] ->; cbv delta. +smt(). + +conseq />. +wp;skip => />; smt(dec dec0 decK). + +skip => |> *. +rewrite dec0 1:to_uintD_small /= 1,2:/# dec to_uintD_small /= /#. +qed. diff --git a/sha3/proof/impl/perm/keccak_f1600_avx2_prevec_vops.ec b/sha3/proof/impl/perm/keccak_f1600_avx2_prevec_vops.ec new file mode 100644 index 0000000..757a16d --- /dev/null +++ b/sha3/proof/impl/perm/keccak_f1600_avx2_prevec_vops.ec @@ -0,0 +1,426 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array4 Array9 Array24 Array25 Array96. +require import WArray288. + +require import Keccak_f1600_ref_op. +import Ops. + +module Mavx2_prevec_vops = { + + proc __KeccakF1600 (a00:W256.t, a01:W256.t, a20:W256.t, a31:W256.t, + a21:W256.t, a41:W256.t, a11:W256.t, + _rhotates_left:W64.t, _rhotates_right:W64.t, + _iotas:W64.t) : W256.t * W256.t * W256.t * W256.t * + W256.t * W256.t * W256.t = { + + var rhotates_left:W64.t; + var rhotates_right:W64.t; + var iotas:W64.t; + var i:W32.t; + var zf:bool; + var c00:W256.t; + var c14:W256.t; + var t:W256.t Array9.t; + var d14:W256.t; + var d00:W256.t; + var _0:bool; + var _1:bool; + var _2:bool; + t <- witness; + rhotates_left <- (_rhotates_left + (W64.of_int 96)); + rhotates_right <- (_rhotates_right + (W64.of_int 96)); + iotas <- _iotas; + i <- (W32.of_int 24); + c00 <@ OpsV.iVPSHUFD_256(a20,(W8.of_int 78)); + c14 <@ OpsV.ilxor4u64(a41,a31); + t.[2] <@ OpsV.ilxor4u64(a21,a11); + c14 <@ OpsV.ilxor4u64(c14,a01); + c14 <@ OpsV.ilxor4u64(c14,t.[2]); + t.[4] <- OpsV.iVPERMQ(c14,(W8.of_int 147)); + c00 <@ OpsV.ilxor4u64(c00,a20); + t.[0] <- OpsV.iVPERMQ(c00,(W8.of_int 78)); + t.[1] <- OpsV.ivshr64u256(c14, (W8.of_int 63)); + t.[2] <- OpsV.ivadd64u256(c14, c14); + t.[1] <@ OpsV.ilor4u64(t.[1],t.[2]); + d14 <- OpsV.iVPERMQ(t.[1],(W8.of_int 57)); + d00 <@ OpsV.ilxor4u64(t.[1],t.[4]); + d00 <- OpsV.iVPERMQ(d00,(W8.of_int 0)); + c00 <@ OpsV.ilxor4u64(c00,a00); + c00 <@ OpsV.ilxor4u64(c00,t.[0]); + t.[0] <- OpsV.ivshr64u256(c00, (W8.of_int 63)); + t.[1] <- OpsV.ivadd64u256(c00, c00); + t.[1] <@ OpsV.ilor4u64(t.[1],t.[0]); + a20 <@ OpsV.ilxor4u64(a20,d00); + a00 <@ OpsV.ilxor4u64(a00,d00); + d14 <- OpsV.iVPBLENDD_256(d14,t.[1], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[4] <- OpsV.iVPBLENDD_256(t.[4],c00, + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + d14 <@ OpsV.ilxor4u64(d14,t.[4]); + t.[3] <@ OpsV.iVPSLLV_4u64(a20, + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96)))))); + a20 <@ OpsV.iVPSRLV_4u64(a20, + (loadW256 Glob.mem (W64.to_uint (rhotates_right+ (W64.of_int ((0 * 32) - 96)))))); + a20 <@ OpsV.ilor4u64(a20,t.[3]); + a31 <@ OpsV.ilxor4u64(a31,d14); + t.[4] <@ OpsV.iVPSLLV_4u64(a31, + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96)))))); + a31 <@ OpsV.iVPSRLV_4u64(a31, + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96)))))); + a31 <@ OpsV.ilor4u64(a31,t.[4]); + a21 <@ OpsV.ilxor4u64(a21,d14); + t.[5] <@ OpsV.iVPSLLV_4u64(a21, + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96)))))); + a21 <@ OpsV.iVPSRLV_4u64(a21, + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96)))))); + a21 <@ OpsV.ilor4u64(a21,t.[5]); + a41 <@ OpsV.ilxor4u64(a41,d14); + t.[6] <@ OpsV.iVPSLLV_4u64(a41, + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96)))))); + a41 <@ OpsV.iVPSRLV_4u64(a41, + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96)))))); + a41 <@ OpsV.ilor4u64(a41,t.[6]); + a11 <@ OpsV.ilxor4u64(a11,d14); + t.[3] <- OpsV.iVPERMQ(a20,(W8.of_int 141)); + t.[4] <- OpsV.iVPERMQ(a31,(W8.of_int 141)); + t.[7] <@ OpsV.iVPSLLV_4u64(a11, + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96)))))); + t.[1] <@ OpsV.iVPSRLV_4u64(a11, + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96)))))); + t.[1] <@ OpsV.ilor4u64(t.[1],t.[7]); + a01 <@ OpsV.ilxor4u64(a01,d14); + t.[5] <- OpsV.iVPERMQ(a21,(W8.of_int 27)); + t.[6] <- OpsV.iVPERMQ(a41,(W8.of_int 114)); + t.[8] <@ OpsV.iVPSLLV_4u64(a01, + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96)))))); + t.[2] <@ OpsV.iVPSRLV_4u64(a01, + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96)))))); + t.[2] <@ OpsV.ilor4u64(t.[2],t.[8]); + t.[7] <@ OpsV.iVPSRLDQ_256(t.[1],(W8.of_int 8)); + t.[0] <@ OpsV.ilandn4u64(t.[1],t.[7]); + a31 <@ OpsV.iVPBLENDD_256(t.[2],t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[8] <@ OpsV.iVPBLENDD_256(t.[4],t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a41 <@ OpsV.iVPBLENDD_256(t.[3], t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[2], t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a31 <@ OpsV.iVPBLENDD_256(a31 ,t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[8] <@ OpsV.iVPBLENDD_256(t.[8], t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a41 <@ OpsV.iVPBLENDD_256(a41, t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[7], t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a31 <@ OpsV.iVPBLENDD_256(a31, t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[8] <@ OpsV.iVPBLENDD_256(t.[8], t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a41 <@ OpsV.iVPBLENDD_256(a41, t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[7], t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a31 <@ OpsV.ilandn4u64(a31,t.[8]); + a41 <@ OpsV.ilandn4u64(a41,t.[7]); + a11 <@ OpsV.iVPBLENDD_256(t.[5],t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[8] <@ OpsV.iVPBLENDD_256(t.[3], t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a31 <@ OpsV.ilxor4u64(a31,t.[3]); + a11 <@ OpsV.iVPBLENDD_256(a11,t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[8] <@ OpsV.iVPBLENDD_256(t.[8],t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a41 <@ OpsV.ilxor4u64(a41,t.[5]); + a11 <@ OpsV.iVPBLENDD_256(a11, t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[8] <@ OpsV.iVPBLENDD_256(t.[8], t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a11 <@ OpsV.ilandn4u64(a11,t.[8]); + a11 <@ OpsV.ilxor4u64(a11,t.[6]); + a21 <@ OpsV.iVPERMQ(t.[1],(W8.of_int 30)); + t.[8] <@ OpsV.iVPBLENDD_256(a21, a00, + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a01 <@ OpsV.iVPERMQ(t.[1],(W8.of_int 57)); + a01 <@ OpsV.iVPBLENDD_256(a01, a00, + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a01 <@ OpsV.ilandn4u64(a01,t.[8]); + a20 <@ OpsV.iVPBLENDD_256(t.[4], t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[6], t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a20 <@ OpsV.iVPBLENDD_256(a20, t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[7], t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a20 <@ OpsV.iVPBLENDD_256(a20, t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[7], t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a20 <@ OpsV.ilandn4u64(a20,t.[7]); + a20 <@ OpsV.ilxor4u64(a20,t.[2]); + t.[0] <@ OpsV.iVPERMQ(t.[0],(W8.of_int 0)); + a31 <@ OpsV.iVPERMQ(a31,(W8.of_int 27)); + a41 <@ OpsV.iVPERMQ(a41,(W8.of_int 141)); + a11 <@ OpsV.iVPERMQ(a11,(W8.of_int 114)); + a21 <@ OpsV.iVPBLENDD_256(t.[6], t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[5], t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a21 <@ OpsV.iVPBLENDD_256(a21, t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[7], t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a21 <@ OpsV.iVPBLENDD_256(a21, t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[7], t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a21 <@ OpsV.ilandn4u64(a21,t.[7]); + a00 <@ OpsV.ilxor4u64(a00,t.[0]); + a01 <@ OpsV.ilxor4u64(a01,t.[1]); + a21 <@ OpsV.ilxor4u64(a21,t.[4]); + a00 <@ OpsV.ilxor4u64(a00, + (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int 0))))); + iotas <- (iotas + (W64.of_int 32)); + ( _0, _1, _2, zf, i) <- x86_DEC_32 i; + while ((! zf)) { + c00 <@ OpsV.iVPSHUFD_256(a20,(W8.of_int 78)); + c14 <@ OpsV.ilxor4u64(a41,a31); + t.[2] <@ OpsV.ilxor4u64(a21,a11); + c14 <@ OpsV.ilxor4u64(c14,a01); + c14 <@ OpsV.ilxor4u64(c14,t.[2]); + t.[4] <@ OpsV.iVPERMQ(c14,(W8.of_int 147)); + c00 <@ OpsV.ilxor4u64(c00,a20); + t.[0] <@ OpsV.iVPERMQ(c00,(W8.of_int 78)); + t.[1] <@ OpsV.ivshr64u256(c14, (W8.of_int 63)); + t.[2] <@ OpsV.ivadd64u256(c14, c14); + t.[1] <@ OpsV.ilor4u64(t.[1],t.[2]); + d14 <@ OpsV.iVPERMQ(t.[1],(W8.of_int 57)); + d00 <@ OpsV.ilxor4u64(t.[1],t.[4]); + d00 <@ OpsV.iVPERMQ(d00,(W8.of_int 0)); + c00 <@ OpsV.ilxor4u64(c00,a00); + c00 <@ OpsV.ilxor4u64(c00,t.[0]); + t.[0] <@ OpsV.ivshr64u256(c00, (W8.of_int 63)); + t.[1] <@ OpsV.ivadd64u256(c00, c00); + t.[1] <@ OpsV.ilor4u64(t.[1],t.[0]); + a20 <@ OpsV.ilxor4u64(a20,d00); + a00 <@ OpsV.ilxor4u64(a00,d00); + d14 <@ OpsV.iVPBLENDD_256(d14,t.[1], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[4] <@ OpsV.iVPBLENDD_256(t.[4],c00, + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + d14 <@ OpsV.ilxor4u64(d14,t.[4]); + t.[3] <@ OpsV.iVPSLLV_4u64(a20, + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96)))))); + a20 <@ OpsV.iVPSRLV_4u64(a20, + (loadW256 Glob.mem (W64.to_uint (rhotates_right+ (W64.of_int ((0 * 32) - 96)))))); + a20 <@ OpsV.ilor4u64(a20,t.[3]); + a31 <@ OpsV.ilxor4u64(a31,d14); + t.[4] <@ OpsV.iVPSLLV_4u64(a31, + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96)))))); + a31 <@ OpsV.iVPSRLV_4u64(a31, + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96)))))); + a31 <@ OpsV.ilor4u64(a31,t.[4]); + a21 <@ OpsV.ilxor4u64(a21,d14); + t.[5] <@ OpsV.iVPSLLV_4u64(a21, + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96)))))); + a21 <@ OpsV.iVPSRLV_4u64(a21, + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96)))))); + a21 <@ OpsV.ilor4u64(a21,t.[5]); + a41 <@ OpsV.ilxor4u64(a41,d14); + t.[6] <@ OpsV.iVPSLLV_4u64(a41, + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96)))))); + a41 <@ OpsV.iVPSRLV_4u64(a41, + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96)))))); + a41 <@ OpsV.ilor4u64(a41,t.[6]); + a11 <@ OpsV.ilxor4u64(a11,d14); + t.[3] <- OpsV.iVPERMQ(a20,(W8.of_int 141)); + t.[4] <- OpsV.iVPERMQ(a31,(W8.of_int 141)); + t.[7] <@ OpsV.iVPSLLV_4u64(a11, + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96)))))); + t.[1] <@ OpsV.iVPSRLV_4u64(a11, + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96)))))); + t.[1] <@ OpsV.ilor4u64(t.[1],t.[7]); + a01 <@ OpsV.ilxor4u64(a01,d14); + t.[5] <- OpsV.iVPERMQ(a21,(W8.of_int 27)); + t.[6] <- OpsV.iVPERMQ(a41,(W8.of_int 114)); + t.[8] <@ OpsV.iVPSLLV_4u64(a01, + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96)))))); + t.[2] <@ OpsV.iVPSRLV_4u64(a01, + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96)))))); + t.[2] <@ OpsV.ilor4u64(t.[2],t.[8]); + t.[7] <@ OpsV.iVPSRLDQ_256(t.[1],(W8.of_int 8)); + t.[0] <@ OpsV.ilandn4u64(t.[1],t.[7]); + a31 <@ OpsV.iVPBLENDD_256(t.[2], t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[8] <@ OpsV.iVPBLENDD_256(t.[4], t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a41 <@ OpsV.iVPBLENDD_256(t.[3], t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[2], t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a31 <@ OpsV.iVPBLENDD_256(a31, t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[8] <@ OpsV.iVPBLENDD_256(t.[8], t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a41 <@ OpsV.iVPBLENDD_256(a41, t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[7], t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a31 <@ OpsV.iVPBLENDD_256(a31, t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[8] <@ OpsV.iVPBLENDD_256(t.[8], t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a41 <@ OpsV.iVPBLENDD_256(a41, t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[7], t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a31 <@ OpsV.ilandn4u64(a31,t.[8]); + a41 <@ OpsV.ilandn4u64(a41,t.[7]); + a11 <@ OpsV.iVPBLENDD_256(t.[5], t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[8] <@ OpsV.iVPBLENDD_256(t.[3], t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a31 <@ OpsV.ilxor4u64(a31,t.[3]); + a11 <@ OpsV.iVPBLENDD_256(a11, t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[8] <@ OpsV.iVPBLENDD_256(t.[8], t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a41 <@ OpsV.ilxor4u64(a41,t.[5]); + a11 <@ OpsV.iVPBLENDD_256(a11, t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[8] <@ OpsV.iVPBLENDD_256(t.[8], t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a11 <@ OpsV.ilandn4u64(a11,t.[8]); + a11 <@ OpsV.ilxor4u64(a11,t.[6]); + a21 <@ OpsV.iVPERMQ(t.[1],(W8.of_int 30)); + t.[8] <@ OpsV.iVPBLENDD_256(a21, a00, + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a01 <@ OpsV.iVPERMQ(t.[1],(W8.of_int 57)); + a01 <@ OpsV.iVPBLENDD_256(a01 ,a00, + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a01 <@ OpsV.ilandn4u64(a01,t.[8]); + a20 <@ OpsV.iVPBLENDD_256(t.[4], t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[6], t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a20 <@ OpsV.iVPBLENDD_256(a20, t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[7], t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a20 <@ OpsV.iVPBLENDD_256(a20, t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[7], t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a20 <@ OpsV.ilandn4u64(a20,t.[7]); + a20 <@ OpsV.ilxor4u64(a20,t.[2]); + t.[0] <@ OpsV.iVPERMQ(t.[0],(W8.of_int 0)); + a31 <@ OpsV.iVPERMQ(a31,(W8.of_int 27)); + a41 <@ OpsV.iVPERMQ(a41,(W8.of_int 141)); + a11 <@ OpsV.iVPERMQ(a11,(W8.of_int 114)); + a21 <@ OpsV.iVPBLENDD_256(t.[6], t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[5], t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a21 <@ OpsV.iVPBLENDD_256(a21, t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[7] ,t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a21 <@ OpsV.iVPBLENDD_256(a21, t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[7], t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a21 <@ OpsV.ilandn4u64(a21,t.[7]); + a00 <@ OpsV.ilxor4u64(a00,t.[0]); + a01 <@ OpsV.ilxor4u64(a01,t.[1]); + a21 <@ OpsV.ilxor4u64(a21,t.[4]); + a00 <@ OpsV.ilxor4u64(a00, + (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int 0))))); + iotas <- (iotas + (W64.of_int 32)); + ( _0, _1, _2, zf, i) <- x86_DEC_32 i; + } + return (a00, a01, a20, a31, a21, a41, a11); + } +}. + +require import Keccak_f1600_avx2_openssl. + +equiv prevec_vops_openssl : + Mavx2_prevec_vops.__KeccakF1600 ~ M.__keccak_f1600_avx2_openssl : + ={Glob.mem,arg} ==> ={Glob.mem,res}. +proc. + seq 112 112 : (#pre /\ ={zf,iotas,rhotates_left,rhotates_right,t,i}). + seq 30 30 : (#pre /\ ={d14,t,iotas,rhotates_left,rhotates_right,i}). + by inline*;wp;skip; rewrite /flat_state; auto => />. + seq 30 30 : #pre. + by inline*;wp;skip; rewrite /flat_state; auto => />. + seq 30 30 : #pre. + by inline*;wp;skip; rewrite /flat_state; auto => />. + by inline*;wp;skip; rewrite /flat_state; auto => />. + while (#pre). + seq 30 30 : (#pre /\ ={d14}). + by inline*;wp;skip; rewrite /flat_state; auto => />. + seq 30 30 : #pre. + by inline*;wp;skip; rewrite /flat_state; auto => />. + seq 30 30 : #pre. + by inline*;wp;skip; rewrite /flat_state; auto => />. + by inline*;wp;skip; rewrite /flat_state; auto => />. + by auto => />. +qed. + +require import Keccak_f1600_avx2_prevec. + +op match_ins(st1 : W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * + W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * W64.t * W64.t * W64.t, + st2 : W256.t * W256.t * W256.t * W256.t * W256.t * W256.t * W256.t * W64.t * + W64.t * W64.t) = + is4u64 st1.`1 st2.`1 /\ + is4u64 st1.`2 st2.`2 /\ + is4u64 st1.`3 st2.`3 /\ + is4u64 st1.`4 st2.`4 /\ + is4u64 st1.`5 st2.`5 /\ + is4u64 st1.`6 st2.`6 /\ + is4u64 st1.`7 st2.`7 /\ + st1.`8 = st2.`8 /\ + st1.`9 = st2.`9 /\ + st1.`10 = st2.`10. + +op match_states( st1 : W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * + W64.t Array4.t * W64.t Array4.t * W64.t Array4.t, + st2 : W256.t * W256.t * W256.t * W256.t * W256.t * W256.t * W256.t) = + is4u64 st1.`1 st2.`1 /\ + is4u64 st1.`2 st2.`2 /\ + is4u64 st1.`3 st2.`3 /\ + is4u64 st1.`4 st2.`4 /\ + is4u64 st1.`5 st2.`5 /\ + is4u64 st1.`6 st2.`6 /\ + is4u64 st1.`7 st2.`7. + +lemma lift2arrayP (w:W256.t) : w = pack4 [(lift2array w).[0]; (lift2array w).[1]; (lift2array w).[2]; (lift2array w).[3]]. +proof. + apply W4u64.wordP => i hi. + rewrite /lift2array /= pack4bE 1:// get_of_list 1:// /#. +qed. + +equiv prevec_vops_prevec : + Mavx2_prevec.__KeccakF1600 ~ Mavx2_prevec_vops.__KeccakF1600 : + ={Glob.mem} /\ match_ins arg{1} arg{2} ==> ={Glob.mem} /\ match_states res{1} res{2}. +proof. + proc. + while (#pre /\ ={zf,iotas,rhotates_left,rhotates_right,i}). + + wp; + do !(call eq_ilxor4u64 || call eq_ilandn4u64 || call eq_iVPBLENDD_256 || call eq_iVPERMQ || call eq_ilandn4u64 || + call eq_iVPSRLDQ_256 || call eq_iVPSLLV_4u64 || call eq_ilor4u64 || call eq_iVPSRLV_4u64 || + call eq_ivadd64u256 || call eq_ivshr64u256 || call eq_iVPSHUFD_256); wp; skip => />; rewrite /is4u64 => />. + smt (lift2arrayP). + wp; + do !(call eq_ilxor4u64 || call eq_ilandn4u64 || call eq_iVPBLENDD_256 || call eq_iVPERMQ || call eq_ilandn4u64 || + call eq_iVPSRLDQ_256 || call eq_iVPSLLV_4u64 || call eq_ilor4u64 || call eq_iVPSRLV_4u64 || + call eq_ivadd64u256 || call eq_ivshr64u256 || call eq_iVPSHUFD_256); wp; skip => />; rewrite /is4u64 => />. + smt (lift2arrayP). +qed. + diff --git a/sha3/proof/impl/perm/keccak_f1600_ref.ec b/sha3/proof/impl/perm/keccak_f1600_ref.ec new file mode 100644 index 0000000..c611460 --- /dev/null +++ b/sha3/proof/impl/perm/keccak_f1600_ref.ec @@ -0,0 +1,272 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array5 Array24 Array25. +require import WArray40 WArray192 WArray200. + + + +module M = { + proc index (x:int, y:int) : int = { + + var r:int; + + r <- ((x %% 5) + (5 * (y %% 5))); + return (r); + } + + proc theta (a:W64.t Array25.t) : W64.t Array25.t = { + var aux_1: bool; + var aux_0: bool; + var aux: int; + var aux_2: W64.t; + + var x:int; + var c:W64.t Array5.t; + var y:int; + var d:W64.t Array5.t; + var _0:bool; + var _1:bool; + c <- witness; + d <- witness; + x <- 0; + while (x < 5) { + c.[x] <- (W64.of_int 0); + y <- 0; + while (y < 5) { + c.[x] <- (c.[x] `^` a.[(x + (5 * y))]); + y <- y + 1; + } + x <- x + 1; + } + x <- 0; + while (x < 5) { + d.[x] <- c.[((x + 1) %% 5)]; + (aux_1, aux_0, aux_2) <- x86_ROL_64 d.[x] (W8.of_int 1); + _0 <- aux_1; + _1 <- aux_0; + d.[x] <- aux_2; + d.[x] <- (d.[x] `^` c.[((x + 4) %% 5)]); + x <- x + 1; + } + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + a.[(x + (5 * y))] <- (a.[(x + (5 * y))] `^` d.[x]); + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc keccakRhoOffsets (i:int) : int = { + var aux: int; + + var r:int; + var x:int; + var y:int; + var t:int; + var z:int; + + r <- 0; + x <- 1; + y <- 0; + t <- 0; + while (t < 24) { + if ((i = (x + (5 * y)))) { + r <- ((((t + 1) * (t + 2)) %/ 2) %% 64); + } else { + + } + z <- (((2 * x) + (3 * y)) %% 5); + x <- y; + y <- z; + t <- t + 1; + } + return (r); + } + + proc rho (a:W64.t Array25.t) : W64.t Array25.t = { + var aux_1: bool; + var aux_0: bool; + var aux: int; + var aux_2: W64.t; + + var x:int; + var y:int; + var i:int; + var z:int; + var _0:bool; + var _1:bool; + + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + i <@ index (x, y); + z <@ keccakRhoOffsets (i); + (aux_1, aux_0, aux_2) <- x86_ROL_64 a.[i] (W8.of_int z); + _0 <- aux_1; + _1 <- aux_0; + a.[i] <- aux_2; + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc pi (a:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var i:int; + var t:W64.t; + var b:W64.t Array25.t; + var y:int; + var x:int; + b <- witness; + i <- 0; + while (i < 25) { + t <- a.[i]; + b.[i] <- t; + i <- i + 1; + } + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + t <- b.[(x + (5 * y))]; + i <@ index (y, ((2 * x) + (3 * y))); + a.[i] <- t; + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc chi (a:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var x:int; + var y:int; + var i:int; + var c:W64.t Array5.t; + c <- witness; + y <- 0; + while (y < 5) { + x <- 0; + while (x < 5) { + i <@ index ((x + 1), y); + c.[x] <- a.[i]; + c.[x] <- (invw c.[x]); + i <@ index ((x + 2), y); + c.[x] <- (c.[x] `&` a.[i]); + i <@ index (x, y); + c.[x] <- (c.[x] `^` a.[i]); + x <- x + 1; + } + x <- 0; + while (x < 5) { + a.[(x + (5 * y))] <- c.[x]; + x <- x + 1; + } + y <- y + 1; + } + return (a); + } + + proc iota_0 (a:W64.t Array25.t, c:W64.t) : W64.t Array25.t = { + + + + a.[0] <- (a.[0] `^` c); + return (a); + } + + proc keccakP1600_round (state:W64.t Array25.t, c:W64.t) : W64.t Array25.t = { + + + + state <@ theta (state); + state <@ rho (state); + state <@ pi (state); + state <@ chi (state); + state <@ iota_0 (state, c); + return (state); + } + + proc keccakRoundConstants () : W64.t Array24.t = { + + var constants:W64.t Array24.t; + var t:W64.t; + constants <- witness; + t <- (W64.of_int 1); + constants.[0] <- t; + t <- (W64.of_int 32898); + constants.[1] <- t; + t <- (W64.of_int 9223372036854808714); + constants.[2] <- t; + t <- (W64.of_int 9223372039002292224); + constants.[3] <- t; + t <- (W64.of_int 32907); + constants.[4] <- t; + t <- (W64.of_int 2147483649); + constants.[5] <- t; + t <- (W64.of_int 9223372039002292353); + constants.[6] <- t; + t <- (W64.of_int 9223372036854808585); + constants.[7] <- t; + t <- (W64.of_int 138); + constants.[8] <- t; + t <- (W64.of_int 136); + constants.[9] <- t; + t <- (W64.of_int 2147516425); + constants.[10] <- t; + t <- (W64.of_int 2147483658); + constants.[11] <- t; + t <- (W64.of_int 2147516555); + constants.[12] <- t; + t <- (W64.of_int 9223372036854775947); + constants.[13] <- t; + t <- (W64.of_int 9223372036854808713); + constants.[14] <- t; + t <- (W64.of_int 9223372036854808579); + constants.[15] <- t; + t <- (W64.of_int 9223372036854808578); + constants.[16] <- t; + t <- (W64.of_int 9223372036854775936); + constants.[17] <- t; + t <- (W64.of_int 32778); + constants.[18] <- t; + t <- (W64.of_int 9223372039002259466); + constants.[19] <- t; + t <- (W64.of_int 9223372039002292353); + constants.[20] <- t; + t <- (W64.of_int 9223372036854808704); + constants.[21] <- t; + t <- (W64.of_int 2147483649); + constants.[22] <- t; + t <- (W64.of_int 9223372039002292232); + constants.[23] <- t; + return (constants); + } + + proc __keccak_f1600_ref (state:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var constants:W64.t Array24.t; + var round:int; + constants <- witness; + constants <@ keccakRoundConstants (); + round <- 0; + while (round < 24) { + state <@ keccakP1600_round (state, constants.[round]); + round <- round + 1; + } + return (state); + } +}. + diff --git a/sha3/proof/impl/perm/keccak_f1600_ref_loop2.ec b/sha3/proof/impl/perm/keccak_f1600_ref_loop2.ec new file mode 100644 index 0000000..2bfd889 --- /dev/null +++ b/sha3/proof/impl/perm/keccak_f1600_ref_loop2.ec @@ -0,0 +1,169 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + + require import Array5 Array24 Array25. +require import WArray40 WArray192 WArray200. + +require import Keccak_f1600_ref_table. +import Keccak_f1600_ref_op. +import Ops. + +module Mrefloop2 = { + include Mreftable [-__keccak_f1600_ref] + + proc __keccak_f1600_ref (state:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var constants:W64.t Array24.t; + var round:int; + constants <- witness; + constants <@ keccakRoundConstants (); + round <- 0; + state <@ keccakP1600_round (state, constants.[round]); + round <- round + 1; + state <@ keccakP1600_round (state, constants.[round]); + round <- round + 1; + while (round < 24) { + state <@ keccakP1600_round (state, constants.[round]); + state <@ keccakP1600_round (state, constants.[round + 1]); + round <- round + 2; + } + return (state); + } +}. + +require import LoopTransform. +clone import ExactIter with + type t = (W64.t Array25.t * W64.t Array24.t). + +module ExplBody : AdvLoop = { + include Mreftable [-__keccak_f1600_ref] + proc body(st : t,i : int) = { + var rst; + rst <@ keccakP1600_round(st.`1,st.`2.[i]); + return (rst,st.`2); + } +}. + +module Mrefloop = { + include ExplBody + include Loop(ExplBody) [loop1] + + proc __keccak_f1600_ref (state:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var constants:W64.t Array24.t; + var round:int; + constants <- witness; + constants <@ keccakRoundConstants (); + (state,constants) <@ loop1((state,constants),24); + return (state); + } + +}. + +module Mrefloopk = { + include ExplBody + include Loop(ExplBody) [loopk] + + proc __keccak_f1600_ref (state:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var constants:W64.t Array24.t; + var round:int; + constants <- witness; + constants <@ keccakRoundConstants (); + (state,constants) <@ loopk((state,constants),12,2); + return (state); + } + +}. + +lemma reftable_refloop : + equiv [ Mreftable.__keccak_f1600_ref ~ Mrefloop.__keccak_f1600_ref : + ={arg,Glob.mem} ==> ={res,Glob.mem} ]. +proc. +inline Mrefloop.loop1. +inline ExplBody.body. +wp. +while (={Glob.mem} /\ (state{1},constants{1}) = t{2} /\ round{1} = i{2} /\ n{2} = 24). +wp; call(_:true); first by sim. +by auto => />. +wp; call(_:true); first by sim. +by auto => />. +qed. + +lemma refloop_refloopk : + equiv [ Mrefloop.__keccak_f1600_ref ~ Mrefloopk.__keccak_f1600_ref : + ={arg,Glob.mem} ==> ={res,Glob.mem} ]. +proc. +call (loop1_loopk ExplBody). + call(_:true); first by sim. +by auto => />. +qed. + + +lemma refloopk_refloop2 : + equiv [ Mrefloopk.__keccak_f1600_ref ~ Mrefloop2.__keccak_f1600_ref : + ={arg,Glob.mem} ==> ={res,Glob.mem} ]. + +proc. +seq 2 2 : (#pre /\ ={constants}); first by sim. +inline Mrefloopk.loopk. + +unroll {1} 5. +rcondt {1} 5; first by move => *; auto => />. + +unroll {1} 6. +rcondt {1} 6; first by move => *; auto => />. + +seq 7 3 : (#{/~state{1}}pre /\ (state{2},constants{2}) = t{1} /\ k{1} = 2 /\ n{1} = 12 /\ j{1} = 1 /\ i{1} = 0 /\ round{2} = 1). +inline ExplBody.body. +wp; call(_:true); first by sim. +by auto => />. + + +unroll {1} 1. +rcondt {1} 1; first by move => *; auto => />. + +seq 2 2 : (#{/~j{1} = 1}{~round{2}=1}pre /\ j{1} = 2 /\ round{2} = 2). +inline ExplBody.body. +wp; call(_:true); first by sim. +by auto => />. + +seq 1 0 : #pre. while {1} (j{1} = 2 /\ k{1} = 2 /\ (state{2},constants{2}) = t{1} ) 1. move => *. exfalso. smt(). +by auto => />. + +seq 1 0 : (#{/~j{1}}{~i{1}}pre /\ i{1} = 1); first by auto => />. +wp. +while (={Glob.mem} /\ + ={constants} /\ + (state{2}, constants{2}) = t{1} /\ + k{1} = 2 /\ n{1} = 12 /\ + round{2} = 2*i{1}). + +unroll {1} 2. +rcondt {1} 2; first by move => *; auto => />. + +seq 3 1 : (#pre /\ j{1} = 1). +inline ExplBody.body. +wp; call(_:true); first by sim. +by auto => />. + +unroll {1} 1. +rcondt {1} 1; first by move => *; auto => />. + +seq 2 1 : (#{/~ j{1} = 1}pre /\ j{1} = 2). +inline ExplBody.body. +wp; call(_:true); first by sim. +by auto => />. + +seq 1 0 : #pre. while {1} (j{1} = 2 /\ k{1} = 2 /\ (state{2},constants{2}) = t{1} ) 1. move => *. exfalso. smt(). +by auto => />. + +by auto => />; smt(). + +by auto => />. + +qed. + diff --git a/sha3/proof/impl/perm/keccak_f1600_ref_op.ec b/sha3/proof/impl/perm/keccak_f1600_ref_op.ec new file mode 100644 index 0000000..99a3fe1 --- /dev/null +++ b/sha3/proof/impl/perm/keccak_f1600_ref_op.ec @@ -0,0 +1,71 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array5 Array24 Array25. +require import WArray40 WArray192 WArray200. + +require import Ops. + +op iotas : W64.t Array24.t = (( + witness + .[0 <- W64.one] + .[1 <- W64.of_int 32898] + .[2 <- W64.of_int 9223372036854808714] + .[3 <- W64.of_int 9223372039002292224] + .[4 <- W64.of_int 32907] + .[5 <- W64.of_int 2147483649] + .[6 <- W64.of_int 9223372039002292353] + .[7 <- W64.of_int 9223372036854808585] + .[8 <- W64.of_int 138] + .[9 <- W64.of_int 136] + .[10 <- W64.of_int 2147516425] + .[11 <- W64.of_int 2147483658] + .[12 <- W64.of_int 2147516555] + .[13 <- W64.of_int 9223372036854775947] + .[14 <- W64.of_int 9223372036854808713] + .[15 <- W64.of_int 9223372036854808579] + .[16 <- W64.of_int 9223372036854808578] + .[17 <- W64.of_int 9223372036854775936] + .[18 <- W64.of_int 32778] + .[19 <- W64.of_int 9223372039002259466] + .[20 <- W64.of_int 9223372039002292353] + .[21 <- W64.of_int 9223372036854808704] + .[22 <- W64.of_int 2147483649] + .[23 <- W64.of_int 9223372039002292232])%Array24). + +require import Keccak_f1600_ref. + +module Mrefop = { + include M [-keccakRoundConstants,__keccak_f1600_ref] + + proc keccakRoundConstants () : W64.t Array24.t = { + return iotas; + } + + + proc __keccak_f1600_ref (state:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var constants:W64.t Array24.t; + var round:int; + constants <- witness; + constants <@ keccakRoundConstants (); + round <- 0; + while (round < 24) { + state <@ keccakP1600_round (state, constants.[round]); + round <- round + 1; + } + return (state); + } +}. + +require import Keccak_f1600_ref. + +equiv ref_refop : + M.__keccak_f1600_ref ~ Mrefop.__keccak_f1600_ref : + ={Glob.mem,arg} ==> ={Glob.mem,res}. +proc. +seq 3 3 : (#pre /\ ={round, constants}). +by inline *;auto => />. +by sim. +qed. diff --git a/sha3/proof/impl/perm/keccak_f1600_ref_table.ec b/sha3/proof/impl/perm/keccak_f1600_ref_table.ec new file mode 100644 index 0000000..5907a35 --- /dev/null +++ b/sha3/proof/impl/perm/keccak_f1600_ref_table.ec @@ -0,0 +1,248 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array24 Array25. + +op rhotates(i : int) : int = (( + witness + .[0 <- 0 ] + .[1 <- 1 ] + .[2 <- 62] + .[3 <- 28] + .[4 <- 27] + .[5 <- 36] + .[6 <- 44] + .[7 <- 6 ] + .[8 <- 55] + .[9 <- 20] + .[10 <- 3 ] + .[11 <- 10] + .[12 <- 43] + .[13 <- 25] + .[14 <- 39] + .[15 <- 41] + .[16 <- 45] + .[17 <- 15] + .[18 <- 21] + .[19 <- 8 ] + .[20 <- 18] + .[21 <- 2 ] + .[22 <- 61] + .[23 <- 56] + .[24 <- 14])%Array25).[i]. + +require import Keccak_f1600_ref_op. +import Ops. + + +module RhotatesAlgo = { + include Mrefop [keccakRhoOffsets] +}. + +module RhotatesTable = { + proc keccakRhoOffsets (i:int) : int = { + return rhotates(i); + } +}. + +equiv rhotates_table_corr : + RhotatesAlgo.keccakRhoOffsets ~ RhotatesTable.keccakRhoOffsets : + ={arg} /\ 0 <= i{1} < 25 ==> ={res} . +proc. +unroll for {1} 5. + +case (i{1} = 0). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 1). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 2). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 3). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 4). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 5). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 6). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 7). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 8). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 9). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 10). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 11). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 12). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 13). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 14). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 15). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 16). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 17). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 18). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 19). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 20). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 21). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 22). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 23). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 24). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +by exfalso; smt(). +qed. + +module Mreftable = { + include Mrefop [-keccakRhoOffsets,rho,keccakP1600_round,__keccak_f1600_ref] + include RhotatesTable + + proc rho (a:W64.t Array25.t) : W64.t Array25.t = { + var aux_1: bool; + var aux_0: bool; + var aux: int; + var aux_2: W64.t; + + var x:int; + var y:int; + var i:int; + var z:int; + var _0:bool; + var _1:bool; + + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + i <@ index (x, y); + z <@ keccakRhoOffsets (i); + (aux_1, aux_0, aux_2) <- x86_ROL_64 a.[i] (W8.of_int z); + _0 <- aux_1; + _1 <- aux_0; + a.[i] <- aux_2; + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc keccakP1600_round (state:W64.t Array25.t, c:W64.t) : W64.t Array25.t = { + state <@ theta (state); + state <@ rho (state); + state <@ pi (state); + state <@ chi (state); + state <@ iota_0 (state, c); + return (state); + } + + proc __keccak_f1600_ref (state:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var constants:W64.t Array24.t; + var round:int; + round <- 0; + constants <@ keccakRoundConstants (); + while (round < 24) { + state <@ keccakP1600_round (state, constants.[round]); + round <- round + 1; + } + return (state); + } + +}. + +lemma ref_reftable : + equiv [ Mrefop.__keccak_f1600_ref ~ Mreftable.__keccak_f1600_ref : + ={arg,Glob.mem} ==> ={res,Glob.mem} ]. +proc. + +seq 3 2 : (#pre /\ ={constants} /\ ={round}); first by inline*; auto => />. + +while (#post /\ ={round,constants}); last by inline *; auto => />. + +wp. +call (_: true). +call (_: true); first by sim. +call (_: true); first by sim. +call (_: true); first by sim. +call (_: true). +while (#post /\ ={a,x} /\ 0 <= x{1} <= 5). +wp. +while (#post /\ ={a,x,y} /\ 0 <= x{1} <5 /\ 0 <=y{1} <= 5). +wp. +call (rhotates_table_corr). + +call(_: ={arg} /\ 0<=x{1} <5 /\ 0<=y{1} <5 ==> ={res} /\ 0 <= res{1} < 25). +by proc; inline *; auto => />;smt(). + +by auto => />;smt(). +by auto => />;smt(). +by auto => />;smt(). + +call(_:true); first by sim. +by auto => />. +by auto => />. + +qed. diff --git a/sha3/proof/impl/perm/keccak_f1600_scalar.ec b/sha3/proof/impl/perm/keccak_f1600_scalar.ec new file mode 100644 index 0000000..c0f0580 --- /dev/null +++ b/sha3/proof/impl/perm/keccak_f1600_scalar.ec @@ -0,0 +1,215 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array5 Array25. +require import WArray40 WArray200. + + + +module M = { + proc index (x:int, y:int) : int = { + + var r:int; + + r <- ((5 * (x %% 5)) + (y %% 5)); + return (r); + } + + proc keccak_rho_offsets (i:int) : int = { + var aux: int; + + var r:int; + var x:int; + var y:int; + var t:int; + var z:int; + + r <- 0; + x <- 1; + y <- 0; + t <- 0; + while (t < 24) { + if ((i = (x + (5 * y)))) { + r <- ((((t + 1) * (t + 2)) %/ 2) %% 64); + } else { + + } + z <- (((2 * x) + (3 * y)) %% 5); + x <- y; + y <- z; + t <- t + 1; + } + return (r); + } + + proc rhotates (x:int, y:int) : int = { + + var r:int; + var i:int; + + i <@ index (x, y); + r <@ keccak_rho_offsets (i); + return (r); + } + + proc rOL64 (x:W64.t, c:int) : W64.t = { + + var y:W64.t; + var _0:bool; + var _1:bool; + + if ((c = 0)) { + y <- x; + } else { + ( _0, _1, y) <- x86_ROL_64 x (W8.of_int c); + } + return (y); + } + + proc theta_sum (a:W64.t Array25.t) : W64.t Array5.t = { + var aux: int; + + var c:W64.t Array5.t; + var i:int; + var j:int; + c <- witness; + i <- 0; + while (i < 5) { + c.[i] <- a.[((5 * (0 %% 5)) + (i %% 5))]; + i <- i + 1; + } + j <- 1; + while (j < 5) { + i <- 0; + while (i < 5) { + c.[i] <- (c.[i] `^` a.[((5 * (j %% 5)) + (i %% 5))]); + i <- i + 1; + } + j <- j + 1; + } + return (c); + } + + proc theta_rol (c:W64.t Array5.t) : W64.t Array5.t = { + var aux_1: bool; + var aux_0: bool; + var aux: int; + var aux_2: W64.t; + + var d:W64.t Array5.t; + var i:int; + var _0:bool; + var _1:bool; + d <- witness; + i <- 0; + while (i < 5) { + d.[i] <- c.[((i + 1) %% 5)]; + (aux_1, aux_0, aux_2) <- x86_ROL_64 d.[i] (W8.of_int 1); + _0 <- aux_1; + _1 <- aux_0; + d.[i] <- aux_2; + d.[i] <- (d.[i] `^` c.[((i + 4) %% 5)]); + i <- i + 1; + } + return (d); + } + + proc rol_sum (d:W64.t Array5.t, a:W64.t Array25.t, offset:int) : W64.t Array5.t = { + var aux: int; + + var c:W64.t Array5.t; + var j:int; + var j1:int; + var k:int; + var t:W64.t; + c <- witness; + j <- 0; + while (j < 5) { + j1 <- ((j + offset) %% 5); + k <@ rhotates (j, j1); + t <- a.[((5 * (j %% 5)) + (j1 %% 5))]; + t <- (t `^` d.[j1]); + t <@ rOL64 (t, k); + c.[j] <- t; + j <- j + 1; + } + return (c); + } + + proc set_row (r:W64.t Array25.t, row:int, c:W64.t Array5.t, iota_0:W64.t) : + W64.t Array25.t = { + var aux: int; + + var j:int; + var j1:int; + var j2:int; + var t:W64.t; + + j <- 0; + while (j < 5) { + j1 <- ((j + 1) %% 5); + j2 <- ((j + 2) %% 5); + t <- ((invw c.[j1]) `&` c.[j2]); + if (((row = 0) /\ (j = 0))) { + t <- (t `^` iota_0); + } else { + + } + t <- (t `^` c.[j]); + r.[((5 * (row %% 5)) + (j %% 5))] <- t; + j <- j + 1; + } + return (r); + } + + proc round2x (a:W64.t Array25.t, r:W64.t Array25.t, iotas:W64.t, o:int) : + W64.t Array25.t * W64.t Array25.t = { + + var iota_0:W64.t; + var c:W64.t Array5.t; + var d:W64.t Array5.t; + c <- witness; + d <- witness; + iota_0 <- (loadW64 Glob.mem (W64.to_uint (iotas + (W64.of_int o)))); + c <@ theta_sum (a); + d <@ theta_rol (c); + c <@ rol_sum (d, a, 0); + r <@ set_row (r, 0, c, iota_0); + c <@ rol_sum (d, a, 3); + r <@ set_row (r, 1, c, iota_0); + c <@ rol_sum (d, a, 1); + r <@ set_row (r, 2, c, iota_0); + c <@ rol_sum (d, a, 4); + r <@ set_row (r, 3, c, iota_0); + c <@ rol_sum (d, a, 2); + r <@ set_row (r, 4, c, iota_0); + return (a, r); + } + + proc __keccak_f1600_scalar (a:W64.t Array25.t, iotas:W64.t) : W64.t Array25.t * + W64.t = { + + var zf:bool; + var r:W64.t Array25.t; + var _0:bool; + var _1:bool; + var _2:bool; + var _3:bool; + r <- witness; + (a, r) <@ round2x (a, r, iotas, 0); + (r, a) <@ round2x (r, a, iotas, 8); + iotas <- (iotas + (W64.of_int 16)); + ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + while ((! zf)) { + (a, r) <@ round2x (a, r, iotas, 0); + (r, a) <@ round2x (r, a, iotas, 8); + iotas <- (iotas + (W64.of_int 16)); + ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + } + iotas <- (iotas - (W64.of_int 192)); + return (a, iotas); + } +}. + diff --git a/sha3/proof/impl/perm/keccak_f1600_scalar_table.ec b/sha3/proof/impl/perm/keccak_f1600_scalar_table.ec new file mode 100644 index 0000000..a2a99aa --- /dev/null +++ b/sha3/proof/impl/perm/keccak_f1600_scalar_table.ec @@ -0,0 +1,565 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array5 Array24 Array25. +require import WArray40 WArray200. + +require import Keccak_f1600_ref_table. +require import Keccak_f1600_ref_loop2. +require import Keccak_f1600_scalar. +require import Keccak_f1600_ref_op. + +module Mscalarrho = { + include M [-keccak_rho_offsets,rhotates,rol_sum,round2x,__keccak_f1600_scalar] + include RhotatesAlgo + + proc rhotates (x:int, y:int) : int = { + + var r:int; + var i:int; + + i <@ index (x, y); + r <@ keccakRhoOffsets (i); + return (r); + } + + proc rol_sum (_D:W64.t Array5.t, _A:W64.t Array25.t, offset:int) : W64.t Array5.t = { + var aux: int; + + var _C:W64.t Array5.t; + var j:int; + var j1:int; + var k:int; + var t:W64.t; + _C <- witness; + j <- 0; + while (j < 5) { + j1 <- ((j + offset) %% 5); + k <@ rhotates (j, j1); + t <- _A.[((5 * (j %% 5)) + (j1 %% 5))]; + t <- (t `^` _D.[j1]); + t <@ rOL64 (t, k); + _C.[j] <- t; + j <- j + 1; + } + return (_C); + } + + + proc round2x (_A:W64.t Array25.t, _R:W64.t Array25.t, iotas:W64.t, o:int) : + W64.t Array25.t * W64.t Array25.t = { + + var iota_0:W64.t; + var _C:W64.t Array5.t; + var _D:W64.t Array5.t; + _C <- witness; + _D <- witness; + iota_0 <- (loadW64 Glob.mem (W64.to_uint (iotas + (W64.of_int o)))); + _C <@ theta_sum (_A); + _D <@ theta_rol (_C); + _C <@ rol_sum (_D, _A, 0); + _R <@ set_row (_R, 0, _C, iota_0); + _C <@ rol_sum (_D, _A, 3); + _R <@ set_row (_R, 1, _C, iota_0); + _C <@ rol_sum (_D, _A, 1); + _R <@ set_row (_R, 2, _C, iota_0); + _C <@ rol_sum (_D, _A, 4); + _R <@ set_row (_R, 3, _C, iota_0); + _C <@ rol_sum (_D, _A, 2); + _R <@ set_row (_R, 4, _C, iota_0); + return (_A, _R); + } + + proc keccak_f (_A:W64.t Array25.t, iotas:W64.t) : W64.t Array25.t * W64.t = { + + var zf:bool; + var _R:W64.t Array25.t; + var _0:bool; + var _1:bool; + var _2:bool; + var _3:bool; + _R <- witness; + (_A, _R) <@ round2x (_A, _R, iotas, 0); + (_R, _A) <@ round2x (_R, _A, iotas, 8); + iotas <- (iotas + (W64.of_int 16)); + ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + while ((! zf)) { + (_A, _R) <@ round2x (_A, _R, iotas, 0); + (_R, _A) <@ round2x (_R, _A, iotas, 8); + iotas <- (iotas + (W64.of_int 16)); + ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + } + iotas <- (iotas - (W64.of_int 192)); + return (_A, iotas); + } +}. + +equiv scalarrhom : + M.__keccak_f1600_scalar ~ Mscalarrho.keccak_f : + ={Glob.mem,arg} ==> ={Glob.mem,res} by sim. + +module Mscalartable = { + include M [-keccak_rho_offsets,rhotates,rol_sum,round2x,__keccak_f1600_scalar] + include RhotatesTable + + proc rhotates (x:int, y:int) : int = { + + var r:int; + var i:int; + + i <@ index (x, y); + r <@ keccakRhoOffsets (i); + return (r); + } + + proc rol_sum (_D:W64.t Array5.t, _A:W64.t Array25.t, offset:int) : W64.t Array5.t = { + var aux: int; + + var _C:W64.t Array5.t; + var j:int; + var j1:int; + var k:int; + var t:W64.t; + _C <- witness; + j <- 0; + while (j < 5) { + j1 <- ((j + offset) %% 5); + k <@ rhotates (j, j1); + t <- _A.[((5 * (j %% 5)) + (j1 %% 5))]; + t <- (t `^` _D.[j1]); + t <@ rOL64 (t, k); + _C.[j] <- t; + j <- j + 1; + } + return (_C); + } + + + proc round2x (_A:W64.t Array25.t, _R:W64.t Array25.t, iotas:W64.t, o:int) : + W64.t Array25.t * W64.t Array25.t = { + + var iota_0:W64.t; + var _C:W64.t Array5.t; + var _D:W64.t Array5.t; + _C <- witness; + _D <- witness; + iota_0 <- (loadW64 Glob.mem (W64.to_uint (iotas + (W64.of_int o)))); + _C <@ theta_sum (_A); + _D <@ theta_rol (_C); + _C <@ rol_sum (_D, _A, 0); + _R <@ set_row (_R, 0, _C, iota_0); + _C <@ rol_sum (_D, _A, 3); + _R <@ set_row (_R, 1, _C, iota_0); + _C <@ rol_sum (_D, _A, 1); + _R <@ set_row (_R, 2, _C, iota_0); + _C <@ rol_sum (_D, _A, 4); + _R <@ set_row (_R, 3, _C, iota_0); + _C <@ rol_sum (_D, _A, 2); + _R <@ set_row (_R, 4, _C, iota_0); + return (_A, _R); + } + + proc keccak_f (_A:W64.t Array25.t, iotas:W64.t) : W64.t Array25.t * W64.t = { + + var zf:bool; + var _R:W64.t Array25.t; + var _0:bool; + var _1:bool; + var _2:bool; + var _3:bool; + _R <- witness; + (_A, _R) <@ round2x (_A, _R, iotas, 0); + (_R, _A) <@ round2x (_R, _A, iotas, 8); + iotas <- (iotas + (W64.of_int 16)); + ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + while ((! zf)) { + (_A, _R) <@ round2x (_A, _R, iotas, 0); + (_R, _A) <@ round2x (_R, _A, iotas, 8); + iotas <- (iotas + (W64.of_int 16)); + ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + } + iotas <- (iotas - (W64.of_int 192)); + return (_A, iotas); + } +}. + +equiv rol_sum : + Mscalarrho.rol_sum ~ Mscalartable.rol_sum : + ={arg} /\ 0 <= offset{1} < 5 ==> ={res}. +proc. +while (={j,_C,_A,_D,offset} /\ 0 <= j{1} <= 5 /\ 0 <= offset{1} < 5). +wp. +call (_:true); first by sim. +inline Mscalartable.rhotates Mscalarrho.rhotates. +wp. +call(rhotates_table_corr). +call (_: ={arg} /\ 0 <= x{1} < 5 /\ 0<=y{1} <5 ==> ={res} /\ 0<= res{1} <25). +proc. by auto => />;smt(). +by auto => />; smt(). +by auto => />; smt(). +qed. + + +equiv round2x : + Mscalarrho.round2x ~ Mscalartable.round2x : + ={Glob.mem,arg} ==> ={Glob.mem,res}. +proc. +do 5! (call (_:true); [by sim | call rol_sum]). +do 2! (call (_:true); first by sim). +by auto => />. +qed. + +equiv scalartable : + Mscalarrho.keccak_f ~ Mscalartable.keccak_f : + ={Glob.mem,arg} ==> ={Glob.mem,res}. +proc. +wp. +while (={Glob.mem,zf,_A,_R,iotas}). ++ by wp; do 2! call round2x; auto. +by wp; do 2! call round2x; auto. +qed. + +op good_iotas (mem : global_mem_t, _iotas : int) = + forall off, 0 <= off < 24 => + loadW64 mem (_iotas + (off * 8)) = iotas.[off]. + +lemma testsem : (forall (x : W64.t), (x86_TEST_8 (truncateu8 x) (W8.of_int 255)).`5 <=> (W64.to_uint x %% 256 = 0)). +move => *. +rewrite /x86_TEST_8 /rflags_of_bwop8 /truncateu8 /ZF_of_w8 /=. +have -> : W8.of_int 255 = W8.onew by rewrite oneE. +rewrite W8.andw1; split => h. ++ by rewrite (_ : 0 = to_uint W8.zero) 1:// -h W8.of_uintK. +by apply W8.to_uintRL; rewrite -h W8.of_uintK. +qed. + +lemma rol0 : (forall x , (x86_ROL_64 x (W8.of_int (rhotates 0))).`3 = x). +move => *. +rewrite x86_ROL_64_E /rhotates rol_xor =>/>. +exact/Ops.lsr_0. +qed. + +lemma rol00 : (forall x , (x86_ROL_64 x (W8.zero)).`3 = x). +move => *. +rewrite x86_ROL_64_E /rhotates rol_xor =>/>. +exact/Ops.lsr_0. +qed. + +lemma scalarcorr _iotas mem : + equiv [ Mrefloop2.__keccak_f1600_ref ~ Mscalartable.keccak_f : + 0 <= _iotas < W64.modulus - 24 * 8 /\ + good_iotas mem _iotas /\ (_iotas - 8*8) %% 256 = 0 /\ + mem = Glob.mem{2} /\ to_uint iotas{2} = _iotas /\ + state{1} = _A{2} ==> mem = Glob.mem{2} /\ to_uint res{2}.`2 = _iotas /\ + res{1} = res{2}.`1 ]. +proc. +seq 2 1 : (#pre /\ constants{1} = iotas); first by inline *;auto => />. + +seq 1 0 : (#{/~iotas{2}}pre /\ + _iotas = to_uint iotas{2} - round{1} * 8 /\ + round{1} = 0 /\ + state{1} = _A{2}); first by auto => />. + +seq 4 3: (#{/~round{1} = 0}pre /\ round{1} = 2). + +inline Mreftable.keccakP1600_round Mscalartable.round2x. + +swap {2}[5..6] -4. seq 0 2 : #pre; first by auto => />. + +swap {1} 2 -1. +swap {2} [3..5] -2. + +seq 1 3 : (#pre /\ iota_0{2} = c{1}). +inline *;wp;skip; rewrite /good_iotas /iotas; auto => />. +move => &2 bound1 bound2 Tass. +progress. +by move : (Tass 0) => //=. + +sp. +inline Mreftable.theta. +seq 7 2 : (#pre /\ a{1}=state0{1} /\ d{1} = _D{2}). +inline *. +sp 3 2. +seq 2 6 : (#{/~c1{1}}{~c{2}}pre /\ c1{1} = c0{2}). +do 6!(unroll for {1} ^while). +do 6!(unroll for {2} ^while). +auto => />. +progress. +apply (Array5.ext_eq). +move => *. +case (x = 0); first by auto => />;smt( @W64). +case (x = 1); first by auto => />;smt( @W64). +case (x = 2); first by auto => />;smt( @W64). +case (x = 3); first by auto => />;smt( @W64). +case (x = 4); first by auto => />;smt( @W64). +smt(). + +sp 0 1;wp. + +unroll for {1} 2. +unroll for {2} 2. +by auto => />. + +seq 8 11 : (#{/~state{1}}{~state0{1}}{~_A0{2}}{~_R0{2}}pre /\ state{1} = _R{2}). +inline *. +do 30!(unroll for {1} ^while). +do 10!(unroll for {2} ^while). + +do !((rcondt {2} ^if; first by move => *; wp;skip;auto => />) || + (rcondf {2} ^if; first by move => *; wp;skip;auto => />)). + +wp;skip. +move => &1 &2 /> h1 h2 h3 h4. +apply Array25.all_eq_eq; cbv delta. +smt(rol0 rol00 @W64). + +(* Second round *) + +swap {2}[5..6] -4. seq 0 2 : #pre; first by auto => />. + +swap {1} 3 -1. +swap {2} [3..5] -2. + +seq 2 3 : (#{/~round{1}}pre /\ + round{1} = 1 /\ + (round{1} - 1) * 8 + _iotas = to_uint iotas{2} + /\ iota_00{2} = c0{1}). + +inline *;wp;skip; rewrite /good_iotas /iotas; auto => />. +move => &2 bound1 bound2 Tass. +move : (Tass 1) => //=. +rewrite (_ : to_uint (iotas{2} + (of_int 8)%W64) = to_uint iotas{2} + 8). rewrite to_uintD. smt(@W64). by trivial. + +seq 8 4 : (#pre /\ a0{1}=state{1} /\ d0{1} = _D0{2} /\ _A1{2} = a0{1}). +inline *; sp 4 4. +seq 2 6 : (#{/~c2{1}}{~c{2}}pre /\ c2{1} = c0{2}). +do 6!(unroll for {1} ^while). +do 6!(unroll for {2} ^while). +auto => /> &2 ????. +by apply Array5.all_eq_eq; cbv delta. + +sp 0 1;wp. + +unroll for {1} 2. +unroll for {2} 2. +by auto => />. + +seq 8 11 : (#{/~state{1}}{~_A1{2}}pre /\ state{1} = _A{2}). +inline *. +do 30!(unroll for {1} ^while). +do 10!(unroll for {2} ^while). + +do !((rcondt {2} ^if; first by move => *; wp;skip;auto => />) || + (rcondf {2} ^if; first by move => *; wp;skip;auto => />)). + +wp;skip => />. +move => &1 &2 /> h1 h2 h3 h4. +apply Array25.all_eq_eq; cbv delta. +smt(rol0 rol00 @W64). + +auto => />. +rewrite to_uintD. +by smt(@W64). + +(* Main loop *) + +seq 0 1 : (#{/~round{1} = 2}pre /\ 0 < round{1} <= 24 /\ round{1} %% 2 = 0 /\ + zf{2} = (x86_TEST_8 (truncateu8 iotas{2}) ((of_int 255))%W8).`5); first by auto => />. +wp. +while (#pre). +wp. + +inline Mreftable.keccakP1600_round Mscalartable.round2x. + +swap {2}[5..6] -4. seq 0 2 : #pre; first by auto => />. + +swap {1} 2 -1. +swap {2} [3..5] -2. + +seq 1 3 : (#pre /\ iota_0{2} = c{1}). +inline *;wp;skip; rewrite /good_iotas /iotas; auto => />. +move => &1 &2 bound1 bound2 Tass. +progress. +move : (Tass round{1}) => //=. +rewrite (_: to_uint iotas{2} - round{1} * 8 + round{1} * 8 = to_uint iotas{2}); first by ring. +smt(). + +inline Mreftable.theta. +seq 8 4 : (#pre /\ a{1}=state0{1} /\ state0{1} = state{1} /\ d{1} = _D{2} /\ _A0{2} = _A{2}). +inline *. +sp 3 2. +seq 3 8 : (#{/~c1{1}}{~c{2}}pre /\ c1{1} = c0{2}). +do 6!(unroll for {1} ^while). +do 6!(unroll for {2} ^while). +auto => />. +progress. +apply (Array5.ext_eq). +move => *. +case (x1 = 0); first by auto => />;smt( @W64). +case (x1 = 1); first by auto => />;smt( @W64). +case (x1 = 2); first by auto => />;smt( @W64). +case (x1 = 3); first by auto => />;smt( @W64). +case (x1 = 4); first by auto => />;smt( @W64). +smt(). + +sp 0 1;wp. + +unroll for {1} 2. +unroll for {2} 2. +auto => />. +move => *. +apply Array5.ext_eq. +move => *. +case (x1 = 0); first by auto => />;smt( @W64). +case (x1 = 1); first by auto => />;smt( @W64). +case (x1 = 2); first by auto => />;smt( @W64). +case (x1 = 3); first by auto => />;smt( @W64). +case (x1 = 4); first by auto => />;smt( @W64). +smt(). + +seq 8 11 : (#{/~state{1}}{~state0{1}}{~_A0{2}}{~_R0{2}}pre /\ state{1} = _R{2}). +inline *. +do 30!(unroll for {1} ^while). +do 10!(unroll for {2} ^while). + +do !((rcondt {2} ^if; first by move => *; wp;skip;auto => />) || + (rcondf {2} ^if; first by move => *; wp;skip;auto => />)). +wp;skip; move => &1 &2 /> h1 h2 h3 h4 ?????; +apply Array25.all_eq_eq; cbv delta. +smt(rol0 rol00 @W64). + +(* Second round *) + +swap {2}[5..6] -4. seq 0 2 : #pre; first by auto => />. +swap {1} 2 -1. +swap {2} [3..5] -2. + +seq 1 3 : (#pre /\ iota_00{2} = c0{1}). +inline *;wp;skip; rewrite /good_iotas /iotas; auto => />. +move => &1 &2 bound1 bound2 Tass. +progress. +move : (Tass (round{1} + 1)) => //=. +rewrite (_: to_uint iotas{2} - round{1} * 8 + (round{1} + 1) * 8 = to_uint (iotas{2} + (of_int 8)%W64)). +rewrite to_uintD. +have bb : (to_uint iotas{2} + to_uint ((of_int 8))%W64 < W64.modulus). +smt(). +smt(@W64). +smt(). + +seq 8 4 : (#pre /\ a0{1}=state{1} /\ d0{1} = _D0{2} /\ _A1{2} = a0{1}). +inline *; sp 4 4. +seq 2 6 : (#{/~c2{1}}{~c{2}}pre /\ c2{1} = c0{2}). +do 6!(unroll for {1} ^while). +do 6!(unroll for {2} ^while). +auto => />. +progress. +apply (Array5.ext_eq). +move => *. +case (x1 = 0); first by auto => />;smt( @W64). +case (x1 = 1); first by auto => />;smt( @W64). +case (x1 = 2); first by auto => />;smt( @W64). +case (x1 = 3); first by auto => />;smt( @W64). +case (x1 = 4); first by auto => />;smt( @W64). +smt(). + +sp 0 1;wp. + +unroll for {1} 2. +unroll for {2} 2. +by auto => />. + +seq 8 11 : (#{/~state{1}}{~_A1{2}}pre /\ state{1} = _A{2}). +inline *. +do 30!(unroll for {1} ^while). +do 10!(unroll for {2} ^while). + +do !((rcondt {2} ^if; first by move => *; wp;skip;auto => />) || + (rcondf {2} ^if; first by move => *; wp;skip;auto => />)). +wp;skip; move => &1 &2 /> h1 h2 h3 h4 ?????; +apply Array25.all_eq_eq; cbv delta. +smt(rol0 rol00 @W64). + +auto => />. + +progress. +rewrite to_uintD;smt(). +smt(). smt(). smt(). +rewrite (testsem (iotas{2} + (of_int 16)%W64)). +rewrite to_uintD. +rewrite (_ : (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% W64.modulus %% 256 = (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% 256). smt(@W64). smt(). + +move : H8. +rewrite testsem. +rewrite to_uintD. +rewrite (_ : (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% W64.modulus %% 256 = (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% 256). smt(@W64). smt(). + +auto => />. +progress. +rewrite (testsem (iotas{2}));smt(). +move : H6. +rewrite testsem;smt(). + +move : H12. +rewrite testsem => //= *. +move : H8; rewrite (_ : round_L = 24); first by smt(). +move => *. +have ir : (to_uint iotas{2} - round{1} * 8 + 24*8) %% 256 = 0. smt(). +rewrite (_ : iotas_R = W64.of_int (to_uint iotas{2} - round{1} * 8 + 24*8)). +smt(@W64). +smt(@W64 @W8). +qed. + +require Keccak_f1600_ref_op. +require Keccak_f1600_ref. + +lemma scalarcorr_op _iotas mem : + equiv [ Keccak_f1600_ref.M.__keccak_f1600_ref ~ Keccak_f1600_scalar.M.__keccak_f1600_scalar : + 0 <= _iotas < W64.modulus - 24 * 8 /\ + good_iotas mem _iotas /\ (_iotas - 8*8) %% 256 = 0 /\ ={Glob.mem} /\ + mem = Glob.mem{2} /\ to_uint iotas{2} = _iotas /\ + state{1} = a{2} ==> mem = Glob.mem{2} /\ to_uint res{2}.`2 = _iotas /\ + res{1} = res{2}.`1 ]. +proof. +transitivity Mrefloop2.__keccak_f1600_ref + (={state, Glob.mem} ==> ={res, Glob.mem}) + ( 0 <= _iotas < W64.modulus - 24 * 8 /\ + good_iotas mem _iotas /\ + (_iotas - 8 * 8) %% 256 = 0 /\ ={Glob.mem} /\ mem = Glob.mem{2} /\ to_uint iotas{2} = _iotas /\ state{1} = a{2} + ==> + mem = Glob.mem{2} /\ to_uint res{2}.`2 = _iotas /\ res{1} = res{2}.`1) => //. ++ smt(). ++ transitivity Mrefop.__keccak_f1600_ref + ( ={Glob.mem, state} ==> ={Glob.mem, res}) + (={state, Glob.mem} ==> ={res, Glob.mem}) => //. + + smt(). + by apply Keccak_f1600_ref_op.ref_refop. + transitivity Mreftable.__keccak_f1600_ref + ( ={state, Glob.mem} ==> ={res, Glob.mem}) + ( ={state, Glob.mem} ==> ={res, Glob.mem}) => //. + + smt(). + by apply Keccak_f1600_ref_table.ref_reftable. + transitivity Mrefloop.__keccak_f1600_ref + ( ={state, Glob.mem} ==> ={res, Glob.mem}) + ( ={state, Glob.mem} ==> ={res, Glob.mem}) => //. + + smt(). + by apply reftable_refloop. + transitivity Mrefloopk.__keccak_f1600_ref + ( ={state, Glob.mem} ==> ={res, Glob.mem}) + ( ={state, Glob.mem} ==> ={res, Glob.mem}) => //. + + smt(). + by apply refloop_refloopk. + by apply refloopk_refloop2 => *. +transitivity Mscalartable.keccak_f + ( 0 <= _iotas < W64.modulus - 24 * 8 /\ + good_iotas mem _iotas /\ + (_iotas - 8 * 8) %% 256 = 0 /\ mem = Glob.mem{2} /\ to_uint iotas{2} = _iotas /\ state{1} = _A{2} + ==> + mem = Glob.mem{2} /\ to_uint res{2}.`2 = _iotas /\ res{1} = res{2}.`1) + ( ={Glob.mem, arg} ==> ={Glob.mem, res}) => //. ++ smt (). + by apply (scalarcorr _iotas mem). +symmetry. +transitivity Mscalarrho.keccak_f + ( ={Glob.mem, arg} ==> ={Glob.mem, res}) + ( ={Glob.mem, arg} ==> ={Glob.mem, res}) => //. ++ smt(). + by apply scalarrhom. +by apply scalartable. +qed. diff --git a/sha3/proof/smart_counter/ConcreteF.eca b/sha3/proof/smart_counter/ConcreteF.eca new file mode 100644 index 0000000..5c510f2 --- /dev/null +++ b/sha3/proof/smart_counter/ConcreteF.eca @@ -0,0 +1,442 @@ +require import Core Int Real StdOrder Ring Distr. +require import List FSet SmtMap Common SLCommon DProd Dexcepted. + +(*...*) import Capacity IntID IntOrder RealOrder. + +require (*..*) Strong_RP_RF. + +module PF = { + var m, mi: (state,state) fmap + + proc init(): unit = { + m <- empty; + mi <- empty; + } + + proc f(x : state): state = { + var y1, y2; + + if (x \notin m) { + y1 <$ bdistr; + y2 <$ cdistr; + m.[x] <- (y1,y2); + mi.[(y1,y2)] <- x; + } + return oget m.[x]; + } + + proc fi(x : state): state = { + var y1, y2; + + if (x \notin mi) { + y1 <$ bdistr; + y2 <$ cdistr; + mi.[x] <- (y1,y2); + m.[(y1,y2)] <- x; + } + return oget mi.[x]; + } + +}. + +module CF(D:DISTINGUISHER) = Indif(SqueezelessSponge(PF), PF, D). + +section. + declare module D <: DISTINGUISHER {-Perm, -C, -PF, -Redo}. + + declare axiom D_ll (F <: DFUNCTIONALITY{-D}) (P <: DPRIMITIVE{-D}): + islossless P.f => islossless P.fi => islossless F.f => + islossless D(F, P).distinguish. + + local module GReal' = Indif(FC(SqueezelessSponge(Perm)), PC(Perm), D). + + local clone import Strong_RP_RF as Switching with + type D <- state, + op uD <- dstate, + type K <- unit, + op dK <- (MUnit.dunit<:unit> tt), + op q <- max_size + proof *. + realize ge0_q by smt w=max_ge0. + realize uD_uf_fu. + split. + case=> [x y]; rewrite supp_dprod /=. + rewrite Block.DBlock.supp_dunifin Capacity.DCapacity.supp_dunifin/=. + smt(dprod1E Block.DBlock.dunifin_funi Capacity.DCapacity.dunifin_funi). + split. + smt(dprod_ll Block.DBlock.dunifin_ll Capacity.DCapacity.dunifin_ll). + apply/dprod_fu. + rewrite Block.DBlock.dunifin_fu. + by rewrite Capacity.DCapacity.dunifin_fu. + qed. + realize dK_ll. + by rewrite /is_lossless MUnit.dunit_ll. + qed. + + (* TODO move this *) + lemma size_behead (l : 'a list) : l <> [] => size (behead l) = size l - 1. + proof. by case l=> // ?? /=; ring. qed. + + local module (D': PRPSec.Distinguisher) (P' : PRPSec.SPRP_Oracles) = { + proc distinguish () : bool = { + var b : bool; + Redo.init(); + b <@ DRestr(D, SqueezelessSponge(P'), P').distinguish(); + return b;} + }. + + local lemma DoubleBounding (P <: PRPSec.PRP {-D, -C, -DBounder, -Redo}) &m: + Pr[PRPSec.IND(P,D').main() @ &m: res] + = Pr[PRPSec.IND(P,DBounder(D')).main() @ &m: res]. + proof. + byequiv=> //=; proc; inline *. + wp. + call (_: ={glob C, glob P, glob Redo} + /\ all_prefixes Redo.prefixes{2} + /\ Redo.prefixes{2}.[[]] = Some (b0,c0) + /\ (forall x, x \in C.queries{2} => x \in Redo.prefixes{2}) + /\ prefix_inv C.queries{2} Redo.prefixes{2} + /\ DBounder.FBounder.c{2} = C.c{2}). + + proc; sp; if=> //=; inline *. + rcondt{2} 3; 1: by auto=> /#. + by wp; call (_: true); auto. + + proc; sp; if=> //=; inline *. + rcondt{2} 3; 1: by auto=> /#. + by wp; call (_: true); auto. + + proc; sp; if=> //=; inline *;1:if;auto. + + splitwhile{1}5:take (i+1) p \in Redo.prefixes. + splitwhile{2}5:take (i+1) p \in Redo.prefixes. + + alias{1}1 pref = Redo.prefixes;alias{2}1 pref = Redo.prefixes;sp 1 1=>/=. + alias{1}1 query = C.queries;alias{2}1 query = C.queries;sp 1 1=>/=. + conseq(:_==> ={sa, Redo.prefixes, glob P, i, C.c} + /\ all_prefixes Redo.prefixes{2} + /\ (forall x, x \in query{2} => x \in Redo.prefixes{2}) + /\ i{1} = size bs{1} + /\ Redo.prefixes{1}.[take i{1} bs{1}] = Some (sa{1},sc{1}) + /\ (forall y, y \in pref{1} => pref{1}.[y] = Redo.prefixes{1}.[y]) + /\ (forall y, y \in Redo.prefixes{1} <=> (y \in pref{1} \/ + (exists j, 0 <= j <= i{1} /\ y = take j bs{1}))) + /\ DBounder.FBounder.c{2} = C.c{2} - size bs{1} + i{1}). + + auto=> />; progress. + + smt(domE mem_set get_setE take_size cat_take_drop). + + smt(domE mem_set get_setE take_size cat_take_drop). + + smt(domE mem_set get_setE take_size cat_take_drop). + + smt(domE mem_set get_setE take_size cat_take_drop). + + by move: H15=> /H11 []; smt(domE mem_set get_setE take_size cat_take_drop). + smt(domE mem_set get_setE take_size cat_take_drop). + while( ={sa, Redo.prefixes, glob P, i, C.c, p, sc} /\ p{1} = bs{1} + /\ all_prefixes Redo.prefixes{2} + /\ Redo.prefixes{2}.[[]] = Some (b0, c0) + /\ (forall x, x \in query{2} => x \in Redo.prefixes{2}) + /\ (i{1} < size p{1} => ! take (i{1} + 1) p{1} \in Redo.prefixes{1}) + /\ 0 <= prefix bs{1} (get_max_prefix bs{1} (elems (fdom C.queries{1}))) <= i{1} <= size bs{1} + /\ C.c{1} <= max_size + /\ Redo.prefixes{1}.[take i{1} bs{1}] = Some (sa{1},sc{1}) + /\ (forall y, y \in pref{1} => pref{1}.[y] = Redo.prefixes{1}.[y]) + /\ (forall y, y \in Redo.prefixes{1} <=> (y \in pref{1} \/ + (exists j, 0 <= j <= i{1} /\ y = take j bs{1}))) + /\ DBounder.FBounder.c{2} = C.c{2} - size bs{1} + i{1}). + + if; auto; 1:smt(domE). + sp;rcondt{2}1;1:auto=>/#;auto;1:call(:true);auto;progress. + * move=>x;rewrite mem_set=>[][|-> j]; 1:smt(mem_set). + case(0 <= j)=>hj0;last first. + + by rewrite (@take_le0 j)1:/# domE get_setE H0 /#. + by rewrite take_take /min; case: (j < i{2} + 1); rewrite mem_set //= /#. + * smt(mem_set take_take domE get_setE oget_some). + * smt(mem_set take_take domE get_setE oget_some). + * rewrite mem_set negb_or H9 negb_or/=negb_exists/=. + have htake:take (i{2} + 1) bs{1} = take (i{2} + 1) (take (i{2} + 1 + 1) bs{1}); + smt(take_take size_take). + * rewrite/#. + * rewrite/#. + * smt(mem_set take_take domE get_setE oget_some). + * smt(mem_set take_take domE get_setE oget_some). + * smt(mem_set take_take domE get_setE oget_some). + * smt(mem_set take_take domE get_setE oget_some). + * smt(mem_set take_take domE get_setE oget_some). + sp; + conseq(:_==> ={sa, Redo.prefixes, glob P, i, C.c, p, sc, bs} /\ p{1} = bs{1} + /\ Redo.prefixes{2} = pref{2} + /\ (forall x, x \in query{2} => x \in Redo.prefixes{2}) + /\ C.c{1} <= max_size + /\ i{1} = prefix bs{1} (get_max_prefix bs{1} (elems (fdom C.queries{1}))) + /\ Redo.prefixes{1}.[take i{1} bs{1}] = Some (sa{1},sc{1}) + /\ DBounder.FBounder.c{2} = C.c{2} - size bs{1} + + prefix bs{1} (get_max_prefix bs{1} (elems (fdom C.queries{1}))))=> />. + progress. + + rewrite -negP. + move: H9; rewrite (prefix_exchange _ Redo.prefixes{2} _)=> //= H9. + by rewrite -mem_fdom memE; apply/prefix_lt_size=> /#. + + exact/prefix_ge0. + + exact/prefix_sizel. + + case: H9=> //= - [j] [#] H42 H72. + have ->: j = min j (prefix bs{2} (get_max_prefix bs{2} (elems (fdom C.queries{2})))) by smt(). + rewrite -(take_take bs{2} j (prefix bs{2} (get_max_prefix bs{2} (elems (fdom C.queries{2}))))). + by move=> ->; rewrite H domE //= H8. + + smt(). + alias{2} 1 k = DBounder.FBounder.c;sp; + conseq(:_==> ={sa, Redo.prefixes, glob P, i, C.c, p, sc, bs} /\ p{1} = bs{1} + /\ Redo.prefixes{2} = pref{2} + /\ (forall x, x \in query{2} => x \in Redo.prefixes{2}) + /\ C.c{2} <= max_size + /\ i{1} = prefix bs{1} (get_max_prefix bs{1} (elems (fdom C.queries{1}))) + /\ Redo.prefixes{1}.[take i{1} bs{1}] = Some (sa{1},sc{1}) + /\ DBounder.FBounder.c{2} = k{2});1:progress=>/#. + while( ={sa, Redo.prefixes, glob P, i, C.c, p, sc, bs, C.queries} /\ p{1} = bs{1} + /\ Redo.prefixes{2} = pref{2} + /\ (forall x, x \in query{2} => x \in Redo.prefixes{2}) + /\ prefix_inv C.queries{2} Redo.prefixes{2} + /\ all_prefixes Redo.prefixes{2} + /\ C.c{2} <= max_size + /\ 0 <= i{1} <= prefix bs{1} (get_max_prefix bs{1} (elems (fdom C.queries{1}))) + /\ (forall j, 0 <= j <= prefix bs{1} (get_max_prefix bs{1} (elems (fdom C.queries{1}))) + => take j bs{2} \in Redo.prefixes{1}) + /\ Redo.prefixes{1}.[take i{1} bs{1}] = Some (sa{1},sc{1}) + /\ DBounder.FBounder.c{2} = k{2}). + + rcondt{1}1;2:rcondt{2}1;auto;progress. + * by smt(). + * by rewrite(@prefix_exchange _ _ bs{2} H0 H1)all_take_in//=/#. + * smt(domE). + auto;progress. smt(prefix_ge0). + + apply/take_get_max_prefix2=> //=. + + by exists []; rewrite domE H0. + by rewrite-(@prefix_exchange _ _ _ H2 H). + * smt(domE take0). + * smt(@Prefix). + auto; call(: true); auto=> />. + (** TODO: send to smt with cast into infinite maps **) + do!split. + + rewrite/all_prefixes; smt(mem_set mem_empty). + + exact/get_set_sameE. + + smt(mem_empty mem_set). + + smt(mem_empty mem_set get_setE). + move=> ?; split=> [|_]. + + smt(mem_set mem_empty). + smt(mem_empty mem_set). + qed. + + local clone import ProdSampling with + type t1 <- block, + type t2 <- capacity. + + lemma Real_Concrete &m : + Pr[GReal(D).main()@ &m: res /\ C.c <= max_size] <= + Pr[CF(DRestr(D)).main()@ &m: res] + (max_size ^ 2 - max_size)%r / 2%r * mu dstate (pred1 witness). + proof. + have ->: + Pr[RealIndif(SqueezelessSponge,PC(Perm),D).main()@ &m: + res /\ C.c <= max_size] = Pr[GReal'.main()@ &m: res/\ C.c <= max_size]. + + byequiv=>//;proc;inline *; + call (_: ={C.c, glob Perm, Redo.prefixes} + /\ prefix_inv C.queries{2} Redo.prefixes{1} + /\ Redo.prefixes{1}.[[]] = Some (b0, c0) + /\ all_prefixes Redo.prefixes{1}); + last first. + + auto;smt(mem_empty mem_set get_setE oget_some). + + by proc; inline*; sp; if; auto. + + by proc; inline*; sp; if; auto. + proc; inline *; wp; sp. + if{2};sp;wp;last first. + + conseq(:_==> sa{1} = (oget Redo.prefixes{1}.[take i{1} p{1}]).`1 + /\ i{1} = size p{1} + /\ Redo.prefixes{1}.[[]] = Some (b0, c0) + /\ ={Perm.m, Perm.mi, Redo.prefixes, C.c});1:smt(take_size). + + while{1}( ={Perm.m, Perm.mi, Redo.prefixes, C.c} + /\ p{1} \in C.queries{2} + /\ prefix_inv C.queries{2} Redo.prefixes{1} + /\ 0 <= i{1} <= size p{1} + /\ Redo.prefixes{1}.[[]] = Some (b0, c0) + /\ (sa{1},sc{1}) = oget Redo.prefixes{1}.[take i{1} p{1}] + /\ all_prefixes Redo.prefixes{1})(size p{1} - i{1}). + + auto;sp;rcondt 1;auto;smt(excepted_lossless). + by auto;smt(size_ge0 take0 take_size). + + splitwhile{1} 1 : take (i+1) p \in Redo.prefixes; + splitwhile{2} 1 : take (i+1) p \in Redo.prefixes. + + alias{1}1 pref = Redo.prefixes;alias{2}1 pref = Redo.prefixes;sp 1 1=>/=. + alias{2}1 query = C.queries;sp 0 1=>/=. + + conseq(:_==> ={sa,Perm.m,Perm.mi,Redo.prefixes,i,p} + /\ C.c{1} = C.c{2} - size p{2} + i{2} + /\ i{2} = size p{2} + /\ Redo.prefixes{2}.[take i{2} p{2}] = Some (sa{2}, sc{2}) + /\ (forall l, l \in pref{2} => pref{2}.[l] = Redo.prefixes{2}.[l]) + /\ (forall j, 0 <= j <= i{2} => take j p{2} \in Redo.prefixes{2}) + /\ (forall l, l \in Redo.prefixes{2} => + l \in pref{2} \/ (exists j, 0 <= j <= i{2} /\ l = take j p{2}))); + progress. + * by rewrite/#. + * move:H3 H7;rewrite take_size mem_set get_setE;case(bs0 = bs{2})=>//=[->|]h. + * by rewrite h oget_some/=. + * move:H=>[H []];progress. + by rewrite -H4; move: (H3 _ H9 (size bs0)); rewrite take_size //= H. + * smt(mem_set take_size oget_some get_setE domE take_oversize take_le0). + * elim: (H6 _ H10). + + elim: H=> /> _ _ /(_ bs0 i0 H9) h /h [] l2 hl2. + by exists l2; rewrite mem_set hl2. + by move=> [j] [] hj ->; exists (drop j bs{2}); rewrite cat_take_drop mem_set. + * smt(mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop). + * smt(mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop). + while(={sa,sc,Perm.m,Perm.mi,Redo.prefixes,i,p} + /\ C.c{1} = C.c{2} - size p{2} + i{2} + /\ all_prefixes Redo.prefixes{2} + /\ all_prefixes pref{2} + /\ prefix_inv C.queries{2} pref{2} + /\ prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{2}))) <= i{2} <= size p{2} + /\ Redo.prefixes{2}.[take i{2} p{2}] = Some (sa{2}, sc{2}) + /\ (forall l, l \in pref{2} => pref{2}.[l] = Redo.prefixes{2}.[l]) + /\ (forall j, 0 <= j <= i{2} => take j p{2} \in Redo.prefixes{2}) + /\ (forall l, l \in Redo.prefixes{2} => + l \in pref{2} \/ (exists j, 0 <= j <= i{2} /\ l = take j p{2}))). + + rcondf{1}1;2:rcondf{2}1;..2:auto;progress. + * have:=H7 (take (i{m0}+1) p{m0}). + case((take (i{m0} + 1) p{m0} \in Redo.prefixes{m0}))=>//=_. + rewrite negb_or negb_exists/=;progress. + + by rewrite -mem_fdom memE prefix_lt_size//=-(@prefix_exchange _ _ p{m0} H1 H0)//=/#. + case(0<=a<=i{m0})=>//=ha;smt(size_take). + * have:=H7 (take (i{hr}+1) p{hr}). + case((take (i{hr} + 1) p{hr} \in Redo.prefixes{hr}))=>//=_. + rewrite negb_or negb_exists/=;progress. + + by rewrite -mem_fdom memE prefix_lt_size//=-(@prefix_exchange _ _ p{hr} H1 H0)//=/#. + case(0<=a<=i{hr})=>//=ha;smt(size_take). + + sp;auto;if;auto;progress. + * rewrite/#. + * move=>x;rewrite mem_set=>[][|h];1: + smt(mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop). + rewrite h=>j;rewrite take_take /min. + case(j//=hij. + case: (0 <= j)=> hj //=. + + by rewrite mem_set; left; apply/H6=> /#. + rewrite mem_set (take_le0 j) 1:/#; left. + by rewrite -(take0 (take i{2} p{2})); apply/H/domE; rewrite H4. + * smt(prefix_lt_size mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop memE). + * smt(prefix_lt_size mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop memE). + * smt(prefix_lt_size mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop memE). + * rewrite!get_setE/=. + have/#: !take (i{2} + 1) p{2} \in pref{2}. + by rewrite -mem_fdom memE prefix_lt_size//=-(@prefix_exchange _ _ _ H1 H0)//=/#. + * rewrite get_set_sameE !oget_some. + have: take (i{2} + 1) p{2} \notin Redo.prefixes{2}. + + move: (H7 (take (i{2} + 1) p{2})); case: (take (i{2} + 1) p{2} \in Redo.prefixes{2})=> //= _. + rewrite negb_or negb_exists //=; split. + + rewrite -mem_fdom memE; apply/prefix_lt_size. + + by rewrite -(prefix_exchange C.queries{2}) // /#. + by rewrite -(prefix_exchange C.queries{2}) // /#. + smt(size_take). + rewrite domE=> /= H728; rewrite get_set_neqE 2:H5 //. + have /H5:= H13. + by apply/contraLR=> /= ->>; move: H13; rewrite domE H728=> ->. + * smt(prefix_lt_size mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop memE mem_fdom). + * smt(prefix_lt_size mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop memE). + * smt(). + * move=>x;rewrite mem_set =>[][|h];1: + smt(mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop). + rewrite h=>j;rewrite take_take /min. + case(j//=hij. + case(0 <= j)=> //= hj. + + by rewrite mem_set H6 /#. + rewrite (take_le0 j) 1:/# mem_set. + have:= (H (take i{2} p{2}) _ 0). + + by rewrite domE H4. + by rewrite take0=> ->. + * smt(prefix_lt_size mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop memE mem_fdom). + * smt(prefix_lt_size mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop memE mem_fdom). + * smt(prefix_lt_size mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop memE mem_fdom). + * by rewrite!get_setE. + * rewrite !get_setE//=. + have /#: !take (i{2} + 1) p{2} \in pref{2}. + by rewrite -mem_fdom memE prefix_lt_size//=-(@prefix_exchange _ _ _ H1 H0)//=/#. + * smt(prefix_lt_size mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop memE mem_fdom). + * smt(prefix_lt_size mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop memE mem_fdom). + conseq(:_==> ={sa,sc,Perm.m,Perm.mi,Redo.prefixes,i,p} + /\ C.c{1} = C.c{2} - size p{2} + i{2} + /\ pref{2} = Redo.prefixes{2} + /\ all_prefixes pref{2} + /\ prefix_inv C.queries{2} pref{2} + /\ prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{2}))) = i{2} + /\ Redo.prefixes{2}.[take i{2} p{2}] = Some (sa{2}, sc{2}));1: + smt(prefix_sizel take_get_max_prefix2 domE prefix_exchange). + + while( ={sa,sc,Perm.m,Perm.mi,Redo.prefixes,i,p} + /\ C.c{1} = C.c{2} - size p{2} + prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{2}))) + /\ pref{2} = Redo.prefixes{2} + /\ all_prefixes pref{2} + /\ prefix_inv C.queries{2} pref{2} + /\ 0 <= i{2} <= prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{2}))) + /\ Redo.prefixes{2}.[take i{2} p{2}] = Some (sa{2}, sc{2})). + + rcondt{1}1;2:rcondt{2}1;auto;progress. + * rewrite/#. search get_max_prefix (<=) take mem. + * rewrite(@prefix_inv_leq _ _ _ _ _ _ H H7 H0)//= 1:/#. + have :=H0=>[][h1 [h2 h3]]. + have :=h3 _ _ _ H7;last smt(memE mem_fdom). + smt(size_eq0 size_take). + * smt(domE). + auto;progress. + * rewrite/#. + * smt(prefix_ge0). + * smt(take0). + * smt(prefix_sizel @Prefix memE). + * smt(prefix_sizel @Prefix memE). + + have p_ll := f_ll _. + + by move=> [b c]; rewrite supp_dprod /= Block.DBlock.dunifin_fu Capacity.DCapacity.dunifin_fu. + have pi_ll := fi_ll _. + + by move=> [b c]; rewrite supp_dprod /= Block.DBlock.dunifin_fu Capacity.DCapacity.dunifin_fu. + have f_ll : islossless SqueezelessSponge(Perm).f. + + proc; while true (size p - i)=> //=. + * by move=> z; wp;if;auto; 2:call (p_ll); auto=>/#. + by auto; smt w=size_ge0. + apply (@ler_trans _ _ _ + (Pr_restr Perm SqueezelessSponge D p_ll pi_ll f_ll D_ll &m)). + have ->: Pr[Indif(SqueezelessSponge(Perm), Perm, DRestr(D)).main() @ &m: res] + = Pr[PRPSec.IND(PRPi.PRPi,DBounder(D')).main() @ &m: res]. + + rewrite -(DoubleBounding PRPi.PRPi &m). + byequiv=> //=; proc; inline *; sim (_: ={m,mi}(Perm,PRPi.PRPi) /\ ={glob C}). + (** * by proc; if=> //=; auto. **) + * proc. if. + + move=> &1 &2 [#] <<- _ _ -> _. (** FIXME: the two instances of PRPi.PRPi.mi{2} appear to not be the same value; one of them in an ill-formed term **) smt(). + + auto=> /#. + + auto=> /#. + by proc; if=> //=; auto=> /#. + have ->: Pr[CF(DRestr(D)).main() @ &m: res] + = Pr[PRPSec.IND(ARP,DBounder(D')).main() @ &m: res]. + + rewrite -(DoubleBounding ARP &m). + byequiv=> //=; proc; inline *; sim (_: ={m,mi}(PF,ARP)). + * proc; if=> //=; auto; conseq (_: true ==> (y1,y2){1} = x{2})=> //=. + transitivity{1} { (y1,y2) <@ S.sample2(bdistr,cdistr); } + (true ==> ={y1,y2}) + (true ==> (y1,y2){1} = x{2})=> //=. + - by inline *; auto. + transitivity{2} { x <@ S.sample(bdistr,cdistr); } + (true ==> (y1,y2){1} = x{2}) + (true ==> ={x})=> //=. + - by symmetry; call sample_sample2; skip=> /> []. + by inline *; auto. + proc; if=> //=; auto; conseq (_: true ==> (y1,y2){1} = y{2})=> //=. + transitivity{1} { (y1,y2) <@ S.sample2(bdistr,cdistr); } + (true ==> ={y1,y2}) + (true ==> (y1,y2){1} = y{2})=> //=. + - by inline *; auto. + transitivity{2} { y <@ S.sample(bdistr,cdistr); } + (true ==> (y1,y2){1} = y{2}) + (true ==> ={y})=> //=. + - by symmetry; call sample_sample2; skip=> /> []. + by inline *; auto. + have:= Conclusion D' &m _. + + move=> O O_f_ll O_fi_ll. + proc;inline*;sp;wp; call (_: true)=> //=. + + apply D_ll. + + by proc; inline*; sp; if=> //=; auto; call O_f_ll; auto. + + by proc; inline*; sp; if=> //=; auto; call O_fi_ll; auto. + + proc; inline *; sp; if=> //=; auto; if; auto. + while true (size p - i);auto. + * sp; if; auto; 2:call O_f_ll; auto=> /#. + by auto; smt w=size_ge0. + smt(). + qed. + +end section. diff --git a/sha3/proof/smart_counter/Gcol.eca b/sha3/proof/smart_counter/Gcol.eca new file mode 100644 index 0000000..e5b2fe0 --- /dev/null +++ b/sha3/proof/smart_counter/Gcol.eca @@ -0,0 +1,358 @@ +pragma -oldip. +require import Core Int Real StdOrder Ring StdBigop. +require import List FSet SmtMap Common SLCommon FelTactic Mu_mem. +require import DProd Dexcepted PROM. +(*...*) import Capacity IntID IntOrder Bigreal RealOrder BRA. + +require (*..*) Handle. + +clone export Handle as Handle0. +import ROhandle. +(* -------------------------------------------------------------------------- *) + + (* TODO: move this *) + lemma c_gt0r : 0%r < (2^c)%r. + proof. by rewrite lt_fromint; apply/IntOrder.expr_gt0. qed. + + lemma c_ge0r : 0%r <= (2^c)%r. + proof. by apply /ltrW/c_gt0r. qed. + + lemma eps_ge0 : 0%r <= (2 * max_size)%r / (2 ^ c)%r. + proof. + apply divr_ge0;1:by rewrite le_fromint;smt ml=0 w=max_ge0. + by apply c_ge0r. + qed. + +section PROOF. + declare module D <: DISTINGUISHER{-C, -PF, -G1}. + + declare axiom D_ll (F <: DFUNCTIONALITY{-D}) (P <: DPRIMITIVE{-D}): + islossless P.f => islossless P.fi => + islossless F.f => islossless D(F, P).distinguish. + + local module Gcol = { + + var count : int + + proc sample_c () = { + var c <- c0; + if (card (image fst (frng FRO.m)) <= 2*max_size /\ + count < max_size) { + c <$ cdistr; + G1.bcol <- G1.bcol \/ mem (image fst (frng FRO.m)) c; + count <- count + 1; + } + + return c; + } + + module M = { + + proc f(p : block list): block = { + var sa, sa', sc; + var h, i, counter <- 0; + sa <- b0; + while (i < size p ) { + if ((sa +^ nth witness p i, h) \in G1.mh) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + if (counter < size p - prefix p (get_max_prefix p (elems (fdom C.queries)))) { + sc <@ sample_c(); + sa' <@ F.RO.get(take (i+1) p); + sa <- sa +^ nth witness p i; + G1.mh.[(sa,h)] <- (sa', G1.chandle); + G1.mhi.[(sa',G1.chandle)] <- (sa, h); + (sa,h) <- (sa',G1.chandle); + FRO.m.[G1.chandle] <- (sc,Unknown); + G1.chandle <- G1.chandle + 1; + counter <- counter + 1; + } + } + i <- i + 1; + } + sa <@ F.RO.get(p); + return sa; + } + } + + module S = { + + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2; + + if (x \notin G1.m) { + y <- (b0,c0); + if (!(rng FRO.m (x.`2, Known))) { + FRO.m.[G1.chandle] <- (x.`2, Known); + G1.chandle <- G1.chandle + 1; + } + hx2 <- oget (hinvK FRO.m x.`2); + if (x.`2 \in G1.paths) { + (p,v) <- oget G1.paths.[x.`2]; + y1 <@ F.RO.get (rcons p (v +^ x.`1)); + y2 <@ sample_c(); + } else { + y1 <$ bdistr; + y2 <@ sample_c(); + } + y <- (y1,y2); + if ((x.`1, hx2) \in G1.mh /\ + in_dom_with FRO.m (oget G1.mh.[(x.`1,hx2)]).`2 Unknown) { + hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; + y <- (y.`1, (oget FRO.m.[hy2]).`1); + FRO.m.[hy2] <- (y.`2, Known); + G1.m.[x] <- y; + G1.mi.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + FRO.m.[hy2] <- (y.`2, Known); + G1.m.[x] <- y; + G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); + G1.mi.[y] <- x; + G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + if (x.`2 \in G1.paths) { + (p,v) <- oget G1.paths.[x.`2]; + G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } + } else { + y <- oget G1.m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2, hx2, hy2; + + if (x \notin G1.mi) { + y <- (b0,c0); + if (!(rng FRO.m (x.`2, Known))) { + FRO.m.[G1.chandle] <- (x.`2, Known); + G1.chandle <- G1.chandle + 1; + } + hx2 <- oget (hinvK FRO.m x.`2); + y1 <$ bdistr; + y2 <@ sample_c(); + y <- (y1,y2); + if ((x.`1, hx2) \in G1.mhi /\ + in_dom_with FRO.m (oget G1.mhi.[(x.`1,hx2)]).`2 Unknown) { + (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; + y <- (y.`1, (oget FRO.m.[hy2]).`1); + FRO.m.[hy2] <- (y.`2, Known); + G1.mi.[x] <- y; + G1.m.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + FRO.m.[hy2] <- (y.`2, Known); + G1.mi.[x] <- y; + G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); + G1.m.[y] <- x; + G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget G1.mi.[x]; + } + return y; + } + + } + + proc main(): bool = { + var b; + + F.RO.m <- empty; + G1.m <- empty; + G1.mi <- empty; + G1.mh <- empty; + G1.mhi <- empty; + G1.bcol <- false; + + FRO.m <- empty.[0 <- (c0, Known)]; + G1.paths <- empty.[c0 <- ([<:block>],b0)]; + G1.chandle <- 1; + count <- 0; + b <@ DRestr(D,M,S).distinguish(); + return b; + } + }. + + lemma card_rng_set (m:('a,'b)fmap) x y: card(frng m.[x<-y]) <= card(frng m) + 1. + proof. + have: frng m.[x <- y] \subset frng m `|` fset1 y. + + move=> b; rewrite in_fsetU1 2!mem_frng 2!rngE /= => [] [] a. + rewrite get_setE; case: (a = x) =>[->>|hax] //= hmab; left. + by exists a. + move=> /subset_leq_fcard; rewrite fcardU fcard1; smt(fcard_ge0). + qed. + + lemma hinv_image handles c: + hinv handles c <> None => + mem (image fst (frng handles)) c. + proof. + case: (hinv handles c) (hinvP handles c)=>//= h[f] Heq. + rewrite imageP;exists (c,f)=>@/fst/=. + by rewrite mem_frng rngE /=; exists (oget (Some h)). + qed. + + local lemma Pr_col &m : + Pr[Gcol.main()@&m : G1.bcol /\ Gcol.count <= max_size] <= + max_size%r * ((2*max_size)%r / (2^c)%r). + proof. + fel 10 Gcol.count (fun x=> (2*max_size)%r / (2^c)%r) + max_size G1.bcol + [Gcol.sample_c : (card (image fst (frng FRO.m)) <= 2*max_size /\ Gcol.count < max_size)]=>//;2:by auto. + + rewrite /felsum Bigreal.sumr_const count_predT size_range. + apply ler_wpmul2r;1:by apply eps_ge0. + by rewrite le_fromint;smt ml=0 w=max_ge0. + + proc;sp;if;2:by hoare=>//??;apply eps_ge0. + wp. + rnd (mem (image fst (frng FRO.m)));skip;progress;2:smt ml=0. + have->:=(Mu_mem.mu_mem (image fst (frng FRO.m{hr})) cdistr (1%r/(2^c)%r) _). + + move=>x _; rewrite DCapacity.dunifin1E;do !congr;smt(@Capacity). + apply ler_wpmul2r;2:by rewrite le_fromint. + by apply divr_ge0=>//;apply /c_ge0r. + + move=>ci;proc;rcondt 2;auto=>/#. + move=> b c;proc;sp;if;auto;smt ml=0. + qed. + + local equiv G1_col : G1(DRestr(D)).main ~ Gcol.main : + ={glob D} ==> (G1.bcol{1} => G1.bcol{2}) /\ Gcol.count{2} <= max_size. + proof. + proc;inline*;wp. + call (_: ={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c,C.queries}/\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (frng FRO.m) <= 2*C.c + 1 /\ + Gcol.count <= C.c <= max_size){2}). + + proc;sp 1 1;if=>//;inline G1(DRestr(D)).S.f Gcol.S.f;swap -3. + sp;if;1,3:auto=>/#;swap{1}[1..2]3;sp 1 1. + seq 5 5 : (={x0, y0, F.RO.m, G1.mi, G1.paths, G1.m, G1.mhi, G1.chandle, + G1.mh, FRO.m, C.c, C.queries} + /\ (G1.bcol{1} => G1.bcol{2}) + /\ card (frng FRO.m{2}) <= 2 * C.c{2} + 1 + /\ Gcol.count{2} <= C.c{2} <= max_size );last by if;auto. + seq 2 2 : (={x0, hx2, F.RO.m, G1.mi, G1.paths, G1.m, G1.mhi, G1.chandle, + G1.mh, FRO.m, C.c, C.queries} + /\ (G1.bcol{1} => G1.bcol{2}) + /\ card (frng FRO.m{2}) <= 2 * C.c{2} + /\ Gcol.count{2} + 1 <= C.c{2} <= max_size). + + by if; auto=> /> &1 &2; smt(card_rng_set). + if;1:auto. + - inline Gcol.sample_c;rcondt{2}4. + * auto;inline*;auto;progress. + + by have/#:=fcard_image_leq (fun (p : capacity * flag) => p.`1) (frng FRO.m{hr}). + rewrite/#. + seq 3 4 : (={x0, p, v, y1, hx2, F.RO.m, G1.mi, G1.paths, G1.m, G1.mhi, + G1.chandle, G1.mh, FRO.m, C.c, C.queries} + /\ (G1.bcol{1} => G1.bcol{2}) + /\ card (frng FRO.m{2}) <= 2 * C.c{2} + /\ Gcol.count{2} + 1 <= C.c{2} <= max_size + /\ (x0{1}.`2 \in G1.paths{1}) + /\ y2{1} = c{2});1: by inline*;auto. + sp 1 4;if;auto;progress. + + by have->:=(H H6). + + smt(card_rng_set). + + case:H5=>/=[h|H_hinv];1: by have->:=H h. + have:=hinvP FRO.m{2} c{2};rewrite H_hinv/=imageP/==>[][]f H_f. + by right; exists (c{2}, f)=> //=; rewrite mem_frng rngE/= /#. + smt(card_rng_set). + inline Gcol.sample_c;rcondt{2}3. + * auto;progress. + + by have/#:=fcard_image_leq (fun (p : capacity * flag) => p.`1) (frng FRO.m{hr}). + rewrite/#. + seq 2 3 : (={x0, y1, hx2, F.RO.m, G1.mi, G1.paths, G1.m, G1.mhi, + G1.chandle, G1.mh, FRO.m, C.c, C.queries} + /\ (G1.bcol{1} => G1.bcol{2}) + /\ card (frng FRO.m{2}) <= 2 * C.c{2} + /\ Gcol.count{2} + 1 <= C.c{2} <= max_size + /\ ! (x0{1}.`2 \in G1.paths{1}) + /\ y2{1} = c{2});1: by auto. + sp 1 4;if;auto;progress. + + by have->:=(H H6). + + smt(card_rng_set). + + case:H5=>/=[h|H_hinv];1: by have->:=H h. + have:= hinvP FRO.m{2} c{2}. + rewrite H_hinv /= imageP /= => [] [] f H_f. + by right; exists (c{2},f); rewrite mem_frng rngE /=; exists (oget (hinv FRO.m{2} c{2})). + smt(card_rng_set). + + + proc;sp 1 1;if=>//. + inline G1(DRestr(D)).S.fi Gcol.S.fi;swap-3. + seq 2 2 : (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + C.c,C.queries,x0} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (frng FRO.m) + 2 <= 2*C.c + 1 /\ + Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. + if=>//;last by auto=>/#. + seq 3 3:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + C.c,C.queries,x0,hx2} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (frng FRO.m) + 1 <= 2 * C.c + 1 /\ + Gcol.count + 1 <= C.c <= max_size){2}). + + sp 1 1;if;auto;smt ml=0 w=card_rng_set. + seq 3 3: + (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + C.c,C.queries,x0,hx2,y0,y1,y2} /\ y0{1} = (y1,y2){1} /\ + ((G1.bcol\/hinv FRO.m y0.`2 <> None){1} => G1.bcol{2}) /\ + (card (frng FRO.m) + 1 <= 2 * C.c + 1 /\ + Gcol.count <= C.c <= max_size){2});2:by auto;smt w=card_rng_set. + inline Gcol.sample_c. + rcondt{2}3. + + by auto;progress;have /#:= fcard_image_leq fst (frng FRO.m{hr}). +(* BUG: auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | H]. marche pas ???? *) + auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | X];right;apply hinv_image=> //. + + + proc;sp 1 1;if=>//;2:auto;sp;if=>//;swap 1;wp. + inline G1(DRestr(D)).M.f Gcol.M.f;sp;wp. + seq 1 1: + (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c, + C.queries,b,p,h,i,sa,bs,counter} /\ i{1}=size p{2} /\ p{2} = bs{2} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (0 <= counter{2} <= size p{2} - + prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{1})))) /\ + card (frng FRO.m{2}) <= 2 * (C.c{2} + counter{2}) + 1 /\ + Gcol.count{2} + size p{2} - + prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{1}))) + - counter{2} <= C.c{2} + size p{2} - + prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{1}))) + <= max_size); + last by inline*;auto;smt(size_ge0 prefix_sizel). + while + (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c,b, + p,h,i,sa,counter,C.queries} /\ (0 <= i <= size p){1} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (0 <= counter{2} <= size p{2} - + prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{1})))) /\ + card (frng FRO.m{2}) <= 2 * (C.c{2} + counter{2}) + 1 /\ + Gcol.count{2} + size p{2} - + prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{1}))) + - counter{2} <= C.c{2} + size p{2} - + prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{1}))) + <= max_size);last first. + + by auto=> />; smt(size_ge0 prefix_sizel prefix_ge0). + if=>//;auto;1:smt ml=0 w=size_ge0. + if=>//;2:auto;2:smt(size_ge0 prefix_sizel). + auto;call (_: ={F.RO.m})=>/=;1:by sim. + inline *;rcondt{2} 2. + + auto;progress. + - apply(StdOrder.IntOrder.ler_trans _ _ _ (fcard_image_leq fst (frng FRO.m{hr})))=>/#. + smt(size_ge0 prefix_sizel). + auto;smt ml=0 w=(hinv_image card_rng_set). + auto;progress;3:by smt ml=0. + + rewrite -(add0z 1) -{2}fcards0<:capacity*flag> -(frng0<:int,_>). + exact/card_rng_set/max_ge0. + by apply max_ge0. + qed. + + lemma Pr_G1col &m: + Pr[G1(DRestr(D)).main() @ &m : G1.bcol] <= max_size%r * ((2*max_size)%r / (2^c)%r). + proof. + apply (ler_trans Pr[Gcol.main()@&m : G1.bcol /\ Gcol.count <= max_size]). + + byequiv G1_col=> //#. + apply (Pr_col &m). + qed. + +end section PROOF. + + diff --git a/sha3/proof/smart_counter/Gconcl.ec b/sha3/proof/smart_counter/Gconcl.ec new file mode 100644 index 0000000..f114324 --- /dev/null +++ b/sha3/proof/smart_counter/Gconcl.ec @@ -0,0 +1,389 @@ +pragma -oldip. +require import Core Int Real StdOrder Ring StdBigop. +require import List FSet SmtMap Common SLCommon FelTactic Mu_mem. +require import DProd Dexcepted PROM. +(*...*) import Capacity IntID IntOrder Bigreal RealOrder BRA. + +require (*..*) Gext. + +module IF = { + proc init = F.RO.init + proc f = F.RO.get +}. + +module S(F : DFUNCTIONALITY) = { + var m, mi : smap + var paths : (capacity, block list * block) fmap + + proc init() = { + m <- empty; + mi <- empty; + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + paths <- empty.[c0 <- ([<:block>],b0)]; + } + + proc f(x : state): state = { + var p, v, y, y1, y2; + + if (x \notin m) { + if (x.`2 \in paths) { + (p, v) <- oget paths.[x.`2]; + y1 <@ F.f (rcons p (v +^ x.`1));} else { + y1 <$ bdistr; + } + y2 <$ cdistr; + y <- (y1,y2); + m.[x] <- y; + mi.[y] <- x; + if (x.`2 \in paths) { + (p,v) <- oget paths.[x.`2]; + paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } + } else { + y <- oget m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2; + + if (x \notin mi) { + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + mi.[x] <- y; + m.[y] <- x; + } else { + y <- oget mi.[x]; + } + return y; + } + +}. + +section. + +declare module D <: DISTINGUISHER{-C, -Perm, -F.RO, -F.FRO, -S, -Redo}. +local clone import Gext as Gext0. + + +local module G3(RO:F.RO) = { + + module M = { + + proc f(p : block list): block = { + var sa, sa'; + var h, i, counter <- 0; + sa <- b0; + while (i < size p ) { + if ((sa +^ nth witness p i, h) \in G1.mh) { + RO.sample(take (i+1) p); + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + if (counter < size p - prefix p (get_max_prefix p (elems (fdom C.queries)))) { + RRO.sample(G1.chandle); + sa' <@ RO.get(take (i+1) p); + sa <- sa +^ nth witness p i; + G1.mh.[(sa,h)] <- (sa', G1.chandle); + G1.mhi.[(sa',G1.chandle)] <- (sa, h); + (sa,h) <- (sa',G1.chandle); + G1.chandle <- G1.chandle + 1; + counter <- counter + 1; + } else { + RO.sample(take (i+1) p); + } + } + i <- i + 1; + } + sa <@ RO.get(p); + return sa; + } + } + + module S = { + + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2, handles_,t; + + if (x \notin G1.m) { + if (x.`2 \in G1.paths) { + (p,v) <- oget G1.paths.[x.`2]; + y1 <@ RO.get (rcons p (v +^ x.`1)); + } else { + y1 <$ bdistr; + } + y2 <$ cdistr; + y <- (y1, y2); + handles_ <@ RRO.allKnown(); + if (!rng handles_ x.`2) { + RRO.set(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <@ RRO.allKnown(); + hx2 <- oget (hinvc handles_ x.`2); + t <@ RRO.queried((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); + if ((x.`1, hx2) \in G1.mh /\ t) { + hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; + FRO.m.[hy2] <- (y2,Known); + G1.m.[x] <- y; + G1.mi.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + RRO.set(hy2, y.`2); + G1.m.[x] <- y; + G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); + G1.mi.[y] <- x; + G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + if (x.`2 \in G1.paths) { + (p,v) <- oget G1.paths.[x.`2]; + G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } + } else { + y <- oget G1.m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2, hx2, hy2, handles_, t; + + if (x \notin G1.mi) { + handles_ <@ RRO.allKnown(); + if (!rng handles_ x.`2) { + RRO.set(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <@ RRO.allKnown(); + hx2 <- oget (hinvc handles_ x.`2); + t <@ RRO.queried((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + if ((x.`1, hx2) \in G1.mhi /\ t) { + (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; + FRO.m.[hy2] <- (y2,Known); + G1.mi.[x] <- y; + G1.m.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + RRO.set(hy2, y.`2); + G1.mi.[x] <- y; + G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); + G1.m.[y] <- x; + G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget G1.mi.[x]; + } + return y; + } + + } + + proc distinguish(): bool = { + var b; + + RO.init(); + G1.m <- empty; + G1.mi <- empty; + G1.mh <- empty; + G1.mhi <- empty; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + RRO.init(); + RRO.set(0,c0); + G1.paths <- empty.[c0 <- ([<:block>],b0)]; + G1.chandle <- 1; + b <@ DRestr(D,M,S).distinguish(); + return b; + } +}. + +local equiv G2_G3: Eager(G2(DRestr(D))).main2 ~ G3(F.LRO).distinguish : ={glob D} ==> ={res}. +proof. + proc;wp;call{1} RRO_resample_ll;inline *;wp. + call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries}); last by auto. + + + proc;sp;if=> //;sim. + call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries});2:by auto. + if=> //;2:by sim. + swap{1} [3..7] -2;swap{2} [4..8] -3. + seq 5 5:(={hx2,t,x,FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries} /\ + (t = in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1}); + 1:by inline *;auto. + seq 3 4:(={y,x,FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries}); + 2:by sim. + if=>//. + + seq 2 2:(={y1,hx2,t,x,FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries} + /\ (t = in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1}). + + by inline *;auto=> /> ? _;rewrite Block.DWord.bdistr_ll. + case (((x.`1, hx2) \in G1.mh /\ t){1}); + [rcondt{1} 3;2:rcondt{2} 3| rcondf{1} 3;2:rcondf{2} 3]; + 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. + inline *;rcondt{1} 6;1:by auto=>/>. + by auto => /> *; rewrite !get_setE. + case (((x.`1, hx2) \in G1.mh /\ t){1}); + [rcondt{1} 4;2:rcondt{2} 4| rcondf{1} 4;2:rcondf{2} 4]; + 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. + inline *;rcondt{1} 7;1:by auto=>/>. + by wp;rnd;auto;rnd{1};auto => /> *; rewrite !get_setE. + + + proc;sp;if=>//;sim. + call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries});2:by auto. + if=> //;2:sim. + swap{1} 8 -3. + seq 6 6 : (={y1,hx2,t,x,FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries} + /\ (t = in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1}). + + by inline *;auto. + case (((x.`1, hx2) \in G1.mhi /\ t){1}); + [rcondt{1} 3;2:rcondt{2} 3| rcondf{1} 3;2:rcondf{2} 3]; + 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. + inline *;rcondt{1} 6;1:by auto=>/>. + by auto => /> *; rewrite !get_setE. + + proc;sp;if=>//;auto;if;1:auto;sim. + call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries});2:by auto. + by inline*;sim. +qed. + +local module G4(RO:F.RO) = { + + module C = { + + proc f(p : block list): block = { + var sa; + var h, i <- 0; + sa <- b0; + while (i < size p ) { + RO.sample(take (i+1) p); + i <- i + 1; + } + sa <@ RO.get(p); + return sa; + } + } + + module S = { + + proc f(x : state): state = { + var p, v, y, y1, y2; + + if (x \notin G1.m) { + if (x.`2 \in G1.paths) { + (p,v) <- oget G1.paths.[x.`2]; + y1 <@ RO.get (rcons p (v +^ x.`1)); + } else { + y1 <$ bdistr; + } + y2 <$ cdistr; + y <- (y1,y2); + G1.m.[x] <- y; + G1.mi.[y] <- x; + if (x.`2 \in G1.paths) { + (p,v) <- oget G1.paths.[x.`2]; + G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } + } else { + y <- oget G1.m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2; + + if (x \notin G1.mi) { + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + G1.mi.[x] <- y; + G1.m.[y] <- x; + } else { + y <- oget G1.mi.[x]; + } + return y; + } + + } + + proc distinguish(): bool = { + var b; + + RO.init(); + G1.m <- empty; + G1.mi <- empty; + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + G1.paths <- empty.[c0 <- ([<:block>],b0)]; + b <@ DRestr(D,C,S).distinguish(); + return b; + } +}. + +local equiv G3_G4 : G3(F.RO).distinguish ~ G4(F.RO).distinguish : ={glob D} ==> ={res}. +proof. + proc;inline *;wp. + call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c,C.queries});last by auto. + + proc;sp;if=>//;sim. + call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c,C.queries});last by auto. + if => //;2:sim. + seq 3 3: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c,C.queries});1:by sim. + sim;seq 5 0: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c,C.queries});1:by inline *;auto. + by if{1};sim;inline *;auto. + + proc;sp;if=>//;sim. + call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c,C.queries});last by auto. + if => //;2:sim. + seq 5 0: (={x,G1.m,G1.mi,G1.paths,F.RO.m,C.c,C.queries});1:by inline *;auto. + seq 3 3: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c,C.queries});1:by sim. + by if{1};sim;inline *;auto. + proc;sp;if=>//;auto;if=>//;sim. + call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c,C.queries});last by auto. + sp;sim; while(={i,p,F.RO.m})=>//. + inline F.RO.sample F.RO.get;if{1};1:by auto. + if{1};2:by auto. + by sim;inline *;auto;progress;smt(DCapacity.dunifin_ll). +qed. + +local equiv G4_Ideal : G4(F.LRO).distinguish ~ IdealIndif(IF,S,DRestr(D)).main : + ={glob D} ==> ={res}. +proof. + proc;inline *;wp. + call (_: ={C.c,C.queries,F.RO.m} /\ G1.m{1}=S.m{2} /\ G1.mi{1}=S.mi{2} /\ G1.paths{1}=S.paths{2}). + + by sim. + by sim. + + proc;sp;if=>//;auto;if=>//;auto. + call (_: ={F.RO.m});2:by auto. + inline F.LRO.get F.FRO.sample;wp 7 2;sim. + by while{1} (true) (size p - i){1};auto;1:inline*;auto=>/#. + by auto. +qed. + +declare axiom D_ll : + forall (F <: DFUNCTIONALITY{-D}) (P <: DPRIMITIVE{-D}), + islossless P.f => + islossless P.fi => islossless F.f => islossless D(F, P).distinguish. + + +lemma Real_Ideal &m: + Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= + Pr[IdealIndif(IF,S,DRestr(D)).main() @ &m :res] + + (max_size ^ 2 - max_size)%r / 2%r * mu dstate (pred1 witness) + + max_size%r * ((2*max_size)%r / (2^c)%r) + + max_size%r * ((2*max_size)%r / (2^c)%r). +proof. + apply (ler_trans _ _ _ (Real_G2 D D_ll &m)). + rewrite !(ler_add2l, ler_add2r);apply lerr_eq. + apply (eq_trans _ Pr[G3(F.LRO).distinguish() @ &m : res]);1:by byequiv G2_G3. + apply (eq_trans _ Pr[G3(F.RO ).distinguish() @ &m : res]). + + byequiv (_: ={glob G3, F.RO.m} ==> _)=>//;symmetry;conseq (F.FullEager.RO_LRO_D G3 _)=> //. + by move=> _; exact/Block.DBlock.dunifin_ll. + apply (eq_trans _ Pr[G4(F.RO ).distinguish() @ &m : res]);1:by byequiv G3_G4. + apply (eq_trans _ Pr[G4(F.LRO).distinguish() @ &m : res]). + + byequiv (F.FullEager.RO_LRO_D G4 _)=> //. + by move=> _; exact/Block.DBlock.dunifin_ll. + by byequiv G4_Ideal. +qed. + +end section. diff --git a/sha3/proof/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec new file mode 100644 index 0000000..a9235b8 --- /dev/null +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -0,0 +1,2199 @@ +pragma -oldip. +require import Core Int Real StdOrder Ring StdBigop. +require import List FSet SmtMap Common SLCommon PROM FelTactic Mu_mem. +require import Distr DProd Dexcepted BlockSponge Gconcl. +(*...*) import Capacity IntID IntOrder Bigreal RealOrder BRA. + +require (*--*) Handle. + +(*** THEORY PARAMETERS ***) +(** Validity of Functionality Queries **) +op valid: block list -> bool = valid_block. +axiom valid_spec p: valid p => p <> []. +axiom parse_gt0 x: 0 < (parse x).`2. +axiom parse_not_valid x : + !valid (parse x).`1 => + forall i, ! valid (parse (format (parse x).`1 i)).`1. +axiom parse_twice p n x : + (p,n) = parse x => forall i, 0 < i <= n => parse (format p i) = (p,i). +axiom valid_uniq p1 p2 n1 n2 : + valid p1 => valid p2 => format p1 n1 = format p2 n2 => p1 = p2 /\ n1 = n2. + + +clone export Handle as Handle0. + +module DSqueeze (F : SLCommon.DFUNCTIONALITY) = { + proc init () : unit = {} + proc f (p : block list, n : int) : block list = { + var lres : block list <- []; + var b : block <- b0; + var i : int <- 0; + if (valid p) { + b <@ F.f(p); + while (i < n) { + i <- i + 1; + lres <- rcons lres b; + if (i < n) { + b <@ F.f(format p (i+1)); + } + } + } + return lres; + } +}. + + +module (Squeeze (F : SLCommon.FUNCTIONALITY) : FUNCTIONALITY) = { + proc init () : unit = { + C.init(); + F.init(); + } + proc f = DSqueeze(F).f +}. + + +module (A (D : DISTINGUISHER) : SLCommon.DISTINGUISHER) + (F : SLCommon.DFUNCTIONALITY) (P : DPRIMITIVE) = { + proc distinguish() : bool = { + var b : bool; + C.init(); + b <@ DRestr(D,DSqueeze(F),P).distinguish(); + return b; + } +}. + + + +module NIndif (F : FUNCTIONALITY, P : PRIMITIVE, D : DISTINGUISHER) = { + proc main () : bool = { + var b : bool; + C.init(); + P.init(); + F.init(); + b <@ D(F,P).distinguish(); + return b; + } +}. + + + +module P = Perm. + +clone IRO as BIRO2 with + type from <- block list, + type to <- block, + op valid <- predT, + op dto <- bdistr. + +module Valid (F : DFUNCTIONALITY) = { + proc init () = {} + proc f (q : block list, k : int) = { + var re : block list <- []; + (q,k) <- parse (format q k); + if (valid q) { + re <@ F.f(q,k); + } else { + re <@ BIRO2.IRO.f(q,k); + } + return re; + } +}. + +module SimLast (S : SLCommon.SIMULATOR) (F : DFUNCTIONALITY) = { + proc init() = { + BIRO2.IRO.init(); + S(Last(Valid(F))).init(); + } + proc f = S(Last(Valid(F))).f + proc fi = S(Last(Valid(F))).fi +}. + +clone F as F2. + + +section Ideal. + + op (<=) (m1 m2 : (block list, 'b) fmap) = + forall x, x <> [] => x \in m1 => m1.[x] = m2.[x]. + + local lemma leq_add_nin (m1 m2 : (block list, 'b) fmap) (x : block list) (y : 'b): + m1 <= m2 => + ! x \in m2 => + m1 <= m2.[x <- y]. + proof. + move=>h_leq H_n_dom a H_a_dom;rewrite get_setE/=;smt(domE). + qed. + + + local lemma leq_add_in (m1 m2 : (block list, 'b) fmap) (x : block list) : + m1 <= m2 => + x \in m2 => + m1.[x <- oget m2.[x]] <= m2. + proof. + move=>h_leq H_n_dom a H_a_dom;rewrite get_setE/=;smt(domE get_setE). + qed. + + local lemma leq_nin_dom (m1 m2 : (block list, 'b) fmap) (x : block list) : + m1 <= m2 => + x <> [] => + ! x \in m2 => ! x \in m1 by smt(domE). + + local lemma prefix_leq1 (l : block list) (m : (block list,block) fmap) i : + 0 <= i => + format l (i+1) \in m => + size (format l (i+1)) <= prefix (format l (i+1+1)) + (get_max_prefix (format l (i+1+1)) (elems (fdom m))) <= size (format l (i+1+1)). + proof. + rewrite -mem_fdom memE;move=>hi0 H_dom. + have->:(format l (i + 1 + 1)) = format l (i + 1) ++ [b0]. + + by rewrite/format//=nseqSr//-cats1 catA. + have:=prefix_leq_prefix_cat_size (format l (i + 1))[b0](elems (fdom m)). + rewrite (prefix_get_max_prefix_eq_size _ _ H_dom)//=. + rewrite (size_cat _ [b0])/=;pose x:= format _ _. + have:=get_max_prefix_max (x ++ [b0]) _ _ H_dom. + have->:prefix (x ++ [b0]) (format l (i + 1)) = size x + by rewrite prefixC-{1}(cats0 (format l (i+1)))/x prefix_cat//=. + smt(prefix_sizel size_cat prefix_ge0 ). + qed. + + local lemma prefix_le1 (l : block list) (m : (block list,block) fmap) i : + 0 <= i => + format l (i+1) \in m => + size (format l (i+1+1)) - prefix (format l (i+1+1)) + (get_max_prefix (format l (i+1+1)) (elems (fdom m))) <= 1. + proof. + move=> Hi0 H_liS_in_m. + have:= prefix_leq1 _ _ _ Hi0 H_liS_in_m. + rewrite /format /= nseqSr //-cats1 catA (size_cat(l ++ nseq i b0) [b0]) /=. + smt(size_ge0). + qed. + + local lemma leq_add2 (m1 m2 : (block list, 'b) fmap) (x : block list) (y : 'b) : + m1 <= m2 => + ! x \in m2 => + m1.[x <- y] <= m2.[x <- y] by smt(domE get_setE mem_set in_fsetU1). + + + local equiv ideal_equiv (D <: DISTINGUISHER{-SLCommon.C, -C, -IF, -S}) : + SLCommon.IdealIndif(IF, S, SLCommon.DRestr(A(D))).main + ~ + SLCommon.IdealIndif(IF, S, A(D)).main + : + ={glob D} ==> ={glob D, res}. + proof. + proc;inline*;auto;sp. + call(: ={glob IF, glob S, glob A} /\ SLCommon.C.c{1} <= C.c{1} + /\ SLCommon.C.queries{1} <= F.RO.m{2});auto;last first. + + progress. + by move=>x;rewrite get_setE/=mem_set-mem_fdom fdom0 in_fset0//==>->. + + proc;inline*;sp;if;auto;sp;rcondt{1}1;1:auto=>/#;sp;if=>//=;2:auto=>/#. + wp 7 6;conseq(:_==> ={y} /\ ={F.RO.m} /\ ={S.paths, S.mi, S.m} + /\ SLCommon.C.queries{1} <= F.RO.m{2});1:smt(). + if;auto;smt(leq_add_nin). + + by proc;inline*;sp;if;auto;sp;rcondt{1}1;1:auto=>/#;sp;if;auto;smt(). + proc;inline*;sp;if;auto;swap 6;auto;sp;if;auto;2:smt(size_ge0). + case(0 < n{1});last first. + + sp;rcondf{1}3;2:rcondf{2}4;1,2:auto. + - by if;auto;if;auto. + by if{1};2:auto;1:if{1};auto; + smt(prefix_ge0 leq_add_in DBlock.dunifin_ll domE size_ge0 get_setE leq_add2). + splitwhile{1}5: i + 1 < n;splitwhile{2}5: i + 1 < n. + rcondt{1}6;2:rcondt{2}6;auto. + * by while(i < n);auto;sp;if;auto;sp;if;auto;if;auto. + * by while(i < n);auto;sp;if;auto;sp;if;auto;if;auto. + rcondf{1}8;2:rcondf{2}8;auto. + * while(i < n);auto. + by sp;if;auto;sp;if;auto;if;auto. + sp;if;auto;2:smt();if;auto;smt(). + * while(i < n);auto;2:smt();sp;if;auto;sp;if;auto;if;auto. + rcondf{1}8;2:rcondf{2}8;auto. + * while(i < n);auto. + by sp;if;auto;sp;if;auto;if;auto. + sp;if;auto;2:smt();if;auto;smt(). + * by while(i < n);auto;2:smt();sp;if;auto;sp;if;auto;if;auto. + conseq(:_==> ={b,lres,F.RO.m,S.paths,S.mi,S.m} + /\ i{1} = n{1} - 1 + /\ SLCommon.C.c{1} <= C.c{1} + size bl{1} + i{1} + /\ SLCommon.C.queries{1} <= F.RO.m{2});1:smt(). + while(={lres,F.RO.m,S.paths,S.mi,S.m,i,n,p,nb,b,bl} + /\ 0 <= i{1} <= n{1} - 1 + /\ SLCommon.C.queries.[format p (i+1)]{1} = Some b{1} + /\ p{1} = bs{1} /\ valid p{1} /\ p{1} = bl{1} + /\ C.c{1} + size p{1} + n{1} - 1 <= max_size + /\ SLCommon.C.c{1} <= C.c{1} + size bl{1} + i{1} + /\ SLCommon.C.queries{1} <= F.RO.m{2});progress. + sp;rcondt{1}1;2:rcondt{2}1;1,2:auto;sp. + case((x0 \in F.RO.m){2});last first. + * rcondt{2}2;1:auto;rcondt{1}1. + + auto => /> &hr iR 9?; apply leq_nin_dom => //. + smt (leq_nin_dom size_cat size_eq0 size_nseq valid_spec). + rcondt{1}1;1:auto. + - move=> /> &hr i [#] h1 h2 h3 h4 h5 h6 h7 h8 h9 h10. + have//= /#:= prefix_le1 bl{m} SLCommon.C.queries{hr} i h1 _. + by rewrite domE h3. + sp;rcondt{1}2;auto;progress. + - smt(). + - smt(). + - by rewrite!get_setE/=. + - have//= /#:= prefix_le1 bl{2} SLCommon.C.queries{1} i_R H _. + by rewrite domE H1. + - by rewrite!get_setE/= leq_add2//=. + if{1}. + * rcondt{1}1;1:auto. + - move=> /> &hr i [#] h1 h2 h3 h4 h5 h6 h7 h8 h9 h10. + have//= /#:= prefix_le1 bl{m} SLCommon.C.queries{hr} i h1 _. + by rewrite domE h3. + sp;rcondf{1}2;2:rcondf{2}2;auto;progress. + - smt(). + - smt(). + - by rewrite!get_setE/=. + - have//= /#:= prefix_le1 bl{2} SLCommon.C.queries{1} i_R H _. + by rewrite domE H1. + - smt(leq_add_in domE). + rcondf{2}2;auto;progress. + - smt(size_cat size_nseq size_eq0 size_ge0). + - smt(). + - smt(). + - by move: H11; rewrite domE; case: (SLCommon.C.queries{1}.[format bl{2} (i_R + 2)]). + - smt(). + sp;conseq(:_==> ={F.RO.m,b} + /\ SLCommon.C.queries.[p]{1} = Some b{1} + /\ SLCommon.C.c{1} <= C.c{1} + size bl{1} + /\ SLCommon.C.queries{1} <= F.RO.m{2});progress. + - smt(). + - smt(nseq0 cats0). + - smt(size_ge0). + - smt(). + case(p{2} \in F.RO.m{2}). + + rcondf{2}2;1:auto. + sp;if{1}. + - rcondt{1}1;1:auto;1:smt(prefix_ge0). + sp;rcondf{1}2;auto;progress. + * by rewrite!get_setE/=. + * smt(prefix_ge0). + * smt(leq_add_in domE). + auto;progress. + - smt(domE). + - smt(domE). + - smt(size_ge0). + rcondt{1}1;1:auto;1:smt(leq_nin_dom domE). + rcondt{1}1;1:auto;1:smt(prefix_ge0). + sp;auto;progress. + + by rewrite!get_setE/=. + + smt(prefix_ge0). + + rewrite get_setE/= leq_add2//=. + + by rewrite!get_setE/=. + + smt(prefix_ge0). + + exact leq_add_in. + qed. + + + local module IF'(F : F.RO) = { + proc init = F.init + proc f (x : block list) : block = { + var b : block <- b0; + var i : int <- 0; + var p,n; + (p,n) <- parse x; + while (i < n) { + i <- i + 1; + F.sample(format p i); + } + b <@ F.get(x); + return b; + } + }. + + + + + local module (L (D : DISTINGUISHER) : F.RO_Distinguisher) (F : F.RO) = { + proc distinguish = SLCommon.IdealIndif(IF'(F), S, A(D)).main + }. + + local module Valid2 (F : F.RO) = { + proc init = F.init + proc f (q : block list) = { + var r : block <- b0; + var s,t; + (s,t) <- parse q; + r <@ F.get(q); + return r; + } + }. + + local module (L2 (D : DISTINGUISHER) : F.RO_Distinguisher) (F : F.RO) = { + proc distinguish = SLCommon.IdealIndif(Valid2(F), S, A(D)).main + }. + + local equiv Ideal_equiv_valid (D <: DISTINGUISHER{-SLCommon.C, -C, -IF, -S}) : + L(D,F.LRO).distinguish + ~ + L2(D,F.LRO).distinguish + : + ={glob D} ==> ={glob D, res}. + proof. + proc;inline*;sp;wp. + call(: ={glob S, glob C, glob F.RO});auto. + + proc;sp;if;auto. + call(: ={glob S,glob F.RO});auto. + sp;if;auto;if;auto;sp. + call(: ={glob F.RO});2:auto;2:smt(). + inline F.LRO.sample;call(: ={glob IF});auto;progress. + by while{1}(true)(n{1}-i{1});auto;smt(). + + by proc;sim. + proc;sp;if;auto;sp;call(: ={glob IF,glob S});auto. + sp;if;auto. + while(={glob S,glob IF,lres,i,n,p,b}). + + sp;if;auto. + call(: ={glob IF});auto. + call(: ={glob IF});auto. + conseq(:_==> true);auto. + by inline*;while{1}(true)(n{1}-i{1});auto;smt(). + call(: ={glob IF});auto. + call(: ={glob IF});auto. + conseq(:_==> true);auto. + by inline*;while{1}(true)(n{1}-i{1});auto;smt(). + qed. + + + local equiv ideal_equiv2 (D <: DISTINGUISHER{-SLCommon.C, -C, -IF, -S}) : + L2(D,F.RO).distinguish ~ SLCommon.IdealIndif(IF,S,A(D)).main + : ={glob D} ==> ={glob D, res}. + proof. + proc;inline*;sp;wp. + call(: ={glob F.RO, glob S, glob C});auto. + + proc;auto;sp;if;auto. + call(: ={glob F.RO, glob S});auto. + if;1,3:auto;sim;if;auto. + call(: ={glob F.RO});2:auto. + by inline*;sp;wp 2 2;sim. + + by proc;sim. + proc;sp;if;auto;sp. + call(: ={glob F.RO});auto;sp;if;auto;inline*;auto;sp. + case(0 < n{1});last first. + + by rcondf{2}4;1:auto;rcondf{1}5;auto. + while(={lres,F.RO.m,i,n,p,b} /\ valid p{1} /\ 0 <= i{1} <= n{1}). + + sp;if;1:auto. + - by auto;smt(parse_valid parseK formatK). + by auto;smt(parse_valid parseK formatK). + by auto;smt(parse_valid parseK formatK). + qed. + + inductive inv_L_L3 (m1 m2 m3 : (block list, block) fmap) = + | INV of (m1 = m2 + m3) + & (forall l, l \in m2 => valid (parse l).`1) + & (forall l, l \in m3 => ! valid (parse l).`1). + + local module IF2(F : F.RO) (F2 : F2.RO) = { + proc init () = { + F.init(); + F2.init(); + } + proc f (x : block list) : block = { + var b : block <- b0; + var i : int <- 0; + var p,n; + (p,n) <- parse x; + if (valid p) { + while (i < n) { + i <- i + 1; + F.sample(format p i); + } + b <@ F.get(x); + } else { + while (i < n) { + i <- i + 1; + F2.sample(format p i); + } + b <@ F2.get(x); + } + return b; + } + }. + + + local module (L3 (D : DISTINGUISHER) : F.RO_Distinguisher) (F : F.RO) = { + proc distinguish = SLCommon.IdealIndif(IF2(F,F2.RO), S, A(D)).main + }. + + local lemma lemma1 m1 m2 m3 p i r: + inv_L_L3 m1 m2 m3 => + valid p => + 0 < i => + ! format p i \in m1 => + ! format p i \in m2 => + inv_L_L3 m1.[format p i <- r] m2.[format p i <- r] m3. + proof. + move=>INV0 p_valid i_gt0 nin_dom1 nin_dom2;split;have[]add_maps valid_dom nvalid_dom:=INV0. + + rewrite add_maps -fmap_eqP=>x. + by rewrite get_setE !joinE get_setE;smt(parseK formatK). + + smt(mem_set parseK formatK). + + smt(mem_set parseK formatK). + qed. + + local lemma lemma2 m1 m2 m3 p i: + inv_L_L3 m1 m2 m3 => + valid p => + 0 < i => + format p i \in m1 => + format p i \in m2. + proof. + move=>INV0 p_valid i_gt0 domE1;have[]add_maps valid_dom nvalid_dom:=INV0. + by have:= domE1; rewrite add_maps mem_join;smt(parseK formatK). + qed. + + + local lemma incl_dom m1 m2 m3 l : + inv_L_L3 m1 m2 m3 => + l \in m1 <=> (l \in m2 \/ l \in m3). + proof. + move=>INV0;have[]add_maps valid_dom nvalid_dom:=INV0. + by rewrite add_maps mem_join. + qed. + + + local lemma lemma3 m1 m2 m3 x r: + inv_L_L3 m1 m2 m3 => + ! valid (parse x).`1 => + ! x \in m1 => + inv_L_L3 m1.[x <- r] m2 m3.[x <- r]. + proof. + move=>INV0 not_valid nin_dom1;have[]add_maps h1 h2:=INV0. + have nin_dom3: ! x \in m3 by smt(incl_dom). + split. + + by apply/fmap_eqP=>y;rewrite add_maps !get_setE!joinE!get_setE mem_set/#. + + exact h1. + smt(mem_set). + qed. + + + local equiv Ideal_equiv3 (D <: DISTINGUISHER{-SLCommon.C, -C, -IF, -S, -F2.RO}) : + L(D,F.RO).distinguish ~ L3(D,F.RO).distinguish + : ={glob D} ==> ={glob D, res}. + proof. + proc;inline*;auto;sp. + call(: ={glob S, glob C} /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});auto;first last. + + proc;sp;if;auto. + by call(: ={glob S});auto;sim. + + proc;sp;if;auto;call(: inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});auto;sp. + inline*;if;auto;sp. + rcondt{1}1;1:auto;1:smt(parse_valid parseK formatK). + rcondt{2}1;1:auto;1:smt(parse_valid parseK formatK). + rcondt{2}1;1:auto;1:smt(parse_valid parseK formatK);sp. + rcondf{1}3;1:auto;1:smt(parse_valid parseK formatK);sp. + rcondf{2}3;1:auto;1:smt(parse_valid parseK formatK);sp. + rcondf{1}5;2:rcondf{2}5; + 1,2:by auto;smt(mem_set nseq0 cats0 parse_valid). + case(0 < n{1});auto;last first. + - rcondf{1}7;1:auto;rcondf{2}7;1:auto. + by wp;rnd;auto;progress;smt(lemma1 nseq0 cats0 lemma2 incl_dom + parse_valid parseK formatK in_fsetU). + while(={i,n,p,lres,b} /\ valid p{1} /\ 0 <= i{1} <= n{1} + /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2}). + - sp;if;1,3:auto=>/#. + sp;rcondt{2}1;1:auto;1:smt(parse_valid parseK formatK). + conseq(:_==> ={b} /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});1:progress=>/#. + auto=>/=. + conseq(:_==> inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});progress. + * by rewrite!get_setE//=. + * smt(lemma1 parse_valid). + * smt(lemma2 parse_valid). + * smt(lemma2 parse_valid). + * smt(incl_dom). + * smt(incl_dom). + * case:H8;smt(joinE). + while(={i1,n1,p1} /\ valid p1{1} /\ 0 <= i1{1} <= n1{1} + /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2}). + * sp;conseq(:_==> inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});1:smt(). + case(x6{1} \in F.RO.m{1}). + + by rcondf{1}2;2:rcondf{2}2;auto;smt(incl_dom lemma2). + by rcondt{1}2;2:rcondt{2}2;auto;smt(lemma2 incl_dom lemma1). + by auto;smt(parseK). + wp;rnd;wp 2 2. + conseq(:_==> F.RO.m{1}.[p{1}] = F.RO.m{2}.[p{2}] + /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});progress. + + have[]add_maps h1 h2:=H5;rewrite add_maps joinE//=. + by have:= h2 p{2}; rewrite parse_valid //= H2 /= => h; rewrite h. + + smt(). + case(x5{1} \in F.RO.m{1}). + - rcondf{1}2;2:rcondf{2}2;auto;progress. + * smt(lemma2 incl_dom parse_valid). + by have[]add_maps h1 h2:=H1;rewrite add_maps joinE//=;smt(parse_valid). + rcondt{1}2;2:rcondt{2}2;auto;progress. + - move:H4;rewrite/format/=nseq0 !cats0 => p0_notin_ROm_m. + case: H1 => joint _ _; move: p0_notin_ROm_m. + by rewrite joint mem_join negb_or; smt(parse_valid). + - have[]add_maps h1 h2:=H1;rewrite add_maps !get_setE joinE//=;smt(parse_valid nseq0 cats0). + - have:=H;rewrite -H0=>//=[][]->>->>;apply lemma1=>//=;1:smt(parse_valid). + have[]add_maps h1 h2:=H1;smt(parse_valid formatK parseK incl_dom). + + progress;split. + - by apply/fmap_eqP=>x;rewrite joinE mem_empty. + - smt(mem_empty). + - smt(mem_empty). + proc;sp;if;auto;call(: ={glob S} /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});auto. + if;1,3:auto. + seq 1 1 : (={x, y1, S.paths, S.mi, S.m} /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});last first. + + by conseq(:_==> ={y, S.paths, S.mi, S.m});progress;sim. + if;auto. + call(: inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});auto;sp;inline*. + if{2}. + + seq 1 1 : (={x,p,n} /\ parse x{1} = (p,n){1} /\ valid p{1} + /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});last first. + - sp;case(x1{1} \in F.RO.m{1}). + * rcondf{1}2;2:rcondf{2}2;auto;progress. + + have:=H2;rewrite -formatK H/=;smt(lemma2 incl_dom parse_gt0). + have[]add_maps h1 h2:=H1;rewrite add_maps joinE. + have:=H2;rewrite -formatK H/==>in_dom1. + case(format p{2} n{2} \in F2.RO.m{2})=>//=in_dom3. + by have:=h2 _ in_dom3;rewrite parseK//=;smt(parse_gt0). + rcondt{1}2;2:rcondt{2}2;auto;progress. + + smt(incl_dom lemma2). + + have[]:=H1;smt(get_setE joinE). + by have:=H2;rewrite-formatK H/==>nin_dom1;rewrite lemma1//=;smt(parse_gt0 lemma2 incl_dom). + conseq(:_==> inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});1:smt(). + while(={i,n,p} /\ 0 <= i{1} /\ valid p{1} /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2}). + + sp;case(x2{1} \in F.RO.m{1}). + - by rcondf{1}2;2:rcondf{2}2;auto;smt(lemma2). + rcondt{1}2;2:rcondt{2}2;auto;progress. + - smt(incl_dom lemma1). + - smt(incl_dom lemma1). + apply/lemma1=> //=. + - smt(). + smt(incl_dom mem_join). + auto;smt(). + seq 1 1 : (={x,p,n} /\ parse x{1} = (p,n){1} /\ ! valid p{1} + /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});last first. + + sp;case(x1{1} \in F.RO.m{1}). + - rcondf{1}2;2:rcondf{2}2;auto;progress. + * have[]:=H1;smt(incl_dom). + have[]:=H1;smt(joinE incl_dom). + rcondt{1}2;2:rcondt{2}2;auto;progress. + * have[]:=H1;smt(incl_dom). + * have[]:=H1;smt(joinE incl_dom get_setE). + by rewrite(lemma3 _ _ _ _ rL H1 _ H2)H//=. + conseq(:_==> inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});1:smt(). + while(={i,n,p,x} /\ 0 <= i{1} /\ ! valid p{1} /\ parse x{1} = (p,n){1} + /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2}). + + sp;case(x2{1} \in F.RO.m{1}). + - rcondf{1}2;2:rcondf{2}2;auto;progress. + * have[]h_join h1 h2:=H2. + have:= H5; rewrite h_join mem_join. + have:= h1 (format p{hr} (i_R + 1)). + have:=parse_not_valid x{hr}; rewrite H1 /= H0 /= => h. + by rewrite (h (i_R+1)) /= => ->. + smt(). + rcondt{1}2;2:rcondt{2}2;auto;progress. + * smt(incl_dom lemma1). + * smt(). + * have//=:=lemma3 _ _ _ _ r0L H2 _ H5. + by have:= parse_not_valid x{2}; rewrite H1 /= H0 /= => h; exact/(h (i_R+1)). + auto;smt(). + qed. + + local module D2 (D : DISTINGUISHER) (F : F.RO) = { + proc distinguish = D(FC(DSqueeze(Valid2(F))), PC(S(Valid2(F)))).distinguish + }. + + local module D3 (D : DISTINGUISHER) (F : F.RO) = { + proc distinguish = D(FC(DSqueeze(IF'(F))), PC(S(IF'(F)))).distinguish + }. + + + module DSqueeze2 (F : F.RO) (F2 : F2.RO) = { + proc init () : unit = { + F.init(); + F2.init(); + } + proc f (p : block list, n : int) : block list = { + var lres : block list <- []; + var b : block <- b0; + var i : int <- 0; + var pp, nn; + (pp,nn) <- parse (format p n); + if (valid p) { + if (n <= 0) { + F.sample(p); + } + while (i < n) { + i <- i + 1; + b <@ F.get(format p i); + lres <- rcons lres b; + } + } else { + if (nn <= 0) { + F2.sample(pp); + } + while (i < nn - n) { + i <- i + 1; + F2.sample(format pp i); + } + while (i < n) { + i <- i + 1; + b <@ F2.get(format pp i); + lres <- rcons lres b; + } + } + return lres; + } + }. + + + local module FValid (F : DFUNCTIONALITY) = { + proc f (p : block list, n : int) = { + var r : block list <- []; + if (valid p) { + r <@ F.f(p,n); + } + return r; + } + }. + + local module DValid (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = D(FValid(F),P). + + local module S2 (F : DFUNCTIONALITY) = S(Last(F)). + + local module L4 (D : DISTINGUISHER) (F : F.RO) (F2 : F2.RO) = { + proc distinguish = IdealIndif(DSqueeze2(F,F2),S2,DValid(DRestr(D))).main + }. + + local equiv equiv_L3_L4 (D <: DISTINGUISHER{-SLCommon.C, -C, -IF, -S, -F2.RO, -BIRO.IRO, -BIRO2.IRO}) : + L3(D,F.RO).distinguish + ~ + L4(D,F.RO,F2.RO).distinguish + : + ={glob D} ==> ={glob D, res}. + proof. + proc; inline*; auto; sp. + call(: ={glob S, glob C, glob F.RO, glob F2.RO}); auto;first last. + + by proc; sim. + + proc; sp; if; auto; call(: ={glob F.RO, glob F2.RO}); auto; sp; if; auto; inline*; sp. + rcondt{1}1; 1:(auto; smt(parse_valid parse_gt0)); sp. + rcondt{1}1; 1:(auto; smt(parse_valid parse_gt0)); sp. + (* rcondt{1}1; 1:(auto; smt(parse_valid parse_gt0)); sp. *) + rcondf{1}3; 1:(auto; smt(parse_valid parse_gt0)); sp. + rcondt{2}1; 1:(auto; smt(parse_valid parse_gt0 parseK formatK)); sp; wp. + if{2};sp. + - rcondf{2}3; 1:(auto; smt(parse_valid parse_gt0)); sp. + rcondf{1}8; 1:(auto; smt(parse_valid parse_gt0)); sp. + rcondf{1}5; 1:(auto; smt(parse_valid parse_gt0 mem_set nseq0 cats0)); sp. + wp 4 2;rnd{1};wp 2 2. + by conseq(:_==> ={F.RO.m} /\ r3{1} = r2{2} /\ x9{1} = x4{2});2:sim; + smt(DBlock.dunifin_ll nseq0 cats0 parse_valid);progress. + rcondt{2}1; 1:(auto; smt(parse_valid parse_gt0)); sp; wp. + splitwhile{1} 8 : i + 1 < n. + rcondt{1}9;1:auto. + - by while(i < n);auto;2:smt();sp;if;auto;1:(sp;if;auto);while(i < n);auto. + rcondf{1}11;1:auto. + - by while(i < n);auto;2:smt();sp;if;auto;1:(sp;if;auto);while(i < n);auto. + rcondf{1}11;1:auto. + - by while(i < n);auto;2:smt();sp;if;auto;1:(sp;if;auto);while(i < n);auto. + wp. + while((n,p){1} = (n0,p0){2} /\ i{1} + 1 = i{2} /\ valid p{1} /\ 0 < n{1} + /\ 0 <= i{2} <= n{1} + /\ (forall j, 1 <= j <= i{2} => format p{1} j \in F.RO.m{1}) + /\ rcons lres{1} b{1} = lres{2} /\ ={F.RO.m, F2.RO.m});last first. + - rcondf{1}5;1:auto;1:smt(mem_set nseq0 cats0 parse_valid). + wp 4 2;rnd{1};wp 2 2. + conseq(:_==> ={F.RO.m} /\ r3{1} = r0{2} /\ x9{1} \in F.RO.m{1}); + 1:smt(DBlock.dunifin_ll nseq0 cats0 parse_valid). + by auto;smt(parse_valid nseq0 cats0 mem_set). + sp. + rcondt{1}1;1:auto;sp. + rcondt{1}1;1:(auto;smt(parse_valid parseK formatK)). + (* rcondt{1}1;1:(auto;smt(parse_valid parseK formatK parse_gt0)). *) + splitwhile{1} 1 : i1 + 1 < n1. + rcondt{1}2;1:auto. + - by while(i1 < n1);auto;smt(parse_gt0 parse_valid parseK formatK). + rcondf{1}7;1:auto. + - by while(i1 < n1);auto;smt(parse_gt0 parse_valid parseK formatK). + rcondf{1}9;1:auto. + - conseq(:_==> i1 + 1 = n1);1:smt(mem_set parseK parse_valid formatK). + by while(i1 + 1 <= n1);auto;smt(parse_gt0 parse_valid parseK formatK). + wp 8 2;rnd{1};wp 6 2. + conseq(:_==> n1{1} = i{2} /\ ={F.RO.m} /\ i1{1} = n1{1} + /\ (forall (j : int), 1 <= j <= i{2} => + format p1{1} j \in F.RO.m{1})); + 1:smt(parseK formatK parse_valid DBlock.dunifin_ll). + seq 2 0 : (={F.RO.m,x0} /\ i1{1} = n1{1} /\ x0{2} = format p{1} i{2} + /\ n1{1} = i{1} + 1 /\ p1{1} = p{1} /\ i{2} = i{1} + 1 /\ forall (j : int), + 1 <= j <= i{1} => format p{1} j \in F.RO.m{1});last first. + - auto;smt(mem_set). + wp;conseq(:_==> ={F.RO.m} /\ i1{1} + 1 = n1{1} + /\ (forall (j : int), 1 <= j < n1{1} => + format p1{1} j \in F.RO.m{1}));1:smt(parseK). + while{1}(={F.RO.m} /\ 0 <= i1{1} /\ i1{1} + 1 <= n1{1} /\ i{2} = n1{1} /\ i{2} = i{1} + 1 + /\ (forall (j : int), 1 <= j < n1{1} => + format p1{1} j \in F.RO.m{1}))(n1{1}-i1{1}-1);progress. + + by sp;rcondf 2;auto;smt(DBlock.dunifin_ll). + by auto;smt(parse_gt0 parseK formatK parse_valid). + proc; sp; if; auto; call(: ={glob S, glob F.RO, glob F2.RO}); auto. + if; 1,3:auto; sim; if; auto; sim; sp. + call(: ={glob F.RO, glob F2.RO});auto;last smt(). + inline*;auto;sp. + if;1:auto;1:smt(). + + (* rcondt{1}1;1:(auto;smt(parse_valid parse_gt0)). *) + rcondf{2}1;1:(auto;smt(parse_valid parse_gt0)). + splitwhile{1} 1 : i + 1 < n;splitwhile{2} 1 : i + 1 < n. + rcondt{1}2;1:auto. + - by while(i ={F.RO.m} /\ p{2} = x0{2});progress. + + smt(last_rcons formatK parseK). + seq 3 3 : (={F.RO.m,i,x0} /\ x0{1} = p{2}); + last by conseq(:_==> ={F.RO.m});progress;sim. + auto;conseq(:_==> ={F.RO.m,i,n} /\ p{1} = p0{2} /\ i{1} + 1 = n{2});1:smt(formatK). + by while(={F.RO.m,i,n} /\ p{1} = p0{2} /\ 0 <= i{1} /\ i{1} + 1 <= n{2}); + auto;smt(parse_gt0). + sp;rcondf{2}1;1:(auto;smt(parse_gt0)). + rcondf{2}1;1:auto;1:smt(parseK formatK). + splitwhile{1} 1 : i + 1 < n;splitwhile{2} 1 : i + 1 < n. + rcondt{1}2;1:auto. + - by while(i ={F2.RO.m} /\ format pp{2} n{2} = x3{2}). + + move=> /> &1 &2 H H0 /= /> [#] H1 H2 m lres /= ?. + smt(last_rcons formatK parseK). + seq 3 3 : (={F2.RO.m,i} /\ x2{1} = x3{2} /\ pp{2} = p{1} /\ format pp{2} n{2} = x3{2}); + last by conseq(:_==> ={F2.RO.m});progress;sim. + auto;conseq(:_==> ={F2.RO.m,i,n} /\ i{1} + 1 = n{2});1:smt(formatK). + by while(={F2.RO.m,i,n} /\ p{1} = pp{2} /\ 0 <= i{1} /\ i{1} + 1 <= n{2}); + auto;smt(parse_gt0 parseK formatK). + qed. + + + op inv_map (m1 : (block list, block) fmap) (m2 : (block list * int, block) fmap) = + (forall p n x, parse x = (p,n+1) => (p,n) \in m2 <=> x \in m1) + /\ (forall p n x, parse x = (p,n+1) => x \in m1 <=> (p,n) \in m2) + /\ (forall p n x, parse x = (p,n+1) => m2.[(p,n)] = m1.[x]) + /\ (forall p n x, parse x = (p,n+1) => m1.[x] = m2.[(p,n)]). + + inductive INV_L4_ideal m1 m2 m3 m4 = + | inv_maps of (inv_map m1 m2) + & (inv_map m3 m4) + & (forall p n, (p,n) \in m2 => valid p /\ 0 <= n) + & (forall p n, (p,n) \in m4 => ! valid p /\ 0 <= n). + + + local lemma lemma5 m1 m2 m3 m4 p i r : + INV_L4_ideal m1 m2 m3 m4 => + ! (p,i) \in m2 => + 0 <= i => + valid p => + INV_L4_ideal m1.[format p (i+1) <- r] m2.[(p,i) <- r] m3 m4. + proof. + move=>INV0 nin_dom1 i_gt0 valid_p;have[]inv12 inv34 dom2 dom4:=INV0;have[]h1[]h2[]h3 h4:=inv12;split=>//=. + + progress. + - move:H0;rewrite 2!mem_set=>[][/#|]/=[]->>->>;smt(parseK formatK). + - move:H0;rewrite 2!mem_set=>[][/#|]/=;smt(parseK formatK). + - move:H0;rewrite 2!mem_set=>[][/#|]/=;smt(parseK formatK). + - move:H0;rewrite 2!mem_set=>[][/#|]/=;smt(parseK formatK). + - smt(get_setE parseK formatK). + smt(get_setE parseK formatK). + smt(get_setE parseK formatK mem_set). + qed. + + local lemma lemma5bis m1 m2 m3 m4 p i r : + INV_L4_ideal m1 m2 m3 m4 => + ! (p,i) \in m4 => + 0 <= i => + ! valid p => + parse (format p (i+1)) = (p,i+1) => + INV_L4_ideal m1 m2 m3.[format p (i+1) <- r] m4.[(p,i) <- r]. + proof. + move=>INV0 nin_dom1 i_gt0 nvalid_p parseK_p_i; + have[]inv12 inv34 dom2 dom4:=INV0; + have[]h1[]h2[]h3 h4:=inv34; + split=>//=. + + progress. + - move:H0;rewrite 2!mem_set=>[][/#|]/=[]->>->>;smt(parseK formatK). + - move:H0;rewrite 2!mem_set=>[][/#|]/=;smt(parseK formatK). + - move:H0;rewrite 2!mem_set=>[][/#|]/=;smt(parseK formatK). + - move:H0;rewrite 2!mem_set=>[][/#|]/=;smt(parseK formatK). + - smt(get_setE parseK formatK). + smt(get_setE parseK formatK). + smt(get_setE parseK formatK mem_set). + qed. + + + + local equiv equiv_L4_ideal (D <: DISTINGUISHER{-SLCommon.C, -C, -IF, -S, -F2.RO, -BIRO.IRO, -BIRO2.IRO}) : + L4(D,F.LRO,F2.LRO).distinguish + ~ + IdealIndif(BIRO.IRO,SimLast(S),DRestr(D)).main + : + ={glob D} ==> ={glob D, res}. + proof. + proc; inline*; auto; sp. + call(: ={glob S, glob C} + /\ INV_L4_ideal F.RO.m{1} BIRO.IRO.mp{2} F2.RO.m{1} BIRO2.IRO.mp{2}); + auto; -1:(progress;split;smt(mem_empty in_fset0 emptyE)). + + proc;sp;if;auto;call(: ={glob S} + /\ INV_L4_ideal F.RO.m{1} BIRO.IRO.mp{2} F2.RO.m{1} BIRO2.IRO.mp{2}); auto. + if;1,3:auto. seq 1 1 : (={y1, x, glob S} + /\ INV_L4_ideal F.RO.m{1} BIRO.IRO.mp{2} F2.RO.m{1} BIRO2.IRO.mp{2}); + last by conseq(:_==> ={y, glob S});progress;sim. + if;auto;call(: INV_L4_ideal F.RO.m{1} BIRO.IRO.mp{2} F2.RO.m{1} BIRO2.IRO.mp{2});auto. + inline*;auto;sp;if;auto;1:smt(parseK parse_gt0 formatK);1:sp 0 4;2:sp 0 3. + - rcondt{2}1;1:auto;1:smt(parseK parse_gt0 formatK). + while(lres{1} = bs{2} /\ ={i,n} /\ x{2} = p0{1} /\ valid p0{1} /\ 0 <= i{1} + /\ INV_L4_ideal F.RO.m{1} BIRO.IRO.mp{2} F2.RO.m{1} BIRO2.IRO.mp{2});progress. + * sp;if{2}. + + rcondt{1}2;auto;progress. + - have[]h1 _ _ _:=H1;have[]h'1 _:=h1;smt(parseK). + - smt(get_setE). + - smt(). + - exact lemma5. + rcondf{1}2;auto;progress. + - have[]h1 _ _ _:=H1;have[]h'1 _:=h1;smt(parseK). + - have[]h1:=H1;have[]:=h1;smt(parseK). + smt(). + by if{1};auto;smt(parseK parse_gt0 formatK). + rcondf{1}1;1:auto;1:smt(parse_gt0);sp. + rcondt{2}1;1:auto. + while(lres{1} = bs0{2} /\ (i,n,pp){1} = (i0,n0,x0){2} + /\ (x0{2}, n0{2}) = parse (format q{2} k{2}) /\ ! valid x0{2} /\ 0 <= i{1} + /\ INV_L4_ideal F.RO.m{1} BIRO.IRO.mp{2} F2.RO.m{1} BIRO2.IRO.mp{2});progress. + * sp;if{2}. + + rcondt{1}2;auto;progress. + - have[]_ h1 _ _:=H2;have[]:=h1;progress. + have:=H7 x0{m} i0{m} (format x0{m} (i0{m} + 1));rewrite H5/==>->//=. + have->/#:=parse_twice _ _ _ H. + - smt(get_setE). + - smt(). + - apply lemma5bis=>//=. + rewrite(parse_twice _ _ _ H)/#. + rcondf{1}2;auto;progress. + - have[]_ h1 _ _:=H2;have[]:=h1;progress. + have:=H7 x0{m} i0{m} (format x0{m} (i0{m} + 1));rewrite H5/==>->//=. + have->/#:=parse_twice _ _ _ H. + - have[]_ h1 _ _:=H2;have[]h'1 _:=h1;smt(parseK parse_twice). + - smt(). + by rcondf{1}1;auto;smt(parseK formatK). + + by proc;inline*;conseq(:_==> ={glob C, glob S, z});progress;sim. + proc;sp;if;auto;call(: INV_L4_ideal F.RO.m{1} BIRO.IRO.mp{2} + F2.RO.m{1} BIRO2.IRO.mp{2});auto. + inline*;sp;if;auto;sp. + rcondt{1}1;1:auto;if{1};sp. + - by rcondf{1}1;2:rcondf{2}1;auto;smt(). + while(lres{1} = bs{2} /\ ={i} /\ n0{1} = n{2} /\ x{2} = p0{1} /\ valid p0{1} /\ 0 <= i{1} + /\ INV_L4_ideal F.RO.m{1} BIRO.IRO.mp{2} F2.RO.m{1} BIRO2.IRO.mp{2});progress. + sp;if{2}. + + rcondt{1}2;auto;progress. + - have[]h1 _ _ _:=H1;have[]h'1 _:=h1;smt(parseK). + - smt(get_setE). + - smt(). + - exact lemma5. + rcondf{1}2;auto;progress. + - have[]h1 _ _ _:=H1;have[]h'1 _:=h1;smt(parseK). + - have[]h1:=H1;have[]:=h1;smt(parseK). + smt(). + qed. + + local module D5 (D : DISTINGUISHER) (F : F.RO) = + D(FC(FValid(DSqueeze2(F, F2.RO))), PC(S(Last(DSqueeze2(F, F2.RO))))). + + local module D6 (D : DISTINGUISHER) (F2 : F2.RO) = + D(FC(FValid(DSqueeze2(F.LRO, F2))), PC(S(Last(DSqueeze2(F.LRO, F2))))). + + lemma equiv_ideal (D <: DISTINGUISHER{-SLCommon.C, -C, -IF, -S, -F.FRO, -F2.RO, -F2.FRO, -BIRO.IRO, -BIRO2.IRO}) &m: + Pr[SLCommon.IdealIndif(IF,S,SLCommon.DRestr(A(D))).main() @ &m : res] = + Pr[IdealIndif(BIRO.IRO,SimLast(S),DRestr(D)).main() @ &m : res]. + proof. + have->:Pr[SLCommon.IdealIndif(IF, S, SLCommon.DRestr(A(D))).main() @ &m : res] + = Pr[SLCommon.IdealIndif(IF, S, A(D)).main() @ &m : res]. + + by byequiv(ideal_equiv D)=>//=. + have<-:Pr[L2(D,F.RO).distinguish() @ &m : res] = + Pr[SLCommon.IdealIndif(IF,S,A(D)).main() @ &m : res]. + + by byequiv(ideal_equiv2 D). + have->:Pr[L2(D, F.RO).distinguish() @ &m : res] = + Pr[L2(D,F.LRO).distinguish() @ &m : res]. + + byequiv=>//=;proc;sp;inline*;sp;wp. + call(F.FullEager.RO_LRO_D (D2(D)) _);auto. + by move=> _; exact/dunifin_ll. + have->:Pr[IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res] = + Pr[L4(D,F.LRO,F2.LRO).distinguish() @ &m : res]. + + by rewrite eq_sym;byequiv(equiv_L4_ideal D)=>//=. + have<-:Pr[L4(D, F.RO, F2.RO).distinguish() @ &m : res] = + Pr[L4(D,F.LRO,F2.LRO).distinguish() @ &m : res]. + + have->:Pr[L4(D, F.RO, F2.RO).distinguish() @ &m : res] = + Pr[L4(D,F.LRO, F2.RO).distinguish() @ &m : res]. + - byequiv=>//=;proc;sp;inline*;sp;wp. + call(F.FullEager.RO_LRO_D (D5(D)) _); auto. + by move=> _; exact/dunifin_ll. + byequiv=>//=;proc;sp;inline*;sp;wp. + call(F2.FullEager.RO_LRO_D (D6(D)) _); auto. + by move=> _; exact/dunifin_ll. + have<-:Pr[L3(D, F.RO).distinguish() @ &m : res] = + Pr[L4(D, F.RO, F2.RO).distinguish() @ &m : res]. + + by byequiv(equiv_L3_L4 D)=>//=. + have<-:Pr[L(D, F.RO).distinguish() @ &m : res] = + Pr[L3(D, F.RO).distinguish() @ &m : res]. + + by byequiv(Ideal_equiv3 D). + have->:Pr[L(D, F.RO).distinguish() @ &m : res] = + Pr[L(D,F.LRO).distinguish() @ &m : res]. + + byequiv=>//=;proc;sp;inline*;sp;wp. + call(F.FullEager.RO_LRO_D (D3(D)) _); auto. + by move=> _; exact/dunifin_ll. + rewrite eq_sym. + by byequiv(Ideal_equiv_valid D). + qed. + +end section Ideal. + + + (* Real part *) + + +section Real. + + inductive m_p (m : (state, state) fmap) (p : (block list, state) fmap) = + | IND_M_P of (p.[[]] = Some (b0, c0)) + & (forall l, l \in p => forall i, 0 <= i < size l => + exists b c, p.[take i l] = Some (b,c) /\ + m.[(b +^ nth witness l i, c)] = p.[take (i+1) l]). + + inductive INV_Real + (c1 c2 : int) + (m mi : (state, state) fmap) + (p : (block list, state) fmap) = + | INV_real of (c1 <= c2) + & (m_p m p) + & (invm m mi). + + local lemma INV_Real_incr c1 c2 m mi p : + INV_Real c1 c2 m mi p => + INV_Real (c1 + 1) (c2 + 1) m mi p. + proof. by case;progress;split=>//=/#. qed. + + local lemma INV_Real_addm_mi c1 c2 m mi p x y : + INV_Real c1 c2 m mi p => + ! x \in m => + ! rng m y => + INV_Real c1 c2 m.[x <- y] mi.[y <- x] p. + proof. + case=> H_c1c2 H_m_p H_invm H_x_dom H_y_rng;split=>//=. + + split;case:H_m_p=>//=; + smt(get_setE domE oget_some take_oversize size_take take_take). + exact/invm_set. + qed. + + local lemma invmC' (m mi : (state, state) fmap) : + invm m mi => invm mi m. + proof. by rewrite /#. qed. + + local lemma invmC (m mi : (state, state) fmap) : + invm m mi <=> invm mi m. + proof. by split;exact invmC'. qed. + + local lemma invm_dom_rng (m mi : (state, state) fmap) : + invm m mi => dom m = rng mi. + proof. + move=>h; rewrite fun_ext=> x; rewrite domE rngE /= eq_iff; have h2 := h x; split. + + move=> m_x_not_None; exists (oget m.[x]); rewrite -h2; move: m_x_not_None. + by case: (m.[x]). + by move=> [] a; rewrite -h2 => ->. + qed. + + local lemma all_prefixes_of_INV_real c1 c2 m mi p: + INV_Real c1 c2 m mi p => + all_prefixes p. + proof. + move=>[]_[]Hp0 Hmp1 _ l H_dom i. + smt(take_le0 take_oversize size_take take_take take_size nth_take domE). + qed. + + local lemma lemma2' c1 c2 m mi p bl i sa sc: + INV_Real c1 c2 m mi p => + 1 < i => + valid bl => + (sa,sc) \in m => + ! (format bl i) \in p => + p.[format bl (i-1)] = Some (sa,sc) => + INV_Real c1 c2 m mi p.[format bl i <- oget m.[(sa,sc)]]. + proof. + move=>inv0 h1i h_valid H_dom_m H_dom_p H_p_val. + split;have[]//=_[] hmp0 hmp1 hinvm:=inv0;split=>//=. + + by rewrite get_setE;smt(size_cat size_nseq size_ge0). + + move=>l;rewrite mem_set;case;1:smt(all_prefixes_of_INV_real get_setE). + move=>->>j[]hj0 hjsize;rewrite get_setE/=. + have:=hmp1 (format bl (i - 1));rewrite domE H_p_val/==>help. + have:=hjsize;rewrite !size_cat !size_nseq/=!ler_maxr 1:/#=>hjsizei. + have->/=:!take j (format bl i) = format bl i by smt(size_take). + have h:forall k, 0 <= k <= size bl + i - 2 => + take k (format bl (i - 1)) = take k (format bl i). + * move=>k[]hk0 hkjS;rewrite !take_cat;case(k//=hksize;congr. + apply (eq_from_nth witness);1:rewrite!size_take//=1,2:/#!size_nseq!ler_maxr/#. + rewrite!size_take//=1:/#!size_nseq!ler_maxr 1:/#. + pose o:=if _ then _ else _;have->/={o}:o = k - size bl by smt(). + by progress;rewrite!nth_take//= 1,2:/# !nth_nseq//=/#. + case(j < size bl + i - 2)=>hj. + - have:=help j _;1:smt(size_cat size_nseq). + move=>[]b c[]. + have->:nth witness (format bl (i - 1)) j = nth witness (format bl i) j. + + by rewrite-(nth_take witness (j+1)) 1,2:/# eq_sym -(nth_take witness (j+1)) 1,2:/# !h//=/#. + rewrite h 1:/# h 1:/# => -> h';exists b c=>//=;rewrite h'/=get_setE/=. + smt(size_take size_cat size_nseq). + have->>/=:j = size (format bl (i-1)) by smt(size_cat size_nseq). + rewrite get_setE/=. + have h':size (format bl (i-1)) = size bl + i - 2 by smt(size_cat size_nseq). + rewrite h'/=. + have h'':(size bl + i - 1) = size (format bl i) by smt(size_cat size_nseq). + rewrite h'' take_size/=-h 1:/# -h' take_size. + rewrite nth_cat h';have->/=:! size bl + i - 2 < size bl by smt(). + by rewrite nth_nseq 1:/#; exists sa sc; smt(Block.WRing.AddMonoid.addm0 domE). + qed. + + local lemma take_nseq (a : 'a) i j : + take j (nseq i a) = if j <= i then nseq j a else nseq i a. + proof. + case(0 <= j)=>hj0;last first. + + rewrite take_le0 1:/#;smt(nseq0_le). + case(j <= i)=>hij//=;last smt(take_oversize size_nseq). + apply(eq_from_nth witness). + + smt(size_take size_nseq). + smt(size_nseq size_take nth_take nth_nseq). + qed. + + local lemma take_format (bl : block list) n i : + 0 < n => + 0 <= i < size bl + n => + take i (format bl n) = + if i <= size bl then take i bl else format bl (i - size bl + 1). + proof. + move=>Hn0[]Hi0 Hisize;rewrite take_cat take_nseq. + case(i < size bl)=>//=[/#|H_isize']. + have->/=:i - size bl <= n - 1 by smt(). + case(i = size bl)=>[->>|H_isize'']//=;1:by rewrite nseq0 take_size cats0. + smt(). + qed. + + + local lemma equiv_sponge (D <: DISTINGUISHER {-P, -Redo, -C, -SLCommon.C}) : + equiv [ GReal(A(D)).main + ~ NIndif(Squeeze(SqueezelessSponge(P)),P,DRestr(D)).main + : ={glob D} ==> ={res, glob D, glob P, C.c} /\ SLCommon.C.c{1} <= C.c{2} <= max_size]. + proof. + proc;inline*;sp;wp. + call(: ={Redo.prefixes, glob P, C.c} /\ C.c{1} <= max_size /\ + INV_Real SLCommon.C.c{1} C.c{2} Perm.m{1} Perm.mi{1} Redo.prefixes{1});auto;last first. + + progress. + + exact max_ge0. + + by split=>//=;1:split;smt(mem_empty in_fset0 mem_set get_setE). + by case:H2=>//=. + + by proc;inline*;auto;sp;if;auto;sp;if;auto; + smt(INV_Real_addm_mi INV_Real_incr supp_dexcepted). + + proc;inline*;auto;sp;if;auto;sp;if;auto;progress. + + apply INV_Real_incr=>//=. + apply INV_Real_addm_mi=>//=. + + case:H0=>H_c H_m_p H_invm;rewrite (invm_dom_rng _ _ H_invm)//=. + by move:H3;rewrite supp_dexcepted. + case:H0=>H_c H_m_p H_invm;have<-//:=(invm_dom_rng Perm.mi{2} Perm.m{2}). + by rewrite invmC. + + exact INV_Real_incr. + + proc;inline*;sp;if;auto. + swap 6;wp;sp=>/=;if;auto;last by progress;split;case:H0=>//=;smt(size_ge0). + conseq(: p{2} = bl{2} /\ n{2} = nb{2} /\ lres{2} = [] /\ b{2} = b0 /\ + i{2} = 0 /\ p{1} = bl{1} /\ n{1} = nb{1} /\ lres{1} = [] /\ b{1} = b0 /\ + i{1} = 0 /\ z{2} = [] /\ z{1} = [] /\ ={bl, nb} /\ ={Redo.prefixes} /\ + ={Perm.mi, Perm.m} /\ ={C.c} /\ + INV_Real SLCommon.C.c{1} C.c{2} Perm.m{1} Perm.mi{1} Redo.prefixes{1} /\ + C.c{1} + size bl{1} + max (nb{1} - 1) 0 <= max_size /\ valid p{1} + ==> ={lres} /\ ={Redo.prefixes} /\ ={Perm.mi, Perm.m} /\ + C.c{1} + size bl{1} + max (nb{1} - 1) 0 = + C.c{2} + size bl{2} + max (nb{2} - 1) 0 /\ + INV_Real SLCommon.C.c{1} (C.c{2} + size bl{2} + max (nb{2} - 1) 0) + Perm.m{1} Perm.mi{1} Redo.prefixes{1});progress. + sp. + seq 2 2:(={i,n,p,lres,nb,bl,b,glob P,glob C,glob Redo} + /\ INV_Real SLCommon.C.c{1} (C.c{2} + size bl{2}) + Perm.m{1} Perm.mi{1} Redo.prefixes{1} + /\ (n,p){1} = (nb,bl){1} /\ lres{1} = [] /\ i{1} = 0 + /\ valid p{1} + /\ Redo.prefixes.[p]{1} = Some (b,sc){1}). + + exists* Redo.prefixes{1},SLCommon.C.c{1};elim* => pref count/=. + wp;conseq(:_==> ={i0,p0,i,p,n,nb,bl,sa,lres,C.c,glob Redo,glob Perm} + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = p{1} /\ i0{1} = size p{1} + /\ Redo.prefixes{1}.[take i0{1} p{1}] = Some (sa{1},sc{1}) + /\ INV_Real count C.c{1} Perm.m{1} Perm.mi{1} pref + /\ (forall l, l \in Redo.prefixes{1} => + l \in pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) + /\ (forall l, l \in pref => pref.[l] = Redo.prefixes{1}.[l]) + /\ SLCommon.C.c{1} <= count + i0{1} <= C.c{1} + i0{1} + /\ (forall j, 0 <= j < i0{1} => + exists b c, Redo.prefixes{1}.[take j p{1}] = Some (b,c) /\ + Perm.m{1}.[(b +^ nth witness p{1} j, c)] = + Redo.prefixes{1}.[take (j+1) p{1}])); + progress. + - have inv0:=H3;have[]h_c1c2[]Hmp0 Hmp1 Hinvm:=inv0;split=>//=. + - case:inv0;smt(size_ge0). + split=>//=. + - smt(domE). + - move=>l H_dom_R i []Hi0 Hisize;have:=H4 l H_dom_R. + case(l \in Redo.prefixes{2})=>H_in_pref//=. + * have:=Hmp1 l H_in_pref i _;rewrite//=. + rewrite ?H5//=;1:smt(domE). + case(i+1 < size l)=>h;1:smt(domE). + by rewrite take_oversize 1:/#. + move=>[]j[][]hj0 hjsize ->>. + have:=Hisize;rewrite size_take 1:/#. + pose k:=if _ then _ else _. + have: k = j by smt(). + move: k=> /> Hij. + by rewrite!take_take!minrE 1:nth_take 1,2:/#;smt(domE). + - smt(get_setE oget_some domE take_oversize). + while( ={i0,p0,i,p,n,nb,bl,sa,sc,lres,C.c,glob Redo,glob Perm} + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = p{1} /\ 0 <= i0{1} <= size p{1} + /\ Redo.prefixes{1}.[take i0{1} p{1}] = Some (sa{1},sc{1}) + /\ INV_Real count C.c{1} Perm.m{1} Perm.mi{1} pref + /\ (forall l, l \in Redo.prefixes{1} => + l \in pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) + /\ (forall l, l \in pref => pref.[l] = Redo.prefixes{1}.[l]) + /\ SLCommon.C.c{1} <= count + i0{1} <= C.c{1} + i0{1} + /\ (i0{1} < size p0{1} => + take (i0{1}+1) p{1} \in Redo.prefixes{1} => + Redo.prefixes{1} = pref) + /\ all_prefixes Redo.prefixes{1} + /\ (forall j, 0 <= j < i0{1} => + exists b c, Redo.prefixes{1}.[take j p{1}] = Some (b,c) /\ + Perm.m{1}.[(b +^ nth witness p{1} j, c)] = + Redo.prefixes{1}.[take (j+1) p{1}]));last first. + + auto;progress. + - exact size_ge0. + - by rewrite take0;have[]_[]->//=:=H. + - smt(). + - by have[]->//=:=H. + - smt(all_prefixes_of_INV_real). + - smt(). + - smt(). + if;auto;progress. + - smt(). + - smt(). + - smt(domE). + - smt(domE). + - smt(). + - smt(). + - smt(all_prefixes_of_INV_real domE take_take size_take). + - case(j < i0{2})=>hj;1:smt(). + have<<-/=:j = i0{2} by smt(). + have->>:=H7 H10 H12. + have[]_[]hmp0 hmp1 _:=H2. + have[]b3 c3:=hmp1 _ H12 j _;1:smt(size_take). + smt(take_take nth_take size_take). + sp;if;auto;progress. + - smt(). + - smt(). + - smt(get_setE domE). + - rewrite INV_Real_addm_mi//=;smt(supp_dexcepted). + - smt(mem_set). + - smt(get_setE domE). + - smt(). + - smt(). + - move:H17;apply absurd=>//=_;rewrite mem_set. + pose x:=_ = _;have->/={x}:x=false by smt(size_take). + move:H12;apply absurd=>//= hpref. + have:= H8 _ hpref (i0{2}+1). + smt(mem_set take_take size_take). + - move=>l;rewrite!mem_set;case=>[H_dom i|->>]/=. + * by rewrite mem_set;smt(). + move=>j; case(0 <= j)=>hj0; rewrite mem_set. + * case: (j <= i0{2}) => hjmax; 2:smt(take_oversize size_take). + left; have-> : take j (take (i0{2}+1) bl{2}) = take j (take i0{2} bl{2}). + * by rewrite 2!take_take !minrE /#. + by apply H8; rewrite domE H1. + rewrite take_le0 1:/#; left. + by rewrite-(take0 (take i0{2} bl{2})) H8 domE H1. + - smt(get_setE domE mem_set). + - smt(get_setE domE). + - smt(). + - smt(get_setE domE). + - smt(mem_set). + - smt(get_setE domE). + - smt(). + - smt(). + - move:H15;apply absurd=>//=_;rewrite mem_set. + pose x:=_ = _;have->/={x}:x=false by smt(size_take). + move:H12;apply absurd=>//=. + have:=take_take bl{2}(i0{2} + 1)(i0{2} + 1 + 1). + rewrite minrE (: i0{2} + 1 <= i0{2} + 1 + 1) 1:/#=><-h. + by rewrite (H8 _ h). + - move=>l;rewrite!mem_set;case=>[H_dom|->>]/=;1:smt(mem_set). + move=>j;rewrite mem_set. + case(0 <= j)=>hj0; last first. + * rewrite take_le0 1:/#; left. + by rewrite-(take0 (take i0{2} bl{2})) H8 domE H1. + case(j < i0{2} + 1)=>hjiS;2:smt(domE take_take). + rewrite take_take/min hjiS//=;left. + have:=(take_take bl{2} j i0{2}). + rewrite minrE (: j <= i0{2}) 1:/#=><-. + smt(all_prefixes_of_INV_real domE). + - smt(get_setE domE mem_set). + sp;case(0 < n{1});last first. + - rcondf{1}1;2:rcondf{2}1;auto;1:smt(). + splitwhile{1} 1 : i + 1 < n;splitwhile{2} 1 : i + 1 < n. + rcondt{1}2;2:rcondt{2}2;auto;progress. + + while(i < n);auto. + by sp;if;auto;sp;while(i < n);auto;if;auto;sp;if;auto. + + while(i < n);auto. + by sp;if;auto;sp;while(i < n);auto;if;auto;sp;if;auto. + rcondf{1}4;2:rcondf{2}4;auto. + + while(i < n);auto;2:smt(). + by sp;if;auto;sp;while(i < n);auto;if;auto;sp;if;auto. + + while(i < n);auto;2:smt(). + by sp;if;auto;sp;while(i < n);auto;if;auto;sp;if;auto. + rcondf{1}4;2:rcondf{2}4;1,2:auto. + + while(i < n);auto;2:smt(). + by sp;if;auto;sp;while(i < n);auto;if;auto;sp;if;auto. + + while(i < n);auto;2:smt(). + by sp;if;auto;sp;while(i < n);auto;if;auto;sp;if;auto. + conseq(:_==> ={i,n,p,lres,nb,bl,b,glob P,glob C,glob Redo} + /\ INV_Real SLCommon.C.c{1} (C.c{2} + size bl{2} + i{1} - 1) + Perm.m{1} Perm.mi{1} Redo.prefixes{1} + /\ i{1} = n{1});1:smt();wp. + conseq(:_==> ={i,n,p,lres,nb,bl,b,glob P,glob C,glob Redo} + /\ INV_Real SLCommon.C.c{1} (C.c{2} + size bl{2} + i{1}) + Perm.m{1} Perm.mi{1} Redo.prefixes{1} + /\ i{1}+1 = n{1});1:smt(). + while(={i,n,p,lres,nb,bl,b,glob P,glob C,glob Redo} + /\ INV_Real SLCommon.C.c{1} (C.c{2} + size bl{2} + i{1}) + Perm.m{1} Perm.mi{1} Redo.prefixes{1} + /\ (n,p){1} = (nb,bl){1} /\ 0 < i{1}+1 <= n{1} + /\ valid p{1} + /\ (exists c2, Redo.prefixes.[format p (i+1)]{1} = Some (b,c2){1})); + last by auto;smt(nseq0 cats0). + sp;rcondt{1}1;2:rcondt{2}1;auto. + sp. + splitwhile{1} 1 : i1 < size p1 - 1;splitwhile{2} 1 : i1 < size p1 - 1. + rcondt{1}2;2:rcondt{2}2;1,2:by auto; + while(i1 < size p1);auto;1:if;2:(sp;if);auto;smt(size_cat size_nseq size_ge0). + rcondf{1}4;2:rcondf{2}4;1,2:by auto; + seq 1 : (i1 = size p1 - 1);1:(auto; + while(i1 < size p1);auto;1:if;2:(sp;if);auto;smt(size_cat size_nseq size_ge0)); + if;sp;2:if;auto;smt(size_cat size_nseq size_ge0). + wp=>//=. + wp;conseq(:_==> ={sa0,sc0,glob Redo,glob Perm} + /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1}) + Perm.m{1} Perm.mi{1} Redo.prefixes{1} + /\ (format p{1} i{1} \in Redo.prefixes{1}) + /\ exists (c2 : capacity), Redo.prefixes{1}.[format p{1} (i{1}+1)] = Some (sa0{1}, c2));progress. + + smt(size_ge0). + + smt(size_ge0). + + smt(). + seq 1 1 : (={nb,bl,n,p,p1,i,i1,lres,sa0,sc0,C.c,glob Redo,glob Perm} + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p1{1} = format p{1} (i{1}+1) + /\ 1 <= i{1} < n{1} /\ valid p{1} /\ i1{1} = size p1{1} - 1 + /\ Redo.prefixes{1}.[format p{1} i{1}] = Some (sa0{1},sc0{1}) + /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{1} + Redo.prefixes{1});last first. + + if;auto;progress. + - by split;case:H3=>//=;smt(). + - by rewrite domE H2//=. + - move:H4;rewrite take_size /= domE=> h. + exists (oget Redo.prefixes{2}.[format bl{2} (i{2} + 1)]).`2; move: h. + by case: (Redo.prefixes{2}.[format bl{2} (i{2} + 1)]); smt(). + sp;if;auto;progress. + - move:H4 H5;rewrite!get_setE/= nth_last/=take_size. + rewrite last_cat last_nseq 1:/# Block.WRing.addr0;progress. + have//=:=lemma2'(SLCommon.C.c{1} + 1)(C.c{2} + size bl{2} + i{2}) + Perm.m{2}.[(sa0_R, sc0{2}) <- y2L] Perm.mi{2}.[y2L <- (sa0_R, sc0{2})] + Redo.prefixes{2} bl{2} (i{2}+1) sa0_R sc0{2}. + rewrite H1/=!mem_set/=H4/=H2/=get_setE/=. + have->->//=:y2L = (y2L.`1, y2L.`2);1,-1:smt(). + rewrite INV_Real_addm_mi//=;2:smt(supp_dexcepted). + by have:=H3=>hinv0;split;case:hinv0=>//=/#. + - by rewrite mem_set//=take_size domE H2. + - by rewrite!get_setE take_size/=;smt(). + - move:H4 H5;rewrite nth_last take_size. + rewrite last_cat last_nseq 1:/# Block.WRing.addr0;progress. + pose a:=(_, _);have->/={a}:a = oget Perm.m{2}.[(sa0_R, sc0{2})] by smt(). + apply lemma2'=>//=;first have:=H3=>hinv0;split;case:hinv0=>//=/#. + smt(). + - by rewrite mem_set//=take_size;smt(domE). + - by rewrite!get_setE/=take_size/=;smt(). + alias{1} 1 pref = Redo.prefixes;sp;alias{1} 1 count = SLCommon.C.c. + alias{1} 1 pm = Perm.m;sp;alias{1} 1 pmi = Perm.mi;sp. + conseq(:_==> ={nb,bl,n,p,p1,i,i1,lres,sa0,sc0,C.c,glob Redo,glob Perm} + /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} + /\ pref{1} = Redo.prefixes{1} /\ SLCommon.C.c{1} = count{1} + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p1{1} = format p{1} (i{1}+1) + /\ i1{1} = size p1{1} - 1 + /\ Redo.prefixes{1}.[format p{1} (i1{1} - size p{1} + 1)] = + Some (sa0{1}, sc0{1}));progress. + + smt(). + + by move: H8; rewrite size_cat size_nseq /= ler_maxr /#. + + move:H8;rewrite size_cat size_nseq/=/max H0/=;smt(). + splitwhile{1}1:i1 < size p;splitwhile{2}1:i1 < size p. + while(={nb,bl,n,p,p1,i,i1,lres,sa0,sc0,C.c,glob Redo,glob Perm} + /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 1) + Perm.m{1} Perm.mi{1} Redo.prefixes{1} + /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} + /\ pref{1} = Redo.prefixes{1} /\ SLCommon.C.c{1} = count{1} + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p1{1} = format p{1} (i{1}+1) + /\ (format p{1} i{1} \in Redo.prefixes{1}) + /\ size p{1} <= i1{1} <= size p1{1} - 1 /\ valid p{1} + /\ Redo.prefixes{1}.[format p{1} (i1{1} - size p{1} + 1)] = + Some (sa0{1}, sc0{1})). + + rcondt{1}1;2:rcondt{2}1;auto;progress. + + have->:take (i1{m} + 1) (format bl{m} (i{m} + 1)) = + take (i1{m} + 1) (format bl{m} i{m});2:smt(all_prefixes_of_INV_real). + smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). + + have->:take (i1{hr} + 1) (format bl{hr} (i{hr} + 1)) = + take (i1{hr} + 1) (format bl{hr} i{hr});2:smt(all_prefixes_of_INV_real). + smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). + + smt(). + + smt(size_cat size_nseq). + + have->:take (i1{2} + 1) (format bl{2} (i{2} + 1)) = + take (i1{2} + 1) (format bl{2} i{2}). + - smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). + have->:format bl{2} (i1{2} + 1 - size bl{2} + 1) = + take (i1{2} + 1) (format bl{2} i{2}). + - smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). + have all_pref:=all_prefixes_of_INV_real _ _ _ _ _ H. + by have:=all_pref _ H0 (i1{2}+1); rewrite domE; smt(). + conseq(:_==> ={nb,bl,n,p,p1,i,i1,lres,sa0,sc0,C.c,glob Redo,glob Perm} + /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 1) + Perm.m{1} Perm.mi{1} Redo.prefixes{1} + /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} + /\ pref{1} = Redo.prefixes{1} /\ SLCommon.C.c{1} = count{1} + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p1{1} = format p{1} (i{1}+1) + /\ (format p{1} i{1} \in Redo.prefixes{1}) + /\ i1{1} = size p{1} /\ valid p{1} + /\ Redo.prefixes{1}.[take i1{1} p{1}] = Some (sa0{1}, sc0{1})); + 1:smt(size_cat size_nseq nseq0 cats0 take_size). + while(={nb,bl,n,p,p1,i,i1,lres,sa0,sc0,C.c,glob Redo,glob Perm} + /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 1) + Perm.m{1} Perm.mi{1} Redo.prefixes{1} + /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} + /\ pref{1} = Redo.prefixes{1} /\ SLCommon.C.c{1} = count{1} + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p1{1} = format p{1} (i{1}+1) + /\ (format p{1} i{1} \in Redo.prefixes{1}) + /\ 0 <= i1{1} <= size p{1} /\ valid p{1} + /\ Redo.prefixes{1}.[take i1{1} p{1}] = Some (sa0{1}, sc0{1}));last first. + + auto;progress. + - smt(). + - have[]_[]:=H;smt(domE). + - exact size_ge0. + - have[]_[]:=H;smt(domE take0). + - smt(size_cat size_nseq). + rcondt{1}1;2:rcondt{2}1;auto;progress. + - have->:take (i1{m} + 1) (format bl{m} (i{m} + 1)) = + take (i1{m} + 1) (format bl{m} i{m});2:smt(all_prefixes_of_INV_real). + smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). + - have->:take (i1{hr} + 1) (format bl{hr} (i{hr} + 1)) = + take (i1{hr} + 1) (format bl{hr} i{hr});2:smt(all_prefixes_of_INV_real). + smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). + - smt(). + - smt(). + - have->:take (i1{2} + 1) (format bl{2} (i{2} + 1)) = + take (i1{2} + 1) (format bl{2} i{2}) + by smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). + have->:take (i1{2} + 1) bl{2} = + take (i1{2} + 1) (format bl{2} i{2}) + by smt(take_cat take_le0 cats0). + smt(all_prefixes_of_INV_real). + qed. + + + local lemma lemma4 c c' m mi p bl i sa sc: + INV_Real c c' m mi p => + 0 < i => + p.[format bl i] = Some (sa,sc) => + format bl (i+1) \in p => + p.[format bl (i+1)] = m.[(sa,sc)]. + proof. + move=>inv0 H_i0 H_p_i H_dom_iS. + have[]_[]_ hmp1 _ :=inv0. + have:=hmp1 (format bl (i+1)) H_dom_iS=>help. + have:=help (size (format bl i)) _;1:smt(size_ge0 size_cat size_nseq). + move=>[]b3 c3;rewrite!take_format;..4:smt(size_ge0 size_cat size_nseq). + have->/=:!size (format bl i) + 1 <= size bl by smt(size_cat size_nseq size_ge0). + rewrite nth_cat. + have->/=:!size (format bl i) < size bl by smt(size_cat size_ge0). + rewrite nth_nseq 1:size_cat 1:size_nseq 1:/#. + pose x:=if _ then _ else _;have->/={x}:x = format bl i. + + rewrite/x;case(i = 1)=>//=[->>|hi1]. + - by rewrite/format/=nseq0 cats0//=take_size. + by rewrite size_cat size_nseq/#. + pose x:=List.size _ + 1 - List.size _ + 1;have->/={x}:x=i+1 + by rewrite/x size_cat size_nseq;smt(). + rewrite H_p_i=>[]/=[][]->>->>. + by rewrite Block.WRing.addr0=>H_pm;rewrite H_pm/=. + qed. + + local lemma lemma_3 c1 c2 m mi p bl b (sa:block) sc: + INV_Real c1 c2 m mi p => + (sa +^ b,sc) \in m => + ! rcons bl b \in p => + p.[bl] = Some (sa,sc) => + INV_Real c1 c2 m mi p.[rcons bl b <- oget m.[(sa +^ b,sc)]]. + proof. + move=>inv0 H_dom_m H_dom_p H_p_val. + split;have[]//=_[] hmp0 hmp1 hinvm:=inv0;split=>//=. + + by rewrite get_setE;smt(size_cat size_nseq size_ge0). + + move=>l;rewrite mem_set;case;1:smt(all_prefixes_of_INV_real get_setE). + move=>->>j[]hj0 hjsize;rewrite get_setE/=. + have:=hmp1 bl;rewrite domE H_p_val/==>help. + have->/=:!take j (rcons bl b) = rcons bl b by smt(size_take). + move:hjsize;rewrite size_rcons=>hjsize. + rewrite-cats1 !take_cat. + pose x := if _ then _ else _;have->/={x}: x = take j bl by smt(take_le0 cats0 take_size). + rewrite nth_cat. + case(j < size bl)=>//=hj;last first. + + have->>/=:j = size bl by smt(). + by rewrite take_size H_p_val/=;exists sa sc=>//=;smt(get_setE). + have->/=:j + 1 - size bl <= 0 by smt(). + rewrite cats0. + pose x := if _ then _ else _;have->/={x}: x = take (j+1) bl by smt(take_le0 cats0 take_size). + have:=hmp1 bl;rewrite domE H_p_val/==>hep. + have:=hep j _;rewrite//=;smt(get_setE size_cat size_take). + qed. + + + + local lemma squeeze_squeezeless (D <: DISTINGUISHER {-P, -Redo, -C, -SLCommon.C}) : + equiv [ NIndif(Squeeze(SqueezelessSponge(P)),P,DRestr(D)).main + ~ RealIndif(Sponge,P,DRestr(D)).main + : ={glob D} ==> ={res, glob P, glob D, C.c} /\ C.c{1} <= max_size]. + proof. + proc;inline*;sp;wp. + call(: ={glob Perm,C.c} /\ C.c{1} <= max_size + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1});auto;last first. + + progress. + + exact max_ge0. + split=>//=;1:split=>//=;smt(get_setE mem_empty emptyE in_fset0 mem_set). + + proc;inline*;auto;sp;if;auto;sp;if;auto;progress. + - by rewrite INV_Real_addm_mi;2..:smt(supp_dexcepted);split;case:H0=>//=;smt(). + - by split;case:H0=>//=;smt(). + + proc;inline*;auto;sp;if;auto;sp;if;auto;progress. + - rewrite INV_Real_addm_mi;1: by split;case:H0=>//=;smt(). + * case:H0;smt(invm_dom_rng invmC supp_dexcepted). + case:H0;smt(invm_dom_rng invmC supp_dexcepted). + - by split;case:H0=>//=;smt(). + proc;inline*;sp;auto;if;auto;sp;if;auto; + last by progress;split;case:H0=>//=;smt(size_ge0). + conseq(: (exists (c_R : int), + C.c{2} = c_R + size bl{2} + max (nb{2} - 1) 0 /\ xs{2} = bl{2} /\ + n{2} = nb{2} /\ z0{2} = [] /\ sc{2} = c0 /\ sa{2} = b0 /\ i{2} = 0 /\ + exists (c_L : int), C.c{1} = c_L + size bl{1} + max (nb{1} - 1) 0 /\ + p{1} = bl{1} /\ n{1} = nb{1} /\ lres{1} = [] /\ b{1} = b0 /\ + i{1} = 0 /\ z{2} = [] /\ z{1} = [] /\ ={bl, nb} /\ + ={Perm.mi, Perm.m} /\ c_L = c_R /\ + INV_Real 0 c_L Perm.m{1} Perm.mi{1} Redo.prefixes{1} /\ valid p{1}) + ==> lres{1} = z0{2} /\ ={Perm.mi, Perm.m} /\ ={C.c} /\ + INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1});1,2:smt(). + sp. + seq 2 1 : (={glob P, i, n, C.c,sa,sc} + /\ b{1} = sa{2} /\ Redo.prefixes.[p]{1} = Some (sa,sc){2} + /\ lres{1} = z0{2} /\ i{1} = 0 /\ valid p{1} + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1}). + + conseq(:_==> ={glob P, n, C.c,sa,sc} /\ b{1} = sa{2} /\ i0{1} = size p0{1} + /\ Redo.prefixes{1}.[take i0{1} p0{1}] = Some (sa{1}, sc{1}) + /\ lres{1} = z0{2} /\ xs{2} = drop i0{1} p0{1} + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1});1:smt(take_size drop_size). + wp;while(={glob P, n, C.c,sa,sc} /\ sa{1} = sa{2} /\ sc{1} = sc{2} + /\ 0 <= i0{1} <= size p0{1} + /\ Redo.prefixes{1}.[take i0{1} p0{1}] = Some (sa{1}, sc{1}) + /\ lres{1} = z0{2} /\ xs{2} = drop i0{1} p0{1} + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1}). + + if{1};auto. + + sp;rcondf{2}1;auto;progress. + + rewrite head_nth nth_drop//=. + have[]_[]_ hmp1 _ :=H2;have:=hmp1 _ H5 i0{m} _;1:smt(size_take). + move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !minrE //= (: i0{m} <= i0{m} + 1) 1:/#. + rewrite H1=>//=[][][]->>->>. + by rewrite nth_onth (onth_nth b0)//=;smt(domE). + + rewrite head_nth nth_drop//=. + have[]_[]_ hmp1 _ :=H2;have:=hmp1 _ H5 i0{1} _;1:smt(size_take). + move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !minrE//= (: i0{1} <= i0{1} + 1) 1:/#. + rewrite H1=>//=[][][]->>->>. + by rewrite nth_onth (onth_nth b0)//=;smt(domE). + + rewrite head_nth nth_drop//=. + have[]_[]_ hmp1 _ :=H2;have:=hmp1 _ H5 i0{1} _;1:smt(size_take). + move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !minrE //= (: i0{1} <= i0{1} + 1) 1:/#. + rewrite H1=>//=[][][]->>->>. + by rewrite nth_onth (onth_nth b0)//=;smt(domE). + + rewrite head_nth nth_drop//=. + have[]_[]_ hmp1 _ :=H2;have:=hmp1 _ H5 i0{1} _;1:smt(size_take). + move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !minrE //= (: i0{1} <= i0{1} + 1) 1:/#. + rewrite H1=>//=[][][]->>->>. + by rewrite nth_onth (onth_nth b0)//=;smt(domE). + + rewrite head_nth nth_drop//=. + have[]_[]_ hmp1 _ :=H2;have:=hmp1 _ H5 i0{1} _;1:smt(size_take). + move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !minrE //= (: i0{1} <= i0{1} + 1) 1:/#. + rewrite H1=>//=[][][]->>->>. + by rewrite nth_onth (onth_nth b0)//=;smt(domE). + + smt(). + + smt(). + + smt(). + + smt(behead_drop drop_add). + + smt(size_drop size_eq0). + + smt(size_drop size_eq0). + sp=>//=. + if;auto;progress. + + by rewrite head_nth nth_drop //=nth_onth (onth_nth witness)//=. + + by move:H6;rewrite head_nth nth_drop //=nth_onth (onth_nth witness)//=. + + by rewrite head_nth nth_drop //=nth_onth (onth_nth b0)//=. + + by rewrite head_nth nth_drop //=nth_onth (onth_nth b0)//=. + + by rewrite head_nth nth_drop //=nth_onth (onth_nth b0)//=. + + by rewrite head_nth nth_drop //=nth_onth (onth_nth b0)//=. + + by rewrite head_nth nth_drop //=nth_onth (onth_nth b0)//=. + + by rewrite head_nth nth_drop //=nth_onth (onth_nth b0)//=. + + smt(). + + smt(). + + by rewrite get_setE/=. + + by rewrite behead_drop drop_add. + + rewrite!get_setE/=. + have:=lemma_3 0 C.c{2}Perm.m{2}.[(sa{2} +^ nth witness p0{1} i0{1}, sc{2}) <- yL] + Perm.mi{2}.[yL <- (sa{2} +^ nth witness p0{1} i0{1}, sc{2})] Redo.prefixes{1} + (take i0{1} p0{1}) (nth witness p0{1} i0{1}) sa{2} sc{2}. + rewrite!mem_set/=-take_nth//=H5/=H1/=get_setE/=. + have->->//=:(yL.`1, yL.`2) = yL by smt(). + rewrite INV_Real_addm_mi=>//=;smt(supp_dexcepted). + + smt(size_drop size_eq0). + + smt(size_drop size_eq0). + + by rewrite head_nth nth_drop //=nth_onth (onth_nth b0)//=. + + by rewrite head_nth nth_drop //=nth_onth (onth_nth b0)//=. + + by rewrite head_nth nth_drop //=nth_onth (onth_nth b0)//=. + + by rewrite head_nth nth_drop //=nth_onth (onth_nth b0)//=. + + smt(). + + smt(). + + by rewrite get_setE. + + by rewrite behead_drop drop_add. + + rewrite(take_nth witness)//=. + have:=lemma_3 0 C.c{2} Perm.m{2} Perm.mi{2} Redo.prefixes{1} + (take i0{1} p0{1}) (nth witness p0{1} i0{1}) sa{2} sc{2}. + by rewrite-take_nth//= H5/=H1/=H2/=H6/=;smt(). + + smt(size_drop size_eq0). + + smt(size_drop size_eq0). + auto;progress. + + exact size_ge0. + + by rewrite take0;have[]_[]->:=H. + + by rewrite drop0. + + split;case:H=>//=;smt(size_ge0). + + smt(size_ge0 size_eq0). + + smt(size_ge0 size_eq0). + + smt(). + case(0 < n{1});last by rcondf{1}1;2:rcondf{2}1;auto;progress. + splitwhile{1} 1 : i + 1 < n;splitwhile{2} 1 : i + 1 < n. + rcondt{1}2;2:rcondt{2}2;auto;progress. + + by while(i ={i,n,glob P,C.c} /\ lres{1} = z0{2} /\ b{1} = sa{2} + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} + /\ Redo.prefixes{1}.[format p{1} (i{1}+1)] = Some (sa,sc){2});progress. + while(={i,n,glob P,C.c} /\ lres{1} = z0{2} /\ b{1} = sa{2} /\ 0 <= i{1} < n{1} + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} /\ valid p{1} + /\ Redo.prefixes{1}.[format p{1} (i{1}+1)] = Some (sa,sc){2});last first. + + auto;1:smt(nseq0 cats0). + sp;if;auto;sp. + splitwhile{1}1: i1 < size p1 - 1. + rcondt{1}2;2:rcondf{1}4;1,2:auto. + + while(i1 < size p1);auto;2:smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). + by if;auto;1:smt();sp;if;auto;progress;smt(). + + seq 1 : (i1 = size p1 - 1). + - while(i1 < size p1);auto;2:smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). + by if;auto;1:smt();sp;if;auto;progress;smt(). + if;auto;sp;if;auto;smt(). + seq 1 0 : (={i,n,glob P,C.c} /\ x0{2} = (sa{2}, sc{2}) /\ 0 < i{1} < n{1} + /\ p1{1} = format p{1} (i{1} + 1) /\ (sa0,sc0){1} = x0{2} + /\ i1{1} = size p{1} + i{1} - 1 /\ lres{1} = z0{2} /\ valid p{1} + /\ Redo.prefixes{1}.[format p{1} i{1}] = Some (sa{2}, sc{2}) + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} + /\ valid p{1});last first. + + if{1};auto. + + rcondf{2}1;auto;progress. + + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq ler_maxr/#. + move=>H_dom;rewrite domE. + by have<-:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;rewrite-domE. + + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq ler_maxr/#;move=>H_dom. + by have:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;smt(domE). + + smt(). + + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq ler_maxr/#;move=>H_dom. + by have:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;smt(domE). + sp;if;auto;progress. + + move:H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). + have->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). + by rewrite Block.WRing.addr0. + + move:H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). + have->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). + by rewrite Block.WRing.addr0. + + move:H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). + have->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). + by rewrite Block.WRing.addr0. + + move:H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). + have->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). + by rewrite Block.WRing.addr0. + + move:H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). + have->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). + by rewrite Block.WRing.addr0. + + smt(). + + move:H5 H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). + have->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). + rewrite Block.WRing.addr0 !get_setE/= take_oversize;1:rewrite size_cat size_nseq/#. + move=>H_dom_iS H_dom_p. + have:=lemma2' 0 C.c{2} Perm.m{2}.[(sa{2}, sc{2}) <- y0L] + Perm.mi{2}.[y0L <- (sa{2}, sc{2})] Redo.prefixes{1} + p{1} (i{2}+1) sa{2} sc{2} _ _ H4 _ H_dom_iS. + + by rewrite INV_Real_addm_mi//=;smt(supp_dexcepted). + + smt(). + + by rewrite mem_set. + by rewrite!get_setE/=H2/=;smt(). + + by rewrite!get_setE/=take_oversize//=size_cat size_nseq/#. + + rewrite nth_cat;have->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). + by rewrite nth_nseq//=1:/# Block.WRing.addr0. + + smt(). + + move:H5 H6;rewrite take_oversize 1:size_cat 1:size_nseq 1:/#. + rewrite nth_cat;have->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). + rewrite nth_nseq//=1:/# Block.WRing.addr0 =>h1 h2. + by have:=lemma2' 0 C.c{2} Perm.m{2} Perm.mi{2} Redo.prefixes{1} + p{1} (i{2}+1) sa{2} sc{2} H3 _ H1 h2 h1;smt(). + + move:H5 H6;rewrite take_oversize 1:size_cat 1:size_nseq 1:/#. + rewrite nth_cat;have->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). + by rewrite nth_nseq//=1:/# Block.WRing.addr0 !get_setE//=. + alias{1} 1 pref = Redo.prefixes;sp. + conseq(:_==> ={glob P} + /\ p1{1} = format p{1} (i{1} + 1) /\ pref{1} = Redo.prefixes{1} + /\ i1{1} = size p1{1} - 1 + /\ Redo.prefixes{1}.[take i1{1} p1{1}] = Some (sa0{1}, sc0{1}) + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1});progress. + + smt(). + + move:H9;rewrite take_format/=1:/#;1:smt(size_ge0 size_cat size_nseq). + pose x := if _ then _ else _ ;have->/={x}: x = format p{1} (i_R+1). + + rewrite/x size_cat size_nseq/=!ler_maxr 1:/#-(addzA _ _ (-1))-(addzA _ _ (-1))/=. + case(size p{1} + i_R <= size p{1})=>//=h;2:smt(size_ge0 size_cat size_nseq). + have->>/=:i_R = 0 by smt(). + by rewrite take_size/format nseq0 cats0. + by rewrite H3/==>[][]->>->>. + + move:H9;rewrite take_format/=1:/#;1:smt(size_ge0 size_cat size_nseq). + pose x := if _ then _ else _ ;have->/={x}: x = format p{1} (i_R+1). + + rewrite/x size_cat size_nseq/=!ler_maxr 1:/#-(addzA _ _ (-1))-(addzA _ _ (-1))/=. + case(size p{1} + i_R <= size p{1})=>//=h;2:smt(size_ge0 size_cat size_nseq). + have->>/=:i_R = 0 by smt(). + by rewrite take_size/format nseq0 cats0. + by rewrite H3/=. + + by rewrite size_cat size_nseq;smt(). + while{1}(={glob P} /\ 0 <= i1{1} <= size p1{1} - 1 /\ 0 < i{1} < n{1} + /\ p1{1} = format p{1} (i{1} + 1) /\ pref{1} = Redo.prefixes{1} + /\ format p{1} i{1} \in pref{1} + /\ Redo.prefixes{1}.[take i1{1} p1{1}] = Some (sa0{1}, sc0{1}) + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1}) + (size p1{1}-i1{1}-1);auto;last first. + + progress. + + smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). + + smt(). + + by rewrite domE H3. + + by rewrite take0;have[]_[]:=H1. + + smt(). + + smt(). + rcondt 1;auto;progress. + + have->:take (i1{hr} + 1) (format p{hr} (i{hr} + 1)) = + take (i1{hr} + 1) (format p{hr} i{hr});2:smt(all_prefixes_of_INV_real domE). + rewrite!take_format;smt(valid_spec size_ge0 size_eq0 size_cat size_nseq). + + smt(). + + smt(valid_spec size_ge0 size_eq0 size_cat size_nseq). + + have->:take (i1{hr} + 1) (format p{hr} (i{hr} + 1)) = + take (i1{hr} + 1) (format p{hr} i{hr});2:smt(all_prefixes_of_INV_real domE). + rewrite!take_format;smt(valid_spec size_ge0 size_eq0 size_cat size_nseq). + smt(). + qed. + + + + lemma pr_real (D <: DISTINGUISHER{-SLCommon.C, -C, -Perm, -Redo}) &m : + Pr [ GReal(A(D)).main() @ &m : res /\ SLCommon.C.c <= max_size] = + Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res]. + proof. + have->:Pr [ RealIndif(Sponge, P, DRestr(D)).main() @ &m : res ] = + Pr [ NIndif(Squeeze(SqueezelessSponge(P)),P,DRestr(D)).main() @ &m : res /\ C.c <= max_size ]. + + by rewrite eq_sym;byequiv (squeeze_squeezeless D)=>//=. + byequiv (equiv_sponge D)=>//=;progress;smt(). + qed. + +end section Real. + + +section Real_Ideal. + (* REAL & IDEAL *) + declare module D <: DISTINGUISHER {-SLCommon.C, -C, -Perm, -Redo, -F.RO, -F.FRO, -S, -BIRO.IRO, -BIRO2.IRO, -F2.RO, -F2.FRO}. + + declare axiom D_lossless (F0 <: DFUNCTIONALITY{-D}) (P0 <: DPRIMITIVE{-D}) : + islossless P0.f => islossless P0.fi => islossless F0.f => + islossless D(F0, P0).distinguish. + + + lemma A_lossless (F <: SLCommon.DFUNCTIONALITY{-A(D)}) + (P0 <: SLCommon.DPRIMITIVE{-A(D)}) : + islossless P0.f => + islossless P0.fi => islossless F.f => islossless A(D, F, P0).distinguish. + proof. + progress;proc;inline*;sp;wp. + call(:true);auto. + + exact D_lossless. + + proc;inline*;sp;if;auto;call H;auto. + + proc;inline*;sp;if;auto;call H0;auto. + proc;inline*;sp;if;auto;sp;if;auto. + while(true)(n-i);auto. + + by sp;if;auto;1:call H1;auto;smt(). + call H1;auto;smt(). + qed. + + lemma concl &m : + Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res ] <= + Pr [ IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res ] + + (max_size ^ 2 - max_size)%r / 2%r / (2^r)%r / (2^c)%r + + max_size%r * ((2*max_size)%r / (2^c)%r) + + max_size%r * ((2*max_size)%r / (2^c)%r). + proof. + rewrite-(pr_real D &m). + rewrite-(equiv_ideal D &m). + have:=Real_Ideal (A(D)) A_lossless &m. + pose x:=witness;elim:x=>a b. + rewrite/dstate dprod1E DBlock.dunifin1E DCapacity.dunifin1E/= + block_card capacity_card;smt(). + qed. + + +end section Real_Ideal. + + +require import AdvAbsVal. + +section Real_Ideal_Abs. + + declare module D <: DISTINGUISHER {-SLCommon.C, -C, -Perm, -Redo, -F.RO, -F.FRO, -S, -BIRO.IRO, -BIRO2.IRO, -F2.RO, -F2.FRO}. + + declare axiom D_lossless (F0 <: DFUNCTIONALITY{-D}) (P0 <: DPRIMITIVE{-D}) : + islossless P0.f => islossless P0.fi => islossless F0.f => + islossless D(F0, P0).distinguish. + + + local module Neg_D (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + proc distinguish () : bool = { + var b : bool; + b <@ D(F,P).distinguish(); + return !b; + } + }. + + + local lemma Neg_D_lossless (F <: DFUNCTIONALITY{-Neg_D(D)}) (P <: DPRIMITIVE{-Neg_D(D)}) : + islossless P.f => islossless P.fi => + islossless F.f => islossless Neg_D(D, F, P).distinguish. + proof. + by progress;proc;inline*;call(D_lossless F P H H0 H1);auto. + qed. + + + local lemma useful m mi a : + invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). + proof. + move=>hinvm nin_dom. + have prod_ll:Distr.is_lossless (bdistr `*` cdistr). + + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. + apply dexcepted_ll=>//=;rewrite-prod_ll. + have->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. + rewrite Distr.mu_disjoint 1:predCI//= RField.addrC. + have/=->:=ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. + rewrite Distr.witness_support/predC. + move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. + have{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + move:a. + have:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. + have->//=:fdom m \subset frng m. + + by move=> x; rewrite mem_fdom mem_frng hyp. + smt(mem_fdom mem_frng). + qed. + + local lemma invmC (m mi : (state, state) fmap) : + invm m mi <=> invm mi m. + proof. smt(). qed. + + + local lemma Real_lossless : + islossless RealIndif(Sponge, P, DRestr(Neg_D(D))).main. + proof. + proc;inline*;auto;call(: invm Perm.m Perm.mi);2..:auto. + + exact D_lossless. + + proc;inline*;sp;if;auto;sp;if;auto;progress. + - by have:=useful _ _ _ H H1. + - smt(invm_set dexcepted1E). + + proc;inline*;sp;if;auto;sp;if;auto;progress. + - have:=H;rewrite invmC=>h;have/#:=useful _ _ _ h H1. + - move:H;rewrite invmC=>H;rewrite invmC;smt(invm_set dexcepted1E domE rngE). + + proc;inline*;sp;if;auto;sp;if;auto. + while(invm Perm.m Perm.mi)(n-i);auto. + - sp;if;auto;2:smt();sp;if;auto;2:smt();progress. + * by have:=useful _ _ _ H H2. + * smt(invm_set dexcepted1E). + smt(). + conseq(:_==> invm Perm.m Perm.mi);1:smt(). + while(invm Perm.m Perm.mi)(size xs);auto. + - sp;if;auto;progress. + * by have:=useful _ _ _ H H1. + * smt(invm_set dexcepted1E). + * smt(size_behead). + * smt(size_behead). + smt(size_ge0 size_eq0). + smt(emptyE). + qed. + + + local lemma Ideal_lossless : + islossless IdealIndif(BIRO.IRO, SimLast(S), DRestr(Neg_D(D))).main. + proof. + proc;inline*;auto;call(D_lossless (FC(BIRO.IRO)) (PC(SimLast(S, BIRO.IRO))) _ _ _);auto. + + proc;inline*;sp;if;auto;sp;if;auto;sp;if;auto;2:smt(DBlock.dunifin_ll DCapacity.dunifin_ll). + sp;if;auto;sp;if;auto;2,4:smt(DBlock.dunifin_ll DCapacity.dunifin_ll). + * while(true)(n-i);auto;2:smt(DBlock.dunifin_ll DCapacity.dunifin_ll). + by sp;if;auto;smt(DBlock.dunifin_ll). + while(true)(n0-i0);auto;2:smt(DBlock.dunifin_ll DCapacity.dunifin_ll). + by sp;if;auto;smt(DBlock.dunifin_ll). + + by proc;inline*;sp;if;auto;sp;if;auto;smt(DBlock.dunifin_ll DCapacity.dunifin_ll). + proc;inline*;sp;if;auto;sp;if;auto;while(true)(n-i);auto;2:smt(). + by sp;if;auto;smt(DBlock.dunifin_ll). + qed. + + + + + local lemma neg_D_concl &m : + Pr [ IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res ] <= + Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res ] + + (max_size ^ 2 - max_size)%r / 2%r / (2^r)%r / (2^c)%r + + max_size%r * ((2*max_size)%r / (2^c)%r) + + max_size%r * ((2*max_size)%r / (2^c)%r). + proof. + have->:Pr[IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res] = + Pr[Neg_main(IdealIndif(BIRO.IRO, SimLast(S), DRestr(Neg_D(D)))).main() @ &m : res]. + + by byequiv=>//=;proc;inline*;auto;conseq(:_==> b0{1} = b2{2});progress;sim. + have->:Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res ] = + Pr [ Neg_main(RealIndif(Sponge,P,DRestr(Neg_D(D)))).main() @ &m : res ]. + + by byequiv=>//=;proc;inline*;auto;conseq(:_==> b0{1} = b2{2});progress;sim. + have h1 := Neg_A_Pr_minus (RealIndif(Sponge,P,DRestr(Neg_D(D)))) &m Real_lossless. + have h2 := Neg_A_Pr_minus (IdealIndif(BIRO.IRO, SimLast(S), DRestr(Neg_D(D)))) &m Ideal_lossless. + have/#:=concl (Neg_D(D)) _ &m;progress. + by proc;call(D_lossless F0 P0 H H0 H1);auto. + qed. + + lemma Inefficient_Real_Ideal &m : + `|Pr [ RealIndif(Sponge,Perm,DRestr(D)).main() @ &m : res ] - + Pr [ IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res ]| <= + (max_size ^ 2 - max_size)%r / 2%r / (2^r)%r / (2^c)%r + + max_size%r * ((2*max_size)%r / (2^c)%r) + + max_size%r * ((2*max_size)%r / (2^c)%r). + proof. + have := concl D D_lossless &m. + have := neg_D_concl &m. + pose p1 := Pr[IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res]. + pose p2 := Pr[RealIndif(Sponge, Perm, DRestr(D)).main() @ &m : res]. + rewrite-5!(RField.addrA). + pose p3 := (max_size ^ 2)%r / 2%r / (2 ^ r)%r / (2 ^ c)%r + + (max_size%r * ((2 * max_size)%r / (2 ^ c)%r) + + max_size%r * ((2 * max_size)%r / (2 ^ c)%r)). + smt(). + qed. + +end section Real_Ideal_Abs. + + + +module Simulator (F : DFUNCTIONALITY) = { + var m : (state, state) fmap + var mi : (state, state) fmap + var paths : (capacity, block list * block) fmap + var unvalid_map : (block list * int, block) fmap + proc init() = { + m <- empty; + mi <- empty; + paths <- empty.[c0 <- ([],b0)]; + unvalid_map <- empty; + } + proc f (x : state) : state = { + var p,v,q,k,cs,y,y1,y2,r; + if (x \notin m) { + if (x.`2 \in paths) { + (p,v) <- oget paths.[x.`2]; + (q,k) <- parse (rcons p (v +^ x.`1)); + if (valid q) { + cs <@ F.f(q, k); + y1 <- last b0 cs; + } else { + if (0 < k) { + if ((q,k-1) \notin unvalid_map) { + r <$ bdistr; + unvalid_map.[(q,k-1)] <- r; + } + y1 <- oget unvalid_map.[(q,k-1)]; + } else { + y1 <- b0; + } + } + } else { + y1 <$ bdistr; + } + y2 <$ cdistr; + y <- (y1,y2); + m.[x] <- y; + mi.[y] <- x; + if (x.`2 \in paths) { + (p,v) <-oget paths.[x.`2]; + paths.[y2] <- (rcons p (v +^ x.`1),y.`1); + } + } else { + y <- oget m.[x]; + } + return y; + } + proc fi (x : state) : state = { + var y,y1,y2; + if (! x \in mi) { + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + mi.[x] <- y; + m.[y] <- x; + } else { + y <- oget mi.[x]; + } + return y; + } +}. + +section Simplify_Simulator. + +declare module D <: DISTINGUISHER {-Simulator, -F.RO, -BIRO.IRO, -C, -S, -BIRO2.IRO}. + +declare axiom D_lossless (F0 <: DFUNCTIONALITY{-D}) (P0 <: DPRIMITIVE{-D}) : + islossless P0.f => islossless P0.fi => islossless F0.f => + islossless D(F0, P0).distinguish. + +local clone import PROM.FullRO as IRO2 with + type in_t <- block list * int, + type out_t <- block, + op dout _ <- bdistr, + type d_in_t <- unit, + type d_out_t <- bool. +import FullEager. + +local module Simu (FRO : IRO2.RO) (F : DFUNCTIONALITY) = { + proc init() = { + Simulator(F).init(); + FRO.init(); + } + proc f (x : state) : state = { + var p,q,v,k,i,cs,y,y1,y2; + if (x \notin Simulator.m) { + if (x.`2 \in Simulator.paths) { + (p,v) <- oget Simulator.paths.[x.`2]; + (q,k) <- parse (rcons p (v +^ x.`1)); + if (valid q) { + cs <@ F.f(q, k); + y1 <- last b0 cs; + } else { + if (0 < k) { + i <- 0; + while (i < k) { + FRO.sample(q,i); + i <- i + 1; + } + y1 <@ FRO.get(q,k-1); + } else { + y1 <- b0; + } + } + } else { + y1 <$ bdistr; + } + y2 <$ cdistr; + y <- (y1,y2); + Simulator.m.[x] <- y; + Simulator.mi.[y] <- x; + if (x.`2 \in Simulator.paths) { + (p,v) <-oget Simulator.paths.[x.`2]; + Simulator.paths.[y2] <- (rcons p (v +^ x.`1),y.`1); + } + } else { + y <- oget Simulator.m.[x]; + } + return y; + } + proc fi (x : state) : state = { + var y,y1,y2; + if (! x \in Simulator.mi) { + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + Simulator.mi.[x] <- y; + Simulator.m.[y] <- x; + } else { + y <- oget Simulator.mi.[x]; + } + return y; + } +}. + +local module L (F : IRO2.RO) = { + proc distinguish = IdealIndif(BIRO.IRO, Simu(F), DRestr(D)).main +}. + +local lemma equal1 &m : + Pr [ IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res ] = + Pr [ L(IRO2.RO).distinguish() @ &m : res ]. +proof. +byequiv=>//=; proc; inline*; auto. +call (: ={BIRO.IRO.mp,C.c} /\ ={m,mi,paths}(S,Simulator) /\ + BIRO2.IRO.mp{1} = IRO2.RO.m{2} /\ + incl Simulator.unvalid_map{2} BIRO2.IRO.mp{1}); first last. ++ by proc; inline*; conseq=>/>; sim. ++ by proc; inline*; conseq=>/>; sim. ++ by auto. +proc; sp; if; auto. +call(: ={BIRO.IRO.mp} /\ ={m,mi,paths}(S,Simulator) /\ + BIRO2.IRO.mp{1} = IRO2.RO.m{2} /\ + incl Simulator.unvalid_map{2} BIRO2.IRO.mp{1});auto. +if; 1,3: by auto. +seq 1 1: (={BIRO.IRO.mp,y1,x} /\ ={m,mi,paths}(S,Simulator) /\ + BIRO2.IRO.mp{1} = IRO2.RO.m{2} /\ + incl Simulator.unvalid_map{2} BIRO2.IRO.mp{1}); last first. +- by conseq=>/>; auto. +if; 1,3: by auto. +inline*; sp; if; 1,2: auto. +- move=> /> &1 &2 h1 h2 bl n h3 h4 h5 h6 h7 h8. + have:= h1; rewrite-h3 /= => [#] ->>->>. + have:= h4; rewrite-h2 /= => [#] ->>->>. + have->>/=: q{2} = (parse (rcons p{1} (v{1} +^ x{2}.`1))).`1 by smt(). + have->>/=: k{2} = (parse (rcons p{1} (v{1} +^ x{2}.`1))).`2 by smt(). + move: h5; have-> h5:= formatK (rcons p{1} (v{1} +^ x{2}.`1)). + by have->>/=: q{1} = (parse (rcons p{1} (v{1} +^ x{2}.`1))).`1 by smt(). +- sp; if; auto. + * move=> /> &1 &2 h1 h2 bl n h3 h4 h5 h6 h7 h8 h9 h10. + have:= h1; rewrite-h3 /= => [#] ->>->>. + have:= h4; rewrite-h2 /= => [#] ->>->>. + have->>/=: q{2} = (parse (rcons p{1} (v{1} +^ x{2}.`1))).`1 by smt(). + have->>/=: k{2} = (parse (rcons p{1} (v{1} +^ x{2}.`1))).`2 by smt(). + move: h5; have-> h5:= formatK (rcons p{1} (v{1} +^ x{2}.`1)). + by have->>/=: q{1} = (parse (rcons p{1} (v{1} +^ x{2}.`1))).`1 by smt(). + by conseq(:_ ==> ={bs, BIRO.IRO.mp})=> />; sim=> />; smt(parseK formatK). +sp; rcondt{1} 1; 1: auto; if{2}; last first. ++ by rcondf{1} 1; auto; smt(parseK formatK). +sp; rcondf{2} 4; 1: auto. ++ conseq(:_ ==> (q,k-1) \in RO.m)=> />. + splitwhile 1 : i + 1 < k. + rcondt 2; 1:(auto; while (i + 1 <= k); auto; smt()). + rcondf 7; 1:(auto; while (i + 1 <= k); auto; smt()). + seq 1 : (i + 1 = k). + - by while(i + 1 <= k); auto; smt(). + by auto=> />; smt(mem_set). +wp; rnd{2}; wp=> /=; conseq=> />. +conseq(:_==> i{2} = k{2} /\ + (0 < i{2} => last Block.b0 bs0{1} = oget RO.m{2}.[(q{2}, i{2} -1)]) /\ + BIRO2.IRO.mp{1} = RO.m{2} /\ incl Simulator.unvalid_map{2} BIRO2.IRO.mp{1}) =>/>. ++ smt(DBlock.dunifin_ll). +while (i{2} <= k{2} /\ n0{1} = k{2} /\ i0{1} = i{2} /\ x1{1} = q{2} /\ ={k} /\ + (0 < i{2} => last Block.b0 bs0{1} = oget RO.m{2}.[(q{2}, i{2} - 1)]) /\ + BIRO2.IRO.mp{1} = RO.m{2} /\ incl Simulator.unvalid_map{2} BIRO2.IRO.mp{1}). ++ sp; wp 2 2=> /=; conseq=> />. + conseq(:_==> b0{1} = oget RO.m{2}.[(q{2}, i{2})] /\ + BIRO2.IRO.mp{1} = RO.m{2} /\ + incl Simulator.unvalid_map{2} BIRO2.IRO.mp{1}); 1: smt(last_rcons). + if{1}; 2: rcondf{2} 2; 1: rcondt{2} 2; 1,3: auto. + - by auto=> />; smt(incl_upd_nin). + by auto; smt(DBlock.dunifin_ll). +auto=> /> &1 &2 h1 h2 [#] q_L k_L h3 h4 h5 h6 h7 h8 h9 h10;split. ++ have:= h1; rewrite -h3 => [#] />; have:= h4; rewrite -h2 => [#] />. + have:= h5. + have-> : q{2} = (parse (rcons p{1} (v{1} +^ x{2}.`1))).`1 by smt(). + have-> : k{2} = (parse (rcons p{1} (v{1} +^ x{2}.`1))).`2 by smt(). + by rewrite (formatK (rcons p{1} (v{1} +^ x{2}.`1)))=> [#] />; smt(). +smt(). +qed. + + +local lemma equal2 &m : + Pr [ IdealIndif(BIRO.IRO, Simulator, DRestr(D)).main() @ &m : res ] = + Pr [ L(IRO2.LRO).distinguish() @ &m : res ]. +proof. +byequiv=>//=; proc; inline*; auto. +call (: ={BIRO.IRO.mp,C.c,Simulator.m,Simulator.mi,Simulator.paths} /\ + Simulator.unvalid_map{1} = IRO2.RO.m{2}); first last. ++ by proc; inline*; conseq=> />; sim. ++ by proc; inline*; conseq=> />; sim. ++ by auto=> />. +proc; sp; if; auto. +call(: ={BIRO.IRO.mp,Simulator.m,Simulator.mi,Simulator.paths} /\ + Simulator.unvalid_map{1} = IRO2.RO.m{2}); auto. +if; 1,3: auto. +seq 1 1: (={y1,x, BIRO.IRO.mp, Simulator.m, Simulator.mi, Simulator.paths} /\ + Simulator.unvalid_map{1} = RO.m{2}); 2: by (conseq=> />; sim). +if; 1,3: auto; sp. +conseq=> />. +conseq(: ={q, k, BIRO.IRO.mp} /\ Simulator.unvalid_map{1} = RO.m{2} ==> _)=> />. ++ move=> &1 &2 h1 h2 h3 h4 h5 h6. + by have:= h1; rewrite -h3 => [#] /> /#. +inline*; if; 1: auto; 1: sim. +if; 1,3: auto; sp. +swap{2} 4; while{2}((i<=k){2})(k{2}-i{2}); 1: by (auto; smt()). +by sp; if{1}; 2: rcondf{2} 2; 1: rcondt{2} 2; auto; smt(DBlock.dunifin_ll). +qed. + + + +lemma Simplify_simulator &m : + Pr [ IdealIndif(BIRO.IRO, Simulator, DRestr(D)).main() @ &m : res ] = + Pr [ IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res ]. +proof. +rewrite (equal1 &m) (equal2 &m) eq_sym. +by byequiv(RO_LRO_D L _)=> //=; exact/dunifin_ll. +qed. + + +end section Simplify_Simulator. + + + + + +section Real_Ideal. + declare module D <: DISTINGUISHER {-SLCommon.C, -C, -Perm, -Redo, -F.RO, -F.FRO, -S, -BIRO.IRO, -BIRO2.IRO, -F2.RO, -F2.FRO, -Simulator}. + + declare axiom D_lossless (F0 <: DFUNCTIONALITY{-D}) (P0 <: DPRIMITIVE{-D}) : + islossless P0.f => islossless P0.fi => islossless F0.f => + islossless D(F0, P0).distinguish. + + + lemma Real_Ideal &m : + `|Pr [ RealIndif(Sponge,Perm,DRestr(D)).main() @ &m : res ] - + Pr [ IdealIndif(BIRO.IRO, Simulator, DRestr(D)).main() @ &m : res ]| <= + (max_size ^ 2 - max_size)%r / 2%r / (2^r)%r / (2^c)%r + + max_size%r * ((2*max_size)%r / (2^c)%r) + + max_size%r * ((2*max_size)%r / (2^c)%r). + proof. + rewrite(Simplify_simulator D D_lossless &m). + exact/(Inefficient_Real_Ideal D D_lossless &m). + qed. + +end section Real_Ideal. diff --git a/sha3/proof/smart_counter/Gext.eca b/sha3/proof/smart_counter/Gext.eca new file mode 100644 index 0000000..e90c3a1 --- /dev/null +++ b/sha3/proof/smart_counter/Gext.eca @@ -0,0 +1,726 @@ +pragma -oldip. +require import Core Int Real StdOrder Ring StdBigop. +require import List FSet SmtMap Common SLCommon FelTactic Mu_mem. +require import DProd Dexcepted PROM. +(*...*) import Capacity IntID IntOrder Bigreal RealOrder BRA DCapacity. + +require (*..*) Gcol. + +clone export Gcol as Gcol0. + +op bad_ext (m mi:smap) y = + mem (image snd (fdom m)) y \/ + mem (image snd (fdom mi)) y. + +op hinvc (m:(handle,capacity)fmap) (c:capacity) = + find (+ pred1 c) m. + +module G2(D:DISTINGUISHER,HS:FRO) = { + + module M = { + + proc f(p : block list): block = { + var sa, sa'; + var h, i, counter <- 0; + sa <- b0; + while (i < size p ) { + if ((sa +^ nth witness p i, h) \in G1.mh) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + if (counter < size p - prefix p (get_max_prefix p (elems (fdom C.queries)))) { + HS.sample(G1.chandle); + sa' <@ F.RO.get(take (i+1) p); + sa <- sa +^ nth witness p i; + G1.mh.[(sa,h)] <- (sa', G1.chandle); + G1.mhi.[(sa',G1.chandle)] <- (sa, h); + (sa,h) <- (sa',G1.chandle); + G1.chandle <- G1.chandle + 1; + counter <- counter + 1; + } + } + i <- i + 1; + } + sa <@ F.RO.get(p); + return sa; + } + } + + module S = { + + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2, handles_,t; + + if (x \notin G1.m) { + if (x.`2 \in G1.paths) { + (p,v) <- oget G1.paths.[x.`2]; + y1 <@ F.RO.get (rcons p (v +^ x.`1)); + y2 <$ cdistr; + } else { + y1 <$ bdistr; + y2 <$ cdistr; + } + y <- (y1, y2); + + handles_ <@ HS.allKnown(); + if (!rng handles_ x.`2) { + HS.set(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <@ HS.allKnown(); + hx2 <- oget (hinvc handles_ x.`2); + t <@ HS.queried((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); + if ((x.`1, hx2) \in G1.mh /\ t) { + hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; + y2 <@ HS.get(hy2); + G1.bext <- G1.bext \/ bad_ext G1.m G1.mi y2 \/ y2 = x.`2; + y <- (y.`1, y2); + G1.m.[x] <- y; + G1.mi.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + HS.set(hy2, y.`2); + G1.m.[x] <- y; + G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); + G1.mi.[y] <- x; + G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + if (x.`2 \in G1.paths) { + (p,v) <- oget G1.paths.[x.`2]; + G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } + } else { + y <- oget G1.m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2, hx2, hy2, handles_, t; + + if (x \notin G1.mi) { + handles_ <@ HS.allKnown(); + if (!rng handles_ x.`2) { + HS.set(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <@ HS.allKnown(); + hx2 <- oget (hinvc handles_ x.`2); + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + t <@ HS.queried((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); + if ((x.`1, hx2) \in G1.mhi /\ t) { + (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; + y2 <@ HS.get(hy2); + y <- (y.`1, y2); + G1.bext <- G1.bext \/ bad_ext G1.m G1.mi y2 \/ y2 = x.`2; + G1.mi.[x] <- y; + G1.m.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + HS.set(hy2, y.`2); + G1.mi.[x] <- y; + G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); + G1.m.[y] <- x; + G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget G1.mi.[x]; + } + return y; + } + + } + + proc distinguish(): bool = { + var b; + + F.RO.m <- empty; + G1.m <- empty; + G1.mi <- empty; + G1.mh <- empty; + G1.mhi <- empty; + G1.bext <- false; + C.queries<- empty.[[] <- b0]; + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + HS.set(0,c0); + G1.paths <- empty.[c0 <- ([<:block>],b0)]; + G1.chandle <- 1; + b <@ D(M,S).distinguish(); + return b; + } +}. + +clone include EagerCore +proof * by (move=> _; exact/Capacity.DCapacity.dunifin_ll). + +section. + declare module D <: DISTINGUISHER{-G1, -G2, -FRO, -C}. + + op inv_ext (m mi:smap) (FROm:handles) = + exists x h, mem (fdom m `|` fdom mi) x /\ FROm.[h] = Some (x.`2, Unknown). + + op inv_ext1 bext1 bext2 (m mi:smap) (FROm:handles) = + bext1 => (bext2 \/ inv_ext m mi FROm). + + lemma rng_restr (m : ('from, 'to * 'flag) fmap) f x: + rng (restr f m) x <=> rng m (x,f). + proof. + rewrite !rngE;split=>-[z]H;exists z;move:H;rewrite restrP; case m.[z]=>//=. + by move=> [t f'] /=;case (f'=f). + qed. + + equiv G1_G2 : G1(DRestr(D)).main ~ Eager(G2(DRestr(D))).main1 : + ={glob D} ==> ={res} /\ inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2}. + proof. + proc;inline{2} FRO.init G2(D, FRO).distinguish;wp. + inline*;wp. + call (_: ={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,C.queries,C.c} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ + (forall h, h \in FRO.m => h < G1.chandle){1}). + + proc. + sp;if;auto;inline G1(DRestr(D)).S.f G2(DRestr(D), FRO).S.f;sp;wp. + if=>//;last by auto. + seq 2 2: (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,x,x0,y0,C.queries,C.c} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ x{1} = x0{1} /\ + (forall h, h \in FRO.m => h < G1.chandle){1} /\ + x0{1} \notin G1.m{1}). + + by if=>//;auto;call (_: ={F.RO.m});[sim |auto]. + seq 3 5: + (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,hx2,x,x0,y0,hx2,C.queries,C.c} /\ + t{2} = (in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1} /\ x{1} = x0{1} /\ + (G1.bext{1} => (G1.bext{2} \/ (rng FRO.m (x.`2, Unknown)){2} \/ + inv_ext G1.m{2} G1.mi{2} FRO.m{2})) /\ + (forall h, h \in FRO.m => h < G1.chandle){1} /\ + x0{1} \notin G1.m{1}). + + inline *; auto=> |> &ml &mr Hi Hhand. + rewrite -dom_restr rng_restr !rngE /= negb_exists=> /= |> x_notin_G1. + case: (x0{mr})=> b0 c0 /=; split=> [x0K_notinrng_m|h mh]. + + split=> [|/#]. + split=> [[/Hi [-> //|[] x h /= [] H1 H2]|[] h Hh]|h]. + + by right; right; exists x h; rewrite get_setE /#. + + right; left; exists h; rewrite get_set_neqE //=. + by have:= Hhand h; rewrite domE Hh /#. + by rewrite mem_set /#. + split=> [/#|[/Hi [->//|[] x h' /= [] H1 H2]|[] h' Hh']]. + + by right; right; exists x h'. + by right; left; exists h'. + seq 1 1: (={x0,y0,x,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,C.queries,C.c} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ x{1} = x0{1} /\ + forall (h : handle), h \in FRO.m{1} => h < G1.chandle{1});2:by auto. + if=>//. + + inline *;rcondt{2} 4. + + by move=> &m;auto;rewrite /in_dom_with. +(* auto=> |>. (* Bug ???? *) *) + auto;progress. + + rewrite /inv_ext1=>/H{H}[->//|[|[[x1 x2] h [Hx Hh]]]]. + + rewrite rngE/==>[][]h Hh. + case (h = (oget G1.mh{2}.[(x0{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + + by rewrite Hh oget_some/#. + by right;exists x0{2} h; rewrite fdom_set !in_fsetU !in_fset1/= get_set_neqE//. + case (h = (oget G1.mh{2}.[(x0{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + + rewrite Hh /bad_ext oget_some /= <@ Hx;rewrite !inE. + by move=>[|]/(mem_image snd)->. + right;exists (x1,x2) h; move:Hx. + by rewrite !fdom_set !in_fsetU !in_fset1 //= => [][] -> //=; rewrite get_set_neqE. + by move:H5 H2;rewrite /in_dom_with mem_set /#. + inline *;auto;progress;last by move:H3;rewrite mem_set /#. + rewrite /inv_ext1=> /H [->//|[|[x' h [Hx Hh]]]]. + + rewrite rngE=> [][] h Hh. + right;exists x0{2} h; rewrite fdom_set !inE /= get_set_neqE //. + by move:(H0 h);rewrite domE Hh /#. + right;exists x' h; rewrite fdom_set !inE /= !mem_fdom. + move:(H0 h);rewrite domE Hh //= !get_setE => Hh2. + have-> /= : ! h = G1.chandle{2} by smt(). + by rewrite Hh /= mem_set; move: Hx; rewrite in_fsetU !mem_fdom=>[][]->. + + + proc;sp;if;auto;inline G1(DRestr(D)).S.fi G2(DRestr(D), FRO).S.fi;sp;wp. + if=>//;last by auto. + seq 6 8: + (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,hx2,x,x0,y0,hx2,C.queries,C.c} /\ + t{2} = (in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1} /\ x{1} = x0{1} /\ + (G1.bext{1} => (G1.bext{2} \/ (rng FRO.m (x.`2, Unknown)){2} \/ + inv_ext G1.m{2} G1.mi{2} FRO.m{2})) /\ + (forall h, h \in FRO.m => h < G1.chandle){1} /\ + x{1} \notin G1.mi{1}). + + inline *; auto=> |> &ml &mr Hi Hhand. + rewrite -dom_restr rng_restr !rngE /= negb_exists=> /= |> c_le_msize x_notin_G1. + case: (x{mr})=> b c /=; split=> [xK_notinrng_m|h mh]. + + split=> [b0 _ c0 _|/#]. + split=> [[/Hi [-> //|[] x h /= [] H1 H2]|[] h Hh]|h]. + + by right; right; exists x h; rewrite get_setE /#. + + right; left; exists h; rewrite get_set_neqE //=. + by have:= Hhand h; rewrite domE Hh /#. + by rewrite mem_set /#. + split=> [/#|b0 _ c0 _ [/Hi [->//|[] x h' /= [] H1 H2]|[] h' Hh']]. + + by right; right; exists x h'. + by right; left; exists h'. + if=>//. + + inline *;rcondt{2} 4. + + by move=> &m;auto;rewrite /in_dom_with. + auto;progress. + + rewrite /inv_ext1=>/H{H}[->//|[|[[x1 x2] h [Hx Hh]]]]. + + rewrite rngE => [][h]Hh. + case (h = (oget G1.mhi{2}.[(x0{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + + by left;rewrite Hh oget_some. + right; exists x0{2} h; rewrite !in_fsetU !mem_fdom !mem_set /=. + by rewrite get_set_neqE. + case (h = (oget G1.mhi{2}.[(x0{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + + rewrite Hh /bad_ext oget_some /= <@ Hx;rewrite !inE. + by move=>[|]/(mem_image snd)->. + right;exists (x1,x2) h;rewrite !in_fsetU !mem_fdom !mem_set /=. + rewrite get_set_neqE //= Hh /=. + by move: Hx; rewrite in_fsetU !mem_fdom=>[][] ->. + by move:H5 H1;rewrite /in_dom_with mem_set /#. + inline *;auto;progress;last by move:H3;rewrite mem_set /#. + rewrite /inv_ext1=> /H [->//|[|[x' h [Hx Hh]]]]. + + rewrite rngE => [][h]Hh. + right;exists x0{2} h;rewrite get_setE in_fsetU !mem_fdom !mem_set /=. + by move:(H0 h);rewrite domE Hh /#. + right;exists x' h;rewrite get_setE in_fsetU !mem_fdom !mem_set /=. + move:Hx; rewrite in_fsetU 2!mem_fdom=>[][]->//=. + + by move:(H0 h);rewrite domE Hh /#. + by move:(H0 h);rewrite domE Hh /#. + + + proc;sp;if;auto;sp;if;auto;sp. + inline G1(DRestr(D)).M.f G2(DRestr(D), FRO).M.f;sp;wp. + conseq (_: ={sa,G1.mh,G1.mhi,F.RO.m, G1.chandle, FRO.m,C.queries,C.c} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ + forall (h0 : handle), h0 \in FRO.m{1} => h0 < G1.chandle{1})=>//. + sp;call (_: ={F.RO.m});1:by sim. + while (={sa,G1.mh,G1.mhi,F.RO.m,G1.chandle,FRO.m,i,h,sa,p,C.queries,counter,bs} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ p{2} = bs{2} /\ + forall (h0 : handle), h0 \in FRO.m{1} => h0 < G1.chandle{1})=>//. + if=>//;inline *;1:by auto. + if;1,3:auto;progress. + rcondt{2} 3;1:by auto=>/#. + auto;progress. + + move=>bad1;have[/=->//|]:=H bad1;rewrite/inv_ext=>[][]x h[]H_dom Hh;right. + exists x h;rewrite H_dom/= get_set_neqE //=. + by move:(H0 h);rewrite domE Hh /#. + + smt(mem_set). + + move=>bad1;have[/=->//|]:=H bad1;rewrite/inv_ext=>[][]x h[]H_dom Hh;right. + exists x h;rewrite H_dom/= get_set_neqE //=. + by move:(H0 h);rewrite domE Hh /#. + + smt(mem_set). + + (* **************** *) + inline *;auto;progress. + smt(mem_set mem_empty). + qed. + +end section. + +section EXT. + + declare module D <: DISTINGUISHER{-C, -PF, -G1, -G2, -Perm, -RO, -Redo}. + + local module ReSample = { + var count:int + proc f (h:handle) = { + var c; + c <$ cdistr; + if (card (fdom G1.m) <= max_size /\ card (fdom G1.mi) <= max_size + /\ ReSample.count < max_size) { + G1.bext <- G1.bext \/ mem (image snd (fdom G1.m `|` fdom G1.mi)) c; + FRO.m.[h] <- (c,Unknown); + count <- count + 1 ; + } + } + + proc f1 (x:capacity,h:handle) = { + var c; + c <$ cdistr; + if (card (fdom G1.m) < max_size /\ card (fdom G1.mi) < max_size /\ ReSample.count < max_size) { + G1.bext <- G1.bext \/ mem (image snd (fdom G1.m `|` fdom G1.mi) `|` fset1 x) c; + FRO.m.[h] <- (c,Unknown); + count <- count + 1; + } + } + + }. + + local module Gext = { + + proc resample () = { + Iter(ReSample).iter (elems (fdom (restr Unknown FRO.m))); + } + + module M = { + + proc f(p : block list): block = { + var sa, sa'; + var h, i, counter <- 0; + sa <- b0; + while (i < size p ) { + if ((sa +^ nth witness p i, h) \in G1.mh) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + if (counter < size p - prefix p (get_max_prefix p (elems (fdom C.queries)))) { + RRO.sample(G1.chandle); + sa' <@ F.RO.get(take (i+1) p); + sa <- sa +^ nth witness p i; + G1.mh.[(sa,h)] <- (sa', G1.chandle); + G1.mhi.[(sa',G1.chandle)] <- (sa, h); + (sa,h) <- (sa',G1.chandle); + G1.chandle <- G1.chandle + 1; + counter <- counter + 1; + } + } + i <- i + 1; + } + sa <@ F.RO.get(p); + return sa; + } + } + + module S = { + + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2, handles_,t; + + if (x \notin G1.m) { + if (x.`2 \in G1.paths) { + (p,v) <- oget G1.paths.[x.`2]; + y1 <@ F.RO.get (rcons p (v +^ x.`1)); + } else { + y1 <$ bdistr; + } + y2 <$ cdistr; + y <- (y1, y2); + (* exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) + + handles_ <@ RRO.allKnown(); + if (!rng handles_ x.`2) { + RRO.set(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <@ RRO.allKnown(); + hx2 <- oget (hinvc handles_ x.`2); + t <@ RRO.queried((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); + if ((x.`1, hx2) \in G1.mh /\ t) { + hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; + ReSample.f1(x.`2, hy2); + y2 <@ FRO.get(hy2); + y <- (y.`1, y2); + G1.m.[x] <- y; + G1.mi.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + RRO.set(hy2, y.`2); + G1.m.[x] <- y; + G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); + G1.mi.[y] <- x; + G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + if (x.`2 \in G1.paths) { + (p,v) <- oget G1.paths.[x.`2]; + G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } + } else { + y <- oget G1.m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2, hx2, hy2, handles_, t; + + if (x \notin G1.mi) { + handles_ <@ RRO.allKnown(); + if (!rng handles_ x.`2) { + RRO.set(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <@ RRO.allKnown(); + hx2 <- oget (hinvc handles_ x.`2); + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + t <@ RRO.queried((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); + if ((x.`1, hx2) \in G1.mhi /\ t) { + (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; + ReSample.f1(x.`2,hy2); + y2 <@ FRO.get(hy2); + y <- (y.`1, y2); + + G1.mi.[x] <- y; + G1.m.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + RRO.set(hy2, y.`2); + G1.mi.[x] <- y; + G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); + G1.m.[y] <- x; + G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget G1.mi.[x]; + } + return y; + } + + } + + proc distinguish(): bool = { + var b; + + SLCommon.C.c <- 0; + F.RO.m <- empty; + G1.m <- empty; + G1.mi <- empty; + G1.mh <- empty; + G1.mhi <- empty; + G1.bext <- false; + ReSample.count <- 0; + FRO.m <- empty; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + RRO.set(0,c0); + G1.paths <- empty.[c0 <- ([<:block>],b0)]; + G1.chandle <- 1; + b <@ DRestr(D,M,S).distinguish(); + resample(); + return b; + } + }. + + op inv_lt (m2 mi2:smap) c1 (Fm2:handles) count2 = + card (fdom m2) < c1 /\ card (fdom mi2) < c1 /\ + count2 + card (fdom (restr Unknown Fm2)) < c1 /\ + c1 <= max_size. + + op inv_le (m2 mi2:smap) c1 (Fm2:handles) count2 = + card (fdom m2) <= c1 /\ card (fdom mi2) <= c1 /\ + count2 + card (fdom (restr Unknown Fm2)) <= c1 /\ + c1 <= max_size. + + lemma fset0_eqP (s:'a fset): s = fset0 <=> forall x, !mem s x. + proof. + split=>[-> x|Hmem];1:by rewrite inE. + by apply fsetP=>x;rewrite inE Hmem. + qed. + + lemma size_set (m:('a,'b)fmap) (x:'a) (y:'b): + card (fdom (m.[x<-y])) = if x \in m then card (fdom m) else card (fdom m) + 1. + proof. + rewrite fdom_set;case (x \in m)=> Hx. + + by rewrite fsetUC subset_fsetU_id 2:// => z; rewrite ?inE mem_fdom. + rewrite fcardUI_indep 1:fset0_eqP=>[z|]. + + by rewrite !inE;case (z=x)=>//; rewrite mem_fdom. + by rewrite fcard1. + qed. + + lemma size_set_le (m:('a,'b)fmap) (x:'a) (y:'b): card (fdom (m.[x<-y])) <= card (fdom m) + 1. + proof. rewrite size_set /#. qed. + + lemma size_rem (m:('a,'b)fmap) (x:'a): + card (fdom (rem m x)) = if x \in m then card (fdom m) - 1 else card (fdom m). + proof. + rewrite fdom_rem fcardD;case (x \in m)=> Hx. + + by rewrite subset_fsetI_id 2:fcard1// => z;rewrite !inE mem_fdom. + by rewrite (@eq_fcards0 (fdom m `&` fset1 x)) 2:// fset0_eqP=>z;rewrite !inE mem_fdom/#. + qed. + + lemma size_rem_le (m:('a,'b)fmap) (x:'a) : card (fdom (rem m x)) <= card (fdom m). + proof. by rewrite size_rem /#. qed. + + lemma size_ge0 (m:('a,'b)fmap) : 0 <= card (fdom m). + proof. rewrite fcard_ge0. qed. + + lemma size0 : card (fdom empty<:'a,'b>) = 0. + proof. by rewrite fdom0 fcards0. qed. + + local equiv RROset_inv_lt : RRO.set ~ RRO.set : + ={x, y, FRO.m} /\ inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} ==> + ={res,FRO.m} /\ inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}. + proof. + proc;auto=> &ml&mr[#]3!-> /= @/inv_lt [*]. + rewrite restr_set /=;smt w=(size_set_le size_rem_le). + qed. + + local lemma Pr_ext &m: + Pr[Gext.distinguish()@&m : G1.bext /\ ReSample.count <= max_size] <= + max_size%r * ((2*max_size)%r / (2^c)%r). + proof. + fel 8 ReSample.count (fun x=> (2*max_size)%r / (2^c)%r) + max_size G1.bext + [ReSample.f : + (card (fdom G1.m) <= max_size /\ card (fdom G1.mi) <= max_size /\ ReSample.count < max_size); + ReSample.f1 : + (card (fdom G1.m) < max_size /\ card (fdom G1.mi) < max_size /\ ReSample.count < max_size) + ]=> //; 2:by auto. + + rewrite /felsum Bigreal.sumr_const count_predT size_range. + apply ler_wpmul2r;1:by apply eps_ge0. + by rewrite le_fromint;smt ml=0 w=max_ge0. + + proc;rcondt 2;1:by auto. + wp; rnd (mem (image snd (fdom G1.m `|` fdom G1.mi ))); skip=> /> &hr h1 h2 h3 h4 h5. + rewrite (Mu_mem.mu_mem + (image snd (fdom G1.m{hr} `|` fdom G1.mi{hr})) + cdistr (1%r/(2^c)%r))//. + + by move=>x _;rewrite DCapacity.dunifin1E capacity_card. + rewrite ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. + rewrite imageU fcardU le_fromint. + move:(fcard_image_leq snd (fdom G1.m{hr}))(fcard_image_leq snd (fdom G1.mi{hr})). + smt(fcard_ge0). + + by move=>c1;proc;auto=> &hr [^H 2->]/#. + + by move=> b1 c1;proc;auto=> /#. + + proc;rcondt 2;1:by auto. + wp;rnd (mem (image snd (fdom G1.m `|` fdom G1.mi) `|` fset1 x));skip=> /> &hr ?????. + rewrite (Mu_mem.mu_mem (image snd (fdom G1.m{hr}`|`fdom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. + + by move=>x _;rewrite DCapacity.dunifin1E capacity_card. + rewrite ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. + rewrite imageU !fcardU le_fromint fcard1. + move:(fcard_image_leq snd (fdom G1.m{hr}))(fcard_image_leq snd (fdom G1.mi{hr})). + smt w=fcard_ge0. + + by move=>c1;proc;auto=> &hr [^H 2->]/#. + by move=> b1 c1;proc;auto=> /#. + qed. + + + local equiv EG2_Gext : Eager(G2(DRestr(D))).main2 ~ Gext.distinguish: + ={glob D} ==> + ReSample.count{2} <= max_size /\ + ((G1.bext{1} \/ inv_ext G1.m{1} G1.mi{1} FRO.m{1}) => G1.bext{2}). + proof. + proc;inline *;wp. + while (={l,FRO.m,G1.m,G1.mi} /\ card (fdom G1.m{2}) <= max_size /\ + card (fdom G1.mi{2}) <= max_size /\ + ReSample.count{2} + size l{2} <= max_size /\ + ((G1.bext{1} \/ + exists (x : state) (h : handle), + mem (fdom G1.m{1} `|` fdom G1.mi{1}) x /\ + FRO.m{1}.[h] = Some (x.`2, Unknown) /\ !mem l{1} h) => + G1.bext{2})). + + rcondt{2} 3. + + move=> &m;auto=> &m'[#] 6!-> /= + _ _;case (l{m'})=>//=; smt w=List.size_ge0. + auto=> &ml&mr[#]6!->;case(l{mr})=>[//|h1 l1/=Hle Hext c ?/=];split. + + smt w=(drop0 size_ge0). + rewrite drop0=>-[H|[x h][#]];1:by rewrite Hext // H. + rewrite get_setE;case (h=h1)=> [/=->Hin->_ | Hneq ???]. + + by right;apply (mem_image snd _ x). + by rewrite Hext 2://;right;exists x h;rewrite Hneq. + wp; call (_: ={F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c,C.queries} /\ + inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}). + + proc;sp;if=>//=;swap -1. + call (_: ={x,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c,C.queries} /\ + inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} ==> + ={res,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c,C.queries} /\ + inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2});last by auto=>/#. + proc;if=>//;last by auto=>/#. + seq 8 9 : (={x, y, F.RO.m, FRO.m, G1.paths, G1.mh, G1.mhi, G1.m, G1.mi, G1.chandle, + G1.bext, C.c, C.queries} /\ + inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2});2:by auto. + seq 2 3 : + (={y,x,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c,C.queries} /\ + inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}). + + by if=>//;auto;call (_: ={F.RO.m});auto. + seq 5 5 : + (={t,y,x,hx2,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c,C.queries} /\ + inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} /\ + (t => in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1}). + + inline RRO.queried; wp;call (_: ={FRO.m});1:by sim. + inline RRO.allKnown;sp 1 1;if=>//. + by wp;call RROset_inv_lt;auto. + if=>//;wp. + + inline *;rcondt{1} 4;1:by auto=>/#. + rcondt{2} 5;1:by auto;smt w=(size_ge0). + rcondt{2} 10. by auto;progress;rewrite mem_set. + wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 4? /=. + move => ? _;rewrite /bad_ext !get_setE /= set_set_eqE //=. + rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. + by call RROset_inv_lt;auto;smt w=size_set_le. + + + proc;sp;if=> //;swap -1. + call (_: ={x,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c} /\ + inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} ==> + ={res,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c} /\ + inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2});last by auto=> /#. + proc;if=>//;last by auto=>/#. + seq 8 8 : + (={t,y,x,hx2,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c} /\ + inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} /\ + (t => in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1}). + + inline RRO.queried; auto;call (_: ={FRO.m});1:by sim. + inline RRO.allKnown;sp 1 1;if=>//. + by wp;call RROset_inv_lt;auto. + if=>//;wp. + + inline *;rcondt{1} 4;1:by auto=>/#. + rcondt{2} 5;1:by auto;smt w=(size_ge0). + rcondt{2} 10. by auto;progress;rewrite mem_set. + wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 5? _. + rewrite /bad_ext !get_setE /= set_set_eqE //=. + rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. + by call RROset_inv_lt;auto;smt w=size_set_le. + + + proc;sp 1 1;if;auto;if;auto=>//. + inline G2(DRestr(D), RRO).M.f Gext.M.f. + sp 6 6;elim *=> c0L c0R. + wp;call (_: ={F.RO.m});1:by sim. + conseq(:_==> ={i,p,G1.mh,sa,h,FRO.m,F.RO.m,G1.mh,G1.mhi,G1.chandle,counter} /\ + 0 <= i{1} <= size p{1} /\ + 0 <= counter{1} <= size p{1} - + prefix bs{1} (get_max_prefix bs{1} (elems (fdom C.queries{1}))) /\ + c0R + size p{1} - + prefix bs{1} (get_max_prefix bs{1} (elems (fdom C.queries{1}))) <= max_size /\ + inv_le G1.m{2} G1.mi{2} (c0R + counter){2} FRO.m{2} ReSample.count{2}). + + by auto=> />; smt(List.size_ge0). + while (={bs,i,p,G1.mh,sa,h,FRO.m,F.RO.m,G1.mh,G1.mhi,G1.chandle,counter,C.queries} /\ + bs{1} = p{1} /\ 0 <= i{1} <= size p{1} /\ + 0 <= counter{1} <= size p{1} - + prefix bs{1} (get_max_prefix bs{1} (elems (fdom C.queries{1}))) /\ + c0R + size p{1} - + prefix bs{1} (get_max_prefix bs{1} (elems (fdom C.queries{1}))) <= max_size /\ + inv_le G1.m{2} G1.mi{2} (c0R + counter){2} FRO.m{2} ReSample.count{2}); + last first. + + by auto=> />;smt(List.size_ge0 prefix_sizel). + if=> //;1:by auto=>/#. + if=> //;2:by auto=>/#. + auto;call (_: ={F.RO.m});1:by sim. + inline *;auto=> &ml &mr [#]!->@/inv_le Hi0[#] _ H_c_0 H_c_max H1 [#]H_size_m H_size_mi H_count H2 H3/=. + rewrite H3/==>H_nin_dom H_counter_prefix c;rewrite DCapacity.dunifin_fu/=. + case(G1.chandle{mr} \in FRO.m{mr})=>//=[/#|]H_handle_in_dom. + progress;..-3,-1: rewrite/#; by rewrite restr_set_eq size_set/=/#. + + auto;progress[delta];rewrite ?(size0,restr0,restr_set,rem0,max_ge0,-sizeE,-cardE) //=. + + smt(size_rem_le size0). + + smt(). + + smt(). + + smt(). + + by elim H7=>// [[x h] [#]];rewrite -memE mem_fdom dom_restr /in_dom_with domE=> _ ->. + by apply H10. + qed. + + declare axiom D_ll: + forall (F <: DFUNCTIONALITY{-D}) (P <: DPRIMITIVE{-D}), + islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. + + lemma Real_G2 &m: + Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= + Pr[Eager(G2(DRestr(D))).main2() @ &m: res] + + (max_size ^ 2 - max_size)%r / 2%r * mu dstate (pred1 witness) + + max_size%r * ((2*max_size)%r / (2^c)%r) + + max_size%r * ((2*max_size)%r / (2^c)%r). + proof. + apply (ler_trans _ _ _ (Real_G1 D D_ll &m)). + do !apply ler_add => //. + + have ->: Pr[G1(DRestr(D)).main() @ &m : res] = Pr[Eager(G2(DRestr(D))).main1() @ &m : res]. + + by byequiv (G1_G2 D). + by apply lerr_eq;byequiv (Eager_1_2 (G2(DRestr(D)))). + + by apply (Pr_G1col D D_ll &m). + apply (ler_trans Pr[Eager(G2(DRestr(D))).main1()@&m: G1.bext \/ inv_ext G1.m G1.mi FRO.m]). + + by byequiv (G1_G2 D)=>//#. + apply (ler_trans Pr[Eager(G2(DRestr(D))).main2()@&m : G1.bext \/ inv_ext G1.m G1.mi FRO.m]). + + by apply lerr_eq;byequiv (Eager_1_2 (G2(DRestr(D)))). + apply (ler_trans _ _ _ _ (Pr_ext &m)). + byequiv EG2_Gext=>//#. + qed. + +end section EXT. + + + diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca new file mode 100644 index 0000000..4ba8b17 --- /dev/null +++ b/sha3/proof/smart_counter/Handle.eca @@ -0,0 +1,2718 @@ +pragma -oldip. pragma +implicits. +require import Core Int Real StdOrder Ring. +require import List FSet SmtMap Common SLCommon. +require import DProd Dexcepted. +require import PROM. +(*...*) import Capacity IntID IntOrder DCapacity. + +require (*--*) ConcreteF. + +clone export PROM.FullRO as ROhandle with + type in_t <- handle, + type out_t <- capacity, + op dout _ <- cdistr, + type d_in_t <- unit, + type d_out_t <- bool. +export ROhandle.FullEager. + +clone export ConcreteF as ConcreteF1. + +module G1(D:DISTINGUISHER) = { + var m, mi : smap + var mh, mhi : hsmap + var chandle : int + var paths : (capacity, block list * block) fmap + var bext, bcol : bool + + module M = { + + proc f(p : block list): block = { + var sa, sa', sc; + var h, i, counter <- 0; + sa <- b0; + sc <- c0; + while (i < size p ) { + if ((sa +^ nth witness p i, h) \in mh) { + (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; + } else { + if (counter < size p - prefix p (get_max_prefix p (elems (fdom C.queries)))) { + sc <$ cdistr; + bcol <- bcol \/ hinv FRO.m sc <> None; + sa' <@ F.RO.get(take (i+1) p); + sa <- sa +^ nth witness p i; + mh.[(sa,h)] <- (sa', chandle); + mhi.[(sa',chandle)] <- (sa, h); + (sa,h) <- (sa',chandle); + FRO.m.[chandle] <- (sc,Unknown); + chandle <- chandle + 1; + counter <- counter + 1; + } + } + i <- i + 1; + } + sa <@ F.RO.get(p); + return sa; + } + } + + module S = { + + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2; + + if (x \notin m) { + if (x.`2 \in paths) { + (p,v) <- oget paths.[x.`2]; + y1 <@ F.RO.get (rcons p (v +^ x.`1)); + y2 <$ cdistr; + } else { + y1 <$ bdistr; + y2 <$ cdistr; + } + y <- (y1, y2); + bext <- bext \/ rng FRO.m (x.`2, Unknown); + if (!(rng FRO.m (x.`2, Known))) { + FRO.m.[chandle] <- (x.`2, Known); + chandle <- chandle + 1; + } + hx2 <- oget (hinvK FRO.m x.`2); + if ((x.`1, hx2) \in mh /\ in_dom_with FRO.m (oget mh.[(x.`1,hx2)]).`2 Unknown) { + hy2 <- (oget mh.[(x.`1, hx2)]).`2; + y <- (y.`1, (oget FRO.m.[hy2]).`1); + FRO.m.[hy2] <- (y.`2, Known); + m.[x] <- y; + mi.[y] <- x; + } else { + bcol <- bcol \/ hinv FRO.m y.`2 <> None; + hy2 <- chandle; + chandle <- chandle + 1; + FRO.m.[hy2] <- (y.`2, Known); + m.[x] <- y; + mh.[(x.`1, hx2)] <- (y.`1, hy2); + mi.[y] <- x; + mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + if (x.`2 \in paths) { + (p,v) <- oget paths.[x.`2]; + paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } + } else { + y <- oget m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2, hx2, hy2; + + if (x \notin mi) { + bext <- bext \/ rng FRO.m (x.`2, Unknown); + if (!(rng FRO.m (x.`2, Known))) { + FRO.m.[chandle] <- (x.`2, Known); + chandle <- chandle + 1; + } + hx2 <- oget (hinvK FRO.m x.`2); + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + if ((x.`1,hx2) \in mhi /\ + in_dom_with FRO.m (oget mhi.[(x.`1,hx2)]).`2 Unknown) { + (y1,hy2) <- oget mhi.[(x.`1, hx2)]; + y <- (y.`1, (oget FRO.m.[hy2]).`1); + FRO.m.[hy2] <- (y.`2, Known); + mi.[x] <- y; + m.[y] <- x; + } else { + bcol <- bcol \/ hinv FRO.m y.`2 <> None; + hy2 <- chandle; + chandle <- chandle + 1; + FRO.m.[hy2] <- (y.`2, Known); + mi.[x] <- y; + mhi.[(x.`1, hx2)] <- (y.`1, hy2); + m.[y] <- x; + mh.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget mi.[x]; + } + return y; + } + + } + + proc main(): bool = { + var b; + + F.RO.m <- empty; + m <- empty; + mi <- empty; + mh <- empty; + mhi <- empty; + bext <- false; + bcol <- false; + C.queries<- empty.[[] <- b0]; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + FRO.m <- empty.[0 <- (c0, Known)]; + paths <- empty.[c0 <- ([<:block>],b0)]; + chandle <- 1; + b <@ D(M,S).distinguish(); + return b; + } +}. + +(* -------------------------------------------------------------------------- *) +(** The state of CF contains + - the map PF.m that represents the primitive's map. + - the map Redo.prefixes that contains all the prefixes computations of the + sponge construction. + The state of G1 contains: + - the map hs that associates handles to flagged capacities; + - the map G1.m that represents the *public* view of map PF.m; + - the map G1.mh that represents PF.m with handle-based indirection; + - the map ro that represents the functionality; + - the map pi that returns *the* known path to a capacity if it exists. + The following invariants encode these facts, and some auxiliary + knowledge that can most likely be deduced but is useful in the proof. **) + +(** RELATIONAL: Map, Handle-Map and Handles are compatible **) +inductive m_mh (hs : handles) (m : smap) (mh : hsmap) = + | INV_m_mh of (forall xa xc ya yc, + m.[(xa,xc)] = Some (ya,yc) => + exists hx fx hy fy, + hs.[hx] = Some (xc,fx) + /\ hs.[hy] = Some (yc,fy) + /\ mh.[(xa,hx)] = Some (ya,hy)) + & (forall xa hx ya hy, + mh.[(xa,hx)] = Some (ya,hy) => + exists xc fx yc fy, + hs.[hx] = Some (xc,fx) + /\ hs.[hy] = Some (yc,fy) + /\ m.[(xa,xc)] = Some (ya,yc)). + + +(* WELL-FORMEDNESS<1 >: Map and Prefixes are compatible *) +inductive m_p (m : smap) (p : (block list, state) fmap) + (q : (block list, block) fmap) = + | INV_m_p of (p.[[]] = Some (b0,c0)) + & (q.[[]] = Some b0) + & (forall (l : block list), + l \in p => + (forall i, 0 <= i < size l => + exists sa sc, p.[take i l] = Some (sa, sc) /\ + m.[(sa +^ nth witness l i, sc)] = p.[take (i+1) l])) + & (forall (l : block list), + l \in q => exists c, p.[l] = Some (oget q.[l], c)) + & (forall (l : block list), + l \in p => exists (l2 : block list), l ++ l2 \in q). + +(** RELATIONAL : Prefixes and RO are compatible. **) +inductive ro_p (ro : (block list, block) fmap) (p : (block list, state) fmap) = + | INV_ro_p of (ro = map (+ (fun (a:state)=> a.`1)) p). + +(* WELL-FORMEDNESS<2>: Handles, Map, Handle-Map and RO are compatible *) +inductive mh_spec (hs : handles) (Gm : smap) (mh : hsmap) (ro : (block list,block) fmap) = + | INV_mh of (forall xa hx ya hy, + mh.[(xa,hx)] = Some (ya,hy) => + exists xc fx yc fy, + hs.[hx] = Some (xc,fx) + /\ hs.[hy] = Some (yc,fy) + /\ if fy = Known + then Gm.[(xa,xc)] = Some (ya,yc) + /\ fx = Known + else exists p v, + ro.[rcons p (v +^ xa)] = Some ya + /\ build_hpath mh p = Some (v,hx)) + & (forall p bn b, + ro.[rcons p bn] = Some b <=> + exists v hx hy, + build_hpath mh p = Some (v,hx) + /\ mh.[(v +^ bn,hx)] = Some (b,hy)) + & (forall p v p' v' hx, + build_hpath mh p = Some (v,hx) + => build_hpath mh p' = Some (v',hx) + => p = p' /\ v = v'). + +(* WELL-FORMEDNESS<2>: Handles, Handle-Map and Paths are compatible *) +inductive pi_spec (hs : handles) (mh : hsmap) (pi : (capacity,block list * block) fmap) = + | INV_pi of (forall c p v, + pi.[c] = Some (p,v) <=> + exists h, + build_hpath mh p = Some(v,h) + /\ hs.[h] = Some (c,Known)). + +(* WELL-FORMEDNESS<2>: Handles are well-formed *) +inductive hs_spec hs ch = + | INV_hs of (huniq hs) + & (hs.[0] = Some (c0,Known)) + & (forall cf h, hs.[h] = Some cf => h < ch). + +(* Useless stuff *) +inductive inv_spec (m:('a,'b) fmap) mi = + | INV_inv of (forall x y, m.[x] = Some y <=> mi.[y] = Some x). + +(* Invariant: maybe we should split relational and non-relational parts? *) +inductive INV_CF_G1 (hs : handles) ch (Pm Pmi Gm Gmi : smap) + (mh mhi : hsmap) (ro : (block list,block) fmap) pi + (p : (block list, state) fmap) + (q : (block list, block) fmap) = + | HCF_G1 of (hs_spec hs ch) + & (inv_spec Gm Gmi) + & (inv_spec mh mhi) + & (m_mh hs Pm mh) + & (m_mh hs Pmi mhi) + & (incl Gm Pm) + & (incl Gmi Pmi) + & (mh_spec hs Gm mh ro) + & (pi_spec hs mh pi) + (* & (all_prefixes_fset (dom ro)) *) + & (m_p Pm p q). + +(** Structural Projections **) +lemma m_mh_of_INV (ch : handle) + (mi1 m2 mi2 : smap) (mhi2 : hsmap) + (ro : (block list, block) fmap) + (pi : (capacity, block list * block) fmap) + hs m1 mh2 p q: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p q => + m_mh hs m1 mh2. +proof. by case. qed. + +lemma mi_mhi_of_INV (ch : handle) + (m1 m2 mi2 : smap) (mh2 : hsmap) + (ro : (block list, block) fmap) + (pi : (capacity, block list * block) fmap) + hs mi1 mhi2 p q: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p q => + m_mh hs mi1 mhi2. +proof. by case. qed. + +lemma incl_of_INV (hs : handles) (ch : handle) + (mi1 mi2 : smap) (mh2 mhi2: hsmap) + (ro : (block list, block) fmap) + (pi : (capacity, block list * block) fmap) + m1 m2 p q: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p q => + incl m2 m1. +proof. by case. qed. + +lemma incli_of_INV (hs : handles) (ch : handle) + (m1 m2 : smap) (mh2 mhi2: hsmap) + (ro : (block list, block) fmap) + (pi : (capacity, block list * block) fmap) + mi1 mi2 p q: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p q => + incl mi2 mi1. +proof. by case. qed. + +lemma mh_of_INV (ch : handle) + (m1 mi1 mi2 : smap) (mhi2 : hsmap) + (pi : (capacity, block list * block) fmap) + hs m2 mh2 ro p q: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p q => + mh_spec hs m2 mh2 ro. +proof. by case. qed. + +lemma pi_of_INV (ch : handle) + (m1 m2 mi1 mi2: smap) (mhi2: hsmap) + (ro : (block list, block) fmap) + hs mh2 pi p q: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p q => + pi_spec hs mh2 pi. +proof. by case. qed. + +lemma hs_of_INV (m1 m2 mi1 mi2 : smap) (mh2 mhi2 : hsmap) + (ro : (block list, block) fmap) + (pi : (capacity, block list * block) fmap) + hs ch p q: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p q => + hs_spec hs ch. +proof. by case. qed. + +lemma inv_of_INV hs ch m1 mi1 m2 mi2 ro pi + mh2 mhi2 p q: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p q=> + inv_spec mh2 mhi2. +proof. by case. qed. + +lemma invG_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p q: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p q => + inv_spec m2 mi2. +proof. by case. qed. + +(* lemma all_prefixes_fset_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p q: *) +(* INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p q => *) +(* all_prefixes_fset (dom ro). *) +(* proof. by case. qed. *) + +lemma m_p_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p q: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p q => + m_p m1 p q. +proof. by case. qed. + +lemma all_prefixes_of_m_p m1 p q: + m_p m1 p q => all_prefixes p. +proof. +case=>h0 h0' h1 h2 _ l hl i. +case(l = [])=>//=l_notnil. +case(0 <= i)=>hi0;last first. ++ by rewrite take_le0 1:/# domE h0. +case(i < size l)=>hisize;last smt(take_oversize). +smt(domE). +qed. + +lemma all_prefixes_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p q: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p q=> + all_prefixes p. +proof. case=>? ? ? ? ? ? ? ? ? h ?;exact(all_prefixes_of_m_p _ _ h). qed. + +(* lemma ro_p_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p: *) +(* INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => *) +(* ro_p ro p. *) +(* proof. by case. qed. *) + +(** Useful Lemmas **) +lemma ch_gt0 hs ch : hs_spec hs ch => 0 < ch. +proof. by case=> _ + Hlt -/Hlt. qed. + +lemma ch_neq0 hs ch : hs_spec hs ch => 0 <> ch. +proof. by move=> /ch_gt0/ltr_eqF. qed. + +lemma ch_notdomE_hs hs ch: hs_spec hs ch => hs.[ch] = None. +proof. +by move=> [] _ _ dom_hs; case: {-1}(hs.[ch]) (eq_refl hs.[ch])=> [//|cf/dom_hs]. +qed. + +lemma Sch_notdomE_hs hs ch: hs_spec hs ch => hs.[ch + 1] = None. +proof. +by move=> [] _ _ dom_hs; case: {-1}(hs.[ch + 1]) (eq_refl hs.[ch + 1])=> [//|cg/dom_hs/#]. +qed. + +lemma ch_notdomE2_mh hs m mh xa ch: + m_mh hs m mh + => hs_spec hs ch + => mh.[(xa,ch)] = None. +proof. +move=> [] Hm_mh Hmh_m [] _ _ dom_hs. +case: {-1}(mh.[(xa,ch)]) (eq_refl mh.[(xa,ch)])=> [//=|[ya hy] /Hmh_m]. +by move=> [xc0 fx0 yc fy] [#] /dom_hs. +qed. + +lemma Sch_notdomE2_mh hs m mh xa ch: + m_mh hs m mh + => hs_spec hs ch + => mh.[(xa,ch + 1)] = None. +proof. +move=> [] Hm_mh Hmh_m [] _ _ dom_hs. +case: {-1}(mh.[(xa,ch + 1)]) (eq_refl mh.[(xa,ch + 1)])=> [//=|[ya hy] /Hmh_m]. +by move=> [xc0 fx0 yc fy] [#] /dom_hs /#. +qed. + +lemma dom_hs_neq_ch hs ch hx xc fx: + hs_spec hs ch + => hs.[hx] = Some (xc,fx) + => hx <> ch. +proof. by move=> [] _ _ dom_hs /dom_hs /#. qed. + +lemma dom_hs_neq_Sch hs ch hx xc fx: + hs_spec hs ch + => hs.[hx] = Some(xc,fx) + => hx <> ch + 1. +proof. by move=> [] _ _ dom_hs /dom_hs /#. qed. + +lemma notin_m_notin_mh hs m mh xa xc hx fx: + m_mh hs m mh + => m.[(xa,xc)] = None + => hs.[hx] = Some (xc,fx) + => mh.[(xa,hx)] = None. +proof. +move=> [] _ Hmh_m m_xaxc hs_hx; case: {-1}(mh.[(xa,hx)]) (eq_refl mh.[(xa,hx)])=> [//|]. +by move=> [ya hy] /Hmh_m [xc0 fx0 yc0 fy0] [#]; rewrite hs_hx=> [#] <*>; rewrite m_xaxc. +qed. + +lemma notin_m_notin_Gm (m Gm : ('a,'b) fmap) x: + incl Gm m + => m.[x] = None + => Gm.[x] = None. +proof. by move=> Gm_leq_m; apply/contraLR=> ^ /Gm_leq_m ->. qed. + +lemma notin_hs_notdomE2_mh hs m mh xa hx: + m_mh hs m mh + => hs.[hx] = None + => mh.[(xa,hx)] = None. +proof. +move=> [] _ Hmh_m hs_hx; case: {-1}(mh.[(xa,hx)]) (eq_refl mh.[(xa,hx)])=> [//|]. +by move=> [ya hy] /Hmh_m [xc fx yc fy] [#]; rewrite hs_hx. +qed. + +(** Preservation of m_mh **) +lemma m_mh_addh hs ch m mh xc fx: + hs_spec hs ch + => m_mh hs m mh + => m_mh hs.[ch <- (xc, fx)] m mh. +proof. +move=> ^Hhs [] Hhuniq hs_0 dom_hs [] Hm_mh Hmh_m; split. ++ move=> xa0 xc0 ya yc /Hm_mh [hx0 fx0 hy fy] [#] hs_hx0 hs_hy mh_xaxc0. + exists hx0 fx0 hy fy; rewrite !get_setE mh_xaxc0 hs_hx0 hs_hy /=. + move: hs_hx0=> /dom_hs/ltr_eqF -> /=. + by move: hs_hy=> /dom_hs/ltr_eqF -> /=. +move=> xa hx ya hy /Hmh_m [xc0 fx0 yc fy] [#] hs_hx hs_hy m_xaxc0. +exists xc0 fx0 yc fy; rewrite !get_setE m_xaxc0 hs_hx hs_hy. +move: hs_hx=> /dom_hs/ltr_eqF -> /=. +by move: hs_hy=> /dom_hs/ltr_eqF -> /=. +qed. + +lemma m_mh_updh fy0 hs m mh yc hy fy: + m_mh hs m mh + => hs.[hy] = Some (yc,fy0) + => m_mh hs.[hy <- (yc,fy)] m mh. +proof. +move=> Im_mh hs_hy; split. ++ move=> xa' xc' ya' yc'; have [] H _ /H {H}:= Im_mh. + move=> [hx' fx' hy' fy'] [#] hs_hx' hs_hy' mh_xahx'. + case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|Hhy'|Hhx'|Hhx' Hhy']. + + by exists hy fy hy fy; rewrite !get_setE /= /#. + + by exists hy fy hy' fy'; rewrite !get_setE Hhy' /#. + + by exists hx' fx' hy fy; rewrite !get_setE Hhx' /#. + by exists hx' fx' hy' fy'; rewrite !get_setE Hhx' Hhy'. +move=> xa' hx' ya' hy'; have [] _ H /H {H}:= Im_mh. +move=> [xc' fx' yc' fy'] [#] hs_hx' hs_hy' m_xaxc'. +case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|Hhy'|Hhx'|Hhx' Hhy']. ++ by exists yc fy yc fy; rewrite !get_setE /= /#. ++ by exists yc fy yc' fy'; rewrite !get_setE Hhy' /#. ++ by exists xc' fx' yc fy; rewrite !get_setE Hhx' /#. +by exists xc' fx' yc' fy'; rewrite !get_setE Hhx' Hhy'. +qed. + +lemma m_mh_addh_addm hs Pm mh hx xa xc hy ya yc f f': + m_mh hs Pm mh => + huniq hs => + hs.[hx] = Some (xc, f) => + hs.[hy] = None => + m_mh hs.[hy <- (yc,f')] Pm.[(xa,xc) <- (ya,yc)] mh.[(xa,hx) <- (ya,hy)]. +proof. +move=> [] Hm_mh Hmh_m Hhuniq hs_hx hs_hy. +split=> [xa0 xc0 ya0 yc0|xa0 hx0 ya0 hy0]; rewrite get_setE. ++ case: ((xa0,xc0) = (xa,xc))=> [[#] <<*> [#] <<*>|] /=. + + by exists hx f hy f'; rewrite !get_setE /= /#. + move=> xaxc0_neq_xaxc /Hm_mh [hx0 fx0 hy0 fy0] [#] hs_hx0 hs_hy0 mh_xahx0. + by exists hx0 fx0 hy0 fy0; rewrite !get_setE /#. +case: ((xa0,hx0) = (xa,hx))=> [[#] <*>> [#] <<*>|] /=. ++ by exists xc f yc f'; rewrite !get_setE /= /#. +move=> /= /negb_and xahx0_neq_xahx /Hmh_m [xc0 fx0 yc0 fy0] [#] hs_hx0 hs_hy0 Pm_xaxc0. +exists xc0 fx0 yc0 fy0; rewrite !get_setE; do !split=> [/#|/#|/=]. +move: xahx0_neq_xahx; case: (xa0 = xa)=> [/= <*>>|//=]; case: (xc0 = xc)=> [<*>>|//=]. +by move: hs_hx=> /(Hhuniq _ _ _ _ hs_hx0). +qed. + +lemma mi_mhi_addh_addmi (hs : handles) mi mhi hx xa xc hy ya yc fx fy: + m_mh hs mi mhi => + (forall f h, hs.[h] <> Some (yc,f)) => + hs.[hx] = Some (xc,fx) => + hs.[hy] = None => + m_mh hs.[hy <- (yc,fy)] mi.[(ya,yc) <- (xa,xc)] mhi.[(ya,hy) <- (xa,hx)]. +proof. +move=> [] Hm_mh Hmh_m yc_notin_rng1_hs hs_hx hs_hy; split. ++ move=> ya0 yc0 xa0 xc0; rewrite get_setE; case: ((ya0,yc0) = (ya,yc))=> [[#] <*>> [#] <*>>|]. + + by exists hy fy hx fx; rewrite !get_setE /= /#. + move=> yayc0_neq_yayc /Hm_mh [hy0 fy0 hx0 fx0] [#] hs_hy0 hs_hx0 mhi_yayc0. + by exists hy0 fy0 hx0 fx0; rewrite !get_setE /#. +move=> ya0 hy0 xa0 hx0; rewrite get_setE; case: ((ya0,hy0) = (ya,hy))=> [[#] <*>> [#] <<*>|]. ++ by exists yc fy xc fx; rewrite !get_setE //= /#. +move=>yahy0_neq_yahy /Hmh_m [yc0 fy0 xc0 fx0] [#] hs_hy0 hs_hx0 mi_yayc0. +exists yc0 fy0 xc0 fx0; rewrite !get_setE; do !split=> [/#|/#|]. +move: yahy0_neq_yahy; case: (ya0 = ya)=> [<<*> //=|/#]; case: (yc0 = yc)=> [<*>> /=|//=]. +by move: hs_hy0; rewrite yc_notin_rng1_hs. +qed. + +(** Inversion **) +lemma inv_mh_inv_Pm hs Pm Pmi mh mhi: + m_mh hs Pm mh + => m_mh hs Pmi mhi + => inv_spec mh mhi + => inv_spec Pm Pmi. +proof. +move=> Hm_mh Hmi_mhi [] Hinv; split=>- [xa xc] [ya yc]; split. ++ have [] H _ /H {H} [hx fx hy fy] [#] hs_hx hs_hy /Hinv := Hm_mh. + have [] _ H /H {H} [? ? ? ?] [#] := Hmi_mhi. + by rewrite hs_hx hs_hy=> /= [#] <<*> [#] <<*>. +have [] H _ /H {H} [hy fy hx fx] [#] hs_hy hs_hx /Hinv := Hmi_mhi. +have [] _ H /H {H} [? ? ? ?] [#] := Hm_mh. +by rewrite hs_hx hs_hy=> /= [#] <<*> [#] <<*>. +qed. + +lemma inv_incl_none Pm Pmi Gm (x : 'a) Gmi (y : 'b): + inv_spec Pm Pmi + => inv_spec Gm Gmi + => incl Gm Pm + => incl Gmi Pmi + => Pm.[x] = Some y + => (Gm.[x] = None <=> Gmi.[y] = None). +proof. +move=> [] invP [] invG Gm_leq_Pm Gmi_leq_Pmi ^P_x; rewrite invP=> Pi_y. +split=> [G_x | Gi_y]. ++ case: {-1}(Gmi.[y]) (eq_refl Gmi.[y])=> [//|x']. + move=> ^Gmi_y; rewrite -Gmi_leq_Pmi 1:Gmi_y// Pi_y /= -negP=> <<*>. + by move: Gmi_y; rewrite -invG G_x. +case: {-1}(Gm.[x]) (eq_refl Gm.[x])=> [//|y']. +move=> ^Gm_y; rewrite -Gm_leq_Pm 1:Gm_y// P_x /= -negP=> <<*>. +by move: Gm_y; rewrite invG Gi_y. +qed. + +(** Preservation of hs_spec **) +lemma huniq_addh hs h c f: + huniq hs + => (forall f' h', hs.[h'] <> Some (c,f')) + => huniq hs.[h <- (c,f)]. +proof. +move=> Hhuniq c_notin_rng1_hs h1 h2 [c1 f1] [c2 f2]; rewrite !get_setE. +case: (h1 = h); case: (h2 = h)=> //= [Hh2 + [#]|+ Hh1 + [#]|_ _] - <*>. ++ by rewrite c_notin_rng1_hs. ++ by rewrite c_notin_rng1_hs. +move=> H1 H2. +by have/=:=Hhuniq _ _ _ _ H1 H2. +qed. + +lemma hs_addh hs ch xc fx: + hs_spec hs ch + => (forall f h, hs.[h] <> Some (xc,f)) + => hs_spec hs.[ch <- (xc,fx)] (ch + 1). +proof. +move=> ^Hhs [] Hhuniq hs_0 dom_hs xc_notin_rng1_hs; split. ++ move=> h1 h2 [c1 f1] [c2 f2]; rewrite !get_setE /=. + case: (h1 = ch); case: (h2 = ch)=> //= [+ + [#]|+ + + [#]|]=> <*>; + first 2 by rewrite xc_notin_rng1_hs. + by move=> _ _ hs_h1 /(Hhuniq _ _ _ _ hs_h1). ++ by rewrite get_setE (ch_neq0 _ Hhs). ++ move=> [c f] h; rewrite !get_setE; case: (h = ch)=> [<*> /#|_]. +by move=> /dom_hs /#. +qed. + +lemma hs_updh hs ch fx hx xc fx': + hs_spec hs ch + => 0 <> hx + => hs.[hx] = Some (xc,fx) + => hs_spec hs.[hx <- (xc,fx')] ch. +proof. +move=> ^Hhs [] Hhuniq hs_0 dom_hs hx_neq0 hs_hx; split. ++ move=> h1 h2 [c1 f1] [c2 f2]; rewrite !get_setE /= => />. + case : (h1 = hx) => />; case : (h2 = hx) => /> U1 U2. + + by have := (Hhuniq _ _ _ _ hs_hx U2 _). + + case (xc = c2) => />. + by have := (Hhuniq _ _ _ _ hs_hx U2 _) => // />. + + move=> H1 H2; by have := (Hhuniq _ _ _ _ H1 H2 _). ++ by rewrite get_setE hx_neq0. +move=> cf h; rewrite get_setE; case: (h = hx)=> [<*> _|_ /dom_hs //]. +by move: hs_hx=> /dom_hs. +qed. + +(** Preservation of mh_spec **) +lemma mh_addh hs ch Gm mh ro xc fx: + hs_spec hs ch + => mh_spec hs Gm mh ro + => mh_spec hs.[ch <- (xc,fx)] Gm mh ro. +proof. +move=> [] _ _ dom_hs [] Hmh ? ?; split=> //. +move=> xa hx ya hy /Hmh [xc0 fx0 yc0 fy0] [#] hs_hx hs_hy Hite. +exists xc0 fx0 yc0 fy0; rewrite !get_setE Hite hs_hx hs_hy /=. +rewrite ltr_eqF /=; 1:by apply/(dom_hs _ hs_hx). +by rewrite ltr_eqF /=; 1:by apply/(dom_hs _ hs_hy). +qed. + +(** Preservation of inv_spec **) +lemma inv_addm (m : ('a,'b) fmap) mi x y: + inv_spec m mi + => m.[x] = None + => mi.[y] = None + => inv_spec m.[x <- y] mi.[y <- x]. +proof. +move=> [] Hinv m_x mi_y; split=> x' y'; rewrite !get_setE; split. ++ case: (x' = x)=> /= [[#] <*> //=|_ /Hinv ^ + ->]. + by move: mi_y; case: (y' = y)=> [[#] <*> ->|]. +case: (y' = y)=> /= [[#] <*> //=|_ /Hinv ^ + ->]. +by move: m_x; case: (x' = x)=> [[#] <*> ->|]. +qed. + +(** Preservation of incl **) +lemma incl_addm (m m' : ('a,'b) fmap) x y: + incl m m' + => incl m.[x <- y] m'.[x <- y]. +proof. by move=> m_leq_m' x'; rewrite !get_setE; case: (x' = x)=> [|_ /m_leq_m']. qed. + +(** getflag: retrieve the flag of a capacity **) +op getflag (hs : handles) xc = + omap snd (obind ("_.[_]" hs) (hinv hs xc)). + +lemma getflagP_none hs xc: + (getflag hs xc = None <=> forall f h, hs.[h] <> Some (xc,f)). +proof. by rewrite /getflag; case: (hinvP hs xc)=> [->|] //= /#. qed. + +lemma getflagP_some hs xc f: + huniq hs + => (getflag hs xc = Some f <=> rng hs (xc,f)). +proof. +move=> huniq_hs; split. ++ rewrite /getflag; case: (hinvP hs xc)=> [-> //|]. + rewrite rngE; case: (hinv hs xc)=> //= h [f'] ^ hs_h -> @/snd /= ->>. + by exists h. +rewrite rngE=> -[h] hs_h. +move: (hinvP hs xc)=> [_ /(_ h f) //|]. +rewrite /getflag; case: (hinv hs xc)=> // h' _ [f']; rewrite oget_some. +move=> /(huniq_hs _ h _ (xc,f)) /(_ hs_h) /= ->>. +by rewrite hs_h. +qed. + +(** Stuff about paths **) +lemma build_hpath_prefix mh p b v h: + build_hpath mh (rcons p b) = Some (v,h) + <=> (exists v' h', build_hpath mh p = Some (v',h') /\ mh.[(v' +^ b,h')] = Some (v,h)). +proof. +rewrite build_hpathP; split=> [[|p' b' v' h' [#] + Hhpath Hmh]|[v' h'] [] Hhpath Hmh]. ++ smt(size_rcons size_ge0). ++ by move=> ^/rconsIs <<- /rconssI <<-; exists v' h'. +exact/(Extend _ _ _ _ _ Hhpath Hmh). +qed. + +lemma build_hpath_up mh xa hx ya hy p za hz: + build_hpath mh p = Some (za,hz) + => mh.[(xa,hx)] = None + => build_hpath mh.[(xa,hx) <- (ya,hy)] p = Some (za,hz). +proof. +move=> + mh_xahx; elim/last_ind: p za hz=> [za hz|p b ih za hz]. ++ by rewrite /build_hpath. +move=> /build_hpath_prefix [b' h'] [#] /ih Hpath Hmh. +apply/build_hpathP/(@Extend _ _ _ _ p b b' h' _ Hpath _)=> //. +by rewrite get_setE /#. +qed. + +lemma build_hpath_down mh xa hx ya hy p v h: + (forall p v, build_hpath mh p <> Some (v,hx)) + => build_hpath mh.[(xa,hx) <- (ya,hy)] p = Some (v,h) + => build_hpath mh p = Some (v,h). +proof. +move=> no_path_to_hx. +elim/last_ind: p v h=> [v h /build_hpathP [<*>|] //=|p b ih]. ++ smt(size_ge0 size_rcons). +move=> v h /build_hpathP [/#|p' b' + + ^/rconsIs <<- /rconssI <<-]. +move=> v' h' /ih; rewrite get_setE. +case: ((v' +^ b,h') = (xa,hx))=> [/#|_ Hpath Hextend]. +exact/build_hpathP/(Extend _ _ _ _ _ Hpath Hextend). +qed. + +lemma known_path_uniq hs mh pi xc hx p xa p' xa': + pi_spec hs mh pi + => hs.[hx] = Some (xc,Known) + => build_hpath mh p = Some (xa, hx) + => build_hpath mh p' = Some (xa',hx) + => p = p' /\ xa = xa'. +proof. +move=> [] Ipi hs_hy path_p path_p'. +have /iffRL /(_ _):= Ipi xc p xa; first by exists hx. +have /iffRL /(_ _):= Ipi xc p' xa'; first by exists hx. +by move=> ->. +qed. + +(* Useful? Not sure... *) +lemma path_split hs ch m mh xc hx p xa: + hs_spec hs ch + => m_mh hs m mh + => hs.[hx] = Some (xc,Unknown) + => build_hpath mh p = Some (xa,hx) + => exists pk ya yc hy b za zc hz pu, + p = (rcons pk b) ++ pu + /\ build_hpath mh pk = Some (ya,hy) + /\ hs.[hy] = Some (yc,Known) + /\ mh.[(ya +^ b,hy)] = Some (za,hz) + /\ hs.[hz] = Some (zc,Unknown). +proof. +move=> Ihs [] _ Imh_m. +elim/last_ind: p hx xa xc=> [hx xa xc + /build_hpathP [_ <*>|]|]. ++ by have [] _ -> _ [#]:= Ihs. ++ smt(size_ge0 size_rcons). +move=> p b ih hx xa xc hs_hx /build_hpath_prefix. +move=> [ya hy] [#] path_p_hy ^mh_yabh' /Imh_m [yc fy ? ?] [#] hs_hy. +rewrite hs_hx=> /= [#] <<*> _; case: fy hs_hy. ++ move=> /ih /(_ ya _) // [pk ya' yc' hy' b' za zc hz pu] [#] <*>. + move=> Hpath hs_hy' mh_tahy' hs_hz. + by exists pk ya' yc' hy' b' za zc hz (rcons pu b); rewrite rcons_cat. +by move=> hs_hy; exists p ya yc hy b xa xc hx []; rewrite cats0. +qed. + +(** Path-specific lemmas **) +lemma lemma1 hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2 prefixes queries: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries + => x2 <> y2 + => Pm.[(x1,x2)] = None + => Gm.[(x1,x2)] = None + => (forall f h, hs.[h] <> Some (x2,f)) + => (forall f h, hs.[h] <> Some (y2,f)) + => INV_CF_G1 + hs.[ch <- (x2,Known)].[ch + 1 <- (y2,Known)] (ch + 2) + Pm.[(x1,x2) <- (y1,y2)] Pmi.[(y1,y2) <- (x1,x2)] + Gm.[(x1,x2) <- (y1,y2)] Gmi.[(y1,y2) <- (x1,x2)] + mh.[(x1,ch) <- (y1,ch + 1)] mhi.[(y1,ch + 1) <- (x1,ch)] + ro pi prefixes queries. +proof. +move=> HINV x2_neq_y2 Pm_x Gm_x x2_notrngE1_hs y2_notrngE1_hs; split. ++ rewrite (@addzA ch 1 1); apply/hs_addh. + + by move: HINV=> /hs_of_INV/hs_addh=> ->. + by move=> f h; rewrite get_setE; case: (h = ch)=> [/#|_]; exact/y2_notrngE1_hs. ++ apply/inv_addm=> //; 1:by case: HINV. + case: {-1}(Gmi.[(y1,y2)]) (eq_refl Gmi.[(y1,y2)])=> [//|[xa xc]]. + + have /incli_of_INV @/incl + ^h - <- := HINV; 1: by rewrite h. + have /mi_mhi_of_INV [] H _ /H {H} [hx fx hy fy] [#] := HINV. + by rewrite y2_notrngE1_hs. ++ apply/inv_addm; 1:by case: HINV. + + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. + by apply/(ch_notdomE2_mh _ _ Hm_mh Hhs). + have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. + by apply/(Sch_notdomE2_mh _ _ Hmi_mhi Hhs). ++ apply/(@m_mh_addh_addm hs.[ch <- (x2,Known)] Pm mh ch x1 x2 (ch + 1) y1 y2 Known). + + by move: HINV=> ^/hs_of_INV Hhs /m_mh_of_INV; exact/(m_mh_addh Hhs). + + by move: HINV => /hs_of_INV /hs_addh /(_ x2 Known _) // []. + + by rewrite get_setE. + by rewrite get_setE gtr_eqF 1:/# /=; apply/Sch_notdomE_hs; case: HINV. ++ apply/(@mi_mhi_addh_addmi hs.[ch <- (x2,Known)] Pmi mhi ch x1 x2 (ch + 1) y1 y2 Known Known). + + by move: HINV=> ^/hs_of_INV Hhs /mi_mhi_of_INV; exact/(m_mh_addh Hhs). + + move=> f h; rewrite get_setE; case: (h = ch)=> [_ //=|_ //=]; first by rewrite x2_neq_y2. + by rewrite y2_notrngE1_hs. + + by rewrite get_setE. + by rewrite get_setE gtr_eqF 1:/# /=; apply/Sch_notdomE_hs; case: HINV. ++ by apply/incl_addm; case: HINV. ++ by apply/incl_addm; case: HINV. ++ split. + + move=> xa hx ya hy; rewrite get_setE; case: ((xa,hx) = (x1,ch))=> [|]. + + by move=> [#] <*> [#] <*>; exists x2 Known y2 Known; rewrite !get_setE /#. + move=> xahx_neq_x1ch; have ^ /hs_of_INV Hhs /mh_of_INV [] Hmh _ _ /Hmh {Hmh} := HINV. + move=> [xc fx yc fy] [#] hs_hx hs_hy Hite. + exists xc fx yc fy; do 2?split; first 2 by smt (dom_hs_neq_ch dom_hs_neq_Sch get_setE). + case: fy Hite hs_hy=> /= [[p v] [Hro Hpath] hs_hy|[#] Gm_xaxc <*> hs_hy] /=; last first. + + by rewrite get_setE; case: ((xa,xc) = (x1,x2))=> [/#|]. + exists p v; rewrite Hro /=; apply/build_hpath_up=> //. + have /m_mh_of_INV /notin_hs_notdomE2_mh H:= HINV. + exact/H/ch_notdomE_hs/Hhs. + + move=> p xa b; have /mh_of_INV [] _ -> _ := HINV. + apply/exists_iff=> v /=; apply/exists_iff=> hx /=; apply/exists_iff=> hy /=. + have mh_x1ch: mh.[(x1,ch)] = None. + + by apply/(notin_hs_notdomE2_mh hs Pm)/ch_notdomE_hs; case: HINV. + have ch_notrngE2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch). + + move=> a h a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. + by move=> [xc fx yc fy] [#] _; rewrite ch_notdomE_hs; case: HINV. + split=> -[#]. + + move=> Hpath mh_vxahx; rewrite get_setE; case: ((v +^ xa,hx) = (x1,ch))=> [/#|_]. + by rewrite mh_vxahx //=; apply/build_hpath_up=> //=; rewrite mh_x1ch. + have H /H {H}:= build_hpath_down mh x1 ch y1 (ch + 1) p v hx _. + + move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. + + by have /hs_of_INV [] _ + H - /H {H} := HINV. + by move=> p' b' v' h' <*>; rewrite ch_notrngE2_mh. + move=> ^ /build_hpathP + -> /=; rewrite get_setE. + by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. + move=> p v p' v' hx. + have: (forall p v, build_hpath mh p <> Some (v,ch)). + + move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. + + by have /hs_of_INV [] _ + H - /H {H} := HINV. + move=> p'0 b'0 v'0 h'0 <*> _; have /m_mh_of_INV [] _ H /H {H} := HINV. + by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. + move=> ^ + /build_hpath_down H /H {H} - /build_hpath_down H + /H {H}. + by have /mh_of_INV [] _ _ /(_ p v p' v' hx) := HINV. +split=> c p v; have ^/hs_of_INV [] _ _ dom_hs /pi_of_INV [] -> := HINV. +apply/exists_iff=> h /=; split=> [#]. ++ move=> /(build_hpath_up mh x1 ch y1 (ch + 1) p v h) /(_ _). + + by apply/(notin_hs_notdomE2_mh hs Pm)/ch_notdomE_hs; case: HINV. + by move=> -> /= ^ /dom_hs; rewrite !get_setE /#. +have ch_notrngE2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch). ++ move=> a h' a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. + by move=> [xc fx yc fy] [#] _; rewrite ch_notdomE_hs; case: HINV. +have Sch_notrngE2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch + 1). ++ move=> a h' a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. + by move=> [xc fx yc fy] [#] _; rewrite Sch_notdomE_hs; case: HINV. +have H /H {H}:= build_hpath_down mh x1 ch y1 (ch + 1) p v h _. ++ move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. + + by have /hs_of_INV [] _ + H - /H {H} := HINV. + by move=> p' b' v' h' <*>; rewrite ch_notrngE2_mh. ++ move=> ^ /build_hpathP + -> /=; rewrite !get_setE. + by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. +(* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) +split=>[]. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] //. ++ move=>l hmem i hi. + have[]_ _ h2 h3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have[]sa sc[]:=h2 l hmem i hi. + have h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + smt(domE get_setE). +by case:HINV=>_ _ _ _ _ _ _ _ _ []. +by case:HINV=>_ _ _ _ _ _ _ _ _ []. +qed. + + +lemma lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries x1 x2 y1 y2: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries + => ! (y1,y2) \in Pm + => x2 <> y2 + => Pmi.[(x1,x2)] = None + => Gmi.[(x1,x2)] = None + => (forall f h, hs.[h] <> Some (x2,f)) + => (forall f h, hs.[h] <> Some (y2,f)) + => INV_CF_G1 + hs.[ch <- (x2,Known)].[ch + 1 <- (y2,Known)] (ch + 2) + Pm.[(y1,y2) <- (x1,x2)] Pmi.[(x1,x2) <- (y1,y2)] + Gm.[(y1,y2) <- (x1,x2)] Gmi.[(x1,x2) <- (y1,y2)] + mh.[(y1,ch + 1) <- (x1,ch)] mhi.[(x1,ch) <- (y1,ch + 1)] + ro pi prefixes queries. +proof. +move=> HINV hh x2_neq_y2 Pm_x Gm_x xc_notrngE1_hs yc_notrngE1_hs; split. ++ rewrite (@addzA ch 1 1); apply/hs_addh. + + by move: HINV=> /hs_of_INV/hs_addh=> ->. + by move=> f h; rewrite get_setE; case: (h = ch)=> [/#|_]; exact/yc_notrngE1_hs. ++ apply/inv_addm=> //; 1:by case: HINV. + case: {-1}(Gm.[(y1,y2)]) (eq_refl Gm.[(y1,y2)])=> [//|[xa xc]]. + + have /incl_of_INV + ^h - <- := HINV; 1: by rewrite h. + have /m_mh_of_INV [] H _ /H {H} [hx fx hy fy] [#] := HINV. + by rewrite yc_notrngE1_hs. ++ apply/inv_addm; 1:by case: HINV. + + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. + by apply/(Sch_notdomE2_mh _ _ Hm_mh Hhs). + have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. + by apply/(ch_notdomE2_mh _ _ Hmi_mhi Hhs). ++ apply/(@mi_mhi_addh_addmi hs.[ch <- (x2,Known)] Pm mh ch x1 x2 (ch + 1) y1 y2 Known Known). + + by move: HINV=> ^/hs_of_INV Hhs /m_mh_of_INV; exact/(m_mh_addh Hhs). + + by move=> f h; rewrite get_setE; case: (h = ch)=> [<*> /#|]; rewrite yc_notrngE1_hs. + + by rewrite get_setE. + by rewrite get_setE gtr_eqF 1:/# /=; apply/Sch_notdomE_hs; case: HINV. ++ apply/(@m_mh_addh_addm hs.[ch <- (x2,Known)] Pmi mhi ch x1 x2 (ch + 1) y1 y2 Known). + + by move: HINV=> ^/hs_of_INV Hhs /mi_mhi_of_INV; exact/(m_mh_addh Hhs). + + by have /hs_of_INV /hs_addh /(_ x2 Known _) // []:= HINV. + + by rewrite get_setE. + by rewrite get_setE gtr_eqF 1:/# /=; apply/Sch_notdomE_hs; case: HINV. ++ by apply/incl_addm; case: HINV. ++ by apply/incl_addm; case: HINV. ++ split. + + move=> ya hy xa hx; rewrite get_setE; case: ((ya,hy) = (y1,ch + 1))=> [|]. + + by move=> [#] <*> [#] <*>; exists y2 Known x2 Known; rewrite !get_setE /#. + move=> yahy_neq_y1Sch; have ^ /hs_of_INV Hhs /mh_of_INV [] Hmh _ _ /Hmh {Hmh} := HINV. + move=> [yc fy xc fx] [#] hs_hy hs_hx Hite. + exists yc fy xc fx; do 2?split; first 2 by smt (dom_hs_neq_ch dom_hs_neq_Sch get_setE). + case: fx Hite hs_hx=> /= [[p v] [Hro Hpath] hs_hx|[#] Gm_yayc <*> hs_hx] /=; last first. + + by rewrite get_setE; case: ((ya,yc) = (y1,y2))=> [/#|]. + exists p v; rewrite Hro /=; apply/build_hpath_up=> //. + have /m_mh_of_INV /notin_hs_notdomE2_mh H:= HINV. + exact/H/Sch_notdomE_hs/Hhs. + + move=> p ya b; have /mh_of_INV [] _ -> _ := HINV. + apply/exists_iff=> v /=; apply/exists_iff=> hx /=; apply/exists_iff=> hy /=. + have mh_y1Sch: mh.[(y1,ch + 1)] = None. + + by apply/(notin_hs_notdomE2_mh hs Pm)/Sch_notdomE_hs; case: HINV. + have Sch_notrngE2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch + 1). + + move=> a h a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. + by move=> [yc fy xc fx] [#] _; rewrite Sch_notdomE_hs; case: HINV. + split=> -[#]. + + move=> Hpath mh_vxahx; rewrite get_setE; case: ((v +^ ya,hx) = (y1,ch + 1))=> [/#|_]. + by rewrite mh_vxahx //=; apply/build_hpath_up=> //=; rewrite mh_y1ch. + have H /H {H}:= build_hpath_down mh y1 (ch + 1) x1 ch p v hx _. + + move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. + + by have /hs_of_INV [] _ + H - /H {H} /# := HINV. + by move=> p' b' v' h' <*>; rewrite Sch_notrngE2_mh. + move=> ^ /build_hpathP + -> /=; rewrite get_setE. + by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. + move=> p v p' v' hx. + have: (forall p v, build_hpath mh p <> Some (v,ch + 1)). + + move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. + + by have /hs_of_INV [] _ + H - /H {H} /# := HINV. + move=> p'0 b'0 v'0 h'0 <*> _; have /m_mh_of_INV [] _ H /H {H} := HINV. + by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H} /#:= HINV. + move=> ^ + /build_hpath_down H /H {H} - /build_hpath_down H + /H {H}. + by have /mh_of_INV [] _ _ /(_ p v p' v' hx) := HINV. +split=> c p v; have ^/hs_of_INV [] _ _ dom_hs /pi_of_INV [] -> := HINV. +apply/exists_iff=> h /=; split=> [#]. ++ move=> /(build_hpath_up mh y1 (ch + 1) x1 ch p v h) /(_ _). + + by apply/(notin_hs_notdomE2_mh hs Pm)/Sch_notdomE_hs; case: HINV. + by move=> -> /= ^ /dom_hs; rewrite !get_setE /#. +have ch_notrngE2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch). ++ move=> a h' a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. + by move=> [xc fx yc fy] [#] _; rewrite ch_notdomE_hs; case: HINV. +have Sch_notrngE2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch + 1). ++ move=> a h' a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. + by move=> [xc fx yc fy] [#] _; rewrite Sch_notdomE_hs; case: HINV. +have H /H {H}:= build_hpath_down mh y1 (ch + 1) x1 ch p v h _. ++ move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. + + by have /hs_of_INV [] _ + H - /H {H} /# := HINV. + by move=> p' b' v' h' <*>; rewrite Sch_notrngE2_mh. ++ move=> ^ /build_hpathP + -> /=; rewrite !get_setE. + by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. +(* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) +split=>[]. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ []. ++ move=>l hmem i hi. + have[]_ _ h2 h3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have[]sa sc[]:=h2 l hmem i hi. + have h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + smt(domE get_setE). +by case:HINV=>_ _ _ _ _ _ _ _ _ []. +by case:HINV=>_ _ _ _ _ _ _ _ _ []. +qed. + +lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes queries x1 x2 y1 y2 hx: + INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes queries + => PFm.[(x1,x2)] = None + => G1m.[(x1,x2)] = None + => pi.[x2] = None + => hs.[hx] = Some (x2,Known) + => (forall f h, hs.[h] <> Some (y2,f)) + => INV_CF_G1 hs.[ch <- (y2,Known)] (ch + 1) + PFm.[(x1,x2) <- (y1,y2)] PFmi.[(y1,y2) <- (x1,x2)] + G1m.[(x1,x2) <- (y1,y2)] G1mi.[(y1,y2) <- (x1,x2)] + G1mh.[(x1,hx) <- (y1,ch)] G1mhi.[(y1,ch) <- (x1,hx)] + ro pi prefixes queries. +proof. +move=> HINV PFm_x1x2 G1m_x1x2 pi_x2 hs_hx y2_notrngE1_hs. +split. ++ by apply/hs_addh=> //=; case: HINV. ++ apply/inv_addm=> //; 1:by case: HINV. + case: {-1}(G1mi.[(y1,y2)]) (eq_refl G1mi.[(y1,y2)])=> [//|[xa xc]]. + + have /incli_of_INV @/incl + ^h - <- := HINV; 1: by rewrite h. + have /mi_mhi_of_INV [] H _ /H {H} [hx' fx' hy' fy'] [#] := HINV. + by rewrite y2_notrngE1_hs. ++ apply/inv_addm; 1:by case: HINV. + + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. + by apply/(notin_m_notin_mh _ _ _ _ Hm_mh PFm_x1x2 hs_hx). + have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. + by apply/(ch_notdomE2_mh _ _ Hmi_mhi Hhs). ++ have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /m_mh_of_INV := HINV. + move=> /m_mh_addh_addm /(_ hx x1 x2 ch y1 y2 Known Known Hhuniq hs_hx _) //. + exact/ch_notdomE_hs. ++ have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /mi_mhi_of_INV := HINV. + move=> /mi_mhi_addh_addmi /(_ hx x1 x2 ch y1 y2 Known Known _ hs_hx _) //. + exact/ch_notdomE_hs. ++ by have /incl_of_INV/incl_addm ->:= HINV. ++ by have /incli_of_INV/incl_addm ->:= HINV. ++ split. + + move=> xa' hx' ya' hy'; rewrite get_setE; case: ((xa',hx') = (x1,hx))=> [[#] <*>> [#] <<*> /=|]. + + exists x2 Known y2 Known=> //=; rewrite !get_setE /=. + by have /hs_of_INV [] _ _ dom_hs /#:= HINV. + move=> xahx'_neq_x1hx; have /mh_of_INV [] Hmh _ _ /Hmh {Hmh} := HINV. + move=> [xc fx yc] [] /= [#] hs_hx' hs_hy'=> [[p v] [Hro Hpath]|<*> Gm_xa'xc]. + + exists xc fx yc Unknown=> /=; rewrite !get_setE hs_hx' hs_hy'. + rewrite (dom_hs_neq_ch hs xc fx _ hs_hx') /=; 1:by case: HINV. + rewrite (dom_hs_neq_ch hs yc Unknown _ hs_hy')/= ; 1:by case: HINV. + exists p v; rewrite Hro /=; apply/build_hpath_up/(notin_m_notin_mh _ _ _ _ _ PFm_x1x2 hs_hx). + + done. + by case: HINV. + exists xc Known yc Known=> //=; rewrite !get_setE; case: ((xa',xc) = (x1,x2))=> [/#|]. + rewrite Gm_xa'xc /= (dom_hs_neq_ch hs xc Known _ hs_hx') /=; 1:by case: HINV. + by rewrite (dom_hs_neq_ch hs yc Known _ hs_hy')/= ; 1:by case: HINV. + + move=> p xa b; have /mh_of_INV [] _ -> _ := HINV; split. + + move=> [v hi hf] [#] Hpath mh_vxahi; exists v hi hf. + rewrite get_setE; case: ((v +^ xa,hi) = (x1,hx))=> [[#] <*>|_]. + + move: mh_vxahi; have /m_mh_of_INV [] _ H /H {H}:= HINV. + by move=> [xc fx yc fy] [#]; rewrite hs_hx=> [#] <*>; rewrite PFm_x1x2. + rewrite mh_vxahi /=; apply/build_hpath_up=> //. + by apply/(notin_m_notin_mh _ _ _ _ _ PFm_x1x2 hs_hx); case: HINV. + move=> [v hi hf] [#]. + have no_path_to_hx: forall p0 v0, build_hpath G1mh p0 <> Some (v0,hx). + + have /pi_of_INV [] /(_ x2):= HINV; rewrite pi_x2 /=. + by move=> + p0 v0 - /(_ p0 v0) /negb_exists /(_ hx) /=; rewrite hs_hx. + have H /H {H} := build_hpath_down G1mh x1 hx y1 ch p v hi no_path_to_hx. + rewrite get_setE. case: ((v +^ xa,hi) = (x1,hx))=> [[#] <*>|_ Hpath Hextend]. + + by rewrite no_path_to_hx. + by exists v hi hf. + move=> p v p' v' h0. + have: forall p0 v0, build_hpath G1mh p0 <> Some (v0,hx). + + have /pi_of_INV [] /(_ x2):= HINV; rewrite pi_x2 /=. + by move=> + p0 v0 - /(_ p0 v0) /negb_exists /(_ hx) /=; rewrite hs_hx. + move=> ^ + /build_hpath_down H /H {H} - /build_hpath_down H + /H {H}. + by have /mh_of_INV [] _ _ /(_ p v p' v' h0):= HINV. +split=> c p v; have /pi_of_INV [] -> := HINV. +apply/exists_iff=> h /=; split=> [#]. ++ move=> /build_hpath_up /(_ x1 hx y1 ch _). + + by apply/(notin_m_notin_mh hs PFm x2 Known); case:HINV. + move=> -> /=; rewrite get_setE. + by have /hs_of_INV [] _ _ dom_hs ^ + /dom_hs /#:= HINV. +have no_path_to_hx: forall p0 v0, build_hpath G1mh p0 <> Some (v0,hx). ++ have /pi_of_INV [] /(_ x2):= HINV; rewrite pi_x2 /=. + by move=> + p0 v0 - /(_ p0 v0) /negb_exists /(_ hx) /=; rewrite hs_hx. +have H /H {H} := build_hpath_down G1mh x1 hx y1 ch p v h no_path_to_hx. +move=> ^ Hpath -> /=; rewrite get_setE; case: (h = ch)=> [<*> /= [#] <*>|//=]. +move: Hpath=> /build_hpathP [<*>|]. ++ by have /hs_of_INV [] _ + H - /H {H}:= HINV. ++ move=> p' b' v' h' <*> _; have /m_mh_of_INV [] _ H /H {H}:= HINV. + by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. +(* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) +split=>[]. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ []. ++ move=>l hmem i hi. + have[]_ _ h2 _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have[]sa sc[]:=h2 l hmem i hi. + have h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + smt(domE get_setE). +by case:HINV=>_ _ _ _ _ _ _ _ _ []. +by case:HINV=>_ _ _ _ _ _ _ _ _ []. +qed. + +lemma lemma2' hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes queries x1 x2 y1 y2 hx: + INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes queries + => ! (y1,y2) \in PFm + => PFmi.[(x1,x2)] = None + => G1mi.[(x1,x2)] = None + => hs.[hx] = Some (x2,Known) + => (forall f h, hs.[h] <> Some (y2,f)) + => INV_CF_G1 hs.[ch <- (y2,Known)] (ch + 1) + PFm.[(y1,y2) <- (x1,x2)] PFmi.[(x1,x2) <- (y1,y2)] + G1m.[(y1,y2) <- (x1,x2)] G1mi.[(x1,x2) <- (y1,y2)] + G1mh.[(y1,ch) <- (x1,hx)] G1mhi.[(x1,hx) <- (y1,ch)] + ro pi prefixes queries. +proof. +move=> HINV hh PFmi_x1x2 G1mi_x1x2 hs_hx y2_notrngE1_hs. +split. ++ by apply/hs_addh=> //=; case: HINV. ++ apply/inv_addm=> //; 1:by case: HINV. + case: {-1}(G1m.[(y1,y2)]) (eq_refl G1m.[(y1,y2)])=> [//|[xa xc]]. + + have /incl_of_INV + ^h - <- := HINV; 1: by rewrite h. + have /m_mh_of_INV [] H _ /H {H} [hx' fx' hy' fy'] [#] := HINV. + by rewrite y2_notrngE1_hs. ++ apply/inv_addm; 1:by case: HINV. + + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. + by apply/(ch_notdomE2_mh _ _ Hm_mh Hhs). + have ^ /mi_mhi_of_INV Hm_mh /hs_of_INV Hhs := HINV. + by apply/(notin_m_notin_mh _ _ _ _ Hm_mh PFmi_x1x2 hs_hx). ++ have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /m_mh_of_INV := HINV. + move=> /mi_mhi_addh_addmi /(_ hx x1 x2 ch y1 y2 Known Known _ hs_hx _) //. + exact/ch_notdomE_hs. ++ have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /mi_mhi_of_INV := HINV. + move=> /m_mh_addh_addm /(_ hx x1 x2 ch y1 y2 Known Known _ hs_hx _) //. + exact/ch_notdomE_hs. ++ by have /incl_of_INV/incl_addm ->:= HINV. ++ by have /incli_of_INV/incl_addm ->:= HINV. ++ split. + + move=> ya' hy' xa' hx'; rewrite get_setE; case: ((ya',hy') = (y1,ch))=> [[#] <*>> [#] <<*> /=|]. + + exists y2 Known x2 Known=> //=; rewrite !get_setE /=. + by have /hs_of_INV [] _ _ dom_hs /#:= HINV. + move=> yahy'_neq_y1ch; have /mh_of_INV [] Hmh _ _ /Hmh {Hmh} := HINV. + move=> [yc fy xc] [] /= [#] hs_hy' hs_hx'=> [[p v] [#] Hro Hpath|Gm_ya'yc <*>]. + + exists yc fy xc Unknown => /=; rewrite !get_setE hs_hx' hs_hy'. + rewrite (dom_hs_neq_ch hs yc fy _ hs_hy') /=; 1:by case: HINV. + rewrite (dom_hs_neq_ch hs xc Unknown _ hs_hx')/= ; 1:by case: HINV. + exists p v; rewrite Hro /=; apply/build_hpath_up=> //. + case: {-1}(G1mh.[(y1,ch)]) (eq_refl G1mh.[(y1,ch)])=> [//|[za zc]]. + have /m_mh_of_INV [] _ H /H {H} [? ? ? ?] [#]:= HINV. + by have /hs_of_INV [] _ _ H /H {H} := HINV. + exists yc Known xc Known=> //=; rewrite !get_setE; case: ((ya',yc) = (y1,y2))=> [/#|]. + rewrite Gm_ya'yc /= (dom_hs_neq_ch hs yc Known _ hs_hy') /=; 1:by case: HINV. + by rewrite (dom_hs_neq_ch hs xc Known _ hs_hx')/= ; 1:by case: HINV. + + move=> p ya b; have /mh_of_INV [] _ -> _ := HINV. + apply/exists_iff=> v /=; apply/exists_iff=> hx' /=; apply/exists_iff=> hy' /=. + split=> [#]. + + move=> /(@build_hpath_up _ y1 ch x1 hx) /(_ _). + + apply/(@notin_hs_notdomE2_mh hs PFm)/(ch_notdomE_hs); by case: HINV. + move=> -> /=; rewrite get_setE /=; case: (hx' = ch)=> <*> //. + have /m_mh_of_INV [] _ H /H {H} [xc fx yc fy] [#] := HINV. + by have /hs_of_INV [] _ _ H /H {H} := HINV. + have no_path_to_ch: forall p0 v0, build_hpath G1mh p0 <> Some (v0,ch). + + move=> p0 v0; elim/last_ind: p0. + + by have /hs_of_INV [] /# := HINV. + move=> p0 b0 _; rewrite build_hpath_prefix. + apply/negb_exists=> b' /=; apply/negb_exists=> h' /=; apply/negb_and=> /=; right. + rewrite -negP; have /mh_of_INV [] H _ _ /H {H} [? ? ? ?] [#] _ := HINV. + by have /hs_of_INV [] _ _ H /H {H} := HINV. + have H /H {H} := build_hpath_down G1mh y1 ch x1 hx p v hx' no_path_to_ch. + rewrite get_setE. case: ((v +^ ya,hx') = (y1,ch))=> [[#] <*>|_ Hpath Hextend //=]. + by rewrite no_path_to_ch. + move=> p v p' v' h0. + have: forall p0 v0, build_hpath G1mh p0 <> Some (v0,ch). + + move=> p0 v0; elim/last_ind: p0. + + by have /hs_of_INV [] /# := HINV. + move=> p0 b0 _; rewrite build_hpath_prefix. + apply/negb_exists=> b' /=; apply/negb_exists=> h' /=; apply/negb_and=> /=; right. + rewrite -negP; have /mh_of_INV [] H _ _ /H {H} [? ? ? ?] [#] _ := HINV. + by have /hs_of_INV [] _ _ H /H {H} := HINV. + move=> ^ + /build_hpath_down H /H {H} - /build_hpath_down H + /H {H}. + by have /mh_of_INV [] _ _ /(_ p v p' v' h0):= HINV. +split=> c p v; have /pi_of_INV [] -> := HINV. +apply/exists_iff=> h /=; split=> [#]. ++ move=> /build_hpath_up /(_ y1 ch x1 hx _). + + have ^ /m_mh_of_INV [] _ H /hs_of_INV [] _ _ H' := HINV. + case: {-1}(G1mh.[(y1,ch)]) (eq_refl (G1mh.[(y1,ch)]))=> [//|]. + by move=> [za zc] /H [? ? ? ?] [#] /H'. + move=> -> /=; rewrite get_setE. + by have /hs_of_INV [] _ _ dom_hs ^ + /dom_hs /#:= HINV. +have no_path_to_ch: forall p0 v0, build_hpath G1mh p0 <> Some (v0,ch). ++ move=> p0 v0; elim/last_ind: p0. + + by have /hs_of_INV [] /# := HINV. + move=> p0 b0 _; rewrite build_hpath_prefix. + apply/negb_exists=> b' /=; apply/negb_exists=> h' /=; apply/negb_and=> /=; right. + rewrite -negP; have /mh_of_INV [] H _ _ /H {H} [? ? ? ?] [#] _ := HINV. + by have /hs_of_INV [] _ _ H /H {H} := HINV. ++ have H /H {H} := build_hpath_down G1mh y1 ch x1 hx p v h no_path_to_ch. + move=> ^ Hpath -> /=; rewrite get_setE; case: (h = ch)=> [<*> /= [#] <*>|//=]. + move: Hpath=> /build_hpathP [<*>|]. + + by have /hs_of_INV [] _ + H - /H {H}:= HINV. + move=> p' b' v' h' <*> _; have /m_mh_of_INV [] _ H /H {H}:= HINV. + by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. +(* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) +split=>[]. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ []. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ []. ++ move=>l hmem i hi. + have[]_ _ h2 _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have[]sa sc[]:=h2 l hmem i hi. + have h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + smt(domE get_setE). +by case:HINV=>_ _ _ _ _ _ _ _ _ []. +by case:HINV=>_ _ _ _ _ _ _ _ _ []. +qed. + +lemma lemma3 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries xa xc hx ya yc hy p b: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries + => Pm.[(xa,xc)] = Some (ya,yc) + => Gm.[(xa,xc)] = None + => mh.[(xa,hx)] = Some (ya,hy) + => hs.[hx] = Some (xc,Known) + => hs.[hy] = Some (yc,Unknown) + => pi.[xc] = Some (p,b) + => INV_CF_G1 hs.[hy <- (yc,Known)] ch + Pm Pmi + Gm.[(xa,xc) <- (ya,yc)] Gmi.[(ya,yc) <- (xa,xc)] + mh mhi + ro pi.[yc <- (rcons p (b +^ xa),ya)] prefixes queries. +proof. +move=> HINV Pm_xaxc Gm_xaxc mh_xahx hs_hx hs_hy pi_xc. +split. ++ have /hs_of_INV /hs_updh /(_ Unknown) H := HINV; apply/H=> {H} //. + by rewrite -negP=> <*>; move: hs_hy; have /hs_of_INV [] _ -> := HINV. ++ apply/inv_addm=> //; 1:by case: HINV. + case: {-1}(Gmi.[(ya,yc)]) (eq_refl Gmi.[(ya,yc)])=> [//|[xa' xc']]. + have /incli_of_INV + ^h - <- := HINV; 1:by rewrite h. + move: Pm_xaxc; have [] -> -> /= := inv_mh_inv_Pm hs Pm Pmi mh mhi _ _ _; first 3 by case: HINV. + rewrite -negP=> [#] <<*>. + move: h; have /invG_of_INV [] <- := HINV. + by rewrite Gm_xaxc. ++ by case: HINV. ++ by apply/(m_mh_updh Unknown)=> //; case: HINV. ++ by apply/(m_mh_updh Unknown)=> //; case: HINV. ++ move=> [za zc]; rewrite get_setE; case: ((za,zc) = (xa,xc))=> // _. + by have /incl_of_INV H /H {H}:= HINV. ++ move: mh_xahx; have /inv_of_INV [] H /H {H}:= HINV. + have /mi_mhi_of_INV [] _ H /H {H} [xct fxt yct fyt] [#] := HINV. + rewrite hs_hx hs_hy=> /= [#] 2!<<- [#] 2!<<- Pmi_yayc. + move=> [za zc]; rewrite get_setE; case: ((za,zc) = (ya,yc))=> // _. + by have /incli_of_INV H /H {H}:= HINV. ++ split; last 2 by have /mh_of_INV [] _:= HINV. + move=> xa' hx' ya' hy'; case: ((xa',hx') = (xa,hx))=> [[#] <*>|]. + + rewrite mh_xahx=> /= [#] <<*>; rewrite !get_setE /=. + case: (hx = hy)=> [<*>|_]; first by move: hs_hx; rewrite hs_hy. + by exists xc Known yc Known; rewrite get_setE. + move=> Hxahx' mh_xahx'. + have ^path_to_hy: build_hpath mh (rcons p (b +^ xa)) = Some (ya,hy). + + apply/build_hpath_prefix; exists b hx. + rewrite xorwA xorwK xorwC xorw0 mh_xahx /=. + move: pi_xc; have /pi_of_INV [] -> [h] [#] := HINV. + by have /hs_of_INV [] H _ _ + /H {H} /(_ _ _ hs_hx _) := HINV. + have /mh_of_INV [] /(_ _ _ _ _ mh_xahx') + ro_def H /H {H} unique_path_to_hy := HINV. + move=> [xc' fx' yc' fy'] /= [#]. + case: (hy' = hy)=> [<*> hs_hx'|Hhy']. + + rewrite hs_hy=> /= [#] <<*> /= [p' b'] [#] ro_pbxa' path_hx'. + have:= unique_path_to_hy (rcons p' (b' +^ xa')) ya' _. + + by apply/build_hpath_prefix; exists b' hx'; rewrite xorwA xorwK xorwC xorw0. + move=> [#] ^/rconsIs + /rconssI - <<*>. + by move: mh_xahx' Hxahx' mh_xahx; have /inv_of_INV [] ^ + -> - -> -> /= -> := HINV. + rewrite (@get_set_neqE _ _ hy' _ Hhy')=> /= hs_hx' ^ hs_hy' -> Hite. + exists xc' (if hx' = hy then Known else fx') yc' fy'. + rewrite (@get_setE Gm) (_: (xa',xc') <> (xa,xc)) /=. + + move: Hxahx'=> /=; case: (xa' = xa)=> [<*> /=|//]. + by apply/contra=> <*>; have /hs_of_INV [] + _ _ - /(_ _ _ _ _ hs_hx' hs_hx _) := HINV. + rewrite get_setE; case: (hx' = hy)=> /= [<*>|//]. + move: hs_hx'; rewrite hs_hy=> /= [#] <<*> /=. + by move: Hite=> /= [#]; case: fy' hs_hy'=> //= _ ->. ++ split=> c p' b'; rewrite !get_setE; case: (yc = c)=> [<<*> /=|yc_neq_c]; last first. + + rewrite (@eq_sym c) yc_neq_c /=; have /pi_of_INV [] -> := HINV. + apply/exists_iff=> h /=; rewrite get_setE; case: (h = hy)=> [<*> /=|//=]. + by rewrite yc_neq_c hs_hy /=. + split=> [[#] <<*>|]. + + exists hy; rewrite get_setE /=; apply/build_hpath_prefix. + exists b hx; rewrite xorwA xorwK xorwC xorw0 mh_xahx /=. + move: pi_xc; have /pi_of_INV [] -> [h] [#] + hs_h:= HINV. + by have /hs_of_INV [] + _ _ - /(_ _ _ _ _ hs_hx hs_h _) := HINV. + move=> [h]; rewrite get_setE; case: (h = hy)=> [<*> /=|]; last first. + + by have /hs_of_INV [] H _ _ + [#] _ /H {H} /(_ _ _ hs_hy _) // <*> := HINV. + have /mh_of_INV [] _ _ /(_ p' b') H /H {H} /(_ (rcons p (b +^ xa)) ya _) //:= HINV. + apply/build_hpath_prefix; exists b hx; rewrite xorwA xorwK xorwC xorw0 mh_xahx /=. + move: pi_xc; have /pi_of_INV [] -> [h] [#] + hs_h:= HINV. + by have /hs_of_INV [] + _ _ - /(_ _ _ _ _ hs_hx hs_h _) := HINV. +(* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) ++ by case:HINV. +qed. + + +lemma m_mh_None hs0 PFm G1mh hx2 x2 k x1: + m_mh hs0 PFm G1mh => + hs0.[hx2] = Some (x2, k) => + PFm.[(x1, x2)] = None => + G1mh.[(x1,hx2)] = None. +proof. + move=> [] HP /(_ x1 hx2) + Hhx2;case (G1mh.[(x1, hx2)]) => //. + by move=> -[ya hy] /(_ ya hy) /= [] ????; rewrite Hhx2 => /= [#] <- _ _ ->. +qed. + +lemma build_hpath_None (G1mh:hsmap) p: + foldl (step_hpath G1mh) None p = None. +proof. by elim:p. qed. + +lemma build_hpath_upd_ch ha ch mh xa ya p v hx: + 0 <> ch => ha <> ch => (forall xa xb ha hb, mh.[(xa,ha)] = Some(xb, hb) => ha <> ch /\ hb <> ch) => + build_hpath mh.[(xa, ha) <- (ya, ch)] p = Some (v, hx) => + if hx = ch then + (exists p0 x, build_hpath mh p0 = Some (x, ha) /\ p = rcons p0 (x +^ xa) /\ v = ya) + else + build_hpath mh p = Some (v, hx). +proof. + move=> Hch0 Hha Hch. + elim/last_ind: p v hx=> /=. + + by move=> v hx;rewrite /build_hpath /= => -[!<<-] //; rewrite Hch0. + move=> p x Hrec v hx /build_hpath_prefix [v' h' [/Hrec{Hrec}]]. + rewrite get_setE /=;case (h' = ch) => [->> | ]. + + by rewrite (@eq_sym ch) Hha /= => _ /Hch. + case (v' +^ x = xa /\ h' = ha) => [[!<<-] /= ?? [!->>] /=| ]. + + by exists p v'; rewrite xorwA xorwK xorwC xorw0. + case (hx = ch)=> [->> |??? Hbu Hg]. + + by move=> ??? /= /Hch. + by rewrite build_hpath_prefix;exists v' h';smt(). +qed. + +lemma build_hpath_up_None (G1mh:hsmap) bi1 bi2 bi p: + G1mh.[bi1] = None => + build_hpath G1mh p = Some bi => + build_hpath G1mh.[bi1 <- bi2] p = Some bi. +proof. + rewrite /build_hpath;move=> Hbi1. + elim: p (Some (b0,0)) => //= b p Hrec obi. + rewrite {2 4}/step_hpath /=;case: obi => //= [ | bi'];1:by apply Hrec. + rewrite get_setE. case ((bi'.`1 +^ b, bi'.`2) = bi1) => [-> | _];2:by apply Hrec. + by rewrite Hbi1 build_hpath_None. +qed. + +(* +lemma build_hpath_down_None h ch mh xa ha ya a p: + h <> ch => ha <> ch => + (forall ya, mh.[(ya,ch)] = None) => + build_hpath mh.[(xa,ha) <- (ya,ch)] p = Some (a,h) => + build_hpath mh p = Some (a,h). +proof. + move=> Hh Hha Hmh;rewrite /build_hpath;move: (Some (b0, 0)). + elim: p => //= b p Hrec [ | bi] /=;rewrite {2 4}/step_hpath /= ?build_hpath_None //. + rewrite oget_some get_setE;case ((bi.`1 +^ b, bi.`2) = (xa, ha)) => _;2:by apply Hrec. + move=> {Hrec};case: p=> /= [[_ ->>]| b' p];1: by move:Hh. + by rewrite {2}/step_hpath /= oget_some /= get_setE_neq /= ?Hha // Hmh build_hpath_None. +qed. +*) + +lemma build_hpath_upd_ch_iff ha ch mh xa ya p v hx: + mh.[(xa,ha)] = None => + 0 <> ch => ha <> ch => (forall xa xb ha hb, mh.[(xa,ha)] = Some(xb, hb) => ha <> ch /\ hb <> ch) => + build_hpath mh.[(xa, ha) <- (ya, ch)] p = Some (v, hx) <=> + if hx = ch then + (exists p0 x, build_hpath mh p0 = Some (x, ha) /\ p = rcons p0 (x +^ xa) /\ v = ya) + else + build_hpath mh p = Some (v, hx). +proof. + move=> Ha Hch0 Hha Hch;split;1: by apply build_hpath_upd_ch. + case (hx = ch);2: by move=> ?;apply build_hpath_up_None. + move=> ->> [p0 x [? [!->>]]]. + rewrite build_hpath_prefix;exists x ha. + by rewrite xorwA xorwK xorwC xorw0 get_set_sameE /=;apply build_hpath_up_None. +qed. + + +lemma lemma4 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries i p sa sc h f: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries +=> 0 <= i < List.size p +=> take (i + 1) p \in prefixes +=> prefixes.[take i p] = Some (sa,sc) +=> build_hpath mh (take i p) = Some (sa,h) +=> ro.[take (i+1) p] = Some (oget prefixes.[take (i+1) p]).`1 +=> hs.[h] = Some (sc, f) +=> (sa +^ nth witness p i, h) \in mh. +proof. +move=>inv0 hi take_i1_p_in_prefixes prefixes_sa_sc build_hpath_i_p ro_prefix hs_h_sc_f. +have[]_ _ m_prefix _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. +have[]b1 c1[]:=m_prefix _ take_i1_p_in_prefixes i _;1:smt(size_take). +rewrite!take_take!minrE //= (: i <= i + 1) 1:/# nth_take 1,2:/# prefixes_sa_sc/==>[][<-<-]{b1 c1}Pm_prefix. +have[]hh1 hh2 hh3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. +move:ro_prefix;have{1}->:=(take_nth witness i p);1:smt(size_take);move=>h1. +have:=hh2 (take i p) (nth witness p i) (oget prefixes.[take (i + 1) p]).`1. +rewrite h1/==>[][] v hx hy;rewrite build_hpath_i_p/==>[][][?<-];smt(domE). +qed. + +(* we should do a lemma to have the equivalence *) + + +equiv eq_fi (D <: DISTINGUISHER {-PF, -RO, -G1}): DPRestr(PF).fi ~ DPRestr(G1(DRestr(D)).S).fi: + !G1.bcol{2} + /\ !G1.bext{2} + /\ ={arg} /\ ={glob C} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} + PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} + F.RO.m{2} G1.paths{2} + Redo.prefixes{1} C.queries{2} + ==> if G1.bcol{2} \/ G1.bext{2} + then ([] \in C.queries{1}) /\ ([] \in C.queries{2}) + else ={res} /\ ={glob C} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} + PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} + F.RO.m{2} G1.paths{2} + Redo.prefixes{1} C.queries{2}. +proof. +proc;sp;if;auto. +call(: !G1.bcol{2} + /\ !G1.bext{2} + /\ ={x} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} + PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} + F.RO.m{2} G1.paths{2} + Redo.prefixes{1} C.queries{2} + ==> !G1.bcol{2} + => !G1.bext{2} + => ={res} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} + PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} + F.RO.m{2} G1.paths{2} + Redo.prefixes{1} C.queries{2});auto. +exists* FRO.m{2}, G1.chandle{2}, PF.m{1}, PF.mi{1}, + G1.m{2}, G1.mi{2}, G1.mh{2}, G1.mhi{2}, + F.RO.m{2}, G1.paths{2}, x{2}, Redo.prefixes{1}, C.queries{2}. +elim* => hs ch Pm Pmi Gm Gmi mh mhi ro pi [xa xc] prefixes queries. +case @[ambient]: + {-1}(INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries) + (eq_refl (INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries)); last first. ++ by move=> inv0; exfalso=> ? ? [#] <<*>; rewrite inv0. +move=> /eqT inv0; proc. +case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] Pmi_xaxc]. ++ have /incli_of_INV /(_ (xa,xc)) := inv0; rewrite Pmi_xaxc /=. + case: {-1}(Gmi.[(xa,xc)]) (eq_refl Gmi.[(xa,xc)])=> //= Gmi_xaxc. + rcondt{1} 1; 1:by auto=> &hr [#] <<*>; rewrite domE Pmi_xaxc. + rcondt{2} 1; 1:by auto=> &hr [#] <<*>; rewrite domE Gmi_xaxc. + case @[ambient]: {-1}(getflag hs xc) (eq_refl (getflag hs xc)). + + move=> /getflagP_none xc_notrngE1_hs. + rcondt{2} 2. + + auto=> &hr [#] <<*> _ _ _; rewrite rngE /= negb_exists=> h /=. + by rewrite xc_notrngE1_hs. + rcondf{2} 8. + + auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _. + rewrite negb_and domE; left. + rewrite (@huniq_hinvK_h ch) 3:oget_some /=. + + by apply/huniq_addh=> //; have /hs_of_INV [] := inv0. + + by rewrite get_setE. + apply/(@notin_m_notin_mh hs.[ch <- (xc,Known)] Pmi _ _ xc ch Known)=> //. + + by apply/m_mh_addh=> //; case: inv0. + by rewrite get_setE. + auto=> ? ? [#] !<<- -> -> ->> _ /= ya ? /= yc ? /=. + case: (hinvP (hs.[ch <- (xc,Known)]) yc)=> [_|-> //] yc_notrngE1_hs_addh _ _. + rewrite get_setE /= (@huniq_hinvK_h ch) 3:oget_some /=. + + by apply/huniq_addh=> //; have /hs_of_INV [] := inv0. + + by rewrite get_setE. + apply/(@lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries xa xc ya yc inv0 _ _ Pmi_xaxc Gmi_xaxc)=> //;first last. + + rewrite -negP=> <*>; move: yc_notrngE1_hs_addh => /=. + apply/negb_forall=> /=; exists ch; apply/negb_forall=> /=; exists Known. + by rewrite get_setE. + + move=> f h; move: (yc_notrngE1_hs_addh h f); rewrite get_setE. + case: (h = ch)=> <*> //= _; rewrite -negP. + by have /hs_of_INV [] _ _ H /H {H} := inv0. + + rewrite domE/=;have[]h1 h2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + have h1':=h1 ya yc. + have :Pm.[(ya, yc)] <> None => exists (hx : handle) (fx : flag), hs.[hx] = Some (yc, fx). + + move=> y_in_Pm; move: (h1' (oget Pm.[(ya,yc)]).`1 (oget Pm.[(ya,yc)]).`2 _). + + by move: y_in_Pm; case: (Pm.[(ya,yc)])=> - //= []. + by move=> [hx fx hy fy] [#] h _ _; exists hx fx. + case(Pm.[(ya, yc)] = None)=>//=h; + rewrite negb_exists/==>a;rewrite negb_exists/==>b. + have:=yc_notrngE1_hs_addh a b;rewrite get_setE;case(a=ch)=>//=hach. + case(xc=yc)=>[/#|]hxyc. + have[]_ _ help:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + by have/#:=help (yc,b) a. + have /hs_of_INV [] Hhuniq _ _ [] /(getflagP_some _ _ _ Hhuniq):= inv0. + + move=> x2_is_U; conseq (_: _ ==> G1.bext{2})=> //. + by auto=> ? ? [#] !<<- _ -> ->>_ /=; rewrite x2_is_U. + move=> x2_is_K; have:=x2_is_K; rewrite rngE=> -[hx2] hs_hx2. + rcondf{2} 2; 1:by auto=> &hr [#] <*> /=; rewrite x2_is_K. + rcondf{2} 6. + + auto=> &hr [#] !<<- _ _ ->> _. + rewrite (@huniq_hinvK_h hx2) // oget_some /= => _ _ _ _. + rewrite negb_and domE /=; left. + by apply/(@notin_m_notin_mh hs Pmi _ _ xc _ Known)=> //; case: inv0. + auto => ? ? [#] !<<- -> -> ->> _. + rewrite (@huniq_hinvK_h hx2) // oget_some /= => y1 ? /= y2 ? /=. + case: (hinvP hs y2)=> [_ y2_notrngE1_hs _ _|/#]. + rewrite get_setE /=. + apply/lemma2'=> //. + + rewrite domE/=;have[]h1 _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + have h1':=h1 y1 y2. + have :Pm.[(y1, y2)] <> None => exists (hx : handle) (fx : flag), hs.[hx] = Some (y2, fx). + + move=> y_in_Pm; move: (h1' (oget Pm.[(y1,y2)]).`1 (oget Pm.[(y1,y2)]).`2 _). + + by move: y_in_Pm; case: (Pm.[(y1,y2)])=> - //= []. + by move=> [hx fx hy fy] [#] h _ _; exists hx fx. + case(Pm.[(y1, y2)] = None)=>//=h; + rewrite negb_exists/==>a;rewrite negb_exists/==>b. + exact(y2_notrngE1_hs). + move=> f h; exact/y2_notrngE1_hs. +rcondf{1} 1; 1:by auto=> &hr [#] <<*>; rewrite domE Pmi_xaxc. +case @[ambient]: {-1}(Gmi.[(xa,xc)]) (eq_refl Gmi.[(xa,xc)])=> [|[ya' yc']] Gmi_xaxc. ++ rcondt{2} 1; 1:by auto=> &hr [#] <<*>; rewrite domE Gmi_xaxc. + conseq (_: _ ==> G1.bext{2})=> //. + auto=> &1 &2 [#] !<<- _ -> ->> _ />. + rewrite !rngE /=; have ->: exists hx, hs.[hx] = Some (xc,Unknown). + + move: Pmi_xaxc; have /mi_mhi_of_INV [] H _ /H {H} := inv0. + move=> [hx fx hy fy] [#] hs_hx hs_hy. + have ^/inv_of_INV [] <- /mh_of_INV [] H _ _ /H {H} := inv0. + move=> [? ? ? ?] [#]; rewrite hs_hx hs_hy=> /= [#] <<*> [#] <<*>. + case: fx hs_hx=> hs_hx /= => [_|[#]]; first by exists hx. + by have /invG_of_INV [] -> := inv0; rewrite Gmi_xaxc. + smt (@Block.DBlock @Capacity.DCapacity). +have:=Gmi_xaxc. +have /incli_of_INV <- := inv0; 1:by rewrite Gmi_xaxc. +rewrite Pmi_xaxc=> /= [#] <<*>. +rcondf{2} 1; 1:by auto=> &hr [#] <<*>; rewrite domE Gmi_xaxc. +by auto=> &1 &2 /#. ++ by move=> /> &1 &2 _ _ /m_p_of_INV []; smt(domE). +by move=> /> &1 &2 -> ->. +qed. + + +equiv eq_f (D <: DISTINGUISHER {-PF, -RO, -G1}): DPRestr(PF).f ~ DPRestr(G1(DRestr(D)).S).f: + !G1.bcol{2} + /\ !G1.bext{2} + /\ ={x} /\ ={glob C} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} + PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} + F.RO.m{2} G1.paths{2} + Redo.prefixes{1} C.queries{2} + ==> if G1.bcol{2} \/ G1.bext{2} + then ([] \in C.queries{2}) + else ={res} /\ ={glob C} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} + PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} + F.RO.m{2} G1.paths{2} + Redo.prefixes{1} C.queries{2}. +proof. +proc;sp;if;auto. +call(: !G1.bcol{2} + /\ !G1.bext{2} + /\ ={arg} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} + PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} + F.RO.m{2} G1.paths{2} + Redo.prefixes{1} C.queries{2} + ==> if G1.bcol{2} \/ G1.bext{2} + then ([] \in C.queries{2}) + else ={res} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} + PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} + F.RO.m{2} G1.paths{2} + Redo.prefixes{1} C.queries{2});auto. + exists * FRO.m{2}, G1.chandle{2}, + PF.m{1}, PF.mi{1}, + G1.m{2}, G1.mi{2}, G1.mh{2}, G1.mhi{2}, + F.RO.m{2}, G1.paths{2}, Redo.prefixes{1}, C.queries{2}, + x{2}. + elim * => hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref queries [] x1 x2. + (* poor man's extraction of a fact from a precondition *) + case @[ambient]: {-1}(INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref queries) + (eq_refl (INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref queries)); last first. + + by move=> h; exfalso=> &1 &2 [#] <*>; rewrite h. + move=> /eqT inv0; proc; case @[ambient] {-1}(PFm.[(x1,x2)]) (eq_refl (PFm.[(x1,x2)])). + + move=> PFm_x1x2. + have /incl_of_INV /(notin_m_notin_Gm _ _ (x1,x2)) /(_ _) // Gm_x1x2 := inv0. + rcondt{1} 1; 1:by move=> //= &1; skip=> &2 [#] <*>; rewrite domE PFm_x1x2. + rcondt{2} 1; 1:by move=> //= &1; skip=> &2 [#] <*>; rewrite domE Gm_x1x2. + case @[ambient]: {-1}(pi0.[x2]) (eq_refl (pi0.[x2])). + + move=> x2_in_pi; rcondf{2} 1. + + by move=> //= &1; skip=> &2 [#] <*>; rewrite domE x2_in_pi. + rcondf{2} 8. + + by move=> //= &1; auto=> &2 [#] !<<-; rewrite !domE x2_in_pi. + seq 2 2: ( hs0 = FRO.m{2} + /\ ch0 = G1.chandle{2} + /\ PFm = PF.m{1} + /\ PFmi = PF.mi{1} + /\ G1m = G1.m{2} + /\ G1mi = G1.mi{2} + /\ G1mh = G1.mh{2} + /\ G1mhi = G1.mhi{2} + /\ ro0 = F.RO.m{2} + /\ pi0 = G1.paths{2} + /\ pref = Redo.prefixes{1} + /\ queries = C.queries{2} + /\ (x1,x2) = x{2} + /\ !G1.bcol{2} + /\ !G1.bext{2} + /\ ={x, y1, y2} + /\ INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref queries). + + by auto. + case @[ambient]: {-1}(getflag hs0 x2) (eq_refl (getflag hs0 x2)). + + rewrite getflagP_none => x2f_notrngE_hs0; rcondt{2} 3. + + move=> &1; auto=> &2 /> _ _ _; rewrite rngE /= negb_exists /=. + exact/(@x2f_notrngE_hs0 Known). + rcondf{2} 6. + + move=> &1; auto=> &2 />. + have ->: hinvK FRO.m{2}.[G1.chandle{2} <- (x2,Known)] x2 = Some G1.chandle{2}. + + rewrite (@huniq_hinvK_h G1.chandle{2} FRO.m{2}.[G1.chandle{2} <- (x2,Known)] x2) //. + + move=> hx hy [] xc xf [] yc yf /=. + rewrite !get_setE; case: (hx = G1.chandle{2}); case: (hy = G1.chandle{2})=> //=. + + by move=> _ + [#] - <*>; have:= (x2f_notrngE_hs0 yf hy). + + by move=> + _ + [#] - <*>; have:= (x2f_notrngE_hs0 xf hx). + by move=> _ _; have /hs_of_INV [] + _ _ - /(_ hx hy (xc,xf) (yc,yf)) := inv0. + by rewrite !get_setE. + rewrite oget_some=> _ _ _. + have -> //: (x1,G1.chandle{2}) \notin G1.mh{2}. + rewrite domE /=; case: {-1}(G1.mh.[(x1,G1.chandle)]{2}) (eq_refl (G1.mh.[(x1,G1.chandle)]{2}))=> //= -[xa xh]; rewrite -negP. + have ^/m_mh_of_INV [] _ + /hs_of_INV [] _ _ h_handles := inv0. + by move=> /(_ x1 G1.chandle{2} xa xh) h /h [] xc xf yc yf [#] /h_handles. + case: (x2 <> y2{2} /\ (forall f h, hs0.[h] <> Some (y2{2},f))). + + auto=> &1 &2 [#] !<<- -> -> !->> /= _ x2_neq_y2 y2_notin_hs. + rewrite get_setE /=. + rewrite (@huniq_hinvK_h ch0 hs0.[ch0 <- (x2,Known)] x2); 2:by rewrite get_setE. + + move=> @/huniq h1 h2 [c1 f1] [c2 f2]; rewrite !get_setE /=. + case: (h1 = ch0); case: (h2 = ch0)=> //=. + + by move=> _ + [#] - <*>; move: (x2f_notrngE_hs0 f2 h2). + + by move=> + _ + [#] <*> - <*>; move: (x2f_notrngE_hs0 f1 h1). + have /hs_of_INV [] + _ _ _ _ - h := inv0. + by apply/h; rewrite get_setE. + rewrite !oget_some;rewrite domE;have[]_ -> _ _ _ /=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + smt(lemma1). + conseq (_: _ ==> G1.bcol{2})=> //=. + + by auto=> &1 &2 [#] !<<- bad1 bad2 -> _ ->> !<<- _ /=/>; + rewrite domE;have[]_ ->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + auto=> &1 &2 [#] !<<- -> _ ->> !<<- _ /=/>. + case: (hinvP hs0.[ch0 <- (x2,Known)] y2{1})=> //= -> /=. + move=> hs0_spec; split=> [|f]. + + by have:= hs0_spec ch0 Known; rewrite get_setE. + move=> h; have:= hs0_spec h f; rewrite get_setE; case: (h = ch0)=> [<*>|//=]. + by move=> _; rewrite -negP; have /hs_of_INV [] _ _ H /H {H}:= inv0. + case; rewrite getflagP_some; 1,3:by have /hs_of_INV []:= inv0. + + move=> x2_is_U; conseq (_: G1.bext{2})=> //=; auto=> &1 &2 /> _ _ hinv0 . + by rewrite domE;have[]_ -> _ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + move=> x2_is_K; rcondf{2} 3; 1:by move=> &1; auto. + have:= x2_is_K; rewrite rngE=> - [hx] hs0_hx. + seq 0 3: ( hs0 = FRO.m{2} + /\ ch0 = G1.chandle{2} + /\ PFm = PF.m{1} + /\ PFmi = PF.mi{1} + /\ G1m = G1.m{2} + /\ G1mi = G1.mi{2} + /\ G1mh = G1.mh{2} + /\ G1mhi = G1.mhi{2} + /\ ro0 = F.RO.m{2} + /\ pi0 = G1.paths{2} + /\ pref = Redo.prefixes{1} + /\ queries = C.queries{2} + /\ (x1,x2) = x{2} + /\ !G1.bcol{2} + /\ !G1.bext{2} + /\ ={x,y1,y2} + /\ y{2} = (y1,y2){2} + /\ hx2{2} = hx + /\ INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref queries). + (* TODO : reduce the example to reproduce the problem with : auto=> &1 &2 /> *) + + auto=> &1 &2 [#] 13!<<- 2!-> 3!->> HINV0 /=;split. + + move: x2_is_K; rewrite rngE /= => -[hx2] hs_hx2. + rewrite negb_exists /==> h; rewrite -negP=> hs_h. + have /hs_of_INV [] Hhuniq _ _ := inv0. + by move: (Hhuniq _ _ _ _ hs_hx2 hs_h)=> ht; move: ht hs_h=> /= <*>; rewrite hs_hx2. + rewrite (@huniq_hinvK_h hx hs0 x2) //. + by have /hs_of_INV [] := inv0. + have x1hx_notin_G1m: (x1,hx) \notin G1mh. + + rewrite domE; case: {-1}(G1mh.[(x1,hx)]) (eq_refl G1mh.[(x1,hx)])=> //=. + move=> [mhx1 mhx2]; rewrite -negP=> h. + have /m_mh_of_INV [] _ hg := inv0. + have [xa xh ya yh] := hg _ _ _ _ h. + by rewrite hs0_hx=> [#] <*>; rewrite PFm_x1x2. + rcondf{2} 1. + + by move=> &m; auto=> //= &hr [#] <*>; rewrite x1hx_notin_G1m. + auto=> &1 &2 [#] !<<- -> -> !->> _ /=. + rewrite domE;have[]_ -> _ _ _ /=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + case(hinv hs0 y2{2} = None)=>//=h; + rewrite get_setE /=;smt(lemma2 hinvP). + move=> [p0 v0] pi_x2; have:=pi_x2. + have /pi_of_INV [] -> [hx2] [#] Hpath hs_hx2:= inv0. + rcondt{2} 1. by move=> &m; auto=> &hr [#] !<<- _ _ ->> /= _; rewrite domE pi_x2. + rcondf{2} 6. + + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. + by rewrite rngE; exists hx2. + rcondf{2} 7. + + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. + rewrite negb_and; left; rewrite (@huniq_hinvK_h hx2 hs0 x2) // 2:oget_some. + + by have /hs_of_INV []:= inv0. + rewrite domE; case: {-1}(G1mh.[(x1,hx2)]) (eq_refl (G1mh.[(x1,hx2)]))=> [//=|[xa xc] G1mh_x1hx2]. + have /m_mh_of_INV [] _ /(_ _ _ _ _ G1mh_x1hx2) [xc0 xf0 yc0 yf0] := inv0. + by move=> [#]; rewrite hs_hx2=> [#] !<<-; rewrite PFm_x1x2. + rcondt{2} 15. + + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. + by rewrite domE pi_x2. + inline F.RO.get. rcondt{2} 4. + + auto=> &hr [#] !<<- _ _ !->> _ /= _ _; rewrite pi_x2 oget_some /=. + rewrite domE; case: {-1}(ro0.[rcons p0 (v0 +^ x1)]) (eq_refl (ro0.[rcons p0 (v0 +^ x1)])). + + done. + move=> bo ^ro_pvx1 /=. have /mh_of_INV [] _ -> _:= inv0. + rewrite negb_exists=> ? /=; rewrite negb_exists=> ? /=; rewrite negb_exists=> yh /=. + rewrite Hpath /=; rewrite negb_and -implyNb /= => [#] !<<-. + rewrite xorwA xorwK xorwC xorw0 -negP=> G1mh_x1hx2. + have /m_mh_of_INV [] _ /(_ _ _ _ _ G1mh_x1hx2) := inv0. + move=> [xc xf yc yf] [#]; rewrite hs_hx2=> [#] <*>. + by rewrite PFm_x1x2. + auto => &m1 &m2 [#] !<- _ _ -> /= _ y1L ? y2L ? /=. + rewrite !get_set_sameE pi_x2 oget_some /=. + have /hs_of_INV [] Hu _ _:= inv0; have -> := huniq_hinvK_h _ _ _ Hu hs_hx2. + rewrite oget_some domE => /= ;have[]_->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + case(G1.bcol{m2} \/ hinv hs0 y2L <> None)=>//=;rewrite !negb_or/==>[][]? hinv0[]? hinv1. + case:inv0=> Hhs Hinv HinvG Hmmh Hmmhi Hincl Hincli Hmh Hpi Hmp. + have Hhx2:= dom_hs_neq_ch _ _ _ _ _ Hhs hs_hx2. + have mh_hx2: G1mh.[(x1,hx2)] = None. + + case Hmmh => _ /(_ x1 hx2);case (G1mh.[(x1, hx2)]) => // -[ya hy] /(_ ya hy) /=. + by rewrite -negP=> -[xc fx yc fy];rewrite hs_hx2 => -[[!<<-]];rewrite PFm_x1x2. + have ch_0 := ch_neq0 _ _ Hhs. + have ch_None : forall xa xb ha hb, G1mh.[(xa,ha)] = Some(xb, hb) => ha <> ch0 /\ hb <> ch0. + + move=> xa xb ha hb;case Hmmh=> _ H /H [xc fx yc fy [#]]. + by move=> /(dom_hs_neq_ch _ _ _ _ _ Hhs) -> /(dom_hs_neq_ch _ _ _ _ _ Hhs). + split. + + by apply hs_addh => //;have /# := hinvP hs0 y2L. + + apply inv_addm=> //; case: {-1}(G1mi.[(y1L,y2L)]) (eq_refl G1mi.[(y1L,y2L)])=> //. + move=> [x1L x2L] ^G1mi_y; rewrite -Hincli 1:G1mi_y//. + case: Hmmhi hinv0 => H _ + /H {H} [hx fx hy fy] [#]. + by case: (hinvP hs0 y2L)=> [_ ->|//]/#. + + by apply inv_addm=>//; apply (ch_notdomE2_mh _ _ Hmmhi Hhs). + + by apply (m_mh_addh_addm _ Hmmh _ hs_hx2)=>//;apply ch_notdomE_hs. + + apply (mi_mhi_addh_addmi _ Hmmhi _ hs_hx2);last by apply ch_notdomE_hs. + by have := hinvP hs0 y2L;rewrite /#. + + by apply incl_addm. + by apply incl_addm. + + split. + + move=> xa hx ya hy;rewrite get_setE;case ((xa, hx) = (x1, hx2))=> /=. + + move=> [] !->> [] !<<-; exists x2 Known y2L Known. + by rewrite /= !get_set_sameE /= get_set_neqE. + move=> Hdiff Hxa; case Hmh=> /(_ _ _ _ _ Hxa) [] xc fx yc fy [#] Hhx Hhy HG1 _ _. + exists xc fx yc fy;rewrite !get_set_neqE //. + + by apply (dom_hs_neq_ch _ _ _ Hhs Hhx). + + by apply (dom_hs_neq_ch _ _ _ Hhs Hhy). + + rewrite /= -negP=> -[] <<- <<-;apply Hdiff=> /=. + by apply (Hu hx (xc, fx) (xc, Known)). + rewrite Hhx Hhy=> /=;move: HG1. + case: fy Hhy=> Hhy //= [p v [Hro Hbu]]. + exists p v;split. + + rewrite get_set_neqE // -negP => ^ /rconssI <<- /rconsIs. + move: Hbu;rewrite Hpath /= => -[!<<-] /=. + by rewrite -negP=> /Block.WRing.addrI /#. + by apply build_hpath_up=> //; move: hs_hx2 PFm_x1x2;apply: m_mh_None. + + move=> p bn b; rewrite get_setE. + case (rcons p bn = rcons p0 (v0 +^ x1)). + + rewrite /= => ^ /rconssI <<- /rconsIs ->> /=; split => [<<- | ]. + + exists v0 hx2 ch0. + rewrite (build_hpath_up Hpath) /=;1:by move: hs_hx2 PFm_x1x2;apply: m_mh_None. + by rewrite xorwA xorwK Block.WRing.add0r get_set_sameE. + move=> [v hx hy] [];rewrite get_setE ;case ((v +^ (v0 +^ x1), hx) = (x1, hx2)) => //. + move=> Hdiff;have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. + have -> /= [->> <<-]:= build_hpath_up_None _ _ (y1L, ch0) _ _ HG1 Hpath. + by move:Hdiff;rewrite xorwA xorwK Block.WRing.add0r. + rewrite /= => Hdiff. + case Hmh => ? -> Huni. + apply exists_iff=> v /= ;apply exists_iff => hx /=;apply exists_iff => hy /=. + rewrite build_hpath_upd_ch_iff //. + case (hx = ch0) => [->>|?]. + + split;1: by move=> [] _ /ch_None. + move=> [[p0' x [Hhx2']]]. + have [!->>] [!->>]:= Huni _ _ _ _ _ Hpath Hhx2'. + rewrite get_set_neqE /=. + + by rewrite (@eq_sym ch0 hx2) Hhx2. + by move => /ch_None. + rewrite get_setE;case ((v +^ bn, hx) = (x1, hx2)) => //= -[<<- ->>]. + split=> -[H];have [!->>]:= Huni _ _ _ _ _ Hpath H;move:Hdiff; + by rewrite xorwA xorwK Block.WRing.add0r. + move=> p v p' v' hx;case Hmh => _ _ Huni. + rewrite !build_hpath_upd_ch_iff //. + case (hx = ch0) => [->> [?? [# H1 -> ->]] [?? [# H2 -> ->]]|_ ] /=. + + by have [!->>] := Huni _ _ _ _ _ H1 H2. + by apply Huni. + split=> c p v;rewrite get_setE. case (c = y2L) => [->> /= | Hc]. + + split. + + move=> [!<<-];exists ch0;rewrite get_set_sameE /= build_hpath_prefix. + exists v0 hx2;rewrite xorwA xorwK Block.WRing.add0r get_set_sameE /=. + have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. + by apply build_hpath_up_None. + move=> [h []];rewrite get_setE build_hpath_upd_ch_iff //. + case (h=ch0)=> [->> /= [??[# H1 -> ->]]| Hh] /=. + + by case Hmh => _ _ /(_ _ _ _ _ _ Hpath H1). + by have := hinvP hs0 y2L;rewrite /= => /#. + case Hpi => ->;apply exists_iff => h /=. + rewrite build_hpath_upd_ch_iff // get_setE;case (h = ch0) => [->> | //]. + split;1: by move=> [_ /(dom_hs_neq_ch _ _ _ _ _ Hhs)]. + by move=> /= [_ <<-];move:Hc. + split. + + by have[]/#:=Hmp. + + by have[]/#:=Hmp. + + have[]_ _ h _ _ l hdom i hi:=Hmp. + have[]b c[]->h':=h l hdom i hi. + by exists b c=>//=;rewrite get_setE/=-h';smt(domE take_oversize). + + by have[]/#:=Hmp. + + by have[]/#:=Hmp. + move=> [xa xc] PFm_x1x2. rcondf{1} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite domE PFm_x1x2. + have /m_mh_of_INV [] + _ - /(_ _ _ _ _ PFm_x1x2) := inv0. + move=> [hx2 fx2 hy2 fy2] [#] hs_hx2 hs_hy2 G1mh_x1hx2. + case @[ambient]: {-1}(G1m.[(x1,x2)]) (eq_refl (G1m.[(x1,x2)])); last first. + + move=> [ya yc] G1m_x1x2; rcondf{2} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite domE G1m_x1x2. + auto=> &1 &2 [#] <*> -> -> -> /=; have /incl_of_INV /(_ (x1,x2)) := inv0. + by rewrite PFm_x1x2 G1m_x1x2. + move=> x1x2_notin_G1m; rcondt{2} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite domE x1x2_notin_G1m. + have <*>: fy2 = Unknown. + + have /mh_of_INV [] /(_ _ _ _ _ G1mh_x1hx2) + _ := inv0. + move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<-. + by case: fy2 hs_hy2 G1mh_x1hx2=> //=; rewrite x1x2_notin_G1m. + case @[ambient]: fx2 hs_hx2=> hs_hx2. + + swap{2} 3 -2; seq 0 1: (queries = C.queries{2} /\ G1.bext{2}). + - by auto=> ? ? [#] !<<- _ -> ->> _ /=; rewrite rngE; exists hx2. + conseq(:_==> (! (G1.bcol{2} \/ G1.bext{2})) => oget PF.m{1}.[x{1}] = y{2} /\ + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} C.queries{2}); + progress;2..-2:rewrite/#. + - by rewrite domE;have[]_->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + by inline*; if{2}; auto=> &1 &2 />; smt(F.sampleto_ll sampleto_ll). + have /mh_of_INV []/(_ _ _ _ _ G1mh_x1hx2) + _ _:= inv0. + move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- /= [p0 v0] [#] Hro Hpath. + have /pi_of_INV [] /(_ x2 p0 v0) /iffRL /(_ _) := inv0. + + by exists hx2=>/#. + move=> pi_x2; rcondt{2} 1; 1:by auto=> &hr [#] <*>; rewrite domE pi_x2. + inline F.RO.get. + rcondf{2} 4; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite pi_x2 oget_some /= domE Hro. + rcondf{2} 8; first by auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _; rewrite rngE; exists hx2. + rcondt{2} 9. + + auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _. + rewrite (@huniq_hinvK_h hx2 hs0 x2) // 2:domE 2:G1mh_x1hx2 2:!oget_some /=. + + by have /hs_of_INV []:= inv0. + by rewrite /in_dom_with domE hs_hy2. + rcondt{2} 14; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite domE pi_x2. + auto=> &1 &2 [#] !<<- -> -> ->> _ /=. + move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 !oget_some //=. + rewrite (@huniq_hinvK_h hx2 hs0 x2) // 10?oget_some. + + by have /hs_of_INV []:= inv0. + rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //=domE. + have[]_->_ _ _//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + case(rng hs0 (x2, Unknown))=>//=_. + exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). + by move=> /> &1 &2 -> ->. +qed. + +lemma head_nth (w:'a) l : head w l = nth w l 0. +proof. by case l. qed. + +lemma drop_add (n1 n2:int) (l:'a list) : 0 <= n1 => 0 <= n2 => drop (n1 + n2) l = drop n2 (drop n1 l). +proof. + move=> Hn1 Hn2;elim: n1 Hn1 l => /= [ | n1 Hn1 Hrec] l;1: by rewrite drop0. + by case: l => //= a l /#. +qed. + +lemma behead_drop (l:'a list) : behead l = drop 1 l. +proof. by case l => //= l;rewrite drop0. qed. + +lemma incl_upd_nin (m1 m2:('a,'b)fmap) x y: incl m1 m2 => x \notin m2 => incl m1 m2.[x <- y]. +proof. + move=> Hincl Hdom w ^/Hincl <- => Hw. + rewrite get_set_neqE // -negP => ->>. + by move: Hdom;rewrite domE. +qed. + + + +lemma lemma5 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries i (p : block list) b c h: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries + => 0 <= i < size p + => take (i + 1) p \in prefixes + => prefixes.[take i p] = Some (b,c) + => (exists f, hs.[h] = Some (c,f)) + => exists b' c' h', + Pm.[(b +^ nth witness p i, c)] = Some (b',c') /\ + mh.[(b +^ nth witness p i, h)] = Some (b',h'). +proof. +move=>Hinv H_size H_take_iS H_take_i H_hs_h. +have[]_ _ H _ _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. +have[]sa sc:=H _ H_take_iS i _;1:smt(size_take). +rewrite!take_take !minrE (: i <= i + 1) 1: /# nth_take 1,2:/#H_take_i=>[][]/=[->>->>] H_pm. +have[]b' c' H_Pm:exists b' c', Pm.[(sa +^ nth witness p i, sc)] = Some (b',c'). ++ rewrite H_pm. exists (oget prefixes.[take (i + 1) p]).`1 (oget prefixes.[take (i + 1) p]).`2. + by move: H_take_iS; rewrite domE; case: (prefixes.[take (i + 1) p])=> //= - []. +exists b' c';rewrite -H_Pm/=. +have[]h_Pm _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. +have[]h' f' hy fy[]H_h'[]H_hy H_mh:=h_Pm _ _ _ _ H_Pm. +have[]h_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. +have[]f H_h := H_hs_h. +have/=<<-:=h_huniq _ _ _ _ H_h H_h'. +by rewrite H_mh/=/#. +qed. + + +lemma lemma5' hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries i (p : block list) b c h: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries + => 0 <= i < size p + => prefixes.[take i p] = Some (b,c) + => (exists f, hs.[h] = Some (c,f)) + => (exists b' c' h', + Pm.[(b +^ nth witness p i, c)] = Some (b',c') /\ + mh.[(b +^ nth witness p i, h)] = Some (b',h')) \/ + (Pm.[(b +^ nth witness p i, c)] = None /\ + mh.[(b +^ nth witness p i, h)] = None). +proof. +move=>Hinv H_size H_take_i H_hs_h. +case(Pm.[(b +^ nth witness p i, c)] = None)=>//=H_Pm. ++ right;move:H_Pm;apply absurd=>H_mh. + have[]b1 h1 H_mh1:exists b1 h1, mh.[(b +^ nth witness p i, h)] = Some (b1,h1). + + exists (oget mh.[(b +^ nth witness p i, h)]).`1 (oget mh.[(b +^ nth witness p i, h)]).`2. + by move: H_mh; case: (mh.[(b +^ nth witness p i, h)])=> //= - []. + have[]H_Pm H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. + by have/#:=H_Gmh _ _ _ _ H_mh1. +have[]b1 c1 H_Pm1:exists b1 c1, Pm.[(b +^ nth witness p i, c)] = Some (b1,c1) + by exists (oget Pm.[(b +^ nth witness p i, c)]).`1 + (oget Pm.[(b +^ nth witness p i, c)]).`2;smt(domE). +have[]H_P_m H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. +have:=H_P_m _ _ _ _ H_Pm1. +have[] :=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. +move=> hun *. +have /> := H_P_m _ _ _ _ H_Pm1. +move=> hx fx hy fy H1 H2 H3; exists b1 c1 hy => />. +case: H_hs_h => fh /(hun _ _ _ _ H1) />. +qed. + + +equiv PFf_Cf (D<:DISTINGUISHER): + + DFRestr(SqueezelessSponge(PF)).f ~ DFRestr(G1(DRestr(D)).M).f : + + ! (G1.bcol{2} \/ G1.bext{2}) /\ + ={arg} /\ ={glob C} /\ + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} C.queries{2} + ==> + if G1.bcol{2} \/ G1.bext{2} + then ([] \in C.queries{2}) + else ={glob C} /\ ={res} /\ + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} C.queries{2}. +proof. + proc;sp;inline*;sp. + if;1,3:auto;if;1,3:auto;swap{1}4;swap{2}11;sp;wp 1 5. + sp;conseq(:_==> ! (G1.bcol{2} \/ G1.bext{2}) => + ={glob C, sa} /\ + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} + G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} C.queries{2}.[bs{1} <- sa{1}] /\ + F.RO.m.[p]{2} = Some sa{2});progress. + + by rewrite mem_set domE;left;have[]_->_ _ _//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0. + + smt(mem_set). + + smt(mem_set). + + smt(mem_set). + seq 1 1: + (={i, p, glob C} /\ i{1} = size p{1} /\ p{2} = bs{1} /\ + (!(G1.bcol{2} \/ G1.bext{2}) => + (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} + C.queries{2}.[bs{1} <- sa{1}] + /\ ={sa} /\ F.RO.m.[p]{2} = Some sa{1})));last first. + + case : (! (G1.bcol{2} \/ G1.bext{2}));last first. + - by conseq(:_==>true);progress;auto;smt(DBlock.dunifin_ll DCapacity.dunifin_ll take_size). + by rcondf{2}3;auto;smt(domE DBlock.dunifin_ll DCapacity.dunifin_ll take_size). + + conseq(:_==> ={i, p, glob C} /\ i{1} = size p{1} /\ p{2} = bs{1} /\ + (!(G1.bcol{2} \/ G1.bext{2}) => + (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} + C.queries{2}.[take i{2} bs{1} <- sa{1}] + /\ ={sa} /\ F.RO.m.[p]{2} = Some sa{1})));1:smt(take_size). + + splitwhile{1} 1 : i < prefix p (get_max_prefix p (elems (fdom C.queries))). + splitwhile{2} 1 : i < prefix p (get_max_prefix p (elems (fdom C.queries))). + + seq 1 1 : (={p, i, glob C, bs} /\ bs{2} = p{2} /\ + (prefix p (get_max_prefix p (elems (fdom C.queries))) = i){2} /\ + (Redo.prefixes.[take i p]{1} = Some (sa,sc){1}) /\ + (take i p \in Redo.prefixes){1} /\ + (C.queries.[[]] = Some b0){1} /\ + (! p{2} \in C.queries{2}) /\ + (!(G1.bcol{2} \/ G1.bext{2}) => + (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} + C.queries{2} /\ + ={sa} /\ counter{2} = 0 /\ + (exists f, FRO.m.[h]{2} = Some (sc{1}, f)) /\ + (build_hpath G1.mh (take i p) = Some (sa,h)){2} /\ + if i{2} = 0 then (sa,h){2} = (b0, 0) + else F.RO.m.[take i p]{2} = Some sa{1})) /\ + (i{2} = 0 => sa{1} = b0) /\ 0 < size p{2}). + + while(={p, i, glob C} /\ bs{2} = p{2} /\ (i{2} = 0 => sa{1} = b0) /\ + (0 <= i <= prefix p (get_max_prefix p (elems (fdom C.queries)))){2} /\ + (Redo.prefixes.[take i p]{1} = Some (sa,sc){1}) /\ + (take i p \in Redo.prefixes){1} /\ + (C.queries.[[]] = Some b0){1} /\ + (! p{2} \in C.queries{2}) /\ + (!(G1.bcol{2} \/ G1.bext{2}) => + (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} + C.queries{2} /\ + ={sa} /\ counter{2} = 0 /\ + (exists f, FRO.m.[h]{2} = Some (sc{1}, f)) /\ + (build_hpath G1.mh (take i p) = Some (sa,h)){2} /\ + if i{2} = 0 then (sa,h){2} = (b0, 0) + else F.RO.m.[take i p]{2} = Some sa{1})) /\ 0 < size p{2});last first. + - auto;progress. + * smt(@Prefix). + * by have[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 domE). + * by have[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 domE). + * by have[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0. + * by have[]:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 domE). + * by rewrite build_hpathP; apply/Empty=> //; exact/take0. + * by have[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0; smt(take0 domE size_take size_eq0 size_ge0). + * smt(prefix_sizel). + + case(G1.bcol{2} \/ G1.bext{2}). + - by if{1};auto;conseq(:_==> (G1.bcol{2} \/ G1.bext{2}));1,3:smt(domE get_setE); + (if{2};2:if{2});auto;1:smt(DBlock.dunifin_ll DCapacity.dunifin_ll); + sp;if{1};auto;smt(DBlock.dunifin_ll DCapacity.dunifin_ll). + conseq(: ={p, i, glob C} /\ bs{2} = p{2} /\ (i{2} = 0 => sa{1} = b0) /\ + 0 <= i{2} <= prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{2}))) /\ + Redo.prefixes{1}.[take i{1} p{1}] = Some (sa{1}, sc{1}) /\ + (C.queries.[[]] = Some b0){1} /\ (! p{2} \in C.queries{2}) /\ + (take i{1} p{1} \in Redo.prefixes{1}) /\ + (! (G1.bcol{2} \/ G1.bext{2}) => + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} + C.queries{2} /\ + ={sa} /\ + counter{2} = 0 /\ + (exists (f : flag), FRO.m{2}.[h{2}] = Some (sc{1}, f)) /\ + build_hpath G1.mh{2} (take i{2} p{2}) = Some (sa{2}, h{2}) /\ + if i{2} = 0 then (sa{2}, h{2}) = (b0, 0) + else F.RO.m{2}.[take i{2} p{2}] = Some sa{1}) /\ + (i{1} < size p{1} /\ + i{1} < prefix p{1} (get_max_prefix p{1} (elems (fdom C.queries{1})))) /\ + i{2} < size p{2} /\ + i{2} < prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{2}))) /\ + ! (G1.bcol{2} \/ G1.bext{2}) /\ (take (i+1) p \in Redo.prefixes){1} /\ + 0 < size p{2} + ==>_);progress. + - have:=prefix_gt0_mem p{2} (elems (fdom C.queries{2})) _;1:rewrite/#. + rewrite-memE=>H_dom_q. + have[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H12. + have[]_ _ h1 h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have:=h2 (get_max_prefix p{2} (elems (fdom C.queries{2}))) _; 1:smt(mem_fdom). + move=>[]c; + have H_dom_p:get_max_prefix p{2} (elems (fdom C.queries{2})) \in Redo.prefixes{1} by smt(domE mem_fdom). + have->/=:=prefix_take_leq p{2} (get_max_prefix p{2} (elems (fdom C.queries{2}))) (i{2}+1) _;1:rewrite/#. + smt(domE take_oversize prefix_sizer). + rcondt{1}1;1:auto;progress. + rcondt{2}1;1:auto;progress. + - have[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. + have//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{hr} p{hr} sa{hr} sc{m} h{hr} HINV _ _ _ _. + * by rewrite H0/=H7/=. + * smt(domE). + * rewrite/#. + * rewrite/#. + by move=>[]b2 c2 h2[]H_PFm H_Gmh;rewrite domE H_Gmh/=. + auto;progress. + - rewrite /#. + - rewrite /#. + - rewrite /#. + - smt(domE). + - have[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO/#:=H6 H11. + - have[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. + have[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + * by rewrite H0/=H7/=. + * smt(domE). + * rewrite/#. + * rewrite/#. + move=>[]b2 c2 h2[]H_PFm H_Gmh. + rewrite H_Gmh/=. + have[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). + by rewrite!take_take !minrE (: i{2} <= i{2} + 1) //= 1:/# nth_take 1,2:/# H2/==>[][]->>->><-;rewrite H_PFm oget_some. + - rewrite/#. + - have[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. + have[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + * by rewrite H0/=H7/=. + * smt(domE). + * rewrite/#. + * rewrite/#. + move=>[]b2 c2 h2[]H_PFm H_Gmh. + have[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). + rewrite!take_take !minrE (: i{2} <= i{2} + 1) // 1:/# nth_take 1,2:/# H2/=H_Gmh oget_some=>[][]<<-<<-<-. + rewrite H_PFm oget_some/=. + have [] help1 help2:= m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + + by have [] xc fx yc fy [#] /# := help2 _ _ _ _ H_Gmh. + - have[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. + have[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + * by rewrite H0/=H7/=. + * smt(domE). + * rewrite/#. + * rewrite/#. + move=>[]b2 c2 h2[]H_PFm H_Gmh. + by rewrite H_Gmh/= (@take_nth witness) 1:/# build_hpath_prefix/#. + - rewrite/#. + - rewrite/#. + - have[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. + have[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + * by rewrite H0/=H7/=. + * smt(domE). + * rewrite/#. + * rewrite/#. + move=>[]b2 c2 h2[]H_PFm H_Gmh. + have[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). + rewrite!take_take !minrE (: i{2} <= i{2} + 1) 1:/# nth_take 1,2:/# H2/==>[][]<<-<<-<-. + rewrite H_PFm/=(@take_nth witness)1:/#. + by have[]help1 help2/# :=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + + alias{1} 1 prefixes = Redo.prefixes;sp. + alias{2} 1 bad1 = G1.bcol;sp. + + while ( ={i, p, C.queries, C.c} + /\ prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{2}))) <= + i{1} <= size p{1} + /\ Redo.prefixes{1}.[take i{2} p{2}] = Some (sa{1}, sc{1}) + /\ p{2} = bs{1} + /\ (! p{2} \in C.queries{2}) + /\ (! (G1.bcol{2} \/ G1.bext{2}) => + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} + C.queries{2}.[take i{2} bs{1} <- sa{1}] + /\ ! (bad1{2} \/ G1.bext{2}) + /\ m_p PF.m{1} prefixes{1} C.queries{2} + /\ (forall (l : block list), + l \in prefixes{1} => prefixes{1}.[l] = Redo.prefixes{1}.[l]) + /\ (forall (l : block list), l \in Redo.prefixes{1} => + (l \in prefixes{1}) \/ + exists (j : int), 0 <= j <= i{2} /\ take j p{2} = l) + /\ ={sa} + /\ counter{2} <= i{2} - prefix p{2} + (get_max_prefix p{2} (elems (fdom C.queries{2}))) + /\ (exists (f : flag), FRO.m{2}.[h{2}] = Some (sc{1}, f)) + /\ build_hpath G1.mh{2} (take i{2} p{2}) = Some (sa{2}, h{2}) + /\ (if i{2} = 0 then (sa{2}, h{2}) = (b0, 0) + else F.RO.m{2}.[take i{2} p{2}] = Some sa{1}) + /\ (i{2} < size p{2} => ! take (i{2}+1) p{2} \in Redo.prefixes{1})));last first. + + auto;progress. + - smt(prefix_sizel). + - have[]HINV [#] ->> _ _ _ h_sa_b0:=H3 H6;split;..-2:case:HINV=>//=. + have[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV; split=> //=. + + move: h_sa_b0; case: (prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{2}))) = 0). + + by move=> -> [#] ->> _; rewrite take0 get_set_sameE. + smt(size_take get_setE). + + move=> l; rewrite mem_set=> - []. + + move=> /Hmp2 [c] h. + case: (l = take (prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{2})))) p{2}). + + by move=> ->>; exists sc{1}; rewrite get_set_sameE H. + by move=> n_not_crap; exists c; rewrite get_set_neqE. + by move=> ->>; exists sc{1}; rewrite get_set_sameE H. + by move=> l /Hmp3 [l2] ll2_in_q; exists l2; rewrite mem_set ll2_in_q. + - by have[]HINV _:=H3 H6;have:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + - rewrite/#. + - rewrite/#. + - rewrite/#. + - rewrite/#. + - rewrite/#. + - rewrite/#. + - rewrite/#. + - rewrite/#. + - have[]HINV[]->>[]->>[]H_h[]H_path H_F_RO:=H3 H6. + have[]H01 H02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have H_pref_eq:=prefix_exchange_prefix_inv (elems (fdom C.queries{2})) + (elems (fdom Redo.prefixes{1})) p{2} _ _ _. + * smt(memE domE mem_fdom). + * smt(memE mem_fdom domE take_oversize size_take take_take nth_take take_le0). + * smt(memE mem_fdom domE take_oversize size_take take_take nth_take take_le0). + by rewrite -mem_fdom memE prefix_lt_size 1:-H_pref_eq /#. + - rewrite/#. + - rewrite/#. + - rewrite/#. + - smt(take_size). + + case : (! (G1.bcol{2} \/ G1.bext{2}));last first. + - wp 1 1=>/=. + conseq(:_==> Redo.prefixes{1}.[take (i{1}+1) p{1}] = Some (sa{1}, sc{1}) + /\ (take (i{1} + 1) p{1} \in Redo.prefixes{1}) + /\ (G1.bcol{2} \/ G1.bext{2}));1:smt(prefix_ge0). + if {1}; last first. + + sp; if {1}; if {2}; last first. + + if {2}; sp; auto=> />. + + smt(get_setE mem_set DBlock.dunifin_ll DCapacity.dunifin_ll). + smt(get_setE mem_set DBlock.dunifin_ll DCapacity.dunifin_ll). + + auto=> />. + smt(get_setE mem_set DBlock.dunifin_ll DCapacity.dunifin_ll). + + if {2}; last first. + + auto=> />. + smt(get_setE mem_set DBlock.dunifin_ll DCapacity.dunifin_ll). + + swap {2} 4 -3; auto=> />. + smt(get_setE mem_set DBlock.dunifin_ll DCapacity.dunifin_ll). + auto=> />. + smt(get_setE mem_set DBlock.dunifin_ll DCapacity.dunifin_ll). + if {2}. + + auto=> />. + smt(get_setE mem_set DBlock.dunifin_ll DCapacity.dunifin_ll). + if {2}. + + auto=> />. + smt(get_setE mem_set DBlock.dunifin_ll DCapacity.dunifin_ll). + auto=> />. + smt(get_setE mem_set DBlock.dunifin_ll DCapacity.dunifin_ll). + + rcondf{1}1;1:auto=>/#. + sp;wp. + if{1};2:rcondt{2}1;first last;3:rcondf{2}1;..3:auto. + + progress. + have[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + have:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{hr} bs{m} sa{hr} sc{m} h{hr} HINV _ _ _. + - smt(prefix_ge0). + - exact H1. + - exact H_h. + by have:=H7;rewrite !domE=>->/=/#. + + progress. + - rewrite/#. + - rewrite/#. + - by rewrite get_setE. + - have[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + split;..-2:case:HINV=>//=. + have[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV;split=>//=. + * smt(get_setE size_take size_eq0 size_ge0 prefix_ge0). + * by have[]_ Hmp02' _ _ _:=H_m_p0; + smt(get_setE size_take size_eq0 size_ge0 prefix_ge0 take0). + * move=>l;rewrite!mem_set. + case(l = take (i{2} + 1) bs{1})=>//=[->>|]. + + move=>j;rewrite size_take;1:smt(prefix_ge0). + have->/=:(if i{2} + 1 < size bs{1} then i{2} + 1 else size bs{1}) = i{2} + 1 by rewrite/#. + move=>[]H0j HjiS;rewrite!get_setE. + have->/=:! take j (take (i{2} + 1) bs{1}) = take (i{2} + 1) bs{1} by smt(size_take). + rewrite!take_take!minrE (: j <= i{2} + 1) 1:/# (: j + 1 <= i{2} + 1) 1:/#. + rewrite nth_take 2:/#;1:smt(prefix_ge0). + case(j < i{2})=>Hij. + - have->/=:!take (j + 1) bs{1} = take (i{2} + 1) bs{1} by smt(size_take). + by have:=Hmp1(take i{2} bs{1}) _ j _; + smt(domE take_take nth_take prefix_ge0 size_take). + have->>:j = i{2} by rewrite/#. + by exists sa{2} sc{1};rewrite H1/=;smt(). + move=>h H_dom j []Hi0 Hisize;rewrite!get_setE. + have->/=:!take j l = take (i{2} + 1) bs{1} by smt(domE take_oversize size_take take_take). + by have->/=/#:!take (j+1) l = take (i{2} + 1) bs{1} + by smt(domE take_oversize size_take take_take). + * move=>l;rewrite mem_set. + case(l = take (i{2} + 1) bs{1})=>//=[->>|]. + + by rewrite!get_setE/= /#. + move=>h H_dom;rewrite!get_setE h/=. + have[]H2mp01 H2mp02 H2mp1 H2mp2 H2mp3:=H_m_p0. + rewrite-Hp1;1:smt(domE). + by apply H2mp2. + move=>l;rewrite !mem_set. + case(l = take (i{2} + 1) bs{1})=>//=[->>|]. + + by exists []; smt(cats0 mem_set). + move=>H_neq H_dom;have[]l1:=Hmp3 _ H_dom;rewrite!mem_set;case=>H_case. + + exists l1;by rewrite mem_set H_case. + exists (rcons l1 (nth witness bs{1} i{2}));rewrite mem_set;right. + by rewrite-rcons_cat (@take_nth witness);smt(prefix_ge0). + - rewrite/#. + - rewrite/#. + - smt(domE get_setE). + - move:H9;rewrite mem_set;case;smt(prefix_ge0). + - have[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + have:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + - smt(prefix_ge0). + - exact H1. + - exact H_h. + by have:=H7;rewrite !domE=>->/=/#. + - rewrite/#. + - have[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + have:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + - smt(prefix_ge0). + - exact H1. + - exact H_h. + have:=H7;rewrite !domE=>->/=[]b4 c4 h4[]H_PFm H_Gmh;rewrite H_PFm H_Gmh !oget_some/=. + have[]_ help:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have:=help _ _ _ _ H_Gmh. + by have[]f H_h':=H_h;rewrite H_h'/==>[][]a b c d[][]->>->>[];rewrite H_PFm/==>[]h'->>/#. + - have[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + have:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + - smt(prefix_ge0). + - exact H1. + - exact H_h. + have:=H7;rewrite !domE=>->/=[]b4 c4 h4[]H_PFm H_Gmh. + rewrite (@take_nth witness);1:smt(prefix_ge0). + by rewrite build_hpath_prefix H_path/=;smt(domE). + - smt(prefix_ge0). + - smt(prefix_ge0). + - have[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + have:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + - smt(prefix_ge0). + - exact H1. + - exact H_h. + have:=H7;rewrite !domE=>->/=[]b4 c4 h4[]H_PFm H_Gmh. + rewrite(@take_nth witness);1:smt(prefix_ge0). + have[]_ help H_uniq_path:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by rewrite help H_path;smt(domE). + - have[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + rewrite mem_set negb_or/=;split;2:smt(size_take prefix_ge0 take_oversize). + have:=Hp2 (take (i{2} + 1 + 1) bs{1}). + pose P:= _ \/ _;have/#:!P;rewrite/P;clear P;rewrite negb_or/=negb_exists/=;split. + * have:=prefix_exchange_prefix_inv(elems (fdom C.queries{2}))(elems (fdom prefixes{1}))bs{1} _ _ _. + + by have[]:=H_m_p0;smt(domE memE mem_fdom). + + have[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=H_m_p0. + have:=all_prefixes_of_m_p _ _ _ H_m_p0. + + move=> h_prefixes l2; rewrite -memE mem_fdom=> /Hmp2 [c]. + move=> pl2; move: (h_prefixes l2 _). + + by rewrite domE pl2. + by move=> + i - /(_ i); rewrite -memE mem_fdom. + + by have[]:=H_m_p0;smt(memE domE mem_fdom). + by move=>H_pref_eq;rewrite -mem_fdom memE prefix_lt_size//= -H_pref_eq/#. + by move=>j;case(0<=j<=i{2})=>//=[][]Hj0 Hji;smt(size_take prefix_ge0 take_le0). + + progress. + have[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + have:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{hr} bs{m} sa{hr} sc{m} h{hr} HINV _ _ _. + - smt(prefix_ge0). + - exact H1. + - exact H_h. + by have:=H7;rewrite !domE=>/=->/=. + rcondt{2}1;1:auto=>/#. + rcondt{2}5;auto;progress. + * rewrite(@take_nth witness);1:smt(prefix_ge0);rewrite domE. + have[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_i:=H3 H6. + have[]:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{hr} bs{m} sa{hr} sc{m} h{hr} HINV _ _ _. + * smt(prefix_ge0). + * rewrite/#. + * rewrite/#. + have:=H7;rewrite domE =>/=->/=H_Gmh _ H_ H_path_uniq. + have help:=H_ (take i{hr} bs{m}) (nth witness bs{m} i{hr});rewrite H_path/= in help. + have:forall (b : block), + F.RO.m{hr}.[rcons (take i{hr} bs{m}) (nth witness bs{m} i{hr})] = Some b + <=> exists hy, G1.mh{hr}.[(sa{hr} +^ nth witness bs{m} i{hr}, h{hr})] = Some (b, hy) by rewrite/#. + move:help=>_ help;move:H_Gmh;apply absurd=>//=H_F_Ro. + have[]b h: exists b, F.RO.m{hr}.[rcons (take i{hr} bs{m}) (nth witness bs{m} i{hr})] = Some b. + + by move: H_F_Ro; case: (F.RO.m{hr}.[rcons (take i{hr} bs{m}) (nth witness bs{m} i{hr})])=> //= /#. + by have:= (help b); rewrite h; smt(). + swap{2}-3;auto;progress. + * rewrite/#. + * rewrite/#. + * by rewrite!get_setE/=. + * have[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. + have:=H10;rewrite !negb_or/==>[][][]bad1 hinv_none bad2. + have H_hs_spec:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have H_mh_spec:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have H_m_mh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have H_mi_mhi:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have H_pi_spec:=pi_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have :=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + * smt(prefix_ge0). + * exact H1. + * rewrite/#. + have:=H7;rewrite domE/==>->/=h_g1. + have H2_pi_spec:pi_spec FRO.m{2}.[G1.chandle{2} <- (y2L, Unknown)] + G1.mh{2}.[(sa{2} +^ nth witness bs{1} i{2}, h{2}) <- (y1L, G1.chandle{2})] + G1.paths{2}. + + split;progress. + - have[]h:=H_pi_spec;have:=h c p0 v;rewrite H11/==>[][]h1[] h'1 h'2. + exists h1;rewrite -h'2 get_setE/=. + have->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h'2. + by apply build_hpath_up=>//=. + move:H12;rewrite get_setE/==>hh0. + have h0_neq_ch:h0 <> G1.chandle{2} by rewrite/#. + have[]->:=H_pi_spec;rewrite-hh0 h0_neq_ch/=;exists h0=>/=. + have:=H;have:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v h0. + rewrite h_g1/=H/=h0_neq_ch/=. + have->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. + have -> /= <-//=:=ch_neq0 _ _ H_hs_spec;progress;have[]hh1 hh2 hh3:=H_mh_spec;smt(dom_hs_neq_ch). + split. + + apply hs_addh;1:have//:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by have:=hinvP FRO.m{2} y2L;rewrite hinv_none/=/#. + + by have:=invG_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + + apply inv_addm=>//;1:have//:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + apply (notin_hs_notdomE2_mh FRO.m{2} PF.mi{1})=>//=. + by apply ch_notdomE_hs;have:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + + have[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + rewrite!get_setE/=. + apply (m_mh_addh_addm _ H_m_mh H_huniq H_h _)=>//=. + by apply ch_notdomE_hs;have:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + + have[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + rewrite!get_setE/=;apply (mi_mhi_addh_addmi _ H_mi_mhi _ H_h _)=>//=. + - smt(hinvP). + by apply ch_notdomE_hs;have:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + + apply incl_upd_nin=>//=. + by have:=incl_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + + apply incl_upd_nin=>//=. + - by have:=incli_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have:=hinvP FRO.m{2} y2L;rewrite domE hinv_none/=;apply absurd=>H_P_mi. + rewrite negb_forall/=. + have H_inv_Gmh:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have[]H_inv_Pm:=inv_mh_inv_Pm _ _ _ _ _ H_m_mh H_mi_mhi H_inv_Gmh. + have[]H_Pmi H_Gmhi:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by have[]/#:=H_Pmi y1L y2L (oget PF.mi{1}.[(y1L, y2L)]).`1 + (oget PF.mi{1}.[(y1L, y2L)]).`2 _;1:smt(domE). + + have H_take_Si:=take_nth witness i{2} bs{1} _;1:smt(prefix_ge0). + split=>//=. + - move=>x hx y hy;rewrite !get_setE. + case((x, hx) = (sa{2} +^ nth witness bs{1} i{2}, h{2}))=>//=. + * move=>[->> ->>][<<- <<-]/=. + have->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. + rewrite H_h/=. + exists sc{1} f y2L Unknown=>//=. + exists (take i{2} bs{1}) (sa{2})=>//=;rewrite get_setE Block.WRing.addKr/=. + rewrite/=(@take_nth witness)/=;1:smt(prefix_ge0). + by apply build_hpath_up=>//=;smt(domE). + move=> neq h1. + have[]hh1 hh2 hh3:=H_mh_spec. + have[]xc hxx yc hyc []h2[]h3 h4:=hh1 _ _ _ _ h1. + have->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h2. + have->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h3. + rewrite h2 h3/=;exists xc hxx yc hyc=>//=. + move:h4;case(hyc = Known)=>//=neq2[]p0 b[]hp0 hb. + exists p0 b;rewrite get_setE. + have->/=:=build_hpath_up _ _ _ y1L G1.chandle{2} _ _ _ hb h_g1. + have/#:!rcons p0 (b +^ x) = rcons (take i{2} bs{1}) (nth witness bs{1} i{2});move:neq;apply absurd=>//=h'. + have<<-:take i{2} bs{1}=p0 by rewrite/#. + have hbex:b +^ x = nth witness bs{1} i{2} by rewrite/#. + by have:=hb;rewrite H_path/==>[][->>->>]/=;rewrite-hbex Block.WRing.addKr/=. + - progress. + * move:H11;rewrite get_setE/=H_take_Si/=. + case(p0 = (take i{2} bs{1}))=>[->>|hpp0];rewrite!get_setE/=. + + have->/=:=build_hpath_up _ _ _ y1L G1.chandle{2} _ _ _ H_path h_g1. + case(bn = (nth witness bs{1} i{2}))=>[->> /= ->>|hbni]/=. + - by exists sa{2} h{2} G1.chandle{2}=>//=;rewrite get_setE/=. + have->/=:!rcons (take i{2} bs{1}) bn = rcons (take i{2} bs{1}) (nth witness bs{1} i{2}). + - move:hbni;apply absurd=>//=h. + exact/(rconsIs _ _ h). + move=>h_ro_p_bn. + have[]_ hh4 _:=H_mh_spec. + by have:=hh4 (take i{2} bs{1}) bn b0;rewrite h_ro_p_bn/=H_path/=;smt(get_setE @Block.WRing). + have->/=:!rcons p0 bn = rcons (take i{2} bs{1}) (nth witness bs{1} i{2}). + + move:hpp0;apply absurd=>/=h. + have:size p0 = size (take i{2} bs{1}) by smt(size_rcons). + move:h;pose p' := take i{2} bs{1};pose e := nth witness bs{1} i{2}. + by move=>h h';move:p0 p' h' bn e h;apply seq2_ind=>//=/#. + move=>h_ro_p_bn. + have[]_ hh4 _:=H_mh_spec. + have:=hh4 p0 bn b0;rewrite h_ro_p_bn/==>[][];progress. + have help:(sa{2} +^ nth witness bs{1} i{2}, h{2}) <> (v +^ bn, hx) by rewrite/#. + exists v hx hy=>//=;rewrite get_setE;rewrite eq_sym in help;rewrite help/=H12/=. + by apply build_hpath_up=>//=. + move:H11 H12;rewrite!get_setE/= =>h_build_hpath_set. + case(hy = G1.chandle{2})=>//=[->>|hy_neq_ch]/=. + + move=>h;have h_eq:v +^ bn = sa{2} +^ nth witness bs{1} i{2} && hx = h{2}. + + have/#:G1.mh{2}.[(v +^ bn, hx)] <> Some (b0, G1.chandle{2}). + have[]_ hh2:=H_m_mh. + have:=hh2 (v +^ bn) hx b0 G1.chandle{2}. + case(G1.mh{2}.[(v +^ bn, hx)] = Some (b0, G1.chandle{2}))=>//=. + rewrite negb_exists/=;progress; + rewrite negb_exists/=;progress; + rewrite negb_exists/=;progress; + rewrite negb_exists/=;progress;rewrite !negb_and. + by have[]/#:=H_hs_spec. + have[]eq_xor ->>:=h_eq. + move:h;rewrite eq_xor/==>->>. + have/#:!(p0 = (take i{2} bs{1}) /\ bn = (nth witness bs{1} i{2})) => + F.RO.m{2}.[rcons p0 bn] = Some b0. + move:H_h;case:f=>h_flag;last first. + - have:=known_path_uniq _ _ _ sc{1} h{2} p0 v (take i{2} bs{1}) sa{2} H2_pi_spec _ h_build_hpath_set _. + * rewrite get_setE/=h_flag. + by have->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. + * by apply build_hpath_up=>//=. + move=>[]->>->>/=;apply absurd=>//=_. + have->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). + have[]hh1 hh2 hh3:=H_mh_spec. + have:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) b0 p0 v h{2}. + rewrite h_build_hpath_set/=h_g1/=. + have->/=:=ch_neq0 _ _ H_hs_spec. + have->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. + move=>help;have:= help _;1:smt(dom_hs_neq_ch). + move=>h_build_hpath_p0. + rewrite hh2 h_build_hpath_p0/==>h_neq. + exists v h{2}=>//=. + rewrite eq_xor h_g1/=;move:h_neq;apply absurd=>//=. + have:=hh3 _ _ _ _ _ H_path h_build_hpath_p0. + have->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). + move=>help;have h_neq:! (v +^ bn = sa{2} +^ nth witness bs{1} i{2} /\ hx = h{2}) by rewrite/#. + move: help. rewrite h_neq/==>h_g1_v_bn_hx. + have[]hh1 hh2 hh3:=H_mh_spec. + have:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. + rewrite h_build_hpath_set/=h_g1/=. + have->/=:=ch_neq0 _ _ H_hs_spec. + by have->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h; smt(dom_hs_neq_ch). + progress. + + have:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. + have:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p' v' hx. + move:H11 H12;rewrite!get_setE/= =>H13 H14;rewrite H13 H14. + have->/=:=ch_neq0 _ _ H_hs_spec. + have->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. + rewrite h_g1/=. + have[]:=H_mh_spec => HH1 HH2 HH3 HH4 HH5. + have toto:(forall (xa xb : block) (ha hb : int), + G1.mh{2}.[(xa, ha)] = Some (xb, hb) => + ha <> G1.chandle{2} /\ hb <> G1.chandle{2}). + - move=> /> xa xb ha hb Hmhab. + have:=dom_hs_neq_ch FRO.m{2} G1.chandle{2} ha. + have:=dom_hs_neq_ch FRO.m{2} G1.chandle{2} hb. + have/#:FRO.m{2}.[ha] <> None /\ FRO.m{2}.[hb] <> None. + have[] _ HH6:=H_m_mh. + by have/> g1 g2 g3 g4 -> -> />:=HH6 _ _ _ _ Hmhab. + have{HH4}:=HH4 toto. + have{HH5}:=HH5 toto. + case: (hx = G1.chandle{2})=>[->>|hx_neq_ch/>]. + - move=>[] p1 x1 [#] hp11 ->> <<-. + move=>[] p2 x2 [#] hp21 ->> ->> /=. + pose y := (sa{2} +^ nth witness bs{1} i{2}). + pose y1:=x1+^y. pose y2:=x2+^y. + have[#]->>->>:=HH3 _ _ _ _ _ hp21 H_path. + by have[#]->><<-//=:=HH3 _ _ _ _ _ hp11 H_path. + move=>hp21 hp11. + by have[#]->>->>:=HH3 _ _ _ _ _ hp21 hp11. + have:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. + have:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p' v' hx. + move:H11 H12;rewrite!get_setE/= =>H13 H14;rewrite H13 H14/=. + have->/=:=ch_neq0 _ _ H_hs_spec. + have->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. + rewrite h_g1/=. + have[]:=H_mh_spec => HH1 HH2 HH3 HH4 HH5. + have toto:(forall (xa xb : block) (ha hb : int), + G1.mh{2}.[(xa, ha)] = Some (xb, hb) => + ha <> G1.chandle{2} /\ hb <> G1.chandle{2}). + - move=> /> xa xb ha hb Hmhab. + have:=dom_hs_neq_ch FRO.m{2} G1.chandle{2} ha. + have:=dom_hs_neq_ch FRO.m{2} G1.chandle{2} hb. + have/#:FRO.m{2}.[ha] <> None /\ FRO.m{2}.[hb] <> None. + have[] _ HH6:=H_m_mh. + by have/> g1 g2 g3 g4 -> -> />:=HH6 _ _ _ _ Hmhab. + have{HH4}:=HH4 toto. + have{HH5}:=HH5 toto. + case: (hx = G1.chandle{2})=>[->>|hx_neq_ch/>]. + - move=>[] p1 x1 [#] hp11 ->> <<-. + move=>[] p2 x2 [#] hp21 ->> ->> /=. + pose y := (sa{2} +^ nth witness bs{1} i{2}). + pose y1:=x1+^y. pose y2:=x2+^y. + have[#]->>->>:=HH3 _ _ _ _ _ hp21 H_path. + by have[#]->><<-//=:=HH3 _ _ _ _ _ hp11 H_path. + move=>hp21 hp11. + by have[#]->>->>:=HH3 _ _ _ _ _ hp21 hp11. + + rewrite!get_setE/=;exact H2_pi_spec. + + rewrite!get_setE/=. + have H_m_p:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have H_all_prefixes:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + split;case:H_m_p=>//=Hmp01 Hmp02 Hmp1 Hmp2 Hmp3. + - smt(get_setE size_take prefix_ge0). + - by have[]:=H_m_p0;smt(get_setE size_take prefix_ge0). + - move=>l;rewrite mem_set;case=>H_case j []Hj0. + * move=>Hjsize;rewrite!get_setE/=. + have->/=:!take j l = take (i{2} + 1) bs{1} by rewrite/#. + have->/=:!take (j+1) l = take (i{2} + 1) bs{1} by rewrite/#. + smt(domE get_setE). + have->>:=H_case;rewrite size_take;1:smt(prefix_ge0). + have->/=:(if i{2} + 1 < size bs{1} then i{2} + 1 else size bs{1}) = i{2} + 1 by rewrite/#. + move=>HjiS;rewrite!get_setE. + have->/=:! take j (take (i{2} + 1) bs{1}) = take (i{2} + 1) bs{1} by smt(size_take). + rewrite!take_take!minrE (: j <= i{2} + 1) 1:/# (: j + 1 <= i{2} + 1) 1:/#. + rewrite nth_take 2:/#;1:smt(prefix_ge0). + case(j < i{2})=>Hij. + - have->/=:!take (j + 1) bs{1} = take (i{2} + 1) bs{1} by smt(size_take). + by have:=Hmp1(take i{2} bs{1}) _ j _;smt(domE take_take nth_take prefix_ge0 size_take get_setE). + have->>:j = i{2} by rewrite/#. + by exists sa{2} sc{1};rewrite H1/=;smt(get_setE domE). + - move=>l;rewrite mem_set. + case(l = take (i{2} + 1) bs{1})=>//=[->>|]. + + by rewrite!get_setE/= /#. + move=>h H_dom;rewrite!get_setE h/=. + have[]H2mp01 H2mp02 H2mp1 H2mp2 H2mp3:=H_m_p0. + rewrite-Hp1;1:smt(domE). + by apply H2mp2. + move=>l;rewrite !mem_set. + case(l = take (i{2} + 1) bs{1})=>//=[->>|]. + + by exists []; smt(cats0 mem_set). + move=>H_neq H_dom;have[]l1:=Hmp3 _ H_dom;rewrite!mem_set;case=>H_case. + + exists l1;by rewrite mem_set H_case. + exists (rcons l1 (nth witness bs{1} i{2}));rewrite mem_set;right. + by rewrite-rcons_cat (@take_nth witness);smt(prefix_ge0). + * rewrite/#. + * have[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. + split;have[]//= hmp01 hmp02 hmp1 hmp2 hmp3:=H_m_p0. + move=> l l_in_pref i hisize. + have//[] sa sc [#] pref_sasc pm_pref:= hmp1 l l_in_pref i hisize. + by exists sa sc; smt(get_setE domE take_take take_nth size_take + prefix_ge0 nth_take take_oversize take_le0 mem_fdom fdom_set). + + rewrite!get_setE/=;smt(domE). + + smt(get_setE domE take_take size_take prefix_ge0 nth_take take_oversize take_le0). + + rewrite!get_setE/=;smt(domE). + + rewrite/#. + + by rewrite!get_setE/=/#. + + rewrite!get_setE/=(@take_nth witness);1:smt(prefix_ge0);rewrite build_hpath_prefix. + have[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. + have:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + - smt(prefix_ge0). + - exact H1. + - rewrite/#. + have:=H7;rewrite domE=>/=->/=H_Gmh. + have->/=:=build_hpath_up_None _ _ (y1L, G1.chandle{2})_ _ H_Gmh H_path;smt(get_setE). + + smt(prefix_ge0). + + smt(prefix_ge0). + + by rewrite!get_setE. + rewrite!mem_set negb_or/=;split;2:smt(prefix_ge0 size_take prefix_ge0 take_oversize). + have[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. + have:=Hp2 (take (i{2} + 1 + 1) bs{1}). + pose P:= _ \/ _;have/#:!P;rewrite/P;clear P;rewrite negb_or/=negb_exists/=;split. + * have:=prefix_exchange_prefix_inv(elems (fdom C.queries{2}))(elems (fdom prefixes{1}))bs{1} _ _ _. + + by have[]:=H_m_p0;smt(domE memE mem_fdom). + + have[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=H_m_p0. + have:=all_prefixes_of_m_p _ _ _ H_m_p0. + move=> + l2; rewrite -memE mem_fdom=> + /Hmp2 [c] l2_in_q - /(_ l2 _). + + by rewrite domE l2_in_q. + by move=> + i - /(_ i); rewrite -memE mem_fdom. + + by have[]:=H_m_p0;smt(memE domE mem_fdom). + by move=>H_pref_eq;rewrite -mem_fdom memE prefix_lt_size//= -H_pref_eq/#. + by move=>j;case(0<=j<=i{2})=>//=[][]Hj0 Hji;smt(size_take prefix_ge0 take_le0). +qed. + + +section AUX. + + declare module D <: DISTINGUISHER {-PF, -RO, -G1, -Redo, -C}. + + declare axiom D_ll (F <: DFUNCTIONALITY{-D}) (P <: DPRIMITIVE{-D}): + islossless P.f => islossless P.fi => islossless F.f => + islossless D(F, P).distinguish. + + equiv CF_G1 : CF(DRestr(D)).main ~ G1(DRestr(D)).main: + ={glob D} ==> !(G1.bcol \/ G1.bext){2} => ={res}. + proof. + proc;inline*;wp. + call (_: G1.bcol \/ G1.bext, ={glob C} /\ + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} + G1.paths{2} Redo.prefixes{1} C.queries{2}, + [] \in C.queries{2}). + (* lossless D *) + + exact/D_ll. + (** proofs for G1.S.f *) + (* equivalence up to bad of PF.f and G1.S.f *) + + conseq (_: !G1.bcol{2} + /\ !G1.bext{2} + /\ ={x, glob C} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} + PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} + F.RO.m{2} G1.paths{2} + Redo.prefixes{1} C.queries{2} + ==> !G1.bcol{2} + => !G1.bext{2} + => ={res, glob C} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} + PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} + F.RO.m{2} G1.paths{2} + Redo.prefixes{1} C.queries{2}). + + by move=> &1 &2; rewrite negb_or. + + progress;have[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(domE). + (* For now, everything is completely directed by the syntax of + programs, so we can *try* to identify general principles of that + weird data structure and of its invariant. I'm not sure we'll ever + be able to do that, though. *) + conseq(eq_f D);progress=>/#. + (* lossless PF.f *) + + move=> &2 _; proc;inline*; sp;if=> //=; auto; sp;if;auto;smt (@Block.DBlock @Capacity.DCapacity). + (* lossless and do not reset bad G1.S.f *) + + move=> &1; proc; inline*;sp;if;auto;sp;if;auto. + conseq (_: _ ==> G1.bcol \/ G1.bext); 1:smt (). + inline *; if=> //=; wp; rnd predT; wp; rnd predT; auto. + + smt (@Block.DBlock @Capacity.DCapacity). + smt (@Block.DBlock @Capacity.DCapacity). + (** proofs for G1.S.fi *) + (* equiv PF.P.fi G1.S.fi *) + + conseq(eq_fi D)=>/#. + (* lossless PF.P.fi *) + + move=> &2 _; proc; inline*; sp; if; auto; sp; if; auto; smt (@Block.DBlock @Capacity.DCapacity). + (* lossless and do not reset bad G1.S.fi *) + + move=> &1; proc; inline*; sp; if; auto; sp; if;auto;smt (@Block.DBlock @Capacity.DCapacity). + (** proofs for G1.C.f *) + (* equiv PF.C.f G1.C.f *) + + conseq(PFf_Cf D);auto=>/#. + (* lossless PF.C.f *) + + move=> &2 _; proc; inline *; sp; if; auto; if; auto; while (true) (size p - i); auto. + + if; 1:auto=>/#. + sp; if; 2: auto=>/#. + by wp; do 2!rnd predT; auto; smt (size_behead @Block.DBlock @Capacity.DCapacity). + smt (size_ge0). + (* lossless and do not reset bad G1.C.f *) + + move=> _; proc; inline *; wp;sp;if;auto;sp;if;auto;sp. + conseq(:_==> true) (: _ ==> G1.bcol \/ G1.bext)=> //=. + + by move=> />. + + smt(@DBlock @DCapacity mem_set). + + while (G1.bcol \/ G1.bext)=> //=. + if; 1:by auto. + if;2:by auto. + by auto=> /> &hr [->|->]. + while (true) (size p - i)=> [z|]. + + if; 1:by auto=> /#. + if; 2:by auto=> /#. + by wp; rnd predT; wp; rnd predT; auto=> />; smt(@DBlock @DCapacity). + by auto=> /#. + (* Init ok *) + inline *; auto=> />; split=> [|/#]. + do !split. + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + smt (get_setE emptyE build_hpath_map0). + qed. + + +end section AUX. + +section. + + declare module D <: DISTINGUISHER{-Perm, -C, -PF, -G1, -RO, -Redo}. + + declare axiom D_ll (F <: DFUNCTIONALITY{-D}) (P <: DPRIMITIVE{-D}): + islossless P.f => islossless P.fi => + islossless F.f => islossless D(F, P).distinguish. + + lemma Real_G1 &m: + Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= + Pr[G1(DRestr(D)).main() @ &m: res] + + (max_size ^ 2 - max_size)%r * inv 2%r * mu dstate (pred1 witness) + + Pr[G1(DRestr(D)).main() @&m: G1.bcol] + + Pr[G1(DRestr(D)).main() @&m: G1.bext]. + proof. + apply (@RealOrder.ler_trans _ _ _ (Real_Concrete D _ &m))=>//=. + + exact: D_ll. + have : Pr[CF(DRestr(D)).main() @ &m : res] <= + Pr[G1(DRestr(D)).main() @ &m : res] + + Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext]. + + by byequiv (CF_G1 D D_ll)=>//=/#. + have/#:Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext] + <= Pr[G1(DRestr(D)).main() @&m: G1.bcol] + + Pr[G1(DRestr(D)).main() @&m: G1.bext]. + by rewrite Pr[mu_or];smt(Distr.mu_bounded). + qed. + +end section. diff --git a/sha3/proof/smart_counter/SLCommon.ec b/sha3/proof/smart_counter/SLCommon.ec new file mode 100644 index 0000000..fa82181 --- /dev/null +++ b/sha3/proof/smart_counter/SLCommon.ec @@ -0,0 +1,1073 @@ +(** This is a theory for the Squeezeless sponge: where the ideal + functionality is a fixed-output-length random oracle whose output + length is the input block size. We prove its security even when + padding is not prefix-free. **) +require import Core Int Real StdOrder Ring. +require import List FSet SmtMap Common Distr DProd Dexcepted. +require import PROM. + +require (*..*) Indifferentiability. +(*...*) import Capacity IntOrder. + +pragma -oldip. + +(** Really? **) +abbrev ([+]) ['a 'b] (x : 'b) = fun (_ : 'a) => x. + +type state = block * capacity. +op dstate = bdistr `*` cdistr. + +clone include Indifferentiability with + type p <- state, + type f_in <- block list, + type f_out <- block + rename [module] "GReal" as "RealIndif" + [module] "GIdeal" as "IdealIndif". + +(** max number of call to the permutation and its inverse, + including those performed by the construction. *) +op max_size : { int | 0 <= max_size } as max_ge0. + +(** Ideal Functionality **) +clone export Tuple as TupleBl with + type t <- block, + op Support.enum <- Block.blocks + proof Support.enum_spec by exact Block.enum_spec. + +op bl_enum = flatten (mkseq (fun i => wordn i) (max_size + 1)). +op bl_univ = FSet.oflist bl_enum. + +(* -------------------------------------------------------------------------- *) +(* Random oracle from block list to block *) + +clone import FullRO as F with + type in_t <- block list, + type out_t <- block, + op dout _ <- bdistr, + type d_in_t <- unit, + type d_out_t <- bool. +import FullEager. + +module Redo = { + var prefixes : (block list, state) fmap + + proc init() : unit = { + prefixes <- empty.[[] <- (b0,c0)]; + } +}. + +(** We can now define the squeezeless sponge construction **) +module SqueezelessSponge (P:DPRIMITIVE): FUNCTIONALITY = { + proc init () = { + Redo.init(); + } + + proc f(p : block list): block = { + var (sa,sc) <- (b0,c0); + var i : int <- 0; + + while (i < size p) { (* Absorption *) + if (take (i+1) p \in Redo.prefixes) { + (sa,sc) <- oget Redo.prefixes.[take (i+1) p]; + } else { + (sa,sc) <- (sa +^ nth witness p i, sc); + (sa,sc) <@ P.f((sa,sc)); + Redo.prefixes.[take (i+1) p] <- (sa,sc); + } + i <- i + 1; + } + + return sa; (* Squeezing phase (non-iterated) *) + } +}. + +clone export DProd.ProdSampling as Sample2 with + type t1 <- block, + type t2 <- capacity. + +(* -------------------------------------------------------------------------- *) +(** TODO move this **) + +op incl (m m':('a,'b)fmap) = + forall x, m .[x] <> None => m'.[x] = m.[x]. + +(* -------------------------------------------------------------------------- *) +(** usefull type and operators for the proof **) + +type handle = int. + +type hstate = block * handle. + +type ccapacity = capacity * flag. + +type smap = (state , state ) fmap. +type hsmap = (hstate, hstate ) fmap. +type handles = (handle, ccapacity) fmap. + +pred is_pre_permutation (m mi : ('a,'a) fmap) = + (forall x, rng m x => dom mi x) + /\ (forall x, rng mi x => dom m x). + +lemma half_permutation_set (m' mi' : ('a,'a) fmap) x' y': + (forall x, rng m' x => dom mi' x) + => (forall x, rng m'.[x' <- y'] x => dom mi'.[y' <- x'] x). +proof. +move=> h x0; rewrite rngE=> - /= [x]; case: (x = x')=> [<*>|]. ++ by rewrite get_set_sameE=> /= <*>; rewrite domE get_set_sameE. +rewrite get_setE=> -> /= m'x_x0; move: (h x0 _). ++ by rewrite rngE; exists x. +by rewrite mem_set=> ->. +qed. + +lemma pre_permutation_set (m mi : ('a,'a) fmap) x y: + is_pre_permutation m mi => + is_pre_permutation m.[x <- y] mi.[y <- x]. +proof. +move=> [dom_mi dom_m]. +by split; apply/half_permutation_set. +qed. + +(* Functionnal version of the construction using handle *) +op step_hpath (mh:hsmap) (sah:hstate option) (b:block) = + if sah = None + then None + else + let sah = oget sah in + mh.[(sah.`1 +^ b, sah.`2)]. + +op build_hpath (mh:hsmap) (bs:block list) = + foldl (step_hpath mh) (Some (b0,0)) bs. + +inductive build_hpath_spec mh p v h = +| Empty of (p = []) + & (v = b0) + & (h = 0) +| Extend p' b v' h' of (p = rcons p' b) + & (build_hpath mh p' = Some (v',h')) + & (mh.[(v' +^ b,h')] = Some (v,h)). + +lemma build_hpathP mh p v h: + build_hpath mh p = Some (v,h) <=> build_hpath_spec mh p v h. +proof. +elim/last_ind: p v h=> @/build_hpath //= [v h|p b ih v h]. ++ by split=> [!~#] <*>; [exact/Empty|move=> []]; smt(size_rcons size_ge0). +rewrite -{1}cats1 foldl_cat {1}/step_hpath /=. +case: {-1}(foldl _ _ _) (eq_refl (foldl (step_hpath mh) (Some (b0,0)) p))=> //=. ++ apply/implybN; case=> [|p' b0 v' h']. + + smt(size_rcons size_ge0). + move=> ^/rconssI <<- /rconsIs ->>. + by rewrite /build_hpath=> ->. +move=> [v' h']; rewrite -/(build_hpath _ _)=> build. +split. ++ by move=> mh__; apply/(Extend mh (rcons p b) v h p b v' h' _ build mh__). +case=> [| p' b' v'' h'']. ++ smt(size_rcons size_ge0). +move=> ^/rconssI <<- /rconsIs <<-. +by rewrite build /= => [#] <*>. +qed. + +lemma build_hpath_map0 p: + build_hpath empty p = if p = [] then Some (b0,0) else None. +proof. +elim/last_ind: p=> //= p b _. +by rewrite -{1}cats1 /build_hpath foldl_cat {1}/step_hpath /= emptyE /= #smt:(size_rcons size_ge0). +qed. + +(* -------------------------------------------------------------------------- *) +theory Prefix. + +op prefix ['a] (s t : 'a list) = + with s = x :: s', t = y :: t' => if x = y then 1 + prefix s' t' else 0 + with s = _ :: _ , t = [] => 0 + with s = [] , t = _ :: _ => 0 + with s = [] , t = [] => 0. + +lemma prefix0s (s : 'a list): prefix [] s = 0. +proof. by elim: s. qed. + +lemma prefixs0 (s : 'a list): prefix s [] = 0. +proof. by elim: s. qed. + +lemma prefix_eq (l : 'a list) : prefix l l = size l. +proof. elim:l=>//=/#. qed. + + +lemma prefixC (l1 l2 : 'a list) : + prefix l1 l2 = prefix l2 l1. +proof. +move:l1; elim: l2=> //=; first by (move=> l1; elim: l1=> //=). +move=> e2 l2 Hind l1; move: e2 l2 Hind; elim: l1=> //=. +move=> e1 l1 Hind e2 l2 Hind1; rewrite Hind1 /#. +qed. + +lemma prefix_ge0 (l1 l2 : 'a list) : + 0 <= prefix l1 l2. +proof. +move: l2; elim: l1=> //=; first (move=> l2; elim: l2=> //=). +move=> e1 l1 Hind l2; move: e1 l1 Hind; elim: l2=> //=. +move=> e2 l2 Hind2 e1 l1 Hind1 /#. +qed. + +lemma prefix_sizel (l1 l2 : 'a list) : + prefix l1 l2 <= size l1. +proof. +move: l2; elim: l1=> //=; first by (move=> l2; elim: l2=> //=). +move=> e1 l1 Hind l2; move: e1 l1 Hind; elim: l2=> //=; 1:smt(size_ge0). +by move=> e2 l2 Hind2 e1 l1 Hind1; smt(size_ge0). +qed. + +lemma prefix_sizer (l1 l2 : 'a list) : + prefix l1 l2 <= size l2. +proof. +by rewrite prefixC prefix_sizel. +qed. + +lemma prefix_take (l1 l2 : 'a list) : + take (prefix l1 l2) l1 = take (prefix l1 l2) l2. +proof. +move: l2; elim: l1=> //=; first by (move=> l2; elim: l2=> //=). +move=> e1 l1 Hind l2 /=; move: e1 l1 Hind; elim: l2=> //=. +move=> e2 l2 Hind1 e1 l1 Hind2=> //=. +by case: (e1 = e2)=> [-> /#|]. +qed. + +lemma take_take (l : 'a list) (i j : int) : + take i (take j l) = take (min i j) l. +proof. +case: (i <= j)=> Hij. ++ case: (j < size l)=> Hjsize; last smt(take_oversize). + case: (0 <= i)=> Hi0; last smt(take_le0). + apply: (eq_from_nth witness); 1:smt(size_take). + move=> k; rewrite !size_take //= 1:/# Hjsize /=. + have ->: (if i < j then i else j) = i by smt(). + move=> [Hk0 Hki]. + by rewrite !nth_take /#. +case: (0 < j)=> //= Hj0; last smt(take_le0). +rewrite (: min i j = j) 1:minrE 1:/#. +by rewrite take_oversize //= size_take /#. +qed. + +lemma prefix_take_leq (l1 l2 : 'a list) (i : int) : + i <= prefix l1 l2 => take i l1 = take i l2. +proof. +move=> Hi; have ->: i = min i (prefix l1 l2) by smt(minrE). +by rewrite -(take_take l1 i _) -(take_take l2 i _) prefix_take. +qed. + +lemma prefix_nth (l1 l2 : 'a list) : + let i = prefix l1 l2 in + forall j, 0 <= j < i => + nth witness l1 j = nth witness l2 j. +proof. +move=> /=; have Htake:= prefix_take l1 l2. +move=> j [Hj0 Hjp]; rewrite -(nth_take witness (prefix l1 l2)) 1:prefix_ge0 //. +by rewrite -(nth_take witness (prefix l1 l2) l2) 1:prefix_ge0 // Htake. +qed. + +(* TODO: can we define this as a fold on a set instead of on a list? *) +op max_prefix (l1 l2 : 'a list) (ll : 'a list list) = + with ll = "[]" => l2 + with ll = (::) l' ll' => + if prefix l1 l2 < prefix l1 l' then max_prefix l1 l' ll' + else max_prefix l1 l2 ll'. + +op get_max_prefix (l : 'a list) (ll : 'a list list) = + with ll = "[]" => [] + with ll = (::) l' ll' => max_prefix l l' ll'. + +pred prefix_inv (queries : (block list, block) fmap) + (prefixes : (block list, state) fmap) = + (forall (bs : block list), + bs \in queries => oget queries.[bs] = (oget prefixes.[bs]).`1) && + (forall (bs : block list), + bs \in queries => forall i, take i bs \in prefixes) && + (forall (bs : block list), + forall i, take i bs <> [] => + take i bs \in prefixes => + exists l2, (take i bs) ++ l2 \in queries). + +pred all_prefixes (prefixes : (block list, state) fmap) = + forall (bs : block list), bs \in prefixes => forall i, take i bs \in prefixes. + +lemma aux_mem_get_max_prefix (l1 l2 : 'a list) ll : + max_prefix l1 l2 ll = l2 \/ max_prefix l1 l2 ll \in ll. +proof. +move: l1 l2; elim: ll=> //= l3 ll Hind l1 l2. +case: (prefix l1 l2 < prefix l1 l3)=> //= hmax. ++ by have /#:= Hind l1 l3. +by have /#:= Hind l1 l2. +qed. + +lemma mem_get_max_prefix (l : 'a list) ll : + ll <> [] => get_max_prefix l ll \in ll. +proof. +move: l; elim: ll=> //= l2 ll Hind l1. +exact/aux_mem_get_max_prefix. +qed. + +lemma take_get_max_prefix l (prefixes : (block list,state) fmap) : + (exists b, b \in prefixes) => + all_prefixes prefixes => + take (prefix l (get_max_prefix l (elems (fdom prefixes)))) l \in prefixes. +proof. +move=> nil_in_dom all_pref. +rewrite prefix_take all_pref -mem_fdom memE mem_get_max_prefix; smt(memE mem_fdom). +qed. + +lemma take_get_max_prefix2 l (prefixes : (block list,state) fmap) i : + (exists b, b \in prefixes) => + all_prefixes prefixes => + i <= prefix l (get_max_prefix l (elems (fdom prefixes))) => + take i l \in prefixes. +proof. +move=> nil_in_dom all_pref hi. +rewrite (prefix_take_leq _ _ i hi) all_pref -mem_fdom memE mem_get_max_prefix. +smt(memE mem_fdom). +qed. + +lemma prefix_cat (l l1 l2 : 'a list) : + prefix (l ++ l1) (l ++ l2) = size l + prefix l1 l2. +proof. by move: l1 l2; elim: l=> /#. qed. + +lemma prefix_leq_take (l1 l2 : 'a list) i : + 0 <= i <= min (size l1) (size l2) => + take i l1 = take i l2 => + i <= prefix l1 l2. +proof. +move=> [hi0 himax] htake. +rewrite -(cat_take_drop i l1) -(cat_take_drop i l2) htake. +rewrite prefix_cat size_take //=; smt(prefix_ge0). +qed. + +lemma prefix0 (l1 l2 : 'a list) : + prefix l1 l2 = 0 <=> l1 = [] \/ l2 = [] \/ head witness l1 <> head witness l2 . +proof. +move: l2; elim: l1=> //= [[] //=|]. +move=> e1 l1 Hind l2; move: e1 l1 Hind; elim: l2=> //= e2 l2 Hind2 e1 l1 Hind1. +smt(prefix_ge0). +qed. + +lemma head_nth0 (l : 'a list) : head witness l = nth witness l 0. +proof. by elim: l. qed. + +lemma get_prefix (l1 l2 : 'a list) i : + 0 <= i <= min (size l1) (size l2)=> + (drop i l1 = [] \/ drop i l2 = [] \/ + (i < min (size l1) (size l2) /\ + nth witness l1 i <> nth witness l2 i)) => + take i l1 = take i l2 => + i = prefix l1 l2. +proof. +move=>[hi0 hisize] [|[]]. ++ move=> hi. + have:= size_eq0 (drop i l1); rewrite {2}hi /= size_drop // => h. + have hsize: size l1 = i by smt(). + rewrite -hsize take_size. + rewrite -{2}(cat_take_drop (size l1) l2)=> <-. + by rewrite -{2}(cats0 l1) prefix_cat; case: (drop (size l1) l2). ++ move=> hi. + have:= size_eq0 (drop i l2); rewrite {2}hi /= size_drop // => h. + have hsize: size l2 = i by rewrite /#. + rewrite -hsize take_size. + rewrite -{2}(cat_take_drop (size l2) l1)=> ->. + by rewrite -{4}(cats0 l2) prefix_cat; case: (drop (size l2) l1). +move=> [himax hnth] htake. +rewrite -(cat_take_drop i l1) -(cat_take_drop i l2) htake. +rewrite prefix_cat size_take //=. +have [_ ->]:= prefix0 (drop i l1) (drop i l2). ++ case: (i = size l1)=> hi1 //=. + + by rewrite hi1 drop_size //=. + case: (i = size l2)=> hi2 //=. + + by rewrite hi2 drop_size //=. + by rewrite 2!head_nth0 nth_drop //= nth_drop //= hnth. +smt(). +qed. + +lemma get_max_prefix_leq (l1 l2 : 'a list) (ll : 'a list list) : + prefix l1 l2 <= prefix l1 (max_prefix l1 l2 ll). +proof. by move: l1 l2; elim: ll=> /#. qed. + +lemma get_max_prefix_is_max (l1 l2 : 'a list) (ll : 'a list list) : + forall l3, l3 \in ll => prefix l1 l3 <= prefix l1 (max_prefix l1 l2 ll). +proof. +move: l1 l2; elim: ll=> //= l4 ll Hind l1 l2 l3. +by case: (prefix l1 l2 < prefix l1 l4)=> //= h []; smt(get_max_prefix_leq). +qed. + +lemma get_max_prefix_max (l : 'a list) (ll : 'a list list) : + forall l2, l2 \in ll => prefix l l2 <= prefix l (get_max_prefix l ll). +proof. smt(get_max_prefix_is_max get_max_prefix_leq). qed. + +(** TODO: NOT PRETTY! **) +lemma all_take_in (l : block list) i prefixes : + 0 <= i <= size l => + all_prefixes prefixes => + take i l \in prefixes => + i <= prefix l (get_max_prefix l (elems (fdom prefixes))). +proof. +move=>[hi0 hisize] all_prefix take_in_dom. +have ->:i = prefix l (take i l);2:smt(get_max_prefix_max memE mem_fdom). +apply get_prefix. ++ smt(size_take). ++ by right;left;apply size_eq0;rewrite size_drop//size_take//=/#. +smt(take_take). +qed. + +lemma prefix_inv_leq (l : block list) i prefixes queries : + 0 <= i <= size l => + elems (fdom queries) <> [] => + all_prefixes prefixes => + take i l \in prefixes => + prefix_inv queries prefixes => + i <= prefix l (get_max_prefix l (elems (fdom queries))). +proof. +move=>h_i h_nil h_all_prefixes take_in_dom [?[h_prefix_inv h_exist]]. +case(take i l = [])=>//=h_take_neq_nil. ++ smt(prefix_ge0 size_take). +have [l2 h_l2_mem]:=h_exist l i h_take_neq_nil take_in_dom. +rewrite -mem_fdom memE in h_l2_mem. +rewrite(StdOrder.IntOrder.ler_trans _ _ _ _ (get_max_prefix_max _ _ _ h_l2_mem)). +rewrite-{1}(cat_take_drop i l)prefix_cat size_take 1:/#;smt(prefix_ge0). +qed. + + +lemma max_prefix_eq (l : 'a list) (ll : 'a list list) : + max_prefix l l ll = l. +proof. +move:l;elim:ll=>//=l2 ll Hind l1;smt( prefix_eq prefix_sizel). +qed. + +lemma prefix_max_prefix_eq_size (l1 l2 : 'a list) (ll : 'a list list) : + l1 = l2 \/ l1 \in ll => + prefix l1 (max_prefix l1 l2 ll) = size l1. +proof. +move:l1 l2;elim:ll=>//=;1:smt(prefix_eq). +move=>l3 ll Hind l1 l2[->|[->|h1]]. ++ by rewrite prefix_eq max_prefix_eq ltzNge prefix_sizel /= prefix_eq. ++ rewrite prefix_eq max_prefix_eq. + case(prefix l3 l2 < size l3)=>//=h;1:by rewrite prefix_eq. + have h1: prefix l3 l2 = size l3 by smt(prefix_sizel). + have: size l3 <= prefix l3 (max_prefix l3 l2 ll);2:smt(prefix_sizel). + rewrite-h1. + by clear Hind l1 h h1;move:l2 l3;elim:ll=>//=l3 ll Hind l1 l2/#. +by case(prefix l1 l2 < prefix l1 l3)=>//=/#. +qed. + +lemma prefix_get_max_prefix_eq_size (l : 'a list) (ll : 'a list list) : + l \in ll => + prefix l (get_max_prefix l ll) = size l. +proof. +move:l;elim:ll=>//;smt(prefix_max_prefix_eq_size). +qed. + +lemma get_max_prefix_exists (l : 'a list) (ll : 'a list list) : + ll <> [] => + exists l2, take (prefix l (get_max_prefix l ll)) l ++ l2 \in ll. +proof. +move:l;elim:ll=>//=l2 ll Hind l1;clear Hind;move:l1 l2;elim:ll=>//=. ++ smt(cat_take_drop prefix_take). +move=>l3 ll Hind l1 l2. +case( prefix l1 l2 < prefix l1 l3 )=>//=h/#. +qed. + +lemma prefix_geq (l1 l2 : 'a list) : + prefix l1 l2 = prefix (take (prefix l1 l2) l1) (take (prefix l1 l2) l2). +proof. +move:l2;elim:l1=>//=[[] //=|] e1 l1 Hind l2;elim:l2=>//=e2 l2 Hind2. +case(e1=e2)=>//=h12. +have ->/=:! 1 + prefix l1 l2 <= 0 by smt(prefix_ge0). +rewrite h12/=/#. +qed. + +lemma prefix_take_prefix (l1 l2 : 'a list) : + prefix (take (prefix l1 l2) l1) l2 = prefix l1 l2. +proof. +move:l2;elim:l1=>//=e1 l1 Hind l2;elim:l2=>//=e2 l2 Hind2. +case(e1=e2)=>//=h12. +have ->/=:! 1 + prefix l1 l2 <= 0 by smt(prefix_ge0). +rewrite h12/=/#. +qed. + +lemma prefix_leq_prefix_cat (l1 l2 l3 : 'a list) : + prefix l1 l2 <= prefix (l1 ++ l3) l2. +proof. +move:l2 l3;elim l1=>//= [[]|]; 1,2:smt(take_le0 prefix_ge0). +move=>e1 l1 hind1 l2;elim:l2=>//=e2 l2 hind2 l3/#. +qed. + +lemma prefix_take_leq_prefix (l1 l2 : 'a list) i : + prefix (take i l1) l2 <= prefix l1 l2. +proof. +rewrite-{2}(cat_take_drop i l1). +move:(take i l1)(drop i l1);clear i l1=>l1 l3. +exact prefix_leq_prefix_cat. +qed. + +lemma prefix_take_geq_prefix (l1 l2 : 'a list) i : + prefix l1 l2 <= i => + prefix l1 l2 = prefix (take i l1) l2. +proof. +move=>hi. +have: prefix (take i l1) l2 <= prefix l1 l2. ++ rewrite-{2}(cat_take_drop i l1) prefix_leq_prefix_cat. +have /#: prefix l1 l2 <= prefix (take i l1) l2. +rewrite -prefix_take_prefix. +rewrite -(cat_take_drop (prefix l1 l2) (take i l1))take_take minrE hi //=. +by rewrite prefix_leq_prefix_cat. +qed. + +lemma get_max_prefix_take (l : 'a list) (ll : 'a list list) i : + prefix l (get_max_prefix l ll) <= i => + get_max_prefix l ll = get_max_prefix (take i l) ll. +proof. +move:l;elim:ll=>//=l2 ll Hind l1;clear Hind;move:l1 l2;elim:ll=>//=l3 ll Hind l1 l2. +case( prefix l1 l2 < prefix l1 l3 )=>//=h hi. ++ rewrite -prefix_take_geq_prefix//=;1:smt(get_max_prefix_leq). + rewrite -prefix_take_geq_prefix//=;1:smt(get_max_prefix_leq). + rewrite h/=/#. +rewrite -prefix_take_geq_prefix//=;1:smt(get_max_prefix_leq). +rewrite -prefix_take_geq_prefix//=;1:smt(get_max_prefix_leq). +rewrite h/=/#. +qed. + + +lemma drop_prefix_neq (l1 l2 : 'a list) : + drop (prefix l1 l2) l1 = [] \/ drop (prefix l1 l2) l1 <> drop (prefix l1 l2) l2. +proof. +move: l2; elim: l1=> //= e1 l1 hind1; elim=> //= e2 l2 //= hind2 //=. +smt(prefix_ge0). +qed. + +lemma prefix_prefix_prefix (l1 l2 l3 : 'a list) (ll : 'a list list) : + prefix l1 l2 <= prefix l1 l3 => + prefix l1 (max_prefix l1 l2 ll) <= prefix l1 (max_prefix l1 l3 ll). +proof. +move:l1 l2 l3;elim:ll=>//=l4 ll hind l1 l2 l3 h123/#. +qed. + +lemma prefix_lt_size (l : 'a list) (ll : 'a list list) : + prefix l (get_max_prefix l ll) < size l => + forall i, prefix l (get_max_prefix l ll) < i => + ! take i l \in ll. +proof. +move:l;elim:ll=>//=l2 ll Hind l1;clear Hind;move:l1 l2;elim:ll=>//=. ++ progress. + rewrite-(cat_take_drop (prefix l1 l2) (take i l1)) + -{3}(cat_take_drop (prefix l1 l2) l2)take_take/min H0/=. + rewrite prefix_take. + have: drop (prefix l1 l2) (take i l1) <> drop (prefix l1 l2) l2;2:smt(catsI). + rewrite (prefix_take_geq_prefix l1 l2 i) 1:/#. + have:= drop_prefix_neq (take i l1) l2. + have /#: drop (prefix (take i l1) l2) (take i l1) <> []. + have: 0 < size (drop (prefix (take i l1) l2) (take i l1));2:smt(size_eq0). + rewrite size_drop 1:prefix_ge0 size_take;1:smt(prefix_ge0). + by rewrite-prefix_take_geq_prefix /#. + +move=>l3 ll hind l1 l2. +case(prefix l1 l2 < prefix l1 l3)=>//=h;progress. ++ rewrite!negb_or/=. + have:= hind l1 l3 H i H0;rewrite negb_or=>[][->->]/=. + have:= hind l1 l2 _ i _;smt(prefix_prefix_prefix). +smt(prefix_prefix_prefix). +qed. + +lemma asfadst queries prefixes (bs : block list) : + prefix_inv queries prefixes => + elems (fdom queries ) <> [] => + all_prefixes prefixes => + (forall j, 0 <= j <= size bs => take j bs \in prefixes) => + take (prefix bs (get_max_prefix bs (elems (fdom queries))) + 1) bs = bs. +proof. +progress. +have h:=prefix_inv_leq bs (size bs) prefixes queries _ _ _ _ _;rewrite//=. ++ rewrite H2//=;exact size_ge0. +have ->/=: prefix bs (get_max_prefix bs (elems (fdom queries))) = size bs by smt(prefix_sizel). +rewrite take_oversize/#. +qed. + + +lemma prefix_exchange_prefix_inv (ll1 ll2 : 'a list list) (l : 'a list) : + (forall l2, l2 \in ll1 => l2 \in ll2) => + (forall (l2 : 'a list), l2 \in ll1 => forall i, take i l2 \in ll2) => + (forall l2, l2 \in ll2 => exists l3, l2 ++ l3 \in ll1) => + prefix l (get_max_prefix l ll1) = prefix l (get_max_prefix l ll2). +proof. +case(ll1 = [])=>//=[-> _ _|]. ++ by case: (ll2 = [])=> [->> //=|] //= + /mem_eq0. +move=> ll1_nil incl all_prefix incl2; have ll2_nil: ll2 <> [] by smt(mem_eq0). +have:= get_max_prefix_max l ll2 (get_max_prefix l ll1) _. ++ by rewrite incl mem_get_max_prefix ll1_nil. +have mem_ll2:=mem_get_max_prefix l ll2 ll2_nil. +have[]l3 mem_ll1:=incl2 _ mem_ll2. +have:=get_max_prefix_max l ll1 _ mem_ll1. +smt(prefixC prefix_leq_prefix_cat). +qed. + +lemma prefix_inv_nil queries prefixes : + prefix_inv queries prefixes => + elems (fdom queries) = [] => fdom prefixes \subset fset1 []. +proof. +move=>[h1 [h2 h3]] h4 x h5;rewrite in_fset1. +have:=h3 x (size x). +rewrite take_size -mem_fdom h5/=;apply absurd=>//=h6. +rewrite h6/=negb_exists/=;smt(memE mem_fdom). +qed. + +lemma aux_prefix_exchange queries prefixes (l : block list) : + prefix_inv queries prefixes => all_prefixes prefixes => + elems (fdom queries) <> [] => + prefix l (get_max_prefix l (elems (fdom queries))) = + prefix l (get_max_prefix l (elems (fdom prefixes))). +proof. +move=>[h1[h2 h3]] h5 h4;apply prefix_exchange_prefix_inv. ++ move=> l2; rewrite -memE mem_fdom=> /h2 /(_ (size l2)). + by rewrite take_size -mem_fdom memE. ++ move=> l2; rewrite -memE mem_fdom=> /h2 + i - /(_ i). + by rewrite -mem_fdom memE. +move=>l2; rewrite -memE=> mem_l2. +case(l2=[])=>//=hl2;1:rewrite hl2/=. ++ move:h4;apply absurd=>//=;rewrite negb_exists/= => /mem_eq0 //=. +have:= h3 l2 (size l2); rewrite take_size hl2 -mem_fdom mem_l2. +by move=> /= [] l3 hl3; exists l3; rewrite -memE mem_fdom. +qed. + +lemma prefix_exchange queries prefixes (l : block list) : + prefix_inv queries prefixes => all_prefixes prefixes => + prefix l (get_max_prefix l (elems (fdom queries))) = + prefix l (get_max_prefix l (elems (fdom prefixes))). +proof. +move=> [h1[h2 h3]] h5. +case: (elems (fdom queries) = [])=> h4. ++ have h6:=prefix_inv_nil queries prefixes _ h4;1:rewrite/#. + rewrite h4/=. + have fdom_prefixP: fdom prefixes = fset0 \/ fdom prefixes = fset1 []. + + by move: h6; rewrite !fsetP /(\subset); smt(in_fset0 in_fset1). + case(elems (fdom prefixes) = [])=>//=[->//=|]h7. + have h8:elems (fdom prefixes) = [[]]. + + have []:= fdom_prefixP. + + by move=> h8; move: h7; rewrite h8 elems_fset0. + by move=> ->; rewrite elems_fset1. + by rewrite h8=>//=. +by apply/(aux_prefix_exchange _ _ _ _ h5 h4). +qed. + +pred all_prefixes_fset (prefixes : block list fset) = + forall bs, bs \in prefixes => forall i, take i bs \in prefixes. + +pred inv_prefix_block (queries : (block list, block) fmap) + (prefixes : (block list, block) fmap) = + (forall (bs : block list), + bs \in queries => queries.[bs] = prefixes.[bs]) && + (forall (bs : block list), + bs \in queries => forall i, 0 < i <= size bs => take i bs \in prefixes). + +lemma prefix_gt0_mem l (ll : 'a list list) : + 0 < prefix l (get_max_prefix l ll) => + get_max_prefix l ll \in ll. +proof. +move:l;elim:ll=>//=;first by move=>l;elim:l. +move=>l2 ll hind l1;clear hind;move:l1 l2;elim:ll=>//=l3 ll hind l1 l2. +by case(prefix l1 l2 < prefix l1 l3)=>//=/#. +qed. + +lemma inv_prefix_block_mem_take queries prefixes l i : + inv_prefix_block queries prefixes => + 0 < i < prefix l (get_max_prefix l (elems (fdom queries))) => + take i l \in prefixes. +proof. +move=>[]H_incl H_all_prefixes Hi. +rewrite (prefix_take_leq _ (get_max_prefix l (elems (fdom queries))))1:/#. +rewrite H_all_prefixes. +have:get_max_prefix l (elems (fdom queries)) \in queries;2:smt(domE). +by rewrite -mem_fdom memE;apply prefix_gt0_mem=>/#. +smt(prefix_sizer). +qed. + +lemma prefix_cat_leq_prefix_size (l1 l2 l3 : 'a list): + prefix (l1 ++ l2) l3 <= prefix l1 l3 + size l2. +proof. +move:l2 l3;elim:l1=>//=. ++ by move=> l2 []; smt(prefix_sizel). +by move=>e1 l1 hind1 l2 l3;move:e1 l1 l2 hind1;elim:l3=>//=;1:smt(size_ge0). +qed. + +lemma prefix_cat1 (l1 l2 l3 : 'a list) : + prefix (l1 ++ l2) l3 = prefix l1 l3 + + if prefix l1 l3 = size l1 + then prefix l2 (drop (size l1) l3) + else 0. +proof. +move:l2 l3;elim:l1=>//=. ++ by move=> l2 []; smt(prefix_sizel). +move=>e1 l1 hind1 l2 l3;move:e1 l1 l2 hind1;elim:l3=>//=;1:smt(size_ge0). +by move=>e3 l3 hind3 e1 l1 l2 hind1;case(e1=e3)=>//=[->>|h];smt(size_ge0). +qed. + + +lemma prefix_leq_prefix_cat_size (l1 l2 : 'a list) (ll : 'a list list) : + prefix (l1++l2) (get_max_prefix (l1++l2) ll) <= + prefix l1 (get_max_prefix l1 ll) + + if (prefix l1 (get_max_prefix l1 ll) = size l1) + then prefix l2 (get_max_prefix l2 (map (drop (size l1)) ll)) + else 0. +proof. +move:l1 l2;elim:ll=>//=. ++ smt(prefixs0). +move=>l3 ll hind{hind};move:l3;elim:ll=>//=;1:smt(prefix_cat1). +move=>l4 ll hind l3 l1 l2. +case(prefix (l1 ++ l2) l3 < prefix (l1 ++ l2) l4)=>//=. ++ rewrite 2!prefix_cat1. + case(prefix l1 l3 = size l1)=>//=H_l1l3;case(prefix l1 l4 = size l1)=>//=H_l1l4. + - rewrite H_l1l4 H_l1l3/=ltz_add2l=>h;rewrite h/=. + rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _)). + have->/=:prefix l1 (max_prefix l1 l4 ll) = size l1 + by move:{hind};elim:ll=>//=;smt(prefix_sizel). + by have->/=:prefix l1 (max_prefix l1 l3 ll) = size l1 + by move:{hind};elim:ll=>//=;smt(prefix_sizel). + - smt(prefix_sizel prefix_ge0). + - have->/=h:prefix l1 l3 < prefix l1 l4 by smt(prefix_sizel). + rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _)). + have->/=:prefix l1 (max_prefix l1 l4 ll) = size l1 + by move:{hind};elim:ll=>//=;smt(prefix_sizel). + smt(prefix_prefix_prefix). + move=>H_l3l4;rewrite H_l3l4/=. + rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _)). + by case(prefix l1 (max_prefix l1 l4 ll) = size l1)=>//=->; + smt(prefix_prefix_prefix). +rewrite 2!prefix_cat1. +case(prefix l1 l3 = size l1)=>//=H_l1l3;case(prefix l1 l4 = size l1)=>//=H_l1l4. ++ by rewrite H_l1l4 H_l1l3/=ltz_add2l=>h;rewrite h/=hind. ++ rewrite H_l1l3. + have->/=:!size l1 < prefix l1 l4 by smt(prefix_sizel). + rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _))//=. + have->//=:prefix l1 (max_prefix l1 l3 ll) = size l1 + by move:{hind};elim:ll=>//=;smt(prefix_sizel). + smt(prefix_prefix_prefix). ++ smt(prefix_sizel prefix_ge0). +move=>H_l3l4;rewrite H_l3l4/=. +rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _))//=. +smt(prefix_prefix_prefix). +qed. + + +lemma diff_size_prefix_leq_cat (l1 l2 : 'a list) (ll : 'a list list) : + size l1 - prefix l1 (get_max_prefix l1 ll) <= + size (l1++l2) - prefix (l1++l2) (get_max_prefix (l1++l2) ll). +proof. +smt(prefix_leq_prefix_cat_size prefix_sizel prefix_ge0 size_ge0 prefix_sizer size_cat). +qed. + + + +(* lemma prefix_inv_prefix queries prefixes l : *) +(* prefix_inv queries prefixes => *) +(* all_prefixes prefixes => *) +(* (elems (fdom queries) = [] => elems (fdom prefixes) = [[]]) => *) +(* prefix l (get_max_prefix l (elems (fdom queries))) = *) +(* prefix l (get_max_prefix l (elems (fdom prefixes))). *) +(* proof. *) +(* move=>[? h_prefix_inv] h_all_prefixes. *) +(* case(elems (fdom queries) = [])=>//=h_nil. *) +(* + by rewrite h_nil//==>->/=. *) +(* cut h_mem_queries:=mem_get_max_prefix l (elems (fdom queries)) h_nil. *) +(* cut h_leq :=all_take_in l (prefix l (get_max_prefix l (elems (fdom queries)))) _ _ h_all_prefixes _. *) +(* + smt(prefix_ge0 prefix_sizel). *) +(* + by rewrite prefix_take h_prefix_inv memE h_mem_queries. *) +(* cut:=all_take_in l (prefix l (get_max_prefix l (elems (fdom prefixes)))) _ _ h_all_prefixes _. *) +(* + smt(prefix_ge0 prefix_sizel). *) +(* + *) +(* rewrite prefix_take. *) + +(* rewrite -take_size. *) + +(* print mem_get_max_prefix. *) + +(* qed. *) + +pred invm (m mi : ('a * 'b, 'a * 'b) fmap) = + forall x y, m.[x] = Some y <=> mi.[y] = Some x. + +lemma invm_set (m mi : ('a * 'b, 'a * 'b) fmap) x y : + ! x \in m => ! rng m y => invm m mi => invm m.[x <- y] mi.[y <- x]. +proof. +move=>Hxdom Hyrng Hinv a b; rewrite !get_setE; split. ++ case(a=x)=>//=hax hab;have->/#:b<>y. + by have/#: rng m b;rewrite rngE /#. +case(a=x)=>//=hax. ++ case(b=y)=>//=hby. + by rewrite (eq_sym y b)hby/=-Hinv hax;rewrite domE /=/# in Hxdom. +by rewrite Hinv/#. +qed. + +end Prefix. +export Prefix. + +(* -------------------------------------------------------------------------- *) + +module C = { + var c : int + var queries : (block list, block) fmap + proc init () = { + c <- 0; + queries <- empty.[[] <- b0]; + } +}. + +module PC (P:PRIMITIVE) = { + + proc init () = { + C.init(); + P.init(); + } + + proc f (x:state) = { + var y <- (b0,c0); + y <@ P.f(x); + C.c <- C.c + 1; + return y; + } + + proc fi(x:state) = { + var y <- (b0,c0); + y <@ P.fi(x); + C.c <- C.c + 1; + return y; + } + +}. + +module DPRestr (P:DPRIMITIVE) = { + + proc f (x:state) = { + var y <- (b0,c0); + if (C.c + 1 <= max_size) { + y <@ P.f(x); + C.c <- C.c + 1; + } + return y; + } + + proc fi(x:state) = { + var y <- (b0,c0); + if (C.c + 1 <= max_size) { + y <@ P.fi(x); + C.c <- C.c + 1; + } + return y; + } + +}. + +module PRestr (P:PRIMITIVE) = { + + proc init () = { + C.init(); + P.init(); + } + + proc f = DPRestr(P).f + + proc fi = DPRestr(P).fi + +}. + +module FC(F:FUNCTIONALITY) = { + + proc init() = { + F.init(); + } + + proc f (bs:block list) = { + var b <- b0; + if (bs \notin C.queries) { + C.c <- C.c + size bs - prefix bs (get_max_prefix bs (elems (fdom C.queries))); + b <@ F.f(bs); + C.queries.[bs] <- b; + } else { + b <- oget C.queries.[bs]; + } + return b; + } +}. + +module DFRestr(F:DFUNCTIONALITY) = { + + proc f (bs:block list) = { + var b <- b0; + if (bs \notin C.queries) { + if (C.c + size bs - prefix bs (get_max_prefix bs (elems (fdom C.queries))) <= max_size) { + C.c <- C.c + size bs - prefix bs (get_max_prefix bs (elems (fdom C.queries))); + b <@ F.f(bs); + C.queries.[bs] <- b; + } + } else { + b <- oget C.queries.[bs]; + } + return b; + } +}. + +module FRestr(F:FUNCTIONALITY) = { + + proc init() = { + Redo.init(); + F.init(); + } + + proc f = DFRestr(F).f + +}. + +(* -------------------------------------------------------------------------- *) +(* This allow swap the counting from oracle to adversary *) +module DRestr(D:DISTINGUISHER, F:DFUNCTIONALITY, P:DPRIMITIVE) = { + proc distinguish() = { + var b; + C.init(); + b <@ D(DFRestr(F), DPRestr(P)).distinguish(); + return b; + } +}. + +lemma rp_ll (P<:DPRIMITIVE{-C}): islossless P.f => islossless DPRestr(P).f. +proof. move=>Hll;proc;sp;if;auto;call Hll;auto. qed. + +lemma rpi_ll (P<:DPRIMITIVE{-C}): islossless P.fi => islossless DPRestr(P).fi. +proof. move=>Hll;proc;sp;if;auto;call Hll;auto. qed. + +lemma rf_ll (F<:DFUNCTIONALITY{-C}): islossless F.f => islossless DFRestr(F).f. +proof. move=>Hll;proc;sp;if;auto;if=>//;auto;call Hll;auto. qed. + +lemma DRestr_ll (D<:DISTINGUISHER{-C}): + (forall (F<:DFUNCTIONALITY{-D})(P<:DPRIMITIVE{-D}), + islossless P.f => islossless P.fi => islossless F.f => + islossless D(F,P).distinguish) => + forall (F <: DFUNCTIONALITY{-DRestr(D)}) (P <: DPRIMITIVE{-DRestr(D)}), + islossless P.f => + islossless P.fi => islossless F.f => islossless DRestr(D, F, P).distinguish. +proof. + move=> D_ll F P p_ll pi_ll f_ll;proc. + call (D_ll (DFRestr(F)) (DPRestr(P)) _ _ _). + + by apply (rp_ll P). + by apply (rpi_ll P). + by apply (rf_ll F). + by inline *;auto. +qed. + +section RESTR. + + declare module F <: FUNCTIONALITY{-C}. + declare module P <: PRIMITIVE{-C, -F}. + declare module D <: DISTINGUISHER{-F, -P, -C}. + + lemma swap_restr &m: + Pr[Indif(FRestr(F), PRestr(P), D).main()@ &m: res] = + Pr[Indif(F,P,DRestr(D)).main()@ &m: res]. + proof. + byequiv=>//;auto. + proc;inline *;wp. + swap{1}[1..2] 3;sim;auto;call(:true);auto. + qed. + +end section RESTR. + +section COUNT. + + declare module P <: PRIMITIVE{-C}. + declare module CO <: CONSTRUCTION{-C, -P}. + declare module D <: DISTINGUISHER{-C, -P, -CO}. + + declare axiom f_ll : islossless P.f. + declare axiom fi_ll : islossless P.fi. + + declare axiom CO_ll : islossless CO(P).f. + + declare axiom D_ll (F <: DFUNCTIONALITY{-D}) (P <: DPRIMITIVE{-D}): + islossless P.f => islossless P.fi => islossless F.f => + islossless D(F, P).distinguish. + + lemma Pr_restr &m : + Pr[Indif(FC(CO(P)), PC(P), D).main()@ &m:res /\ C.c <= max_size] <= + Pr[Indif(CO(P), P, DRestr(D)).main()@ &m:res]. + proof. + byequiv (_: ={glob D, glob P, glob CO} ==> C.c{1} <= max_size => ={res})=>//; + 2:by move=> ??H[]?/H<-. + symmetry;proc;inline *;wp. + call (_: max_size < C.c, ={glob P, glob CO, glob C}). + + apply D_ll. + + proc; sp;if{1};1:by auto;call(_:true);auto. + by auto;call{2} f_ll;auto=>/#. + + by move=> ?_;proc;sp;auto;if;auto;call f_ll;auto. + + by move=> _;proc;sp;auto;call f_ll;auto=>/#. + + proc;sp;auto;if{1};1:by auto;call(_:true);auto. + by call{2} fi_ll;auto=>/#. + + by move=> ?_;proc;sp;auto;if;auto;call fi_ll;auto. + + by move=> _;proc;sp;auto;call fi_ll;auto=>/#. + + proc;inline*;sp 1 1;if;auto;if{1};auto;1:by call(_: ={glob P});auto;sim. + by call{2} CO_ll;auto=>/#. + + by move=> ?_;proc;sp;if;auto;if;auto;call CO_ll;auto. + + by move=> _;proc;sp;if;auto;call CO_ll;auto;smt(prefix_sizel). + auto;call (_:true);auto;call(:true);auto=>/#. + qed. + +end section COUNT. + +(** Operators and properties of handles *) +op hinv (handles:handles) (c:capacity) = + find (fun _ => pred1 c \o fst) handles. + +op hinvK (handles:handles) (c:capacity) = + find (fun _ => pred1 c) (restr Known handles). + +op huniq (handles:handles) = + forall h1 h2 cf1 cf2, + handles.[h1] = Some cf1 => + handles.[h2] = Some cf2 => + cf1.`1 = cf2.`1 => h1 = h2. + +lemma hinvP handles c: + if hinv handles c = None then forall h f, handles.[h] <> Some(c,f) + else exists f, handles.[oget (hinv handles c)] = Some(c,f). +proof. +move=> @/hinv. +have @/pred1 @/(\o) /> [-> /= + h f|h [] /> f -> //= Hmem] := findP (fun _=> pred1 c \o fst) handles. ++ by move=> /(_ h); rewrite domE; case: (handles.[h])=> /#. +by exists f. +qed. + +lemma huniq_hinv (handles:handles) (h:handle): + huniq handles => dom handles h => hinv handles (oget handles.[h]).`1 = Some h. +proof. +move=> Huniq;pose c := (oget handles.[h]).`1. +have:=Huniq h;have:=hinvP handles c. +case (hinv _ _)=> /=[Hdiff _| h' +/(_ h')]. ++ rewrite domE /=; move: (Hdiff h (oget handles.[h]).`2). + by rewrite /c; case: handles.[h]=> //= - []. +move=> [f ->] /(_ (oget handles.[h]) (c,f)) H1 H2;rewrite H1 //. +by move: H2; rewrite domE; case: (handles.[h]). +qed. + +lemma hinvKP handles c: + if hinvK handles c = None then forall h, handles.[h] <> Some(c,Known) + else handles.[oget (hinvK handles c)] = Some(c,Known). +proof. +rewrite /hinvK. +have @/pred1 /= [-> /= + h|h /> -> /=]:= findP (+ pred1 c) (restr Known handles). ++ by move=> /(_ h); rewrite domE restrP=> /#. +by rewrite restrP; case: (handles.[h])=> //= - [] /#. +qed. + +lemma huniq_hinvK (handles:handles) c: + huniq handles => rng handles (c,Known) => handles.[oget (hinvK handles c)] = Some(c,Known). +proof. +move=> Huniq;rewrite rngE=> -[h]H;case: (hinvK _ _) (Huniq h) (hinvKP handles c)=>//=. +by move=>_/(_ h);rewrite H. +qed. + +lemma huniq_hinvK_h h (handles:handles) c: + huniq handles => handles.[h] = Some (c,Known) => hinvK handles c = Some h. +proof. +by move=> Huniq;case: (hinvK _ _) (hinvKP handles c)=>/= [ H | h' /Huniq H/H //]; apply H. +qed. + +(* -------------------------------------------------------------------------- *) +(** The initial Game *) +module GReal(D:DISTINGUISHER) = RealIndif(SqueezelessSponge, PC(Perm), D).