From 9633d38359f5069cce1333798a47e5948694da8e Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Mon, 25 Aug 2014 11:33:42 +0200 Subject: [PATCH 001/394] initial revision From fd4e78bb12299444984e637f1ddd7a4be8f11ea6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 27 Feb 2015 14:09:11 +0100 Subject: [PATCH 002/394] Core definitions. Starting to line up the definitions so we can prioritize the missing bits of the standard library. A note: indifferentiability should be generalized to any pair of primitives, rather than be specialized to random oracles. For example, we may want to tackle the random permutation case... --- sha3/proof/Indifferentiability.eca | 49 +++++++++++++++++++++ sha3/proof/RO.eca | 30 +++++++++++++ sha3/proof/Sponge.ec | 68 ++++++++++++++++++++++++++++++ 3 files changed, 147 insertions(+) create mode 100644 sha3/proof/Indifferentiability.eca create mode 100644 sha3/proof/RO.eca create mode 100644 sha3/proof/Sponge.ec diff --git a/sha3/proof/Indifferentiability.eca b/sha3/proof/Indifferentiability.eca new file mode 100644 index 0000000..1dcb8d9 --- /dev/null +++ b/sha3/proof/Indifferentiability.eca @@ -0,0 +1,49 @@ +require (*...*) RO. + +type from0, to0. +op d0: from0 -> to0 distr. + +type from1, to1. +op d1: from1 -> to1 distr. + +clone import RO as H with + type from <- from0, + type to <- to0, + op d <- d0. + +clone import RO as G with + type from <- from1, + type to <- to1, + op d <- d1. + +module type Construction (H : H.RO) = { + proc init() : unit + proc hash(x : from1): to1 +}. + +module type Simulator (H : G.RO) = { + proc init() : unit + proc hash(x : from0): to0 +}. + +module type Distinguisher (G : G.RO_, H : H.RO_) = { + proc distinguish(): bool +}. + +module Indif (G : G.RO, H : H.RO, D : Distinguisher) = { + module D = D(G,H) + + proc main(): bool = { + var b; + + G.init(); + H.init(); + b = D.distinguish(); + return b; + } +}. + +(* A C <: Construction is indifferentiable from a random oracle if + there exists a P <: Simulator such that, for all D, + | Pr[Indif(C(G),G,D): res] - Pr[Indif(H,P(H),D): res] | is small + (where G and H are the concrete random oracles defined by d0 and d1) *) diff --git a/sha3/proof/RO.eca b/sha3/proof/RO.eca new file mode 100644 index 0000000..72ab948 --- /dev/null +++ b/sha3/proof/RO.eca @@ -0,0 +1,30 @@ +require import NewFSet NewFMap. + +type from, to. + +op d: from -> to distr. + +module type RO = { + proc init() : unit + proc hash(x : from): to +}. + +module type RO_ = { + proc hash(x : from): to +}. + +module type Distinguisher(G : RO_) = { + proc distinguish(): bool +}. + +module IND(G:RO, D:Distinguisher) = { + module D = D(G) + + proc main(): bool = { + var b; + + G.init(); + b = D.distinguish(); + return b; + } +}. diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec new file mode 100644 index 0000000..bded7e6 --- /dev/null +++ b/sha3/proof/Sponge.ec @@ -0,0 +1,68 @@ +require import Option Pair Int ABitstring NewList. +require (*..*) AWord Indifferentiability. +(* TODO: Clean up the Bitstring and Word theories + -- Make use of those new versions. *) + +(*...*) import Dprod. +(* TODO: Datatype definitions and distributions should + be properly separated and reorganized. *) + +op r : int. +axiom le0_r: 0 < r. + +op c : int. +axiom le0_c: 0 < c. + +(** Clarify assumptions on the distributions as we go. As this is currently + written, we are hiding some pretty heavy axioms behind cloning. **) +type block. +op dblock: block distr. + +clone import AWord as Block with + op length <- r, + type word <- block, + op Dword.dword <- dblock +proof leq0_length by smt. + +type capacity. +op dcapacity: capacity distr. + +clone AWord as Capacity with + op length <- c, + type word <- capacity, + op Dword.dword <- dcapacity +proof leq0_length by smt. + +type state = block * capacity. + +clone import Indifferentiability as Main with + type from0 <- state, + type to0 <- state, + op d0 <- fun (x:state) => dblock * dcapacity, + type from1 <- block list * int, + type to1 <- bitstring, + op d1 <- fun (x:block list * int) => DBitstring.dbitstring x.`2. + +module Sponge (H : H.RO): Construction(H) = { + proc init = H.init + + proc hash(p : block list, n : int): bitstring = { + var z = ABitstring.zeros n; + var s = (Block.zeros,Capacity.zeros); + var i = 0; + + if (size p >= 1 /\ nth witness p (size p - 1) <> Block.zeros) { + z = ABitstring.zeros 0; + while (p <> []) { + s = H.hash(s.`1 ^ head witness p,s.`2); + p = behead p; + } + while (i < n/%r) { + z = z || (to_bits s.`1); + s = H.hash(s); + } + } + + return sub z 0 n; + } +}. From ce5f65aa9490014cf7c09ff5a3a2743e82d23fc2 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 27 Feb 2015 13:57:10 -0500 Subject: [PATCH 003/394] Added strawman implemetation of an infinite random oracle. --- sha3/proof/IRO.eca | 53 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) create mode 100644 sha3/proof/IRO.eca diff --git a/sha3/proof/IRO.eca b/sha3/proof/IRO.eca new file mode 100644 index 0000000..b5dd307 --- /dev/null +++ b/sha3/proof/IRO.eca @@ -0,0 +1,53 @@ +(* infinite random oracle: conceptually, its range consists of + infinite length bitstrings, all of whose bits are independently + chosen *) + +require import Int Bool List FMap FSet. + +type from. + +module type IRO = { + proc init() : unit + + (* hash x, returning the first n bits of the result *) + proc hash(x : from, n : int) : bool list +}. + +op take : 'a list -> int -> 'a list. (* in NewFMap ... *) + +module IRO : IRO = { + var mp : (from, bool list) map + + proc init() : unit = { + mp = FMap.empty; + } + + proc choose(n : int) : bool list = { + var b : bool; + var bs : bool list; + bs = []; + while (n > 0) { + b = $Dbool.dbool; + bs = b :: bs; + n = n - 1; + } + return bs; + } + + proc hash(x : from, n : int) : bool list = { + var ys : bool list; + var zs : bool list; + if (! mem x (dom mp)) { + ys = choose(n); + mp.[x] = ys; + } + else { + ys = oget(mp.[x]); + if (n > length ys) { + zs = choose(n - length ys); + mp.[x] = ys ++ zs; + } + } + return take (oget mp.[x]) n; + } +}. From 7ec67879b11c9fcf936d1d6f47861f2a694e78c2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 2 Mar 2015 12:19:57 +0100 Subject: [PATCH 004/394] Folding in Alley's contribution. Generalizing Indifferentiability. --- sha3/proof/IRO.eca | 14 ++--- sha3/proof/Indifferentiability.eca | 66 ++++++++++++---------- sha3/proof/LazyRO.eca | 20 +++++++ sha3/proof/RO.eca | 2 - sha3/proof/Sponge.ec | 89 +++++++++++++++++++++++------- 5 files changed, 132 insertions(+), 59 deletions(-) create mode 100644 sha3/proof/LazyRO.eca diff --git a/sha3/proof/IRO.eca b/sha3/proof/IRO.eca index b5dd307..85ae9d1 100644 --- a/sha3/proof/IRO.eca +++ b/sha3/proof/IRO.eca @@ -2,7 +2,7 @@ infinite length bitstrings, all of whose bits are independently chosen *) -require import Int Bool List FMap FSet. +require import Option Int Bool NewList NewFMap NewFSet. type from. @@ -16,10 +16,10 @@ module type IRO = { op take : 'a list -> int -> 'a list. (* in NewFMap ... *) module IRO : IRO = { - var mp : (from, bool list) map + var mp : (from, bool list) fmap proc init() : unit = { - mp = FMap.empty; + mp = map0; } proc choose(n : int) : bool list = { @@ -37,14 +37,14 @@ module IRO : IRO = { proc hash(x : from, n : int) : bool list = { var ys : bool list; var zs : bool list; - if (! mem x (dom mp)) { + if (! mem (dom mp) x) { ys = choose(n); mp.[x] = ys; } else { - ys = oget(mp.[x]); - if (n > length ys) { - zs = choose(n - length ys); + ys = oget (mp.[x]); + if (n > size ys) { + zs = choose(n - size ys); mp.[x] = ys ++ zs; } } diff --git a/sha3/proof/Indifferentiability.eca b/sha3/proof/Indifferentiability.eca index 1dcb8d9..68101c0 100644 --- a/sha3/proof/Indifferentiability.eca +++ b/sha3/proof/Indifferentiability.eca @@ -1,49 +1,55 @@ -require (*...*) RO. +(** A primitive: the building block we assume ideal **) +type p_in, p_out. -type from0, to0. -op d0: from0 -> to0 distr. - -type from1, to1. -op d1: from1 -> to1 distr. +module type Primitive = { + proc init(): unit + proc oracle(x : p_in): p_out +}. -clone import RO as H with - type from <- from0, - type to <- to0, - op d <- d0. +(** A functionality: the target construction **) +type f_in, f_out. -clone import RO as G with - type from <- from1, - type to <- to1, - op d <- d1. +module type Functionality = { + proc init(): unit + proc oracle(x : f_in): f_out +}. -module type Construction (H : H.RO) = { - proc init() : unit - proc hash(x : from1): to1 +(** 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 : Primitive) = { + proc init() : unit { P.init } + proc oracle(x : f_in): f_out { P.oracle } }. -module type Simulator (H : G.RO) = { - proc init() : unit - proc hash(x : from0): to0 +module type Simulator (F : Functionality) = { + proc init() : unit { F.init } + proc oracle(x : p_in): p_out { F.oracle } }. -module type Distinguisher (G : G.RO_, H : H.RO_) = { - proc distinguish(): bool +module type Distinguisher (F : Functionality, P : Primitive) = { + proc distinguish(): bool { P.oracle F.oracle } }. -module Indif (G : G.RO, H : H.RO, D : Distinguisher) = { - module D = D(G,H) +module Indif (F : Functionality, P : Primitive, D : Distinguisher) = { + module D = D(F,P) proc main(): bool = { var b; - G.init(); - H.init(); + P.init(); + F.init(); b = D.distinguish(); return b; } }. -(* A C <: Construction is indifferentiable from a random oracle if - there exists a P <: Simulator such that, for all D, - | Pr[Indif(C(G),G,D): res] - Pr[Indif(H,P(H),D): res] | is small - (where G and H are the concrete random oracles defined by d0 and d1) *) +(* (C <: Construction) applied to (P <: Primitive) is indifferentiable + from (F <: Functionality) if there exists (S <: Simulator) such + that, for all (D <: Distinguisher), + | Pr[Indif(C(P),P,D): res] - Pr[Indif(F,S(F),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/LazyRO.eca b/sha3/proof/LazyRO.eca new file mode 100644 index 0000000..10f9a64 --- /dev/null +++ b/sha3/proof/LazyRO.eca @@ -0,0 +1,20 @@ +require import Option NewFSet NewFMap. +require (*..*) RO. + +type from, to. +op d: to distr. + +clone import RO as Types with + type from <- from, + type to <- to. + +module H : RO, RO_ = { + var m : (from, to) fmap + + proc init(): unit = { m = map0; } + + proc hash(x : from): to = { + if (!mem (dom m) x) m.[x] = $d; + return oget m.[x]; + } +}. diff --git a/sha3/proof/RO.eca b/sha3/proof/RO.eca index 72ab948..b224703 100644 --- a/sha3/proof/RO.eca +++ b/sha3/proof/RO.eca @@ -2,8 +2,6 @@ require import NewFSet NewFMap. type from, to. -op d: from -> to distr. - module type RO = { proc init() : unit proc hash(x : from): to diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index bded7e6..1dbea52 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -1,8 +1,7 @@ -require import Option Pair Int ABitstring NewList. -require (*..*) AWord Indifferentiability. +require import Option Pair Int Real NewList NewFSet NewFMap. +require (*..*) AWord LazyRO IRO Indifferentiability. (* TODO: Clean up the Bitstring and Word theories -- Make use of those new versions. *) - (*...*) import Dprod. (* TODO: Datatype definitions and distributions should be properly separated and reorganized. *) @@ -35,34 +34,84 @@ proof leq0_length by smt. type state = block * capacity. +(** Ideal Functionality **) +clone import IRO as Functionality with + type from <- block list. + +(** The following is just lining up type definitions and defines the + Indifferentiability experiment. Importantly, it defines neither + ideal primitive nor ideal functionality: only their type. **) clone import Indifferentiability as Main with - type from0 <- state, - type to0 <- state, - op d0 <- fun (x:state) => dblock * dcapacity, - type from1 <- block list * int, - type to1 <- bitstring, - op d1 <- fun (x:block list * int) => DBitstring.dbitstring x.`2. - -module Sponge (H : H.RO): Construction(H) = { - proc init = H.init - - proc hash(p : block list, n : int): bitstring = { - var z = ABitstring.zeros n; + type p_in <- state, + type p_out <- state, + type f_in <- block list * int, + type f_out <- bool list. + +(** Ideal Primitive for the Random Transformation case **) +clone import LazyRO as Primitive with + type from <- state, + type to <- state, + op d <- dblock * dcapacity. + +(*** TODO: deal with these. + - bitstrings should have conversions to and from bool list + - the generic RO should be defined somewhere else + - lining up names and types should be easier than it is... ***) +op to_bits: block -> bool list. + +module RO_to_P (O : Types.RO) = { + proc init = O.init + proc oracle = O.hash +}. + +module IRO_to_F (O : IRO): Functionality = { + proc init = O.init + + (* proc oracle = O.hash + does not work because of input types not lining up... + I though this had been taken care of. *) + proc oracle(x : block list * int): bool list = { + var bs; + bs = O.hash(x.`1,x.`2); + return bs; + } +}. + +(** We can now define the sponge construction **) +module Sponge (P : Primitive): Construction(P) = { + proc init = P.init + + proc oracle(p : block list, n : int): bool list = { + var z; var s = (Block.zeros,Capacity.zeros); var i = 0; if (size p >= 1 /\ nth witness p (size p - 1) <> Block.zeros) { - z = ABitstring.zeros 0; + z = []; while (p <> []) { - s = H.hash(s.`1 ^ head witness p,s.`2); + s = P.oracle(s.`1 ^ head witness p,s.`2); p = behead p; } while (i < n/%r) { - z = z || (to_bits s.`1); - s = H.hash(s); + z = z ++ (Self.to_bits s.`1); (* Typing by constraint would be nice *) + s = P.oracle(s); } } - return sub z 0 n; + return take n z; } }. + +(** TODO: ftn is in fact a function of N + (number of queries to the primitive interface) **) +op ftn: real. + +module P = RO_to_P(Primitive.H). +module F = IRO_to_F(IRO). + +lemma TransformationLemma (D <: Distinguisher) &m: + exists (S <: Simulator), + `|Pr[Indif(Sponge(P),P,D).main() @ &m: res] + - Pr[Indif(F,S(F),D).main() @ &m: res]| + < ftn. +proof. admit. qed. From e75c9b53ceee3612505ea73607fafd171cd63f05 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 5 Mar 2015 18:06:10 +0100 Subject: [PATCH 005/394] Trying out `clone include` in anger. Identifying some possible improvements. --- sha3/proof/LazyRO.eca | 2 +- sha3/proof/RO.eca | 2 -- sha3/proof/Sponge.ec | 15 ++++++++------- 3 files changed, 9 insertions(+), 10 deletions(-) diff --git a/sha3/proof/LazyRO.eca b/sha3/proof/LazyRO.eca index 10f9a64..c8575f4 100644 --- a/sha3/proof/LazyRO.eca +++ b/sha3/proof/LazyRO.eca @@ -4,7 +4,7 @@ require (*..*) RO. type from, to. op d: to distr. -clone import RO as Types with +clone include RO with type from <- from, type to <- to. diff --git a/sha3/proof/RO.eca b/sha3/proof/RO.eca index b224703..5617647 100644 --- a/sha3/proof/RO.eca +++ b/sha3/proof/RO.eca @@ -1,5 +1,3 @@ -require import NewFSet NewFMap. - type from, to. module type RO = { diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 1dbea52..5ca5413 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -34,19 +34,19 @@ proof leq0_length by smt. type state = block * capacity. -(** Ideal Functionality **) -clone import IRO as Functionality with - type from <- block list. - (** The following is just lining up type definitions and defines the Indifferentiability experiment. Importantly, it defines neither ideal primitive nor ideal functionality: only their type. **) -clone import Indifferentiability as Main with +clone include Indifferentiability with type p_in <- state, type p_out <- state, type f_in <- block list * int, type f_out <- bool list. +(** Ideal Functionality **) +clone import IRO as Functionality with + type from <- block list. + (** Ideal Primitive for the Random Transformation case **) clone import LazyRO as Primitive with type from <- state, @@ -59,7 +59,7 @@ clone import LazyRO as Primitive with - lining up names and types should be easier than it is... ***) op to_bits: block -> bool list. -module RO_to_P (O : Types.RO) = { +module RO_to_P (O : RO) = { proc init = O.init proc oracle = O.hash }. @@ -109,7 +109,8 @@ op ftn: real. module P = RO_to_P(Primitive.H). module F = IRO_to_F(IRO). -lemma TransformationLemma (D <: Distinguisher) &m: +(* That Self is unfortunate *) +lemma TransformationLemma (D <: Self.Distinguisher) &m: exists (S <: Simulator), `|Pr[Indif(Sponge(P),P,D).main() @ &m: res] - Pr[Indif(F,S(F),D).main() @ &m: res]| From df846b06424667ba2e3a11cee449a11b7ee54a5c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 20 Aug 2015 10:28:26 +0200 Subject: [PATCH 006/394] Old minor stuff. --- sha3/proof/Sponge.ec | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 5ca5413..cbb602e 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -1,3 +1,5 @@ +pragma +Smt:lazy. + require import Option Pair Int Real NewList NewFSet NewFMap. require (*..*) AWord LazyRO IRO Indifferentiability. (* TODO: Clean up the Bitstring and Word theories @@ -88,10 +90,12 @@ module Sponge (P : Primitive): Construction(P) = { if (size p >= 1 /\ nth witness p (size p - 1) <> Block.zeros) { z = []; + (* Absorption *) while (p <> []) { s = P.oracle(s.`1 ^ head witness p,s.`2); p = behead p; } + (* Squeezing *) while (i < n/%r) { z = z ++ (Self.to_bits s.`1); (* Typing by constraint would be nice *) s = P.oracle(s); From 4e28afe0537f823f5deb7010012e89b24fddf25c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 20 Aug 2015 11:01:51 +0200 Subject: [PATCH 007/394] Updating syntax - moving to permutation simulator. --- sha3/proof/IRO.eca | 52 +++++++++-------------- sha3/proof/Indifferentiability.eca | 8 ++-- sha3/proof/LazyRO.eca | 4 +- sha3/proof/LazyRP.eca | 32 ++++++++++++++ sha3/proof/RO.eca | 12 +++--- sha3/proof/RP.eca | 26 ++++++++++++ sha3/proof/Sponge.ec | 67 +++++++++++++++++++----------- 7 files changed, 131 insertions(+), 70 deletions(-) create mode 100644 sha3/proof/LazyRP.eca create mode 100644 sha3/proof/RP.eca diff --git a/sha3/proof/IRO.eca b/sha3/proof/IRO.eca index 85ae9d1..07c2c25 100644 --- a/sha3/proof/IRO.eca +++ b/sha3/proof/IRO.eca @@ -1,6 +1,6 @@ -(* infinite random oracle: conceptually, its range consists of - infinite length bitstrings, all of whose bits are independently - chosen *) +(* infinite random oracle: it ranges over infinite length bitstrings, + all of whose bits are sampled uniformly and independently. We + obviously make it lazy. *) require import Option Int Bool NewList NewFMap NewFSet. @@ -9,45 +9,33 @@ type from. module type IRO = { proc init() : unit - (* hash x, returning the first n bits of the result *) - proc hash(x : from, n : int) : bool list + (* f x, returning the first n bits of the result *) + proc f(x : from, n : int) : bool list }. -op take : 'a list -> int -> 'a list. (* in NewFMap ... *) - module IRO : IRO = { var mp : (from, bool list) fmap - proc init() : unit = { - mp = map0; - } + proc init() = { mp = map0; } + + proc choose(n) = { + var b, bs; - proc choose(n : int) : bool list = { - var b : bool; - var bs : bool list; - bs = []; + bs <- []; while (n > 0) { - b = $Dbool.dbool; - bs = b :: bs; - n = n - 1; + b <$ Dbool.dbool; + bs <- b :: bs; + n <- n - 1; } return bs; } - proc hash(x : from, n : int) : bool list = { - var ys : bool list; - var zs : bool list; - if (! mem (dom mp) x) { - ys = choose(n); - mp.[x] = ys; - } - else { - ys = oget (mp.[x]); - if (n > size ys) { - zs = choose(n - size ys); - mp.[x] = ys ++ zs; - } - } - return take (oget mp.[x]) n; + proc f(x, n) = { + var ys, zs; + + ys <- odflt [] mp.[x]; + zs <@ choose (max 0 (n - size ys)); + mp.[x] <- ys ++ zs; + return take n (oget mp.[x]); } }. diff --git a/sha3/proof/Indifferentiability.eca b/sha3/proof/Indifferentiability.eca index 68101c0..ca782a8 100644 --- a/sha3/proof/Indifferentiability.eca +++ b/sha3/proof/Indifferentiability.eca @@ -35,14 +35,12 @@ module type Distinguisher (F : Functionality, P : Primitive) = { }. module Indif (F : Functionality, P : Primitive, D : Distinguisher) = { - module D = D(F,P) - proc main(): bool = { var b; - P.init(); - F.init(); - b = D.distinguish(); + P.init(); + F.init(); + b <@ D(F,P).distinguish(); return b; } }. diff --git a/sha3/proof/LazyRO.eca b/sha3/proof/LazyRO.eca index c8575f4..80d090c 100644 --- a/sha3/proof/LazyRO.eca +++ b/sha3/proof/LazyRO.eca @@ -11,9 +11,9 @@ clone include RO with module H : RO, RO_ = { var m : (from, to) fmap - proc init(): unit = { m = map0; } + proc init() = { m = map0; } - proc hash(x : from): to = { + proc f(x) = { if (!mem (dom m) x) m.[x] = $d; return oget m.[x]; } diff --git a/sha3/proof/LazyRP.eca b/sha3/proof/LazyRP.eca new file mode 100644 index 0000000..2752038 --- /dev/null +++ b/sha3/proof/LazyRP.eca @@ -0,0 +1,32 @@ +require import Option NewFSet NewFMap. +require (*..*) RP. + +type D. +op d: D distr. + +clone include RP with + type from <- D, + type to <- D. + +module P : RP, RP_ = { + var m : (D, D) fmap + var mi: (D, D) fmap + + proc init() = { m = map0; } + + proc f(x) = { + if (!mem (dom m) x) { + m.[x] <$ d; + mi.[oget m.[x]] <- x; + } + return oget m.[x]; + } + + proc fi(x) = { + if (!mem (dom mi) x) { + mi.[x] <$ d; + m.[oget m.[x]] <- x; + } + return oget mi.[x]; + } +}. diff --git a/sha3/proof/RO.eca b/sha3/proof/RO.eca index 5617647..3bf0d3b 100644 --- a/sha3/proof/RO.eca +++ b/sha3/proof/RO.eca @@ -1,12 +1,12 @@ type from, to. module type RO = { - proc init() : unit - proc hash(x : from): to + proc init() : unit + proc f(x : from): to }. module type RO_ = { - proc hash(x : from): to + proc f(x : from): to }. module type Distinguisher(G : RO_) = { @@ -14,13 +14,11 @@ module type Distinguisher(G : RO_) = { }. module IND(G:RO, D:Distinguisher) = { - module D = D(G) - proc main(): bool = { var b; - G.init(); - b = D.distinguish(); + G.init(); + b <@ D(G).distinguish(); return b; } }. diff --git a/sha3/proof/RP.eca b/sha3/proof/RP.eca new file mode 100644 index 0000000..eafe094 --- /dev/null +++ b/sha3/proof/RP.eca @@ -0,0 +1,26 @@ +type from, to. + +module type RP = { + proc init() : unit + proc f (x : from): to + proc fi(x : to ): from +}. + +module type RP_ = { + proc f (x : from): to + proc fi(x : to ): from +}. + +module type Distinguisher(G : RP_) = { + proc distinguish(): bool +}. + +module IND(G:RP, D:Distinguisher) = { + proc main(): bool = { + var b; + + G.init(); + b <@ D(G).distinguish(); + return b; + } +}. diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index cbb602e..60f06c8 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -1,18 +1,13 @@ -pragma +Smt:lazy. - require import Option Pair Int Real NewList NewFSet NewFMap. -require (*..*) AWord LazyRO IRO Indifferentiability. +require (*..*) AWord LazyRP IRO Indifferentiability. (* TODO: Clean up the Bitstring and Word theories -- Make use of those new versions. *) (*...*) import Dprod. (* TODO: Datatype definitions and distributions should be properly separated and reorganized. *) -op r : int. -axiom le0_r: 0 < r. - -op c : int. -axiom le0_c: 0 < c. +op r : { int | 0 < r } as lt0_r. +op c : { int | 0 < c } as lt0_c. (** Clarify assumptions on the distributions as we go. As this is currently written, we are hiding some pretty heavy axioms behind cloning. **) @@ -39,8 +34,25 @@ type state = block * capacity. (** The following is just lining up type definitions and defines the Indifferentiability experiment. Importantly, it defines neither ideal primitive nor ideal functionality: only their type. **) +type p_query = [ + | F of state + | Fi of state +]. + +op is_F (q : p_query) = + with q = F s => true + with q = Fi s => false. + +op is_Fi (q : p_query) = + with q = F s => false + with q = Fi s => true. + +op get_query (q : p_query) = + with q = F s => s + with q = Fi s => s. + clone include Indifferentiability with - type p_in <- state, + type p_in <- p_query, type p_out <- state, type f_in <- block list * int, type f_out <- bool list. @@ -50,9 +62,8 @@ clone import IRO as Functionality with type from <- block list. (** Ideal Primitive for the Random Transformation case **) -clone import LazyRO as Primitive with - type from <- state, - type to <- state, +clone import LazyRP as Primitive with + type D <- state, op d <- dblock * dcapacity. (*** TODO: deal with these. @@ -61,9 +72,18 @@ clone import LazyRO as Primitive with - lining up names and types should be easier than it is... ***) op to_bits: block -> bool list. -module RO_to_P (O : RO) = { +module RO_to_P (O : RP) = { proc init = O.init - proc oracle = O.hash + proc oracle(q : p_query) = { + var r; + + if (is_F q) { + r <@ O.f(get_query q); + } else { + r <@ O.fi(get_query q); + } + return r; + } }. module IRO_to_F (O : IRO): Functionality = { @@ -74,7 +94,7 @@ module IRO_to_F (O : IRO): Functionality = { I though this had been taken care of. *) proc oracle(x : block list * int): bool list = { var bs; - bs = O.hash(x.`1,x.`2); + bs = O.f(x.`1,x.`2); return bs; } }. @@ -84,21 +104,20 @@ module Sponge (P : Primitive): Construction(P) = { proc init = P.init proc oracle(p : block list, n : int): bool list = { - var z; - var s = (Block.zeros,Capacity.zeros); - var i = 0; + var z <- []; + var s <- (Block.zeros,Capacity.zeros); + var i <- 0; if (size p >= 1 /\ nth witness p (size p - 1) <> Block.zeros) { - z = []; (* Absorption *) while (p <> []) { - s = P.oracle(s.`1 ^ head witness p,s.`2); - p = behead p; + s <@ P.oracle(F (s.`1 ^ head witness p,s.`2)); + p <- behead p; } (* Squeezing *) while (i < n/%r) { - z = z ++ (Self.to_bits s.`1); (* Typing by constraint would be nice *) - s = P.oracle(s); + z <- z ++ (Self.to_bits s.`1); (* Typing by constraint would be nice *) + s <@ P.oracle(F s); } } @@ -110,7 +129,7 @@ module Sponge (P : Primitive): Construction(P) = { (number of queries to the primitive interface) **) op ftn: real. -module P = RO_to_P(Primitive.H). +module P = RO_to_P(Primitive.P). module F = IRO_to_F(IRO). (* That Self is unfortunate *) From 7be43df0d6e9972ac5c23f8bf12f3dc5d5cc421d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 24 Aug 2015 11:46:55 +0200 Subject: [PATCH 008/394] Bugfix in LazyRP (was not a permutation). Minor in other defs. --- sha3/proof/LazyRP.eca | 5 +++-- sha3/proof/Sponge.ec | 2 +- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/sha3/proof/LazyRP.eca b/sha3/proof/LazyRP.eca index 2752038..299a80c 100644 --- a/sha3/proof/LazyRP.eca +++ b/sha3/proof/LazyRP.eca @@ -1,4 +1,5 @@ require import Option NewFSet NewFMap. +require import Dexcepted. require (*..*) RP. type D. @@ -16,7 +17,7 @@ module P : RP, RP_ = { proc f(x) = { if (!mem (dom m) x) { - m.[x] <$ d; + m.[x] <$ d \ rng m; mi.[oget m.[x]] <- x; } return oget m.[x]; @@ -24,7 +25,7 @@ module P : RP, RP_ = { proc fi(x) = { if (!mem (dom mi) x) { - mi.[x] <$ d; + mi.[x] <$ d \ rng mi; m.[oget m.[x]] <- x; } return oget mi.[x]; diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 60f06c8..7340f61 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -100,7 +100,7 @@ module IRO_to_F (O : IRO): Functionality = { }. (** We can now define the sponge construction **) -module Sponge (P : Primitive): Construction(P) = { +module Sponge (P : Primitive): Construction(P), Functionality = { proc init = P.init proc oracle(p : block list, n : int): bool list = { From 3c8b90d58639100cf2c6da57b5dd6f23d7214c42 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 9 Sep 2015 19:24:01 +0200 Subject: [PATCH 009/394] Iterating on ec defs. --- sha3/proof/Sponge.ec | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 7340f61..365266a 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -72,7 +72,7 @@ clone import LazyRP as Primitive with - lining up names and types should be easier than it is... ***) op to_bits: block -> bool list. -module RO_to_P (O : RP) = { +module RP_to_P (O : RP) = { proc init = O.init proc oracle(q : p_query) = { var r; @@ -129,11 +129,11 @@ module Sponge (P : Primitive): Construction(P), Functionality = { (number of queries to the primitive interface) **) op ftn: real. -module P = RO_to_P(Primitive.P). +module P = RP_to_P(Primitive.P). module F = IRO_to_F(IRO). (* That Self is unfortunate *) -lemma TransformationLemma (D <: Self.Distinguisher) &m: +lemma PermutationLemma (D <: Self.Distinguisher) &m: exists (S <: Simulator), `|Pr[Indif(Sponge(P),P,D).main() @ &m: res] - Pr[Indif(F,S(F),D).main() @ &m: res]| From 7a46ee78a81046b4bd415a5c93cc48de6346f6a5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 10 Sep 2015 12:34:53 +0200 Subject: [PATCH 010/394] Misplaced file. --- sha3/proof/Squeezeless.ec | 177 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 177 insertions(+) create mode 100644 sha3/proof/Squeezeless.ec diff --git a/sha3/proof/Squeezeless.ec b/sha3/proof/Squeezeless.ec new file mode 100644 index 0000000..645ae30 --- /dev/null +++ b/sha3/proof/Squeezeless.ec @@ -0,0 +1,177 @@ +(** 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 Option Pair Int Real NewList NewFSet NewFMap. +require (*..*) AWord LazyRP LazyRO Indifferentiability. +(* TODO: Clean up the Bitstring and Word theories + -- Make use of those new versions. *) +(*...*) import Dprod. +(* TODO: Datatype definitions and distributions should + be properly separated and reorganized. *) + +op r : { int | 0 < r } as lt0_r. +op c : { int | 0 < c } as lt0_c. + +(** Clarify assumptions on the distributions as we go. As this is currently + written, we are hiding some pretty heavy axioms behind cloning. **) +type block. +op dblock: block distr. + +clone import AWord as Block with + op length <- r, + type word <- block, + op Dword.dword <- dblock +proof leq0_length by smt. + +type capacity. +op dcapacity: capacity distr. + +clone AWord as Capacity with + op length <- c, + type word <- capacity, + op Dword.dword <- dcapacity +proof leq0_length by smt. + +type state = block * capacity. +op dstate = dblock * dcapacity. + +(** The following is just lining up type definitions and defines the + Indifferentiability experiment. Importantly, it defines neither + ideal primitive nor ideal functionality: only their type. **) +type p_query = [ + | F of state + | Fi of state +]. + +op is_F (q : p_query) = + with q = F s => true + with q = Fi s => false. + +op is_Fi (q : p_query) = + with q = F s => false + with q = Fi s => true. + +op get_query (q : p_query) = + with q = F s => s + with q = Fi s => s. + +clone include Indifferentiability with + type p_in <- p_query, + type p_out <- state, + type f_in <- block list, + type f_out <- block. + +(** Ideal Functionality **) +clone import LazyRO as Functionality with + type from <- block list, + type to <- block, + op d <- dblock. + +(** Ideal Primitive for the Random Transformation case **) +clone import LazyRP as Primitive with + type D <- state, + op d <- dstate. + +(*** TODO: deal with these. + - bitstrings should have conversions to and from bool list + - the generic RO should be defined somewhere else + - lining up names and types should be easier than it is... ***) +op to_bits: block -> bool list. + +module RP_to_P (O : RP) = { + proc init = O.init + proc oracle(q : p_query) = { + var r; + + if (is_F q) { + r <@ O.f(get_query q); + } else { + r <@ O.fi(get_query q); + } + return r; + } +}. + +module RO_to_F (O : RO): Functionality = { + proc init = O.init + proc oracle = O.f +}. + +(** We can now define the squeezeless sponge construction **) +module SqueezelessSponge (P : Primitive): Construction(P), Functionality = { + proc init = P.init + + proc oracle(p : block list): block = { + var (sa,sc) <- (Block.zeros,Capacity.zeros); + + if (size p >= 1 /\ p <> [Block.zeros]) { + (* Absorption *) + while (p <> []) { + (sa,sc) <@ P.oracle(F (sa ^ head witness p,sc)); + p <- behead p; + } + } + return sa; + } +}. + +(** And the corresponding simulator **) +op find_chain: (state,state) fmap -> state -> (block list * block) option. + +module PreSimulator (F : Functionality) = { + var m, mi: (state,state) fmap + + proc init() = { + F.init(); + m <- map0; + mi <- map0; + } + + proc f(x:state) = { + var pvo, p, v, h, y; + + if (!mem (dom m) x) { + pvo <- find_chain m x; + if (pvo <> None) { + (p,v) <- oget pvo; + h <@ F.oracle(rcons p v); + y <$ dcapacity; + } else { + (h,y) <$ dstate; + } + m.[x] <- (h,y); + mi.[(h,y)] <- x; + } + return oget m.[x]; + } + + proc fi(x:state) = { + var y; + + if (!mem (dom mi) x) { + y <$ dstate; + mi.[x] <- y; + m.[y] <- x; + } + return oget mi.[x]; + } +}. + +module Simulator(F : Functionality) = RP_to_P(PreSimulator(F)). + +(** TODO: ftn is in fact a function of N + (number of queries to the primitive interface) **) +op ftn: real. + +module P = RP_to_P(Primitive.P). +module F = RO_to_F(H). + +(* That Self is unfortunate *) +lemma PermutationLemma: + exists (S <: Simulator), + forall (D <: Self.Distinguisher) &m, + `|Pr[Indif(SqueezelessSponge(P),P,D).main() @ &m: res] + - Pr[Indif(F,S(F),D).main() @ &m: res]| + < ftn. +proof. admit. qed. From a2d7f5fdd4dbb6dd998dd0cc8fbdc76110761a6c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 10 Sep 2015 12:55:36 +0200 Subject: [PATCH 011/394] Minor in proof. --- sha3/proof/Squeezeless.ec | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/sha3/proof/Squeezeless.ec b/sha3/proof/Squeezeless.ec index 645ae30..7fe9755 100644 --- a/sha3/proof/Squeezeless.ec +++ b/sha3/proof/Squeezeless.ec @@ -158,20 +158,15 @@ module PreSimulator (F : Functionality) = { } }. -module Simulator(F : Functionality) = RP_to_P(PreSimulator(F)). - -(** TODO: ftn is in fact a function of N - (number of queries to the primitive interface) **) -op ftn: real. - module P = RP_to_P(Primitive.P). module F = RO_to_F(H). +module S(F : Functionality) = RP_to_P(PreSimulator(F)). (* That Self is unfortunate *) lemma PermutationLemma: - exists (S <: Simulator), + exists epsilon, forall (D <: Self.Distinguisher) &m, `|Pr[Indif(SqueezelessSponge(P),P,D).main() @ &m: res] - Pr[Indif(F,S(F),D).main() @ &m: res]| - < ftn. + < epsilon. proof. admit. qed. From 3b02ef93906b69691bd85e2b53ecd0c6a76734e7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 15 Sep 2015 12:19:06 +0200 Subject: [PATCH 012/394] Cleanup and notes on the top-level arguments. --- sha3/proof/Sponge.ec | 125 ++++++++++++++++++++++++++++++++++++-- sha3/proof/Squeezeless.ec | 9 +-- 2 files changed, 123 insertions(+), 11 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 365266a..fc66d8f 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -1,5 +1,5 @@ require import Option Pair Int Real NewList NewFSet NewFMap. -require (*..*) AWord LazyRP IRO Indifferentiability. +require (*..*) AWord LazyRP IRO Indifferentiability Squeezeless. (* TODO: Clean up the Bitstring and Word theories -- Make use of those new versions. *) (*...*) import Dprod. @@ -132,10 +132,127 @@ op ftn: real. module P = RP_to_P(Primitive.P). module F = IRO_to_F(IRO). +clone import Squeezeless as Core with + op r <- r, + type block <- block, + op dblock <- dblock, + op c <- c, + type capacity <- capacity, + op dcapacity <- dcapacity, + (** The following should be dealt with by sub-theory instantiation, + but the sub-theories we instantiate are partially concrete **) + op Block.zeros <- Self.Block.zeros, + op Block.ones <- Self.Block.ones, + op Block.(^) <- Self.Block.(^), + op Block.land <- Self.Block.land, + op Block.to_bits <- Self.Block.to_bits, + op Block.from_bits <- Self.Block.from_bits, + op Block.to_int <- Self.Block.to_int, + op Block.from_int <- Self.Block.from_int, + op Capacity.zeros <- Self.Capacity.zeros, + op Capacity.ones <- Self.Capacity.ones, + op Capacity.(^) <- Self.Capacity.(^), + op Capacity.land <- Self.Capacity.land, + op Capacity.to_bits <- Self.Capacity.to_bits, + op Capacity.from_bits <- Self.Capacity.from_bits, + op Capacity.to_int <- Self.Capacity.to_int, + op Capacity.from_int <- Self.Capacity.from_int +proof *. + realize lt0_r by exact/lt0_r. + realize lt0_c by exact/lt0_c. + realize Block.ones_neq0 by exact/Self.Block.ones_neq0. + realize Block.xorwA by exact/Self.Block.xorwA. + realize Block.xorwC by exact/Self.Block.xorwC. + realize Block.xor0w by exact/Self.Block.xor0w. + realize Block.xorwK by exact/Self.Block.xorwK. + realize Block.landwA by exact/Self.Block.landwA. + realize Block.landwC by exact/Self.Block.landwC. + realize Block.land1w by exact/Self.Block.land1w. + realize Block.landwDl by exact/Self.Block.landwDl. + realize Block.landI by exact/Self.Block.landI. + realize Block.length_to_bits by exact/Self.Block.length_to_bits. + realize Block.can_from_to by exact/Self.Block.can_from_to. + realize Block.pcan_to_from by exact/Self.Block.pcan_to_from. + realize Block.to_from by exact/Self.Block.to_from. + realize Block.from_to by exact/Self.Block.from_to. + realize Block.Dword.mu_x_def by exact/Self.Block.Dword.mu_x_def. + realize Block.Dword.lossless by exact/Self.Block.Dword.lossless. + realize Capacity.ones_neq0 by exact/Self.Capacity.ones_neq0. + realize Capacity.xorwA by exact/Self.Capacity.xorwA. + realize Capacity.xorwC by exact/Self.Capacity.xorwC. + realize Capacity.xor0w by exact/Self.Capacity.xor0w. + realize Capacity.xorwK by exact/Self.Capacity.xorwK. + realize Capacity.landwA by exact/Self.Capacity.landwA. + realize Capacity.landwC by exact/Self.Capacity.landwC. + realize Capacity.land1w by exact/Self.Capacity.land1w. + realize Capacity.landwDl by exact/Self.Capacity.landwDl. + realize Capacity.landI by exact/Self.Capacity.landI. + realize Capacity.length_to_bits by exact/Self.Capacity.length_to_bits. + realize Capacity.can_from_to by exact/Self.Capacity.can_from_to. + realize Capacity.pcan_to_from by exact/Self.Capacity.pcan_to_from. + realize Capacity.to_from by exact/Self.Capacity.to_from. + realize Capacity.from_to by exact/Self.Capacity.from_to. + realize Capacity.Dword.mu_x_def by exact/Self.Capacity.Dword.mu_x_def. + realize Capacity.Dword.lossless by exact/Self.Capacity.Dword.lossless. +(* end of clone *) + +module type BlockSponge = { + proc init(): unit + proc oracle(p : block list, n : int): block list +}. + +module Squeezer(F : Core.Functionality): BlockSponge = { + proc init = F.init + + proc oracle(p : block list, n : int): block list = { + var z <- []; + var b; + var i <- 0; + + if (size p >= 1 /\ nth witness p (size p - 1) <> Self.Block.zeros) { + while (i < n) { + b <@ F.oracle(p ++ mkseq (fun i => Self.Block.zeros) i); + z <- rcons z b; + i <- i + 1; + } + } + + return z; + } +}. + +(* Result: if there exists a good simulator for the Core functionality + F, then we can construct a simulator for Squeezer(F) that has the + same differentiability advantage. + Note: We need to be careful and may need to make this whitebox so + we can avoid having to make too many queries. *) + +module Truncator(F : BlockSponge): Self.Functionality = { + proc init = F.init + + proc oracle(p : block list, n : int): bool list = { + var z <- []; + var bs; + + if (size p >= 1 /\ nth witness p ( size p - 1) <> Self.Block.zeros) { + bs <@ F.oracle(p,n /% r); + z <- z ++ flatten (map to_bits bs); + } + + return take n z; + } +}. + +(* Result: if there exists a good simulator for the BlockSponge F, + then we can construct a simulator for Truncator(F) that has the + same differentiability advantage. + Note: We need to be careful and may need to make this whitebox so + we can avoid having to make too many queries. *) + (* That Self is unfortunate *) -lemma PermutationLemma (D <: Self.Distinguisher) &m: - exists (S <: Simulator), +lemma PermutationLemma: exists (S <: Simulator), + forall (D <: Self.Distinguisher) &m, `|Pr[Indif(Sponge(P),P,D).main() @ &m: res] - Pr[Indif(F,S(F),D).main() @ &m: res]| < ftn. -proof. admit. qed. +proof. admit. qed. \ No newline at end of file diff --git a/sha3/proof/Squeezeless.ec b/sha3/proof/Squeezeless.ec index 7fe9755..a6a3151 100644 --- a/sha3/proof/Squeezeless.ec +++ b/sha3/proof/Squeezeless.ec @@ -74,11 +74,7 @@ clone import LazyRP as Primitive with op d <- dstate. (*** TODO: deal with these. - - bitstrings should have conversions to and from bool list - - the generic RO should be defined somewhere else - lining up names and types should be easier than it is... ***) -op to_bits: block -> bool list. - module RP_to_P (O : RP) = { proc init = O.init proc oracle(q : p_query) = { @@ -106,13 +102,12 @@ module SqueezelessSponge (P : Primitive): Construction(P), Functionality = { var (sa,sc) <- (Block.zeros,Capacity.zeros); if (size p >= 1 /\ p <> [Block.zeros]) { - (* Absorption *) - while (p <> []) { + while (p <> []) { (* Absorption *) (sa,sc) <@ P.oracle(F (sa ^ head witness p,sc)); p <- behead p; } } - return sa; + return sa; (* Squeezing phase (non-iterated) *) } }. From c4500bfed2042502f7fdf3fdcd73628e7a25fd6c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 15 Sep 2015 16:17:34 +0200 Subject: [PATCH 013/394] Fixing LazyRP. More defs for discussion support. --- sha3/proof/LazyRP.eca | 16 ++-- sha3/proof/Squeezeless.ec | 157 +++++++++++++++++++++++++++++++++++++- 2 files changed, 167 insertions(+), 6 deletions(-) diff --git a/sha3/proof/LazyRP.eca b/sha3/proof/LazyRP.eca index 299a80c..578ed7b 100644 --- a/sha3/proof/LazyRP.eca +++ b/sha3/proof/LazyRP.eca @@ -13,20 +13,26 @@ module P : RP, RP_ = { var m : (D, D) fmap var mi: (D, D) fmap - proc init() = { m = map0; } + proc init() = { m = map0; mi = map0; } proc f(x) = { + var y; + if (!mem (dom m) x) { - m.[x] <$ d \ rng m; - mi.[oget m.[x]] <- x; + y <$ d \ rng m; + m.[x] <- y; + mi.[y] <- x; } return oget m.[x]; } proc fi(x) = { + var y; + if (!mem (dom mi) x) { - mi.[x] <$ d \ rng mi; - m.[oget m.[x]] <- x; + y <$ d \ rng mi; + mi.[x] <- y; + m.[y] <- x; } return oget mi.[x]; } diff --git a/sha3/proof/Squeezeless.ec b/sha3/proof/Squeezeless.ec index a6a3151..e73acfa 100644 --- a/sha3/proof/Squeezeless.ec +++ b/sha3/proof/Squeezeless.ec @@ -6,7 +6,7 @@ require import Option Pair Int Real NewList NewFSet NewFMap. require (*..*) AWord LazyRP LazyRO Indifferentiability. (* TODO: Clean up the Bitstring and Word theories -- Make use of those new versions. *) -(*...*) import Dprod. +(*...*) import Dprod Dexcepted. (* TODO: Datatype definitions and distributions should be properly separated and reorganized. *) @@ -157,6 +157,161 @@ module P = RP_to_P(Primitive.P). module F = RO_to_F(H). module S(F : Functionality) = RP_to_P(PreSimulator(F)). +section. + declare module D : Self.Distinguisher {P, F, S, Indif}. + + (** Inlining oracles into the experiment for clarity **) + (* TODO: Drop init from the Distinguisher parameters' signatures *) + local module Ideal = { + var ro : (block list,block) fmap + var m, mi : (state,state) fmap + + module F = { + proc init(): unit = { } + + proc oracle(x : block list): block = { + if (!mem (dom ro) x) { + ro.[x] <$ dblock; + } + return oget ro.[x]; + } + } + + module S = { + proc init(): unit = { } + + proc f(x : state): state = { + var pvo, p, v, h, y; + + if (!mem (dom m) x) { + pvo <- find_chain m x; + if (pvo <> None) { + (p,v) <- oget pvo; + h <@ F.oracle(rcons p v); + y <$ dcapacity; + } else { + (h,y) <$ dstate; + } + m.[x] <- (h,y); + mi.[(h,y)] <- x; + } + return oget m.[x]; + } + + proc fi(x:state) = { + var y; + + if (!mem (dom mi) x) { + y <$ dstate; + mi.[x] <- y; + m.[y] <- x; + } + return oget mi.[x]; + } + + proc oracle(q : p_query): state = { + var r; + + if (is_F q) { + r <@ f(get_query q); + } else { + r <@ fi(get_query q); + } + return r; + } + } + + proc main(): bool = { + var b; + + ro <- map0; + m <- map0; + mi <- map0; + b <@ D(F,S).distinguish(); + return b; + } + }. + + local module Concrete = { + var m, mi: (state,state) fmap + + module P = { + proc init(): unit = { } + + proc f(x : state): state = { + var y; + + if (!mem (dom m) x) { + y <$ dstate \ (rng m); + m.[x] <- y; + mi.[y] <- x; + } + return oget m.[x]; + } + + proc fi(x : state): state = { + var y; + + if (!mem (dom mi) x) { + y <$ dstate \ (rng mi); + mi.[x] <- y; + m.[y] <- x; + } + return oget mi.[x]; + } + + proc oracle(q : p_query): state = { + var r; + + if (is_F q) { + r <@ f(get_query q); + } else { + r <@ fi(get_query q); + } + return r; + } + + } + + module C = { + proc init(): unit = { } + + proc oracle(p : block list): block = { + var (sa,sc) <- (Block.zeros,Capacity.zeros); + + if (size p >= 1 /\ p <> [Block.zeros]) { + while (p <> []) { (* Absorption *) + (sa,sc) <@ P.oracle(F (sa ^ head witness p,sc)); + p <- behead p; + } + } + return sa; (* Squeezing phase (non-iterated) *) + } + } + + proc main(): bool = { + var b; + + m <- map0; + mi <- map0; + b <@ D(C,P).distinguish(); + return b; + } + }. + + (** Result: The adversary's advantage in distinguishing the modular + defs if equal to that of distinguishing these **) + local lemma Inlined_pr &m: + `|Pr[Indif(SqueezelessSponge(P),P,D).main() @ &m: res] + - Pr[Indif(F,S(F),D).main() @ &m: res]| + = `|Pr[Concrete.main() @ &m: res] + - Pr[Ideal.main() @ &m: res]|. + proof. by do !congr; expect 2 (byequiv=> //=; proc; inline *; sim; auto). qed. + + (** And now for the interesting bits **) + (* ... *) +end section. + (* That Self is unfortunate *) lemma PermutationLemma: exists epsilon, From 738b5b06e2f5d26bc3fbb92600b62264d7a5e6ab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 16 Sep 2015 13:11:06 +0200 Subject: [PATCH 014/394] Guiding discussion further. Sticking to Canteaut et al for now. Need to reorganize bad events. --- sha3/proof/Squeezeless.ec | 212 +++++++++++++++++++++++++++++++++++++- sha3/proof/Utils.ec | 15 +++ 2 files changed, 224 insertions(+), 3 deletions(-) create mode 100644 sha3/proof/Utils.ec diff --git a/sha3/proof/Squeezeless.ec b/sha3/proof/Squeezeless.ec index e73acfa..82c74fc 100644 --- a/sha3/proof/Squeezeless.ec +++ b/sha3/proof/Squeezeless.ec @@ -2,7 +2,7 @@ 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 Option Pair Int Real NewList NewFSet NewFMap. +require import Fun Option Pair Int Real NewList NewFSet NewFMap Utils. require (*..*) AWord LazyRP LazyRO Indifferentiability. (* TODO: Clean up the Bitstring and Word theories -- Make use of those new versions. *) @@ -158,7 +158,7 @@ module F = RO_to_F(H). module S(F : Functionality) = RP_to_P(PreSimulator(F)). section. - declare module D : Self.Distinguisher {P, F, S, Indif}. + declare module D : Self.Distinguisher {P, F, S}. (** Inlining oracles into the experiment for clarity **) (* TODO: Drop init from the Distinguisher parameters' signatures *) @@ -309,7 +309,213 @@ section. proof. by do !congr; expect 2 (byequiv=> //=; proc; inline *; sim; auto). qed. (** And now for the interesting bits **) - (* ... *) + (** Inform the primitive interface of queries made by the + distinguisher on its functionality interface, keep track of + primitive call paths. **) + type caller = [ | I | D ]. + + op (<=) (o1 o2 : caller) = o1 = I \/ o2 = D. + + op max (o1 o2 : caller) = + with o1 = I => o2 + with o1 = D => D. + + local module InstrumentedConcrete = { + var m, mi : (state,caller * state) fmap + var paths : (capacity,caller * (block list * block)) fmap + var bext, bred : bool + var bcoll, bsuff, bmitm : bool + + module P = { + var m, mi : (state,state) fmap + + proc f(x : state): state = { + var y; + + if (!mem (dom m) x) { + y <$ dstate \ (rng m); + m.[x] <- y; + mi.[y] <- x; + } + return oget m.[x]; + } + + proc fi(x : state): state = { + var y; + + if (!mem (dom mi) x) { + y <$ dstate \ (rng mi); + mi.[x] <- y; + m.[y] <- x; + } + return oget mi.[x]; + } + } + + module S = { + (** Inner interface **) + proc f(o : caller, x : state): state = { + var o', y, pv, p, v; + + o' <- oapp fst D paths.[x.`2]; + bext <- bext \/ (o' <= o); + + if (!mem (dom m) x) { + y <@ P.f(x); + if (mem (dom paths) x.`2) { + (o',pv) <- oget paths.[x.`2]; + (p,v) <- pv; + bcoll <- bcoll \/ (mem (dom paths) y.`2); + bsuff <- bsuff \/ (mem (image (snd \o snd) (rng m)) y.`2); + paths.[y.`2] <- (max o o',(rcons p (v ^ x.`1),y.`1)); + } + m.[x] <- (o,y); + mi.[y] <- (o,x); + } else { + (o',y) <- oget m.[x]; + o' <- max o o'; + m.[x] <- (o',y); + mi.[y] <- (o',x); + } + return snd (oget m.[x]); + } + + proc fi(x : state): state = { + var o', y; + + if (!mem (dom mi) x) { + y <@ P.fi(x); + mi.[x] <- (D,y); + m.[y] <- (D,x); + bmitm <- bmitm \/ (mem (dom paths) y.`2); + } else { + (o',y) <- oget mi.[x]; + bred <- bred \/ o' = I; + mi.[x] <- (D,y); + m.[y] <- (D,x); + } + return snd (oget mi.[x]); + } + + (** Distinguisher interface **) + proc init() = { } + + proc oracle(q : p_query): state = { + var r; + + if (is_F q) { + r <@ f(D,get_query q); + } else { + r <@ fi(get_query q); + } + return r; + } + + } + + module C = { + proc init(): unit = { } + + proc oracle(p : block list): block = { + var (sa,sc) <- (Block.zeros,Capacity.zeros); + + if (size p >= 1 /\ p <> [Block.zeros]) { + while (p <> []) { + (sa,sc) <@ S.f(I,(sa ^ head witness p,sc)); + p <- behead p; + } + } + return sa; + } + } + + proc main(): bool = { + var b; + + P.m <- map0; + P.mi <- map0; + m <- map0; + mi <- map0; + paths <- map0; + bext <- false; + bred <- false; + bcoll <- false; + bsuff <- false; + bmitm <- false; + b <@ D(C,S).distinguish(); + return b; + } + }. + + (** Result: the instrumented system and the concrete system are + perfectly equivalent **) + (** This proof is done brutally because it is *just* program verification. *) + local equiv Instrumented_P_S_eq: + Concrete.P.f ~ InstrumentedConcrete.S.f: + arg{1} = arg{2}.`2 + /\ ={m,mi}(Concrete,InstrumentedConcrete.P) + /\ (forall x, InstrumentedConcrete.P.m.[x]{2} = omap snd (InstrumentedConcrete.m.[x]){2}) + /\ (forall x, InstrumentedConcrete.P.mi.[x]{2} = omap snd (InstrumentedConcrete.mi.[x]){2}) + /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x) + ==> ={res} + /\ ={m,mi}(Concrete,InstrumentedConcrete.P) + /\ (forall x, InstrumentedConcrete.P.m.[x]{2} = omap snd (InstrumentedConcrete.m.[x]){2}) + /\ (forall x, InstrumentedConcrete.P.mi.[x]{2} = omap snd (InstrumentedConcrete.mi.[x]){2}) + /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x). + proof. + proc. inline *. sp; if; 1:smt. + rcondt{2} 2; 1:by auto. + by auto; progress; expect 5 smt. + by auto; progress; expect 3 smt. + qed. + + local equiv Instrumented_Pi_Si_eq: + Concrete.P.fi ~ InstrumentedConcrete.S.fi: + ={arg} + /\ ={m,mi}(Concrete,InstrumentedConcrete.P) + /\ (forall x, InstrumentedConcrete.P.m.[x]{2} = omap snd (InstrumentedConcrete.m.[x]){2}) + /\ (forall x, InstrumentedConcrete.P.mi.[x]{2} = omap snd (InstrumentedConcrete.mi.[x]){2}) + /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x) + ==> ={res} + /\ ={m,mi}(Concrete,InstrumentedConcrete.P) + /\ (forall x, InstrumentedConcrete.P.m.[x]{2} = omap snd (InstrumentedConcrete.m.[x]){2}) + /\ (forall x, InstrumentedConcrete.P.mi.[x]{2} = omap snd (InstrumentedConcrete.mi.[x]){2}) + /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x). + proof. + proc. inline *. sp; if; 1:smt. + rcondt{2} 2; 1:by auto. + by auto; progress; expect 5 smt. + by auto; progress; expect 3 smt. + qed. + + local lemma Instrumented_pr &m: + `|Pr[Concrete.main() @ &m: res] + - Pr[Ideal.main() @ &m: res]| + = `|Pr[InstrumentedConcrete.main() @ &m: res] + - Pr[Ideal.main() @ &m: res]|. + proof. + do !congr. + byequiv=> //=. + proc. + call (_: ={m,mi}(Concrete,InstrumentedConcrete.P) + /\ (forall x, InstrumentedConcrete.P.m.[x]{2} = omap snd (InstrumentedConcrete.m.[x]){2}) + /\ (forall x, InstrumentedConcrete.P.mi.[x]{2} = omap snd (InstrumentedConcrete.mi.[x]){2}) + /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x)). + proc; if=> //=. + by call Instrumented_P_S_eq. + by call Instrumented_Pi_Si_eq. + proc. sp; if=> //=. + while ( ={sa,sc,p} + /\ ={m,mi}(Concrete,InstrumentedConcrete.P) + /\ (forall x, InstrumentedConcrete.P.m.[x]{2} = omap snd (InstrumentedConcrete.m.[x]){2}) + /\ (forall x, InstrumentedConcrete.P.mi.[x]{2} = omap snd (InstrumentedConcrete.mi.[x]){2}) + /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x)). + inline Concrete.P.oracle. rcondt{1} 2; 1:by auto. + wp; call Instrumented_P_S_eq. + by auto. + by auto. + by auto; smt. + qed. end section. (* That Self is unfortunate *) diff --git a/sha3/proof/Utils.ec b/sha3/proof/Utils.ec new file mode 100644 index 0000000..d9d7706 --- /dev/null +++ b/sha3/proof/Utils.ec @@ -0,0 +1,15 @@ +(** These should make it into the standard libs **) +require import NewList NewFSet. + +op image (f : 'a -> 'b) (X : 'a fset) = oflist (map f (elems X)) + axiomatized by imageE. + +lemma imageP (f : 'a -> 'b) (X : 'a fset) (b : 'b): + mem (image f X) b <=> exists a, mem X a /\ f a = b. +proof. + rewrite imageE mem_oflist mapP. + (* FIXME *) + by split=> [[a] [a_in_X b_def]| [a] [a_in_X b_def]]; + [rewrite -memE in a_in_X | rewrite memE in a_in_X]; + exists a; rewrite b_def. +qed. \ No newline at end of file From d44f4b94bf57630b9419fa1d1a3717e582055a48 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 16 Sep 2015 14:31:31 +0200 Subject: [PATCH 015/394] One less redundant data structure. --- sha3/proof/Squeezeless.ec | 139 ++++++++++++++++++++------------------ 1 file changed, 73 insertions(+), 66 deletions(-) diff --git a/sha3/proof/Squeezeless.ec b/sha3/proof/Squeezeless.ec index 82c74fc..8026ee7 100644 --- a/sha3/proof/Squeezeless.ec +++ b/sha3/proof/Squeezeless.ec @@ -311,7 +311,29 @@ section. (** And now for the interesting bits **) (** Inform the primitive interface of queries made by the distinguisher on its functionality interface, keep track of - primitive call paths. **) + primitive call paths in a coloured graph. **) + (** The following invariants should always hold at adversary + boundaries (they may be violated locally, but should always be + fixed (say, by setting bad) before returning control, and the + adversary should not be able to violate them himself): + - if paths[x] = (_,(p,v)), then following path p through m + from (0^r,0^c) leads to state (v,x); (in particular, this + implies (v,x) \in rng m; + - unless bad occurs (identify which ones), for every sc, there + is at most one sa such that (sa,sc) \in rng m; + - unless bad occurs (identify which ones), if paths[x] = + (o,(p,_)) and paths[x'] = (o',(p++p',_)), then o' <= o; + (todo: maybe change the direction of that order relation so + it corresponds to "order of appearance along paths"?) + + The next step in the proof will probably be to eagerly sample + all values of the rate and introduce some indirection on + capacities so that they are only sampled (and propagated) just + before being given to the adversary. This is much easier to do + if we always sample from the full type, but I can't seem to line + up the defs so that introducing the colouring doesn't mess the + "m{1} = omap snd m{2}" invariant. This is TODO. + **) type caller = [ | I | D ]. op (<=) (o1 o2 : caller) = o1 = I \/ o2 = D. @@ -320,38 +342,12 @@ section. with o1 = I => o2 with o1 = D => D. - local module InstrumentedConcrete = { + local module Game0 = { var m, mi : (state,caller * state) fmap var paths : (capacity,caller * (block list * block)) fmap var bext, bred : bool var bcoll, bsuff, bmitm : bool - module P = { - var m, mi : (state,state) fmap - - proc f(x : state): state = { - var y; - - if (!mem (dom m) x) { - y <$ dstate \ (rng m); - m.[x] <- y; - mi.[y] <- x; - } - return oget m.[x]; - } - - proc fi(x : state): state = { - var y; - - if (!mem (dom mi) x) { - y <$ dstate \ (rng mi); - mi.[x] <- y; - m.[y] <- x; - } - return oget mi.[x]; - } - } - module S = { (** Inner interface **) proc f(o : caller, x : state): state = { @@ -361,7 +357,7 @@ section. bext <- bext \/ (o' <= o); if (!mem (dom m) x) { - y <@ P.f(x); + y <$ dstate \ (image snd (rng m)); if (mem (dom paths) x.`2) { (o',pv) <- oget paths.[x.`2]; (p,v) <- pv; @@ -384,7 +380,7 @@ section. var o', y; if (!mem (dom mi) x) { - y <@ P.fi(x); + y <$ dstate \ (image snd (rng mi)); mi.[x] <- (D,y); m.[y] <- (D,x); bmitm <- bmitm \/ (mem (dom paths) y.`2); @@ -432,16 +428,15 @@ section. proc main(): bool = { var b; - P.m <- map0; - P.mi <- map0; m <- map0; mi <- map0; - paths <- map0; bext <- false; bred <- false; bcoll <- false; bsuff <- false; bmitm <- false; + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + paths <- map0.[Capacity.zeros <- (D,([<:block>],Block.zeros))]; b <@ D(C,S).distinguish(); return b; } @@ -450,68 +445,80 @@ section. (** Result: the instrumented system and the concrete system are perfectly equivalent **) (** This proof is done brutally because it is *just* program verification. *) - local equiv Instrumented_P_S_eq: - Concrete.P.f ~ InstrumentedConcrete.S.f: + local equiv Game0_P_S_eq: + Concrete.P.f ~ Game0.S.f: arg{1} = arg{2}.`2 - /\ ={m,mi}(Concrete,InstrumentedConcrete.P) - /\ (forall x, InstrumentedConcrete.P.m.[x]{2} = omap snd (InstrumentedConcrete.m.[x]){2}) - /\ (forall x, InstrumentedConcrete.P.mi.[x]{2} = omap snd (InstrumentedConcrete.mi.[x]){2}) + /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x) ==> ={res} - /\ ={m,mi}(Concrete,InstrumentedConcrete.P) - /\ (forall x, InstrumentedConcrete.P.m.[x]{2} = omap snd (InstrumentedConcrete.m.[x]){2}) - /\ (forall x, InstrumentedConcrete.P.mi.[x]{2} = omap snd (InstrumentedConcrete.mi.[x]){2}) + /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x). proof. - proc. inline *. sp; if; 1:smt. - rcondt{2} 2; 1:by auto. - by auto; progress; expect 5 smt. + proc. inline *. + conseq (_: x{1} = x{2} (* FIXME: conseq extend *) + /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) + /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x) + /\ image snd (rng Game0.m{2}) = rng Concrete.m{1} (* Helper *) + ==> _). + progress. apply fsetP=> x; rewrite imageP in_rng; split=> [[[o s]]|[t]]. + by rewrite in_rng /snd /= => [[t h] ->>] {s}; exists t; rewrite H h. + by rewrite H=> h; exists (oget Game0.m{2}.[t]); smt. + sp; if; 1:smt. + by auto; progress; expect 7 smt. by auto; progress; expect 3 smt. qed. - local equiv Instrumented_Pi_Si_eq: - Concrete.P.fi ~ InstrumentedConcrete.S.fi: + local equiv Game0_Pi_Si_eq: + Concrete.P.fi ~ Game0.S.fi: ={arg} - /\ ={m,mi}(Concrete,InstrumentedConcrete.P) - /\ (forall x, InstrumentedConcrete.P.m.[x]{2} = omap snd (InstrumentedConcrete.m.[x]){2}) - /\ (forall x, InstrumentedConcrete.P.mi.[x]{2} = omap snd (InstrumentedConcrete.mi.[x]){2}) + /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x) ==> ={res} - /\ ={m,mi}(Concrete,InstrumentedConcrete.P) - /\ (forall x, InstrumentedConcrete.P.m.[x]{2} = omap snd (InstrumentedConcrete.m.[x]){2}) - /\ (forall x, InstrumentedConcrete.P.mi.[x]{2} = omap snd (InstrumentedConcrete.mi.[x]){2}) + /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x). proof. - proc. inline *. sp; if; 1:smt. - rcondt{2} 2; 1:by auto. - by auto; progress; expect 5 smt. + proc. inline *. + conseq (_: x{1} = x{2} (* FIXME: conseq extend *) + /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) + /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x) + /\ image snd (rng Game0.mi{2}) = rng Concrete.mi{1} (* Helper *) + ==> _). + progress. apply fsetP=> x; rewrite imageP in_rng; split=> [[[o s]]|[t]]. + by rewrite in_rng /snd /= => [[t h] ->>] {s}; exists t; rewrite H0 h. + by rewrite H0=> h; exists (oget Game0.mi{2}.[t]); smt. + sp; if; 1:smt. + by auto; progress; expect 7 smt. by auto; progress; expect 3 smt. qed. - local lemma Instrumented_pr &m: + local lemma Game0_pr &m: `|Pr[Concrete.main() @ &m: res] - Pr[Ideal.main() @ &m: res]| - = `|Pr[InstrumentedConcrete.main() @ &m: res] + = `|Pr[Game0.main() @ &m: res] - Pr[Ideal.main() @ &m: res]|. proof. do !congr. byequiv=> //=. proc. - call (_: ={m,mi}(Concrete,InstrumentedConcrete.P) - /\ (forall x, InstrumentedConcrete.P.m.[x]{2} = omap snd (InstrumentedConcrete.m.[x]){2}) - /\ (forall x, InstrumentedConcrete.P.mi.[x]{2} = omap snd (InstrumentedConcrete.mi.[x]){2}) + call (_: (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x)). proc; if=> //=. - by call Instrumented_P_S_eq. - by call Instrumented_Pi_Si_eq. + by call Game0_P_S_eq. + by call Game0_Pi_Si_eq. proc. sp; if=> //=. while ( ={sa,sc,p} - /\ ={m,mi}(Concrete,InstrumentedConcrete.P) - /\ (forall x, InstrumentedConcrete.P.m.[x]{2} = omap snd (InstrumentedConcrete.m.[x]){2}) - /\ (forall x, InstrumentedConcrete.P.mi.[x]{2} = omap snd (InstrumentedConcrete.mi.[x]){2}) + /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x)). inline Concrete.P.oracle. rcondt{1} 2; 1:by auto. - wp; call Instrumented_P_S_eq. + wp; call Game0_P_S_eq. by auto. by auto. by auto; smt. From f47f1784d9fe23a77154eee744af82aea6c770ee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 16 Sep 2015 17:24:48 +0200 Subject: [PATCH 016/394] Moving away from permutation. Assumed RP_RF transition, plus modifications to Game0 to recover the invariant. --- sha3/proof/Squeezeless.ec | 171 +++++++++++++++++++++++++++----------- 1 file changed, 121 insertions(+), 50 deletions(-) diff --git a/sha3/proof/Squeezeless.ec b/sha3/proof/Squeezeless.ec index 8026ee7..dc26cae 100644 --- a/sha3/proof/Squeezeless.ec +++ b/sha3/proof/Squeezeless.ec @@ -308,6 +308,81 @@ section. - Pr[Ideal.main() @ &m: res]|. proof. by do !congr; expect 2 (byequiv=> //=; proc; inline *; sim; auto). qed. + (** An intermediate game where we don't care about the permutation + being a bijection anymore... **) + local module Concrete_F = { + var m, mi: (state,state) fmap + + module P = { + proc init(): unit = { } + + proc f(x : state): state = { + var y; + + if (!mem (dom m) x) { + y <$ dstate; + m.[x] <- y; + mi.[y] <- x; + } + return oget m.[x]; + } + + proc fi(x : state): state = { + var y; + + if (!mem (dom mi) x) { + y <$ dstate; + mi.[x] <- y; + m.[y] <- x; + } + return oget mi.[x]; + } + + proc oracle(q : p_query): state = { + var r; + + if (is_F q) { + r <@ f(get_query q); + } else { + r <@ fi(get_query q); + } + return r; + } + + } + + module C = { + proc init(): unit = { } + + proc oracle(p : block list): block = { + var (sa,sc) <- (Block.zeros,Capacity.zeros); + + if (size p >= 1 /\ p <> [Block.zeros]) { + while (p <> []) { (* Absorption *) + (sa,sc) <@ P.oracle(F (sa ^ head witness p,sc)); + p <- behead p; + } + } + return sa; (* Squeezing phase (non-iterated) *) + } + } + + proc main(): bool = { + var b; + + m <- map0; + mi <- map0; + b <@ D(C,P).distinguish(); + return b; + } + }. + + (** Result (expected): The distance between Concrete and Concrete_F + is bounded by N^2/|state|, where N is the total cost (in terms + of queries to P and P^-1) of the adversary's queries **) + + (** TODO: express and prove **) + (** And now for the interesting bits **) (** Inform the primitive interface of queries made by the distinguisher on its functionality interface, keep track of @@ -329,10 +404,9 @@ section. The next step in the proof will probably be to eagerly sample all values of the rate and introduce some indirection on capacities so that they are only sampled (and propagated) just - before being given to the adversary. This is much easier to do - if we always sample from the full type, but I can't seem to line - up the defs so that introducing the colouring doesn't mess the - "m{1} = omap snd m{2}" invariant. This is TODO. + before being given to the adversary. This is easier to do if all + samplings are independent, hence the move away from a random + permutation. Some side-effects remain worrying. **) type caller = [ | I | D ]. @@ -351,13 +425,13 @@ section. module S = { (** Inner interface **) proc f(o : caller, x : state): state = { - var o', y, pv, p, v; + var o', y, pv, p, v, x'; o' <- oapp fst D paths.[x.`2]; bext <- bext \/ (o' <= o); if (!mem (dom m) x) { - y <$ dstate \ (image snd (rng m)); + y <$ dstate; if (mem (dom paths) x.`2) { (o',pv) <- oget paths.[x.`2]; (p,v) <- pv; @@ -368,27 +442,32 @@ section. m.[x] <- (o,y); mi.[y] <- (o,x); } else { - (o',y) <- oget m.[x]; - o' <- max o o'; - m.[x] <- (o',y); - mi.[y] <- (o',x); + (o',y) <- oget m.[x]; + m.[x] <- (max o o',y); + if (mem (dom mi) y) { + (o',x') <- oget mi.[y]; + mi.[y] <- (max o o',x'); + } } return snd (oget m.[x]); } proc fi(x : state): state = { - var o', y; + var o', y, x'; if (!mem (dom mi) x) { - y <$ dstate \ (image snd (rng mi)); + y <$ dstate; mi.[x] <- (D,y); m.[y] <- (D,x); bmitm <- bmitm \/ (mem (dom paths) y.`2); } else { - (o',y) <- oget mi.[x]; - bred <- bred \/ o' = I; - mi.[x] <- (D,y); - m.[y] <- (D,x); + (o',y) <- oget mi.[x]; + bred <- bred \/ o' = I; + mi.[x] <- (D,y); + if (mem (dom m) y) { + (o',x') <- oget m.[y]; + m.[y] <- (D,x'); + } } return snd (oget mi.[x]); } @@ -446,59 +525,53 @@ section. perfectly equivalent **) (** This proof is done brutally because it is *just* program verification. *) local equiv Game0_P_S_eq: - Concrete.P.f ~ Game0.S.f: + Concrete_F.P.f ~ Game0.S.f: arg{1} = arg{2}.`2 - /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x) + /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) ==> ={res} - /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x). + /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}). proof. proc. inline *. conseq (_: x{1} = x{2} (* FIXME: conseq extend *) - /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x) - /\ image snd (rng Game0.m{2}) = rng Concrete.m{1} (* Helper *) + /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) + /\ image snd (rng Game0.m{2}) = rng Concrete_F.m{1} (* Helper *) ==> _). progress. apply fsetP=> x; rewrite imageP in_rng; split=> [[[o s]]|[t]]. by rewrite in_rng /snd /= => [[t h] ->>] {s}; exists t; rewrite H h. by rewrite H=> h; exists (oget Game0.m{2}.[t]); smt. sp; if; 1:smt. - by auto; progress; expect 7 smt. - by auto; progress; expect 3 smt. + by auto; progress; expect 3 smt. + by auto; progress; expect 5 smt. qed. local equiv Game0_Pi_Si_eq: - Concrete.P.fi ~ Game0.S.fi: + Concrete_F.P.fi ~ Game0.S.fi: ={arg} - /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x) + /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) ==> ={res} - /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x). + /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}). proof. proc. inline *. conseq (_: x{1} = x{2} (* FIXME: conseq extend *) - /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x) - /\ image snd (rng Game0.mi{2}) = rng Concrete.mi{1} (* Helper *) + /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) + /\ image snd (rng Game0.mi{2}) = rng Concrete_F.mi{1} (* Helper *) ==> _). progress. apply fsetP=> x; rewrite imageP in_rng; split=> [[[o s]]|[t]]. by rewrite in_rng /snd /= => [[t h] ->>] {s}; exists t; rewrite H0 h. by rewrite H0=> h; exists (oget Game0.mi{2}.[t]); smt. sp; if; 1:smt. - by auto; progress; expect 7 smt. - by auto; progress; expect 3 smt. + by auto; progress; expect 3 smt. + by auto; progress; expect 5 smt. qed. local lemma Game0_pr &m: - `|Pr[Concrete.main() @ &m: res] + `|Pr[Concrete_F.main() @ &m: res] - Pr[Ideal.main() @ &m: res]| = `|Pr[Game0.main() @ &m: res] - Pr[Ideal.main() @ &m: res]|. @@ -506,18 +579,16 @@ section. do !congr. byequiv=> //=. proc. - call (_: (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x)). + call (_: (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2})). proc; if=> //=. by call Game0_P_S_eq. by call Game0_Pi_Si_eq. proc. sp; if=> //=. while ( ={sa,sc,p} - /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x)). - inline Concrete.P.oracle. rcondt{1} 2; 1:by auto. + /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2})). + inline Concrete_F.P.oracle. rcondt{1} 2; 1:by auto. wp; call Game0_P_S_eq. by auto. by auto. From 29eb29cf5e505821c11d14f00f5c7dd1462d3155 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 17 Sep 2015 14:12:05 +0200 Subject: [PATCH 017/394] Game0: refining the invariant slightly to simplify book keeping code. --- sha3/proof/Squeezeless.ec | 68 ++++++++++++++++++++++++++++++--------- sha3/proof/Utils.ec | 20 ++++++++++-- 2 files changed, 70 insertions(+), 18 deletions(-) diff --git a/sha3/proof/Squeezeless.ec b/sha3/proof/Squeezeless.ec index dc26cae..86b4fbd 100644 --- a/sha3/proof/Squeezeless.ec +++ b/sha3/proof/Squeezeless.ec @@ -444,10 +444,8 @@ section. } else { (o',y) <- oget m.[x]; m.[x] <- (max o o',y); - if (mem (dom mi) y) { - (o',x') <- oget mi.[y]; - mi.[y] <- (max o o',x'); - } + (o',x') <- oget mi.[y]; + mi.[y] <- (max o o',x'); } return snd (oget m.[x]); } @@ -464,10 +462,8 @@ section. (o',y) <- oget mi.[x]; bred <- bred \/ o' = I; mi.[x] <- (D,y); - if (mem (dom m) y) { - (o',x') <- oget m.[y]; - m.[y] <- (D,x'); - } + (o',x') <- oget m.[y]; + m.[y] <- (D,x'); } return snd (oget mi.[x]); } @@ -529,22 +525,40 @@ section. arg{1} = arg{2}.`2 /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) + /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) + /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x) ==> ={res} /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}). + /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) + /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) + /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x). proof. proc. inline *. conseq (_: x{1} = x{2} (* FIXME: conseq extend *) /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) + /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) + /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x) /\ image snd (rng Game0.m{2}) = rng Concrete_F.m{1} (* Helper *) ==> _). progress. apply fsetP=> x; rewrite imageP in_rng; split=> [[[o s]]|[t]]. by rewrite in_rng /snd /= => [[t h] ->>] {s}; exists t; rewrite H h. by rewrite H=> h; exists (oget Game0.m{2}.[t]); smt. sp; if; 1:smt. - by auto; progress; expect 3 smt. - by auto; progress; expect 5 smt. + auto; progress; first 3 smt. + + by move: H7; rewrite domP rng_set !in_fsetU !in_fset1 rem_id // => [/H1 ->|->]. + move: H7; rewrite rng_set domP !in_fsetU !in_fset1; case (x0 = x{2})=> [->> //|x0_neq_x /=]. + + by move=> h; apply/H2/(rng_rem_le yL). + auto; progress; first 2 smt. + (** FIXME: Refine the invariant enough that the following becomes easier to prove? **) + have ->: (oget Game0.m.[x]){2}.`2 = oget Concrete_F.m{1}.[x{2}] by smt. + move: H4; rewrite in_dom. + case {-1}(Concrete_F.m{1}.[x{2}]) (eq_refl Concrete_F.m{1}.[x{2}])=> //= x' h. + rewrite/(oget (Some _))/=. + have ->: (oget Game0.mi.[x']){2}.`2 = oget Concrete_F.mi{1}.[x'] by smt. + rewrite getP; case (x0 = x')=> [<<-/=|/= _]. + by rewrite /snd /=; smt. (* x0 \in dom mi{1} (by H1 and h) *) + exact/H0. qed. local equiv Game0_Pi_Si_eq: @@ -552,22 +566,40 @@ section. ={arg} /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) + /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) + /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x) ==> ={res} /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}). + /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) + /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) + /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x). proof. proc. inline *. conseq (_: x{1} = x{2} (* FIXME: conseq extend *) /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) + /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) + /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x) /\ image snd (rng Game0.mi{2}) = rng Concrete_F.mi{1} (* Helper *) ==> _). progress. apply fsetP=> x; rewrite imageP in_rng; split=> [[[o s]]|[t]]. by rewrite in_rng /snd /= => [[t h] ->>] {s}; exists t; rewrite H0 h. by rewrite H0=> h; exists (oget Game0.mi{2}.[t]); smt. sp; if; 1:smt. - by auto; progress; expect 3 smt. - by auto; progress; expect 5 smt. + auto; progress; first 3 by smt. + + move: H7; rewrite domP rng_set !in_fsetU !in_fset1; case (x0 = x{2})=> [->> //|x0_neq_x /=]. + by move=> h; apply/H1/(rng_rem_le yL). + + by move: H7; rewrite domP rng_set !in_fsetU !in_fset1 rem_id // => [/H2 ->|->]. + auto; progress; 1,3:smt. + (** FIXME: Refine the invariant enough that the following becomes easier to prove? **) + have ->: (oget Game0.mi.[x]){2}.`2 = oget Concrete_F.mi{1}.[x{2}] by smt. + move: H4; rewrite in_dom. + case {-1}(Concrete_F.mi{1}.[x{2}]) (eq_refl Concrete_F.mi{1}.[x{2}])=> //= x' h. + rewrite/(oget (Some _))/=. + have ->: (oget Game0.m.[x']){2}.`2 = oget Concrete_F.m{1}.[x'] by smt. + rewrite getP; case (x0 = x')=> [<<-/=|/= _]. + by rewrite /snd /=; smt. (* x0 \in dom mi{1} (by H1 and h) *) + exact/H. qed. local lemma Game0_pr &m: @@ -580,14 +612,18 @@ section. byequiv=> //=. proc. call (_: (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2})). + /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) + /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) + /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x)). proc; if=> //=. by call Game0_P_S_eq. by call Game0_Pi_Si_eq. proc. sp; if=> //=. while ( ={sa,sc,p} /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2})). + /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) + /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) + /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x)). inline Concrete_F.P.oracle. rcondt{1} 2; 1:by auto. wp; call Game0_P_S_eq. by auto. diff --git a/sha3/proof/Utils.ec b/sha3/proof/Utils.ec index d9d7706..573c8c6 100644 --- a/sha3/proof/Utils.ec +++ b/sha3/proof/Utils.ec @@ -1,5 +1,5 @@ (** These should make it into the standard libs **) -require import NewList NewFSet. +require import NewList NewFSet NewFMap. op image (f : 'a -> 'b) (X : 'a fset) = oflist (map f (elems X)) axiomatized by imageE. @@ -12,4 +12,20 @@ proof. by split=> [[a] [a_in_X b_def]| [a] [a_in_X b_def]]; [rewrite -memE in a_in_X | rewrite memE in a_in_X]; exists a; rewrite b_def. -qed. \ No newline at end of file +qed. + +lemma rem_id (x : 'a) (m : ('a,'b) fmap): + !mem (dom m) x => rem x m = m. +proof. + rewrite in_dom /= => x_notin_m; apply/fmapP=> x'; rewrite remP. + case (x' = x)=> //= ->>. + by rewrite x_notin_m. +qed. + +lemma dom_rem_le (x : 'a) (m : ('a,'b) fmap) (x' : 'a): + mem (dom (rem x m)) x' => mem (dom m) x'. +proof. by rewrite dom_rem in_fsetD. qed. + +lemma rng_rem_le (x : 'a) (m : ('a,'b) fmap) (x' : 'b): + mem (rng (rem x m)) x' => mem (rng m) x'. +proof. by rewrite rng_rm in_rng=> [x0] [_ h]; exists x0. qed. From a2f4b0c0cbcb3b1a5a937f0728d62da7ce28b8af Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 21 Sep 2015 15:01:29 +0200 Subject: [PATCH 018/394] SHA3: splitting maps for fun and profit. - Completely separated the map associating query origin to query; - Proved equivalence of simulator with split rate and capacity maps. The second point above should allow us to easily pre-sample all rates (visible by both adversary and ideal functionality), and use indirections for capacities. Such indirections should then allow us to perform eager sampling on capacities. --- sha3/proof/Squeezeless.ec | 407 +++++++++++++++++++++++++++----------- 1 file changed, 293 insertions(+), 114 deletions(-) diff --git a/sha3/proof/Squeezeless.ec b/sha3/proof/Squeezeless.ec index 86b4fbd..aa9cb5e 100644 --- a/sha3/proof/Squeezeless.ec +++ b/sha3/proof/Squeezeless.ec @@ -300,7 +300,7 @@ section. }. (** Result: The adversary's advantage in distinguishing the modular - defs if equal to that of distinguishing these **) + defs is equal to that of distinguishing these **) local lemma Inlined_pr &m: `|Pr[Indif(SqueezelessSponge(P),P,D).main() @ &m: res] - Pr[Indif(F,S(F),D).main() @ &m: res]| @@ -416,56 +416,86 @@ section. with o1 = I => o2 with o1 = D => D. + pred is_pre_permutation (m mi : ('a,'a) fmap) = + (forall x, mem (rng m) x => mem (dom mi) x) + /\ (forall x, mem (rng mi) x => mem (dom m) x). + + lemma half_permutation_set (m' mi' : ('a,'a) fmap) x' y': + (forall x, mem (rng m') x => mem (dom mi') x) + => (forall x, mem (rng m'.[x' <- y']) x => mem (dom mi'.[y' <- x']) x). + proof. + move=> h x0. + rewrite rng_set domP !in_fsetU in_fset1 => [/rng_rem_le in_rng|//=]. + by rewrite h. + 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. + local module Game0 = { - var m, mi : (state,caller * state) fmap - var paths : (capacity,caller * (block list * block)) fmap + var m, mi : (state,state) fmap + var mcol, micol : (state,caller) fmap (* colouring maps for m, mi *) + var paths : (capacity,block list * block) fmap + var pathscol : (capacity,caller) fmap (* colouring maps for paths *) var bext, bred : bool var bcoll, bsuff, bmitm : bool module S = { (** Inner interface **) proc f(o : caller, x : state): state = { - var o', y, pv, p, v, x'; + var o', y, pv, p, v; - o' <- oapp fst D paths.[x.`2]; + o' <- odflt D pathscol.[x.`2]; bext <- bext \/ (o' <= o); if (!mem (dom m) x) { y <$ dstate; if (mem (dom paths) x.`2) { - (o',pv) <- oget paths.[x.`2]; - (p,v) <- pv; - bcoll <- bcoll \/ (mem (dom paths) y.`2); - bsuff <- bsuff \/ (mem (image (snd \o snd) (rng m)) y.`2); - paths.[y.`2] <- (max o o',(rcons p (v ^ x.`1),y.`1)); + o' <- oget pathscol.[x.`2]; + pv <- oget paths.[x.`2]; + (p,v) <- pv; + bcoll <- bcoll \/ (mem (dom paths) y.`2); + bsuff <- bsuff \/ (mem (image snd (rng m)) y.`2); + pathscol.[y.`2] <- max o o'; + paths.[y.`2] <- (rcons p (v ^ x.`1),y.`1); } - m.[x] <- (o,y); - mi.[y] <- (o,x); + mcol.[x] <- o; + m.[x] <- y; + micol.[y] <- o; + mi.[y] <- x; } else { - (o',y) <- oget m.[x]; - m.[x] <- (max o o',y); - (o',x') <- oget mi.[y]; - mi.[y] <- (max o o',x'); + o' <- oget mcol.[x]; + mcol.[x] <- max o o'; + y <- oget m.[x]; + o' <- oget micol.[y]; + micol.[y] <- max o o'; } - return snd (oget m.[x]); + return oget m.[x]; } proc fi(x : state): state = { - var o', y, x'; + var o', y; if (!mem (dom mi) x) { y <$ dstate; - mi.[x] <- (D,y); - m.[y] <- (D,x); - bmitm <- bmitm \/ (mem (dom paths) y.`2); + micol.[x] <- D; + mi.[x] <- y; + mcol.[y] <- D; + m.[y] <- x; + bmitm <- bmitm \/ (mem (dom paths) y.`2); } else { - (o',y) <- oget mi.[x]; - bred <- bred \/ o' = I; - mi.[x] <- (D,y); - (o',x') <- oget m.[y]; - m.[y] <- (D,x'); + o' <- oget micol.[x]; + bred <- bred \/ o' = I; + y <- oget mi.[x]; + micol.[x] <- D; + mcol.[y] <- D; } - return snd (oget mi.[x]); + return oget mi.[x]; } (** Distinguisher interface **) @@ -503,103 +533,53 @@ section. proc main(): bool = { var b; - m <- map0; - mi <- map0; - bext <- false; - bred <- false; - bcoll <- false; - bsuff <- false; - bmitm <- false; + mcol <- map0; + m <- map0; + micol <- map0; + mi <- map0; + bext <- false; + bred <- false; + bcoll <- false; + bsuff <- false; + bmitm <- false; (* the empty path is initially known by the adversary to lead to capacity 0^c *) - paths <- map0.[Capacity.zeros <- (D,([<:block>],Block.zeros))]; - b <@ D(C,S).distinguish(); + pathscol <- map0.[Capacity.zeros <- D]; + paths <- map0.[Capacity.zeros <- ([<:block>],Block.zeros)]; + b <@ D(C,S).distinguish(); return b; } }. (** Result: the instrumented system and the concrete system are perfectly equivalent **) - (** This proof is done brutally because it is *just* program verification. *) local equiv Game0_P_S_eq: Concrete_F.P.f ~ Game0.S.f: arg{1} = arg{2}.`2 - /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) - /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x) + /\ ={m,mi}(Concrete_F,Game0) + /\ is_pre_permutation (Concrete_F.m){1} (Concrete_F.mi){1} ==> ={res} - /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) - /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x). + /\ ={m,mi}(Concrete_F,Game0) + /\ is_pre_permutation (Concrete_F.m){1} (Concrete_F.mi){1}. proof. proc. inline *. - conseq (_: x{1} = x{2} (* FIXME: conseq extend *) - /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) - /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x) - /\ image snd (rng Game0.m{2}) = rng Concrete_F.m{1} (* Helper *) - ==> _). - progress. apply fsetP=> x; rewrite imageP in_rng; split=> [[[o s]]|[t]]. - by rewrite in_rng /snd /= => [[t h] ->>] {s}; exists t; rewrite H h. - by rewrite H=> h; exists (oget Game0.m{2}.[t]); smt. - sp; if; 1:smt. - auto; progress; first 3 smt. - + by move: H7; rewrite domP rng_set !in_fsetU !in_fset1 rem_id // => [/H1 ->|->]. - move: H7; rewrite rng_set domP !in_fsetU !in_fset1; case (x0 = x{2})=> [->> //|x0_neq_x /=]. - + by move=> h; apply/H2/(rng_rem_le yL). - auto; progress; first 2 smt. - (** FIXME: Refine the invariant enough that the following becomes easier to prove? **) - have ->: (oget Game0.m.[x]){2}.`2 = oget Concrete_F.m{1}.[x{2}] by smt. - move: H4; rewrite in_dom. - case {-1}(Concrete_F.m{1}.[x{2}]) (eq_refl Concrete_F.m{1}.[x{2}])=> //= x' h. - rewrite/(oget (Some _))/=. - have ->: (oget Game0.mi.[x']){2}.`2 = oget Concrete_F.mi{1}.[x'] by smt. - rewrite getP; case (x0 = x')=> [<<-/=|/= _]. - by rewrite /snd /=; smt. (* x0 \in dom mi{1} (by H1 and h) *) - exact/H0. + sp; if=> //=; 2:by auto. + auto; progress [-split]. + by rewrite pre_permutation_set. qed. local equiv Game0_Pi_Si_eq: Concrete_F.P.fi ~ Game0.S.fi: ={arg} - /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) - /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x) + /\ ={m,mi}(Concrete_F,Game0) + /\ is_pre_permutation (Concrete_F.m){1} (Concrete_F.mi){1} ==> ={res} - /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) - /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x). + /\ ={m,mi}(Concrete_F,Game0) + /\ is_pre_permutation (Concrete_F.m){1} (Concrete_F.mi){1}. proof. proc. inline *. - conseq (_: x{1} = x{2} (* FIXME: conseq extend *) - /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) - /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x) - /\ image snd (rng Game0.mi{2}) = rng Concrete_F.mi{1} (* Helper *) - ==> _). - progress. apply fsetP=> x; rewrite imageP in_rng; split=> [[[o s]]|[t]]. - by rewrite in_rng /snd /= => [[t h] ->>] {s}; exists t; rewrite H0 h. - by rewrite H0=> h; exists (oget Game0.mi{2}.[t]); smt. - sp; if; 1:smt. - auto; progress; first 3 by smt. - + move: H7; rewrite domP rng_set !in_fsetU !in_fset1; case (x0 = x{2})=> [->> //|x0_neq_x /=]. - by move=> h; apply/H1/(rng_rem_le yL). - + by move: H7; rewrite domP rng_set !in_fsetU !in_fset1 rem_id // => [/H2 ->|->]. - auto; progress; 1,3:smt. - (** FIXME: Refine the invariant enough that the following becomes easier to prove? **) - have ->: (oget Game0.mi.[x]){2}.`2 = oget Concrete_F.mi{1}.[x{2}] by smt. - move: H4; rewrite in_dom. - case {-1}(Concrete_F.mi{1}.[x{2}]) (eq_refl Concrete_F.mi{1}.[x{2}])=> //= x' h. - rewrite/(oget (Some _))/=. - have ->: (oget Game0.m.[x']){2}.`2 = oget Concrete_F.m{1}.[x'] by smt. - rewrite getP; case (x0 = x')=> [<<-/=|/= _]. - by rewrite /snd /=; smt. (* x0 \in dom mi{1} (by H1 and h) *) - exact/H. + sp; if=> //=; 2:by auto. + auto; progress [-split]. + by rewrite pre_permutation_set. qed. local lemma Game0_pr &m: @@ -611,25 +591,224 @@ section. do !congr. byequiv=> //=. proc. - call (_: (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) - /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x)). + call (_: ={m,mi}(Concrete_F,Game0) + /\ is_pre_permutation Concrete_F.m{1} Concrete_F.mi{1}). proc; if=> //=. - by call Game0_P_S_eq. - by call Game0_Pi_Si_eq. - proc. sp; if=> //=. + + by call Game0_P_S_eq. + + by call Game0_Pi_Si_eq. + + proc. sp; if=> //=. while ( ={sa,sc,p} - /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) - /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x)). + /\ ={m,mi}(Concrete_F,Game0) + /\ is_pre_permutation Concrete_F.m{1} Concrete_F.mi{1}). inline Concrete_F.P.oracle. rcondt{1} 2; 1:by auto. wp; call Game0_P_S_eq. by auto. by auto. by auto; smt. qed. + + (** Split the simulator map into distinct rate and capacity maps **) + pred map_split (m0 : (state,state) fmap) (a1 : (state,block) fmap) (c1 : (state,capacity) fmap) = + (forall x, mem (dom m0) x = mem (dom a1) x) + /\ (forall x, mem (dom m0) x = mem (dom c1) x) + /\ (forall x, mem (dom m0) x => m0.[x] = Some (oget a1.[x],oget c1.[x])). + + lemma map_split_set m0 a1 c1 s a c: + map_split m0 a1 c1 => + map_split m0.[s <- (a,c)] a1.[s <- a] c1.[s <- c] + by []. + + local module Game1 = { + var mcol,micol : (state,caller) fmap + var rate, ratei : (state,block) fmap + var cap, capi : (state,capacity) fmap + var pathscol : (capacity,caller) fmap + var paths : (capacity,block list * block) fmap + var bext, bred : bool + var bcoll, bsuff, bmitm : bool + + module S = { + (** Inner interface **) + proc f(o : caller, x : state): state = { + var o', ya, yc, pv, p, v; + + o' <- odflt D pathscol.[x.`2]; + bext <- bext \/ (o' <= o); + + if (!mem (dom rate) x) { + (ya,yc) <$ dstate; + if (mem (dom paths) x.`2) { + o' <- oget pathscol.[x.`2]; + pv <- oget paths.[x.`2]; + (p,v) <- pv; + bcoll <- bcoll \/ (mem (dom paths) yc); + bsuff <- bsuff \/ (mem (rng cap) yc); + pathscol.[yc] <- max o o'; + paths.[yc] <- (rcons p (v ^ x.`1),ya); + } + rate.[x] <- ya; + ratei.[(ya,yc)] <- x.`1; + cap.[x] <- yc; + capi.[(ya,yc)] <- x.`2; + mcol.[x] <- o; + micol.[(ya,yc)] <- o; + } else { + o' <- oget mcol.[x]; + mcol.[x] <- max o o'; + ya <- oget rate.[x]; + yc <- oget cap.[x]; + o' <- oget micol.[(ya,yc)]; + micol.[(ya,yc)] <- max o o'; + } + return (oget rate.[x],oget cap.[x]); + } + + proc fi(x : state): state = { + var ya, yc; + + if (!mem (dom ratei) x) { + (ya,yc) <$ dstate; + micol.[x] <- D; + ratei.[x] <- ya; + capi.[x] <- yc; + mcol.[(ya,yc)] <- D; + rate.[(ya,yc)] <- x.`1; + cap.[(ya,yc)] <- x.`2; + bmitm <- bmitm \/ (mem (dom paths) yc); + } else { + bred <- bred \/ oget micol.[x] = I; + micol.[x] <- D; + ya <- oget ratei.[x]; + yc <- oget capi.[x]; + mcol.[(ya,yc)] <- D; + } + return (oget ratei.[x],oget capi.[x]); + } + + (** Distinguisher interface **) + proc init() = { } + + proc oracle(q : p_query): state = { + var r; + + if (is_F q) { + r <@ f(D,get_query q); + } else { + r <@ fi(get_query q); + } + return r; + } + + } + + module C = { + proc init(): unit = { } + + proc oracle(p : block list): block = { + var (sa,sc) <- (Block.zeros,Capacity.zeros); + + if (size p >= 1 /\ p <> [Block.zeros]) { + while (p <> []) { + (sa,sc) <@ S.f(I,(sa ^ head witness p,sc)); + p <- behead p; + } + } + return sa; + } + } + + proc main(): bool = { + var b; + + mcol <- map0; + micol <- map0; + rate <- map0; + ratei <- map0; + cap <- map0; + capi <- map0; + bext <- false; + bred <- false; + bcoll <- false; + bsuff <- false; + bmitm <- false; + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + pathscol <- map0.[Capacity.zeros <- D]; + paths <- map0.[Capacity.zeros <- ([<:block>],Block.zeros)]; + b <@ D(C,S).distinguish(); + return b; + } + }. + + local equiv Game1_S_S_eq: + Game0.S.f ~ Game1.S.f: + ={arg} + /\ ={pathscol,paths}(Game0,Game1) + /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} + /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} + /\ is_pre_permutation (Game0.m){1} (Game0.mi){1} + ==> ={res} + /\ ={pathscol,paths}(Game0,Game1) + /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} + /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} + /\ is_pre_permutation (Game0.m){1} (Game0.mi){1}. + proof. + proc. inline *. + sp; if; 1:by progress [-split]; move: H=> [->]. + + auto; progress [-split]. + move: H3; case yL=> ya yc H3; case (x{2})=> xa xc. + by rewrite !getP_eq !map_split_set ?pre_permutation_set. + + auto; progress [-split]. + rewrite H H0 H1 /=. + by move: H=> [_ [_ ->]]. + qed. + + local equiv Game1_Si_Si_eq: + Game0.S.fi ~ Game1.S.fi: + ={arg} + /\ ={pathscol,paths}(Game0,Game1) + /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} + /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} + /\ is_pre_permutation (Game0.m){1} (Game0.mi){1} + ==> ={res} + /\ ={pathscol,paths}(Game0,Game1) + /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} + /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} + /\ is_pre_permutation (Game0.m){1} (Game0.mi){1}. + proof. + proc. inline *. + sp; if; 1:by progress [-split]; move: H0=> [->]. + + auto; progress [-split]. + move: H3; case yL=> ya yc H3; case (x{2})=> xa xc. + by rewrite !getP_eq !map_split_set ?pre_permutation_set. + + auto; progress [-split]. + rewrite H H0 H1 /=. + by move: H0=> [_ [_ ->]]. + qed. + + local lemma Game1_pr &m: + `|Pr[Game0.main() @ &m: res] + - Pr[Ideal.main() @ &m: res]| + = `|Pr[Game1.main() @ &m: res] + - Pr[Ideal.main() @ &m: res]|. + proof. + do !congr. byequiv=> //=; proc. + call (_: ={pathscol,paths}(Game0,Game1) + /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} + /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} + /\ is_pre_permutation Game0.m{1} Game0.mi{1}). + proc; if=> //=. + + by call Game1_S_S_eq. + + by call Game1_Si_Si_eq. + + proc; sp; if=> //=. + while ( ={sa,sc,p} + /\ ={pathscol,paths}(Game0,Game1) + /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} + /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} + /\ is_pre_permutation Game0.m{1} Game0.mi{1}). + by wp; call Game1_S_S_eq. + done. + by auto; smt. + qed. end section. (* That Self is unfortunate *) From e5032b71c2897ef193e3b9180601c78283730388 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Wed, 23 Sep 2015 16:27:21 +0200 Subject: [PATCH 019/394] add generic reduction for padding --- sha3/proof/IndifPadding.ec | 134 +++++++++++++++++++++++++++++++++++++ sha3/proof/Sponge.ec | 2 +- 2 files changed, 135 insertions(+), 1 deletion(-) create mode 100644 sha3/proof/IndifPadding.ec diff --git a/sha3/proof/IndifPadding.ec b/sha3/proof/IndifPadding.ec new file mode 100644 index 0000000..b1fec65 --- /dev/null +++ b/sha3/proof/IndifPadding.ec @@ -0,0 +1,134 @@ +require import Real NewFMap Fun. +require (*..*) Indifferentiability LazyRO. + +clone import Indifferentiability as Ind1. + +clone import Indifferentiability as Ind2 + with type p_in <- Ind1.p_in, + type p_out <- Ind1.p_out, + type f_out <- Ind1.f_out. + +op pad : Ind2.f_in -> Ind1.f_in. +op padinv : Ind1.f_in -> Ind2.f_in. +axiom cancel_pad : cancel pad padinv. +axiom cancel_padinv : cancel padinv pad. + +clone import LazyRO as RO1 + with type from <- Ind1.f_in, + type to <- Ind1.f_out. + +clone import LazyRO as RO2 + with type from <- Ind2.f_in, + type to <- Ind1.f_out, + op d <- RO1.d. + +module HF1 = { + proc init = RO1.H.init + proc oracle = RO1.H.f +}. + +module HF2 = { + proc init = RO2.H.init + proc oracle = RO2.H.f +}. + +module ConstrPad (FC:Ind1.Construction, P:Ind1.Primitive) = { + module C = FC(P) + + proc init = C.init + + proc oracle (x:Ind2.f_in) : f_out = { + var r; + r = C.oracle(pad x); + return r; + } +}. + +module DistPad(FD: Ind2.Distinguisher, F:Ind1.Functionality, P:Ind1.Primitive) = { + module Fpad = { + proc init = F.init + + proc oracle(x:Ind2.f_in) : f_out = { + var r; + r = F.oracle(pad x); + return r; + } + } + + module Dpad = FD(Fpad, P) + + proc distinguish = Dpad.distinguish +}. + +module SimPadinv(S:Ind1.Simulator, F2:Ind2.Functionality) = { + module F1 = { + proc init = F2.init + proc oracle(x:Ind1.f_in):Ind1.f_out = { + var r; + r = F2.oracle(padinv x); + return r; + } + } + + module S2 = S(F1) + + proc init = S2.init + + proc oracle = S2.oracle + }. + +section Reduction. + + declare module P : Ind1.Primitive. (* It is compatible with Ind2.Primitive *) + declare module C : Ind1.Construction {P}. + declare module S : Ind1.Simulator{ RO1.H, RO2.H}. + + declare module D' : Ind2.Distinguisher{P,C, RO1.H, RO2.H, S}. + + equiv ConstrDistPad: + Ind2.Indif(ConstrPad(C,P), P, D').main ~ + Ind1.Indif(C(P), P, DistPad(D')).main : ={glob P, glob C, glob D'} ==> + ={glob P, glob C, glob D', res}. + proof. by proc;sim. qed. + + lemma PrConstrDistPad &m: + Pr[ Ind2.Indif(ConstrPad(C,P), P, D').main() @ &m : res] = + Pr[ Ind1.Indif(C(P), P, DistPad(D')).main() @ &m : res]. + proof. by byequiv ConstrDistPad. qed. + + equiv DistH2H1: + Ind2.Indif(HF2,SimPadinv(S,HF2),D').main ~ + Ind1.Indif(HF1,S(HF1), DistPad(D')).main : + ={glob D', glob S} ==> + ={glob D',glob S, res} /\ forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]. + proof. + proc. + call (_: ={glob S} /\ forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]). + + proc *;inline *. + call (_: forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]);auto. + proc;inline *;wp;sp;if;first by progress [-split];rewrite !in_dom H. + + auto;progress;first by rewrite !getP_eq. + by rewrite !getP (can_eq _ _ cancel_padinv) H. + by auto;progress;rewrite H. + + proc;inline *;wp;sp;if;first by progress[-split];rewrite -{1}(cancel_pad x{2}) !in_dom H. + + auto;progress;first by rewrite !getP_eq. + by rewrite !getP (eq_sym x1) (can2_eq _ _ cancel_pad cancel_padinv) (eq_sym x{2}) H. + by auto;progress;rewrite -H cancel_pad. + inline *;wp. call (_: ={glob D'});first by sim. + auto;progress;by rewrite !map0P. + qed. + + lemma PrDistH2H1 &m: + Pr[Ind2.Indif(HF2,SimPadinv(S,HF2),D').main() @ &m : res] = + Pr[Ind1.Indif(HF1,S(HF1), DistPad(D')).main() @ &m : res]. + proof. by byequiv DistH2H1. qed. + + lemma Conclusion &m: + `| Pr[ Ind2.Indif(ConstrPad(C,P), P, D').main() @ &m : res] - + Pr[Ind2.Indif(HF2,SimPadinv(S,HF2),D').main() @ &m : res] | = + `| Pr[ Ind1.Indif(C(P), P, DistPad(D')).main() @ &m : res] - + Pr[Ind1.Indif(HF1,S(HF1), DistPad(D')).main() @ &m : res] |. + proof. by rewrite (PrConstrDistPad &m) (PrDistH2H1 &m). qed. + +end section Reduction. + diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index fc66d8f..7d91e06 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -236,7 +236,7 @@ module Truncator(F : BlockSponge): Self.Functionality = { if (size p >= 1 /\ nth witness p ( size p - 1) <> Self.Block.zeros) { bs <@ F.oracle(p,n /% r); - z <- z ++ flatten (map to_bits bs); + z <- flatten (map to_bits bs); } return take n z; From d0ffd8b83ea4463e2e4853f9d57ddd062abe306e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 23 Sep 2015 18:34:52 +0200 Subject: [PATCH 020/394] Minor things. --- sha3/proof/IndifPadding.ec | 33 ++++++++++++++------------------- 1 file changed, 14 insertions(+), 19 deletions(-) diff --git a/sha3/proof/IndifPadding.ec b/sha3/proof/IndifPadding.ec index b1fec65..db95efd 100644 --- a/sha3/proof/IndifPadding.ec +++ b/sha3/proof/IndifPadding.ec @@ -1,4 +1,4 @@ -require import Real NewFMap Fun. +require import Fun Pair Real NewFMap. require (*..*) Indifferentiability LazyRO. clone import Indifferentiability as Ind1. @@ -13,11 +13,11 @@ op padinv : Ind1.f_in -> Ind2.f_in. axiom cancel_pad : cancel pad padinv. axiom cancel_padinv : cancel padinv pad. -clone import LazyRO as RO1 +clone import LazyRO as RO1 with type from <- Ind1.f_in, type to <- Ind1.f_out. -clone import LazyRO as RO2 +clone import LazyRO as RO2 with type from <- Ind2.f_in, type to <- Ind1.f_out, op d <- RO1.d. @@ -54,10 +54,8 @@ module DistPad(FD: Ind2.Distinguisher, F:Ind1.Functionality, P:Ind1.Primitive) = return r; } } - - module Dpad = FD(Fpad, P) - proc distinguish = Dpad.distinguish + proc distinguish = FD(Fpad,P).distinguish }. module SimPadinv(S:Ind1.Simulator, F2:Ind2.Functionality) = { @@ -75,34 +73,33 @@ module SimPadinv(S:Ind1.Simulator, F2:Ind2.Functionality) = { proc init = S2.init proc oracle = S2.oracle - }. +}. section Reduction. - declare module P : Ind1.Primitive. (* It is compatible with Ind2.Primitive *) declare module C : Ind1.Construction {P}. declare module S : Ind1.Simulator{ RO1.H, RO2.H}. declare module D' : Ind2.Distinguisher{P,C, RO1.H, RO2.H, S}. - equiv ConstrDistPad: + local equiv ConstrDistPad: Ind2.Indif(ConstrPad(C,P), P, D').main ~ Ind1.Indif(C(P), P, DistPad(D')).main : ={glob P, glob C, glob D'} ==> ={glob P, glob C, glob D', res}. - proof. by proc;sim. qed. + proof. by sim. qed. - lemma PrConstrDistPad &m: + local lemma PrConstrDistPad &m: Pr[ Ind2.Indif(ConstrPad(C,P), P, D').main() @ &m : res] = Pr[ Ind1.Indif(C(P), P, DistPad(D')).main() @ &m : res]. proof. by byequiv ConstrDistPad. qed. - - equiv DistH2H1: + + local equiv DistH2H1: Ind2.Indif(HF2,SimPadinv(S,HF2),D').main ~ - Ind1.Indif(HF1,S(HF1), DistPad(D')).main : - ={glob D', glob S} ==> + Ind1.Indif(HF1,S(HF1), DistPad(D')).main : + ={glob D', glob S} ==> ={glob D',glob S, res} /\ forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]. proof. - proc. + proc. call (_: ={glob S} /\ forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]). + proc *;inline *. call (_: forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]);auto. @@ -118,7 +115,7 @@ section Reduction. auto;progress;by rewrite !map0P. qed. - lemma PrDistH2H1 &m: + local lemma PrDistH2H1 &m: Pr[Ind2.Indif(HF2,SimPadinv(S,HF2),D').main() @ &m : res] = Pr[Ind1.Indif(HF1,S(HF1), DistPad(D')).main() @ &m : res]. proof. by byequiv DistH2H1. qed. @@ -129,6 +126,4 @@ section Reduction. `| Pr[ Ind1.Indif(C(P), P, DistPad(D')).main() @ &m : res] - Pr[Ind1.Indif(HF1,S(HF1), DistPad(D')).main() @ &m : res] |. proof. by rewrite (PrConstrDistPad &m) (PrDistH2H1 &m). qed. - end section Reduction. - From f447bdb3aa404301051b053def9806c921ae9e1d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Sat, 26 Sep 2015 12:42:14 +0200 Subject: [PATCH 021/394] Some more lemmas that may be useful. --- sha3/proof/Utils.ec | 64 ++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 63 insertions(+), 1 deletion(-) diff --git a/sha3/proof/Utils.ec b/sha3/proof/Utils.ec index 573c8c6..5517692 100644 --- a/sha3/proof/Utils.ec +++ b/sha3/proof/Utils.ec @@ -1,6 +1,8 @@ (** These should make it into the standard libs **) -require import NewList NewFSet NewFMap. +require import Pair NewList NewFSet NewFMap. +(* -------------------------------------------------------------------- *) +(* In NewFSet *) op image (f : 'a -> 'b) (X : 'a fset) = oflist (map f (elems X)) axiomatized by imageE. @@ -29,3 +31,63 @@ proof. by rewrite dom_rem in_fsetD. qed. lemma rng_rem_le (x : 'a) (m : ('a,'b) fmap) (x' : 'b): mem (rng (rem x m)) x' => mem (rng m) x'. proof. by rewrite rng_rm in_rng=> [x0] [_ h]; exists x0. qed. + + +(* -------------------------------------------------------------------- *) +(* In NewFMap *) +op reindex (f : 'a -> 'c) (m : ('a, 'b) fmap) = + NewFMap.oflist (map (fun (x : 'a * 'b) => (f x.`1,x.`2)) (elems m)) + axiomatized by reindexE. + +lemma dom_reindex (f : 'a -> 'c) (m : ('a, 'b) fmap) x: + mem (dom (reindex f m)) x <=> mem (image f (dom m)) x. +proof. + rewrite reindexE dom_oflist imageP mapP /fst; split. + move=> [[x' y] [+ ->>]]. + rewrite mapP=> [[x0 y0]] /= [h [->> ->>]] {x' y}. + by exists x0; rewrite domE mem_oflist mapP /fst; exists (x0,y0). + move=> [a] [a_in_m <<-]. + exists (f a,oget m.[a])=> /=; rewrite mapP /=. + exists (a,oget m.[a])=> //=. + have:= a_in_m; rewrite in_dom; case {-1}(m.[a]) (eq_refl m.[a])=> //=. + by move=> y; rewrite getE mem_assoc_uniq 1:uniq_keys. +qed. + +require import Fun. + +lemma reindex_injective_on (f : 'a -> 'c) (m : ('a, 'b) fmap): + (forall x y, mem (dom m) x => f x = f y => x = y) => + (forall x, m.[x] = (reindex f m).[f x]). +proof. + move=> f_pinj x. + pose s:= elems (reindex f m). + case (assocP s (f x)). + rewrite -dom_oflist {1}/s elemsK dom_reindex imageP. + move=> [[a]] [] /f_pinj h /(h x) ->> {a}. + rewrite !getE. + move=> [y] [+ ->]. + rewrite /s reindexE. + pose s':= map (fun (x : 'a * 'b) => (f x.`1,x.`2)) (elems m). + have <- := (perm_eq_mem _ _ (oflistK s')). + (** FIXME: make this a lemma **) + have h' /h': forall (s : ('c * 'b) list) x, mem (reduce s) x => mem s x. + rewrite /reduce=> s0 x0; rewrite -{2}(cat0s s0); pose acc:= []. + elim s0 acc x0=> {s'} [acc x0 /=|x' s' ih acc x0 /=]. + by rewrite cats0. + move=> /ih; rewrite -cat1s catA cats1 !mem_cat=> [|-> //=]. + rewrite /augment; case (mem (map fst acc) x'.`1)=> _ h'; left=> //. + by rewrite mem_rcons /=; right. + rewrite /s' mapP=> [[a' b']] /= [xy_in_m []]. + rewrite eq_sym. have h0 /h0 ->> <<- {a' b'}:= f_pinj a' x _; 1:by smt. + by apply/mem_assoc_uniq; 1:exact uniq_keys. + rewrite -mem_oflist {1}/s -domE=> [] h; have := h; rewrite dom_reindex. + rewrite imageP=> h'. have {h'} h': forall (a : 'a), !mem (dom m) a \/ f a <> f x by smt. + have /= := h' x. + rewrite in_dom !getE /=. + by move=> -> ->. +qed. + +lemma reindex_injective (f : 'a -> 'c) (m : ('a, 'b) fmap): + injective f => + (forall x, m.[x] = (reindex f m).[f x]). +proof. by move=> f_inj; apply/reindex_injective_on=> + + _. qed. From 918d702ef4bfa6af75312039f0588ee8b6167ef7 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 1 Oct 2015 09:57:15 +0200 Subject: [PATCH 022/394] small change + Generic theories for Random Oracle. --- sha3/proof/IndifPadding.ec | 35 +-- sha3/proof/Indifferentiability.eca | 4 +- sha3/proof/LazyRO.eca | 2 +- sha3/proof/RO.eca | 369 ++++++++++++++++++++++++++++- 4 files changed, 384 insertions(+), 26 deletions(-) diff --git a/sha3/proof/IndifPadding.ec b/sha3/proof/IndifPadding.ec index db95efd..3a47891 100644 --- a/sha3/proof/IndifPadding.ec +++ b/sha3/proof/IndifPadding.ec @@ -22,16 +22,6 @@ clone import LazyRO as RO2 type to <- Ind1.f_out, op d <- RO1.d. -module HF1 = { - proc init = RO1.H.init - proc oracle = RO1.H.f -}. - -module HF2 = { - proc init = RO2.H.init - proc oracle = RO2.H.f -}. - module ConstrPad (FC:Ind1.Construction, P:Ind1.Primitive) = { module C = FC(P) @@ -83,19 +73,19 @@ section Reduction. declare module D' : Ind2.Distinguisher{P,C, RO1.H, RO2.H, S}. local equiv ConstrDistPad: - Ind2.Indif(ConstrPad(C,P), P, D').main ~ - Ind1.Indif(C(P), P, DistPad(D')).main : ={glob P, glob C, glob D'} ==> + Ind2.Real(P, ConstrPad(C), D').main ~ + Ind1.Real(P, C, DistPad(D')).main : ={glob P, glob C, glob D'} ==> ={glob P, glob C, glob D', res}. proof. by sim. qed. local lemma PrConstrDistPad &m: - Pr[ Ind2.Indif(ConstrPad(C,P), P, D').main() @ &m : res] = - Pr[ Ind1.Indif(C(P), P, DistPad(D')).main() @ &m : res]. + Pr[ Ind2.Real(P,ConstrPad(C), D').main() @ &m : res] = + Pr[ Ind1.Real(P,C,DistPad(D')).main() @ &m : res]. proof. by byequiv ConstrDistPad. qed. local equiv DistH2H1: - Ind2.Indif(HF2,SimPadinv(S,HF2),D').main ~ - Ind1.Indif(HF1,S(HF1), DistPad(D')).main : + Ind2.Ideal(RO2.H, SimPadinv(S), D').main ~ + Ind1.Ideal(RO1.H, S, DistPad(D')).main : ={glob D', glob S} ==> ={glob D',glob S, res} /\ forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]. proof. @@ -116,14 +106,15 @@ section Reduction. qed. local lemma PrDistH2H1 &m: - Pr[Ind2.Indif(HF2,SimPadinv(S,HF2),D').main() @ &m : res] = - Pr[Ind1.Indif(HF1,S(HF1), DistPad(D')).main() @ &m : res]. + Pr[Ind2.Ideal(RO2.H,SimPadinv(S),D').main() @ &m : res] = + Pr[Ind1.Ideal(RO1.H,S, DistPad(D')).main() @ &m : res]. proof. by byequiv DistH2H1. qed. lemma Conclusion &m: - `| Pr[ Ind2.Indif(ConstrPad(C,P), P, D').main() @ &m : res] - - Pr[Ind2.Indif(HF2,SimPadinv(S,HF2),D').main() @ &m : res] | = - `| Pr[ Ind1.Indif(C(P), P, DistPad(D')).main() @ &m : res] - - Pr[Ind1.Indif(HF1,S(HF1), DistPad(D')).main() @ &m : res] |. + `| Pr[Ind2.Real (P , ConstrPad(C), D').main() @ &m : res] - + Pr[Ind2.Ideal(RO2.H, SimPadinv(S), D').main() @ &m : res] | = + `| Pr[Ind1.Real(P , C, DistPad(D')).main() @ &m : res] - + Pr[Ind1.Ideal(RO1.H, S, DistPad(D')).main() @ &m : res] |. proof. by rewrite (PrConstrDistPad &m) (PrDistH2H1 &m). qed. + end section Reduction. diff --git a/sha3/proof/Indifferentiability.eca b/sha3/proof/Indifferentiability.eca index ca782a8..a4a3659 100644 --- a/sha3/proof/Indifferentiability.eca +++ b/sha3/proof/Indifferentiability.eca @@ -45,9 +45,11 @@ module Indif (F : Functionality, P : Primitive, D : Distinguisher) = { } }. +module Real(P:Primitive, C:Construction) = Indif(C(P),P). +module Ideal(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[Indif(C(P),P,D): res] - Pr[Indif(F,S(F),D): res] | is small. + | 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/LazyRO.eca b/sha3/proof/LazyRO.eca index 80d090c..d9784b4 100644 --- a/sha3/proof/LazyRO.eca +++ b/sha3/proof/LazyRO.eca @@ -13,7 +13,7 @@ module H : RO, RO_ = { proc init() = { m = map0; } - proc f(x) = { + proc oracle(x) = { if (!mem (dom m) x) m.[x] = $d; return oget m.[x]; } diff --git a/sha3/proof/RO.eca b/sha3/proof/RO.eca index 3bf0d3b..8d90a89 100644 --- a/sha3/proof/RO.eca +++ b/sha3/proof/RO.eca @@ -1,12 +1,17 @@ +require import NewFMap. +(* TODO move this in NewFMap *) +lemma dom_set (m:('a,'b) fmap) a b : dom m.[a<-b] = dom m `|` fset1 a. +proof. by apply fsetP=> x;smt. qed. + type from, to. module type RO = { proc init() : unit - proc f(x : from): to + proc oracle(x : from): to }. module type RO_ = { - proc f(x : from): to + proc oracle(x : from): to }. module type Distinguisher(G : RO_) = { @@ -22,3 +27,363 @@ module IND(G:RO, D:Distinguisher) = { return b; } }. + +abstract theory Ideal. + + op sample : from -> to distr. + + module RO = { + var m : (from, to) fmap + + proc init() : unit = { + m <- map0; + } + + proc oracle(x : from) : to = { + var rd; + rd <$ sample x; + if (! mem (dom m) x) m.[x] <- rd; + return oget m.[x]; + } + }. + + section LL. + + axiom sample_ll : forall x, Distr.weight (sample x) = 1%r. + + lemma oracle_ll : phoare[RO.oracle : true ==> true] = 1%r. + proof. proc;auto;progress;apply sample_ll. qed. + + end section LL. + +end Ideal. + + +abstract theory GenIdeal. + + clone include Ideal. + axiom sample_ll : forall x, Distr.weight (sample x) = 1%r. + + op RO_dom : from fset. + + module ERO = { + proc sample() = { + var work; + work <- RO_dom; + while (work <> fset0) { + RO.oracle(pick work); + work = work `\` fset1 (pick work); + } + } + + proc init() = { + RO.m <- map0; + sample(); + } + + proc oracle = RO.oracle + }. + + module IND_S(D:Distinguisher) = { + proc main(): bool = { + var b; + RO.init(); + b <@ D(RO).distinguish(); + ERO.sample(); + return b; + } + }. + + section EAGER. + + local lemma eager_query: + eager [ERO.sample(); , RO.oracle ~ ERO.oracle, ERO.sample(); : + ={x,RO.m} ==> ={res,RO.m} ]. + proof. + eager proc. + inline ERO.sample;swap{2} 4 -3. + seq 1 1: (={x,work,RO.m});first by sim. + wp;case ((mem (dom RO.m) x){1}). + + rnd{1}. + alias{1} 1 mx = oget RO.m.[x]. + while (={work,RO.m} /\ (RO.m.[x] = Some mx){1}). + + by inline *;auto;progress;smt. + auto;progress [- split]; rewrite sample_ll H /=;smt. + case ((!mem work x){1}). + + swap{1} 2 -1;while (={work,x} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ + (!mem work x){1} /\ (RO.m.[x] = Some rd){2} /\ (!mem (dom RO.m) x){1}). + + inline *;auto;progress [-split]. + cut -> : mem (dom RO.m{2}) (pick work{2}) = mem (dom RO.m{1}) (pick work{2}) by rewrite !in_dom;smt. + smt. + auto;progress [-split];rewrite !getP_eq;smt. + inline RO.oracle. + transitivity{1} { rd <$ sample x; + while (work <> fset0) { + x0 <- pick work; + rd0 <$ sample x0; + if (!mem (dom RO.m) x0) + RO.m.[x0] <- if x0 = x then rd else rd0; + work <- work `\` fset1 (pick work); + } } + (={x,work,RO.m} ==> ={x,RO.m}) + ((={x,work,RO.m} /\ mem work{1} x{1}) /\ ! mem (dom RO.m{2}) x{2} ==> + ={x,RO.m} /\ (result = oget RO.m.[x]){2} /\ mem (dom RO.m{1}) x{1}) => //. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; generalize H. + + transitivity{1} { while (work <> fset0) { + x0 <- pick work; + rd0 <$ sample x0; + if (!mem (dom RO.m) x0) RO.m.[x0] <- rd0; + work <- work `\` fset1 (pick work); + } + rd <$ sample x; } + (={x,work,RO.m} ==> ={x,RO.m}) + (={x,work,RO.m} ==> ={x,RO.m})=> //. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; generalize H. + + by sim; rnd{2}; sim : (={x,IND_Eager.H.m}); smt. + symmetry; eager while (H: rd <$ sample x; ~ rd <$ sample x; : ={x} ==> ={rd})=> //; sim. + swap{2} 5 -4; swap [2..3] -1; case ((x = pick work){1}). + + by wp; rnd{2}; rnd; rnd{1}; wp; skip; smt. + by auto; smt. + + while (={x, work} /\ + (!mem work x => mem (dom RO.m) x){1} /\ + RO.m.[x]{2} = Some rd{1} /\ + if (mem (dom RO.m) x){1} then ={RO.m} + else eq_except RO.m{1} RO.m{2} (fset1 x{1})). + + auto;progress; 1..9,12:smt. + + case ((pick work = x){2})=> pick_x; last smt. + subst x{2}; generalize H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. + by apply fmapP=> x0; case (pick work{2} = x0); smt. + by auto; smt. + by auto;progress [-split];rewrite H0 /= getP_eq;smt. + qed. + + equiv Eager_S (D <: Distinguisher{RO}): IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. + proof. + proc; inline ERO.init RO.init. + seq 1 1: (={glob D, RO.m});first by wp. + symmetry; eager (H: ERO.sample(); ~ ERO.sample();: ={RO.m} ==> ={RO.m}): + (={glob D, RO.m}) => //; first by sim. + eager proc H (={RO.m}) => //; [by apply eager_query | by sim]. + qed. + + equiv Eager (D <: Distinguisher{RO}): IND(RO,D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. + proof. + transitivity IND_S(D).main + (={glob D} ==> ={res,glob D}) + (={glob D} ==> ={res,RO.m,glob D}) => //. + + by progress;exists (glob D){2}. + + proc;inline{2} ERO.sample. + while{2} true (card work{2}). + + move=> &m1 z;wp;call (oracle_ll sample_ll);auto;smt. + conseq (_: _ ==> ={b,glob D}) => //;[smt | by sim]. + apply (Eager_S D). + qed. + + end section EAGER. + +end GenIdeal. + +abstract theory FiniteIdeal. + + clone include Ideal. + axiom sample_ll (x : from): Distr.weight (sample x) = 1%r. + + op univ : from fset. + axiom univP (x:from) : mem univ x. + + module ERO = { + proc sample() = { + var work; + work <- univ; + while (work <> fset0) { + RO.oracle(pick work); + work = work `\` fset1 (pick work); + } + } + + proc init() = { + RO.m <- map0; + sample(); + } + + proc oracle(x:from):to = { return oget RO.m.[x]; } + }. + + module IND_S(D:Distinguisher) = { + proc main(): bool = { + var b; + RO.init(); + b <@ D(RO).distinguish(); + ERO.sample(); + return b; + } + }. + + section EAGER. + + declare module D: Distinguisher { RO }. + + local clone GenIdeal as GI with + op sample <- sample, + op RO_dom <- univ + proof sample_ll by apply sample_ll. + + local equiv ERO_main: + IND(GI.ERO, D).main ~ IND(ERO, D).main : ={glob D} ==> ={res, glob D} /\ GI.RO.m{1} = RO.m{2}. + proof. + proc. + call (_:GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ). + + proc; rcondf{1} 2;auto;progress;[ by rewrite H univP | by apply sample_ll]. + inline *. + while (={work} /\ GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ `\` work{2});auto;smt. + qed. + + equiv Eager_S : IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. + proof. + transitivity GI.IND_S(D).main + (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) + (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. + + by progress;exists (glob D){2}. + + by sim. + transitivity IND(GI.ERO,D).main + (={glob D} ==> ={res,glob D, GI.RO.m}) + (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. + + by progress;exists (glob D){2}. + + by conseq (GI.Eager_S D). + by apply ERO_main. + qed. + + equiv Eager : IND(RO, D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. + proof. + transitivity IND(GI.RO,D).main + (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) + (={glob D} ==> ={res,glob D}) => //. + + by progress;exists (glob D){2}. + + by sim. + transitivity IND(GI.ERO,D).main + (={glob D} ==> ={res,glob D}) + (={glob D} ==> ={res,glob D}) => //. + + by progress;exists (glob D){2}. + + by conseq (GI.Eager D). + by conseq ERO_main. + qed. + + end section EAGER. + +end FiniteIdeal. + + +abstract theory RestrIdeal. + + clone include Ideal. + axiom sample_ll (x : from): Distr.weight (sample x) = 1%r. + + op test : from -> bool. + op univ : from fset. + op dfl : to. + + axiom testP x : test x <=> mem univ x. + + module Restr (O:RO) = { + proc init = RO.init + proc oracle (x:from) : to = { + var r <- dfl; + if (test x) r <@ RO.oracle(x); + return r; + } + }. + + module ERO = { + proc sample() = { + var work; + work <- univ; + while (work <> fset0) { + RO.oracle(pick work); + work = work `\` fset1 (pick work); + } + } + + proc init() = { + RO.m <- map0; + sample(); + } + + proc oracle(x:from):to = { + return (if test x then oget RO.m.[x] else dfl); + } + }. + + module IND_S(D:Distinguisher) = { + proc main(): bool = { + var b; + RO.init(); + b <@ D(Restr(RO)).distinguish(); + ERO.sample(); + return b; + } + }. + + section EAGER. + + declare module D: Distinguisher { RO }. + + local clone GenIdeal as GI with + op sample <- sample, + op RO_dom <- univ. + + local module Restr' (O:RO_) = { + proc init() = { } + proc oracle(x:from) = { + var r <- dfl; + if (test x) r <@ O.oracle(x); + return r; + } + }. + + local module RD (O:RO_) = D(Restr'(O)). + + local equiv ERO_main: + IND(GI.ERO, RD).main ~ IND(ERO, D).main : ={glob D} ==> ={res, glob D} /\ GI.RO.m{1} = RO.m{2}. + proof. + proc. + call (_:GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ). + + proc. + case (test x{1});[ rcondt{1} 2 | rcondf{1} 2];auto;last smt ml=0. + by inline *;rcondf{1} 4;auto;progress;2:(by apply sample_ll);rewrite ?H0 ?H -?testP. + inline *. + while (={work} /\ GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} `|` work{2} = univ);auto;1:progress; smt. + qed. + + equiv Eager_S : IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. + proof. + transitivity GI.IND_S(RD).main + (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) + (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. + + by progress;exists (glob D){2}. + + by sim. + transitivity IND(GI.ERO,RD).main + (={glob D} ==> ={res,glob D, GI.RO.m}) + (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. + + by progress;exists (glob D){2}. + + by conseq (GI.Eager_S RD). + by apply ERO_main. + qed. + + equiv Eager : IND(Restr(RO), D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. + proof. + transitivity IND(GI.RO,RD).main + (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) + (={glob D} ==> ={res,glob D}) => //. + + by progress;exists (glob D){2}. + + by sim. + transitivity IND(GI.ERO,RD).main + (={glob D} ==> ={res,glob D}) + (={glob D} ==> ={res,glob D}) => //. + + by progress;exists (glob D){2}. + + by conseq (GI.Eager RD). + by conseq ERO_main. + qed. + + end section EAGER. + +end RestrIdeal. \ No newline at end of file From 0bd733c1a13a023d3c66f4dab50ded09ee170bf4 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 1 Oct 2015 09:59:23 +0200 Subject: [PATCH 023/394] renaming --- sha3/proof/{RO.eca => RndOrcl.eca} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename sha3/proof/{RO.eca => RndOrcl.eca} (100%) diff --git a/sha3/proof/RO.eca b/sha3/proof/RndOrcl.eca similarity index 100% rename from sha3/proof/RO.eca rename to sha3/proof/RndOrcl.eca From 23386b60a094c07129dda0dee6ad6023b82d25e4 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 1 Oct 2015 15:56:25 +0200 Subject: [PATCH 024/394] Some progress --- sha3/proof/Indifferentiability.eca | 4 +- sha3/proof/NBRO.eca | 153 +++++++++++++++++++++++++++++ sha3/proof/RndOrcl.eca | 12 +-- 3 files changed, 159 insertions(+), 10 deletions(-) create mode 100644 sha3/proof/NBRO.eca diff --git a/sha3/proof/Indifferentiability.eca b/sha3/proof/Indifferentiability.eca index a4a3659..6c4514b 100644 --- a/sha3/proof/Indifferentiability.eca +++ b/sha3/proof/Indifferentiability.eca @@ -21,12 +21,12 @@ module type Functionality = { is playing with constructed functionality and ideal primitive or with ideal functionality and simulated primitive). **) module type Construction (P : Primitive) = { - proc init() : unit { P.init } + proc init() : unit { } proc oracle(x : f_in): f_out { P.oracle } }. module type Simulator (F : Functionality) = { - proc init() : unit { F.init } + proc init() : unit { } proc oracle(x : p_in): p_out { F.oracle } }. diff --git a/sha3/proof/NBRO.eca b/sha3/proof/NBRO.eca new file mode 100644 index 0000000..195905f --- /dev/null +++ b/sha3/proof/NBRO.eca @@ -0,0 +1,153 @@ +require import Int Real NewList NewFMap. +require RndOrcl Indifferentiability. + +type p_in. +type p_out. + +type from. + +type block. +op dblock : block distr. +axiom dblock_ll: Distr.weight dblock = 1%r. + +op univ : (from * int) fset. +op test : from * int -> bool. +op dfl : block. + +clone RndOrcl as ROB with + type from <- from * int, + type to <- block. + +clone include ROB.RestrIdeal with + op sample <- fun (x:from*int) => dblock, + op dfl <- dfl, + op univ <- univ, + op test <- test + proof sample_ll by apply dblock_ll. + +(* axiom testP (x:from * int): test x <=> mem univ x. *) +axiom test_neg (x:from) (n:int): n < 0 => !test (x,n). +axiom test_le (x:from) (n p:int) : 0 <= p <= n => test (x,n) => test (x,p). + +clone import Indifferentiability as IndB with + type p_in <- p_in, + type p_out <- p_out, + type f_in <- from * int, + type f_out <- block. + +clone import Indifferentiability as IndNB with + type p_in <- p_in, + type p_out <- p_out, + type f_in <- from * int, + type f_out <- block list. + +module RONB (Ob:IndB.Functionality) = { + proc init = Ob.init + + proc oracle(x:from, n:int) : block list = { + var b, bs; + bs <- []; + while (size bs < n) { + b <@ Ob.oracle(x,size bs); + bs <- rcons bs b; + } + return bs; + } +}. + +module DNB(D:IndNB.Distinguisher, F:IndB.Functionality, P:IndB.Primitive) = { + proc distinguish = D(RONB(F), P).distinguish +}. + +module CNB (C: IndB.Construction, P:IndB.Primitive) = RONB(C(P)). + +module FNB_B(F:IndNB.Functionality) = { + proc init () = {} + + proc oracle(x:from,n:int) : block = { + var bs; + bs <@ F.oracle(x,n+1); + return nth dfl bs n; + } +}. + +module SNB(S:IndB.Simulator, F:IndNB.Functionality) = { + + proc init = S(FNB_B(F)).init + + proc oracle = S(FNB_B(F)).oracle +}. + +section PROOF. + + declare module P:IndB.Primitive. + declare module C:IndB.Construction {P}. + declare module S:IndB.Simulator {RO}. + + declare module D: IndNB.Distinguisher {P, RO, S, C}. + + local equiv equivReal: IndNB.Real(P, CNB(C), D).main ~ IndB.Real(P, C, DNB(D)).main: + ={glob P, glob C, glob D} ==> + ={glob P, glob C, glob D,res}. + proof. proc;inline *; sim. qed. + + local module DRO (O:ROB.RO) = { + proc distinguish () : bool = { + var b; + SNB(S, RONB(O)).init(); + b <@ D(RONB(O), SNB(S, RONB(O))).distinguish(); + return b; + } + }. + + local module DNB'(O:ROB.RO) = { + proc distinguish () : bool = { + var b; + S(O).init(); + b <@ DNB(D, O, S(O)).distinguish(); + return b; + } + }. + + lemma conclusion &m: + `|Pr[IndNB.Real(P, CNB(C), D).main()@ &m:res] - Pr[IndNB.Ideal(RONB(Restr(RO)), SNB(S), D).main()@ &m:res] | = + `|Pr[IndB.Real(P, C, DNB(D)).main()@ &m:res] - Pr[IndB.Ideal(Restr(RO),S,DNB(D)).main()@ &m:res] |. + proof. + cut -> : Pr[IndNB.Real(P, CNB(C), D).main()@ &m:res] = Pr[IndB.Real(P, C, DNB(D)).main()@ &m:res]. + + byequiv equivReal=> //. + cut -> : Pr[Ideal(RONB(Restr(RO)), SNB(S), D).main() @ &m : res] = + Pr[ROB.IND(Restr(RO), DRO).main() @ &m : res]. + + byequiv=> //; proc;inline *;swap{1} 1 1;sim. + cut -> : Pr[ROB.IND(Restr(RO), DRO).main() @ &m : res] = + Pr[ROB.IND(ERO,DRO).main () @ &m : res]. + + byequiv (Eager DRO)=> //. + do 2! congr. + cut -> : Pr[IndB.Ideal(Restr(RO), S, DNB(D)).main() @ &m : res] = + Pr[ROB.IND(Restr(RO), DNB').main() @ &m : res]. + + byequiv=> //; proc;inline *;swap{1} 1 1;sim. + cut -> : Pr[ROB.IND(Restr(RO), DNB').main() @ &m : res] = + Pr[ROB.IND(ERO, DNB').main() @ &m : res]. + + byequiv (Eager DNB')=> //. + byequiv=> //;proc;inline DRO(ERO).distinguish DNB'(ERO).distinguish;wp. + call (_: ={RO.m, glob S}). + + proc (={RO.m}) => //. + proc;inline *;wp. + while{1} ((0 <= n0 => size bs0 <= n0){1} /\ forall i, 0 <= i < size bs0{1} => + nth dfl bs0{1} i = + if test (x0{1},i) + then oget RO.m{1}.[(x0{1},i)] + else dfl) ((n0 - size bs0){1}). + + move=> &m2 z;auto;progress [-split]. + rewrite size_rcons;split;2:smt ml=0;split;1:smt ml=0. + move=> i [Hi0 Hi1];rewrite nth_rcons. + case (i < size bs0{hr})=> Hi';first by apply H0. + by cut -> : i = size bs0{hr} by smt ml=0. + auto;progress;1,2: smt ml=0. + case (n{1} < 0)=> Hn. + + by rewrite nth_neg // test_neg. + apply H1=> {H1} //;smt ml=0. + + sim. + by conseq (_: _ ==> ={glob S, glob D, RO.m})=> //;sim. + qed. + +end section PROOF. diff --git a/sha3/proof/RndOrcl.eca b/sha3/proof/RndOrcl.eca index 8d90a89..09d0322 100644 --- a/sha3/proof/RndOrcl.eca +++ b/sha3/proof/RndOrcl.eca @@ -10,12 +10,8 @@ module type RO = { proc oracle(x : from): to }. -module type RO_ = { - proc oracle(x : from): to -}. - -module type Distinguisher(G : RO_) = { - proc distinguish(): bool +module type Distinguisher(G : RO) = { + proc distinguish(): bool {G.oracle} }. module IND(G:RO, D:Distinguisher) = { @@ -331,7 +327,7 @@ abstract theory RestrIdeal. op sample <- sample, op RO_dom <- univ. - local module Restr' (O:RO_) = { + local module Restr' (O:RO) = { proc init() = { } proc oracle(x:from) = { var r <- dfl; @@ -340,7 +336,7 @@ abstract theory RestrIdeal. } }. - local module RD (O:RO_) = D(Restr'(O)). + local module RD (O:RO) = D(Restr'(O)). local equiv ERO_main: IND(GI.ERO, RD).main ~ IND(ERO, D).main : ={glob D} ==> ={res, glob D} /\ GI.RO.m{1} = RO.m{2}. From 378ba632ac311beffc65a4990652d0c3d2870e1e Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Thu, 22 Oct 2015 17:53:02 +0200 Subject: [PATCH 025/394] Top level definitions. --- sha3/proof/Definitions.ec | 104 ++++++++++++++++++++++++++++++++++++++ sha3/proof/IRO.eca | 28 ++++++---- sha3/proof/LazyRP.eca | 2 +- 3 files changed, 123 insertions(+), 11 deletions(-) create mode 100644 sha3/proof/Definitions.ec diff --git a/sha3/proof/Definitions.ec b/sha3/proof/Definitions.ec new file mode 100644 index 0000000..f355064 --- /dev/null +++ b/sha3/proof/Definitions.ec @@ -0,0 +1,104 @@ +(* -------------------------------------------------------------------- *) +require import Pair Int Real List. +require (*--*) IRO LazyRP. +(*---*) import Dprod. + +(* -------------------------------------------------------------------- *) +op r : { int | 0 < r } as gt0_r. +op c : { int | 0 < c } as gt0_c. + +type block. (* = {0,1}^r *) +type capacity. (* = {0,1}^c *) + +op cdist : capacity distr. +op bdist : block distr. + +(* isomorphic to the {0,1}^? uniform distributions *) + +op b0 : block. +op c0 : capacity. + +op b2bits : block -> bool list. + +op (^) : block -> block -> block. +op pad : bool list -> block list. + +(* -------------------------------------------------------------------- *) +clone import IRO as BIRO with + type from <- bool list, + type to <- bool, + op valid (x : bool list) <- true. + +clone import LazyRP as Perm with + type D <- block * capacity, + op d <- bdist * cdist + + rename [module] "P" as "Perm". + +(* -------------------------------------------------------------------- *) +module type CONSTRUCTION(P : RP) = { + proc init() : unit + + proc f(bp : bool list, n : int) : bool list +}. + +module type SIMULATOR(F : BIRO.IRO) = { + proc init() : unit + + proc f(_ : block * capacity) : block * capacity + + proc fi(_ : block * capacity) : block * capacity +}. + +module type DISTINGUISHER(F : BIRO.IRO, P : RP) = { + proc distinguish() : bool +}. + +(* -------------------------------------------------------------------- *) +module Experiment(F : BIRO.IRO, P : RP, D : DISTINGUISHER) = { + proc main() : bool = { + var b; + + F.init(); + P.init(); + b <@ D(F, P).distinguish(); + + return b; + } +}. + +(* -------------------------------------------------------------------- *) +module Sponge (P : RP) : BIRO.IRO, CONSTRUCTION(P) = { + proc init = P.init + + proc f(bp : bool list, n : int): bool list = { + var z <- []; + var s <- (b0, c0); + var i <- 0; + var p <- pad bp; + + (* Absorption *) + while (p <> []) { + s <@ P.f(s.`1 ^ head b0 p, s.`2); + p <- behead p; + } + (* Squeezing *) + while (i < n/%r) { + z <- z ++ (b2bits s.`1); + s <@ P.f(s); + } + + return take n z; + } +}. + +(* -------------------------------------------------------------------- *) +op eps : real. + +lemma top: + exists (S <: SIMULATOR), + forall (D <: DISTINGUISHER) &m, + `| Pr[Experiment(Sponge(Perm), Perm, D).main() @ &m : res] + - Pr[Experiment(IRO, S(IRO), D).main() @ &m : res]| + < eps. +proof. admit. qed. diff --git a/sha3/proof/IRO.eca b/sha3/proof/IRO.eca index 07c2c25..a8ff48c 100644 --- a/sha3/proof/IRO.eca +++ b/sha3/proof/IRO.eca @@ -2,19 +2,22 @@ all of whose bits are sampled uniformly and independently. We obviously make it lazy. *) -require import Option Int Bool NewList NewFMap NewFSet. +require import Option Int Bool List FSet NewFMap. -type from. +type to, from. + +op valid : from -> bool. +op dto : to distr. module type IRO = { proc init() : unit (* f x, returning the first n bits of the result *) - proc f(x : from, n : int) : bool list + proc f(x : from, n : int) : to list }. module IRO : IRO = { - var mp : (from, bool list) fmap + var mp : (from, to list) fmap proc init() = { mp = map0; } @@ -23,7 +26,7 @@ module IRO : IRO = { bs <- []; while (n > 0) { - b <$ Dbool.dbool; + b <$ dto; bs <- b :: bs; n <- n - 1; } @@ -31,11 +34,16 @@ module IRO : IRO = { } proc f(x, n) = { - var ys, zs; + var ys, zs, aout; + + aout <- []; + if (valid x) { + ys <- odflt [] mp.[x]; + zs <@ choose (max 0 (n - size ys)); + mp.[x] <- ys ++ zs; + aout <- take n (oget mp.[x]); + } - ys <- odflt [] mp.[x]; - zs <@ choose (max 0 (n - size ys)); - mp.[x] <- ys ++ zs; - return take n (oget mp.[x]); + return aout; } }. diff --git a/sha3/proof/LazyRP.eca b/sha3/proof/LazyRP.eca index 578ed7b..b483b42 100644 --- a/sha3/proof/LazyRP.eca +++ b/sha3/proof/LazyRP.eca @@ -1,4 +1,4 @@ -require import Option NewFSet NewFMap. +require import Option FSet NewFMap. require import Dexcepted. require (*..*) RP. From d6a4e9469a2c2db9693b463e63f1568d1993f89c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 23 Oct 2015 12:06:14 +0200 Subject: [PATCH 026/394] File for Benjamin to play with. --- sha3/proof/LeakyAbsorb.ec | 172 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 172 insertions(+) create mode 100644 sha3/proof/LeakyAbsorb.ec diff --git a/sha3/proof/LeakyAbsorb.ec b/sha3/proof/LeakyAbsorb.ec new file mode 100644 index 0000000..7fb9ffe --- /dev/null +++ b/sha3/proof/LeakyAbsorb.ec @@ -0,0 +1,172 @@ +(* -------------------------------------------------------------------- *) +require import Option Pair Int Real List FSet NewFMap. +require (*--*) IRO LazyRP. +(*---*) import Dprod. + +(* -------------------------------------------------------------------- *) +op r : { int | 0 < r } as gt0_r. +op c : { int | 0 < c } as gt0_c. + +type block. (* = {0,1}^r *) +type capacity. (* = {0,1}^c *) + +op cdist : capacity distr. +op bdist : block distr. + +(* isomorphic to the {0,1}^? uniform distributions *) + +op b0 : block. +op c0 : capacity. + +op b2bits : block -> bool list. + +op (^) : block -> block -> block. +op pad : bool list -> block list. + +(* -------------------------------------------------------------------- *) +clone import LazyRP as Perm with + type D <- block * capacity, + op d <- bdist * cdist + + rename [module] "P" as "Perm". + +clone import IRO as BIRO with + type from <- block list, + type to <- block, + op valid (x : block list) <- true, + op dto <- bdist. + +(* -------------------------------------------------------------------- *) +module type WeirdIRO = { + proc init(): unit + + proc f(_: block list * int): block list +}. + +module IdealFunctionality = { + var h : (block list,block) fmap + + proc init() = { h = map0; } + + proc core(m : block list) = { + if (!mem (dom h) m) { + h.[m] <$ bdist; + } + return oget h.[m]; + } + + proc f(m : block list, n : int) = { + var i <- 1; + var z <- [b0]; + var b; + + m <- m ++ mkseq (fun k => b0) n; + while (i < size m) { + b <@ core(take i m); + z <- rcons z b; + } + return z; + } +}. + +(* -------------------------------------------------------------------- *) +module type CONSTRUCTION(P : RP) = { + proc init() : unit + + proc f(bp : block list, n : int) : block list +}. + +module type SIMULATOR(F : WeirdIRO) = { + proc init() : unit + + proc f(_ : block * capacity) : block * capacity + + proc fi(_ : block * capacity) : block * capacity +}. + +module type DISTINGUISHER(F : WeirdIRO, P : RP) = { + proc distinguish() : bool +}. + +(* -------------------------------------------------------------------- *) +module Experiment(F : WeirdIRO, P : RP, D : DISTINGUISHER) = { + proc main() : bool = { + var b; + + F.init(); + P.init(); + b <@ D(F, P).distinguish(); + + return b; + } +}. + +(* -------------------------------------------------------------------- *) +module SpongeThatDoesNotAbsorb (P : RP) : WeirdIRO, CONSTRUCTION(P) = { + proc init = P.init + + proc f(p : block list, n : int): block list = { + var z <- []; + var (sa,sc) <- (b0, c0); + var i <- 0; + var l <- size p; + + (* Absorption *) + while (p <> []) { + z <- rcons z sa; + (sa,sc) <@ P.f(sa ^ head b0 p, sc); + p <- behead p; + } + (* Squeezing *) + while (i < n/%r) { + z <- rcons z sa; + (sa,sc) <@ P.f(sa,sc); + } + + return drop l z; + } +}. + +(* -------------------------------------------------------------------- *) +module SpongeThatAbsorbs (P : RP) : WeirdIRO, CONSTRUCTION(P) = { + proc init = P.init + + proc f(p : block list, n : int): block list = { + var z <- []; + var (sa,sc) <- (b0, c0); + var i <- 0; + + (* Absorption *) + while (p <> []) { + (sa,sc) <@ P.f(sa ^ head b0 p, sc); + p <- behead p; + } + (* Squeezing *) + while (i < n/%r) { + z <- rcons z sa; + (sa,sc) <@ P.f(sa,sc); + } + + return z; + } +}. + +(* -------------------------------------------------------------------- *) +op eps : real. + +axiom core: + exists (S <: SIMULATOR), + forall (D <: DISTINGUISHER) &m, + `| Pr[Experiment(SpongeThatDoesNotAbsorb(Perm), Perm, D).main() @ &m : res] + - Pr[Experiment(IdealFunctionality, S(IdealFunctionality), D).main() @ &m : res]| + < eps. + + +lemma top: + exists eps', + exists (S <: SIMULATOR), + forall (D <: DISTINGUISHER) &m, + `| Pr[Experiment(SpongeThatAbsorbs(Perm), Perm, D).main() @ &m : res] + - Pr[Experiment(IRO, S(IRO), D).main() @ &m : res]| + < eps'. +proof. admit. (** FILL ME IN **) qed. \ No newline at end of file From 5d7f6b0765e0bcdea9c938df67540baaac5e758d Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Fri, 23 Oct 2015 12:50:57 +0200 Subject: [PATCH 027/394] Refactoring + core def. --- sha3/proof/Common.ec | 61 ++++++++++++++++++++++ sha3/proof/{Definitions.ec => TopLevel.ec} | 9 ++-- 2 files changed, 66 insertions(+), 4 deletions(-) create mode 100644 sha3/proof/Common.ec rename sha3/proof/{Definitions.ec => TopLevel.ec} (94%) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec new file mode 100644 index 0000000..cace21f --- /dev/null +++ b/sha3/proof/Common.ec @@ -0,0 +1,61 @@ +(* -------------------------------------------------------------------- *) +require import Fun Pair Int Real List NewDistr. +require (*--*) FinType NewMonoid. + +(* -------------------------------------------------------------------- *) +theory BitWord. +type bword. + +op zero : bword. +op (^) : bword -> bword -> bword. + +clone include NewMonoid + with + type t <- bword, + op idm <- zero, + op (+) <- (^) + proof Axioms.* by admit. + +clone FinType with type t <- bword + proof * by admit. + +op w2bits : bword -> bool list. +op bits2w : bool list -> bword. +op size : { int | 0 < size } as gt0_size. + +lemma w2bitsK : cancel w2bits bits2w. +proof. admit. qed. + +lemma bits2wK (s : bool list) : + size s = size => w2bits (bits2w s) = s. +proof. admit. qed. + +op uniform : bword distr = + MUniform.duniform FinType.elts. +end BitWord. + +(* -------------------------------------------------------------------- *) +op r : { int | 0 < r } as gt0_r. +op c : { int | 0 < c } as gt0_c. + +type block. (* ~ bitstrings of size r *) +type capacity. (* ~ bitstrings of size c *) + +(* -------------------------------------------------------------------- *) +clone BitWord as Capacity with + type bword <- capacity, + op size <- c + proof * by apply/gt0_c + + rename + [op] "zero" as "c0" + [op] "uniform" as "cdistr". + +clone export BitWord as Block with + type bword <- block, + op size <- r + proof * by apply/gt0_r + + rename + [op] "zero" as "b0" + [op] "uniform" as "bdistr". diff --git a/sha3/proof/Definitions.ec b/sha3/proof/TopLevel.ec similarity index 94% rename from sha3/proof/Definitions.ec rename to sha3/proof/TopLevel.ec index f355064..25235f4 100644 --- a/sha3/proof/Definitions.ec +++ b/sha3/proof/TopLevel.ec @@ -4,23 +4,24 @@ require (*--*) IRO LazyRP. (*---*) import Dprod. (* -------------------------------------------------------------------- *) +(* Replay Common.ec *) op r : { int | 0 < r } as gt0_r. op c : { int | 0 < c } as gt0_c. -type block. (* = {0,1}^r *) -type capacity. (* = {0,1}^c *) +type block. +type capacity. op cdist : capacity distr. op bdist : block distr. -(* isomorphic to the {0,1}^? uniform distributions *) - op b0 : block. op c0 : capacity. op b2bits : block -> bool list. op (^) : block -> block -> block. + +(* -------------------------------------------------------------------- *) op pad : bool list -> block list. (* -------------------------------------------------------------------- *) From ca8a2997014966334cd70eb356829cb22b1a9dc0 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Fri, 23 Oct 2015 12:57:48 +0200 Subject: [PATCH 028/394] Refactoring. --- ...entiability.eca => Indifferentiability.ec} | 26 +++++++++++++------ 1 file changed, 18 insertions(+), 8 deletions(-) rename sha3/proof/{Indifferentiability.eca => Indifferentiability.ec} (74%) diff --git a/sha3/proof/Indifferentiability.eca b/sha3/proof/Indifferentiability.ec similarity index 74% rename from sha3/proof/Indifferentiability.eca rename to sha3/proof/Indifferentiability.ec index 6c4514b..178798e 100644 --- a/sha3/proof/Indifferentiability.eca +++ b/sha3/proof/Indifferentiability.ec @@ -1,9 +1,12 @@ +(* -------------------------------------------------------------------- *) +abstract theory Types. (** A primitive: the building block we assume ideal **) -type p_in, p_out. +type p. module type Primitive = { proc init(): unit - proc oracle(x : p_in): p_out + proc f(x : p): p + proc fi(x : p): p }. (** A functionality: the target construction **) @@ -11,7 +14,7 @@ type f_in, f_out. module type Functionality = { proc init(): unit - proc oracle(x : f_in): f_out + proc f(x : f_in): f_out }. (** A construction takes a primitive and builds a functionality. @@ -21,18 +24,24 @@ module type Functionality = { is playing with constructed functionality and ideal primitive or with ideal functionality and simulated primitive). **) module type Construction (P : Primitive) = { - proc init() : unit { } - proc oracle(x : f_in): f_out { P.oracle } + proc init() : unit { } + proc f(x : f_in): f_out { P.f } }. module type Simulator (F : Functionality) = { - proc init() : unit { } - proc oracle(x : p_in): p_out { F.oracle } + proc init() : unit { } + proc f(x : p) : p { F.f } + proc fi(x : p) : p { F.f } }. module type Distinguisher (F : Functionality, P : Primitive) = { - proc distinguish(): bool { P.oracle F.oracle } + proc distinguish(): bool { P.f P.fi F.f } }. +end Types. + +(* -------------------------------------------------------------------- *) +abstract theory Core. +clone import Types. module Indif (F : Functionality, P : Primitive, D : Distinguisher) = { proc main(): bool = { @@ -53,3 +62,4 @@ module Ideal(F:Functionality, S:Simulator) = Indif(F,S(F)). | 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. *) +end Core. From 2badd56bfab214e621aeb92221ce9e04746a6a5e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 23 Oct 2015 15:12:36 +0200 Subject: [PATCH 029/394] Up one level of proof stack. --- sha3/proof/Blocks.ec | 70 +++++++++++++++++++++++++++++++ sha3/proof/Indifferentiability.ec | 45 ++++++++++---------- sha3/proof/TopLevel.ec | 58 +++++++++---------------- 3 files changed, 112 insertions(+), 61 deletions(-) create mode 100644 sha3/proof/Blocks.ec diff --git a/sha3/proof/Blocks.ec b/sha3/proof/Blocks.ec new file mode 100644 index 0000000..a7ae183 --- /dev/null +++ b/sha3/proof/Blocks.ec @@ -0,0 +1,70 @@ +(* -------------------------------------------------------------------- *) +require import Pair Int Real List. +require (*--*) Common IRO LazyRP Indifferentiability. + +op ( * ): 'a NewDistr.distr -> 'b NewDistr.distr -> ('a * 'b) distr. + +(* -------------------------------------------------------------------- *) +clone include Common. + +(* -------------------------------------------------------------------- *) +op valid: block list -> bool. (* is in the image of the padding function *) + +clone import IRO as BIRO with + type from <- block list, + type to <- block, + op valid <- valid. + +clone import LazyRP as Perm with + type D <- block * capacity, + op d <- bdistr * Capacity.cdistr + + rename [module] "P" as "Perm". + +(* -------------------------------------------------------------------- *) +clone include Indifferentiability.Core with + type Types.p <- block * capacity, + type Types.f_in <- block list * int, + type Types.f_out <- block list + + rename + [module] "Indif" as "Experiment" + [module] "al" as "alIndif". +import Types. + +(* -------------------------------------------------------------------- *) +(** Spurious uninitialized variable warning on p *) +module BlockSponge (P : RP) : BIRO.IRO, CONSTRUCTION(P) = { + proc init = P.init + + proc f(p : block list, n : int): block list = { + var z <- []; + var (sa,sc) <- (b0, Capacity.c0); + var i <- 0; + + if (valid p) { + (* Absorption *) + while (p <> []) { + (sa,sc) <@ P.f(sa ^ head b0 p, sc); + p <- behead p; + } + (* Squeezing *) + while (i < n) { + z <- rcons z sa; + (sa,sc) <@ P.f(sa,sc); + } + } + return z; + } +}. + +(* -------------------------------------------------------------------- *) +op eps : real. + +lemma top: + exists (S <: SIMULATOR), + forall (D <: DISTINGUISHER) &m, + `| Pr[Experiment(BlockSponge(Perm), Perm, D).main() @ &m : res] + - Pr[Experiment(IRO, S(IRO), D).main() @ &m : res]| + < eps. +proof. admit. qed. diff --git a/sha3/proof/Indifferentiability.ec b/sha3/proof/Indifferentiability.ec index 178798e..f710925 100644 --- a/sha3/proof/Indifferentiability.ec +++ b/sha3/proof/Indifferentiability.ec @@ -3,16 +3,21 @@ abstract theory Types. (** A primitive: the building block we assume ideal **) type p. -module type Primitive = { +(** A functionality: the target construction **) +type f_in, f_out. +end Types. + +(* -------------------------------------------------------------------- *) +abstract theory Core. +clone import Types. + +module type PRIMITIVE = { proc init(): unit proc f(x : p): p proc fi(x : p): p }. -(** A functionality: the target construction **) -type f_in, f_out. - -module type Functionality = { +module type FUNCTIONALITY = { proc init(): unit proc f(x : f_in): f_out }. @@ -23,27 +28,22 @@ module type Functionality = { 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 : Primitive) = { - proc init() : unit { } +module type CONSTRUCTION (P : PRIMITIVE) = { + proc init() : unit proc f(x : f_in): f_out { P.f } }. -module type Simulator (F : Functionality) = { - proc init() : unit { } +module type SIMULATOR (F : FUNCTIONALITY) = { + proc init() : unit proc f(x : p) : p { F.f } proc fi(x : p) : p { F.f } }. -module type Distinguisher (F : Functionality, P : Primitive) = { +module type DISTINGUISHER (F : FUNCTIONALITY, P : PRIMITIVE) = { proc distinguish(): bool { P.f P.fi F.f } }. -end Types. - -(* -------------------------------------------------------------------- *) -abstract theory Core. -clone import Types. -module Indif (F : Functionality, P : Primitive, D : Distinguisher) = { +module Indif (F : FUNCTIONALITY, P : PRIMITIVE, D : DISTINGUISHER) = { proc main(): bool = { var b; @@ -54,12 +54,13 @@ module Indif (F : Functionality, P : Primitive, D : Distinguisher) = { } }. -module Real(P:Primitive, C:Construction) = Indif(C(P),P). -module Ideal(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), +module Real(P : PRIMITIVE, C : CONSTRUCTION) = Indif(C(P),P). +module Ideal(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. *) -end Core. +end Core. \ No newline at end of file diff --git a/sha3/proof/TopLevel.ec b/sha3/proof/TopLevel.ec index 25235f4..a329f2c 100644 --- a/sha3/proof/TopLevel.ec +++ b/sha3/proof/TopLevel.ec @@ -1,6 +1,6 @@ (* -------------------------------------------------------------------- *) require import Pair Int Real List. -require (*--*) IRO LazyRP. +require (*--*) IRO LazyRP Indifferentiability. (*---*) import Dprod. (* -------------------------------------------------------------------- *) @@ -37,56 +37,36 @@ clone import LazyRP as Perm with rename [module] "P" as "Perm". (* -------------------------------------------------------------------- *) -module type CONSTRUCTION(P : RP) = { - proc init() : unit +clone include Indifferentiability.Core with + type Types.p <- block * capacity, + type Types.f_in <- bool list * int, + type Types.f_out <- bool list - proc f(bp : bool list, n : int) : bool list -}. - -module type SIMULATOR(F : BIRO.IRO) = { - proc init() : unit - - proc f(_ : block * capacity) : block * capacity - - proc fi(_ : block * capacity) : block * capacity -}. - -module type DISTINGUISHER(F : BIRO.IRO, P : RP) = { - proc distinguish() : bool -}. - -(* -------------------------------------------------------------------- *) -module Experiment(F : BIRO.IRO, P : RP, D : DISTINGUISHER) = { - proc main() : bool = { - var b; - - F.init(); - P.init(); - b <@ D(F, P).distinguish(); - - return b; - } -}. + rename + [module] "Indif" as "Experiment" + [module] "al" as "alIndif". +import Types. (* -------------------------------------------------------------------- *) +(** Spurious uninitialized variable warning on p *) module Sponge (P : RP) : BIRO.IRO, CONSTRUCTION(P) = { proc init = P.init proc f(bp : bool list, n : int): bool list = { - var z <- []; - var s <- (b0, c0); - var i <- 0; - var p <- pad bp; + var z <- []; + var (sa,sc) <- (b0, c0); + var i <- 0; + var p <- pad bp; (* Absorption *) while (p <> []) { - s <@ P.f(s.`1 ^ head b0 p, s.`2); - p <- behead p; + (sa,sc) <@ P.f(sa ^ head b0 p, sc); + p <- behead p; } (* Squeezing *) - while (i < n/%r) { - z <- z ++ (b2bits s.`1); - s <@ P.f(s); + while (i < (n + r - 1) /% r) { + z <- z ++ (b2bits sa); + (sa,sc) <@ P.f(sa,sc); } return take n z; From d82a7e0221e3206f8211bdc9e49adb63981b5e20 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 23 Oct 2015 15:59:08 +0200 Subject: [PATCH 030/394] Cleaning up Benjamin's playpen. --- sha3/proof/IRO.eca | 2 +- sha3/proof/LeakyAbsorb.ec | 111 ++++++++++++++++++++++++-------------- 2 files changed, 73 insertions(+), 40 deletions(-) diff --git a/sha3/proof/IRO.eca b/sha3/proof/IRO.eca index a8ff48c..a644a88 100644 --- a/sha3/proof/IRO.eca +++ b/sha3/proof/IRO.eca @@ -27,7 +27,7 @@ module IRO : IRO = { bs <- []; while (n > 0) { b <$ dto; - bs <- b :: bs; + bs <- rcons bs b; n <- n - 1; } return bs; diff --git a/sha3/proof/LeakyAbsorb.ec b/sha3/proof/LeakyAbsorb.ec index 7fb9ffe..1e5e6dd 100644 --- a/sha3/proof/LeakyAbsorb.ec +++ b/sha3/proof/LeakyAbsorb.ec @@ -30,12 +30,6 @@ clone import LazyRP as Perm with rename [module] "P" as "Perm". -clone import IRO as BIRO with - type from <- block list, - type to <- block, - op valid (x : block list) <- true, - op dto <- bdist. - (* -------------------------------------------------------------------- *) module type WeirdIRO = { proc init(): unit @@ -43,12 +37,12 @@ module type WeirdIRO = { proc f(_: block list * int): block list }. -module IdealFunctionality = { - var h : (block list,block) fmap +module IdealFunctionalityThatDoesNotAbsorb = { + var h : (block list * int,block) fmap proc init() = { h = map0; } - proc core(m : block list) = { + proc core(m : block list * int) = { if (!mem (dom h) m) { h.[m] <$ bdist; } @@ -56,14 +50,51 @@ module IdealFunctionality = { } proc f(m : block list, n : int) = { - var i <- 1; - var z <- [b0]; + var i <- 0; + var j <- 1; + var z <- []; + var b <- b0; + + if (m <> []) { + while (i < size m) { + z <- rcons z b; + b <@ core(take i m,0); + i <- i + 1; + } + while (j < n) { + z <- rcons z b; + b <@ core(m,j); + j <- j + 1; + } + } + return z; + } +}. + +module IdealFunctionalityThatAbsorbs = { + var h : (block list * int,block) fmap + + proc init() = { h = map0; } + + proc core (m : block list * int) = { + if (!mem (dom h) m) { + h.[m] <$ bdist; + } + return oget h.[m]; + } + + proc f(m : block list, n : int) = { + var j <- 1; + var z <- []; var b; - m <- m ++ mkseq (fun k => b0) n; - while (i < size m) { - b <@ core(take i m); - z <- rcons z b; + if (m <> []) { + b <@ core(m,0); + while (j < n) { + z <- rcons z b; + b <@ core(m,j); + j <- j + 1; + } } return z; } @@ -111,23 +142,24 @@ module SpongeThatDoesNotAbsorb (P : RP) : WeirdIRO, CONSTRUCTION(P) = { var i <- 0; var l <- size p; - (* Absorption *) - while (p <> []) { - z <- rcons z sa; - (sa,sc) <@ P.f(sa ^ head b0 p, sc); - p <- behead p; - } - (* Squeezing *) - while (i < n/%r) { - z <- rcons z sa; - (sa,sc) <@ P.f(sa,sc); + if (p <> [] /\ nth witness p (size p - 1) <> b0) { + (* Absorption *) + while (p <> []) { + z <- rcons z sa; + (sa,sc) <@ P.f(sa ^ head b0 p, sc); + p <- behead p; + } + (* Squeezing *) + while (i < n) { + z <- rcons z sa; + (sa,sc) <@ P.f(sa,sc); + } } - return drop l z; + return z; } }. -(* -------------------------------------------------------------------- *) module SpongeThatAbsorbs (P : RP) : WeirdIRO, CONSTRUCTION(P) = { proc init = P.init @@ -136,15 +168,17 @@ module SpongeThatAbsorbs (P : RP) : WeirdIRO, CONSTRUCTION(P) = { var (sa,sc) <- (b0, c0); var i <- 0; - (* Absorption *) - while (p <> []) { - (sa,sc) <@ P.f(sa ^ head b0 p, sc); - p <- behead p; - } - (* Squeezing *) - while (i < n/%r) { - z <- rcons z sa; - (sa,sc) <@ P.f(sa,sc); + if (p <> [] /\ nth witness p (size p - 1) <> b0) { + (* Absorption *) + while (p <> []) { + (sa,sc) <@ P.f(sa ^ head b0 p, sc); + p <- behead p; + } + (* Squeezing *) + while (i < n) { + z <- rcons z sa; + (sa,sc) <@ P.f(sa,sc); + } } return z; @@ -158,15 +192,14 @@ axiom core: exists (S <: SIMULATOR), forall (D <: DISTINGUISHER) &m, `| Pr[Experiment(SpongeThatDoesNotAbsorb(Perm), Perm, D).main() @ &m : res] - - Pr[Experiment(IdealFunctionality, S(IdealFunctionality), D).main() @ &m : res]| + - Pr[Experiment(IdealFunctionalityThatDoesNotAbsorb, S(IdealFunctionalityThatDoesNotAbsorb), D).main() @ &m : res]| < eps. - lemma top: exists eps', exists (S <: SIMULATOR), forall (D <: DISTINGUISHER) &m, `| Pr[Experiment(SpongeThatAbsorbs(Perm), Perm, D).main() @ &m : res] - - Pr[Experiment(IRO, S(IRO), D).main() @ &m : res]| + - Pr[Experiment(IdealFunctionalityThatAbsorbs, S(IdealFunctionalityThatAbsorbs), D).main() @ &m : res]| < eps'. proof. admit. (** FILL ME IN **) qed. \ No newline at end of file From 99e4f192644cf4bce4144aaccc305edd668f1467 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 23 Oct 2015 16:00:40 +0200 Subject: [PATCH 031/394] remove unused stuff --- sha3/proof/LeakyAbsorb.ec | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/sha3/proof/LeakyAbsorb.ec b/sha3/proof/LeakyAbsorb.ec index 1e5e6dd..44072f2 100644 --- a/sha3/proof/LeakyAbsorb.ec +++ b/sha3/proof/LeakyAbsorb.ec @@ -18,10 +18,9 @@ op bdist : block distr. op b0 : block. op c0 : capacity. -op b2bits : block -> bool list. op (^) : block -> block -> block. -op pad : bool list -> block list. + (* -------------------------------------------------------------------- *) clone import LazyRP as Perm with From 839144564684133f7d48a86bd1ebe70cc54c0978 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 23 Oct 2015 17:20:04 +0200 Subject: [PATCH 032/394] One more intermediate level. --- sha3/proof/Absorb.ec | 67 +++++++++++++++++++++++++++++++++++++++ sha3/proof/Blocks.ec | 7 ++-- sha3/proof/LeakyAbsorb.ec | 2 +- sha3/proof/RndOrcl.eca | 36 ++++++++++----------- 4 files changed, 91 insertions(+), 21 deletions(-) create mode 100644 sha3/proof/Absorb.ec diff --git a/sha3/proof/Absorb.ec b/sha3/proof/Absorb.ec new file mode 100644 index 0000000..4fb40a6 --- /dev/null +++ b/sha3/proof/Absorb.ec @@ -0,0 +1,67 @@ +(* -------------------------------------------------------------------- *) +require import Option Pair Int Real List. +require (*--*) Common LazyRP RndOrcl Indifferentiability. + +op ( * ): 'a NewDistr.distr -> 'b NewDistr.distr -> ('a * 'b) distr. +op cast: 'a NewDistr.distr -> 'a distr. + +(* -------------------------------------------------------------------- *) +clone include Common. + +(* -------------------------------------------------------------------- *) +op valid: block list -> bool. (* is in the image of the padding function *) +axiom valid_lb m: + valid m => + forall n, m <> mkseq (fun k => b0) n. + +clone import RndOrcl as RO with + type from <- block list, + type to <- block, + op Ideal.sample (x : block list) <- cast bdistr. +clone import Ideal. (* ?? Nested abstract theories... we don't like them *) + +clone import LazyRP as Perm with + type D <- block * capacity, + op d <- bdistr * Capacity.cdistr + + rename [module] "P" as "Perm". + +(* -------------------------------------------------------------------- *) +clone include Indifferentiability.Core with + type Types.p <- block * capacity, + type Types.f_in <- block list, + type Types.f_out <- block + + rename + [module] "Indif" as "Experiment" + [module] "al" as "alIndif". +import Types. + +(* -------------------------------------------------------------------- *) +module BlockSponge (P : RP) : RO, CONSTRUCTION(P) = { + proc init = P.init + + proc f(p : block list): block = { + var (sa,sc) <- (b0, Capacity.c0); + + if (valid p) { + (* Absorption *) + while (p <> []) { + (sa,sc) <@ P.f(sa ^ head b0 p, sc); + p <- behead p; + } + } + return sa; + } +}. + +(* -------------------------------------------------------------------- *) +op eps : real. + +lemma top: + exists (S <: SIMULATOR), + forall (D <: DISTINGUISHER) &m, + `| Pr[Experiment(BlockSponge(Perm), Perm, D).main() @ &m : res] + - Pr[Experiment(RO, S(RO), D).main() @ &m : res]| + < eps. +proof. admit. qed. diff --git a/sha3/proof/Blocks.ec b/sha3/proof/Blocks.ec index a7ae183..a9c448e 100644 --- a/sha3/proof/Blocks.ec +++ b/sha3/proof/Blocks.ec @@ -1,5 +1,5 @@ (* -------------------------------------------------------------------- *) -require import Pair Int Real List. +require import Option Pair Int Real List. require (*--*) Common IRO LazyRP Indifferentiability. op ( * ): 'a NewDistr.distr -> 'b NewDistr.distr -> ('a * 'b) distr. @@ -9,6 +9,9 @@ clone include Common. (* -------------------------------------------------------------------- *) op valid: block list -> bool. (* is in the image of the padding function *) +axiom valid_lb m: + valid m => + m <> [] /\ nth witness m (size m - 1) <> b0. clone import IRO as BIRO with type from <- block list, @@ -42,7 +45,7 @@ module BlockSponge (P : RP) : BIRO.IRO, CONSTRUCTION(P) = { var (sa,sc) <- (b0, Capacity.c0); var i <- 0; - if (valid p) { + if (valid p) { (* Absorption *) while (p <> []) { (sa,sc) <@ P.f(sa ^ head b0 p, sc); diff --git a/sha3/proof/LeakyAbsorb.ec b/sha3/proof/LeakyAbsorb.ec index 44072f2..8695c01 100644 --- a/sha3/proof/LeakyAbsorb.ec +++ b/sha3/proof/LeakyAbsorb.ec @@ -1,6 +1,6 @@ (* -------------------------------------------------------------------- *) require import Option Pair Int Real List FSet NewFMap. -require (*--*) IRO LazyRP. +require (*--*) LazyRP. (*---*) import Dprod. (* -------------------------------------------------------------------- *) diff --git a/sha3/proof/RndOrcl.eca b/sha3/proof/RndOrcl.eca index 09d0322..96d3045 100644 --- a/sha3/proof/RndOrcl.eca +++ b/sha3/proof/RndOrcl.eca @@ -1,4 +1,4 @@ -require import NewFMap. +require import Option FSet NewFMap. (* TODO move this in NewFMap *) lemma dom_set (m:('a,'b) fmap) a b : dom m.[a<-b] = dom m `|` fset1 a. proof. by apply fsetP=> x;smt. qed. @@ -7,11 +7,11 @@ type from, to. module type RO = { proc init() : unit - proc oracle(x : from): to + proc f(x : from): to }. module type Distinguisher(G : RO) = { - proc distinguish(): bool {G.oracle} + proc distinguish(): bool {G.f} }. module IND(G:RO, D:Distinguisher) = { @@ -35,7 +35,7 @@ abstract theory Ideal. m <- map0; } - proc oracle(x : from) : to = { + proc f(x : from) : to = { var rd; rd <$ sample x; if (! mem (dom m) x) m.[x] <- rd; @@ -47,7 +47,7 @@ abstract theory Ideal. axiom sample_ll : forall x, Distr.weight (sample x) = 1%r. - lemma oracle_ll : phoare[RO.oracle : true ==> true] = 1%r. + lemma f_ll : phoare[RO.f : true ==> true] = 1%r. proof. proc;auto;progress;apply sample_ll. qed. end section LL. @@ -67,7 +67,7 @@ abstract theory GenIdeal. var work; work <- RO_dom; while (work <> fset0) { - RO.oracle(pick work); + RO.f(pick work); work = work `\` fset1 (pick work); } } @@ -77,7 +77,7 @@ abstract theory GenIdeal. sample(); } - proc oracle = RO.oracle + proc f = RO.f }. module IND_S(D:Distinguisher) = { @@ -93,7 +93,7 @@ abstract theory GenIdeal. section EAGER. local lemma eager_query: - eager [ERO.sample(); , RO.oracle ~ ERO.oracle, ERO.sample(); : + eager [ERO.sample(); , RO.f ~ ERO.f, ERO.sample(); : ={x,RO.m} ==> ={res,RO.m} ]. proof. eager proc. @@ -112,7 +112,7 @@ abstract theory GenIdeal. cut -> : mem (dom RO.m{2}) (pick work{2}) = mem (dom RO.m{1}) (pick work{2}) by rewrite !in_dom;smt. smt. auto;progress [-split];rewrite !getP_eq;smt. - inline RO.oracle. + inline RO.f. transitivity{1} { rd <$ sample x; while (work <> fset0) { x0 <- pick work; @@ -170,7 +170,7 @@ abstract theory GenIdeal. + by progress;exists (glob D){2}. + proc;inline{2} ERO.sample. while{2} true (card work{2}). - + move=> &m1 z;wp;call (oracle_ll sample_ll);auto;smt. + + move=> &m1 z;wp;call (f_ll sample_ll);auto;smt. conseq (_: _ ==> ={b,glob D}) => //;[smt | by sim]. apply (Eager_S D). qed. @@ -192,7 +192,7 @@ abstract theory FiniteIdeal. var work; work <- univ; while (work <> fset0) { - RO.oracle(pick work); + RO.f(pick work); work = work `\` fset1 (pick work); } } @@ -202,7 +202,7 @@ abstract theory FiniteIdeal. sample(); } - proc oracle(x:from):to = { return oget RO.m.[x]; } + proc f(x:from):to = { return oget RO.m.[x]; } }. module IND_S(D:Distinguisher) = { @@ -282,9 +282,9 @@ abstract theory RestrIdeal. module Restr (O:RO) = { proc init = RO.init - proc oracle (x:from) : to = { + proc f (x:from) : to = { var r <- dfl; - if (test x) r <@ RO.oracle(x); + if (test x) r <@ RO.f(x); return r; } }. @@ -294,7 +294,7 @@ abstract theory RestrIdeal. var work; work <- univ; while (work <> fset0) { - RO.oracle(pick work); + RO.f(pick work); work = work `\` fset1 (pick work); } } @@ -304,7 +304,7 @@ abstract theory RestrIdeal. sample(); } - proc oracle(x:from):to = { + proc f(x:from):to = { return (if test x then oget RO.m.[x] else dfl); } }. @@ -329,9 +329,9 @@ abstract theory RestrIdeal. local module Restr' (O:RO) = { proc init() = { } - proc oracle(x:from) = { + proc f(x:from) = { var r <- dfl; - if (test x) r <@ O.oracle(x); + if (test x) r <@ O.f(x); return r; } }. From 40c83eaf67a0f8700ac72c8f1406603bab7be131 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 26 Oct 2015 18:27:11 +0100 Subject: [PATCH 033/394] Iterating with Alley. Broken state for now. --- sha3/proof/Absorb.ec | 5 +- sha3/proof/AbsorbToBlocks.ec | 125 +++++++++++++++++++++++++++++++++++ sha3/proof/Blocks.ec | 13 ++-- sha3/proof/Common.ec | 2 +- sha3/proof/LeakyAbsorb.ec | 2 +- 5 files changed, 133 insertions(+), 14 deletions(-) create mode 100644 sha3/proof/AbsorbToBlocks.ec diff --git a/sha3/proof/Absorb.ec b/sha3/proof/Absorb.ec index 4fb40a6..89f1b12 100644 --- a/sha3/proof/Absorb.ec +++ b/sha3/proof/Absorb.ec @@ -6,13 +6,10 @@ op ( * ): 'a NewDistr.distr -> 'b NewDistr.distr -> ('a * 'b) distr. op cast: 'a NewDistr.distr -> 'a distr. (* -------------------------------------------------------------------- *) -clone include Common. +require import Common. (* -------------------------------------------------------------------- *) op valid: block list -> bool. (* is in the image of the padding function *) -axiom valid_lb m: - valid m => - forall n, m <> mkseq (fun k => b0) n. clone import RndOrcl as RO with type from <- block list, diff --git a/sha3/proof/AbsorbToBlocks.ec b/sha3/proof/AbsorbToBlocks.ec new file mode 100644 index 0000000..77f1272 --- /dev/null +++ b/sha3/proof/AbsorbToBlocks.ec @@ -0,0 +1,125 @@ +(* -------------------------------------------------------------------- *) +require import Option Pair Int Real List FSet NewFMap. +require (*--*) Absorb Blocks. + +(* -------------------------------------------------------------------- *) +require import Common. + +op ( * ): 'a NewDistr.distr -> 'b NewDistr.distr -> ('a * 'b) distr. +op cast: 'a NewDistr.distr -> 'a distr. + +op extend (bs : block list) (n : int): block list = + bs ++ (mkseq (fun k => b0) n). + +op strip_aux (bs : block list) (n : int) : block list * int = + with bs = [] => ([],n) + with bs = b :: bs => + if b = b0 + then strip_aux bs (n + 1) + else (rev (b :: bs),n). + +op strip (bs : block list) = strip_aux (rev bs) 0. + +op valid_upper (bs : block list) = + bs <> [] /\ + forallb (fun n=> strip (extend bs n) = (bs,n)). + +op valid_lower (bs : block list) = + valid_upper (strip bs).`1. + +(* PY: FIXME *) +clone Absorb as Lower with + op ( * ) <- ( * )<:'a,'b>, + op cast <- cast<:'a>, + op valid <- valid_lower. + +clone Blocks as Upper with + op ( * ) <- ( * )<:'a,'b>, + op valid <- valid_upper. + +(* -------------------------------------------------------------------- *) +module LowerFun( F : Upper.FUNCTIONALITY ) : Lower.FUNCTIONALITY = { + proc init = F.init + + proc f(p : block list): block = { + var b <- []; + var n; + + if (valid_lower p) { + (p,n) <- strip p; + b <@ F.f(p,n + 1); + } + return last b0 b; + } +}. + +module Sim ( S : Lower.SIMULATOR, F : Upper.FUNCTIONALITY ) = S(LowerFun(F)). + +module UpperFun ( F : Lower.FUNCTIONALITY ) = { + proc init = F.init + + proc f(p : block list, n : int) : block list = { + var b <- b0; + var bs <- []; + var i <- 0; + + if (valid_upper p) { + while (i < n) { + b <@ F.f(extend p i); + bs <- rcons bs b; + i <- i + 1; + } + } + + return bs; + } +}. + +module Dist ( D : Upper.DISTINGUISHER, F : Lower.FUNCTIONALITY, P : Lower.PRIMITIVE ) = D(UpperFun(F),P). + +section. + declare module LowerSim : Lower.SIMULATOR. + declare module UpperDist : Upper.DISTINGUISHER { LowerSim }. + + local equiv ModularUpper: + UpperFun(Lower.BlockSponge(Lower.Perm.Perm)).f ~ Upper.BlockSponge(Upper.Perm.Perm).f: + ={arg} + /\ ={m,mi}(Lower.Perm.Perm,Upper.Perm.Perm) + /\ (forall x, mem (dom Lower.Perm.Perm.m){1} x) + ==> ={res} + /\ ={m,mi}(Lower.Perm.Perm,Upper.Perm.Perm) + /\ (forall x, mem (dom Lower.Perm.Perm.m){1} x). + proof. + proc. sp; if=> //=. + inline Lower.BlockSponge(Lower.Perm.Perm).f. + admit. (* Fun with loops *) + qed. + + pred relation (ro : (block list,block) fmap) (iro : (block list,block list) fmap) = + (forall x y, iro.[x] = Some y => + forall i, 0 <= i < size y => ro.[extend x i] = onth y i) + /\ (forall x y, ro.[x] = Some y => + let (x',n) = strip x in + mem (dom iro) x + /\ size (oget iro.[x]) >= n + /\ nth witness (oget iro.[x]) n = y). + + local equiv ModularLower: + UpperFun(Lower.Ideal.RO).f ~ Upper.BIRO.IRO.f: + ={arg} + /\ relation Lower.Ideal.RO.m{1} Upper.BIRO.IRO.mp{2} + ==> ={res} + /\ relation Lower.Ideal.RO.m{1} Upper.BIRO.IRO.mp{2}. + proof. + proc. sp; if=> //=. + inline Lower.BlockSponge(Lower.Perm.Perm).f. + admit. (* Fun with loops *) + qed. + + lemma Conclusion &m: + `|Pr[Upper.RealIndif(Upper.Perm.Perm,Upper.BlockSponge,UpperDist).main() @ &m: res] + - Pr[Upper.IdealIndif(Upper.BIRO.IRO,Sim(LowerSim),UpperDist).main() @ &m: res]| + = `|Pr[Lower.RealIndif(Lower.Perm.Perm,Lower.BlockSponge,Dist(UpperDist)).main() @ &m: res] + - Pr[Lower.IdealIndif(Lower.Ideal.RO,LowerSim,Dist(UpperDist)).main() @ &m: res]|. + proof. admit. qed. +end section. diff --git a/sha3/proof/Blocks.ec b/sha3/proof/Blocks.ec index a9c448e..0d0ca6d 100644 --- a/sha3/proof/Blocks.ec +++ b/sha3/proof/Blocks.ec @@ -5,18 +5,15 @@ require (*--*) Common IRO LazyRP Indifferentiability. op ( * ): 'a NewDistr.distr -> 'b NewDistr.distr -> ('a * 'b) distr. (* -------------------------------------------------------------------- *) -clone include Common. +require import Common. (* -------------------------------------------------------------------- *) -op valid: block list -> bool. (* is in the image of the padding function *) -axiom valid_lb m: - valid m => - m <> [] /\ nth witness m (size m - 1) <> b0. +op valid: block list -> bool. clone import IRO as BIRO with - type from <- block list, - type to <- block, - op valid <- valid. + type from <- block list, + type to <- block, + op valid <- valid. clone import LazyRP as Perm with type D <- block * capacity, diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index cace21f..8df87b9 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -31,7 +31,7 @@ lemma bits2wK (s : bool list) : proof. admit. qed. op uniform : bword distr = - MUniform.duniform FinType.elts. + MUniform.duniform FinType.enum. end BitWord. (* -------------------------------------------------------------------- *) diff --git a/sha3/proof/LeakyAbsorb.ec b/sha3/proof/LeakyAbsorb.ec index 8695c01..077ecb1 100644 --- a/sha3/proof/LeakyAbsorb.ec +++ b/sha3/proof/LeakyAbsorb.ec @@ -55,7 +55,7 @@ module IdealFunctionalityThatDoesNotAbsorb = { var b <- b0; if (m <> []) { - while (i < size m) { + while (i <= size m) { z <- rcons z b; b <@ core(take i m,0); i <- i + 1; From a0012a07501abcbb4d984d98cea6d24d81babdad Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 23 Oct 2015 17:36:15 +0200 Subject: [PATCH 034/394] Some try --- sha3/proof/LeakyAbsorb.ec | 87 +++++++++++++++++++++++++-------------- 1 file changed, 57 insertions(+), 30 deletions(-) diff --git a/sha3/proof/LeakyAbsorb.ec b/sha3/proof/LeakyAbsorb.ec index 077ecb1..1c3710f 100644 --- a/sha3/proof/LeakyAbsorb.ec +++ b/sha3/proof/LeakyAbsorb.ec @@ -1,6 +1,6 @@ (* -------------------------------------------------------------------- *) require import Option Pair Int Real List FSet NewFMap. -require (*--*) LazyRP. +require (*--*) LazyRP RndOrcl. (*---*) import Dprod. (* -------------------------------------------------------------------- *) @@ -18,10 +18,8 @@ op bdist : block distr. op b0 : block. op c0 : capacity. - op (^) : block -> block -> block. - (* -------------------------------------------------------------------- *) clone import LazyRP as Perm with type D <- block * capacity, @@ -29,6 +27,7 @@ clone import LazyRP as Perm with rename [module] "P" as "Perm". + (* -------------------------------------------------------------------- *) module type WeirdIRO = { proc init(): unit @@ -36,12 +35,20 @@ module type WeirdIRO = { proc f(_: block list * int): block list }. +module type WeirdIRO_ = { + proc f(_: block list * int): block list +}. + +op valid_query : block list -> int -> bool. +op valid_queries : (block list) fset. +axiom valid_queryP : forall m n, valid_query m n => mem valid_queries (m ++ n). + module IdealFunctionalityThatDoesNotAbsorb = { - var h : (block list * int,block) fmap + var h : (block list,block) fmap proc init() = { h = map0; } - proc core(m : block list * int) = { + proc core(m : block list) = { if (!mem (dom h) m) { h.[m] <$ bdist; } @@ -49,20 +56,21 @@ module IdealFunctionalityThatDoesNotAbsorb = { } proc f(m : block list, n : int) = { - var i <- 0; + var i <- 1; var j <- 1; var z <- []; var b <- b0; - if (m <> []) { - while (i <= size m) { + if (valid_query m n) { + while (j <= size m) { z <- rcons z b; - b <@ core(take i m,0); - i <- i + 1; + b <@ core(take j m); + j <- j + 1; } - while (j < n) { + while (i < n) { z <- rcons z b; - b <@ core(m,j); + m <- rcons m b0; + b <@ core(m); j <- j + 1; } } @@ -71,27 +79,17 @@ module IdealFunctionalityThatDoesNotAbsorb = { }. module IdealFunctionalityThatAbsorbs = { - var h : (block list * int,block) fmap - - proc init() = { h = map0; } - - proc core (m : block list * int) = { - if (!mem (dom h) m) { - h.[m] <$ bdist; - } - return oget h.[m]; - } - proc f(m : block list, n : int) = { var j <- 1; var z <- []; var b; - if (m <> []) { - b <@ core(m,0); + if (valid_query m n) { + b <@ IdealFunctionalityThatDoesNotAbsorb.core(m); while (j < n) { z <- rcons z b; - b <@ core(m,j); + m <- rcons m b0; + b <@ IdealFunctionalityThatDoesNotAbsorb.core(m); j <- j + 1; } } @@ -114,8 +112,8 @@ module type SIMULATOR(F : WeirdIRO) = { proc fi(_ : block * capacity) : block * capacity }. -module type DISTINGUISHER(F : WeirdIRO, P : RP) = { - proc distinguish() : bool +module type DISTINGUISHER(F : WeirdIRO_, P : RP_) = { + proc distinguish() : bool }. (* -------------------------------------------------------------------- *) @@ -141,7 +139,7 @@ module SpongeThatDoesNotAbsorb (P : RP) : WeirdIRO, CONSTRUCTION(P) = { var i <- 0; var l <- size p; - if (p <> [] /\ nth witness p (size p - 1) <> b0) { + if (valid_query p n) { (* Absorption *) while (p <> []) { z <- rcons z sa; @@ -167,7 +165,7 @@ module SpongeThatAbsorbs (P : RP) : WeirdIRO, CONSTRUCTION(P) = { var (sa,sc) <- (b0, c0); var i <- 0; - if (p <> [] /\ nth witness p (size p - 1) <> b0) { + if (valid_query p n) { (* Absorption *) while (p <> []) { (sa,sc) <@ P.f(sa ^ head b0 p, sc); @@ -185,6 +183,35 @@ module SpongeThatAbsorbs (P : RP) : WeirdIRO, CONSTRUCTION(P) = { }. (* -------------------------------------------------------------------- *) +section PROOF. + declare module S:SIMULATOR { IdealFunctionalityThatDoesNotAbsorb }. + declare module D:DISTINGUISHER { Perm, IdealFunctionalityThatDoesNotAbsorb, S }. + + (* From DoNot to Absorb *) + + module MkF(F:WeirdIRO_) = { + proc f(m:block list, n:int) = { + var r = []; + if (valid_query m n) { + r <@ F.f(m,n); + r <- drop (size m) r; + } + return r; + } + }. + + module MkD (D:DISTINGUISHER, F:WeirdIRO, P:RP) = D(MkF(F),P). + + lemma conclusion &m: + `| Pr[Experiment(SpongeThatDoesNotAbsorb(Perm), Perm, MkD(D)).main() @ &m : res] + - Pr[Experiment(IdealFunctionalityThatDoesNotAbsorb, + S(IdealFunctionalityThatDoesNotAbsorb), MkD(D)).main() @ &m : res] | = + `|Pr[Experiment(SpongeThatAbsorb(Perm),Perm,D).main() @ &m : res] - + -Pr[Experiment(IdealFunctionalityThatAbsorb, + S(IdealFunctionalityThatAbsorb), D) + + + op eps : real. axiom core: From 44a915f958ac782106b65291d48105f1b89aa786 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 26 Oct 2015 09:26:01 +0100 Subject: [PATCH 035/394] some progress --- sha3/proof/LeakyAbsorb.ec | 60 +++++++++++++++++++++++++++++++++------ 1 file changed, 52 insertions(+), 8 deletions(-) diff --git a/sha3/proof/LeakyAbsorb.ec b/sha3/proof/LeakyAbsorb.ec index 1c3710f..0943045 100644 --- a/sha3/proof/LeakyAbsorb.ec +++ b/sha3/proof/LeakyAbsorb.ec @@ -41,7 +41,7 @@ module type WeirdIRO_ = { op valid_query : block list -> int -> bool. op valid_queries : (block list) fset. -axiom valid_queryP : forall m n, valid_query m n => mem valid_queries (m ++ n). +axiom valid_queryP : forall m n, valid_query m n => mem valid_queries (m ++ map (fun x => b0) (iota_ 0 n)). module IdealFunctionalityThatDoesNotAbsorb = { var h : (block list,block) fmap @@ -79,6 +79,8 @@ module IdealFunctionalityThatDoesNotAbsorb = { }. module IdealFunctionalityThatAbsorbs = { + proc init = IdealFunctionalityThatDoesNotAbsorb.init + proc f(m : block list, n : int) = { var j <- 1; var z <- []; @@ -131,7 +133,7 @@ module Experiment(F : WeirdIRO, P : RP, D : DISTINGUISHER) = { (* -------------------------------------------------------------------- *) module SpongeThatDoesNotAbsorb (P : RP) : WeirdIRO, CONSTRUCTION(P) = { - proc init = P.init + proc init () = { } proc f(p : block list, n : int): block list = { var z <- []; @@ -158,7 +160,7 @@ module SpongeThatDoesNotAbsorb (P : RP) : WeirdIRO, CONSTRUCTION(P) = { }. module SpongeThatAbsorbs (P : RP) : WeirdIRO, CONSTRUCTION(P) = { - proc init = P.init + proc init () = {} proc f(p : block list, n : int): block list = { var z <- []; @@ -199,16 +201,58 @@ section PROOF. return r; } }. - - module MkD (D:DISTINGUISHER, F:WeirdIRO, P:RP) = D(MkF(F),P). + + (* From Absord to do Not *) + module MkD (D:DISTINGUISHER, F:WeirdIRO_, P:RP_) = D(MkF(F),P). + + module MkFdoNot (F:WeirdIRO) = { + proc init = F.init + proc f(m:block list, n:int) : block list = { + var i, r, tl, b; + r <- []; + if (valid_query m n) { + i <- 0; + while (i < size m - 1) { + b <- F.f(take i m, 1); + i <- i + 1; + r <- r ++ b; + } + tl <- F.f(m,n); + r <- r ++ tl; + } + return r; + } + }. + + module MkS(S:SIMULATOR, F:WeirdIRO) = S(MkFdoNot(F)). + + local clone lemma conclusion &m: `| Pr[Experiment(SpongeThatDoesNotAbsorb(Perm), Perm, MkD(D)).main() @ &m : res] - Pr[Experiment(IdealFunctionalityThatDoesNotAbsorb, S(IdealFunctionalityThatDoesNotAbsorb), MkD(D)).main() @ &m : res] | = - `|Pr[Experiment(SpongeThatAbsorb(Perm),Perm,D).main() @ &m : res] - - -Pr[Experiment(IdealFunctionalityThatAbsorb, - S(IdealFunctionalityThatAbsorb), D) + `|Pr[Experiment(SpongeThatAbsorbs(Perm),Perm,D).main() @ &m : res] - + -Pr[Experiment(IdealFunctionalityThatAbsorbs, MkS(S,IdealFunctionalityThatAbsorbs), D).main() @ &m : res]|. + proof. + congr;congr. + + byequiv (_: ={glob D} ==> _) => //;proc;inline *. + call (_: ={glob Perm});1,2:(by sim); last by auto. + proc;inline{1}SpongeThatDoesNotAbsorb(Perm).f;sp 1 3;if=> //. + sp;rcondt{1} 1=> //;wp. + while (={glob Perm, i, sa, sc} /\ n0{1} = n{2} /\ z{1} = take (size m{1}) z{1} ++ z{2} /\ size m{1} <= size z{1}). + + call (_ : ={glob Perm});[by sim|auto;progress [-split];smt]. + while (={glob Perm, p, sa,sc} /\ (size z = size m - size p){1}). + + wp;call (_ : ={glob Perm});[by sim|auto;progress [-split];smt]. + by auto;progress [-split];smt. + + + auto. + +smt. smt. +search drop. + +sim. + From efb7df0b5e086cdd4880fdb72cab4f6cff0c3801 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 26 Oct 2015 19:36:40 +0100 Subject: [PATCH 036/394] absorbs <-> does not absurd --- sha3/proof/LeakyAbsorb.ec | 255 +++++++++++++++++++++++++++++--------- 1 file changed, 198 insertions(+), 57 deletions(-) diff --git a/sha3/proof/LeakyAbsorb.ec b/sha3/proof/LeakyAbsorb.ec index 0943045..5b487ee 100644 --- a/sha3/proof/LeakyAbsorb.ec +++ b/sha3/proof/LeakyAbsorb.ec @@ -1,17 +1,16 @@ (* -------------------------------------------------------------------- *) -require import Option Pair Int Real List FSet NewFMap. -require (*--*) LazyRP RndOrcl. +require import Option Pair Int Real Distr List FSet NewFMap. +require (*--*) LazyRP RndOrcl. (*---*) import Dprod. (* -------------------------------------------------------------------- *) -op r : { int | 0 < r } as gt0_r. -op c : { int | 0 < c } as gt0_c. type block. (* = {0,1}^r *) type capacity. (* = {0,1}^c *) op cdist : capacity distr. op bdist : block distr. +axiom bdist_ll : weight bdist = 1%r. (* isomorphic to the {0,1}^? uniform distributions *) @@ -41,19 +40,32 @@ module type WeirdIRO_ = { op valid_query : block list -> int -> bool. op valid_queries : (block list) fset. -axiom valid_queryP : forall m n, valid_query m n => mem valid_queries (m ++ map (fun x => b0) (iota_ 0 n)). +axiom valid_queryP : forall m n, valid_query m n => forall k, 0 <= k <= n => mem valid_queries (m ++ map (fun x => b0) (iota_ 0 k)). +axiom valid_query_take : forall m n, valid_query m n => forall i, 0 <= i <= size m => mem valid_queries (take i m). +axiom valid_query_take1 : + forall m n, valid_query m n => forall i, 0 <= i <= size m => valid_query (take i m) 1. +axiom valid_query_size : forall m n, valid_query m n => 1 <= size m. + +module type RO = { + proc init () : unit + proc f(_:block list) : block +}. -module IdealFunctionalityThatDoesNotAbsorb = { +module Ro = { var h : (block list,block) fmap proc init() = { h = map0; } - proc core(m : block list) = { - if (!mem (dom h) m) { - h.[m] <$ bdist; - } + proc f(m : block list) = { + var r; + r <$ bdist; + if (!mem (dom h) m) h.[m] <- r ; return oget h.[m]; } +}. + +module GenIdealFunctionalityThatDoesNotAbsorb(Ro:RO) = { + proc init = Ro.init proc f(m : block list, n : int) = { var i <- 1; @@ -64,41 +76,45 @@ module IdealFunctionalityThatDoesNotAbsorb = { if (valid_query m n) { while (j <= size m) { z <- rcons z b; - b <@ core(take j m); + b <@ Ro.f(take j m); j <- j + 1; } while (i < n) { z <- rcons z b; m <- rcons m b0; - b <@ core(m); - j <- j + 1; + b <@ Ro.f(m); + i <- i + 1; } } return z; } }. -module IdealFunctionalityThatAbsorbs = { - proc init = IdealFunctionalityThatDoesNotAbsorb.init +module IdealFunctionalityThatDoesNotAbsorb = GenIdealFunctionalityThatDoesNotAbsorb(Ro). + +module GenIdealFunctionalityThatAbsorbs(Ro:RO) = { + proc init = Ro.init proc f(m : block list, n : int) = { - var j <- 1; + var i <- 1; var z <- []; var b; if (valid_query m n) { - b <@ IdealFunctionalityThatDoesNotAbsorb.core(m); - while (j < n) { + b <@ Ro.f(m); + while (i < n) { z <- rcons z b; m <- rcons m b0; - b <@ IdealFunctionalityThatDoesNotAbsorb.core(m); - j <- j + 1; + b <@ Ro.f(m); + i<- i + 1; } } return z; } }. +module IdealFunctionalityThatAbsorbs = GenIdealFunctionalityThatAbsorbs(Ro). + (* -------------------------------------------------------------------- *) module type CONSTRUCTION(P : RP) = { proc init() : unit @@ -106,7 +122,7 @@ module type CONSTRUCTION(P : RP) = { proc f(bp : block list, n : int) : block list }. -module type SIMULATOR(F : WeirdIRO) = { +module type SIMULATOR(F : WeirdIRO_) = { proc init() : unit proc f(_ : block * capacity) : block * capacity @@ -205,17 +221,18 @@ section PROOF. (* From Absord to do Not *) module MkD (D:DISTINGUISHER, F:WeirdIRO_, P:RP_) = D(MkF(F),P). - module MkFdoNot (F:WeirdIRO) = { - proc init = F.init + module MkFdoNot1 (F:WeirdIRO_) = { proc f(m:block list, n:int) : block list = { var i, r, tl, b; r <- []; if (valid_query m n) { - i <- 0; - while (i < size m - 1) { + i <- 1; + b <- [b0]; + while (i <= size m) { + r <- r ++ b; b <- F.f(take i m, 1); i <- i + 1; - r <- r ++ b; + } tl <- F.f(m,n); r <- r ++ tl; @@ -224,16 +241,127 @@ section PROOF. } }. + module MkFdoNot (F:WeirdIRO) = { + proc init = F.init + proc f = MkFdoNot1(F).f + }. + module MkS(S:SIMULATOR, F:WeirdIRO) = S(MkFdoNot(F)). - local clone + local clone RndOrcl as RndOrcl0 with + type from <- block list, + type to <- block. + + local clone RndOrcl0.RestrIdeal as RI with + op sample <- fun (bl:block list) => bdist, + op test <- (mem valid_queries), + op univ <- valid_queries, + op dfl <- b0 + proof *. + realize sample_ll. by move=> _;apply bdist_ll. qed. + realize testP. by []. qed. + import RI. + + local module E1 (Ro:RO) = { + module F = { + proc f = GenIdealFunctionalityThatDoesNotAbsorb(Ro).f + } + module P = S(F) + proc distinguish () : bool = { + var b; + P.init(); + b <@ MkD(D, F, P).distinguish(); + return b; + } + }. + + local module E2 (Ro:RO) = { + module F = { + proc f = GenIdealFunctionalityThatAbsorbs(Ro).f + } + module P = S(MkFdoNot1(F)) + proc distinguish () : bool = { + var b; + P.init(); + b <@ D(F, P).distinguish(); + return b; + } + }. + + local equiv f_f : + GenIdealFunctionalityThatDoesNotAbsorb(Ro).f ~ E1(Restr(RO)).F.f : + ={m, n} /\ Ro.h{1} = RO.m{2} ==> ={res} /\ Ro.h{1} = RO.m{2}. + proof. + proc;sp;if => //. + inline{2} Restr(RO).f. + while (={z,i,n,b,m} /\ Ro.h{1} = RO.m{2} /\ + (forall k, 0 <= k <= n - i => mem valid_queries (m ++ map (fun x => b0) (iota_ 0 k))){2}). + + rcondt{2} 5=> //. + + auto;progress; rewrite - cats1;cut := H 1 _; [by smt| by rewrite iota1]. + auto; call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress]. + cut := H (k+1) _;1:by smt. + rewrite iotaS //= -cats1 -catA /= (_: map (fun (x : int) => b0) (iota_ 1 k) = map (fun (x : int) => b0) (iota_ 0 k)) //. + by rewrite (iota_addl 1 0 k) -map_comp;apply eq_map. + while (={z,j,n,b,m} /\ Ro.h{1} = RO.m{2} /\ valid_query m{1} n{1} /\ 0 <= j{1}). + + rcondt{2} 4=> //. + + auto;progress;apply (valid_query_take _ _ H)=> //. + auto; call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress;smt]. + skip;progress;apply (valid_queryP _ _ H2);smt. + qed. + + local equiv f_f_a : GenIdealFunctionalityThatAbsorbs(Ro).f ~ E2(Restr(RO)).F.f : ={m,n} /\ Ro.h{1} = RO.m{2} ==> ={res} /\ Ro.h{1} = RO.m{2}. + proof. + proc; sp;if=> //;inline{2} Restr(RO).f;sp. + rcondt{2} 1=> //. + + auto;progress;cut := valid_query_take _ _ H (size m{hr}). + rewrite take_size=> HH;apply HH;smt. + while (={z,i,n,b,m} /\ Ro.h{1} = RO.m{2} /\ + (forall k, 0 <= k <= n - i => mem valid_queries (m ++ map (fun x => b0) (iota_ 0 k))){2}). + + rcondt{2} 5=> //. + + auto;progress; rewrite -cats1;cut := H 1 _; [by smt| by rewrite iota1]. + auto; call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress]. + cut := H (k+1) _;1:by smt. + rewrite iotaS //= -cats1 -catA /= (_: map (fun (x : int) => b0) (iota_ 1 k) = map (fun (x : int) => b0) (iota_ 0 k)) //. + by rewrite (iota_addl 1 0 k) -map_comp;apply eq_map. + wp;call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress]. + apply (valid_queryP _ _ H);smt. + qed. + + local equiv f_f' : + MkFdoNot(GenIdealFunctionalityThatAbsorbs(Ro)).f ~ MkFdoNot1(E2(Restr(RO)).F).f : + ={m, n} /\ Ro.h{1} = RO.m{2} ==> + ={res} /\ Ro.h{1} = RO.m{2}. + proof. + proc;sp;if => //;wp. + call f_f_a. + while (={i,m,r,b} /\ Ro.h{1} = RO.m{2} /\ valid_query m{1} n{1} /\ 0 <= i{1});last by auto. + wp; call f_f_a;auto;progress;smt. + qed. + + local equiv f_dN : E1(ERO).F.f ~ MkFdoNot1(E2(ERO).F).f : ={m, n} /\ ={RO.m} ==> ={res, RO.m}. + proof. + proc;sp;if=> //;sp. + inline {2} E2(ERO).F.f. + rcondt{2} 6;auto; 1: by conseq (_: _ ==> true). + while (={RO.m} /\ z{1} = r{2} ++ z0{2} /\ i{1} = i1{2} /\ n{1} = n1{2} /\ b{1} = b1{2} /\ + m{1} = m1{2}). + + inline *;auto;progress;smt. + inline ERO.f;auto. + while (={RO.m,m,n} /\ z{1} = r{2} /\ b{2} = [b{1}] /\ valid_query m{1} n{1} /\ + j{1} = i{2} /\ 0 <= i{2} /\ + (1 < j => b = mem valid_queries (take j m) ? oget RO.m.[x] : Self.b0){1}). + + rcondt{2} 6;1:by auto;progress;smt. + rcondf{2} 8;1:by auto. + auto;progress;smt. + auto;progress;smt. + qed. lemma conclusion &m: `| Pr[Experiment(SpongeThatDoesNotAbsorb(Perm), Perm, MkD(D)).main() @ &m : res] - Pr[Experiment(IdealFunctionalityThatDoesNotAbsorb, S(IdealFunctionalityThatDoesNotAbsorb), MkD(D)).main() @ &m : res] | = - `|Pr[Experiment(SpongeThatAbsorbs(Perm),Perm,D).main() @ &m : res] - - -Pr[Experiment(IdealFunctionalityThatAbsorbs, MkS(S,IdealFunctionalityThatAbsorbs), D).main() @ &m : res]|. + `|Pr[Experiment(SpongeThatAbsorbs(Perm),Perm,D).main() @ &m : res] + - Pr[Experiment(IdealFunctionalityThatAbsorbs, MkS(S,IdealFunctionalityThatAbsorbs), D).main() @ &m : res]|. proof. congr;congr. + byequiv (_: ={glob D} ==> _) => //;proc;inline *. @@ -245,31 +373,44 @@ section PROOF. while (={glob Perm, p, sa,sc} /\ (size z = size m - size p){1}). + wp;call (_ : ={glob Perm});[by sim|auto;progress [-split];smt]. by auto;progress [-split];smt. - + - auto. - -smt. smt. -search drop. - -sim. - - - - -op eps : real. - -axiom core: - exists (S <: SIMULATOR), - forall (D <: DISTINGUISHER) &m, - `| Pr[Experiment(SpongeThatDoesNotAbsorb(Perm), Perm, D).main() @ &m : res] - - Pr[Experiment(IdealFunctionalityThatDoesNotAbsorb, S(IdealFunctionalityThatDoesNotAbsorb), D).main() @ &m : res]| - < eps. - -lemma top: - exists eps', - exists (S <: SIMULATOR), - forall (D <: DISTINGUISHER) &m, - `| Pr[Experiment(SpongeThatAbsorbs(Perm), Perm, D).main() @ &m : res] - - Pr[Experiment(IdealFunctionalityThatAbsorbs, S(IdealFunctionalityThatAbsorbs), D).main() @ &m : res]| - < eps'. -proof. admit. (** FILL ME IN **) qed. \ No newline at end of file + cut -> : Pr[Experiment(IdealFunctionalityThatDoesNotAbsorb, S(IdealFunctionalityThatDoesNotAbsorb), MkD(D)).main () @ &m : res] = + Pr[RndOrcl0.IND(Restr(RO), E1).main() @ &m : res]. + + byequiv=> //. (* PY: BUG printer res *) + proc;inline{2} E1(Restr(RO)).distinguish;auto. + call (_: ={glob S} /\ Ro.h{1} = RO.m{2}). + + by proc (Ro.h{1} = RO.m{2}) => //;apply f_f. + + by proc (Ro.h{1} = RO.m{2}) => //;apply f_f. + + by proc;sp;if=> //;wp;call f_f. + by inline *; call (_: Ro.h{1} = RO.m{2});auto;apply f_f. + cut -> : Pr[Experiment(IdealFunctionalityThatAbsorbs, MkS(S, IdealFunctionalityThatAbsorbs), D).main() @ &m : res] = + Pr[RndOrcl0.IND(Restr(RO), E2).main() @ &m : res]. + + byequiv=> //. + proc;inline{2} E2(Restr(RO)).distinguish;auto. + call (_: ={glob S} /\ Ro.h{1} = RO.m{2}). + + proc (Ro.h{1} = RO.m{2}) => //; apply f_f'. + + by proc (Ro.h{1} = RO.m{2}) => //;apply f_f'. + + conseq f_f_a => //. + by inline *;call (_:Ro.h{1} = RO.m{2});[apply f_f'|auto]. + cut -> : Pr[RndOrcl0.IND(Restr(RO), E1).main() @ &m : res] = + Pr[RndOrcl0.IND(ERO, E1).main() @ &m : res]. + + byequiv (Eager E1)=> //. + cut -> : Pr[RndOrcl0.IND(Restr(RO), E2).main() @ &m : res] = + Pr[RndOrcl0.IND(ERO, E2).main() @ &m : res]. + + byequiv (Eager E2)=> //. + byequiv=> //. + proc; inline *;wp. + call (_: ={RO.m, glob S}). + + by proc (={RO.m})=> //;apply f_dN. + + by proc (={RO.m})=> //;apply f_dN. + + proc;sp;if => //. + inline{1} E1(ERO).F.f;sp;rcondt{1} 1; 1:by auto. + wp;while (={RO.m,i,b} /\ n0{1} = n{2} /\ m0{1} = m{2} /\ z{1} = take (size m{1}) z{1} ++ z{2} /\ (size m <= size z){1}). + + inline *;auto;progress [-split]; smt. + inline *;splitwhile{1} 1 : (j < size m0). + wp;seq 1 0 : (={i,RO.m, m, glob S} /\ n0{1} = n{2} /\ m0{1} = m{2} /\ size m0{1} - 1 = size z{1} /\ size m0{1} = j{1} /\ z{2} = []). + while{1} (size z{1} = j{1} - 1 /\ j{1} <= size m0{1}) ((size m0 - j){1});auto;progress [-split]; smt. + rcondt{1} 1;1:by auto. + rcondf{1} 5;auto;progress[-split];smt. + call (_: ={RO.m})=> //;1:by apply f_dN. + sim : (={glob S, glob D, RO.m})=> //. + qed. From e22509a463107e74274cc7824d881dcb391c2e6d Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 27 Oct 2015 10:42:38 +0100 Subject: [PATCH 037/394] Intermediate lemma. --- sha3/proof/AbsorbToBlocks.ec | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/sha3/proof/AbsorbToBlocks.ec b/sha3/proof/AbsorbToBlocks.ec index 77f1272..b9dd5e9 100644 --- a/sha3/proof/AbsorbToBlocks.ec +++ b/sha3/proof/AbsorbToBlocks.ec @@ -75,6 +75,8 @@ module UpperFun ( F : Lower.FUNCTIONALITY ) = { } }. +module UpperOfLowerBlockSponge (P : Upper.PRIMITIVE) = UpperFun(Lower.BlockSponge(P)). + module Dist ( D : Upper.DISTINGUISHER, F : Lower.FUNCTIONALITY, P : Lower.PRIMITIVE ) = D(UpperFun(F),P). section. @@ -116,6 +118,15 @@ section. admit. (* Fun with loops *) qed. +print Upper.RealIndif. + + lemma Intermediate &m: + `|Pr[Upper.RealIndif(Upper.Perm.Perm,UpperOfLowerBlockSponge,UpperDist).main() @ &m: res] + - Pr[Upper.IdealIndif(UpperFun(Lower.Ideal.RO),Sim(LowerSim),UpperDist).main() @ &m: res]| + = `|Pr[Lower.RealIndif(Lower.Perm.Perm,Lower.BlockSponge,Dist(UpperDist)).main() @ &m: res] + - Pr[Lower.IdealIndif(Lower.Ideal.RO,LowerSim,Dist(UpperDist)).main() @ &m: res]|. + proof. admit. qed. + lemma Conclusion &m: `|Pr[Upper.RealIndif(Upper.Perm.Perm,Upper.BlockSponge,UpperDist).main() @ &m: res] - Pr[Upper.IdealIndif(Upper.BIRO.IRO,Sim(LowerSim),UpperDist).main() @ &m: res]| From 2fb56a5594bc27bd5a801e1c39aa5b9b2ed27f51 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 27 Oct 2015 19:40:49 +0100 Subject: [PATCH 038/394] Some progress. May be broken. --- sha3/proof/Absorb.ec | 9 +- sha3/proof/AbsorbToBlocks.ec | 215 +++++++++++++++++++++++++----- sha3/proof/Blocks.ec | 14 +- sha3/proof/Common.ec | 12 +- sha3/proof/IRO.eca | 72 ++++++++++ sha3/proof/Indifferentiability.ec | 2 +- 6 files changed, 272 insertions(+), 52 deletions(-) diff --git a/sha3/proof/Absorb.ec b/sha3/proof/Absorb.ec index 89f1b12..dbc570d 100644 --- a/sha3/proof/Absorb.ec +++ b/sha3/proof/Absorb.ec @@ -2,7 +2,6 @@ require import Option Pair Int Real List. require (*--*) Common LazyRP RndOrcl Indifferentiability. -op ( * ): 'a NewDistr.distr -> 'b NewDistr.distr -> ('a * 'b) distr. op cast: 'a NewDistr.distr -> 'a distr. (* -------------------------------------------------------------------- *) @@ -16,12 +15,6 @@ clone import RndOrcl as RO with type to <- block, op Ideal.sample (x : block list) <- cast bdistr. clone import Ideal. (* ?? Nested abstract theories... we don't like them *) - -clone import LazyRP as Perm with - type D <- block * capacity, - op d <- bdistr * Capacity.cdistr - - rename [module] "P" as "Perm". (* -------------------------------------------------------------------- *) clone include Indifferentiability.Core with @@ -35,7 +28,7 @@ clone include Indifferentiability.Core with import Types. (* -------------------------------------------------------------------- *) -module BlockSponge (P : RP) : RO, CONSTRUCTION(P) = { +module BlockSponge (P : PRIMITIVE) : RO, CONSTRUCTION(P) = { proc init = P.init proc f(p : block list): block = { diff --git a/sha3/proof/AbsorbToBlocks.ec b/sha3/proof/AbsorbToBlocks.ec index b9dd5e9..03696ba 100644 --- a/sha3/proof/AbsorbToBlocks.ec +++ b/sha3/proof/AbsorbToBlocks.ec @@ -5,7 +5,6 @@ require (*--*) Absorb Blocks. (* -------------------------------------------------------------------- *) require import Common. -op ( * ): 'a NewDistr.distr -> 'b NewDistr.distr -> ('a * 'b) distr. op cast: 'a NewDistr.distr -> 'a distr. op extend (bs : block list) (n : int): block list = @@ -20,6 +19,19 @@ op strip_aux (bs : block list) (n : int) : block list * int = op strip (bs : block list) = strip_aux (rev bs) 0. +lemma ge0_strip_aux n bs: + 0 <= n => + 0 <= (strip_aux bs n).`2. +proof. + elim bs n=> //= b bs ih n le0_n. + case (b = b0)=> //=. + by rewrite (ih (n + 1) _) 1:smt. +qed. + +lemma ge0_strip2 bs: + 0 <= (strip bs).`2. +proof. by rewrite /strip; exact/(ge0_strip_aux 0 (rev bs)). qed. + op valid_upper (bs : block list) = bs <> [] /\ forallb (fun n=> strip (extend bs n) = (bs,n)). @@ -29,12 +41,10 @@ op valid_lower (bs : block list) = (* PY: FIXME *) clone Absorb as Lower with - op ( * ) <- ( * )<:'a,'b>, op cast <- cast<:'a>, op valid <- valid_lower. clone Blocks as Upper with - op ( * ) <- ( * )<:'a,'b>, op valid <- valid_upper. (* -------------------------------------------------------------------- *) @@ -80,57 +90,200 @@ module UpperOfLowerBlockSponge (P : Upper.PRIMITIVE) = UpperFun(Lower.BlockSpong module Dist ( D : Upper.DISTINGUISHER, F : Lower.FUNCTIONALITY, P : Lower.PRIMITIVE ) = D(UpperFun(F),P). section. - declare module LowerSim : Lower.SIMULATOR. - declare module UpperDist : Upper.DISTINGUISHER { LowerSim }. + declare module LowerSim : Lower.SIMULATOR { Perm, Upper.BIRO.IRO', Lower.Ideal.RO }. + declare module UpperDist : Upper.DISTINGUISHER { Perm, Upper.BIRO.IRO', Lower.Ideal.RO, LowerSim }. - local equiv ModularUpper: - UpperFun(Lower.BlockSponge(Lower.Perm.Perm)).f ~ Upper.BlockSponge(Upper.Perm.Perm).f: + local equiv ModularUpper_Real: + UpperFun(Lower.BlockSponge(Perm)).f ~ Upper.BlockSponge(Perm).f: ={arg} - /\ ={m,mi}(Lower.Perm.Perm,Upper.Perm.Perm) - /\ (forall x, mem (dom Lower.Perm.Perm.m){1} x) + /\ ={m,mi}(Perm,Perm) + /\ (forall x, mem (dom Perm.m){1} x) ==> ={res} - /\ ={m,mi}(Lower.Perm.Perm,Upper.Perm.Perm) - /\ (forall x, mem (dom Lower.Perm.Perm.m){1} x). + /\ ={m,mi}(Perm,Perm) + /\ (forall x, mem (dom Perm.m){1} x). proof. proc. sp; if=> //=. - inline Lower.BlockSponge(Lower.Perm.Perm).f. + inline Lower.BlockSponge(Perm).f. admit. (* Fun with loops *) qed. - pred relation (ro : (block list,block) fmap) (iro : (block list,block list) fmap) = - (forall x y, iro.[x] = Some y => - forall i, 0 <= i < size y => ro.[extend x i] = onth y i) - /\ (forall x y, ro.[x] = Some y => - let (x',n) = strip x in - mem (dom iro) x - /\ size (oget iro.[x]) >= n - /\ nth witness (oget iro.[x]) n = y). + pred lower (ro : (block list,block) fmap) (iro : (block list * int,block) fmap) = + Upper.BIRO.prefix_closed iro /\ + forall x n, valid_upper x => iro.[(x,n)] = ro.[extend x n]. local equiv ModularLower: - UpperFun(Lower.Ideal.RO).f ~ Upper.BIRO.IRO.f: + UpperFun(Lower.Ideal.RO).f ~ Upper.BIRO.IRO'.f: ={arg} - /\ relation Lower.Ideal.RO.m{1} Upper.BIRO.IRO.mp{2} + /\ lower Lower.Ideal.RO.m{1} Upper.BIRO.IRO'.mp{2} ==> ={res} - /\ relation Lower.Ideal.RO.m{1} Upper.BIRO.IRO.mp{2}. + /\ lower Lower.Ideal.RO.m{1} Upper.BIRO.IRO'.mp{2}. proof. proc. sp; if=> //=. - inline Lower.BlockSponge(Lower.Perm.Perm).f. + inline Lower.BlockSponge(Perm).f. admit. (* Fun with loops *) qed. -print Upper.RealIndif. + pred upper (ro : (block list,block) fmap) (iro : (block list * int,block) fmap) = + (forall x y, valid_lower x => ro.[x] = Some y => iro.[strip x] = Some y) + /\ (forall x n y, + valid_upper x => + iro.[(x,n)] = Some y => + exists n', + n <= n' + /\ mem (dom ro) (extend x n')). + + module LowIRO' : Lower.FUNCTIONALITY = { + proc init = Upper.BIRO.IRO'.init + proc f(x : block list) = { + var b <- b0; + + if (valid_lower x) { + b <@ Upper.BIRO.IRO'.f_lazy(strip x); + } + + return b; + } + }. + + pred holey_map (iro iro_lazy : (block list * int,block) fmap) = + Upper.BIRO.prefix_closed iro + /\ (forall xn, + mem (dom iro_lazy) xn => + iro_lazy.[xn] = iro.[xn]) + /\ (forall x n, + mem (dom iro) (x,n) => + exists n', + n <= n' + /\ mem (dom iro_lazy) (x,n')). + + (** Essentially, we can delay sampling every entry in the left map + whose index is not in the index of the right map, as they have + not ben given to the adversary. **) + local lemma LazifyIRO: + eager [Upper.BIRO.IRO'.resample_invisible(); , LowerFun(Upper.BIRO.IRO').f ~ LowIRO'.f, Upper.BIRO.IRO'.resample_invisible();: + ={arg, Upper.BIRO.IRO'.visible} + /\ holey_map Upper.BIRO.IRO'.mp{1} Upper.BIRO.IRO'.mp{2} + /\ Upper.BIRO.IRO'.visible{2} = dom (Upper.BIRO.IRO'.mp){2} + ==> ={res, Upper.BIRO.IRO'.visible} + /\ holey_map Upper.BIRO.IRO'.mp{1} Upper.BIRO.IRO'.mp{2} + /\ Upper.BIRO.IRO'.visible{2} = dom (Upper.BIRO.IRO'.mp){2}]. + proof. + eager proc. + case (!valid_lower p{1})=> /=. + rcondf{1} 3; 1: by auto; inline *; auto; while (true); auto. + rcondf{2} 2; 1: by auto. + inline *; auto. + rcondf{2} 4; 1: by auto; smt. + while{1} ( work{1} <= dom (Upper.BIRO.IRO'.mp){1} + /\ holey_map Upper.BIRO.IRO'.mp{1} Upper.BIRO.IRO'.mp{2} + /\ forall x, mem work{1} x => mem (dom Upper.BIRO.IRO'.mp){1} x /\ !mem (dom Upper.BIRO.IRO'.mp){2} x) + (card work{1}). + auto; progress. + + admit. (* TODO: dto lossless *) + + move=> x; rewrite domP in_fsetD in_fsetU !in_fset1. + by case (x = pick work{hr})=> //= _ /H1 [->]. + + smt. + + smt. + + have [_] [_] /(_ x1 n0 _) //= := H0. + move: H5; rewrite domP in_fsetU in_fset1=> [//=|h]. + by have [->]:= H1 (x1,n0) _; first by rewrite h mem_pick // H2. + + move: H5; rewrite domP in_fsetD in_fsetU !in_fset1. + by case (x1 = pick work{hr})=> //= _ /H1 [->]. + + move: H5; rewrite in_fsetD in_fset1. + by case (x1 = pick work{hr})=> //= _ /H1 [_ ->]. + + smt. + by auto; smt. + rcondt{1} 3; 1: by auto; inline *; auto; while (true); auto. + rcondt{2} 2; 1: by auto. + inline Upper.BIRO.IRO'.f Upper.BIRO.IRO'.f_lazy. + rcondt{1} 8; 1: by auto; inline *; auto; while (true); auto; smt. + rcondt{2} 4; 1: by auto; smt. + case ((mem (dom Upper.BIRO.IRO'.mp) (strip p)){1} /\ !(mem (dom Upper.BIRO.IRO'.mp) (strip x)){2}). + admit. (* this is the bad case where we need to bring down the sampling from resample_invisible *) + inline{2} Upper.BIRO.IRO'.resample_invisible. + rcondf{2} 9; 1: by auto; inline *; sp; if; auto; smt. + seq 1 0: ((((p{1} = x{2} /\ ={Upper.BIRO.IRO'.visible}) /\ + holey_map Upper.BIRO.IRO'.mp{1} Upper.BIRO.IRO'.mp{2} /\ + Upper.BIRO.IRO'.visible{2} = dom Upper.BIRO.IRO'.mp{2}) /\ + valid_lower p{1}) /\ + ! (mem (dom Upper.BIRO.IRO'.mp{1}) (strip p{1}) /\ + ! mem (dom Upper.BIRO.IRO'.mp{2}) (strip x{2}))). (* disgusting copy-paste. we need seq* *) + admit. + splitwhile{1} 8: (i < n0 - 1). + rcondt{1} 9. + move=> &m; while (0 <= i < n0). + by inline*; sp; if; auto; smt. + by auto; smt. + rcondf{1} 12. + move=> &m; seq 8: (i = n0 - 1). + * wp; while (0 <= i < n0). + by inline*; sp; if; auto; smt. + by auto; smt. + * inline*; sp; if; auto; smt. + admit. (* just pushing the proof through *) + qed. + + + (** This is an eager statement: + - on actual queries, the two maps agree; + - blocks in the IRO that are just generated on the way + to answering actual queries can be resampled. **) + (* Lower.Ideal.RO.f ~ LowerFun(Upper.BIRO.IRO).f: + ={arg} + /\ true + ==> ={res}. + *) lemma Intermediate &m: - `|Pr[Upper.RealIndif(Upper.Perm.Perm,UpperOfLowerBlockSponge,UpperDist).main() @ &m: res] + `|Pr[Upper.RealIndif(Perm,Upper.BlockSponge,UpperDist).main() @ &m :res] + - Pr[Upper.IdealIndif(Upper.BIRO.IRO,Sim(LowerSim),UpperDist).main() @ &m: res]| + = `|Pr[Upper.RealIndif(Perm,UpperOfLowerBlockSponge,UpperDist).main() @ &m: res] + - Pr[Upper.IdealIndif(UpperFun(Lower.Ideal.RO),Sim(LowerSim),UpperDist).main() @ &m: res]|. + proof. + have ->: Pr[Upper.RealIndif(Perm,UpperOfLowerBlockSponge,UpperDist).main() @ &m: res] + = Pr[Upper.RealIndif(Perm,Upper.BlockSponge,UpperDist).main() @ &m :res]. + byequiv=> //=; proc. + call (_: ={m,mi}(Perm,Perm) + /\ (forall x, mem (dom Perm.m){1} x)). + by proc; if; auto; smt. + by proc; if; auto; smt. + (* BUG: arg should be handled much earlier and automatically *) + by conseq ModularUpper=> //= &1 &2; case (arg{1}); case (arg{2})=> //=. + call (_: true + ==> ={glob Perm} + /\ (forall x, mem (dom Perm.m){1} x)). + admit. (* Do this with an eagerly sampled RP *) + (* Now the other initialization is dead code. *) + call (_: true ==> true)=> //. + by proc; auto. + have ->: Pr[Upper.IdealIndif(UpperFun(Lower.Ideal.RO),Sim(LowerSim),UpperDist).main() @ &m: res] + = Pr[Upper.IdealIndif(Upper.BIRO.IRO,Sim(LowerSim),UpperDist).main() @ &m: res]. + byequiv=> //=; proc. + call (_: ={glob LowerSim} /\ relation Lower.Ideal.RO.m{1} Upper.BIRO.IRO.mp{2}). + proc (relation Lower.Ideal.RO.m{1} Upper.BIRO.IRO.mp{2})=> //=. + by proc; sp; if=> //=; call ModularLower; auto. + proc (relation Lower.Ideal.RO.m{1} Upper.BIRO.IRO.mp{2})=> //=. + by proc; sp; if=> //=; call ModularLower; auto. + (* Re-Bug *) + by conseq ModularLower=> &1 &2; case (arg{1}); case (arg{2}). + inline *; wp; call (_: true)=> //=. + by sim. + auto; progress [-split]; split=> //=. + by split=> x y; rewrite map0P. + done. + qed. + + lemma Remainder &m: + `|Pr[Upper.RealIndif(Perm,UpperOfLowerBlockSponge,UpperDist).main() @ &m: res] - Pr[Upper.IdealIndif(UpperFun(Lower.Ideal.RO),Sim(LowerSim),UpperDist).main() @ &m: res]| - = `|Pr[Lower.RealIndif(Lower.Perm.Perm,Lower.BlockSponge,Dist(UpperDist)).main() @ &m: res] - - Pr[Lower.IdealIndif(Lower.Ideal.RO,LowerSim,Dist(UpperDist)).main() @ &m: res]|. + = `|Pr[Lower.RealIndif(Perm,Lower.BlockSponge,Dist(UpperDist)).main() @ &m: res] + - Pr[Lower.IdealIndif(Lower.Ideal.RO,LowerSim,Dist(UpperDist)).main() @ &m: res]|. proof. admit. qed. lemma Conclusion &m: - `|Pr[Upper.RealIndif(Upper.Perm.Perm,Upper.BlockSponge,UpperDist).main() @ &m: res] + `|Pr[Upper.RealIndif(Perm,Upper.BlockSponge,UpperDist).main() @ &m: res] - Pr[Upper.IdealIndif(Upper.BIRO.IRO,Sim(LowerSim),UpperDist).main() @ &m: res]| - = `|Pr[Lower.RealIndif(Lower.Perm.Perm,Lower.BlockSponge,Dist(UpperDist)).main() @ &m: res] + = `|Pr[Lower.RealIndif(Perm,Lower.BlockSponge,Dist(UpperDist)).main() @ &m: res] - Pr[Lower.IdealIndif(Lower.Ideal.RO,LowerSim,Dist(UpperDist)).main() @ &m: res]|. - proof. admit. qed. + proof. by rewrite (Intermediate &m) (Remainder &m). qed. end section. diff --git a/sha3/proof/Blocks.ec b/sha3/proof/Blocks.ec index 0d0ca6d..83159e6 100644 --- a/sha3/proof/Blocks.ec +++ b/sha3/proof/Blocks.ec @@ -2,8 +2,6 @@ require import Option Pair Int Real List. require (*--*) Common IRO LazyRP Indifferentiability. -op ( * ): 'a NewDistr.distr -> 'b NewDistr.distr -> ('a * 'b) distr. - (* -------------------------------------------------------------------- *) require import Common. @@ -14,12 +12,6 @@ clone import IRO as BIRO with type from <- block list, type to <- block, op valid <- valid. - -clone import LazyRP as Perm with - type D <- block * capacity, - op d <- bdistr * Capacity.cdistr - - rename [module] "P" as "Perm". (* -------------------------------------------------------------------- *) clone include Indifferentiability.Core with @@ -34,7 +26,7 @@ import Types. (* -------------------------------------------------------------------- *) (** Spurious uninitialized variable warning on p *) -module BlockSponge (P : RP) : BIRO.IRO, CONSTRUCTION(P) = { +module BlockSponge (P : PRIMITIVE) : BIRO.IRO, CONSTRUCTION(P) = { proc init = P.init proc f(p : block list, n : int): block list = { @@ -65,6 +57,6 @@ lemma top: exists (S <: SIMULATOR), forall (D <: DISTINGUISHER) &m, `| Pr[Experiment(BlockSponge(Perm), Perm, D).main() @ &m : res] - - Pr[Experiment(IRO, S(IRO), D).main() @ &m : res]| + - Pr[Experiment(IRO', S(IRO'), D).main() @ &m : res]| < eps. -proof. admit. qed. +proof. admit. qed. \ No newline at end of file diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 8df87b9..d462d5a 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -1,6 +1,6 @@ (* -------------------------------------------------------------------- *) require import Fun Pair Int Real List NewDistr. -require (*--*) FinType NewMonoid. +require (*--*) FinType LazyRP NewMonoid. (* -------------------------------------------------------------------- *) theory BitWord. @@ -59,3 +59,13 @@ clone export BitWord as Block with rename [op] "zero" as "b0" [op] "uniform" as "bdistr". + + print LazyRP. + +op ( * ): 'a NewDistr.distr -> 'b NewDistr.distr -> ('a * 'b) Pervasive.distr. +clone export LazyRP as Perm with + type D <- block * capacity, + op d <- bdistr * Capacity.cdistr +rename + [module type] "RP" as "PRIMITIVE" + [module] "P" as "Perm". diff --git a/sha3/proof/IRO.eca b/sha3/proof/IRO.eca index a644a88..436f7e7 100644 --- a/sha3/proof/IRO.eca +++ b/sha3/proof/IRO.eca @@ -47,3 +47,75 @@ module IRO : IRO = { return aout; } }. + +pred prefix_closed (m : (from * int,to) fmap) = + forall x n, + mem (dom m) (x,n) => + (forall i, 0 <= i < n => + mem (dom m) (x,i)). + +pred prefix_closed' (m : (from * int,to) fmap) = + forall x n i, + mem (dom m) (x,n) => + 0 <= i < n => + mem (dom m) (x,i). + +lemma cool m: prefix_closed m <=> prefix_closed' m +by []. + +module IRO' : IRO = { + var mp : (from * int, to) fmap + var visible : (from * int) fset + + proc resample_invisible() = { + var work, x; + + work <- dom mp `\` visible; + while (work <> fset0) { + x <- pick work; + mp.[x] <$ dto; + work <- work `\` fset1 x; + } + } + + proc init() = { + mp <- map0; + visible <- fset0; + } + + proc fill_in(x,n) = { + if (!mem (dom mp) (x,n)) { + mp.[(x,n)] <$ dto; + } + 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; + } +}. + +(** The two are equivalent **) \ No newline at end of file diff --git a/sha3/proof/Indifferentiability.ec b/sha3/proof/Indifferentiability.ec index f710925..85d037c 100644 --- a/sha3/proof/Indifferentiability.ec +++ b/sha3/proof/Indifferentiability.ec @@ -34,7 +34,7 @@ module type CONSTRUCTION (P : PRIMITIVE) = { }. module type SIMULATOR (F : FUNCTIONALITY) = { - proc init() : unit + proc init() : unit { F.init } proc f(x : p) : p { F.f } proc fi(x : p) : p { F.f } }. From 26f296a0df6c7d030c1e4f257c6afd5fba3cca13 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Wed, 28 Oct 2015 08:30:59 +0100 Subject: [PATCH 039/394] Jenkins integration --- sha3/config/tests.config | 5 +++++ 1 file changed, 5 insertions(+) create mode 100644 sha3/config/tests.config diff --git a/sha3/config/tests.config b/sha3/config/tests.config new file mode 100644 index 0000000..3c0fbec --- /dev/null +++ b/sha3/config/tests.config @@ -0,0 +1,5 @@ +[default] +bin = ec.native + +[test-sha3] +okdirs = proof From 782d533bfb8209bd0c92f146598c87546d2ee79a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 28 Oct 2015 15:44:53 +0100 Subject: [PATCH 040/394] Lining up more defs. --- sha3/proof/AbsorbToBlocks.ec | 32 ++++++------ sha3/proof/Blocks.ec | 4 +- sha3/proof/BlocksToTopLevel.ec | 82 +++++++++++++++++++++++++++++++ sha3/proof/Indifferentiability.ec | 2 +- sha3/proof/LeakyAbsorb.ec | 2 +- sha3/proof/TopLevel.ec | 30 ++--------- 6 files changed, 106 insertions(+), 46 deletions(-) create mode 100644 sha3/proof/BlocksToTopLevel.ec diff --git a/sha3/proof/AbsorbToBlocks.ec b/sha3/proof/AbsorbToBlocks.ec index 03696ba..41657ca 100644 --- a/sha3/proof/AbsorbToBlocks.ec +++ b/sha3/proof/AbsorbToBlocks.ec @@ -235,20 +235,20 @@ section. *) lemma Intermediate &m: - `|Pr[Upper.RealIndif(Perm,Upper.BlockSponge,UpperDist).main() @ &m :res] - - Pr[Upper.IdealIndif(Upper.BIRO.IRO,Sim(LowerSim),UpperDist).main() @ &m: res]| - = `|Pr[Upper.RealIndif(Perm,UpperOfLowerBlockSponge,UpperDist).main() @ &m: res] + `|Pr[Upper.RealIndif(Upper.BlockSponge,Perm,UpperDist).main() @ &m :res] + - Pr[Upper.IdealIndif(Upper.BIRO.IRO',Sim(LowerSim),UpperDist).main() @ &m: res]| + = `|Pr[Upper.RealIndif(UpperOfLowerBlockSponge,Perm,UpperDist).main() @ &m: res] - Pr[Upper.IdealIndif(UpperFun(Lower.Ideal.RO),Sim(LowerSim),UpperDist).main() @ &m: res]|. proof. - have ->: Pr[Upper.RealIndif(Perm,UpperOfLowerBlockSponge,UpperDist).main() @ &m: res] - = Pr[Upper.RealIndif(Perm,Upper.BlockSponge,UpperDist).main() @ &m :res]. + have ->: Pr[Upper.RealIndif(UpperOfLowerBlockSponge,Perm,UpperDist).main() @ &m: res] + = Pr[Upper.RealIndif(Upper.BlockSponge,Perm,UpperDist).main() @ &m :res]. byequiv=> //=; proc. call (_: ={m,mi}(Perm,Perm) /\ (forall x, mem (dom Perm.m){1} x)). by proc; if; auto; smt. by proc; if; auto; smt. (* BUG: arg should be handled much earlier and automatically *) - by conseq ModularUpper=> //= &1 &2; case (arg{1}); case (arg{2})=> //=. + by conseq ModularUpper_Real=> //= &1 &2; case (arg{1}); case (arg{2})=> //=. call (_: true ==> ={glob Perm} /\ (forall x, mem (dom Perm.m){1} x)). @@ -257,33 +257,33 @@ section. call (_: true ==> true)=> //. by proc; auto. have ->: Pr[Upper.IdealIndif(UpperFun(Lower.Ideal.RO),Sim(LowerSim),UpperDist).main() @ &m: res] - = Pr[Upper.IdealIndif(Upper.BIRO.IRO,Sim(LowerSim),UpperDist).main() @ &m: res]. + = Pr[Upper.IdealIndif(Upper.BIRO.IRO',Sim(LowerSim),UpperDist).main() @ &m: res]. byequiv=> //=; proc. - call (_: ={glob LowerSim} /\ relation Lower.Ideal.RO.m{1} Upper.BIRO.IRO.mp{2}). - proc (relation Lower.Ideal.RO.m{1} Upper.BIRO.IRO.mp{2})=> //=. + call (_: ={glob LowerSim} /\ lower Lower.Ideal.RO.m{1} Upper.BIRO.IRO'.mp{2}). + proc (lower Lower.Ideal.RO.m{1} Upper.BIRO.IRO'.mp{2})=> //=. by proc; sp; if=> //=; call ModularLower; auto. - proc (relation Lower.Ideal.RO.m{1} Upper.BIRO.IRO.mp{2})=> //=. + proc (lower Lower.Ideal.RO.m{1} Upper.BIRO.IRO'.mp{2})=> //=. by proc; sp; if=> //=; call ModularLower; auto. (* Re-Bug *) by conseq ModularLower=> &1 &2; case (arg{1}); case (arg{2}). inline *; wp; call (_: true)=> //=. by sim. auto; progress [-split]; split=> //=. - by split=> x y; rewrite map0P. + smt. done. qed. lemma Remainder &m: - `|Pr[Upper.RealIndif(Perm,UpperOfLowerBlockSponge,UpperDist).main() @ &m: res] + `|Pr[Upper.RealIndif(UpperOfLowerBlockSponge,Perm,UpperDist).main() @ &m: res] - Pr[Upper.IdealIndif(UpperFun(Lower.Ideal.RO),Sim(LowerSim),UpperDist).main() @ &m: res]| - = `|Pr[Lower.RealIndif(Perm,Lower.BlockSponge,Dist(UpperDist)).main() @ &m: res] + = `|Pr[Lower.RealIndif(Lower.BlockSponge,Perm,Dist(UpperDist)).main() @ &m: res] - Pr[Lower.IdealIndif(Lower.Ideal.RO,LowerSim,Dist(UpperDist)).main() @ &m: res]|. proof. admit. qed. lemma Conclusion &m: - `|Pr[Upper.RealIndif(Perm,Upper.BlockSponge,UpperDist).main() @ &m: res] - - Pr[Upper.IdealIndif(Upper.BIRO.IRO,Sim(LowerSim),UpperDist).main() @ &m: res]| - = `|Pr[Lower.RealIndif(Perm,Lower.BlockSponge,Dist(UpperDist)).main() @ &m: res] + `|Pr[Upper.RealIndif(Upper.BlockSponge,Perm,UpperDist).main() @ &m: res] + - Pr[Upper.IdealIndif(Upper.BIRO.IRO',Sim(LowerSim),UpperDist).main() @ &m: res]| + = `|Pr[Lower.RealIndif(Lower.BlockSponge,Perm,Dist(UpperDist)).main() @ &m: res] - Pr[Lower.IdealIndif(Lower.Ideal.RO,LowerSim,Dist(UpperDist)).main() @ &m: res]|. proof. by rewrite (Intermediate &m) (Remainder &m). qed. end section. diff --git a/sha3/proof/Blocks.ec b/sha3/proof/Blocks.ec index 83159e6..9457575 100644 --- a/sha3/proof/Blocks.ec +++ b/sha3/proof/Blocks.ec @@ -56,7 +56,7 @@ op eps : real. lemma top: exists (S <: SIMULATOR), forall (D <: DISTINGUISHER) &m, - `| Pr[Experiment(BlockSponge(Perm), Perm, D).main() @ &m : res] - - Pr[Experiment(IRO', S(IRO'), D).main() @ &m : res]| + `| Pr[RealIndif(BlockSponge, Perm, D).main() @ &m : res] + - Pr[IdealIndif(IRO', S, D).main() @ &m : res]| < eps. proof. admit. qed. \ No newline at end of file diff --git a/sha3/proof/BlocksToTopLevel.ec b/sha3/proof/BlocksToTopLevel.ec new file mode 100644 index 0000000..50cfda7 --- /dev/null +++ b/sha3/proof/BlocksToTopLevel.ec @@ -0,0 +1,82 @@ +(* -------------------------------------------------------------------- *) +require import Fun Pred Option Pair Int Real List FSet NewFMap. +require (*--*) Blocks TopLevel. + +(* -------------------------------------------------------------------- *) +require import Common. +print Common. + +op chunk: bool list -> bool list list. + +op padlength (n : int) = + let n' = (n + 2) %% r in + if n' = 0 then 0 else r - n'. + +op pad (bs : bool list): block list = + let p = rcons (true :: mkseq (fun k => false) (padlength (size bs))) true in + map bits2w (chunk (bs ++ p)). + +op unpad (bs : block list): bool list option. (* Alley to fill in the definition *) + +axiom unpadK (bs : bool list): pcancel pad unpad. +axiom padK (*?*) (bs : block list): ocancel unpad pad. + +op valid_lower (bs : block list) = unpad bs <> None. + +clone Blocks as Lower with + op valid <- valid_lower. + +clone TopLevel as Upper. + +(* -------------------------------------------------------------------- *) +module UpperFun ( F : Lower.FUNCTIONALITY ) = { + proc init = F.init + + proc f(p : bool list, n : int) = { + var bs; + + bs <@ F.f(pad p,(n + r - 1) /% r); + return take n (flatten (map w2bits bs)); + } +}. + +module LowerFun ( F: Upper.FUNCTIONALITY) = { + proc init = F.init + + proc f(p : block list, n : int) = { + var bs, m; + var bs' <- []; + + m <- unpad p; + if (m <> None) { + bs <@ F.f(oget m,n * r); + bs' <- map bits2w (chunk bs); + } + return bs'; + } +}. + +(* -------------------------------------------------------------------- *) +equiv ModularConstruction: + UpperFun(Lower.BlockSponge(Perm)).f ~ Upper.Sponge(Perm).f: + ={glob Perm, arg} ==> ={glob Perm, res}. +proof. + proc. inline Lower.BlockSponge(Perm).f. + admit. (* done *) +qed. + +module ModularSimulator (S : Lower.SIMULATOR, F : Upper.FUNCTIONALITY) = S(LowerFun(F)). + +module LowerDist ( D : Upper.DISTINGUISHER, F : Lower.FUNCTIONALITY, P : PRIMITIVE) = + D(UpperFun(F),P). + +section. + declare module LowerSim : Lower.SIMULATOR. + declare module UpperDist : Upper.DISTINGUISHER. + + lemma Conclusion &m: + `|Pr[Upper.RealIndif(Upper.Sponge,Perm,UpperDist).main() @ &m: res] + - Pr[Upper.IdealIndif(Upper.BIRO.IRO',ModularSimulator(LowerSim),UpperDist).main() @ &m: res]| + = `|Pr[Lower.RealIndif(Lower.BlockSponge,Perm,LowerDist(UpperDist)).main() @ &m: res] + - Pr[Lower.IdealIndif(Lower.BIRO.IRO',LowerSim,LowerDist(UpperDist)).main() @ &m: res]|. + proof. admit. qed. diff --git a/sha3/proof/Indifferentiability.ec b/sha3/proof/Indifferentiability.ec index 85d037c..9a11bd5 100644 --- a/sha3/proof/Indifferentiability.ec +++ b/sha3/proof/Indifferentiability.ec @@ -54,7 +54,7 @@ module Indif (F : FUNCTIONALITY, P : PRIMITIVE, D : DISTINGUISHER) = { } }. -module Real(P : PRIMITIVE, C : CONSTRUCTION) = Indif(C(P),P). +module Real(C : CONSTRUCTION, P : PRIMITIVE) = Indif(C(P),P). module Ideal(F : FUNCTIONALITY, S : SIMULATOR) = Indif(F,S(F)). (* (C <: CONSTRUCTION) applied to (P <: PRIMITIVE) is indifferentiable diff --git a/sha3/proof/LeakyAbsorb.ec b/sha3/proof/LeakyAbsorb.ec index 5b487ee..c59fe8b 100644 --- a/sha3/proof/LeakyAbsorb.ec +++ b/sha3/proof/LeakyAbsorb.ec @@ -40,7 +40,7 @@ module type WeirdIRO_ = { op valid_query : block list -> int -> bool. op valid_queries : (block list) fset. -axiom valid_queryP : forall m n, valid_query m n => forall k, 0 <= k <= n => mem valid_queries (m ++ map (fun x => b0) (iota_ 0 k)). +axiom valid_queryP : forall m n, valid_query m n => forall k, 0 <= k <= n => mem valid_queries (m ++ mkseq (fun x => b0) k). axiom valid_query_take : forall m n, valid_query m n => forall i, 0 <= i <= size m => mem valid_queries (take i m). axiom valid_query_take1 : forall m n, valid_query m n => forall i, 0 <= i <= size m => valid_query (take i m) 1. diff --git a/sha3/proof/TopLevel.ec b/sha3/proof/TopLevel.ec index a329f2c..23b7558 100644 --- a/sha3/proof/TopLevel.ec +++ b/sha3/proof/TopLevel.ec @@ -1,25 +1,9 @@ (* -------------------------------------------------------------------- *) require import Pair Int Real List. require (*--*) IRO LazyRP Indifferentiability. -(*---*) import Dprod. (* -------------------------------------------------------------------- *) -(* Replay Common.ec *) -op r : { int | 0 < r } as gt0_r. -op c : { int | 0 < c } as gt0_c. - -type block. -type capacity. - -op cdist : capacity distr. -op bdist : block distr. - -op b0 : block. -op c0 : capacity. - -op b2bits : block -> bool list. - -op (^) : block -> block -> block. +require import Common. (* -------------------------------------------------------------------- *) op pad : bool list -> block list. @@ -29,12 +13,6 @@ clone import IRO as BIRO with type from <- bool list, type to <- bool, op valid (x : bool list) <- true. - -clone import LazyRP as Perm with - type D <- block * capacity, - op d <- bdist * cdist - - rename [module] "P" as "Perm". (* -------------------------------------------------------------------- *) clone include Indifferentiability.Core with @@ -49,12 +27,12 @@ import Types. (* -------------------------------------------------------------------- *) (** Spurious uninitialized variable warning on p *) -module Sponge (P : RP) : BIRO.IRO, CONSTRUCTION(P) = { +module Sponge (P : PRIMITIVE) : BIRO.IRO, CONSTRUCTION(P) = { proc init = P.init proc f(bp : bool list, n : int): bool list = { var z <- []; - var (sa,sc) <- (b0, c0); + var (sa,sc) <- (b0, Capacity.c0); var i <- 0; var p <- pad bp; @@ -65,7 +43,7 @@ module Sponge (P : RP) : BIRO.IRO, CONSTRUCTION(P) = { } (* Squeezing *) while (i < (n + r - 1) /% r) { - z <- z ++ (b2bits sa); + z <- z ++ (Block.w2bits sa); (sa,sc) <@ P.f(sa,sc); } From c7d95686b5bcfad3e39deda2087be7af075e5201 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Sat, 14 Nov 2015 16:22:10 -0500 Subject: [PATCH 041/394] Adapted scripts to changes in EC library. Created two subdirectories: old has the development predating our October work (we can adapt these files as needed and move back to top-level) variant has Benjamin's LeakyAbsorb.ec and supporing theories (if we decide to go with this approach, we can move it back) --- sha3/proof/AbsorbToBlocks.ec | 2 +- sha3/proof/Common.ec | 4 +- sha3/proof/{ => old}/IndifPadding.ec | 0 sha3/proof/{ => old}/LazyRO.eca | 0 sha3/proof/{ => old}/NBRO.eca | 0 sha3/proof/{ => old}/Sponge.ec | 2 +- sha3/proof/{ => old}/Squeezeless.ec | 0 sha3/proof/{ => old}/Utils.ec | 2 +- sha3/proof/variant/LazyRP.eca | 39 +++ sha3/proof/{ => variant}/LeakyAbsorb.ec | 0 sha3/proof/variant/RP.eca | 26 ++ sha3/proof/variant/RndOrcl.eca | 385 ++++++++++++++++++++++++ 12 files changed, 455 insertions(+), 5 deletions(-) rename sha3/proof/{ => old}/IndifPadding.ec (100%) rename sha3/proof/{ => old}/LazyRO.eca (100%) rename sha3/proof/{ => old}/NBRO.eca (100%) rename sha3/proof/{ => old}/Sponge.ec (99%) rename sha3/proof/{ => old}/Squeezeless.ec (100%) rename sha3/proof/{ => old}/Utils.ec (98%) create mode 100644 sha3/proof/variant/LazyRP.eca rename sha3/proof/{ => variant}/LeakyAbsorb.ec (100%) create mode 100644 sha3/proof/variant/RP.eca create mode 100644 sha3/proof/variant/RndOrcl.eca diff --git a/sha3/proof/AbsorbToBlocks.ec b/sha3/proof/AbsorbToBlocks.ec index 41657ca..f6befac 100644 --- a/sha3/proof/AbsorbToBlocks.ec +++ b/sha3/proof/AbsorbToBlocks.ec @@ -34,7 +34,7 @@ proof. by rewrite /strip; exact/(ge0_strip_aux 0 (rev bs)). qed. op valid_upper (bs : block list) = bs <> [] /\ - forallb (fun n=> strip (extend bs n) = (bs,n)). + forall n, strip (extend bs n) = (bs,n). op valid_lower (bs : block list) = valid_upper (strip bs).`1. diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index d462d5a..ef408c3 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -1,6 +1,6 @@ (* -------------------------------------------------------------------- *) require import Fun Pair Int Real List NewDistr. -require (*--*) FinType LazyRP NewMonoid. +require (*--*) FinType LazyRP Monoid. (* -------------------------------------------------------------------- *) theory BitWord. @@ -9,7 +9,7 @@ type bword. op zero : bword. op (^) : bword -> bword -> bword. -clone include NewMonoid +clone include Monoid with type t <- bword, op idm <- zero, diff --git a/sha3/proof/IndifPadding.ec b/sha3/proof/old/IndifPadding.ec similarity index 100% rename from sha3/proof/IndifPadding.ec rename to sha3/proof/old/IndifPadding.ec diff --git a/sha3/proof/LazyRO.eca b/sha3/proof/old/LazyRO.eca similarity index 100% rename from sha3/proof/LazyRO.eca rename to sha3/proof/old/LazyRO.eca diff --git a/sha3/proof/NBRO.eca b/sha3/proof/old/NBRO.eca similarity index 100% rename from sha3/proof/NBRO.eca rename to sha3/proof/old/NBRO.eca diff --git a/sha3/proof/Sponge.ec b/sha3/proof/old/Sponge.ec similarity index 99% rename from sha3/proof/Sponge.ec rename to sha3/proof/old/Sponge.ec index 7d91e06..9648347 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/old/Sponge.ec @@ -1,4 +1,4 @@ -require import Option Pair Int Real NewList NewFSet NewFMap. +require import Option Pair Int Real List FSet NewFMap. require (*..*) AWord LazyRP IRO Indifferentiability Squeezeless. (* TODO: Clean up the Bitstring and Word theories -- Make use of those new versions. *) diff --git a/sha3/proof/Squeezeless.ec b/sha3/proof/old/Squeezeless.ec similarity index 100% rename from sha3/proof/Squeezeless.ec rename to sha3/proof/old/Squeezeless.ec diff --git a/sha3/proof/Utils.ec b/sha3/proof/old/Utils.ec similarity index 98% rename from sha3/proof/Utils.ec rename to sha3/proof/old/Utils.ec index 5517692..4a460ae 100644 --- a/sha3/proof/Utils.ec +++ b/sha3/proof/old/Utils.ec @@ -1,5 +1,5 @@ (** These should make it into the standard libs **) -require import Pair NewList NewFSet NewFMap. +require import Option Pair List FSet NewFMap. (* -------------------------------------------------------------------- *) (* In NewFSet *) diff --git a/sha3/proof/variant/LazyRP.eca b/sha3/proof/variant/LazyRP.eca new file mode 100644 index 0000000..b483b42 --- /dev/null +++ b/sha3/proof/variant/LazyRP.eca @@ -0,0 +1,39 @@ +require import Option FSet NewFMap. +require import Dexcepted. +require (*..*) RP. + +type D. +op d: D distr. + +clone include RP with + type from <- D, + type to <- D. + +module P : RP, RP_ = { + var m : (D, D) fmap + var mi: (D, D) fmap + + proc init() = { m = map0; mi = map0; } + + proc f(x) = { + var y; + + if (!mem (dom m) x) { + y <$ d \ rng m; + m.[x] <- y; + mi.[y] <- x; + } + return oget m.[x]; + } + + proc fi(x) = { + var y; + + if (!mem (dom mi) x) { + y <$ d \ rng mi; + mi.[x] <- y; + m.[y] <- x; + } + return oget mi.[x]; + } +}. diff --git a/sha3/proof/LeakyAbsorb.ec b/sha3/proof/variant/LeakyAbsorb.ec similarity index 100% rename from sha3/proof/LeakyAbsorb.ec rename to sha3/proof/variant/LeakyAbsorb.ec diff --git a/sha3/proof/variant/RP.eca b/sha3/proof/variant/RP.eca new file mode 100644 index 0000000..eafe094 --- /dev/null +++ b/sha3/proof/variant/RP.eca @@ -0,0 +1,26 @@ +type from, to. + +module type RP = { + proc init() : unit + proc f (x : from): to + proc fi(x : to ): from +}. + +module type RP_ = { + proc f (x : from): to + proc fi(x : to ): from +}. + +module type Distinguisher(G : RP_) = { + proc distinguish(): bool +}. + +module IND(G:RP, D:Distinguisher) = { + proc main(): bool = { + var b; + + G.init(); + b <@ D(G).distinguish(); + return b; + } +}. diff --git a/sha3/proof/variant/RndOrcl.eca b/sha3/proof/variant/RndOrcl.eca new file mode 100644 index 0000000..96d3045 --- /dev/null +++ b/sha3/proof/variant/RndOrcl.eca @@ -0,0 +1,385 @@ +require import Option FSet NewFMap. +(* TODO move this in NewFMap *) +lemma dom_set (m:('a,'b) fmap) a b : dom m.[a<-b] = dom m `|` fset1 a. +proof. by apply fsetP=> x;smt. qed. + +type from, to. + +module type RO = { + proc init() : unit + proc f(x : from): to +}. + +module type Distinguisher(G : RO) = { + proc distinguish(): bool {G.f} +}. + +module IND(G:RO, D:Distinguisher) = { + proc main(): bool = { + var b; + + G.init(); + b <@ D(G).distinguish(); + return b; + } +}. + +abstract theory Ideal. + + op sample : from -> to distr. + + module RO = { + var m : (from, to) fmap + + proc init() : unit = { + m <- map0; + } + + proc f(x : from) : to = { + var rd; + rd <$ sample x; + if (! mem (dom m) x) m.[x] <- rd; + return oget m.[x]; + } + }. + + section LL. + + axiom sample_ll : forall x, Distr.weight (sample x) = 1%r. + + lemma f_ll : phoare[RO.f : true ==> true] = 1%r. + proof. proc;auto;progress;apply sample_ll. qed. + + end section LL. + +end Ideal. + + +abstract theory GenIdeal. + + clone include Ideal. + axiom sample_ll : forall x, Distr.weight (sample x) = 1%r. + + op RO_dom : from fset. + + module ERO = { + proc sample() = { + var work; + work <- RO_dom; + while (work <> fset0) { + RO.f(pick work); + work = work `\` fset1 (pick work); + } + } + + proc init() = { + RO.m <- map0; + sample(); + } + + proc f = RO.f + }. + + module IND_S(D:Distinguisher) = { + proc main(): bool = { + var b; + RO.init(); + b <@ D(RO).distinguish(); + ERO.sample(); + return b; + } + }. + + section EAGER. + + local lemma eager_query: + eager [ERO.sample(); , RO.f ~ ERO.f, ERO.sample(); : + ={x,RO.m} ==> ={res,RO.m} ]. + proof. + eager proc. + inline ERO.sample;swap{2} 4 -3. + seq 1 1: (={x,work,RO.m});first by sim. + wp;case ((mem (dom RO.m) x){1}). + + rnd{1}. + alias{1} 1 mx = oget RO.m.[x]. + while (={work,RO.m} /\ (RO.m.[x] = Some mx){1}). + + by inline *;auto;progress;smt. + auto;progress [- split]; rewrite sample_ll H /=;smt. + case ((!mem work x){1}). + + swap{1} 2 -1;while (={work,x} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ + (!mem work x){1} /\ (RO.m.[x] = Some rd){2} /\ (!mem (dom RO.m) x){1}). + + inline *;auto;progress [-split]. + cut -> : mem (dom RO.m{2}) (pick work{2}) = mem (dom RO.m{1}) (pick work{2}) by rewrite !in_dom;smt. + smt. + auto;progress [-split];rewrite !getP_eq;smt. + inline RO.f. + transitivity{1} { rd <$ sample x; + while (work <> fset0) { + x0 <- pick work; + rd0 <$ sample x0; + if (!mem (dom RO.m) x0) + RO.m.[x0] <- if x0 = x then rd else rd0; + work <- work `\` fset1 (pick work); + } } + (={x,work,RO.m} ==> ={x,RO.m}) + ((={x,work,RO.m} /\ mem work{1} x{1}) /\ ! mem (dom RO.m{2}) x{2} ==> + ={x,RO.m} /\ (result = oget RO.m.[x]){2} /\ mem (dom RO.m{1}) x{1}) => //. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; generalize H. + + transitivity{1} { while (work <> fset0) { + x0 <- pick work; + rd0 <$ sample x0; + if (!mem (dom RO.m) x0) RO.m.[x0] <- rd0; + work <- work `\` fset1 (pick work); + } + rd <$ sample x; } + (={x,work,RO.m} ==> ={x,RO.m}) + (={x,work,RO.m} ==> ={x,RO.m})=> //. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; generalize H. + + by sim; rnd{2}; sim : (={x,IND_Eager.H.m}); smt. + symmetry; eager while (H: rd <$ sample x; ~ rd <$ sample x; : ={x} ==> ={rd})=> //; sim. + swap{2} 5 -4; swap [2..3] -1; case ((x = pick work){1}). + + by wp; rnd{2}; rnd; rnd{1}; wp; skip; smt. + by auto; smt. + + while (={x, work} /\ + (!mem work x => mem (dom RO.m) x){1} /\ + RO.m.[x]{2} = Some rd{1} /\ + if (mem (dom RO.m) x){1} then ={RO.m} + else eq_except RO.m{1} RO.m{2} (fset1 x{1})). + + auto;progress; 1..9,12:smt. + + case ((pick work = x){2})=> pick_x; last smt. + subst x{2}; generalize H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. + by apply fmapP=> x0; case (pick work{2} = x0); smt. + by auto; smt. + by auto;progress [-split];rewrite H0 /= getP_eq;smt. + qed. + + equiv Eager_S (D <: Distinguisher{RO}): IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. + proof. + proc; inline ERO.init RO.init. + seq 1 1: (={glob D, RO.m});first by wp. + symmetry; eager (H: ERO.sample(); ~ ERO.sample();: ={RO.m} ==> ={RO.m}): + (={glob D, RO.m}) => //; first by sim. + eager proc H (={RO.m}) => //; [by apply eager_query | by sim]. + qed. + + equiv Eager (D <: Distinguisher{RO}): IND(RO,D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. + proof. + transitivity IND_S(D).main + (={glob D} ==> ={res,glob D}) + (={glob D} ==> ={res,RO.m,glob D}) => //. + + by progress;exists (glob D){2}. + + proc;inline{2} ERO.sample. + while{2} true (card work{2}). + + move=> &m1 z;wp;call (f_ll sample_ll);auto;smt. + conseq (_: _ ==> ={b,glob D}) => //;[smt | by sim]. + apply (Eager_S D). + qed. + + end section EAGER. + +end GenIdeal. + +abstract theory FiniteIdeal. + + clone include Ideal. + axiom sample_ll (x : from): Distr.weight (sample x) = 1%r. + + op univ : from fset. + axiom univP (x:from) : mem univ x. + + module ERO = { + proc sample() = { + var work; + work <- univ; + while (work <> fset0) { + RO.f(pick work); + work = work `\` fset1 (pick work); + } + } + + proc init() = { + RO.m <- map0; + sample(); + } + + proc f(x:from):to = { return oget RO.m.[x]; } + }. + + module IND_S(D:Distinguisher) = { + proc main(): bool = { + var b; + RO.init(); + b <@ D(RO).distinguish(); + ERO.sample(); + return b; + } + }. + + section EAGER. + + declare module D: Distinguisher { RO }. + + local clone GenIdeal as GI with + op sample <- sample, + op RO_dom <- univ + proof sample_ll by apply sample_ll. + + local equiv ERO_main: + IND(GI.ERO, D).main ~ IND(ERO, D).main : ={glob D} ==> ={res, glob D} /\ GI.RO.m{1} = RO.m{2}. + proof. + proc. + call (_:GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ). + + proc; rcondf{1} 2;auto;progress;[ by rewrite H univP | by apply sample_ll]. + inline *. + while (={work} /\ GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ `\` work{2});auto;smt. + qed. + + equiv Eager_S : IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. + proof. + transitivity GI.IND_S(D).main + (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) + (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. + + by progress;exists (glob D){2}. + + by sim. + transitivity IND(GI.ERO,D).main + (={glob D} ==> ={res,glob D, GI.RO.m}) + (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. + + by progress;exists (glob D){2}. + + by conseq (GI.Eager_S D). + by apply ERO_main. + qed. + + equiv Eager : IND(RO, D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. + proof. + transitivity IND(GI.RO,D).main + (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) + (={glob D} ==> ={res,glob D}) => //. + + by progress;exists (glob D){2}. + + by sim. + transitivity IND(GI.ERO,D).main + (={glob D} ==> ={res,glob D}) + (={glob D} ==> ={res,glob D}) => //. + + by progress;exists (glob D){2}. + + by conseq (GI.Eager D). + by conseq ERO_main. + qed. + + end section EAGER. + +end FiniteIdeal. + + +abstract theory RestrIdeal. + + clone include Ideal. + axiom sample_ll (x : from): Distr.weight (sample x) = 1%r. + + op test : from -> bool. + op univ : from fset. + op dfl : to. + + axiom testP x : test x <=> mem univ x. + + module Restr (O:RO) = { + proc init = RO.init + proc f (x:from) : to = { + var r <- dfl; + if (test x) r <@ RO.f(x); + return r; + } + }. + + module ERO = { + proc sample() = { + var work; + work <- univ; + while (work <> fset0) { + RO.f(pick work); + work = work `\` fset1 (pick work); + } + } + + proc init() = { + RO.m <- map0; + sample(); + } + + proc f(x:from):to = { + return (if test x then oget RO.m.[x] else dfl); + } + }. + + module IND_S(D:Distinguisher) = { + proc main(): bool = { + var b; + RO.init(); + b <@ D(Restr(RO)).distinguish(); + ERO.sample(); + return b; + } + }. + + section EAGER. + + declare module D: Distinguisher { RO }. + + local clone GenIdeal as GI with + op sample <- sample, + op RO_dom <- univ. + + local module Restr' (O:RO) = { + proc init() = { } + proc f(x:from) = { + var r <- dfl; + if (test x) r <@ O.f(x); + return r; + } + }. + + local module RD (O:RO) = D(Restr'(O)). + + local equiv ERO_main: + IND(GI.ERO, RD).main ~ IND(ERO, D).main : ={glob D} ==> ={res, glob D} /\ GI.RO.m{1} = RO.m{2}. + proof. + proc. + call (_:GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ). + + proc. + case (test x{1});[ rcondt{1} 2 | rcondf{1} 2];auto;last smt ml=0. + by inline *;rcondf{1} 4;auto;progress;2:(by apply sample_ll);rewrite ?H0 ?H -?testP. + inline *. + while (={work} /\ GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} `|` work{2} = univ);auto;1:progress; smt. + qed. + + equiv Eager_S : IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. + proof. + transitivity GI.IND_S(RD).main + (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) + (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. + + by progress;exists (glob D){2}. + + by sim. + transitivity IND(GI.ERO,RD).main + (={glob D} ==> ={res,glob D, GI.RO.m}) + (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. + + by progress;exists (glob D){2}. + + by conseq (GI.Eager_S RD). + by apply ERO_main. + qed. + + equiv Eager : IND(Restr(RO), D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. + proof. + transitivity IND(GI.RO,RD).main + (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) + (={glob D} ==> ={res,glob D}) => //. + + by progress;exists (glob D){2}. + + by sim. + transitivity IND(GI.ERO,RD).main + (={glob D} ==> ={res,glob D}) + (={glob D} ==> ={res,glob D}) => //. + + by progress;exists (glob D){2}. + + by conseq (GI.Eager RD). + by conseq ERO_main. + qed. + + end section EAGER. + +end RestrIdeal. \ No newline at end of file From 375b876b011094a6b1386fb101216028db0369e3 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Sat, 14 Nov 2015 16:34:17 -0500 Subject: [PATCH 042/394] Removed some [print]s. --- sha3/proof/BlocksToTopLevel.ec | 1 - sha3/proof/Common.ec | 3 +-- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/sha3/proof/BlocksToTopLevel.ec b/sha3/proof/BlocksToTopLevel.ec index 50cfda7..e0fbbb3 100644 --- a/sha3/proof/BlocksToTopLevel.ec +++ b/sha3/proof/BlocksToTopLevel.ec @@ -4,7 +4,6 @@ require (*--*) Blocks TopLevel. (* -------------------------------------------------------------------- *) require import Common. -print Common. op chunk: bool list -> bool list list. diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index ef408c3..d64371a 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -60,9 +60,8 @@ clone export BitWord as Block with [op] "zero" as "b0" [op] "uniform" as "bdistr". - print LazyRP. - op ( * ): 'a NewDistr.distr -> 'b NewDistr.distr -> ('a * 'b) Pervasive.distr. + clone export LazyRP as Perm with type D <- block * capacity, op d <- bdistr * Capacity.cdistr From af9ffe284c7ad1bcb3fe605c9aa6d880ef7d59b5 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Sun, 15 Nov 2015 08:26:09 +0100 Subject: [PATCH 043/394] tests.config --- sha3/config/tests.config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/config/tests.config b/sha3/config/tests.config index 3c0fbec..3879c44 100644 --- a/sha3/config/tests.config +++ b/sha3/config/tests.config @@ -2,4 +2,4 @@ bin = ec.native [test-sha3] -okdirs = proof +okdirs = !proof From 647f1364e463e9079011e42c1be2210692f4b185 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Mon, 16 Nov 2015 19:08:51 -0500 Subject: [PATCH 044/394] Change > to <. All scripts weakly check again. --- sha3/proof/IRO.eca | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/proof/IRO.eca b/sha3/proof/IRO.eca index 436f7e7..a138d16 100644 --- a/sha3/proof/IRO.eca +++ b/sha3/proof/IRO.eca @@ -25,7 +25,7 @@ module IRO : IRO = { var b, bs; bs <- []; - while (n > 0) { + while (0 < n) { b <$ dto; bs <- rcons bs b; n <- n - 1; From 9638dc6423b3cc63c7f89eb66314e299b0c3de32 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 18 Nov 2015 14:58:59 -0500 Subject: [PATCH 045/394] We'd forgotten to increment i in the squeezing loops. Because we are using <- in cloning Indifferentiability.Core, the subtheory Types is empty, so no need to import it. --- sha3/proof/Absorb.ec | 1 - sha3/proof/Blocks.ec | 2 +- sha3/proof/TopLevel.ec | 6 +++--- 3 files changed, 4 insertions(+), 5 deletions(-) diff --git a/sha3/proof/Absorb.ec b/sha3/proof/Absorb.ec index dbc570d..f44437b 100644 --- a/sha3/proof/Absorb.ec +++ b/sha3/proof/Absorb.ec @@ -25,7 +25,6 @@ clone include Indifferentiability.Core with rename [module] "Indif" as "Experiment" [module] "al" as "alIndif". -import Types. (* -------------------------------------------------------------------- *) module BlockSponge (P : PRIMITIVE) : RO, CONSTRUCTION(P) = { diff --git a/sha3/proof/Blocks.ec b/sha3/proof/Blocks.ec index 9457575..aac1631 100644 --- a/sha3/proof/Blocks.ec +++ b/sha3/proof/Blocks.ec @@ -22,7 +22,6 @@ clone include Indifferentiability.Core with rename [module] "Indif" as "Experiment" [module] "al" as "alIndif". -import Types. (* -------------------------------------------------------------------- *) (** Spurious uninitialized variable warning on p *) @@ -44,6 +43,7 @@ module BlockSponge (P : PRIMITIVE) : BIRO.IRO, CONSTRUCTION(P) = { while (i < n) { z <- rcons z sa; (sa,sc) <@ P.f(sa,sc); + i <- i + 1; } } return z; diff --git a/sha3/proof/TopLevel.ec b/sha3/proof/TopLevel.ec index 23b7558..9886558 100644 --- a/sha3/proof/TopLevel.ec +++ b/sha3/proof/TopLevel.ec @@ -23,14 +23,13 @@ clone include Indifferentiability.Core with rename [module] "Indif" as "Experiment" [module] "al" as "alIndif". -import Types. (* -------------------------------------------------------------------- *) -(** Spurious uninitialized variable warning on p *) + module Sponge (P : PRIMITIVE) : BIRO.IRO, CONSTRUCTION(P) = { proc init = P.init - proc f(bp : bool list, n : int): bool list = { + proc f(bp : bool list, n : int) : bool list = { var z <- []; var (sa,sc) <- (b0, Capacity.c0); var i <- 0; @@ -45,6 +44,7 @@ module Sponge (P : PRIMITIVE) : BIRO.IRO, CONSTRUCTION(P) = { while (i < (n + r - 1) /% r) { z <- z ++ (Block.w2bits sa); (sa,sc) <@ P.f(sa,sc); + i <- i + 1; } return take n z; From 64d6df8c0c0521082153cfd0b44d9fbe5accf36d Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 19 Nov 2015 18:44:27 -0500 Subject: [PATCH 046/394] Defining unpadding. --- sha3/proof/Absorb.ec | 20 +++++++++++++++++++- sha3/proof/Blocks.ec | 7 ++++--- sha3/proof/Common.ec | 37 ++++++++++++++++++++++++++++++++++++- 3 files changed, 59 insertions(+), 5 deletions(-) diff --git a/sha3/proof/Absorb.ec b/sha3/proof/Absorb.ec index f44437b..9d1f753 100644 --- a/sha3/proof/Absorb.ec +++ b/sha3/proof/Absorb.ec @@ -8,7 +8,25 @@ op cast: 'a NewDistr.distr -> 'a distr. require import Common. (* -------------------------------------------------------------------- *) -op valid: block list -> bool. (* is in the image of the padding function *) + +(* valid_strip returns None if removing the longest suffix of b0's + from its argument yields a block list that cannot be unpadded; + otherwise, it removes the longest suffix of b0's from its argument + and returns the pair of the resulting block list with the number of + b0's removed *) +op valid_strip : block list -> (block list * int)option = + fun xs => + let ys = rev xs in + let i = find (fun x => x <> b0) ys in + if i = size xs + then None + else let zs = rev(drop i ys) in + if unpad zs = None + then None + else Some(zs, i). + +op valid : block list -> bool = + fun xs => valid_strip xs <> None. clone import RndOrcl as RO with type from <- block list, diff --git a/sha3/proof/Blocks.ec b/sha3/proof/Blocks.ec index aac1631..3e5d038 100644 --- a/sha3/proof/Blocks.ec +++ b/sha3/proof/Blocks.ec @@ -6,7 +6,9 @@ require (*--*) Common IRO LazyRP Indifferentiability. require import Common. (* -------------------------------------------------------------------- *) -op valid: block list -> bool. + +op valid : block list -> bool = + fun xs => unpad xs <> None. clone import IRO as BIRO with type from <- block list, @@ -24,11 +26,10 @@ clone include Indifferentiability.Core with [module] "al" as "alIndif". (* -------------------------------------------------------------------- *) -(** Spurious uninitialized variable warning on p *) module BlockSponge (P : PRIMITIVE) : BIRO.IRO, CONSTRUCTION(P) = { proc init = P.init - proc f(p : block list, n : int): block list = { + proc f(p : block list, n : int) : block list = { var z <- []; var (sa,sc) <- (b0, Capacity.c0); var i <- 0; diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index d64371a..862f64a 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -1,5 +1,5 @@ (* -------------------------------------------------------------------- *) -require import Fun Pair Int Real List NewDistr. +require import Option Fun Pair Int Real List NewDistr. require (*--*) FinType LazyRP Monoid. (* -------------------------------------------------------------------- *) @@ -68,3 +68,38 @@ clone export LazyRP as Perm with rename [module type] "RP" as "PRIMITIVE" [module] "P" as "Perm". + +(* ------------------------------ Padding ----------------------------- *) + +(* unpad_aux returns None if its argument xs doesn't end with true and + have at least one other occurrence of true; otherwise, it returns + Some of the result of removing the shortest suffix of xs containing + two occurrences of true *) +op unpad_aux : bool list -> bool list option = + fun xs => + let ys = rev xs in + if !(head false ys) + then None + else let zs = behead ys in + let i = find ((=) true) zs in + if i = size zs + then None + else Some(rev(drop (i + 1) zs)). + +op unpad : block list -> bool list option = + fun xs => + if xs = [] + then None + else let bs = w2bits(last b0 xs) in + let ys = take (size xs - 1) xs in + let ocs = unpad_aux bs in + if ocs = None + then if bs = nseq (r - 1) false ++ [true] && ys <> [] + then let ds = w2bits(last b0 ys) in + let ws = take (size ys - 1) ys in + if !(last false ds) + then None + else Some(flatten(map w2bits ws) ++ + take (size ds - 1) ds) + else None + else Some(flatten(map w2bits ys) ++ oget ocs). From aeb2a1fbd4712f5ceb84cdc05839468763d43f71 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 20 Nov 2015 18:02:04 -0500 Subject: [PATCH 047/394] Padding/unpadding and extending/stripping fully specified, and lemmas connecting them stated. --- sha3/proof/Absorb.ec | 18 +-- sha3/proof/AbsorbToBlocks.ec | 208 ++++++++++++++------------------- sha3/proof/Blocks.ec | 2 +- sha3/proof/BlocksToTopLevel.ec | 69 ++++------- sha3/proof/Common.ec | 85 +++++++++++++- sha3/proof/TopLevel.ec | 3 - 6 files changed, 196 insertions(+), 189 deletions(-) diff --git a/sha3/proof/Absorb.ec b/sha3/proof/Absorb.ec index 9d1f753..633c864 100644 --- a/sha3/proof/Absorb.ec +++ b/sha3/proof/Absorb.ec @@ -9,24 +9,8 @@ require import Common. (* -------------------------------------------------------------------- *) -(* valid_strip returns None if removing the longest suffix of b0's - from its argument yields a block list that cannot be unpadded; - otherwise, it removes the longest suffix of b0's from its argument - and returns the pair of the resulting block list with the number of - b0's removed *) -op valid_strip : block list -> (block list * int)option = - fun xs => - let ys = rev xs in - let i = find (fun x => x <> b0) ys in - if i = size xs - then None - else let zs = rev(drop i ys) in - if unpad zs = None - then None - else Some(zs, i). - op valid : block list -> bool = - fun xs => valid_strip xs <> None. + fun xs => strip xs <> None. clone import RndOrcl as RO with type from <- block list, diff --git a/sha3/proof/AbsorbToBlocks.ec b/sha3/proof/AbsorbToBlocks.ec index f6befac..c349cf3 100644 --- a/sha3/proof/AbsorbToBlocks.ec +++ b/sha3/proof/AbsorbToBlocks.ec @@ -7,94 +7,55 @@ require import Common. op cast: 'a NewDistr.distr -> 'a distr. -op extend (bs : block list) (n : int): block list = - bs ++ (mkseq (fun k => b0) n). - -op strip_aux (bs : block list) (n : int) : block list * int = - with bs = [] => ([],n) - with bs = b :: bs => - if b = b0 - then strip_aux bs (n + 1) - else (rev (b :: bs),n). - -op strip (bs : block list) = strip_aux (rev bs) 0. - -lemma ge0_strip_aux n bs: - 0 <= n => - 0 <= (strip_aux bs n).`2. -proof. - elim bs n=> //= b bs ih n le0_n. - case (b = b0)=> //=. - by rewrite (ih (n + 1) _) 1:smt. -qed. - -lemma ge0_strip2 bs: - 0 <= (strip bs).`2. -proof. by rewrite /strip; exact/(ge0_strip_aux 0 (rev bs)). qed. - -op valid_upper (bs : block list) = - bs <> [] /\ - forall n, strip (extend bs n) = (bs,n). - -op valid_lower (bs : block list) = - valid_upper (strip bs).`1. - -(* PY: FIXME *) -clone Absorb as Lower with - op cast <- cast<:'a>, - op valid <- valid_lower. - -clone Blocks as Upper with - op valid <- valid_upper. - (* -------------------------------------------------------------------- *) -module LowerFun( F : Upper.FUNCTIONALITY ) : Lower.FUNCTIONALITY = { +module LowerFun(F : Blocks.FUNCTIONALITY) : Absorb.FUNCTIONALITY = { proc init = F.init - proc f(p : block list): block = { - var b <- []; + proc f(xs : block list) : block = { + var o : (block list * int)option; + var ys <- []; var n; - if (valid_lower p) { - (p,n) <- strip p; - b <@ F.f(p,n + 1); + o <- strip xs; + if (o <> None) { + (ys, n) <- oget o; + ys <@ F.f(ys, n + 1); } - return last b0 b; + return last b0 ys; } }. -module Sim ( S : Lower.SIMULATOR, F : Upper.FUNCTIONALITY ) = S(LowerFun(F)). +module Sim (S : Absorb.SIMULATOR, F : Blocks.FUNCTIONALITY) = S(LowerFun(F)). -module UpperFun ( F : Lower.FUNCTIONALITY ) = { +module UpperFun (F : Absorb.FUNCTIONALITY) = { proc init = F.init - proc f(p : block list, n : int) : block list = { - var b <- b0; - var bs <- []; + proc f(xs : block list, n : int) : block list = { + var y <- b0; + var ys <- []; var i <- 0; - if (valid_upper p) { + if (unpad xs <> None) { while (i < n) { - b <@ F.f(extend p i); - bs <- rcons bs b; + y <@ F.f(oget(extend xs i)); + ys <- rcons ys y; i <- i + 1; } } - - return bs; + return ys; } }. -module UpperOfLowerBlockSponge (P : Upper.PRIMITIVE) = UpperFun(Lower.BlockSponge(P)). +module BlocksOfAbsorbBlockSponge (P : Blocks.PRIMITIVE) = UpperFun(Absorb.BlockSponge(P)). -module Dist ( D : Upper.DISTINGUISHER, F : Lower.FUNCTIONALITY, P : Lower.PRIMITIVE ) = D(UpperFun(F),P). +module Dist ( D : Blocks.DISTINGUISHER, F : Absorb.FUNCTIONALITY, P : Absorb.PRIMITIVE ) = D(UpperFun(F),P). section. - declare module LowerSim : Lower.SIMULATOR { Perm, Upper.BIRO.IRO', Lower.Ideal.RO }. - declare module UpperDist : Upper.DISTINGUISHER { Perm, Upper.BIRO.IRO', Lower.Ideal.RO, LowerSim }. + declare module AbsorbSim : Absorb.SIMULATOR { Perm, Blocks.BIRO.IRO', Absorb.Ideal.RO }. + declare module BlocksDist : Blocks.DISTINGUISHER { Perm, Blocks.BIRO.IRO', Absorb.Ideal.RO, AbsorbSim }. - local equiv ModularUpper_Real: - UpperFun(Lower.BlockSponge(Perm)).f ~ Upper.BlockSponge(Perm).f: + local equiv ModularBlocks_Real: + UpperFun(Absorb.BlockSponge(Perm)).f ~ Blocks.BlockSponge(Perm).f: ={arg} /\ ={m,mi}(Perm,Perm) /\ (forall x, mem (dom Perm.m){1} x) @@ -103,42 +64,44 @@ section. /\ (forall x, mem (dom Perm.m){1} x). proof. proc. sp; if=> //=. - inline Lower.BlockSponge(Perm).f. + inline Absorb.BlockSponge(Perm).f. admit. (* Fun with loops *) qed. pred lower (ro : (block list,block) fmap) (iro : (block list * int,block) fmap) = - Upper.BIRO.prefix_closed iro /\ - forall x n, valid_upper x => iro.[(x,n)] = ro.[extend x n]. + Blocks.BIRO.prefix_closed iro /\ + forall x n, unpad x <> None => iro.[(x,n)] = ro.[oget(extend x n)]. - local equiv ModularLower: - UpperFun(Lower.Ideal.RO).f ~ Upper.BIRO.IRO'.f: + local equiv ModularAbsorb: + UpperFun(Absorb.Ideal.RO).f ~ Blocks.BIRO.IRO'.f: ={arg} - /\ lower Lower.Ideal.RO.m{1} Upper.BIRO.IRO'.mp{2} + /\ lower Absorb.Ideal.RO.m{1} Blocks.BIRO.IRO'.mp{2} ==> ={res} - /\ lower Lower.Ideal.RO.m{1} Upper.BIRO.IRO'.mp{2}. + /\ lower Absorb.Ideal.RO.m{1} Blocks.BIRO.IRO'.mp{2}. proof. proc. sp; if=> //=. - inline Lower.BlockSponge(Perm).f. + inline Absorb.BlockSponge(Perm).f. admit. (* Fun with loops *) qed. pred upper (ro : (block list,block) fmap) (iro : (block list * int,block) fmap) = - (forall x y, valid_lower x => ro.[x] = Some y => iro.[strip x] = Some y) + (forall x y, strip x <> None => ro.[x] = Some y => iro.[oget(strip x)] = Some y) /\ (forall x n y, - valid_upper x => + unpad x <> None => iro.[(x,n)] = Some y => exists n', n <= n' - /\ mem (dom ro) (extend x n')). + /\ mem (dom ro) (oget(extend x n'))). - module LowIRO' : Lower.FUNCTIONALITY = { - proc init = Upper.BIRO.IRO'.init + module LowIRO' : Absorb.FUNCTIONALITY = { + proc init = Blocks.BIRO.IRO'.init proc f(x : block list) = { var b <- b0; + var o : (block list * int)option; - if (valid_lower x) { - b <@ Upper.BIRO.IRO'.f_lazy(strip x); + o <- strip x; + if (o <> None) { + b <@ Blocks.BIRO.IRO'.f_lazy(oget o); } return b; @@ -146,7 +109,7 @@ section. }. pred holey_map (iro iro_lazy : (block list * int,block) fmap) = - Upper.BIRO.prefix_closed iro + Blocks.BIRO.prefix_closed iro /\ (forall xn, mem (dom iro_lazy) xn => iro_lazy.[xn] = iro.[xn]) @@ -160,23 +123,24 @@ section. whose index is not in the index of the right map, as they have not ben given to the adversary. **) local lemma LazifyIRO: - eager [Upper.BIRO.IRO'.resample_invisible(); , LowerFun(Upper.BIRO.IRO').f ~ LowIRO'.f, Upper.BIRO.IRO'.resample_invisible();: - ={arg, Upper.BIRO.IRO'.visible} - /\ holey_map Upper.BIRO.IRO'.mp{1} Upper.BIRO.IRO'.mp{2} - /\ Upper.BIRO.IRO'.visible{2} = dom (Upper.BIRO.IRO'.mp){2} - ==> ={res, Upper.BIRO.IRO'.visible} - /\ holey_map Upper.BIRO.IRO'.mp{1} Upper.BIRO.IRO'.mp{2} - /\ Upper.BIRO.IRO'.visible{2} = dom (Upper.BIRO.IRO'.mp){2}]. + eager [Blocks.BIRO.IRO'.resample_invisible(); , LowerFun(Blocks.BIRO.IRO').f ~ LowIRO'.f, Blocks.BIRO.IRO'.resample_invisible();: + ={arg, Blocks.BIRO.IRO'.visible} + /\ holey_map Blocks.BIRO.IRO'.mp{1} Blocks.BIRO.IRO'.mp{2} + /\ Blocks.BIRO.IRO'.visible{2} = dom (Blocks.BIRO.IRO'.mp){2} + ==> ={res, Blocks.BIRO.IRO'.visible} + /\ holey_map Blocks.BIRO.IRO'.mp{1} Blocks.BIRO.IRO'.mp{2} + /\ Blocks.BIRO.IRO'.visible{2} = dom (Blocks.BIRO.IRO'.mp){2}]. proof. +(* eager proc. case (!valid_lower p{1})=> /=. rcondf{1} 3; 1: by auto; inline *; auto; while (true); auto. rcondf{2} 2; 1: by auto. inline *; auto. rcondf{2} 4; 1: by auto; smt. - while{1} ( work{1} <= dom (Upper.BIRO.IRO'.mp){1} - /\ holey_map Upper.BIRO.IRO'.mp{1} Upper.BIRO.IRO'.mp{2} - /\ forall x, mem work{1} x => mem (dom Upper.BIRO.IRO'.mp){1} x /\ !mem (dom Upper.BIRO.IRO'.mp){2} x) + while{1} ( work{1} <= dom (Blocks.BIRO.IRO'.mp){1} + /\ holey_map Blocks.BIRO.IRO'.mp{1} Blocks.BIRO.IRO'.mp{2} + /\ forall x, mem work{1} x => mem (dom Blocks.BIRO.IRO'.mp){1} x /\ !mem (dom Blocks.BIRO.IRO'.mp){2} x) (card work{1}). auto; progress. + admit. (* TODO: dto lossless *) @@ -195,19 +159,19 @@ section. by auto; smt. rcondt{1} 3; 1: by auto; inline *; auto; while (true); auto. rcondt{2} 2; 1: by auto. - inline Upper.BIRO.IRO'.f Upper.BIRO.IRO'.f_lazy. + inline Blocks.BIRO.IRO'.f Blocks.BIRO.IRO'.f_lazy. rcondt{1} 8; 1: by auto; inline *; auto; while (true); auto; smt. rcondt{2} 4; 1: by auto; smt. - case ((mem (dom Upper.BIRO.IRO'.mp) (strip p)){1} /\ !(mem (dom Upper.BIRO.IRO'.mp) (strip x)){2}). + case ((mem (dom Blocks.BIRO.IRO'.mp) (strip p)){1} /\ !(mem (dom Blocks.BIRO.IRO'.mp) (strip x)){2}). admit. (* this is the bad case where we need to bring down the sampling from resample_invisible *) - inline{2} Upper.BIRO.IRO'.resample_invisible. + inline{2} Blocks.BIRO.IRO'.resample_invisible. rcondf{2} 9; 1: by auto; inline *; sp; if; auto; smt. - seq 1 0: ((((p{1} = x{2} /\ ={Upper.BIRO.IRO'.visible}) /\ - holey_map Upper.BIRO.IRO'.mp{1} Upper.BIRO.IRO'.mp{2} /\ - Upper.BIRO.IRO'.visible{2} = dom Upper.BIRO.IRO'.mp{2}) /\ + seq 1 0: ((((p{1} = x{2} /\ ={Blocks.BIRO.IRO'.visible}) /\ + holey_map Blocks.BIRO.IRO'.mp{1} Blocks.BIRO.IRO'.mp{2} /\ + Blocks.BIRO.IRO'.visible{2} = dom Blocks.BIRO.IRO'.mp{2}) /\ valid_lower p{1}) /\ - ! (mem (dom Upper.BIRO.IRO'.mp{1}) (strip p{1}) /\ - ! mem (dom Upper.BIRO.IRO'.mp{2}) (strip x{2}))). (* disgusting copy-paste. we need seq* *) + ! (mem (dom Blocks.BIRO.IRO'.mp{1}) (strip p{1}) /\ + ! mem (dom Blocks.BIRO.IRO'.mp{2}) (strip x{2}))). (* disgusting copy-paste. we need seq* *) admit. splitwhile{1} 8: (i < n0 - 1). rcondt{1} 9. @@ -221,6 +185,8 @@ section. by auto; smt. * inline*; sp; if; auto; smt. admit. (* just pushing the proof through *) +*) + admit. qed. @@ -228,27 +194,27 @@ section. - on actual queries, the two maps agree; - blocks in the IRO that are just generated on the way to answering actual queries can be resampled. **) - (* Lower.Ideal.RO.f ~ LowerFun(Upper.BIRO.IRO).f: + (* Absorb.Ideal.RO.f ~ LowerFun(Blocks.BIRO.IRO).f: ={arg} /\ true ==> ={res}. *) lemma Intermediate &m: - `|Pr[Upper.RealIndif(Upper.BlockSponge,Perm,UpperDist).main() @ &m :res] - - Pr[Upper.IdealIndif(Upper.BIRO.IRO',Sim(LowerSim),UpperDist).main() @ &m: res]| - = `|Pr[Upper.RealIndif(UpperOfLowerBlockSponge,Perm,UpperDist).main() @ &m: res] - - Pr[Upper.IdealIndif(UpperFun(Lower.Ideal.RO),Sim(LowerSim),UpperDist).main() @ &m: res]|. + `|Pr[Blocks.RealIndif(Blocks.BlockSponge,Perm,BlocksDist).main() @ &m :res] + - Pr[Blocks.IdealIndif(Blocks.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]| + = `|Pr[Blocks.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] + - Pr[Blocks.IdealIndif(UpperFun(Absorb.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res]|. proof. - have ->: Pr[Upper.RealIndif(UpperOfLowerBlockSponge,Perm,UpperDist).main() @ &m: res] - = Pr[Upper.RealIndif(Upper.BlockSponge,Perm,UpperDist).main() @ &m :res]. + have ->: Pr[Blocks.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] + = Pr[Blocks.RealIndif(Blocks.BlockSponge,Perm,BlocksDist).main() @ &m :res]. byequiv=> //=; proc. call (_: ={m,mi}(Perm,Perm) /\ (forall x, mem (dom Perm.m){1} x)). by proc; if; auto; smt. by proc; if; auto; smt. (* BUG: arg should be handled much earlier and automatically *) - by conseq ModularUpper_Real=> //= &1 &2; case (arg{1}); case (arg{2})=> //=. + by conseq ModularBlocks_Real=> //= &1 &2; case (arg{1}); case (arg{2})=> //=. call (_: true ==> ={glob Perm} /\ (forall x, mem (dom Perm.m){1} x)). @@ -256,16 +222,16 @@ section. (* Now the other initialization is dead code. *) call (_: true ==> true)=> //. by proc; auto. - have ->: Pr[Upper.IdealIndif(UpperFun(Lower.Ideal.RO),Sim(LowerSim),UpperDist).main() @ &m: res] - = Pr[Upper.IdealIndif(Upper.BIRO.IRO',Sim(LowerSim),UpperDist).main() @ &m: res]. + have ->: Pr[Blocks.IdealIndif(UpperFun(Absorb.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res] + = Pr[Blocks.IdealIndif(Blocks.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]. byequiv=> //=; proc. - call (_: ={glob LowerSim} /\ lower Lower.Ideal.RO.m{1} Upper.BIRO.IRO'.mp{2}). - proc (lower Lower.Ideal.RO.m{1} Upper.BIRO.IRO'.mp{2})=> //=. - by proc; sp; if=> //=; call ModularLower; auto. - proc (lower Lower.Ideal.RO.m{1} Upper.BIRO.IRO'.mp{2})=> //=. - by proc; sp; if=> //=; call ModularLower; auto. + call (_: ={glob AbsorbSim} /\ lower Absorb.Ideal.RO.m{1} Blocks.BIRO.IRO'.mp{2}). + proc (lower Absorb.Ideal.RO.m{1} Blocks.BIRO.IRO'.mp{2})=> //=. + by proc; sp; if=> //=; call ModularAbsorb; auto. + proc (lower Absorb.Ideal.RO.m{1} Blocks.BIRO.IRO'.mp{2})=> //=. + by proc; sp; if=> //=; call ModularAbsorb; auto. (* Re-Bug *) - by conseq ModularLower=> &1 &2; case (arg{1}); case (arg{2}). + by conseq ModularAbsorb=> &1 &2; case (arg{1}); case (arg{2}). inline *; wp; call (_: true)=> //=. by sim. auto; progress [-split]; split=> //=. @@ -274,16 +240,16 @@ section. qed. lemma Remainder &m: - `|Pr[Upper.RealIndif(UpperOfLowerBlockSponge,Perm,UpperDist).main() @ &m: res] - - Pr[Upper.IdealIndif(UpperFun(Lower.Ideal.RO),Sim(LowerSim),UpperDist).main() @ &m: res]| - = `|Pr[Lower.RealIndif(Lower.BlockSponge,Perm,Dist(UpperDist)).main() @ &m: res] - - Pr[Lower.IdealIndif(Lower.Ideal.RO,LowerSim,Dist(UpperDist)).main() @ &m: res]|. + `|Pr[Blocks.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] + - Pr[Blocks.IdealIndif(UpperFun(Absorb.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res]| + = `|Pr[Absorb.RealIndif(Absorb.BlockSponge,Perm,Dist(BlocksDist)).main() @ &m: res] + - Pr[Absorb.IdealIndif(Absorb.Ideal.RO,AbsorbSim,Dist(BlocksDist)).main() @ &m: res]|. proof. admit. qed. lemma Conclusion &m: - `|Pr[Upper.RealIndif(Upper.BlockSponge,Perm,UpperDist).main() @ &m: res] - - Pr[Upper.IdealIndif(Upper.BIRO.IRO',Sim(LowerSim),UpperDist).main() @ &m: res]| - = `|Pr[Lower.RealIndif(Lower.BlockSponge,Perm,Dist(UpperDist)).main() @ &m: res] - - Pr[Lower.IdealIndif(Lower.Ideal.RO,LowerSim,Dist(UpperDist)).main() @ &m: res]|. + `|Pr[Blocks.RealIndif(Blocks.BlockSponge,Perm,BlocksDist).main() @ &m: res] + - Pr[Blocks.IdealIndif(Blocks.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]| + = `|Pr[Absorb.RealIndif(Absorb.BlockSponge,Perm,Dist(BlocksDist)).main() @ &m: res] + - Pr[Absorb.IdealIndif(Absorb.Ideal.RO,AbsorbSim,Dist(BlocksDist)).main() @ &m: res]|. proof. by rewrite (Intermediate &m) (Remainder &m). qed. end section. diff --git a/sha3/proof/Blocks.ec b/sha3/proof/Blocks.ec index 3e5d038..ff3c8cd 100644 --- a/sha3/proof/Blocks.ec +++ b/sha3/proof/Blocks.ec @@ -60,4 +60,4 @@ lemma top: `| Pr[RealIndif(BlockSponge, Perm, D).main() @ &m : res] - Pr[IdealIndif(IRO', S, D).main() @ &m : res]| < eps. -proof. admit. qed. \ No newline at end of file +proof. admit. qed. diff --git a/sha3/proof/BlocksToTopLevel.ec b/sha3/proof/BlocksToTopLevel.ec index e0fbbb3..977ffac 100644 --- a/sha3/proof/BlocksToTopLevel.ec +++ b/sha3/proof/BlocksToTopLevel.ec @@ -5,77 +5,56 @@ require (*--*) Blocks TopLevel. (* -------------------------------------------------------------------- *) require import Common. -op chunk: bool list -> bool list list. - -op padlength (n : int) = - let n' = (n + 2) %% r in - if n' = 0 then 0 else r - n'. - -op pad (bs : bool list): block list = - let p = rcons (true :: mkseq (fun k => false) (padlength (size bs))) true in - map bits2w (chunk (bs ++ p)). - -op unpad (bs : block list): bool list option. (* Alley to fill in the definition *) - -axiom unpadK (bs : bool list): pcancel pad unpad. -axiom padK (*?*) (bs : block list): ocancel unpad pad. - -op valid_lower (bs : block list) = unpad bs <> None. - -clone Blocks as Lower with - op valid <- valid_lower. - -clone TopLevel as Upper. - (* -------------------------------------------------------------------- *) -module UpperFun ( F : Lower.FUNCTIONALITY ) = { +module UpperFun (F : Blocks.FUNCTIONALITY) = { proc init = F.init proc f(p : bool list, n : int) = { - var bs; + var xs; - bs <@ F.f(pad p,(n + r - 1) /% r); - return take n (flatten (map w2bits bs)); + xs <@ F.f(pad p, (n + r - 1) /% r); + return take n (flatten(map w2bits xs)); } }. -module LowerFun ( F: Upper.FUNCTIONALITY) = { +module LowerFun (F : TopLevel.FUNCTIONALITY) = { proc init = F.init - proc f(p : block list, n : int) = { - var bs, m; - var bs' <- []; + proc f(xs : block list, n : int) = { + var cs, ds : bool list; + var obs : bool list option; + var ys : block list <- []; - m <- unpad p; - if (m <> None) { - bs <@ F.f(oget m,n * r); - bs' <- map bits2w (chunk bs); + obs <- unpad xs; + if (obs <> None) { + cs <@ F.f(oget obs, n * r); (* size cs = n * r *) + ys <- (chunk cs).`1; } - return bs'; + return ys; } }. (* -------------------------------------------------------------------- *) equiv ModularConstruction: - UpperFun(Lower.BlockSponge(Perm)).f ~ Upper.Sponge(Perm).f: + UpperFun(Blocks.BlockSponge(Perm)).f ~ TopLevel.Sponge(Perm).f: ={glob Perm, arg} ==> ={glob Perm, res}. proof. - proc. inline Lower.BlockSponge(Perm).f. + proc. inline Blocks.BlockSponge(Perm).f. admit. (* done *) qed. -module ModularSimulator (S : Lower.SIMULATOR, F : Upper.FUNCTIONALITY) = S(LowerFun(F)). +module ModularSimulator (S : Blocks.SIMULATOR, F : TopLevel.FUNCTIONALITY) = S(LowerFun(F)). -module LowerDist ( D : Upper.DISTINGUISHER, F : Lower.FUNCTIONALITY, P : PRIMITIVE) = +module BlocksDist ( D : TopLevel.DISTINGUISHER, F : Blocks.FUNCTIONALITY, P : PRIMITIVE) = D(UpperFun(F),P). section. - declare module LowerSim : Lower.SIMULATOR. - declare module UpperDist : Upper.DISTINGUISHER. + declare module BlocksSim : Blocks.SIMULATOR. + declare module TopLevelDist : TopLevel.DISTINGUISHER. lemma Conclusion &m: - `|Pr[Upper.RealIndif(Upper.Sponge,Perm,UpperDist).main() @ &m: res] - - Pr[Upper.IdealIndif(Upper.BIRO.IRO',ModularSimulator(LowerSim),UpperDist).main() @ &m: res]| - = `|Pr[Lower.RealIndif(Lower.BlockSponge,Perm,LowerDist(UpperDist)).main() @ &m: res] - - Pr[Lower.IdealIndif(Lower.BIRO.IRO',LowerSim,LowerDist(UpperDist)).main() @ &m: res]|. + `|Pr[TopLevel.RealIndif(TopLevel.Sponge,Perm,TopLevelDist).main() @ &m: res] + - Pr[TopLevel.IdealIndif(TopLevel.BIRO.IRO',ModularSimulator(BlocksSim),TopLevelDist).main() @ &m: res]| + = `|Pr[Blocks.RealIndif(Blocks.BlockSponge,Perm,BlocksDist(TopLevelDist)).main() @ &m: res] + - Pr[Blocks.IdealIndif(Blocks.BIRO.IRO',BlocksSim,BlocksDist(TopLevelDist)).main() @ &m: res]|. proof. admit. qed. diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 862f64a..dec6307 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -1,5 +1,5 @@ (* -------------------------------------------------------------------- *) -require import Option Fun Pair Int Real List NewDistr. +require import Option Fun Pair Int IntExtra Real List NewDistr. require (*--*) FinType LazyRP Monoid. (* -------------------------------------------------------------------- *) @@ -69,7 +69,34 @@ rename [module type] "RP" as "PRIMITIVE" [module] "P" as "Perm". -(* ------------------------------ Padding ----------------------------- *) +(* ------------------------- Padding/Unpadding ------------------------ *) + +(* if size cs < r, then size (chunk_aux (xs, cs) b).`2 < r *) +op chunk_aux : block list * bool list -> bool -> block list * bool list = + fun p b => + let (xs, cs) = p in + let ds = rcons cs b in + if size ds = r + then (rcons xs (bits2w ds), []) + else (xs, ds). + +(* size (chunk bs).`2 < r *) +op chunk : bool list -> block list * bool list = + fun bs => foldl chunk_aux ([], []) bs. + +op pad : bool list -> block list = + fun bs => + let (xs, cs) = chunk bs in + let siz_cs = size cs in (* siz_cs < r *) + if 2 <= r - siz_cs + then rcons xs + (bits2w(cs ++ + [true] ++ + nseq (r - siz_cs - 2) false ++ + [true])) + else (* r - siz_cs = 1 *) + xs ++ [bits2w(rcons cs true)] ++ + [bits2w(rcons (nseq (r - 1) false) true)]. (* unpad_aux returns None if its argument xs doesn't end with true and have at least one other occurrence of true; otherwise, it returns @@ -103,3 +130,57 @@ op unpad : block list -> bool list option = take (size ds - 1) ds) else None else Some(flatten(map w2bits ys) ++ oget ocs). + +lemma pad_unpad : pcancel pad unpad. +proof. +rewrite /pcancel. +admit. +qed. + +lemma unpad_pad : ocancel unpad pad. +proof. +rewrite /ocancel. +admit. +qed. + +(* ------------------------ Extending/Stripping ----------------------- *) + +(* extend xs n returns None if xs doesn't unpad successfully; + otherwise, it returns the result of adding n copies of b0 to the + end of xs (n < 0 is treated as n = 0) *) +op extend : block list -> int -> block list option = + fun xs n => + if unpad xs = None + then None + else Some(xs ++ nseq n b0). + +op extend_uncur : block list * int -> block list option = + fun (p : block list * int) => extend p.`1 p.`2. + +(* strip returns None if removing the longest suffix of b0's from its + argument yields a block list that cannot be unpadded; otherwise, it + removes the longest suffix of b0's from its argument and returns + the pair of the resulting block list with the number of b0's + removed *) +op strip : block list -> (block list * int)option = + fun xs => + let ys = rev xs in + let i = find (fun x => x <> b0) ys in + if i = size xs + then None + else let zs = rev(drop i ys) in + if unpad zs = None + then None + else Some(zs, i). + +lemma extend_strip (xs : block list, n : int) : + oapp strip (Some(xs, max n 0)) (extend xs n) = Some(xs, max n 0). +proof. +admit. +qed. + +lemma strip_extend (xs : block list) : + oapp extend_uncur (Some xs) (strip xs) = Some xs. +proof. +admit. +qed. diff --git a/sha3/proof/TopLevel.ec b/sha3/proof/TopLevel.ec index 9886558..f42864e 100644 --- a/sha3/proof/TopLevel.ec +++ b/sha3/proof/TopLevel.ec @@ -5,9 +5,6 @@ require (*--*) IRO LazyRP Indifferentiability. (* -------------------------------------------------------------------- *) require import Common. -(* -------------------------------------------------------------------- *) -op pad : bool list -> block list. - (* -------------------------------------------------------------------- *) clone import IRO as BIRO with type from <- bool list, From 21c7671781d0ec562d9367bdb631a5e0927c5608 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Mon, 23 Nov 2015 12:22:39 -0500 Subject: [PATCH 048/394] Characterization lemmas for unpad and strip success. --- sha3/proof/Common.ec | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index dec6307..3d3361a 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -131,6 +131,17 @@ op unpad : block list -> bool list option = else None else Some(flatten(map w2bits ys) ++ oget ocs). +pred valid_block (xs : block list) = + exists (ys : bool list, n : int), + 0 <= n < r /\ + flatten(map w2bits xs) = ys ++ [true] ++ nseq n false ++ [true]. + +lemma valid_block (xs : block list) : + unpad xs <> None <=> valid_block xs. +proof. +admit. +qed. + lemma pad_unpad : pcancel pad unpad. proof. rewrite /pcancel. @@ -173,6 +184,16 @@ op strip : block list -> (block list * int)option = then None else Some(zs, i). +pred valid_absorb (xs : block list) = + exists (ys : block list, n : int), + 0 <= n /\ valid_block ys /\ xs = ys ++ nseq n b0. + +lemma valid_absorb (xs : block list) : + strip xs <> None <=> valid_absorb xs. +proof. +admit. +qed. + lemma extend_strip (xs : block list, n : int) : oapp strip (Some(xs, max n 0)) (extend xs n) = Some(xs, max n 0). proof. From 091e149312f51656e0d36d10b7e242cc37c7c0cf Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 24 Nov 2015 11:48:56 -0500 Subject: [PATCH 049/394] Changed to use IntDiv. --- sha3/proof/BlocksToTopLevel.ec | 4 ++-- sha3/proof/TopLevel.ec | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/sha3/proof/BlocksToTopLevel.ec b/sha3/proof/BlocksToTopLevel.ec index 977ffac..ee672ec 100644 --- a/sha3/proof/BlocksToTopLevel.ec +++ b/sha3/proof/BlocksToTopLevel.ec @@ -1,5 +1,5 @@ (* -------------------------------------------------------------------- *) -require import Fun Pred Option Pair Int Real List FSet NewFMap. +require import Fun Pred Option Pair Int IntDiv Real List FSet NewFMap. require (*--*) Blocks TopLevel. (* -------------------------------------------------------------------- *) @@ -12,7 +12,7 @@ module UpperFun (F : Blocks.FUNCTIONALITY) = { proc f(p : bool list, n : int) = { var xs; - xs <@ F.f(pad p, (n + r - 1) /% r); + xs <@ F.f(pad p, (n + r - 1) %/ r); return take n (flatten(map w2bits xs)); } }. diff --git a/sha3/proof/TopLevel.ec b/sha3/proof/TopLevel.ec index f42864e..fdf783d 100644 --- a/sha3/proof/TopLevel.ec +++ b/sha3/proof/TopLevel.ec @@ -1,5 +1,5 @@ (* -------------------------------------------------------------------- *) -require import Pair Int Real List. +require import Pair Int IntDiv Real List. require (*--*) IRO LazyRP Indifferentiability. (* -------------------------------------------------------------------- *) @@ -38,7 +38,7 @@ module Sponge (P : PRIMITIVE) : BIRO.IRO, CONSTRUCTION(P) = { p <- behead p; } (* Squeezing *) - while (i < (n + r - 1) /% r) { + while (i < (n + r - 1) %/ r) { z <- z ++ (Block.w2bits sa); (sa,sc) <@ P.f(sa,sc); i <- i + 1; From 2614a22450ed8703494e6dffbb1c6ce69d8a4535 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 25 Nov 2015 21:55:06 -0500 Subject: [PATCH 050/394] Ugly proofs regarding chunking; will clean up next. --- sha3/proof/Common.ec | 171 +++++++++++++++++++++++++++++++++++++------ 1 file changed, 150 insertions(+), 21 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 3d3361a..d371986 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -30,6 +30,9 @@ lemma bits2wK (s : bool list) : size s = size => w2bits (bits2w s) = s. proof. admit. qed. +lemma w2bits_size (x : bword) : size(w2bits x) = size. +proof. admit. qed. + op uniform : bword distr = MUniform.duniform FinType.enum. end BitWord. @@ -82,7 +85,150 @@ op chunk_aux : block list * bool list -> bool -> block list * bool list = (* size (chunk bs).`2 < r *) op chunk : bool list -> block list * bool list = - fun bs => foldl chunk_aux ([], []) bs. + foldl chunk_aux ([], []). + +op flatten (p : block list * bool list) : bool list = + flatten(map w2bits p.`1) ++ p.`2. + +lemma chunk_aux_flatten (xs : block list, cs : bool list, bs : bool list) : + size cs < r => + flatten (foldl chunk_aux (xs, cs) bs) = + flatten(map w2bits xs) ++ cs ++ bs. +proof. +move: bs xs cs. +elim. +(* basis step *) +move=> xs cs siz_cs_lt_r. +have -> : foldl chunk_aux (xs, cs) [] = (xs, cs) by trivial. +rewrite /flatten /=. +rewrite - catA. +rewrite cats0 //. +(* inductive step *) +move=> x l IH xs cs siz_cs_lt_r /=. +rewrite {2} /chunk_aux /=. +case (size cs = r - 1) => siz_cs_eq_r_min1. +have -> : size(rcons cs x) = r by smt. +simplify. +have -> : + flatten (map w2bits xs) ++ cs ++ x :: l = + flatten (map w2bits xs) ++ (rcons cs x) ++ l by smt. +rewrite (IH (rcons xs (bits2w (rcons cs x))) []). + smt. +have -> : + map w2bits (rcons xs (bits2w (rcons cs x))) = + rcons (map w2bits xs) (rcons cs x) by smt. +rewrite - cats1. +smt. +have : size cs < r - 1 by smt. +move=> siz_cs_lt_r_min1. +clear siz_cs_lt_r siz_cs_eq_r_min1. +have : !(size(rcons cs x) = r) by smt. +move=> H. +rewrite H /=. +rewrite (IH xs (rcons cs x)). + smt. +smt. +qed. + +lemma chunk_flatten : cancel chunk flatten. +proof. +rewrite /cancel => p. +rewrite /chunk. +rewrite chunk_aux_flatten. +smt. +smt. +qed. + +lemma foldl_chunk_aux_add_bits (ys : block list, cs, ds : bool list) : + size ds + size cs < r => + foldl chunk_aux (ys, ds) cs = (ys, ds ++ cs). +proof. +move: ys ds. +elim cs. +smt. +move=> c cs IH ys ds siz_ys_plus_c_cs_lt_r. +have -> : + foldl chunk_aux (ys, ds) (c :: cs) = + foldl chunk_aux (ys, rcons ds c) cs. + simplify. + have -> : chunk_aux (ys, ds) c = (ys, rcons ds c). + rewrite /chunk_aux. + simplify. + smt. + reflexivity. +rewrite (IH ys (rcons ds c)). +smt. +smt. +qed. + +lemma foldl_chunk_aux_new_block (ys : block list, cs, ds : bool list) : + cs <> [] => size ds + size cs = r => + foldl chunk_aux (ys, ds) cs = (rcons ys (bits2w(ds ++ cs)), []). +proof. +move=> cs_nonnil siz. +cut cs_form : exists (es, fs : bool list), + size es = size cs - 1 /\ + size fs = 1 /\ + cs = es ++ fs. + exists (take (size cs - 1) cs), (drop (size cs - 1) cs). + smt. +elim cs_form => es fs [H1 [H2 H3]]. +cut fs_form : exists (f : bool), fs = [f]. + exists (nth false fs 0). + smt. +elim fs_form => f H4. +rewrite H3 H4. +rewrite foldl_cat. +rewrite foldl_chunk_aux_add_bits. +smt. +cut -> : + foldl chunk_aux (ys, ds ++ es) [f] = + chunk_aux (ys, ds ++ es) f. + trivial. +rewrite /chunk_aux. +smt. +qed. + +lemma flatten_chunk_aux (xs, ys : block list, cs : bool list) : + size cs < r => + foldl chunk_aux (ys, []) (flatten(xs, cs)) = (ys ++ xs, cs). +proof. +move: cs ys. +elim xs. +(* basis step *) +move=> cs ys siz_cs_lt_r. +have -> : flatten([], cs) = cs by smt. +rewrite foldl_chunk_aux_add_bits. +smt. +smt. +(* inductive step *) +move=> x xs IH cs ys siz_cs_lt_r. +have -> : flatten(x :: xs, cs) = w2bits x ++ flatten (xs, cs) by smt. +rewrite foldl_cat. +rewrite foldl_chunk_aux_new_block. +smt. +smt. +have -> : bits2w([] ++ w2bits x) = x by smt. +rewrite (IH cs (rcons ys x)). +assumption. +smt. +qed. + +lemma flatten_chunk (xs, ys : block list, cs : bool list) : + size cs < r => + chunk(flatten(xs, cs)) = (xs, cs). +proof. +move=> siz_cs_lt_r. +rewrite /chunk. +rewrite (flatten_chunk_aux xs [] cs). +assumption. +smt. +qed. + +pred valid_block (xs : block list) = + exists (ys : bool list, n : int), + 0 <= n < r /\ + flatten(map w2bits xs) = ys ++ [true] ++ nseq n false ++ [true]. op pad : bool list -> block list = fun bs => @@ -114,27 +260,10 @@ op unpad_aux : bool list -> bool list option = else Some(rev(drop (i + 1) zs)). op unpad : block list -> bool list option = - fun xs => - if xs = [] - then None - else let bs = w2bits(last b0 xs) in - let ys = take (size xs - 1) xs in - let ocs = unpad_aux bs in - if ocs = None - then if bs = nseq (r - 1) false ++ [true] && ys <> [] - then let ds = w2bits(last b0 ys) in - let ws = take (size ys - 1) ys in - if !(last false ds) - then None - else Some(flatten(map w2bits ws) ++ - take (size ds - 1) ds) - else None - else Some(flatten(map w2bits ys) ++ oget ocs). + fun xs => unpad_aux(flatten(map w2bits xs)). -pred valid_block (xs : block list) = - exists (ys : bool list, n : int), - 0 <= n < r /\ - flatten(map w2bits xs) = ys ++ [true] ++ nseq n false ++ [true]. +lemma pad_valid (bs : bool list) : valid_block(pad bs). +proof. lemma valid_block (xs : block list) : unpad xs <> None <=> valid_block xs. From dd9478fe8a3b8ff67ca8cf3a91ed7dfce445af80 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Wed, 25 Nov 2015 21:46:40 +0100 Subject: [PATCH 051/394] Alternative padding def. Quoting a french dictator: Un bon croquis vaut mieux qu'un long discours. --- sha3/proof/Common.ec | 147 +++++++++++++++++++++++++++++++++++++++- sha3/proof/ListExtra.ec | 34 ++++++++++ 2 files changed, 178 insertions(+), 3 deletions(-) create mode 100644 sha3/proof/ListExtra.ec diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index d371986..7547744 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -1,6 +1,8 @@ (* -------------------------------------------------------------------- *) -require import Option Fun Pair Int IntExtra Real List NewDistr. +require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. +require import Ring StdRing StdOrder StdBigop ListExtra. require (*--*) FinType LazyRP Monoid. +(*---*) import IntID IntOrder Bigint Bigint.BIA. (* -------------------------------------------------------------------- *) theory BitWord. @@ -38,12 +40,19 @@ op uniform : bword distr = end BitWord. (* -------------------------------------------------------------------- *) -op r : { int | 0 < r } as gt0_r. -op c : { int | 0 < c } as gt0_c. +op r : { int | 2 <= r } as ge2_r. +op c : { int | 0 < c } as gt0_c. type block. (* ~ bitstrings of size r *) type capacity. (* ~ bitstrings of size 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. + (* -------------------------------------------------------------------- *) clone BitWord as Capacity with type bword <- capacity, @@ -74,6 +83,136 @@ rename (* ------------------------- Padding/Unpadding ------------------------ *) +(* What about this (and the comment applies to other functions): *) + +theory Alternative. +op chunk (bs : bool list) = + mkseq (fun i => take r (drop (r * i) bs)) (size bs %/ r). + +op mkpad (n : int) = + true :: rcons (nseq ((-(n+2)) %% r) 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 Some (take (size s - (i+2)) s). + +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 !(lastcons, lastrcons). 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 lastcat last_mkpad. qed. + +lemma size_mkpad n : size (mkpad n) = (-(n+2)) %% r + 2. +proof. +rewrite /mkpad /= size_rcons size_nseq max_ler. +by rewrite modz_ge0 gtr_eqF ?gt0_r. by ring. +qed. + +lemma size_pad s: size (pad s) = (size s + 1) %/ r * r + r. +proof. +rewrite /pad /mkpad size_cat /= size_rcons size_nseq. +rewrite max_ler 1:modz_ge0 1:gtr_eqF ?gt0_r // (addrCA 1). +rewrite modNz ?gt0_r ?ltr_spaddr ?size_ge0 //. +by rewrite (@subrE (size s + 2)) -(addrA _ 2) /= modzE; ring. +qed. + +lemma size_pad_dvd_r s: r %| size (pad s). +proof. by rewrite size_pad dvdzD 1:dvdz_mull dvdzz. qed. + +lemma index_true_behead_mkpad n : + index true (behead (mkpad n)) = (-(n + 2)) %% r. +proof. +rewrite /mkpad -cats1 index_cat mem_nseq size_nseq. +by rewrite max_ler // modz_ge0 gtr_eqF ?gt0_r. +qed. + +lemma size_chunk bs : size (chunk bs) = size bs %/ r. +proof. by rewrite size_mkseq max_ler // divz_ge0 ?gt0_r ?size_ge0. qed. + +lemma in_chunk_size bs b: mem (chunk bs) b => size b = r. +proof. +move/mapP=> [i] [] /mem_iota /= [ge0_i ^lt_is +] ->. +rewrite ltzE -(@ler_pmul2r r) 1:gt0_r divzE mulrDl mul1r. +rewrite -ler_subr_addr 2!subrE addrAC -2!subrE. +move/ler_trans/(_ (size bs - r) _); 1: rewrite subrE. + by rewrite ler_naddr // oppr_le0 modz_ge0 gtr_eqF ?gt0_r. +rewrite (mulrC i) ler_subr_addl -ler_subr_addr => ler. +rewrite size_take ?ge0_r size_drop // 1:mulr_ge0 ?ge0_r //. +rewrite max_ler 1:subr_ge0 1:-subr_ge0 1:(ler_trans r) ?ge0_r //. +by move/ler_eqVlt: ler=> [<-|->]. +qed. + +lemma size_flatten_chunk bs : + size (flatten (chunk bs)) = (size bs) %/ r * r. +proof. +rewrite size_flatten sumzE big_map predT_comp /(\o) /= big_seq. +rewrite (@eq_bigr _ _ (fun x => r)) /=; 1: exact/in_chunk_size. +by rewrite -big_seq big_constz count_predT size_chunk mulrC. +qed. + +lemma chunkK bs : r %| size bs => flatten (chunk bs) = bs. +proof. +move=> dvd_d_bs; apply/(eq_from_nth false)=> [|i]. + by rewrite size_flatten_chunk divzK. +rewrite size_flatten_chunk divzK // => [ge0_i lt_ibs]. +rewrite (@nth_flatten false r); 1: by apply/allP=> s /in_chunk_size. +rewrite nth_mkseq /= 1:divz_ge0 ?ge0_i ?ltz_divRL ?gt0_r //. + by apply/(@ler_lt_trans i)=> //; rewrite lez_floor gtr_eqF ?gt0_r. +rewrite nth_take ?ltz_pmod 1:ltrW ?gt0_r nth_drop; last 2 first. + by rewrite modz_ge0 ?gtr_eqF ?gt0_r. by rewrite (@mulrC r) -divz_eq. +by rewrite mulr_ge0 ?ge0_r divz_ge0 // gt0_r. +qed. + +lemma padK : pcancel pad unpad. +proof. +move=> s @/unpad; rewrite last_pad /= rev_cat rev_mkpad. +pose i := index _ _; have ^iE {1}->: 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 (subrE (size s + 2)) -(addrA _ 2) size_pad. + rewrite (addrC _ r) 2!subrE -!addrA => /addrI; rewrite addrCA /=. + rewrite -subr_eq0 -opprB subrE opprK -divz_eq oppr_eq0. + by rewrite addz_neq0 ?size_ge0. +move=> _ /=; rewrite iE -size_mkpad /pad size_cat addrK_sub. +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 lastrcons => hb. +rewrite rev_rcons /= size_rcons -(inj_eq _ (addIr (-1))) /= ?addrK. +pose i := index _ _; case: (i = size s) => //=. +move=> ne_is @/pad; pose j := _ - (i+2); apply/eq_sym. +rewrite -{1}(cat_take_drop j (rcons s b)) eqseq_cat //=. +rewrite size_take; first rewrite /j subr_ge0. + (have ->: 2=1+1 by done); rewrite addrA -ltzE ltr_add2r. + by rewrite ltr_neqAle ne_is /= /i -size_rev index_size. +rewrite {2}/j size_rcons ltr_subl_addr ?ltr_spaddr //=. + by rewrite /i index_ge0. +rewrite -cats1 drop_cat {1}/j ltr_subl_addr ler_lt_add //=. + by rewrite ltzE /= ler_addr // /i index_ge0. +rewrite /mkpad -cats1 -cat_cons hb; congr. +admit. (* missing results on drop/take *) +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. +end Alternative. + +(* -------------------------------------------------------------------- *) (* if size cs < r, then size (chunk_aux (xs, cs) b).`2 < r *) op chunk_aux : block list * bool list -> bool -> block list * bool list = fun p b => @@ -230,6 +369,8 @@ pred valid_block (xs : block list) = 0 <= n < r /\ flatten(map w2bits xs) = ys ++ [true] ++ nseq n false ++ [true]. + + op pad : bool list -> block list = fun bs => let (xs, cs) = chunk bs in diff --git a/sha3/proof/ListExtra.ec b/sha3/proof/ListExtra.ec new file mode 100644 index 0000000..e8608cc --- /dev/null +++ b/sha3/proof/ListExtra.ec @@ -0,0 +1,34 @@ +(* -------------------------------------------------------------------- *) +require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. +require import Ring StdRing StdOrder. +(*---*) import IntID IntOrder. + +(* -------------------------------------------------------------------- *) +lemma nth_flatten x0 n (bs : 'a list list) i : + all (fun s => size s = n) bs + => nth x0 (flatten bs) i = nth x0 (nth [] bs (i %/ n)) (i %% n). +proof. +case: (n <= 0) => [ge0_n|/ltrNge gt0_n] /allP /= eqz. + have bsE: bs = nseq (size bs) []. + elim: bs eqz => /= [|b bs ih eqz]; 1: by rewrite nseq0. + rewrite addrC nseqS ?size_ge0 -ih /=. + by move=> x bsx; apply/eqz; rewrite bsx. + by rewrite -size_eq0 -leqn0 ?size_ge0 eqz. + rewrite {2}bsE nth_nseq_if if_same /=. + rewrite bsE; elim/natind: (size bs)=> [m le0_m|m ge0_m ih]; + by rewrite ?nseqS // nseq0_le // flatten_nil. +case: (i < 0)=> [lt0_i|/lerNgt ge0_i]. + rewrite nth_neg // (@nth_neg []) // ltrNge. + by rewrite divz_ge0 // -ltrNge. +elim: bs i ge0_i eqz => [|b bs ih] i ge0_i eqz /=. + by rewrite flatten_nil. +have /(_ b) /= := eqz; rewrite flatten_cons nth_cat => ->. +have <-: (i < n) <=> (i %/ n = 0) by rewrite -divz_eq0 // ge0_i. +case: (i < n) => [lt_in|/lerNgt le_ni]; 2: rewrite ih ?subr_ge0 //. ++ by rewrite modz_small // ge0_i ltr_normr ?lt_in. ++ by move=> x bx; have := eqz x; apply; rewrite /= bx. +rewrite subrE -mulN1r modzMDr subrE; congr. +case: (n = 0)=> [^zn ->/=|nz_n]; 2: by rewrite divzMDr 1?addrC. +rewrite divz0 /= eq_sym nth_neg ?oppr_lt0 // => {ih}; move: eqz. +by case: bs => // c bs /(_ c) /=; rewrite zn size_eq0 => ->. +qed. From 378522b2af49511576ce07b38a9cbfbce4b14042 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Mon, 30 Nov 2015 09:24:49 +0100 Subject: [PATCH 052/394] Use stdlib. bit chunking ops. --- sha3/proof/Common.ec | 39 +++++---------------------------------- sha3/proof/ListExtra.ec | 34 ---------------------------------- 2 files changed, 5 insertions(+), 68 deletions(-) delete mode 100644 sha3/proof/ListExtra.ec diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 7547744..acc5412 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -1,6 +1,6 @@ (* -------------------------------------------------------------------- *) require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. -require import Ring StdRing StdOrder StdBigop ListExtra. +require import Ring StdRing StdOrder StdBigop BitEncoding. require (*--*) FinType LazyRP Monoid. (*---*) import IntID IntOrder Bigint Bigint.BIA. @@ -86,8 +86,7 @@ rename (* What about this (and the comment applies to other functions): *) theory Alternative. -op chunk (bs : bool list) = - mkseq (fun i => take r (drop (r * i) bs)) (size bs %/ r). +op chunk (bs : bool list) = BitChunking.chunk r bs. op mkpad (n : int) = true :: rcons (nseq ((-(n+2)) %% r) false) true. @@ -137,41 +136,13 @@ by rewrite max_ler // modz_ge0 gtr_eqF ?gt0_r. qed. lemma size_chunk bs : size (chunk bs) = size bs %/ r. -proof. by rewrite size_mkseq max_ler // divz_ge0 ?gt0_r ?size_ge0. qed. +proof. by apply/BitChunking.size_chunk/gt0_r. qed. lemma in_chunk_size bs b: mem (chunk bs) b => size b = r. -proof. -move/mapP=> [i] [] /mem_iota /= [ge0_i ^lt_is +] ->. -rewrite ltzE -(@ler_pmul2r r) 1:gt0_r divzE mulrDl mul1r. -rewrite -ler_subr_addr 2!subrE addrAC -2!subrE. -move/ler_trans/(_ (size bs - r) _); 1: rewrite subrE. - by rewrite ler_naddr // oppr_le0 modz_ge0 gtr_eqF ?gt0_r. -rewrite (mulrC i) ler_subr_addl -ler_subr_addr => ler. -rewrite size_take ?ge0_r size_drop // 1:mulr_ge0 ?ge0_r //. -rewrite max_ler 1:subr_ge0 1:-subr_ge0 1:(ler_trans r) ?ge0_r //. -by move/ler_eqVlt: ler=> [<-|->]. -qed. - -lemma size_flatten_chunk bs : - size (flatten (chunk bs)) = (size bs) %/ r * r. -proof. -rewrite size_flatten sumzE big_map predT_comp /(\o) /= big_seq. -rewrite (@eq_bigr _ _ (fun x => r)) /=; 1: exact/in_chunk_size. -by rewrite -big_seq big_constz count_predT size_chunk mulrC. -qed. +proof. by apply/BitChunking.in_chunk_size/gt0_r. qed. lemma chunkK bs : r %| size bs => flatten (chunk bs) = bs. -proof. -move=> dvd_d_bs; apply/(eq_from_nth false)=> [|i]. - by rewrite size_flatten_chunk divzK. -rewrite size_flatten_chunk divzK // => [ge0_i lt_ibs]. -rewrite (@nth_flatten false r); 1: by apply/allP=> s /in_chunk_size. -rewrite nth_mkseq /= 1:divz_ge0 ?ge0_i ?ltz_divRL ?gt0_r //. - by apply/(@ler_lt_trans i)=> //; rewrite lez_floor gtr_eqF ?gt0_r. -rewrite nth_take ?ltz_pmod 1:ltrW ?gt0_r nth_drop; last 2 first. - by rewrite modz_ge0 ?gtr_eqF ?gt0_r. by rewrite (@mulrC r) -divz_eq. -by rewrite mulr_ge0 ?ge0_r divz_ge0 // gt0_r. -qed. +proof. by apply/BitChunking.chunkK/gt0_r. qed. lemma padK : pcancel pad unpad. proof. diff --git a/sha3/proof/ListExtra.ec b/sha3/proof/ListExtra.ec deleted file mode 100644 index e8608cc..0000000 --- a/sha3/proof/ListExtra.ec +++ /dev/null @@ -1,34 +0,0 @@ -(* -------------------------------------------------------------------- *) -require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. -require import Ring StdRing StdOrder. -(*---*) import IntID IntOrder. - -(* -------------------------------------------------------------------- *) -lemma nth_flatten x0 n (bs : 'a list list) i : - all (fun s => size s = n) bs - => nth x0 (flatten bs) i = nth x0 (nth [] bs (i %/ n)) (i %% n). -proof. -case: (n <= 0) => [ge0_n|/ltrNge gt0_n] /allP /= eqz. - have bsE: bs = nseq (size bs) []. - elim: bs eqz => /= [|b bs ih eqz]; 1: by rewrite nseq0. - rewrite addrC nseqS ?size_ge0 -ih /=. - by move=> x bsx; apply/eqz; rewrite bsx. - by rewrite -size_eq0 -leqn0 ?size_ge0 eqz. - rewrite {2}bsE nth_nseq_if if_same /=. - rewrite bsE; elim/natind: (size bs)=> [m le0_m|m ge0_m ih]; - by rewrite ?nseqS // nseq0_le // flatten_nil. -case: (i < 0)=> [lt0_i|/lerNgt ge0_i]. - rewrite nth_neg // (@nth_neg []) // ltrNge. - by rewrite divz_ge0 // -ltrNge. -elim: bs i ge0_i eqz => [|b bs ih] i ge0_i eqz /=. - by rewrite flatten_nil. -have /(_ b) /= := eqz; rewrite flatten_cons nth_cat => ->. -have <-: (i < n) <=> (i %/ n = 0) by rewrite -divz_eq0 // ge0_i. -case: (i < n) => [lt_in|/lerNgt le_ni]; 2: rewrite ih ?subr_ge0 //. -+ by rewrite modz_small // ge0_i ltr_normr ?lt_in. -+ by move=> x bx; have := eqz x; apply; rewrite /= bx. -rewrite subrE -mulN1r modzMDr subrE; congr. -case: (n = 0)=> [^zn ->/=|nz_n]; 2: by rewrite divzMDr 1?addrC. -rewrite divz0 /= eq_sym nth_neg ?oppr_lt0 // => {ih}; move: eqz. -by case: bs => // c bs /(_ c) /=; rewrite zn size_eq0 => ->. -qed. From cd5f91246f8585ad7d4881cf7c786df712fd65bf Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Mon, 30 Nov 2015 09:43:54 +0100 Subject: [PATCH 053/394] Use stdlib bitwords theory. --- sha3/proof/Common.ec | 62 +++++++++----------------------------------- 1 file changed, 12 insertions(+), 50 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index acc5412..02e88e0 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -1,44 +1,9 @@ (* -------------------------------------------------------------------- *) require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. require import Ring StdRing StdOrder StdBigop BitEncoding. -require (*--*) FinType LazyRP Monoid. +require (*--*) FinType BitWord LazyRP Monoid. (*---*) import IntID IntOrder Bigint Bigint.BIA. -(* -------------------------------------------------------------------- *) -theory BitWord. -type bword. - -op zero : bword. -op (^) : bword -> bword -> bword. - -clone include Monoid - with - type t <- bword, - op idm <- zero, - op (+) <- (^) - proof Axioms.* by admit. - -clone FinType with type t <- bword - proof * by admit. - -op w2bits : bword -> bool list. -op bits2w : bool list -> bword. -op size : { int | 0 < size } as gt0_size. - -lemma w2bitsK : cancel w2bits bits2w. -proof. admit. qed. - -lemma bits2wK (s : bool list) : - size s = size => w2bits (bits2w s) = s. -proof. admit. qed. - -lemma w2bits_size (x : bword) : size(w2bits x) = size. -proof. admit. qed. - -op uniform : bword distr = - MUniform.duniform FinType.enum. -end BitWord. - (* -------------------------------------------------------------------- *) op r : { int | 2 <= r } as ge2_r. op c : { int | 0 < c } as gt0_c. @@ -55,28 +20,25 @@ proof. by apply/ltrW/gt0_r. qed. (* -------------------------------------------------------------------- *) clone BitWord as Capacity with - type bword <- capacity, - op size <- c - proof * by apply/gt0_c + type word <- capacity, + op n <- c + proof gt0_n by apply/gt0_c - rename - [op] "zero" as "c0" - [op] "uniform" as "cdistr". + rename "dword" as "cdistr". clone export BitWord as Block with - type bword <- block, - op size <- r - proof * by apply/gt0_r + type word <- block, + op n <- r + proof gt0_n by apply/gt0_r - rename - [op] "zero" as "b0" - [op] "uniform" as "bdistr". + rename "dword" as "bdistr". -op ( * ): 'a NewDistr.distr -> 'b NewDistr.distr -> ('a * 'b) Pervasive.distr. +(* -------------------------------------------------------------------- *) +op ( * ): 'a distr -> 'b distr -> ('a * 'b) distr. clone export LazyRP as Perm with type D <- block * capacity, - op d <- bdistr * Capacity.cdistr + op d <- bdistr * Capacity.cdistr rename [module type] "RP" as "PRIMITIVE" [module] "P" as "Perm". From 75a4c4711082d0bcdfd7a1ce90816677eb1aa0a0 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 30 Nov 2015 14:50:17 +0100 Subject: [PATCH 054/394] Use new libraries on all files. Perform some renaming... --- sha3/proof/Absorb.ec | 12 +- sha3/proof/AbsorbToBlocks.ec | 3 +- sha3/proof/Blocks.ec | 11 +- sha3/proof/Common.ec | 2 + ...entiability.ec => Indifferentiability.eca} | 15 +- sha3/proof/TopLevel.ec | 11 +- sha3/proof/old/IndifPadding.ec | 64 +++-- sha3/proof/old/LazyRO.eca | 16 +- sha3/proof/old/NBRO.eca | 102 +++---- sha3/proof/old/Sponge.ec | 258 ------------------ sha3/proof/old/Squeezeless.ec | 236 +++++----------- sha3/proof/old/Utils.ec | 18 +- 12 files changed, 200 insertions(+), 548 deletions(-) rename sha3/proof/{Indifferentiability.ec => Indifferentiability.eca} (80%) delete mode 100644 sha3/proof/old/Sponge.ec diff --git a/sha3/proof/Absorb.ec b/sha3/proof/Absorb.ec index 633c864..e8984d7 100644 --- a/sha3/proof/Absorb.ec +++ b/sha3/proof/Absorb.ec @@ -19,14 +19,16 @@ clone import RndOrcl as RO with clone import Ideal. (* ?? Nested abstract theories... we don't like them *) (* -------------------------------------------------------------------- *) -clone include Indifferentiability.Core with - type Types.p <- block * capacity, - type Types.f_in <- block list, - type Types.f_out <- block +clone include Indifferentiability with + type p <- block * capacity, + type f_in <- block list, + type f_out <- block rename [module] "Indif" as "Experiment" - [module] "al" as "alIndif". + [module] "GReal" as "RealIndif" + [module] "GIdeal" as "IdealIndif". + (* -------------------------------------------------------------------- *) module BlockSponge (P : PRIMITIVE) : RO, CONSTRUCTION(P) = { diff --git a/sha3/proof/AbsorbToBlocks.ec b/sha3/proof/AbsorbToBlocks.ec index c349cf3..a5c48bf 100644 --- a/sha3/proof/AbsorbToBlocks.ec +++ b/sha3/proof/AbsorbToBlocks.ec @@ -232,8 +232,7 @@ section. by proc; sp; if=> //=; call ModularAbsorb; auto. (* Re-Bug *) by conseq ModularAbsorb=> &1 &2; case (arg{1}); case (arg{2}). - inline *; wp; call (_: true)=> //=. - by sim. + inline *; wp;call (_: true)=> //=. auto; progress [-split]; split=> //=. smt. done. diff --git a/sha3/proof/Blocks.ec b/sha3/proof/Blocks.ec index ff3c8cd..eb1513f 100644 --- a/sha3/proof/Blocks.ec +++ b/sha3/proof/Blocks.ec @@ -16,14 +16,15 @@ clone import IRO as BIRO with op valid <- valid. (* -------------------------------------------------------------------- *) -clone include Indifferentiability.Core with - type Types.p <- block * capacity, - type Types.f_in <- block list * int, - type Types.f_out <- block list +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] "al" as "alIndif". + [module] "GReal" as "RealIndif" + [module] "GIdeal" as "IdealIndif". (* -------------------------------------------------------------------- *) module BlockSponge (P : PRIMITIVE) : BIRO.IRO, CONSTRUCTION(P) = { diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 02e88e0..2c0493d 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -338,6 +338,8 @@ op unpad : block list -> bool list option = lemma pad_valid (bs : bool list) : valid_block(pad bs). proof. +admit. +qed. lemma valid_block (xs : block list) : unpad xs <> None <=> valid_block xs. diff --git a/sha3/proof/Indifferentiability.ec b/sha3/proof/Indifferentiability.eca similarity index 80% rename from sha3/proof/Indifferentiability.ec rename to sha3/proof/Indifferentiability.eca index 9a11bd5..623ca31 100644 --- a/sha3/proof/Indifferentiability.ec +++ b/sha3/proof/Indifferentiability.eca @@ -1,15 +1,8 @@ -(* -------------------------------------------------------------------- *) -abstract theory Types. (** A primitive: the building block we assume ideal **) type p. (** A functionality: the target construction **) type f_in, f_out. -end Types. - -(* -------------------------------------------------------------------- *) -abstract theory Core. -clone import Types. module type PRIMITIVE = { proc init(): unit @@ -34,7 +27,7 @@ module type CONSTRUCTION (P : PRIMITIVE) = { }. module type SIMULATOR (F : FUNCTIONALITY) = { - proc init() : unit { F.init } + proc init() : unit { (* F.init *) } proc f(x : p) : p { F.f } proc fi(x : p) : p { F.f } }. @@ -54,8 +47,9 @@ module Indif (F : FUNCTIONALITY, P : PRIMITIVE, D : DISTINGUISHER) = { } }. -module Real(C : CONSTRUCTION, P : PRIMITIVE) = Indif(C(P),P). -module Ideal(F : FUNCTIONALITY, S : SIMULATOR) = Indif(F,S(F)). +(* 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 @@ -63,4 +57,3 @@ module Ideal(F : FUNCTIONALITY, S : SIMULATOR) = Indif(F,S(F)). | 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. *) -end Core. \ No newline at end of file diff --git a/sha3/proof/TopLevel.ec b/sha3/proof/TopLevel.ec index fdf783d..ed1f87e 100644 --- a/sha3/proof/TopLevel.ec +++ b/sha3/proof/TopLevel.ec @@ -12,14 +12,15 @@ clone import IRO as BIRO with op valid (x : bool list) <- true. (* -------------------------------------------------------------------- *) -clone include Indifferentiability.Core with - type Types.p <- block * capacity, - type Types.f_in <- bool list * int, - type Types.f_out <- bool list +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] "al" as "alIndif". + [module] "GReal" as "RealIndif" + [module] "GIdeal" as "IdealIndif". (* -------------------------------------------------------------------- *) diff --git a/sha3/proof/old/IndifPadding.ec b/sha3/proof/old/IndifPadding.ec index 3a47891..cf80091 100644 --- a/sha3/proof/old/IndifPadding.ec +++ b/sha3/proof/old/IndifPadding.ec @@ -4,8 +4,7 @@ require (*..*) Indifferentiability LazyRO. clone import Indifferentiability as Ind1. clone import Indifferentiability as Ind2 - with type p_in <- Ind1.p_in, - type p_out <- Ind1.p_out, + with type p <- Ind1.p, type f_out <- Ind1.f_out. op pad : Ind2.f_in -> Ind1.f_in. @@ -22,25 +21,25 @@ clone import LazyRO as RO2 type to <- Ind1.f_out, op d <- RO1.d. -module ConstrPad (FC:Ind1.Construction, P:Ind1.Primitive) = { +module ConstrPad (FC:Ind1.CONSTRUCTION, P:Ind1.PRIMITIVE) = { module C = FC(P) proc init = C.init - proc oracle (x:Ind2.f_in) : f_out = { + proc f (x:Ind2.f_in) : f_out = { var r; - r = C.oracle(pad x); + r = C.f(pad x); return r; } }. -module DistPad(FD: Ind2.Distinguisher, F:Ind1.Functionality, P:Ind1.Primitive) = { +module DistPad(FD: Ind2.DISTINGUISHER, F:Ind1.FUNCTIONALITY, P:Ind1.PRIMITIVE) = { module Fpad = { proc init = F.init - proc oracle(x:Ind2.f_in) : f_out = { + proc f(x:Ind2.f_in) : f_out = { var r; - r = F.oracle(pad x); + r = F.f(pad x); return r; } } @@ -48,12 +47,12 @@ module DistPad(FD: Ind2.Distinguisher, F:Ind1.Functionality, P:Ind1.Primitive) = proc distinguish = FD(Fpad,P).distinguish }. -module SimPadinv(S:Ind1.Simulator, F2:Ind2.Functionality) = { +module SimPadinv(S:Ind1.SIMULATOR, F2:Ind2.FUNCTIONALITY) = { module F1 = { proc init = F2.init - proc oracle(x:Ind1.f_in):Ind1.f_out = { + proc f(x:Ind1.f_in):Ind1.f_out = { var r; - r = F2.oracle(padinv x); + r = F2.f(padinv x); return r; } } @@ -62,35 +61,42 @@ module SimPadinv(S:Ind1.Simulator, F2:Ind2.Functionality) = { proc init = S2.init - proc oracle = S2.oracle + proc f = S2.f + proc fi = S2.fi }. section Reduction. - declare module P : Ind1.Primitive. (* It is compatible with Ind2.Primitive *) - declare module C : Ind1.Construction {P}. - declare module S : Ind1.Simulator{ RO1.H, RO2.H}. + declare module P : Ind1.PRIMITIVE. (* It is compatible with Ind2.Primitive *) + declare module C : Ind1.CONSTRUCTION {P}. + declare module S : Ind1.SIMULATOR{ RO1.H, RO2.H}. - declare module D' : Ind2.Distinguisher{P,C, RO1.H, RO2.H, S}. + declare module D' : Ind2.DISTINGUISHER{P,C, RO1.H, RO2.H, S}. local equiv ConstrDistPad: - Ind2.Real(P, ConstrPad(C), D').main ~ - Ind1.Real(P, C, DistPad(D')).main : ={glob P, glob C, glob D'} ==> + Ind2.GReal(ConstrPad(C), P, D').main ~ + Ind1.GReal(C, P, DistPad(D')).main : ={glob P, glob C, glob D'} ==> ={glob P, glob C, glob D', res}. proof. by sim. qed. local lemma PrConstrDistPad &m: - Pr[ Ind2.Real(P,ConstrPad(C), D').main() @ &m : res] = - Pr[ Ind1.Real(P,C,DistPad(D')).main() @ &m : res]. + Pr[ Ind2.GReal(ConstrPad(C), P, D').main() @ &m : res] = + Pr[ Ind1.GReal(C, P, DistPad(D')).main() @ &m : res]. proof. by byequiv ConstrDistPad. qed. local equiv DistH2H1: - Ind2.Ideal(RO2.H, SimPadinv(S), D').main ~ - Ind1.Ideal(RO1.H, S, DistPad(D')).main : + Ind2.GIdeal(RO2.H, SimPadinv(S), D').main ~ + Ind1.GIdeal(RO1.H, S, DistPad(D')).main : ={glob D', glob S} ==> ={glob D',glob S, res} /\ forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]. proof. proc. call (_: ={glob S} /\ forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]). + + proc *;inline *. + call (_: forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]);auto. + proc;inline *;wp;sp;if;first by progress [-split];rewrite !in_dom H. + + auto;progress;first by rewrite !getP_eq. + by rewrite !getP (can_eq _ _ cancel_padinv) H. + by auto;progress;rewrite H. + proc *;inline *. call (_: forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]);auto. proc;inline *;wp;sp;if;first by progress [-split];rewrite !in_dom H. @@ -101,20 +107,20 @@ section Reduction. + auto;progress;first by rewrite !getP_eq. by rewrite !getP (eq_sym x1) (can2_eq _ _ cancel_pad cancel_padinv) (eq_sym x{2}) H. by auto;progress;rewrite -H cancel_pad. - inline *;wp. call (_: ={glob D'});first by sim. + inline *;wp. call (_: ={glob D'}). auto;progress;by rewrite !map0P. qed. local lemma PrDistH2H1 &m: - Pr[Ind2.Ideal(RO2.H,SimPadinv(S),D').main() @ &m : res] = - Pr[Ind1.Ideal(RO1.H,S, DistPad(D')).main() @ &m : res]. + Pr[Ind2.GIdeal(RO2.H,SimPadinv(S),D').main() @ &m : res] = + Pr[Ind1.GIdeal(RO1.H,S, DistPad(D')).main() @ &m : res]. proof. by byequiv DistH2H1. qed. lemma Conclusion &m: - `| Pr[Ind2.Real (P , ConstrPad(C), D').main() @ &m : res] - - Pr[Ind2.Ideal(RO2.H, SimPadinv(S), D').main() @ &m : res] | = - `| Pr[Ind1.Real(P , C, DistPad(D')).main() @ &m : res] - - Pr[Ind1.Ideal(RO1.H, S, DistPad(D')).main() @ &m : res] |. + `| Pr[Ind2.GReal (ConstrPad(C), P , D' ).main() @ &m : res] - + Pr[Ind2.GIdeal(RO2.H , SimPadinv(S), D' ).main() @ &m : res] | = + `| Pr[Ind1.GReal (C , P , DistPad(D')).main() @ &m : res] - + Pr[Ind1.GIdeal(RO1.H , S , DistPad(D')).main() @ &m : res] |. proof. by rewrite (PrConstrDistPad &m) (PrDistH2H1 &m). qed. end section Reduction. diff --git a/sha3/proof/old/LazyRO.eca b/sha3/proof/old/LazyRO.eca index d9784b4..96136e7 100644 --- a/sha3/proof/old/LazyRO.eca +++ b/sha3/proof/old/LazyRO.eca @@ -1,19 +1,21 @@ -require import Option NewFSet NewFMap. -require (*..*) RO. +require import Option FSet NewFMap. +require (*..*) NewROM. type from, to. op d: to distr. -clone include RO with - type from <- from, - type to <- to. +clone include NewROM with + type from <- from, + type to <- to, + op dsample <- fun (x:from) => d. -module H : RO, RO_ = { + +module H = { var m : (from, to) fmap proc init() = { m = map0; } - proc oracle(x) = { + proc f(x) = { if (!mem (dom m) x) m.[x] = $d; return oget m.[x]; } diff --git a/sha3/proof/old/NBRO.eca b/sha3/proof/old/NBRO.eca index 195905f..e744ecb 100644 --- a/sha3/proof/old/NBRO.eca +++ b/sha3/proof/old/NBRO.eca @@ -1,8 +1,7 @@ -require import Int Real NewList NewFMap. +require import Option Int Real List FSet NewFMap. require RndOrcl Indifferentiability. -type p_in. -type p_out. +type p. type from. @@ -30,63 +29,62 @@ axiom test_neg (x:from) (n:int): n < 0 => !test (x,n). axiom test_le (x:from) (n p:int) : 0 <= p <= n => test (x,n) => test (x,p). clone import Indifferentiability as IndB with - type p_in <- p_in, - type p_out <- p_out, + type p <- p, type f_in <- from * int, type f_out <- block. clone import Indifferentiability as IndNB with - type p_in <- p_in, - type p_out <- p_out, + type p <- p, type f_in <- from * int, type f_out <- block list. -module RONB (Ob:IndB.Functionality) = { +module RONB (Ob:IndB.FUNCTIONALITY) = { proc init = Ob.init - proc oracle(x:from, n:int) : block list = { + proc f(x:from, n:int) : block list = { var b, bs; bs <- []; while (size bs < n) { - b <@ Ob.oracle(x,size bs); + b <@ Ob.f(x,size bs); bs <- rcons bs b; } return bs; } }. -module DNB(D:IndNB.Distinguisher, F:IndB.Functionality, P:IndB.Primitive) = { +module DNB(D:IndNB.DISTINGUISHER, F:IndB.FUNCTIONALITY, P:IndB.PRIMITIVE) = { proc distinguish = D(RONB(F), P).distinguish }. -module CNB (C: IndB.Construction, P:IndB.Primitive) = RONB(C(P)). +module CNB (C: IndB.CONSTRUCTION, P:IndB.PRIMITIVE) = RONB(C(P)). -module FNB_B(F:IndNB.Functionality) = { +module FNB_B(F:IndNB.FUNCTIONALITY) = { proc init () = {} - proc oracle(x:from,n:int) : block = { + proc f(x:from,n:int) : block = { var bs; - bs <@ F.oracle(x,n+1); + bs <@ F.f(x,n+1); return nth dfl bs n; } }. -module SNB(S:IndB.Simulator, F:IndNB.Functionality) = { +module SNB(S:IndB.SIMULATOR, F:IndNB.FUNCTIONALITY) = { proc init = S(FNB_B(F)).init - proc oracle = S(FNB_B(F)).oracle + proc f = S(FNB_B(F)).f + proc fi = S(FNB_B(F)).fi }. section PROOF. - declare module P:IndB.Primitive. - declare module C:IndB.Construction {P}. - declare module S:IndB.Simulator {RO}. + declare module P:IndB.PRIMITIVE. + declare module C:IndB.CONSTRUCTION {P}. + declare module S:IndB.SIMULATOR {RO}. - declare module D: IndNB.Distinguisher {P, RO, S, C}. + declare module D: IndNB.DISTINGUISHER {P, RO, S, C}. - local equiv equivReal: IndNB.Real(P, CNB(C), D).main ~ IndB.Real(P, C, DNB(D)).main: + local equiv equivReal: IndNB.GReal(CNB(C), P, D).main ~ IndB.GReal(C, P, DNB(D)).main: ={glob P, glob C, glob D} ==> ={glob P, glob C, glob D,res}. proof. proc;inline *; sim. qed. @@ -100,52 +98,56 @@ section PROOF. } }. - local module DNB'(O:ROB.RO) = { + local module DNB'(O:ROB.RO) : ROB.Distinguisher(O)= { proc distinguish () : bool = { var b; - S(O).init(); + S(O).init(); b <@ DNB(D, O, S(O)).distinguish(); return b; } }. + local equiv feq : + FNB_B(RONB(ERO)).f ~ ERO.f : (x, n){1} = x{2} /\ ={RO.m} ==> ={res, RO.m}. + proof. + proc;inline *;wp. + while{1} ((0 <= n0 => size bs0 <= n0){1} /\ forall i, 0 <= i < size bs0{1} => + nth dfl bs0{1} i = + if test (x0{1},i) + then oget RO.m{1}.[(x0{1},i)] + else dfl) ((n0 - size bs0){1}). + + move=> &m2 z;auto;progress [-split]. + rewrite size_rcons;split;2:smt ml=0;split;1:smt ml=0. + move=> i [Hi0 Hi1];rewrite nth_rcons. + case (i < size bs0{hr})=> Hi';first by apply H0. + by cut -> : i = size bs0{hr} by smt ml=0. + auto;progress;1,2: smt ml=0. + case (n{1} < 0)=> Hn. + + by rewrite nth_neg // test_neg. + apply H1=> {H1} //;smt ml=0. + qed. + lemma conclusion &m: - `|Pr[IndNB.Real(P, CNB(C), D).main()@ &m:res] - Pr[IndNB.Ideal(RONB(Restr(RO)), SNB(S), D).main()@ &m:res] | = - `|Pr[IndB.Real(P, C, DNB(D)).main()@ &m:res] - Pr[IndB.Ideal(Restr(RO),S,DNB(D)).main()@ &m:res] |. + `|Pr[IndNB.GReal(CNB(C), P, D).main()@ &m:res] - Pr[IndNB.GIdeal(RONB(Restr(RO)), SNB(S), D).main()@ &m:res] | = + `|Pr[IndB.GReal(C, P, DNB(D)).main()@ &m:res] - Pr[IndB.GIdeal(Restr(RO),S,DNB(D)).main()@ &m:res] |. proof. - cut -> : Pr[IndNB.Real(P, CNB(C), D).main()@ &m:res] = Pr[IndB.Real(P, C, DNB(D)).main()@ &m:res]. + cut -> : Pr[IndNB.GReal(CNB(C), P, D).main()@ &m:res] = Pr[IndB.GReal(C, P, DNB(D)).main()@ &m:res]. + byequiv equivReal=> //. - cut -> : Pr[Ideal(RONB(Restr(RO)), SNB(S), D).main() @ &m : res] = + cut -> : Pr[GIdeal(RONB(Restr(RO)), SNB(S), D).main() @ &m : res] = Pr[ROB.IND(Restr(RO), DRO).main() @ &m : res]. - + byequiv=> //; proc;inline *;swap{1} 1 1;sim. + + by byequiv=> //; proc;inline *;swap{1} 1 1;sim. cut -> : Pr[ROB.IND(Restr(RO), DRO).main() @ &m : res] = Pr[ROB.IND(ERO,DRO).main () @ &m : res]. - + byequiv (Eager DRO)=> //. + + by byequiv (Eager DRO)=> //. do 2! congr. - cut -> : Pr[IndB.Ideal(Restr(RO), S, DNB(D)).main() @ &m : res] = + cut -> : Pr[IndB.GIdeal(Restr(RO), S, DNB(D)).main() @ &m : res] = Pr[ROB.IND(Restr(RO), DNB').main() @ &m : res]. - + byequiv=> //; proc;inline *;swap{1} 1 1;sim. + + by byequiv=> //; proc;inline *;swap{1} 1 1;sim. cut -> : Pr[ROB.IND(Restr(RO), DNB').main() @ &m : res] = Pr[ROB.IND(ERO, DNB').main() @ &m : res]. - + byequiv (Eager DNB')=> //. + + by byequiv (Eager DNB')=> //. byequiv=> //;proc;inline DRO(ERO).distinguish DNB'(ERO).distinguish;wp. - call (_: ={RO.m, glob S}). - + proc (={RO.m}) => //. - proc;inline *;wp. - while{1} ((0 <= n0 => size bs0 <= n0){1} /\ forall i, 0 <= i < size bs0{1} => - nth dfl bs0{1} i = - if test (x0{1},i) - then oget RO.m{1}.[(x0{1},i)] - else dfl) ((n0 - size bs0){1}). - + move=> &m2 z;auto;progress [-split]. - rewrite size_rcons;split;2:smt ml=0;split;1:smt ml=0. - move=> i [Hi0 Hi1];rewrite nth_rcons. - case (i < size bs0{hr})=> Hi';first by apply H0. - by cut -> : i = size bs0{hr} by smt ml=0. - auto;progress;1,2: smt ml=0. - case (n{1} < 0)=> Hn. - + by rewrite nth_neg // test_neg. - apply H1=> {H1} //;smt ml=0. + call (_: ={RO.m, glob S});1,2:by proc (={RO.m}) => //;apply feq. + sim. by conseq (_: _ ==> ={glob S, glob D, RO.m})=> //;sim. qed. diff --git a/sha3/proof/old/Sponge.ec b/sha3/proof/old/Sponge.ec deleted file mode 100644 index 9648347..0000000 --- a/sha3/proof/old/Sponge.ec +++ /dev/null @@ -1,258 +0,0 @@ -require import Option Pair Int Real List FSet NewFMap. -require (*..*) AWord LazyRP IRO Indifferentiability Squeezeless. -(* TODO: Clean up the Bitstring and Word theories - -- Make use of those new versions. *) -(*...*) import Dprod. -(* TODO: Datatype definitions and distributions should - be properly separated and reorganized. *) - -op r : { int | 0 < r } as lt0_r. -op c : { int | 0 < c } as lt0_c. - -(** Clarify assumptions on the distributions as we go. As this is currently - written, we are hiding some pretty heavy axioms behind cloning. **) -type block. -op dblock: block distr. - -clone import AWord as Block with - op length <- r, - type word <- block, - op Dword.dword <- dblock -proof leq0_length by smt. - -type capacity. -op dcapacity: capacity distr. - -clone AWord as Capacity with - op length <- c, - type word <- capacity, - op Dword.dword <- dcapacity -proof leq0_length by smt. - -type state = block * capacity. - -(** The following is just lining up type definitions and defines the - Indifferentiability experiment. Importantly, it defines neither - ideal primitive nor ideal functionality: only their type. **) -type p_query = [ - | F of state - | Fi of state -]. - -op is_F (q : p_query) = - with q = F s => true - with q = Fi s => false. - -op is_Fi (q : p_query) = - with q = F s => false - with q = Fi s => true. - -op get_query (q : p_query) = - with q = F s => s - with q = Fi s => s. - -clone include Indifferentiability with - type p_in <- p_query, - type p_out <- state, - type f_in <- block list * int, - type f_out <- bool list. - -(** Ideal Functionality **) -clone import IRO as Functionality with - type from <- block list. - -(** Ideal Primitive for the Random Transformation case **) -clone import LazyRP as Primitive with - type D <- state, - op d <- dblock * dcapacity. - -(*** TODO: deal with these. - - bitstrings should have conversions to and from bool list - - the generic RO should be defined somewhere else - - lining up names and types should be easier than it is... ***) -op to_bits: block -> bool list. - -module RP_to_P (O : RP) = { - proc init = O.init - proc oracle(q : p_query) = { - var r; - - if (is_F q) { - r <@ O.f(get_query q); - } else { - r <@ O.fi(get_query q); - } - return r; - } -}. - -module IRO_to_F (O : IRO): Functionality = { - proc init = O.init - - (* proc oracle = O.hash - does not work because of input types not lining up... - I though this had been taken care of. *) - proc oracle(x : block list * int): bool list = { - var bs; - bs = O.f(x.`1,x.`2); - return bs; - } -}. - -(** We can now define the sponge construction **) -module Sponge (P : Primitive): Construction(P), Functionality = { - proc init = P.init - - proc oracle(p : block list, n : int): bool list = { - var z <- []; - var s <- (Block.zeros,Capacity.zeros); - var i <- 0; - - if (size p >= 1 /\ nth witness p (size p - 1) <> Block.zeros) { - (* Absorption *) - while (p <> []) { - s <@ P.oracle(F (s.`1 ^ head witness p,s.`2)); - p <- behead p; - } - (* Squeezing *) - while (i < n/%r) { - z <- z ++ (Self.to_bits s.`1); (* Typing by constraint would be nice *) - s <@ P.oracle(F s); - } - } - - return take n z; - } -}. - -(** TODO: ftn is in fact a function of N - (number of queries to the primitive interface) **) -op ftn: real. - -module P = RP_to_P(Primitive.P). -module F = IRO_to_F(IRO). - -clone import Squeezeless as Core with - op r <- r, - type block <- block, - op dblock <- dblock, - op c <- c, - type capacity <- capacity, - op dcapacity <- dcapacity, - (** The following should be dealt with by sub-theory instantiation, - but the sub-theories we instantiate are partially concrete **) - op Block.zeros <- Self.Block.zeros, - op Block.ones <- Self.Block.ones, - op Block.(^) <- Self.Block.(^), - op Block.land <- Self.Block.land, - op Block.to_bits <- Self.Block.to_bits, - op Block.from_bits <- Self.Block.from_bits, - op Block.to_int <- Self.Block.to_int, - op Block.from_int <- Self.Block.from_int, - op Capacity.zeros <- Self.Capacity.zeros, - op Capacity.ones <- Self.Capacity.ones, - op Capacity.(^) <- Self.Capacity.(^), - op Capacity.land <- Self.Capacity.land, - op Capacity.to_bits <- Self.Capacity.to_bits, - op Capacity.from_bits <- Self.Capacity.from_bits, - op Capacity.to_int <- Self.Capacity.to_int, - op Capacity.from_int <- Self.Capacity.from_int -proof *. - realize lt0_r by exact/lt0_r. - realize lt0_c by exact/lt0_c. - realize Block.ones_neq0 by exact/Self.Block.ones_neq0. - realize Block.xorwA by exact/Self.Block.xorwA. - realize Block.xorwC by exact/Self.Block.xorwC. - realize Block.xor0w by exact/Self.Block.xor0w. - realize Block.xorwK by exact/Self.Block.xorwK. - realize Block.landwA by exact/Self.Block.landwA. - realize Block.landwC by exact/Self.Block.landwC. - realize Block.land1w by exact/Self.Block.land1w. - realize Block.landwDl by exact/Self.Block.landwDl. - realize Block.landI by exact/Self.Block.landI. - realize Block.length_to_bits by exact/Self.Block.length_to_bits. - realize Block.can_from_to by exact/Self.Block.can_from_to. - realize Block.pcan_to_from by exact/Self.Block.pcan_to_from. - realize Block.to_from by exact/Self.Block.to_from. - realize Block.from_to by exact/Self.Block.from_to. - realize Block.Dword.mu_x_def by exact/Self.Block.Dword.mu_x_def. - realize Block.Dword.lossless by exact/Self.Block.Dword.lossless. - realize Capacity.ones_neq0 by exact/Self.Capacity.ones_neq0. - realize Capacity.xorwA by exact/Self.Capacity.xorwA. - realize Capacity.xorwC by exact/Self.Capacity.xorwC. - realize Capacity.xor0w by exact/Self.Capacity.xor0w. - realize Capacity.xorwK by exact/Self.Capacity.xorwK. - realize Capacity.landwA by exact/Self.Capacity.landwA. - realize Capacity.landwC by exact/Self.Capacity.landwC. - realize Capacity.land1w by exact/Self.Capacity.land1w. - realize Capacity.landwDl by exact/Self.Capacity.landwDl. - realize Capacity.landI by exact/Self.Capacity.landI. - realize Capacity.length_to_bits by exact/Self.Capacity.length_to_bits. - realize Capacity.can_from_to by exact/Self.Capacity.can_from_to. - realize Capacity.pcan_to_from by exact/Self.Capacity.pcan_to_from. - realize Capacity.to_from by exact/Self.Capacity.to_from. - realize Capacity.from_to by exact/Self.Capacity.from_to. - realize Capacity.Dword.mu_x_def by exact/Self.Capacity.Dword.mu_x_def. - realize Capacity.Dword.lossless by exact/Self.Capacity.Dword.lossless. -(* end of clone *) - -module type BlockSponge = { - proc init(): unit - proc oracle(p : block list, n : int): block list -}. - -module Squeezer(F : Core.Functionality): BlockSponge = { - proc init = F.init - - proc oracle(p : block list, n : int): block list = { - var z <- []; - var b; - var i <- 0; - - if (size p >= 1 /\ nth witness p (size p - 1) <> Self.Block.zeros) { - while (i < n) { - b <@ F.oracle(p ++ mkseq (fun i => Self.Block.zeros) i); - z <- rcons z b; - i <- i + 1; - } - } - - return z; - } -}. - -(* Result: if there exists a good simulator for the Core functionality - F, then we can construct a simulator for Squeezer(F) that has the - same differentiability advantage. - Note: We need to be careful and may need to make this whitebox so - we can avoid having to make too many queries. *) - -module Truncator(F : BlockSponge): Self.Functionality = { - proc init = F.init - - proc oracle(p : block list, n : int): bool list = { - var z <- []; - var bs; - - if (size p >= 1 /\ nth witness p ( size p - 1) <> Self.Block.zeros) { - bs <@ F.oracle(p,n /% r); - z <- flatten (map to_bits bs); - } - - return take n z; - } -}. - -(* Result: if there exists a good simulator for the BlockSponge F, - then we can construct a simulator for Truncator(F) that has the - same differentiability advantage. - Note: We need to be careful and may need to make this whitebox so - we can avoid having to make too many queries. *) - -(* That Self is unfortunate *) -lemma PermutationLemma: exists (S <: Simulator), - forall (D <: Self.Distinguisher) &m, - `|Pr[Indif(Sponge(P),P,D).main() @ &m: res] - - Pr[Indif(F,S(F),D).main() @ &m: res]| - < ftn. -proof. admit. qed. \ No newline at end of file diff --git a/sha3/proof/old/Squeezeless.ec b/sha3/proof/old/Squeezeless.ec index aa9cb5e..ec7e0d1 100644 --- a/sha3/proof/old/Squeezeless.ec +++ b/sha3/proof/old/Squeezeless.ec @@ -2,7 +2,7 @@ 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 Fun Option Pair Int Real NewList NewFSet NewFMap Utils. +require import Fun Option Pair Int Real List FSet NewFMap Utils. require (*..*) AWord LazyRP LazyRO Indifferentiability. (* TODO: Clean up the Bitstring and Word theories -- Make use of those new versions. *) @@ -36,31 +36,14 @@ proof leq0_length by smt. type state = block * capacity. op dstate = dblock * dcapacity. -(** The following is just lining up type definitions and defines the - Indifferentiability experiment. Importantly, it defines neither - ideal primitive nor ideal functionality: only their type. **) -type p_query = [ - | F of state - | Fi of state -]. - -op is_F (q : p_query) = - with q = F s => true - with q = Fi s => false. - -op is_Fi (q : p_query) = - with q = F s => false - with q = Fi s => true. - -op get_query (q : p_query) = - with q = F s => s - with q = Fi s => s. +print Indifferentiability. clone include Indifferentiability with - type p_in <- p_query, - type p_out <- state, + type p <- state, type f_in <- block list, - type f_out <- block. + type f_out <- block + rename [module] "GReal" as "RealIndif" + [module] "GIdeal" as "IdealIndif". (** Ideal Functionality **) clone import LazyRO as Functionality with @@ -73,37 +56,16 @@ clone import LazyRP as Primitive with type D <- state, op d <- dstate. -(*** TODO: deal with these. - - lining up names and types should be easier than it is... ***) -module RP_to_P (O : RP) = { - proc init = O.init - proc oracle(q : p_query) = { - var r; - - if (is_F q) { - r <@ O.f(get_query q); - } else { - r <@ O.fi(get_query q); - } - return r; - } -}. - -module RO_to_F (O : RO): Functionality = { - proc init = O.init - proc oracle = O.f -}. - (** We can now define the squeezeless sponge construction **) -module SqueezelessSponge (P : Primitive): Construction(P), Functionality = { - proc init = P.init +module SqueezelessSponge (P:PRIMITIVE): CONSTRUCTION(P), FUNCTIONALITY = { + proc init () = {} - proc oracle(p : block list): block = { + proc f(p : block list): block = { var (sa,sc) <- (Block.zeros,Capacity.zeros); - if (size p >= 1 /\ p <> [Block.zeros]) { + if (1 <= size p /\ p <> [Block.zeros]) { while (p <> []) { (* Absorption *) - (sa,sc) <@ P.oracle(F (sa ^ head witness p,sc)); + (sa,sc) <@ P.f((sa ^ head witness p,sc)); p <- behead p; } } @@ -114,11 +76,10 @@ module SqueezelessSponge (P : Primitive): Construction(P), Functionality = { (** And the corresponding simulator **) op find_chain: (state,state) fmap -> state -> (block list * block) option. -module PreSimulator (F : Functionality) = { +module S (F : FUNCTIONALITY) = { var m, mi: (state,state) fmap proc init() = { - F.init(); m <- map0; mi <- map0; } @@ -130,7 +91,7 @@ module PreSimulator (F : Functionality) = { pvo <- find_chain m x; if (pvo <> None) { (p,v) <- oget pvo; - h <@ F.oracle(rcons p v); + h <@ F.f(rcons p v); y <$ dcapacity; } else { (h,y) <$ dstate; @@ -153,12 +114,8 @@ module PreSimulator (F : Functionality) = { } }. -module P = RP_to_P(Primitive.P). -module F = RO_to_F(H). -module S(F : Functionality) = RP_to_P(PreSimulator(F)). - section. - declare module D : Self.Distinguisher {P, F, S}. + declare module D : Self.DISTINGUISHER {P, H, S}. (** Inlining oracles into the experiment for clarity **) (* TODO: Drop init from the Distinguisher parameters' signatures *) @@ -169,7 +126,7 @@ section. module F = { proc init(): unit = { } - proc oracle(x : block list): block = { + proc f(x : block list): block = { if (!mem (dom ro) x) { ro.[x] <$ dblock; } @@ -187,7 +144,7 @@ section. pvo <- find_chain m x; if (pvo <> None) { (p,v) <- oget pvo; - h <@ F.oracle(rcons p v); + h <@ F.f(rcons p v); y <$ dcapacity; } else { (h,y) <$ dstate; @@ -209,16 +166,6 @@ section. return oget mi.[x]; } - proc oracle(q : p_query): state = { - var r; - - if (is_F q) { - r <@ f(get_query q); - } else { - r <@ fi(get_query q); - } - return r; - } } proc main(): bool = { @@ -260,28 +207,17 @@ section. return oget mi.[x]; } - proc oracle(q : p_query): state = { - var r; - - if (is_F q) { - r <@ f(get_query q); - } else { - r <@ fi(get_query q); - } - return r; - } - } module C = { proc init(): unit = { } - proc oracle(p : block list): block = { + proc f(p : block list): block = { var (sa,sc) <- (Block.zeros,Capacity.zeros); - if (size p >= 1 /\ p <> [Block.zeros]) { + if (1 <= size p /\ p <> [Block.zeros]) { while (p <> []) { (* Absorption *) - (sa,sc) <@ P.oracle(F (sa ^ head witness p,sc)); + (sa,sc) <@ P.f((sa ^ head witness p,sc)); p <- behead p; } } @@ -302,8 +238,8 @@ section. (** Result: The adversary's advantage in distinguishing the modular defs is equal to that of distinguishing these **) local lemma Inlined_pr &m: - `|Pr[Indif(SqueezelessSponge(P),P,D).main() @ &m: res] - - Pr[Indif(F,S(F),D).main() @ &m: res]| + `|Pr[RealIndif(SqueezelessSponge,P,D).main() @ &m: res] + - Pr[IdealIndif(H,S,D).main() @ &m: res]| = `|Pr[Concrete.main() @ &m: res] - Pr[Ideal.main() @ &m: res]|. proof. by do !congr; expect 2 (byequiv=> //=; proc; inline *; sim; auto). qed. @@ -338,28 +274,17 @@ section. return oget mi.[x]; } - proc oracle(q : p_query): state = { - var r; - - if (is_F q) { - r <@ f(get_query q); - } else { - r <@ fi(get_query q); - } - return r; - } - } module C = { proc init(): unit = { } - proc oracle(p : block list): block = { + proc f(p : block list): block = { var (sa,sc) <- (Block.zeros,Capacity.zeros); - if (size p >= 1 /\ p <> [Block.zeros]) { + if (1 <= size p /\ p <> [Block.zeros]) { while (p <> []) { (* Absorption *) - (sa,sc) <@ P.oracle(F (sa ^ head witness p,sc)); + (sa,sc) <@ P.f((sa ^ head witness p,sc)); p <- behead p; } } @@ -437,6 +362,7 @@ section. by split; apply/half_permutation_set. qed. +print FUNCTIONALITY. local module Game0 = { var m, mi : (state,state) fmap var mcol, micol : (state,caller) fmap (* colouring maps for m, mi *) @@ -447,7 +373,7 @@ section. module S = { (** Inner interface **) - proc f(o : caller, x : state): state = { + proc fg(o : caller, x : state): state = { var o', y, pv, p, v; o' <- odflt D pathscol.[x.`2]; @@ -478,6 +404,12 @@ section. return oget m.[x]; } + proc f(x:state):state = { + var r; + r <@ fg(D,x); + return r; + } + proc fi(x : state): state = { var o', y; @@ -501,28 +433,17 @@ section. (** Distinguisher interface **) proc init() = { } - proc oracle(q : p_query): state = { - var r; - - if (is_F q) { - r <@ f(D,get_query q); - } else { - r <@ fi(get_query q); - } - return r; - } - } module C = { proc init(): unit = { } - proc oracle(p : block list): block = { + proc f(p : block list): block = { var (sa,sc) <- (Block.zeros,Capacity.zeros); - if (size p >= 1 /\ p <> [Block.zeros]) { + if (1 <= size p /\ p <> [Block.zeros]) { while (p <> []) { - (sa,sc) <@ S.f(I,(sa ^ head witness p,sc)); + (sa,sc) <@ S.fg(I,(sa ^ head witness p,sc)); p <- behead p; } } @@ -553,7 +474,7 @@ section. (** Result: the instrumented system and the concrete system are perfectly equivalent **) local equiv Game0_P_S_eq: - Concrete_F.P.f ~ Game0.S.f: + Concrete_F.P.f ~ Game0.S.fg: arg{1} = arg{2}.`2 /\ ={m,mi}(Concrete_F,Game0) /\ is_pre_permutation (Concrete_F.m){1} (Concrete_F.mi){1} @@ -593,14 +514,12 @@ section. proc. call (_: ={m,mi}(Concrete_F,Game0) /\ is_pre_permutation Concrete_F.m{1} Concrete_F.mi{1}). - proc; if=> //=. - + by call Game0_P_S_eq. - + by call Game0_Pi_Si_eq. + + by proc *;inline Game0.S.f;wp;call Game0_P_S_eq;auto. + + by proc *;call Game0_Pi_Si_eq. + proc. sp; if=> //=. while ( ={sa,sc,p} /\ ={m,mi}(Concrete_F,Game0) /\ is_pre_permutation Concrete_F.m{1} Concrete_F.mi{1}). - inline Concrete_F.P.oracle. rcondt{1} 2; 1:by auto. wp; call Game0_P_S_eq. by auto. by auto. @@ -629,7 +548,7 @@ section. module S = { (** Inner interface **) - proc f(o : caller, x : state): state = { + proc fg(o : caller, x : state): state = { var o', ya, yc, pv, p, v; o' <- odflt D pathscol.[x.`2]; @@ -663,6 +582,12 @@ section. return (oget rate.[x],oget cap.[x]); } + proc f(x:state):state = { + var r; + r <@ fg(D,x); + return r; + } + proc fi(x : state): state = { var ya, yc; @@ -688,28 +613,17 @@ section. (** Distinguisher interface **) proc init() = { } - proc oracle(q : p_query): state = { - var r; - - if (is_F q) { - r <@ f(D,get_query q); - } else { - r <@ fi(get_query q); - } - return r; - } - } module C = { proc init(): unit = { } - proc oracle(p : block list): block = { + proc f(p : block list): block = { var (sa,sc) <- (Block.zeros,Capacity.zeros); - if (size p >= 1 /\ p <> [Block.zeros]) { + if (1<= size p /\ p <> [Block.zeros]) { while (p <> []) { - (sa,sc) <@ S.f(I,(sa ^ head witness p,sc)); + (sa,sc) <@ S.fg(I,(sa ^ head witness p,sc)); p <- behead p; } } @@ -740,7 +654,7 @@ section. }. local equiv Game1_S_S_eq: - Game0.S.f ~ Game1.S.f: + Game0.S.fg ~ Game1.S.fg: ={arg} /\ ={pathscol,paths}(Game0,Game1) /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} @@ -751,15 +665,15 @@ section. /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} /\ is_pre_permutation (Game0.m){1} (Game0.mi){1}. - proof. + proof. proc. inline *. sp; if; 1:by progress [-split]; move: H=> [->]. - + auto; progress [-split]. - move: H3; case yL=> ya yc H3; case (x{2})=> xa xc. - by rewrite !getP_eq !map_split_set ?pre_permutation_set. - + auto; progress [-split]. - rewrite H H0 H1 /=. - by move: H=> [_ [_ ->]]. + + auto; progress [-split]. + move: H3; case yL=> ya yc H3; case (x{2})=> xa xc. + by rewrite !getP_eq !map_split_set ?pre_permutation_set. + + auto; progress [-split]. + rewrite H H0 H1 /=. + by move: H=> [_ [_ ->]]. qed. local equiv Game1_Si_Si_eq: @@ -777,12 +691,12 @@ section. proof. proc. inline *. sp; if; 1:by progress [-split]; move: H0=> [->]. - + auto; progress [-split]. - move: H3; case yL=> ya yc H3; case (x{2})=> xa xc. - by rewrite !getP_eq !map_split_set ?pre_permutation_set. - + auto; progress [-split]. - rewrite H H0 H1 /=. - by move: H0=> [_ [_ ->]]. + + auto; progress [-split]. + move: H3; case yL=> ya yc H3; case (x{2})=> xa xc. + by rewrite !getP_eq !map_split_set ?pre_permutation_set. + + auto; progress [-split]. + rewrite H H0 H1 /=. + by move: H0=> [_ [_ ->]]. qed. local lemma Game1_pr &m: @@ -796,17 +710,15 @@ section. /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} /\ is_pre_permutation Game0.m{1} Game0.mi{1}). - proc; if=> //=. - + by call Game1_S_S_eq. - + by call Game1_Si_Si_eq. - + proc; sp; if=> //=. - while ( ={sa,sc,p} - /\ ={pathscol,paths}(Game0,Game1) - /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} - /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} - /\ is_pre_permutation Game0.m{1} Game0.mi{1}). - by wp; call Game1_S_S_eq. - done. + + by proc;call Game1_S_S_eq. + + by apply Game1_Si_Si_eq. + + proc; sp; if=> //=. + while ( ={sa,sc,p} + /\ ={pathscol,paths}(Game0,Game1) + /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} + /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} + /\ is_pre_permutation Game0.m{1} Game0.mi{1})=> //. + by wp; call Game1_S_S_eq. by auto; smt. qed. end section. @@ -814,8 +726,8 @@ end section. (* That Self is unfortunate *) lemma PermutationLemma: exists epsilon, - forall (D <: Self.Distinguisher) &m, - `|Pr[Indif(SqueezelessSponge(P),P,D).main() @ &m: res] - - Pr[Indif(F,S(F),D).main() @ &m: res]| + forall (D <: Self.DISTINGUISHER) &m, + `|Pr[RealIndif(SqueezelessSponge,P,D).main() @ &m: res] + - Pr[IdealIndif(H,S,D).main() @ &m: res]| < epsilon. proof. admit. qed. diff --git a/sha3/proof/old/Utils.ec b/sha3/proof/old/Utils.ec index 4a460ae..5b6f0bd 100644 --- a/sha3/proof/old/Utils.ec +++ b/sha3/proof/old/Utils.ec @@ -2,19 +2,6 @@ require import Option Pair List FSet NewFMap. (* -------------------------------------------------------------------- *) -(* In NewFSet *) -op image (f : 'a -> 'b) (X : 'a fset) = oflist (map f (elems X)) - axiomatized by imageE. - -lemma imageP (f : 'a -> 'b) (X : 'a fset) (b : 'b): - mem (image f X) b <=> exists a, mem X a /\ f a = b. -proof. - rewrite imageE mem_oflist mapP. - (* FIXME *) - by split=> [[a] [a_in_X b_def]| [a] [a_in_X b_def]]; - [rewrite -memE in a_in_X | rewrite memE in a_in_X]; - exists a; rewrite b_def. -qed. lemma rem_id (x : 'a) (m : ('a,'b) fmap): !mem (dom m) x => rem x m = m. @@ -34,11 +21,14 @@ proof. by rewrite rng_rm in_rng=> [x0] [_ h]; exists x0. qed. (* -------------------------------------------------------------------- *) -(* In NewFMap *) + (* In NewFMap *) + op reindex (f : 'a -> 'c) (m : ('a, 'b) fmap) = NewFMap.oflist (map (fun (x : 'a * 'b) => (f x.`1,x.`2)) (elems m)) axiomatized by reindexE. + + lemma dom_reindex (f : 'a -> 'c) (m : ('a, 'b) fmap) x: mem (dom (reindex f m)) x <=> mem (image f (dom m)) x. proof. From 0ecd1bf059072eed3bca362fcc9dce8ef5aa382d Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 30 Nov 2015 22:15:27 +0100 Subject: [PATCH 055/394] fixing previous commits --- sha3/proof/Absorb.ec | 2 +- sha3/proof/AbsorbToBlocks.ec | 6 +-- sha3/proof/Blocks.ec | 9 ++-- sha3/proof/BlocksToTopLevel.ec | 8 ++-- sha3/proof/Common.ec | 85 ++++++++++++++++++++++++---------- sha3/proof/TopLevel.ec | 4 +- 6 files changed, 73 insertions(+), 41 deletions(-) diff --git a/sha3/proof/Absorb.ec b/sha3/proof/Absorb.ec index e8984d7..062ddb0 100644 --- a/sha3/proof/Absorb.ec +++ b/sha3/proof/Absorb.ec @@ -40,7 +40,7 @@ module BlockSponge (P : PRIMITIVE) : RO, CONSTRUCTION(P) = { if (valid p) { (* Absorption *) while (p <> []) { - (sa,sc) <@ P.f(sa ^ head b0 p, sc); + (sa,sc) <@ P.f(sa +^ head b0 p, sc); p <- behead p; } } diff --git a/sha3/proof/AbsorbToBlocks.ec b/sha3/proof/AbsorbToBlocks.ec index a5c48bf..d49c36a 100644 --- a/sha3/proof/AbsorbToBlocks.ec +++ b/sha3/proof/AbsorbToBlocks.ec @@ -35,7 +35,7 @@ module UpperFun (F : Absorb.FUNCTIONALITY) = { var ys <- []; var i <- 0; - if (unpad xs <> None) { + if (valid_block xs) { while (i < n) { y <@ F.f(oget(extend xs i)); ys <- rcons ys y; @@ -70,7 +70,7 @@ section. pred lower (ro : (block list,block) fmap) (iro : (block list * int,block) fmap) = Blocks.BIRO.prefix_closed iro /\ - forall x n, unpad x <> None => iro.[(x,n)] = ro.[oget(extend x n)]. + forall x n, valid_block x => iro.[(x,n)] = ro.[oget(extend x n)]. local equiv ModularAbsorb: UpperFun(Absorb.Ideal.RO).f ~ Blocks.BIRO.IRO'.f: @@ -87,7 +87,7 @@ section. pred upper (ro : (block list,block) fmap) (iro : (block list * int,block) fmap) = (forall x y, strip x <> None => ro.[x] = Some y => iro.[oget(strip x)] = Some y) /\ (forall x n y, - unpad x <> None => + valid_block x => iro.[(x,n)] = Some y => exists n', n <= n' diff --git a/sha3/proof/Blocks.ec b/sha3/proof/Blocks.ec index eb1513f..a91162a 100644 --- a/sha3/proof/Blocks.ec +++ b/sha3/proof/Blocks.ec @@ -7,13 +7,10 @@ require import Common. (* -------------------------------------------------------------------- *) -op valid : block list -> bool = - fun xs => unpad xs <> None. - clone import IRO as BIRO with type from <- block list, type to <- block, - op valid <- valid. + op valid <- valid_block. (* -------------------------------------------------------------------- *) clone include Indifferentiability with @@ -35,10 +32,10 @@ module BlockSponge (P : PRIMITIVE) : BIRO.IRO, CONSTRUCTION(P) = { var (sa,sc) <- (b0, Capacity.c0); var i <- 0; - if (valid p) { + if (valid_block p) { (* Absorption *) while (p <> []) { - (sa,sc) <@ P.f(sa ^ head b0 p, sc); + (sa,sc) <@ P.f(sa +^ head b0 p, sc); p <- behead p; } (* Squeezing *) diff --git a/sha3/proof/BlocksToTopLevel.ec b/sha3/proof/BlocksToTopLevel.ec index ee672ec..088f7e3 100644 --- a/sha3/proof/BlocksToTopLevel.ec +++ b/sha3/proof/BlocksToTopLevel.ec @@ -12,8 +12,8 @@ module UpperFun (F : Blocks.FUNCTIONALITY) = { proc f(p : bool list, n : int) = { var xs; - xs <@ F.f(pad p, (n + r - 1) %/ r); - return take n (flatten(map w2bits xs)); + xs <@ F.f(bits2blocks (pad p), (n + r - 1) %/ r); + return take n (blocks2bits xs); } }. @@ -25,10 +25,10 @@ module LowerFun (F : TopLevel.FUNCTIONALITY) = { var obs : bool list option; var ys : block list <- []; - obs <- unpad xs; + obs <- unpad (blocks2bits xs); if (obs <> None) { cs <@ F.f(oget obs, n * r); (* size cs = n * r *) - ys <- (chunk cs).`1; + ys <- bits2blocks cs; } return ys; } diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 2c0493d..c078abe 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -2,7 +2,7 @@ require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. require import Ring StdRing StdOrder StdBigop BitEncoding. require (*--*) FinType BitWord LazyRP Monoid. -(*---*) import IntID IntOrder Bigint Bigint.BIA. +(*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv. (* -------------------------------------------------------------------- *) op r : { int | 2 <= r } as ge2_r. @@ -24,14 +24,16 @@ clone BitWord as Capacity with op n <- c proof gt0_n by apply/gt0_c - rename "dword" as "cdistr". + rename "dword" as "cdistr" + "zerow" as "c0". clone export BitWord as Block with type word <- block, op n <- r proof gt0_n by apply/gt0_r - rename "dword" as "bdistr". + rename "dword" as "bdistr" + "zerow" as "b0". (* -------------------------------------------------------------------- *) op ( * ): 'a distr -> 'b distr -> ('a * 'b) distr. @@ -47,7 +49,6 @@ rename (* What about this (and the comment applies to other functions): *) -theory Alternative. op chunk (bs : bool list) = BitChunking.chunk r bs. op mkpad (n : int) = @@ -143,8 +144,41 @@ 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. -end Alternative. + +lemma mkseq_add (f:int -> 'a) (n m:int): + 0 <= n => 0 <= m => + mkseq f (n+m) = mkseq f n ++ mkseq (fun i => f (n+i)) m. +admit. +qed. + + +lemma flattenK bs : (forall b, mem bs b => size b = r) => chunk (flatten bs) = bs. +proof. + elim:bs=> [_|x xs Hrec Hs]. by rewrite flatten_nil /chunk /= div0z mkseq0. + rewrite flatten_cons /chunk size_cat Hs 1://. + cut /= -> :=(divzMDl 1 (size (flatten xs)) r);1:by apply /gtr_eqF/gt0_r. + rewrite mkseq_add // 1:divz_ge0 1:gt0_r 1:size_ge0 (mkseqS _ 0) 1:// mkseq0 /=. + rewrite drop0 take_cat Hs //= take0 cats0 /= -{3}Hrec;1:by move=> b Hb;apply Hs;right. + apply eq_in_mkseq => /= i Hi; rewrite IntID.mulrDr /= drop_cat (Hs x) //=. + cut ->/=:!(r + r * i < r);smt ml=0 w=gt0_r. +qed. + +op blocks2bits (xs:block list) : bool list = + flatten (map w2bits xs). + +op bits2blocks (xs:bool list) : block list = + map bits2w (chunk xs). + +lemma block2bitsK : cancel blocks2bits bits2blocks. +proof. + move=> xs;rewrite /blocks2bits /bits2blocks flattenK. + + by move=> b /mapP [x [_ ->]];rewrite /w2bits -Array.sizeE size_word. + rewrite -map_comp -{2}(map_id xs) /(\o) /=;apply eq_map=> @/idfun x /=;apply oflistK. +qed. + + +(* (* -------------------------------------------------------------------- *) (* if size cs < r, then size (chunk_aux (xs, cs) b).`2 < r *) op chunk_aux : block list * bool list -> bool -> block list * bool list = @@ -275,10 +309,10 @@ smt. smt. (* inductive step *) move=> x xs IH cs ys siz_cs_lt_r. -have -> : flatten(x :: xs, cs) = w2bits x ++ flatten (xs, cs) by smt. +have -> : flatten(x :: xs, cs) = w2bits x ++ flatten (xs, cs) by (* smt *) admit. rewrite foldl_cat. rewrite foldl_chunk_aux_new_block. -smt. +smt ml=0. smt. have -> : bits2w([] ++ w2bits x) = x by smt. rewrite (IH cs (rcons ys x)). @@ -358,36 +392,37 @@ proof. rewrite /ocancel. admit. qed. - +*) (* ------------------------ Extending/Stripping ----------------------- *) + +op valid_block (xs : block list) = + unpad (flatten (map w2bits xs)) <> None. (* extend xs n returns None if xs doesn't unpad successfully; otherwise, it returns the result of adding n copies of b0 to the end of xs (n < 0 is treated as n = 0) *) -op extend : block list -> int -> block list option = - fun xs n => - if unpad xs = None - then None + +op extend (xs:block list) (n:int): block list option = + if unpad (flatten (map w2bits xs)) = None then None else Some(xs ++ nseq n b0). -op extend_uncur : block list * int -> block list option = - fun (p : block list * int) => extend p.`1 p.`2. +op extend_uncur (p:block list * int): block list option = + extend p.`1 p.`2. -(* strip returns None if removing the longest suffix of b0's from its +(* strip returns None if removing the longest suffix of zerow's from its argument yields a block list that cannot be unpadded; otherwise, it - removes the longest suffix of b0's from its argument and returns - the pair of the resulting block list with the number of b0's + removes the longest suffix of zerow's from its argument and returns + the pair of the resulting block list with the number of zerow's removed *) -op strip : block list -> (block list * int)option = - fun xs => +op strip (xs:block list): (block list * int)option = let ys = rev xs in let i = find (fun x => x <> b0) ys in - if i = size xs - then None - else let zs = rev(drop i ys) in - if unpad zs = None - then None - else Some(zs, i). + if i = size xs then None + else + let zs = rev(drop i ys) in + if valid_block zs then Some(zs, i) + else None. + pred valid_absorb (xs : block list) = exists (ys : block list, n : int), diff --git a/sha3/proof/TopLevel.ec b/sha3/proof/TopLevel.ec index ed1f87e..37e77a1 100644 --- a/sha3/proof/TopLevel.ec +++ b/sha3/proof/TopLevel.ec @@ -31,11 +31,11 @@ module Sponge (P : PRIMITIVE) : BIRO.IRO, CONSTRUCTION(P) = { var z <- []; var (sa,sc) <- (b0, Capacity.c0); var i <- 0; - var p <- pad bp; + var p <- map bits2w (chunk (pad bp)); (* Absorption *) while (p <> []) { - (sa,sc) <@ P.f(sa ^ head b0 p, sc); + (sa,sc) <@ P.f(sa +^ head b0 p, sc); p <- behead p; } (* Squeezing *) From 76daa4aba74d5a19cda03cf433d4c080bbd94dba Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Tue, 1 Dec 2015 09:26:44 +0100 Subject: [PATCH 056/394] Move some results to the EasyCrypt stdlib. --- sha3/proof/Common.ec | 22 +++------------------- 1 file changed, 3 insertions(+), 19 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index c078abe..f60a782 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -145,24 +145,9 @@ 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 mkseq_add (f:int -> 'a) (n m:int): - 0 <= n => 0 <= m => - mkseq f (n+m) = mkseq f n ++ mkseq (fun i => f (n+i)) m. -admit. -qed. - - -lemma flattenK bs : (forall b, mem bs b => size b = r) => chunk (flatten bs) = bs. -proof. - elim:bs=> [_|x xs Hrec Hs]. by rewrite flatten_nil /chunk /= div0z mkseq0. - rewrite flatten_cons /chunk size_cat Hs 1://. - cut /= -> :=(divzMDl 1 (size (flatten xs)) r);1:by apply /gtr_eqF/gt0_r. - rewrite mkseq_add // 1:divz_ge0 1:gt0_r 1:size_ge0 (mkseqS _ 0) 1:// mkseq0 /=. - rewrite drop0 take_cat Hs //= take0 cats0 /= -{3}Hrec;1:by move=> b Hb;apply Hs;right. - apply eq_in_mkseq => /= i Hi; rewrite IntID.mulrDr /= drop_cat (Hs x) //=. - cut ->/=:!(r + r * i < r);smt ml=0 w=gt0_r. -qed. +lemma flattenK bs : + (forall b, mem bs b => size b = r) => chunk (flatten bs) = bs. +proof. by apply/BitChunking.flattenK/gt0_r. qed. op blocks2bits (xs:block list) : bool list = flatten (map w2bits xs). @@ -177,7 +162,6 @@ proof. rewrite -map_comp -{2}(map_id xs) /(\o) /=;apply eq_map=> @/idfun x /=;apply oflistK. qed. - (* (* -------------------------------------------------------------------- *) (* if size cs < r, then size (chunk_aux (xs, cs) b).`2 < r *) From 2293d8b972f63592f94be5cb393dd893264bf4bd Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 1 Dec 2015 18:58:58 -0500 Subject: [PATCH 057/394] Defined these functions op pad2blocks : bool list -> block list = bits2blocks \o pad. op unpad_blocks : block list -> bool list option = unpad \o blocks2bits. Proved the expected cancelation lemmas, as well as bits2blocksK, which was missing. extend and strip no longer can fail (as P-Y said, this makes them easier to reason about): 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). Defined validity tests for each level: (* in TopLevel *) op valid_toplevel (_ : bool list) = true. (* in Block *) op valid_block (xs : block list) = unpad_blocks xs <> None. (* in Absorb *) op valid_absorb (xs : block list) = let (ys, n) = strip xs in valid_block ys. Updated other files to track these changes. (Cancelation lemmas for extend/strip almost done, but not in this commit.) --- sha3/proof/Absorb.ec | 5 +- sha3/proof/AbsorbToBlocks.ec | 36 ++-- sha3/proof/Blocks.ec | 6 +- sha3/proof/BlocksToTopLevel.ec | 4 +- sha3/proof/Common.ec | 297 ++++++--------------------------- sha3/proof/TopLevel.ec | 4 +- 6 files changed, 76 insertions(+), 276 deletions(-) diff --git a/sha3/proof/Absorb.ec b/sha3/proof/Absorb.ec index 062ddb0..31978ef 100644 --- a/sha3/proof/Absorb.ec +++ b/sha3/proof/Absorb.ec @@ -9,9 +9,6 @@ require import Common. (* -------------------------------------------------------------------- *) -op valid : block list -> bool = - fun xs => strip xs <> None. - clone import RndOrcl as RO with type from <- block list, type to <- block, @@ -37,7 +34,7 @@ module BlockSponge (P : PRIMITIVE) : RO, CONSTRUCTION(P) = { proc f(p : block list): block = { var (sa,sc) <- (b0, Capacity.c0); - if (valid p) { + if (valid_absorb p) { (* Absorption *) while (p <> []) { (sa,sc) <@ P.f(sa +^ head b0 p, sc); diff --git a/sha3/proof/AbsorbToBlocks.ec b/sha3/proof/AbsorbToBlocks.ec index d49c36a..eb00f91 100644 --- a/sha3/proof/AbsorbToBlocks.ec +++ b/sha3/proof/AbsorbToBlocks.ec @@ -12,16 +12,13 @@ module LowerFun(F : Blocks.FUNCTIONALITY) : Absorb.FUNCTIONALITY = { proc init = F.init proc f(xs : block list) : block = { - var o : (block list * int)option; - var ys <- []; - var n; + var (ys, n) <- strip xs; + var zs <- []; - o <- strip xs; - if (o <> None) { - (ys, n) <- oget o; - ys <@ F.f(ys, n + 1); + if (valid_block ys) { + zs <@ F.f(ys, n + 1); } - return last b0 ys; + return last b0 zs; } }. @@ -37,7 +34,7 @@ module UpperFun (F : Absorb.FUNCTIONALITY) = { if (valid_block xs) { while (i < n) { - y <@ F.f(oget(extend xs i)); + y <@ F.f(extend xs i); ys <- rcons ys y; i <- i + 1; } @@ -70,7 +67,7 @@ section. pred lower (ro : (block list,block) fmap) (iro : (block list * int,block) fmap) = Blocks.BIRO.prefix_closed iro /\ - forall x n, valid_block x => iro.[(x,n)] = ro.[oget(extend x n)]. + forall x n, valid_block x => iro.[(x,n)] = ro.[extend x n]. local equiv ModularAbsorb: UpperFun(Absorb.Ideal.RO).f ~ Blocks.BIRO.IRO'.f: @@ -85,23 +82,22 @@ section. qed. pred upper (ro : (block list,block) fmap) (iro : (block list * int,block) fmap) = - (forall x y, strip x <> None => ro.[x] = Some y => iro.[oget(strip x)] = Some y) + (forall x y, valid_absorb x => ro.[x] = y => iro.[strip x] = y) /\ (forall x n y, valid_block x => iro.[(x,n)] = Some y => exists n', n <= n' - /\ mem (dom ro) (oget(extend x n'))). + /\ mem (dom ro) (extend x n')). module LowIRO' : Absorb.FUNCTIONALITY = { proc init = Blocks.BIRO.IRO'.init - proc f(x : block list) = { + proc f(xs : block list) = { var b <- b0; - var o : (block list * int)option; + var (ys, n) = strip xs; - o <- strip x; - if (o <> None) { - b <@ Blocks.BIRO.IRO'.f_lazy(oget o); + if (valid_block ys) { + b <@ Blocks.BIRO.IRO'.f_lazy(ys, n); } return b; @@ -227,9 +223,11 @@ section. byequiv=> //=; proc. call (_: ={glob AbsorbSim} /\ lower Absorb.Ideal.RO.m{1} Blocks.BIRO.IRO'.mp{2}). proc (lower Absorb.Ideal.RO.m{1} Blocks.BIRO.IRO'.mp{2})=> //=. - by proc; sp; if=> //=; call ModularAbsorb; auto. + proc; sp; if=> //=. smt. + call ModularAbsorb; auto; smt. proc (lower Absorb.Ideal.RO.m{1} Blocks.BIRO.IRO'.mp{2})=> //=. - by proc; sp; if=> //=; call ModularAbsorb; auto. + proc; sp; if=> //=. smt. + call ModularAbsorb; auto; smt. (* Re-Bug *) by conseq ModularAbsorb=> &1 &2; case (arg{1}); case (arg{2}). inline *; wp;call (_: true)=> //=. diff --git a/sha3/proof/Blocks.ec b/sha3/proof/Blocks.ec index a91162a..bdc4d2b 100644 --- a/sha3/proof/Blocks.ec +++ b/sha3/proof/Blocks.ec @@ -8,9 +8,9 @@ require import Common. (* -------------------------------------------------------------------- *) clone import IRO as BIRO with - type from <- block list, - type to <- block, - op valid <- valid_block. + type from <- block list, + type to <- block, + op valid <- valid_block. (* -------------------------------------------------------------------- *) clone include Indifferentiability with diff --git a/sha3/proof/BlocksToTopLevel.ec b/sha3/proof/BlocksToTopLevel.ec index 088f7e3..94aff60 100644 --- a/sha3/proof/BlocksToTopLevel.ec +++ b/sha3/proof/BlocksToTopLevel.ec @@ -12,7 +12,7 @@ module UpperFun (F : Blocks.FUNCTIONALITY) = { proc f(p : bool list, n : int) = { var xs; - xs <@ F.f(bits2blocks (pad p), (n + r - 1) %/ r); + xs <@ F.f(pad2blocks p, (n + r - 1) %/ r); return take n (blocks2bits xs); } }. @@ -25,7 +25,7 @@ module LowerFun (F : TopLevel.FUNCTIONALITY) = { var obs : bool list option; var ys : block list <- []; - obs <- unpad (blocks2bits xs); + obs <- unpad_blocks xs; if (obs <> None) { cs <@ F.f(oget obs, n * r); (* size cs = n * r *) ys <- bits2blocks cs; diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index f60a782..14fe129 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -155,277 +155,82 @@ op blocks2bits (xs:block list) : bool list = op bits2blocks (xs:bool list) : block list = map bits2w (chunk xs). -lemma block2bitsK : cancel blocks2bits bits2blocks. +lemma blocks2bitsK : cancel blocks2bits bits2blocks. proof. move=> xs;rewrite /blocks2bits /bits2blocks flattenK. + by move=> b /mapP [x [_ ->]];rewrite /w2bits -Array.sizeE size_word. rewrite -map_comp -{2}(map_id xs) /(\o) /=;apply eq_map=> @/idfun x /=;apply oflistK. qed. -(* -(* -------------------------------------------------------------------- *) -(* if size cs < r, then size (chunk_aux (xs, cs) b).`2 < r *) -op chunk_aux : block list * bool list -> bool -> block list * bool list = - fun p b => - let (xs, cs) = p in - let ds = rcons cs b in - if size ds = r - then (rcons xs (bits2w ds), []) - else (xs, ds). - -(* size (chunk bs).`2 < r *) -op chunk : bool list -> block list * bool list = - foldl chunk_aux ([], []). - -op flatten (p : block list * bool list) : bool list = - flatten(map w2bits p.`1) ++ p.`2. - -lemma chunk_aux_flatten (xs : block list, cs : bool list, bs : bool list) : - size cs < r => - flatten (foldl chunk_aux (xs, cs) bs) = - flatten(map w2bits xs) ++ cs ++ bs. +lemma bits2blocksK (bs : bool list) : + r %| size bs => blocks2bits(bits2blocks bs) = bs. proof. -move: bs xs cs. -elim. -(* basis step *) -move=> xs cs siz_cs_lt_r. -have -> : foldl chunk_aux (xs, cs) [] = (xs, cs) by trivial. -rewrite /flatten /=. -rewrite - catA. -rewrite cats0 //. -(* inductive step *) -move=> x l IH xs cs siz_cs_lt_r /=. -rewrite {2} /chunk_aux /=. -case (size cs = r - 1) => siz_cs_eq_r_min1. -have -> : size(rcons cs x) = r by smt. -simplify. -have -> : - flatten (map w2bits xs) ++ cs ++ x :: l = - flatten (map w2bits xs) ++ (rcons cs x) ++ l by smt. -rewrite (IH (rcons xs (bits2w (rcons cs x))) []). - smt. -have -> : - map w2bits (rcons xs (bits2w (rcons cs x))) = - rcons (map w2bits xs) (rcons cs x) by smt. -rewrite - cats1. -smt. -have : size cs < r - 1 by smt. -move=> siz_cs_lt_r_min1. -clear siz_cs_lt_r siz_cs_eq_r_min1. -have : !(size(rcons cs x) = r) by smt. -move=> H. -rewrite H /=. -rewrite (IH xs (rcons cs x)). - smt. -smt. +move=> siz_bs_div_r. +rewrite /blocks2bits /bits2blocks -map_comp. +cut map_tolistK : + forall (xss : bool list list), + (forall (xs : bool list), mem xss xs => size xs = r) => + map (w2bits \o bits2w) xss = xss. + + elim => [// | xs yss ih mem_xs_cons_yss_siz_r /=]. + + split. + + apply tolistK; rewrite mem_xs_cons_yss_siz_r //. + + apply ih => zs mem_zss_zs. + + by rewrite mem_xs_cons_yss_siz_r /=; first right; assumption. +rewrite map_tolistK; [apply in_chunk_size | exact chunkK]. qed. -lemma chunk_flatten : cancel chunk flatten. -proof. -rewrite /cancel => p. -rewrite /chunk. -rewrite chunk_aux_flatten. -smt. -smt. -qed. +op pad2blocks : bool list -> block list = bits2blocks \o pad. +op unpad_blocks : block list -> bool list option = unpad \o blocks2bits. -lemma foldl_chunk_aux_add_bits (ys : block list, cs, ds : bool list) : - size ds + size cs < r => - foldl chunk_aux (ys, ds) cs = (ys, ds ++ cs). +lemma pad2blocksK : pcancel pad2blocks unpad_blocks. proof. -move: ys ds. -elim cs. -smt. -move=> c cs IH ys ds siz_ys_plus_c_cs_lt_r. -have -> : - foldl chunk_aux (ys, ds) (c :: cs) = - foldl chunk_aux (ys, rcons ds c) cs. - simplify. - have -> : chunk_aux (ys, ds) c = (ys, rcons ds c). - rewrite /chunk_aux. - simplify. - smt. - reflexivity. -rewrite (IH ys (rcons ds c)). -smt. -smt. +move=> xs. +rewrite /pad2blocks /unpad_blocks /(\o) bits2blocksK + 1:size_pad_dvd_r padK //. qed. -lemma foldl_chunk_aux_new_block (ys : block list, cs, ds : bool list) : - cs <> [] => size ds + size cs = r => - foldl chunk_aux (ys, ds) cs = (rcons ys (bits2w(ds ++ cs)), []). +lemma unpadBlocksK : ocancel unpad_blocks pad2blocks. proof. -move=> cs_nonnil siz. -cut cs_form : exists (es, fs : bool list), - size es = size cs - 1 /\ - size fs = 1 /\ - cs = es ++ fs. - exists (take (size cs - 1) cs), (drop (size cs - 1) cs). - smt. -elim cs_form => es fs [H1 [H2 H3]]. -cut fs_form : exists (f : bool), fs = [f]. - exists (nth false fs 0). - smt. -elim fs_form => f H4. -rewrite H3 H4. -rewrite foldl_cat. -rewrite foldl_chunk_aux_add_bits. -smt. -cut -> : - foldl chunk_aux (ys, ds ++ es) [f] = - chunk_aux (ys, ds ++ es) f. - trivial. -rewrite /chunk_aux. -smt. +move=> xs; rewrite /pad2blocks /unpad_blocks /(\o). +pose bs := blocks2bits xs. +case (unpad bs = None) => [-> // | unpad_bs_neq_None]. +cut unpad_bs : unpad bs = Some(oget(unpad bs)) by rewrite /#. +rewrite unpad_bs /=. +cut -> : pad(oget(unpad bs)) = bs by rewrite - {2} (unpadK bs) unpad_bs //. +rewrite /bs blocks2bitsK //. qed. -lemma flatten_chunk_aux (xs, ys : block list, cs : bool list) : - size cs < r => - foldl chunk_aux (ys, []) (flatten(xs, cs)) = (ys ++ xs, cs). -proof. -move: cs ys. -elim xs. -(* basis step *) -move=> cs ys siz_cs_lt_r. -have -> : flatten([], cs) = cs by smt. -rewrite foldl_chunk_aux_add_bits. -smt. -smt. -(* inductive step *) -move=> x xs IH cs ys siz_cs_lt_r. -have -> : flatten(x :: xs, cs) = w2bits x ++ flatten (xs, cs) by (* smt *) admit. -rewrite foldl_cat. -rewrite foldl_chunk_aux_new_block. -smt ml=0. -smt. -have -> : bits2w([] ++ w2bits x) = x by smt. -rewrite (IH cs (rcons ys x)). -assumption. -smt. -qed. +(* ------------------------ Extending/Stripping ----------------------- *) -lemma flatten_chunk (xs, ys : block list, cs : bool list) : - size cs < r => - chunk(flatten(xs, cs)) = (xs, cs). -proof. -move=> siz_cs_lt_r. -rewrite /chunk. -rewrite (flatten_chunk_aux xs [] cs). -assumption. -smt. -qed. +op extend (xs : block list) (n : int) = + xs ++ nseq n b0. -pred valid_block (xs : block list) = - exists (ys : bool list, n : int), - 0 <= n < r /\ - flatten(map w2bits xs) = ys ++ [true] ++ nseq n false ++ [true]. - - - -op pad : bool list -> block list = - fun bs => - let (xs, cs) = chunk bs in - let siz_cs = size cs in (* siz_cs < r *) - if 2 <= r - siz_cs - then rcons xs - (bits2w(cs ++ - [true] ++ - nseq (r - siz_cs - 2) false ++ - [true])) - else (* r - siz_cs = 1 *) - xs ++ [bits2w(rcons cs true)] ++ - [bits2w(rcons (nseq (r - 1) false) true)]. - -(* unpad_aux returns None if its argument xs doesn't end with true and - have at least one other occurrence of true; otherwise, it returns - Some of the result of removing the shortest suffix of xs containing - two occurrences of true *) -op unpad_aux : bool list -> bool list option = - fun xs => - let ys = rev xs in - if !(head false ys) - then None - else let zs = behead ys in - let i = find ((=) true) zs in - if i = size zs - then None - else Some(rev(drop (i + 1) zs)). - -op unpad : block list -> bool list option = - fun xs => unpad_aux(flatten(map w2bits xs)). - -lemma pad_valid (bs : bool list) : valid_block(pad bs). -proof. -admit. -qed. +op strip (xs : block list) = + let i = find (fun x => x <> b0) (rev xs) in + (take (size xs - i) xs, i). -lemma valid_block (xs : block list) : - unpad xs <> None <=> valid_block xs. +lemma extendK (xs : block list) (n : int) : + last b0 xs <> b0 => 0 <= n => + strip(extend xs n) = (xs, n). proof. -admit. +admit. (* proof in progress *) qed. -lemma pad_unpad : pcancel pad unpad. +lemma stripK (xs : block list) : + let (ys, n) = strip xs in + extend ys n = xs. proof. -rewrite /pcancel. -admit. +admit. (* proof in progress *) qed. -lemma unpad_pad : ocancel unpad pad. -proof. -rewrite /ocancel. -admit. -qed. -*) -(* ------------------------ Extending/Stripping ----------------------- *) +(*------------------------------ Validity ----------------------------- *) +(* in TopLevel *) +op valid_toplevel (_ : bool list) = true. -op valid_block (xs : block list) = - unpad (flatten (map w2bits xs)) <> None. -(* extend xs n returns None if xs doesn't unpad successfully; - otherwise, it returns the result of adding n copies of b0 to the - end of xs (n < 0 is treated as n = 0) *) - -op extend (xs:block list) (n:int): block list option = - if unpad (flatten (map w2bits xs)) = None then None - else Some(xs ++ nseq n b0). - -op extend_uncur (p:block list * int): block list option = - extend p.`1 p.`2. - -(* strip returns None if removing the longest suffix of zerow's from its - argument yields a block list that cannot be unpadded; otherwise, it - removes the longest suffix of zerow's from its argument and returns - the pair of the resulting block list with the number of zerow's - removed *) -op strip (xs:block list): (block list * int)option = - let ys = rev xs in - let i = find (fun x => x <> b0) ys in - if i = size xs then None - else - let zs = rev(drop i ys) in - if valid_block zs then Some(zs, i) - else None. - - -pred valid_absorb (xs : block list) = - exists (ys : block list, n : int), - 0 <= n /\ valid_block ys /\ xs = ys ++ nseq n b0. - -lemma valid_absorb (xs : block list) : - strip xs <> None <=> valid_absorb xs. -proof. -admit. -qed. +(* in Block *) +op valid_block (xs : block list) = unpad_blocks xs <> None. -lemma extend_strip (xs : block list, n : int) : - oapp strip (Some(xs, max n 0)) (extend xs n) = Some(xs, max n 0). -proof. -admit. -qed. - -lemma strip_extend (xs : block list) : - oapp extend_uncur (Some xs) (strip xs) = Some xs. -proof. -admit. -qed. +(* in Absorb *) +op valid_absorb (xs : block list) = + let (ys, n) = strip xs in valid_block ys. diff --git a/sha3/proof/TopLevel.ec b/sha3/proof/TopLevel.ec index 37e77a1..2d724c5 100644 --- a/sha3/proof/TopLevel.ec +++ b/sha3/proof/TopLevel.ec @@ -8,8 +8,8 @@ require import Common. (* -------------------------------------------------------------------- *) clone import IRO as BIRO with type from <- bool list, - type to <- bool, - op valid (x : bool list) <- true. + type to <- bool, + op valid <- valid_toplevel. (* -------------------------------------------------------------------- *) clone include Indifferentiability with From 3500b40c79b429cc64c82410414f9f471a92a823 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 2 Dec 2015 08:37:35 -0500 Subject: [PATCH 058/394] Simplify proof using newly introduced size_tolist. Other nits. --- sha3/proof/Common.ec | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 14fe129..fd10f1c 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -158,8 +158,9 @@ op bits2blocks (xs:bool list) : block list = lemma blocks2bitsK : cancel blocks2bits bits2blocks. proof. move=> xs;rewrite /blocks2bits /bits2blocks flattenK. - + by move=> b /mapP [x [_ ->]];rewrite /w2bits -Array.sizeE size_word. - rewrite -map_comp -{2}(map_id xs) /(\o) /=;apply eq_map=> @/idfun x /=;apply oflistK. + + by move=> b /mapP [x [_ ->]];rewrite size_tolist. + rewrite -map_comp -{2}(map_id xs) /(\o) /=;apply eq_map=> @/idfun x /=; + apply oflistK. qed. lemma bits2blocksK (bs : bool list) : @@ -194,7 +195,8 @@ proof. move=> xs; rewrite /pad2blocks /unpad_blocks /(\o). pose bs := blocks2bits xs. case (unpad bs = None) => [-> // | unpad_bs_neq_None]. -cut unpad_bs : unpad bs = Some(oget(unpad bs)) by rewrite /#. +cut unpad_bs : unpad bs = Some(oget(unpad bs)) + by move: unpad_bs_neq_None; case (unpad bs)=> //. rewrite unpad_bs /=. cut -> : pad(oget(unpad bs)) = bs by rewrite - {2} (unpadK bs) unpad_bs //. rewrite /bs blocks2bitsK //. @@ -233,4 +235,4 @@ op valid_block (xs : block list) = unpad_blocks xs <> None. (* in Absorb *) op valid_absorb (xs : block list) = - let (ys, n) = strip xs in valid_block ys. + let (ys, _) = strip xs in valid_block ys. From 2e86830fba2faf2d37a2fc7d3c961028e3ade704 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 3 Dec 2015 19:31:16 -0500 Subject: [PATCH 059/394] (1) Proved the cancellation lemmas for extend/strip: extendK and stripK. --- (2) Put some useful lemmas in Auxiliary.ec: (* go in Int.ec? *) lemma leltz (y x z : int) : x <= y < z => x < z. proof. move=> [/lez_eqVlt [-> // | lt_xy lt_yz]]; exact (ltz_trans y). qed. (* go in Int.ec? *) lemma ltlez (y x z : int) : x < y <= z => x < z. proof. move=> [lt_xy /lez_eqVlt [<- // | lt_yz]]; exact (ltz_trans y). qed. (* go in List.ec? *) lemma last_rev ['a] (x0 : 'a) (xs : 'a list) : last x0 (rev xs) = head x0 xs. proof. elim xs=> [| x xs ih]; [rewrite rev_nil // | rewrite rev_cons lastrcons //]. qed. (* go in List.ec? *) lemma head_nonnil ['a] (x0 : 'a) (xs : 'a list) : head x0 xs <> x0 => xs <> []. proof. case (xs)=> //. qed. --- sha3/proof/Auxiliary.ec | 27 +++++++++++++++++++ sha3/proof/Common.ec | 60 ++++++++++++++++++++++++++++++++++++----- 2 files changed, 80 insertions(+), 7 deletions(-) create mode 100644 sha3/proof/Auxiliary.ec diff --git a/sha3/proof/Auxiliary.ec b/sha3/proof/Auxiliary.ec new file mode 100644 index 0000000..337452e --- /dev/null +++ b/sha3/proof/Auxiliary.ec @@ -0,0 +1,27 @@ +(* ------------------------- Auxiliary Lemmas ------------------------- *) + +require import Bool Int List. + +(* go in Int.ec? *) +lemma leltz (y x z : int) : x <= y < z => x < z. +proof. +move=> [/lez_eqVlt [-> // | lt_xy lt_yz]]; exact (ltz_trans y). +qed. + +(* go in Int.ec? *) +lemma ltlez (y x z : int) : x < y <= z => x < z. +proof. +move=> [lt_xy /lez_eqVlt [<- // | lt_yz]]; exact (ltz_trans y). +qed. + +(* go in List.ec? *) +lemma last_rev ['a] (x0 : 'a) (xs : 'a list) : + last x0 (rev xs) = head x0 xs. +proof. +elim xs=> [| x xs ih]; [rewrite rev_nil // | rewrite rev_cons lastrcons //]. +qed. + +(* go in List.ec? *) +lemma head_nonnil ['a] (x0 : 'a) (xs : 'a list) : + head x0 xs <> x0 => xs <> []. +proof. case (xs)=> //. qed. diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index fd10f1c..2e740fe 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -3,6 +3,7 @@ require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. require import Ring StdRing StdOrder StdBigop BitEncoding. require (*--*) FinType BitWord LazyRP Monoid. (*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv. +require import Auxiliary. (* -------------------------------------------------------------------- *) op r : { int | 2 <= r } as ge2_r. @@ -168,7 +169,7 @@ lemma bits2blocksK (bs : bool list) : proof. move=> siz_bs_div_r. rewrite /blocks2bits /bits2blocks -map_comp. -cut map_tolistK : +have map_tolistK : forall (xss : bool list list), (forall (xs : bool list), mem xss xs => size xs = r) => map (w2bits \o bits2w) xss = xss. @@ -195,10 +196,10 @@ proof. move=> xs; rewrite /pad2blocks /unpad_blocks /(\o). pose bs := blocks2bits xs. case (unpad bs = None) => [-> // | unpad_bs_neq_None]. -cut unpad_bs : unpad bs = Some(oget(unpad bs)) +have unpad_bs : unpad bs = Some(oget(unpad bs)) by move: unpad_bs_neq_None; case (unpad bs)=> //. rewrite unpad_bs /=. -cut -> : pad(oget(unpad bs)) = bs by rewrite - {2} (unpadK bs) unpad_bs //. +have -> : pad(oget(unpad bs)) = bs by rewrite - {2} (unpadK bs) unpad_bs //. rewrite /bs blocks2bitsK //. qed. @@ -212,17 +213,62 @@ op strip (xs : block list) = (take (size xs - i) xs, i). lemma extendK (xs : block list) (n : int) : - last b0 xs <> b0 => 0 <= n => - strip(extend xs n) = (xs, n). + last b0 xs <> b0 => 0 <= n => strip(extend xs n) = (xs, n). proof. -admit. (* proof in progress *) +move=> xs_ends_not_b0 ge0_n. +rewrite /strip /extend /= rev_cat rev_nseq size_cat size_nseq max_ler // + subzE - 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 //; exact (head_nonnil b0 (rev xs)). +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 max_ler //. + have -> // : p (head b0 (rev xs)) by trivial. +by rewrite (addzC n) addNz /= take_size_cat. qed. lemma stripK (xs : block list) : let (ys, n) = strip xs in extend ys n = xs. proof. -admit. (* proof in progress *) +rewrite /strip /extend /=. +pose p := fun x => x <> b0. +pose i := find p (rev xs). +have [i_low i_upp] : 0 <= i <= size xs + by split; [apply find_ge0 | move=> _; rewrite - size_rev find_size]. +have i_upp' : 0 <= size xs - i by rewrite subz_ge0 //. +have {3} <- : + take (size xs - i) xs ++ drop (size xs - i) xs = xs by apply cat_take_drop. +have siz_drop : size(drop (size xs - i) xs) = i. + rewrite size_drop 1 : i_upp'. + have -> : size xs - (size xs - i) = i by algebra. + apply max_ler; first apply i_low. +have drop_eq_b0 : + forall (j : int), + 0 <= j < i => nth b0 (drop (size xs - i) xs) j = b0. + move=> j [j_low j_upp]. + have [i_min_j_min_1_low i_min_j_min_1_upp] : 0 <= i - j - 1 < i. + split => [|_]. + rewrite - subz_gt0 - lez_add1r in j_upp; rewrite subz_ge0 //. + rewrite - subz_gt0. + have -> : i - (i - j - 1) = j + 1 by algebra. + by rewrite - lez_add1r addzC addzA lez_add2r. + rewrite nth_drop //. + have -> : size xs - i + j = size xs - ((i - j - 1) + 1) by algebra. + rewrite - (nth_rev b0 (i - j - 1) xs). + split=> [//| _]; exact (ltlez i). + have -> : + (nth b0 (rev xs) (i - j - 1) = b0) = !p(nth b0 (rev xs) (i - j - 1)) + by trivial. + exact before_find. +have <- // : drop (size xs - i) xs = nseq i b0. + apply (eq_from_nth b0)=> [| j rng_j]. + rewrite siz_drop size_nseq max_ler //. + rewrite siz_drop in rng_j; rewrite nth_nseq //; exact drop_eq_b0. qed. (*------------------------------ Validity ----------------------------- *) From 76db37b30c2df34ba25ee2a972dc9a383513fc6e Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Fri, 4 Dec 2015 09:07:10 +0100 Subject: [PATCH 060/394] Prune Auxiliary.ec + fix proofs w.r.t. name changes in the stdlib. Only last_rev has been kept. Other ones are either present in the standard library (see Number.eca && the search command), or does not qualify for having a name as their application is harder than directly calling the relevant tactic. --- sha3/proof/Auxiliary.ec | 27 --------------------------- sha3/proof/Common.ec | 13 ++++++------- 2 files changed, 6 insertions(+), 34 deletions(-) delete mode 100644 sha3/proof/Auxiliary.ec diff --git a/sha3/proof/Auxiliary.ec b/sha3/proof/Auxiliary.ec deleted file mode 100644 index 337452e..0000000 --- a/sha3/proof/Auxiliary.ec +++ /dev/null @@ -1,27 +0,0 @@ -(* ------------------------- Auxiliary Lemmas ------------------------- *) - -require import Bool Int List. - -(* go in Int.ec? *) -lemma leltz (y x z : int) : x <= y < z => x < z. -proof. -move=> [/lez_eqVlt [-> // | lt_xy lt_yz]]; exact (ltz_trans y). -qed. - -(* go in Int.ec? *) -lemma ltlez (y x z : int) : x < y <= z => x < z. -proof. -move=> [lt_xy /lez_eqVlt [<- // | lt_yz]]; exact (ltz_trans y). -qed. - -(* go in List.ec? *) -lemma last_rev ['a] (x0 : 'a) (xs : 'a list) : - last x0 (rev xs) = head x0 xs. -proof. -elim xs=> [| x xs ih]; [rewrite rev_nil // | rewrite rev_cons lastrcons //]. -qed. - -(* go in List.ec? *) -lemma head_nonnil ['a] (x0 : 'a) (xs : 'a list) : - head x0 xs <> x0 => xs <> []. -proof. case (xs)=> //. qed. diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 2e740fe..a2448b1 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -3,7 +3,6 @@ require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. require import Ring StdRing StdOrder StdBigop BitEncoding. require (*--*) FinType BitWord LazyRP Monoid. (*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv. -require import Auxiliary. (* -------------------------------------------------------------------- *) op r : { int | 2 <= r } as ge2_r. @@ -67,13 +66,13 @@ 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 !(lastcons, lastrcons). qed. +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 lastcat last_mkpad. qed. +proof. by rewrite last_cat last_mkpad. qed. lemma size_mkpad n : size (mkpad n) = (-(n+2)) %% r + 2. proof. @@ -127,7 +126,7 @@ qed. lemma unpadK : ocancel unpad pad. proof. move=> s @/unpad; case: (last false s) => //=. -elim/last_ind: s=> //= s b ih {ih}; rewrite lastrcons => hb. +elim/last_ind: s=> //= s b ih {ih}; rewrite last_rcons => hb. rewrite rev_rcons /= size_rcons -(inj_eq _ (addIr (-1))) /= ?addrK. pose i := index _ _; case: (i = size s) => //=. move=> ne_is @/pad; pose j := _ - (i+2); apply/eq_sym. @@ -219,8 +218,8 @@ move=> xs_ends_not_b0 ge0_n. rewrite /strip /extend /= rev_cat rev_nseq size_cat size_nseq max_ler // subzE - 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 //; exact (head_nonnil b0 (rev xs)). +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. @@ -260,7 +259,7 @@ have drop_eq_b0 : rewrite nth_drop //. have -> : size xs - i + j = size xs - ((i - j - 1) + 1) by algebra. rewrite - (nth_rev b0 (i - j - 1) xs). - split=> [//| _]; exact (ltlez i). + split=> [//| _]; exact/(ltr_le_trans i). have -> : (nth b0 (rev xs) (i - j - 1) = b0) = !p(nth b0 (rev xs) (i - j - 1)) by trivial. From 27664f908cd0616be19abb62e1066cd588814bf4 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Fri, 4 Dec 2015 10:48:27 +0100 Subject: [PATCH 061/394] Backward chaining... --- sha3/proof/Common.ec | 53 +++++++++++++------------------------------- 1 file changed, 16 insertions(+), 37 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index a2448b1..522d5d8 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -203,7 +203,6 @@ rewrite /bs blocks2bitsK //. qed. (* ------------------------ Extending/Stripping ----------------------- *) - op extend (xs : block list) (n : int) = xs ++ nseq n b0. @@ -231,43 +230,23 @@ by rewrite (addzC n) addNz /= take_size_cat. qed. lemma stripK (xs : block list) : - let (ys, n) = strip xs in - extend ys n = xs. + extend (strip xs).`1 (strip xs).`2 = xs. proof. -rewrite /strip /extend /=. -pose p := fun x => x <> b0. -pose i := find p (rev xs). -have [i_low i_upp] : 0 <= i <= size xs - by split; [apply find_ge0 | move=> _; rewrite - size_rev find_size]. -have i_upp' : 0 <= size xs - i by rewrite subz_ge0 //. -have {3} <- : - take (size xs - i) xs ++ drop (size xs - i) xs = xs by apply cat_take_drop. -have siz_drop : size(drop (size xs - i) xs) = i. - rewrite size_drop 1 : i_upp'. - have -> : size xs - (size xs - i) = i by algebra. - apply max_ler; first apply i_low. -have drop_eq_b0 : - forall (j : int), - 0 <= j < i => nth b0 (drop (size xs - i) xs) j = b0. - move=> j [j_low j_upp]. - have [i_min_j_min_1_low i_min_j_min_1_upp] : 0 <= i - j - 1 < i. - split => [|_]. - rewrite - subz_gt0 - lez_add1r in j_upp; rewrite subz_ge0 //. - rewrite - subz_gt0. - have -> : i - (i - j - 1) = j + 1 by algebra. - by rewrite - lez_add1r addzC addzA lez_add2r. - rewrite nth_drop //. - have -> : size xs - i + j = size xs - ((i - j - 1) + 1) by algebra. - rewrite - (nth_rev b0 (i - j - 1) xs). - split=> [//| _]; exact/(ltr_le_trans i). - have -> : - (nth b0 (rev xs) (i - j - 1) = b0) = !p(nth b0 (rev xs) (i - j - 1)) - by trivial. - exact before_find. -have <- // : drop (size xs - i) xs = nseq i b0. - apply (eq_from_nth b0)=> [| j rng_j]. - rewrite siz_drop size_nseq max_ler //. - rewrite siz_drop in rng_j; rewrite nth_nseq //; exact drop_eq_b0. +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 // 2!subrE opprD opprK. + by rewrite addrA addrN /= max_ler. +apply/(eq_from_nth b0) => [|j]; rewrite ?size_nseq ?max_ler //. +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 2!subrE. + 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 /= subrE ltr_snaddr // oppr_lt0 ltzS. qed. (*------------------------------ Validity ----------------------------- *) From 2be8a715d72fec1aa441e5ab024062cc20a3e437 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Sat, 5 Dec 2015 08:20:58 +0100 Subject: [PATCH 062/394] Start proof of sha3. Definition of game for bad event + game after eager. Some try in the proof --- sha3/proof/Common.ec | 3 +- sha3/proof/old/Squeezeless.ec | 1069 +++++++++++++++++++++++++-------- 2 files changed, 803 insertions(+), 269 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 522d5d8..90eea5c 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -2,7 +2,7 @@ require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. require import Ring StdRing StdOrder StdBigop BitEncoding. require (*--*) FinType BitWord LazyRP Monoid. -(*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv. +(*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv Dprod. (* -------------------------------------------------------------------- *) op r : { int | 2 <= r } as ge2_r. @@ -36,7 +36,6 @@ clone export BitWord as Block with "zerow" as "b0". (* -------------------------------------------------------------------- *) -op ( * ): 'a distr -> 'b distr -> ('a * 'b) distr. clone export LazyRP as Perm with type D <- block * capacity, diff --git a/sha3/proof/old/Squeezeless.ec b/sha3/proof/old/Squeezeless.ec index ec7e0d1..d9bea41 100644 --- a/sha3/proof/old/Squeezeless.ec +++ b/sha3/proof/old/Squeezeless.ec @@ -1,42 +1,16 @@ + (** 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 Fun Option Pair Int Real List FSet NewFMap Utils. -require (*..*) AWord LazyRP LazyRO Indifferentiability. -(* TODO: Clean up the Bitstring and Word theories - -- Make use of those new versions. *) -(*...*) import Dprod Dexcepted. -(* TODO: Datatype definitions and distributions should - be properly separated and reorganized. *) - -op r : { int | 0 < r } as lt0_r. -op c : { int | 0 < c } as lt0_c. - -(** Clarify assumptions on the distributions as we go. As this is currently - written, we are hiding some pretty heavy axioms behind cloning. **) -type block. -op dblock: block distr. - -clone import AWord as Block with - op length <- r, - type word <- block, - op Dword.dword <- dblock -proof leq0_length by smt. - -type capacity. -op dcapacity: capacity distr. - -clone AWord as Capacity with - op length <- c, - type word <- capacity, - op Dword.dword <- dcapacity -proof leq0_length by smt. - -type state = block * capacity. -op dstate = dblock * dcapacity. - -print Indifferentiability. +require import Pred Fun Option Pair Int Real List FSet NewFMap Utils Common. + +require (*..*) RndOrcl Indifferentiability. +(*...*) import Dprod Dexcepted Capacity. + +type state = block * capacity. +op dstate = bdistr * cdistr. + clone include Indifferentiability with type p <- state, @@ -45,27 +19,47 @@ clone include Indifferentiability with rename [module] "GReal" as "RealIndif" [module] "GIdeal" as "IdealIndif". + +(* max number of call to the permutation and its inverse *) +op max_size : int. + (** Ideal Functionality **) -clone import LazyRO as Functionality with - type from <- block list, - type to <- block, - op d <- dblock. +clone import Tuple as TupleBl with + type t <- block, + op Support.enum <- Block.words + proof Support.enum_spec by exact Block.enum_spec. -(** Ideal Primitive for the Random Transformation case **) -clone import LazyRP as Primitive with - type D <- state, - op d <- dstate. +op bl_enum = flatten (mkseq (fun i => wordn i) (max_size + 1)). +op bl_univ = FSet.oflist bl_enum. + +clone RndOrcl as RndOrclB with + type from <- block list, + type to <- block. + +clone import RndOrclB.RestrIdeal as Functionality with + op sample _ <- bdistr, + op test l <- List.size l <= max_size, + op univ <- bl_univ, + op dfl <- b0 + proof *. +realize sample_ll by exact Block.DWord.bdistr_ll. +realize testP. +proof. + move=> x; rewrite mem_oflist-flattenP; split=>[_|[s[/mkseqP[i[/=_->>]]/wordnP->/#]]]. + exists (wordn (size x));cut Hsx := size_ge0 x. + rewrite wordnP max_ler //= mkseqP /=;exists (size x);smt ml=0. +qed. (** We can now define the squeezeless sponge construction **) module SqueezelessSponge (P:PRIMITIVE): CONSTRUCTION(P), FUNCTIONALITY = { proc init () = {} proc f(p : block list): block = { - var (sa,sc) <- (Block.zeros,Capacity.zeros); + var (sa,sc) <- (b0,c0); - if (1 <= size p /\ p <> [Block.zeros]) { + if (1 <= size p /\ p <> [b0]) { while (p <> []) { (* Absorption *) - (sa,sc) <@ P.f((sa ^ head witness p,sc)); + (sa,sc) <@ P.f((sa +^ head witness p,sc)); p <- behead p; } } @@ -73,176 +67,18 @@ module SqueezelessSponge (P:PRIMITIVE): CONSTRUCTION(P), FUNCTIONALITY = { } }. -(** And the corresponding simulator **) -op find_chain: (state,state) fmap -> state -> (block list * block) option. - -module S (F : FUNCTIONALITY) = { - var m, mi: (state,state) fmap - - proc init() = { - m <- map0; - mi <- map0; - } - - proc f(x:state) = { - var pvo, p, v, h, y; - - if (!mem (dom m) x) { - pvo <- find_chain m x; - if (pvo <> None) { - (p,v) <- oget pvo; - h <@ F.f(rcons p v); - y <$ dcapacity; - } else { - (h,y) <$ dstate; - } - m.[x] <- (h,y); - mi.[(h,y)] <- x; - } - return oget m.[x]; - } - - proc fi(x:state) = { - var y; - - if (!mem (dom mi) x) { - y <$ dstate; - mi.[x] <- y; - m.[y] <- x; - } - return oget mi.[x]; - } -}. - section. - declare module D : Self.DISTINGUISHER {P, H, S}. - - (** Inlining oracles into the experiment for clarity **) - (* TODO: Drop init from the Distinguisher parameters' signatures *) - local module Ideal = { - var ro : (block list,block) fmap - var m, mi : (state,state) fmap - - module F = { - proc init(): unit = { } - - proc f(x : block list): block = { - if (!mem (dom ro) x) { - ro.[x] <$ dblock; - } - return oget ro.[x]; - } - } - - module S = { - proc init(): unit = { } - - proc f(x : state): state = { - var pvo, p, v, h, y; - - if (!mem (dom m) x) { - pvo <- find_chain m x; - if (pvo <> None) { - (p,v) <- oget pvo; - h <@ F.f(rcons p v); - y <$ dcapacity; - } else { - (h,y) <$ dstate; - } - m.[x] <- (h,y); - mi.[(h,y)] <- x; - } - return oget m.[x]; - } - - proc fi(x:state) = { - var y; - - if (!mem (dom mi) x) { - y <$ dstate; - mi.[x] <- y; - m.[y] <- x; - } - return oget mi.[x]; - } - - } - - proc main(): bool = { - var b; - - ro <- map0; - m <- map0; - mi <- map0; - b <@ D(F,S).distinguish(); - return b; - } - }. - local module Concrete = { - var m, mi: (state,state) fmap + declare module D : Self.DISTINGUISHER {Perm, RO}. - module P = { - proc init(): unit = { } - - proc f(x : state): state = { - var y; - - if (!mem (dom m) x) { - y <$ dstate \ (rng m); - m.[x] <- y; - mi.[y] <- x; - } - return oget m.[x]; - } - - proc fi(x : state): state = { - var y; - - if (!mem (dom mi) x) { - y <$ dstate \ (rng mi); - mi.[x] <- y; - m.[y] <- x; - } - return oget mi.[x]; - } - - } - - module C = { - proc init(): unit = { } - - proc f(p : block list): block = { - var (sa,sc) <- (Block.zeros,Capacity.zeros); - - if (1 <= size p /\ p <> [Block.zeros]) { - while (p <> []) { (* Absorption *) - (sa,sc) <@ P.f((sa ^ head witness p,sc)); - p <- behead p; - } - } - return sa; (* Squeezing phase (non-iterated) *) - } - } - - proc main(): bool = { - var b; - - m <- map0; - mi <- map0; - b <@ D(C,P).distinguish(); - return b; - } - }. + local module Concrete = RealIndif(SqueezelessSponge,Perm,D). (** Result: The adversary's advantage in distinguishing the modular defs is equal to that of distinguishing these **) local lemma Inlined_pr &m: - `|Pr[RealIndif(SqueezelessSponge,P,D).main() @ &m: res] - - Pr[IdealIndif(H,S,D).main() @ &m: res]| - = `|Pr[Concrete.main() @ &m: res] - - Pr[Ideal.main() @ &m: res]|. - proof. by do !congr; expect 2 (byequiv=> //=; proc; inline *; sim; auto). qed. + Pr[RealIndif(SqueezelessSponge,Perm,D).main() @ &m: res] + = Pr[Concrete.main() @ &m: res]. + proof. trivial. qed. (** An intermediate game where we don't care about the permutation being a bijection anymore... **) @@ -280,11 +116,11 @@ section. proc init(): unit = { } proc f(p : block list): block = { - var (sa,sc) <- (Block.zeros,Capacity.zeros); + var (sa,sc) <- (b0,c0); - if (1 <= size p /\ p <> [Block.zeros]) { + if (1 <= size p /\ p <> [b0]) { while (p <> []) { (* Absorption *) - (sa,sc) <@ P.f((sa ^ head witness p,sc)); + (sa,sc) <@ P.f((sa +^ head witness p,sc)); p <- behead p; } } @@ -301,6 +137,13 @@ section. return b; } }. + + op bound_concrete : real. + + local lemma Concrete_Concrete_F &m: + Pr[Concrete.main() @ &m: res] <= + Pr[Concrete_F.main() @ &m: res] + bound_concrete. + admitted. (** Result (expected): The distance between Concrete and Concrete_F is bounded by N^2/|state|, where N is the total cost (in terms @@ -333,7 +176,7 @@ section. samplings are independent, hence the move away from a random permutation. Some side-effects remain worrying. **) - type caller = [ | I | D ]. + type caller = [ I | D ]. op (<=) (o1 o2 : caller) = o1 = I \/ o2 = D. @@ -362,46 +205,521 @@ section. by split; apply/half_permutation_set. qed. -print FUNCTIONALITY. - local module Game0 = { - var m, mi : (state,state) fmap - var mcol, micol : (state,caller) fmap (* colouring maps for m, mi *) - var paths : (capacity,block list * block) fmap - var pathscol : (capacity,caller) fmap (* colouring maps for paths *) - var bext, bred : bool - var bcoll, bsuff, bmitm : bool + type handle = int. + + type hstate = block * handle. + + type ccapacity = capacity * caller. + + op hinv (handles:(handle,ccapacity) fmap) (c:capacity) = + find (fun _ => pred1 c \o fst) handles. + + op hinvD (handles:(handle,ccapacity) fmap) (c:capacity) = + find (fun _ => pred1 (c,D)) handles. + + local module G2 = { + var m, mi : (state , state ) fmap + var mh, mhi : (hstate, hstate) fmap + var handles : (handle, ccapacity) fmap + var chandle : int + var paths : (capacity, block list * block) fmap + var bext, bcol : bool + + + module C = { + proc init(): unit = { } + + proc f(p : block list): block = { + var h, i <- 0; + var (sa,sc) <- (b0,c0); + var sa'; + + if (1 <= size p /\ p <> [b0]) { + while (i < size p - 1 /\ mem (dom m) (sa +^ nth witness p i, sc)) { + (sa, sc) <- oget m.[(sa +^ nth witness p i, sc)]; + (sa', h) <- oget mh.[(sa +^ nth witness p i, h)]; + i <- i + 1; + } + while (i < size p) { + sc <$ cdistr; + bcol <- bcol \/ hinv handles sc <> None; + sa' <- RO.f(take i p); + mh.[(sa,h)] <- (sa', chandle); + mhi.[(sa',chandle)] <- (sa,h); + (sa,h) <- (sa',chandle); + handles.[chandle] <- (sc,I); + chandle <- chandle + 1; + i <- i + 1; + } + sa <- RO.f(p); + } + return sa; + } + } module S = { (** Inner interface **) - proc fg(o : caller, x : state): state = { - var o', y, pv, p, v; + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2; + + if (!mem (dom m) x) { + if (mem (dom paths) x.`2) { + (p,v) <- oget paths.[x.`2]; + y1 <- RO.f (rcons p (v +^ x.`1)); + y2 <$ cdistr; + y <- (y1, y2); + paths.[y2] <- (rcons p (v +^ x.`1), y.`1); + } else { + y <$ dstate; + } + bext <- bext \/ mem (rng handles) (x.`2, I); + (* exists x2 h, handles.[h] = Some (X2,I) *) + if (!(mem (rng handles) (x.`2, D))) { + handles.[chandle] <- (x.`2, D); + chandle <- chandle + 1; + } + hx2 <- oget (hinvD handles x.`2); + if (mem (dom mh) (x.`1, hx2) /\ (oget handles.[(oget mh.[(x.`1,hx2)]).`2]).`2 = I) { + hy2 <- (oget mh.[(x.`1, hx2)]).`2; + y <- (y.`1, (oget handles.[hy2]).`1); + handles.[hy2] <- (y.`2, D); + (* bad <- bad \/ mem X2 y.`2; *) + m.[x] <- y; + mi.[y] <- x; + } else { + bcol <- bcol \/ hinv handles y.`2 <> None; + hy2 <- chandle; + chandle <- chandle + 1; + handles.[hy2] <- (y.`2, D); + m.[x] <- y; + mh.[(x.`1, hx2)] <- (y.`1, hy2); + mi.[y] <- x; + mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget m.[x]; + } + return y; + } - o' <- odflt D pathscol.[x.`2]; - bext <- bext \/ (o' <= o); + proc fi(x : state): state = { + var y, y1, hx2, hy2; + + if (!mem (dom mi) x) { + bext <- bext \/ mem (rng handles) (x.`2, I); + (* exists x2 h, handles.[h] = Some (X2,I) *) + if (!(mem (rng handles) (x.`2, D))) { + handles.[chandle] <- (x.`2, D); + chandle <- chandle + 1; + } + hx2 <- oget (hinvD handles x.`2); + y <$ dstate; + if (mem (dom mhi) (x.`1, hx2) /\ (oget handles.[(oget mh.[(x.`1,hx2)]).`2]).`2 = I) { + (y1,hy2) <- oget mhi.[(x.`1, hx2)]; + y <- (y.`1, (oget handles.[hy2]).`1); + handles.[hy2] <- (y.`2, D); + (* bad <- bad \/ mem X2 y.`2; *) + mi.[x] <- y; + mhi.[(x.`1, hx2)] <- (y.`1, hy2); + m.[y] <- x; + mh.[(y.`1, hy2)] <- (x.`1, hx2); + } else { + bcol <- bcol \/ hinv handles y.`2 <> None; + hy2 <- chandle; + chandle <- chandle + 1; + handles.[hy2] <- (y.`2, D); + 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; + } + + (** Distinguisher interface **) + proc init() = { } + + } + + + proc main(): bool = { + var b; + + m <- map0; + mi <- map0; + bext <- false; + bcol <- false; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + handles <- map0.[0 <- (c0, D)]; + paths <- map0.[c0 <- ([<:block>],b0)]; + chandle <- 1; + b <@ D(C,S).distinguish(); + return b; + } + }. + +op INV2 (m mi:(state , state ) fmap) (mh mhi:(hstate, hstate) fmap) (handles:(handle, ccapacity) fmap) chandle = + dom mh = rng mhi /\ dom mhi = rng mh /\ + (forall xh, mem (dom mh `|` rng mh) xh => mem (dom handles) xh.`2) /\ + (forall h, mem (dom handles) h => h < chandle) /\ + (forall xh, mem (dom mh) xh => mem (dom m) (xh.`1, (oget handles.[xh.`2]).`1) \/ (oget handles.[xh.`2]).`2 = I) /\ + (forall xh, mem (dom mhi) xh => mem (dom mi) (xh.`1, (oget handles.[xh.`2]).`1) \/ (oget handles.[xh.`2]).`2 = I). + +lemma get_oget (m:('a,'b)fmap) (x:'a) : mem (dom m) x => m.[x] = Some (oget m.[x]). +proof. by rewrite in_dom;case (m.[x]). qed. + +lemma find_set (m:('a,'b) fmap) y x (p:'a -> 'b -> bool): + (forall x, mem (dom m) x => !p x (oget m.[x])) => + find p m.[x <- y] = if p x y then Some x else None. +proof. + cut [[a []->[]] | []-> Hp Hnp]:= findP p (m.[x<-y]);1: rewrite getP dom_set !inE /#. + by case (p x y)=> //; cut := Hp x;rewrite getP dom_set !inE /= oget_some. +qed. + +require import StdOrder. +require import Ring. + +lemma hinvD_rng x (handles:(handle, ccapacity) fmap): + mem (rng handles) (x, D) => + handles.[oget (hinvD handles x)]= Some(x, D). +proof. + cut[ [a []->[]] | []->/=Hp ]/=:= findP (fun _ z => z = (x, D)) handles. + + by rewrite oget_some=> ? <- _;apply get_oget. + by rewrite in_rng=> [a Ha];cut := Hp a; rewrite in_dom Ha oget_some. +qed. + +(* TODO: change the name *) +lemma map_perm (m mi: ('a, 'a) fmap) x y: !mem (dom mi) y => dom m = rng mi => dom m.[x<-y] = rng mi.[y<- x]. +proof. + move=> Hdom Heq;rewrite fsetP=> w;rewrite dom_set in_rng !inE;split. + + rewrite Heq in_rng. case (w=x)=>[->|Hneq/=[a Ha]];1:by exists y;rewrite getP. + exists a;rewrite getP;case (a=y)=>[->>|//]. + by move:Hdom;rewrite in_dom Ha. + rewrite Heq in_rng;by move=>[a];rewrite getP;case(a=y)=>[->>/# |_ <-];left;exists a. +qed. + +local hoare test_f : G2.S.f : INV2 G2.m G2.mi G2.mh G2.mhi G2.handles G2.chandle (*/\ INV2 G2.mi G2.mhi G2.handles*) ==> + INV2 G2.m G2.mi G2.mh G2.mhi G2.handles G2.chandle. +proof. + proc;if;last by auto. + auto;conseq (_ :_ ==> true)=> //. + move=> &hr [][]Hmhmhi[]Hmhimh[]Hdomh[]Hhbound[]Hmhor Hmhior Hnmem y _;split;beta iota. + + move=> Hnrng handles chandle hx2 @/handles. + cut ->>{hx2} : hx2 = G2.chandle{hr}. + + rewrite /hx2 /handles /hinvD find_set /pred1 //=. + move=> x2 Hx2;cut := Hnrng;rewrite in_rng NewLogic.negb_exists /= => /(_ x2). + by rewrite get_oget. + split=> /= [[Hmem _] | Hmem]. + + by cut /Hhbound // := Hdomh (x{hr}.`1, G2.chandle{hr}) _; rewrite inE;left. + do !apply andI. + + apply map_perm=> //;rewrite -not_def=> H. + by cut /#:= Hhbound chandle _;apply (Hdomh (y.`1,chandle));rewrite !inE -Hmhimh H. + + apply map_perm=> //;rewrite -not_def=> H. + by cut /#:= Hhbound G2.chandle{hr} _;apply (Hdomh (x{hr}.`1,G2.chandle{hr}));rewrite !inE H. + + move=>[x1 h];cut := Hdomh (x1,h). + rewrite !(dom_set, rng_set, inE) /==>H1 [[H2|[_->]]|[/rng_rem_le H2|[_->]]]//; + by rewrite H1 ?H2. + + by move=> h;cut := Hhbound h;rewrite !dom_set !inE /= => H [[/H|]|->>]/#. + + move=>[x1 h];rewrite !getP !dom_set !inE /==>[|[]->> ->>];rewrite /chandles /=. + + move=>Hh. cut /Hhbound/=:= Hdomh (x1,h) _;1:by rewrite !inE Hh. + move=> ^Hlt /IntOrder.gtr_eqF; rewrite eq_sym=>->. + by cut ->/#: h <> G2.chandle{hr} + 1 by smt ml=0. + cut ->/=: G2.chandle{hr} <> G2.chandle{hr} + 1 by smt ml=0. + by rewrite oget_some /#. + move=>[x1 h];rewrite !getP !dom_set !inE /==>[|[]->> ->>];rewrite /chandles /=. + + move=>Hh; cut /Hhbound/=:= Hdomh (x1,h) _;1:by rewrite !inE -Hmhimh Hh. + move=> ^Hlt /IntOrder.gtr_eqF; rewrite eq_sym=>->. + by cut ->/#: h <> G2.chandle{hr} + 1 by smt ml=0. + by rewrite oget_some /#. + move=> /= Hrng;cut Hget:= hinvD_rng _ _ Hrng;split=> /=. + + move=> []/Hmhor /= [] ; rewrite Hget oget_some /#. + move=> Hnot;do !apply andI. + + apply map_perm=> //;rewrite -not_def=> H. + by cut /#:= Hhbound G2.chandle{hr} _;apply (Hdomh (y.`1,G2.chandle{hr})); + rewrite !inE -Hmhimh H. + + apply map_perm=> //;rewrite -not_def=> H. + by cut := Hmhor _ H;move: Hnmem;rewrite Hget oget_some /=;case (x{hr}). + + move=> [x1 h];rewrite !(dom_set,rng_set, inE) => [[H|[_ ->]]| [/rng_rem_le H|[_->]]]//=. + + by left;apply (Hdomh (x1,h));rewrite inE H. + + by left;rewrite in_dom Hget. + by left;apply (Hdomh (x1,h));rewrite inE H. + + by move=>h;rewrite dom_set !inE=> [/Hhbound|->]/#. + + move=> [x1 h];rewrite !(dom_set, getP, inE) /==>[H|[->> ->>]]. + + by cut /IntOrder.ltr_eqF->/#:= Hhbound h _;1:by apply (Hdomh (x1,h));rewrite inE H. + cut ->/=:oget (hinvD G2.handles{hr} x{hr}.`2) <> G2.chandle{hr}. + + by cut /#:= Hhbound (oget (hinvD G2.handles{hr} x{hr}.`2)) _;1:by rewrite in_dom Hget. + by rewrite Hget oget_some /=;right;case (x{hr}). + move=> [x1 h];rewrite !(dom_set, getP, inE) /==>[H|[->> ->> /=]]. + + by cut /IntOrder.ltr_eqF->/#:= Hhbound h _;1: apply (Hdomh (x1,h));rewrite inE -Hmhimh H. + by rewrite oget_some /=;right;case y. +qed. + +local hoare test_fi : G2.S.fi : INV2 G2.m G2.mi G2.mh G2.mhi G2.handles G2.chandle ==> + INV2 G2.m G2.mi G2.mh G2.mhi G2.handles G2.chandle. +proof. + proc;if;last by auto. + auto. move=> &hr [][]Hmhmhi[]Hmhimh[]Hdomh[]Hhbound[]Hmhor Hmhior Hnmem;split;beta iota. + + move=> Hnrng handles chandle hx2 @/handles y Hy. + cut ->>{hx2} : hx2 = G2.chandle{hr}. + + rewrite /hx2 /handles /hinvD find_set /pred1 //=. + move=> x2 Hx2;cut := Hnrng;rewrite in_rng NewLogic.negb_exists /= => /(_ x2). + by rewrite get_oget. + split=> /= [[Hmem _] | Hmem]. + + by cut /Hhbound // := Hdomh (x{hr}.`1, G2.chandle{hr}) _;rewrite inE -Hmhimh;right. + do !apply andI. + + apply map_perm=> //;rewrite -not_def=> H. + by cut /#:= Hhbound G2.chandle{hr} _;apply (Hdomh (x{hr}.`1,G2.chandle{hr})); + rewrite !inE -Hmhimh H. + + apply map_perm=> //;rewrite -not_def=> H. + by cut /#:= Hhbound chandle _;apply (Hdomh (y.`1,chandle));rewrite !inE -Hmhimh H. + + move=>[x1 h];cut := Hdomh (x1,h). + rewrite !(dom_set, rng_set, inE) /==>H1 [[H2|[_->]]|[/rng_rem_le H2|[_->]]]//; + by rewrite H1 ?H2. + + by move=> h;cut := Hhbound h;rewrite !dom_set !inE /= => H [[/H|]|->>]/#. + + move=>[x1 h];rewrite !getP !dom_set !inE /==>[|[]->> ->>];rewrite /chandles /=. + + move=>Hh; cut /Hhbound/=:= Hdomh (x1,h) _;1:by rewrite !inE -Hmhimh Hh. + move=> ^Hlt /IntOrder.gtr_eqF; rewrite eq_sym=>->. + by cut ->/#: h <> G2.chandle{hr} + 1 by smt ml=0. + by rewrite oget_some /#. + move=>[x1 h];rewrite !getP !dom_set !inE /==>[|[]->> ->>];rewrite /chandles /=. + + move=>Hh;cut /Hhbound/=:= Hdomh (x1,h) _;1:by rewrite !inE -Hmhimh Hh. + move=> ^Hlt /IntOrder.gtr_eqF; rewrite eq_sym=>->. + by cut ->/#: h <> G2.chandle{hr} + 1 by smt ml=0. + cut ->/=: G2.chandle{hr} <> G2.chandle{hr} + 1 by smt ml=0. + by rewrite oget_some /#. + move=> /= Hrng y Hy;cut Hget:= hinvD_rng _ _ Hrng;split=> /=. + + move=> []/Hmhior /= [] ; rewrite Hget oget_some /#. + move=> Hnot;do !apply andI. + + apply map_perm=> //;rewrite -not_def=> H. + by cut := Hmhior _ H;move: Hnmem;rewrite Hget oget_some /=;case (x{hr}). + + apply map_perm=> //;rewrite -not_def=> H. + by cut /#:= Hhbound G2.chandle{hr} _;apply (Hdomh (y.`1,G2.chandle{hr})); + rewrite !inE -Hmhimh H. + + move=> [x1 h];rewrite !(dom_set,rng_set, inE) => [[H|[_ ->]]| [/rng_rem_le H|[_->]]]//=. + + by left;apply (Hdomh (x1,h));rewrite inE H. + + by left;apply (Hdomh (x1,h));rewrite inE H. + by left;rewrite in_dom Hget. + + by move=>h;rewrite dom_set !inE=> [/Hhbound|->]/#. + + move=> [x1 h];rewrite !(dom_set, getP, inE) /==>[H|[->> ->> /=]]. + + by cut /IntOrder.ltr_eqF->/#:= Hhbound h _;1: apply (Hdomh (x1,h));rewrite inE -Hmhimh H. + by rewrite oget_some /==>{Hy};right;case y. + move=> [x1 h];rewrite !(dom_set, getP, inE) /==>[H|[->> ->>]]. + + by cut /IntOrder.ltr_eqF->/#:= Hhbound h _;1:apply (Hdomh (x1,h));rewrite inE -Hmhimh H. + cut ->/=:oget (hinvD G2.handles{hr} x{hr}.`2) <> G2.chandle{hr}. + + by cut /#:= Hhbound (oget (hinvD G2.handles{hr} x{hr}.`2)) _;1:by rewrite in_dom Hget. + by rewrite Hget oget_some /=;right;case (x{hr}). +qed. + +local hoare test_C : G2.C.f : INV2 G2.m G2.mi G2.mh G2.mhi G2.handles G2.chandle ==> + INV2 G2.m G2.mi G2.mh G2.mhi G2.handles G2.chandle. + + +local module Game3 = { + var m, mi : (state , state ) fmap + var mh, mhi : (hstate, hstate) fmap + var handles : (handle, ccapacity) fmap + var chandle : int + var paths : (capacity, block list * block) fmap + var bext : bool + + + module C = { + proc init(): unit = { } + + proc f(p : block list): block = { + var h, i <- 0; + var (sa,sc) <- (b0,c0); + var sa'; + + if (1 <= size p /\ p <> [b0]) { + while (i < size p - 1 /\ mem (dom m) (sa +^ nth witness p i, sc)) { + (sa, sc) <- oget m.[(sa +^ nth witness p i, sc)]; + (sa', h) <- oget mh.[(sa +^ nth witness p i, h)]; + i <- i + 1; + } + while (i < size p) { + sc <$ cdistr; + sa' <- RO.f(take i p); + mh.[(sa,h)] <- (sa', chandle); + mhi.[(sa',chandle)] <- (sa,h); + (sa,h) <- (sa',chandle); + handles.[chandle] <- (sc,I); + chandle <- chandle + 1; + i <- i + 1; + } + sa <- RO.f(p); + } + return sa; + } + } + + module S = { + (** Inner interface **) + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2; + if (!mem (dom m) x) { - y <$ dstate; if (mem (dom paths) x.`2) { - o' <- oget pathscol.[x.`2]; - pv <- oget paths.[x.`2]; - (p,v) <- pv; - bcoll <- bcoll \/ (mem (dom paths) y.`2); - bsuff <- bsuff \/ (mem (image snd (rng m)) y.`2); - pathscol.[y.`2] <- max o o'; - paths.[y.`2] <- (rcons p (v ^ x.`1),y.`1); + (p,v) <- oget paths.[x.`2]; + y1 <- RO.f (rcons p (v +^ x.`1)); + y2 <$ cdistr; + y <- (y1, y2); + paths.[y2] <- (rcons p (v +^ x.`1), y.`1); + } else { + y <$ dstate; + } + bext <- bext \/ mem (rng handles) (x.`2, I); + (* exists x2 h, handles.[h] = Some (X2,I) *) + if (!(mem (rng handles) (x.`2, D))) { + handles.[chandle] <- (x.`2, D); + chandle <- chandle + 1; + } + hx2 <- oget (hinvD handles x.`2); + if (mem (dom mh) (x.`1, hx2)) { + hy2 <- (oget mh.[(x.`1, hx2)]).`2; + handles.[hy2] <- (y.`2, D); + (* bad <- bad \/ mem X2 y.`2; *) + m.[x] <- y; + mh.[(x.`1, hx2)] <- (y.`1, hy2); + mi.[y] <- x; + mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } else { + hy2 <- chandle; + chandle <- chandle + 1; + handles.[hy2] <- (y.`2, D); + m.[x] <- y; + mh.[(x.`1, hx2)] <- (y.`1, hy2); + mi.[y] <- x; + mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2, hx2, hy2; + + if (!mem (dom mi) x) { + bext <- bext \/ mem (rng handles) (x.`2, I); + (* exists x2 h, handles.[h] = Some (X2,I) *) + if (!(mem (rng handles) (x.`2, D))) { + handles.[chandle] <- (x.`2, D); + chandle <- chandle + 1; + } + hx2 <- oget (hinvD handles x.`2); + if (mem (dom mhi) (x.`1, hx2)) { + (y1,hy2) <- oget mhi.[(x.`1, hx2)]; + y2 <$ cdistr; + y <- (y1,y2); + handles.[hy2] <- (y.`2, D); + (* bad <- bad \/ mem X2 y.`2; *) + mi.[x] <- y; + mhi.[(x.`1, hx2)] <- (y.`1, hy2); + m.[y] <- x; + mh.[(y.`1, hy2)] <- (x.`1, hx2); + } else { + y <$ dstate; + hy2 <- chandle; + chandle <- chandle + 1; + handles.[hy2] <- (y.`2, D); + mi.[x] <- y; + mhi.[(x.`1, hx2)] <- (y.`1, hy2); + m.[y] <- x; + mh.[(y.`1, hy2)] <- (x.`1, hx2); } - mcol.[x] <- o; - m.[x] <- y; - micol.[y] <- o; - mi.[y] <- x; } else { - o' <- oget mcol.[x]; - mcol.[x] <- max o o'; - y <- oget m.[x]; - o' <- oget micol.[y]; - micol.[y] <- max o o'; + y <- oget mi.[x]; } - return oget m.[x]; + return y; + } + + (** Distinguisher interface **) + proc init() = { } + + } + + + + proc main(): bool = { + var b; + + m <- map0; + mi <- map0; + bext <- false; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + handles <- map0.[0 <- (c0, D)]; + paths <- map0.[c0 <- ([<:block>],b0)]; + chandle <- 1; + b <@ D(C,S).distinguish(); + return b; + } + }. + + + + + local module Game1 = { + var m, mi : (hstate,hstate) fmap + var paths : (handle,(block list * block) list) fmap + var handles : (handle, ccapacity) fmap + var bext, bred, bcoll : bool + var chandle : int + + module S = { + (** Inner interface **) + proc fg(o : caller, x : state): state = { + var o', p, v, y, y1, y2, ox2, hx2, y1h; + + ox2 <- hinv handles x.`2; + hx2 <- oget ox2; + bext <- bext \/ + (o = D /\ ox2 <> None /\ paths.[hx2] <> None /\ + find_path m D paths hx2 = None); + + + if (ox2 = None) { + handles.[chandle] <- (x.`2,o); + hx2 <- chandle; + chandle <- chandle + 1; + } + + if (!mem (dom m) (x.`1, hx2) || (oget handles.[hx2]).`2 = I /\ o = D) { + if (mem (dom paths) hx2 /\ find_path m o paths hx2 <> None) { + (p,v) <- oget (find_path m o paths hx2); + y1 <- RO.f (rcons p (v +^ x.`1)); + y2 <$ cdistr; + y <- (y1, y2); + if (hinv handles y.`2 = None) + paths.[chandle (*y2*)] <- extend_paths x.`1 y.`1 (oget paths.[hx2]); + } else { + y <$ dstate; + } + if (hinv handles y.`2 = None) { + y1h <- (y.`1, chandle); + handles.[chandle] <- (y.`2, o); + m.[(x.`1, hx2)] <- y1h; + mi.[y1h] <- (x.`1, hx2); + handles.[hx2] <- (x.`2, max o (oget handles.[hx2]).`2); (* Warning: not sure we want it *) + chandle <- chandle + 1; + } else { + bcoll <- true; + } + } else { (* mem (dom m) (x.`1, hx2) /\ (!dom m with I \/ o <> D) *) + y1h <- oget m.[(x.`1,hx2)]; + (y2,o') <- oget handles.[y1h.`2]; + handles.[y1h.`2] <- (y2, max o o'); + handles.[hx2] <- (x.`2, max o (oget handles.[hx2]).`2); + y <- (y1h.`1, y2); + } + return y; } proc f(x:state):state = { @@ -411,23 +729,40 @@ print FUNCTIONALITY. } proc fi(x : state): state = { - var o', y; + var o', y, y2, ox2, hx2, y1h; + + ox2 <- hinv handles x.`2; + hx2 <- oget ox2; + + if (ox2 = None) { + handles.[chandle] <- (x.`2,D); + hx2 <- chandle; + chandle <- chandle + 1; + } + + if (!mem (dom mi) (x.`1,hx2) || (oget handles.[hx2]).`2 = I) { + y <$ dstate; + if ( hinv handles y.`2 = None) { + y1h <- (y.`1, chandle); + handles.[chandle] <- (y.`2, D); + mi.[(x.`1, hx2)] <- y1h; + m.[y1h] <- (x.`1, hx2); + handles.[hx2] <- ((oget handles.[hx2]).`1, D); + chandle <- chandle + 1; + } else { + bcoll <- true; + } - if (!mem (dom mi) x) { - y <$ dstate; - micol.[x] <- D; - mi.[x] <- y; - mcol.[y] <- D; - m.[y] <- x; - bmitm <- bmitm \/ (mem (dom paths) y.`2); } else { - o' <- oget micol.[x]; - bred <- bred \/ o' = I; - y <- oget mi.[x]; - micol.[x] <- D; - mcol.[y] <- D; + y1h <- oget mi.[(x.`1,hx2)]; + (y2,o') <- oget handles.[y1h.`2]; + bred <- bred \/ o' = I; + handles.[y1h.`2] <- (y2, D); + handles.[hx2] <- (x.`2, D); + y <- (y1h.`1, y2); + } - return oget mi.[x]; + return y; } (** Distinguisher interface **) @@ -439,9 +774,9 @@ print FUNCTIONALITY. proc init(): unit = { } proc f(p : block list): block = { - var (sa,sc) <- (Block.zeros,Capacity.zeros); + var (sa,sc) <- (b0,c0); - if (1 <= size p /\ p <> [Block.zeros]) { + if (1 <= size p /\ p <> [b0]) { while (p <> []) { (sa,sc) <@ S.fg(I,(sa ^ head witness p,sc)); p <- behead p; @@ -454,9 +789,7 @@ print FUNCTIONALITY. proc main(): bool = { var b; - mcol <- map0; m <- map0; - micol <- map0; mi <- map0; bext <- false; bred <- false; @@ -464,12 +797,87 @@ print FUNCTIONALITY. bsuff <- false; bmitm <- false; (* the empty path is initially known by the adversary to lead to capacity 0^c *) - pathscol <- map0.[Capacity.zeros <- D]; - paths <- map0.[Capacity.zeros <- ([<:block>],Block.zeros)]; + handles <- map0.[0 <- (c0, D)]; + paths <- map0.[0 <- ([<:block>],b0,D)]; + chandle <- 1; b <@ D(C,S).distinguish(); return b; } }. + + + + + +module M = { + proc f () : unit = { + var x; + var l:int list; + l = []; + } +}. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + (** Result: the instrumented system and the concrete system are perfectly equivalent **) @@ -619,9 +1027,9 @@ print FUNCTIONALITY. proc init(): unit = { } proc f(p : block list): block = { - var (sa,sc) <- (Block.zeros,Capacity.zeros); + var (sa,sc) <- (b0,c0); - if (1<= size p /\ p <> [Block.zeros]) { + if (1<= size p /\ p <> [b0]) { while (p <> []) { (sa,sc) <@ S.fg(I,(sa ^ head witness p,sc)); p <- behead p; @@ -646,8 +1054,8 @@ print FUNCTIONALITY. bsuff <- false; bmitm <- false; (* the empty path is initially known by the adversary to lead to capacity 0^c *) - pathscol <- map0.[Capacity.zeros <- D]; - paths <- map0.[Capacity.zeros <- ([<:block>],Block.zeros)]; + pathscol <- map0.[c0 <- D]; + paths <- map0.[c0 <- ([<:block>],b0)]; b <@ D(C,S).distinguish(); return b; } @@ -721,6 +1129,133 @@ print FUNCTIONALITY. by wp; call Game1_S_S_eq. by auto; smt. qed. + +(*un jeu avec indirection. +jeu avec indirection -> simulateur. *) + type handle = int. + type hstate = block * handle. + + + local module Game2 = { + + var mcol,micol : (hstate,caller) fmap + var rate, ratei : (hstate,block) fmap + var cap, capi : (hstate,handle) fmap + var handles : (handle,capacity) fmap + var pathscol : (handle,caller) fmap + var paths : (handle,block list * block) fmap + var bext, bred : bool + var bcoll, bsuff, bmitm : bool + + module S = { + (** Inner interface **) + proc fg(o : caller, x : state): state = { + var o', ya, yc, pv, p, v, x2; + + (* Fait chier ici *) +(* o' <- odflt D pathscol.[x.`2]; + bext <- bext \/ (o' <= o); *) + + if (!mem (dom rate) x) { + x2 <- hinv handles x.`2; + (ya,yc) <$ dstate; + if (mem (dom paths) x.`2) { + o' <- oget pathscol.[x.`2]; + pv <- oget paths.[x.`2]; + (p,v) <- pv; + bcoll <- bcoll \/ (mem (dom paths) yc); + bsuff <- bsuff \/ (mem (rng cap) yc); + pathscol.[yc] <- max o o'; + paths.[yc] <- (rcons p (v ^ x.`1),ya); + } + rate.[x] <- ya; + ratei.[(ya,yc)] <- x.`1; + cap.[x] <- yc; + capi.[(ya,yc)] <- x.`2; + mcol.[x] <- o; + micol.[(ya,yc)] <- o; + } else { + o' <- oget mcol.[x]; + mcol.[x] <- max o o'; + ya <- oget rate.[x]; + yc <- oget cap.[x]; + o' <- oget micol.[(ya,yc)]; + micol.[(ya,yc)] <- max o o'; + } + return (oget rate.[x],oget cap.[x]); + } + + proc f(x:state):state = { + var r; + r <@ fg(D,x); + return r; + } + + proc fi(x : state): state = { + var ya, yc; + + if (!mem (dom ratei) x) { + (ya,yc) <$ dstate; + micol.[x] <- D; + ratei.[x] <- ya; + capi.[x] <- yc; + mcol.[(ya,yc)] <- D; + rate.[(ya,yc)] <- x.`1; + cap.[(ya,yc)] <- x.`2; + bmitm <- bmitm \/ (mem (dom paths) yc); + } else { + bred <- bred \/ oget micol.[x] = I; + micol.[x] <- D; + ya <- oget ratei.[x]; + yc <- oget capi.[x]; + mcol.[(ya,yc)] <- D; + } + return (oget ratei.[x],oget capi.[x]); + } + + (** Distinguisher interface **) + proc init() = { } + + } + + module C = { + proc init(): unit = { } + + proc f(p : block list): block = { + var (sa,sc) <- (b0,c0); + + if (1<= size p /\ p <> [b0]) { + while (p <> []) { + (sa,sc) <@ S.fg(I,(sa ^ head witness p,sc)); + p <- behead p; + } + } + return sa; + } + } + + proc main(): bool = { + var b; + + mcol <- map0; + micol <- map0; + rate <- map0; + ratei <- map0; + cap <- map0; + capi <- map0; + bext <- false; + bred <- false; + bcoll <- false; + bsuff <- false; + bmitm <- false; + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + pathscol <- map0.[c0 <- D]; + paths <- map0.[c0 <- ([<:block>],b0)]; + b <@ D(C,S).distinguish(); + return b; + } + }. + end section. (* That Self is unfortunate *) From 0b72e9a706774012b4d5ded897dfb5dff937eaf8 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Wed, 9 Dec 2015 12:00:13 +0100 Subject: [PATCH 063/394] Update proofs w.r.t. the new stdlib. --- sha3/proof/Common.ec | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 90eea5c..295d385 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -84,7 +84,7 @@ proof. rewrite /pad /mkpad size_cat /= size_rcons size_nseq. rewrite max_ler 1:modz_ge0 1:gtr_eqF ?gt0_r // (addrCA 1). rewrite modNz ?gt0_r ?ltr_spaddr ?size_ge0 //. -by rewrite (@subrE (size s + 2)) -(addrA _ 2) /= modzE; ring. +by rewrite -(addrA _ 2) /= modzE; ring. qed. lemma size_pad_dvd_r s: r %| size (pad s). @@ -114,11 +114,10 @@ pose i := index _ _; have ^iE {1}->: i = (-(size s + 2)) %% r. by rewrite index_true_behead_mkpad. pose b := _ = size _; case: b => @/b - {b}. rewrite modNz ?gt0_r ?ltr_spaddr ?size_ge0 //. - rewrite (subrE (size s + 2)) -(addrA _ 2) size_pad. - rewrite (addrC _ r) 2!subrE -!addrA => /addrI; rewrite addrCA /=. - rewrite -subr_eq0 -opprB subrE opprK -divz_eq oppr_eq0. + 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=> _ /=; rewrite iE -size_mkpad /pad size_cat addrK_sub. +move=> _ /=; rewrite iE -size_mkpad /pad size_cat addrK. by rewrite take_cat /= take0 cats0. qed. @@ -212,9 +211,8 @@ op strip (xs : block list) = 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 /= rev_cat rev_nseq size_cat size_nseq max_ler // - subzE - addzA. +move=> xs_ends_not_b0 ge0_n; rewrite /strip /extend /=. +rewrite rev_cat rev_nseq size_cat size_nseq max_ler // -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. @@ -236,16 +234,16 @@ 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 // 2!subrE opprD opprK. - by rewrite addrA addrN /= max_ler. + rewrite size_drop ?subr_ge0 // opprD opprK. + by rewrite addrA /= max_ler. apply/(eq_from_nth b0) => [|j]; rewrite ?size_nseq ?max_ler //. 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 2!subrE. + 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 /= subrE ltr_snaddr // oppr_lt0 ltzS. +by rewrite subr_ge0 -ltzE lt_ji /= ltr_snaddr // oppr_lt0 ltzS. qed. (*------------------------------ Validity ----------------------------- *) From a68c225f8c7eda1c346ab614afaa1aa95fecd8d4 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Wed, 9 Dec 2015 12:07:33 +0100 Subject: [PATCH 064/394] progress --- sha3/proof/old/Squeezeless.ec | 389 ++++++++++++++++++++++++++++++---- 1 file changed, 349 insertions(+), 40 deletions(-) diff --git a/sha3/proof/old/Squeezeless.ec b/sha3/proof/old/Squeezeless.ec index d9bea41..969918c 100644 --- a/sha3/proof/old/Squeezeless.ec +++ b/sha3/proof/old/Squeezeless.ec @@ -82,7 +82,7 @@ section. (** An intermediate game where we don't care about the permutation being a bijection anymore... **) - local module Concrete_F = { + local module CF = { var m, mi: (state,state) fmap module P = { @@ -140,9 +140,9 @@ section. op bound_concrete : real. - local lemma Concrete_Concrete_F &m: + local lemma Concrete_CF &m: Pr[Concrete.main() @ &m: res] <= - Pr[Concrete_F.main() @ &m: res] + bound_concrete. + Pr[CF.main() @ &m: res] + bound_concrete. admitted. (** Result (expected): The distance between Concrete and Concrete_F @@ -211,16 +211,70 @@ section. type ccapacity = capacity * caller. - op hinv (handles:(handle,ccapacity) fmap) (c:capacity) = + type smap = (state , state ) fmap. + type hsmap = (hstate, hstate ) fmap. + type handles = (handle, ccapacity) fmap. + +lemma get_oget (m:('a,'b)fmap) (x:'a) : mem (dom m) x => m.[x] = Some (oget m.[x]). +proof. by rewrite in_dom;case (m.[x]). qed. + +lemma find_set (m:('a,'b) fmap) y x (p:'a -> 'b -> bool): + (forall x, mem (dom m) x => !p x (oget m.[x])) => + find p m.[x <- y] = if p x y then Some x else None. +proof. + cut [[a []->[]] | []-> Hp Hnp]:= findP p (m.[x<-y]);1: rewrite getP dom_set !inE /#. + by case (p x y)=> //; cut := Hp x;rewrite getP dom_set !inE /= oget_some. +qed. + +require import StdOrder. +require import Ring. + + (* Operators and properties of handles *) + op hinv (handles:handles) (c:capacity) = find (fun _ => pred1 c \o fst) handles. - op hinvD (handles:(handle,ccapacity) fmap) (c:capacity) = + op hinvD (handles:handles) (c:capacity) = find (fun _ => pred1 (c,D)) 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. + cut @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := + findP (fun (_ : handle) => pred1 c \o fst) handles. + + by exists (oget handles.[h]).`2;rewrite oget_some get_oget;2:case (oget handles.[h]). + by rewrite -not_def=> Heq; cut := H h;rewrite in_dom Heq. + qed. + + lemma huniq_hinv (handles:handles) (h:handle): + huniq handles => mem (dom handles) h => hinv handles (oget handles.[h]).`1 = Some h. + proof. + move=> Huniq;pose c := (oget handles.[h]).`1. + cut:=Huniq h;cut:=hinvP handles c. + case (hinv _ _)=> /=[Hdiff _| h' +/(_ h')];1:by rewrite in_dom /#. + by move=> [f ->] /(_ (oget handles.[h]) (c,f)) H1 H2;rewrite H1 // get_oget. + qed. + + lemma hinvDP handles c: + if hinvD handles c = None then forall h, handles.[h] <> Some(c,D) + else handles.[oget (hinvD handles c)] = Some(c,D). + proof. + cut @/pred1/=[[h []->[]Hmem ]|[]->H h ]/= := + findP (fun (_ : handle) => pred1 (c,D)) handles. + + by rewrite oget_some get_oget. + by rewrite -not_def=> Heq; cut := H h;rewrite in_dom Heq. + qed. + local module G2 = { - var m, mi : (state , state ) fmap - var mh, mhi : (hstate, hstate) fmap - var handles : (handle, ccapacity) fmap + var m, mi : smap + var mh, mhi : hsmap + var handles : handles var chandle : int var paths : (capacity, block list * block) fmap var bext, bcol : bool @@ -230,27 +284,26 @@ section. proc init(): unit = { } proc f(p : block list): block = { + var sa, sa', sc; var h, i <- 0; - var (sa,sc) <- (b0,c0); - var sa'; - + sa <- b0; if (1 <= size p /\ p <> [b0]) { - while (i < size p - 1 /\ mem (dom m) (sa +^ nth witness p i, sc)) { - (sa, sc) <- oget m.[(sa +^ nth witness p i, sc)]; - (sa', h) <- oget mh.[(sa +^ nth witness p i, h)]; + while (i < size p ) { + if (mem (dom mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; + } else { + sc <$ cdistr; + bcol <- bcol \/ hinv handles sc <> None; + sa' <- RO.f(take (i+1) p); + sa <- sa +^ nth witness p i; + mh.[(sa,h)] <- (sa', chandle); + mhi.[(sa',chandle)] <- (sa, h); + (sa,h) <- (sa',chandle); + handles.[chandle] <- (sc,I); + chandle <- chandle + 1; + } i <- i + 1; } - while (i < size p) { - sc <$ cdistr; - bcol <- bcol \/ hinv handles sc <> None; - sa' <- RO.f(take i p); - mh.[(sa,h)] <- (sa', chandle); - mhi.[(sa',chandle)] <- (sa,h); - (sa,h) <- (sa',chandle); - handles.[chandle] <- (sc,I); - chandle <- chandle + 1; - i <- i + 1; - } sa <- RO.f(p); } return sa; @@ -344,8 +397,6 @@ section. } - - proc main(): bool = { var b; @@ -363,6 +414,277 @@ section. } }. + op build_hpath (mh:hsmap) (bs:block list) = + let step = fun (sah:hstate option ) (b:block) => + if sah = None then None + else + let sah = oget sah in + mh.[(sah.`1 +^ b, sah.`2)] in + foldl step (Some (b0,0)) bs. + + op eqm_handles (handles:handles) (m:smap) (mh:hsmap) = + (forall bc bc', m.[bc] = Some bc' => + exists h h' f f', + handles.[h ] = Some(bc .`2,f ) /\ + handles.[h'] = Some(bc'.`2,f') /\ + mh.[(bc.`1, h)] = Some (bc'.`1,h')) /\ + (forall bh bh', mh.[bh] = Some bh' => + exists c c' f f', + handles.[bh .`2] = Some(c ,f) /\ + handles.[bh'.`2] = Some(c',f') /\ + m.[(bh.`1, c)] = Some (bh'.`1,c')). + + op mh_spec (handles:handles) (m2:smap) (mh:hsmap) (ro:(block list, block)fmap) = + (forall bh bh', mh.[bh] = Some bh' => + exists c f c' f', + handles.[bh .`2]=Some(c,f) /\ + handles.[bh'.`2]=Some(c',f') /\ + if f' = D then m2.[(bh.`1,c)] = Some(bh'.`1,c') /\ f = D + else + exists p v b, + ro.[rcons p b] = Some bh'.`1 /\ + build_hpath mh p = Some(v,bh.`2) /\ + bh.`1 = v +^ b) /\ + (forall p b, mem (dom ro) (rcons p b) <=> + exists v h h', + build_hpath mh p = Some (v,h) /\ + mh.[(v +^ b,h)] = Some (oget ro.[rcons p b], h')). + + op paths_spec (handles:handles) (mh:hsmap) (paths:(capacity,block list * block)fmap) = + forall c p v, paths.[c] = Some(p,v) <=> + exists h, + build_hpath mh p = Some(v,h) /\ + handles.[h] = Some(c,D). + + op incl (m m':('a,'b)fmap) = + forall x, m .[x] <> None => m'.[x] = m.[x]. + + op INV_CF_G2 (handles:handles) (m1 mi1 m2 mi2:smap) (mh2 mhi2:hsmap) (ro:(block list, block) fmap) paths = + (eqm_handles handles m1 mh2 /\ eqm_handles handles mi1 mhi2) /\ + (incl m2 m1 /\ incl mi2 mi1) /\ + (mh_spec handles m2 mh2 ro /\ paths_spec handles mh2 paths /\ huniq handles). + + lemma eqm_dom_mh_m handles m mh hx2 f (x:state): + eqm_handles handles m mh => + handles.[hx2] = Some (x.`2, f) => + mem (dom mh) (x.`1, hx2) => mem (dom m) x. + proof. + move=>[]H1 H2 Hhx2;rewrite !in_dom. + case: (mh.[_]) (H2 (x.`1,hx2))=> //= bh' /(_ bh') [c c' f1 f1']. + by rewrite Hhx2=> /=[][]<<- _;case:(x)=> ??[]_->. + qed. + + axiom D_ll (F <: FUNCTIONALITY{D}) (P <: PRIMITIVE{D}): + islossless P.f => islossless P.fi => islossless F.f => + islossless D(F, P).distinguish. + + clone import Pair.Dprod.Sample as Sample2 with + type t1 <- block, + type t2 <- capacity, + op d1 <- bdistr, + op d2 <- cdistr. + + local equiv CF_G2 : CF.main ~ G2.main : ={glob D} ==> !(G2.bcol \/ G2.bext){2} => ={res}. + proof. + proc. + call (_:(G2.bcol \/ G2.bext), INV_CF_G2 G2.handles{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} G2.mh{2} G2.mhi{2} RO.m{2} G2.paths{2}). + (* lossless D *) + + apply D_ll. + (** proofs for G2.S.f *) + (* equiv CF.P.f G2.S.f *) + + proc;if{1}=>/=. + (* x is not in m{1} so forall h, (x.1,h) is not in mh{2} *) + + rcondt{2} 1. + + move=> &hr;skip=> &hr'[][]_[]<-[]_[][]Hincl Hincli _. + rewrite !in_dom/==>H; by case:(G2.m{hr'}.[x{hr}]) (Hincl x{hr})=> //=;rewrite H. + exists* RO.m{2}, G2.paths{2};elim*=>ro0 paths0. + seq 1 2 : (!G2.bcol{2} /\ (G2.bext = mem (rng G2.handles) (x.`2, I)){2} /\ + ={x,y} /\ + INV_CF_G2 G2.handles{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} G2.mh{2} G2.mhi{2} ro0 paths0 /\ + ! mem (dom CF.m{1}) x{1} /\ + (if mem (dom paths0) x.`2 then + let (p,v) = oget paths0.[x.`2] in + RO.m{2} = ro0.[rcons p (v+^x.`1) <- y.`1] /\ + G2.paths = paths0.[y.`2 <- (rcons p (v +^ x.`1), y.`1)] + else RO.m = ro0 /\ G2.paths = paths0){2}). + + wp 1 1;conseq (_: ={y} /\ + if mem (dom paths0) x{2}.`2 then + let (p0, v0) = oget paths0.[x{2}.`2] in + RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ + G2.paths{2} = paths0.[y{2}.`2 <- (rcons p0 (v0 +^ x{2}.`1), y{2}.`1)] + else RO.m{2} = ro0 /\ G2.paths{2} = paths0);1:smt ml=0. + if{2};2:by auto=>/#. + inline{2} RO.f;rcondt{2} 4. + + move=> &ml;auto=>/= &mr[][]_[][]_[]->[][][]_ Heqm _[]_[][]_ Hro[] Hpath _ HnCFm. + rewrite in_dom;case:(G2.paths{mr}.[_]) (Hpath x{mr}.`2)=>//[[p v]]/(_ p v)/=[h][]Hbu Hh b _. + rewrite -not_def=> /Hro [??h'];rewrite oget_some Hbu => [][]<- <- /=. + rewrite Block.xorwA Block.xorwK Block.xorwC Block.xorw0 -not_def=>/Heqm [c c' f f']. + by rewrite Hh=>[][]<- _[]_ Hm;move:HnCFm;rewrite in_dom;case:(x{mr}) Hm=> ??->. + swap{2} 3-2;swap{2}6-4;wp;conseq (_:y{1} =(rd,y2){2}). + + progress [-split]. rewrite getP_eq oget_some H2/=. + by move:H2;rewrite in_dom;case:(G2.paths{2}.[x{2}.`2]). + transitivity{1} {y <- S.sample();} (true ==> ={y}) (true==>y{1}=(rd,y2){2})=>//;1:by inline*;auto. + transitivity{2} {(rd,y2) <- S.sample2();} (true==>y{1}=(rd,y2){2}) (true==> ={rd,y2})=>//;2:by inline*;auto. + by call sample_sample2;auto=> /=?[??]->. + +print Sample2. + appl + + inline*;auto. + + + +search Pair.Dprod.( * ). +print Pair. + +search mem dom None. +print in_dom. + search "_.[_]" "_.[_<-_]" . + + move: Heqm=> []. +search (+^). + + Hp b _;rewrite -not_def. + move=> /Hro. + +[][][]_[]->Hinv Hmx Hp b _. + cut [H1 H2] : path_RO G2.mh{mr} RO.m{mr}. admit. + rewrite -not_def in_dom=>/H2[h1 h2][]Hh1 Hh2. cut:= H1 _ _ _ _ Hh1 Hh2. + case ((oget G2.paths{mr}.[x{mr}.`2]).`1 = [])=> /=. + + admit. + admit. (* should be more or less ok *) + by auto=> &ml&mr;rewrite NewLogic.negb_or=> [][][][]-> ->;progress. + case (mem (rng G2.handles{2}) (x{2}.`2, I)). + + conseq (_:_ ==> true);[by move=> &ml&mr[][]_[]->_-> | auto]. + seq 0 2: ((!G2.bcol{2} /\ + G2.bext{2} = mem (rng G2.handles{2}) (x{2}.`2, I) /\ + ={x, y} /\ + INV_CF_G2 G2.handles{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} G2.mh{2} + G2.mhi{2} RO.m{2} /\ + !mem (dom CF.m{1}) x{1}) /\ + !mem (rng G2.handles{2}) (x{2}.`2, I) /\ + (G2.handles.[hx2] = Some (x.`2,D)){2}). + + admit. (* should be ok *) + rcondf{2} 1. + + move=> &ml;skip=> &mr[][]_[]_[][->_][]Hinv Hdom[]_ Hx2. + rewrite NewLogic.negb_and;left;move:Hdom;apply NewLogic.contraLR=> /=. + admit. (* foo *) + admit. (* should be ok *) *) + if{2}=> /=. + + admit. (* can be hard *) + auto=> &ml&mr[][][]->[]-> ^Hinv->/=. + admit. + + +search dom hinv. + = hinv G2.handles x.`2){2}). +=>//. + +;progress;smt ml=0. + seq 0 1 : + case ((mem (rng G2.handles) (x.`2, I)){2}). + + + + !mem (dom m) x => + !mem (dom mh) x.1 (hinv x.2) + +hinv x.2 = + + rcondf{2} 5. + + move=> &ml;wp 2;conseq (_:_==>true)=> //= &mr. + rewrite in_rng. +search rng. += to_hstate.[x] + + + +print incl. + +[]+[]_[]+ _. + +<-. +;1:(move=> &hr;skip). + + |]. + +admit. + (* lossless CF.P.f *) + + admit. + (* lossless and do not reset bad G2.S.f *) + + admit. + (** proofs for G2.S.fi *) + (* equiv CF.P.fi G2.S.fi *) + + admit. + (* lossless CF.P.fi *) + + admit. + (* lossless and do not reset bad G2.S.fi *) + + admit. + (** proofs for G2.C.f *) + (* equiv CF.C.f G2.C.f *) + + admit. + (* lossless CF.C.f *) + + admit. + (* lossless and do not reset bad G2.C.f *) + + admit. + (* Init ok *) + + admit. + qed. + + + +ma equiv_ +Concrete_F + + + + + + mh.[RO. + + + (p,v) <- oget paths.[x.`2]; + y1 <- RO.f (rcons p (v +^ x.`1)); + y2 <$ cdistr; + y <- (y1, y2); + paths.[y2] <- (rcons p (v +^ x.`1), y.`1); + + + +inv : + (forall (x:state), m.[x]{1} <> None => m.[x]{1} = mh.[x.`1, oget (hinv handles{2} x.`2)]) + (forall (xh:hstate), m.[xh]{2} <> None => mh.[xh]{2} = mh.[x.`1, (oget (handles.[xh.`2])).`1]) + + (si path alors mh= ...) + (si + + + + +op check_hpath (mh:(hstate, hstate) fmap) (handles:(handle, ccapacity) fmap) (xs:block list) (c:capacity) = + obind (fun (sah:hstate) => if c = sah.`2 then Some sah.`1 else None) + (build_hpath mh xs). + + if sah <> None then + + else None + +hpath + let step = fun (sah:hstate option ) (x:block) => + if sah = None then None + else + let sah = oget sah in + mh.[(sah.`1 +^ x, sah.`2)] in + foldl step (Some (b0,0)) xs. + + + + + + + +fun sah => mh.fun (sah:hstate) (cont=> + if mem + + op INV2 (m mi:(state , state ) fmap) (mh mhi:(hstate, hstate) fmap) (handles:(handle, ccapacity) fmap) chandle = dom mh = rng mhi /\ dom mhi = rng mh /\ (forall xh, mem (dom mh `|` rng mh) xh => mem (dom handles) xh.`2) /\ @@ -370,19 +692,6 @@ op INV2 (m mi:(state , state ) fmap) (mh mhi:(hstate, hstate) fmap) (handles:(ha (forall xh, mem (dom mh) xh => mem (dom m) (xh.`1, (oget handles.[xh.`2]).`1) \/ (oget handles.[xh.`2]).`2 = I) /\ (forall xh, mem (dom mhi) xh => mem (dom mi) (xh.`1, (oget handles.[xh.`2]).`1) \/ (oget handles.[xh.`2]).`2 = I). -lemma get_oget (m:('a,'b)fmap) (x:'a) : mem (dom m) x => m.[x] = Some (oget m.[x]). -proof. by rewrite in_dom;case (m.[x]). qed. - -lemma find_set (m:('a,'b) fmap) y x (p:'a -> 'b -> bool): - (forall x, mem (dom m) x => !p x (oget m.[x])) => - find p m.[x <- y] = if p x y then Some x else None. -proof. - cut [[a []->[]] | []-> Hp Hnp]:= findP p (m.[x<-y]);1: rewrite getP dom_set !inE /#. - by case (p x y)=> //; cut := Hp x;rewrite getP dom_set !inE /= oget_some. -qed. - -require import StdOrder. -require import Ring. lemma hinvD_rng x (handles:(handle, ccapacity) fmap): mem (rng handles) (x, D) => From f4407732341c56f2029aaeeb22c16a51a532bc34 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Wed, 9 Dec 2015 22:06:59 +0100 Subject: [PATCH 065/394] really start the proof --- sha3/proof/old/Squeezeless.ec | 166 +++++++++++++++++++++++++++++++--- 1 file changed, 155 insertions(+), 11 deletions(-) diff --git a/sha3/proof/old/Squeezeless.ec b/sha3/proof/old/Squeezeless.ec index 969918c..2376327 100644 --- a/sha3/proof/old/Squeezeless.ec +++ b/sha3/proof/old/Squeezeless.ec @@ -271,6 +271,20 @@ require import Ring. by rewrite -not_def=> Heq; cut := H h;rewrite in_dom Heq. qed. + lemma huniq_hinvD (handles:handles) c: + huniq handles => mem (rng handles) (c,D) => handles.[oget (hinvD handles c)] = Some(c,D). + proof. + move=> Huniq;rewrite in_rng=> [h]H;case: (hinvD _ _) (Huniq h) (hinvDP handles c)=>//=. + by move=>_/(_ h);rewrite H. + qed. + + lemma huniq_hinvD_h h (handles:handles) c: + huniq handles => handles.[h] = Some (c,D) => hinvD handles c = Some h. + proof. + move=> Huniq;case: (hinvD _ _) (hinvDP handles c)=>/= [H|h'];1: by apply H. + by rewrite oget_some=> /Huniq H/H. + qed. + local module G2 = { var m, mi : smap var mh, mhi : hsmap @@ -414,13 +428,14 @@ require import Ring. } }. - op build_hpath (mh:hsmap) (bs:block list) = - let step = fun (sah:hstate option ) (b:block) => + 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)] in - foldl step (Some (b0,0)) bs. + mh.[(sah.`1 +^ b, sah.`2)]. + + op build_hpath (mh:hsmap) (bs:block list) = + foldl (step_hpath mh) (Some (b0,0)) bs. op eqm_handles (handles:handles) (m:smap) (mh:hsmap) = (forall bc bc', m.[bc] = Some bc' => @@ -459,10 +474,13 @@ require import Ring. op incl (m m':('a,'b)fmap) = forall x, m .[x] <> None => m'.[x] = m.[x]. - op INV_CF_G2 (handles:handles) (m1 mi1 m2 mi2:smap) (mh2 mhi2:hsmap) (ro:(block list, block) fmap) paths = + op handle_spec handles chandle = + huniq handles /\ handles.[0] = Some (c0,D) /\ forall h, mem (dom handles) h => h < chandle. + + op INV_CF_G2 (handles:handles) chandle (m1 mi1 m2 mi2:smap) (mh2 mhi2:hsmap) (ro:(block list, block) fmap) paths = (eqm_handles handles m1 mh2 /\ eqm_handles handles mi1 mhi2) /\ (incl m2 m1 /\ incl mi2 mi1) /\ - (mh_spec handles m2 mh2 ro /\ paths_spec handles mh2 paths /\ huniq handles). + (mh_spec handles m2 mh2 ro /\ paths_spec handles mh2 paths /\ handle_spec handles chandle). lemma eqm_dom_mh_m handles m mh hx2 f (x:state): eqm_handles handles m mh => @@ -484,10 +502,76 @@ require import Ring. op d1 <- bdistr, op d2 <- cdistr. + lemma eqm_up_handles handles chandle m mh x2 : + handle_spec handles chandle => + eqm_handles handles m mh => + eqm_handles handles.[chandle <- (x2, D)] m mh. + proof. + move=> []Hu[Hh0 Hlt][]H1 H2;split=>[bc bc'/H1 [h h' f f'][]Hh[]Hh' Hmh| bh bh'/H2 [c c' f f'][]Hh []Hh' Hm]. + + exists h,h',f,f';rewrite !getP Hmh/=-Hh-Hh'(_:h<>chandle)2:(_:h'<>chandle) //. + + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. + + exists c,c',f,f';rewrite !getP Hm/=-Hh-Hh'(_:bh.`2<>chandle)2:(_:bh'.`2<>chandle) //. + + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. + qed. + + lemma build_hpathP mh p v h: + build_hpath mh p = Some (v, h) => + (p = [] /\ v=b0 /\ h=0) \/ + exists p' b v' h', + p = rcons p' b /\ build_hpath mh p' = Some(v',h') /\ mh.[(v'+^b, h')] = Some(v,h). + proof. + elim/last_ind:p=>@/build_hpath //= p' b _. + rewrite -cats1 foldl_cat /= => H;right;exists p',b. + move:H;rewrite {1}/step_hpath;case (foldl _ _ _)=> //= -[v' h']. + by rewrite oget_some /==>Heq; exists v',h';rewrite -cats1. + qed. + + lemma chandle_ge0 handles chandle : handle_spec handles chandle => 0 < chandle. + proof. by move=>[]_[]Heq Hlt;apply Hlt;rewrite in_dom Heq. qed. + + lemma chandle_0 handles chandle : handle_spec handles chandle => 0 <> chandle. + proof. move=> Hh;apply /IntOrder.ltr_eqF/(chandle_ge0 _ _ Hh). qed. + + (* TODO make sub lemmas for this proof *) + lemma INV_CF_G2_up_handle handles chandle m1 mi1 m2 mi2 mh mhi ro paths x2: + INV_CF_G2 handles chandle m1 mi1 m2 mi2 mh mhi ro paths => + (forall f, ! mem (rng handles) (x2, f)) => + INV_CF_G2 handles.[chandle <- (x2, D)](chandle+1) m1 mi1 m2 mi2 mh mhi ro paths. + proof. + move=>[][]Heqm Heqmi[]Hincl[]Hmh[]Hp Hh Hx2;split. + + by split;apply eqm_up_handles. + split=>//;split;[|split]. + + move:Hmh Hh=>[H1 ?][_[]_ Hlt];split=>// bh bh' /H1 [c f c' f'][]Hh[]Hh' Hif. + exists c,f,c',f';rewrite Hif-Hh-Hh'!getP(_:bh.`2<>chandle)2:(_:bh'.`2<>chandle) //. + + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. + + move=> c p v;rewrite Hp;apply NewLogic.exists_iff=> h/=;split=> -[^Hbu->] /=; + rewrite getP. + + move:Hh=>[]_[]_/(_ h)Hlt Hh;rewrite (_:h<>chandle)//. + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. + rewrite (_:h<>chandle)//. + cut [[]_[]_->|[p' b v' h'[]_[]_ Hh']]:= build_hpathP _ _ _ _ Hbu. + + by rewrite (chandle_0 _ _ Hh). + move:Hh=>[]_[]_/(_ h)Hlt;apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom. + by cut [/(_ _ _ Hh')[????][]_[]->]:= Hmh. + cut []Hu[]Hh0 Hlt:= Hh;split;[ | split]. + + move=> h1 h2 [c1 f1] [c2 f2];rewrite !getP. + case (h1=chandle)=>[->/=[]->> ->|_]; (case (h2=chandle)=>[->//=|_]). + + by move=>Heq ->>;move:(Hx2 f2);rewrite in_rng NewLogic.negb_exists=>/=/(_ h2); + rewrite Heq. + + by move=>Heq[]->> <<- ->>;move:(Hx2 f1);rewrite in_rng NewLogic.negb_exists=>/=/(_ h1); + rewrite Heq. + by apply Hu. + + by rewrite getP (chandle_0 _ _ Hh). + move=>h;rewrite dom_set !inE /#. + qed. + local equiv CF_G2 : CF.main ~ G2.main : ={glob D} ==> !(G2.bcol \/ G2.bext){2} => ={res}. proof. proc. - call (_:(G2.bcol \/ G2.bext), INV_CF_G2 G2.handles{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} G2.mh{2} G2.mhi{2} RO.m{2} G2.paths{2}). + call (_:(G2.bcol \/ G2.bext), INV_CF_G2 G2.handles{2} G2.chandle{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} G2.mh{2} G2.mhi{2} RO.m{2} G2.paths{2}). (* lossless D *) + apply D_ll. (** proofs for G2.S.f *) @@ -500,7 +584,7 @@ require import Ring. exists* RO.m{2}, G2.paths{2};elim*=>ro0 paths0. seq 1 2 : (!G2.bcol{2} /\ (G2.bext = mem (rng G2.handles) (x.`2, I)){2} /\ ={x,y} /\ - INV_CF_G2 G2.handles{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} G2.mh{2} G2.mhi{2} ro0 paths0 /\ + INV_CF_G2 G2.handles{2} G2.chandle{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} G2.mh{2} G2.mhi{2} ro0 paths0 /\ ! mem (dom CF.m{1}) x{1} /\ (if mem (dom paths0) x.`2 then let (p,v) = oget paths0.[x.`2] in @@ -515,18 +599,78 @@ require import Ring. else RO.m{2} = ro0 /\ G2.paths{2} = paths0);1:smt ml=0. if{2};2:by auto=>/#. inline{2} RO.f;rcondt{2} 4. - + move=> &ml;auto=>/= &mr[][]_[][]_[]->[][][]_ Heqm _[]_[][]_ Hro[] Hpath _ HnCFm. + + move=> &ml;auto=>/= &mr[][]_[][]_[]->[][][]_ Heqm _[]_[][]_ Hro[] Hpath _ HnCFm. rewrite in_dom;case:(G2.paths{mr}.[_]) (Hpath x{mr}.`2)=>//[[p v]]/(_ p v)/=[h][]Hbu Hh b _. rewrite -not_def=> /Hro [??h'];rewrite oget_some Hbu => [][]<- <- /=. rewrite Block.xorwA Block.xorwK Block.xorwC Block.xorw0 -not_def=>/Heqm [c c' f f']. by rewrite Hh=>[][]<- _[]_ Hm;move:HnCFm;rewrite in_dom;case:(x{mr}) Hm=> ??->. swap{2} 3-2;swap{2}6-4;wp;conseq (_:y{1} =(rd,y2){2}). - + progress [-split]. rewrite getP_eq oget_some H2/=. - by move:H2;rewrite in_dom;case:(G2.paths{2}.[x{2}.`2]). + + progress [-split];rewrite getP_eq oget_some H2/=. + by move:H2;rewrite in_dom;case:(G2.paths{2}.[_]). transitivity{1} {y <- S.sample();} (true ==> ={y}) (true==>y{1}=(rd,y2){2})=>//;1:by inline*;auto. transitivity{2} {(rd,y2) <- S.sample2();} (true==>y{1}=(rd,y2){2}) (true==> ={rd,y2})=>//;2:by inline*;auto. by call sample_sample2;auto=> /=?[??]->. + case (mem (rng G2.handles{2}) (x{2}.`2, I)). + + conseq (_:true);[by move=> ??[][]_[]->_->|auto]. + conseq (_: !G2.bcol{2} => + oget CF.m{1}.[x{1}] = y{2} /\ + INV_CF_G2 G2.handles{2} G2.chandle{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} G2.mh{2} G2.mhi{2} RO.m{2} G2.paths{2}). + + by move=> ??[][]_[]->[][]-> _ _ ->. + seq 0 2: ((!G2.bcol{2} /\ ={x, y} /\ + INV_CF_G2 G2.handles{2} G2.chandle{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} + G2.mh{2} G2.mhi{2} ro0 paths0 /\ + ! mem (dom CF.m{1}) x{1} /\ + if mem (dom paths0) x{2}.`2 then + let (p0, v0) = oget paths0.[x{2}.`2] in + RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ + G2.paths{2} = paths0.[y{2}.`2 <- (rcons p0 (v0 +^ x{2}.`1), y{2}.`1)] + else RO.m{2} = ro0 /\ G2.paths{2} = paths0) /\ + !mem (rng G2.handles{2}) (x{2}.`2, I) /\ + (G2.handles.[hx2]=Some(x.`2,D)){2}). + + auto=> &ml&mr[][]->[]_[][]-> ->[]Hinv []-> -> ^Hrng-> /=. + case (mem (rng G2.handles{mr}) (x{mr}.`2, Top.D))=> Hmem /=. + + by split=>//;apply /huniq_hinvD=>//;move:Hinv;rewrite /INV_CF_G2/handle_spec. + rewrite -anda_and;split=> [ | {Hinv}Hinv]. + + by apply INV_CF_G2_up_handle=>//[[]]. + rewrite rng_set (huniq_hinvD_h G2.chandle{mr}) ?getP//. + + by move:Hinv;rewrite /INV_CF_G2/handle_spec. + by rewrite oget_some /=!inE/=;move:Hrng;apply NewLogic.contraLR=>/=;apply rng_rem_le. + rcondf{2} 1. + + move=> &ml;skip=> &mr[][]_[][]-> _ []Hinv[]Hndom _[]_ Hh;rewrite -not_def in_dom=>[]. + move:Hinv=>[][][]_ /(_ (x{mr}.`1, hx2{mr}));case (G2.mh{mr}.[_])=>// bh' /(_ bh') [c c' f f'] /=. + by rewrite Hh/= =>[][]<- _ []_ H;case: (x{mr}) H Hndom => [x1 x2];rewrite in_dom=>->. + auto. +(* Stopped here *) + admit. + + +/=. +case ( + + + + _. + rewrite in_dom;case (paths0.[x{mr}.`2])=> //= [[p v]]. + rewrite oget_some /=. + case + +search rng rem. + + rewrite getP. +search hinvD. + move=> + + + + search hinvD. +search hinv. + G2.mh{2} G2.mhi{2} RO.m{2} G2.paths{2} + seq + wp=> //. +progress [-split]. by move:H4;rewrite H3. + progress. + seq print Sample2. appl + inline*;auto. From ec3ad4d8c128b14b0e70bbfaa5e14d751439b698 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 9 Dec 2015 11:00:46 -0500 Subject: [PATCH 066/394] Fixed definition of unpad. Revised padK is done. unpadK will be done later today -- please leave alone for the moment. --- sha3/proof/Common.ec | 23 +++++++++++++++++------ 1 file changed, 17 insertions(+), 6 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 295d385..93f8891 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -46,8 +46,6 @@ rename (* ------------------------- Padding/Unpadding ------------------------ *) -(* What about this (and the comment applies to other functions): *) - op chunk (bs : bool list) = BitChunking.chunk r bs. op mkpad (n : int) = @@ -59,7 +57,9 @@ op pad (s : bool list) = 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 Some (take (size s - (i+2)) s). + if i + 1 = size s then None + else let n = size s - (i + 2) in + if i = (-(n+2)) %% r 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. @@ -109,20 +109,29 @@ proof. by apply/BitChunking.chunkK/gt0_r. qed. lemma padK : pcancel pad unpad. proof. move=> s @/unpad; rewrite last_pad /= rev_cat rev_mkpad. -pose i := index _ _; have ^iE {1}->: i = (-(size s + 2)) %% r. +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}. +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=> _ /=; rewrite iE -size_mkpad /pad size_cat addrK. +move=> x {x}. +cut -> : size (pad s) - (i + 2) + 2 = size (pad s) - i by algebra. +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=> x {x} /=; rewrite iE -size_mkpad /pad size_cat addrK. by rewrite take_cat /= take0 cats0. qed. lemma unpadK : ocancel unpad pad. proof. +(* +proof in progress -- Alley to fill in shortly + move=> s @/unpad; case: (last false s) => //=. elim/last_ind: s=> //= s b ih {ih}; rewrite last_rcons => hb. rewrite rev_rcons /= size_rcons -(inj_eq _ (addIr (-1))) /= ?addrK. @@ -138,6 +147,8 @@ rewrite -cats1 drop_cat {1}/j ltr_subl_addr ler_lt_add //=. by rewrite ltzE /= ler_addr // /i index_ge0. rewrite /mkpad -cats1 -cat_cons hb; congr. admit. (* missing results on drop/take *) +*) +admit. qed. lemma chunk_padK : pcancel (chunk \o pad) (unpad \o flatten). From a6cfb32366c52efa9b846383d82115b0b90d0098 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Wed, 9 Dec 2015 22:35:36 +0100 Subject: [PATCH 067/394] cleaning + split lemma. --- sha3/proof/old/Squeezeless.ec | 234 +++++++++++----------------------- 1 file changed, 72 insertions(+), 162 deletions(-) diff --git a/sha3/proof/old/Squeezeless.ec b/sha3/proof/old/Squeezeless.ec index 2376327..33743e4 100644 --- a/sha3/proof/old/Squeezeless.ec +++ b/sha3/proof/old/Squeezeless.ec @@ -474,13 +474,13 @@ require import Ring. op incl (m m':('a,'b)fmap) = forall x, m .[x] <> None => m'.[x] = m.[x]. - op handle_spec handles chandle = + op handles_spec handles chandle = huniq handles /\ handles.[0] = Some (c0,D) /\ forall h, mem (dom handles) h => h < chandle. op INV_CF_G2 (handles:handles) chandle (m1 mi1 m2 mi2:smap) (mh2 mhi2:hsmap) (ro:(block list, block) fmap) paths = (eqm_handles handles m1 mh2 /\ eqm_handles handles mi1 mhi2) /\ (incl m2 m1 /\ incl mi2 mi1) /\ - (mh_spec handles m2 mh2 ro /\ paths_spec handles mh2 paths /\ handle_spec handles chandle). + (mh_spec handles m2 mh2 ro /\ paths_spec handles mh2 paths /\ handles_spec handles chandle). lemma eqm_dom_mh_m handles m mh hx2 f (x:state): eqm_handles handles m mh => @@ -502,20 +502,6 @@ require import Ring. op d1 <- bdistr, op d2 <- cdistr. - lemma eqm_up_handles handles chandle m mh x2 : - handle_spec handles chandle => - eqm_handles handles m mh => - eqm_handles handles.[chandle <- (x2, D)] m mh. - proof. - move=> []Hu[Hh0 Hlt][]H1 H2;split=>[bc bc'/H1 [h h' f f'][]Hh[]Hh' Hmh| bh bh'/H2 [c c' f f'][]Hh []Hh' Hm]. - + exists h,h',f,f';rewrite !getP Hmh/=-Hh-Hh'(_:h<>chandle)2:(_:h'<>chandle) //. - + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. - by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. - + exists c,c',f,f';rewrite !getP Hm/=-Hh-Hh'(_:bh.`2<>chandle)2:(_:bh'.`2<>chandle) //. - + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. - by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. - qed. - lemma build_hpathP mh p v h: build_hpath mh p = Some (v, h) => (p = [] /\ v=b0 /\ h=0) \/ @@ -528,35 +514,62 @@ require import Ring. by rewrite oget_some /==>Heq; exists v',h';rewrite -cats1. qed. - lemma chandle_ge0 handles chandle : handle_spec handles chandle => 0 < chandle. + lemma chandle_ge0 handles chandle : handles_spec handles chandle => 0 < chandle. proof. by move=>[]_[]Heq Hlt;apply Hlt;rewrite in_dom Heq. qed. - lemma chandle_0 handles chandle : handle_spec handles chandle => 0 <> chandle. + lemma chandle_0 handles chandle : handles_spec handles chandle => 0 <> chandle. proof. move=> Hh;apply /IntOrder.ltr_eqF/(chandle_ge0 _ _ Hh). qed. - (* TODO make sub lemmas for this proof *) - lemma INV_CF_G2_up_handle handles chandle m1 mi1 m2 mi2 mh mhi ro paths x2: - INV_CF_G2 handles chandle m1 mi1 m2 mi2 mh mhi ro paths => - (forall f, ! mem (rng handles) (x2, f)) => - INV_CF_G2 handles.[chandle <- (x2, D)](chandle+1) m1 mi1 m2 mi2 mh mhi ro paths. + lemma eqm_up_handles handles chandle m mh x2 : + handles_spec handles chandle => + eqm_handles handles m mh => + eqm_handles handles.[chandle <- (x2, D)] m mh. proof. - move=>[][]Heqm Heqmi[]Hincl[]Hmh[]Hp Hh Hx2;split. - + by split;apply eqm_up_handles. - split=>//;split;[|split]. - + move:Hmh Hh=>[H1 ?][_[]_ Hlt];split=>// bh bh' /H1 [c f c' f'][]Hh[]Hh' Hif. - exists c,f,c',f';rewrite Hif-Hh-Hh'!getP(_:bh.`2<>chandle)2:(_:bh'.`2<>chandle) //. + move=> []Hu[Hh0 Hlt][]H1 H2;split=> + [bc bc'/H1 [h h' f f'][]Hh[]Hh' Hmh| bh bh'/H2 [c c' f f'][]Hh []Hh' Hm]. + + exists h,h',f,f';rewrite !getP Hmh/=-Hh-Hh'(_:h<>chandle)2:(_:h'<>chandle) //. + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. - + move=> c p v;rewrite Hp;apply NewLogic.exists_iff=> h/=;split=> -[^Hbu->] /=; + exists c,c',f,f';rewrite !getP Hm/=-Hh-Hh'(_:bh.`2<>chandle)2:(_:bh'.`2<>chandle) //. + + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. + qed. + + lemma mh_up_handles handles chandle m2 mh ro cf: + handles_spec handles chandle => + mh_spec handles m2 mh ro => + mh_spec handles.[chandle <- cf] m2 mh ro. + proof. + move=> Hh Hmh. + move:Hmh Hh=>[H1 ?][_[]_ Hlt];split=>// bh bh' /H1 [c f c' f'][]Hh[]Hh' Hif. + exists c,f,c',f';rewrite Hif-Hh-Hh'!getP(_:bh.`2<>chandle)2:(_:bh'.`2<>chandle) //. + + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. + qed. + + lemma paths_up_handles m2 ro handles mh paths cf chandle: + mh_spec handles m2 mh ro => + handles_spec handles chandle => + paths_spec handles mh paths => + paths_spec handles.[chandle <- cf] mh paths. + proof. + move=> Hmh Hh Hp c p v;rewrite Hp;apply NewLogic.exists_iff=> h/=;split=> -[^Hbu->] /=; rewrite getP. - + move:Hh=>[]_[]_/(_ h)Hlt Hh;rewrite (_:h<>chandle)//. - by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. - rewrite (_:h<>chandle)//. - cut [[]_[]_->|[p' b v' h'[]_[]_ Hh']]:= build_hpathP _ _ _ _ Hbu. - + by rewrite (chandle_0 _ _ Hh). - move:Hh=>[]_[]_/(_ h)Hlt;apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom. - by cut [/(_ _ _ Hh')[????][]_[]->]:= Hmh. - cut []Hu[]Hh0 Hlt:= Hh;split;[ | split]. + + move:Hh=>[]_[]_/(_ h)Hlt Hh;rewrite (_:h<>chandle)//. + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. + rewrite (_:h<>chandle)//. + cut [[]_[]_->|[p' b v' h'[]_[]_ Hh']]:= build_hpathP _ _ _ _ Hbu. + + by rewrite (chandle_0 _ _ Hh). + move:Hh=>[]_[]_/(_ h)Hlt;apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom. + by cut [/(_ _ _ Hh')[????][]_[]->]:= Hmh. + qed. + + lemma handles_up_handles handles chandle x2 f': + (forall (f : caller), ! mem (rng handles) (x2, f)) => + handles_spec handles chandle => + handles_spec handles.[chandle <- (x2, f')] (chandle + 1). + proof. + move=> Hx2^Hh[]Hu[]Hh0 Hlt;split;[ | split]. + move=> h1 h2 [c1 f1] [c2 f2];rewrite !getP. case (h1=chandle)=>[->/=[]->> ->|_]; (case (h2=chandle)=>[->//=|_]). + by move=>Heq ->>;move:(Hx2 f2);rewrite in_rng NewLogic.negb_exists=>/=/(_ h2); @@ -568,6 +581,19 @@ require import Ring. move=>h;rewrite dom_set !inE /#. qed. + lemma INV_CF_G2_up_handles handles chandle m1 mi1 m2 mi2 mh mhi ro paths x2: + INV_CF_G2 handles chandle m1 mi1 m2 mi2 mh mhi ro paths => + (forall f, ! mem (rng handles) (x2, f)) => + INV_CF_G2 handles.[chandle <- (x2, D)](chandle+1) m1 mi1 m2 mi2 mh mhi ro paths. + proof. + move=>[][]Heqm Heqmi[]Hincl[]Hmh[]Hp Hh Hx2;split. + + by split;apply eqm_up_handles. + split=>//;split;[|split]. + + by apply mh_up_handles. + + by apply (paths_up_handles m2 ro). + by apply handles_up_handles. + qed. + local equiv CF_G2 : CF.main ~ G2.main : ={glob D} ==> !(G2.bcol \/ G2.bext){2} => ={res}. proof. proc. @@ -629,11 +655,11 @@ require import Ring. (G2.handles.[hx2]=Some(x.`2,D)){2}). + auto=> &ml&mr[][]->[]_[][]-> ->[]Hinv []-> -> ^Hrng-> /=. case (mem (rng G2.handles{mr}) (x{mr}.`2, Top.D))=> Hmem /=. - + by split=>//;apply /huniq_hinvD=>//;move:Hinv;rewrite /INV_CF_G2/handle_spec. + + by split=>//;apply /huniq_hinvD=>//;move:Hinv;rewrite /INV_CF_G2/handles_spec. rewrite -anda_and;split=> [ | {Hinv}Hinv]. - + by apply INV_CF_G2_up_handle=>//[[]]. + + by apply INV_CF_G2_up_handles=>//[[]]. rewrite rng_set (huniq_hinvD_h G2.chandle{mr}) ?getP//. - + by move:Hinv;rewrite /INV_CF_G2/handle_spec. + + by move:Hinv;rewrite /INV_CF_G2/handles_spec. by rewrite oget_some /=!inE/=;move:Hrng;apply NewLogic.contraLR=>/=;apply rng_rem_le. rcondf{2} 1. + move=> &ml;skip=> &mr[][]_[][]-> _ []Hinv[]Hndom _[]_ Hh;rewrite -not_def in_dom=>[]. @@ -642,115 +668,7 @@ require import Ring. auto. (* Stopped here *) admit. - - -/=. -case ( - - - - _. - rewrite in_dom;case (paths0.[x{mr}.`2])=> //= [[p v]]. - rewrite oget_some /=. - case - -search rng rem. - - rewrite getP. -search hinvD. - move=> - - - - search hinvD. -search hinv. - - G2.mh{2} G2.mhi{2} RO.m{2} G2.paths{2} - seq - wp=> //. -progress [-split]. by move:H4;rewrite H3. - progress. - seq -print Sample2. - appl - + inline*;auto. - - - -search Pair.Dprod.( * ). -print Pair. - -search mem dom None. -print in_dom. - search "_.[_]" "_.[_<-_]" . - - move: Heqm=> []. -search (+^). - - Hp b _;rewrite -not_def. - move=> /Hro. - -[][][]_[]->Hinv Hmx Hp b _. - cut [H1 H2] : path_RO G2.mh{mr} RO.m{mr}. admit. - rewrite -not_def in_dom=>/H2[h1 h2][]Hh1 Hh2. cut:= H1 _ _ _ _ Hh1 Hh2. - case ((oget G2.paths{mr}.[x{mr}.`2]).`1 = [])=> /=. - + admit. - admit. (* should be more or less ok *) - by auto=> &ml&mr;rewrite NewLogic.negb_or=> [][][][]-> ->;progress. - case (mem (rng G2.handles{2}) (x{2}.`2, I)). - + conseq (_:_ ==> true);[by move=> &ml&mr[][]_[]->_-> | auto]. - seq 0 2: ((!G2.bcol{2} /\ - G2.bext{2} = mem (rng G2.handles{2}) (x{2}.`2, I) /\ - ={x, y} /\ - INV_CF_G2 G2.handles{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} G2.mh{2} - G2.mhi{2} RO.m{2} /\ - !mem (dom CF.m{1}) x{1}) /\ - !mem (rng G2.handles{2}) (x{2}.`2, I) /\ - (G2.handles.[hx2] = Some (x.`2,D)){2}). - + admit. (* should be ok *) - rcondf{2} 1. - + move=> &ml;skip=> &mr[][]_[]_[][->_][]Hinv Hdom[]_ Hx2. - rewrite NewLogic.negb_and;left;move:Hdom;apply NewLogic.contraLR=> /=. - admit. (* foo *) - admit. (* should be ok *) *) - if{2}=> /=. - + admit. (* can be hard *) - auto=> &ml&mr[][][]->[]-> ^Hinv->/=. admit. - - -search dom hinv. - = hinv G2.handles x.`2){2}). -=>//. - -;progress;smt ml=0. - seq 0 1 : - case ((mem (rng G2.handles) (x.`2, I)){2}). - + - - !mem (dom m) x => - !mem (dom mh) x.1 (hinv x.2) - -hinv x.2 = - - rcondf{2} 5. - + move=> &ml;wp 2;conseq (_:_==>true)=> //= &mr. - rewrite in_rng. -search rng. -= to_hstate.[x] - - - -print incl. - -[]+[]_[]+ _. - -<-. -;1:(move=> &hr;skip). - - |]. - -admit. (* lossless CF.P.f *) + admit. (* lossless and do not reset bad G2.S.f *) @@ -775,30 +693,22 @@ admit. -ma equiv_ -Concrete_F - - mh.[RO. - (p,v) <- oget paths.[x.`2]; - y1 <- RO.f (rcons p (v +^ x.`1)); - y2 <$ cdistr; - y <- (y1, y2); - paths.[y2] <- (rcons p (v +^ x.`1), y.`1); -inv : - (forall (x:state), m.[x]{1} <> None => m.[x]{1} = mh.[x.`1, oget (hinv handles{2} x.`2)]) - (forall (xh:hstate), m.[xh]{2} <> None => mh.[xh]{2} = mh.[x.`1, (oget (handles.[xh.`2])).`1]) - (si path alors mh= ...) - (si + + + + + + From 866be8d88e7105f8af39fa1b84b0e8adf98c34be Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 9 Dec 2015 18:39:46 -0500 Subject: [PATCH 068/394] Full proof of unpadK. --- sha3/proof/Common.ec | 75 ++++++++++++++++++++++++++++++++++---------- 1 file changed, 59 insertions(+), 16 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 93f8891..6b3d84c 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -118,37 +118,80 @@ pose b := _ = size _; case b => @/b - {b}. 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=> x {x}. -cut -> : size (pad s) - (i + 2) + 2 = size (pad s) - i by algebra. +move=> sz {sz}. +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=> x {x} /=; rewrite iE -size_mkpad /pad size_cat addrK. +move=> sz {sz} /=; rewrite iE -size_mkpad /pad size_cat addrK. by rewrite take_cat /= take0 cats0. qed. lemma unpadK : ocancel unpad pad. proof. -(* -proof in progress -- Alley to fill in shortly - -move=> s @/unpad; case: (last false s) => //=. +move=> s @/unpad; case: (last false s)=> //=. elim/last_ind: s=> //= s b ih {ih}; rewrite last_rcons => hb. rewrite rev_rcons /= size_rcons -(inj_eq _ (addIr (-1))) /= ?addrK. -pose i := index _ _; case: (i = size s) => //=. -move=> ne_is @/pad; pose j := _ - (i+2); apply/eq_sym. +pose i := index _ _; case: (i = size s)=> // ne_is @/pad. +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 //]. +have -> : size s + 1 - (i + 2) + 2 = size s - i + 1 by ring. +have -> : size s + 1 - (i + 2) = size s - i - 1 by ring. +case: (i = (-(size s - i + 1)) %% r) => [iE | //]. +pose j := size s - i - 1; apply/eq_sym. rewrite -{1}(cat_take_drop j (rcons s b)) eqseq_cat //=. rewrite size_take; first rewrite /j subr_ge0. - (have ->: 2=1+1 by done); rewrite addrA -ltzE ltr_add2r. - by rewrite ltr_neqAle ne_is /= /i -size_rev index_size. + rewrite - (ler_add2r i) - addrA addNr /= lez_add1r //. rewrite {2}/j size_rcons ltr_subl_addr ?ltr_spaddr //=. - by rewrite /i index_ge0. + rewrite ler_add2l - ler_oppl (ler_trans 0) // lerN10. rewrite -cats1 drop_cat {1}/j ltr_subl_addr ler_lt_add //=. - by rewrite ltzE /= ler_addr // /i index_ge0. + rewrite ltr_oppl (ltr_le_trans 0) 1:ltrN10 //. rewrite /mkpad -cats1 -cat_cons hb; congr. -admit. (* missing results on drop/take *) -*) -admit. +have [ge0_j le_siz_j] : 0 <= j < size s. + rewrite /j; split=> [| _]. + rewrite - (ler_add2r 1) /= - addrA addNr /= - (ler_add2r i) + - addrA addNr /= lez_add1r //. + rewrite - addrA - opprD - (ltr_add2r (i + 1)) - addrA addrN /= + ltz_addl (ler_lt_trans i) // ltz_addl ltr01. +rewrite (drop_nth false) //. +have -> : nth false s j = true + by rewrite /j - addrA - opprD - nth_rev // nth_index // + - index_mem size_rev //. +congr. +have size_drop : size (drop (j + 1) s) = (-(j + 2)) %% r. + rewrite size_drop; 1:rewrite (ler_trans j) //ler_addl ler01. + rewrite max_ler /j. + have -> // : size s - (size s - i - 1 + 1) = i by ring. + have -> : size s - (size s - i - 1 + 1) = i by ring. + have -> : -(size s - i - 1 + 2) = -(size s - i + 1). + ring. rewrite - iE //. +apply (eq_from_nth false). +rewrite size_drop size_nseq. +rewrite max_ler // 1:modz_ge0 gtr_eqF ?gt0_r //. +move=> k [ge0k lt_size_drop_k]; rewrite size_drop in lt_size_drop_k. +rewrite nth_nseq; first split=> // _; rewrite - size_drop //. +rewrite nth_drop // 1:(ler_trans j) // 1:lez_addl 1:ler01. +rewrite /j. +have -> : size s - i - 1 + 1 + k = size s - ((i - k - 1) + 1) by ring. +have i_min_k_min1_rng {size_drop} : 0 <= i - k - 1 < i. + rewrite iE; pose sz := (-(size s - i + 1)) %% r. + split=> [| _]. + rewrite - (ler_add2r (k + 1)) /=. + have -> @/sz : sz - k - 1 + (k + 1) = sz by ring. + have -> : -(size s - i + 1) = -(size s - i - 1 + 2) by ring. + rewrite - /j addrC lez_add1r //. + rewrite -(ltr_add2r (k + 1)). + have -> : sz - k - 1 + (k + 1) = sz by algebra. + rewrite ltr_addl ltzS //. +rewrite - nth_rev //. + split=> [| _ //]. + elim i_min_k_min1_rng=> //. + rewrite (ltr_trans i) //; elim i_min_k_min1_rng=> //. +have -> : + (nth false (rev s) (i - k - 1) = false) = + (nth false (rev s) (i - k - 1) <> true) by smt ml=0. +rewrite (before_index false) //. qed. lemma chunk_padK : pcancel (chunk \o pad) (unpad \o flatten). From 6072b26639508b876c8e03fce1c44474f5feb5d8 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 10 Dec 2015 09:45:23 +0100 Subject: [PATCH 069/394] Split proof into different file such that we can limit conflict --- sha3/proof/Indifferentiability.eca | 13 +- sha3/proof/old/ConcreteF.eca | 77 +++++ sha3/proof/old/G1.eca | 405 ++++++++++++++++++++++ sha3/proof/old/SLCommon.ec | 208 +++++++++++ sha3/proof/old/Squeezeless.ec | 539 ++++------------------------- 5 files changed, 770 insertions(+), 472 deletions(-) create mode 100644 sha3/proof/old/ConcreteF.eca create mode 100644 sha3/proof/old/G1.eca create mode 100644 sha3/proof/old/SLCommon.ec diff --git a/sha3/proof/Indifferentiability.eca b/sha3/proof/Indifferentiability.eca index 623ca31..9a3a37a 100644 --- a/sha3/proof/Indifferentiability.eca +++ b/sha3/proof/Indifferentiability.eca @@ -10,11 +10,20 @@ module type PRIMITIVE = { proc fi(x : p): p }. +module type DPRIMITIVE = { + proc f(x : p): p + proc fi(x : p): p +}. + 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 @@ -32,8 +41,8 @@ module type SIMULATOR (F : FUNCTIONALITY) = { proc fi(x : p) : p { F.f } }. -module type DISTINGUISHER (F : FUNCTIONALITY, P : PRIMITIVE) = { - proc distinguish(): bool { P.f P.fi F.f } +module type DISTINGUISHER (F : DFUNCTIONALITY, P : DPRIMITIVE) = { + proc distinguish(): bool }. module Indif (F : FUNCTIONALITY, P : PRIMITIVE, D : DISTINGUISHER) = { diff --git a/sha3/proof/old/ConcreteF.eca b/sha3/proof/old/ConcreteF.eca new file mode 100644 index 0000000..548b2a3 --- /dev/null +++ b/sha3/proof/old/ConcreteF.eca @@ -0,0 +1,77 @@ +require import Pred Fun Option Pair Int Real StdOrder Ring. +require import List FSet NewFMap Utils Common SLCommon. +(*...*) import Dprod Dexcepted Capacity IntOrder. + +module Concrete(D:DISTINGUISHER) = RealIndif(SqueezelessSponge,Perm,D). +(** An intermediate game where we don't care about the permutation + being a bijection anymore... **) +module CF(D:DISTINGUISHER) = { + var m, mi: (state,state) fmap + + module P = { + proc init(): unit = { } + + proc f(x : state): state = { + var y; + + if (!mem (dom m) x) { + y <$ dstate; + m.[x] <- y; + mi.[y] <- x; + } + return oget m.[x]; + } + + proc fi(x : state): state = { + var y; + + if (!mem (dom mi) x) { + y <$ dstate; + mi.[x] <- y; + m.[y] <- x; + } + return oget mi.[x]; + } + + } + + module C = { + proc init(): unit = { } + + proc f(p : block list): block = { + var (sa,sc) <- (b0,c0); + + if (1 <= size p /\ p <> [b0]) { + while (p <> []) { (* Absorption *) + (sa,sc) <@ P.f((sa +^ head witness p,sc)); + p <- behead p; + } + } + return sa; (* Squeezing phase (non-iterated) *) + } + } + + proc main(): bool = { + var b; + + m <- map0; + mi <- map0; + b <@ D(C,P).distinguish(); + return b; + } + }. + +section PROOF. + + declare module D : DISTINGUISHER {Perm, RO, CF}. + + op bound_concrete : real. + + lemma Concrete_CF &m: + Pr[Concrete(D).main() @ &m: res] <= + Pr[CF(D).main() @ &m: res] + bound_concrete. + admitted. + +end section PROOF. + + diff --git a/sha3/proof/old/G1.eca b/sha3/proof/old/G1.eca new file mode 100644 index 0000000..d3dcd1f --- /dev/null +++ b/sha3/proof/old/G1.eca @@ -0,0 +1,405 @@ +require import Pred Fun Option Pair Int Real StdOrder Ring. +require import List FSet NewFMap Utils Common SLCommon. +(*...*) import Dprod Dexcepted Capacity IntOrder. + +require ConcreteF. + +module G1(D:DISTINGUISHER) = { + var m, mi : smap + var mh, mhi : hsmap + var handles : handles + var chandle : int + var paths : (capacity, block list * block) fmap + var bext, bcol : bool + + + module C = { + proc init(): unit = { } + + proc f(p : block list): block = { + var sa, sa', sc; + var h, i <- 0; + sa <- b0; + if (1 <= size p /\ p <> [b0]) { + while (i < size p ) { + if (mem (dom mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; + } else { + sc <$ cdistr; + bcol <- bcol \/ hinv handles sc <> None; + sa' <- RO.f(take (i+1) p); + sa <- sa +^ nth witness p i; + mh.[(sa,h)] <- (sa', chandle); + mhi.[(sa',chandle)] <- (sa, h); + (sa,h) <- (sa',chandle); + handles.[chandle] <- (sc,I); + chandle <- chandle + 1; + } + i <- i + 1; + } + sa <- RO.f(p); + } + return sa; + } + } + + module S = { + (** Inner interface **) + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2; + + if (!mem (dom m) x) { + if (mem (dom paths) x.`2) { + (p,v) <- oget paths.[x.`2]; + y1 <- RO.f (rcons p (v +^ x.`1)); + y2 <$ cdistr; + y <- (y1, y2); + paths.[y2] <- (rcons p (v +^ x.`1), y.`1); + } else { + y <$ dstate; + } + bext <- bext \/ mem (rng handles) (x.`2, I); + (* exists x2 h, handles.[h] = Some (X2,I) *) + if (!(mem (rng handles) (x.`2, D))) { + handles.[chandle] <- (x.`2, D); + chandle <- chandle + 1; + } + hx2 <- oget (hinvD handles x.`2); + if (mem (dom mh) (x.`1, hx2) /\ (oget handles.[(oget mh.[(x.`1,hx2)]).`2]).`2 = I) { + hy2 <- (oget mh.[(x.`1, hx2)]).`2; + y <- (y.`1, (oget handles.[hy2]).`1); + handles.[hy2] <- (y.`2, D); + (* bad <- bad \/ mem X2 y.`2; *) + m.[x] <- y; + mi.[y] <- x; + } else { + bcol <- bcol \/ hinv handles y.`2 <> None; + hy2 <- chandle; + chandle <- chandle + 1; + handles.[hy2] <- (y.`2, D); + m.[x] <- y; + mh.[(x.`1, hx2)] <- (y.`1, hy2); + mi.[y] <- x; + mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, hx2, hy2; + + if (!mem (dom mi) x) { + bext <- bext \/ mem (rng handles) (x.`2, I); + (* exists x2 h, handles.[h] = Some (X2,I) *) + if (!(mem (rng handles) (x.`2, D))) { + handles.[chandle] <- (x.`2, D); + chandle <- chandle + 1; + } + hx2 <- oget (hinvD handles x.`2); + y <$ dstate; + if (mem (dom mhi) (x.`1, hx2) /\ (oget handles.[(oget mh.[(x.`1,hx2)]).`2]).`2 = I) { + (y1,hy2) <- oget mhi.[(x.`1, hx2)]; + y <- (y.`1, (oget handles.[hy2]).`1); + handles.[hy2] <- (y.`2, D); + (* bad <- bad \/ mem X2 y.`2; *) + mi.[x] <- y; + mhi.[(x.`1, hx2)] <- (y.`1, hy2); + m.[y] <- x; + mh.[(y.`1, hy2)] <- (x.`1, hx2); + } else { + bcol <- bcol \/ hinv handles y.`2 <> None; + hy2 <- chandle; + chandle <- chandle + 1; + handles.[hy2] <- (y.`2, D); + 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; + } + + (** Distinguisher interface **) + proc init() = { } + + } + + proc main(): bool = { + var b; + + m <- map0; + mi <- map0; + bext <- false; + bcol <- false; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + handles <- map0.[0 <- (c0, D)]; + paths <- map0.[c0 <- ([<:block>],b0)]; + chandle <- 1; + b <@ D(C,S).distinguish(); + return b; + } +}. + +(* -------------------------------------------------------------------------- *) + +op eqm_handles (handles:handles) (m:smap) (mh:hsmap) = + (forall bc bc', m.[bc] = Some bc' => + exists h h' f f', + handles.[h ] = Some(bc .`2,f ) /\ + handles.[h'] = Some(bc'.`2,f') /\ + mh.[(bc.`1, h)] = Some (bc'.`1,h')) /\ + (forall bh bh', mh.[bh] = Some bh' => + exists c c' f f', + handles.[bh .`2] = Some(c ,f) /\ + handles.[bh'.`2] = Some(c',f') /\ + m.[(bh.`1, c)] = Some (bh'.`1,c')). + +op mh_spec (handles:handles) (m2:smap) (mh:hsmap) (ro:(block list, block)fmap) = + (forall bh bh', mh.[bh] = Some bh' => + exists c f c' f', + handles.[bh .`2]=Some(c,f) /\ + handles.[bh'.`2]=Some(c',f') /\ + if f' = D then m2.[(bh.`1,c)] = Some(bh'.`1,c') /\ f = D + else + exists p v b, + ro.[rcons p b] = Some bh'.`1 /\ + build_hpath mh p = Some(v,bh.`2) /\ + bh.`1 = v +^ b) /\ + (forall p b, mem (dom ro) (rcons p b) <=> + exists v h h', + build_hpath mh p = Some (v,h) /\ + mh.[(v +^ b,h)] = Some (oget ro.[rcons p b], h')). + +op paths_spec (handles:handles) (mh:hsmap) (paths:(capacity,block list * block)fmap) = + forall c p v, paths.[c] = Some(p,v) <=> + exists h, + build_hpath mh p = Some(v,h) /\ + handles.[h] = Some(c,D). + +op handles_spec handles chandle = + huniq handles /\ handles.[0] = Some (c0,D) /\ forall h, mem (dom handles) h => h < chandle. + +op INV_CF_G1 (handles:handles) chandle (m1 mi1 m2 mi2:smap) (mh2 mhi2:hsmap) (ro:(block list, block) fmap) paths = + (eqm_handles handles m1 mh2 /\ eqm_handles handles mi1 mhi2) /\ + (incl m2 m1 /\ incl mi2 mi1) /\ + (mh_spec handles m2 mh2 ro /\ paths_spec handles mh2 paths /\ handles_spec handles chandle). + +lemma eqm_dom_mh_m handles m mh hx2 f (x:state): + eqm_handles handles m mh => + handles.[hx2] = Some (x.`2, f) => + mem (dom mh) (x.`1, hx2) => mem (dom m) x. +proof. + move=>[]H1 H2 Hhx2;rewrite !in_dom. + case: (mh.[_]) (H2 (x.`1,hx2))=> //= bh' /(_ bh') [c c' f1 f1']. + by rewrite Hhx2=> /=[][]<<- _;case:(x)=> ??[]_->. +qed. + +lemma chandle_ge0 handles chandle : handles_spec handles chandle => 0 < chandle. +proof. by move=>[]_[]Heq Hlt;apply Hlt;rewrite in_dom Heq. qed. + +lemma chandle_0 handles chandle : handles_spec handles chandle => 0 <> chandle. +proof. move=> Hh;apply /IntOrder.ltr_eqF/(chandle_ge0 _ _ Hh). qed. + +lemma eqm_up_handles handles chandle m mh x2 : + handles_spec handles chandle => + eqm_handles handles m mh => + eqm_handles handles.[chandle <- (x2, D)] m mh. +proof. + move=> []Hu[Hh0 Hlt][]H1 H2;split=> + [bc bc'/H1 [h h' f f'][]Hh[]Hh' Hmh| bh bh'/H2 [c c' f f'][]Hh []Hh' Hm]. + + exists h,h',f,f';rewrite !getP Hmh/=-Hh-Hh'(_:h<>chandle)2:(_:h'<>chandle) //. + + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. + exists c,c',f,f';rewrite !getP Hm/=-Hh-Hh'(_:bh.`2<>chandle)2:(_:bh'.`2<>chandle) //. + + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. +qed. + +lemma mh_up_handles handles chandle m2 mh ro cf: + handles_spec handles chandle => + mh_spec handles m2 mh ro => + mh_spec handles.[chandle <- cf] m2 mh ro. +proof. + move=> Hh Hmh. + move:Hmh Hh=>[H1 ?][_[]_ Hlt];split=>// bh bh' /H1 [c f c' f'][]Hh[]Hh' Hif. + exists c,f,c',f';rewrite Hif-Hh-Hh'!getP(_:bh.`2<>chandle)2:(_:bh'.`2<>chandle) //. + + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. +qed. + +lemma paths_up_handles m2 ro handles mh paths cf chandle: + mh_spec handles m2 mh ro => + handles_spec handles chandle => + paths_spec handles mh paths => + paths_spec handles.[chandle <- cf] mh paths. +proof. + move=> Hmh Hh Hp c p v;rewrite Hp;apply NewLogic.exists_iff=> h/=;split=> -[^Hbu->] /=; + rewrite getP. + + move:Hh=>[]_[]_/(_ h)Hlt Hh;rewrite (_:h<>chandle)//. + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. + rewrite (_:h<>chandle)//. + cut [[]_[]_->|[p' b v' h'[]_[]_ Hh']]:= build_hpathP _ _ _ _ Hbu. + + by rewrite (chandle_0 _ _ Hh). + move:Hh=>[]_[]_/(_ h)Hlt;apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom. + by cut [/(_ _ _ Hh')[????][]_[]->]:= Hmh. +qed. + +lemma handles_up_handles handles chandle x2 f': + (forall (f : caller), ! mem (rng handles) (x2, f)) => + handles_spec handles chandle => + handles_spec handles.[chandle <- (x2, f')] (chandle + 1). +proof. + move=> Hx2^Hh[]Hu[]Hh0 Hlt;split;[ | split]. + + move=> h1 h2 [c1 f1] [c2 f2];rewrite !getP. + case (h1=chandle)=>[->/=[]->> ->|_]; (case (h2=chandle)=>[->//=|_]). + + by move=>Heq ->>;move:(Hx2 f2);rewrite in_rng NewLogic.negb_exists=>/=/(_ h2); + rewrite Heq. + + by move=>Heq[]->> <<- ->>;move:(Hx2 f1);rewrite in_rng NewLogic.negb_exists=>/=/(_ h1); + rewrite Heq. + by apply Hu. + + by rewrite getP (chandle_0 _ _ Hh). + move=>h;rewrite dom_set !inE /#. +qed. + +lemma INV_CF_G1_up_handles handles chandle m1 mi1 m2 mi2 mh mhi ro paths x2: + INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh mhi ro paths => + (forall f, ! mem (rng handles) (x2, f)) => + INV_CF_G1 handles.[chandle <- (x2, D)](chandle+1) m1 mi1 m2 mi2 mh mhi ro paths. +proof. + move=>[][]Heqm Heqmi[]Hincl[]Hmh[]Hp Hh Hx2;split. + + by split;apply eqm_up_handles. + split=>//;split;[|split]. + + by apply mh_up_handles. + + by apply (paths_up_handles m2 ro). + by apply handles_up_handles. +qed. + +section PROOF. + + declare module D : DISTINGUISHER {Perm, RO, G1}. + + axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + islossless P.f => islossless P.fi => islossless F.f => + islossless D(F, P).distinguish. + + local clone import ConcreteF as ConcreteF'. + + local equiv CF_G1 : CF(D).main ~ G1(D).main : ={glob D} ==> !(G1.bcol \/ G1.bext){2} => ={res}. + proof. + proc. + call (_:(G1.bcol \/ G1.bext), INV_CF_G1 G1.handles{2} G1.chandle{2} CF.m{1} CF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} RO.m{2} G1.paths{2}). + (* lossless D *) + + apply D_ll. + (** proofs for G1.S.f *) + (* equiv CF.P.f G1.S.f *) + + proc;if{1}=>/=. + (* x is not in m{1} so forall h, (x.1,h) is not in mh{2} *) + + rcondt{2} 1. + + move=> &hr;skip=> &hr'[][]_[]<-[]_[][]Hincl Hincli _. + rewrite !in_dom/==>H; by case:(G1.m{hr'}.[x{hr}]) (Hincl x{hr})=> //=;rewrite H. + exists* RO.m{2}, G1.paths{2};elim*=>ro0 paths0. + seq 1 2 : (!G1.bcol{2} /\ (G1.bext = mem (rng G1.handles) (x.`2, I)){2} /\ + ={x,y} /\ + INV_CF_G1 G1.handles{2} G1.chandle{2} CF.m{1} CF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} ro0 paths0 /\ + ! mem (dom CF.m{1}) x{1} /\ + (if mem (dom paths0) x.`2 then + let (p,v) = oget paths0.[x.`2] in + RO.m{2} = ro0.[rcons p (v+^x.`1) <- y.`1] /\ + G1.paths = paths0.[y.`2 <- (rcons p (v +^ x.`1), y.`1)] + else RO.m = ro0 /\ G1.paths = paths0){2}). + + wp 1 1;conseq (_: ={y} /\ + if mem (dom paths0) x{2}.`2 then + let (p0, v0) = oget paths0.[x{2}.`2] in + RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ + G1.paths{2} = paths0.[y{2}.`2 <- (rcons p0 (v0 +^ x{2}.`1), y{2}.`1)] + else RO.m{2} = ro0 /\ G1.paths{2} = paths0);1:smt ml=0. + if{2};2:by auto=>/#. + inline{2} RO.f;rcondt{2} 4. + + move=> &ml;auto=>/= &mr[][]_[][]_[]->[][][]_ Heqm _[]_[][]_ Hro[] Hpath _ HnCFm. + rewrite in_dom;case:(G1.paths{mr}.[_]) (Hpath x{mr}.`2)=>//[[p v]]/(_ p v)/=[h][]Hbu Hh b _. + rewrite -not_def=> /Hro [??h'];rewrite oget_some Hbu => [][]<- <- /=. + rewrite Block.xorwA Block.xorwK Block.xorwC Block.xorw0 -not_def=>/Heqm [c c' f f']. + by rewrite Hh=>[][]<- _[]_ Hm;move:HnCFm;rewrite in_dom;case:(x{mr}) Hm=> ??->. + swap{2} 3-2;swap{2}6-4;wp;conseq (_:y{1} =(rd,y2){2}). + + progress [-split];rewrite getP_eq oget_some H2/=. + by move:H2;rewrite in_dom;case:(G1.paths{2}.[_]). + transitivity{1} {y <- S.sample();} (true ==> ={y}) (true==>y{1}=(rd,y2){2})=>//;1:by inline*;auto. + transitivity{2} {(rd,y2) <- S.sample2();} (true==>y{1}=(rd,y2){2}) (true==> ={rd,y2})=>//;2:by inline*;auto. + by call sample_sample2;auto=> /=?[??]->. + case (mem (rng G1.handles{2}) (x{2}.`2, I)). + + conseq (_:true);[by move=> ??[][]_[]->_->|auto]. + conseq (_: !G1.bcol{2} => + oget CF.m{1}.[x{1}] = y{2} /\ + INV_CF_G1 G1.handles{2} G1.chandle{2} CF.m{1} CF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} RO.m{2} G1.paths{2}). + + by move=> ??[][]_[]->[][]-> _ _ ->. + seq 0 2: ((!G1.bcol{2} /\ ={x, y} /\ + INV_CF_G1 G1.handles{2} G1.chandle{2} CF.m{1} CF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} ro0 paths0 /\ + ! mem (dom CF.m{1}) x{1} /\ + if mem (dom paths0) x{2}.`2 then + let (p0, v0) = oget paths0.[x{2}.`2] in + RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ + G1.paths{2} = paths0.[y{2}.`2 <- (rcons p0 (v0 +^ x{2}.`1), y{2}.`1)] + else RO.m{2} = ro0 /\ G1.paths{2} = paths0) /\ + !mem (rng G1.handles{2}) (x{2}.`2, I) /\ + (G1.handles.[hx2]=Some(x.`2,D)){2}). + + auto=> &ml&mr[][]->[]_[][]-> ->[]Hinv []-> -> ^Hrng-> /=. + case (mem (rng G1.handles{mr}) (x{mr}.`2, D))=> Hmem /=. + + by split=>//;apply /huniq_hinvD=>//;move:Hinv;rewrite /INV_CF_G1/handles_spec. + rewrite -anda_and;split=> [ | {Hinv}Hinv]. + + by apply INV_CF_G1_up_handles=>//[[]]. + rewrite rng_set (huniq_hinvD_h G1.chandle{mr}) ?getP//. + + by move:Hinv;rewrite /INV_CF_G1/handles_spec. + by rewrite oget_some /=!inE/=;move:Hrng;apply NewLogic.contraLR=>/=;apply rng_rem_le. + rcondf{2} 1. + + move=> &ml;skip=> &mr[][]_[][]-> _ []Hinv[]Hndom _[]_ Hh;rewrite -not_def in_dom=>[]. + move:Hinv=>[][][]_ /(_ (x{mr}.`1, hx2{mr}));case (G1.mh{mr}.[_])=>// bh' /(_ bh') [c c' f f'] /=. + by rewrite Hh/= =>[][]<- _ []_ H;case: (x{mr}) H Hndom => [x1 x2];rewrite in_dom=>->. + auto. + (* Stopped here *) + admit. + admit. + (* lossless CF.P.f *) + + admit. + (* lossless and do not reset bad G1.S.f *) + + admit. + (** proofs for G1.S.fi *) + (* equiv CF.P.fi G1.S.fi *) + + admit. + (* lossless CF.P.fi *) + + admit. + (* lossless and do not reset bad G1.S.fi *) + + admit. + (** proofs for G1.C.f *) + (* equiv CF.C.f G1.C.f *) + + admit. + (* lossless CF.C.f *) + + admit. + (* lossless and do not reset bad G1.C.f *) + + admit. + (* Init ok *) + + admit. + qed. + + lemma Concrete_G1 &m: + Pr[RealIndif(SqueezelessSponge,Perm,D).main() @ &m: res] <= + Pr[G1(D).main() @ &m: res] + bound_concrete + Pr[G1(D).main() @&m: G1.bcol] + Pr[G1(D).main() @&m: G1.bext]. + proof. + apply (RealOrder.ler_trans _ _ _ (Concrete_CF D &m)). + cut : Pr[CF(D).main() @ &m : res] <= + Pr[G1(D).main() @ &m : res] + Pr[G1(D).main() @ &m : G1.bcol \/ G1.bext]. + + by byequiv CF_G1 =>/#. + cut /# : Pr[G1(D).main() @ &m : G1.bcol \/ G1.bext] <= Pr[G1(D).main() @ &m : G1.bcol] + Pr[G1(D).main() @ &m : G1.bext]. + rewrite Pr [mu_or]; smt. + qed. + +end section PROOF. + + diff --git a/sha3/proof/old/SLCommon.ec b/sha3/proof/old/SLCommon.ec new file mode 100644 index 0000000..cfbe2ca --- /dev/null +++ b/sha3/proof/old/SLCommon.ec @@ -0,0 +1,208 @@ + +(** 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 Pred Fun Option Pair Int Real StdOrder Ring. +require import List FSet NewFMap Utils Common. + +require (*..*) RndOrcl Indifferentiability. +(*...*) import Dprod Dexcepted Capacity IntOrder. + +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. + +(** Ideal Functionality **) +clone export Tuple as TupleBl with + type t <- block, + op Support.enum <- Block.words + 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. + +clone RndOrcl as RndOrclB with + type from <- block list, + type to <- block. + +clone export RndOrclB.RestrIdeal as Functionality with + op sample _ <- bdistr, + op test l <- List.size l <= max_size, + op univ <- bl_univ, + op dfl <- b0 + proof *. +realize sample_ll by exact Block.DWord.bdistr_ll. +realize testP. +proof. + move=> x; rewrite mem_oflist-flattenP; split=>[_|[s[/mkseqP[i[/=_->>]]/wordnP->/#]]]. + exists (wordn (size x));cut Hsx := size_ge0 x. + rewrite wordnP max_ler //= mkseqP /=;exists (size x);smt ml=0. +qed. + +(** We can now define the squeezeless sponge construction **) +module SqueezelessSponge (P:PRIMITIVE): CONSTRUCTION(P), FUNCTIONALITY = { + proc init () = {} + + proc f(p : block list): block = { + var (sa,sc) <- (b0,c0); + + if (1 <= size p /\ p <> [b0]) { + while (p <> []) { (* Absorption *) + (sa,sc) <@ P.f((sa +^ head witness p,sc)); + p <- behead p; + } + } + return sa; (* Squeezing phase (non-iterated) *) + } +}. + +clone export Pair.Dprod.Sample as Sample2 with + type t1 <- block, + type t2 <- capacity, + op d1 <- bdistr, + op d2 <- cdistr. + +(* -------------------------------------------------------------------------- *) +(** 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 caller = [ I | D ]. + +type handle = int. + +type hstate = block * handle. + +type ccapacity = capacity * caller. + +type smap = (state , state ) fmap. +type hsmap = (hstate, hstate ) fmap. +type handles = (handle, ccapacity) fmap. + +(* Did we use it? *) +op (<=) (o1 o2 : caller) = o1 = I \/ o2 = D. + +(* Did we use it? *) +op max (o1 o2 : caller) = + with o1 = I => o2 + with o1 = D => D. + +pred is_pre_permutation (m mi : ('a,'a) fmap) = + (forall x, mem (rng m) x => mem (dom mi) x) + /\ (forall x, mem (rng mi) x => mem (dom m) x). + +lemma half_permutation_set (m' mi' : ('a,'a) fmap) x' y': + (forall x, mem (rng m') x => mem (dom mi') x) + => (forall x, mem (rng m'.[x' <- y']) x => mem (dom mi'.[y' <- x']) x). +proof. + move=> h x0. + rewrite rng_set domP !in_fsetU in_fset1 => [/rng_rem_le in_rng|//=]. + by rewrite h. +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. + +(** Operators and properties of handles *) + +op hinv (handles:handles) (c:capacity) = + find (fun _ => pred1 c \o fst) handles. + +op hinvD (handles:handles) (c:capacity) = + find (fun _ => pred1 (c,D)) 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. + cut @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := + findP (fun (_ : handle) => pred1 c \o fst) handles. + + by exists (oget handles.[h]).`2;rewrite oget_some get_oget;2:case (oget handles.[h]). + by rewrite -not_def=> Heq; cut := H h;rewrite in_dom Heq. +qed. + +lemma huniq_hinv (handles:handles) (h:handle): + huniq handles => mem (dom handles) h => hinv handles (oget handles.[h]).`1 = Some h. +proof. + move=> Huniq;pose c := (oget handles.[h]).`1. + cut:=Huniq h;cut:=hinvP handles c. + case (hinv _ _)=> /=[Hdiff _| h' +/(_ h')];1:by rewrite in_dom /#. + by move=> [f ->] /(_ (oget handles.[h]) (c,f)) H1 H2;rewrite H1 // get_oget. +qed. + +lemma hinvDP handles c: + if hinvD handles c = None then forall h, handles.[h] <> Some(c,D) + else handles.[oget (hinvD handles c)] = Some(c,D). +proof. + cut @/pred1/=[[h []->[]Hmem ]|[]->H h ]/= := + findP (fun (_ : handle) => pred1 (c,D)) handles. + + by rewrite oget_some get_oget. + by rewrite -not_def=> Heq; cut := H h;rewrite in_dom Heq. +qed. + +lemma huniq_hinvD (handles:handles) c: + huniq handles => mem (rng handles) (c,D) => handles.[oget (hinvD handles c)] = Some(c,D). +proof. + move=> Huniq;rewrite in_rng=> [h]H;case: (hinvD _ _) (Huniq h) (hinvDP handles c)=>//=. + by move=>_/(_ h);rewrite H. +qed. + +lemma huniq_hinvD_h h (handles:handles) c: + huniq handles => handles.[h] = Some (c,D) => hinvD handles c = Some h. +proof. + move=> Huniq;case: (hinvD _ _) (hinvDP handles c)=>/= [H|h'];1: by apply H. + by rewrite oget_some=> /Huniq H/H. +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. + +lemma build_hpathP mh p v h: + build_hpath mh p = Some (v, h) => + (p = [] /\ v=b0 /\ h=0) \/ + exists p' b v' h', + p = rcons p' b /\ build_hpath mh p' = Some(v',h') /\ mh.[(v'+^b, h')] = Some(v,h). +proof. + elim/last_ind:p=>@/build_hpath //= p' b _. + rewrite -cats1 foldl_cat /= => H;right;exists p',b. + move:H;rewrite {1}/step_hpath;case (foldl _ _ _)=> //= -[v' h']. + by rewrite oget_some /==>Heq; exists v',h';rewrite -cats1. +qed. + + diff --git a/sha3/proof/old/Squeezeless.ec b/sha3/proof/old/Squeezeless.ec index 33743e4..a684ada 100644 --- a/sha3/proof/old/Squeezeless.ec +++ b/sha3/proof/old/Squeezeless.ec @@ -67,83 +67,91 @@ module SqueezelessSponge (P:PRIMITIVE): CONSTRUCTION(P), FUNCTIONALITY = { } }. -section. +module Count = { var c:int }. - declare module D : Self.DISTINGUISHER {Perm, RO}. +module DCount (D:DISTINGUISHER, F:DFUNCTIONALITY, P:DPRIMITIVE) = { - local module Concrete = RealIndif(SqueezelessSponge,Perm,D). - - (** Result: The adversary's advantage in distinguishing the modular - defs is equal to that of distinguishing these **) - local lemma Inlined_pr &m: - Pr[RealIndif(SqueezelessSponge,Perm,D).main() @ &m: res] - = Pr[Concrete.main() @ &m: res]. - proof. trivial. qed. + module Fc = { + proc f (bs:block list) = { + var b; + Count.c <- Count.c + size bs; + b <@ F.f(bs); + return b; + } + } - (** An intermediate game where we don't care about the permutation - being a bijection anymore... **) - local module CF = { - var m, mi: (state,state) fmap + module Pc = { + proc f (x:state) = { + var y; + Count.c <- Count.c + 1; + y <@ P.f(x); + return y; + } - module P = { - proc init(): unit = { } + proc fi(x:state) = { + var y; + Count.c <- Count.c + 1; + y <@ P.fi(x); + return y; + } + } - proc f(x : state): state = { - var y; + proc distinguish = D(Fc,Pc).distinguish - if (!mem (dom m) x) { - y <$ dstate; - m.[x] <- y; - mi.[y] <- x; - } - return oget m.[x]; - } +}. - proc fi(x : state): state = { - var y; +module DRestr (D:DISTINGUISHER, F:DFUNCTIONALITY, P:DPRIMITIVE) = { + var count:int - if (!mem (dom mi) x) { - y <$ dstate; - mi.[x] <- y; - m.[y] <- x; - } - return oget mi.[x]; + module Fc = { + proc f (bs:block list) = { + var b = b0; + if (Count.c + size bs <= max_size) { + Count.c <- Count.c + size bs; + b <@ F.f(bs); } + return b; + } + } + module Pc = { + proc f (x:state) = { + var y; + if ( + count <- count + 1; + y <@ P.f(x); + return y; } - module C = { - proc init(): unit = { } + proc fi(x:state) = { + var y; + count <- count + 1; + y <@ P.fi(x); + return y; + } + } - proc f(p : block list): block = { - var (sa,sc) <- (b0,c0); + proc distinguish = D(Fc,Pc).distinguish - if (1 <= size p /\ p <> [b0]) { - while (p <> []) { (* Absorption *) - (sa,sc) <@ P.f((sa +^ head witness p,sc)); - p <- behead p; - } - } - return sa; (* Squeezing phase (non-iterated) *) - } - } +}. - proc main(): bool = { - var b; - m <- map0; - mi <- map0; - b <@ D(C,P).distinguish(); - return b; - } - }. - - op bound_concrete : real. - local lemma Concrete_CF &m: - Pr[Concrete.main() @ &m: res] <= - Pr[CF.main() @ &m: res] + bound_concrete. - admitted. + +module type DPRIMITIVE = { + proc f(x : p): p + proc fi(x : p): p +}. + +module type FUNCTIONALITY = { + proc init(): unit + proc f(x : f_in): f_out +}. + +module type DFUNCTIONALITY = { + proc f(x : f_in): f_out +}. + (** Result (expected): The distance between Concrete and Concrete_F is bounded by N^2/|state|, where N is the total cost (in terms @@ -226,7 +234,7 @@ proof. by case (p x y)=> //; cut := Hp x;rewrite getP dom_set !inE /= oget_some. qed. -require import StdOrder. +require import StdOrder IntOrder. require import Ring. (* Operators and properties of handles *) @@ -285,416 +293,7 @@ require import Ring. by rewrite oget_some=> /Huniq H/H. qed. - local module G2 = { - var m, mi : smap - var mh, mhi : hsmap - var handles : handles - var chandle : int - var paths : (capacity, block list * block) fmap - var bext, bcol : bool - - - module C = { - proc init(): unit = { } - - proc f(p : block list): block = { - var sa, sa', sc; - var h, i <- 0; - sa <- b0; - if (1 <= size p /\ p <> [b0]) { - while (i < size p ) { - if (mem (dom mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; - } else { - sc <$ cdistr; - bcol <- bcol \/ hinv handles sc <> None; - sa' <- RO.f(take (i+1) p); - sa <- sa +^ nth witness p i; - mh.[(sa,h)] <- (sa', chandle); - mhi.[(sa',chandle)] <- (sa, h); - (sa,h) <- (sa',chandle); - handles.[chandle] <- (sc,I); - chandle <- chandle + 1; - } - i <- i + 1; - } - sa <- RO.f(p); - } - return sa; - } - } - - module S = { - (** Inner interface **) - proc f(x : state): state = { - var p, v, y, y1, y2, hy2, hx2; - - if (!mem (dom m) x) { - if (mem (dom paths) x.`2) { - (p,v) <- oget paths.[x.`2]; - y1 <- RO.f (rcons p (v +^ x.`1)); - y2 <$ cdistr; - y <- (y1, y2); - paths.[y2] <- (rcons p (v +^ x.`1), y.`1); - } else { - y <$ dstate; - } - bext <- bext \/ mem (rng handles) (x.`2, I); - (* exists x2 h, handles.[h] = Some (X2,I) *) - if (!(mem (rng handles) (x.`2, D))) { - handles.[chandle] <- (x.`2, D); - chandle <- chandle + 1; - } - hx2 <- oget (hinvD handles x.`2); - if (mem (dom mh) (x.`1, hx2) /\ (oget handles.[(oget mh.[(x.`1,hx2)]).`2]).`2 = I) { - hy2 <- (oget mh.[(x.`1, hx2)]).`2; - y <- (y.`1, (oget handles.[hy2]).`1); - handles.[hy2] <- (y.`2, D); - (* bad <- bad \/ mem X2 y.`2; *) - m.[x] <- y; - mi.[y] <- x; - } else { - bcol <- bcol \/ hinv handles y.`2 <> None; - hy2 <- chandle; - chandle <- chandle + 1; - handles.[hy2] <- (y.`2, D); - m.[x] <- y; - mh.[(x.`1, hx2)] <- (y.`1, hy2); - mi.[y] <- x; - mhi.[(y.`1, hy2)] <- (x.`1, hx2); - } - } else { - y <- oget m.[x]; - } - return y; - } - - proc fi(x : state): state = { - var y, y1, hx2, hy2; - - if (!mem (dom mi) x) { - bext <- bext \/ mem (rng handles) (x.`2, I); - (* exists x2 h, handles.[h] = Some (X2,I) *) - if (!(mem (rng handles) (x.`2, D))) { - handles.[chandle] <- (x.`2, D); - chandle <- chandle + 1; - } - hx2 <- oget (hinvD handles x.`2); - y <$ dstate; - if (mem (dom mhi) (x.`1, hx2) /\ (oget handles.[(oget mh.[(x.`1,hx2)]).`2]).`2 = I) { - (y1,hy2) <- oget mhi.[(x.`1, hx2)]; - y <- (y.`1, (oget handles.[hy2]).`1); - handles.[hy2] <- (y.`2, D); - (* bad <- bad \/ mem X2 y.`2; *) - mi.[x] <- y; - mhi.[(x.`1, hx2)] <- (y.`1, hy2); - m.[y] <- x; - mh.[(y.`1, hy2)] <- (x.`1, hx2); - } else { - bcol <- bcol \/ hinv handles y.`2 <> None; - hy2 <- chandle; - chandle <- chandle + 1; - handles.[hy2] <- (y.`2, D); - 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; - } - - (** Distinguisher interface **) - proc init() = { } - - } - - proc main(): bool = { - var b; - - m <- map0; - mi <- map0; - bext <- false; - bcol <- false; - - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - handles <- map0.[0 <- (c0, D)]; - paths <- map0.[c0 <- ([<:block>],b0)]; - chandle <- 1; - b <@ D(C,S).distinguish(); - return b; - } - }. - - 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. - - op eqm_handles (handles:handles) (m:smap) (mh:hsmap) = - (forall bc bc', m.[bc] = Some bc' => - exists h h' f f', - handles.[h ] = Some(bc .`2,f ) /\ - handles.[h'] = Some(bc'.`2,f') /\ - mh.[(bc.`1, h)] = Some (bc'.`1,h')) /\ - (forall bh bh', mh.[bh] = Some bh' => - exists c c' f f', - handles.[bh .`2] = Some(c ,f) /\ - handles.[bh'.`2] = Some(c',f') /\ - m.[(bh.`1, c)] = Some (bh'.`1,c')). - - op mh_spec (handles:handles) (m2:smap) (mh:hsmap) (ro:(block list, block)fmap) = - (forall bh bh', mh.[bh] = Some bh' => - exists c f c' f', - handles.[bh .`2]=Some(c,f) /\ - handles.[bh'.`2]=Some(c',f') /\ - if f' = D then m2.[(bh.`1,c)] = Some(bh'.`1,c') /\ f = D - else - exists p v b, - ro.[rcons p b] = Some bh'.`1 /\ - build_hpath mh p = Some(v,bh.`2) /\ - bh.`1 = v +^ b) /\ - (forall p b, mem (dom ro) (rcons p b) <=> - exists v h h', - build_hpath mh p = Some (v,h) /\ - mh.[(v +^ b,h)] = Some (oget ro.[rcons p b], h')). - - op paths_spec (handles:handles) (mh:hsmap) (paths:(capacity,block list * block)fmap) = - forall c p v, paths.[c] = Some(p,v) <=> - exists h, - build_hpath mh p = Some(v,h) /\ - handles.[h] = Some(c,D). - - op incl (m m':('a,'b)fmap) = - forall x, m .[x] <> None => m'.[x] = m.[x]. - - op handles_spec handles chandle = - huniq handles /\ handles.[0] = Some (c0,D) /\ forall h, mem (dom handles) h => h < chandle. - - op INV_CF_G2 (handles:handles) chandle (m1 mi1 m2 mi2:smap) (mh2 mhi2:hsmap) (ro:(block list, block) fmap) paths = - (eqm_handles handles m1 mh2 /\ eqm_handles handles mi1 mhi2) /\ - (incl m2 m1 /\ incl mi2 mi1) /\ - (mh_spec handles m2 mh2 ro /\ paths_spec handles mh2 paths /\ handles_spec handles chandle). - - lemma eqm_dom_mh_m handles m mh hx2 f (x:state): - eqm_handles handles m mh => - handles.[hx2] = Some (x.`2, f) => - mem (dom mh) (x.`1, hx2) => mem (dom m) x. - proof. - move=>[]H1 H2 Hhx2;rewrite !in_dom. - case: (mh.[_]) (H2 (x.`1,hx2))=> //= bh' /(_ bh') [c c' f1 f1']. - by rewrite Hhx2=> /=[][]<<- _;case:(x)=> ??[]_->. - qed. - - axiom D_ll (F <: FUNCTIONALITY{D}) (P <: PRIMITIVE{D}): - islossless P.f => islossless P.fi => islossless F.f => - islossless D(F, P).distinguish. - - clone import Pair.Dprod.Sample as Sample2 with - type t1 <- block, - type t2 <- capacity, - op d1 <- bdistr, - op d2 <- cdistr. - - lemma build_hpathP mh p v h: - build_hpath mh p = Some (v, h) => - (p = [] /\ v=b0 /\ h=0) \/ - exists p' b v' h', - p = rcons p' b /\ build_hpath mh p' = Some(v',h') /\ mh.[(v'+^b, h')] = Some(v,h). - proof. - elim/last_ind:p=>@/build_hpath //= p' b _. - rewrite -cats1 foldl_cat /= => H;right;exists p',b. - move:H;rewrite {1}/step_hpath;case (foldl _ _ _)=> //= -[v' h']. - by rewrite oget_some /==>Heq; exists v',h';rewrite -cats1. - qed. - - lemma chandle_ge0 handles chandle : handles_spec handles chandle => 0 < chandle. - proof. by move=>[]_[]Heq Hlt;apply Hlt;rewrite in_dom Heq. qed. - - lemma chandle_0 handles chandle : handles_spec handles chandle => 0 <> chandle. - proof. move=> Hh;apply /IntOrder.ltr_eqF/(chandle_ge0 _ _ Hh). qed. - - lemma eqm_up_handles handles chandle m mh x2 : - handles_spec handles chandle => - eqm_handles handles m mh => - eqm_handles handles.[chandle <- (x2, D)] m mh. - proof. - move=> []Hu[Hh0 Hlt][]H1 H2;split=> - [bc bc'/H1 [h h' f f'][]Hh[]Hh' Hmh| bh bh'/H2 [c c' f f'][]Hh []Hh' Hm]. - + exists h,h',f,f';rewrite !getP Hmh/=-Hh-Hh'(_:h<>chandle)2:(_:h'<>chandle) //. - + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. - by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. - exists c,c',f,f';rewrite !getP Hm/=-Hh-Hh'(_:bh.`2<>chandle)2:(_:bh'.`2<>chandle) //. - + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. - by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. - qed. - - lemma mh_up_handles handles chandle m2 mh ro cf: - handles_spec handles chandle => - mh_spec handles m2 mh ro => - mh_spec handles.[chandle <- cf] m2 mh ro. - proof. - move=> Hh Hmh. - move:Hmh Hh=>[H1 ?][_[]_ Hlt];split=>// bh bh' /H1 [c f c' f'][]Hh[]Hh' Hif. - exists c,f,c',f';rewrite Hif-Hh-Hh'!getP(_:bh.`2<>chandle)2:(_:bh'.`2<>chandle) //. - + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. - by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. - qed. - - lemma paths_up_handles m2 ro handles mh paths cf chandle: - mh_spec handles m2 mh ro => - handles_spec handles chandle => - paths_spec handles mh paths => - paths_spec handles.[chandle <- cf] mh paths. - proof. - move=> Hmh Hh Hp c p v;rewrite Hp;apply NewLogic.exists_iff=> h/=;split=> -[^Hbu->] /=; - rewrite getP. - + move:Hh=>[]_[]_/(_ h)Hlt Hh;rewrite (_:h<>chandle)//. - by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. - rewrite (_:h<>chandle)//. - cut [[]_[]_->|[p' b v' h'[]_[]_ Hh']]:= build_hpathP _ _ _ _ Hbu. - + by rewrite (chandle_0 _ _ Hh). - move:Hh=>[]_[]_/(_ h)Hlt;apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom. - by cut [/(_ _ _ Hh')[????][]_[]->]:= Hmh. - qed. - - lemma handles_up_handles handles chandle x2 f': - (forall (f : caller), ! mem (rng handles) (x2, f)) => - handles_spec handles chandle => - handles_spec handles.[chandle <- (x2, f')] (chandle + 1). - proof. - move=> Hx2^Hh[]Hu[]Hh0 Hlt;split;[ | split]. - + move=> h1 h2 [c1 f1] [c2 f2];rewrite !getP. - case (h1=chandle)=>[->/=[]->> ->|_]; (case (h2=chandle)=>[->//=|_]). - + by move=>Heq ->>;move:(Hx2 f2);rewrite in_rng NewLogic.negb_exists=>/=/(_ h2); - rewrite Heq. - + by move=>Heq[]->> <<- ->>;move:(Hx2 f1);rewrite in_rng NewLogic.negb_exists=>/=/(_ h1); - rewrite Heq. - by apply Hu. - + by rewrite getP (chandle_0 _ _ Hh). - move=>h;rewrite dom_set !inE /#. - qed. - - lemma INV_CF_G2_up_handles handles chandle m1 mi1 m2 mi2 mh mhi ro paths x2: - INV_CF_G2 handles chandle m1 mi1 m2 mi2 mh mhi ro paths => - (forall f, ! mem (rng handles) (x2, f)) => - INV_CF_G2 handles.[chandle <- (x2, D)](chandle+1) m1 mi1 m2 mi2 mh mhi ro paths. - proof. - move=>[][]Heqm Heqmi[]Hincl[]Hmh[]Hp Hh Hx2;split. - + by split;apply eqm_up_handles. - split=>//;split;[|split]. - + by apply mh_up_handles. - + by apply (paths_up_handles m2 ro). - by apply handles_up_handles. - qed. - - local equiv CF_G2 : CF.main ~ G2.main : ={glob D} ==> !(G2.bcol \/ G2.bext){2} => ={res}. - proof. - proc. - call (_:(G2.bcol \/ G2.bext), INV_CF_G2 G2.handles{2} G2.chandle{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} G2.mh{2} G2.mhi{2} RO.m{2} G2.paths{2}). - (* lossless D *) - + apply D_ll. - (** proofs for G2.S.f *) - (* equiv CF.P.f G2.S.f *) - + proc;if{1}=>/=. - (* x is not in m{1} so forall h, (x.1,h) is not in mh{2} *) - + rcondt{2} 1. - + move=> &hr;skip=> &hr'[][]_[]<-[]_[][]Hincl Hincli _. - rewrite !in_dom/==>H; by case:(G2.m{hr'}.[x{hr}]) (Hincl x{hr})=> //=;rewrite H. - exists* RO.m{2}, G2.paths{2};elim*=>ro0 paths0. - seq 1 2 : (!G2.bcol{2} /\ (G2.bext = mem (rng G2.handles) (x.`2, I)){2} /\ - ={x,y} /\ - INV_CF_G2 G2.handles{2} G2.chandle{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} G2.mh{2} G2.mhi{2} ro0 paths0 /\ - ! mem (dom CF.m{1}) x{1} /\ - (if mem (dom paths0) x.`2 then - let (p,v) = oget paths0.[x.`2] in - RO.m{2} = ro0.[rcons p (v+^x.`1) <- y.`1] /\ - G2.paths = paths0.[y.`2 <- (rcons p (v +^ x.`1), y.`1)] - else RO.m = ro0 /\ G2.paths = paths0){2}). - + wp 1 1;conseq (_: ={y} /\ - if mem (dom paths0) x{2}.`2 then - let (p0, v0) = oget paths0.[x{2}.`2] in - RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ - G2.paths{2} = paths0.[y{2}.`2 <- (rcons p0 (v0 +^ x{2}.`1), y{2}.`1)] - else RO.m{2} = ro0 /\ G2.paths{2} = paths0);1:smt ml=0. - if{2};2:by auto=>/#. - inline{2} RO.f;rcondt{2} 4. - + move=> &ml;auto=>/= &mr[][]_[][]_[]->[][][]_ Heqm _[]_[][]_ Hro[] Hpath _ HnCFm. - rewrite in_dom;case:(G2.paths{mr}.[_]) (Hpath x{mr}.`2)=>//[[p v]]/(_ p v)/=[h][]Hbu Hh b _. - rewrite -not_def=> /Hro [??h'];rewrite oget_some Hbu => [][]<- <- /=. - rewrite Block.xorwA Block.xorwK Block.xorwC Block.xorw0 -not_def=>/Heqm [c c' f f']. - by rewrite Hh=>[][]<- _[]_ Hm;move:HnCFm;rewrite in_dom;case:(x{mr}) Hm=> ??->. - swap{2} 3-2;swap{2}6-4;wp;conseq (_:y{1} =(rd,y2){2}). - + progress [-split];rewrite getP_eq oget_some H2/=. - by move:H2;rewrite in_dom;case:(G2.paths{2}.[_]). - transitivity{1} {y <- S.sample();} (true ==> ={y}) (true==>y{1}=(rd,y2){2})=>//;1:by inline*;auto. - transitivity{2} {(rd,y2) <- S.sample2();} (true==>y{1}=(rd,y2){2}) (true==> ={rd,y2})=>//;2:by inline*;auto. - by call sample_sample2;auto=> /=?[??]->. - case (mem (rng G2.handles{2}) (x{2}.`2, I)). - + conseq (_:true);[by move=> ??[][]_[]->_->|auto]. - conseq (_: !G2.bcol{2} => - oget CF.m{1}.[x{1}] = y{2} /\ - INV_CF_G2 G2.handles{2} G2.chandle{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} G2.mh{2} G2.mhi{2} RO.m{2} G2.paths{2}). - + by move=> ??[][]_[]->[][]-> _ _ ->. - seq 0 2: ((!G2.bcol{2} /\ ={x, y} /\ - INV_CF_G2 G2.handles{2} G2.chandle{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} - G2.mh{2} G2.mhi{2} ro0 paths0 /\ - ! mem (dom CF.m{1}) x{1} /\ - if mem (dom paths0) x{2}.`2 then - let (p0, v0) = oget paths0.[x{2}.`2] in - RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ - G2.paths{2} = paths0.[y{2}.`2 <- (rcons p0 (v0 +^ x{2}.`1), y{2}.`1)] - else RO.m{2} = ro0 /\ G2.paths{2} = paths0) /\ - !mem (rng G2.handles{2}) (x{2}.`2, I) /\ - (G2.handles.[hx2]=Some(x.`2,D)){2}). - + auto=> &ml&mr[][]->[]_[][]-> ->[]Hinv []-> -> ^Hrng-> /=. - case (mem (rng G2.handles{mr}) (x{mr}.`2, Top.D))=> Hmem /=. - + by split=>//;apply /huniq_hinvD=>//;move:Hinv;rewrite /INV_CF_G2/handles_spec. - rewrite -anda_and;split=> [ | {Hinv}Hinv]. - + by apply INV_CF_G2_up_handles=>//[[]]. - rewrite rng_set (huniq_hinvD_h G2.chandle{mr}) ?getP//. - + by move:Hinv;rewrite /INV_CF_G2/handles_spec. - by rewrite oget_some /=!inE/=;move:Hrng;apply NewLogic.contraLR=>/=;apply rng_rem_le. - rcondf{2} 1. - + move=> &ml;skip=> &mr[][]_[][]-> _ []Hinv[]Hndom _[]_ Hh;rewrite -not_def in_dom=>[]. - move:Hinv=>[][][]_ /(_ (x{mr}.`1, hx2{mr}));case (G2.mh{mr}.[_])=>// bh' /(_ bh') [c c' f f'] /=. - by rewrite Hh/= =>[][]<- _ []_ H;case: (x{mr}) H Hndom => [x1 x2];rewrite in_dom=>->. - auto. -(* Stopped here *) - admit. - admit. - (* lossless CF.P.f *) - + admit. - (* lossless and do not reset bad G2.S.f *) - + admit. - (** proofs for G2.S.fi *) - (* equiv CF.P.fi G2.S.fi *) - + admit. - (* lossless CF.P.fi *) - + admit. - (* lossless and do not reset bad G2.S.fi *) - + admit. - (** proofs for G2.C.f *) - (* equiv CF.C.f G2.C.f *) - + admit. - (* lossless CF.C.f *) - + admit. - (* lossless and do not reset bad G2.C.f *) - + admit. - (* Init ok *) - + admit. - qed. - - - - - From 7fed7d62c1c0ddd477bb59640f1e8853b55274d9 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Thu, 10 Dec 2015 10:25:38 +0100 Subject: [PATCH 070/394] apply auto-magic sed commands to sha3 (w.r.t EC update) --- sha3/proof/AbsorbToBlocks.ec | 2 +- sha3/proof/old/G1.eca | 10 +++++----- sha3/proof/old/SLCommon.ec | 4 ++-- sha3/proof/old/Squeezeless.ec | 32 ++++++++++++++++---------------- sha3/proof/old/Utils.ec | 10 +++++----- 5 files changed, 29 insertions(+), 29 deletions(-) diff --git a/sha3/proof/AbsorbToBlocks.ec b/sha3/proof/AbsorbToBlocks.ec index eb00f91..8122a2a 100644 --- a/sha3/proof/AbsorbToBlocks.ec +++ b/sha3/proof/AbsorbToBlocks.ec @@ -145,7 +145,7 @@ section. + smt. + smt. + have [_] [_] /(_ x1 n0 _) //= := H0. - move: H5; rewrite domP in_fsetU in_fset1=> [//=|h]. + move: H5; rewrite domP in_fsetU in_fset1=> -[//=|h]. by have [->]:= H1 (x1,n0) _; first by rewrite h mem_pick // H2. + move: H5; rewrite domP in_fsetD in_fsetU !in_fset1. by case (x1 = pick work{hr})=> //= _ /H1 [->]. diff --git a/sha3/proof/old/G1.eca b/sha3/proof/old/G1.eca index d3dcd1f..32df648 100644 --- a/sha3/proof/old/G1.eca +++ b/sha3/proof/old/G1.eca @@ -198,7 +198,7 @@ lemma eqm_dom_mh_m handles m mh hx2 f (x:state): proof. move=>[]H1 H2 Hhx2;rewrite !in_dom. case: (mh.[_]) (H2 (x.`1,hx2))=> //= bh' /(_ bh') [c c' f1 f1']. - by rewrite Hhx2=> /=[][]<<- _;case:(x)=> ??[]_->. + by rewrite Hhx2=> /= -[][]<<- _;case:(x)=> ??[]_->. qed. lemma chandle_ge0 handles chandle : handles_spec handles chandle => 0 < chandle. @@ -324,9 +324,9 @@ section PROOF. inline{2} RO.f;rcondt{2} 4. + move=> &ml;auto=>/= &mr[][]_[][]_[]->[][][]_ Heqm _[]_[][]_ Hro[] Hpath _ HnCFm. rewrite in_dom;case:(G1.paths{mr}.[_]) (Hpath x{mr}.`2)=>//[[p v]]/(_ p v)/=[h][]Hbu Hh b _. - rewrite -not_def=> /Hro [??h'];rewrite oget_some Hbu => [][]<- <- /=. + rewrite -not_def=> /Hro [??h'];rewrite oget_some Hbu => -[][]<- <- /=. rewrite Block.xorwA Block.xorwK Block.xorwC Block.xorw0 -not_def=>/Heqm [c c' f f']. - by rewrite Hh=>[][]<- _[]_ Hm;move:HnCFm;rewrite in_dom;case:(x{mr}) Hm=> ??->. + by rewrite Hh=> -[][]<- _[]_ Hm;move:HnCFm;rewrite in_dom;case:(x{mr}) Hm=> ??->. swap{2} 3-2;swap{2}6-4;wp;conseq (_:y{1} =(rd,y2){2}). + progress [-split];rewrite getP_eq oget_some H2/=. by move:H2;rewrite in_dom;case:(G1.paths{2}.[_]). @@ -359,9 +359,9 @@ section PROOF. + by move:Hinv;rewrite /INV_CF_G1/handles_spec. by rewrite oget_some /=!inE/=;move:Hrng;apply NewLogic.contraLR=>/=;apply rng_rem_le. rcondf{2} 1. - + move=> &ml;skip=> &mr[][]_[][]-> _ []Hinv[]Hndom _[]_ Hh;rewrite -not_def in_dom=>[]. + + move=> &ml;skip=> &mr[][]_[][]-> _ []Hinv[]Hndom _[]_ Hh;rewrite -not_def in_dom=> -[]. move:Hinv=>[][][]_ /(_ (x{mr}.`1, hx2{mr}));case (G1.mh{mr}.[_])=>// bh' /(_ bh') [c c' f f'] /=. - by rewrite Hh/= =>[][]<- _ []_ H;case: (x{mr}) H Hndom => [x1 x2];rewrite in_dom=>->. + by rewrite Hh/= => -[][]<- _ []_ H;case: (x{mr}) H Hndom => [x1 x2];rewrite in_dom=>->. auto. (* Stopped here *) admit. diff --git a/sha3/proof/old/SLCommon.ec b/sha3/proof/old/SLCommon.ec index cfbe2ca..4add140 100644 --- a/sha3/proof/old/SLCommon.ec +++ b/sha3/proof/old/SLCommon.ec @@ -113,7 +113,7 @@ lemma half_permutation_set (m' mi' : ('a,'a) fmap) x' y': => (forall x, mem (rng m'.[x' <- y']) x => mem (dom mi'.[y' <- x']) x). proof. move=> h x0. - rewrite rng_set domP !in_fsetU in_fset1 => [/rng_rem_le in_rng|//=]. + rewrite rng_set domP !in_fsetU in_fset1 => -[/rng_rem_le in_rng|//=]. by rewrite h. qed. @@ -171,7 +171,7 @@ qed. lemma huniq_hinvD (handles:handles) c: huniq handles => mem (rng handles) (c,D) => handles.[oget (hinvD handles c)] = Some(c,D). proof. - move=> Huniq;rewrite in_rng=> [h]H;case: (hinvD _ _) (Huniq h) (hinvDP handles c)=>//=. + move=> Huniq;rewrite in_rng=> -[h]H;case: (hinvD _ _) (Huniq h) (hinvDP handles c)=>//=. by move=>_/(_ h);rewrite H. qed. diff --git a/sha3/proof/old/Squeezeless.ec b/sha3/proof/old/Squeezeless.ec index a684ada..a0345bc 100644 --- a/sha3/proof/old/Squeezeless.ec +++ b/sha3/proof/old/Squeezeless.ec @@ -201,7 +201,7 @@ module type DFUNCTIONALITY = { => (forall x, mem (rng m'.[x' <- y']) x => mem (dom mi'.[y' <- x']) x). proof. move=> h x0. - rewrite rng_set domP !in_fsetU in_fset1 => [/rng_rem_le in_rng|//=]. + rewrite rng_set domP !in_fsetU in_fset1 => -[/rng_rem_le in_rng|//=]. by rewrite h. qed. @@ -282,7 +282,7 @@ require import Ring. lemma huniq_hinvD (handles:handles) c: huniq handles => mem (rng handles) (c,D) => handles.[oget (hinvD handles c)] = Some(c,D). proof. - move=> Huniq;rewrite in_rng=> [h]H;case: (hinvD _ _) (Huniq h) (hinvDP handles c)=>//=. + move=> Huniq;rewrite in_rng=> -[h]H;case: (hinvD _ _) (Huniq h) (hinvDP handles c)=>//=. by move=>_/(_ h);rewrite H. qed. @@ -352,14 +352,14 @@ lemma hinvD_rng x (handles:(handle, ccapacity) fmap): proof. cut[ [a []->[]] | []->/=Hp ]/=:= findP (fun _ z => z = (x, D)) handles. + by rewrite oget_some=> ? <- _;apply get_oget. - by rewrite in_rng=> [a Ha];cut := Hp a; rewrite in_dom Ha oget_some. + by rewrite in_rng=> -[a Ha];cut := Hp a; rewrite in_dom Ha oget_some. qed. (* TODO: change the name *) lemma map_perm (m mi: ('a, 'a) fmap) x y: !mem (dom mi) y => dom m = rng mi => dom m.[x<-y] = rng mi.[y<- x]. proof. move=> Hdom Heq;rewrite fsetP=> w;rewrite dom_set in_rng !inE;split. - + rewrite Heq in_rng. case (w=x)=>[->|Hneq/=[a Ha]];1:by exists y;rewrite getP. + + rewrite Heq in_rng. case (w=x)=> -[->|Hneq/=[a Ha]];1:by exists y;rewrite getP. exists a;rewrite getP;case (a=y)=>[->>|//]. by move:Hdom;rewrite in_dom Ha. rewrite Heq in_rng;by move=>[a];rewrite getP;case(a=y)=>[->>/# |_ <-];left;exists a. @@ -387,13 +387,13 @@ proof. rewrite !(dom_set, rng_set, inE) /==>H1 [[H2|[_->]]|[/rng_rem_le H2|[_->]]]//; by rewrite H1 ?H2. + by move=> h;cut := Hhbound h;rewrite !dom_set !inE /= => H [[/H|]|->>]/#. - + move=>[x1 h];rewrite !getP !dom_set !inE /==>[|[]->> ->>];rewrite /chandles /=. + + move=>[x1 h];rewrite !getP !dom_set !inE /==> -[|[]->> ->>];rewrite /chandles /=. + move=>Hh. cut /Hhbound/=:= Hdomh (x1,h) _;1:by rewrite !inE Hh. move=> ^Hlt /IntOrder.gtr_eqF; rewrite eq_sym=>->. by cut ->/#: h <> G2.chandle{hr} + 1 by smt ml=0. cut ->/=: G2.chandle{hr} <> G2.chandle{hr} + 1 by smt ml=0. by rewrite oget_some /#. - move=>[x1 h];rewrite !getP !dom_set !inE /==>[|[]->> ->>];rewrite /chandles /=. + move=>[x1 h];rewrite !getP !dom_set !inE /==> -[|[]->> ->>];rewrite /chandles /=. + move=>Hh; cut /Hhbound/=:= Hdomh (x1,h) _;1:by rewrite !inE -Hmhimh Hh. move=> ^Hlt /IntOrder.gtr_eqF; rewrite eq_sym=>->. by cut ->/#: h <> G2.chandle{hr} + 1 by smt ml=0. @@ -406,17 +406,17 @@ proof. rewrite !inE -Hmhimh H. + apply map_perm=> //;rewrite -not_def=> H. by cut := Hmhor _ H;move: Hnmem;rewrite Hget oget_some /=;case (x{hr}). - + move=> [x1 h];rewrite !(dom_set,rng_set, inE) => [[H|[_ ->]]| [/rng_rem_le H|[_->]]]//=. + + move=> [x1 h];rewrite !(dom_set,rng_set, inE) => -[[H|[_ ->]]| [/rng_rem_le H|[_->]]]//=. + by left;apply (Hdomh (x1,h));rewrite inE H. + by left;rewrite in_dom Hget. by left;apply (Hdomh (x1,h));rewrite inE H. - + by move=>h;rewrite dom_set !inE=> [/Hhbound|->]/#. - + move=> [x1 h];rewrite !(dom_set, getP, inE) /==>[H|[->> ->>]]. + + by move=>h;rewrite dom_set !inE=> -[/Hhbound|->]/#. + + move=> [x1 h];rewrite !(dom_set, getP, inE) /==> -[H|[->> ->>]]. + by cut /IntOrder.ltr_eqF->/#:= Hhbound h _;1:by apply (Hdomh (x1,h));rewrite inE H. cut ->/=:oget (hinvD G2.handles{hr} x{hr}.`2) <> G2.chandle{hr}. + by cut /#:= Hhbound (oget (hinvD G2.handles{hr} x{hr}.`2)) _;1:by rewrite in_dom Hget. by rewrite Hget oget_some /=;right;case (x{hr}). - move=> [x1 h];rewrite !(dom_set, getP, inE) /==>[H|[->> ->> /=]]. + move=> [x1 h];rewrite !(dom_set, getP, inE) /==> -[H|[->> ->> /=]]. + by cut /IntOrder.ltr_eqF->/#:= Hhbound h _;1: apply (Hdomh (x1,h));rewrite inE -Hmhimh H. by rewrite oget_some /=;right;case y. qed. @@ -443,12 +443,12 @@ proof. rewrite !(dom_set, rng_set, inE) /==>H1 [[H2|[_->]]|[/rng_rem_le H2|[_->]]]//; by rewrite H1 ?H2. + by move=> h;cut := Hhbound h;rewrite !dom_set !inE /= => H [[/H|]|->>]/#. - + move=>[x1 h];rewrite !getP !dom_set !inE /==>[|[]->> ->>];rewrite /chandles /=. + + move=>[x1 h];rewrite !getP !dom_set !inE /==> -[|[]->> ->>];rewrite /chandles /=. + move=>Hh; cut /Hhbound/=:= Hdomh (x1,h) _;1:by rewrite !inE -Hmhimh Hh. move=> ^Hlt /IntOrder.gtr_eqF; rewrite eq_sym=>->. by cut ->/#: h <> G2.chandle{hr} + 1 by smt ml=0. by rewrite oget_some /#. - move=>[x1 h];rewrite !getP !dom_set !inE /==>[|[]->> ->>];rewrite /chandles /=. + move=>[x1 h];rewrite !getP !dom_set !inE /==> -[|[]->> ->>];rewrite /chandles /=. + move=>Hh;cut /Hhbound/=:= Hdomh (x1,h) _;1:by rewrite !inE -Hmhimh Hh. move=> ^Hlt /IntOrder.gtr_eqF; rewrite eq_sym=>->. by cut ->/#: h <> G2.chandle{hr} + 1 by smt ml=0. @@ -462,15 +462,15 @@ proof. + apply map_perm=> //;rewrite -not_def=> H. by cut /#:= Hhbound G2.chandle{hr} _;apply (Hdomh (y.`1,G2.chandle{hr})); rewrite !inE -Hmhimh H. - + move=> [x1 h];rewrite !(dom_set,rng_set, inE) => [[H|[_ ->]]| [/rng_rem_le H|[_->]]]//=. + + move=> [x1 h];rewrite !(dom_set,rng_set, inE) => -[[H|[_ ->]]| [/rng_rem_le H|[_->]]]//=. + by left;apply (Hdomh (x1,h));rewrite inE H. + by left;apply (Hdomh (x1,h));rewrite inE H. by left;rewrite in_dom Hget. - + by move=>h;rewrite dom_set !inE=> [/Hhbound|->]/#. - + move=> [x1 h];rewrite !(dom_set, getP, inE) /==>[H|[->> ->> /=]]. + + by move=>h;rewrite dom_set !inE=> -[/Hhbound|->]/#. + + move=> [x1 h];rewrite !(dom_set, getP, inE) /==> -[H|[->> ->> /=]]. + by cut /IntOrder.ltr_eqF->/#:= Hhbound h _;1: apply (Hdomh (x1,h));rewrite inE -Hmhimh H. by rewrite oget_some /==>{Hy};right;case y. - move=> [x1 h];rewrite !(dom_set, getP, inE) /==>[H|[->> ->>]]. + move=> [x1 h];rewrite !(dom_set, getP, inE) /==> -[H|[->> ->>]]. + by cut /IntOrder.ltr_eqF->/#:= Hhbound h _;1:apply (Hdomh (x1,h));rewrite inE -Hmhimh H. cut ->/=:oget (hinvD G2.handles{hr} x{hr}.`2) <> G2.chandle{hr}. + by cut /#:= Hhbound (oget (hinvD G2.handles{hr} x{hr}.`2)) _;1:by rewrite in_dom Hget. diff --git a/sha3/proof/old/Utils.ec b/sha3/proof/old/Utils.ec index 5b6f0bd..8ec5b44 100644 --- a/sha3/proof/old/Utils.ec +++ b/sha3/proof/old/Utils.ec @@ -17,7 +17,7 @@ proof. by rewrite dom_rem in_fsetD. qed. lemma rng_rem_le (x : 'a) (m : ('a,'b) fmap) (x' : 'b): mem (rng (rem x m)) x' => mem (rng m) x'. -proof. by rewrite rng_rm in_rng=> [x0] [_ h]; exists x0. qed. +proof. by rewrite rng_rm in_rng=> -[x0] [_ h]; exists x0. qed. (* -------------------------------------------------------------------- *) @@ -34,7 +34,7 @@ lemma dom_reindex (f : 'a -> 'c) (m : ('a, 'b) fmap) x: proof. rewrite reindexE dom_oflist imageP mapP /fst; split. move=> [[x' y] [+ ->>]]. - rewrite mapP=> [[x0 y0]] /= [h [->> ->>]] {x' y}. + rewrite mapP=> -[[x0 y0]] /= [h [->> ->>]] {x' y}. by exists x0; rewrite domE mem_oflist mapP /fst; exists (x0,y0). move=> [a] [a_in_m <<-]. exists (f a,oget m.[a])=> /=; rewrite mapP /=. @@ -64,13 +64,13 @@ proof. rewrite /reduce=> s0 x0; rewrite -{2}(cat0s s0); pose acc:= []. elim s0 acc x0=> {s'} [acc x0 /=|x' s' ih acc x0 /=]. by rewrite cats0. - move=> /ih; rewrite -cat1s catA cats1 !mem_cat=> [|-> //=]. + move=> /ih; rewrite -cat1s catA cats1 !mem_cat=> -[|-> //=]. rewrite /augment; case (mem (map fst acc) x'.`1)=> _ h'; left=> //. by rewrite mem_rcons /=; right. - rewrite /s' mapP=> [[a' b']] /= [xy_in_m []]. + rewrite /s' mapP=> -[[a' b']] /= [xy_in_m []]. rewrite eq_sym. have h0 /h0 ->> <<- {a' b'}:= f_pinj a' x _; 1:by smt. by apply/mem_assoc_uniq; 1:exact uniq_keys. - rewrite -mem_oflist {1}/s -domE=> [] h; have := h; rewrite dom_reindex. + rewrite -mem_oflist {1}/s -domE=> -[] h; have := h; rewrite dom_reindex. rewrite imageP=> h'. have {h'} h': forall (a : 'a), !mem (dom m) a \/ f a <> f x by smt. have /= := h' x. rewrite in_dom !getE /=. From fcd58a8776fbe8f875126356ed349f64aa77ce53 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Thu, 10 Dec 2015 13:08:29 +0100 Subject: [PATCH 071/394] generalize -> move: --- sha3/proof/RndOrcl.eca | 6 +++--- sha3/proof/variant/RndOrcl.eca | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/sha3/proof/RndOrcl.eca b/sha3/proof/RndOrcl.eca index 96d3045..4b15b5c 100644 --- a/sha3/proof/RndOrcl.eca +++ b/sha3/proof/RndOrcl.eca @@ -124,7 +124,7 @@ abstract theory GenIdeal. (={x,work,RO.m} ==> ={x,RO.m}) ((={x,work,RO.m} /\ mem work{1} x{1}) /\ ! mem (dom RO.m{2}) x{2} ==> ={x,RO.m} /\ (result = oget RO.m.[x]){2} /\ mem (dom RO.m{1}) x{1}) => //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; generalize H. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. + transitivity{1} { while (work <> fset0) { x0 <- pick work; rd0 <$ sample x0; @@ -134,7 +134,7 @@ abstract theory GenIdeal. rd <$ sample x; } (={x,work,RO.m} ==> ={x,RO.m}) (={x,work,RO.m} ==> ={x,RO.m})=> //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; generalize H. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. + by sim; rnd{2}; sim : (={x,IND_Eager.H.m}); smt. symmetry; eager while (H: rd <$ sample x; ~ rd <$ sample x; : ={x} ==> ={rd})=> //; sim. swap{2} 5 -4; swap [2..3] -1; case ((x = pick work){1}). @@ -147,7 +147,7 @@ abstract theory GenIdeal. else eq_except RO.m{1} RO.m{2} (fset1 x{1})). + auto;progress; 1..9,12:smt. + case ((pick work = x){2})=> pick_x; last smt. - subst x{2}; generalize H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. + subst x{2}; move: H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. by apply fmapP=> x0; case (pick work{2} = x0); smt. by auto; smt. by auto;progress [-split];rewrite H0 /= getP_eq;smt. diff --git a/sha3/proof/variant/RndOrcl.eca b/sha3/proof/variant/RndOrcl.eca index 96d3045..4b15b5c 100644 --- a/sha3/proof/variant/RndOrcl.eca +++ b/sha3/proof/variant/RndOrcl.eca @@ -124,7 +124,7 @@ abstract theory GenIdeal. (={x,work,RO.m} ==> ={x,RO.m}) ((={x,work,RO.m} /\ mem work{1} x{1}) /\ ! mem (dom RO.m{2}) x{2} ==> ={x,RO.m} /\ (result = oget RO.m.[x]){2} /\ mem (dom RO.m{1}) x{1}) => //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; generalize H. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. + transitivity{1} { while (work <> fset0) { x0 <- pick work; rd0 <$ sample x0; @@ -134,7 +134,7 @@ abstract theory GenIdeal. rd <$ sample x; } (={x,work,RO.m} ==> ={x,RO.m}) (={x,work,RO.m} ==> ={x,RO.m})=> //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; generalize H. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. + by sim; rnd{2}; sim : (={x,IND_Eager.H.m}); smt. symmetry; eager while (H: rd <$ sample x; ~ rd <$ sample x; : ={x} ==> ={rd})=> //; sim. swap{2} 5 -4; swap [2..3] -1; case ((x = pick work){1}). @@ -147,7 +147,7 @@ abstract theory GenIdeal. else eq_except RO.m{1} RO.m{2} (fset1 x{1})). + auto;progress; 1..9,12:smt. + case ((pick work = x){2})=> pick_x; last smt. - subst x{2}; generalize H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. + subst x{2}; move: H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. by apply fmapP=> x0; case (pick work{2} = x0); smt. by auto; smt. by auto;progress [-split];rewrite H0 /= getP_eq;smt. From 2da093159c6ab5e06cff90fd2cef0b206999c63e Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Thu, 10 Dec 2015 13:19:30 +0100 Subject: [PATCH 072/394] .dir-locals --- sha3/proof/.dir-locals.el | 4 ++++ 1 file changed, 4 insertions(+) create mode 100644 sha3/proof/.dir-locals.el diff --git a/sha3/proof/.dir-locals.el b/sha3/proof/.dir-locals.el new file mode 100644 index 0000000..fbf2dcd --- /dev/null +++ b/sha3/proof/.dir-locals.el @@ -0,0 +1,4 @@ +((easycrypt-mode . + ((eval . + (flet ((pre (s) (concat (locate-dominating-file buffer-file-name ".dir-locals.el") s))) + (setq easycrypt-load-path `(,(pre ".") ,(pre "variant") ,(pre "old")))))))) From e4cecabba1b11f168b4c3464dfdf1e0cde53f43b Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 10 Dec 2015 14:03:38 +0100 Subject: [PATCH 073/394] Add a generic proof allowing to switch from an oracle to a restricted oracle --- sha3/proof/old/Count.eca | 140 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 140 insertions(+) create mode 100644 sha3/proof/old/Count.eca diff --git a/sha3/proof/old/Count.eca b/sha3/proof/old/Count.eca new file mode 100644 index 0000000..1ce6ea7 --- /dev/null +++ b/sha3/proof/old/Count.eca @@ -0,0 +1,140 @@ +require import Pred Fun Option Pair Int Real StdOrder Ring. +require import List FSet NewFMap Utils Common SLCommon. +(*...*) import Dprod Dexcepted Capacity IntOrder. + +module type ODISTINGUISHER = { + proc p (_:state) : state + proc pi (_:state) : state + proc f (_:block list) : block +}. + +module type DISTINGUISHER1 (O:ODISTINGUISHER) = { + proc distinguish () : bool +}. + +module ToC (D:DISTINGUISHER, O:ODISTINGUISHER) = { + module F = { + proc f = O.f + } + module P = { + proc f = O.p + proc fi = O.pi + } + proc distinguisher = D(F,P).distinguish +}. + +module OfC(F:DFUNCTIONALITY, P:DPRIMITIVE) = { + proc f = F.f + proc p = P.f + proc pi = P.fi +}. + +module OC (O:ODISTINGUISHER) = { + + var c : int + + proc init () = { + c <- 0; + } + + proc f (bs:block list) = { + var b; + c <- c + size bs; + b <@ O.f(bs); + return b; + } + + proc p (x:state) = { + var y; + c <- c + 1; + y <@ O.p(x); + return y; + } + + proc pi(x:state) = { + var y; + c <- c + 1; + y <@ O.pi(x); + return y; + } + +}. + + +module OCRestr (O:ODISTINGUISHER) = { + + proc f (bs:block list) = { + var b = b0; + if (OC.c + size bs <= max_size) { + OC.c <- OC.c + size bs; + b <@ O.f(bs); + } + return b; + } + + proc p (x:state) = { + var y = (b0,c0); + if (OC.c + 1 <= max_size) { + OC.c <- OC.c + 1; + y <@ O.p(x); + } + return y; + } + + proc pi(x:state) = { + var y = (b0,c0); + if (OC.c + 1 <= max_size) { + OC.c <- OC.c + 1; + y <@ O.pi(x); + } + return y; + } + +}. + +section PROOF. + + declare module O:ODISTINGUISHER{OC}. + + declare module D : DISTINGUISHER1 {O,OC}. + + axiom D_ll (O <: ODISTINGUISHER{D}): + islossless O.p => islossless O.pi => islossless O.f => + islossless D(O).distinguish. + + axiom D_max : hoare [D(OC(O)).distinguish : OC.c = 0 ==> OC.c <= max_size]. + + axiom f_ll : phoare [O.f:true ==> true] = 1%r. + axiom p_ll : phoare [O.p:true ==> true] = 1%r. + axiom pi_ll : phoare [O.pi:true ==> true] = 1%r. + + equiv D_DRestr : D(O).distinguish ~ D(OCRestr(O)).distinguish : + ={glob D, glob O} /\ OC.c{2} = 0 ==> ={res,glob D, glob O}. + proof. + transitivity D(OC(O)).distinguish + (={glob D, glob O} ==> ={res,glob D, glob O}) + (={glob D, glob O, OC.c} /\ OC.c{1} = 0 ==> ={res,glob D, glob O})=>//. + + by move=> ?&mr[][]-> -> ->;exists (glob O){mr}, (glob D){mr}, 0. + + by proc (={glob O})=>//;proc *;inline *;sim. + symmetry. + conseq (_: ={glob D, glob O,OC.c} /\ OC.c{2} = 0 ==> OC.c{2} <= max_size => ={res,glob D, glob O}) _ + (_: OC.c = 0 ==> OC.c <= max_size)=>//;1:by smt ml=0. + + apply D_max. + proc (max_size < OC.c) (={glob O, OC.c})=>//. + + smt ml=0. + + by move=> O' ???;apply (D_ll O'). + + proc;sp 1 0;if{1};1:by call(_:true);auto. + by call{2} p_ll;auto=> /#. + + by move=> ?_;proc;sp;if;auto;call p_ll;auto. + + by move=> _;proc;call p_ll;auto=> /#. + + proc;sp 1 0;if{1};1:by call(_:true);auto. + by call{2} pi_ll;auto=> /#. + + by move=> ?_;proc;sp;if;auto;call pi_ll;auto. + + by move=> _;proc;call pi_ll;auto=> /#. + + proc;sp 1 0;if{1};1:by call(_:true);auto. + by call{2} f_ll;auto=> /#. + + by move=> ?_;proc;sp;if;auto;call f_ll;auto. + by move=> _;proc;call f_ll;auto; smt ml=0 w=size_ge0. + qed. + +end section PROOF. \ No newline at end of file From eb3704003e17ec30a0fb1ae63d54f0cd89be3d32 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 10 Dec 2015 15:09:52 +0100 Subject: [PATCH 074/394] end generic proof on counting --- sha3/proof/old/Count.eca | 69 ++++++++++++++++++++++++++++++++++++---- 1 file changed, 62 insertions(+), 7 deletions(-) diff --git a/sha3/proof/old/Count.eca b/sha3/proof/old/Count.eca index 1ce6ea7..640261e 100644 --- a/sha3/proof/old/Count.eca +++ b/sha3/proof/old/Count.eca @@ -2,6 +2,13 @@ require import Pred Fun Option Pair Int Real StdOrder Ring. require import List FSet NewFMap Utils Common SLCommon. (*...*) import Dprod Dexcepted Capacity IntOrder. +module type ORACLES = { + proc *init() : unit + proc p (_:state) : state + proc pi (_:state) : state + proc f (_:block list) : block +}. + module type ODISTINGUISHER = { proc p (_:state) : state proc pi (_:state) : state @@ -33,10 +40,6 @@ module OC (O:ODISTINGUISHER) = { var c : int - proc init () = { - c <- 0; - } - proc f (bs:block list) = { var b; c <- c + size bs; @@ -92,7 +95,30 @@ module OCRestr (O:ODISTINGUISHER) = { }. -section PROOF. +module Main1 (O:ORACLES,D:DISTINGUISHER1) = { + + proc main() : bool = { + var b; + O.init(); + b <@ D(O).distinguish(); + return b; + } + +}. + +module Main2 (O:ORACLES,D:DISTINGUISHER1) = { + + proc main() : bool = { + var b; + O.init(); + OC.c <- 0; + b <@ D(OCRestr(O)).distinguish(); + return b; + } + +}. + +section. declare module O:ODISTINGUISHER{OC}. @@ -117,7 +143,8 @@ section PROOF. + by move=> ?&mr[][]-> -> ->;exists (glob O){mr}, (glob D){mr}, 0. + by proc (={glob O})=>//;proc *;inline *;sim. symmetry. - conseq (_: ={glob D, glob O,OC.c} /\ OC.c{2} = 0 ==> OC.c{2} <= max_size => ={res,glob D, glob O}) _ + conseq (_: ={glob D, glob O,OC.c} /\ OC.c{2} = 0 ==> + OC.c{2} <= max_size => ={res,glob D, glob O}) _ (_: OC.c = 0 ==> OC.c <= max_size)=>//;1:by smt ml=0. + apply D_max. proc (max_size < OC.c) (={glob O, OC.c})=>//. @@ -137,4 +164,32 @@ section PROOF. by move=> _;proc;call f_ll;auto; smt ml=0 w=size_ge0. qed. -end section PROOF. \ No newline at end of file +end section. + +section. + + declare module O:ORACLES{OC}. + + declare module D : DISTINGUISHER1 {O,OC}. + + axiom D_ll (O <: ODISTINGUISHER{D}): + islossless O.p => islossless O.pi => islossless O.f => + islossless D(O).distinguish. + + axiom D_max : hoare [D(OC(O)).distinguish : OC.c = 0 ==> OC.c <= max_size]. + + axiom f_ll : phoare [O.f:true ==> true] = 1%r. + axiom p_ll : phoare [O.p:true ==> true] = 1%r. + axiom pi_ll : phoare [O.pi:true ==> true] = 1%r. + + equiv Main1_Main2 : Main1(O,D).main ~ Main2(O,D).main: + ={glob D} ==> ={res, glob D, glob O}. + proof. + proc;call (D_DRestr O D D_ll D_max f_ll p_ll pi_ll);wp;call(_:true);auto. + qed. + + lemma Pr_Main1_Main2 &m : + Pr[Main1(O,D).main()@&m:res] = Pr[Main2(O,D).main()@&m:res]. + proof. by byequiv Main1_Main2. qed. + +end section. From d9a025b5721c991120afbf198f179d9a1f02855e Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 10 Dec 2015 15:14:03 +0100 Subject: [PATCH 075/394] renaming --- sha3/proof/old/{Count.eca => Count.ec} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename sha3/proof/old/{Count.eca => Count.ec} (100%) diff --git a/sha3/proof/old/Count.eca b/sha3/proof/old/Count.ec similarity index 100% rename from sha3/proof/old/Count.eca rename to sha3/proof/old/Count.ec From 01c1085454fcbe33dd32d3d1fa357ca564cdba3b Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 10 Dec 2015 21:55:30 +0100 Subject: [PATCH 076/394] some progress ? --- sha3/proof/Indifferentiability.eca | 6 +- sha3/proof/old/ConcreteF.eca | 239 +++++++++++++++++++++-------- sha3/proof/old/SLCommon.ec | 2 +- 3 files changed, 181 insertions(+), 66 deletions(-) diff --git a/sha3/proof/Indifferentiability.eca b/sha3/proof/Indifferentiability.eca index 9a3a37a..14c871f 100644 --- a/sha3/proof/Indifferentiability.eca +++ b/sha3/proof/Indifferentiability.eca @@ -30,12 +30,12 @@ module type DFUNCTIONALITY = { 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 : PRIMITIVE) = { - proc init() : unit +module type CONSTRUCTION (P : DPRIMITIVE) = { + proc init() : unit {} proc f(x : f_in): f_out { P.f } }. -module type SIMULATOR (F : FUNCTIONALITY) = { +module type SIMULATOR (F : DFUNCTIONALITY) = { proc init() : unit { (* F.init *) } proc f(x : p) : p { F.f } proc fi(x : p) : p { F.f } diff --git a/sha3/proof/old/ConcreteF.eca b/sha3/proof/old/ConcreteF.eca index 548b2a3..ffdf199 100644 --- a/sha3/proof/old/ConcreteF.eca +++ b/sha3/proof/old/ConcreteF.eca @@ -1,77 +1,192 @@ require import Pred Fun Option Pair Int Real StdOrder Ring. require import List FSet NewFMap Utils Common SLCommon. -(*...*) import Dprod Dexcepted Capacity IntOrder. - -module Concrete(D:DISTINGUISHER) = RealIndif(SqueezelessSponge,Perm,D). -(** An intermediate game where we don't care about the permutation - being a bijection anymore... **) -module CF(D:DISTINGUISHER) = { - var m, mi: (state,state) fmap - - module P = { - proc init(): unit = { } - - proc f(x : state): state = { - var y; - - if (!mem (dom m) x) { - y <$ dstate; - m.[x] <- y; - mi.[y] <- x; - } - return oget m.[x]; - } - - proc fi(x : state): state = { - var y; - - if (!mem (dom mi) x) { - y <$ dstate; - mi.[x] <- y; - m.[y] <- x; - } - return oget mi.[x]; - } +(*...*) import Dprod Dexcepted Capacity IntOrder RealOrder. - } - module C = { - proc init(): unit = { } - proc f(p : block list): block = { - var (sa,sc) <- (b0,c0); +module C = { + var c:int + proc init () = { c <- 0; } +}. - if (1 <= size p /\ p <> [b0]) { - while (p <> []) { (* Absorption *) - (sa,sc) <@ P.f((sa +^ head witness p,sc)); - p <- behead p; - } - } - return sa; (* Squeezing phase (non-iterated) *) - } - } +module PC (P:PRIMITIVE) = { + + proc init () = { + C.init(); + P.init(); + } + + proc f (x:state) = { + var y; + C.c <- C.c + 1; + y <@ P.f(x); + return y; + } + + proc fi(x:state) = { + var y; + C.c <- C.c + 1; + y <@ P.fi(x); + return y; + } + +}. + +module PRestr (P:PRIMITIVE) = { - proc main(): bool = { - var b; + proc init () = { + C.init(); + P.init(); + } - m <- map0; - mi <- map0; - b <@ D(C,P).distinguish(); - return b; + proc f (x:state) = { + var y=(b0,c0); + if (C.c + 1 <= max_size) { + C.c <- C.c + 1; + y <@ P.f(x); } - }. + return y; + } + + proc fi(x:state) = { + var y=(b0,c0); + if (C.c + 1 <= max_size) { + C.c <- C.c + 1; + y <@ P.fi(x); + } + return y; + } + +}. -section PROOF. +module FC(F:FUNCTIONALITY) = { - declare module D : DISTINGUISHER {Perm, RO, CF}. - - op bound_concrete : real. + proc init = F.init - lemma Concrete_CF &m: - Pr[Concrete(D).main() @ &m: res] <= - Pr[CF(D).main() @ &m: res] + bound_concrete. - admitted. + proc f (bs:block list) = { + var b= b0; + C.c <- C.c + size bs; + b <@ F.f(bs); + return b; + } +}. -end section PROOF. +module FRestr(F:FUNCTIONALITY) = { + proc init = F.init + proc f (bs:block list) = { + var b= b0; + if (C.c + size bs <= max_size) { + C.c <- C.c + size bs; + b <@ F.f(bs); + } + return b; + } +}. + +section COUNT. + + declare module P:PRIMITIVE{C}. + declare module CO:CONSTRUCTION{C,P}. + declare module D:DISTINGUISHER{C,P,CO}. + + axiom f_ll : islossless P.f. + axiom fi_ll : islossless P.fi. + + axiom CO_ll : islossless CO(P).f. + + 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(FRestr(CO(P)), PRestr(P), 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. + call (_: max_size < C.c, ={glob P, glob CO, glob C}). + + apply D_ll. + + proc; sp 1 0;if{1};1:by call(_:true);auto. + by call{2} f_ll;auto=>/#. + + by move=> ?_;proc;sp;if;auto;call f_ll;auto. + + by move=> _;proc;call f_ll;auto=>/#. + + proc;sp 1 0;if{1};1:by call(_:true);auto. + by call{2} fi_ll;auto=>/#. + + by move=> ?_;proc;sp;if;auto;call fi_ll;auto. + + by move=> _;proc;call fi_ll;auto=>/#. + + proc;sp 1 0;if{1};1:by call(_: ={glob P});auto;sim. + by call{2} CO_ll;auto=>/#. + + by move=> ?_;proc;sp;if;auto;call CO_ll;auto. + + move=> _;proc;call CO_ll;auto;smt ml=0 w=size_ge0. + inline *;call (_:true);call(_:true);auto=>/#. + qed. + +end section COUNT. + +module PF = { + var m, mi: (state,state) fmap + + proc init(): unit = { + m <- map0; + mi <- map0; + } + + proc f(x : state): state = { + var y; + + if (!mem (dom m) x) { + y <$ dstate; + m.[x] <- y; + mi.[y] <- x; + } + return oget m.[x]; + } + + proc fi(x : state): state = { + var y; + + if (!mem (dom mi) x) { + y <$ dstate; + mi.[x] <- y; + m.[y] <- x; + } + return oget mi.[x]; + } + +}. + +op bound_concrete : real. + +module GReal(D:DISTINGUISHER) = + Indif(FC(SqueezelessSponge(Perm)), PC(Perm), D). + +module CF(D:DISTINGUISHER) = + Indif(FRestr(SqueezelessSponge(PF)), PRestr(PF), D). + +section. + + declare module D : DISTINGUISHER {Perm, C, PF}. + + 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_Concrete &m : + Pr[GReal(D).main()@ &m:res /\ C.c <= max_size] <= + Pr[CF(D).main()@ &m: res] + bound_concrete. + proof. + cut p_ll : islossless Perm.f. + + admit. (* We should have the lemma *) + cut pi_ll : islossless Perm.fi. + + admit. (* We should have the lemma *) + cut f_ll : islossless SqueezelessSponge(Perm).f. + + admit. (* We should have the lemma *) + apply (ler_trans _ _ _ + (Pr_restr Perm SqueezelessSponge D p_ll pi_ll f_ll D_ll &m)). + admit. (* Francois *) + qed. + +end section. diff --git a/sha3/proof/old/SLCommon.ec b/sha3/proof/old/SLCommon.ec index 4add140..6cffd25 100644 --- a/sha3/proof/old/SLCommon.ec +++ b/sha3/proof/old/SLCommon.ec @@ -53,7 +53,7 @@ proof. qed. (** We can now define the squeezeless sponge construction **) -module SqueezelessSponge (P:PRIMITIVE): CONSTRUCTION(P), FUNCTIONALITY = { +module SqueezelessSponge (P:DPRIMITIVE): FUNCTIONALITY = { proc init () = {} proc f(p : block list): block = { From f20050653ea7ed8cff32707e756da1c96008c950 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 10 Dec 2015 21:58:44 +0100 Subject: [PATCH 077/394] remove unused try. --- sha3/proof/old/Count.ec | 195 ---------------------------------------- 1 file changed, 195 deletions(-) delete mode 100644 sha3/proof/old/Count.ec diff --git a/sha3/proof/old/Count.ec b/sha3/proof/old/Count.ec deleted file mode 100644 index 640261e..0000000 --- a/sha3/proof/old/Count.ec +++ /dev/null @@ -1,195 +0,0 @@ -require import Pred Fun Option Pair Int Real StdOrder Ring. -require import List FSet NewFMap Utils Common SLCommon. -(*...*) import Dprod Dexcepted Capacity IntOrder. - -module type ORACLES = { - proc *init() : unit - proc p (_:state) : state - proc pi (_:state) : state - proc f (_:block list) : block -}. - -module type ODISTINGUISHER = { - proc p (_:state) : state - proc pi (_:state) : state - proc f (_:block list) : block -}. - -module type DISTINGUISHER1 (O:ODISTINGUISHER) = { - proc distinguish () : bool -}. - -module ToC (D:DISTINGUISHER, O:ODISTINGUISHER) = { - module F = { - proc f = O.f - } - module P = { - proc f = O.p - proc fi = O.pi - } - proc distinguisher = D(F,P).distinguish -}. - -module OfC(F:DFUNCTIONALITY, P:DPRIMITIVE) = { - proc f = F.f - proc p = P.f - proc pi = P.fi -}. - -module OC (O:ODISTINGUISHER) = { - - var c : int - - proc f (bs:block list) = { - var b; - c <- c + size bs; - b <@ O.f(bs); - return b; - } - - proc p (x:state) = { - var y; - c <- c + 1; - y <@ O.p(x); - return y; - } - - proc pi(x:state) = { - var y; - c <- c + 1; - y <@ O.pi(x); - return y; - } - -}. - - -module OCRestr (O:ODISTINGUISHER) = { - - proc f (bs:block list) = { - var b = b0; - if (OC.c + size bs <= max_size) { - OC.c <- OC.c + size bs; - b <@ O.f(bs); - } - return b; - } - - proc p (x:state) = { - var y = (b0,c0); - if (OC.c + 1 <= max_size) { - OC.c <- OC.c + 1; - y <@ O.p(x); - } - return y; - } - - proc pi(x:state) = { - var y = (b0,c0); - if (OC.c + 1 <= max_size) { - OC.c <- OC.c + 1; - y <@ O.pi(x); - } - return y; - } - -}. - -module Main1 (O:ORACLES,D:DISTINGUISHER1) = { - - proc main() : bool = { - var b; - O.init(); - b <@ D(O).distinguish(); - return b; - } - -}. - -module Main2 (O:ORACLES,D:DISTINGUISHER1) = { - - proc main() : bool = { - var b; - O.init(); - OC.c <- 0; - b <@ D(OCRestr(O)).distinguish(); - return b; - } - -}. - -section. - - declare module O:ODISTINGUISHER{OC}. - - declare module D : DISTINGUISHER1 {O,OC}. - - axiom D_ll (O <: ODISTINGUISHER{D}): - islossless O.p => islossless O.pi => islossless O.f => - islossless D(O).distinguish. - - axiom D_max : hoare [D(OC(O)).distinguish : OC.c = 0 ==> OC.c <= max_size]. - - axiom f_ll : phoare [O.f:true ==> true] = 1%r. - axiom p_ll : phoare [O.p:true ==> true] = 1%r. - axiom pi_ll : phoare [O.pi:true ==> true] = 1%r. - - equiv D_DRestr : D(O).distinguish ~ D(OCRestr(O)).distinguish : - ={glob D, glob O} /\ OC.c{2} = 0 ==> ={res,glob D, glob O}. - proof. - transitivity D(OC(O)).distinguish - (={glob D, glob O} ==> ={res,glob D, glob O}) - (={glob D, glob O, OC.c} /\ OC.c{1} = 0 ==> ={res,glob D, glob O})=>//. - + by move=> ?&mr[][]-> -> ->;exists (glob O){mr}, (glob D){mr}, 0. - + by proc (={glob O})=>//;proc *;inline *;sim. - symmetry. - conseq (_: ={glob D, glob O,OC.c} /\ OC.c{2} = 0 ==> - OC.c{2} <= max_size => ={res,glob D, glob O}) _ - (_: OC.c = 0 ==> OC.c <= max_size)=>//;1:by smt ml=0. - + apply D_max. - proc (max_size < OC.c) (={glob O, OC.c})=>//. - + smt ml=0. - + by move=> O' ???;apply (D_ll O'). - + proc;sp 1 0;if{1};1:by call(_:true);auto. - by call{2} p_ll;auto=> /#. - + by move=> ?_;proc;sp;if;auto;call p_ll;auto. - + by move=> _;proc;call p_ll;auto=> /#. - + proc;sp 1 0;if{1};1:by call(_:true);auto. - by call{2} pi_ll;auto=> /#. - + by move=> ?_;proc;sp;if;auto;call pi_ll;auto. - + by move=> _;proc;call pi_ll;auto=> /#. - + proc;sp 1 0;if{1};1:by call(_:true);auto. - by call{2} f_ll;auto=> /#. - + by move=> ?_;proc;sp;if;auto;call f_ll;auto. - by move=> _;proc;call f_ll;auto; smt ml=0 w=size_ge0. - qed. - -end section. - -section. - - declare module O:ORACLES{OC}. - - declare module D : DISTINGUISHER1 {O,OC}. - - axiom D_ll (O <: ODISTINGUISHER{D}): - islossless O.p => islossless O.pi => islossless O.f => - islossless D(O).distinguish. - - axiom D_max : hoare [D(OC(O)).distinguish : OC.c = 0 ==> OC.c <= max_size]. - - axiom f_ll : phoare [O.f:true ==> true] = 1%r. - axiom p_ll : phoare [O.p:true ==> true] = 1%r. - axiom pi_ll : phoare [O.pi:true ==> true] = 1%r. - - equiv Main1_Main2 : Main1(O,D).main ~ Main2(O,D).main: - ={glob D} ==> ={res, glob D, glob O}. - proof. - proc;call (D_DRestr O D D_ll D_max f_ll p_ll pi_ll);wp;call(_:true);auto. - qed. - - lemma Pr_Main1_Main2 &m : - Pr[Main1(O,D).main()@&m:res] = Pr[Main2(O,D).main()@&m:res]. - proof. by byequiv Main1_Main2. qed. - -end section. From 7e24b2ee91794e8783268fedde99307231ed50d8 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 11 Dec 2015 09:15:42 +0100 Subject: [PATCH 078/394] General infrastructure. --- sha3/proof/old/ConcreteF.eca | 151 ++++----------------------- sha3/proof/old/G1.eca | 77 ++++++++------ sha3/proof/old/SLCommon.ec | 196 ++++++++++++++++++++++++++++++++++- 3 files changed, 261 insertions(+), 163 deletions(-) diff --git a/sha3/proof/old/ConcreteF.eca b/sha3/proof/old/ConcreteF.eca index ffdf199..22b4e05 100644 --- a/sha3/proof/old/ConcreteF.eca +++ b/sha3/proof/old/ConcreteF.eca @@ -2,130 +2,6 @@ require import Pred Fun Option Pair Int Real StdOrder Ring. require import List FSet NewFMap Utils Common SLCommon. (*...*) import Dprod Dexcepted Capacity IntOrder RealOrder. - - -module C = { - var c:int - proc init () = { c <- 0; } -}. - -module PC (P:PRIMITIVE) = { - - proc init () = { - C.init(); - P.init(); - } - - proc f (x:state) = { - var y; - C.c <- C.c + 1; - y <@ P.f(x); - return y; - } - - proc fi(x:state) = { - var y; - C.c <- C.c + 1; - y <@ P.fi(x); - return y; - } - -}. - -module PRestr (P:PRIMITIVE) = { - - proc init () = { - C.init(); - P.init(); - } - - proc f (x:state) = { - var y=(b0,c0); - if (C.c + 1 <= max_size) { - C.c <- C.c + 1; - y <@ P.f(x); - } - return y; - } - - proc fi(x:state) = { - var y=(b0,c0); - if (C.c + 1 <= max_size) { - C.c <- C.c + 1; - y <@ P.fi(x); - } - return y; - } - -}. - -module FC(F:FUNCTIONALITY) = { - - proc init = F.init - - proc f (bs:block list) = { - var b= b0; - C.c <- C.c + size bs; - b <@ F.f(bs); - return b; - } -}. - -module FRestr(F:FUNCTIONALITY) = { - - proc init = F.init - - proc f (bs:block list) = { - var b= b0; - if (C.c + size bs <= max_size) { - C.c <- C.c + size bs; - b <@ F.f(bs); - } - return b; - } -}. - -section COUNT. - - declare module P:PRIMITIVE{C}. - declare module CO:CONSTRUCTION{C,P}. - declare module D:DISTINGUISHER{C,P,CO}. - - axiom f_ll : islossless P.f. - axiom fi_ll : islossless P.fi. - - axiom CO_ll : islossless CO(P).f. - - 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(FRestr(CO(P)), PRestr(P), 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. - call (_: max_size < C.c, ={glob P, glob CO, glob C}). - + apply D_ll. - + proc; sp 1 0;if{1};1:by call(_:true);auto. - by call{2} f_ll;auto=>/#. - + by move=> ?_;proc;sp;if;auto;call f_ll;auto. - + by move=> _;proc;call f_ll;auto=>/#. - + proc;sp 1 0;if{1};1:by call(_:true);auto. - by call{2} fi_ll;auto=>/#. - + by move=> ?_;proc;sp;if;auto;call fi_ll;auto. - + by move=> _;proc;call fi_ll;auto=>/#. - + proc;sp 1 0;if{1};1:by call(_: ={glob P});auto;sim. - by call{2} CO_ll;auto=>/#. - + by move=> ?_;proc;sp;if;auto;call CO_ll;auto. - + move=> _;proc;call CO_ll;auto;smt ml=0 w=size_ge0. - inline *;call (_:true);call(_:true);auto=>/#. - qed. - -end section COUNT. - module PF = { var m, mi: (state,state) fmap @@ -158,13 +34,10 @@ module PF = { }. +(* Fixme *) op bound_concrete : real. -module GReal(D:DISTINGUISHER) = - Indif(FC(SqueezelessSponge(Perm)), PC(Perm), D). - -module CF(D:DISTINGUISHER) = - Indif(FRestr(SqueezelessSponge(PF)), PRestr(PF), D). +module CF(D:DISTINGUISHER) = Indif(SqueezelessSponge(PF), PF, D). section. @@ -174,10 +47,26 @@ section. islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. + local module GReal' = Indif(FC(SqueezelessSponge(Perm)), PC(Perm), D). + + (* TODO move this *) + lemma size_behead(l:'a list): l <> [] => size (behead l) = size l - 1. + proof. case l=>// ??/=;ring. qed. + lemma Real_Concrete &m : - Pr[GReal(D).main()@ &m:res /\ C.c <= max_size] <= - Pr[CF(D).main()@ &m: res] + bound_concrete. + Pr[GReal(D).main()@ &m: res /\ C.c <= max_size] <= + Pr[CF(DRestr(D)).main()@ &m: res] + bound_concrete. proof. + cut->: + 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});last by auto. + + by sim. + by sim. + proc;inline *;sp 1 0;if{1};wp;[rcondt{2}5|rcondf{2}5];1,3:by auto. + + while (={glob Perm,sc,sa,p} /\ (C.c + size p){1} = C.c{2});2:by auto. + by wp;sp 1 1;if{2};[rcondt{1} 3|rcondf{1} 3];auto; + progress;rewrite size_behead//;ring. + by auto; smt ml=0 w=size_ge0. cut p_ll : islossless Perm.f. + admit. (* We should have the lemma *) cut pi_ll : islossless Perm.fi. diff --git a/sha3/proof/old/G1.eca b/sha3/proof/old/G1.eca index 32df648..42c8fc6 100644 --- a/sha3/proof/old/G1.eca +++ b/sha3/proof/old/G1.eca @@ -14,7 +14,6 @@ module G1(D:DISTINGUISHER) = { module C = { - proc init(): unit = { } proc f(p : block list): block = { var sa, sa', sc; @@ -44,7 +43,7 @@ module G1(D:DISTINGUISHER) = { } module S = { - (** Inner interface **) + proc f(x : state): state = { var p, v, y, y1, y2, hy2, hx2; @@ -281,24 +280,25 @@ proof. by apply handles_up_handles. qed. -section PROOF. +clone import ConcreteF as ConcreteF1. + +section AUX. - declare module D : DISTINGUISHER {Perm, RO, G1}. + declare module D : DISTINGUISHER {PF, RO, G1}. axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. - local clone import ConcreteF as ConcreteF'. - - local equiv CF_G1 : CF(D).main ~ G1(D).main : ={glob D} ==> !(G1.bcol \/ G1.bext){2} => ={res}. + equiv CF_G1 : CF(D).main ~ G1(D).main: + ={glob D} ==> !(G1.bcol \/ G1.bext){2} => ={res}. proof. proc. - call (_:(G1.bcol \/ G1.bext), INV_CF_G1 G1.handles{2} G1.chandle{2} CF.m{1} CF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} RO.m{2} G1.paths{2}). + call (_:(G1.bcol \/ G1.bext), INV_CF_G1 G1.handles{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} RO.m{2} G1.paths{2}). (* lossless D *) + apply D_ll. (** proofs for G1.S.f *) - (* equiv CF.P.f G1.S.f *) + (* equiv PF.P.f G1.S.f *) + proc;if{1}=>/=. (* x is not in m{1} so forall h, (x.1,h) is not in mh{2} *) + rcondt{2} 1. @@ -307,8 +307,8 @@ section PROOF. exists* RO.m{2}, G1.paths{2};elim*=>ro0 paths0. seq 1 2 : (!G1.bcol{2} /\ (G1.bext = mem (rng G1.handles) (x.`2, I)){2} /\ ={x,y} /\ - INV_CF_G1 G1.handles{2} G1.chandle{2} CF.m{1} CF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} ro0 paths0 /\ - ! mem (dom CF.m{1}) x{1} /\ + INV_CF_G1 G1.handles{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} ro0 paths0 /\ + ! mem (dom PF.m{1}) x{1} /\ (if mem (dom paths0) x.`2 then let (p,v) = oget paths0.[x.`2] in RO.m{2} = ro0.[rcons p (v+^x.`1) <- y.`1] /\ @@ -322,11 +322,11 @@ section PROOF. else RO.m{2} = ro0 /\ G1.paths{2} = paths0);1:smt ml=0. if{2};2:by auto=>/#. inline{2} RO.f;rcondt{2} 4. - + move=> &ml;auto=>/= &mr[][]_[][]_[]->[][][]_ Heqm _[]_[][]_ Hro[] Hpath _ HnCFm. + + move=> &ml;auto=>/= &mr[][]_[][]_[]->[][][]_ Heqm _[]_[][]_ Hro[] Hpath _ HnPFm. rewrite in_dom;case:(G1.paths{mr}.[_]) (Hpath x{mr}.`2)=>//[[p v]]/(_ p v)/=[h][]Hbu Hh b _. rewrite -not_def=> /Hro [??h'];rewrite oget_some Hbu => -[][]<- <- /=. rewrite Block.xorwA Block.xorwK Block.xorwC Block.xorw0 -not_def=>/Heqm [c c' f f']. - by rewrite Hh=> -[][]<- _[]_ Hm;move:HnCFm;rewrite in_dom;case:(x{mr}) Hm=> ??->. + by rewrite Hh=> -[][]<- _[]_ Hm;move:HnPFm;rewrite in_dom;case:(x{mr}) Hm=> ??->. swap{2} 3-2;swap{2}6-4;wp;conseq (_:y{1} =(rd,y2){2}). + progress [-split];rewrite getP_eq oget_some H2/=. by move:H2;rewrite in_dom;case:(G1.paths{2}.[_]). @@ -336,13 +336,13 @@ section PROOF. case (mem (rng G1.handles{2}) (x{2}.`2, I)). + conseq (_:true);[by move=> ??[][]_[]->_->|auto]. conseq (_: !G1.bcol{2} => - oget CF.m{1}.[x{1}] = y{2} /\ - INV_CF_G1 G1.handles{2} G1.chandle{2} CF.m{1} CF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} RO.m{2} G1.paths{2}). + oget PF.m{1}.[x{1}] = y{2} /\ + INV_CF_G1 G1.handles{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} RO.m{2} G1.paths{2}). + by move=> ??[][]_[]->[][]-> _ _ ->. seq 0 2: ((!G1.bcol{2} /\ ={x, y} /\ - INV_CF_G1 G1.handles{2} G1.chandle{2} CF.m{1} CF.mi{1} G1.m{2} G1.mi{2} + INV_CF_G1 G1.handles{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} ro0 paths0 /\ - ! mem (dom CF.m{1}) x{1} /\ + ! mem (dom PF.m{1}) x{1} /\ if mem (dom paths0) x{2}.`2 then let (p0, v0) = oget paths0.[x{2}.`2] in RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ @@ -366,21 +366,21 @@ section PROOF. (* Stopped here *) admit. admit. - (* lossless CF.P.f *) + (* lossless PF.P.f *) + admit. (* lossless and do not reset bad G1.S.f *) + admit. (** proofs for G1.S.fi *) - (* equiv CF.P.fi G1.S.fi *) + (* equiv PF.P.fi G1.S.fi *) + admit. - (* lossless CF.P.fi *) + (* lossless PF.P.fi *) + admit. (* lossless and do not reset bad G1.S.fi *) + admit. (** proofs for G1.C.f *) - (* equiv CF.C.f G1.C.f *) + (* equiv PF.C.f G1.C.f *) + admit. - (* lossless CF.C.f *) + (* lossless PF.C.f *) + admit. (* lossless and do not reset bad G1.C.f *) + admit. @@ -388,18 +388,33 @@ section PROOF. + admit. qed. - lemma Concrete_G1 &m: - Pr[RealIndif(SqueezelessSponge,Perm,D).main() @ &m: res] <= - Pr[G1(D).main() @ &m: res] + bound_concrete + Pr[G1(D).main() @&m: G1.bcol] + Pr[G1(D).main() @&m: G1.bext]. +end section AUX. + +section. + + declare module D: DISTINGUISHER{Perm, C, PF, G1}. + + 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] + bound_concrete + + Pr[G1(DRestr(D)).main() @&m: G1.bcol] + Pr[G1(DRestr(D)).main() @&m: G1.bext]. proof. - apply (RealOrder.ler_trans _ _ _ (Concrete_CF D &m)). - cut : Pr[CF(D).main() @ &m : res] <= - Pr[G1(D).main() @ &m : res] + Pr[G1(D).main() @ &m : G1.bcol \/ G1.bext]. - + by byequiv CF_G1 =>/#. - cut /# : Pr[G1(D).main() @ &m : G1.bcol \/ G1.bext] <= Pr[G1(D).main() @ &m : G1.bcol] + Pr[G1(D).main() @ &m : G1.bext]. + apply (RealOrder.ler_trans _ _ _ (Real_Concrete D D_ll &m)). + cut : Pr[CF(DRestr(D)).main() @ &m : res] <= + Pr[G1(DRestr(D)).main() @ &m : res] + + Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext]. + + byequiv (CF_G1 (DRestr(D)) _)=>//;1:by apply (DRestr_ll D D_ll). + smt ml=0. + cut /# : 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]. rewrite Pr [mu_or]; smt. qed. -end section PROOF. +end section. diff --git a/sha3/proof/old/SLCommon.ec b/sha3/proof/old/SLCommon.ec index 6cffd25..43df1f4 100644 --- a/sha3/proof/old/SLCommon.ec +++ b/sha3/proof/old/SLCommon.ec @@ -59,7 +59,7 @@ module SqueezelessSponge (P:DPRIMITIVE): FUNCTIONALITY = { proc f(p : block list): block = { var (sa,sc) <- (b0,c0); - if (1 <= size p /\ p <> [b0]) { + if (1 <= size p (*/\ p <> [b0]*)) { while (p <> []) { (* Absorption *) (sa,sc) <@ P.f((sa +^ head witness p,sc)); p <- behead p; @@ -206,3 +206,197 @@ proof. qed. +(* -------------------------------------------------------------------------- *) + +module C = { + var c:int + proc init () = { c <- 0; } +}. + +module PC (P:PRIMITIVE) = { + + proc init () = { + C.init(); + P.init(); + } + + proc f (x:state) = { + var y; + C.c <- C.c + 1; + y <@ P.f(x); + return y; + } + + proc fi(x:state) = { + var y; + C.c <- C.c + 1; + y <@ P.fi(x); + return y; + } + +}. + +module DPRestr (P:DPRIMITIVE) = { + + proc f (x:state) = { + var y=(b0,c0); + if (C.c + 1 <= max_size) { + C.c <- C.c + 1; + y <@ P.f(x); + } + return y; + } + + proc fi(x:state) = { + var y=(b0,c0); + if (C.c + 1 <= max_size) { + C.c <- C.c + 1; + y <@ P.fi(x); + } + 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; + C.c <- C.c + size bs; + b <@ F.f(bs); + return b; + } +}. + +module DFRestr(F:DFUNCTIONALITY) = { + + proc f (bs:block list) = { + var b= b0; + if (C.c + size bs <= max_size) { + C.c <- C.c + size bs; + b <@ F.f(bs); + } + return b; + } +}. + +module FRestr(F:FUNCTIONALITY) = { + + proc 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): islossless P.f => islossless DPRestr(P).f. +proof. move=>Hll;proc;sp;if=>//;call Hll;auto. qed. + +lemma rpi_ll (P<:DPRIMITIVE): islossless P.fi => islossless DPRestr(P).fi. +proof. move=>Hll;proc;sp;if=>//;call Hll;auto. qed. + +lemma rf_ll (F<:DFUNCTIONALITY): islossless F.f => islossless DFRestr(F).f. +proof. move=>Hll;proc;sp;if=>//;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. + +(* Exemple *) +(* +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=>//. + proc;inline *;wp;swap{1}1 2;sim. + qed. + +end RESTR. +*) + +section COUNT. + + declare module P:PRIMITIVE{C}. + declare module CO:CONSTRUCTION{C,P}. + declare module D:DISTINGUISHER{C,P,CO}. + + axiom f_ll : islossless P.f. + axiom fi_ll : islossless P.fi. + + axiom CO_ll : islossless CO(P).f. + + 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;swap{2}1 2. + call (_: max_size < C.c, ={glob P, glob CO, glob C}). + + apply D_ll. + + proc; sp 1 0;if{1};1:by call(_:true);auto. + by call{2} f_ll;auto=>/#. + + by move=> ?_;proc;sp;if;auto;call f_ll;auto. + + by move=> _;proc;call f_ll;auto=>/#. + + proc;sp 1 0;if{1};1:by call(_:true);auto. + by call{2} fi_ll;auto=>/#. + + by move=> ?_;proc;sp;if;auto;call fi_ll;auto. + + by move=> _;proc;call fi_ll;auto=>/#. + + proc;sp 1 0;if{1};1:by call(_: ={glob P});auto;sim. + by call{2} CO_ll;auto=>/#. + + by move=> ?_;proc;sp;if;auto;call CO_ll;auto. + + move=> _;proc;call CO_ll;auto;smt ml=0 w=size_ge0. + wp;call (_:true);call(_:true);auto=>/#. + qed. + +end section COUNT. + +(* -------------------------------------------------------------------------- *) +(** The initial Game *) +module GReal(D:DISTINGUISHER) = RealIndif(SqueezelessSponge, PC(Perm), D). + From 2077ae16c3c3486664256c38339315c015888962 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 11 Dec 2015 10:08:25 +0100 Subject: [PATCH 079/394] rename file --- sha3/proof/old/{G1.eca => Handle.eca} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename sha3/proof/old/{G1.eca => Handle.eca} (100%) diff --git a/sha3/proof/old/G1.eca b/sha3/proof/old/Handle.eca similarity index 100% rename from sha3/proof/old/G1.eca rename to sha3/proof/old/Handle.eca From 3b29596e0cbb7aefd42dde5e403e18db28920ea4 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 11 Dec 2015 14:52:29 +0100 Subject: [PATCH 080/394] minors fix (dead code, missing initialization), duplicate with stdlib --- sha3/proof/old/Handle.eca | 10 +++++----- sha3/proof/old/SLCommon.ec | 2 +- sha3/proof/old/Utils.ec | 19 ------------------- 3 files changed, 6 insertions(+), 25 deletions(-) diff --git a/sha3/proof/old/Handle.eca b/sha3/proof/old/Handle.eca index 42c8fc6..354c31e 100644 --- a/sha3/proof/old/Handle.eca +++ b/sha3/proof/old/Handle.eca @@ -124,18 +124,18 @@ module G1(D:DISTINGUISHER) = { return y; } - (** Distinguisher interface **) - proc init() = { } - } proc main(): bool = { var b; + RO.m <- map0; m <- map0; mi <- map0; + mh <- map0; + mhi <- map0; bext <- false; - bcol <- false; + bcol <- false; (* the empty path is initially known by the adversary to lead to capacity 0^c *) handles <- map0.[0 <- (c0, D)]; @@ -280,7 +280,7 @@ proof. by apply handles_up_handles. qed. -clone import ConcreteF as ConcreteF1. +clone export ConcreteF as ConcreteF1. section AUX. diff --git a/sha3/proof/old/SLCommon.ec b/sha3/proof/old/SLCommon.ec index 43df1f4..c1f6648 100644 --- a/sha3/proof/old/SLCommon.ec +++ b/sha3/proof/old/SLCommon.ec @@ -23,7 +23,7 @@ clone include Indifferentiability with (** max number of call to the permutation and its inverse, including those performed by the construction. *) -op max_size : int. +op max_size : { int | 0 <= max_size } as max_ge0. (** Ideal Functionality **) clone export Tuple as TupleBl with diff --git a/sha3/proof/old/Utils.ec b/sha3/proof/old/Utils.ec index 8ec5b44..549d1ac 100644 --- a/sha3/proof/old/Utils.ec +++ b/sha3/proof/old/Utils.ec @@ -1,25 +1,6 @@ (** These should make it into the standard libs **) require import Option Pair List FSet NewFMap. -(* -------------------------------------------------------------------- *) - -lemma rem_id (x : 'a) (m : ('a,'b) fmap): - !mem (dom m) x => rem x m = m. -proof. - rewrite in_dom /= => x_notin_m; apply/fmapP=> x'; rewrite remP. - case (x' = x)=> //= ->>. - by rewrite x_notin_m. -qed. - -lemma dom_rem_le (x : 'a) (m : ('a,'b) fmap) (x' : 'a): - mem (dom (rem x m)) x' => mem (dom m) x'. -proof. by rewrite dom_rem in_fsetD. qed. - -lemma rng_rem_le (x : 'a) (m : ('a,'b) fmap) (x' : 'b): - mem (rng (rem x m)) x' => mem (rng m) x'. -proof. by rewrite rng_rm in_rng=> -[x0] [_ h]; exists x0. qed. - - (* -------------------------------------------------------------------- *) (* In NewFMap *) From 8d278d1caaf25807c18e63cc7c053838b04a1032 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 11 Dec 2015 14:52:56 +0100 Subject: [PATCH 081/394] start bounding the 2 bad events --- sha3/proof/old/G2.eca | 286 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 286 insertions(+) create mode 100644 sha3/proof/old/G2.eca diff --git a/sha3/proof/old/G2.eca b/sha3/proof/old/G2.eca new file mode 100644 index 0000000..2eb8483 --- /dev/null +++ b/sha3/proof/old/G2.eca @@ -0,0 +1,286 @@ +require import Pred Fun Option Pair Int Real StdOrder Ring. +require import List FSet NewFMap Utils Common SLCommon. +(*...*) import Dprod Dexcepted Capacity IntOrder. + +require Handle. + +clone import Handle as Handle0. + +(* -------------------------------------------------------------------------- *) +section PROOF. + declare module D: DISTINGUISHER{C, PF, G1}. + + 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 (rng G1.handles)) <= 2*max_size) { + c <$ cdistr; + G1.bcol <- G1.bcol \/ mem (image fst (rng G1.handles)) c; + count <- count + 1; + } + return c; + } + + module C = { + + proc f(p : block list): block = { + var sa, sa', sc; + var h, i <- 0; + sa <- b0; + if (1 <= size p /\ p <> [b0]) { + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + sc <@ sample_c(); + sa' <- RO.f(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.handles.[G1.chandle] <- (sc,I); + G1.chandle <- G1.chandle + 1; + } + i <- i + 1; + } + sa <- RO.f(p); + } + return sa; + } + } + + module S = { + + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2; + + if (!mem (dom G1.m) x) { + if (!(mem (rng G1.handles) (x.`2, D))) { + G1.handles.[G1.chandle] <- (x.`2, D); + G1.chandle <- G1.chandle + 1; + } + hx2 <- oget (hinvD G1.handles x.`2); + + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + y1 <- RO.f (rcons p (v +^ x.`1)); + y2 <@ sample_c(); + y <- (y1, y2); + G1.paths.[y2] <- (rcons p (v +^ x.`1), y.`1); + } else { + y1 <$ bdistr; + y2 <@ sample_c(); + y <- (y1,y2); + } + (* exists x2 h, G1.handles.[h] = Some (X2,I) *) + + if (mem (dom G1.mh) (x.`1, hx2) /\ + (oget G1.handles.[(oget G1.mh.[(x.`1,hx2)]).`2]).`2 = I) { + hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; + y <- (y.`1, (oget G1.handles.[hy2]).`1); + G1.handles.[hy2] <- (y.`2, D); + (* bad <- bad \/ mem X2 y.`2; *) + G1.m.[x] <- y; + G1.mi.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + G1.handles.[hy2] <- (y.`2, D); + G1.m.[x] <- y; + G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); + G1.mi.[y] <- x; + G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget G1.m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2, hx2, hy2; + + if (!mem (dom G1.mi) x) { + if (!(mem (rng G1.handles) (x.`2, D))) { + G1.handles.[G1.chandle] <- (x.`2, D); + G1.chandle <- G1.chandle + 1; + } + hx2 <- oget (hinvD G1.handles x.`2); + y1 <$ bdistr; + y2 <@ sample_c(); + y <- (y1,y2); + if (mem (dom G1.mhi) (x.`1, hx2) /\ + (oget G1.handles.[(oget G1.mh.[(x.`1,hx2)]).`2]).`2 = I) { + (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; + y <- (y.`1, (oget G1.handles.[hy2]).`1); + G1.handles.[hy2] <- (y.`2, D); + (* bad <- bad \/ mem X2 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 { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + G1.handles.[hy2] <- (y.`2, D); + 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; + + RO.m <- map0; + G1.m <- map0; + G1.mi <- map0; + G1.mh <- map0; + G1.mhi <- map0; + G1.bcol <- false; + + G1.handles <- map0.[0 <- (c0, D)]; + G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.chandle <- 1; + count <- 0; + b <@ DRestr(D,C,S).distinguish(); + return b; + } + }. + + lemma card_rng_set (m:('a,'b)fmap) x y: card(rng m.[x<-y]) <= card(rng m) + 1. + proof. + rewrite rng_set fcardU fcard1. + cut := subset_leq_fcard (rng (rem x m)) (rng m) _;2:smt ml=0 w=fcard_ge0. + rewrite subsetP=> z;apply rng_rem_le. + qed. + + lemma hinv_image handles c: + hinv handles c <> None => + mem (image fst (rng handles)) c. + proof. + case: (hinv handles c) (hinvP handles c)=>//= h[f] Heq. + rewrite imageP;exists (c,f)=>@/fst/=. + by rewrite in_rng;exists (oget (Some h)). + qed. + + local equiv G1col : G1(DRestr(D)).main ~ Gcol.main : + ={glob D} ==> (G1.bcol{1} => G1.bcol{2}) /\ Gcol.count{2} <= max_size. + proof. + proc;inline*;wp. + call (_: ={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles,C.c}/\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (rng G1.handles) <= 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. + seq 2 2 : (={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles, + C.c,x0} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card(rng G1.handles) + 2 <= 2*C.c + 1/\ + Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. + if=>//;last by auto=>/#. + swap{1}[2..4]-1. + seq 3 2:(={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles, + C.c,x0,hx2} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (rng G1.handles) + 1 <= 2 * C.c + 1/\ + Gcol.count + 1 <= C.c <= max_size){2}). + + auto;smt ml=0 w=card_rng_set. + seq 1 1: + (={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles, + C.c,x0,hx2,y0} /\ + ((G1.bcol\/hinv G1.handles y0.`2 <> None){1} => G1.bcol{2}) /\ + (card (rng G1.handles) + 1 <= 2 * C.c + 1 /\ + Gcol.count <= C.c <= max_size){2});last by auto;smt ml=0 w=card_rng_set. + if=>//;inline Gcol.sample_c. + + rcondt{2}4. + + auto;conseq (_:true)=>//;progress. + cut /#:= fcard_image_leq fst (rng G1.handles{hr}). + wp;conseq (_: ={p,v,RO.m,y1} /\ y2{1}=c{2})=>//;1:smt ml=0 w=hinv_image. + by sim. + rcondt{2}3. + + by auto;progress;cut /#:= fcard_image_leq fst (rng G1.handles{hr}). + swap{2}2-1;sp 0 1;wp;conseq(_:y0{1}=(y1,c){2})=>//;1:smt ml=0 w=hinv_image. + transitivity{1} {y0 <- S.sample();} + (true ==> ={y0}) + (true ==> y0{1}=(y1,c){2})=>//;1:by inline*;auto. + transitivity{2} {(y1,c) <- S.sample2();} + (true==>y0{1}=(y1,c){2}) + (true==> ={y1,c})=>//;2:by inline*;auto. + by call sample_sample2;auto=> /=?[??]->. + + + proc;sp 1 1;if=>//. + inline G1(DRestr(D)).S.fi Gcol.S.fi. + seq 2 2 : (={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles, + C.c,x0} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card(rng G1.handles) + 2 <= 2*C.c + 1 /\ + Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. + if=>//;last by auto=>/#. + seq 3 2:(={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles, + C.c,x0,hx2} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (rng G1.handles) + 1 <= 2 * C.c + 1 /\ + Gcol.count + 1 <= C.c <= max_size){2}). + + auto;smt ml=0 w=card_rng_set. + seq 1 2: + (={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles, + C.c,x0,hx2} /\ y0{1} = (y1,y2){2} /\ + ((G1.bcol\/hinv G1.handles y0.`2 <> None){1} => G1.bcol{2}) /\ + (card (rng G1.handles) + 1 <= 2 * C.c + 1 /\ + Gcol.count <= C.c <= max_size){2});last by auto;smt ml=0 w=card_rng_set. + inline Gcol.sample_c. + rcondt{2}3. + + by auto;progress;cut /#:= fcard_image_leq fst (rng G1.handles{hr}). + swap{2}2-1;sp 0 1;wp;conseq(_:y0{1}=(y1,c){2})=>//;1:smt ml=0 w=hinv_image. + transitivity{1} {y0 <- S.sample();} + (true ==> ={y0}) + (true ==> y0{1}=(y1,c){2})=>//;1:by inline*;auto. + transitivity{2} {(y1,c) <- S.sample2();} + (true==>y0{1}=(y1,c){2}) + (true==> ={y1,c})=>//;2:by inline*;auto. + by call sample_sample2;auto=> /=?[??]->. + + + proc;sp 1 1;if=>//. + inline G1(DRestr(D)).C.f Gcol.C.f. + seq 5 5: + (={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles,C.c,b, + p,h,i,sa} /\ i{1}=0 /\ + (G1.bcol{1} => G1.bcol{2}) /\ + card (rng G1.handles{2}) + 2*(size p{2}) <= 2 * C.c{2} + 1 /\ + Gcol.count{2} + size p{2} <= C.c{2} <= max_size);1:by auto=>/#. + wp;if=>//;2:by auto;smt ml=0 w=size_ge0. + call (_: ={RO.m});1:by sim. + while + (={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles,C.c,b, + p,h,i,sa} /\ (i <= size p){1} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (rng G1.handles) + 2*(size p - i) <= 2 * C.c + 1 /\ + Gcol.count + size p - i <= C.c <= max_size){2}); + last by auto; smt ml=0 w=size_ge0. + if=>//;auto;1:smt ml=0 w=size_ge0. + call (_: ={RO.m});1:by sim. + inline *;rcondt{2} 2. + + auto;progress;cut /#:= fcard_image_leq fst (rng G1.handles{hr}). + auto;smt ml=0 w=(hinv_image card_rng_set). + + auto;progress;3:by smt ml=0. + + by rewrite rng_set rem0 rng0 fset0U fcard1. + by apply max_ge0. + qed. + From debfea6d94c38b5618ee75deea6c908ff58dacd5 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 11 Dec 2015 16:49:22 +0100 Subject: [PATCH 082/394] use fel to bound the probability. --- sha3/proof/old/G2.eca | 45 ++++++++++++++++++++++++++++++++++++++----- 1 file changed, 40 insertions(+), 5 deletions(-) diff --git a/sha3/proof/old/G2.eca b/sha3/proof/old/G2.eca index 2eb8483..b7d61bd 100644 --- a/sha3/proof/old/G2.eca +++ b/sha3/proof/old/G2.eca @@ -1,6 +1,6 @@ -require import Pred Fun Option Pair Int Real StdOrder Ring. -require import List FSet NewFMap Utils Common SLCommon. -(*...*) import Dprod Dexcepted Capacity IntOrder. +require import Pred Fun Option Pair Int Real StdOrder Ring StdBigop. +require import List FSet NewFMap Utils Common SLCommon FelTactic Mu_mem. +(*...*) import Dprod Dexcepted Capacity IntOrder Bigreal RealOrder BRA. require Handle. @@ -20,11 +20,13 @@ section PROOF. proc sample_c () = { var c=c0; - if (card (image fst (rng G1.handles)) <= 2*max_size) { + if (card (image fst (rng G1.handles)) <= 2*max_size /\ + count < max_size) { c <$ cdistr; G1.bcol <- G1.bcol \/ mem (image fst (rng G1.handles)) c; count <- count + 1; } + return c; } @@ -209,7 +211,7 @@ section PROOF. Gcol.count <= C.c <= max_size){2});last by auto;smt ml=0 w=card_rng_set. if=>//;inline Gcol.sample_c. + rcondt{2}4. - + auto;conseq (_:true)=>//;progress. + + auto;conseq (_:true)=>//;progress;2: smt ml=0. cut /#:= fcard_image_leq fst (rng G1.handles{hr}). wp;conseq (_: ={p,v,RO.m,y1} /\ y2{1}=c{2})=>//;1:smt ml=0 w=hinv_image. by sim. @@ -284,3 +286,36 @@ section PROOF. by apply max_ge0. qed. + (* TODO: move this *) + lemma c_gt0r : 0%r < (2^c)%r. + proof. by rewrite from_intM;apply /powPos. qed. + + local lemma eps_ge0 : 0%r <= (2 * max_size)%r / (2 ^ c)%r. + proof. + apply divr_ge0;1:by rewrite from_intMle;smt ml=0 w=max_ge0. + by apply /ltrW/c_gt0r. + 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 (rng G1.handles)) <= 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 from_intMle;smt ml=0 w=max_ge0. + + proc;sp;if;2:by hoare=>//??;apply eps_ge0. + wp. + rnd (mem (image fst (rng G1.handles)));skip;progress;2:smt ml=0. + rewrite (Mu_mem.mu_mem (image fst (rng G1.handles{hr})) cdistr (1%r/(2^c)%r))//. + + move=>x _;apply DWord.muxP. + rewrite (div_def (2 * _)%r) 1:from_intMeq;1:by apply /IntOrder.lt0r_neq0/powPos. + apply ler_wpmul2r;2:by rewrite from_intMle. + by apply divr_ge0=>//;apply /ltrW/c_gt0r. + + move=>ci;proc;rcondt 2;auto=>/#. + move=> b c;proc;sp;if;auto;smt ml=0. + qed. + +end section PROOF. From 4e425a2aa0ab8adacf9ae6823cf4bbe2461f5a56 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 11 Dec 2015 17:02:41 -0500 Subject: [PATCH 083/394] Tracking Benjamin's changes to Indifferentiability.eca. Because of the introduction/use of DPRIMITIVE and DFUNCTIONALITY, almost everything wasn't checking. Now constructions and simulators *don't* have access to the init procedure of their arguments, but they are still required to provide init procedures themselves. (It's in Indif.main that they are called.) Also made the version of IRO that uses a RO from [from * int] to [to] be the official implementation. --- sha3/proof/Absorb.ec | 5 +- sha3/proof/AbsorbToBlocks.ec | 17 ++--- sha3/proof/Blocks.ec | 6 +- sha3/proof/BlocksToTopLevel.ec | 27 +++++--- sha3/proof/IRO.eca | 103 ++++++++++++++++++++--------- sha3/proof/Indifferentiability.eca | 2 +- sha3/proof/TopLevel.ec | 10 +-- 7 files changed, 107 insertions(+), 63 deletions(-) diff --git a/sha3/proof/Absorb.ec b/sha3/proof/Absorb.ec index 31978ef..bdbbc80 100644 --- a/sha3/proof/Absorb.ec +++ b/sha3/proof/Absorb.ec @@ -25,11 +25,10 @@ clone include Indifferentiability with [module] "Indif" as "Experiment" [module] "GReal" as "RealIndif" [module] "GIdeal" as "IdealIndif". - (* -------------------------------------------------------------------- *) -module BlockSponge (P : PRIMITIVE) : RO, CONSTRUCTION(P) = { - proc init = P.init +module BlockSponge (P : DPRIMITIVE) : FUNCTIONALITY, CONSTRUCTION(P) = { + proc init() = {} proc f(p : block list): block = { var (sa,sc) <- (b0, Capacity.c0); diff --git a/sha3/proof/AbsorbToBlocks.ec b/sha3/proof/AbsorbToBlocks.ec index 8122a2a..b21bcb3 100644 --- a/sha3/proof/AbsorbToBlocks.ec +++ b/sha3/proof/AbsorbToBlocks.ec @@ -8,8 +8,8 @@ require import Common. op cast: 'a NewDistr.distr -> 'a distr. (* -------------------------------------------------------------------- *) -module LowerFun(F : Blocks.FUNCTIONALITY) : Absorb.FUNCTIONALITY = { - proc init = F.init +module LowerFun(F : Blocks.DFUNCTIONALITY) : Absorb.DFUNCTIONALITY = { + proc init() = {} proc f(xs : block list) : block = { var (ys, n) <- strip xs; @@ -22,10 +22,10 @@ module LowerFun(F : Blocks.FUNCTIONALITY) : Absorb.FUNCTIONALITY = { } }. -module Sim (S : Absorb.SIMULATOR, F : Blocks.FUNCTIONALITY) = S(LowerFun(F)). +module Sim (S : Absorb.SIMULATOR, F : Blocks.DFUNCTIONALITY) = S(LowerFun(F)). -module UpperFun (F : Absorb.FUNCTIONALITY) = { - proc init = F.init +module UpperFun (F : Absorb.DFUNCTIONALITY) = { + proc init() = {} proc f(xs : block list, n : int) : block list = { var y <- b0; @@ -43,9 +43,10 @@ module UpperFun (F : Absorb.FUNCTIONALITY) = { } }. -module BlocksOfAbsorbBlockSponge (P : Blocks.PRIMITIVE) = UpperFun(Absorb.BlockSponge(P)). +module BlocksOfAbsorbBlockSponge (P : Blocks.DPRIMITIVE) = + UpperFun(Absorb.BlockSponge(P)). -module Dist ( D : Blocks.DISTINGUISHER, F : Absorb.FUNCTIONALITY, P : Absorb.PRIMITIVE ) = D(UpperFun(F),P). +module Dist (D : Blocks.DISTINGUISHER, F : Absorb.DFUNCTIONALITY) = D(UpperFun(F)). section. declare module AbsorbSim : Absorb.SIMULATOR { Perm, Blocks.BIRO.IRO', Absorb.Ideal.RO }. @@ -232,7 +233,7 @@ section. by conseq ModularAbsorb=> &1 &2; case (arg{1}); case (arg{2}). inline *; wp;call (_: true)=> //=. auto; progress [-split]; split=> //=. - smt. + admit. done. qed. diff --git a/sha3/proof/Blocks.ec b/sha3/proof/Blocks.ec index bdc4d2b..fb20873 100644 --- a/sha3/proof/Blocks.ec +++ b/sha3/proof/Blocks.ec @@ -24,8 +24,8 @@ clone include Indifferentiability with [module] "GIdeal" as "IdealIndif". (* -------------------------------------------------------------------- *) -module BlockSponge (P : PRIMITIVE) : BIRO.IRO, CONSTRUCTION(P) = { - proc init = P.init +module BlockSponge (P : DPRIMITIVE) : FUNCTIONALITY, CONSTRUCTION(P) = { + proc init() = {} proc f(p : block list, n : int) : block list = { var z <- []; @@ -56,6 +56,6 @@ lemma top: exists (S <: SIMULATOR), forall (D <: DISTINGUISHER) &m, `| Pr[RealIndif(BlockSponge, Perm, D).main() @ &m : res] - - Pr[IdealIndif(IRO', S, D).main() @ &m : res]| + - Pr[IdealIndif(IRO, S, D).main() @ &m : res]| < eps. proof. admit. qed. diff --git a/sha3/proof/BlocksToTopLevel.ec b/sha3/proof/BlocksToTopLevel.ec index 94aff60..e9b159a 100644 --- a/sha3/proof/BlocksToTopLevel.ec +++ b/sha3/proof/BlocksToTopLevel.ec @@ -6,8 +6,8 @@ require (*--*) Blocks TopLevel. require import Common. (* -------------------------------------------------------------------- *) -module UpperFun (F : Blocks.FUNCTIONALITY) = { - proc init = F.init +module UpperFun (F : Blocks.DFUNCTIONALITY) = { + proc init() = {} proc f(p : bool list, n : int) = { var xs; @@ -17,8 +17,8 @@ module UpperFun (F : Blocks.FUNCTIONALITY) = { } }. -module LowerFun (F : TopLevel.FUNCTIONALITY) = { - proc init = F.init +module LowerFun (F : TopLevel.DFUNCTIONALITY) = { + proc init() = {} proc f(xs : block list, n : int) = { var cs, ds : bool list; @@ -43,18 +43,23 @@ proof. admit. (* done *) qed. -module ModularSimulator (S : Blocks.SIMULATOR, F : TopLevel.FUNCTIONALITY) = S(LowerFun(F)). +module ModularSimulator (S : Blocks.SIMULATOR, F : TopLevel.DFUNCTIONALITY) = + S(LowerFun(F)). -module BlocksDist ( D : TopLevel.DISTINGUISHER, F : Blocks.FUNCTIONALITY, P : PRIMITIVE) = - D(UpperFun(F),P). +module BlocksDist (D : TopLevel.DISTINGUISHER, F : Blocks.DFUNCTIONALITY) = + D(UpperFun(F)). section. declare module BlocksSim : Blocks.SIMULATOR. declare module TopLevelDist : TopLevel.DISTINGUISHER. lemma Conclusion &m: - `|Pr[TopLevel.RealIndif(TopLevel.Sponge,Perm,TopLevelDist).main() @ &m: res] - - Pr[TopLevel.IdealIndif(TopLevel.BIRO.IRO',ModularSimulator(BlocksSim),TopLevelDist).main() @ &m: res]| - = `|Pr[Blocks.RealIndif(Blocks.BlockSponge,Perm,BlocksDist(TopLevelDist)).main() @ &m: res] - - Pr[Blocks.IdealIndif(Blocks.BIRO.IRO',BlocksSim,BlocksDist(TopLevelDist)).main() @ &m: res]|. + `|Pr[TopLevel.RealIndif(TopLevel.Sponge, Perm, TopLevelDist).main() @ &m: res] - + Pr[TopLevel.IdealIndif(TopLevel.BIRO.IRO, ModularSimulator(BlocksSim), + TopLevelDist).main() @ &m: res]| = + `|Pr[Blocks.RealIndif(Blocks.BlockSponge, Perm, + BlocksDist(TopLevelDist)).main() @ &m: res] - + Pr[Blocks.IdealIndif(Blocks.BIRO.IRO, BlocksSim, + BlocksDist(TopLevelDist)).main() @ &m: res]|. proof. admit. qed. +end section. diff --git a/sha3/proof/IRO.eca b/sha3/proof/IRO.eca index a138d16..d2a1cf0 100644 --- a/sha3/proof/IRO.eca +++ b/sha3/proof/IRO.eca @@ -16,38 +16,6 @@ module type IRO = { proc f(x : from, n : int) : to list }. -module IRO : IRO = { - var mp : (from, to list) fmap - - proc init() = { mp = map0; } - - proc choose(n) = { - var b, bs; - - bs <- []; - while (0 < n) { - b <$ dto; - bs <- rcons bs b; - n <- n - 1; - } - return bs; - } - - proc f(x, n) = { - var ys, zs, aout; - - aout <- []; - if (valid x) { - ys <- odflt [] mp.[x]; - zs <@ choose (max 0 (n - size ys)); - mp.[x] <- ys ++ zs; - aout <- take n (oget mp.[x]); - } - - return aout; - } -}. - pred prefix_closed (m : (from * int,to) fmap) = forall x n, mem (dom m) (x,n) => @@ -63,6 +31,41 @@ pred prefix_closed' (m : (from * int,to) fmap) = lemma cool m: prefix_closed m <=> prefix_closed' m by []. +(* official version: *) + +module IRO : IRO = { + var mp : (from * int, to) fmap + + proc init() = { + mp <- map0; + } + + proc fill_in(x, n) = { + if (!mem (dom mp) (x, n)) { + mp.[(x,n)] <$ dto; + } + 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 @@ -118,4 +121,38 @@ module IRO' : IRO = { } }. -(** The two are equivalent **) \ No newline at end of file +(* +another implementation, but probably not useful + +module IRO : IRO = { + var mp : (from, to list) fmap + + proc init() = { mp = map0; } + + proc choose(n) = { + var b, bs; + + bs <- []; + while (0 < n) { + b <$ dto; + bs <- rcons bs b; + n <- n - 1; + } + return bs; + } + + proc f(x, n) = { + var ys, zs, aout; + + aout <- []; + if (valid x) { + ys <- odflt [] mp.[x]; + zs <@ choose (max 0 (n - size ys)); + mp.[x] <- ys ++ zs; + aout <- take n (oget mp.[x]); + } + + return aout; + } +}. +*) diff --git a/sha3/proof/Indifferentiability.eca b/sha3/proof/Indifferentiability.eca index 14c871f..d0cf65e 100644 --- a/sha3/proof/Indifferentiability.eca +++ b/sha3/proof/Indifferentiability.eca @@ -36,7 +36,7 @@ module type CONSTRUCTION (P : DPRIMITIVE) = { }. module type SIMULATOR (F : DFUNCTIONALITY) = { - proc init() : unit { (* F.init *) } + proc init() : unit { } proc f(x : p) : p { F.f } proc fi(x : p) : p { F.f } }. diff --git a/sha3/proof/TopLevel.ec b/sha3/proof/TopLevel.ec index 2d724c5..39ee761 100644 --- a/sha3/proof/TopLevel.ec +++ b/sha3/proof/TopLevel.ec @@ -24,8 +24,8 @@ clone include Indifferentiability with (* -------------------------------------------------------------------- *) -module Sponge (P : PRIMITIVE) : BIRO.IRO, CONSTRUCTION(P) = { - proc init = P.init +module Sponge (P : DPRIMITIVE) : FUNCTIONALITY, CONSTRUCTION(P) = { + proc init() : unit = {} proc f(bp : bool list, n : int) : bool list = { var z <- []; @@ -52,10 +52,12 @@ module Sponge (P : PRIMITIVE) : BIRO.IRO, CONSTRUCTION(P) = { (* -------------------------------------------------------------------- *) op eps : real. +print RealIndif. + lemma top: exists (S <: SIMULATOR), forall (D <: DISTINGUISHER) &m, - `| Pr[Experiment(Sponge(Perm), Perm, D).main() @ &m : res] - - Pr[Experiment(IRO, S(IRO), D).main() @ &m : res]| + `| Pr[RealIndif(Sponge, Perm, D).main() @ &m : res] + - Pr[IdealIndif(IRO, S, D).main() @ &m : res]| < eps. proof. admit. qed. From fb85ef792a10bab47881854fe2bc3b1bb1f88f33 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 14 Dec 2015 12:43:40 +0100 Subject: [PATCH 084/394] some intermediary stuff. --- sha3/proof/old/G2.eca | 238 ++++++++- sha3/proof/old/Handle.eca | 7 +- sha3/proof/old/MyRO.ec | 1003 +++++++++++++++++++++++++++++++++++++ 3 files changed, 1236 insertions(+), 12 deletions(-) create mode 100644 sha3/proof/old/MyRO.ec diff --git a/sha3/proof/old/G2.eca b/sha3/proof/old/G2.eca index b7d61bd..3c91e0e 100644 --- a/sha3/proof/old/G2.eca +++ b/sha3/proof/old/G2.eca @@ -6,6 +6,10 @@ require Handle. clone import Handle as Handle0. + + +(* + (* -------------------------------------------------------------------------- *) section PROOF. declare module D: DISTINGUISHER{C, PF, G1}. @@ -81,14 +85,11 @@ section PROOF. y2 <@ sample_c(); y <- (y1,y2); } - (* exists x2 h, G1.handles.[h] = Some (X2,I) *) - if (mem (dom G1.mh) (x.`1, hx2) /\ - (oget G1.handles.[(oget G1.mh.[(x.`1,hx2)]).`2]).`2 = I) { + in_dom_with G1.handles (oget G1.mh.[(x.`1,hx2)]).`2 I) { hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; y <- (y.`1, (oget G1.handles.[hy2]).`1); G1.handles.[hy2] <- (y.`2, D); - (* bad <- bad \/ mem X2 y.`2; *) G1.m.[x] <- y; G1.mi.[y] <- x; } else { @@ -119,11 +120,10 @@ section PROOF. y2 <@ sample_c(); y <- (y1,y2); if (mem (dom G1.mhi) (x.`1, hx2) /\ - (oget G1.handles.[(oget G1.mh.[(x.`1,hx2)]).`2]).`2 = I) { + in_dom_with G1.handles (oget G1.mhi.[(x.`1,hx2)]).`2 I) { (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; y <- (y.`1, (oget G1.handles.[hy2]).`1); G1.handles.[hy2] <- (y.`2, D); - (* bad <- bad \/ mem X2 y.`2; *) G1.mi.[x] <- y; G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); G1.m.[y] <- x; @@ -290,10 +290,13 @@ section PROOF. lemma c_gt0r : 0%r < (2^c)%r. proof. by rewrite from_intM;apply /powPos. qed. + lemma c_ge0r : 0%r <= (2^c)%r. + proof. by apply /ltrW/c_gt0r. qed. + local lemma eps_ge0 : 0%r <= (2 * max_size)%r / (2 ^ c)%r. proof. apply divr_ge0;1:by rewrite from_intMle;smt ml=0 w=max_ge0. - by apply /ltrW/c_gt0r. + by apply c_ge0r. qed. local lemma Pr_col &m : @@ -313,9 +316,228 @@ section PROOF. + move=>x _;apply DWord.muxP. rewrite (div_def (2 * _)%r) 1:from_intMeq;1:by apply /IntOrder.lt0r_neq0/powPos. apply ler_wpmul2r;2:by rewrite from_intMle. - by apply divr_ge0=>//;apply /ltrW/c_gt0r. + by apply divr_ge0=>//;apply /c_ge0r. + move=>ci;proc;rcondt 2;auto=>/#. move=> b c;proc;sp;if;auto;smt ml=0. qed. end section PROOF. +*) + +module type SAMPLE = { + proc sampleI(h:handle) : unit + proc setD(h:handle, c:capacity) : unit + proc get(h:handle) : capacity + proc in_dom(h:handle,c:caller) : bool + proc restrD() : (handle,capacity)fmap +}. + +module type ADV_SAMPLEH(O:SAMPLE) = { + proc main() : bool +}. + + +module Lsample = { + var handles : (handle, ccapacity)fmap + + proc sampleI(h:handle) = { + var c; + c <$ cdistr; + handles.[h] <- (c,I); + } + + proc setD (h:handle, c:capacity) = { + handles.[h] <- (c,D); + } + + proc in_dom(h:handle, c:caller) = { + return in_dom_with handles h c; + } + + proc restrD() = { + return ( + let m = NewFMap.filter (fun _ (p:ccapacity) => p.`2=D) handles in + NewFMap.map (fun _ (p:ccapacity) => p.`1) m); + } + + proc get(h:handle) = { + var c; + c <$ cdistr; + if (!mem (dom handles) h) { + handles.[h] <- (c,D); + } + return (oget (handles.[h])).`1; + } + +}. + +module Esample = { + var handles : (handle, ccapacity)fmap + + proc sampleI(h:handle) = { + var c; + c <$ cdistr; + handles.[h] <- (c,I); + } + + proc setD (h:handle, c:capacity) = { + handles.[h] <- (c,D); + } + + proc in_dom(h:handle, c:caller) = { + return in_dom_with handles h c; + } + + proc restrD() = { + return ( + let m = NewFMap.filter (fun _ (p:ccapacity) => p.`2=D) handles in + NewFMap.map (fun _ (p:ccapacity) => p.`1) m); + } + + proc get(h:handle) = { + var c; + c <$ cdistr; + if (!mem (dom handles) h || (oget handles.[h]).`2 = I) { + handles.[h] <- (c,D); + } + return (oget (handles.[h])).`1; + } + +}. + +op hinvc (handles : (handle,capacity)fmap) (c : capacity) : handle option = + find (fun _ => pred1 c) handles. + +module G2(D:DISTINGUISHER,HS:SAMPLE) = { + + module C = { + + proc f(p : block list): block = { + var sa, sa'; + var h, i <- 0; + sa <- b0; + if (1 <= size p /\ p <> [b0]) { + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + HS.sampleI(G1.chandle); + sa' <- RO.f(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; + } + i <- i + 1; + } + sa <- RO.f(p); + } + return sa; + } + } + + module S = { + + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2, handles_,t; + + if (!mem (dom G1.m) x) { + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + y1 <- RO.f (rcons p (v +^ x.`1)); + y2 <$ cdistr; + y <- (y1, y2); + G1.paths.[y2] <- (rcons p (v +^ x.`1), y.`1); + } else { + y <$ dstate; + } +(* G1.bext <- G1.bext \/ mem (rng handles) (x.`2, I); *) + (* exists x2 h, handles.[h] = Some (X2,I) *) + handles_ <@ HS.restrD(); + if (!mem (rng handles_) x.`2) { + HS.setD(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <- HS.restrD(); + hx2 <- oget (hinvc handles_ x.`2); + t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, I); + if (mem (dom G1.mh) (x.`1, hx2) /\ t) { + hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; + y2 <@ HS.get(hy2); + y <- (y.`1, y2); + (* bad <- bad \/ mem X2 y.`2; *) + G1.m.[x] <- y; + G1.mi.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + HS.setD(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); + } + } else { + y <- oget G1.m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2, hx2, hy2, handles_, t; + + if (!mem (dom G1.mi) x) { + (* bext <- bext \/ mem (rng handles) (x.`2, I); *) + (* exists x2 h, handles.[h] = Some (X2,I) *) + handles_ <@ HS.restrD(); + if (!mem (rng handles_) x.`2) { + HS.setD(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <@ HS.restrD(); + hx2 <- oget (hinvc handles_ x.`2); + y <$ dstate; + t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, I); + if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { + (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; + y2 <@ HS.get(hy2); + y <- (y.`1, y2); + (* bad <- bad \/ mem X2 y.`2; *) + G1.mi.[x] <- y; + G1.m.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + HS.setD(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 main(): bool = { + var b; + + RO.m <- map0; + G1.m <- map0; + G1.mi <- map0; + G1.mh <- map0; + G1.mhi <- map0; + G1.bext <- false; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + HS.setD(0,c0); + G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.chandle <- 1; + b <@ D(C,S).distinguish(); + return b; + } +}. \ No newline at end of file diff --git a/sha3/proof/old/Handle.eca b/sha3/proof/old/Handle.eca index 354c31e..a5f2b18 100644 --- a/sha3/proof/old/Handle.eca +++ b/sha3/proof/old/Handle.eca @@ -64,7 +64,7 @@ module G1(D:DISTINGUISHER) = { chandle <- chandle + 1; } hx2 <- oget (hinvD handles x.`2); - if (mem (dom mh) (x.`1, hx2) /\ (oget handles.[(oget mh.[(x.`1,hx2)]).`2]).`2 = I) { + if (mem (dom mh) (x.`1, hx2) /\ in_dom_with handles (oget mh.[(x.`1,hx2)]).`2 I) { hy2 <- (oget mh.[(x.`1, hx2)]).`2; y <- (y.`1, (oget handles.[hy2]).`1); handles.[hy2] <- (y.`2, D); @@ -99,15 +99,14 @@ module G1(D:DISTINGUISHER) = { } hx2 <- oget (hinvD handles x.`2); y <$ dstate; - if (mem (dom mhi) (x.`1, hx2) /\ (oget handles.[(oget mh.[(x.`1,hx2)]).`2]).`2 = I) { + if (mem (dom mhi) (x.`1,hx2) /\ + in_dom_with handles (oget mhi.[(x.`1,hx2)]).`2 I) { (y1,hy2) <- oget mhi.[(x.`1, hx2)]; y <- (y.`1, (oget handles.[hy2]).`1); handles.[hy2] <- (y.`2, D); (* bad <- bad \/ mem X2 y.`2; *) mi.[x] <- y; - mhi.[(x.`1, hx2)] <- (y.`1, hy2); m.[y] <- x; - mh.[(y.`1, hy2)] <- (x.`1, hx2); } else { bcol <- bcol \/ hinv handles y.`2 <> None; hy2 <- chandle; diff --git a/sha3/proof/old/MyRO.ec b/sha3/proof/old/MyRO.ec new file mode 100644 index 0000000..59aaaab --- /dev/null +++ b/sha3/proof/old/MyRO.ec @@ -0,0 +1,1003 @@ +require import Option List FSet NewFMap. + import NewLogic. + +abstract theory Titer. + +type t. + +module type Orcl = { + proc f (x:t) : unit +}. + +module Iter (O:Orcl) = { + proc iter(l:t list) = { + while (l <> []) { + O.f(head witness l); + l <- drop 1 l; + } + } +}. + +section. + +declare module O:Orcl. + +axiom iter_swap1 i1 i2: + equiv [Iter(O).iter ~ Iter(O).iter : + l{1} = [i1;i2] /\ l{2} = [i2;i1] /\ ={glob O} ==> ={glob O}]. + +lemma iter_swap s1 i s2: + equiv [Iter(O).iter ~ Iter(O).iter : + l{1} = i::s1++s2 /\ l{2} = s1++i::s2 /\ ={glob O} ==> ={glob O}]. +proof. + elim:s1=> /=[|i' s1 Hrec];1:by sim. + transitivity Iter(O).iter + (l{1}= i :: i' :: (s1 ++ s2) /\ l{2} = i' :: i :: (s1 ++ s2) /\ ={glob O} ==> + ={glob O}) + (l{1}= i' :: i :: (s1 ++ s2) /\ l{2} = i' :: (s1 ++ i::s2) /\ ={glob O} ==> + ={glob O})=>//. + + by move=> ?&ml[*]<*>;exists (glob O){ml}, (i' :: i :: (s1 ++ s2)). + + proc;rcondt{1}1=>//;rcondt{2}1=>//. + rcondt{1}3;1:by auto;conseq(_: true). + rcondt{2}3;1:by auto;conseq(_: true). + seq 4 4 : (={l,glob O});last by sim. + transitivity{1} {Iter(O).iter([i;i']); l <- drop 2 l;} + (l{1} = i :: i' :: (s1 ++ s2) /\ ={l, glob O} ==> ={l,glob O}) + (l{1} = i :: i' :: (s1 ++ s2) /\ + l{2} = i' :: i :: (s1 ++ s2) /\ ={glob O} ==> ={l,glob O})=>//. + + by move=>?&ml[*]<*>;exists (glob O){ml}, (i :: i' :: (s1 ++ s2)). + + inline *;rcondt{2} 2;1:by auto. + rcondt{2} 4;1:by auto;sp;conseq(_:true). + rcondf{2} 6; auto;call(_:true);wp;call(_:true);auto. + transitivity{1} {Iter(O).iter([i';i]); l <- drop 2 l;} + (l{1} = i :: i' :: (s1 ++ s2) /\ + l{2} = i' :: i :: (s1 ++ s2) /\ ={glob O} ==> ={l,glob O}) + (l{2} = i' :: i :: (s1 ++ s2) /\ ={l, glob O} ==> ={l,glob O})=>//. + + by move=>?&ml[*]<*>;exists (glob O){ml}, (i' :: i :: (s1 ++ s2)). + + wp; by call (iter_swap1 i i'). + (* call iter_swap1: FIXME catch exception *) + inline *;rcondt{1} 2;1:by auto. + rcondt{1} 4;1:by auto;sp;conseq(_:true). + rcondf{1} 6; auto;call(_:true);wp;call(_:true);auto. + proc;rcondt{1}1=>//;rcondt{2}1=>//. + seq 2 2 : (l{1} = i :: (s1 ++ s2) /\ l{2} = s1 ++ i :: s2 /\ ={glob O}). + + by wp;call(_:true);auto;progress;rewrite drop0. + transitivity{1} {Iter(O).iter(l); } + (={l,glob O} /\ l{1}= i::(s1++s2) ==> ={glob O}) + (={glob O} /\ l{1}=i::(s1++s2) /\ l{2}= (s1++i::s2) ==> ={glob O})=>//. + + by move=>?&ml[*]<*>;exists (glob O){ml}, (i :: (s1 ++ s2)). + + by inline *;sim. + transitivity{1} {Iter(O).iter(l); } + (={glob O} /\ l{1}=i::(s1++s2) /\ l{2}= (s1++i::s2) ==> ={glob O}) + (={l,glob O} /\ l{2}= (s1++i::s2) ==> ={glob O})=>//. + + by move=>?&ml[*]<*>;exists (glob O){ml}, (s1 ++ i::s2). + + by call Hrec;auto. + by inline*;sim. +qed. + +lemma iter_perm : + equiv [Iter(O).iter ~ Iter(O).iter : perm_eq l{1} l{2} /\ ={glob O} ==> ={glob O}]. +proof. + exists*l{1},l{2};elim*=>l1 l2;case (perm_eq l1 l2)=> Hp;last first. + + conseq (_:false==>_)=>// ??[*]//. + elim: l1 l2 Hp=> [|i s1 ih] s2 eq_s12 /=. + + have ->: s2 = [] by apply/perm_eq_small/perm_eq_sym. + proc;rcondf{1} 1=>//;rcondf{2} 1=>//. + have/perm_eq_mem/(_ i) := eq_s12; rewrite mem_head /=. + move/splitPr => [s3 s4] ->>. + transitivity Iter(O).iter + (l{1}=i::s1 /\ l{2}=i::(s3++s4) /\ ={glob O} ==> ={glob O}) + (l{1}=i::(s3++s4) /\ l{2}=s3++i::s4 /\ ={glob O} ==> ={glob O})=>//. + + by move=>?&ml[*]-> -> _ ->; exists (glob O){ml}, (i :: (s3 ++ s4)). + + proc;rcondt{1}1=>//;rcondt{2}1=>//. + seq 2 2: (s1 = l{1} /\ l{2}=s3++s4 /\ ={glob O}). + + by wp;call(_:true);auto;progress;rewrite drop0. + transitivity{1} {Iter(O).iter(l); } + (={l,glob O} ==> ={glob O}) + (s1 = l{1} /\ l{2} = s3 ++ s4 /\ ={glob O} ==> ={glob O})=>//. + + by move=>?&ml[*]-> -> ->;exists (glob O){ml}, l{1}. + + by inline Iter(O).iter;sim. + transitivity{1} {Iter(O).iter(l); } + (s1 = l{1} /\ l{2} = s3 ++ s4 /\ ={glob O} ==> ={glob O}) + (={l,glob O} ==> ={glob O}) =>//. + + by move=>?&ml[*]-> -> ->;exists (glob O){ml}, (s3++s4). + + move: eq_s12; rewrite -(cat1s i s4) catA perm_eq_sym. + rewrite perm_catCA /= perm_cons perm_eq_sym=> Hp. + + call (ih (s3++s4) Hp)=>//. + by inline Iter(O).iter;sim. + by apply (iter_swap s3 i s4). (* FIXME: apply iter_swap fail! *) +qed. + +end section. + +end Titer. + +type flag = [ Unknown | Known ]. + +abstract theory Ideal. + +type from, to. + +op sampleto : from -> to distr. + +module type RO = { + proc init () : unit + proc get (x : from) : to + proc set (x : from, y : to) : unit + proc sample(x : from) : unit + proc in_dom(x : from,f : flag) : bool + proc restrK() : (from,to)fmap +}. + +module type Distinguisher(G : RO) = { + proc distinguish(): bool +}. + +op in_dom_with (m:(from, to * flag)fmap) (x:from) (f:flag) = + mem (dom m) x /\ (oget (m.[x])).`2 = f. + +op restr f (m:(from, to * flag)fmap) = + let m = filter (fun _ (p:to*flag) => p.`2=f) m in + map (fun _ (p:to*flag) => p.`1) m. + +lemma restrP m f x: + (restr f m).[x] = + obind (fun (p:to*flag)=>if p.`2=f then Some p.`1 else None) m.[x]. +proof. + rewrite /restr /= mapP filterP in_dom /=. + by case (m.[x])=>//= -[x0 f'];rewrite oget_some /=;case (f' = f). +qed. + +lemma restr_dom m f x: + mem (dom(restr f m)) x <=> (mem (dom m) x /\ (oget m.[x]).`2 = f). +proof. + rewrite !in_dom;case: (m.[x]) (restrP m f x)=>//= -[t f'] /=. + by rewrite oget_some /=;case (f' = f)=> [_ ->|]. +qed. + +lemma restr_set_diff f2 f1 m x y: + !mem (dom m) x => + f2 <> f1 => restr f1 m.[x<-(y,f2)] = restr f1 m. +proof. + rewrite fmapP in_dom=>/= Hdom Hf x';rewrite !restrP getP. + by case (x' = x)=>//=->;rewrite Hf Hdom. +qed. + +module RO : RO = { + var m : (from, to * flag)fmap + + proc init () = { m <- map0; } + + proc get(x:from) = { + var r; + r <$ sampleto x; + if (mem (dom m) x) r <- (oget m.[x]).`1; + m.[x] <- (r,Known); + return r; + } + + proc set (x:from, y:to) = { + m.[x] <- (y,Known); + } + + proc sample(x:from) = { + var c; + c <$ sampleto x; + m.[x] <- (c,Unknown); + } + + proc in_dom(x:from, f:flag) = { + return in_dom_with m x f; + } + + proc restrK() = { + return restr Known m; + } +}. + +section LL. + +lemma init_ll : islossless RO.init. +proof. by proc;auto. qed. + +lemma in_dom_ll : islossless RO.in_dom. +proof. by proc. qed. + +lemma restrK_ll : islossless RO.restrK. +proof. by proc. qed. + +lemma set_ll : islossless RO.set. +proof. by proc;auto. qed. + +axiom sampleto_ll : forall x, Distr.weight (sampleto x) = 1%r. + +lemma get_ll : islossless RO.get. +proof. by proc;auto;progress;apply sampleto_ll. qed. + +lemma sample_ll : islossless RO.sample. +proof. by proc;auto;progress;apply sampleto_ll. qed. + +end section LL. + +end Ideal. + +abstract theory GenEager. + +clone include Ideal. + +axiom sampleto_ll : forall x, Distr.weight (sampleto x) = 1%r. + +clone include Titer with type t <- from. + +module ERO : RO = { + + proc init = RO.init + + proc get(x:from) = { + var r; + r <$ sampleto x; + if (!mem (dom RO.m) x || (oget RO.m.[x]).`2 = Unknown) { + RO.m.[x] <- (r,Known); + } + return (oget RO.m.[x]).`1; + } + + proc set = RO.set + + proc sample = RO.sample + + proc in_dom = RO.in_dom + + proc restrK = RO.restrK + + module I = { + proc f = sample + } + + proc resample () = { + Iter(I).iter (elems (dom (restr Unknown RO.m))); + } + +}. + +lemma set_eq (m:('a,'b)fmap) x y: m.[x] = Some y => m.[x<-y] = m. +proof. + by rewrite fmapP=> Hx x';rewrite getP;case (x'=x)=>//->;rewrite Hx. +qed. + +lemma eager_get : + eager [ERO.resample(); , RO.get ~ ERO.get, ERO.resample(); : + ={x,RO.m} ==> ={res,RO.m} ]. +proof. + eager proc. + wp;case ((mem (dom RO.m) x /\ (oget RO.m.[x]).`2=Known){1}). + + rnd{1};rcondf{2} 2;1:by auto=> /#. + alias{1} 1 mx = oget RO.m.[x];inline *. + while (={l,RO.m} /\ (!mem l x /\ RO.m.[x] = Some (mx.`1,Known)){1}). + + auto=>?&ml[*]-> ->;case (l{ml})=>//=x2 l2 Hmx Hgx?->. + by rewrite getP drop0 /#. + auto=>??[*]-> ->/= Hmem HK;rewrite sampleto_ll/==> r _. + rewrite -memE restr_dom Hmem/= HK. + rewrite {1}get_oget //= -HK;case:(oget _)HK=> x1?/=->. + by move=>????-> _[*]_-> _ Heq?;rewrite in_dom set_eq Heq. + rcondt{2} 2. + auto=> ?[*]-> ->;rewrite negb_and /#. + case ((mem (dom RO.m) x){1}). + + inline{1} ERO.resample=>/=. + transitivity{1} { Iter(ERO.I).iter(x::elems ((dom (restr Unknown RO.m)) `\` fset1 x)); + r <$ sampleto x; } + (={x,RO.m} /\ mem (dom RO.m{1}) x{1} /\ (oget RO.m{1}.[x{1}]).`2 = Unknown ==> + ={x,RO.m}) + (={x,RO.m} /\ mem (dom RO.m{1}) x{1} /\ (oget RO.m{1}.[x{1}]).`2 = Unknown==> + ={x} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ + RO.m{1}.[x{2}] = Some (result{2},Unknown) /\ + RO.m{2}.[x{2}] = Some (result{2},Known)). + + by move=>?&ml[*]-> -> ??;exists RO.m{ml}, x{ml}=>/#. + + move=>???;rewrite in_dom=>[*]<*>[*]->/eq_except_sym H Hxm Hx2. + rewrite Hxm oget_some /=;apply /eq_sym. + have /(congr1 oget):= Hx2 => <-;apply eq_except_set_eq=>//. + by rewrite in_dom Hx2. + + rnd;call (iter_perm ERO.I _). + + + + + + cut ->: (result{2}, Known) = oget RO.m{2}.[x{2}]. + + + search eq_except. + set_eq. + 1:Hx. +;rewrite H=>{H}. + + <- ((oget RO.m{1}.[x{1}]).`1, Known)] = RO.m{2} + mem (dom RO.m{1} x{1} + + transitivity{1} { work <- dom RO.m; + r <$ sampleto x; + while (work <> fset0) { + x0 <- pick work; + if (in_dom_with RO.m x0 Unknown) { + c <$ sampleto x0; + RO.m.[x0] <- (if x0 = x then r else c, Unknown); + } + work <- work `\` fset1 (pick work); + } } + (={x,RO.m} ==> ={x,RO.m}) + (={x,RO.m} /\ (mem (dom RO.m) x /\ (oget RO.m.[x]).`2 = Unknown){1} ==> + ={x} /\ RO.m{1} = RO.m{2}.[x{2}<-(result{2}, Unknown)] /\ + RO.m{2}.[x{2}] = Some(result{2}, Known)). + + move=>?&mr[*]-> ->??;exists RO.m{mr},x{mr}=>/#. + + move=>?&m?[2*]-> -> <- ->_. + by rewrite in_dom getP_eq oget_some set_set set_eq. + + seq 1 1:(={work,x,RO.m});[by sim|symmetry]. + eager while (H:r<$sampleto x; ~ r<$sampleto x; : ={x} ==> ={r})=>//;1,3:by sim. + swap{1}2-1;sp 1 1. + if{2};[rcondt{1}2|rcondf{1}2];1,3,4:by auto. + by rnd{2};wp;case ((x0 = x){1});[rnd{1}|];auto=>??[*]-> -> -> -> ->_ _ _->; + rewrite sampleto_ll. + alias{1} 1 cx = (oget RO.m.[x]).`1. + while (={work,x,r} /\ mem (dom RO.m{1}) x{1} /\ (RO.m.[x]=Some(r,Known)){2}/\ + RO.m{1} = (RO.m.[x<-(if mem work x then cx{1} else r, Unknown)]){2}). + + sp 1 1;case ((x0 = x){1}). + + rcondt{1} 1. by auto;progress;rewrite getP_eq oget_some;case (mem _ _). + rcondf{2} 1. by auto=> @/in_dom_with;progress;rewrite H0. + auto=> ??[*]_-> -> -> ->?-> ->?_<-/=;rewrite sampleto_ll=>c _. + by rewrite dom_set !inE /= set_set. + if=>//. auto;progress[-split]. by rewrite /in_dom_with dom_set getP !inE H3. + + auto;progress [-split];split=>// _. + by rewrite dom_set !inE H/= getP set_set (eq_sym x{2}) H3 H0. + by auto;progress;rewrite !inE (eq_sym x{2}) H3. + auto;progress [-split];rewrite H1 /=. + rewrite dom_set fsetUC subset_fsetU_id /=. + + by move=> x;rewrite inE. + rewrite H getP_eq /= set_set /= set_eq. + + by rewrite {1}get_oget // -H0;case (oget _). + by move=> ????-> ->/=[*];rewrite !inE oget_some. + inline *;swap{1} 3 -2. + admit. +(* + (* Admit *) + while (={work,x,r} /\ (RO.m.[x]=None){1} /\ + RO.m{2} = RO.m{1}.[x{2}<-(r{2},Known)] /\ + !mem work{2} x{2}). + + wp;sp 1 1;if. auto=> ??[*]-> -> -> Hex Hmem Heq Hx _ /= ?->/=. + rewrite !inE Hmem !getP Heq /=. + cut ^Hd->/=: x{2} <> pick work{2} by smt ml=0 w=mem_pick. + by rewrite Hex set_set Hd. + auto=>??/=[*]-> -> _ ^Hdom;rewrite in_dom=>/=Hnone?->;rewrite restr_set_diff//=. + by rewrite Hnone /= restr_dom Hdom=>????-> ->[*];rewrite in_dom getP_eq. *) +qed. + +search "_.[_<-_]". + search + auto=> ??/=[*]-> -> _ Hmem/=?->/=;rewrite restr_set_diff //=. + rewrite eq_except_sym set_eq_except restr_dom Hmem getP_eq=>????->_ [*]. + + rewrite Hmem. + + get_eq. + + transitivity{2} { + +=>-[->//|/#]. + + + {1}(get_oget m_R x{2}). +print get_oget. +search "_.[_]" "_.[_<-_]". +print restrK. + + +smt. + H /=;smt. + case ((!mem work x){1}). + + swap{1} 2 -1;while (={work,x} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ + (!mem work x){1} /\ (RO.m.[x] = Some rd){2} /\ (!mem (dom RO.m) x){1}). + + inline *;auto;progress [-split]. + cut -> : mem (dom RO.m{2}) (pick work{2}) = mem (dom RO.m{1}) (pick work{2}) by rewrite !in_dom;smt. + smt. + auto;progress [-split];rewrite !getP_eq;smt. + inline RO.f. + transitivity{1} { rd <$ sample x; + while (work <> fset0) { + x0 <- pick work; + rd0 <$ sample x0; + if (!mem (dom RO.m) x0) + RO.m.[x0] <- if x0 = x then rd else rd0; + work <- work `\` fset1 (pick work); + } } + (={x,work,RO.m} ==> ={x,RO.m}) + ((={x,work,RO.m} /\ mem work{1} x{1}) /\ ! mem (dom RO.m{2}) x{2} ==> + ={x,RO.m} /\ (result = oget RO.m.[x]){2} /\ mem (dom RO.m{1}) x{1}) => //. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. + + transitivity{1} { while (work <> fset0) { + x0 <- pick work; + rd0 <$ sample x0; + if (!mem (dom RO.m) x0) RO.m.[x0] <- rd0; + work <- work `\` fset1 (pick work); + } + rd <$ sample x; } + (={x,work,RO.m} ==> ={x,RO.m}) + (={x,work,RO.m} ==> ={x,RO.m})=> //. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. + + by sim; rnd{2}; sim : (={x,IND_Eager.H.m}); smt. + symmetry; eager while (H: rd <$ sample x; ~ rd <$ sample x; : ={x} ==> ={rd})=> //; sim. + swap{2} 5 -4; swap [2..3] -1; case ((x = pick work){1}). + + by wp; rnd{2}; rnd; rnd{1}; wp; skip; smt. + by auto; smt. + + while (={x, work} /\ + (!mem work x => mem (dom RO.m) x){1} /\ + RO.m.[x]{2} = Some rd{1} /\ + if (mem (dom RO.m) x){1} then ={RO.m} + else eq_except RO.m{1} RO.m{2} (fset1 x{1})). + + auto;progress; 1..9,12:smt. + + case ((pick work = x){2})=> pick_x; last smt. + subst x{2}; move: H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. + by apply fmapP=> x0; case (pick work{2} = x0); smt. + by auto; smt. + by auto;progress [-split];rewrite H0 /= getP_eq;smt. + + + + + + + + + + + + + + module IND_S(D:Distinguisher) = { + proc main(): bool = { + var b; + RO.init(); + b <@ D(RO).distinguish(); + ERO.sample(); + return b; + } + }. + + section EAGER. + + local lemma eager_query: + eager [ERO.sample(); , RO.f ~ ERO.f, ERO.sample(); : + ={x,RO.m} ==> ={res,RO.m} ]. + proof. + eager proc. + inline ERO.sample;swap{2} 4 -3. + seq 1 1: (={x,work,RO.m});first by sim. + wp;case ((mem (dom RO.m) x){1}). + + rnd{1}. + alias{1} 1 mx = oget RO.m.[x]. + while (={work,RO.m} /\ (RO.m.[x] = Some mx){1}). + + by inline *;auto;progress;smt. + auto;progress [- split]; rewrite sample_ll H /=;smt. + case ((!mem work x){1}). + + swap{1} 2 -1;while (={work,x} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ + (!mem work x){1} /\ (RO.m.[x] = Some rd){2} /\ (!mem (dom RO.m) x){1}). + + inline *;auto;progress [-split]. + cut -> : mem (dom RO.m{2}) (pick work{2}) = mem (dom RO.m{1}) (pick work{2}) by rewrite !in_dom;smt. + smt. + auto;progress [-split];rewrite !getP_eq;smt. + inline RO.f. + transitivity{1} { rd <$ sample x; + while (work <> fset0) { + x0 <- pick work; + rd0 <$ sample x0; + if (!mem (dom RO.m) x0) + RO.m.[x0] <- if x0 = x then rd else rd0; + work <- work `\` fset1 (pick work); + } } + (={x,work,RO.m} ==> ={x,RO.m}) + ((={x,work,RO.m} /\ mem work{1} x{1}) /\ ! mem (dom RO.m{2}) x{2} ==> + ={x,RO.m} /\ (result = oget RO.m.[x]){2} /\ mem (dom RO.m{1}) x{1}) => //. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. + + transitivity{1} { while (work <> fset0) { + x0 <- pick work; + rd0 <$ sample x0; + if (!mem (dom RO.m) x0) RO.m.[x0] <- rd0; + work <- work `\` fset1 (pick work); + } + rd <$ sample x; } + (={x,work,RO.m} ==> ={x,RO.m}) + (={x,work,RO.m} ==> ={x,RO.m})=> //. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. + + by sim; rnd{2}; sim : (={x,IND_Eager.H.m}); smt. + symmetry; eager while (H: rd <$ sample x; ~ rd <$ sample x; : ={x} ==> ={rd})=> //; sim. + swap{2} 5 -4; swap [2..3] -1; case ((x = pick work){1}). + + by wp; rnd{2}; rnd; rnd{1}; wp; skip; smt. + by auto; smt. + + while (={x, work} /\ + (!mem work x => mem (dom RO.m) x){1} /\ + RO.m.[x]{2} = Some rd{1} /\ + if (mem (dom RO.m) x){1} then ={RO.m} + else eq_except RO.m{1} RO.m{2} (fset1 x{1})). + + auto;progress; 1..9,12:smt. + + case ((pick work = x){2})=> pick_x; last smt. + subst x{2}; move: H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. + by apply fmapP=> x0; case (pick work{2} = x0); smt. + by auto; smt. + by auto;progress [-split];rewrite H0 /= getP_eq;smt. + qed. + + equiv Eager_S (D <: Distinguisher{RO}): IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. + proof. + proc; inline ERO.init RO.init. + seq 1 1: (={glob D, RO.m});first by wp. + symmetry; eager (H: ERO.sample(); ~ ERO.sample();: ={RO.m} ==> ={RO.m}): + (={glob D, RO.m}) => //; first by sim. + eager proc H (={RO.m}) => //; [by apply eager_query | by sim]. + qed. + + equiv Eager (D <: Distinguisher{RO}): IND(RO,D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. + proof. + transitivity IND_S(D).main + (={glob D} ==> ={res,glob D}) + (={glob D} ==> ={res,RO.m,glob D}) => //. + + by progress;exists (glob D){2}. + + proc;inline{2} ERO.sample. + while{2} true (card work{2}). + + move=> &m1 z;wp;call (f_ll sample_ll);auto;smt. + conseq (_: _ ==> ={b,glob D}) => //;[smt | by sim]. + apply (Eager_S D). + qed. + + end section EAGER. + +end GenIdeal. + + + + + + + + + + + + + + + +abstract theory + + +module type SAMPLE = { + proc sampleI(h:handle) : unit + proc setD(h:handle, c:capacity) : unit + proc get(h:handle) : capacity + proc in_dom(h:handle,c:caller) : bool + proc restrD() : (handle,capacity)fmap +}. + +module type ADV_SAMPLEH(O:SAMPLE) = { + proc main() : bool +}. + + + +module Esample = { + var handles : (handle, ccapacity)fmap + + proc sampleI(h:handle) = { + var c; + c <$ cdistr; + handles.[h] <- (c,I); + } + + proc setD (h:handle, c:capacity) = { + handles.[h] <- (c,D); + } + + proc in_dom(h:handle, c:caller) = { + return in_dom_with handles h c; + } + + proc restrD() = { + return ( + let m = NewFMap.filter (fun _ (p:ccapacity) => p.`2=D) handles in + NewFMap.map (fun _ (p:ccapacity) => p.`1) m); + } + + proc get(h:handle) = { + var c; + c <$ cdistr; + if (!mem (dom handles) h || (oget handles.[h]).`2 = I) { + handles.[h] <- (c,D); + } + return (oget (handles.[h])).`1; + } + +}. + + + + + + + + +type from, to. + +module type RO = { + proc init() : unit + proc f(x : from): to +}. + +module type Distinguisher(G : RO) = { + proc distinguish(): bool {G.f} +}. + +module IND(G:RO, D:Distinguisher) = { + proc main(): bool = { + var b; + + G.init(); + b <@ D(G).distinguish(); + return b; + } +}. + +abstract theory Ideal. + + op sample : from -> to distr. + + module RO = { + var m : (from, to) fmap + + proc init() : unit = { + m <- map0; + } + + proc f(x : from) : to = { + var rd; + rd <$ sample x; + if (! mem (dom m) x) m.[x] <- rd; + return oget m.[x]; + } + }. + + section LL. + + axiom sample_ll : forall x, Distr.weight (sample x) = 1%r. + + lemma f_ll : phoare[RO.f : true ==> true] = 1%r. + proof. proc;auto;progress;apply sample_ll. qed. + + end section LL. + +end Ideal. + + +abstract theory GenIdeal. + + clone include Ideal. + axiom sample_ll : forall x, Distr.weight (sample x) = 1%r. + + op RO_dom : from fset. + + module ERO = { + proc sample() = { + var work; + work <- RO_dom; + while (work <> fset0) { + RO.f(pick work); + work = work `\` fset1 (pick work); + } + } + + proc init() = { + RO.m <- map0; + sample(); + } + + proc f = RO.f + }. + + module IND_S(D:Distinguisher) = { + proc main(): bool = { + var b; + RO.init(); + b <@ D(RO).distinguish(); + ERO.sample(); + return b; + } + }. + + section EAGER. + + local lemma eager_query: + eager [ERO.sample(); , RO.f ~ ERO.f, ERO.sample(); : + ={x,RO.m} ==> ={res,RO.m} ]. + proof. + eager proc. + inline ERO.sample;swap{2} 4 -3. + seq 1 1: (={x,work,RO.m});first by sim. + wp;case ((mem (dom RO.m) x){1}). + + rnd{1}. + alias{1} 1 mx = oget RO.m.[x]. + while (={work,RO.m} /\ (RO.m.[x] = Some mx){1}). + + by inline *;auto;progress;smt. + auto;progress [- split]; rewrite sample_ll H /=;smt. + case ((!mem work x){1}). + + swap{1} 2 -1;while (={work,x} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ + (!mem work x){1} /\ (RO.m.[x] = Some rd){2} /\ (!mem (dom RO.m) x){1}). + + inline *;auto;progress [-split]. + cut -> : mem (dom RO.m{2}) (pick work{2}) = mem (dom RO.m{1}) (pick work{2}) by rewrite !in_dom;smt. + smt. + auto;progress [-split];rewrite !getP_eq;smt. + inline RO.f. + transitivity{1} { rd <$ sample x; + while (work <> fset0) { + x0 <- pick work; + rd0 <$ sample x0; + if (!mem (dom RO.m) x0) + RO.m.[x0] <- if x0 = x then rd else rd0; + work <- work `\` fset1 (pick work); + } } + (={x,work,RO.m} ==> ={x,RO.m}) + ((={x,work,RO.m} /\ mem work{1} x{1}) /\ ! mem (dom RO.m{2}) x{2} ==> + ={x,RO.m} /\ (result = oget RO.m.[x]){2} /\ mem (dom RO.m{1}) x{1}) => //. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. + + transitivity{1} { while (work <> fset0) { + x0 <- pick work; + rd0 <$ sample x0; + if (!mem (dom RO.m) x0) RO.m.[x0] <- rd0; + work <- work `\` fset1 (pick work); + } + rd <$ sample x; } + (={x,work,RO.m} ==> ={x,RO.m}) + (={x,work,RO.m} ==> ={x,RO.m})=> //. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. + + by sim; rnd{2}; sim : (={x,IND_Eager.H.m}); smt. + symmetry; eager while (H: rd <$ sample x; ~ rd <$ sample x; : ={x} ==> ={rd})=> //; sim. + swap{2} 5 -4; swap [2..3] -1; case ((x = pick work){1}). + + by wp; rnd{2}; rnd; rnd{1}; wp; skip; smt. + by auto; smt. + + while (={x, work} /\ + (!mem work x => mem (dom RO.m) x){1} /\ + RO.m.[x]{2} = Some rd{1} /\ + if (mem (dom RO.m) x){1} then ={RO.m} + else eq_except RO.m{1} RO.m{2} (fset1 x{1})). + + auto;progress; 1..9,12:smt. + + case ((pick work = x){2})=> pick_x; last smt. + subst x{2}; move: H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. + by apply fmapP=> x0; case (pick work{2} = x0); smt. + by auto; smt. + by auto;progress [-split];rewrite H0 /= getP_eq;smt. + qed. + + equiv Eager_S (D <: Distinguisher{RO}): IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. + proof. + proc; inline ERO.init RO.init. + seq 1 1: (={glob D, RO.m});first by wp. + symmetry; eager (H: ERO.sample(); ~ ERO.sample();: ={RO.m} ==> ={RO.m}): + (={glob D, RO.m}) => //; first by sim. + eager proc H (={RO.m}) => //; [by apply eager_query | by sim]. + qed. + + equiv Eager (D <: Distinguisher{RO}): IND(RO,D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. + proof. + transitivity IND_S(D).main + (={glob D} ==> ={res,glob D}) + (={glob D} ==> ={res,RO.m,glob D}) => //. + + by progress;exists (glob D){2}. + + proc;inline{2} ERO.sample. + while{2} true (card work{2}). + + move=> &m1 z;wp;call (f_ll sample_ll);auto;smt. + conseq (_: _ ==> ={b,glob D}) => //;[smt | by sim]. + apply (Eager_S D). + qed. + + end section EAGER. + +end GenIdeal. + +abstract theory FiniteIdeal. + + clone include Ideal. + axiom sample_ll (x : from): Distr.weight (sample x) = 1%r. + + op univ : from fset. + axiom univP (x:from) : mem univ x. + + module ERO = { + proc sample() = { + var work; + work <- univ; + while (work <> fset0) { + RO.f(pick work); + work = work `\` fset1 (pick work); + } + } + + proc init() = { + RO.m <- map0; + sample(); + } + + proc f(x:from):to = { return oget RO.m.[x]; } + }. + + module IND_S(D:Distinguisher) = { + proc main(): bool = { + var b; + RO.init(); + b <@ D(RO).distinguish(); + ERO.sample(); + return b; + } + }. + + section EAGER. + + declare module D: Distinguisher { RO }. + + local clone GenIdeal as GI with + op sample <- sample, + op RO_dom <- univ + proof sample_ll by apply sample_ll. + + local equiv ERO_main: + IND(GI.ERO, D).main ~ IND(ERO, D).main : ={glob D} ==> ={res, glob D} /\ GI.RO.m{1} = RO.m{2}. + proof. + proc. + call (_:GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ). + + proc; rcondf{1} 2;auto;progress;[ by rewrite H univP | by apply sample_ll]. + inline *. + while (={work} /\ GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ `\` work{2});auto;smt. + qed. + + equiv Eager_S : IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. + proof. + transitivity GI.IND_S(D).main + (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) + (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. + + by progress;exists (glob D){2}. + + by sim. + transitivity IND(GI.ERO,D).main + (={glob D} ==> ={res,glob D, GI.RO.m}) + (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. + + by progress;exists (glob D){2}. + + by conseq (GI.Eager_S D). + by apply ERO_main. + qed. + + equiv Eager : IND(RO, D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. + proof. + transitivity IND(GI.RO,D).main + (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) + (={glob D} ==> ={res,glob D}) => //. + + by progress;exists (glob D){2}. + + by sim. + transitivity IND(GI.ERO,D).main + (={glob D} ==> ={res,glob D}) + (={glob D} ==> ={res,glob D}) => //. + + by progress;exists (glob D){2}. + + by conseq (GI.Eager D). + by conseq ERO_main. + qed. + + end section EAGER. + +end FiniteIdeal. + + +abstract theory RestrIdeal. + + clone include Ideal. + axiom sample_ll (x : from): Distr.weight (sample x) = 1%r. + + op test : from -> bool. + op univ : from fset. + op dfl : to. + + axiom testP x : test x <=> mem univ x. + + module Restr (O:RO) = { + proc init = RO.init + proc f (x:from) : to = { + var r <- dfl; + if (test x) r <@ RO.f(x); + return r; + } + }. + + module ERO = { + proc sample() = { + var work; + work <- univ; + while (work <> fset0) { + RO.f(pick work); + work = work `\` fset1 (pick work); + } + } + + proc init() = { + RO.m <- map0; + sample(); + } + + proc f(x:from):to = { + return (if test x then oget RO.m.[x] else dfl); + } + }. + + module IND_S(D:Distinguisher) = { + proc main(): bool = { + var b; + RO.init(); + b <@ D(Restr(RO)).distinguish(); + ERO.sample(); + return b; + } + }. + + section EAGER. + + declare module D: Distinguisher { RO }. + + local clone GenIdeal as GI with + op sample <- sample, + op RO_dom <- univ. + + local module Restr' (O:RO) = { + proc init() = { } + proc f(x:from) = { + var r <- dfl; + if (test x) r <@ O.f(x); + return r; + } + }. + + local module RD (O:RO) = D(Restr'(O)). + + local equiv ERO_main: + IND(GI.ERO, RD).main ~ IND(ERO, D).main : ={glob D} ==> ={res, glob D} /\ GI.RO.m{1} = RO.m{2}. + proof. + proc. + call (_:GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ). + + proc. + case (test x{1});[ rcondt{1} 2 | rcondf{1} 2];auto;last smt ml=0. + by inline *;rcondf{1} 4;auto;progress;2:(by apply sample_ll);rewrite ?H0 ?H -?testP. + inline *. + while (={work} /\ GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} `|` work{2} = univ);auto;1:progress; smt. + qed. + + equiv Eager_S : IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. + proof. + transitivity GI.IND_S(RD).main + (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) + (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. + + by progress;exists (glob D){2}. + + by sim. + transitivity IND(GI.ERO,RD).main + (={glob D} ==> ={res,glob D, GI.RO.m}) + (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. + + by progress;exists (glob D){2}. + + by conseq (GI.Eager_S RD). + by apply ERO_main. + qed. + + equiv Eager : IND(Restr(RO), D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. + proof. + transitivity IND(GI.RO,RD).main + (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) + (={glob D} ==> ={res,glob D}) => //. + + by progress;exists (glob D){2}. + + by sim. + transitivity IND(GI.ERO,RD).main + (={glob D} ==> ={res,glob D}) + (={glob D} ==> ={res,glob D}) => //. + + by progress;exists (glob D){2}. + + by conseq (GI.Eager RD). + by conseq ERO_main. + qed. + + end section EAGER. + +end RestrIdeal. \ No newline at end of file From 3ef8c3e36d078b12ab8d524bccdf32c31b8dc3f6 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Mon, 14 Dec 2015 17:08:39 -0500 Subject: [PATCH 085/394] Two auxiliary lemmas, for consideration for inclusion in EC library: lemma dvdz_lt (x y z : int) : 0 < z => z %| x => z %| y => x < y => x + z <= y. lemma chunk_cat r (xs ys : 'a list) : 0 < r => r %| size xs => chunk r (xs ++ ys) = chunk r xs ++ chunk r ys. --- sha3/proof/Temp.ec | 63 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 63 insertions(+) create mode 100644 sha3/proof/Temp.ec diff --git a/sha3/proof/Temp.ec b/sha3/proof/Temp.ec new file mode 100644 index 0000000..0ab3d3b --- /dev/null +++ b/sha3/proof/Temp.ec @@ -0,0 +1,63 @@ +(* Temporary File for Auxiliary Lemmas *) + +require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. +require import Ring StdRing StdOrder StdBigop BitEncoding. +(*---*) import IntID IntOrder BitChunking. + +(* Add to IntDiv? *) + +lemma dvdz_lt (x y z : int) : + 0 < z => z %| x => z %| y => x < y => x + z <= y. +proof. +move=> gt0_z z_dvd_x z_dvd_y. +have -> : x = (x %/ z) * z by rewrite divzK. +have -> : y = (y %/ z) * z by rewrite divzK. +pose u := x %/ z; pose v := y %/ z; move=> u_tim_z_lt_v_tim_z. +have u_lt_v : u < v by rewrite -(@ltr_pmul2r z). +have -> : v = u + (v - u) by ring. +rewrite mulrDl ler_add2l ler_pemull 1:ltrW //. +by rewrite - (@ler_add2r u) - addrA addNr /= lez_add1r. +qed. + +(* Add to BitEncoding? *) + +lemma chunk_cat r (xs ys : 'a list) : + 0 < r => r %| size xs => chunk r (xs ++ ys) = chunk r xs ++ chunk r ys. +proof. +move=> ge0_r r_dvd_siz_xs; rewrite /chunk size_cat divzDl //. +(rewrite mkseq_add; first 2 rewrite divz_ge0 // size_ge0); congr. +apply eq_in_mkseq=> i [ge0_i i_lt_siz_xs_div_r] /=. +have i_tim_r_lt_siz_xs : i * r < size xs + by rewrite ltz_divRL // in i_lt_siz_xs_div_r. +have i_tim_r_add_r_le_siz_xs : i * r + r <= size xs + by rewrite dvdz_lt // dvdz_mull dvdzz. +rewrite mulrC drop_cat i_tim_r_lt_siz_xs /= take_cat. +cut r_le_siz_drop : r <= size (drop (i * r) xs) + by rewrite size_drop 1:divr_ge0 // 1:ltrW // max_ler + ler_subr_addr /= 1:ltrW // addrC. +rewrite ler_eqVlt in r_le_siz_drop. +elim r_le_siz_drop=> [r_eq_siz_drop | -> //]. +rewrite {1 6 8} r_eq_siz_drop /= take0 cats0 take_size //. +apply eq_in_mkseq=> i [ge0_i lt_siz_ys_i] /=. +have -> : r * (size xs %/ r + i) = size xs + r * i + by rewrite mulrDr mulrC divzK. +rewrite drop_cat. +case (size xs + r * i < size xs)=> [/gtr_addl lt0_r_tim_i | _]. +have contrad : 0 <= r * i < 0 by split; [rewrite divr_ge0 1:ltrW |]. +rewrite ler_lt_asym in contrad; elim contrad. +have -> // : size xs + r * i - size xs = r * i by ring. +qed. + +(* Add to Common? *) + +theory ForCommon. + +require import Common. + +lemma chunk_cat (xs ys : 'a list) : + r %| size xs => chunk r (xs ++ ys) = chunk r xs ++ chunk r ys. +proof. +exact /chunk_cat /gt0_r. +qed. + +end ForCommon. From 0e94ff1ecaf237563ee45dd2c7921fa0f3eb4d63 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Tue, 15 Dec 2015 01:39:27 +0100 Subject: [PATCH 086/394] Move a new version of generic RO with the corresponding eager proof. Should help a lot in the proof of squeezeless sponge and also in the Alley part. --- sha3/proof/old/MyRO.ec | 978 ++++++++++++----------------------------- 1 file changed, 269 insertions(+), 709 deletions(-) diff --git a/sha3/proof/old/MyRO.ec b/sha3/proof/old/MyRO.ec index 59aaaab..56f8be7 100644 --- a/sha3/proof/old/MyRO.ec +++ b/sha3/proof/old/MyRO.ec @@ -1,5 +1,39 @@ require import Option List FSet NewFMap. - import NewLogic. + import NewLogic Fun. + +(* TODO: move this *) +lemma set_eq (m:('a,'b)fmap) x y: m.[x] = Some y => m.[x<-y] = m. +proof. + by rewrite fmapP=> Hx x';rewrite getP;case (x'=x)=>//->;rewrite Hx. +qed. + +lemma oflistK_uniq (s : 'a list) : uniq s => + perm_eq s (elems (oflist s)). +proof. by move/undup_id => {1}<-; apply/FSet.oflistK. qed. + +lemma setD1E (s : 'a fset) x : + perm_eq (elems (s `\` fset1 x)) (rem x (elems s)). +proof. +rewrite setDE; pose s' := List.filter _ _; apply/(perm_eq_trans s'). + rewrite perm_eq_sym oflistK_uniq ?filter_uniq ?uniq_elems. +rewrite /s' rem_filter ?uniq_elems; apply/uniq_perm_eq; + rewrite ?filter_uniq ?uniq_elems // => y. +by rewrite !mem_filter /predC in_fset1. +qed. + +lemma perm_to_rem (s:'a fset) x : + mem s x => perm_eq (elems s) (x :: elems (s `\` fset1 x)). +proof. +rewrite memE => /perm_to_rem /perm_eqlP->; apply/perm_cons. +have /perm_eqlP <- := (setD1E s x); rewrite perm_eq_refl. +qed. + +lemma mem_drop (s:'a list) n x: mem (drop n s) x => mem s x. +proof. by rewrite -{2}(cat_take_drop n) mem_cat=>->. qed. + +lemma mem_take (s:'a list) n x: mem (take n s) x => mem s x. +proof. by rewrite -{2}(cat_take_drop n) mem_cat=>->. qed. +(* end TODO *) abstract theory Titer. @@ -18,6 +52,14 @@ module Iter (O:Orcl) = { } }. +lemma iter_ll(O<:Orcl): islossless O.f => islossless Iter(O).iter. +proof. + move=> O_ll;proc;inline Iter(O).iter. + while true (size l);auto=>/=. + + call O_ll;skip=> /=?[*]Hl<-;smt ml=0 w=(size_eq0 size_ge0 size_drop). + smt ml=0 w=(size_eq0 size_ge0). +qed. + section. declare module O:Orcl. @@ -36,7 +78,7 @@ proof. ={glob O}) (l{1}= i' :: i :: (s1 ++ s2) /\ l{2} = i' :: (s1 ++ i::s2) /\ ={glob O} ==> ={glob O})=>//. - + by move=> ?&ml[*]<*>;exists (glob O){ml}, (i' :: i :: (s1 ++ s2)). + + by move=> ?&mr[*]<*>;exists (glob O){mr}, (i' :: i :: (s1 ++ s2)). + proc;rcondt{1}1=>//;rcondt{2}1=>//. rcondt{1}3;1:by auto;conseq(_: true). rcondt{2}3;1:by auto;conseq(_: true). @@ -45,7 +87,7 @@ proof. (l{1} = i :: i' :: (s1 ++ s2) /\ ={l, glob O} ==> ={l,glob O}) (l{1} = i :: i' :: (s1 ++ s2) /\ l{2} = i' :: i :: (s1 ++ s2) /\ ={glob O} ==> ={l,glob O})=>//. - + by move=>?&ml[*]<*>;exists (glob O){ml}, (i :: i' :: (s1 ++ s2)). + + by move=>?&mr[*]<*>;exists (glob O){mr}, (i :: i' :: (s1 ++ s2)). + inline *;rcondt{2} 2;1:by auto. rcondt{2} 4;1:by auto;sp;conseq(_:true). rcondf{2} 6; auto;call(_:true);wp;call(_:true);auto. @@ -53,7 +95,7 @@ proof. (l{1} = i :: i' :: (s1 ++ s2) /\ l{2} = i' :: i :: (s1 ++ s2) /\ ={glob O} ==> ={l,glob O}) (l{2} = i' :: i :: (s1 ++ s2) /\ ={l, glob O} ==> ={l,glob O})=>//. - + by move=>?&ml[*]<*>;exists (glob O){ml}, (i' :: i :: (s1 ++ s2)). + + by move=>?&mr[*]<*>;exists (glob O){mr}, (i' :: i :: (s1 ++ s2)). + wp; by call (iter_swap1 i i'). (* call iter_swap1: FIXME catch exception *) inline *;rcondt{1} 2;1:by auto. @@ -65,12 +107,12 @@ proof. transitivity{1} {Iter(O).iter(l); } (={l,glob O} /\ l{1}= i::(s1++s2) ==> ={glob O}) (={glob O} /\ l{1}=i::(s1++s2) /\ l{2}= (s1++i::s2) ==> ={glob O})=>//. - + by move=>?&ml[*]<*>;exists (glob O){ml}, (i :: (s1 ++ s2)). + + by move=>?&mr[*]<*>;exists (glob O){mr}, (i :: (s1 ++ s2)). + by inline *;sim. transitivity{1} {Iter(O).iter(l); } (={glob O} /\ l{1}=i::(s1++s2) /\ l{2}= (s1++i::s2) ==> ={glob O}) (={l,glob O} /\ l{2}= (s1++i::s2) ==> ={glob O})=>//. - + by move=>?&ml[*]<*>;exists (glob O){ml}, (s1 ++ i::s2). + + by move=>?&mr[*]<*>;exists (glob O){mr}, (s1 ++ i::s2). + by call Hrec;auto. by inline*;sim. qed. @@ -88,19 +130,19 @@ proof. transitivity Iter(O).iter (l{1}=i::s1 /\ l{2}=i::(s3++s4) /\ ={glob O} ==> ={glob O}) (l{1}=i::(s3++s4) /\ l{2}=s3++i::s4 /\ ={glob O} ==> ={glob O})=>//. - + by move=>?&ml[*]-> -> _ ->; exists (glob O){ml}, (i :: (s3 ++ s4)). + + by move=>?&mr[*]-> -> _ ->; exists (glob O){mr}, (i :: (s3 ++ s4)). + proc;rcondt{1}1=>//;rcondt{2}1=>//. seq 2 2: (s1 = l{1} /\ l{2}=s3++s4 /\ ={glob O}). + by wp;call(_:true);auto;progress;rewrite drop0. transitivity{1} {Iter(O).iter(l); } (={l,glob O} ==> ={glob O}) (s1 = l{1} /\ l{2} = s3 ++ s4 /\ ={glob O} ==> ={glob O})=>//. - + by move=>?&ml[*]-> -> ->;exists (glob O){ml}, l{1}. + + by move=>?&mr[*]-> -> ->;exists (glob O){mr}, l{1}. + by inline Iter(O).iter;sim. transitivity{1} {Iter(O).iter(l); } (s1 = l{1} /\ l{2} = s3 ++ s4 /\ ={glob O} ==> ={glob O}) (={l,glob O} ==> ={glob O}) =>//. - + by move=>?&ml[*]-> -> ->;exists (glob O){ml}, (s3++s4). + + by move=>?&mr[*]-> -> ->;exists (glob O){mr}, (s3++s4). + move: eq_s12; rewrite -(cat1s i s4) catA perm_eq_sym. rewrite perm_catCA /= perm_cons perm_eq_sym=> Hp. + call (ih (s3++s4) Hp)=>//. @@ -155,14 +197,29 @@ proof. by rewrite oget_some /=;case (f' = f)=> [_ ->|]. qed. -lemma restr_set_diff f2 f1 m x y: +lemma restr_set m f1 f2 x y: + restr f1 m.[x<-(y,f2)] = if f1 = f2 then (restr f1 m).[x<-y] else rem x (restr f1 m). +proof. + rewrite fmapP;case (f1=f2)=>[->|Hneq]x0;rewrite !(restrP,getP);1: by case (x0=x). + case (x0=x)=>[->|Hnx];1:by rewrite (eq_sym f2) Hneq remP_eq. + by rewrite remP Hnx restrP. +qed. + +lemma restr_set_eq m f x y: + restr f m.[x<-(y,f)] = (restr f m).[x<-y]. +proof. by rewrite restr_set. qed. + +lemma restr0 f : restr f map0 = map0. +proof. by apply fmapP=>x;rewrite restrP !map0P. qed. + +lemma restr_set_neq f2 f1 m x y: !mem (dom m) x => f2 <> f1 => restr f1 m.[x<-(y,f2)] = restr f1 m. proof. - rewrite fmapP in_dom=>/= Hdom Hf x';rewrite !restrP getP. - by case (x' = x)=>//=->;rewrite Hf Hdom. + by move=>Hm Hneq;rewrite restr_set (eq_sym f1) Hneq rem_id//restr_dom Hm. qed. +(* -------------------------------------------------------------------------- *) module RO : RO = { var m : (from, to * flag)fmap @@ -221,6 +278,8 @@ end section LL. end Ideal. + +(* -------------------------------------------------------------------------- *) abstract theory GenEager. clone include Ideal. @@ -260,9 +319,32 @@ module ERO : RO = { }. -lemma set_eq (m:('a,'b)fmap) x y: m.[x] = Some y => m.[x<-y] = m. +lemma resample_ll : islossless ERO.resample. +proof. + proc;call (iter_ll ERO.I _)=>//;apply (sample_ll sampleto_ll). +qed. + +lemma eager_init : + eager [ERO.resample(); , RO.init ~ ERO.init, ERO.resample(); : + ={RO.m} ==> ={RO.m} ]. proof. - by rewrite fmapP=> Hx x';rewrite getP;case (x'=x)=>//->;rewrite Hx. + eager proc. inline{2} *;rcondf{2}3;auto=>/=. + + by move=>?_;rewrite restr0 dom0 elems_fset0. + by conseq (_:) (_:true==>true: =1%r) _=>//;call resample_ll. +qed. + +lemma iter_perm2 (i1 i2 : from): + equiv[ Iter(ERO.I).iter ~ Iter(ERO.I).iter : + l{1} = [i1; i2] /\ l{2} = [i2; i1] /\ ={glob ERO.I} ==> + ={glob ERO.I}]. +proof. + proc;rcondt{1}1=>//;rcondt{2}1=>//. + rcondt{1}3;1:by auto;conseq(_:true). + rcondt{2}3;1:by auto;conseq(_:true). + seq 4 4 : (={l,RO.m});2:by sim. + case (i1=i2);1:by sim. + inline *;swap[4..5]-2;swap{2} 6-2;auto=>?&mr[*]3!<*>Hneq/=?->?->/=. + by rewrite set_set Hneq. qed. lemma eager_get : @@ -274,7 +356,7 @@ proof. + rnd{1};rcondf{2} 2;1:by auto=> /#. alias{1} 1 mx = oget RO.m.[x];inline *. while (={l,RO.m} /\ (!mem l x /\ RO.m.[x] = Some (mx.`1,Known)){1}). - + auto=>?&ml[*]-> ->;case (l{ml})=>//=x2 l2 Hmx Hgx?->. + + auto=>?&mr[*]-> ->;case (l{mr})=>//=x2 l2 Hmx Hgx?->. by rewrite getP drop0 /#. auto=>??[*]-> ->/= Hmem HK;rewrite sampleto_ll/==> r _. rewrite -memE restr_dom Hmem/= HK. @@ -282,722 +364,200 @@ proof. by move=>????-> _[*]_-> _ Heq?;rewrite in_dom set_eq Heq. rcondt{2} 2. + auto=> ?[*]-> ->;rewrite negb_and /#. case ((mem (dom RO.m) x){1}). - + inline{1} ERO.resample=>/=. + + inline{1} ERO.resample=>/=;rnd{1}. transitivity{1} { Iter(ERO.I).iter(x::elems ((dom (restr Unknown RO.m)) `\` fset1 x)); - r <$ sampleto x; } + } (={x,RO.m} /\ mem (dom RO.m{1}) x{1} /\ (oget RO.m{1}.[x{1}]).`2 = Unknown ==> ={x,RO.m}) (={x,RO.m} /\ mem (dom RO.m{1}) x{1} /\ (oget RO.m{1}.[x{1}]).`2 = Unknown==> ={x} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ RO.m{1}.[x{2}] = Some (result{2},Unknown) /\ RO.m{2}.[x{2}] = Some (result{2},Known)). - + by move=>?&ml[*]-> -> ??;exists RO.m{ml}, x{ml}=>/#. + + by move=>?&mr[*]-> -> ??;exists RO.m{mr}, x{mr}=>/#. + move=>???;rewrite in_dom=>[*]<*>[*]->/eq_except_sym H Hxm Hx2. - rewrite Hxm oget_some /=;apply /eq_sym. + rewrite sampleto_ll=> r _;rewrite /= Hxm oget_some /=;apply /eq_sym. have /(congr1 oget):= Hx2 => <-;apply eq_except_set_eq=>//. by rewrite in_dom Hx2. - + rnd;call (iter_perm ERO.I _). - - - - - - cut ->: (result{2}, Known) = oget RO.m{2}.[x{2}]. - - - search eq_except. - set_eq. - 1:Hx. -;rewrite H=>{H}. - - <- ((oget RO.m{1}.[x{1}]).`1, Known)] = RO.m{2} - mem (dom RO.m{1} x{1} - - transitivity{1} { work <- dom RO.m; - r <$ sampleto x; - while (work <> fset0) { - x0 <- pick work; - if (in_dom_with RO.m x0 Unknown) { - c <$ sampleto x0; - RO.m.[x0] <- (if x0 = x then r else c, Unknown); - } - work <- work `\` fset1 (pick work); - } } - (={x,RO.m} ==> ={x,RO.m}) - (={x,RO.m} /\ (mem (dom RO.m) x /\ (oget RO.m.[x]).`2 = Unknown){1} ==> - ={x} /\ RO.m{1} = RO.m{2}.[x{2}<-(result{2}, Unknown)] /\ - RO.m{2}.[x{2}] = Some(result{2}, Known)). - + move=>?&mr[*]-> ->??;exists RO.m{mr},x{mr}=>/#. - + move=>?&m?[2*]-> -> <- ->_. - by rewrite in_dom getP_eq oget_some set_set set_eq. - + seq 1 1:(={work,x,RO.m});[by sim|symmetry]. - eager while (H:r<$sampleto x; ~ r<$sampleto x; : ={x} ==> ={r})=>//;1,3:by sim. - swap{1}2-1;sp 1 1. - if{2};[rcondt{1}2|rcondf{1}2];1,3,4:by auto. - by rnd{2};wp;case ((x0 = x){1});[rnd{1}|];auto=>??[*]-> -> -> -> ->_ _ _->; - rewrite sampleto_ll. - alias{1} 1 cx = (oget RO.m.[x]).`1. - while (={work,x,r} /\ mem (dom RO.m{1}) x{1} /\ (RO.m.[x]=Some(r,Known)){2}/\ - RO.m{1} = (RO.m.[x<-(if mem work x then cx{1} else r, Unknown)]){2}). - + sp 1 1;case ((x0 = x){1}). - + rcondt{1} 1. by auto;progress;rewrite getP_eq oget_some;case (mem _ _). - rcondf{2} 1. by auto=> @/in_dom_with;progress;rewrite H0. - auto=> ??[*]_-> -> -> ->?-> ->?_<-/=;rewrite sampleto_ll=>c _. - by rewrite dom_set !inE /= set_set. - if=>//. auto;progress[-split]. by rewrite /in_dom_with dom_set getP !inE H3. - + auto;progress [-split];split=>// _. - by rewrite dom_set !inE H/= getP set_set (eq_sym x{2}) H3 H0. - by auto;progress;rewrite !inE (eq_sym x{2}) H3. - auto;progress [-split];rewrite H1 /=. - rewrite dom_set fsetUC subset_fsetU_id /=. - + by move=> x;rewrite inE. - rewrite H getP_eq /= set_set /= set_eq. - + by rewrite {1}get_oget // -H0;case (oget _). - by move=> ????-> ->/=[*];rewrite !inE oget_some. - inline *;swap{1} 3 -2. - admit. -(* - (* Admit *) - while (={work,x,r} /\ (RO.m.[x]=None){1} /\ - RO.m{2} = RO.m{1}.[x{2}<-(r{2},Known)] /\ - !mem work{2} x{2}). - + wp;sp 1 1;if. auto=> ??[*]-> -> -> Hex Hmem Heq Hx _ /= ?->/=. - rewrite !inE Hmem !getP Heq /=. - cut ^Hd->/=: x{2} <> pick work{2} by smt ml=0 w=mem_pick. - by rewrite Hex set_set Hd. - auto=>??/=[*]-> -> _ ^Hdom;rewrite in_dom=>/=Hnone?->;rewrite restr_set_diff//=. - by rewrite Hnone /= restr_dom Hdom=>????-> ->[*];rewrite in_dom getP_eq. *) + + call (iter_perm ERO.I iter_perm2). + skip=> &1 &2 [[->> ->>]] [Hdom Hm];progress. + by apply /perm_to_rem/restr_dom;rewrite Hdom Hm. + inline *;rcondt{1} 2;1:by auto. + while (={x,l} /\ !mem l{1} x{1}/\ + eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ + RO.m{1}.[x{2}] = Some (result{2}, Unknown) /\ + RO.m{2}.[x{2}] = Some (result{2}, Known)). + + auto=> ?&mr[*]2!->Hm Hex Hm1 Hmr Hneq _/=?->. + rewrite (contra _ _ (mem_drop _ 1 _) Hm) /=. + rewrite!getP;move:Hm;rewrite-(mem_head_behead witness l{mr})//negb_or=>-[]->_. + by rewrite Hm1 Hmr/=;apply eq_except_set. + auto=>?&mr[[->>->>]][]Hdom Hm /=/=?->/=. + rewrite !drop0 restr_set /= dom_rem /= -memE !inE /=. + by rewrite !getP_eq /= oget_some/= set2_eq_except. + inline *. swap{1}3-2. + while (={l,x} /\ !mem l{1} x{1} /\ RO.m{1}.[x{1}] = None /\ + RO.m{2} = RO.m{1}.[x{2}<-(r{2},Known)]). + + auto=> ?&mr[*]2!->Hm Hn Heq Hl _/=?->. + rewrite (contra _ _ (mem_drop _ 1 _) Hm) /=. + rewrite set_set -Heq !getP -(eq_sym (x{mr})). + by move:Hm;rewrite -(mem_head_behead witness l{mr} Hl) -Hn negb_or=>-[]->. + auto=> ?&mr[*]2!->_ Hnm/=?->. + rewrite -memE restr_set_neq //= restr_dom Hnm /=. + by have:=Hnm;rewrite in_dom/==>->/=????->->;rewrite in_dom getP_eq oget_some. qed. - -search "_.[_<-_]". - search - auto=> ??/=[*]-> -> _ Hmem/=?->/=;rewrite restr_set_diff //=. - rewrite eq_except_sym set_eq_except restr_dom Hmem getP_eq=>????->_ [*]. - rewrite Hmem. - - get_eq. - - transitivity{2} { - -=>-[->//|/#]. - - - {1}(get_oget m_R x{2}). -print get_oget. -search "_.[_]" "_.[_<-_]". -print restrK. - - -smt. - H /=;smt. - case ((!mem work x){1}). - + swap{1} 2 -1;while (={work,x} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ - (!mem work x){1} /\ (RO.m.[x] = Some rd){2} /\ (!mem (dom RO.m) x){1}). - + inline *;auto;progress [-split]. - cut -> : mem (dom RO.m{2}) (pick work{2}) = mem (dom RO.m{1}) (pick work{2}) by rewrite !in_dom;smt. - smt. - auto;progress [-split];rewrite !getP_eq;smt. - inline RO.f. - transitivity{1} { rd <$ sample x; - while (work <> fset0) { - x0 <- pick work; - rd0 <$ sample x0; - if (!mem (dom RO.m) x0) - RO.m.[x0] <- if x0 = x then rd else rd0; - work <- work `\` fset1 (pick work); - } } - (={x,work,RO.m} ==> ={x,RO.m}) - ((={x,work,RO.m} /\ mem work{1} x{1}) /\ ! mem (dom RO.m{2}) x{2} ==> - ={x,RO.m} /\ (result = oget RO.m.[x]){2} /\ mem (dom RO.m{1}) x{1}) => //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. - + transitivity{1} { while (work <> fset0) { - x0 <- pick work; - rd0 <$ sample x0; - if (!mem (dom RO.m) x0) RO.m.[x0] <- rd0; - work <- work `\` fset1 (pick work); +lemma eager_set : + eager [ERO.resample(); , RO.set ~ ERO.set, ERO.resample(); : + ={x,y} /\ ={RO.m} ==> ={res,RO.m} ]. +proof. + eager proc. + case ((mem (dom RO.m) x /\ (oget RO.m.[x]).`2 = Unknown){1}). + inline{1} ERO.resample=>/=;wp 1 2. + transitivity{1} { Iter(ERO.I).iter(x::elems ((dom (restr Unknown RO.m)) `\` fset1 x)); } - rd <$ sample x; } - (={x,work,RO.m} ==> ={x,RO.m}) - (={x,work,RO.m} ==> ={x,RO.m})=> //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. - + by sim; rnd{2}; sim : (={x,IND_Eager.H.m}); smt. - symmetry; eager while (H: rd <$ sample x; ~ rd <$ sample x; : ={x} ==> ={rd})=> //; sim. - swap{2} 5 -4; swap [2..3] -1; case ((x = pick work){1}). - + by wp; rnd{2}; rnd; rnd{1}; wp; skip; smt. - by auto; smt. - + while (={x, work} /\ - (!mem work x => mem (dom RO.m) x){1} /\ - RO.m.[x]{2} = Some rd{1} /\ - if (mem (dom RO.m) x){1} then ={RO.m} - else eq_except RO.m{1} RO.m{2} (fset1 x{1})). - + auto;progress; 1..9,12:smt. - + case ((pick work = x){2})=> pick_x; last smt. - subst x{2}; move: H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. - by apply fmapP=> x0; case (pick work{2} = x0); smt. - by auto; smt. - by auto;progress [-split];rewrite H0 /= getP_eq;smt. - - - - - - - - - - - - - - module IND_S(D:Distinguisher) = { - proc main(): bool = { - var b; - RO.init(); - b <@ D(RO).distinguish(); - ERO.sample(); - return b; - } - }. - - section EAGER. - - local lemma eager_query: - eager [ERO.sample(); , RO.f ~ ERO.f, ERO.sample(); : - ={x,RO.m} ==> ={res,RO.m} ]. - proof. - eager proc. - inline ERO.sample;swap{2} 4 -3. - seq 1 1: (={x,work,RO.m});first by sim. - wp;case ((mem (dom RO.m) x){1}). - + rnd{1}. - alias{1} 1 mx = oget RO.m.[x]. - while (={work,RO.m} /\ (RO.m.[x] = Some mx){1}). - + by inline *;auto;progress;smt. - auto;progress [- split]; rewrite sample_ll H /=;smt. - case ((!mem work x){1}). - + swap{1} 2 -1;while (={work,x} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ - (!mem work x){1} /\ (RO.m.[x] = Some rd){2} /\ (!mem (dom RO.m) x){1}). - + inline *;auto;progress [-split]. - cut -> : mem (dom RO.m{2}) (pick work{2}) = mem (dom RO.m{1}) (pick work{2}) by rewrite !in_dom;smt. - smt. - auto;progress [-split];rewrite !getP_eq;smt. - inline RO.f. - transitivity{1} { rd <$ sample x; - while (work <> fset0) { - x0 <- pick work; - rd0 <$ sample x0; - if (!mem (dom RO.m) x0) - RO.m.[x0] <- if x0 = x then rd else rd0; - work <- work `\` fset1 (pick work); - } } - (={x,work,RO.m} ==> ={x,RO.m}) - ((={x,work,RO.m} /\ mem work{1} x{1}) /\ ! mem (dom RO.m{2}) x{2} ==> - ={x,RO.m} /\ (result = oget RO.m.[x]){2} /\ mem (dom RO.m{1}) x{1}) => //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. - + transitivity{1} { while (work <> fset0) { - x0 <- pick work; - rd0 <$ sample x0; - if (!mem (dom RO.m) x0) RO.m.[x0] <- rd0; - work <- work `\` fset1 (pick work); - } - rd <$ sample x; } - (={x,work,RO.m} ==> ={x,RO.m}) - (={x,work,RO.m} ==> ={x,RO.m})=> //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. - + by sim; rnd{2}; sim : (={x,IND_Eager.H.m}); smt. - symmetry; eager while (H: rd <$ sample x; ~ rd <$ sample x; : ={x} ==> ={rd})=> //; sim. - swap{2} 5 -4; swap [2..3] -1; case ((x = pick work){1}). - + by wp; rnd{2}; rnd; rnd{1}; wp; skip; smt. - by auto; smt. - + while (={x, work} /\ - (!mem work x => mem (dom RO.m) x){1} /\ - RO.m.[x]{2} = Some rd{1} /\ - if (mem (dom RO.m) x){1} then ={RO.m} - else eq_except RO.m{1} RO.m{2} (fset1 x{1})). - + auto;progress; 1..9,12:smt. - + case ((pick work = x){2})=> pick_x; last smt. - subst x{2}; move: H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. - by apply fmapP=> x0; case (pick work{2} = x0); smt. - by auto; smt. - by auto;progress [-split];rewrite H0 /= getP_eq;smt. - qed. - - equiv Eager_S (D <: Distinguisher{RO}): IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. - proof. - proc; inline ERO.init RO.init. - seq 1 1: (={glob D, RO.m});first by wp. - symmetry; eager (H: ERO.sample(); ~ ERO.sample();: ={RO.m} ==> ={RO.m}): - (={glob D, RO.m}) => //; first by sim. - eager proc H (={RO.m}) => //; [by apply eager_query | by sim]. - qed. - - equiv Eager (D <: Distinguisher{RO}): IND(RO,D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. - proof. - transitivity IND_S(D).main - (={glob D} ==> ={res,glob D}) - (={glob D} ==> ={res,RO.m,glob D}) => //. - + by progress;exists (glob D){2}. - + proc;inline{2} ERO.sample. - while{2} true (card work{2}). - + move=> &m1 z;wp;call (f_ll sample_ll);auto;smt. - conseq (_: _ ==> ={b,glob D}) => //;[smt | by sim]. - apply (Eager_S D). - qed. - - end section EAGER. - -end GenIdeal. - - - - - - - - - - - - - - - -abstract theory - - -module type SAMPLE = { - proc sampleI(h:handle) : unit - proc setD(h:handle, c:capacity) : unit - proc get(h:handle) : capacity - proc in_dom(h:handle,c:caller) : bool - proc restrD() : (handle,capacity)fmap -}. - -module type ADV_SAMPLEH(O:SAMPLE) = { - proc main() : bool -}. - - - -module Esample = { - var handles : (handle, ccapacity)fmap + (={x,y,RO.m} /\ mem (dom RO.m{1}) x{1} /\ (oget RO.m{1}.[x{1}]).`2 = Unknown ==> + ={x,y,RO.m}) + (={x,y,RO.m} /\ mem (dom RO.m{1}) x{1} /\ (oget RO.m{1}.[x{1}]).`2 = Unknown==> + ={x,y} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ + RO.m{2}.[x{2}] = Some (y{2},Known)). + + by move=>?&mr[*]-> -> ???;exists RO.m{mr}, y{mr}, x{mr}=>/#. + + move=>??? [*]<*>[*]-> -> Hex Hm2. + by rewrite (eq_except_set_eq RO.m{2} RO.m{m} x{2}) ?in_dom ?Hm2// eq_except_sym. + + call (iter_perm ERO.I iter_perm2). + skip=>?&mr[][]->>[]->>->>[]Hdom Hm/=. + by apply /perm_to_rem/restr_dom;rewrite Hdom Hm. + inline *;rcondt{1} 2;1:by auto. + while (={x,l} /\ !mem l{1} x{1}/\ + eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ + RO.m{2}.[x{2}] = Some (y{2}, Known)). + + auto=> ?&mr[*]2!->Hm Hex Hm1 Hmr _/=?->. + rewrite (contra _ _ (mem_drop _ 1 _) Hm) /=. + rewrite!getP;move:Hm;rewrite-(mem_head_behead witness l{mr})//negb_or=>-[]->_. + by rewrite Hm1 /=;apply eq_except_set. + auto=>?&mr[*]3!<*>Hdom Hm /=/=;rewrite !drop0 sampleto_ll=>/=?_. + by rewrite -memE restr_set /= dom_rem !inE !getP_eq set2_eq_except. + inline *;wp. + while (={x,l} /\ !mem l{1} x{1}/\ + eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ + RO.m{2}.[x{2}] = Some (y{2}, Known)). + + auto=> ?&mr[*]2!->Hm Hex Hm1 Hmr _/=?->. + rewrite (contra _ _ (mem_drop _ 1 _) Hm) /=. + rewrite!getP;move:Hm;rewrite-(mem_head_behead witness l{mr})//negb_or=>-[]->_. + by rewrite Hm1 /=;apply eq_except_set. + auto=> ?&mr[*]3!-> Hnm /=. + rewrite-memE restr_set/=rem_id?restr_dom//=Hnm. + rewrite getP_eq eq_except_sym set_eq_except/=. + move=>/=????2!->/=[]/eq_except_sym? Hx2;apply/eq_sym. + have/(congr1 oget):=Hx2=><-;apply eq_except_set_eq=>//;by rewrite in_dom Hx2. +qed. - proc sampleI(h:handle) = { - var c; - c <$ cdistr; - handles.[h] <- (c,I); - } +lemma eager_in_dom: + eager [ERO.resample(); , RO.in_dom ~ ERO.in_dom, ERO.resample(); : + ={x,f} /\ ={RO.m} ==> ={res,RO.m} ]. +proof. + eager proc;inline *;wp. + while (={l,RO.m} /\ (forall z, mem l z => in_dom_with RO.m z Unknown){1} /\ + in_dom_with RO.m{1} x{1} f{1} = result{2}). + + auto=>?&mr[*]2!->Hz <-?_/=?->/=. + by split=>[z Hm|];rewrite /in_dom_with dom_set getP !inE/#. + by auto=>?&mr/=[*]3!->/=;split=>// z;rewrite -memE restr_dom. +qed. - proc setD (h:handle, c:capacity) = { - handles.[h] <- (c,D); - } +lemma eager_restrK: + eager [ERO.resample(); , RO.restrK ~ ERO.restrK, ERO.resample(); : + ={RO.m} ==> ={res,RO.m} ]. +proof. + eager proc;inline *;wp. + while (={l,RO.m} /\ (forall z, mem l z => in_dom_with RO.m z Unknown){1} /\ + restr Known RO.m{1} = result{2}). + + auto=>?&mr[*]2!->Hz<-?_/=?->/=. + split=>[z Hm|];1:by rewrite /in_dom_with dom_set getP !inE/#. + rewrite restr_set rem_id?restr_dom//. + by move:H=>/(mem_head_behead witness) /(_ (head witness l{mr})) /= /Hz /#. + by auto=>?&mr/=->/=;split=>// z;rewrite -memE restr_dom. +qed. - proc in_dom(h:handle, c:caller) = { - return in_dom_with handles h c; - } +lemma eager_sample: + eager [ERO.resample(); , RO.sample ~ ERO.sample, ERO.resample(); : + ={x,RO.m} ==> ={res,RO.m} ]. +proof. + eager proc. + transitivity{2} { + c <$ sampleto x; RO.m.[x] <- (c, Unknown); + Iter(ERO.I).iter(x::elems ((dom (restr Unknown RO.m)) `\` fset1 x));} + (={x,RO.m} ==> ={x,RO.m}) + (={x,RO.m} ==> ={x,RO.m})=>//;last first. + + inline{2} ERO.resample;call (iter_perm ERO.I iter_perm2);auto=>?&mr[]->->/=?->. + by rewrite !restr_set/= !dom_set perm_eq_sym perm_to_rem !inE. + + by move=>?&mr[*]2!->;exists RO.m{mr}, x{mr}. + inline ERO.resample;inline{2}*;rcondt{2}4;1:by auto. + wp;case ((!mem (dom RO.m) x \/ (oget RO.m.[x]).`2=Known){1}). + + inline *;swap{1}3-1. + while (={x,l} /\ RO.m{1}.[x{1} <- (c{1}, Unknown)] = RO.m{2} /\ !(mem l x){1}). + + auto=>?&mr[*]2!-><- Hnm Hl _/=?->. + rewrite (contra _ _ (mem_drop _ 1 _) Hnm) /= set_set. + by move:Hnm;rewrite-(mem_head_behead witness l{mr})//negb_or eq_sym=>-[]->. + auto=>?&mr[*]2!->?/=;rewrite sampleto_ll=>?_?->;rewrite drop0. + rewrite restr_set/= dom_set fsetDK. + cut<-/=:dom (restr Unknown RO.m{mr}) = + dom (restr Unknown RO.m{mr}) `\` fset1 x{mr}. + + apply fsetP=>z;rewrite !(restr_dom,inE)/#. + by rewrite set_set/= -memE restr_dom;split=>/#. + transitivity{1} { + Iter(ERO.I).iter(x::elems ((dom (restr Unknown RO.m)) `\` fset1 x)); + c<$ sampleto x;} + (={x,RO.m} /\ (mem (dom RO.m) x /\ (oget RO.m.[x]).`2=Unknown){1} ==> ={x,c,RO.m}) + (={x,RO.m} /\ (mem (dom RO.m) x /\ (oget RO.m.[x]).`2=Unknown){1} ==> + ={x} /\ RO.m{1}.[x{1} <- (c{1}, Unknown)] = RO.m{2})=>//. + + by move=>?&mr[*]2!->?;exists RO.m{mr}, x{mr}=>/#. + + rnd;call (iter_perm ERO.I iter_perm2);auto=>?&mr[*]->->/=??;split=>//. + by rewrite perm_to_rem restr_dom. + inline *;rcondt{1}2;1:by auto. + swap{1} 7-2. + while (={x,l} /\ RO.m{1}.[x{1} <- (c{1}, Unknown)] = RO.m{2} /\ !(mem l x){1}). + + auto=>?&mr[*]2!-><- Hnm Hl _/=?->. + rewrite (contra _ _ (mem_drop _ 1 _) Hnm) /= set_set. + by move:Hnm;rewrite-(mem_head_behead witness l{mr})//negb_or eq_sym=>-[]->. + by auto=>?&mr[*]2!->??/=?->?->;rewrite!drop0 restr_set/=dom_set fsetDK-memE!inE. +qed. - proc restrD() = { - return ( - let m = NewFMap.filter (fun _ (p:ccapacity) => p.`2=D) handles in - NewFMap.map (fun _ (p:ccapacity) => p.`1) m); - } +module Eager (D:Distinguisher) = { - proc get(h:handle) = { - var c; - c <$ cdistr; - if (!mem (dom handles) h || (oget handles.[h]).`2 = I) { - handles.[h] <- (c,D); - } - return (oget (handles.[h])).`1; + proc main1() = { + var b; + RO.init(); + b <@ D(RO).distinguish(); + return b; } -}. - - - - - - - - -type from, to. - -module type RO = { - proc init() : unit - proc f(x : from): to -}. - -module type Distinguisher(G : RO) = { - proc distinguish(): bool {G.f} -}. - -module IND(G:RO, D:Distinguisher) = { - proc main(): bool = { + proc main2() = { var b; - - G.init(); - b <@ D(G).distinguish(); + ERO.init(); + b <@ D(ERO).distinguish(); + ERO.resample(); return b; - } -}. - -abstract theory Ideal. - - op sample : from -> to distr. - - module RO = { - var m : (from, to) fmap - - proc init() : unit = { - m <- map0; - } - - proc f(x : from) : to = { - var rd; - rd <$ sample x; - if (! mem (dom m) x) m.[x] <- rd; - return oget m.[x]; - } - }. - - section LL. - - axiom sample_ll : forall x, Distr.weight (sample x) = 1%r. - - lemma f_ll : phoare[RO.f : true ==> true] = 1%r. - proof. proc;auto;progress;apply sample_ll. qed. - - end section LL. - -end Ideal. - - -abstract theory GenIdeal. - - clone include Ideal. - axiom sample_ll : forall x, Distr.weight (sample x) = 1%r. - - op RO_dom : from fset. + } - module ERO = { - proc sample() = { - var work; - work <- RO_dom; - while (work <> fset0) { - RO.f(pick work); - work = work `\` fset1 (pick work); - } - } +}. - proc init() = { - RO.m <- map0; - sample(); - } +equiv Eager_1_2 (D<:Distinguisher{RO}) : Eager(D).main1 ~ Eager(D).main2 : + ={glob D} ==> ={res,glob RO, glob D}. +proof. + proc. + transitivity{1} + { RO.init(); + ERO.resample(); + b <@ D(RO).distinguish(); } + (={glob D} ==> ={b,RO.m,glob D}) + (={glob D} ==> ={b,RO.m,glob D})=> //. + + by move=> ?&mr->;exists (glob D){mr}. + + inline *;rcondf{2}3;2:by sim. + by auto=>?;rewrite restr0 dom0 elems_fset0. + seq 1 1: (={glob D, RO.m});1:by inline *;auto. + eager (H: ERO.resample(); ~ ERO.resample();: ={RO.m} ==> ={RO.m}): + (={glob D, RO.m}) => //;1:by sim. + eager proc H (={RO.m}) => //;try sim. + + by apply eager_init. + by apply eager_get. + by apply eager_set. + + by apply eager_sample. + by apply eager_in_dom. + by apply eager_restrK. +qed. - proc f = RO.f - }. - - module IND_S(D:Distinguisher) = { - proc main(): bool = { - var b; - RO.init(); - b <@ D(RO).distinguish(); - ERO.sample(); - return b; - } - }. - - section EAGER. - - local lemma eager_query: - eager [ERO.sample(); , RO.f ~ ERO.f, ERO.sample(); : - ={x,RO.m} ==> ={res,RO.m} ]. - proof. - eager proc. - inline ERO.sample;swap{2} 4 -3. - seq 1 1: (={x,work,RO.m});first by sim. - wp;case ((mem (dom RO.m) x){1}). - + rnd{1}. - alias{1} 1 mx = oget RO.m.[x]. - while (={work,RO.m} /\ (RO.m.[x] = Some mx){1}). - + by inline *;auto;progress;smt. - auto;progress [- split]; rewrite sample_ll H /=;smt. - case ((!mem work x){1}). - + swap{1} 2 -1;while (={work,x} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ - (!mem work x){1} /\ (RO.m.[x] = Some rd){2} /\ (!mem (dom RO.m) x){1}). - + inline *;auto;progress [-split]. - cut -> : mem (dom RO.m{2}) (pick work{2}) = mem (dom RO.m{1}) (pick work{2}) by rewrite !in_dom;smt. - smt. - auto;progress [-split];rewrite !getP_eq;smt. - inline RO.f. - transitivity{1} { rd <$ sample x; - while (work <> fset0) { - x0 <- pick work; - rd0 <$ sample x0; - if (!mem (dom RO.m) x0) - RO.m.[x0] <- if x0 = x then rd else rd0; - work <- work `\` fset1 (pick work); - } } - (={x,work,RO.m} ==> ={x,RO.m}) - ((={x,work,RO.m} /\ mem work{1} x{1}) /\ ! mem (dom RO.m{2}) x{2} ==> - ={x,RO.m} /\ (result = oget RO.m.[x]){2} /\ mem (dom RO.m{1}) x{1}) => //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. - + transitivity{1} { while (work <> fset0) { - x0 <- pick work; - rd0 <$ sample x0; - if (!mem (dom RO.m) x0) RO.m.[x0] <- rd0; - work <- work `\` fset1 (pick work); - } - rd <$ sample x; } - (={x,work,RO.m} ==> ={x,RO.m}) - (={x,work,RO.m} ==> ={x,RO.m})=> //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. - + by sim; rnd{2}; sim : (={x,IND_Eager.H.m}); smt. - symmetry; eager while (H: rd <$ sample x; ~ rd <$ sample x; : ={x} ==> ={rd})=> //; sim. - swap{2} 5 -4; swap [2..3] -1; case ((x = pick work){1}). - + by wp; rnd{2}; rnd; rnd{1}; wp; skip; smt. - by auto; smt. - + while (={x, work} /\ - (!mem work x => mem (dom RO.m) x){1} /\ - RO.m.[x]{2} = Some rd{1} /\ - if (mem (dom RO.m) x){1} then ={RO.m} - else eq_except RO.m{1} RO.m{2} (fset1 x{1})). - + auto;progress; 1..9,12:smt. - + case ((pick work = x){2})=> pick_x; last smt. - subst x{2}; move: H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. - by apply fmapP=> x0; case (pick work{2} = x0); smt. - by auto; smt. - by auto;progress [-split];rewrite H0 /= getP_eq;smt. - qed. - - equiv Eager_S (D <: Distinguisher{RO}): IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. - proof. - proc; inline ERO.init RO.init. - seq 1 1: (={glob D, RO.m});first by wp. - symmetry; eager (H: ERO.sample(); ~ ERO.sample();: ={RO.m} ==> ={RO.m}): - (={glob D, RO.m}) => //; first by sim. - eager proc H (={RO.m}) => //; [by apply eager_query | by sim]. - qed. - - equiv Eager (D <: Distinguisher{RO}): IND(RO,D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. - proof. - transitivity IND_S(D).main - (={glob D} ==> ={res,glob D}) - (={glob D} ==> ={res,RO.m,glob D}) => //. - + by progress;exists (glob D){2}. - + proc;inline{2} ERO.sample. - while{2} true (card work{2}). - + move=> &m1 z;wp;call (f_ll sample_ll);auto;smt. - conseq (_: _ ==> ={b,glob D}) => //;[smt | by sim]. - apply (Eager_S D). - qed. - - end section EAGER. - -end GenIdeal. - -abstract theory FiniteIdeal. - - clone include Ideal. - axiom sample_ll (x : from): Distr.weight (sample x) = 1%r. - - op univ : from fset. - axiom univP (x:from) : mem univ x. - - module ERO = { - proc sample() = { - var work; - work <- univ; - while (work <> fset0) { - RO.f(pick work); - work = work `\` fset1 (pick work); - } - } - - proc init() = { - RO.m <- map0; - sample(); - } - - proc f(x:from):to = { return oget RO.m.[x]; } - }. - - module IND_S(D:Distinguisher) = { - proc main(): bool = { - var b; - RO.init(); - b <@ D(RO).distinguish(); - ERO.sample(); - return b; - } - }. - - section EAGER. - - declare module D: Distinguisher { RO }. - - local clone GenIdeal as GI with - op sample <- sample, - op RO_dom <- univ - proof sample_ll by apply sample_ll. - - local equiv ERO_main: - IND(GI.ERO, D).main ~ IND(ERO, D).main : ={glob D} ==> ={res, glob D} /\ GI.RO.m{1} = RO.m{2}. - proof. - proc. - call (_:GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ). - + proc; rcondf{1} 2;auto;progress;[ by rewrite H univP | by apply sample_ll]. - inline *. - while (={work} /\ GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ `\` work{2});auto;smt. - qed. - - equiv Eager_S : IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. - proof. - transitivity GI.IND_S(D).main - (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) - (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. - + by progress;exists (glob D){2}. - + by sim. - transitivity IND(GI.ERO,D).main - (={glob D} ==> ={res,glob D, GI.RO.m}) - (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. - + by progress;exists (glob D){2}. - + by conseq (GI.Eager_S D). - by apply ERO_main. - qed. - - equiv Eager : IND(RO, D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. - proof. - transitivity IND(GI.RO,D).main - (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) - (={glob D} ==> ={res,glob D}) => //. - + by progress;exists (glob D){2}. - + by sim. - transitivity IND(GI.ERO,D).main - (={glob D} ==> ={res,glob D}) - (={glob D} ==> ={res,glob D}) => //. - + by progress;exists (glob D){2}. - + by conseq (GI.Eager D). - by conseq ERO_main. - qed. - - end section EAGER. - -end FiniteIdeal. - - -abstract theory RestrIdeal. - - clone include Ideal. - axiom sample_ll (x : from): Distr.weight (sample x) = 1%r. - - op test : from -> bool. - op univ : from fset. - op dfl : to. - - axiom testP x : test x <=> mem univ x. - - module Restr (O:RO) = { - proc init = RO.init - proc f (x:from) : to = { - var r <- dfl; - if (test x) r <@ RO.f(x); - return r; - } - }. - - module ERO = { - proc sample() = { - var work; - work <- univ; - while (work <> fset0) { - RO.f(pick work); - work = work `\` fset1 (pick work); - } - } - - proc init() = { - RO.m <- map0; - sample(); - } - - proc f(x:from):to = { - return (if test x then oget RO.m.[x] else dfl); - } - }. - - module IND_S(D:Distinguisher) = { - proc main(): bool = { - var b; - RO.init(); - b <@ D(Restr(RO)).distinguish(); - ERO.sample(); - return b; - } - }. - - section EAGER. - - declare module D: Distinguisher { RO }. - - local clone GenIdeal as GI with - op sample <- sample, - op RO_dom <- univ. - - local module Restr' (O:RO) = { - proc init() = { } - proc f(x:from) = { - var r <- dfl; - if (test x) r <@ O.f(x); - return r; - } - }. - - local module RD (O:RO) = D(Restr'(O)). - - local equiv ERO_main: - IND(GI.ERO, RD).main ~ IND(ERO, D).main : ={glob D} ==> ={res, glob D} /\ GI.RO.m{1} = RO.m{2}. - proof. - proc. - call (_:GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ). - + proc. - case (test x{1});[ rcondt{1} 2 | rcondf{1} 2];auto;last smt ml=0. - by inline *;rcondf{1} 4;auto;progress;2:(by apply sample_ll);rewrite ?H0 ?H -?testP. - inline *. - while (={work} /\ GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} `|` work{2} = univ);auto;1:progress; smt. - qed. - - equiv Eager_S : IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. - proof. - transitivity GI.IND_S(RD).main - (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) - (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. - + by progress;exists (glob D){2}. - + by sim. - transitivity IND(GI.ERO,RD).main - (={glob D} ==> ={res,glob D, GI.RO.m}) - (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. - + by progress;exists (glob D){2}. - + by conseq (GI.Eager_S RD). - by apply ERO_main. - qed. - - equiv Eager : IND(Restr(RO), D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. - proof. - transitivity IND(GI.RO,RD).main - (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) - (={glob D} ==> ={res,glob D}) => //. - + by progress;exists (glob D){2}. - + by sim. - transitivity IND(GI.ERO,RD).main - (={glob D} ==> ={res,glob D}) - (={glob D} ==> ={res,glob D}) => //. - + by progress;exists (glob D){2}. - + by conseq (GI.Eager RD). - by conseq ERO_main. - qed. - - end section EAGER. - -end RestrIdeal. \ No newline at end of file +end GenEager. From 53033666e239731ecb0fbc522d5a96666e7991a3 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Tue, 15 Dec 2015 08:43:59 +0100 Subject: [PATCH 087/394] small improvement --- sha3/proof/old/MyRO.ec | 29 +++++++++++++++++++---------- 1 file changed, 19 insertions(+), 10 deletions(-) diff --git a/sha3/proof/old/MyRO.ec b/sha3/proof/old/MyRO.ec index 56f8be7..8da2d87 100644 --- a/sha3/proof/old/MyRO.ec +++ b/sha3/proof/old/MyRO.ec @@ -520,6 +520,21 @@ proof. by auto=>?&mr[*]2!->??/=?->?->;rewrite!drop0 restr_set/=dom_set fsetDK-memE!inE. qed. +section. + +declare module D:Distinguisher {RO}. + +lemma eager_D : eager [ERO.resample(); , D(RO).distinguish ~ + D(ERO).distinguish, ERO.resample(); : + ={glob D,RO.m} ==> ={RO.m, glob D} /\ ={res} ]. +proof. + eager proc (H_: ERO.resample(); ~ ERO.resample();: ={RO.m} ==> ={RO.m}) + (={RO.m})=>//; try by sim. + + by apply eager_init. + by apply eager_get. + by apply eager_set. + + by apply eager_sample. + by apply eager_in_dom. + by apply eager_restrK. +qed. + + module Eager (D:Distinguisher) = { proc main1() = { @@ -531,7 +546,7 @@ module Eager (D:Distinguisher) = { proc main2() = { var b; - ERO.init(); + RO.init(); b <@ D(ERO).distinguish(); ERO.resample(); return b; @@ -539,25 +554,19 @@ module Eager (D:Distinguisher) = { }. -equiv Eager_1_2 (D<:Distinguisher{RO}) : Eager(D).main1 ~ Eager(D).main2 : +equiv Eager_1_2: Eager(D).main1 ~ Eager(D).main2 : ={glob D} ==> ={res,glob RO, glob D}. proof. proc. transitivity{1} - { RO.init(); - ERO.resample(); - b <@ D(RO).distinguish(); } + { RO.init(); ERO.resample(); b <@ D(RO).distinguish(); } (={glob D} ==> ={b,RO.m,glob D}) (={glob D} ==> ={b,RO.m,glob D})=> //. + by move=> ?&mr->;exists (glob D){mr}. + inline *;rcondf{2}3;2:by sim. by auto=>?;rewrite restr0 dom0 elems_fset0. seq 1 1: (={glob D, RO.m});1:by inline *;auto. - eager (H: ERO.resample(); ~ ERO.resample();: ={RO.m} ==> ={RO.m}): - (={glob D, RO.m}) => //;1:by sim. - eager proc H (={RO.m}) => //;try sim. - + by apply eager_init. + by apply eager_get. + by apply eager_set. - + by apply eager_sample. + by apply eager_in_dom. + by apply eager_restrK. + by eager call eager_D. qed. end GenEager. From d9481edc111714ba60bcfead84eb872800d8071c Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Tue, 15 Dec 2015 12:44:07 +0100 Subject: [PATCH 088/394] Clearing proofs that have been pushed in the stdlib. --- sha3/proof/Common.ec | 4 ++++ sha3/proof/Temp.ec | 56 -------------------------------------------- 2 files changed, 4 insertions(+), 56 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 6b3d84c..3b0e1f0 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -106,6 +106,10 @@ 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_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 padK : pcancel pad unpad. proof. move=> s @/unpad; rewrite last_pad /= rev_cat rev_mkpad. diff --git a/sha3/proof/Temp.ec b/sha3/proof/Temp.ec index 0ab3d3b..06449dd 100644 --- a/sha3/proof/Temp.ec +++ b/sha3/proof/Temp.ec @@ -4,60 +4,4 @@ require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. require import Ring StdRing StdOrder StdBigop BitEncoding. (*---*) import IntID IntOrder BitChunking. -(* Add to IntDiv? *) - -lemma dvdz_lt (x y z : int) : - 0 < z => z %| x => z %| y => x < y => x + z <= y. -proof. -move=> gt0_z z_dvd_x z_dvd_y. -have -> : x = (x %/ z) * z by rewrite divzK. -have -> : y = (y %/ z) * z by rewrite divzK. -pose u := x %/ z; pose v := y %/ z; move=> u_tim_z_lt_v_tim_z. -have u_lt_v : u < v by rewrite -(@ltr_pmul2r z). -have -> : v = u + (v - u) by ring. -rewrite mulrDl ler_add2l ler_pemull 1:ltrW //. -by rewrite - (@ler_add2r u) - addrA addNr /= lez_add1r. -qed. - -(* Add to BitEncoding? *) - -lemma chunk_cat r (xs ys : 'a list) : - 0 < r => r %| size xs => chunk r (xs ++ ys) = chunk r xs ++ chunk r ys. -proof. -move=> ge0_r r_dvd_siz_xs; rewrite /chunk size_cat divzDl //. -(rewrite mkseq_add; first 2 rewrite divz_ge0 // size_ge0); congr. -apply eq_in_mkseq=> i [ge0_i i_lt_siz_xs_div_r] /=. -have i_tim_r_lt_siz_xs : i * r < size xs - by rewrite ltz_divRL // in i_lt_siz_xs_div_r. -have i_tim_r_add_r_le_siz_xs : i * r + r <= size xs - by rewrite dvdz_lt // dvdz_mull dvdzz. -rewrite mulrC drop_cat i_tim_r_lt_siz_xs /= take_cat. -cut r_le_siz_drop : r <= size (drop (i * r) xs) - by rewrite size_drop 1:divr_ge0 // 1:ltrW // max_ler - ler_subr_addr /= 1:ltrW // addrC. -rewrite ler_eqVlt in r_le_siz_drop. -elim r_le_siz_drop=> [r_eq_siz_drop | -> //]. -rewrite {1 6 8} r_eq_siz_drop /= take0 cats0 take_size //. -apply eq_in_mkseq=> i [ge0_i lt_siz_ys_i] /=. -have -> : r * (size xs %/ r + i) = size xs + r * i - by rewrite mulrDr mulrC divzK. -rewrite drop_cat. -case (size xs + r * i < size xs)=> [/gtr_addl lt0_r_tim_i | _]. -have contrad : 0 <= r * i < 0 by split; [rewrite divr_ge0 1:ltrW |]. -rewrite ler_lt_asym in contrad; elim contrad. -have -> // : size xs + r * i - size xs = r * i by ring. -qed. - -(* Add to Common? *) - -theory ForCommon. - -require import Common. - -lemma chunk_cat (xs ys : 'a list) : - r %| size xs => chunk r (xs ++ ys) = chunk r xs ++ chunk r ys. -proof. -exact /chunk_cat /gt0_r. -qed. - end ForCommon. From a70285cb738c2e1f043a63e9c49d0b7d06597532 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Tue, 15 Dec 2015 13:41:44 +0100 Subject: [PATCH 089/394] Shrinking unpadK. --- sha3/proof/Common.ec | 75 +++++++++++--------------------------------- 1 file changed, 18 insertions(+), 57 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 3b0e1f0..f34b353 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -3,6 +3,7 @@ require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. require import Ring StdRing StdOrder StdBigop BitEncoding. require (*--*) FinType BitWord LazyRP Monoid. (*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv Dprod. +require import NewLogic. (* -------------------------------------------------------------------- *) op r : { int | 2 <= r } as ge2_r. @@ -134,68 +135,28 @@ 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 => hb. +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. +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 //]. -have -> : size s + 1 - (i + 2) + 2 = size s - i + 1 by ring. -have -> : size s + 1 - (i + 2) = size s - i - 1 by ring. -case: (i = (-(size s - i + 1)) %% r) => [iE | //]. -pose j := size s - i - 1; apply/eq_sym. -rewrite -{1}(cat_take_drop j (rcons s b)) eqseq_cat //=. -rewrite size_take; first rewrite /j subr_ge0. - rewrite - (ler_add2r i) - addrA addNr /= lez_add1r //. -rewrite {2}/j size_rcons ltr_subl_addr ?ltr_spaddr //=. - rewrite ler_add2l - ler_oppl (ler_trans 0) // lerN10. -rewrite -cats1 drop_cat {1}/j ltr_subl_addr ler_lt_add //=. - rewrite ltr_oppl (ltr_le_trans 0) 1:ltrN10 //. -rewrite /mkpad -cats1 -cat_cons hb; congr. -have [ge0_j le_siz_j] : 0 <= j < size s. - rewrite /j; split=> [| _]. - rewrite - (ler_add2r 1) /= - addrA addNr /= - (ler_add2r i) - - addrA addNr /= lez_add1r //. - rewrite - addrA - opprD - (ltr_add2r (i + 1)) - addrA addrN /= - ltz_addl (ler_lt_trans i) // ltz_addl ltr01. -rewrite (drop_nth false) //. -have -> : nth false s j = true - by rewrite /j - addrA - opprD - nth_rev // nth_index // - - index_mem size_rev //. -congr. -have size_drop : size (drop (j + 1) s) = (-(j + 2)) %% r. - rewrite size_drop; 1:rewrite (ler_trans j) //ler_addl ler01. - rewrite max_ler /j. - have -> // : size s - (size s - i - 1 + 1) = i by ring. - have -> : size s - (size s - i - 1 + 1) = i by ring. - have -> : -(size s - i - 1 + 2) = -(size s - i + 1). - ring. rewrite - iE //. -apply (eq_from_nth false). -rewrite size_drop size_nseq. -rewrite max_ler // 1:modz_ge0 gtr_eqF ?gt0_r //. -move=> k [ge0k lt_size_drop_k]; rewrite size_drop in lt_size_drop_k. -rewrite nth_nseq; first split=> // _; rewrite - size_drop //. -rewrite nth_drop // 1:(ler_trans j) // 1:lez_addl 1:ler01. -rewrite /j. -have -> : size s - i - 1 + 1 + k = size s - ((i - k - 1) + 1) by ring. -have i_min_k_min1_rng {size_drop} : 0 <= i - k - 1 < i. - rewrite iE; pose sz := (-(size s - i + 1)) %% r. - split=> [| _]. - rewrite - (ler_add2r (k + 1)) /=. - have -> @/sz : sz - k - 1 + (k + 1) = sz by ring. - have -> : -(size s - i + 1) = -(size s - i - 1 + 2) by ring. - rewrite - /j addrC lez_add1r //. - rewrite -(ltr_add2r (k + 1)). - have -> : sz - k - 1 + (k + 1) = sz by algebra. - rewrite ltr_addl ltzS //. -rewrite - nth_rev //. - split=> [| _ //]. - elim i_min_k_min1_rng=> //. - rewrite (ltr_trans i) //; elim i_min_k_min1_rng=> //. -have -> : - (nth false (rev s) (i - k - 1) = false) = - (nth false (rev s) (i - k - 1) <> true) by smt ml=0. -rewrite (before_index false) //. +pose j := (size s + _ - _); case: (i = (-(j + 2)) %% r) => // iE. +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 //= -iE. +have sz_js: size (drop j s) = i+1; last apply/(eq_from_nth false). ++ by rewrite size_drop //= max_ler ?subr_ge0 ?ltrW // /j #ring. ++ by rewrite sz_js /= addrC size_nseq max_ler. +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. lemma chunk_padK : pcancel (chunk \o pad) (unpad \o flatten). From b82e5fbafd269c97152523bd413f3f6cd28f627b Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 17 Dec 2015 15:17:16 -0500 Subject: [PATCH 090/394] Proved lemmas giving iff characterizations of the validity functions for Block and Absorb. lemma nosmt valid_block_prop (xs : block list) : valid_block xs <=> exists (s : bool list, n : int), (0 <= n < r /\ r %| (size s + n + 2)) && blocks2bits xs = s ++ [true] ++ nseq n false ++ [true]. lemma valid_block_ends_not_b0 (xs : block list) : valid_block xs => last b0 xs <> b0. lemma nosmt valid_absorb_prop (xs : block list) : valid_absorb xs <=> exists (ys : block list, n : int), 0 <= n /\ xs = ys ++ nseq n b0 /\ valid_block ys. There are several functions at the beginning of Common.ec for the standard library. --- sha3/proof/Common.ec | 218 +++++++++++++++++++++++++++++++++++-------- 1 file changed, 178 insertions(+), 40 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index f34b353..ad58974 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -1,4 +1,5 @@ (* -------------------------------------------------------------------- *) + require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. require import Ring StdRing StdOrder StdBigop BitEncoding. require (*--*) FinType BitWord LazyRP Monoid. @@ -36,6 +37,29 @@ clone export BitWord as Block with rename "dword" as "bdistr" "zerow" as "b0". +lemma b0 : b0 = bits2w(nseq r false). +proof. +admit. (* FIXME *) +qed. + +lemma bits2w_inj_eq (cs ds : bool list) : + size cs = r => size ds = r => bits2w cs = bits2w ds <=> cs = ds. +proof. +admit. (* FIXME *) +qed. + +lemma last_neq_cat (x : 'a) (xs : 'a list) : + last x xs = x => xs = [] \/ exists ys, xs = rcons ys x. +proof. +elim xs; smt ml=0. +qed. + +lemma last_nseq (x0 x : 'a, n : int) : + 0 < n => last x0 (nseq n x) = x. +proof. +admit. +qed. + (* -------------------------------------------------------------------- *) clone export LazyRP as Perm with @@ -49,18 +73,18 @@ rename op chunk (bs : bool list) = BitChunking.chunk r bs. -op mkpad (n : int) = - true :: rcons (nseq ((-(n+2)) %% r) false) true. +op num0 (n : int) = (-(n + 2)) %% r. -op pad (s : bool list) = - s ++ mkpad (size s). +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 = (-(n+2)) %% r then Some (take n s) else None. + 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. @@ -74,42 +98,68 @@ 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) = (-(n+2)) %% r + 2. +lemma size_mkpad n : size (mkpad n) = num0 n + 2. proof. rewrite /mkpad /= size_rcons size_nseq max_ler. by rewrite modz_ge0 gtr_eqF ?gt0_r. by ring. qed. -lemma size_pad s: size (pad s) = (size s + 1) %/ r * r + r. +lemma size_pad_equiv (m : int) : + 0 <= m => m + num0 m + 2 = (m + 1) %/ r * r + r. proof. -rewrite /pad /mkpad size_cat /= size_rcons size_nseq. -rewrite max_ler 1:modz_ge0 1:gtr_eqF ?gt0_r // (addrCA 1). -rewrite modNz ?gt0_r ?ltr_spaddr ?size_ge0 //. -by rewrite -(addrA _ 2) /= modzE; ring. +move=> ge0_m. +by rewrite modNz 1:/# 1:gt0_r -(addrA _ 2) /= modzE #ring. qed. -lemma size_pad_dvd_r s: r %| size (pad s). -proof. by rewrite size_pad dvdzD 1:dvdz_mull dvdzz. qed. +lemma num0_prop (m : int) : + 0 <= m => 0 <= num0 m < r /\ r %| (m + num0 m + 2). +proof. +move=> ge0_m. split. split=> [| _]. +by rewrite modz_ge0 1:gtr_eqF 1:gt0_r. rewrite ltz_pmod gt0_r. +rewrite (size_pad_equiv m) // dvdzD 1:dvdz_mull dvdzz. +qed. -lemma index_true_behead_mkpad n : - index true (behead (mkpad n)) = (-(n + 2)) %% r. +lemma num0_alt (n m : int) : + 0 <= m => 0 <= n < r => r %| (m + n + 2) => n = num0 m. proof. -rewrite /mkpad -cats1 index_cat mem_nseq size_nseq. -by rewrite max_ler // modz_ge0 gtr_eqF ?gt0_r. +move=> ge0_m [ge0_n lt_rn] r_dvd_m_add_n_add2. +rewrite modNz 1:ltr_spaddr // 1:gt0_r. +have -> : m + 2 - 1 = ((m + n + 2) - (n + 1)) by algebra. +rewrite -modzDm; have -> /= : (m + n + 2) %% r = 0 by apply dvdzE. +rewrite modz_mod modNz 1:/# 1:gt0_r. +have -> : r - 1 - (r - 1 - (n + 1 - 1) %% r) = n %% r by algebra. +rewrite modz_small 1:gtr0_norm 1:gt0_r /#. qed. -lemma size_chunk bs : size (chunk bs) = size bs %/ r. -proof. by apply/BitChunking.size_chunk/gt0_r. qed. +lemma size_pad_raw (s : bool list) : + size (pad s) = size s + num0 (size s) + 2. +proof. +rewrite /pad /mkpad /= -cats1 -cat1s 2!catA 3!size_cat /= + size_nseq 1:max_ler 1:modz_ge0 1:gtr_eqF 1:gt0_r // #ring. +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 size_pad (s : bool list) : + size (pad s) = (size s + 1) %/ r * r + r. +proof. by rewrite size_pad_raw size_pad_equiv 1:size_ge0. qed. -lemma chunkK bs : r %| size bs => flatten (chunk bs) = bs. -proof. by apply/BitChunking.chunkK/gt0_r. qed. +lemma size_pad_dvd_r s : r %| size (pad s). +proof. by rewrite size_pad dvdzD 1:dvdz_mull dvdzz. 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 pad_alt (s : bool list, n : int) : + 0 <= n < r => r %| (size s + n + 2) => + pad s = s ++ [true] ++ nseq n false ++ [true]. +proof. +move=> [ge0_n lt_nr] mod. +rewrite /pad /mkpad /= -cats1 -cat1s 2!catA + (num0_alt n (size s)) // size_ge0. +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 max_ler // modz_ge0 gtr_eqF ?gt0_r. +qed. lemma padK : pcancel pad unpad. proof. @@ -123,7 +173,7 @@ pose b := _ = size _; case b => @/b - {b}. 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}. +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 @@ -137,7 +187,7 @@ 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. +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. @@ -159,6 +209,34 @@ have ->: j + k = (size s) - ((i-k) + 1) by rewrite /j #ring. by rewrite -nth_rev 1:/# &(negbRL _ true) &(before_index) /#. qed. +lemma nosmt unpad_prop (t : bool list) : + unpad t <> None <=> + exists (s : bool list, n : int), + (0 <= n < r /\ r %| (size s + n + 2)) && + t = s ++ [true] ++ nseq n false ++ [true]. +proof. +split=> [unpd_neq_None | [s n [[range_n dvd] ->]]]. +have [u unpd_Some] : exists s, unpad t = Some s + by move: unpd_neq_None; case (unpad t)=> // x _; exists x. +have <- : pad u = t by rewrite -(unpadK t) unpd_Some. +exists u, (num0 (size u)); split=> [| [num0_rng dvd_num0]]. +by rewrite num0_prop size_ge0. by apply pad_alt. +by rewrite -pad_alt // padK. +qed. + +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_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. @@ -166,11 +244,19 @@ lemma flattenK bs : (forall b, mem bs b => size b = r) => chunk (flatten bs) = bs. proof. by apply/BitChunking.flattenK/gt0_r. qed. -op blocks2bits (xs:block list) : bool list = - flatten (map w2bits xs). +op blocks2bits (xs:block list) : bool list = flatten (map w2bits xs). + +lemma blocks2bits_nil : blocks2bits [] = []. +proof. by rewrite /blocks2bits /= flatten_nil. qed. + +lemma blocks2bits_sing (x : block) : blocks2bits [x] = w2bits 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. -op bits2blocks (xs:bool list) : block list = - map bits2w (chunk xs). +op bits2blocks (xs:bool list) : block list = map bits2w (chunk xs). lemma blocks2bitsK : cancel blocks2bits bits2blocks. proof. @@ -193,7 +279,7 @@ have map_tolistK : + split. + apply tolistK; rewrite mem_xs_cons_yss_siz_r //. + apply ih => zs mem_zss_zs. - + by rewrite mem_xs_cons_yss_siz_r /=; first right; assumption. + + by rewrite mem_xs_cons_yss_siz_r /=; first right. rewrite map_tolistK; [apply in_chunk_size | exact chunkK]. qed. @@ -203,8 +289,8 @@ op unpad_blocks : block list -> bool list option = unpad \o blocks2bits. lemma pad2blocksK : pcancel pad2blocks unpad_blocks. proof. move=> xs. -rewrite /pad2blocks /unpad_blocks /(\o) bits2blocksK - 1:size_pad_dvd_r padK //. +by rewrite /pad2blocks /unpad_blocks /(\o) bits2blocksK + 1:size_pad_dvd_r padK. qed. lemma unpadBlocksK : ocancel unpad_blocks pad2blocks. @@ -213,10 +299,11 @@ 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)=> //. + 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 //. -rewrite /bs blocks2bitsK //. +have -> : pad(oget(unpad bs)) = bs + by rewrite - {2} (unpadK bs) unpad_bs. +by rewrite /bs blocks2bitsK. qed. (* ------------------------ Extending/Stripping ----------------------- *) @@ -227,6 +314,10 @@ 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. 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. @@ -273,6 +364,53 @@ op valid_toplevel (_ : bool list) = true. (* in Block *) op valid_block (xs : block list) = unpad_blocks xs <> None. +lemma nosmt valid_block_prop (xs : block list) : + valid_block xs <=> + exists (s : bool list, n : int), + (0 <= n < r /\ r %| (size s + n + 2)) && + blocks2bits xs = s ++ [true] ++ nseq n false ++ [true]. +proof. rewrite /unpad_blocks /(\o); apply unpad_prop. qed. + +lemma valid_block_ends_not_b0 (xs : block list) : + valid_block xs => last b0 xs <> b0. +proof. +move=> vb_xs. +have [s n [_ btb_eq]] : + exists (s : bool list) (n : int), + (0 <= n < r /\ r %| (size s + n + 2)) && + blocks2bits xs = s ++ [true] ++ nseq n false ++ [true] + by rewrite -valid_block_prop. +case (last b0 xs <> b0)=> [// | last_xs_eq_b0]. +rewrite nnot in last_xs_eq_b0. +move: last_xs_eq_b0=> /last_neq_cat [->> | [ys ->>]]. +rewrite /blocks2bits /# in btb_eq. +rewrite -cats1 blocks2bits_cat blocks2bits_sing in btb_eq. +have left : last true (blocks2bits ys ++ w2bits b0) = false + by rewrite last_cat b0 tolistK 1:size_nseq 1:max_ler // 1:ge0_r // + last_nseq 1:gt0_r. +have right : last true (s ++ [true] ++ nseq n false ++ [true]) = true + by rewrite cats1 last_rcons. +have last_eq : + last true (blocks2bits ys ++ w2bits b0) = + last true (s ++ [true] ++ nseq n false ++ [true]) + by rewrite btb_eq. +by rewrite left right in last_eq. +qed. + (* in Absorb *) -op valid_absorb (xs : block list) = - let (ys, _) = strip xs in valid_block ys. +op valid_absorb (xs : block list) = valid_block((strip xs).`1). + +lemma nosmt valid_absorb_prop (xs : block list) : + valid_absorb xs <=> + exists (ys : block list, n : int), + 0 <= n /\ xs = ys ++ nseq n b0 /\ valid_block ys. +proof. +rewrite /valid_absorb. +split=> [| [ys n] [ge0_n [-> vb_ys]]]. +move=> strp_xs_valid. +exists (strip xs).`1, (strip xs).`2. +split; first apply (strip_ge0 xs). +split=> //. +by rewrite -/(extend (strip xs).`1 (strip xs).`2) eq_sym (stripK xs). +by rewrite -/(extend ys n) extendK 1:valid_block_ends_not_b0. +qed. From 009d9315bc5539386ab12fe2623ee2cc75b16217 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 17 Dec 2015 17:42:59 -0500 Subject: [PATCH 091/394] valid_block_prop had redundant conjunct. --- sha3/proof/Common.ec | 35 +++++++++++++++++++++++++---------- 1 file changed, 25 insertions(+), 10 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index ad58974..de91f3b 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -54,12 +54,6 @@ proof. elim xs; smt ml=0. qed. -lemma last_nseq (x0 x : 'a, n : int) : - 0 < n => last x0 (nseq n x) = x. -proof. -admit. -qed. - (* -------------------------------------------------------------------- *) clone export LazyRP as Perm with @@ -256,6 +250,15 @@ 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]. +by rewrite blocks2bits_nil. +rewrite -cat1s blocks2bits_cat blocks2bits_sing size_cat // + size_cat size_tolist ih /= #ring. +qed. + op bits2blocks (xs:bool list) : block list = map bits2w (chunk xs). lemma blocks2bitsK : cancel blocks2bits bits2blocks. @@ -367,9 +370,21 @@ op valid_block (xs : block list) = unpad_blocks xs <> None. lemma nosmt valid_block_prop (xs : block list) : valid_block xs <=> exists (s : bool list, n : int), + 0 <= n < r /\ blocks2bits xs = s ++ [true] ++ nseq n false ++ [true]. +proof. +rewrite /unpad_blocks /(\o). +split=> [vb | [s n] [rng_n btb]]. +have /# : + exists (s : bool list) (n : int), (0 <= n < r /\ r %| (size s + n + 2)) && - blocks2bits xs = s ++ [true] ++ nseq n false ++ [true]. -proof. rewrite /unpad_blocks /(\o); apply unpad_prop. qed. + blocks2bits xs = s ++ [true] ++ nseq n false ++ [true] + by apply unpad_prop. +have dvd : r %| (size s + n + 2). + have <- : size (blocks2bits xs) = size s + n + 2 + by rewrite btb 3!size_cat /= size_nseq max_ler /#. + rewrite size_blocks2bits dvdz_mulr dvdzz. +rewrite unpad_prop /#. +qed. lemma valid_block_ends_not_b0 (xs : block list) : valid_block xs => last b0 xs <> b0. @@ -377,8 +392,8 @@ proof. move=> vb_xs. have [s n [_ btb_eq]] : exists (s : bool list) (n : int), - (0 <= n < r /\ r %| (size s + n + 2)) && - blocks2bits xs = s ++ [true] ++ nseq n false ++ [true] + 0 <= n < r /\ + blocks2bits xs = s ++ [true] ++ nseq n false ++ [true]. by rewrite -valid_block_prop. case (last b0 xs <> b0)=> [// | last_xs_eq_b0]. rewrite nnot in last_xs_eq_b0. From 3a61c9718ae0b8b190647e05edcfbbf573b16001 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 17 Dec 2015 21:28:52 -0500 Subject: [PATCH 092/394] Nit. --- sha3/proof/Common.ec | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index de91f3b..a28e312 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -48,12 +48,18 @@ proof. admit. (* FIXME *) qed. -lemma last_neq_cat (x : 'a) (xs : 'a list) : +lemma last_eq_rcons (x : 'a) (xs : 'a list) : last x xs = x => xs = [] \/ exists ys, xs = rcons ys x. proof. elim xs; smt ml=0. qed. +lemma last_neq_rcons (y x : 'a) (xs : 'a list) : + x <> y => last y xs = x => exists ys, xs = rcons ys x. +proof. +elim xs; smt ml=0. +qed. + (* -------------------------------------------------------------------- *) clone export LazyRP as Perm with @@ -397,7 +403,7 @@ have [s n [_ btb_eq]] : by rewrite -valid_block_prop. case (last b0 xs <> b0)=> [// | last_xs_eq_b0]. rewrite nnot in last_xs_eq_b0. -move: last_xs_eq_b0=> /last_neq_cat [->> | [ys ->>]]. +move: last_xs_eq_b0=> /last_eq_rcons [->> | [ys ->>]]. rewrite /blocks2bits /# in btb_eq. rewrite -cats1 blocks2bits_cat blocks2bits_sing in btb_eq. have left : last true (blocks2bits ys ++ w2bits b0) = false From 5f2705d4f4126ad60e565b2ff3b12805e615ae1e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 18 Dec 2015 10:20:41 +0100 Subject: [PATCH 093/394] Pushing on the GReal->ConcreteF transition. --- sha3/proof/LazyRP.eca | 21 ++++++++++++++++- sha3/proof/old/ConcreteF.eca | 29 +++++++++++++++++------ sha3/proof/variant/LazyRP.eca | 39 ------------------------------- sha3/proof/variant/LeakyAbsorb.ec | 5 ++-- sha3/proof/variant/RP.eca | 26 --------------------- 5 files changed, 45 insertions(+), 75 deletions(-) delete mode 100644 sha3/proof/variant/LazyRP.eca delete mode 100644 sha3/proof/variant/RP.eca diff --git a/sha3/proof/LazyRP.eca b/sha3/proof/LazyRP.eca index b483b42..012268d 100644 --- a/sha3/proof/LazyRP.eca +++ b/sha3/proof/LazyRP.eca @@ -1,4 +1,4 @@ -require import Option FSet NewFMap. +require import Option Real FSet NewFMap Distr. require import Dexcepted. require (*..*) RP. @@ -37,3 +37,22 @@ module P : RP, RP_ = { return oget mi.[x]; } }. + +lemma P_init_ll: islossless P.init. +proof. by proc; auto. qed. + +lemma P_f_ll: is_lossless d => support d = predT => islossless P.f. +proof. +move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. +have h:= endo_dom_rng P.m{m} _; first by exists x{m}. +apply/lossless_restr; first by rewrite d_ll. +smt. (* needs help *) +qed. + +lemma P_fi_ll: is_lossless d => support d = predT => islossless P.fi. +proof. +move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. +have h:= endo_dom_rng P.mi{m} _; first by exists x{m}. +apply/lossless_restr; first by rewrite d_ll. +smt. (* needs help *) +qed. diff --git a/sha3/proof/old/ConcreteF.eca b/sha3/proof/old/ConcreteF.eca index 22b4e05..dbf7ed3 100644 --- a/sha3/proof/old/ConcreteF.eca +++ b/sha3/proof/old/ConcreteF.eca @@ -66,13 +66,28 @@ section. + while (={glob Perm,sc,sa,p} /\ (C.c + size p){1} = C.c{2});2:by auto. by wp;sp 1 1;if{2};[rcondt{1} 3|rcondf{1} 3];auto; progress;rewrite size_behead//;ring. - by auto; smt ml=0 w=size_ge0. - cut p_ll : islossless Perm.f. - + admit. (* We should have the lemma *) - cut pi_ll : islossless Perm.fi. - + admit. (* We should have the lemma *) - cut f_ll : islossless SqueezelessSponge(Perm).f. - + admit. (* We should have the lemma *) + by auto; smt ml=0 w=size_ge0. + have p_ll := P_f_ll _ _. + + apply/Dprod.lossless. + + exact/Block.DWord.bdistr_ll. + exact/Capacity.DWord.cdistr_ll. + + apply/fun_ext=> x; rewrite Dprod.supp_def /bdistr /cdistr. + rewrite -/(Distr.support _ _) NewDistr.MUniform.support_duniform Block.enumP. + by rewrite -/(Distr.support _ _) NewDistr.MUniform.support_duniform Capacity.enumP. + have pi_ll := P_fi_ll _ _. + + apply/Dprod.lossless. + + exact/Block.DWord.bdistr_ll. + exact/Capacity.DWord.cdistr_ll. + + apply/fun_ext=> x; rewrite Dprod.supp_def /bdistr /cdistr. + rewrite -/(Distr.support _ _) NewDistr.MUniform.support_duniform Block.enumP. + by rewrite -/(Distr.support _ _) NewDistr.MUniform.support_duniform Capacity.enumP. + have f_ll : islossless SqueezelessSponge(Perm).f. + + proc; sp; if=> //=. + while true (size p) (size p) 1%r=> //=. + * smt w=(size_ge0 size_eq0). + * by move=> hind; seq 2: true 1%r 1%r 0%r _=> //=; wp; call p_ll. + * by wp; call p_ll. + by move=> z; conseq (_: _ : =1%r); wp; call p_ll; skip; smt w=size_behead. apply (ler_trans _ _ _ (Pr_restr Perm SqueezelessSponge D p_ll pi_ll f_ll D_ll &m)). admit. (* Francois *) diff --git a/sha3/proof/variant/LazyRP.eca b/sha3/proof/variant/LazyRP.eca deleted file mode 100644 index b483b42..0000000 --- a/sha3/proof/variant/LazyRP.eca +++ /dev/null @@ -1,39 +0,0 @@ -require import Option FSet NewFMap. -require import Dexcepted. -require (*..*) RP. - -type D. -op d: D distr. - -clone include RP with - type from <- D, - type to <- D. - -module P : RP, RP_ = { - var m : (D, D) fmap - var mi: (D, D) fmap - - proc init() = { m = map0; mi = map0; } - - proc f(x) = { - var y; - - if (!mem (dom m) x) { - y <$ d \ rng m; - m.[x] <- y; - mi.[y] <- x; - } - return oget m.[x]; - } - - proc fi(x) = { - var y; - - if (!mem (dom mi) x) { - y <$ d \ rng mi; - mi.[x] <- y; - m.[y] <- x; - } - return oget mi.[x]; - } -}. diff --git a/sha3/proof/variant/LeakyAbsorb.ec b/sha3/proof/variant/LeakyAbsorb.ec index c59fe8b..3ebe579 100644 --- a/sha3/proof/variant/LeakyAbsorb.ec +++ b/sha3/proof/variant/LeakyAbsorb.ec @@ -363,7 +363,7 @@ section PROOF. `|Pr[Experiment(SpongeThatAbsorbs(Perm),Perm,D).main() @ &m : res] - Pr[Experiment(IdealFunctionalityThatAbsorbs, MkS(S,IdealFunctionalityThatAbsorbs), D).main() @ &m : res]|. proof. - congr;congr. + do 3?congr. + byequiv (_: ={glob D} ==> _) => //;proc;inline *. call (_: ={glob Perm});1,2:(by sim); last by auto. proc;inline{1}SpongeThatDoesNotAbsorb(Perm).f;sp 1 3;if=> //. @@ -371,7 +371,8 @@ section PROOF. while (={glob Perm, i, sa, sc} /\ n0{1} = n{2} /\ z{1} = take (size m{1}) z{1} ++ z{2} /\ size m{1} <= size z{1}). + call (_ : ={glob Perm});[by sim|auto;progress [-split];smt]. while (={glob Perm, p, sa,sc} /\ (size z = size m - size p){1}). - + wp;call (_ : ={glob Perm});[by sim|auto;progress [-split];smt]. + + wp;call (_ : ={glob Perm});[by sim|auto;progress [-split]]. + by rewrite size_rcons H; move: H0; case: (p{2})=> //= x xs; ring. by auto;progress [-split];smt. cut -> : Pr[Experiment(IdealFunctionalityThatDoesNotAbsorb, S(IdealFunctionalityThatDoesNotAbsorb), MkD(D)).main () @ &m : res] = Pr[RndOrcl0.IND(Restr(RO), E1).main() @ &m : res]. diff --git a/sha3/proof/variant/RP.eca b/sha3/proof/variant/RP.eca deleted file mode 100644 index eafe094..0000000 --- a/sha3/proof/variant/RP.eca +++ /dev/null @@ -1,26 +0,0 @@ -type from, to. - -module type RP = { - proc init() : unit - proc f (x : from): to - proc fi(x : to ): from -}. - -module type RP_ = { - proc f (x : from): to - proc fi(x : to ): from -}. - -module type Distinguisher(G : RP_) = { - proc distinguish(): bool -}. - -module IND(G:RP, D:Distinguisher) = { - proc main(): bool = { - var b; - - G.init(); - b <@ D(G).distinguish(); - return b; - } -}. From 6161b5d37575bbda3d6d8d646e412fc08c276a65 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Sat, 19 Dec 2015 14:00:29 -0500 Subject: [PATCH 094/394] Simplifications. --- sha3/proof/Common.ec | 38 ++++++++++++++++---------------------- 1 file changed, 16 insertions(+), 22 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index a28e312..b0d322d 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -265,6 +265,9 @@ rewrite -cat1s blocks2bits_cat blocks2bits_sing size_cat // size_cat size_tolist ih /= #ring. qed. +lemma size_blocks2bits_dvd_r (xs : block list) : r %| size(blocks2bits xs). +proof. rewrite size_blocks2bits dvdz_mulr dvdzz. qed. + op bits2blocks (xs:bool list) : block list = map bits2w (chunk xs). lemma blocks2bitsK : cancel blocks2bits bits2blocks. @@ -378,30 +381,24 @@ lemma nosmt valid_block_prop (xs : block list) : exists (s : bool list, n : int), 0 <= n < r /\ blocks2bits xs = s ++ [true] ++ nseq n false ++ [true]. proof. -rewrite /unpad_blocks /(\o). +rewrite /valid_block /unpad_blocks /(\o). split=> [vb | [s n] [rng_n btb]]. -have /# : - exists (s : bool list) (n : int), - (0 <= n < r /\ r %| (size s + n + 2)) && - blocks2bits xs = s ++ [true] ++ nseq n false ++ [true] - by apply unpad_prop. -have dvd : r %| (size s + n + 2). - have <- : size (blocks2bits xs) = size s + n + 2 - by rewrite btb 3!size_cat /= size_nseq max_ler /#. - rewrite size_blocks2bits dvdz_mulr dvdzz. -rewrite unpad_prop /#. +cut [up _] := (unpad_prop (blocks2bits xs)). +rewrite vb /= in up; elim up=> [s n] [[rng_n _] b2b]. +by exists s, n. +apply unpad_prop; exists s, n; split=> //; split=> //. +have <- : size (blocks2bits xs) = size s + n + 2 + by rewrite btb 3!size_cat /= size_nseq max_ler /#ring. +rewrite 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 [s n [_ btb_eq]] : - exists (s : bool list) (n : int), - 0 <= n < r /\ - blocks2bits xs = s ++ [true] ++ nseq n false ++ [true]. - by rewrite -valid_block_prop. -case (last b0 xs <> b0)=> [// | last_xs_eq_b0]. +cut bp := valid_block_prop xs. +rewrite vb_xs /= in bp; elim bp=> [s n] [_ btb_eq]. +case: (last b0 xs <> b0)=> [// | last_xs_eq_b0]. rewrite nnot in last_xs_eq_b0. move: last_xs_eq_b0=> /last_eq_rcons [->> | [ys ->>]]. rewrite /blocks2bits /# in btb_eq. @@ -426,12 +423,9 @@ lemma nosmt valid_absorb_prop (xs : block list) : exists (ys : block list, n : int), 0 <= n /\ xs = ys ++ nseq n b0 /\ valid_block ys. proof. -rewrite /valid_absorb. -split=> [| [ys n] [ge0_n [-> vb_ys]]]. -move=> strp_xs_valid. +rewrite /valid_absorb; split=> [strp_xs_valid | [ys n] [ge0_n [-> vb_ys]]]. exists (strip xs).`1, (strip xs).`2. -split; first apply (strip_ge0 xs). -split=> //. +split; [apply (strip_ge0 xs) | split=> //]. by rewrite -/(extend (strip xs).`1 (strip xs).`2) eq_sym (stripK xs). by rewrite -/(extend ys n) extendK 1:valid_block_ends_not_b0. qed. From 82b4f799b85c2fbf91b7a64ace999ea083c45f81 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Sun, 20 Dec 2015 23:12:39 -0500 Subject: [PATCH 095/394] Almost done with alternative version of valid_block_prop, which should be more useful for some purposes. --- sha3/proof/Common.ec | 196 ++++++++++++++++++++++++++++++++++++------- 1 file changed, 168 insertions(+), 28 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index b0d322d..6736cd8 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -37,6 +37,19 @@ clone export BitWord as Block with rename "dword" as "bdistr" "zerow" as "b0". +(* ------------------------- Auxiliary Lemmas ------------------------- *) + +lemma chunk_nil' ['a] (r : int) : BitChunking.chunk r [<:'a>] = []. +proof. by rewrite /chunk /= div0z 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 b0 : b0 = bits2w(nseq r false). proof. admit. (* FIXME *) @@ -48,16 +61,16 @@ proof. admit. (* FIXME *) qed. -lemma last_eq_rcons (x : 'a) (xs : 'a list) : - last x xs = x => xs = [] \/ exists ys, xs = rcons ys x. +lemma last_drop_all_but_last (y : 'a, xs : 'a list) : + xs = [] \/ drop (size xs - 1) xs = [last y xs]. proof. -elim xs; smt ml=0. -qed. - -lemma last_neq_rcons (y x : 'a) (xs : 'a list) : - x <> y => last y xs = x => exists ys, xs = rcons ys x. -proof. -elim xs; smt ml=0. +elim xs=> // z zs ih /=; have -> : 1 + size zs - 1 = size zs by ring. +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 (last_nonempty y z). qed. (* -------------------------------------------------------------------- *) @@ -233,6 +246,12 @@ 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'. 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. @@ -268,7 +287,22 @@ qed. lemma size_blocks2bits_dvd_r (xs : block list) : r %| size(blocks2bits xs). proof. rewrite size_blocks2bits dvdz_mulr dvdzz. qed. -op bits2blocks (xs:bool list) : block list = map bits2w (chunk xs). +op bits2blocks (xs : bool list) : block list = map bits2w (chunk xs). + +lemma bits2blocks_nil : bits2blocks [] = []. +proof. by rewrite /bits2blocks chunk_nil. qed. + +lemma bits2blocks_sing (xs : bool list) : + size xs = r => bits2blocks xs = [bits2w xs]. +proof. move=> sz_xs_eq_r; by 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 // map_cat. +qed. lemma blocks2bitsK : cancel blocks2bits bits2blocks. proof. @@ -382,37 +416,143 @@ lemma nosmt valid_block_prop (xs : block list) : 0 <= n < r /\ blocks2bits xs = s ++ [true] ++ nseq n false ++ [true]. proof. rewrite /valid_block /unpad_blocks /(\o). -split=> [vb | [s n] [rng_n btb]]. +split=> [vb | [s n] [rng_n b2b]]. cut [up _] := (unpad_prop (blocks2bits xs)). rewrite vb /= in up; elim up=> [s n] [[rng_n _] b2b]. by exists s, n. apply unpad_prop; exists s, n; split=> //; split=> //. have <- : size (blocks2bits xs) = size s + n + 2 - by rewrite btb 3!size_cat /= size_nseq max_ler /#ring. + by rewrite b2b 3!size_cat /= size_nseq max_ler /#ring. rewrite 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. -cut bp := valid_block_prop xs. -rewrite vb_xs /= in bp; elim bp=> [s n] [_ btb_eq]. +move=> vb_xs; cut bp := valid_block_prop xs. +rewrite vb_xs /= in bp; elim bp=> [s n] [_ b2b_xs_eq]. case: (last b0 xs <> b0)=> [// | last_xs_eq_b0]. rewrite nnot in last_xs_eq_b0. -move: last_xs_eq_b0=> /last_eq_rcons [->> | [ys ->>]]. -rewrite /blocks2bits /# in btb_eq. -rewrite -cats1 blocks2bits_cat blocks2bits_sing in btb_eq. -have left : last true (blocks2bits ys ++ w2bits b0) = false - by rewrite last_cat b0 tolistK 1:size_nseq 1:max_ler // 1:ge0_r // - last_nseq 1:gt0_r. -have right : last true (s ++ [true] ++ nseq n false ++ [true]) = true - by rewrite cats1 last_rcons. -have last_eq : - last true (blocks2bits ys ++ w2bits b0) = - last true (s ++ [true] ++ nseq n false ++ [true]) - by rewrite btb_eq. -by rewrite left right in last_eq. +have xs_non_nil : xs <> [] by smt ml=0. +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 b0 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 tolistK + 1:size_nseq 1:max_ler 1:ge0_r // last_cat + last_nseq 1:gt0_r. +by rewrite last_b2b_xs_true in last_b2b_xs_false. +qed. + +lemma dvd_bounded_imp_eq (n : int) : + r %| n => 0 < n < r + r => n = r. +proof. +move=> dvd_rn [gt0_n lt_n_2r]. +have [m] n_eq /# : exists m, m * r = n + by exists (n %/ r); apply dvdz_eq. +qed. + +lemma nosmt valid_block_prop_alt (xs : block list) : + valid_block xs <=> + (exists (ys : block list, x : block, s : bool list, n : int), + xs = ys ++ [x] /\ 0 <= n /\ + w2bits x = s ++ [true] ++ nseq n false ++ [true]) \/ + (exists (ys : block list, y z : block), + xs = ys ++ [y; z] /\ last false (w2bits y) /\ + w2bits z = nseq (r - 1) false ++ [true]). +proof. +rewrite valid_block_prop. +split=>[[s n] [[ge0_n lt_nr] b2b_xs_eq] | + [[ys x s n] [xs_eq [ge0_n w2b_ys_eq]] | + [ys y z] [xs_eq [lst_w2b_y 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 max_ler /#. + 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 max_lel /#. +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 max_ler 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. + cut -> : 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 in xs_eq. +rewrite bits2blocks_cat in xs_eq. +rewrite sz_tke_dvd_r. rewrite !size_cat /= size_nseq max_ler 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]. +right. +admit. (* Alley in process of filling *) +have lt_n_r_min1 : n < r - 1 by smt ml=0. +left. +move: xs_eq. +have sz_drp_plus_n_plus_2_eq_r : size drp + n + 2 = r. + rewrite (dvd_bounded_imp_eq (size drp + n + 2)) // sz_drp. + have n_plus2_rng : 2 <= n + 2 <= r by smt ml=0. + rewrite -addrA; split=> [| _]. + rewrite ltr_paddl 1:modz_ge0 1:gtr_eqF 1:gt0_r // /#. + 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 max_ler 1:ge0_n 1:sz_drp. + have -> : size s %% r + (1 + (n + 1)) = size s %%r + n + 2 by ring. + by rewrite -sz_drp. +exists (bits2blocks tke), + (bits2w(drp ++ ([true] ++ (nseq n false ++ [true])))), + drp, n. +split=> //; split=> //. +by rewrite tolistK 1:!size_cat /= 1:size_nseq 1:max_ler 1:ge0_n + 1:-sz_drp_plus_n_plus_2_eq_r 1:#ring -!catA cat1s. +exists (blocks2bits ys ++ s), n; split. +have sz_w2b_x_eq_r : size(w2bits x) = r by apply size_tolist. +rewrite w2b_ys_eq !size_cat /= size_nseq max_ler // in sz_w2b_x_eq_r. +split=> // _; smt ml=0 w=(size_ge0). +by rewrite xs_eq blocks2bits_cat blocks2bits_sing w2b_ys_eq !catA. +exists (blocks2bits ys ++ (take (r - 1) (w2bits y))), (r - 1). +split; first smt ml=0 w=(gt0_r). +rewrite xs_eq blocks2bits_cat; have -> : [y; z] = [y] ++ [z] by trivial. +rewrite blocks2bits_cat 2!blocks2bits_sing -!catA; congr. +have {1}-> : w2bits y = take (r - 1) (w2bits y) ++ [true]. + rewrite -{1}(cat_take_drop (r - 1) (w2bits y)); congr. + elim (last_drop_all_but_last false (w2bits y))=> + [w2b_y_nil | drop_w2b_y_last]. + have not_lst_w2b_y : ! last false (w2bits y) by rewrite w2b_y_nil. + done. + rewrite lst_w2b_y in drop_w2b_y_last. + by rewrite -drop_w2b_y_last size_tolist. +by rewrite w2b_z_eq !catA. qed. (* in Absorb *) From e90904d425db669acc5b1189b8a3ca0d11ef633b Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Mon, 21 Dec 2015 10:25:27 -0500 Subject: [PATCH 096/394] Done with alternative block-level validity function. --- sha3/proof/Common.ec | 85 ++++++++++++++++++++++++++++---------------- sha3/proof/Temp.ec | 7 ---- 2 files changed, 54 insertions(+), 38 deletions(-) delete mode 100644 sha3/proof/Temp.ec diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 6736cd8..c50e1c7 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -39,7 +39,15 @@ clone export BitWord as Block with (* ------------------------- Auxiliary Lemmas ------------------------- *) -lemma chunk_nil' ['a] (r : int) : BitChunking.chunk r [<:'a>] = []. +lemma dvdz_close (n : int) : + r %| n => 0 < n < 2 * r => n = r. +proof. +move=> dvd_rn [gt0_n lt_n_2r]. +have [m] n_eq /# : exists m, m * r = n + by exists (n %/ r); apply dvdz_eq. +qed. + +lemma chunk_nil' ['a] r : BitChunking.chunk r [<:'a>] = []. proof. by rewrite /chunk /= div0z mkseq0. qed. lemma chunk_sing' r (xs : bool list) : @@ -301,7 +309,7 @@ lemma bits2blocks_cat (xs ys : bool list) : bits2blocks (xs ++ ys) = bits2blocks xs ++ bits2blocks ys. proof. move=> r_dvd_sz_xs r_dvd_sz_ys. -by rewrite /bits2blocks chunk_cat // map_cat. +by rewrite /bits2blocks chunk_cat 2:map_cat. qed. lemma blocks2bitsK : cancel blocks2bits bits2blocks. @@ -353,6 +361,7 @@ by rewrite /bs blocks2bitsK. qed. (* ------------------------ Extending/Stripping ----------------------- *) + op extend (xs : block list) (n : int) = xs ++ nseq n b0. @@ -417,7 +426,7 @@ lemma nosmt valid_block_prop (xs : block list) : proof. rewrite /valid_block /unpad_blocks /(\o). split=> [vb | [s n] [rng_n b2b]]. -cut [up _] := (unpad_prop (blocks2bits xs)). +have [up _] := (unpad_prop (blocks2bits xs)). rewrite vb /= in up; elim up=> [s n] [[rng_n _] b2b]. by exists s, n. apply unpad_prop; exists s, n; split=> //; split=> //. @@ -429,7 +438,7 @@ qed. lemma valid_block_ends_not_b0 (xs : block list) : valid_block xs => last b0 xs <> b0. proof. -move=> vb_xs; cut bp := valid_block_prop xs. +move=> vb_xs; have bp := valid_block_prop xs. rewrite vb_xs /= in bp; elim bp=> [s n] [_ b2b_xs_eq]. case: (last b0 xs <> b0)=> [// | last_xs_eq_b0]. rewrite nnot in last_xs_eq_b0. @@ -447,14 +456,6 @@ have last_b2b_xs_false : last true (blocks2bits xs) = false by rewrite last_b2b_xs_true in last_b2b_xs_false. qed. -lemma dvd_bounded_imp_eq (n : int) : - r %| n => 0 < n < r + r => n = r. -proof. -move=> dvd_rn [gt0_n lt_n_2r]. -have [m] n_eq /# : exists m, m * r = n - by exists (n %/ r); apply dvdz_eq. -qed. - lemma nosmt valid_block_prop_alt (xs : block list) : valid_block xs <=> (exists (ys : block list, x : block, s : bool list, n : int), @@ -470,14 +471,12 @@ split=>[[s n] [[ge0_n lt_nr] b2b_xs_eq] | [ys y z] [xs_eq [lst_w2b_y 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. +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=> // _. + 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 @@ -485,40 +484,64 @@ have sz_drp : size drp = size s %% r. case (size s %/ r * r < size s)=> // not_lt_sz_s. rewrite max_ler /#. have eq : size s %/ r * r = size s. - rewrite -lezNgt in not_lt_sz_s. - apply ler_asym; split=> //. + rewrite -lezNgt in not_lt_sz_s; apply ler_asym; split=> //. by rewrite lez_floor gtr_eqF 1:gt0_r //. rewrite max_lel /#. 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 max_ler 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_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. - cut -> : size s %/ r * r + (size s %% r + n + 2) = size s + n + 2. + 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 in xs_eq. -rewrite bits2blocks_cat in xs_eq. -rewrite sz_tke_dvd_r. rewrite !size_cat /= size_nseq max_ler 1:ge0_n. -have -> : size drp + (1 + (n + 1)) = size drp + n + 2 by ring. -rewrite sz_drp_plus_n_plus_2_dvd_r. +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 max_ler 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]. right. -admit. (* Alley in process of filling *) +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 ml=0. + 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. +exists (bits2blocks tke), + (bits2w (drp ++ [true])), + (bits2w (nseq n false ++ [true])). +split. +rewrite xs_eq. +rewrite (catA drp [true]) bits2blocks_cat 1:size_cat // + 1:size_cat 1:size_nseq 1:max_ler 1:ge0_n /= 1:/#. +rewrite (bits2blocks_sing (drp ++ [true])) 1:size_cat //. +rewrite (bits2blocks_sing (nseq n false ++ [true])). +rewrite size_cat size_nseq max_ler /= 1:ge0_n /#. +by rewrite catA. +do 2! rewrite tolistK 1:size_cat //=. ++ rewrite size_nseq max_ler 1:ge0_n /#. +split; first rewrite cats1 last_rcons. +have -> // : n = r - 1 by smt ml=0. have lt_n_r_min1 : n < r - 1 by smt ml=0. left. move: xs_eq. have sz_drp_plus_n_plus_2_eq_r : size drp + n + 2 = r. - rewrite (dvd_bounded_imp_eq (size drp + n + 2)) // sz_drp. + rewrite (dvdz_close (size drp + n + 2)) // sz_drp. have n_plus2_rng : 2 <= n + 2 <= r by smt ml=0. 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. @@ -526,9 +549,9 @@ move=> xs_eq. rewrite (bits2blocks_sing (drp ++ ([true] ++ (nseq n false ++ [true])))) in xs_eq. -rewrite !size_cat /= size_nseq max_ler 1:ge0_n 1:sz_drp. - have -> : size s %% r + (1 + (n + 1)) = size s %%r + n + 2 by ring. - by rewrite -sz_drp. ++ rewrite !size_cat /= size_nseq max_ler 1:ge0_n 1:sz_drp. ++ have -> : size s %% r + (1 + (n + 1)) = size s %%r + n + 2 by ring. ++ by rewrite -sz_drp. exists (bits2blocks tke), (bits2w(drp ++ ([true] ++ (nseq n false ++ [true])))), drp, n. diff --git a/sha3/proof/Temp.ec b/sha3/proof/Temp.ec deleted file mode 100644 index 06449dd..0000000 --- a/sha3/proof/Temp.ec +++ /dev/null @@ -1,7 +0,0 @@ -(* Temporary File for Auxiliary Lemmas *) - -require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. -require import Ring StdRing StdOrder StdBigop BitEncoding. -(*---*) import IntID IntOrder BitChunking. - -end ForCommon. From fdc18c3b32671f9cb78f5e393c73c7da68eedcaf Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Mon, 21 Dec 2015 19:04:31 +0100 Subject: [PATCH 097/394] Some refactoring in Common. - use implicits (even if the system if far from perfect). Note that some proofs tend to overspecify lemmas' arguments. - remove useless intermediate that can be proved by a single rewrite or apply, or simplify their proofs. - remove useless pre-conditions && split lemmas of the form `XXX => A1 && ... && An`. - some renamings (xxxE for alt. def., xxxP for specifications) - start using inductive predicates (note: `exists` should handle inductive predicates equiv. to existentials). --- sha3/proof/Common.ec | 185 +++++++++++++++++++------------------------ 1 file changed, 83 insertions(+), 102 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index c50e1c7..65ba799 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -1,11 +1,12 @@ (* -------------------------------------------------------------------- *) - require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. require import Ring StdRing StdOrder StdBigop BitEncoding. require (*--*) FinType BitWord LazyRP Monoid. (*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv Dprod. require import NewLogic. +pragma +implicits. + (* -------------------------------------------------------------------- *) op r : { int | 2 <= r } as ge2_r. op c : { int | 0 < c } as gt0_c. @@ -75,23 +76,21 @@ proof. elim xs=> // z zs ih /=; have -> : 1 + size zs - 1 = size zs by ring. 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 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 (last_nonempty y z). +by rewrite (@last_nonempty y z). qed. (* -------------------------------------------------------------------- *) - clone export LazyRP as Perm with type D <- block * capacity, op d <- bdistr * Capacity.cdistr -rename - [module type] "RP" as "PRIMITIVE" - [module] "P" as "Perm". + rename + [module type] "RP" as "PRIMITIVE" + [module] "P" as "Perm". (* ------------------------- Padding/Unpadding ------------------------ *) - op chunk (bs : bool list) = BitChunking.chunk r bs. op num0 (n : int) = (-(n + 2)) %% r. @@ -129,51 +128,28 @@ lemma size_pad_equiv (m : int) : 0 <= m => m + num0 m + 2 = (m + 1) %/ r * r + r. proof. move=> ge0_m. -by rewrite modNz 1:/# 1:gt0_r -(addrA _ 2) /= modzE #ring. -qed. - -lemma num0_prop (m : int) : - 0 <= m => 0 <= num0 m < r /\ r %| (m + num0 m + 2). -proof. -move=> ge0_m. split. split=> [| _]. -by rewrite modz_ge0 1:gtr_eqF 1:gt0_r. rewrite ltz_pmod gt0_r. -rewrite (size_pad_equiv m) // dvdzD 1:dvdz_mull dvdzz. +by rewrite modNz 1:/# 1:gt0_r -(@addrA _ 2) /= modzE #ring. qed. -lemma num0_alt (n m : int) : - 0 <= m => 0 <= n < r => r %| (m + n + 2) => n = num0 m. -proof. -move=> ge0_m [ge0_n lt_rn] r_dvd_m_add_n_add2. -rewrite modNz 1:ltr_spaddr // 1:gt0_r. -have -> : m + 2 - 1 = ((m + n + 2) - (n + 1)) by algebra. -rewrite -modzDm; have -> /= : (m + n + 2) %% r = 0 by apply dvdzE. -rewrite modz_mod modNz 1:/# 1:gt0_r. -have -> : r - 1 - (r - 1 - (n + 1 - 1) %% r) = n %% r by algebra. -rewrite modz_small 1:gtr0_norm 1:gt0_r /#. -qed. - -lemma size_pad_raw (s : bool list) : +lemma size_padE (s : bool list) : size (pad s) = size s + num0 (size s) + 2. -proof. -rewrite /pad /mkpad /= -cats1 -cat1s 2!catA 3!size_cat /= - size_nseq 1:max_ler 1:modz_ge0 1:gtr_eqF 1:gt0_r // #ring. -qed. +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_pad_raw size_pad_equiv 1:size_ge0. qed. +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 pad_alt (s : bool list, n : int) : - 0 <= n < r => r %| (size s + n + 2) => - pad s = s ++ [true] ++ nseq n false ++ [true]. -proof. -move=> [ge0_n lt_nr] mod. -rewrite /pad /mkpad /= -cats1 -cat1s 2!catA - (num0_alt n (size s)) // size_ge0. -qed. +lemma dvd_r_num0 (m : int) : r %| (m + num0 m + 2). +proof. by rewrite /num0 /(%|) addrAC modzDmr subrr mod0z. qed. + +lemma num0_ge0 (m : int) : 0 <= num0 m. +proof. by rewrite modz_ge0 ?gtr_eqF ?gt0_r. qed. + +lemma num0_ltr (m : int) : num0 m < r. +proof. by rewrite ltz_pmod gt0_r. qed. lemma index_true_behead_mkpad n : index true (behead (mkpad n)) = num0 n. @@ -182,6 +158,14 @@ rewrite /mkpad -cats1 index_cat mem_nseq size_nseq. by rewrite max_ler // 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. @@ -191,7 +175,7 @@ have ^iE {1 2}->: i = (-(size s + 2)) %% r. 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 -(@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. @@ -207,14 +191,14 @@ 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. +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. -apply/eq_sym; rewrite -{1}(cat_take_drop j (rcons _ _)); congr. +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=> //=. @@ -227,22 +211,24 @@ 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) /#. +by rewrite -nth_rev 1:/# &(@negbRL _ true) &(before_index) /#. qed. -lemma nosmt unpad_prop (t : bool list) : - unpad t <> None <=> - exists (s : bool list, n : int), - (0 <= n < r /\ r %| (size s + n + 2)) && - t = s ++ [true] ++ nseq n false ++ [true]. +pred 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=> [unpd_neq_None | [s n [[range_n dvd] ->]]]. -have [u unpd_Some] : exists s, unpad t = Some s - by move: unpd_neq_None; case (unpad t)=> // x _; exists x. -have <- : pad u = t by rewrite -(unpadK t) unpd_Some. -exists u, (num0 (size u)); split=> [| [num0_rng dvd_num0]]. -by rewrite num0_prop size_ge0. by apply pad_alt. -by rewrite -pad_alt // padK. +split=> [|[s n lt_nr dvd ->]]; last by rewrite -padE ?padK. +case: {-2}(unpad _) (eq_refl (unpad t)) => // s /eq_sym 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. lemma size_chunk bs : size (chunk bs) = size bs %/ r. @@ -286,15 +272,15 @@ 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]. -by rewrite blocks2bits_nil. -rewrite -cat1s blocks2bits_cat blocks2bits_sing size_cat // - size_cat size_tolist ih /= #ring. +elim: xs=> [| x xs ih]; first by rewrite blocks2bits_nil. +rewrite -cat1s blocks2bits_cat blocks2bits_sing size_cat //. +rewrite size_cat size_tolist ih /= #ring. qed. lemma size_blocks2bits_dvd_r (xs : block list) : r %| size(blocks2bits xs). -proof. rewrite size_blocks2bits dvdz_mulr dvdzz. qed. +proof. by rewrite size_blocks2bits dvdz_mulr dvdzz. qed. +(* -------------------------------------------------------------------- *) op bits2blocks (xs : bool list) : block list = map bits2w (chunk xs). lemma bits2blocks_nil : bits2blocks [] = []. @@ -302,10 +288,9 @@ proof. by rewrite /bits2blocks chunk_nil. qed. lemma bits2blocks_sing (xs : bool list) : size xs = r => bits2blocks xs = [bits2w xs]. -proof. move=> sz_xs_eq_r; by rewrite /bits2blocks chunk_sing. qed. +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 => +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. @@ -314,37 +299,34 @@ qed. lemma blocks2bitsK : cancel blocks2bits bits2blocks. proof. - move=> xs;rewrite /blocks2bits /bits2blocks flattenK. - + by move=> b /mapP [x [_ ->]];rewrite size_tolist. - rewrite -map_comp -{2}(map_id xs) /(\o) /=;apply eq_map=> @/idfun x /=; - apply oflistK. +move=> xs; rewrite /blocks2bits /bits2blocks flattenK. + by move=> b /mapP [x [_ ->]];rewrite size_tolist. +rewrite -map_comp -{2}(@map_id xs) /(\o) /=. +by apply eq_map=> @/idfun x /=; apply oflistK. qed. lemma bits2blocksK (bs : bool list) : r %| size bs => blocks2bits(bits2blocks bs) = bs. proof. -move=> siz_bs_div_r. -rewrite /blocks2bits /bits2blocks -map_comp. +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 (w2bits \o bits2w) xss = xss. - + elim => [// | xs yss ih mem_xs_cons_yss_siz_r /=]. - + split. - + apply tolistK; rewrite mem_xs_cons_yss_siz_r //. - + apply ih => zs mem_zss_zs. - + by rewrite mem_xs_cons_yss_siz_r /=; first right. -rewrite map_tolistK; [apply in_chunk_size | exact chunkK]. ++ elim=> [// | xs yss ih eqr_sz /=]; split. + by apply tolistK; 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. +(* -------------------------------------------------------------------- *) 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. -by rewrite /pad2blocks /unpad_blocks /(\o) bits2blocksK - 1:size_pad_dvd_r padK. +move=> xs @/pad2blocks @/unpad_blocks @/(\o). +by rewrite bits2blocksK 1:size_pad_dvd_r padK. qed. lemma unpadBlocksK : ocancel unpad_blocks pad2blocks. @@ -361,7 +343,6 @@ by rewrite /bs blocks2bitsK. qed. (* ------------------------ Extending/Stripping ----------------------- *) - op extend (xs : block list) (n : int) = xs ++ nseq n b0. @@ -371,7 +352,7 @@ op strip (xs : block list) = lemma strip_ge0 (xs : block list) : 0 <= (strip xs).`2. -proof. rewrite /strip /= find_ge0. qed. +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). @@ -388,14 +369,14 @@ 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 max_ler //. have -> // : p (head b0 (rev xs)) by trivial. -by rewrite (addzC n) addNz /= take_size_cat. +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. +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. @@ -426,10 +407,10 @@ lemma nosmt valid_block_prop (xs : block list) : proof. rewrite /valid_block /unpad_blocks /(\o). split=> [vb | [s n] [rng_n b2b]]. -have [up _] := (unpad_prop (blocks2bits xs)). -rewrite vb /= in up; elim up=> [s n] [[rng_n _] b2b]. +have [up _] := (unpadP (blocks2bits xs)). +rewrite vb /= in up; case: up=> [s n rng_n _ b2b]. by exists s, n. -apply unpad_prop; exists s, n; split=> //; split=> //. +apply unpadP; apply (Unpad s n)=> //. have <- : size (blocks2bits xs) = size s + n + 2 by rewrite b2b 3!size_cat /= size_nseq max_ler /#ring. rewrite size_blocks2bits_dvd_r. @@ -494,13 +475,13 @@ have sz_s_pad_dvd_r : r %| (size s + n + 2). 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) + -(@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 +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 max_ler 1:ge0_n. + have -> : size drp + (1 + (n + 1)) = size drp + n + 2 by ring. @@ -508,13 +489,13 @@ rewrite -(cat_take_drop (size s %/ r * r) s) -!catA -/tke -/drp case: (n = r - 1)=> [n_eq_r_min1 | n_neq_r_min1]. right. have sz_drp_plus1_dvd_r : r %| (size drp + 1). - rewrite dvdzE -(addz0 (size drp + 1)) -{1}(modzz r). + rewrite dvdzE -(@addz0 (size drp + 1)) -{1}(@modzz r). have {1}-> : r = n + 1 by smt ml=0. 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)) //. + 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. @@ -523,10 +504,10 @@ exists (bits2blocks tke), (bits2w (nseq n false ++ [true])). split. rewrite xs_eq. -rewrite (catA drp [true]) bits2blocks_cat 1:size_cat // +rewrite (@catA drp [true]) bits2blocks_cat 1:size_cat // 1:size_cat 1:size_nseq 1:max_ler 1:ge0_n /= 1:/#. -rewrite (bits2blocks_sing (drp ++ [true])) 1:size_cat //. -rewrite (bits2blocks_sing (nseq n false ++ [true])). +rewrite (@bits2blocks_sing (drp ++ [true])) 1:size_cat //. +rewrite (@bits2blocks_sing (nseq n false ++ [true])). rewrite size_cat size_nseq max_ler /= 1:ge0_n /#. by rewrite catA. do 2! rewrite tolistK 1:size_cat //=. @@ -537,16 +518,16 @@ have lt_n_r_min1 : n < r - 1 by smt ml=0. left. 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. + rewrite (@dvdz_close (size drp + n + 2)) // sz_drp. have n_plus2_rng : 2 <= n + 2 <= r by smt ml=0. 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. + by rewrite -(@ltr_add2r (-2)) -2!addrA. move=> xs_eq. -rewrite (bits2blocks_sing +rewrite (@bits2blocks_sing (drp ++ ([true] ++ (nseq n false ++ [true])))) in xs_eq. + rewrite !size_cat /= size_nseq max_ler 1:ge0_n 1:sz_drp. @@ -568,7 +549,7 @@ split; first smt ml=0 w=(gt0_r). rewrite xs_eq blocks2bits_cat; have -> : [y; z] = [y] ++ [z] by trivial. rewrite blocks2bits_cat 2!blocks2bits_sing -!catA; congr. have {1}-> : w2bits y = take (r - 1) (w2bits y) ++ [true]. - rewrite -{1}(cat_take_drop (r - 1) (w2bits y)); congr. + rewrite -{1}(@cat_take_drop (r - 1) (w2bits y)); congr. elim (last_drop_all_but_last false (w2bits y))=> [w2b_y_nil | drop_w2b_y_last]. have not_lst_w2b_y : ! last false (w2bits y) by rewrite w2b_y_nil. @@ -588,7 +569,7 @@ lemma nosmt valid_absorb_prop (xs : block list) : proof. rewrite /valid_absorb; split=> [strp_xs_valid | [ys n] [ge0_n [-> vb_ys]]]. exists (strip xs).`1, (strip xs).`2. -split; [apply (strip_ge0 xs) | split=> //]. -by rewrite -/(extend (strip xs).`1 (strip xs).`2) eq_sym (stripK xs). +split; [apply (@strip_ge0 xs) | split=> //]. +by rewrite -/(extend (strip xs).`1 (strip xs).`2) eq_sym (@stripK xs). by rewrite -/(extend ys n) extendK 1:valid_block_ends_not_b0. qed. From c1898402ac9b37a6a3eec20160fca8d2c99c544a Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Tue, 22 Dec 2015 21:21:05 +0100 Subject: [PATCH 098/394] Examplify `case _: ...`. --- sha3/proof/Common.ec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 65ba799..48326ff 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -224,7 +224,7 @@ 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: {-2}(unpad _) (eq_refl (unpad t)) => // s /eq_sym sE _. +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. From 6d93f4ca73f93bdb4af7c226136357011072e2b9 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 28 Dec 2015 09:08:12 +0100 Subject: [PATCH 099/394] progress --- sha3/proof/old/MyRO.ec | 752 +++++++++++++++++++++++------------------ 1 file changed, 417 insertions(+), 335 deletions(-) diff --git a/sha3/proof/old/MyRO.ec b/sha3/proof/old/MyRO.ec index 8da2d87..b373634 100644 --- a/sha3/proof/old/MyRO.ec +++ b/sha3/proof/old/MyRO.ec @@ -1,161 +1,67 @@ -require import Option List FSet NewFMap. +require import Pair Option List FSet NewFMap. import NewLogic Fun. +require IterProc. -(* TODO: move this *) -lemma set_eq (m:('a,'b)fmap) x y: m.[x] = Some y => m.[x<-y] = m. -proof. - by rewrite fmapP=> Hx x';rewrite getP;case (x'=x)=>//->;rewrite Hx. -qed. - -lemma oflistK_uniq (s : 'a list) : uniq s => - perm_eq s (elems (oflist s)). -proof. by move/undup_id => {1}<-; apply/FSet.oflistK. qed. - -lemma setD1E (s : 'a fset) x : - perm_eq (elems (s `\` fset1 x)) (rem x (elems s)). -proof. -rewrite setDE; pose s' := List.filter _ _; apply/(perm_eq_trans s'). - rewrite perm_eq_sym oflistK_uniq ?filter_uniq ?uniq_elems. -rewrite /s' rem_filter ?uniq_elems; apply/uniq_perm_eq; - rewrite ?filter_uniq ?uniq_elems // => y. -by rewrite !mem_filter /predC in_fset1. -qed. +(* FIXME notation *) +abbrev ([+]) ['a 'b](x : 'b) = fun (_ : 'a) => x. -lemma perm_to_rem (s:'a fset) x : - mem s x => perm_eq (elems s) (x :: elems (s `\` fset1 x)). -proof. -rewrite memE => /perm_to_rem /perm_eqlP->; apply/perm_cons. -have /perm_eqlP <- := (setD1E s x); rewrite perm_eq_refl. -qed. - -lemma mem_drop (s:'a list) n x: mem (drop n s) x => mem s x. -proof. by rewrite -{2}(cat_take_drop n) mem_cat=>->. qed. +type flag = [ Unknown | Known ]. -lemma mem_take (s:'a list) n x: mem (take n s) x => mem s x. -proof. by rewrite -{2}(cat_take_drop n) mem_cat=>->. qed. -(* end TODO *) +lemma neqK_eqU f : f <> Known <=> f = Unknown. +proof. by case: f. qed. -abstract theory Titer. +op in_dom_with (m:('from, 'to * 'flag)fmap) (x:'from) (f:'flag) = + mem (dom m) x /\ (oget (m.[x])).`2 = f. -type t. +op restr f (m:('from, 'to * 'flag)fmap) = + let m = filter (fun _ (p:'to*'flag) => p.`2=f) m in + map (fun _ (p:'to*'flag) => p.`1) m. -module type Orcl = { - proc f (x:t) : unit -}. +lemma restrP (m:('from, 'to * 'flag)fmap) f x: + (restr f m).[x] = + obind (fun (p:'to*'flag)=>if p.`2=f then Some p.`1 else None) m.[x]. +proof. + rewrite /restr /= mapP filterP in_dom /=. + by case (m.[x])=>//= -[x0 f'];rewrite oget_some /=;case (f' = f). +qed. -module Iter (O:Orcl) = { - proc iter(l:t list) = { - while (l <> []) { - O.f(head witness l); - l <- drop 1 l; - } - } -}. +lemma dom_restr (m:('from, 'to * 'flag)fmap) f x: + mem (dom(restr f m)) x <=> in_dom_with m x f. +proof. + rewrite /in_dom_with !in_dom;case: (m.[x]) (restrP m f x)=>//= -[t f'] /=. + by rewrite oget_some /=;case (f' = f)=> [_ ->|]. +qed. -lemma iter_ll(O<:Orcl): islossless O.f => islossless Iter(O).iter. +lemma restr_set (m:('from, 'to * 'flag)fmap) f1 f2 x y: + restr f1 m.[x<-(y,f2)] = if f1 = f2 then (restr f1 m).[x<-y] else rem x (restr f1 m). proof. - move=> O_ll;proc;inline Iter(O).iter. - while true (size l);auto=>/=. - + call O_ll;skip=> /=?[*]Hl<-;smt ml=0 w=(size_eq0 size_ge0 size_drop). - smt ml=0 w=(size_eq0 size_ge0). + rewrite fmapP;case (f1=f2)=>[->|Hneq]x0;rewrite !(restrP,getP);1: by case (x0=x). + case (x0=x)=>[->|Hnx];1:by rewrite (eq_sym f2) Hneq remP_eq. + by rewrite remP Hnx restrP. qed. -section. - -declare module O:Orcl. +lemma restr_set_eq (m:('from, 'to * 'flag)fmap) f x y: + restr f m.[x<-(y,f)] = (restr f m).[x<-y]. +proof. by rewrite restr_set. qed. -axiom iter_swap1 i1 i2: - equiv [Iter(O).iter ~ Iter(O).iter : - l{1} = [i1;i2] /\ l{2} = [i2;i1] /\ ={glob O} ==> ={glob O}]. +lemma restr0 f : restr f map0<:'from, 'to * 'flag> = map0. +proof. by apply fmapP=>x;rewrite restrP !map0P. qed. -lemma iter_swap s1 i s2: - equiv [Iter(O).iter ~ Iter(O).iter : - l{1} = i::s1++s2 /\ l{2} = s1++i::s2 /\ ={glob O} ==> ={glob O}]. +lemma restr_set_neq f2 f1 (m:('from, 'to * 'flag)fmap) x y: + !mem (dom m) x => + f2 <> f1 => restr f1 m.[x<-(y,f2)] = restr f1 m. proof. - elim:s1=> /=[|i' s1 Hrec];1:by sim. - transitivity Iter(O).iter - (l{1}= i :: i' :: (s1 ++ s2) /\ l{2} = i' :: i :: (s1 ++ s2) /\ ={glob O} ==> - ={glob O}) - (l{1}= i' :: i :: (s1 ++ s2) /\ l{2} = i' :: (s1 ++ i::s2) /\ ={glob O} ==> - ={glob O})=>//. - + by move=> ?&mr[*]<*>;exists (glob O){mr}, (i' :: i :: (s1 ++ s2)). - + proc;rcondt{1}1=>//;rcondt{2}1=>//. - rcondt{1}3;1:by auto;conseq(_: true). - rcondt{2}3;1:by auto;conseq(_: true). - seq 4 4 : (={l,glob O});last by sim. - transitivity{1} {Iter(O).iter([i;i']); l <- drop 2 l;} - (l{1} = i :: i' :: (s1 ++ s2) /\ ={l, glob O} ==> ={l,glob O}) - (l{1} = i :: i' :: (s1 ++ s2) /\ - l{2} = i' :: i :: (s1 ++ s2) /\ ={glob O} ==> ={l,glob O})=>//. - + by move=>?&mr[*]<*>;exists (glob O){mr}, (i :: i' :: (s1 ++ s2)). - + inline *;rcondt{2} 2;1:by auto. - rcondt{2} 4;1:by auto;sp;conseq(_:true). - rcondf{2} 6; auto;call(_:true);wp;call(_:true);auto. - transitivity{1} {Iter(O).iter([i';i]); l <- drop 2 l;} - (l{1} = i :: i' :: (s1 ++ s2) /\ - l{2} = i' :: i :: (s1 ++ s2) /\ ={glob O} ==> ={l,glob O}) - (l{2} = i' :: i :: (s1 ++ s2) /\ ={l, glob O} ==> ={l,glob O})=>//. - + by move=>?&mr[*]<*>;exists (glob O){mr}, (i' :: i :: (s1 ++ s2)). - + wp; by call (iter_swap1 i i'). - (* call iter_swap1: FIXME catch exception *) - inline *;rcondt{1} 2;1:by auto. - rcondt{1} 4;1:by auto;sp;conseq(_:true). - rcondf{1} 6; auto;call(_:true);wp;call(_:true);auto. - proc;rcondt{1}1=>//;rcondt{2}1=>//. - seq 2 2 : (l{1} = i :: (s1 ++ s2) /\ l{2} = s1 ++ i :: s2 /\ ={glob O}). - + by wp;call(_:true);auto;progress;rewrite drop0. - transitivity{1} {Iter(O).iter(l); } - (={l,glob O} /\ l{1}= i::(s1++s2) ==> ={glob O}) - (={glob O} /\ l{1}=i::(s1++s2) /\ l{2}= (s1++i::s2) ==> ={glob O})=>//. - + by move=>?&mr[*]<*>;exists (glob O){mr}, (i :: (s1 ++ s2)). - + by inline *;sim. - transitivity{1} {Iter(O).iter(l); } - (={glob O} /\ l{1}=i::(s1++s2) /\ l{2}= (s1++i::s2) ==> ={glob O}) - (={l,glob O} /\ l{2}= (s1++i::s2) ==> ={glob O})=>//. - + by move=>?&mr[*]<*>;exists (glob O){mr}, (s1 ++ i::s2). - + by call Hrec;auto. - by inline*;sim. + by move=>Hm Hneq;rewrite restr_set(eq_sym f1)Hneq rem_id//dom_restr/in_dom_with Hm. qed. -lemma iter_perm : - equiv [Iter(O).iter ~ Iter(O).iter : perm_eq l{1} l{2} /\ ={glob O} ==> ={glob O}]. +lemma restr_rem (m:('from,'to*'flag)fmap) x f: + restr f (rem x m) = + if in_dom_with m x f then rem x (restr f m) else restr f m. proof. - exists*l{1},l{2};elim*=>l1 l2;case (perm_eq l1 l2)=> Hp;last first. - + conseq (_:false==>_)=>// ??[*]//. - elim: l1 l2 Hp=> [|i s1 ih] s2 eq_s12 /=. - + have ->: s2 = [] by apply/perm_eq_small/perm_eq_sym. - proc;rcondf{1} 1=>//;rcondf{2} 1=>//. - have/perm_eq_mem/(_ i) := eq_s12; rewrite mem_head /=. - move/splitPr => [s3 s4] ->>. - transitivity Iter(O).iter - (l{1}=i::s1 /\ l{2}=i::(s3++s4) /\ ={glob O} ==> ={glob O}) - (l{1}=i::(s3++s4) /\ l{2}=s3++i::s4 /\ ={glob O} ==> ={glob O})=>//. - + by move=>?&mr[*]-> -> _ ->; exists (glob O){mr}, (i :: (s3 ++ s4)). - + proc;rcondt{1}1=>//;rcondt{2}1=>//. - seq 2 2: (s1 = l{1} /\ l{2}=s3++s4 /\ ={glob O}). - + by wp;call(_:true);auto;progress;rewrite drop0. - transitivity{1} {Iter(O).iter(l); } - (={l,glob O} ==> ={glob O}) - (s1 = l{1} /\ l{2} = s3 ++ s4 /\ ={glob O} ==> ={glob O})=>//. - + by move=>?&mr[*]-> -> ->;exists (glob O){mr}, l{1}. - + by inline Iter(O).iter;sim. - transitivity{1} {Iter(O).iter(l); } - (s1 = l{1} /\ l{2} = s3 ++ s4 /\ ={glob O} ==> ={glob O}) - (={l,glob O} ==> ={glob O}) =>//. - + by move=>?&mr[*]-> -> ->;exists (glob O){mr}, (s3++s4). - + move: eq_s12; rewrite -(cat1s i s4) catA perm_eq_sym. - rewrite perm_catCA /= perm_cons perm_eq_sym=> Hp. - + call (ih (s3++s4) Hp)=>//. - by inline Iter(O).iter;sim. - by apply (iter_swap s3 i s4). (* FIXME: apply iter_swap fail! *) + rewrite fmapP=>z;rewrite restrP;case (in_dom_with m x f); + rewrite !(restrP,remP) /in_dom_with in_dom /#. qed. -end section. - -end Titer. - -type flag = [ Unknown | Known ]. - abstract theory Ideal. type from, to. @@ -166,61 +72,60 @@ module type RO = { proc init () : unit proc get (x : from) : to proc set (x : from, y : to) : unit + proc rem (x : from) : unit + proc sample(x : from) : unit +}. + +module type RO_Distinguisher(G : RO) = { + proc distinguish(): bool +}. + +module type FRO = { + proc init () : unit + proc get (x : from) : to + proc set (x : from, y : to) : unit + proc rem (x : from) : unit proc sample(x : from) : unit proc in_dom(x : from,f : flag) : bool proc restrK() : (from,to)fmap }. -module type Distinguisher(G : RO) = { +module type FRO_Distinguisher(G : FRO) = { proc distinguish(): bool }. -op in_dom_with (m:(from, to * flag)fmap) (x:from) (f:flag) = - mem (dom m) x /\ (oget (m.[x])).`2 = f. +(* -------------------------------------------------------------------------- *) +module RO : RO = { + var m : (from, to)fmap -op restr f (m:(from, to * flag)fmap) = - let m = filter (fun _ (p:to*flag) => p.`2=f) m in - map (fun _ (p:to*flag) => p.`1) m. + proc init () = { m <- map0; } -lemma restrP m f x: - (restr f m).[x] = - obind (fun (p:to*flag)=>if p.`2=f then Some p.`1 else None) m.[x]. -proof. - rewrite /restr /= mapP filterP in_dom /=. - by case (m.[x])=>//= -[x0 f'];rewrite oget_some /=;case (f' = f). -qed. + proc get(x:from) = { + var r; + r <$ sampleto x; + if (!mem (dom m) x) m.[x] <- r; + return (oget m.[x]); + } -lemma restr_dom m f x: - mem (dom(restr f m)) x <=> (mem (dom m) x /\ (oget m.[x]).`2 = f). -proof. - rewrite !in_dom;case: (m.[x]) (restrP m f x)=>//= -[t f'] /=. - by rewrite oget_some /=;case (f' = f)=> [_ ->|]. -qed. + proc set (x:from, y:to) = { + m.[x] <- y; + } -lemma restr_set m f1 f2 x y: - restr f1 m.[x<-(y,f2)] = if f1 = f2 then (restr f1 m).[x<-y] else rem x (restr f1 m). -proof. - rewrite fmapP;case (f1=f2)=>[->|Hneq]x0;rewrite !(restrP,getP);1: by case (x0=x). - case (x0=x)=>[->|Hnx];1:by rewrite (eq_sym f2) Hneq remP_eq. - by rewrite remP Hnx restrP. -qed. + proc rem (x:from) = { + m <- rem x m; + } -lemma restr_set_eq m f x y: - restr f m.[x<-(y,f)] = (restr f m).[x<-y]. -proof. by rewrite restr_set. qed. + proc sample(x:from) = { + get(x); + } -lemma restr0 f : restr f map0 = map0. -proof. by apply fmapP=>x;rewrite restrP !map0P. qed. + proc restrK() = { + return m; + } -lemma restr_set_neq f2 f1 m x y: - !mem (dom m) x => - f2 <> f1 => restr f1 m.[x<-(y,f2)] = restr f1 m. -proof. - by move=>Hm Hneq;rewrite restr_set (eq_sym f1) Hneq rem_id//restr_dom Hm. -qed. +}. -(* -------------------------------------------------------------------------- *) -module RO : RO = { +module FRO : FRO = { var m : (from, to * flag)fmap proc init () = { m <- map0; } @@ -237,10 +142,14 @@ module RO : RO = { m.[x] <- (y,Known); } + proc rem (x:from) = { + m <- rem x m; + } + proc sample(x:from) = { var c; - c <$ sampleto x; - m.[x] <- (c,Unknown); + c <$ sampleto x; + if (!mem (dom m) x) m.[x] <- (c,Unknown); } proc in_dom(x:from, f:flag) = { @@ -250,323 +159,496 @@ module RO : RO = { proc restrK() = { return restr Known m; } + }. +equiv RO_FRO_init : RO.init ~ FRO.init : true ==> RO.m{1} = map (+fst) FRO.m{2}. +proof. by proc;auto=>/=;rewrite map_map0. qed. + +equiv RO_FRO_get : RO.get ~ FRO.get : + ={x} /\ RO.m{1} = map (+fst) FRO.m{2} ==> ={res} /\ RO.m{1} = map (+fst) FRO.m{2}. +proof. + proc;auto=>?&ml[]->->/=?->/=. + rewrite !dom_map !map_set/fst/= getP_eq oget_some;progress. + + by rewrite mapP oget_omap_some // -in_dom. + by apply /eq_sym/set_eq;rewrite get_oget?dom_map// mapP oget_omap_some// -in_dom. +qed. + +equiv RO_FRO_set : RO.set ~ FRO.set : + ={x,y} /\ RO.m{1} = map (+fst) FRO.m{2} ==> RO.m{1} = map (+fst) FRO.m{2}. +proof. by proc;auto=>?&ml[*]3!->;rewrite map_set. qed. + +equiv RO_FRO_rem : RO.rem ~ FRO.rem : + ={x} /\ RO.m{1} = map (+fst) FRO.m{2} ==> RO.m{1} = map (+fst) FRO.m{2}. +proof. by proc;auto=>??;rewrite map_rem. qed. + +equiv RO_FRO_sample : RO.sample ~ FRO.sample : + ={x} /\ RO.m{1} = map (+fst) FRO.m{2} ==> RO.m{1} = map (+fst) FRO.m{2}. +proof. + by proc;inline *;auto=>?&ml[]2!->/=?->;rewrite dom_map/= map_set. +qed. + +lemma RO_FRO_D (D<:RO_Distinguisher{RO,FRO}) : + equiv [D(RO).distinguish ~ D(FRO).distinguish : + ={glob D} /\ RO.m{1} = map (+fst) FRO.m{2} ==> + ={glob D} /\ RO.m{1} = map (+fst) FRO.m{2} ]. +proof. + proc (RO.m{1} = map (+fst) FRO.m{2})=>//. + + by conseq RO_FRO_init. + by conseq RO_FRO_get. + by conseq RO_FRO_set. + + by conseq RO_FRO_rem. + by conseq RO_FRO_sample. +qed. + section LL. -lemma init_ll : islossless RO.init. +lemma RO_init_ll : islossless RO.init. proof. by proc;auto. qed. -lemma in_dom_ll : islossless RO.in_dom. +lemma FRO_init_ll : islossless FRO.init. +proof. by proc;auto. qed. + +lemma FRO_in_dom_ll : islossless FRO.in_dom. proof. by proc. qed. -lemma restrK_ll : islossless RO.restrK. +lemma FRO_restrK_ll : islossless FRO.restrK. proof. by proc. qed. -lemma set_ll : islossless RO.set. +lemma RO_set_ll : islossless RO.set. +proof. by proc;auto. qed. + +lemma FRO_set_ll : islossless FRO.set. proof. by proc;auto. qed. axiom sampleto_ll : forall x, Distr.weight (sampleto x) = 1%r. -lemma get_ll : islossless RO.get. +lemma RO_get_ll : islossless RO.get. +proof. by proc;auto;progress;apply sampleto_ll. qed. + +lemma FRO_get_ll : islossless FRO.get. proof. by proc;auto;progress;apply sampleto_ll. qed. -lemma sample_ll : islossless RO.sample. +lemma RO_sample_ll : islossless RO.sample. +proof. by proc;call RO_get_ll. qed. + +lemma FRO_sample_ll : islossless FRO.sample. proof. by proc;auto;progress;apply sampleto_ll. qed. end section LL. end Ideal. - (* -------------------------------------------------------------------------- *) + abstract theory GenEager. clone include Ideal. axiom sampleto_ll : forall x, Distr.weight (sampleto x) = 1%r. -clone include Titer with type t <- from. +clone include IterProc with type t <- from. -module ERO : RO = { +(** A module that resample query if the associate value is unknown *) +module RRO : FRO = { - proc init = RO.init + proc init = FRO.init proc get(x:from) = { var r; r <$ sampleto x; - if (!mem (dom RO.m) x || (oget RO.m.[x]).`2 = Unknown) { - RO.m.[x] <- (r,Known); + if (!mem (dom FRO.m) x || (oget FRO.m.[x]).`2 = Unknown) { + FRO.m.[x] <- (r,Known); } - return (oget RO.m.[x]).`1; + return (oget FRO.m.[x]).`1; } - proc set = RO.set + proc set = FRO.set + + proc rem = FRO.rem - proc sample = RO.sample + proc sample = FRO.sample - proc in_dom = RO.in_dom + proc in_dom = FRO.in_dom - proc restrK = RO.restrK + proc restrK = FRO.restrK module I = { - proc f = sample + proc f (x:from) = { + var c; + c <$ sampleto x; + FRO.m.[x] <- (c,Unknown); + } } proc resample () = { - Iter(I).iter (elems (dom (restr Unknown RO.m))); + Iter(I).iter (elems (dom (restr Unknown FRO.m))); } }. -lemma resample_ll : islossless ERO.resample. +(* A module which is lazy on sample *) +module LRO : RO = { + + proc init = RO.init + + proc get = RO.get + + proc set = RO.set + + proc rem = RO.rem + + proc sample(x:from) = {} + +}. + +lemma RRO_resample_ll : islossless RRO.resample. proof. - proc;call (iter_ll ERO.I _)=>//;apply (sample_ll sampleto_ll). + proc;call (iter_ll RRO.I _)=>//;proc;auto=>/=?;apply sampleto_ll. qed. lemma eager_init : - eager [ERO.resample(); , RO.init ~ ERO.init, ERO.resample(); : - ={RO.m} ==> ={RO.m} ]. + eager [RRO.resample(); , FRO.init ~ RRO.init, RRO.resample(); : + ={FRO.m} ==> ={FRO.m} ]. proof. eager proc. inline{2} *;rcondf{2}3;auto=>/=. + by move=>?_;rewrite restr0 dom0 elems_fset0. - by conseq (_:) (_:true==>true: =1%r) _=>//;call resample_ll. + by conseq (_:) (_:true==>true: =1%r) _=>//;call RRO_resample_ll. qed. lemma iter_perm2 (i1 i2 : from): - equiv[ Iter(ERO.I).iter ~ Iter(ERO.I).iter : - l{1} = [i1; i2] /\ l{2} = [i2; i1] /\ ={glob ERO.I} ==> - ={glob ERO.I}]. + equiv[ Iter(RRO.I).iter_12 ~ Iter(RRO.I).iter_21 : + ={glob RRO.I, t1, t2} ==> ={glob RRO.I}]. proof. - proc;rcondt{1}1=>//;rcondt{2}1=>//. - rcondt{1}3;1:by auto;conseq(_:true). - rcondt{2}3;1:by auto;conseq(_:true). - seq 4 4 : (={l,RO.m});2:by sim. - case (i1=i2);1:by sim. - inline *;swap[4..5]-2;swap{2} 6-2;auto=>?&mr[*]3!<*>Hneq/=?->?->/=. - by rewrite set_set Hneq. + proc;inline *;case ((t1=t2){1});1:by auto. + by swap{2}[4..5]-3;auto=> &ml&mr[*]3!->neq/=?->?->;rewrite set_set neq. qed. lemma eager_get : - eager [ERO.resample(); , RO.get ~ ERO.get, ERO.resample(); : - ={x,RO.m} ==> ={res,RO.m} ]. + eager [RRO.resample(); , FRO.get ~ RRO.get, RRO.resample(); : + ={x,FRO.m} ==> ={res,FRO.m} ]. proof. eager proc. - wp;case ((mem (dom RO.m) x /\ (oget RO.m.[x]).`2=Known){1}). + wp;case ((mem (dom FRO.m) x /\ (oget FRO.m.[x]).`2=Known){1}). + rnd{1};rcondf{2} 2;1:by auto=> /#. - alias{1} 1 mx = oget RO.m.[x];inline *. - while (={l,RO.m} /\ (!mem l x /\ RO.m.[x] = Some (mx.`1,Known)){1}). + exists * ((oget FRO.m.[x{2}]){1}). +;inline RRO.resample. + cut := iter_inv RRO.I (fun z=>x{1}<>z) (fun m1 m2 => m1 = m2 /\ . + print iter_inv. + while (={l,FRO.m} /\ (!mem l x /\ FRO.m.[x] = Some (mx.`1,Known)){1}). + auto=>?&mr[*]-> ->;case (l{mr})=>//=x2 l2 Hmx Hgx?->. by rewrite getP drop0 /#. auto=>??[*]-> ->/= Hmem HK;rewrite sampleto_ll/==> r _. - rewrite -memE restr_dom Hmem/= HK. + rewrite -memE dom_restr Hmem/= HK. rewrite {1}get_oget //= -HK;case:(oget _)HK=> x1?/=->. by move=>????-> _[*]_-> _ Heq?;rewrite in_dom set_eq Heq. rcondt{2} 2. + auto=> ?[*]-> ->;rewrite negb_and /#. - case ((mem (dom RO.m) x){1}). - + inline{1} ERO.resample=>/=;rnd{1}. - transitivity{1} { Iter(ERO.I).iter(x::elems ((dom (restr Unknown RO.m)) `\` fset1 x)); - } - (={x,RO.m} /\ mem (dom RO.m{1}) x{1} /\ (oget RO.m{1}.[x{1}]).`2 = Unknown ==> - ={x,RO.m}) - (={x,RO.m} /\ mem (dom RO.m{1}) x{1} /\ (oget RO.m{1}.[x{1}]).`2 = Unknown==> - ={x} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ - RO.m{1}.[x{2}] = Some (result{2},Unknown) /\ - RO.m{2}.[x{2}] = Some (result{2},Known)). - + by move=>?&mr[*]-> -> ??;exists RO.m{mr}, x{mr}=>/#. + case ((mem (dom FRO.m) x){1}). + + inline{1} RRO.resample=>/=;rnd{1}. + transitivity{1} + { Iter(RRO.I).iter(x::elems ((dom (restr Unknown FRO.m)) `\` fset1 x)); } + (={x,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown ==> + ={x,FRO.m}) + (={x,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown==> + ={x} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + FRO.m{1}.[x{2}] = Some (result{2},Unknown) /\ + FRO.m{2}.[x{2}] = Some (result{2},Known)). + + by move=>?&mr[*]-> -> ??;exists FRO.m{mr}, x{mr}=>/#. + move=>???;rewrite in_dom=>[*]<*>[*]->/eq_except_sym H Hxm Hx2. rewrite sampleto_ll=> r _;rewrite /= Hxm oget_some /=;apply /eq_sym. have /(congr1 oget):= Hx2 => <-;apply eq_except_set_eq=>//. by rewrite in_dom Hx2. - + call (iter_perm ERO.I iter_perm2). + + call (iter_perm RRO.I iter_perm2). skip=> &1 &2 [[->> ->>]] [Hdom Hm];progress. - by apply /perm_to_rem/restr_dom;rewrite Hdom Hm. + by apply /perm_to_rem/dom_restr;rewrite Hdom Hm. inline *;rcondt{1} 2;1:by auto. while (={x,l} /\ !mem l{1} x{1}/\ - eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ - RO.m{1}.[x{2}] = Some (result{2}, Unknown) /\ - RO.m{2}.[x{2}] = Some (result{2}, Known)). + eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + FRO.m{1}.[x{2}] = Some (result{2}, Unknown) /\ + FRO.m{2}.[x{2}] = Some (result{2}, Known)). + auto=> ?&mr[*]2!->Hm Hex Hm1 Hmr Hneq _/=?->. - rewrite (contra _ _ (mem_drop _ 1 _) Hm) /=. - rewrite!getP;move:Hm;rewrite-(mem_head_behead witness l{mr})//negb_or=>-[]->_. - by rewrite Hm1 Hmr/=;apply eq_except_set. + rewrite (contra _ _ (mem_drop 1 _ _) Hm) /= !getP. + move:Hm;rewrite-(mem_head_behead witness l{mr})//negb_or=>-[]-> _/=. + rewrite Hm1 Hmr/=;apply eq_except_set=>//. auto=>?&mr[[->>->>]][]Hdom Hm /=/=?->/=. rewrite !drop0 restr_set /= dom_rem /= -memE !inE /=. by rewrite !getP_eq /= oget_some/= set2_eq_except. inline *. swap{1}3-2. - while (={l,x} /\ !mem l{1} x{1} /\ RO.m{1}.[x{1}] = None /\ - RO.m{2} = RO.m{1}.[x{2}<-(r{2},Known)]). + while (={l,x} /\ !mem l{1} x{1} /\ FRO.m{1}.[x{1}] = None /\ + FRO.m{2} = FRO.m{1}.[x{2}<-(r{2},Known)]). + auto=> ?&mr[*]2!->Hm Hn Heq Hl _/=?->. - rewrite (contra _ _ (mem_drop _ 1 _) Hm) /=. + rewrite (contra _ _ (mem_drop 1 _ _) Hm) /=. rewrite set_set -Heq !getP -(eq_sym (x{mr})). by move:Hm;rewrite -(mem_head_behead witness l{mr} Hl) -Hn negb_or=>-[]->. auto=> ?&mr[*]2!->_ Hnm/=?->. - rewrite -memE restr_set_neq //= restr_dom Hnm /=. + rewrite -memE restr_set_neq //= dom_restr Hnm /=. by have:=Hnm;rewrite in_dom/==>->/=????->->;rewrite in_dom getP_eq oget_some. qed. lemma eager_set : - eager [ERO.resample(); , RO.set ~ ERO.set, ERO.resample(); : - ={x,y} /\ ={RO.m} ==> ={res,RO.m} ]. + eager [RRO.resample(); , FRO.set ~ RRO.set, RRO.resample(); : + ={x,y} /\ ={FRO.m} ==> ={res,FRO.m} ]. proof. eager proc. - case ((mem (dom RO.m) x /\ (oget RO.m.[x]).`2 = Unknown){1}). - inline{1} ERO.resample=>/=;wp 1 2. - transitivity{1} { Iter(ERO.I).iter(x::elems ((dom (restr Unknown RO.m)) `\` fset1 x)); + case ((mem (dom FRO.m) x /\ (oget FRO.m.[x]).`2 = Unknown){1}). + inline{1} RRO.resample=>/=;wp 1 2. + transitivity{1} { Iter(RRO.I).iter(x::elems ((dom (restr Unknown FRO.m)) `\` fset1 x)); } - (={x,y,RO.m} /\ mem (dom RO.m{1}) x{1} /\ (oget RO.m{1}.[x{1}]).`2 = Unknown ==> - ={x,y,RO.m}) - (={x,y,RO.m} /\ mem (dom RO.m{1}) x{1} /\ (oget RO.m{1}.[x{1}]).`2 = Unknown==> - ={x,y} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ - RO.m{2}.[x{2}] = Some (y{2},Known)). - + by move=>?&mr[*]-> -> ???;exists RO.m{mr}, y{mr}, x{mr}=>/#. + (={x,y,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown ==> + ={x,y,FRO.m}) + (={x,y,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown==> + ={x,y} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + FRO.m{2}.[x{2}] = Some (y{2},Known)). + + by move=>?&mr[*]-> -> ???;exists FRO.m{mr}, y{mr}, x{mr}=>/#. + move=>??? [*]<*>[*]-> -> Hex Hm2. - by rewrite (eq_except_set_eq RO.m{2} RO.m{m} x{2}) ?in_dom ?Hm2// eq_except_sym. - + call (iter_perm ERO.I iter_perm2). + by rewrite (eq_except_set_eq FRO.m{2} FRO.m{m} x{2}) ?in_dom ?Hm2// eq_except_sym. + + call (iter_perm RRO.I iter_perm2). skip=>?&mr[][]->>[]->>->>[]Hdom Hm/=. - by apply /perm_to_rem/restr_dom;rewrite Hdom Hm. + by apply /perm_to_rem/dom_restr;rewrite Hdom Hm. inline *;rcondt{1} 2;1:by auto. while (={x,l} /\ !mem l{1} x{1}/\ - eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ - RO.m{2}.[x{2}] = Some (y{2}, Known)). + eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + FRO.m{2}.[x{2}] = Some (y{2}, Known)). + auto=> ?&mr[*]2!->Hm Hex Hm1 Hmr _/=?->. - rewrite (contra _ _ (mem_drop _ 1 _) Hm) /=. + rewrite (contra _ _ (mem_drop 1 _ _) Hm) /=. rewrite!getP;move:Hm;rewrite-(mem_head_behead witness l{mr})//negb_or=>-[]->_. by rewrite Hm1 /=;apply eq_except_set. auto=>?&mr[*]3!<*>Hdom Hm /=/=;rewrite !drop0 sampleto_ll=>/=?_. by rewrite -memE restr_set /= dom_rem !inE !getP_eq set2_eq_except. inline *;wp. while (={x,l} /\ !mem l{1} x{1}/\ - eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ - RO.m{2}.[x{2}] = Some (y{2}, Known)). + eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + FRO.m{2}.[x{2}] = Some (y{2}, Known)). + auto=> ?&mr[*]2!->Hm Hex Hm1 Hmr _/=?->. - rewrite (contra _ _ (mem_drop _ 1 _) Hm) /=. + rewrite (contra _ _ (mem_drop 1 _ _) Hm) /=. rewrite!getP;move:Hm;rewrite-(mem_head_behead witness l{mr})//negb_or=>-[]->_. by rewrite Hm1 /=;apply eq_except_set. auto=> ?&mr[*]3!-> Hnm /=. - rewrite-memE restr_set/=rem_id?restr_dom//=Hnm. + rewrite-memE restr_set/=rem_id?dom_restr//=Hnm. rewrite getP_eq eq_except_sym set_eq_except/=. move=>/=????2!->/=[]/eq_except_sym? Hx2;apply/eq_sym. have/(congr1 oget):=Hx2=><-;apply eq_except_set_eq=>//;by rewrite in_dom Hx2. qed. +lemma eager_rem: + eager [RRO.resample(); , FRO.rem ~ RRO.rem, RRO.resample(); : + ={x} /\ ={FRO.m} ==> ={res,FRO.m} ]. +proof. + eager proc;case ((in_dom_with FRO.m x Unknown){1}). + + inline RRO.resample;wp. + transitivity{1} + { Iter(RRO.I).iter(x::elems (dom (restr Unknown FRO.m) `\` fset1 x)); } + (={x,FRO.m}/\(in_dom_with FRO.m x Unknown){1}==> ={x,FRO.m}) + (={x,FRO.m}/\ (in_dom_with FRO.m x Unknown){1} ==> (rem x FRO.m){1} = FRO.m{2})=>//. + + by move=>?&mr[*]2!->_;exists FRO.m{mr}, x{mr}. + + call (iter_perm RRO.I iter_perm2);skip=>?&mr[*]2!->?/=. + by apply /perm_to_rem/dom_restr. + inline *;rcondt{1}2;1:by auto. + while (={l} /\ FRO.m{2} = rem x{1} FRO.m{1} /\ !(mem l x){1}). + + auto=>?&mr[*]->-> ^ + Hm Hl _/=?->. + rewrite rem_set-(mem_head_behead witness l{mr})//negb_or=>-[]->_/=. + by rewrite (contra _ _ (mem_drop 1 _ _) Hm). + auto=>?&mr[*]2!->Hidm/=;rewrite sampleto_ll/==>?. + by rewrite drop0 restr_rem Hidm/= dom_rem rem_set -memE !inE. + inline *;wp. + while (={l} /\ FRO.m{2} = rem x{1} FRO.m{1} /\ !(mem l x){1}). + + auto=>?&mr[*]->-> ^ + Hm Hl _/=?->. + rewrite rem_set-(mem_head_behead witness l{mr})//negb_or=>-[]->_/=. + by rewrite (contra _ _ (mem_drop 1 _ _) Hm). + by auto=>?&mr[*]2!->Hndw/=;rewrite restr_rem Hndw//= -memE dom_restr. +qed. + lemma eager_in_dom: - eager [ERO.resample(); , RO.in_dom ~ ERO.in_dom, ERO.resample(); : - ={x,f} /\ ={RO.m} ==> ={res,RO.m} ]. + eager [RRO.resample(); , FRO.in_dom ~ RRO.in_dom, RRO.resample(); : + ={x,f} /\ ={FRO.m} ==> ={res,FRO.m} ]. proof. eager proc;inline *;wp. - while (={l,RO.m} /\ (forall z, mem l z => in_dom_with RO.m z Unknown){1} /\ - in_dom_with RO.m{1} x{1} f{1} = result{2}). + while (={l,FRO.m} /\ (forall z, mem l z => in_dom_with FRO.m z Unknown){1} /\ + in_dom_with FRO.m{1} x{1} f{1} = result{2}). + auto=>?&mr[*]2!->Hz <-?_/=?->/=. - by split=>[z Hm|];rewrite /in_dom_with dom_set getP !inE/#. - by auto=>?&mr/=[*]3!->/=;split=>// z;rewrite -memE restr_dom. + split=>[z /mem_drop Hm|];rewrite /in_dom_with dom_set getP !inE /#. + by auto=>?&mr/=[*]3!->/=;split=>// z;rewrite -memE dom_restr. qed. lemma eager_restrK: - eager [ERO.resample(); , RO.restrK ~ ERO.restrK, ERO.resample(); : - ={RO.m} ==> ={res,RO.m} ]. + eager [RRO.resample(); , FRO.restrK ~ RRO.restrK, RRO.resample(); : + ={FRO.m} ==> ={res,FRO.m} ]. proof. eager proc;inline *;wp. - while (={l,RO.m} /\ (forall z, mem l z => in_dom_with RO.m z Unknown){1} /\ - restr Known RO.m{1} = result{2}). + while (={l,FRO.m} /\ (forall z, mem l z => in_dom_with FRO.m z Unknown){1} /\ + restr Known FRO.m{1} = result{2}). + auto=>?&mr[*]2!->Hz<-?_/=?->/=. - split=>[z Hm|];1:by rewrite /in_dom_with dom_set getP !inE/#. - rewrite restr_set rem_id?restr_dom//. + split=>[z /mem_drop Hm|];1:by rewrite /in_dom_with dom_set getP !inE /#. + rewrite restr_set rem_id?dom_restr//. by move:H=>/(mem_head_behead witness) /(_ (head witness l{mr})) /= /Hz /#. - by auto=>?&mr/=->/=;split=>// z;rewrite -memE restr_dom. + by auto=>?&mr/=->/=;split=>// z;rewrite -memE dom_restr. qed. lemma eager_sample: - eager [ERO.resample(); , RO.sample ~ ERO.sample, ERO.resample(); : - ={x,RO.m} ==> ={res,RO.m} ]. + eager [RRO.resample(); , FRO.sample ~ RRO.sample, RRO.resample(); : + ={x,FRO.m} ==> ={res,FRO.m} ]. proof. eager proc. - transitivity{2} { - c <$ sampleto x; RO.m.[x] <- (c, Unknown); - Iter(ERO.I).iter(x::elems ((dom (restr Unknown RO.m)) `\` fset1 x));} - (={x,RO.m} ==> ={x,RO.m}) - (={x,RO.m} ==> ={x,RO.m})=>//;last first. - + inline{2} ERO.resample;call (iter_perm ERO.I iter_perm2);auto=>?&mr[]->->/=?->. - by rewrite !restr_set/= !dom_set perm_eq_sym perm_to_rem !inE. - + by move=>?&mr[*]2!->;exists RO.m{mr}, x{mr}. - inline ERO.resample;inline{2}*;rcondt{2}4;1:by auto. - wp;case ((!mem (dom RO.m) x \/ (oget RO.m.[x]).`2=Known){1}). - + inline *;swap{1}3-1. - while (={x,l} /\ RO.m{1}.[x{1} <- (c{1}, Unknown)] = RO.m{2} /\ !(mem l x){1}). - + auto=>?&mr[*]2!-><- Hnm Hl _/=?->. - rewrite (contra _ _ (mem_drop _ 1 _) Hnm) /= set_set. - by move:Hnm;rewrite-(mem_head_behead witness l{mr})//negb_or eq_sym=>-[]->. - auto=>?&mr[*]2!->?/=;rewrite sampleto_ll=>?_?->;rewrite drop0. - rewrite restr_set/= dom_set fsetDK. - cut<-/=:dom (restr Unknown RO.m{mr}) = - dom (restr Unknown RO.m{mr}) `\` fset1 x{mr}. - + apply fsetP=>z;rewrite !(restr_dom,inE)/#. - by rewrite set_set/= -memE restr_dom;split=>/#. - transitivity{1} { - Iter(ERO.I).iter(x::elems ((dom (restr Unknown RO.m)) `\` fset1 x)); - c<$ sampleto x;} - (={x,RO.m} /\ (mem (dom RO.m) x /\ (oget RO.m.[x]).`2=Unknown){1} ==> ={x,c,RO.m}) - (={x,RO.m} /\ (mem (dom RO.m) x /\ (oget RO.m.[x]).`2=Unknown){1} ==> - ={x} /\ RO.m{1}.[x{1} <- (c{1}, Unknown)] = RO.m{2})=>//. - + by move=>?&mr[*]2!->?;exists RO.m{mr}, x{mr}=>/#. - + rnd;call (iter_perm ERO.I iter_perm2);auto=>?&mr[*]->->/=??;split=>//. - by rewrite perm_to_rem restr_dom. - inline *;rcondt{1}2;1:by auto. - swap{1} 7-2. - while (={x,l} /\ RO.m{1}.[x{1} <- (c{1}, Unknown)] = RO.m{2} /\ !(mem l x){1}). - + auto=>?&mr[*]2!-><- Hnm Hl _/=?->. - rewrite (contra _ _ (mem_drop _ 1 _) Hnm) /= set_set. - by move:Hnm;rewrite-(mem_head_behead witness l{mr})//negb_or eq_sym=>-[]->. - by auto=>?&mr[*]2!->??/=?->?->;rewrite!drop0 restr_set/=dom_set fsetDK-memE!inE. + case (!mem (dom (FRO.m{2})) x{2}). + + rcondt{2}2;1:by auto. + transitivity{2} { + c <$ sampleto x; FRO.m.[x] <- (c, Unknown); + Iter(RRO.I).iter(x::elems ((dom (restr Unknown FRO.m)) `\` fset1 x));} + (={x,FRO.m} /\ ! mem (dom FRO.m{2}) x{2} ==> ={x,FRO.m}) + (={x,FRO.m} /\ ! mem (dom FRO.m{2}) x{2} ==> ={x,FRO.m})=>//;last first. + + inline{2} RRO.resample;call (iter_perm RRO.I iter_perm2);auto=>?&mr[*]2!->?/=?->. + by rewrite !restr_set/= !dom_set perm_eq_sym perm_to_rem !inE. + + by move=>?&mr[*]2!->?;exists FRO.m{mr}, x{mr}. + inline RRO.resample;inline{2}*;rcondt{2}4;1:by auto. + inline *;wp;swap{1}-2. + while (={l} /\ FRO.m{2} = (FRO.m.[x <- (c,Unknown)]){1} /\ + (!mem (dom FRO.m) x /\ !mem l x){1}). + + auto=>?&mr[*]2!->Hd Hl Hnl _/=?->. + rewrite dom_set !inE set_set (contra _ _ (mem_drop 1 _ _) Hl). + by move:Hl;rewrite-(mem_head_behead witness l{mr})//negb_or eq_sym=>-[]->. + auto=>?&mr[*]2!->Hd;rewrite sampleto_ll=>?_/=?->. + rewrite drop0 set_set_eq restr_set/= -memE dom_set fsetDK;split=>//. + have^Hx->: !mem (dom (restr Unknown FRO.m{mr})) x{mr} by rewrite dom_restr Hd. + cut->//: dom (restr Unknown FRO.m{mr}) `\` fset1 x{mr} = + dom (restr Unknown FRO.m{mr}). + by rewrite fsetP=>x;rewrite in_fsetD1 /#. + rcondf{2}2;1:by auto. + swap{1}2-1;inline*;auto. + while (={l,FRO.m} /\ (mem (dom FRO.m) x){1});auto. + by move=>?&mr[*]2!->Hm Hl _/=?->;rewrite dom_set !inE Hm. qed. section. -declare module D:Distinguisher {RO}. +declare module D:FRO_Distinguisher {FRO}. -lemma eager_D : eager [ERO.resample(); , D(RO).distinguish ~ - D(ERO).distinguish, ERO.resample(); : - ={glob D,RO.m} ==> ={RO.m, glob D} /\ ={res} ]. +lemma eager_D : eager [RRO.resample(); , D(FRO).distinguish ~ + D(RRO).distinguish, RRO.resample(); : + ={glob D,FRO.m} ==> ={FRO.m, glob D} /\ ={res} ]. proof. - eager proc (H_: ERO.resample(); ~ ERO.resample();: ={RO.m} ==> ={RO.m}) - (={RO.m})=>//; try by sim. + eager proc (H_: RRO.resample(); ~ RRO.resample();: ={FRO.m} ==> ={FRO.m}) + (={FRO.m})=>//; try by sim. + by apply eager_init. + by apply eager_get. + by apply eager_set. - + by apply eager_sample. + by apply eager_in_dom. + by apply eager_restrK. + + by apply eager_rem. + by apply eager_sample. + + by apply eager_in_dom. + by apply eager_restrK. qed. - -module Eager (D:Distinguisher) = { +module Eager (D:FRO_Distinguisher) = { proc main1() = { var b; - RO.init(); - b <@ D(RO).distinguish(); + FRO.init(); + b <@ D(FRO).distinguish(); return b; } proc main2() = { var b; - RO.init(); - b <@ D(ERO).distinguish(); - ERO.resample(); + FRO.init(); + b <@ D(RRO).distinguish(); + RRO.resample(); return b; } }. equiv Eager_1_2: Eager(D).main1 ~ Eager(D).main2 : - ={glob D} ==> ={res,glob RO, glob D}. + ={glob D} ==> ={res,glob FRO, glob D}. proof. proc. transitivity{1} - { RO.init(); ERO.resample(); b <@ D(RO).distinguish(); } - (={glob D} ==> ={b,RO.m,glob D}) - (={glob D} ==> ={b,RO.m,glob D})=> //. + { FRO.init(); RRO.resample(); b <@ D(FRO).distinguish(); } + (={glob D} ==> ={b,FRO.m,glob D}) + (={glob D} ==> ={b,FRO.m,glob D})=> //. + by move=> ?&mr->;exists (glob D){mr}. + inline *;rcondf{2}3;2:by sim. by auto=>?;rewrite restr0 dom0 elems_fset0. - seq 1 1: (={glob D, RO.m});1:by inline *;auto. + seq 1 1: (={glob D, FRO.m});1:by inline *;auto. by eager call eager_D. qed. -end GenEager. +end section. + +equiv LRO_RRO_init : LRO.init ~ RRO.init : true ==> RO.m{1} = restr Known FRO.m{2}. +proof. by proc;auto=>/=;rewrite restr0. qed. + +equiv LRO_RRO_get : LRO.get ~ RRO.get : + ={x} /\ RO.m{1} = restr Known FRO.m{2} ==> ={res} /\ RO.m{1} = restr Known FRO.m{2}. +proof. + proc;auto=>?&ml[]->->/=?->/=. + rewrite dom_restr negb_and ora_or neqK_eqU. + rewrite !restr_set/= !getP_eq oget_some;progress. + by move:H;rewrite negb_or/= restrP in_dom /#. +qed. + +equiv LRO_RRO_set : LRO.set ~ RRO.set : + ={x,y} /\ RO.m{1} = restr Known FRO.m{2} ==> RO.m{1} = restr Known FRO.m{2}. +proof. by proc;auto=>?&ml[*]3!->;rewrite restr_set. qed. + +equiv LRO_RRO_rem : LRO.rem ~ RRO.rem : + ={x} /\ RO.m{1} = restr Known FRO.m{2} ==> RO.m{1} = restr Known FRO.m{2}. +proof. + proc;inline *;auto=>?&mr[*]->->. rewrite restr_rem. + case (in_dom_with FRO.m{mr} x{mr} Known)=>// Hidw. + by rewrite rem_id // dom_restr. +qed. + +equiv LRO_RRO_sample : LRO.sample ~ RRO.sample: + ={x} /\ RO.m{1} = restr Known FRO.m{2} ==> RO.m{1} = restr Known FRO.m{2}. +proof. + proc;auto=>?&ml[]_->;rewrite sampleto_ll=> ??;rewrite restr_set /==>Hnd. + by rewrite rem_id // dom_restr Hnd. +qed. + +lemma LRO_RRO_D (D<:RO_Distinguisher{RO,FRO}) : + equiv [D(LRO).distinguish ~ D(RRO).distinguish : + ={glob D} /\ RO.m{1} = restr Known FRO.m{2} ==> + ={glob D} /\ RO.m{1} = restr Known FRO.m{2} ]. +proof. + proc (RO.m{1} = restr Known FRO.m{2})=>//. + + by conseq LRO_RRO_init. + by conseq LRO_RRO_get. + by conseq LRO_RRO_set. + + by conseq LRO_RRO_rem. + by conseq LRO_RRO_sample. +qed. + +section. + +declare module D : RO_Distinguisher{RO,FRO}. + +local module M = { + proc main1() = { + var b; + RRO.resample(); + b <@ D(FRO).distinguish(); + return b; + } + + proc main2() = { + var b; + b <@ D(RRO).distinguish(); + RRO.resample(); + return b; + } +}. + +lemma RO_LRO_D : + equiv [D(RO).distinguish ~ D(LRO).distinguish : + ={glob D,RO.m} ==> ={glob D}]. +proof. + transitivity M.main1 + (={glob D} /\ FRO.m{2} = map (fun _ c => (c,Known)) RO.m{1} ==> + ={glob D}) + (={glob D} /\ FRO.m{1} = map (fun _ c => (c,Known)) RO.m{2} ==> + ={glob D})=>//. + + by move=>?&mr[]2!->;exists (glob D){mr},(map(fun _ c =>(c,Known))RO.m{mr}). + + proc*;inline M.main1;wp;call (RO_FRO_D D);inline *. + rcondf{2}2;auto. + + move=> &mr[]_->;apply mem_eq0=>z;rewrite -memE dom_restr mapP dom_map in_dom. + by case(RO.m{m}.[_]). + by move=>?&mr[]2!->/=;rewrite map_comp map_id. + transitivity M.main2 + (={glob D, FRO.m} ==> ={glob D}) + (={glob D} /\ FRO.m{1} = map (fun _ c => (c,Known)) RO.m{2} ==> + ={glob D})=>//. + + by move=>?&mr[]2!->;exists (glob D){mr},(map(fun _ c =>(c,Known))RO.m{mr}). + + by proc; eager call (eager_D D);auto. + proc*;inline M.main2;wp;call{1} RRO_resample_ll. + symmetry;call (LRO_RRO_D D);auto=> &ml&mr[*]2!->;split=>//=. + by rewrite fmapP=>x;rewrite restrP mapP;case (RO.m{ml}.[x]). +qed. From 5b468e2abf38a8933ed048848b70f5f71bf74739 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 4 Jan 2016 13:57:37 +0100 Subject: [PATCH 100/394] use std lib --- sha3/proof/old/MyRO.ec | 237 +++++++++++++++++++++++------------------ 1 file changed, 132 insertions(+), 105 deletions(-) diff --git a/sha3/proof/old/MyRO.ec b/sha3/proof/old/MyRO.ec index b373634..0a0ed47 100644 --- a/sha3/proof/old/MyRO.ec +++ b/sha3/proof/old/MyRO.ec @@ -321,6 +321,29 @@ proof. by swap{2}[4..5]-3;auto=> &ml&mr[*]3!->neq/=?->?->;rewrite set_set neq. qed. +equiv I_f_neq x1 mx1: RRO.I.f ~ RRO.I.f : + ={x,FRO.m} /\ x1 <> x{1} /\ FRO.m{1}.[x1] = mx1 ==> + ={FRO.m} /\ FRO.m{1}.[x1] = mx1. +proof. + by proc;auto=>?&mr[*]2!->Hneq Heq/=?->;rewrite getP Hneq. +qed. + +equiv I_f_eqex x1 mx1 mx2: RRO.I.f ~ RRO.I.f : + ={x} /\ x1 <> x{1} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x1) /\ + FRO.m{1}.[x1] = mx1 /\ FRO.m{2}.[x1] = mx2 ==> + eq_except FRO.m{1} FRO.m{2} (fset1 x1) /\ + FRO.m{1}.[x1] = mx1 /\ FRO.m{2}.[x1] = mx2. +proof. + by proc;auto=>?&mr[*]->Hneq Heq/= Heq1 Heq2?->/=;rewrite !getP Hneq eq_except_set. +qed. + +equiv I_f_set x1 r1 : RRO.I.f ~ RRO.I.f : + ={x} /\ x1 <> x{1} /\ FRO.m{1}.[x1] = None /\ FRO.m{2} = FRO.m{1}.[x1 <- (r1, Known)] ==> + FRO.m{1}.[x1] = None /\ FRO.m{2} = FRO.m{1}.[x1 <- (r1, Known)]. +proof. + by proc;auto=>?&mr[*]->Hneq H1->/=?->;rewrite getP Hneq/= H1 set_set Hneq. +qed. + lemma eager_get : eager [RRO.resample(); , FRO.get ~ RRO.get, RRO.resample(); : ={x,FRO.m} ==> ={res,FRO.m} ]. @@ -328,22 +351,16 @@ proof. eager proc. wp;case ((mem (dom FRO.m) x /\ (oget FRO.m.[x]).`2=Known){1}). + rnd{1};rcondf{2} 2;1:by auto=> /#. - exists * ((oget FRO.m.[x{2}]){1}). -;inline RRO.resample. - cut := iter_inv RRO.I (fun z=>x{1}<>z) (fun m1 m2 => m1 = m2 /\ . - print iter_inv. - while (={l,FRO.m} /\ (!mem l x /\ FRO.m.[x] = Some (mx.`1,Known)){1}). - + auto=>?&mr[*]-> ->;case (l{mr})=>//=x2 l2 Hmx Hgx?->. - by rewrite getP drop0 /#. - auto=>??[*]-> ->/= Hmem HK;rewrite sampleto_ll/==> r _. - rewrite -memE dom_restr Hmem/= HK. - rewrite {1}get_oget //= -HK;case:(oget _)HK=> x1?/=->. - by move=>????-> _[*]_-> _ Heq?;rewrite in_dom set_eq Heq. - rcondt{2} 2. + auto=> ?[*]-> ->;rewrite negb_and /#. + exists*x{1}, ((oget FRO.m.[x{2}]){1});elim*=>x1 mx;inline RRO.resample. + call (iter_inv RRO.I (fun z=>x1<>z) (fun o1 o2 => o1 = o2 /\ o1.[x1]= Some mx) _)=>/=. + + by conseq (I_f_neq x1 (Some mx))=>//. + auto=>?&mr[*]4!->Hd Hget;rewrite sampleto_ll /==>?_;split. + + by rewrite get_oget//oget_some/==> x;rewrite -memE dom_restr/#. + by move=>[*]_ Heq?mr[*]->Heq'?_;rewrite in_dom Heq' oget_some /= set_eq /#. case ((mem (dom FRO.m) x){1}). + inline{1} RRO.resample=>/=;rnd{1}. transitivity{1} - { Iter(RRO.I).iter(x::elems ((dom (restr Unknown FRO.m)) `\` fset1 x)); } + { Iter(RRO.I).iter_1s(x, elems ((dom (restr Unknown FRO.m)) `\` fset1 x)); } (={x,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown ==> ={x,FRO.m}) (={x,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown==> @@ -355,31 +372,29 @@ proof. rewrite sampleto_ll=> r _;rewrite /= Hxm oget_some /=;apply /eq_sym. have /(congr1 oget):= Hx2 => <-;apply eq_except_set_eq=>//. by rewrite in_dom Hx2. - + call (iter_perm RRO.I iter_perm2). - skip=> &1 &2 [[->> ->>]] [Hdom Hm];progress. - by apply /perm_to_rem/dom_restr;rewrite Hdom Hm. - inline *;rcondt{1} 2;1:by auto. - while (={x,l} /\ !mem l{1} x{1}/\ - eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ - FRO.m{1}.[x{2}] = Some (result{2}, Unknown) /\ - FRO.m{2}.[x{2}] = Some (result{2}, Known)). - + auto=> ?&mr[*]2!->Hm Hex Hm1 Hmr Hneq _/=?->. - rewrite (contra _ _ (mem_drop 1 _ _) Hm) /= !getP. - move:Hm;rewrite-(mem_head_behead witness l{mr})//negb_or=>-[]-> _/=. - rewrite Hm1 Hmr/=;apply eq_except_set=>//. - auto=>?&mr[[->>->>]][]Hdom Hm /=/=?->/=. - rewrite !drop0 restr_set /= dom_rem /= -memE !inE /=. - by rewrite !getP_eq /= oget_some/= set2_eq_except. - inline *. swap{1}3-2. - while (={l,x} /\ !mem l{1} x{1} /\ FRO.m{1}.[x{1}] = None /\ - FRO.m{2} = FRO.m{1}.[x{2}<-(r{2},Known)]). - + auto=> ?&mr[*]2!->Hm Hn Heq Hl _/=?->. - rewrite (contra _ _ (mem_drop 1 _ _) Hm) /=. - rewrite set_set -Heq !getP -(eq_sym (x{mr})). - by move:Hm;rewrite -(mem_head_behead witness l{mr} Hl) -Hn negb_or=>-[]->. - auto=> ?&mr[*]2!->_ Hnm/=?->. - rewrite -memE restr_set_neq //= dom_restr Hnm /=. - by have:=Hnm;rewrite in_dom/==>->/=????->->;rewrite in_dom getP_eq oget_some. + + symmetry;call (iter1_perm RRO.I iter_perm2). + skip=> &1 &2 [[->> ->>]] [Hdom Hm];split=>//=. + by apply /perm_eq_sym/perm_to_rem/dom_restr;rewrite /in_dom_with Hdom Hm. + inline Iter(RRO.I).iter_1s RRO.I.f RRO.resample. + seq 5 3 : (={x} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + (l =elems(dom (restr Unknown FRO.m) `\` fset1 x)){1} /\ + FRO.m{1}.[x{2}] = Some (result{2}, Unknown) /\ + FRO.m{2}.[x{2}] = Some (result{2}, Known)). + + auto=>?&mr[*]2!->/=^Hdom->^Hget->?->/=. + by rewrite !getP /=oget_some !restr_set/= dom_set set2_eq_except fsetDK. + exists*x{1}, FRO.m{1}.[x{2}], FRO.m{2}.[x{2}];elim*=>x1 mx1 mx2. + call (iter_inv RRO.I (fun z=>x1<>z) + (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) + (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[*]4!->^H->->^H1->^H2->/=;split. + + congr;rewrite fsetP=>z;rewrite !inE !dom_restr /in_dom_with !in_dom; smt. + by move=>x;rewrite -memE in_fsetD1 eq_sym. + swap{1}-1;seq 1 1 : (={r,x,FRO.m} /\ ! mem (dom FRO.m{1}) x{1});1:by auto. + inline RRO.resample;exists*x{1},r{1};elim*=>x1 r1. + call (iter_inv RRO.I (fun z=>x1<>z) + (fun o1 o2 => o1.[x1] = None /\ o2= o1.[x1<-(r1,Known)]) (I_f_set x1 r1));auto. + move=>?&mr[*]5!-> ^Hnin^ + ->/=;rewrite in_dom=>/=->/=;rewrite restr_set_neq //=;split. + + by move=>z; rewrite -memE dom_restr /#. + by move=>_?mr[*]^Hmem 2!->;rewrite in_dom Hmem /= getP /=oget_some. qed. lemma eager_set : @@ -387,44 +402,39 @@ lemma eager_set : ={x,y} /\ ={FRO.m} ==> ={res,FRO.m} ]. proof. eager proc. + inline RRO.resample=>/=;wp. case ((mem (dom FRO.m) x /\ (oget FRO.m.[x]).`2 = Unknown){1}). - inline{1} RRO.resample=>/=;wp 1 2. - transitivity{1} { Iter(RRO.I).iter(x::elems ((dom (restr Unknown FRO.m)) `\` fset1 x)); - } + + transitivity{1} { Iter(RRO.I).iter_1s(x,elems ((dom (restr Unknown FRO.m)) `\` fset1 x));} (={x,y,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown ==> ={x,y,FRO.m}) (={x,y,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown==> ={x,y} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ FRO.m{2}.[x{2}] = Some (y{2},Known)). - + by move=>?&mr[*]-> -> ???;exists FRO.m{mr}, y{mr}, x{mr}=>/#. - + move=>??? [*]<*>[*]-> -> Hex Hm2. - by rewrite (eq_except_set_eq FRO.m{2} FRO.m{m} x{2}) ?in_dom ?Hm2// eq_except_sym. - + call (iter_perm RRO.I iter_perm2). - skip=>?&mr[][]->>[]->>->>[]Hdom Hm/=. - by apply /perm_to_rem/dom_restr;rewrite Hdom Hm. - inline *;rcondt{1} 2;1:by auto. - while (={x,l} /\ !mem l{1} x{1}/\ - eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ - FRO.m{2}.[x{2}] = Some (y{2}, Known)). - + auto=> ?&mr[*]2!->Hm Hex Hm1 Hmr _/=?->. - rewrite (contra _ _ (mem_drop 1 _ _) Hm) /=. - rewrite!getP;move:Hm;rewrite-(mem_head_behead witness l{mr})//negb_or=>-[]->_. - by rewrite Hm1 /=;apply eq_except_set. - auto=>?&mr[*]3!<*>Hdom Hm /=/=;rewrite !drop0 sampleto_ll=>/=?_. - by rewrite -memE restr_set /= dom_rem !inE !getP_eq set2_eq_except. - inline *;wp. - while (={x,l} /\ !mem l{1} x{1}/\ - eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ - FRO.m{2}.[x{2}] = Some (y{2}, Known)). - + auto=> ?&mr[*]2!->Hm Hex Hm1 Hmr _/=?->. - rewrite (contra _ _ (mem_drop 1 _ _) Hm) /=. - rewrite!getP;move:Hm;rewrite-(mem_head_behead witness l{mr})//negb_or=>-[]->_. - by rewrite Hm1 /=;apply eq_except_set. - auto=> ?&mr[*]3!-> Hnm /=. - rewrite-memE restr_set/=rem_id?dom_restr//=Hnm. - rewrite getP_eq eq_except_sym set_eq_except/=. - move=>/=????2!->/=[]/eq_except_sym? Hx2;apply/eq_sym. - have/(congr1 oget):=Hx2=><-;apply eq_except_set_eq=>//;by rewrite in_dom Hx2. + + by move=>?&mr[*]2!->???;exists FRO.m{mr}, y{mr}, x{mr}=>/#. + + move=>?&m&mr[*]<*>[*]2!->Hex Hm2. + by rewrite (eq_except_set_eq FRO.m{mr} FRO.m{m} x{mr}) ?in_dom ?Hm2// eq_except_sym. + + symmetry;call (iter1_perm RRO.I iter_perm2);auto=>?&mr[*]3!-> Hdom Hm;split=>//=. + by apply /perm_eq_sym/perm_to_rem/dom_restr;rewrite /in_dom_with Hdom. + inline{1}Iter(RRO.I).iter_1s. + seq 3 1: (={x,y} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + l{1} = (elems (dom (restr Unknown FRO.m))){2} /\ !mem l{1} x{1} /\ + (FRO.m.[x]=Some(y, Known)){2}). + + inline *;auto=>?&mr[*]3!->/=Hmem Hget;rewrite sampleto_ll=>?_. + by rewrite set2_eq_except getP_eq restr_set /= dom_rem -memE !inE negb_and. + exists* x{1},y{1},(FRO.m.[x]{1});elim*=>x1 y1 mx1;pose mx2:=Some(y1,Known). + call (iter_inv RRO.I (fun z=>x1<>z) + (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) + (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[*]-><-2!->->>2!->Hmem->/#. + exists* x{1},y{1},(FRO.m.[x]{1});elim*=>x1 y1 mx1;pose mx2:=Some(y1,Known). + call (iter_inv RRO.I (fun z=>x1<>z) + (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) + (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[*]-><-2!->->>->/= Hidm. + rewrite restr_set getP_eq/mx2 eq_except_sym set_eq_except/=;split;[split|]. + + by congr;apply fsetP=>z;rewrite !(dom_rem,inE,dom_restr) /#. + + by move=>z;rewrite -memE dom_restr /#. + move=>_??[*]Hex HLx HRx;apply /eq_sym. + have/(congr1 oget):=HRx=><-;apply eq_except_set_eq=>//;1:by rewrite in_dom HRx. + by apply /eq_except_sym. qed. lemma eager_rem: @@ -434,25 +444,37 @@ proof. eager proc;case ((in_dom_with FRO.m x Unknown){1}). + inline RRO.resample;wp. transitivity{1} - { Iter(RRO.I).iter(x::elems (dom (restr Unknown FRO.m) `\` fset1 x)); } + { Iter(RRO.I).iter_1s(x,elems (dom (restr Unknown FRO.m) `\` fset1 x)); } (={x,FRO.m}/\(in_dom_with FRO.m x Unknown){1}==> ={x,FRO.m}) (={x,FRO.m}/\ (in_dom_with FRO.m x Unknown){1} ==> (rem x FRO.m){1} = FRO.m{2})=>//. + by move=>?&mr[*]2!->_;exists FRO.m{mr}, x{mr}. - + call (iter_perm RRO.I iter_perm2);skip=>?&mr[*]2!->?/=. - by apply /perm_to_rem/dom_restr. - inline *;rcondt{1}2;1:by auto. - while (={l} /\ FRO.m{2} = rem x{1} FRO.m{1} /\ !(mem l x){1}). - + auto=>?&mr[*]->-> ^ + Hm Hl _/=?->. - rewrite rem_set-(mem_head_behead witness l{mr})//negb_or=>-[]->_/=. - by rewrite (contra _ _ (mem_drop 1 _ _) Hm). - auto=>?&mr[*]2!->Hidm/=;rewrite sampleto_ll/==>?. - by rewrite drop0 restr_rem Hidm/= dom_rem rem_set -memE !inE. - inline *;wp. - while (={l} /\ FRO.m{2} = rem x{1} FRO.m{1} /\ !(mem l x){1}). - + auto=>?&mr[*]->-> ^ + Hm Hl _/=?->. - rewrite rem_set-(mem_head_behead witness l{mr})//negb_or=>-[]->_/=. - by rewrite (contra _ _ (mem_drop 1 _ _) Hm). - by auto=>?&mr[*]2!->Hndw/=;rewrite restr_rem Hndw//= -memE dom_restr. + + symmetry;call (iter1_perm RRO.I iter_perm2);skip=>?&mr[*]2!->?/=;split=>//. + by apply /perm_eq_sym/perm_to_rem/dom_restr. + inline{1}Iter(RRO.I).iter_1s. + seq 3 1: (={x} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + l{1} = (elems (dom (restr Unknown FRO.m))){2} /\ !mem l{1} x{1} /\ + (FRO.m.[x]=None){2}). + + inline *;auto=>??[*]2!->Hidm/=;rewrite sampleto_ll=>?_. + rewrite eq_except_rem 1:!inE 2:set_eq_except // remP -memE in_fsetD1 negb_and /=. + by rewrite restr_rem Hidm /= dom_rem. + exists* x{1},(FRO.m.[x]{1});elim*=>x1 mx1. + call (iter_inv RRO.I (fun z=>x1<>z) + (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=None) _). + + by conseq (I_f_eqex x1 mx1 None). + auto=>?&mr[*]3!->^Hex 2!->Hmem ^Hx->/=;split=>[/#|_ mL mR[*]/eq_exceptP Hex'?Heq]. + apply fmapP=>z;rewrite remP;case (z=x{mr})=>[->/=|Hneq];1:by rewrite Heq. + by apply Hex';rewrite inE. + inline RRO.resample;wp. + exists *x{1},(FRO.m.[x]{1});elim*=>x1 mx1. + call (iter_inv RRO.I (fun z=>x1<>z) + (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=None) _). + + by conseq (I_f_eqex x1 mx1 None). + auto=>?&mr[*]4!->Hin/=. + rewrite restr_rem Hin/= remP eq_except_rem 1:inE // 1:eq_except_refl /=;split. + + by move=>z;rewrite -memE dom_restr /#. + move=>_ mL mR[*] /eq_exceptP Hex'?Heq. + apply fmapP=>z;rewrite remP;case (z=x{mr})=>[->/=|Hneq];1:by rewrite Heq. + by apply Hex';rewrite inE. qed. lemma eager_in_dom: @@ -490,25 +512,28 @@ proof. + rcondt{2}2;1:by auto. transitivity{2} { c <$ sampleto x; FRO.m.[x] <- (c, Unknown); - Iter(RRO.I).iter(x::elems ((dom (restr Unknown FRO.m)) `\` fset1 x));} + Iter(RRO.I).iter_1s(x,elems ((dom (restr Unknown FRO.m)) `\` fset1 x));} (={x,FRO.m} /\ ! mem (dom FRO.m{2}) x{2} ==> ={x,FRO.m}) (={x,FRO.m} /\ ! mem (dom FRO.m{2}) x{2} ==> ={x,FRO.m})=>//;last first. - + inline{2} RRO.resample;call (iter_perm RRO.I iter_perm2);auto=>?&mr[*]2!->?/=?->. - by rewrite !restr_set/= !dom_set perm_eq_sym perm_to_rem !inE. + + inline{2} RRO.resample;call (iter1_perm RRO.I iter_perm2);auto=>?&mr[*]2!->Hmem/=?->/=. + by apply /perm_eq_sym/perm_to_rem;rewrite restr_set/=dom_set !inE. + by move=>?&mr[*]2!->?;exists FRO.m{mr}, x{mr}. - inline RRO.resample;inline{2}*;rcondt{2}4;1:by auto. - inline *;wp;swap{1}-2. - while (={l} /\ FRO.m{2} = (FRO.m.[x <- (c,Unknown)]){1} /\ - (!mem (dom FRO.m) x /\ !mem l x){1}). - + auto=>?&mr[*]2!->Hd Hl Hnl _/=?->. - rewrite dom_set !inE set_set (contra _ _ (mem_drop 1 _ _) Hl). - by move:Hl;rewrite-(mem_head_behead witness l{mr})//negb_or eq_sym=>-[]->. - auto=>?&mr[*]2!->Hd;rewrite sampleto_ll=>?_/=?->. - rewrite drop0 set_set_eq restr_set/= -memE dom_set fsetDK;split=>//. - have^Hx->: !mem (dom (restr Unknown FRO.m{mr})) x{mr} by rewrite dom_restr Hd. - cut->//: dom (restr Unknown FRO.m{mr}) `\` fset1 x{mr} = - dom (restr Unknown FRO.m{mr}). - by rewrite fsetP=>x;rewrite in_fsetD1 /#. + inline Iter(RRO.I).iter_1s RRO.I.f RRO.resample;wp;swap{1}-1. + seq 1 7 : (={x} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + l{2} = (elems (dom (restr Unknown FRO.m))){1} /\ + (FRO.m.[x]){2} = Some(c{1},Unknown) /\ (FRO.m.[x]){1} = None). + + wp;rnd;auto=>?&mr[*]2!->;rewrite in_dom sampleto_ll/==>Heq?_?->. + rewrite getP_eq restr_set/=dom_set fsetDK eq_except_sym set_set Heq/=set_eq_except/=. + congr;apply fsetP=>z;rewrite in_fsetD1 dom_restr /in_dom_with !in_dom /#. + exists*x{1},c{1};elim*=>x1 c1;pose mx2:=Some(c1,Unknown). + call (iter_inv RRO.I (fun z=>x1<>z) + (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= None /\ o2.[x1]=mx2) _). + + by conseq (I_f_eqex x1 None mx2). + auto=>?&mr[*]2!<-->^Hex 3!->^Hx1-> @/mx2/=;split=>[z|_ mL mR[*]]. + + rewrite -memE dom_restr /in_dom_with in_dom /#. + rewrite in_dom=>Hex'->HRx/=;apply /eq_sym. + have/(congr1 oget):=HRx=><-;apply eq_except_set_eq;1:by rewrite in_dom HRx. + by apply eq_except_sym. rcondf{2}2;1:by auto. swap{1}2-1;inline*;auto. while (={l,FRO.m} /\ (mem (dom FRO.m) x){1});auto. @@ -594,7 +619,7 @@ equiv LRO_RRO_sample : LRO.sample ~ RRO.sample: ={x} /\ RO.m{1} = restr Known FRO.m{2} ==> RO.m{1} = restr Known FRO.m{2}. proof. proc;auto=>?&ml[]_->;rewrite sampleto_ll=> ??;rewrite restr_set /==>Hnd. - by rewrite rem_id // dom_restr Hnd. + by rewrite rem_id // dom_restr /in_dom_with Hnd. qed. lemma LRO_RRO_D (D<:RO_Distinguisher{RO,FRO}) : @@ -639,9 +664,9 @@ proof. + by move=>?&mr[]2!->;exists (glob D){mr},(map(fun _ c =>(c,Known))RO.m{mr}). + proc*;inline M.main1;wp;call (RO_FRO_D D);inline *. rcondf{2}2;auto. - + move=> &mr[]_->;apply mem_eq0=>z;rewrite -memE dom_restr mapP dom_map in_dom. + + move=> &mr[]_->;apply mem_eq0=>z;rewrite -memE dom_restr /in_dom_with mapP dom_map in_dom. by case(RO.m{m}.[_]). - by move=>?&mr[]2!->/=;rewrite map_comp map_id. + by move=>?&mr[]2!->/=;rewrite map_comp /fst/= map_id. transitivity M.main2 (={glob D, FRO.m} ==> ={glob D}) (={glob D} /\ FRO.m{1} = map (fun _ c => (c,Known)) RO.m{2} ==> @@ -652,3 +677,5 @@ proof. symmetry;call (LRO_RRO_D D);auto=> &ml&mr[*]2!->;split=>//=. by rewrite fmapP=>x;rewrite restrP mapP;case (RO.m{ml}.[x]). qed. + +end section. From 0e0506cb9eb31712365b7383705fbc165c23c0a8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 7 Jan 2016 21:33:20 -0800 Subject: [PATCH 101/394] Moving forward slightly. --- sha3/proof/old/ConcreteF.eca | 27 +++++++++++++++++++++++++-- 1 file changed, 25 insertions(+), 2 deletions(-) diff --git a/sha3/proof/old/ConcreteF.eca b/sha3/proof/old/ConcreteF.eca index dbf7ed3..26f5f27 100644 --- a/sha3/proof/old/ConcreteF.eca +++ b/sha3/proof/old/ConcreteF.eca @@ -1,6 +1,7 @@ require import Pred Fun Option Pair Int Real StdOrder Ring. require import List FSet NewFMap Utils Common SLCommon. (*...*) import Dprod Dexcepted Capacity IntOrder RealOrder. +require (*..*) Strong_RP_RF. module PF = { var m, mi: (state,state) fmap @@ -40,7 +41,6 @@ op bound_concrete : real. module CF(D:DISTINGUISHER) = Indif(SqueezelessSponge(PF), PF, D). section. - declare module D : DISTINGUISHER {Perm, C, PF}. axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): @@ -49,9 +49,32 @@ section. local module GReal' = Indif(FC(SqueezelessSponge(Perm)), PC(Perm), D). + (** TODO: this is expressed with restricted oracles rather than + restricted events. Extend the library and unify with the + statement as expressed in this file. **) + local clone Strong_RP_RF as Toto with + type D <- state, + op uD <- dstate, + type K <- unit, + op dK <- (Distr.Dunit.dunit<:unit> tt), + op q <- max_size + 1 + proof *. + realize gt0_q by smt w=max_ge0. + realize uD_uf_fu. + split. + case=> [x y]; rewrite Dprod.supp_def /fst /snd /=. + by rewrite Block.DWord.supportP Capacity.DWord.supportP. + apply/dprodU. + by rewrite Block.DWord.bdistr_uf. + by rewrite Capacity.DWord.cdistr_uf. + qed. + realize dK_ll. + by rewrite /is_lossless -/(Distr.weight _) Distr.Dunit.lossless. + qed. + (* TODO move this *) lemma size_behead(l:'a list): l <> [] => size (behead l) = size l - 1. - proof. case l=>// ??/=;ring. qed. + proof. by case l=> // ?? /=; ring. qed. lemma Real_Concrete &m : Pr[GReal(D).main()@ &m: res /\ C.c <= max_size] <= From d92fc1712562f0b7705aff856ed3876c7639d90b Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Mon, 18 Jan 2016 10:47:06 +0100 Subject: [PATCH 102/394] syntax change fix --- sha3/proof/Common.ec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 48326ff..e018936 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -214,7 +214,7 @@ have ->: j + k = (size s) - ((i-k) + 1) by rewrite /j #ring. by rewrite -nth_rev 1:/# &(@negbRL _ true) &(before_index) /#. qed. -pred unpad_spec (t : bool list) = +inductive unpad_spec (t : bool list) = | Unpad (s : bool list, n : int) of (0 <= n < r) & (r %| (size s + n + 2)) From 6a30e2c79b33e2542c5f49ffaf6eb5950b554080 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 18 Jan 2016 11:27:05 +0100 Subject: [PATCH 103/394] MyRO: Closing internal theory. --- sha3/proof/old/MyRO.ec | 2 ++ 1 file changed, 2 insertions(+) diff --git a/sha3/proof/old/MyRO.ec b/sha3/proof/old/MyRO.ec index 0a0ed47..4bf405c 100644 --- a/sha3/proof/old/MyRO.ec +++ b/sha3/proof/old/MyRO.ec @@ -679,3 +679,5 @@ proof. qed. end section. + +end GenEager. From fb3f178c54bea79ea4aeb76b3eda3b231f81e730 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 18 Jan 2016 11:11:31 +0100 Subject: [PATCH 104/394] remember the proof --- sha3/proof/old/G2.eca | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/sha3/proof/old/G2.eca b/sha3/proof/old/G2.eca index 3c91e0e..3a5baac 100644 --- a/sha3/proof/old/G2.eca +++ b/sha3/proof/old/G2.eca @@ -8,7 +8,7 @@ clone import Handle as Handle0. -(* + (* -------------------------------------------------------------------------- *) section PROOF. @@ -454,6 +454,8 @@ module G2(D:DISTINGUISHER,HS:SAMPLE) = { } (* G1.bext <- G1.bext \/ mem (rng handles) (x.`2, I); *) (* exists x2 h, handles.[h] = Some (X2,I) *) + (* exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) + handles_ <@ HS.restrD(); if (!mem (rng handles_) x.`2) { HS.setD(G1.chandle, x.`2); @@ -465,8 +467,10 @@ module G2(D:DISTINGUISHER,HS:SAMPLE) = { if (mem (dom G1.mh) (x.`1, hx2) /\ t) { hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; y2 <@ HS.get(hy2); + (* bad <- bad \/ mem (map snd (dom G1.m)) y2 *) + +(* bext{1} => bad{2} \/ exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) y <- (y.`1, y2); - (* bad <- bad \/ mem X2 y.`2; *) G1.m.[x] <- y; G1.mi.[y] <- x; } else { From 98f9e90a9395e129b10a68b336d4f465637466b2 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 18 Jan 2016 12:15:54 +0100 Subject: [PATCH 105/394] Renaming --- sha3/proof/{old/MyRO.ec => RndO.ec} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename sha3/proof/{old/MyRO.ec => RndO.ec} (100%) diff --git a/sha3/proof/old/MyRO.ec b/sha3/proof/RndO.ec similarity index 100% rename from sha3/proof/old/MyRO.ec rename to sha3/proof/RndO.ec From de9ac23074f0413bf24c316adf533f09ba7fb2c9 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 18 Jan 2016 14:42:51 +0100 Subject: [PATCH 106/394] bla bla --- sha3/proof/old/G2.eca | 177 ++++++++++++++++++++++++++++++++++++-- sha3/proof/old/Handle.eca | 3 +- 2 files changed, 170 insertions(+), 10 deletions(-) diff --git a/sha3/proof/old/G2.eca b/sha3/proof/old/G2.eca index 3a5baac..55a7188 100644 --- a/sha3/proof/old/G2.eca +++ b/sha3/proof/old/G2.eca @@ -2,15 +2,15 @@ require import Pred Fun Option Pair Int Real StdOrder Ring StdBigop. require import List FSet NewFMap Utils Common SLCommon FelTactic Mu_mem. (*...*) import Dprod Dexcepted Capacity IntOrder Bigreal RealOrder BRA. -require Handle. +require import RndO. +require (*..*) Handle. clone import Handle as Handle0. - - (* -------------------------------------------------------------------------- *) + section PROOF. declare module D: DISTINGUISHER{C, PF, G1}. @@ -125,9 +125,7 @@ section PROOF. y <- (y.`1, (oget G1.handles.[hy2]).`1); G1.handles.[hy2] <- (y.`2, D); 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 { hy2 <- G1.chandle; G1.chandle <- G1.chandle + 1; @@ -239,13 +237,13 @@ section PROOF. (G1.bcol{1} => G1.bcol{2}) /\ (card (rng G1.handles) + 1 <= 2 * C.c + 1 /\ Gcol.count + 1 <= C.c <= max_size){2}). - + auto;smt ml=0 w=card_rng_set. + + by auto;smt ml=0 w=card_rng_set. seq 1 2: (={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles, C.c,x0,hx2} /\ y0{1} = (y1,y2){2} /\ ((G1.bcol\/hinv G1.handles y0.`2 <> None){1} => G1.bcol{2}) /\ (card (rng G1.handles) + 1 <= 2 * C.c + 1 /\ - Gcol.count <= C.c <= max_size){2});last by auto;smt ml=0 w=card_rng_set. + 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;cut /#:= fcard_image_leq fst (rng G1.handles{hr}). @@ -322,7 +320,167 @@ section PROOF. qed. end section PROOF. -*) + + + +(*section PROOF_ext. + + declare module D: DISTINGUISHER{C, PF, G1}. + + local clone import GenEager as Gen with + type from <- int, + type to = + +type from, to. + +op sampleto : from -> to distr. +axiom sampleto_ll : forall x, Distr.weight (sampleto x) = 1%r. + + +print Gen. + + clone import + + module G2(D:DISTINGUISHER,HS:SAMPLE) = { + + module C = { + + proc f(p : block list): block = { + var sa, sa'; + var h, i <- 0; + sa <- b0; + if (1 <= size p /\ p <> [b0]) { + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + HS.sampleI(G1.chandle); + sa' <- RO.f(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; + } + i <- i + 1; + } + sa <- RO.f(p); + } + return sa; + } + } + + module S = { + + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2, handles_,t; + + if (!mem (dom G1.m) x) { + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + y1 <- RO.f (rcons p (v +^ x.`1)); + y2 <$ cdistr; + y <- (y1, y2); + G1.paths.[y2] <- (rcons p (v +^ x.`1), y.`1); + } else { + y <$ dstate; + } +(* G1.bext <- G1.bext \/ mem (rng handles) (x.`2, I); *) + (* exists x2 h, handles.[h] = Some (X2,I) *) + (* exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) + + handles_ <@ HS.restrD(); + if (!mem (rng handles_) x.`2) { + HS.setD(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <- HS.restrD(); + hx2 <- oget (hinvc handles_ x.`2); + t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, I); + if (mem (dom G1.mh) (x.`1, hx2) /\ t) { + hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; + y2 <@ HS.get(hy2); + (* bad <- bad \/ mem (map snd (dom G1.m)) y2 *) + +(* bext{1} => bad{2} \/ exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) + y <- (y.`1, y2); + G1.m.[x] <- y; + G1.mi.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + HS.setD(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); + } + } else { + y <- oget G1.m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2, hx2, hy2, handles_, t; + + if (!mem (dom G1.mi) x) { + (* bext <- bext \/ mem (rng handles) (x.`2, I); *) + (* exists x2 h, handles.[h] = Some (X2,I) *) + handles_ <@ HS.restrD(); + if (!mem (rng handles_) x.`2) { + HS.setD(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <@ HS.restrD(); + hx2 <- oget (hinvc handles_ x.`2); + y <$ dstate; + t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, I); + if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { + (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; + y2 <@ HS.get(hy2); + y <- (y.`1, y2); + (* bad <- bad \/ mem X2 y.`2; *) + G1.mi.[x] <- y; + G1.m.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + HS.setD(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 main(): bool = { + var b; + + RO.m <- map0; + G1.m <- map0; + G1.mi <- map0; + G1.mh <- map0; + G1.mhi <- map0; + G1.bext <- false; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + HS.setD(0,c0); + G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.chandle <- 1; + b <@ D(C,S).distinguish(); + return b; + } +}. + + + module type SAMPLE = { proc sampleI(h:handle) : unit @@ -544,4 +702,5 @@ module G2(D:DISTINGUISHER,HS:SAMPLE) = { b <@ D(C,S).distinguish(); return b; } -}. \ No newline at end of file +}. +*) \ No newline at end of file diff --git a/sha3/proof/old/Handle.eca b/sha3/proof/old/Handle.eca index a5f2b18..50efca9 100644 --- a/sha3/proof/old/Handle.eca +++ b/sha3/proof/old/Handle.eca @@ -1,9 +1,10 @@ require import Pred Fun Option Pair Int Real StdOrder Ring. -require import List FSet NewFMap Utils Common SLCommon. +require import List FSet NewFMap Utils Common SLCommon RndO. (*...*) import Dprod Dexcepted Capacity IntOrder. require ConcreteF. + module G1(D:DISTINGUISHER) = { var m, mi : smap var mh, mhi : hsmap From 05f4be5aea1879b4da0d1ed6e2e2b752bc185d9b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 18 Jan 2016 17:43:37 +0100 Subject: [PATCH 107/394] A proof for ConcreteF -- ugly but effective. --- sha3/proof/old/ConcreteF.eca | 67 ++++++++++++++++++++++++++++++++---- 1 file changed, 60 insertions(+), 7 deletions(-) diff --git a/sha3/proof/old/ConcreteF.eca b/sha3/proof/old/ConcreteF.eca index 26f5f27..4f408fc 100644 --- a/sha3/proof/old/ConcreteF.eca +++ b/sha3/proof/old/ConcreteF.eca @@ -52,11 +52,11 @@ section. (** TODO: this is expressed with restricted oracles rather than restricted events. Extend the library and unify with the statement as expressed in this file. **) - local clone Strong_RP_RF as Toto with + local clone import Strong_RP_RF as Switching with type D <- state, op uD <- dstate, type K <- unit, - op dK <- (Distr.Dunit.dunit<:unit> tt), + op dK <- (NewDistr.MUnit.dunit<:unit> tt), op q <- max_size + 1 proof *. realize gt0_q by smt w=max_ge0. @@ -69,16 +69,44 @@ section. by rewrite Capacity.DWord.cdistr_uf. qed. realize dK_ll. - by rewrite /is_lossless -/(Distr.weight _) Distr.Dunit.lossless. + by rewrite /is_lossless NewDistr.MUnit.dunit_ll. qed. (* TODO move this *) - lemma size_behead(l:'a list): l <> [] => size (behead l) = size l - 1. + lemma size_behead (l : 'a list) : l <> [] => size (behead l) = size l - 1. proof. by case l=> // ?? /=; ring. qed. + local module D'(P' : PRPt.Oracles): PRPt.Distinguisher(P') = { + proc distinguish = DRestr(D,SqueezelessSponge(P'),P').distinguish + }. + + local lemma DoubleBounding (P <: PRPt.StrongPRP {D, C, DBounder}) &m: + Pr[PRPt.IND(P,D').main() @ &m: res] + = Pr[PRPt.IND(P,DBounder(D')).main() @ &m: res]. + proof. + byequiv=> //=; proc; inline *. + wp. + call (_: ={glob C, glob P} /\ DBounder.FBounder.c{2} = C.c{2}). + + proc; sp; if=> //=; inline *. + rcondt{2} 4; 1: by auto=> /#. + by wp; call (_: true); auto. + + proc; sp; if=> //=; inline *. + rcondt{2} 4; 1: by auto=> /#. + by wp; call (_: true); auto. + + proc; sp; if=> //=; inline *. + sp; if=> //=; last by wp; auto; smt w=size_ge0. + wp; while ( ={glob C, glob P, p, sa, sc} + /\ C.c{2} <= max_size + /\ DBounder.FBounder.c{2} = C.c{2} - size p{2}). + rcondt{2} 3; 1: by auto; smt w=size_ge0. + by wp; call (_: true); auto=> /#. + by auto; progress; ring. + by wp; call (_: true). + qed. + lemma Real_Concrete &m : Pr[GReal(D).main()@ &m: res /\ C.c <= max_size] <= - Pr[CF(DRestr(D)).main()@ &m: res] + bound_concrete. + Pr[CF(DRestr(D)).main()@ &m: res] + ((max_size + 1) ^ 2)%r * mu dstate (pred1 witness). proof. cut->: Pr[RealIndif(SqueezelessSponge,PC(Perm),D).main()@ &m: @@ -89,7 +117,7 @@ section. + while (={glob Perm,sc,sa,p} /\ (C.c + size p){1} = C.c{2});2:by auto. by wp;sp 1 1;if{2};[rcondt{1} 3|rcondf{1} 3];auto; progress;rewrite size_behead//;ring. - by auto; smt ml=0 w=size_ge0. + by auto; smt w=size_ge0. have p_ll := P_f_ll _ _. + apply/Dprod.lossless. + exact/Block.DWord.bdistr_ll. @@ -113,7 +141,32 @@ section. by move=> z; conseq (_: _ : =1%r); wp; call p_ll; skip; smt w=size_behead. apply (ler_trans _ _ _ (Pr_restr Perm SqueezelessSponge D p_ll pi_ll f_ll D_ll &m)). - admit. (* Francois *) + have ->: Pr[Indif(SqueezelessSponge(Perm), Perm, DRestr(D)).main() @ &m: res] + = Pr[PRPt.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. + by proc; if=> //=; auto. + have ->: Pr[CF(DRestr(D)).main() @ &m: res] + = Pr[PRPt.IND(ARP,DBounder(D')).main() @ &m: res]. + + rewrite -(DoubleBounding ARP &m). + byequiv=> //=; proc; inline *; sim (_: ={m,mi}(PF,ARP)). + * by proc; if=> //=; auto. + have:= Conclusion D' &m _. + + move=> O O_f_ll O_fi_ll. + proc; call (_: true)=> //=. + * apply D_ll. + * by proc; sp; if=> //=; call O_f_ll; auto. + * by proc; sp; if=> //=; call O_fi_ll; auto. + * proc; inline *; sp; if=> //=; sp; if=> //=; auto. + while true (size p). + - by auto; call O_f_ll; auto=> /#. + by auto; smt w=size_ge0. + by inline *; auto. + move=> h. + (* to avoid asking smt to do the proof with probability expressions... *) + have -> //: forall (x y z : real), `|x - y| <= z => x <= y + z. + smt w=(@RealOrder). qed. end section. From ce89fa7ba28e93cee3186689fcf2c82ce1536c12 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 18 Jan 2016 17:44:14 +0100 Subject: [PATCH 108/394] Removing an obsolete comment. --- sha3/proof/old/ConcreteF.eca | 3 --- 1 file changed, 3 deletions(-) diff --git a/sha3/proof/old/ConcreteF.eca b/sha3/proof/old/ConcreteF.eca index 4f408fc..d4763fe 100644 --- a/sha3/proof/old/ConcreteF.eca +++ b/sha3/proof/old/ConcreteF.eca @@ -49,9 +49,6 @@ section. local module GReal' = Indif(FC(SqueezelessSponge(Perm)), PC(Perm), D). - (** TODO: this is expressed with restricted oracles rather than - restricted events. Extend the library and unify with the - statement as expressed in this file. **) local clone import Strong_RP_RF as Switching with type D <- state, op uD <- dstate, From 08b47b924bf482f59be39f64bc11762fe3e85eca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 18 Jan 2016 17:45:09 +0100 Subject: [PATCH 109/394] Further cleanup of unneeded operator. Sorry for the spam. --- sha3/proof/old/ConcreteF.eca | 3 --- 1 file changed, 3 deletions(-) diff --git a/sha3/proof/old/ConcreteF.eca b/sha3/proof/old/ConcreteF.eca index d4763fe..737381b 100644 --- a/sha3/proof/old/ConcreteF.eca +++ b/sha3/proof/old/ConcreteF.eca @@ -35,9 +35,6 @@ module PF = { }. -(* Fixme *) -op bound_concrete : real. - module CF(D:DISTINGUISHER) = Indif(SqueezelessSponge(PF), PF, D). section. From 62b1dc629f2622e93f38e9887cda47f426c4194e Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Tue, 19 Jan 2016 09:37:35 +0100 Subject: [PATCH 110/394] progress --- sha3/proof/old/G2.eca | 99 ++++++++++++++++++++++----------------- sha3/proof/old/Handle.eca | 3 +- 2 files changed, 58 insertions(+), 44 deletions(-) diff --git a/sha3/proof/old/G2.eca b/sha3/proof/old/G2.eca index 55a7188..e2372ee 100644 --- a/sha3/proof/old/G2.eca +++ b/sha3/proof/old/G2.eca @@ -7,10 +7,8 @@ require (*..*) Handle. clone import Handle as Handle0. - - (* -------------------------------------------------------------------------- *) - +(* section PROOF. declare module D: DISTINGUISHER{C, PF, G1}. @@ -320,28 +318,26 @@ section PROOF. qed. end section PROOF. +*) +print RO. +clone import GenEager as Gen with + type from <- int, + type to <- capacity, + op sampleto <- fun (_:int) => cdistr + proof sampleto_ll by apply DWord.cdistr_ll. -(*section PROOF_ext. - - declare module D: DISTINGUISHER{C, PF, G1}. - - local clone import GenEager as Gen with - type from <- int, - type to = - -type from, to. - -op sampleto : from -> to distr. -axiom sampleto_ll : forall x, Distr.weight (sampleto x) = 1%r. - +print RO. +print Functionality.RO. -print Gen. +op bad_ext (m:('a*'b,'c)fmap) (y:'b) = + mem (map snd (elems (dom m))) y. - clone import +op hinvc (handles : (int,capacity) fmap) (c : capacity) : handle option = + find (+ pred1 c) handles. - module G2(D:DISTINGUISHER,HS:SAMPLE) = { + module G2(D:DISTINGUISHER,HS:FRO) = { module C = { @@ -354,8 +350,8 @@ print Gen. if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; } else { - HS.sampleI(G1.chandle); - sa' <- RO.f(take (i+1) p); + HS.sample(G1.chandle); + sa' <@ Functionality.RO.f(take (i+1) p); sa <- sa +^ nth witness p i; G1.mh.[(sa,h)] <- (sa', G1.chandle); G1.mhi.[(sa',G1.chandle)] <- (sa, h); @@ -364,7 +360,7 @@ print Gen. } i <- i + 1; } - sa <- RO.f(p); + sa <- Functionality.RO.f(p); } return sa; } @@ -378,38 +374,34 @@ print Gen. if (!mem (dom G1.m) x) { if (mem (dom G1.paths) x.`2) { (p,v) <- oget G1.paths.[x.`2]; - y1 <- RO.f (rcons p (v +^ x.`1)); + y1 <- Functionality.RO.f (rcons p (v +^ x.`1)); y2 <$ cdistr; y <- (y1, y2); G1.paths.[y2] <- (rcons p (v +^ x.`1), y.`1); } else { y <$ dstate; } -(* G1.bext <- G1.bext \/ mem (rng handles) (x.`2, I); *) - (* exists x2 h, handles.[h] = Some (X2,I) *) (* exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) - handles_ <@ HS.restrD(); + handles_ <@ HS.restrK(); if (!mem (rng handles_) x.`2) { - HS.setD(G1.chandle, x.`2); + HS.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } - handles_ <- HS.restrD(); + handles_ <- HS.restrK(); hx2 <- oget (hinvc handles_ x.`2); - t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, I); + t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); if (mem (dom G1.mh) (x.`1, hx2) /\ t) { hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; y2 <@ HS.get(hy2); - (* bad <- bad \/ mem (map snd (dom G1.m)) y2 *) - -(* bext{1} => bad{2} \/ exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) + G1.bext <- G1.bext \/ bad_ext G1.m y2; y <- (y.`1, y2); G1.m.[x] <- y; G1.mi.[y] <- x; } else { hy2 <- G1.chandle; G1.chandle <- G1.chandle + 1; - HS.setD(hy2, y.`2); + HS.set(hy2, y.`2); G1.m.[x] <- y; G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); G1.mi.[y] <- x; @@ -425,28 +417,26 @@ print Gen. var y, y1, y2, hx2, hy2, handles_, t; if (!mem (dom G1.mi) x) { - (* bext <- bext \/ mem (rng handles) (x.`2, I); *) - (* exists x2 h, handles.[h] = Some (X2,I) *) - handles_ <@ HS.restrD(); + handles_ <@ HS.restrK(); if (!mem (rng handles_) x.`2) { - HS.setD(G1.chandle, x.`2); + HS.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } - handles_ <@ HS.restrD(); + handles_ <@ HS.restrK(); hx2 <- oget (hinvc handles_ x.`2); y <$ dstate; - t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, I); + t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; y2 <@ HS.get(hy2); y <- (y.`1, y2); - (* bad <- bad \/ mem X2 y.`2; *) + G1.bext <- G1.bext \/ bad_ext G1.m y2; G1.mi.[x] <- y; G1.m.[y] <- x; } else { hy2 <- G1.chandle; G1.chandle <- G1.chandle + 1; - HS.setD(hy2, y.`2); + HS.set(hy2, y.`2); G1.mi.[x] <- y; G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); G1.m.[y] <- x; @@ -471,7 +461,8 @@ print Gen. G1.bext <- false; (* the empty path is initially known by the adversary to lead to capacity 0^c *) - HS.setD(0,c0); + HS.init(); + HS.set(0,c0); G1.paths <- map0.[c0 <- ([<:block>],b0)]; G1.chandle <- 1; b <@ D(C,S).distinguish(); @@ -480,6 +471,30 @@ print Gen. }. +section EXT. + + declare module D: DISTINGUISHER{C, PF, G1, G2}. + + equiv G1_G2 : G1(D).main ~ G2(D,FRO).main : + ={glob D} ==> ={res} /\ G1.bext{1} => (G1.bext{2} \/ + exists x h, mem (dom G1.m{2}) x /\ FRO.m{2}.[h] = Some (x.`2, Unknown)). + + + + +col.main +type from, to. + +op sampleto : from -> to distr. +axiom sampleto_ll : forall x, Distr.weight (sampleto x) = 1%r. + + +print Gen. + + clone import + + + module type SAMPLE = { diff --git a/sha3/proof/old/Handle.eca b/sha3/proof/old/Handle.eca index 50efca9..78f490e 100644 --- a/sha3/proof/old/Handle.eca +++ b/sha3/proof/old/Handle.eca @@ -4,7 +4,6 @@ require import List FSet NewFMap Utils Common SLCommon RndO. require ConcreteF. - module G1(D:DISTINGUISHER) = { var m, mi : smap var mh, mhi : hsmap @@ -27,7 +26,7 @@ module G1(D:DISTINGUISHER) = { } else { sc <$ cdistr; bcol <- bcol \/ hinv handles sc <> None; - sa' <- RO.f(take (i+1) p); + sa' <@ RO.f(take (i+1) p); sa <- sa +^ nth witness p i; mh.[(sa,h)] <- (sa', chandle); mhi.[(sa',chandle)] <- (sa, h); From b97ea42d1180f4b2ab6aa2c824d60ebee1aed1d1 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Tue, 19 Jan 2016 10:07:28 +0100 Subject: [PATCH 111/394] start propagation of RndO instead of RndOrcl --- sha3/proof/old/Handle.eca | 7 ++ sha3/proof/old/SLCommon.ec | 153 +++++++++++++++++-------------------- 2 files changed, 79 insertions(+), 81 deletions(-) diff --git a/sha3/proof/old/Handle.eca b/sha3/proof/old/Handle.eca index 78f490e..d5deb5c 100644 --- a/sha3/proof/old/Handle.eca +++ b/sha3/proof/old/Handle.eca @@ -4,6 +4,13 @@ require import List FSet NewFMap Utils Common SLCommon RndO. require ConcreteF. +clone import GenEager as Gen with + type from <- handle, + type to <- capacity, + op sampleto <- fun (_:int) => cdistr + proof sampleto_ll by apply DWord.cdistr_ll. + +print hinv. module G1(D:DISTINGUISHER) = { var m, mi : smap var mh, mhi : hsmap diff --git a/sha3/proof/old/SLCommon.ec b/sha3/proof/old/SLCommon.ec index c1f6648..280bcc9 100644 --- a/sha3/proof/old/SLCommon.ec +++ b/sha3/proof/old/SLCommon.ec @@ -4,15 +4,14 @@ length is the input block size. We prove its security even when padding is not prefix-free. **) require import Pred Fun Option Pair Int Real StdOrder Ring. -require import List FSet NewFMap Utils Common. +require import List FSet NewFMap Utils Common RndO. -require (*..*) RndOrcl Indifferentiability. +require (*..*) Indifferentiability. (*...*) import Dprod Dexcepted Capacity IntOrder. type state = block * capacity. op dstate = bdistr * cdistr. - clone include Indifferentiability with type p <- state, type f_in <- block list, @@ -34,23 +33,14 @@ clone export Tuple as TupleBl with op bl_enum = flatten (mkseq (fun i => wordn i) (max_size + 1)). op bl_univ = FSet.oflist bl_enum. -clone RndOrcl as RndOrclB with +(* -------------------------------------------------------------------------- *) +(* Random oracle from block list to block *) + +clone import RndO.GenEager as F with type from <- block list, - type to <- block. - -clone export RndOrclB.RestrIdeal as Functionality with - op sample _ <- bdistr, - op test l <- List.size l <= max_size, - op univ <- bl_univ, - op dfl <- b0 - proof *. -realize sample_ll by exact Block.DWord.bdistr_ll. -realize testP. -proof. - move=> x; rewrite mem_oflist-flattenP; split=>[_|[s[/mkseqP[i[/=_->>]]/wordnP->/#]]]. - exists (wordn (size x));cut Hsx := size_ge0 x. - rewrite wordnP max_ler //= mkseqP /=;exists (size x);smt ml=0. -qed. + type to <- block, + op sampleto <- fun (_:block list)=> bdistr + proof * by exact Block.DWord.bdistr_ll. (** We can now define the squeezeless sponge construction **) module SqueezelessSponge (P:DPRIMITIVE): FUNCTIONALITY = { @@ -90,7 +80,7 @@ type handle = int. type hstate = block * handle. -type ccapacity = capacity * caller. +type ccapacity = capacity * flag. type smap = (state , state ) fmap. type hsmap = (hstate, hstate ) fmap. @@ -125,63 +115,6 @@ proof. by split; apply/half_permutation_set. qed. -(** Operators and properties of handles *) - -op hinv (handles:handles) (c:capacity) = - find (fun _ => pred1 c \o fst) handles. - -op hinvD (handles:handles) (c:capacity) = - find (fun _ => pred1 (c,D)) 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. - cut @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := - findP (fun (_ : handle) => pred1 c \o fst) handles. - + by exists (oget handles.[h]).`2;rewrite oget_some get_oget;2:case (oget handles.[h]). - by rewrite -not_def=> Heq; cut := H h;rewrite in_dom Heq. -qed. - -lemma huniq_hinv (handles:handles) (h:handle): - huniq handles => mem (dom handles) h => hinv handles (oget handles.[h]).`1 = Some h. -proof. - move=> Huniq;pose c := (oget handles.[h]).`1. - cut:=Huniq h;cut:=hinvP handles c. - case (hinv _ _)=> /=[Hdiff _| h' +/(_ h')];1:by rewrite in_dom /#. - by move=> [f ->] /(_ (oget handles.[h]) (c,f)) H1 H2;rewrite H1 // get_oget. -qed. - -lemma hinvDP handles c: - if hinvD handles c = None then forall h, handles.[h] <> Some(c,D) - else handles.[oget (hinvD handles c)] = Some(c,D). -proof. - cut @/pred1/=[[h []->[]Hmem ]|[]->H h ]/= := - findP (fun (_ : handle) => pred1 (c,D)) handles. - + by rewrite oget_some get_oget. - by rewrite -not_def=> Heq; cut := H h;rewrite in_dom Heq. -qed. - -lemma huniq_hinvD (handles:handles) c: - huniq handles => mem (rng handles) (c,D) => handles.[oget (hinvD handles c)] = Some(c,D). -proof. - move=> Huniq;rewrite in_rng=> -[h]H;case: (hinvD _ _) (Huniq h) (hinvDP handles c)=>//=. - by move=>_/(_ h);rewrite H. -qed. - -lemma huniq_hinvD_h h (handles:handles) c: - huniq handles => handles.[h] = Some (c,D) => hinvD handles c = Some h. -proof. - move=> Huniq;case: (hinvD _ _) (hinvDP handles c)=>/= [H|h'];1: by apply H. - by rewrite oget_some=> /Huniq H/H. -qed. - (* Functionnal version of the construction using handle *) op step_hpath (mh:hsmap) (sah:hstate option) (b:block) = @@ -337,9 +270,8 @@ proof. by inline *;auto. qed. -(* Exemple *) -(* section RESTR. + declare module F:FUNCTIONALITY{C}. declare module P:PRIMITIVE{C,F}. declare module D:DISTINGUISHER{F,P,C}. @@ -352,8 +284,7 @@ section RESTR. proc;inline *;wp;swap{1}1 2;sim. qed. -end RESTR. -*) +end section RESTR. section COUNT. @@ -396,7 +327,67 @@ section COUNT. 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,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. + cut @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := + findP (fun (_ : handle) => pred1 c \o fst) handles. + + by exists (oget handles.[h]).`2;rewrite oget_some get_oget;2:case (oget handles.[h]). + by rewrite -not_def=> Heq; cut := H h;rewrite in_dom Heq. +qed. + +lemma huniq_hinv (handles:handles) (h:handle): + huniq handles => mem (dom handles) h => hinv handles (oget handles.[h]).`1 = Some h. +proof. + move=> Huniq;pose c := (oget handles.[h]).`1. + cut:=Huniq h;cut:=hinvP handles c. + case (hinv _ _)=> /=[Hdiff _| h' +/(_ h')];1:by rewrite in_dom /#. + by move=> [f ->] /(_ (oget handles.[h]) (c,f)) H1 H2;rewrite H1 // get_oget. +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. + cut @/pred1/=[[h []->[]Hmem ]|[]->H h ]/= := + findP (fun (_ : handle) => pred1 (c,Known)) handles. + + by rewrite oget_some get_oget. + by rewrite -not_def=> Heq; cut := H h;rewrite in_dom Heq. +qed. + +lemma huniq_hinvK (handles:handles) c: + huniq handles => mem (rng handles) (c,Known) => handles.[oget (hinvK handles c)] = Some(c,Known). +proof. + move=> Huniq;rewrite in_rng=> -[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. + move=> Huniq;case: (hinvK _ _) (hinvKP handles c)=>/= [H|h'];1: by apply H. + by rewrite oget_some=> /Huniq H/H. +qed. + (* -------------------------------------------------------------------------- *) (** The initial Game *) module GReal(D:DISTINGUISHER) = RealIndif(SqueezelessSponge, PC(Perm), D). + From 48d5751fa94688d726a886fc82eec26f1325f319 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Tue, 19 Jan 2016 15:37:03 +0100 Subject: [PATCH 112/394] use RndO and not RndOrcl. --- sha3/proof/old/ConcreteF.eca | 29 +- sha3/proof/old/G2.eca | 616 ++--------------------------------- sha3/proof/old/Gcol.eca | 321 ++++++++++++++++++ sha3/proof/old/Handle.eca | 118 +++---- sha3/proof/old/SLCommon.ec | 11 - 5 files changed, 423 insertions(+), 672 deletions(-) create mode 100644 sha3/proof/old/Gcol.eca diff --git a/sha3/proof/old/ConcreteF.eca b/sha3/proof/old/ConcreteF.eca index 737381b..23e2ba1 100644 --- a/sha3/proof/old/ConcreteF.eca +++ b/sha3/proof/old/ConcreteF.eca @@ -1,6 +1,8 @@ require import Pred Fun Option Pair Int Real StdOrder Ring. require import List FSet NewFMap Utils Common SLCommon. + (*...*) import Dprod Dexcepted Capacity IntOrder RealOrder. + require (*..*) Strong_RP_RF. module PF = { @@ -53,6 +55,7 @@ section. op dK <- (NewDistr.MUnit.dunit<:unit> tt), op q <- max_size + 1 proof *. + realize gt0_q by smt w=max_ge0. realize uD_uf_fu. split. @@ -146,21 +149,17 @@ section. + rewrite -(DoubleBounding ARP &m). byequiv=> //=; proc; inline *; sim (_: ={m,mi}(PF,ARP)). * by proc; if=> //=; auto. - have:= Conclusion D' &m _. - + move=> O O_f_ll O_fi_ll. - proc; call (_: true)=> //=. - * apply D_ll. - * by proc; sp; if=> //=; call O_f_ll; auto. - * by proc; sp; if=> //=; call O_fi_ll; auto. - * proc; inline *; sp; if=> //=; sp; if=> //=; auto. - while true (size p). - - by auto; call O_f_ll; auto=> /#. - by auto; smt w=size_ge0. - by inline *; auto. - move=> h. - (* to avoid asking smt to do the proof with probability expressions... *) - have -> //: forall (x y z : real), `|x - y| <= z => x <= y + z. - smt w=(@RealOrder). + have /#:= Conclusion D' &m _. + move=> O O_f_ll O_fi_ll. + proc; call (_: true)=> //=. + + apply D_ll. + + by proc; sp; if=> //=; call O_f_ll; auto. + + by proc; sp; if=> //=; call O_fi_ll; auto. + + proc; inline *; sp; if=> //=; sp; if=> //=; auto. + while true (size p). + * by auto; call O_f_ll; auto=> /#. + by auto; smt w=size_ge0. + by inline *; auto. qed. end section. diff --git a/sha3/proof/old/G2.eca b/sha3/proof/old/G2.eca index e2372ee..8dda61d 100644 --- a/sha3/proof/old/G2.eca +++ b/sha3/proof/old/G2.eca @@ -1,346 +1,21 @@ -require import Pred Fun Option Pair Int Real StdOrder Ring StdBigop. -require import List FSet NewFMap Utils Common SLCommon FelTactic Mu_mem. +require import Pred Fun Option Pair Int Real RealExtra StdOrder Ring StdBigop. +require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. (*...*) import Dprod Dexcepted Capacity IntOrder Bigreal RealOrder BRA. -require import RndO. -require (*..*) Handle. +require (*..*) Gcol. -clone import Handle as Handle0. +clone export Gcol as Gcol0. -(* -------------------------------------------------------------------------- *) -(* -section PROOF. - declare module D: DISTINGUISHER{C, PF, G1}. - - 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 (rng G1.handles)) <= 2*max_size /\ - count < max_size) { - c <$ cdistr; - G1.bcol <- G1.bcol \/ mem (image fst (rng G1.handles)) c; - count <- count + 1; - } - - return c; - } - - module C = { - - proc f(p : block list): block = { - var sa, sa', sc; - var h, i <- 0; - sa <- b0; - if (1 <= size p /\ p <> [b0]) { - while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; - } else { - sc <@ sample_c(); - sa' <- RO.f(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.handles.[G1.chandle] <- (sc,I); - G1.chandle <- G1.chandle + 1; - } - i <- i + 1; - } - sa <- RO.f(p); - } - return sa; - } - } - - module S = { - - proc f(x : state): state = { - var p, v, y, y1, y2, hy2, hx2; - - if (!mem (dom G1.m) x) { - if (!(mem (rng G1.handles) (x.`2, D))) { - G1.handles.[G1.chandle] <- (x.`2, D); - G1.chandle <- G1.chandle + 1; - } - hx2 <- oget (hinvD G1.handles x.`2); - - if (mem (dom G1.paths) x.`2) { - (p,v) <- oget G1.paths.[x.`2]; - y1 <- RO.f (rcons p (v +^ x.`1)); - y2 <@ sample_c(); - y <- (y1, y2); - G1.paths.[y2] <- (rcons p (v +^ x.`1), y.`1); - } else { - y1 <$ bdistr; - y2 <@ sample_c(); - y <- (y1,y2); - } - if (mem (dom G1.mh) (x.`1, hx2) /\ - in_dom_with G1.handles (oget G1.mh.[(x.`1,hx2)]).`2 I) { - hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; - y <- (y.`1, (oget G1.handles.[hy2]).`1); - G1.handles.[hy2] <- (y.`2, D); - G1.m.[x] <- y; - G1.mi.[y] <- x; - } else { - hy2 <- G1.chandle; - G1.chandle <- G1.chandle + 1; - G1.handles.[hy2] <- (y.`2, D); - G1.m.[x] <- y; - G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); - G1.mi.[y] <- x; - G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); - } - } else { - y <- oget G1.m.[x]; - } - return y; - } - - proc fi(x : state): state = { - var y, y1, y2, hx2, hy2; - - if (!mem (dom G1.mi) x) { - if (!(mem (rng G1.handles) (x.`2, D))) { - G1.handles.[G1.chandle] <- (x.`2, D); - G1.chandle <- G1.chandle + 1; - } - hx2 <- oget (hinvD G1.handles x.`2); - y1 <$ bdistr; - y2 <@ sample_c(); - y <- (y1,y2); - if (mem (dom G1.mhi) (x.`1, hx2) /\ - in_dom_with G1.handles (oget G1.mhi.[(x.`1,hx2)]).`2 I) { - (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; - y <- (y.`1, (oget G1.handles.[hy2]).`1); - G1.handles.[hy2] <- (y.`2, D); - G1.mi.[x] <- y; - G1.m.[y] <- x; - } else { - hy2 <- G1.chandle; - G1.chandle <- G1.chandle + 1; - G1.handles.[hy2] <- (y.`2, D); - 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; - - RO.m <- map0; - G1.m <- map0; - G1.mi <- map0; - G1.mh <- map0; - G1.mhi <- map0; - G1.bcol <- false; - - G1.handles <- map0.[0 <- (c0, D)]; - G1.paths <- map0.[c0 <- ([<:block>],b0)]; - G1.chandle <- 1; - count <- 0; - b <@ DRestr(D,C,S).distinguish(); - return b; - } - }. - - lemma card_rng_set (m:('a,'b)fmap) x y: card(rng m.[x<-y]) <= card(rng m) + 1. - proof. - rewrite rng_set fcardU fcard1. - cut := subset_leq_fcard (rng (rem x m)) (rng m) _;2:smt ml=0 w=fcard_ge0. - rewrite subsetP=> z;apply rng_rem_le. - qed. - - lemma hinv_image handles c: - hinv handles c <> None => - mem (image fst (rng handles)) c. - proof. - case: (hinv handles c) (hinvP handles c)=>//= h[f] Heq. - rewrite imageP;exists (c,f)=>@/fst/=. - by rewrite in_rng;exists (oget (Some h)). - qed. - - local equiv G1col : G1(DRestr(D)).main ~ Gcol.main : - ={glob D} ==> (G1.bcol{1} => G1.bcol{2}) /\ Gcol.count{2} <= max_size. - proof. - proc;inline*;wp. - call (_: ={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles,C.c}/\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card (rng G1.handles) <= 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. - seq 2 2 : (={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles, - C.c,x0} /\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card(rng G1.handles) + 2 <= 2*C.c + 1/\ - Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. - if=>//;last by auto=>/#. - swap{1}[2..4]-1. - seq 3 2:(={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles, - C.c,x0,hx2} /\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card (rng G1.handles) + 1 <= 2 * C.c + 1/\ - Gcol.count + 1 <= C.c <= max_size){2}). - + auto;smt ml=0 w=card_rng_set. - seq 1 1: - (={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles, - C.c,x0,hx2,y0} /\ - ((G1.bcol\/hinv G1.handles y0.`2 <> None){1} => G1.bcol{2}) /\ - (card (rng G1.handles) + 1 <= 2 * C.c + 1 /\ - Gcol.count <= C.c <= max_size){2});last by auto;smt ml=0 w=card_rng_set. - if=>//;inline Gcol.sample_c. - + rcondt{2}4. - + auto;conseq (_:true)=>//;progress;2: smt ml=0. - cut /#:= fcard_image_leq fst (rng G1.handles{hr}). - wp;conseq (_: ={p,v,RO.m,y1} /\ y2{1}=c{2})=>//;1:smt ml=0 w=hinv_image. - by sim. - rcondt{2}3. - + by auto;progress;cut /#:= fcard_image_leq fst (rng G1.handles{hr}). - swap{2}2-1;sp 0 1;wp;conseq(_:y0{1}=(y1,c){2})=>//;1:smt ml=0 w=hinv_image. - transitivity{1} {y0 <- S.sample();} - (true ==> ={y0}) - (true ==> y0{1}=(y1,c){2})=>//;1:by inline*;auto. - transitivity{2} {(y1,c) <- S.sample2();} - (true==>y0{1}=(y1,c){2}) - (true==> ={y1,c})=>//;2:by inline*;auto. - by call sample_sample2;auto=> /=?[??]->. - - + proc;sp 1 1;if=>//. - inline G1(DRestr(D)).S.fi Gcol.S.fi. - seq 2 2 : (={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles, - C.c,x0} /\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card(rng G1.handles) + 2 <= 2*C.c + 1 /\ - Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. - if=>//;last by auto=>/#. - seq 3 2:(={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles, - C.c,x0,hx2} /\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card (rng G1.handles) + 1 <= 2 * C.c + 1 /\ - Gcol.count + 1 <= C.c <= max_size){2}). - + by auto;smt ml=0 w=card_rng_set. - seq 1 2: - (={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles, - C.c,x0,hx2} /\ y0{1} = (y1,y2){2} /\ - ((G1.bcol\/hinv G1.handles y0.`2 <> None){1} => G1.bcol{2}) /\ - (card (rng G1.handles) + 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;cut /#:= fcard_image_leq fst (rng G1.handles{hr}). - swap{2}2-1;sp 0 1;wp;conseq(_:y0{1}=(y1,c){2})=>//;1:smt ml=0 w=hinv_image. - transitivity{1} {y0 <- S.sample();} - (true ==> ={y0}) - (true ==> y0{1}=(y1,c){2})=>//;1:by inline*;auto. - transitivity{2} {(y1,c) <- S.sample2();} - (true==>y0{1}=(y1,c){2}) - (true==> ={y1,c})=>//;2:by inline*;auto. - by call sample_sample2;auto=> /=?[??]->. - - + proc;sp 1 1;if=>//. - inline G1(DRestr(D)).C.f Gcol.C.f. - seq 5 5: - (={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles,C.c,b, - p,h,i,sa} /\ i{1}=0 /\ - (G1.bcol{1} => G1.bcol{2}) /\ - card (rng G1.handles{2}) + 2*(size p{2}) <= 2 * C.c{2} + 1 /\ - Gcol.count{2} + size p{2} <= C.c{2} <= max_size);1:by auto=>/#. - wp;if=>//;2:by auto;smt ml=0 w=size_ge0. - call (_: ={RO.m});1:by sim. - while - (={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles,C.c,b, - p,h,i,sa} /\ (i <= size p){1} /\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card (rng G1.handles) + 2*(size p - i) <= 2 * C.c + 1 /\ - Gcol.count + size p - i <= C.c <= max_size){2}); - last by auto; smt ml=0 w=size_ge0. - if=>//;auto;1:smt ml=0 w=size_ge0. - call (_: ={RO.m});1:by sim. - inline *;rcondt{2} 2. - + auto;progress;cut /#:= fcard_image_leq fst (rng G1.handles{hr}). - auto;smt ml=0 w=(hinv_image card_rng_set). - - auto;progress;3:by smt ml=0. - + by rewrite rng_set rem0 rng0 fset0U fcard1. - by apply max_ge0. - qed. - - (* TODO: move this *) - lemma c_gt0r : 0%r < (2^c)%r. - proof. by rewrite from_intM;apply /powPos. qed. - - lemma c_ge0r : 0%r <= (2^c)%r. - proof. by apply /ltrW/c_gt0r. qed. - - local lemma eps_ge0 : 0%r <= (2 * max_size)%r / (2 ^ c)%r. - proof. - apply divr_ge0;1:by rewrite from_intMle;smt ml=0 w=max_ge0. - by apply c_ge0r. - 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 (rng G1.handles)) <= 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 from_intMle;smt ml=0 w=max_ge0. - + proc;sp;if;2:by hoare=>//??;apply eps_ge0. - wp. - rnd (mem (image fst (rng G1.handles)));skip;progress;2:smt ml=0. - rewrite (Mu_mem.mu_mem (image fst (rng G1.handles{hr})) cdistr (1%r/(2^c)%r))//. - + move=>x _;apply DWord.muxP. - rewrite (div_def (2 * _)%r) 1:from_intMeq;1:by apply /IntOrder.lt0r_neq0/powPos. - apply ler_wpmul2r;2:by rewrite from_intMle. - by apply divr_ge0=>//;apply /c_ge0r. - + move=>ci;proc;rcondt 2;auto=>/#. - move=> b c;proc;sp;if;auto;smt ml=0. - qed. - -end section PROOF. -*) - -print RO. - -clone import GenEager as Gen with - type from <- int, - type to <- capacity, - op sampleto <- fun (_:int) => cdistr - proof sampleto_ll by apply DWord.cdistr_ll. - -print RO. -print Functionality.RO. - -op bad_ext (m:('a*'b,'c)fmap) (y:'b) = +op bad_ext (m:smap) y = mem (map snd (elems (dom m))) y. -op hinvc (handles : (int,capacity) fmap) (c : capacity) : handle option = - find (+ pred1 c) handles. +op hinvc (m:(handle,capacity)fmap) (c:capacity) = + find (+ pred1 c) m. - module G2(D:DISTINGUISHER,HS:FRO) = { +module G2(D:DISTINGUISHER,HS:FRO) = { module C = { - + proc f(p : block list): block = { var sa, sa'; var h, i <- 0; @@ -351,7 +26,7 @@ op hinvc (handles : (int,capacity) fmap) (c : capacity) : handle option = (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; } else { HS.sample(G1.chandle); - sa' <@ Functionality.RO.f(take (i+1) p); + 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); @@ -360,21 +35,21 @@ op hinvc (handles : (int,capacity) fmap) (c : capacity) : handle option = } i <- i + 1; } - sa <- Functionality.RO.f(p); + 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 (!mem (dom G1.m) x) { if (mem (dom G1.paths) x.`2) { (p,v) <- oget G1.paths.[x.`2]; - y1 <- Functionality.RO.f (rcons p (v +^ x.`1)); + y1 <- F.RO.get (rcons p (v +^ x.`1)); y2 <$ cdistr; y <- (y1, y2); G1.paths.[y2] <- (rcons p (v +^ x.`1), y.`1); @@ -382,7 +57,7 @@ op hinvc (handles : (int,capacity) fmap) (c : capacity) : handle option = y <$ dstate; } (* exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) - + handles_ <@ HS.restrK(); if (!mem (rng handles_) x.`2) { HS.set(G1.chandle, x.`2); @@ -412,10 +87,10 @@ op hinvc (handles : (int,capacity) fmap) (c : capacity) : handle option = } return y; } - + proc fi(x : state): state = { var y, y1, y2, hx2, hy2, handles_, t; - + if (!mem (dom G1.mi) x) { handles_ <@ HS.restrK(); if (!mem (rng handles_) x.`2) { @@ -447,19 +122,19 @@ op hinvc (handles : (int,capacity) fmap) (c : capacity) : handle option = } return y; } - + } - + proc main(): bool = { var b; - - RO.m <- map0; + + F.RO.m <- map0; G1.m <- map0; G1.mi <- map0; G1.mh <- map0; G1.mhi <- map0; G1.bext <- false; - + (* the empty path is initially known by the adversary to lead to capacity 0^c *) HS.init(); HS.set(0,c0); @@ -470,7 +145,6 @@ op hinvc (handles : (int,capacity) fmap) (c : capacity) : handle option = } }. - section EXT. declare module D: DISTINGUISHER{C, PF, G1, G2}. @@ -478,244 +152,12 @@ section EXT. equiv G1_G2 : G1(D).main ~ G2(D,FRO).main : ={glob D} ==> ={res} /\ G1.bext{1} => (G1.bext{2} \/ exists x h, mem (dom G1.m{2}) x /\ FRO.m{2}.[h] = Some (x.`2, Unknown)). + proof. + proc. + admit. + qed. +end section EXT. - - -col.main -type from, to. - -op sampleto : from -> to distr. -axiom sampleto_ll : forall x, Distr.weight (sampleto x) = 1%r. - - -print Gen. - - clone import - - - - - -module type SAMPLE = { - proc sampleI(h:handle) : unit - proc setD(h:handle, c:capacity) : unit - proc get(h:handle) : capacity - proc in_dom(h:handle,c:caller) : bool - proc restrD() : (handle,capacity)fmap -}. - -module type ADV_SAMPLEH(O:SAMPLE) = { - proc main() : bool -}. - - -module Lsample = { - var handles : (handle, ccapacity)fmap - - proc sampleI(h:handle) = { - var c; - c <$ cdistr; - handles.[h] <- (c,I); - } - - proc setD (h:handle, c:capacity) = { - handles.[h] <- (c,D); - } - - proc in_dom(h:handle, c:caller) = { - return in_dom_with handles h c; - } - - proc restrD() = { - return ( - let m = NewFMap.filter (fun _ (p:ccapacity) => p.`2=D) handles in - NewFMap.map (fun _ (p:ccapacity) => p.`1) m); - } - - proc get(h:handle) = { - var c; - c <$ cdistr; - if (!mem (dom handles) h) { - handles.[h] <- (c,D); - } - return (oget (handles.[h])).`1; - } - -}. - -module Esample = { - var handles : (handle, ccapacity)fmap - - proc sampleI(h:handle) = { - var c; - c <$ cdistr; - handles.[h] <- (c,I); - } - - proc setD (h:handle, c:capacity) = { - handles.[h] <- (c,D); - } - - proc in_dom(h:handle, c:caller) = { - return in_dom_with handles h c; - } - - proc restrD() = { - return ( - let m = NewFMap.filter (fun _ (p:ccapacity) => p.`2=D) handles in - NewFMap.map (fun _ (p:ccapacity) => p.`1) m); - } - - proc get(h:handle) = { - var c; - c <$ cdistr; - if (!mem (dom handles) h || (oget handles.[h]).`2 = I) { - handles.[h] <- (c,D); - } - return (oget (handles.[h])).`1; - } - -}. - -op hinvc (handles : (handle,capacity)fmap) (c : capacity) : handle option = - find (fun _ => pred1 c) handles. - -module G2(D:DISTINGUISHER,HS:SAMPLE) = { - - module C = { - - proc f(p : block list): block = { - var sa, sa'; - var h, i <- 0; - sa <- b0; - if (1 <= size p /\ p <> [b0]) { - while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; - } else { - HS.sampleI(G1.chandle); - sa' <- RO.f(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; - } - i <- i + 1; - } - sa <- RO.f(p); - } - return sa; - } - } - - module S = { - - proc f(x : state): state = { - var p, v, y, y1, y2, hy2, hx2, handles_,t; - - if (!mem (dom G1.m) x) { - if (mem (dom G1.paths) x.`2) { - (p,v) <- oget G1.paths.[x.`2]; - y1 <- RO.f (rcons p (v +^ x.`1)); - y2 <$ cdistr; - y <- (y1, y2); - G1.paths.[y2] <- (rcons p (v +^ x.`1), y.`1); - } else { - y <$ dstate; - } -(* G1.bext <- G1.bext \/ mem (rng handles) (x.`2, I); *) - (* exists x2 h, handles.[h] = Some (X2,I) *) - (* exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) - - handles_ <@ HS.restrD(); - if (!mem (rng handles_) x.`2) { - HS.setD(G1.chandle, x.`2); - G1.chandle <- G1.chandle + 1; - } - handles_ <- HS.restrD(); - hx2 <- oget (hinvc handles_ x.`2); - t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, I); - if (mem (dom G1.mh) (x.`1, hx2) /\ t) { - hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; - y2 <@ HS.get(hy2); - (* bad <- bad \/ mem (map snd (dom G1.m)) y2 *) - -(* bext{1} => bad{2} \/ exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) - y <- (y.`1, y2); - G1.m.[x] <- y; - G1.mi.[y] <- x; - } else { - hy2 <- G1.chandle; - G1.chandle <- G1.chandle + 1; - HS.setD(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); - } - } else { - y <- oget G1.m.[x]; - } - return y; - } - - proc fi(x : state): state = { - var y, y1, y2, hx2, hy2, handles_, t; - - if (!mem (dom G1.mi) x) { - (* bext <- bext \/ mem (rng handles) (x.`2, I); *) - (* exists x2 h, handles.[h] = Some (X2,I) *) - handles_ <@ HS.restrD(); - if (!mem (rng handles_) x.`2) { - HS.setD(G1.chandle, x.`2); - G1.chandle <- G1.chandle + 1; - } - handles_ <@ HS.restrD(); - hx2 <- oget (hinvc handles_ x.`2); - y <$ dstate; - t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, I); - if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { - (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; - y2 <@ HS.get(hy2); - y <- (y.`1, y2); - (* bad <- bad \/ mem X2 y.`2; *) - G1.mi.[x] <- y; - G1.m.[y] <- x; - } else { - hy2 <- G1.chandle; - G1.chandle <- G1.chandle + 1; - HS.setD(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 main(): bool = { - var b; - - RO.m <- map0; - G1.m <- map0; - G1.mi <- map0; - G1.mh <- map0; - G1.mhi <- map0; - G1.bext <- false; - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - HS.setD(0,c0); - G1.paths <- map0.[c0 <- ([<:block>],b0)]; - G1.chandle <- 1; - b <@ D(C,S).distinguish(); - return b; - } -}. -*) \ No newline at end of file + diff --git a/sha3/proof/old/Gcol.eca b/sha3/proof/old/Gcol.eca new file mode 100644 index 0000000..24778fd --- /dev/null +++ b/sha3/proof/old/Gcol.eca @@ -0,0 +1,321 @@ +require import Pred Fun Option Pair Int Real RealExtra StdOrder Ring StdBigop. +require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. +(*...*) import Dprod Dexcepted Capacity IntOrder Bigreal RealOrder BRA. + +require (*..*) Handle. + +clone export Handle as Handle0. + export ROhandle. + +(* -------------------------------------------------------------------------- *) + +section PROOF. + declare module D: DISTINGUISHER{C, PF, G1}. + + 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 (rng FRO.m)) <= 2*max_size /\ + count < max_size) { + c <$ cdistr; + G1.bcol <- G1.bcol \/ mem (image fst (rng FRO.m)) c; + count <- count + 1; + } + + return c; + } + + module C = { + + proc f(p : block list): block = { + var sa, sa', sc; + var h, i <- 0; + sa <- b0; + if (1 <= size p /\ p <> [b0]) { + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + 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; + } + 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 (!mem (dom G1.m) x) { + if (!(mem (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 (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + y1 <- F.RO.get (rcons p (v +^ x.`1)); + y2 <@ sample_c(); + y <- (y1, y2); + G1.paths.[y2] <- (rcons p (v +^ x.`1), y.`1); + } else { + y1 <$ bdistr; + y2 <@ sample_c(); + y <- (y1,y2); + } + if (mem (dom G1.mh) (x.`1, hx2) /\ + 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); + } + } else { + y <- oget G1.m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2, hx2, hy2; + + if (!mem (dom G1.mi) x) { + if (!(mem (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 (mem (dom G1.mhi) (x.`1, hx2) /\ + 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 <- map0; + G1.m <- map0; + G1.mi <- map0; + G1.mh <- map0; + G1.mhi <- map0; + G1.bcol <- false; + + FRO.m <- map0.[0 <- (c0, Known)]; + G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.chandle <- 1; + count <- 0; + b <@ DRestr(D,C,S).distinguish(); + return b; + } + }. + + lemma card_rng_set (m:('a,'b)fmap) x y: card(rng m.[x<-y]) <= card(rng m) + 1. + proof. + rewrite rng_set fcardU fcard1. + cut := subset_leq_fcard (rng (rem x m)) (rng m) _;2:smt ml=0 w=fcard_ge0. + rewrite subsetP=> z;apply rng_rem_le. + qed. + + lemma hinv_image handles c: + hinv handles c <> None => + mem (image fst (rng handles)) c. + proof. + case: (hinv handles c) (hinvP handles c)=>//= h[f] Heq. + rewrite imageP;exists (c,f)=>@/fst/=. + by rewrite in_rng;exists (oget (Some h)). + qed. + + local equiv G1col : 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}/\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (rng 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. + seq 2 2 : (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + C.c,x0} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card(rng FRO.m) + 2 <= 2*C.c + 1/\ + Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. + if=>//;last by auto=>/#. + swap{1}[2..4]-1. + seq 3 2:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + C.c,x0,hx2} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (rng FRO.m) + 1 <= 2 * C.c + 1/\ + Gcol.count + 1 <= C.c <= max_size){2}). + + auto;smt ml=0 w=card_rng_set. + seq 1 1: + (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + C.c,x0,hx2,y0} /\ + ((G1.bcol\/hinv FRO.m y0.`2 <> None){1} => G1.bcol{2}) /\ + (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ + Gcol.count <= C.c <= max_size){2});last by auto;smt ml=0 w=card_rng_set. + if=>//;inline Gcol.sample_c. + + rcondt{2}4. + + auto;conseq (_:true)=>//;progress;2: smt ml=0. + cut /#:= fcard_image_leq fst (rng FRO.m{hr}). + wp;conseq (_: ={p,v,F.RO.m,y1} /\ y2{1}=c{2})=>//;1:smt ml=0 w=hinv_image. + sim. + rcondt{2}3. + + by auto;progress;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). + swap{2}2-1;sp 0 1;wp;conseq(_:y0{1}=(y1,c){2})=>//;1:smt ml=0 w=hinv_image. + transitivity{1} {y0 <- S.sample();} + (true ==> ={y0}) + (true ==> y0{1}=(y1,c){2})=>//;1:by inline*;auto. + transitivity{2} {(y1,c) <- S.sample2();} + (true==>y0{1}=(y1,c){2}) + (true==> ={y1,c})=>//;2:by inline*;auto. + by call sample_sample2;auto=> /=?[??]->. + + + proc;sp 1 1;if=>//. + inline G1(DRestr(D)).S.fi Gcol.S.fi. + seq 2 2 : (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + C.c,x0} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card(rng FRO.m) + 2 <= 2*C.c + 1 /\ + Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. + if=>//;last by auto=>/#. + seq 3 2:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + C.c,x0,hx2} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ + Gcol.count + 1 <= C.c <= max_size){2}). + + by auto;smt ml=0 w=card_rng_set. + seq 1 2: + (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + C.c,x0,hx2} /\ y0{1} = (y1,y2){2} /\ + ((G1.bcol\/hinv FRO.m y0.`2 <> None){1} => G1.bcol{2}) /\ + (card (rng 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;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). + swap{2}2-1;sp 0 1;wp;conseq(_:y0{1}=(y1,c){2})=>//;1:smt ml=0 w=hinv_image. + transitivity{1} {y0 <- S.sample();} + (true ==> ={y0}) + (true ==> y0{1}=(y1,c){2})=>//;1:by inline*;auto. + transitivity{2} {(y1,c) <- S.sample2();} + (true==>y0{1}=(y1,c){2}) + (true==> ={y1,c})=>//;2:by inline*;auto. + by call sample_sample2;auto=> /=?[??]->. + + + proc;sp 1 1;if=>//. + inline G1(DRestr(D)).C.f Gcol.C.f. + seq 5 5: + (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c,b, + p,h,i,sa} /\ i{1}=0 /\ + (G1.bcol{1} => G1.bcol{2}) /\ + card (rng FRO.m{2}) + 2*(size p{2}) <= 2 * C.c{2} + 1 /\ + Gcol.count{2} + size p{2} <= C.c{2} <= max_size);1:by auto=>/#. + wp;if=>//;2:by auto;smt ml=0 w=size_ge0. + call (_: ={F.RO.m});1:by sim. + 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} /\ (i <= size p){1} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (rng FRO.m) + 2*(size p - i) <= 2 * C.c + 1 /\ + Gcol.count + size p - i <= C.c <= max_size){2}); + last by auto; smt ml=0 w=size_ge0. + if=>//;auto;1:smt ml=0 w=size_ge0. + call (_: ={F.RO.m});1:by sim. + inline *;rcondt{2} 2. + + auto;progress;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). + auto;smt ml=0 w=(hinv_image card_rng_set). + + auto;progress;3:by smt ml=0. + + by rewrite rng_set rem0 rng0 fset0U fcard1. + by apply max_ge0. + qed. + + (* TODO: move this *) + lemma c_gt0r : 0%r < (2^c)%r. + proof. by rewrite lt_fromint;apply /powPos. qed. + + lemma c_ge0r : 0%r <= (2^c)%r. + proof. by apply /ltrW/c_gt0r. qed. + + local 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. + + 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 (rng 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 (rng FRO.m)));skip;progress;2:smt ml=0. + rewrite (Mu_mem.mu_mem (image fst (rng FRO.m{hr})) cdistr (1%r/(2^c)%r))//. + + move=>x _;apply DWord.muxP. + 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. + +end section PROOF. + + diff --git a/sha3/proof/old/Handle.eca b/sha3/proof/old/Handle.eca index d5deb5c..b93dea6 100644 --- a/sha3/proof/old/Handle.eca +++ b/sha3/proof/old/Handle.eca @@ -4,22 +4,19 @@ require import List FSet NewFMap Utils Common SLCommon RndO. require ConcreteF. -clone import GenEager as Gen with +clone import GenEager as ROhandle with type from <- handle, type to <- capacity, op sampleto <- fun (_:int) => cdistr proof sampleto_ll by apply DWord.cdistr_ll. -print hinv. module G1(D:DISTINGUISHER) = { var m, mi : smap var mh, mhi : hsmap - var handles : handles var chandle : int var paths : (capacity, block list * block) fmap var bext, bcol : bool - module C = { proc f(p : block list): block = { @@ -32,18 +29,18 @@ module G1(D:DISTINGUISHER) = { (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; } else { sc <$ cdistr; - bcol <- bcol \/ hinv handles sc <> None; - sa' <@ RO.f(take (i+1) p); + 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); - handles.[chandle] <- (sc,I); + FRO.m.[chandle] <- (sc,Unknown); chandle <- chandle + 1; } i <- i + 1; } - sa <- RO.f(p); + sa <- F.RO.get(p); } return sa; } @@ -57,32 +54,32 @@ module G1(D:DISTINGUISHER) = { if (!mem (dom m) x) { if (mem (dom paths) x.`2) { (p,v) <- oget paths.[x.`2]; - y1 <- RO.f (rcons p (v +^ x.`1)); + y1 <- F.RO.get (rcons p (v +^ x.`1)); y2 <$ cdistr; y <- (y1, y2); paths.[y2] <- (rcons p (v +^ x.`1), y.`1); } else { y <$ dstate; } - bext <- bext \/ mem (rng handles) (x.`2, I); + bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); (* exists x2 h, handles.[h] = Some (X2,I) *) - if (!(mem (rng handles) (x.`2, D))) { - handles.[chandle] <- (x.`2, D); + if (!(mem (rng FRO.m) (x.`2, Known))) { + FRO.m.[chandle] <- (x.`2, Known); chandle <- chandle + 1; } - hx2 <- oget (hinvD handles x.`2); - if (mem (dom mh) (x.`1, hx2) /\ in_dom_with handles (oget mh.[(x.`1,hx2)]).`2 I) { + hx2 <- oget (hinvK FRO.m x.`2); + if (mem (dom mh) (x.`1, hx2) /\ in_dom_with FRO.m (oget mh.[(x.`1,hx2)]).`2 Unknown) { hy2 <- (oget mh.[(x.`1, hx2)]).`2; - y <- (y.`1, (oget handles.[hy2]).`1); - handles.[hy2] <- (y.`2, D); + y <- (y.`1, (oget FRO.m.[hy2]).`1); + FRO.m.[hy2] <- (y.`2, Known); (* bad <- bad \/ mem X2 y.`2; *) m.[x] <- y; mi.[y] <- x; } else { - bcol <- bcol \/ hinv handles y.`2 <> None; + bcol <- bcol \/ hinv FRO.m y.`2 <> None; hy2 <- chandle; chandle <- chandle + 1; - handles.[hy2] <- (y.`2, D); + FRO.m.[hy2] <- (y.`2, Known); m.[x] <- y; mh.[(x.`1, hx2)] <- (y.`1, hy2); mi.[y] <- x; @@ -98,27 +95,27 @@ module G1(D:DISTINGUISHER) = { var y, y1, hx2, hy2; if (!mem (dom mi) x) { - bext <- bext \/ mem (rng handles) (x.`2, I); + bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); (* exists x2 h, handles.[h] = Some (X2,I) *) - if (!(mem (rng handles) (x.`2, D))) { - handles.[chandle] <- (x.`2, D); + if (!(mem (rng FRO.m) (x.`2, Known))) { + FRO.m.[chandle] <- (x.`2, Known); chandle <- chandle + 1; } - hx2 <- oget (hinvD handles x.`2); + hx2 <- oget (hinvK FRO.m x.`2); y <$ dstate; if (mem (dom mhi) (x.`1,hx2) /\ - in_dom_with handles (oget mhi.[(x.`1,hx2)]).`2 I) { + in_dom_with FRO.m (oget mhi.[(x.`1,hx2)]).`2 Unknown) { (y1,hy2) <- oget mhi.[(x.`1, hx2)]; - y <- (y.`1, (oget handles.[hy2]).`1); - handles.[hy2] <- (y.`2, D); + y <- (y.`1, (oget FRO.m.[hy2]).`1); + FRO.m.[hy2] <- (y.`2, Known); (* bad <- bad \/ mem X2 y.`2; *) mi.[x] <- y; m.[y] <- x; } else { - bcol <- bcol \/ hinv handles y.`2 <> None; + bcol <- bcol \/ hinv FRO.m y.`2 <> None; hy2 <- chandle; chandle <- chandle + 1; - handles.[hy2] <- (y.`2, D); + FRO.m.[hy2] <- (y.`2, Known); mi.[x] <- y; mhi.[(x.`1, hx2)] <- (y.`1, hy2); m.[y] <- x; @@ -135,7 +132,7 @@ module G1(D:DISTINGUISHER) = { proc main(): bool = { var b; - RO.m <- map0; + F.RO.m <- map0; m <- map0; mi <- map0; mh <- map0; @@ -144,7 +141,7 @@ module G1(D:DISTINGUISHER) = { bcol <- false; (* the empty path is initially known by the adversary to lead to capacity 0^c *) - handles <- map0.[0 <- (c0, D)]; + FRO.m <- map0.[0 <- (c0, Known)]; paths <- map0.[c0 <- ([<:block>],b0)]; chandle <- 1; b <@ D(C,S).distinguish(); @@ -171,7 +168,7 @@ op mh_spec (handles:handles) (m2:smap) (mh:hsmap) (ro:(block list, block)fmap) = exists c f c' f', handles.[bh .`2]=Some(c,f) /\ handles.[bh'.`2]=Some(c',f') /\ - if f' = D then m2.[(bh.`1,c)] = Some(bh'.`1,c') /\ f = D + if f' = Known then m2.[(bh.`1,c)] = Some(bh'.`1,c') /\ f = Known else exists p v b, ro.[rcons p b] = Some bh'.`1 /\ @@ -186,10 +183,10 @@ op paths_spec (handles:handles) (mh:hsmap) (paths:(capacity,block list * block)f forall c p v, paths.[c] = Some(p,v) <=> exists h, build_hpath mh p = Some(v,h) /\ - handles.[h] = Some(c,D). + handles.[h] = Some(c,Known). op handles_spec handles chandle = - huniq handles /\ handles.[0] = Some (c0,D) /\ forall h, mem (dom handles) h => h < chandle. + huniq handles /\ handles.[0] = Some (c0,Known) /\ forall h, mem (dom handles) h => h < chandle. op INV_CF_G1 (handles:handles) chandle (m1 mi1 m2 mi2:smap) (mh2 mhi2:hsmap) (ro:(block list, block) fmap) paths = (eqm_handles handles m1 mh2 /\ eqm_handles handles mi1 mhi2) /\ @@ -215,7 +212,7 @@ proof. move=> Hh;apply /IntOrder.ltr_eqF/(chandle_ge0 _ _ Hh). qed. lemma eqm_up_handles handles chandle m mh x2 : handles_spec handles chandle => eqm_handles handles m mh => - eqm_handles handles.[chandle <- (x2, D)] m mh. + eqm_handles handles.[chandle <- (x2, Known)] m mh. proof. move=> []Hu[Hh0 Hlt][]H1 H2;split=> [bc bc'/H1 [h h' f f'][]Hh[]Hh' Hmh| bh bh'/H2 [c c' f f'][]Hh []Hh' Hm]. @@ -257,7 +254,7 @@ proof. qed. lemma handles_up_handles handles chandle x2 f': - (forall (f : caller), ! mem (rng handles) (x2, f)) => + (forall (f : flag), ! mem (rng handles) (x2, f)) => handles_spec handles chandle => handles_spec handles.[chandle <- (x2, f')] (chandle + 1). proof. @@ -276,7 +273,7 @@ qed. lemma INV_CF_G1_up_handles handles chandle m1 mi1 m2 mi2 mh mhi ro paths x2: INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh mhi ro paths => (forall f, ! mem (rng handles) (x2, f)) => - INV_CF_G1 handles.[chandle <- (x2, D)](chandle+1) m1 mi1 m2 mi2 mh mhi ro paths. + INV_CF_G1 handles.[chandle <- (x2, Known)](chandle+1) m1 mi1 m2 mi2 mh mhi ro paths. proof. move=>[][]Heqm Heqmi[]Hincl[]Hmh[]Hp Hh Hx2;split. + by split;apply eqm_up_handles. @@ -300,7 +297,9 @@ section AUX. ={glob D} ==> !(G1.bcol \/ G1.bext){2} => ={res}. proof. proc. - call (_:(G1.bcol \/ G1.bext), INV_CF_G1 G1.handles{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} RO.m{2} G1.paths{2}). + call (_:(G1.bcol \/ G1.bext), + 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}). (* lossless D *) + apply D_ll. (** proofs for G1.S.f *) @@ -310,58 +309,59 @@ section AUX. + rcondt{2} 1. + move=> &hr;skip=> &hr'[][]_[]<-[]_[][]Hincl Hincli _. rewrite !in_dom/==>H; by case:(G1.m{hr'}.[x{hr}]) (Hincl x{hr})=> //=;rewrite H. - exists* RO.m{2}, G1.paths{2};elim*=>ro0 paths0. - seq 1 2 : (!G1.bcol{2} /\ (G1.bext = mem (rng G1.handles) (x.`2, I)){2} /\ + exists* F.RO.m{2}, G1.paths{2};elim*=>ro0 paths0. + seq 1 2 : (!G1.bcol{2} /\ (G1.bext = mem (rng FRO.m) (x.`2, Unknown)){2} /\ ={x,y} /\ - INV_CF_G1 G1.handles{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} ro0 paths0 /\ + 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} ro0 paths0 /\ ! mem (dom PF.m{1}) x{1} /\ (if mem (dom paths0) x.`2 then let (p,v) = oget paths0.[x.`2] in - RO.m{2} = ro0.[rcons p (v+^x.`1) <- y.`1] /\ + F.RO.m{2} = ro0.[rcons p (v+^x.`1) <- y.`1] /\ G1.paths = paths0.[y.`2 <- (rcons p (v +^ x.`1), y.`1)] - else RO.m = ro0 /\ G1.paths = paths0){2}). + else F.RO.m = ro0 /\ G1.paths = paths0){2}). + wp 1 1;conseq (_: ={y} /\ if mem (dom paths0) x{2}.`2 then let (p0, v0) = oget paths0.[x{2}.`2] in - RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ + F.RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ G1.paths{2} = paths0.[y{2}.`2 <- (rcons p0 (v0 +^ x{2}.`1), y{2}.`1)] - else RO.m{2} = ro0 /\ G1.paths{2} = paths0);1:smt ml=0. + else F.RO.m{2} = ro0 /\ G1.paths{2} = paths0);1:smt ml=0. if{2};2:by auto=>/#. - inline{2} RO.f;rcondt{2} 4. + inline{2} F.RO.get;rcondt{2} 4. + move=> &ml;auto=>/= &mr[][]_[][]_[]->[][][]_ Heqm _[]_[][]_ Hro[] Hpath _ HnPFm. rewrite in_dom;case:(G1.paths{mr}.[_]) (Hpath x{mr}.`2)=>//[[p v]]/(_ p v)/=[h][]Hbu Hh b _. rewrite -not_def=> /Hro [??h'];rewrite oget_some Hbu => -[][]<- <- /=. rewrite Block.xorwA Block.xorwK Block.xorwC Block.xorw0 -not_def=>/Heqm [c c' f f']. by rewrite Hh=> -[][]<- _[]_ Hm;move:HnPFm;rewrite in_dom;case:(x{mr}) Hm=> ??->. - swap{2} 3-2;swap{2}6-4;wp;conseq (_:y{1} =(rd,y2){2}). + swap{2} 3-2;swap{2}6-4;wp;conseq (_:y{1} =(r,y2){2}). + progress [-split];rewrite getP_eq oget_some H2/=. by move:H2;rewrite in_dom;case:(G1.paths{2}.[_]). - transitivity{1} {y <- S.sample();} (true ==> ={y}) (true==>y{1}=(rd,y2){2})=>//;1:by inline*;auto. - transitivity{2} {(rd,y2) <- S.sample2();} (true==>y{1}=(rd,y2){2}) (true==> ={rd,y2})=>//;2:by inline*;auto. + transitivity{1} {y <- S.sample();} (true ==> ={y}) (true==>y{1}=(r,y2){2})=>//;1:by inline*;auto. + transitivity{2} {(r,y2) <- S.sample2();} (true==>y{1}=(r,y2){2}) (true==> ={r,y2})=>//;2:by inline*;auto. by call sample_sample2;auto=> /=?[??]->. - case (mem (rng G1.handles{2}) (x{2}.`2, I)). + case (mem (rng FRO.m{2}) (x{2}.`2, Unknown)). + conseq (_:true);[by move=> ??[][]_[]->_->|auto]. conseq (_: !G1.bcol{2} => oget PF.m{1}.[x{1}] = y{2} /\ - INV_CF_G1 G1.handles{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} RO.m{2} G1.paths{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}). + by move=> ??[][]_[]->[][]-> _ _ ->. seq 0 2: ((!G1.bcol{2} /\ ={x, y} /\ - INV_CF_G1 G1.handles{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{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} ro0 paths0 /\ ! mem (dom PF.m{1}) x{1} /\ if mem (dom paths0) x{2}.`2 then let (p0, v0) = oget paths0.[x{2}.`2] in - RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ + F.RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ G1.paths{2} = paths0.[y{2}.`2 <- (rcons p0 (v0 +^ x{2}.`1), y{2}.`1)] - else RO.m{2} = ro0 /\ G1.paths{2} = paths0) /\ - !mem (rng G1.handles{2}) (x{2}.`2, I) /\ - (G1.handles.[hx2]=Some(x.`2,D)){2}). + else F.RO.m{2} = ro0 /\ G1.paths{2} = paths0) /\ + !mem (rng FRO.m{2}) (x{2}.`2, Unknown) /\ + (FRO.m.[hx2]=Some(x.`2,Known)){2}). + auto=> &ml&mr[][]->[]_[][]-> ->[]Hinv []-> -> ^Hrng-> /=. - case (mem (rng G1.handles{mr}) (x{mr}.`2, D))=> Hmem /=. - + by split=>//;apply /huniq_hinvD=>//;move:Hinv;rewrite /INV_CF_G1/handles_spec. + case (mem (rng FRO.m{mr}) (x{mr}.`2, Known))=> Hmem /=. + + by split=>//;apply /huniq_hinvK=>//;move:Hinv;rewrite /INV_CF_G1/handles_spec. rewrite -anda_and;split=> [ | {Hinv}Hinv]. + by apply INV_CF_G1_up_handles=>//[[]]. - rewrite rng_set (huniq_hinvD_h G1.chandle{mr}) ?getP//. + rewrite rng_set (huniq_hinvK_h G1.chandle{mr}) ?getP//. + by move:Hinv;rewrite /INV_CF_G1/handles_spec. by rewrite oget_some /=!inE/=;move:Hrng;apply NewLogic.contraLR=>/=;apply rng_rem_le. rcondf{2} 1. @@ -398,7 +398,7 @@ end section AUX. section. - declare module D: DISTINGUISHER{Perm, C, PF, G1}. + declare module D: DISTINGUISHER{Perm, C, PF, G1, RO}. axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): islossless P.f => islossless P.fi => @@ -406,7 +406,7 @@ section. lemma Real_G1 &m: Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= - Pr[G1(DRestr(D)).main() @ &m: res] + bound_concrete + + Pr[G1(DRestr(D)).main() @ &m: res] + ((max_size + 1) ^ 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 D_ll &m)). diff --git a/sha3/proof/old/SLCommon.ec b/sha3/proof/old/SLCommon.ec index 280bcc9..468adc5 100644 --- a/sha3/proof/old/SLCommon.ec +++ b/sha3/proof/old/SLCommon.ec @@ -19,7 +19,6 @@ clone include Indifferentiability with 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. @@ -74,8 +73,6 @@ op incl (m m':('a,'b)fmap) = (* -------------------------------------------------------------------------- *) (** usefull type and operators for the proof **) -type caller = [ I | D ]. - type handle = int. type hstate = block * handle. @@ -86,14 +83,6 @@ type smap = (state , state ) fmap. type hsmap = (hstate, hstate ) fmap. type handles = (handle, ccapacity) fmap. -(* Did we use it? *) -op (<=) (o1 o2 : caller) = o1 = I \/ o2 = D. - -(* Did we use it? *) -op max (o1 o2 : caller) = - with o1 = I => o2 - with o1 = D => D. - pred is_pre_permutation (m mi : ('a,'a) fmap) = (forall x, mem (rng m) x => mem (dom mi) x) /\ (forall x, mem (rng mi) x => mem (dom m) x). From 59c1b7d4e3bca7cdaff922e613ccee1e8a2ddd83 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Wed, 20 Jan 2016 15:32:36 +0100 Subject: [PATCH 113/394] push for the others --- sha3/proof/RndO.ec | 5 +- sha3/proof/old/G2.eca | 319 +++++++++++++++++++++++++++++++++++-- sha3/proof/old/SLCommon.ec | 12 +- 3 files changed, 313 insertions(+), 23 deletions(-) diff --git a/sha3/proof/RndO.ec b/sha3/proof/RndO.ec index 4bf405c..a8c21dc 100644 --- a/sha3/proof/RndO.ec +++ b/sha3/proof/RndO.ec @@ -1,3 +1,4 @@ +pragma -oldip. require import Pair Option List FSet NewFMap. import NewLogic Fun. require IterProc. @@ -447,7 +448,7 @@ proof. { Iter(RRO.I).iter_1s(x,elems (dom (restr Unknown FRO.m) `\` fset1 x)); } (={x,FRO.m}/\(in_dom_with FRO.m x Unknown){1}==> ={x,FRO.m}) (={x,FRO.m}/\ (in_dom_with FRO.m x Unknown){1} ==> (rem x FRO.m){1} = FRO.m{2})=>//. - + by move=>?&mr[*]2!->_;exists FRO.m{mr}, x{mr}. + + by move=>?&mr[*]2!->?;exists FRO.m{mr}, x{mr}. + symmetry;call (iter1_perm RRO.I iter_perm2);skip=>?&mr[*]2!->?/=;split=>//. by apply /perm_eq_sym/perm_to_rem/dom_restr. inline{1}Iter(RRO.I).iter_1s. @@ -496,7 +497,7 @@ proof. eager proc;inline *;wp. while (={l,FRO.m} /\ (forall z, mem l z => in_dom_with FRO.m z Unknown){1} /\ restr Known FRO.m{1} = result{2}). - + auto=>?&mr[*]2!->Hz<-?_/=?->/=. + + auto=>?&mr[*]2!->Hz<-?H/=?->/=. split=>[z /mem_drop Hm|];1:by rewrite /in_dom_with dom_set getP !inE /#. rewrite restr_set rem_id?dom_restr//. by move:H=>/(mem_head_behead witness) /(_ (head witness l{mr})) /= /Hz /#. diff --git a/sha3/proof/old/G2.eca b/sha3/proof/old/G2.eca index 8dda61d..c1464d0 100644 --- a/sha3/proof/old/G2.eca +++ b/sha3/proof/old/G2.eca @@ -1,3 +1,4 @@ +pragma -oldip. require import Pred Fun Option Pair Int Real RealExtra StdOrder Ring StdBigop. require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. (*...*) import Dprod Dexcepted Capacity IntOrder Bigreal RealOrder BRA. @@ -7,7 +8,8 @@ require (*..*) Gcol. clone export Gcol as Gcol0. op bad_ext (m:smap) y = - mem (map snd (elems (dom m))) y. + mem (map snd (elems (dom m))) y \/ + mem (map snd (elems (rng m))) y. op hinvc (m:(handle,capacity)fmap) (c:capacity) = find (+ pred1 c) m. @@ -31,7 +33,7 @@ module G2(D:DISTINGUISHER,HS:FRO) = { G1.mh.[(sa,h)] <- (sa', G1.chandle); G1.mhi.[(sa',G1.chandle)] <- (sa, h); (sa,h) <- (sa',G1.chandle); - G1.chandle <- G1.chandle + 1; + G1.chandle <- G1.chandle + 1; } i <- i + 1; } @@ -69,7 +71,7 @@ module G2(D:DISTINGUISHER,HS:FRO) = { if (mem (dom G1.mh) (x.`1, hx2) /\ t) { hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; y2 <@ HS.get(hy2); - G1.bext <- G1.bext \/ bad_ext G1.m y2; + G1.bext <- G1.bext \/ bad_ext G1.m y2 \/ y2 = x.`2; y <- (y.`1, y2); G1.m.[x] <- y; G1.mi.[y] <- x; @@ -100,12 +102,12 @@ module G2(D:DISTINGUISHER,HS:FRO) = { handles_ <@ HS.restrK(); hx2 <- oget (hinvc handles_ x.`2); y <$ dstate; - t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); + t <@ HS.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); if (mem (dom G1.mhi) (x.`1, hx2) /\ 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 y2; + G1.bext <- G1.bext \/ bad_ext G1.m y2 \/ y2 = x.`2; G1.mi.[x] <- y; G1.m.[y] <- x; } else { @@ -125,7 +127,7 @@ module G2(D:DISTINGUISHER,HS:FRO) = { } - proc main(): bool = { + proc distinguish(): bool = { var b; F.RO.m <- map0; @@ -136,7 +138,6 @@ module G2(D:DISTINGUISHER,HS:FRO) = { G1.bext <- false; (* the empty path is initially known by the adversary to lead to capacity 0^c *) - HS.init(); HS.set(0,c0); G1.paths <- map0.[c0 <- ([<:block>],b0)]; G1.chandle <- 1; @@ -145,18 +146,308 @@ module G2(D:DISTINGUISHER,HS:FRO) = { } }. -section EXT. +section. - declare module D: DISTINGUISHER{C, PF, G1, G2}. - - equiv G1_G2 : G1(D).main ~ G2(D,FRO).main : - ={glob D} ==> ={res} /\ G1.bext{1} => (G1.bext{2} \/ - exists x h, mem (dom G1.m{2}) x /\ FRO.m{2}.[h] = Some (x.`2, Unknown)). + declare module D: DISTINGUISHER{G1, G2, FRO}. + + op inv_ext1 bext1 bext2 (G1m:smap) (FROm:handles) = + bext1 => (bext2 \/ exists x h, mem (dom G1m `|` rng G1m) x /\ FROm.[h] = Some (x.`2, Unknown)). + + lemma rng_restr (m : ('from, 'to * 'flag) fmap) f x: + mem (rng (restr f m)) x <=> mem (rng m) (x,f). proof. - proc. + rewrite !in_rng;split=>-[z]H;exists z;move:H;rewrite restrP; case m.[z]=>//=. + by move=> [t f'] /=;case (f'=f). + qed. + + equiv G1_G2 : G1(D).main ~ Eager(G2(D)).main1 : + ={glob D} ==> ={res} /\ inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} FRO.m{2}. + proof. + proc;inline{2} FRO.init G2(D, FRO).distinguish;wp. + call (_: ={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} FRO.m{2} /\ + (forall h, mem (dom FRO.m) h => h < G1.chandle){1}). + + proc;if=>//;last by auto. + seq 1 1: (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,x,y} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} FRO.m{2} /\ + (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ + ! mem (dom G1.m{1}) x{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,y,hx2} /\ + t{2} = (in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1} /\ + (G1.bext{1} => (G1.bext{2} \/ (mem (rng FRO.m) (x.`2, Unknown)){2} \/ + exists x h, mem (dom G1.m{2} `|` rng G1.m{2}) x /\ + FRO.m{2}.[h] = Some (x.`2, Unknown))) /\ + (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ + ! mem (dom G1.m{1}) x{1}). + + inline *;auto=> &ml&mr[*]10!-> Hi Hhand -> /=. + rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. + + rewrite rng_set !inE rem_id 1:/#;move:H0=>[/Hi[->|[x' h][]H1 H2]|->]//. + right;right;exists x', h;rewrite getP. + by cut ->//:(h<> G1.chandle{mr});move:(Hhand h);rewrite in_dom H2 /#. + by move:H0;rewrite dom_set !inE /#. + if=>//. + + inline *;rcondt{2} 4. + + by move=> &m;auto;rewrite /in_dom_with. + auto;progress. + + by apply DWord.cdistr_ll. + + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. + + case (h = (oget G1.mh{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + + by left;rewrite Hh oget_some. + by right;exists x{2}, h;rewrite dom_set getP Hneq !inE. + case (h = (oget G1.mh{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + rewrite Hh /bad_ext oget_some /= !mem_map_snd. + by left;right;left <@ Hx;rewrite !inE=>-[|]Hx;[left|right];exists x1; + rewrite -memE. + right;exists (x1,x2), h;rewrite dom_set rng_set getP Hneq rem_id //=. + by move:Hx;rewrite !inE Hh=>-[]->. + by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. + inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. + rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. + + right;exists x{2}, h;rewrite getP dom_set !inE /=. + by move:(H0 h);rewrite in_dom Hh /#. + right;exists x', h;rewrite getP dom_set !inE. + move:(H0 h) Hx;rewrite in_dom rng_set Hh !inE rem_id //= /#. + + + proc;if=>//;last by auto. + seq 4 6: + (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,hx2,x,y,hx2} /\ + t{2} = (in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1} /\ + (G1.bext{1} => (G1.bext{2} \/ (mem (rng FRO.m) (x.`2, Unknown)){2} \/ + exists x h, mem (dom G1.m{2} `|` rng G1.m{2}) x /\ + FRO.m{2}.[h] = Some (x.`2, Unknown))) /\ + (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ + ! mem (dom G1.mi{1}) x{1}). + + inline *;auto=> &ml&mr[*]9!-> Hi Hhand -> /=. + rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. + + rewrite rng_set !inE rem_id 1:/#;move:H2=>[/Hi[->|[x' h][]HH1 HH2]|->]//. + right;right;exists x', h;rewrite getP. + by cut ->//:(h<> G1.chandle{mr});move:(Hhand h);rewrite in_dom HH2 /#. + by move:H2;rewrite dom_set !inE /#. + if=>//. + + inline *;rcondt{2} 4. + + by move=> &m;auto;rewrite /in_dom_with. + auto;progress. + + by apply DWord.cdistr_ll. + + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. + + case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq /=]. + + by left;rewrite Hh oget_some. + by right;exists x{2}, h;rewrite rng_set getP Hneq !inE. + case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + rewrite Hh /bad_ext oget_some /= !mem_map_snd. + by left;right;left <@ Hx;rewrite !inE=>-[|]?;[left|right]; + exists x1;rewrite -memE. + right;exists (x1,x2), h;rewrite dom_set rng_set getP Hneq !inE Hh /= rng_rem. + move:Hx;rewrite !inE in_rng. + + +search mem rng. +print rngP. + + case ((x1,x2) = + (y{2}.`1, (oget FRO.m{2}.[(oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2]).`1))=> + [/=->//|Hneq']. + right;left;exists (x1,x2);rewrite Hneq'. + move:Hx;rewrite inE in_rng=>-[->//|[[a1 a2]]] /#. +search mem rng. +search rng rem. + Hh. + Hx. + by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. + inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. + rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. + + right;exists x{2}, h;rewrite getP dom_set !inE /=. + by move:(H0 h);rewrite in_dom Hh /#. + right;exists x', h;rewrite getP dom_set !inE. + by move:(H0 h);rewrite in_dom Hh Hx /#. + + + + (************) + inline*;auto. + + auto=> //. +sim. admit. qed. + equiv Eager_1_2: Eager(G2(D)).main1 ~ Eager(G2(D)).main2 : + ={glob G2(D)} ==> ={G1.m,FRO.m,G1.bext}. + proof. by conseq (Eager_1_2 (G2(D))). qed. + +end section. + +section EXT. + + declare module D: DISTINGUISHER{C, PF, G1, G2 }. + + local module ReSample = { + var count:int + proc f (x:handle) = { + var c; + c <$ cdistr; + if (card (dom G1.m) < max_size /\ count < max_size) { + G1.bext <- G1.bext \/ bad_ext G1.m c; + FRO.m.[x] <- (c,Unknown); + } + } + }. + + local module Gext = { + + proc resample () = { + Iter(ReSample).iter (elems (dom (restr Unknown FRO.m))); + } + + module C = { + + proc f(p : block list): block = { + var sa, sa'; + var h, i <- 0; + sa <- b0; + if (1 <= size p /\ p <> [b0]) { + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + 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; + } + 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 (!mem (dom G1.m) x) { + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + y1 <- F.RO.get (rcons p (v +^ x.`1)); + y2 <$ cdistr; + y <- (y1, y2); + G1.paths.[y2] <- (rcons p (v +^ x.`1), y.`1); + } else { + y <$ dstate; + } + (* exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) + + handles_ <@ RRO.restrK(); + if (!mem (rng handles_) x.`2) { + RRO.set(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <- RRO.restrK(); + hx2 <- oget (hinvc handles_ x.`2); + t <@ RRO.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); + if (mem (dom G1.mh) (x.`1, hx2) /\ t) { + hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; + ReSample.f(hy2); + y2 <@ RRO.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); + } + } else { + y <- oget G1.m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2, hx2, hy2, handles_, t; + + if (!mem (dom G1.mi) x) { + handles_ <@ RRO.restrK(); + if (!mem (rng handles_) x.`2) { + RRO.set(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <@ RRO.restrK(); + hx2 <- oget (hinvc handles_ x.`2); + y <$ dstate; + t <@ RRO.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); + if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { + (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; + ReSample.f(hy2); + y2 <@ RRO.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; + + F.RO.m <- map0; + G1.m <- map0; + G1.mi <- map0; + G1.mh <- map0; + G1.mhi <- map0; + G1.bext <- false; + ReSample.count <- 0; + FRO.m <- map0; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + RRO.set(0,c0); + G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.chandle <- 1; + b <@ D(C,S).distinguish(); + resample(); + return b; + } + }. + + local equiv EG2_Gext : Eager(G2(DRestr(D))).main2 ~ Gext.distinguish: + ={glob D} ==> + (G1.bext{1} \/ + exists x h, mem (dom G1.m{1}) x /\ FRO.m{1}.[h] = Some (x.`2, Unknown)) => + G1.bext{2}. + proof. + admit. + qed. + + local lemma Pr_ext &m: + Pr[Gext.distinguish()@ &m : G1.bext] <= (max_size^2)%r / (2^c)%r. + proof. + admit. + qed. + + end section EXT. diff --git a/sha3/proof/old/SLCommon.ec b/sha3/proof/old/SLCommon.ec index 468adc5..2073e0f 100644 --- a/sha3/proof/old/SLCommon.ec +++ b/sha3/proof/old/SLCommon.ec @@ -316,15 +316,13 @@ section COUNT. 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,Known)) handles. + find (fun _ => pred1 c) (restr Known handles). op huniq (handles:handles) = forall h1 h2 cf1 cf2, @@ -355,10 +353,10 @@ 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. - cut @/pred1/=[[h []->[]Hmem ]|[]->H h ]/= := - findP (fun (_ : handle) => pred1 (c,Known)) handles. - + by rewrite oget_some get_oget. - by rewrite -not_def=> Heq; cut := H h;rewrite in_dom Heq. + rewrite /hinvK. + cut @/pred1/= [[h]|][->/=]:= findP (+ pred1 c) (restr Known handles). + + by rewrite oget_some in_dom restrP;case (handles.[h])=>//= /#. + by move=>+h-/(_ h);rewrite in_dom restrP -!not_def=> H1 H2;apply H1;rewrite H2. qed. lemma huniq_hinvK (handles:handles) c: From 20d5e3c8a50db6f9aa6b1c25b3735fc7b4f11b06 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 20 Jan 2016 19:48:10 +0100 Subject: [PATCH 114/394] Changed Common.ec to use inductive predicates, thoughout. Housekeeping in Block.ec (renamed from Blocks.ec) and TopLevel.ec (which now encorporates BlocksToTopLevel.ec). --- sha3/proof/Block.ec | 65 ++++++++++++++ sha3/proof/Blocks.ec | 61 ------------- sha3/proof/BlocksToTopLevel.ec | 65 -------------- sha3/proof/Common.ec | 159 ++++++++++++++++++--------------- sha3/proof/TopLevel.ec | 121 ++++++++++++++++++------- 5 files changed, 238 insertions(+), 233 deletions(-) create mode 100644 sha3/proof/Block.ec delete mode 100644 sha3/proof/Blocks.ec delete mode 100644 sha3/proof/BlocksToTopLevel.ec diff --git a/sha3/proof/Block.ec b/sha3/proof/Block.ec new file mode 100644 index 0000000..d3710ef --- /dev/null +++ b/sha3/proof/Block.ec @@ -0,0 +1,65 @@ +(*-------------------- Padded Block Sponge Construction ----------------*) + +require import Option Pair Int Real List. +require (*--*) IRO Indifferentiability. +require import Common. + +(*------------------------- 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. + +(*------------------------- Sponge Construction ------------------------*) + +module Sponge (P : DPRIMITIVE) : FUNCTIONALITY, CONSTRUCTION(P) = { + 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; + (sa, sc) <@ P.f(sa, sc); + i <- i + 1; + } + } + return z; + } +}. + +(*----------------------------- Conclusion -----------------------------*) + +(* this is just for typechecking, right now: *) + +op eps : real. + +lemma top: + exists (S <: SIMULATOR), + forall (D <: DISTINGUISHER) &m, + `| Pr[RealIndif(Sponge, Perm, D).main() @ &m : res] + - Pr[IdealIndif(IRO, S, D).main() @ &m : res]| + < eps. +proof. admit. qed. diff --git a/sha3/proof/Blocks.ec b/sha3/proof/Blocks.ec deleted file mode 100644 index fb20873..0000000 --- a/sha3/proof/Blocks.ec +++ /dev/null @@ -1,61 +0,0 @@ -(* -------------------------------------------------------------------- *) -require import Option Pair Int Real List. -require (*--*) Common IRO LazyRP Indifferentiability. - -(* -------------------------------------------------------------------- *) -require import Common. - -(* -------------------------------------------------------------------- *) - -clone import IRO as BIRO with - type from <- block list, - type to <- block, - op valid <- valid_block. - -(* -------------------------------------------------------------------- *) -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". - -(* -------------------------------------------------------------------- *) -module BlockSponge (P : DPRIMITIVE) : FUNCTIONALITY, CONSTRUCTION(P) = { - proc init() = {} - - proc f(p : block list, n : int) : block list = { - var z <- []; - var (sa,sc) <- (b0, Capacity.c0); - var i <- 0; - - if (valid_block p) { - (* Absorption *) - while (p <> []) { - (sa,sc) <@ P.f(sa +^ head b0 p, sc); - p <- behead p; - } - (* Squeezing *) - while (i < n) { - z <- rcons z sa; - (sa,sc) <@ P.f(sa,sc); - i <- i + 1; - } - } - return z; - } -}. - -(* -------------------------------------------------------------------- *) -op eps : real. - -lemma top: - exists (S <: SIMULATOR), - forall (D <: DISTINGUISHER) &m, - `| Pr[RealIndif(BlockSponge, Perm, D).main() @ &m : res] - - Pr[IdealIndif(IRO, S, D).main() @ &m : res]| - < eps. -proof. admit. qed. diff --git a/sha3/proof/BlocksToTopLevel.ec b/sha3/proof/BlocksToTopLevel.ec deleted file mode 100644 index e9b159a..0000000 --- a/sha3/proof/BlocksToTopLevel.ec +++ /dev/null @@ -1,65 +0,0 @@ -(* -------------------------------------------------------------------- *) -require import Fun Pred Option Pair Int IntDiv Real List FSet NewFMap. -require (*--*) Blocks TopLevel. - -(* -------------------------------------------------------------------- *) -require import Common. - -(* -------------------------------------------------------------------- *) -module UpperFun (F : Blocks.DFUNCTIONALITY) = { - proc init() = {} - - proc f(p : bool list, n : int) = { - var xs; - - xs <@ F.f(pad2blocks p, (n + r - 1) %/ r); - return take n (blocks2bits xs); - } -}. - -module LowerFun (F : TopLevel.DFUNCTIONALITY) = { - proc init() = {} - - 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; - } - return ys; - } -}. - -(* -------------------------------------------------------------------- *) -equiv ModularConstruction: - UpperFun(Blocks.BlockSponge(Perm)).f ~ TopLevel.Sponge(Perm).f: - ={glob Perm, arg} ==> ={glob Perm, res}. -proof. - proc. inline Blocks.BlockSponge(Perm).f. - admit. (* done *) -qed. - -module ModularSimulator (S : Blocks.SIMULATOR, F : TopLevel.DFUNCTIONALITY) = - S(LowerFun(F)). - -module BlocksDist (D : TopLevel.DISTINGUISHER, F : Blocks.DFUNCTIONALITY) = - D(UpperFun(F)). - -section. - declare module BlocksSim : Blocks.SIMULATOR. - declare module TopLevelDist : TopLevel.DISTINGUISHER. - - lemma Conclusion &m: - `|Pr[TopLevel.RealIndif(TopLevel.Sponge, Perm, TopLevelDist).main() @ &m: res] - - Pr[TopLevel.IdealIndif(TopLevel.BIRO.IRO, ModularSimulator(BlocksSim), - TopLevelDist).main() @ &m: res]| = - `|Pr[Blocks.RealIndif(Blocks.BlockSponge, Perm, - BlocksDist(TopLevelDist)).main() @ &m: res] - - Pr[Blocks.IdealIndif(Blocks.BIRO.IRO, BlocksSim, - BlocksDist(TopLevelDist)).main() @ &m: res]|. - proof. admit. qed. -end section. diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index e018936..180ac9d 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -1,4 +1,5 @@ -(* -------------------------------------------------------------------- *) +(*------------------- Common Definitions and Lemmas --------------------*) + require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. require import Ring StdRing StdOrder StdBigop BitEncoding. require (*--*) FinType BitWord LazyRP Monoid. @@ -82,7 +83,8 @@ case (zs = [])=> // zs_non_nil. elim ih=> // ->. by rewrite (@last_nonempty y z). qed. -(* -------------------------------------------------------------------- *) +(*------------------------------ Primitive -----------------------------*) + clone export LazyRP as Perm with type D <- block * capacity, op d <- bdistr * Capacity.cdistr @@ -91,7 +93,6 @@ clone export LazyRP as Perm with [module] "P" as "Perm". (* ------------------------- Padding/Unpadding ------------------------ *) -op chunk (bs : bool list) = BitChunking.chunk r bs. op num0 (n : int) = (-(n + 2)) %% r. @@ -215,7 +216,7 @@ by rewrite -nth_rev 1:/# &(@negbRL _ true) &(before_index) /#. qed. inductive unpad_spec (t : bool list) = -| Unpad (s : bool list, n : int) of + Unpad (s : bool list, n : int) of (0 <= n < r) & (r %| (size s + n + 2)) & (t = s ++ [true] ++ nseq n false ++ [true]). @@ -231,6 +232,10 @@ apply/(Unpad s (num0 (size s))). 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. @@ -257,6 +262,8 @@ 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 w2bits xs). lemma blocks2bits_nil : blocks2bits [] = []. @@ -280,7 +287,6 @@ 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 bits2w (chunk xs). lemma bits2blocks_nil : bits2blocks [] = []. @@ -319,7 +325,8 @@ have map_tolistK : 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. @@ -342,7 +349,8 @@ have -> : pad(oget(unpad bs)) = bs by rewrite /bs blocks2bitsK. qed. -(* ------------------------ Extending/Stripping ----------------------- *) +(*-------------------------- Extending/Stripping -----------------------*) + op extend (xs : block list) (n : int) = xs ++ nseq n b0. @@ -392,35 +400,40 @@ 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 ----------------------------- *) +(*------------------------------ Validity ------------------------------*) (* in TopLevel *) + op valid_toplevel (_ : bool list) = true. (* in Block *) + op valid_block (xs : block list) = unpad_blocks xs <> None. -lemma nosmt valid_block_prop (xs : block list) : - valid_block xs <=> - exists (s : bool list, n : int), - 0 <= n < r /\ blocks2bits xs = s ++ [true] ++ nseq n false ++ [true]. +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. -rewrite /valid_block /unpad_blocks /(\o). -split=> [vb | [s n] [rng_n b2b]]. +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 exists s, n. -apply unpadP; apply (Unpad s n)=> //. +by apply (@ValidBlock xs s n). +rewrite unpadP (@Unpad (blocks2bits xs) s n) //. have <- : size (blocks2bits xs) = size s + n + 2 - by rewrite b2b 3!size_cat /= size_nseq max_ler /#ring. -rewrite size_blocks2bits_dvd_r. + by rewrite b2b_xs_eq 3!size_cat /= size_nseq max_ler /#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_block_prop xs. -rewrite vb_xs /= in bp; elim bp=> [s n] [_ b2b_xs_eq]. +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 nnot in last_xs_eq_b0. have xs_non_nil : xs <> [] by smt ml=0. @@ -437,19 +450,23 @@ have last_b2b_xs_false : last true (blocks2bits xs) = false by rewrite last_b2b_xs_true in last_b2b_xs_false. qed. -lemma nosmt valid_block_prop_alt (xs : block list) : - valid_block xs <=> - (exists (ys : block list, x : block, s : bool list, n : int), - xs = ys ++ [x] /\ 0 <= n /\ - w2bits x = s ++ [true] ++ nseq n false ++ [true]) \/ - (exists (ys : block list, y z : block), - xs = ys ++ [y; z] /\ last false (w2bits y) /\ - w2bits z = nseq (r - 1) false ++ [true]). +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) + & (w2bits x = s ++ [true] ++ nseq n false ++ [true]) +| ValidBlockStruct2 (ys : block list, y z : block) of + (xs = ys ++ [y; z]) + & (last false (w2bits y)) + & (w2bits 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_block_prop. -split=>[[s n] [[ge0_n lt_nr] b2b_xs_eq] | - [[ys x s n] [xs_eq [ge0_n w2b_ys_eq]] | - [ys y z] [xs_eq [lst_w2b_y w2b_z_eq]]]]. +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. @@ -487,7 +504,6 @@ rewrite -(@cat_take_drop (size s %/ r * r) s) -!catA -/tke -/drp + 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]. -right. 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 ml=0. @@ -499,23 +515,16 @@ have sz_drp_plus1_eq_r : size drp + 1 = r. 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. -exists (bits2blocks tke), - (bits2w (drp ++ [true])), - (bits2w (nseq n false ++ [true])). -split. -rewrite xs_eq. -rewrite (@catA drp [true]) bits2blocks_cat 1:size_cat // - 1:size_cat 1:size_nseq 1:max_ler 1:ge0_n /= 1:/#. -rewrite (@bits2blocks_sing (drp ++ [true])) 1:size_cat //. -rewrite (@bits2blocks_sing (nseq n false ++ [true])). -rewrite size_cat size_nseq max_ler /= 1:ge0_n /#. -by rewrite catA. -do 2! rewrite tolistK 1:size_cat //=. -+ rewrite size_nseq max_ler 1:ge0_n /#. -split; first rewrite cats1 last_rcons. -have -> // : n = r - 1 by smt ml=0. +apply (@ValidBlockStruct2 xs (bits2blocks tke) + (bits2w (drp ++ [true])) (bits2w (nseq n false ++ [true]))). +rewrite xs_eq (@catA drp [true]) bits2blocks_cat 1:size_cat // + 1:size_cat 1:size_nseq 1:max_ler 1:ge0_n /= 1:/# + (@bits2blocks_sing (drp ++ [true])) 1:size_cat // + (@bits2blocks_sing (nseq n false ++ [true])) + 1:size_cat 1:size_nseq /= 1:max_ler 1:ge0_n /#. +rewrite tolistK 1:size_cat //= cats1 last_rcons. +rewrite n_eq_r_min1 tolistK 1:size_cat //= size_nseq max_ler /#. have lt_n_r_min1 : n < r - 1 by smt ml=0. -left. 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. @@ -533,43 +542,47 @@ rewrite (@bits2blocks_sing + rewrite !size_cat /= size_nseq max_ler 1:ge0_n 1:sz_drp. + have -> : size s %% r + (1 + (n + 1)) = size s %%r + n + 2 by ring. + by rewrite -sz_drp. -exists (bits2blocks tke), - (bits2w(drp ++ ([true] ++ (nseq n false ++ [true])))), - drp, n. -split=> //; split=> //. +apply (@ValidBlockStruct1 xs (bits2blocks tke) + (bits2w(drp ++ ([true] ++ (nseq n false ++ [true])))) + drp n)=> //. by rewrite tolistK 1:!size_cat /= 1:size_nseq 1:max_ler 1:ge0_n 1:-sz_drp_plus_n_plus_2_eq_r 1:#ring -!catA cat1s. -exists (blocks2bits ys ++ s), n; split. have sz_w2b_x_eq_r : size(w2bits x) = r by apply size_tolist. -rewrite w2b_ys_eq !size_cat /= size_nseq max_ler // in sz_w2b_x_eq_r. -split=> // _; smt ml=0 w=(size_ge0). -by rewrite xs_eq blocks2bits_cat blocks2bits_sing w2b_ys_eq !catA. -exists (blocks2bits ys ++ (take (r - 1) (w2bits y))), (r - 1). -split; first smt ml=0 w=(gt0_r). -rewrite xs_eq blocks2bits_cat; have -> : [y; z] = [y] ++ [z] by trivial. -rewrite blocks2bits_cat 2!blocks2bits_sing -!catA; congr. -have {1}-> : w2bits y = take (r - 1) (w2bits y) ++ [true]. +rewrite w2b_x_eq !size_cat /= size_nseq max_ler // in sz_w2b_x_eq_r. +have lt_nr : n < r by smt ml=0 w=(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 : w2bits y = take (r - 1) (w2bits y) ++ [true]. rewrite -{1}(@cat_take_drop (r - 1) (w2bits y)); congr. elim (last_drop_all_but_last false (w2bits y))=> [w2b_y_nil | drop_w2b_y_last]. have not_lst_w2b_y : ! last false (w2bits y) by rewrite w2b_y_nil. - done. - rewrite lst_w2b_y in drop_w2b_y_last. + by rewrite w2b_y_nil. + rewrite lst in drop_w2b_y_last. by rewrite -drop_w2b_y_last size_tolist. -by rewrite w2b_z_eq !catA. +apply (@ValidBlock xs (blocks2bits ys ++ (take (r - 1) (w2bits y))) + (r - 1)). +smt ml=0 w=(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 Absorb *) + op valid_absorb (xs : block list) = valid_block((strip xs).`1). -lemma nosmt valid_absorb_prop (xs : block list) : - valid_absorb xs <=> - exists (ys : block list, n : int), - 0 <= n /\ xs = ys ++ nseq n b0 /\ valid_block ys. +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]]]. -exists (strip xs).`1, (strip xs).`2. -split; [apply (@strip_ge0 xs) | split=> //]. -by rewrite -/(extend (strip xs).`1 (strip xs).`2) eq_sym (@stripK xs). +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) 2:(@stripK xs). by rewrite -/(extend ys n) extendK 1:valid_block_ends_not_b0. qed. diff --git a/sha3/proof/TopLevel.ec b/sha3/proof/TopLevel.ec index 39ee761..406bf77 100644 --- a/sha3/proof/TopLevel.ec +++ b/sha3/proof/TopLevel.ec @@ -1,17 +1,11 @@ -(* -------------------------------------------------------------------- *) -require import Pair Int IntDiv Real List. -require (*--*) IRO LazyRP Indifferentiability. +(*------------------------- Sponge Construction ------------------------*) -(* -------------------------------------------------------------------- *) +require import Pair Int IntDiv Real List Option. require import Common. +require (*--*) IRO Block. + +(*------------------------- Indifferentiability ------------------------*) -(* -------------------------------------------------------------------- *) -clone import IRO as BIRO with - type from <- bool list, - type to <- bool, - op valid <- valid_toplevel. - -(* -------------------------------------------------------------------- *) clone include Indifferentiability with type p <- block * capacity, type f_in <- bool list * int, @@ -22,42 +16,101 @@ clone include Indifferentiability with [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. + +(*------------------------- Sponge Construction ------------------------*) module Sponge (P : DPRIMITIVE) : FUNCTIONALITY, CONSTRUCTION(P) = { proc init() : unit = {} - proc f(bp : bool list, n : int) : bool list = { - var z <- []; - var (sa,sc) <- (b0, Capacity.c0); - var i <- 0; - var p <- map bits2w (chunk (pad bp)); + 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 (p <> []) { - (sa,sc) <@ P.f(sa +^ head b0 p, sc); - p <- behead p; + (* absorption *) + while (xs <> []) { + (sa, sc) <@ P.f(sa +^ head b0 xs, sc); + xs <- behead xs; } - (* Squeezing *) + (* squeezing *) while (i < (n + r - 1) %/ r) { - z <- z ++ (Block.w2bits sa); - (sa,sc) <@ P.f(sa,sc); - i <- i + 1; + z <- z ++ w2bits sa; + (sa, sc) <@ P.f(sa, sc); + i <- i + 1; } return take n z; } }. -(* -------------------------------------------------------------------- *) -op eps : real. +(*------------- Simulator and Distinguisher Constructions --------------*) + +module LowerFun (F : DFUNCTIONALITY) : Block.DFUNCTIONALITY = { + proc init() = {} -print RealIndif. + proc f(xs : block list, n : int) = { + var cs, ds : bool list; + var obs : bool list option; + var ys : block list <- []; -lemma top: - exists (S <: SIMULATOR), - forall (D <: DISTINGUISHER) &m, - `| Pr[RealIndif(Sponge, Perm, D).main() @ &m : res] - - Pr[IdealIndif(IRO, S, D).main() @ &m : res]| - < eps. + obs <- unpad_blocks xs; + if (obs <> None) { + cs <@ F.f(oget obs, n * r); (* size cs = n * r *) + ys <- bits2blocks cs; + } + return ys; + } +}. + +module RaiseFun (F : Block.DFUNCTIONALITY) : DFUNCTIONALITY = { + proc init() = {} + + 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 : Block.DFUNCTIONALITY) = D(RaiseFun(F)). + +module RaiseSim (S : Block.SIMULATOR, F : DFUNCTIONALITY) = S(LowerFun(F)). + +(*------------------------------- Proof --------------------------------*) + +section. + +declare module BlockSim : Block.SIMULATOR. +declare module Dist : DISTINGUISHER. + +lemma Conclusion' &m : + `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] - + Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res]| = + `|Pr[Block.RealIndif + (Block.Sponge, Perm, LowerDist(Dist)).main() @ &m : res] - + Pr[Block.IdealIndif + (Block.BIRO.IRO, BlockSim, LowerDist(Dist)).main() @ &m : res]|. proof. admit. qed. + +end section. + +(*----------------------------- Conclusion -----------------------------*) + +lemma Conclusion (BlockSim <: Block.SIMULATOR) + (Dist <: DISTINGUISHER) + &m : + `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] - + Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res]| = + `|Pr[Block.RealIndif + (Block.Sponge, Perm, LowerDist(Dist)).main() @ &m : res] - + Pr[Block.IdealIndif + (Block.BIRO.IRO, BlockSim, LowerDist(Dist)).main() @ &m : res]|. +proof. by apply (Conclusion' BlockSim Dist &m). qed. From a417503d82d6f2b6cbf99d930632c6297219af42 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 21 Jan 2016 10:34:03 +0100 Subject: [PATCH 115/394] Updated documentation. --- sha3/proof/IRO.eca | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/sha3/proof/IRO.eca b/sha3/proof/IRO.eca index d2a1cf0..697902f 100644 --- a/sha3/proof/IRO.eca +++ b/sha3/proof/IRO.eca @@ -1,6 +1,7 @@ -(* infinite random oracle: it ranges over infinite length bitstrings, - all of whose bits are sampled uniformly and independently. We - obviously make it lazy. *) +(* 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 Option Int Bool List FSet NewFMap. @@ -12,7 +13,7 @@ op dto : to distr. module type IRO = { proc init() : unit - (* f x, returning the first n bits of the result *) + (* f x, returning the first n elements of the result *) proc f(x : from, n : int) : to list }. @@ -28,7 +29,7 @@ pred prefix_closed' (m : (from * int,to) fmap) = 0 <= i < n => mem (dom m) (x,i). -lemma cool m: prefix_closed m <=> prefix_closed' m +lemma prefix_closed_equiv m: prefix_closed m <=> prefix_closed' m by []. (* official version: *) From 215bb52cfec1822529978d93ff9390d09fcf980a Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 21 Jan 2016 12:00:07 +0100 Subject: [PATCH 116/394] Added lemma connecting valid_block and pad2blocks. --- sha3/proof/Common.ec | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 180ac9d..115c5ce 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -410,6 +410,12 @@ op valid_toplevel (_ : bool list) = true. 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) From 77c0dd28cae04e2c70cbdb75eebb834ed0e8b8b0 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 21 Jan 2016 15:43:31 +0100 Subject: [PATCH 117/394] Reduced TopLevel proof to lemma to be proved using eager. --- sha3/proof/TopLevel.ec | 85 ++++++++++++++++++++++++++++++++++++++---- 1 file changed, 78 insertions(+), 7 deletions(-) diff --git a/sha3/proof/TopLevel.ec b/sha3/proof/TopLevel.ec index 406bf77..8c0be41 100644 --- a/sha3/proof/TopLevel.ec +++ b/sha3/proof/TopLevel.ec @@ -1,6 +1,6 @@ (*------------------------- Sponge Construction ------------------------*) -require import Pair Int IntDiv Real List Option. +require import Pair Int IntDiv Real List Option NewFMap. require import Common. require (*--*) IRO Block. @@ -88,8 +88,77 @@ module RaiseSim (S : Block.SIMULATOR, F : DFUNCTIONALITY) = S(LowerFun(F)). section. -declare module BlockSim : Block.SIMULATOR. -declare module Dist : DISTINGUISHER. +declare module BlockSim : Block.SIMULATOR{IRO, Block.BIRO.IRO}. +declare module Dist : DISTINGUISHER{Perm, BlockSim, IRO, Block.BIRO.IRO}. + +lemma Sponge_Raise_Block_Sponge_f : + equiv[Sponge(Perm).f ~ RaiseFun(Block.Sponge(Perm)).f : + ={bs, n, glob Perm} ==> ={res, glob Perm}]. +proof. +proc; inline Block.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). +wp. call (_ : ={glob Perm}); first sim. auto. +auto; progress; by rewrite -cats1 blocks2bits_cat blocks2bits_sing. +auto. +qed. + +lemma RealIndif &m : + Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] = + Pr[Block.RealIndif + (Block.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_Block_Sponge_f=> //. +auto. +qed. + +lemma IdealDist &1 &2 (a : bool) : + (glob Dist){1} = (glob Dist){2} => (glob BlockSim){1} = (glob BlockSim){2} => + IRO.mp{1} = NewFMap.map0 => Block.BIRO.IRO.mp{2} = NewFMap.map0 => + Pr[Dist(IRO, BlockSim(LowerFun(IRO))).distinguish() @ &1 : a = res] = + Pr[Dist(RaiseFun(Block.BIRO.IRO), + BlockSim(Block.BIRO.IRO)).distinguish() @ &2 : a = res]. +proof. +admit. +qed. + +lemma IdealIndif &m : + Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = + Pr[Block.IdealIndif + (Block.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res]. +proof. +byequiv=> //; proc. +seq 2 2 : + (={glob Dist, glob BlockSim} /\ IRO.mp{1} = NewFMap.map0 /\ + Block.BIRO.IRO.mp{2} = NewFMap.map0). +inline *; wp; call (_ : true); auto. +call + (_ : + ={glob Dist, glob BlockSim} /\ + IRO.mp{1} = map0 /\ Block.BIRO.IRO.mp{2} = map0 ==> + ={res}). +bypr res{1} res{2}=> //; progress. +apply (IdealDist &1 &2 a)=> //. +auto. +qed. lemma Conclusion' &m : `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] - @@ -98,14 +167,16 @@ lemma Conclusion' &m : (Block.Sponge, Perm, LowerDist(Dist)).main() @ &m : res] - Pr[Block.IdealIndif (Block.BIRO.IRO, BlockSim, LowerDist(Dist)).main() @ &m : res]|. -proof. admit. qed. +proof. +by rewrite (RealIndif &m) (IdealIndif &m). +qed. end section. (*----------------------------- Conclusion -----------------------------*) -lemma Conclusion (BlockSim <: Block.SIMULATOR) - (Dist <: DISTINGUISHER) +lemma Conclusion (BlockSim <: Block.SIMULATOR{IRO, Block.BIRO.IRO}) + (Dist <: DISTINGUISHER{Perm, BlockSim, IRO, Block.BIRO.IRO}) &m : `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] - Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res]| = @@ -113,4 +184,4 @@ lemma Conclusion (BlockSim <: Block.SIMULATOR) (Block.Sponge, Perm, LowerDist(Dist)).main() @ &m : res] - Pr[Block.IdealIndif (Block.BIRO.IRO, BlockSim, LowerDist(Dist)).main() @ &m : res]|. -proof. by apply (Conclusion' BlockSim Dist &m). qed. +proof. by apply/(Conclusion' BlockSim Dist &m). qed. From 5365ab744aca153b30bc9756cbeb9eedb6004e2f Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 22 Jan 2016 15:03:45 +0100 Subject: [PATCH 118/394] Progress in top level proof. --- sha3/proof/Block.ec | 3 +- sha3/proof/TopLevel.ec | 254 +++++++++++++++++++++++++++++++++++++---- 2 files changed, 234 insertions(+), 23 deletions(-) diff --git a/sha3/proof/Block.ec b/sha3/proof/Block.ec index d3710ef..8887e5e 100644 --- a/sha3/proof/Block.ec +++ b/sha3/proof/Block.ec @@ -21,7 +21,8 @@ clone include Indifferentiability with clone import IRO as BIRO with type from <- block list, type to <- block, - op valid <- valid_block. + op valid <- valid_block, + op dto <- bdistr. (*------------------------- Sponge Construction ------------------------*) diff --git a/sha3/proof/TopLevel.ec b/sha3/proof/TopLevel.ec index 8c0be41..9276ec5 100644 --- a/sha3/proof/TopLevel.ec +++ b/sha3/proof/TopLevel.ec @@ -1,7 +1,7 @@ (*------------------------- Sponge Construction ------------------------*) -require import Pair Int IntDiv Real List Option NewFMap. -require import Common. +require import Pair Int IntDiv Real List Option FSet NewFMap DBool. +require import Fun Common. require (*--*) IRO Block. (*------------------------- Indifferentiability ------------------------*) @@ -21,7 +21,8 @@ clone include Indifferentiability with clone import IRO as BIRO with type from <- bool list, type to <- bool, - op valid <- valid_toplevel. + op valid <- valid_toplevel, + op dto <- dbool. (*------------------------- Sponge Construction ------------------------*) @@ -53,8 +54,6 @@ module Sponge (P : DPRIMITIVE) : FUNCTIONALITY, CONSTRUCTION(P) = { (*------------- Simulator and Distinguisher Constructions --------------*) module LowerFun (F : DFUNCTIONALITY) : Block.DFUNCTIONALITY = { - proc init() = {} - proc f(xs : block list, n : int) = { var cs, ds : bool list; var obs : bool list option; @@ -63,15 +62,13 @@ module LowerFun (F : DFUNCTIONALITY) : Block.DFUNCTIONALITY = { obs <- unpad_blocks xs; if (obs <> None) { cs <@ F.f(oget obs, n * r); (* size cs = n * r *) - ys <- bits2blocks cs; + ys <- bits2blocks cs; (* size ys = n *) } return ys; } }. module RaiseFun (F : Block.DFUNCTIONALITY) : DFUNCTIONALITY = { - proc init() = {} - proc f(bs : bool list, n : int) = { var xs; @@ -91,7 +88,175 @@ section. declare module BlockSim : Block.SIMULATOR{IRO, Block.BIRO.IRO}. declare module Dist : DISTINGUISHER{Perm, BlockSim, IRO, Block.BIRO.IRO}. -lemma Sponge_Raise_Block_Sponge_f : +module type BLOCK_IRO_BITS = { + proc init() : unit + proc g(x : block list, n : int) : bool list + proc f(x : block list, n : int) : block list +}. + +module type BLOCK_IRO_BITS_DIST(BIROB : BLOCK_IRO_BITS) = { + proc distinguish(): bool +}. + +local module BlockIROBitsEager : BLOCK_IRO_BITS, Block.BIRO.IRO = { + var mp : (block list * int, bool) fmap + + proc init() : unit = { + mp <- map0; + } + + proc fill_in(xs, i) = { + if (! mem (dom mp) (xs, i)) { + mp.[(xs, i)] <$ dbool; + } + return oget mp.[(xs, i)]; + } + + proc g(xs, n) = { + var b, bs; + var m <- ((n + r - 1) %/ r) * r; + 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; + } + + proc f(xs, n) = { + var bs, ys; + bs <@ g(xs, n * r); + ys <- bits2blocks bs; + return ys; + } +}. + +local module BlockIROBitsLazy : BLOCK_IRO_BITS, Block.BIRO.IRO = { + var mp : (block list * int, bool) fmap + + proc init() : unit = { + mp <- map0; + } + + proc fill_in(xs, i) = { + if (! mem (dom mp) (xs, i)) { + mp.[(xs, i)] <$ dbool; + } + return oget mp.[(xs, i)]; + } + + proc g(xs, n) = { + 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; + } + + proc f(xs, n) = { + var bs, ys; + bs <@ g(xs, n * r); + ys <- bits2blocks bs; + return ys; + } +}. + +local module RaiseBIROBLazy (F : BLOCK_IRO_BITS) : FUNCTIONALITY = { + proc init() = { + F.init(); + } + + proc f(bs : bool list, n : int) = { + var cs; + + cs <@ F.g(pad2blocks bs, n); + return take n cs; + } +}. + +pred LazyInvar + (mp1 : (bool list * int, bool) fmap, + mp2 : (block list * int, bool) fmap) = + (forall (bs : bool list, n : int), + mem (dom mp1) (bs, n) <=> mem (dom mp2) (pad2blocks bs, n)) /\ + (forall (xs : block list, n), + mem (dom mp2) (xs, n) => valid_block xs) /\ + (forall (bs : bool list, n : int), + mem (dom mp1) (bs, n) => + oget mp1.[(bs, n)] = oget mp2.[(pad2blocks bs, n)]). + +local lemma LowerFun_IRO_BlockIROBitsLazy_f : + equiv[LowerFun(IRO).f ~ BlockIROBitsLazy.f : + ={xs, n} /\ LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2} ==> + ={res} /\ LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2}]. +proof. +proc=> /=; inline BlockIROBitsLazy.g. +seq 0 1 : + (={n} /\ xs{1} = xs0{2} /\ + LazyInvar IRO.mp{1} BlockIROBitsLazy.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 : + (={n, n0} /\ xs{1} = xs0{2} /\ n0{1} = n{1} * r /\ + LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2} /\ + valid_block xs{1} /\ pad2blocks x{1} = xs0{2}). +auto; progress; have {2}<- /# := unpadBlocksK xs0{2}. +admit. +rcondf{1} 3; first auto. rcondf{2} 4; first auto. +auto; progress; by rewrite bits2blocks_nil. +qed. + +(* TODO: + + IRO.f ~ RaiseBIROBLazy(BlockIROBitsLazy).f *) + +(* TODO: +BlockIROBitsEager.f ~ Block.BIRO.IRO.f + +BlockIROBitsEager.fi ~ Block.BIRO.IRO.fi + +RaiseFun(BlockIROBitsEager).f ~ RaiseFun(Block.BIRO.IRO).f +*) + +local lemma BlockIROBitsEager (D <: BLOCK_IRO_BITS_DIST) : + equiv[D(BlockIROBitsEager).distinguish ~ D(BlockIROBitsLazy).distinguish : + ={glob D} /\ BlockIROBitsEager.mp{1} = BlockIROBitsLazy.mp{2} ==> + ={glob D}]. +proof. +admit. +qed. + +pred BlockIROBits_Eager_Invar + (mp1 : (block list * int, block) fmap, + mp2 : (block list * int, bool) fmap) = + (forall (xs : block list, i : int), + mem (dom mp1) (xs, i) => + 0 <= i /\ + (forall (j : int), 0 <= j < i => mem (dom mp1) (xs, j)) /\ + (forall (j : int), i * r <= j < (i + 1) * r => + mp2.[(xs, j)] = Some(nth false (w2bits(oget mp1.[(xs, i)])) j))) /\ + (forall (xs : block list, j : int), + mem (dom mp2) (xs, j) => + 0 <= j /\ mem (dom mp1) (xs, j %/ r)). + +local lemma Sponge_Raise_Block_Sponge_f : equiv[Sponge(Perm).f ~ RaiseFun(Block.Sponge(Perm)).f : ={bs, n, glob Perm} ==> ={res, glob Perm}]. proof. @@ -118,7 +283,7 @@ auto; progress; by rewrite -cats1 blocks2bits_cat blocks2bits_sing. auto. qed. -lemma RealIndif &m : +local lemma RealIndif &m : Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] = Pr[Block.RealIndif (Block.Sponge, Perm, LowerDist(Dist)).main() @ &m : res]. @@ -130,36 +295,81 @@ conseq Sponge_Raise_Block_Sponge_f=> //. auto. qed. -lemma IdealDist &1 &2 (a : bool) : - (glob Dist){1} = (glob Dist){2} => (glob BlockSim){1} = (glob BlockSim){2} => - IRO.mp{1} = NewFMap.map0 => Block.BIRO.IRO.mp{2} = NewFMap.map0 => - Pr[Dist(IRO, BlockSim(LowerFun(IRO))).distinguish() @ &1 : a = res] = - Pr[Dist(RaiseFun(Block.BIRO.IRO), - BlockSim(Block.BIRO.IRO)).distinguish() @ &2 : a = res]. +local lemma IdealIndifIROLazy &m : + Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = + Pr[Experiment + (RaiseBIROBLazy(BlockIROBitsLazy), BlockSim(BlockIROBitsLazy), + Dist).main() @ &m : res]. proof. +byequiv=> //; proc. +seq 2 2 : + (={glob Dist, glob BlockSim} /\ IRO.mp{1} = NewFMap.map0 /\ + BlockIROBitsLazy.mp{2} = NewFMap.map0). +inline *; wp; call (_ : true); auto. +call + (_ : + ={glob Dist, glob BlockSim} /\ + IRO.mp{1} = map0 /\ BlockIROBitsLazy.mp{2} = map0 ==> + ={res}). +proc (={glob BlockSim}). +smt. +smt. +admit. +admit. admit. +auto. qed. -lemma IdealIndif &m : - Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = +local lemma IdealIndifLazy &m : + Pr[Experiment + (RaiseBIROBLazy(BlockIROBitsLazy), BlockSim(BlockIROBitsLazy), + Dist).main() @ &m : res] = + Pr[Block.IdealIndif + (BlockIROBitsEager, BlockSim, LowerDist(Dist)).main() @ &m : res]. +proof. +byequiv=> //; proc. +seq 2 2 : + (={glob Dist, glob BlockSim} /\ BlockIROBitsLazy.mp{1} = NewFMap.map0 /\ + BlockIROBitsEager.mp{2} = NewFMap.map0). +inline *; wp; call (_ : true); auto. +(* reduction to BlockIROBitsEager *) +admit. +qed. + +local lemma IdealIndifEager &m : + Pr[Block.IdealIndif + (BlockIROBitsEager, BlockSim, LowerDist(Dist)).main() @ &m : res] = Pr[Block.IdealIndif (Block.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res]. proof. byequiv=> //; proc. seq 2 2 : - (={glob Dist, glob BlockSim} /\ IRO.mp{1} = NewFMap.map0 /\ + (={glob Dist, glob BlockSim} /\ BlockIROBitsEager.mp{1} = NewFMap.map0 /\ Block.BIRO.IRO.mp{2} = NewFMap.map0). inline *; wp; call (_ : true); auto. call (_ : ={glob Dist, glob BlockSim} /\ - IRO.mp{1} = map0 /\ Block.BIRO.IRO.mp{2} = map0 ==> + BlockIROBitsEager.mp{1} = map0 /\ Block.BIRO.IRO.mp{2} = map0 ==> ={res}). -bypr res{1} res{2}=> //; progress. -apply (IdealDist &1 &2 a)=> //. +proc (={glob BlockSim}). +smt. +smt. +proc (true); first 2 smt. +admit. +admit. +admit. auto. qed. +local lemma IdealIndif &m : + Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = + Pr[Block.IdealIndif + (Block.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res]. +proof. +by rewrite (IdealIndifIROLazy &m) (IdealIndifLazy &m) (IdealIndifEager &m). +qed. + lemma Conclusion' &m : `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] - Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res]| = From dc3ec4b0bd0c30412f6a7e1d06494401a245c971 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 22 Jan 2016 12:53:52 +0100 Subject: [PATCH 119/394] RndO: new intro pattern syntax. --- sha3/proof/RndO.ec | 74 +++++++++++++++++++++++----------------------- 1 file changed, 37 insertions(+), 37 deletions(-) diff --git a/sha3/proof/RndO.ec b/sha3/proof/RndO.ec index a8c21dc..2e8757f 100644 --- a/sha3/proof/RndO.ec +++ b/sha3/proof/RndO.ec @@ -177,7 +177,7 @@ qed. equiv RO_FRO_set : RO.set ~ FRO.set : ={x,y} /\ RO.m{1} = map (+fst) FRO.m{2} ==> RO.m{1} = map (+fst) FRO.m{2}. -proof. by proc;auto=>?&ml[*]3!->;rewrite map_set. qed. +proof. by proc;auto=>?&ml[#]3->;rewrite map_set. qed. equiv RO_FRO_rem : RO.rem ~ FRO.rem : ={x} /\ RO.m{1} = map (+fst) FRO.m{2} ==> RO.m{1} = map (+fst) FRO.m{2}. @@ -319,14 +319,14 @@ lemma iter_perm2 (i1 i2 : from): ={glob RRO.I, t1, t2} ==> ={glob RRO.I}]. proof. proc;inline *;case ((t1=t2){1});1:by auto. - by swap{2}[4..5]-3;auto=> &ml&mr[*]3!->neq/=?->?->;rewrite set_set neq. + by swap{2}[4..5]-3;auto=> &ml&mr[#]3->neq/=?->?->;rewrite set_set neq. qed. equiv I_f_neq x1 mx1: RRO.I.f ~ RRO.I.f : ={x,FRO.m} /\ x1 <> x{1} /\ FRO.m{1}.[x1] = mx1 ==> ={FRO.m} /\ FRO.m{1}.[x1] = mx1. proof. - by proc;auto=>?&mr[*]2!->Hneq Heq/=?->;rewrite getP Hneq. + by proc;auto=>?&mr[#]2->Hneq Heq/=?->;rewrite getP Hneq. qed. equiv I_f_eqex x1 mx1 mx2: RRO.I.f ~ RRO.I.f : @@ -335,14 +335,14 @@ equiv I_f_eqex x1 mx1 mx2: RRO.I.f ~ RRO.I.f : eq_except FRO.m{1} FRO.m{2} (fset1 x1) /\ FRO.m{1}.[x1] = mx1 /\ FRO.m{2}.[x1] = mx2. proof. - by proc;auto=>?&mr[*]->Hneq Heq/= Heq1 Heq2?->/=;rewrite !getP Hneq eq_except_set. + by proc;auto=>?&mr[#]->Hneq Heq/= Heq1 Heq2?->/=;rewrite !getP Hneq eq_except_set. qed. equiv I_f_set x1 r1 : RRO.I.f ~ RRO.I.f : ={x} /\ x1 <> x{1} /\ FRO.m{1}.[x1] = None /\ FRO.m{2} = FRO.m{1}.[x1 <- (r1, Known)] ==> FRO.m{1}.[x1] = None /\ FRO.m{2} = FRO.m{1}.[x1 <- (r1, Known)]. proof. - by proc;auto=>?&mr[*]->Hneq H1->/=?->;rewrite getP Hneq/= H1 set_set Hneq. + by proc;auto=>?&mr[#]->Hneq H1->/=?->;rewrite getP Hneq/= H1 set_set Hneq. qed. lemma eager_get : @@ -355,9 +355,9 @@ proof. exists*x{1}, ((oget FRO.m.[x{2}]){1});elim*=>x1 mx;inline RRO.resample. call (iter_inv RRO.I (fun z=>x1<>z) (fun o1 o2 => o1 = o2 /\ o1.[x1]= Some mx) _)=>/=. + by conseq (I_f_neq x1 (Some mx))=>//. - auto=>?&mr[*]4!->Hd Hget;rewrite sampleto_ll /==>?_;split. + auto=>?&mr[#]4->Hd Hget;rewrite sampleto_ll /==>?_;split. + by rewrite get_oget//oget_some/==> x;rewrite -memE dom_restr/#. - by move=>[*]_ Heq?mr[*]->Heq'?_;rewrite in_dom Heq' oget_some /= set_eq /#. + by move=>[#]_ Heq?mr[#]->Heq'?_;rewrite in_dom Heq' oget_some /= set_eq /#. case ((mem (dom FRO.m) x){1}). + inline{1} RRO.resample=>/=;rnd{1}. transitivity{1} @@ -368,8 +368,8 @@ proof. ={x} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ FRO.m{1}.[x{2}] = Some (result{2},Unknown) /\ FRO.m{2}.[x{2}] = Some (result{2},Known)). - + by move=>?&mr[*]-> -> ??;exists FRO.m{mr}, x{mr}=>/#. - + move=>???;rewrite in_dom=>[*]<*>[*]->/eq_except_sym H Hxm Hx2. + + by move=>?&mr[#]-> -> ??;exists FRO.m{mr}, x{mr}=>/#. + + move=>???;rewrite in_dom=>[#]<*>[#]->/eq_except_sym H Hxm Hx2. rewrite sampleto_ll=> r _;rewrite /= Hxm oget_some /=;apply /eq_sym. have /(congr1 oget):= Hx2 => <-;apply eq_except_set_eq=>//. by rewrite in_dom Hx2. @@ -381,21 +381,21 @@ proof. (l =elems(dom (restr Unknown FRO.m) `\` fset1 x)){1} /\ FRO.m{1}.[x{2}] = Some (result{2}, Unknown) /\ FRO.m{2}.[x{2}] = Some (result{2}, Known)). - + auto=>?&mr[*]2!->/=^Hdom->^Hget->?->/=. + + auto=>?&mr[#]2->/=^Hdom->^Hget->?->/=. by rewrite !getP /=oget_some !restr_set/= dom_set set2_eq_except fsetDK. exists*x{1}, FRO.m{1}.[x{2}], FRO.m{2}.[x{2}];elim*=>x1 mx1 mx2. call (iter_inv RRO.I (fun z=>x1<>z) (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) - (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[*]4!->^H->->^H1->^H2->/=;split. + (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[#]4->^H->->^H1->^H2->/=;split. + congr;rewrite fsetP=>z;rewrite !inE !dom_restr /in_dom_with !in_dom; smt. by move=>x;rewrite -memE in_fsetD1 eq_sym. swap{1}-1;seq 1 1 : (={r,x,FRO.m} /\ ! mem (dom FRO.m{1}) x{1});1:by auto. inline RRO.resample;exists*x{1},r{1};elim*=>x1 r1. call (iter_inv RRO.I (fun z=>x1<>z) (fun o1 o2 => o1.[x1] = None /\ o2= o1.[x1<-(r1,Known)]) (I_f_set x1 r1));auto. - move=>?&mr[*]5!-> ^Hnin^ + ->/=;rewrite in_dom=>/=->/=;rewrite restr_set_neq //=;split. + move=>?&mr[#]5-> ^Hnin^ + ->/=;rewrite in_dom=>/=->/=;rewrite restr_set_neq //=;split. + by move=>z; rewrite -memE dom_restr /#. - by move=>_?mr[*]^Hmem 2!->;rewrite in_dom Hmem /= getP /=oget_some. + by move=>_?mr[#]^Hmem 2!->;rewrite in_dom Hmem /= getP /=oget_some. qed. lemma eager_set : @@ -411,29 +411,29 @@ proof. (={x,y,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown==> ={x,y} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ FRO.m{2}.[x{2}] = Some (y{2},Known)). - + by move=>?&mr[*]2!->???;exists FRO.m{mr}, y{mr}, x{mr}=>/#. - + move=>?&m&mr[*]<*>[*]2!->Hex Hm2. + + by move=>?&mr[#]2->???;exists FRO.m{mr}, y{mr}, x{mr}=>/#. + + move=>?&m&mr[#]<*>[#]2->Hex Hm2. by rewrite (eq_except_set_eq FRO.m{mr} FRO.m{m} x{mr}) ?in_dom ?Hm2// eq_except_sym. - + symmetry;call (iter1_perm RRO.I iter_perm2);auto=>?&mr[*]3!-> Hdom Hm;split=>//=. + + symmetry;call (iter1_perm RRO.I iter_perm2);auto=>?&mr[#]3-> Hdom Hm;split=>//=. by apply /perm_eq_sym/perm_to_rem/dom_restr;rewrite /in_dom_with Hdom. inline{1}Iter(RRO.I).iter_1s. seq 3 1: (={x,y} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ l{1} = (elems (dom (restr Unknown FRO.m))){2} /\ !mem l{1} x{1} /\ (FRO.m.[x]=Some(y, Known)){2}). - + inline *;auto=>?&mr[*]3!->/=Hmem Hget;rewrite sampleto_ll=>?_. + + inline *;auto=>?&mr[#]3->/=Hmem Hget;rewrite sampleto_ll=>?_. by rewrite set2_eq_except getP_eq restr_set /= dom_rem -memE !inE negb_and. exists* x{1},y{1},(FRO.m.[x]{1});elim*=>x1 y1 mx1;pose mx2:=Some(y1,Known). call (iter_inv RRO.I (fun z=>x1<>z) (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) - (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[*]-><-2!->->>2!->Hmem->/#. + (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[#]-><-2!->->>2!->Hmem->/#. exists* x{1},y{1},(FRO.m.[x]{1});elim*=>x1 y1 mx1;pose mx2:=Some(y1,Known). call (iter_inv RRO.I (fun z=>x1<>z) (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) - (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[*]-><-2!->->>->/= Hidm. + (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[#]-><-2!->->>->/= Hidm. rewrite restr_set getP_eq/mx2 eq_except_sym set_eq_except/=;split;[split|]. + by congr;apply fsetP=>z;rewrite !(dom_rem,inE,dom_restr) /#. + by move=>z;rewrite -memE dom_restr /#. - move=>_??[*]Hex HLx HRx;apply /eq_sym. + move=>_??[#]Hex HLx HRx;apply /eq_sym. have/(congr1 oget):=HRx=><-;apply eq_except_set_eq=>//;1:by rewrite in_dom HRx. by apply /eq_except_sym. qed. @@ -448,21 +448,21 @@ proof. { Iter(RRO.I).iter_1s(x,elems (dom (restr Unknown FRO.m) `\` fset1 x)); } (={x,FRO.m}/\(in_dom_with FRO.m x Unknown){1}==> ={x,FRO.m}) (={x,FRO.m}/\ (in_dom_with FRO.m x Unknown){1} ==> (rem x FRO.m){1} = FRO.m{2})=>//. - + by move=>?&mr[*]2!->?;exists FRO.m{mr}, x{mr}. - + symmetry;call (iter1_perm RRO.I iter_perm2);skip=>?&mr[*]2!->?/=;split=>//. + + by move=>?&mr[#]2->?;exists FRO.m{mr}, x{mr}. + + symmetry;call (iter1_perm RRO.I iter_perm2);skip=>?&mr[#]2!->?/=;split=>//. by apply /perm_eq_sym/perm_to_rem/dom_restr. inline{1}Iter(RRO.I).iter_1s. seq 3 1: (={x} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ l{1} = (elems (dom (restr Unknown FRO.m))){2} /\ !mem l{1} x{1} /\ (FRO.m.[x]=None){2}). - + inline *;auto=>??[*]2!->Hidm/=;rewrite sampleto_ll=>?_. + + inline *;auto=>??[#]2->Hidm/=;rewrite sampleto_ll=>?_. rewrite eq_except_rem 1:!inE 2:set_eq_except // remP -memE in_fsetD1 negb_and /=. by rewrite restr_rem Hidm /= dom_rem. exists* x{1},(FRO.m.[x]{1});elim*=>x1 mx1. call (iter_inv RRO.I (fun z=>x1<>z) (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=None) _). + by conseq (I_f_eqex x1 mx1 None). - auto=>?&mr[*]3!->^Hex 2!->Hmem ^Hx->/=;split=>[/#|_ mL mR[*]/eq_exceptP Hex'?Heq]. + auto=>?&mr[#]3->^Hex 2!->Hmem ^Hx->/=;split=>[/#|_ mL mR[#]/eq_exceptP Hex'?Heq]. apply fmapP=>z;rewrite remP;case (z=x{mr})=>[->/=|Hneq];1:by rewrite Heq. by apply Hex';rewrite inE. inline RRO.resample;wp. @@ -470,10 +470,10 @@ proof. call (iter_inv RRO.I (fun z=>x1<>z) (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=None) _). + by conseq (I_f_eqex x1 mx1 None). - auto=>?&mr[*]4!->Hin/=. + auto=>?&mr[#]4->Hin/=. rewrite restr_rem Hin/= remP eq_except_rem 1:inE // 1:eq_except_refl /=;split. + by move=>z;rewrite -memE dom_restr /#. - move=>_ mL mR[*] /eq_exceptP Hex'?Heq. + move=>_ mL mR[#] /eq_exceptP Hex'?Heq. apply fmapP=>z;rewrite remP;case (z=x{mr})=>[->/=|Hneq];1:by rewrite Heq. by apply Hex';rewrite inE. qed. @@ -485,9 +485,9 @@ proof. eager proc;inline *;wp. while (={l,FRO.m} /\ (forall z, mem l z => in_dom_with FRO.m z Unknown){1} /\ in_dom_with FRO.m{1} x{1} f{1} = result{2}). - + auto=>?&mr[*]2!->Hz <-?_/=?->/=. + + auto=>?&mr[#]2->Hz <-?_/=?->/=. split=>[z /mem_drop Hm|];rewrite /in_dom_with dom_set getP !inE /#. - by auto=>?&mr/=[*]3!->/=;split=>// z;rewrite -memE dom_restr. + by auto=>?&mr/=[#]3->/=;split=>// z;rewrite -memE dom_restr. qed. lemma eager_restrK: @@ -497,7 +497,7 @@ proof. eager proc;inline *;wp. while (={l,FRO.m} /\ (forall z, mem l z => in_dom_with FRO.m z Unknown){1} /\ restr Known FRO.m{1} = result{2}). - + auto=>?&mr[*]2!->Hz<-?H/=?->/=. + + auto=>?&mr[#]2->Hz<-?H/=?->/=. split=>[z /mem_drop Hm|];1:by rewrite /in_dom_with dom_set getP !inE /#. rewrite restr_set rem_id?dom_restr//. by move:H=>/(mem_head_behead witness) /(_ (head witness l{mr})) /= /Hz /#. @@ -516,21 +516,21 @@ proof. Iter(RRO.I).iter_1s(x,elems ((dom (restr Unknown FRO.m)) `\` fset1 x));} (={x,FRO.m} /\ ! mem (dom FRO.m{2}) x{2} ==> ={x,FRO.m}) (={x,FRO.m} /\ ! mem (dom FRO.m{2}) x{2} ==> ={x,FRO.m})=>//;last first. - + inline{2} RRO.resample;call (iter1_perm RRO.I iter_perm2);auto=>?&mr[*]2!->Hmem/=?->/=. + + inline{2} RRO.resample;call (iter1_perm RRO.I iter_perm2);auto=>?&mr[#]2->Hmem/=?->/=. by apply /perm_eq_sym/perm_to_rem;rewrite restr_set/=dom_set !inE. - + by move=>?&mr[*]2!->?;exists FRO.m{mr}, x{mr}. + + by move=>?&mr[#]2->?;exists FRO.m{mr}, x{mr}. inline Iter(RRO.I).iter_1s RRO.I.f RRO.resample;wp;swap{1}-1. seq 1 7 : (={x} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ l{2} = (elems (dom (restr Unknown FRO.m))){1} /\ (FRO.m.[x]){2} = Some(c{1},Unknown) /\ (FRO.m.[x]){1} = None). - + wp;rnd;auto=>?&mr[*]2!->;rewrite in_dom sampleto_ll/==>Heq?_?->. + + wp;rnd;auto=>?&mr[#]2->;rewrite in_dom sampleto_ll/==>Heq?_?->. rewrite getP_eq restr_set/=dom_set fsetDK eq_except_sym set_set Heq/=set_eq_except/=. congr;apply fsetP=>z;rewrite in_fsetD1 dom_restr /in_dom_with !in_dom /#. exists*x{1},c{1};elim*=>x1 c1;pose mx2:=Some(c1,Unknown). call (iter_inv RRO.I (fun z=>x1<>z) (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= None /\ o2.[x1]=mx2) _). + by conseq (I_f_eqex x1 None mx2). - auto=>?&mr[*]2!<-->^Hex 3!->^Hx1-> @/mx2/=;split=>[z|_ mL mR[*]]. + auto=>?&mr[#]2<-->^Hex 3!->^Hx1-> @/mx2/=;split=>[z|_ mL mR[#]]. + rewrite -memE dom_restr /in_dom_with in_dom /#. rewrite in_dom=>Hex'->HRx/=;apply /eq_sym. have/(congr1 oget):=HRx=><-;apply eq_except_set_eq;1:by rewrite in_dom HRx. @@ -538,7 +538,7 @@ proof. rcondf{2}2;1:by auto. swap{1}2-1;inline*;auto. while (={l,FRO.m} /\ (mem (dom FRO.m) x){1});auto. - by move=>?&mr[*]2!->Hm Hl _/=?->;rewrite dom_set !inE Hm. + by move=>?&mr[#]2->Hm Hl _/=?->;rewrite dom_set !inE Hm. qed. section. @@ -606,12 +606,12 @@ qed. equiv LRO_RRO_set : LRO.set ~ RRO.set : ={x,y} /\ RO.m{1} = restr Known FRO.m{2} ==> RO.m{1} = restr Known FRO.m{2}. -proof. by proc;auto=>?&ml[*]3!->;rewrite restr_set. qed. +proof. by proc;auto=>?&ml[#]3->;rewrite restr_set. qed. equiv LRO_RRO_rem : LRO.rem ~ RRO.rem : ={x} /\ RO.m{1} = restr Known FRO.m{2} ==> RO.m{1} = restr Known FRO.m{2}. proof. - proc;inline *;auto=>?&mr[*]->->. rewrite restr_rem. + proc;inline *;auto=>?&mr[#]->->. rewrite restr_rem. case (in_dom_with FRO.m{mr} x{mr} Known)=>// Hidw. by rewrite rem_id // dom_restr. qed. @@ -675,7 +675,7 @@ proof. + by move=>?&mr[]2!->;exists (glob D){mr},(map(fun _ c =>(c,Known))RO.m{mr}). + by proc; eager call (eager_D D);auto. proc*;inline M.main2;wp;call{1} RRO_resample_ll. - symmetry;call (LRO_RRO_D D);auto=> &ml&mr[*]2!->;split=>//=. + symmetry;call (LRO_RRO_D D);auto=> &ml&mr[#]2->;split=>//=. by rewrite fmapP=>x;rewrite restrP mapP;case (RO.m{ml}.[x]). qed. From 727b76d5edd45b2985a4b4f295d18bacbc6e0b9e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 22 Jan 2016 15:07:49 +0100 Subject: [PATCH 120/394] Some progress on the invariant proofs. --- sha3/proof/old/Handle.eca | 200 +++++++++++++++++++++++++++++++++++++- 1 file changed, 195 insertions(+), 5 deletions(-) diff --git a/sha3/proof/old/Handle.eca b/sha3/proof/old/Handle.eca index b93dea6..c35ae48 100644 --- a/sha3/proof/old/Handle.eca +++ b/sha3/proof/old/Handle.eca @@ -165,7 +165,7 @@ op eqm_handles (handles:handles) (m:smap) (mh:hsmap) = op mh_spec (handles:handles) (m2:smap) (mh:hsmap) (ro:(block list, block)fmap) = (forall bh bh', mh.[bh] = Some bh' => - exists c f c' f', + exists c c' f f', handles.[bh .`2]=Some(c,f) /\ handles.[bh'.`2]=Some(c',f') /\ if f' = Known then m2.[(bh.`1,c)] = Some(bh'.`1,c') /\ f = Known @@ -185,7 +185,7 @@ op paths_spec (handles:handles) (mh:hsmap) (paths:(capacity,block list * block)f build_hpath mh p = Some(v,h) /\ handles.[h] = Some(c,Known). -op handles_spec handles chandle = +op handles_spec handles chandle = huniq handles /\ handles.[0] = Some (c0,Known) /\ forall h, mem (dom handles) h => h < chandle. op INV_CF_G1 (handles:handles) chandle (m1 mi1 m2 mi2:smap) (mh2 mhi2:hsmap) (ro:(block list, block) fmap) paths = @@ -193,6 +193,66 @@ op INV_CF_G1 (handles:handles) chandle (m1 mi1 m2 mi2:smap) (mh2 mhi2:hsmap) (ro (incl m2 m1 /\ incl mi2 mi1) /\ (mh_spec handles m2 mh2 ro /\ paths_spec handles mh2 paths /\ handles_spec handles chandle). +lemma eqm_of_INV (chandle : handle) + (mi1 m2 mi2 : smap) (mhi2 : hsmap) + (ro : (block list, block) fmap) + (paths : (capacity, block list * block) fmap) + handles m1 mh2: + INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => + eqm_handles handles m1 mh2. +proof. by move=> @/INV_CF_G1 [#]. qed. + +lemma eqmi_of_INV (chandle : handle) + (m1 m2 mi2 : smap) (mh2 : hsmap) + (ro : (block list, block) fmap) + (paths : (capacity, block list * block) fmap) + handles mi1 mhi2: + INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => + eqm_handles handles mi1 mhi2. +proof. by move=> @/INV_CF_G1 [#]. qed. + +lemma incl_of_INV (handles : handles) (chandle : handle) + (mi1 mi2 : smap) (mh2 mhi2: hsmap) + (ro : (block list, block) fmap) + (paths : (capacity, block list * block) fmap) + m1 m2: + INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => + incl m2 m1. +proof. by move=> @/INV_CF_G1 [#]. qed. + +lemma incli_of_INV (handles : handles) (chandle : handle) + (m1 m2 : smap) (mh2 mhi2: hsmap) + (ro : (block list, block) fmap) + (paths : (capacity, block list * block) fmap) + mi1 mi2: + INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => + incl mi2 mi1. +proof. by move=> @/INV_CF_G1 [#]. qed. + +lemma mh_of_INV (chandle : handle) + (m1 mi1 mi2 : smap) (mhi2 : hsmap) + (paths : (capacity, block list * block) fmap) + handles m2 mh2 ro: + INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => + mh_spec handles m2 mh2 ro. +proof. by move=> @/INV_CF_G1 [#]. qed. + +lemma paths_of_INV (chandle : handle) + (m1 m2 mi1 mi2: smap) (mhi2: hsmap) + (ro : (block list, block) fmap) + handles mh2 paths: + INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => + paths_spec handles mh2 paths. +proof. by move=> @/INV_CF_G1 [#]. qed. + +lemma handles_of_INV (m1 m2 mi1 mi2 : smap) (mh2 mhi2 : hsmap) + (ro : (block list, block) fmap) + (paths : (capacity, block list * block) fmap) + handles chandle: + INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => + handles_spec handles chandle. +proof. by move=> @/INV_CF_G1 [#]. qed. + lemma eqm_dom_mh_m handles m mh hx2 f (x:state): eqm_handles handles m mh => handles.[hx2] = Some (x.`2, f) => @@ -283,6 +343,76 @@ proof. by apply handles_up_handles. qed. +lemma eqm_handles_up (handles : handles) m mh (h hx:handle) (x y : state) f: + huniq handles => + handles.[h] = None => + handles.[hx] = Some (x.`2, f) => + eqm_handles handles m mh => + eqm_handles handles.[h <- (y.`2,Known)] m.[x <- y] mh.[(x.`1,hx) <- (y.`1,h)]. +proof. +move=> uniq_h h_h h_hx @/eqm_handles [] hmmh hmhm; split. ++ move=> bc bc'; rewrite getP; case (bc = x)=> /= [->> <<- {bc bc'}|]. + * by exists hx, h, f, Known; rewrite !getP /= [smt w=in_dom]. + move=> bc_neq_x /hmmh [] h0 h0' f0 f0' [#] h_h0 h_h0' mhi_bc. + by exists h0, h0', f0, f0'; rewrite !getP [smt w=in_dom]. +move=> bh bh'; rewrite getP; case (bh = (x.`1,hx))=> /= [->> <<- {bh bh'}|]. + * by exists x.`2, y.`2, f, Known; rewrite !getP [smt w=in_dom]. +case bh=> b h0 /=. +rewrite anda_and NewLogic.negb_and=> bh_neq_x1hx /hmhm /= [] c0 c0' f0 f0' [#] h_h0 h_bh' m_bc. +exists c0, c0', f0, f0'; rewrite !getP. +split; 1:smt w=in_dom. +split; 1:smt w=in_dom. +case x bh_neq_x1hx h_hx=> x1 x2 /= => - [/#|h0_neq_hx h_hx]. +have -> //=: c0 <> x2; move: h0_neq_hx; apply/contra. +exact/(uniq_h _ _ _ _ h_h0 h_hx). +qed. + +lemma eqmi_handles_up (handles : handles) mi mhi (h hx : handle) (x y : state) f: + (!exists f', mem (rng handles) (y.`2,f')) => + handles.[h] = None => + handles.[hx] = Some (x.`2, f) => + eqm_handles handles mi mhi => + eqm_handles handles.[h <- (y.`2,Known)] mi.[y <- x] mhi.[(y.`1,h) <- (x.`1,hx)]. +proof. +move=> y_notinr1_handles h_h h_hx @/eqm_handles [] hmmh hmhm; split. ++ move=> bc bc'; rewrite getP; case (bc = y)=> /= [->> <<- {bc bc'}|]. + * by exists h, hx, Known, f; rewrite !getP /= [smt w=in_dom]. + move=> bc_neq_y /hmmh [] h0 h0' f0 f0' [#] h_h0 h_h0' mhi_bc. + by exists h0, h0', f0, f0'; rewrite !getP [smt w=in_dom]. +move=> bh bh'; rewrite getP; case (bh = (y.`1,h))=> /= [->> <<- {bh bh'}|]. + * by exists y.`2, x.`2, Known, f; rewrite !getP [smt w=in_dom]. +case bh=> b h0 /=. +rewrite anda_and NewLogic.negb_and=> bh_neq_y1h /hmhm /= [] c0 c0' f0 f0' [#] h_bh h_bh' mi_bh. +exists c0, c0', f0, f0'; rewrite !getP. +split; 1:smt w=in_dom. +split; 1:smt w=in_dom. +case y bh_neq_y1h y_notinr1_handles=> y1 y2 /= [/#|h0_neq_h y_notinr1_handles]. +have /#: c0 = y2 => false; move=> /(congr1 (fun x=> exists f', mem (rng handles) (x,f'))) /=. +rewrite y_notinr1_handles /= neqF /=; exists f0. +by rewrite in_rng; exists h0. +qed. + +lemma incl_set (m m' : ('a,'b) fmap) x y: + incl m m' => + incl m.[x <- y] m'.[x <- y]. +proof. smt w=(in_dom getP). qed. + +lemma hinv_notin_rng m y2: + SLCommon.hinv m y2 = None => + (forall h f, m.[h] <> Some (y2,f)). +proof. by move=> hinv_none; have:= hinvP m y2; rewrite hinv_none. qed. + +lemma handles_spec_notin_dom m h: + handles_spec m h => + !mem (dom m) h. +proof. smt w=in_dom. qed. + +lemma neq_Known f: f <> Known <=> f = Unknown. +proof. by case f. qed. + +lemma neq_Unkwown f: f <> Unknown <=> f = Known. +proof. by case f. qed. + clone export ConcreteF as ConcreteF1. section AUX. @@ -368,9 +498,48 @@ section AUX. + move=> &ml;skip=> &mr[][]_[][]-> _ []Hinv[]Hndom _[]_ Hh;rewrite -not_def in_dom=> -[]. move:Hinv=>[][][]_ /(_ (x{mr}.`1, hx2{mr}));case (G1.mh{mr}.[_])=>// bh' /(_ bh') [c c' f f'] /=. by rewrite Hh/= => -[][]<- _ []_ H;case: (x{mr}) H Hndom => [x1 x2];rewrite in_dom=>->. - auto. + auto=> &1 &2 [#] -> ->> ->> hinv x_notin_PF disj x2U_notinr_FRO FRO_hx2 /= hinv_y2. + have:= hinvP FRO.m{2} y{2}.`2; rewrite hinv_y2 //= => y2_notinr1_FRO. + rewrite getP /= oget_some /= /INV_CF_G1. + rewrite (eqm_handles_up FRO.m{2} PF.m{1} G1.mh{2} G1.chandle{2} hx2{2} x{2} y{2} Known _ _ _ _) //= 1..3:[smt w=in_dom]. + rewrite (eqmi_handles_up FRO.m{2} PF.mi{1} G1.mhi{2} G1.chandle{2} hx2{2} x{2} y{2} Known _ _ _ _) //= 2..3:[smt w=in_dom]. + + rewrite NewLogic.negb_exists=> f /=; rewrite in_rng NewLogic.negb_exists=> h. + exact/(y2_notinr1_FRO h f). + have /eqT -> /= := incl_set G1.m{2} PF.m{1} x{2} y{2} _; 1: by smt ml=0. + have /eqT -> /= := incl_set G1.mi{2} PF.mi{1} y{2} x{2} _; 1: by smt ml=0. + rewrite handles_up_handles 1:[smt w=in_rng] 1:/# /=. + split. + rewrite /mh_spec; split. + move=> bh [] b ch; rewrite getP; case (bh = (x.`1,hx2){2})=> [<*> /=|]. + rewrite anda_and=> [#] <*>. + exists x{2}.`2, y{2}.`2, Known, Known=> //=. + rewrite !getP /=; elim: (x{2}) FRO_hx2=> x1 x2 FRO_hx2; elim (y{2})=> y1 y2 /=. + have /#: hx2{2} = G1.chandle{2} => false. + move=> /(congr1 (fun x=> FRO.m{2}.[x])) /=; rewrite FRO_hx2. + have:= handles_spec_notin_dom FRO.m{2} G1.chandle{2} _; 1: smt ml=0. + by rewrite in_dom /= => ->. + elim bh=> b' h' /=; rewrite anda_and NewLogic.negb_and=> bh_neq_xhx ^mh_bh. + have @/eqm_handles [] hmmh hmhm := eqm_of_INV _ _ _ _ _ _ _ _ _ _ hinv. + move=> /hmhm=>- [c c' f f'] /= [#] FRO_h' FRO_ch PF_b'c. + exists c, c', f, f'=> //=. + rewrite !getP /=; elim: (x{2}) FRO_hx2 mh_bh x2U_notinr_FRO x_notin_PF bh_neq_xhx=> x1 x2 /= FRO_hx2 mh_bh x2U_notinr_FRO x_notin_PF bh_neq_xhx. + elim: (y{2}) y2_notinr1_FRO hinv_y2=> y1 y2 /= y2_notinr1_FRO hinv_y2. + have -> /=: h' <> G1.chandle{2} by smt w=in_dom. + rewrite FRO_h' /=. + have -> /=: ch <> G1.chandle{2} by smt w=in_dom. + rewrite FRO_ch /=; split=> /= [|/neq_Known ->> {f'}]. + case bh_neq_xhx=> [-> /#|h'_neq_hx2]. + have /#: c <> x2. + have @/handles_spec [] huniq _ := handles_of_INV _ _ _ _ _ _ _ _ _ _ hinv. + by move: h'_neq_hx2; apply/contra/(huniq _ _ (c,f) (x2,Known)). + case disj. + rewrite in_dom; case (paths0.[x{2}.`2])=> @/oget //= [[p0 v]] /= [#] <*>. + admit. (** KEY observation: if two hstates lead to hstates that + share the same handle through mh, then they are equal **) + admit. (* this one should be a lot easier *) + admit. (* some pain here *) + admit. (* will be painful as well *) (* Stopped here *) - admit. admit. (* lossless PF.P.f *) + admit. @@ -391,7 +560,28 @@ section AUX. (* lossless and do not reset bad G1.C.f *) + admit. (* Init ok *) - + admit. + inline *. auto; progress=> //=. + + smt w=map0P. + + smt w=map0P. + + smt w=map0P. + + smt w=map0P. + + smt w=map0P. + + smt w=(map0P in_dom). + + smt w=map0P. + + rewrite /paths_spec=> c p v. rewrite !getP; case (c = c0)=> //=. + rewrite anda_and=> c_c0; split=> [[] <<- <<-|]. + + by exists 0; rewrite /build_hpath /= getP /= c_c0. + move=> [h] @/build_hpath [] h0; rewrite getP; case (h = 0). + + by move=> /= ->> ->>; move: h0; smt. + smt w=map0P. + move=> c_c0; rewrite map0P /= NewLogic.negb_exists /= => h. + rewrite NewLogic.negb_and getP; case (h = 0)=> //=; [|by rewrite map0P]. + by move=> _; right; rewrite eq_sym. + + smt w=(map0P getP). + + by rewrite getP. + + move: H; rewrite in_dom getP; case (h = 0)=> //=. + by rewrite map0P. + + by move: H1=> /H0 [#]. qed. end section AUX. From 086a1a8a2936245ccea12dbfa597c46e992e807c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 22 Jan 2016 15:27:12 +0100 Subject: [PATCH 121/394] Fixing Absorb to Blocks as much as possible. --- sha3/proof/AbsorbToBlocks.ec | 74 ++++++++++++++++++------------------ 1 file changed, 37 insertions(+), 37 deletions(-) diff --git a/sha3/proof/AbsorbToBlocks.ec b/sha3/proof/AbsorbToBlocks.ec index b21bcb3..f22d47c 100644 --- a/sha3/proof/AbsorbToBlocks.ec +++ b/sha3/proof/AbsorbToBlocks.ec @@ -1,6 +1,6 @@ (* -------------------------------------------------------------------- *) require import Option Pair Int Real List FSet NewFMap. -require (*--*) Absorb Blocks. +require (*--*) Absorb Block. (* -------------------------------------------------------------------- *) require import Common. @@ -8,7 +8,7 @@ require import Common. op cast: 'a NewDistr.distr -> 'a distr. (* -------------------------------------------------------------------- *) -module LowerFun(F : Blocks.DFUNCTIONALITY) : Absorb.DFUNCTIONALITY = { +module LowerFun(F : Self.Block.DFUNCTIONALITY) : Absorb.DFUNCTIONALITY = { proc init() = {} proc f(xs : block list) : block = { @@ -22,7 +22,7 @@ module LowerFun(F : Blocks.DFUNCTIONALITY) : Absorb.DFUNCTIONALITY = { } }. -module Sim (S : Absorb.SIMULATOR, F : Blocks.DFUNCTIONALITY) = S(LowerFun(F)). +module Sim (S : Absorb.SIMULATOR, F : Self.Block.DFUNCTIONALITY) = S(LowerFun(F)). module UpperFun (F : Absorb.DFUNCTIONALITY) = { proc init() = {} @@ -43,17 +43,17 @@ module UpperFun (F : Absorb.DFUNCTIONALITY) = { } }. -module BlocksOfAbsorbBlockSponge (P : Blocks.DPRIMITIVE) = +module BlocksOfAbsorbBlockSponge (P : Self.Block.DPRIMITIVE) = UpperFun(Absorb.BlockSponge(P)). -module Dist (D : Blocks.DISTINGUISHER, F : Absorb.DFUNCTIONALITY) = D(UpperFun(F)). +module Dist (D : Self.Block.DISTINGUISHER, F : Absorb.DFUNCTIONALITY) = D(UpperFun(F)). section. - declare module AbsorbSim : Absorb.SIMULATOR { Perm, Blocks.BIRO.IRO', Absorb.Ideal.RO }. - declare module BlocksDist : Blocks.DISTINGUISHER { Perm, Blocks.BIRO.IRO', Absorb.Ideal.RO, AbsorbSim }. + declare module AbsorbSim : Absorb.SIMULATOR { Perm, Self.Block.BIRO.IRO', Absorb.Ideal.RO }. + declare module BlocksDist : Self.Block.DISTINGUISHER { Perm, Self.Block.BIRO.IRO', Absorb.Ideal.RO, AbsorbSim }. local equiv ModularBlocks_Real: - UpperFun(Absorb.BlockSponge(Perm)).f ~ Blocks.BlockSponge(Perm).f: + UpperFun(Absorb.BlockSponge(Perm)).f ~ Self.Block.Sponge(Perm).f: ={arg} /\ ={m,mi}(Perm,Perm) /\ (forall x, mem (dom Perm.m){1} x) @@ -67,15 +67,15 @@ section. qed. pred lower (ro : (block list,block) fmap) (iro : (block list * int,block) fmap) = - Blocks.BIRO.prefix_closed iro /\ + Self.Block.BIRO.prefix_closed iro /\ forall x n, valid_block x => iro.[(x,n)] = ro.[extend x n]. local equiv ModularAbsorb: - UpperFun(Absorb.Ideal.RO).f ~ Blocks.BIRO.IRO'.f: + UpperFun(Absorb.Ideal.RO).f ~ Self.Block.BIRO.IRO'.f: ={arg} - /\ lower Absorb.Ideal.RO.m{1} Blocks.BIRO.IRO'.mp{2} + /\ lower Absorb.Ideal.RO.m{1} Self.Block.BIRO.IRO'.mp{2} ==> ={res} - /\ lower Absorb.Ideal.RO.m{1} Blocks.BIRO.IRO'.mp{2}. + /\ lower Absorb.Ideal.RO.m{1} Self.Block.BIRO.IRO'.mp{2}. proof. proc. sp; if=> //=. inline Absorb.BlockSponge(Perm).f. @@ -92,13 +92,13 @@ section. /\ mem (dom ro) (extend x n')). module LowIRO' : Absorb.FUNCTIONALITY = { - proc init = Blocks.BIRO.IRO'.init + proc init = Self.Block.BIRO.IRO'.init proc f(xs : block list) = { var b <- b0; var (ys, n) = strip xs; if (valid_block ys) { - b <@ Blocks.BIRO.IRO'.f_lazy(ys, n); + b <@ Self.Block.BIRO.IRO'.f_lazy(ys, n); } return b; @@ -106,7 +106,7 @@ section. }. pred holey_map (iro iro_lazy : (block list * int,block) fmap) = - Blocks.BIRO.prefix_closed iro + Self.Block.BIRO.prefix_closed iro /\ (forall xn, mem (dom iro_lazy) xn => iro_lazy.[xn] = iro.[xn]) @@ -120,13 +120,13 @@ section. whose index is not in the index of the right map, as they have not ben given to the adversary. **) local lemma LazifyIRO: - eager [Blocks.BIRO.IRO'.resample_invisible(); , LowerFun(Blocks.BIRO.IRO').f ~ LowIRO'.f, Blocks.BIRO.IRO'.resample_invisible();: - ={arg, Blocks.BIRO.IRO'.visible} - /\ holey_map Blocks.BIRO.IRO'.mp{1} Blocks.BIRO.IRO'.mp{2} - /\ Blocks.BIRO.IRO'.visible{2} = dom (Blocks.BIRO.IRO'.mp){2} - ==> ={res, Blocks.BIRO.IRO'.visible} - /\ holey_map Blocks.BIRO.IRO'.mp{1} Blocks.BIRO.IRO'.mp{2} - /\ Blocks.BIRO.IRO'.visible{2} = dom (Blocks.BIRO.IRO'.mp){2}]. + eager [Self.Block.BIRO.IRO'.resample_invisible(); , LowerFun(Self.Block.BIRO.IRO').f ~ LowIRO'.f, Self.Block.BIRO.IRO'.resample_invisible();: + ={arg, Self.Block.BIRO.IRO'.visible} + /\ holey_map Self.Block.BIRO.IRO'.mp{1} Self.Block.BIRO.IRO'.mp{2} + /\ Self.Block.BIRO.IRO'.visible{2} = dom (Self.Block.BIRO.IRO'.mp){2} + ==> ={res, Self.Block.BIRO.IRO'.visible} + /\ holey_map Self.Block.BIRO.IRO'.mp{1} Self.Block.BIRO.IRO'.mp{2} + /\ Self.Block.BIRO.IRO'.visible{2} = dom (Self.Block.BIRO.IRO'.mp){2}]. proof. (* eager proc. @@ -198,13 +198,13 @@ section. *) lemma Intermediate &m: - `|Pr[Blocks.RealIndif(Blocks.BlockSponge,Perm,BlocksDist).main() @ &m :res] - - Pr[Blocks.IdealIndif(Blocks.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]| - = `|Pr[Blocks.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] - - Pr[Blocks.IdealIndif(UpperFun(Absorb.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res]|. + `|Pr[Self.Block.RealIndif(Self.Block.Sponge,Perm,BlocksDist).main() @ &m :res] + - Pr[Self.Block.IdealIndif(Self.Block.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]| + = `|Pr[Self.Block.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] + - Pr[Self.Block.IdealIndif(UpperFun(Absorb.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res]|. proof. - have ->: Pr[Blocks.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] - = Pr[Blocks.RealIndif(Blocks.BlockSponge,Perm,BlocksDist).main() @ &m :res]. + have ->: Pr[Self.Block.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] + = Pr[Self.Block.RealIndif(Self.Block.Sponge,Perm,BlocksDist).main() @ &m :res]. byequiv=> //=; proc. call (_: ={m,mi}(Perm,Perm) /\ (forall x, mem (dom Perm.m){1} x)). @@ -219,14 +219,14 @@ section. (* Now the other initialization is dead code. *) call (_: true ==> true)=> //. by proc; auto. - have ->: Pr[Blocks.IdealIndif(UpperFun(Absorb.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res] - = Pr[Blocks.IdealIndif(Blocks.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]. + have ->: Pr[Self.Block.IdealIndif(UpperFun(Absorb.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res] + = Pr[Self.Block.IdealIndif(Self.Block.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]. byequiv=> //=; proc. - call (_: ={glob AbsorbSim} /\ lower Absorb.Ideal.RO.m{1} Blocks.BIRO.IRO'.mp{2}). - proc (lower Absorb.Ideal.RO.m{1} Blocks.BIRO.IRO'.mp{2})=> //=. + call (_: ={glob AbsorbSim} /\ lower Absorb.Ideal.RO.m{1} Self.Block.BIRO.IRO'.mp{2}). + proc (lower Absorb.Ideal.RO.m{1} Self.Block.BIRO.IRO'.mp{2})=> //=. proc; sp; if=> //=. smt. call ModularAbsorb; auto; smt. - proc (lower Absorb.Ideal.RO.m{1} Blocks.BIRO.IRO'.mp{2})=> //=. + proc (lower Absorb.Ideal.RO.m{1} Self.Block.BIRO.IRO'.mp{2})=> //=. proc; sp; if=> //=. smt. call ModularAbsorb; auto; smt. (* Re-Bug *) @@ -238,15 +238,15 @@ section. qed. lemma Remainder &m: - `|Pr[Blocks.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] - - Pr[Blocks.IdealIndif(UpperFun(Absorb.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res]| + `|Pr[Self.Block.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] + - Pr[Self.Block.IdealIndif(UpperFun(Absorb.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res]| = `|Pr[Absorb.RealIndif(Absorb.BlockSponge,Perm,Dist(BlocksDist)).main() @ &m: res] - Pr[Absorb.IdealIndif(Absorb.Ideal.RO,AbsorbSim,Dist(BlocksDist)).main() @ &m: res]|. proof. admit. qed. lemma Conclusion &m: - `|Pr[Blocks.RealIndif(Blocks.BlockSponge,Perm,BlocksDist).main() @ &m: res] - - Pr[Blocks.IdealIndif(Blocks.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]| + `|Pr[Self.Block.RealIndif(Self.Block.Sponge,Perm,BlocksDist).main() @ &m: res] + - Pr[Self.Block.IdealIndif(Self.Block.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]| = `|Pr[Absorb.RealIndif(Absorb.BlockSponge,Perm,Dist(BlocksDist)).main() @ &m: res] - Pr[Absorb.IdealIndif(Absorb.Ideal.RO,AbsorbSim,Dist(BlocksDist)).main() @ &m: res]|. proof. by rewrite (Intermediate &m) (Remainder &m). qed. From d56a0bc14652245ac9112b0d0d38a36168891b34 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 22 Jan 2016 15:37:40 +0100 Subject: [PATCH 122/394] Removing obsolete definition file. SLCommon contains the defs for the Core transformation. --- sha3/proof/old/Squeezeless.ec | 1230 --------------------------------- 1 file changed, 1230 deletions(-) delete mode 100644 sha3/proof/old/Squeezeless.ec diff --git a/sha3/proof/old/Squeezeless.ec b/sha3/proof/old/Squeezeless.ec deleted file mode 100644 index a0345bc..0000000 --- a/sha3/proof/old/Squeezeless.ec +++ /dev/null @@ -1,1230 +0,0 @@ - -(** 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 Pred Fun Option Pair Int Real List FSet NewFMap Utils Common. - -require (*..*) RndOrcl Indifferentiability. -(*...*) import Dprod Dexcepted Capacity. - -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 *) -op max_size : int. - -(** Ideal Functionality **) -clone import Tuple as TupleBl with - type t <- block, - op Support.enum <- Block.words - 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. - -clone RndOrcl as RndOrclB with - type from <- block list, - type to <- block. - -clone import RndOrclB.RestrIdeal as Functionality with - op sample _ <- bdistr, - op test l <- List.size l <= max_size, - op univ <- bl_univ, - op dfl <- b0 - proof *. -realize sample_ll by exact Block.DWord.bdistr_ll. -realize testP. -proof. - move=> x; rewrite mem_oflist-flattenP; split=>[_|[s[/mkseqP[i[/=_->>]]/wordnP->/#]]]. - exists (wordn (size x));cut Hsx := size_ge0 x. - rewrite wordnP max_ler //= mkseqP /=;exists (size x);smt ml=0. -qed. - -(** We can now define the squeezeless sponge construction **) -module SqueezelessSponge (P:PRIMITIVE): CONSTRUCTION(P), FUNCTIONALITY = { - proc init () = {} - - proc f(p : block list): block = { - var (sa,sc) <- (b0,c0); - - if (1 <= size p /\ p <> [b0]) { - while (p <> []) { (* Absorption *) - (sa,sc) <@ P.f((sa +^ head witness p,sc)); - p <- behead p; - } - } - return sa; (* Squeezing phase (non-iterated) *) - } -}. - -module Count = { var c:int }. - -module DCount (D:DISTINGUISHER, F:DFUNCTIONALITY, P:DPRIMITIVE) = { - - module Fc = { - proc f (bs:block list) = { - var b; - Count.c <- Count.c + size bs; - b <@ F.f(bs); - return b; - } - } - - module Pc = { - proc f (x:state) = { - var y; - Count.c <- Count.c + 1; - y <@ P.f(x); - return y; - } - - proc fi(x:state) = { - var y; - Count.c <- Count.c + 1; - y <@ P.fi(x); - return y; - } - } - - proc distinguish = D(Fc,Pc).distinguish - -}. - -module DRestr (D:DISTINGUISHER, F:DFUNCTIONALITY, P:DPRIMITIVE) = { - var count:int - - module Fc = { - proc f (bs:block list) = { - var b = b0; - if (Count.c + size bs <= max_size) { - Count.c <- Count.c + size bs; - b <@ F.f(bs); - } - return b; - } - } - - module Pc = { - proc f (x:state) = { - var y; - if ( - count <- count + 1; - y <@ P.f(x); - return y; - } - - proc fi(x:state) = { - var y; - count <- count + 1; - y <@ P.fi(x); - return y; - } - } - - proc distinguish = D(Fc,Pc).distinguish - -}. - - - - -module type DPRIMITIVE = { - proc f(x : p): p - proc fi(x : p): p -}. - -module type FUNCTIONALITY = { - proc init(): unit - proc f(x : f_in): f_out -}. - -module type DFUNCTIONALITY = { - proc f(x : f_in): f_out -}. - - - (** Result (expected): The distance between Concrete and Concrete_F - is bounded by N^2/|state|, where N is the total cost (in terms - of queries to P and P^-1) of the adversary's queries **) - - (** TODO: express and prove **) - - (** And now for the interesting bits **) - (** Inform the primitive interface of queries made by the - distinguisher on its functionality interface, keep track of - primitive call paths in a coloured graph. **) - (** The following invariants should always hold at adversary - boundaries (they may be violated locally, but should always be - fixed (say, by setting bad) before returning control, and the - adversary should not be able to violate them himself): - - if paths[x] = (_,(p,v)), then following path p through m - from (0^r,0^c) leads to state (v,x); (in particular, this - implies (v,x) \in rng m; - - unless bad occurs (identify which ones), for every sc, there - is at most one sa such that (sa,sc) \in rng m; - - unless bad occurs (identify which ones), if paths[x] = - (o,(p,_)) and paths[x'] = (o',(p++p',_)), then o' <= o; - (todo: maybe change the direction of that order relation so - it corresponds to "order of appearance along paths"?) - - The next step in the proof will probably be to eagerly sample - all values of the rate and introduce some indirection on - capacities so that they are only sampled (and propagated) just - before being given to the adversary. This is easier to do if all - samplings are independent, hence the move away from a random - permutation. Some side-effects remain worrying. - **) - type caller = [ I | D ]. - - op (<=) (o1 o2 : caller) = o1 = I \/ o2 = D. - - op max (o1 o2 : caller) = - with o1 = I => o2 - with o1 = D => D. - - pred is_pre_permutation (m mi : ('a,'a) fmap) = - (forall x, mem (rng m) x => mem (dom mi) x) - /\ (forall x, mem (rng mi) x => mem (dom m) x). - - lemma half_permutation_set (m' mi' : ('a,'a) fmap) x' y': - (forall x, mem (rng m') x => mem (dom mi') x) - => (forall x, mem (rng m'.[x' <- y']) x => mem (dom mi'.[y' <- x']) x). - proof. - move=> h x0. - rewrite rng_set domP !in_fsetU in_fset1 => -[/rng_rem_le in_rng|//=]. - by rewrite h. - 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. - - type handle = int. - - type hstate = block * handle. - - type ccapacity = capacity * caller. - - type smap = (state , state ) fmap. - type hsmap = (hstate, hstate ) fmap. - type handles = (handle, ccapacity) fmap. - -lemma get_oget (m:('a,'b)fmap) (x:'a) : mem (dom m) x => m.[x] = Some (oget m.[x]). -proof. by rewrite in_dom;case (m.[x]). qed. - -lemma find_set (m:('a,'b) fmap) y x (p:'a -> 'b -> bool): - (forall x, mem (dom m) x => !p x (oget m.[x])) => - find p m.[x <- y] = if p x y then Some x else None. -proof. - cut [[a []->[]] | []-> Hp Hnp]:= findP p (m.[x<-y]);1: rewrite getP dom_set !inE /#. - by case (p x y)=> //; cut := Hp x;rewrite getP dom_set !inE /= oget_some. -qed. - -require import StdOrder IntOrder. -require import Ring. - - (* Operators and properties of handles *) - op hinv (handles:handles) (c:capacity) = - find (fun _ => pred1 c \o fst) handles. - - op hinvD (handles:handles) (c:capacity) = - find (fun _ => pred1 (c,D)) 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. - cut @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := - findP (fun (_ : handle) => pred1 c \o fst) handles. - + by exists (oget handles.[h]).`2;rewrite oget_some get_oget;2:case (oget handles.[h]). - by rewrite -not_def=> Heq; cut := H h;rewrite in_dom Heq. - qed. - - lemma huniq_hinv (handles:handles) (h:handle): - huniq handles => mem (dom handles) h => hinv handles (oget handles.[h]).`1 = Some h. - proof. - move=> Huniq;pose c := (oget handles.[h]).`1. - cut:=Huniq h;cut:=hinvP handles c. - case (hinv _ _)=> /=[Hdiff _| h' +/(_ h')];1:by rewrite in_dom /#. - by move=> [f ->] /(_ (oget handles.[h]) (c,f)) H1 H2;rewrite H1 // get_oget. - qed. - - lemma hinvDP handles c: - if hinvD handles c = None then forall h, handles.[h] <> Some(c,D) - else handles.[oget (hinvD handles c)] = Some(c,D). - proof. - cut @/pred1/=[[h []->[]Hmem ]|[]->H h ]/= := - findP (fun (_ : handle) => pred1 (c,D)) handles. - + by rewrite oget_some get_oget. - by rewrite -not_def=> Heq; cut := H h;rewrite in_dom Heq. - qed. - - lemma huniq_hinvD (handles:handles) c: - huniq handles => mem (rng handles) (c,D) => handles.[oget (hinvD handles c)] = Some(c,D). - proof. - move=> Huniq;rewrite in_rng=> -[h]H;case: (hinvD _ _) (Huniq h) (hinvDP handles c)=>//=. - by move=>_/(_ h);rewrite H. - qed. - - lemma huniq_hinvD_h h (handles:handles) c: - huniq handles => handles.[h] = Some (c,D) => hinvD handles c = Some h. - proof. - move=> Huniq;case: (hinvD _ _) (hinvDP handles c)=>/= [H|h'];1: by apply H. - by rewrite oget_some=> /Huniq H/H. - qed. - - - - - - - - - - - - - - - - - - - - -op check_hpath (mh:(hstate, hstate) fmap) (handles:(handle, ccapacity) fmap) (xs:block list) (c:capacity) = - obind (fun (sah:hstate) => if c = sah.`2 then Some sah.`1 else None) - (build_hpath mh xs). - - if sah <> None then - - else None - -hpath - let step = fun (sah:hstate option ) (x:block) => - if sah = None then None - else - let sah = oget sah in - mh.[(sah.`1 +^ x, sah.`2)] in - foldl step (Some (b0,0)) xs. - - - - - - - -fun sah => mh.fun (sah:hstate) (cont=> - if mem - - -op INV2 (m mi:(state , state ) fmap) (mh mhi:(hstate, hstate) fmap) (handles:(handle, ccapacity) fmap) chandle = - dom mh = rng mhi /\ dom mhi = rng mh /\ - (forall xh, mem (dom mh `|` rng mh) xh => mem (dom handles) xh.`2) /\ - (forall h, mem (dom handles) h => h < chandle) /\ - (forall xh, mem (dom mh) xh => mem (dom m) (xh.`1, (oget handles.[xh.`2]).`1) \/ (oget handles.[xh.`2]).`2 = I) /\ - (forall xh, mem (dom mhi) xh => mem (dom mi) (xh.`1, (oget handles.[xh.`2]).`1) \/ (oget handles.[xh.`2]).`2 = I). - - -lemma hinvD_rng x (handles:(handle, ccapacity) fmap): - mem (rng handles) (x, D) => - handles.[oget (hinvD handles x)]= Some(x, D). -proof. - cut[ [a []->[]] | []->/=Hp ]/=:= findP (fun _ z => z = (x, D)) handles. - + by rewrite oget_some=> ? <- _;apply get_oget. - by rewrite in_rng=> -[a Ha];cut := Hp a; rewrite in_dom Ha oget_some. -qed. - -(* TODO: change the name *) -lemma map_perm (m mi: ('a, 'a) fmap) x y: !mem (dom mi) y => dom m = rng mi => dom m.[x<-y] = rng mi.[y<- x]. -proof. - move=> Hdom Heq;rewrite fsetP=> w;rewrite dom_set in_rng !inE;split. - + rewrite Heq in_rng. case (w=x)=> -[->|Hneq/=[a Ha]];1:by exists y;rewrite getP. - exists a;rewrite getP;case (a=y)=>[->>|//]. - by move:Hdom;rewrite in_dom Ha. - rewrite Heq in_rng;by move=>[a];rewrite getP;case(a=y)=>[->>/# |_ <-];left;exists a. -qed. - -local hoare test_f : G2.S.f : INV2 G2.m G2.mi G2.mh G2.mhi G2.handles G2.chandle (*/\ INV2 G2.mi G2.mhi G2.handles*) ==> - INV2 G2.m G2.mi G2.mh G2.mhi G2.handles G2.chandle. -proof. - proc;if;last by auto. - auto;conseq (_ :_ ==> true)=> //. - move=> &hr [][]Hmhmhi[]Hmhimh[]Hdomh[]Hhbound[]Hmhor Hmhior Hnmem y _;split;beta iota. - + move=> Hnrng handles chandle hx2 @/handles. - cut ->>{hx2} : hx2 = G2.chandle{hr}. - + rewrite /hx2 /handles /hinvD find_set /pred1 //=. - move=> x2 Hx2;cut := Hnrng;rewrite in_rng NewLogic.negb_exists /= => /(_ x2). - by rewrite get_oget. - split=> /= [[Hmem _] | Hmem]. - + by cut /Hhbound // := Hdomh (x{hr}.`1, G2.chandle{hr}) _; rewrite inE;left. - do !apply andI. - + apply map_perm=> //;rewrite -not_def=> H. - by cut /#:= Hhbound chandle _;apply (Hdomh (y.`1,chandle));rewrite !inE -Hmhimh H. - + apply map_perm=> //;rewrite -not_def=> H. - by cut /#:= Hhbound G2.chandle{hr} _;apply (Hdomh (x{hr}.`1,G2.chandle{hr}));rewrite !inE H. - + move=>[x1 h];cut := Hdomh (x1,h). - rewrite !(dom_set, rng_set, inE) /==>H1 [[H2|[_->]]|[/rng_rem_le H2|[_->]]]//; - by rewrite H1 ?H2. - + by move=> h;cut := Hhbound h;rewrite !dom_set !inE /= => H [[/H|]|->>]/#. - + move=>[x1 h];rewrite !getP !dom_set !inE /==> -[|[]->> ->>];rewrite /chandles /=. - + move=>Hh. cut /Hhbound/=:= Hdomh (x1,h) _;1:by rewrite !inE Hh. - move=> ^Hlt /IntOrder.gtr_eqF; rewrite eq_sym=>->. - by cut ->/#: h <> G2.chandle{hr} + 1 by smt ml=0. - cut ->/=: G2.chandle{hr} <> G2.chandle{hr} + 1 by smt ml=0. - by rewrite oget_some /#. - move=>[x1 h];rewrite !getP !dom_set !inE /==> -[|[]->> ->>];rewrite /chandles /=. - + move=>Hh; cut /Hhbound/=:= Hdomh (x1,h) _;1:by rewrite !inE -Hmhimh Hh. - move=> ^Hlt /IntOrder.gtr_eqF; rewrite eq_sym=>->. - by cut ->/#: h <> G2.chandle{hr} + 1 by smt ml=0. - by rewrite oget_some /#. - move=> /= Hrng;cut Hget:= hinvD_rng _ _ Hrng;split=> /=. - + move=> []/Hmhor /= [] ; rewrite Hget oget_some /#. - move=> Hnot;do !apply andI. - + apply map_perm=> //;rewrite -not_def=> H. - by cut /#:= Hhbound G2.chandle{hr} _;apply (Hdomh (y.`1,G2.chandle{hr})); - rewrite !inE -Hmhimh H. - + apply map_perm=> //;rewrite -not_def=> H. - by cut := Hmhor _ H;move: Hnmem;rewrite Hget oget_some /=;case (x{hr}). - + move=> [x1 h];rewrite !(dom_set,rng_set, inE) => -[[H|[_ ->]]| [/rng_rem_le H|[_->]]]//=. - + by left;apply (Hdomh (x1,h));rewrite inE H. - + by left;rewrite in_dom Hget. - by left;apply (Hdomh (x1,h));rewrite inE H. - + by move=>h;rewrite dom_set !inE=> -[/Hhbound|->]/#. - + move=> [x1 h];rewrite !(dom_set, getP, inE) /==> -[H|[->> ->>]]. - + by cut /IntOrder.ltr_eqF->/#:= Hhbound h _;1:by apply (Hdomh (x1,h));rewrite inE H. - cut ->/=:oget (hinvD G2.handles{hr} x{hr}.`2) <> G2.chandle{hr}. - + by cut /#:= Hhbound (oget (hinvD G2.handles{hr} x{hr}.`2)) _;1:by rewrite in_dom Hget. - by rewrite Hget oget_some /=;right;case (x{hr}). - move=> [x1 h];rewrite !(dom_set, getP, inE) /==> -[H|[->> ->> /=]]. - + by cut /IntOrder.ltr_eqF->/#:= Hhbound h _;1: apply (Hdomh (x1,h));rewrite inE -Hmhimh H. - by rewrite oget_some /=;right;case y. -qed. - -local hoare test_fi : G2.S.fi : INV2 G2.m G2.mi G2.mh G2.mhi G2.handles G2.chandle ==> - INV2 G2.m G2.mi G2.mh G2.mhi G2.handles G2.chandle. -proof. - proc;if;last by auto. - auto. move=> &hr [][]Hmhmhi[]Hmhimh[]Hdomh[]Hhbound[]Hmhor Hmhior Hnmem;split;beta iota. - + move=> Hnrng handles chandle hx2 @/handles y Hy. - cut ->>{hx2} : hx2 = G2.chandle{hr}. - + rewrite /hx2 /handles /hinvD find_set /pred1 //=. - move=> x2 Hx2;cut := Hnrng;rewrite in_rng NewLogic.negb_exists /= => /(_ x2). - by rewrite get_oget. - split=> /= [[Hmem _] | Hmem]. - + by cut /Hhbound // := Hdomh (x{hr}.`1, G2.chandle{hr}) _;rewrite inE -Hmhimh;right. - do !apply andI. - + apply map_perm=> //;rewrite -not_def=> H. - by cut /#:= Hhbound G2.chandle{hr} _;apply (Hdomh (x{hr}.`1,G2.chandle{hr})); - rewrite !inE -Hmhimh H. - + apply map_perm=> //;rewrite -not_def=> H. - by cut /#:= Hhbound chandle _;apply (Hdomh (y.`1,chandle));rewrite !inE -Hmhimh H. - + move=>[x1 h];cut := Hdomh (x1,h). - rewrite !(dom_set, rng_set, inE) /==>H1 [[H2|[_->]]|[/rng_rem_le H2|[_->]]]//; - by rewrite H1 ?H2. - + by move=> h;cut := Hhbound h;rewrite !dom_set !inE /= => H [[/H|]|->>]/#. - + move=>[x1 h];rewrite !getP !dom_set !inE /==> -[|[]->> ->>];rewrite /chandles /=. - + move=>Hh; cut /Hhbound/=:= Hdomh (x1,h) _;1:by rewrite !inE -Hmhimh Hh. - move=> ^Hlt /IntOrder.gtr_eqF; rewrite eq_sym=>->. - by cut ->/#: h <> G2.chandle{hr} + 1 by smt ml=0. - by rewrite oget_some /#. - move=>[x1 h];rewrite !getP !dom_set !inE /==> -[|[]->> ->>];rewrite /chandles /=. - + move=>Hh;cut /Hhbound/=:= Hdomh (x1,h) _;1:by rewrite !inE -Hmhimh Hh. - move=> ^Hlt /IntOrder.gtr_eqF; rewrite eq_sym=>->. - by cut ->/#: h <> G2.chandle{hr} + 1 by smt ml=0. - cut ->/=: G2.chandle{hr} <> G2.chandle{hr} + 1 by smt ml=0. - by rewrite oget_some /#. - move=> /= Hrng y Hy;cut Hget:= hinvD_rng _ _ Hrng;split=> /=. - + move=> []/Hmhior /= [] ; rewrite Hget oget_some /#. - move=> Hnot;do !apply andI. - + apply map_perm=> //;rewrite -not_def=> H. - by cut := Hmhior _ H;move: Hnmem;rewrite Hget oget_some /=;case (x{hr}). - + apply map_perm=> //;rewrite -not_def=> H. - by cut /#:= Hhbound G2.chandle{hr} _;apply (Hdomh (y.`1,G2.chandle{hr})); - rewrite !inE -Hmhimh H. - + move=> [x1 h];rewrite !(dom_set,rng_set, inE) => -[[H|[_ ->]]| [/rng_rem_le H|[_->]]]//=. - + by left;apply (Hdomh (x1,h));rewrite inE H. - + by left;apply (Hdomh (x1,h));rewrite inE H. - by left;rewrite in_dom Hget. - + by move=>h;rewrite dom_set !inE=> -[/Hhbound|->]/#. - + move=> [x1 h];rewrite !(dom_set, getP, inE) /==> -[H|[->> ->> /=]]. - + by cut /IntOrder.ltr_eqF->/#:= Hhbound h _;1: apply (Hdomh (x1,h));rewrite inE -Hmhimh H. - by rewrite oget_some /==>{Hy};right;case y. - move=> [x1 h];rewrite !(dom_set, getP, inE) /==> -[H|[->> ->>]]. - + by cut /IntOrder.ltr_eqF->/#:= Hhbound h _;1:apply (Hdomh (x1,h));rewrite inE -Hmhimh H. - cut ->/=:oget (hinvD G2.handles{hr} x{hr}.`2) <> G2.chandle{hr}. - + by cut /#:= Hhbound (oget (hinvD G2.handles{hr} x{hr}.`2)) _;1:by rewrite in_dom Hget. - by rewrite Hget oget_some /=;right;case (x{hr}). -qed. - -local hoare test_C : G2.C.f : INV2 G2.m G2.mi G2.mh G2.mhi G2.handles G2.chandle ==> - INV2 G2.m G2.mi G2.mh G2.mhi G2.handles G2.chandle. - - -local module Game3 = { - var m, mi : (state , state ) fmap - var mh, mhi : (hstate, hstate) fmap - var handles : (handle, ccapacity) fmap - var chandle : int - var paths : (capacity, block list * block) fmap - var bext : bool - - - module C = { - proc init(): unit = { } - - proc f(p : block list): block = { - var h, i <- 0; - var (sa,sc) <- (b0,c0); - var sa'; - - if (1 <= size p /\ p <> [b0]) { - while (i < size p - 1 /\ mem (dom m) (sa +^ nth witness p i, sc)) { - (sa, sc) <- oget m.[(sa +^ nth witness p i, sc)]; - (sa', h) <- oget mh.[(sa +^ nth witness p i, h)]; - i <- i + 1; - } - while (i < size p) { - sc <$ cdistr; - sa' <- RO.f(take i p); - mh.[(sa,h)] <- (sa', chandle); - mhi.[(sa',chandle)] <- (sa,h); - (sa,h) <- (sa',chandle); - handles.[chandle] <- (sc,I); - chandle <- chandle + 1; - i <- i + 1; - } - sa <- RO.f(p); - } - return sa; - } - } - - module S = { - (** Inner interface **) - proc f(x : state): state = { - var p, v, y, y1, y2, hy2, hx2; - - if (!mem (dom m) x) { - if (mem (dom paths) x.`2) { - (p,v) <- oget paths.[x.`2]; - y1 <- RO.f (rcons p (v +^ x.`1)); - y2 <$ cdistr; - y <- (y1, y2); - paths.[y2] <- (rcons p (v +^ x.`1), y.`1); - } else { - y <$ dstate; - } - bext <- bext \/ mem (rng handles) (x.`2, I); - (* exists x2 h, handles.[h] = Some (X2,I) *) - if (!(mem (rng handles) (x.`2, D))) { - handles.[chandle] <- (x.`2, D); - chandle <- chandle + 1; - } - hx2 <- oget (hinvD handles x.`2); - if (mem (dom mh) (x.`1, hx2)) { - hy2 <- (oget mh.[(x.`1, hx2)]).`2; - handles.[hy2] <- (y.`2, D); - (* bad <- bad \/ mem X2 y.`2; *) - m.[x] <- y; - mh.[(x.`1, hx2)] <- (y.`1, hy2); - mi.[y] <- x; - mhi.[(y.`1, hy2)] <- (x.`1, hx2); - } else { - hy2 <- chandle; - chandle <- chandle + 1; - handles.[hy2] <- (y.`2, D); - m.[x] <- y; - mh.[(x.`1, hx2)] <- (y.`1, hy2); - mi.[y] <- x; - mhi.[(y.`1, hy2)] <- (x.`1, hx2); - } - } else { - y <- oget m.[x]; - } - return y; - } - - proc fi(x : state): state = { - var y, y1, y2, hx2, hy2; - - if (!mem (dom mi) x) { - bext <- bext \/ mem (rng handles) (x.`2, I); - (* exists x2 h, handles.[h] = Some (X2,I) *) - if (!(mem (rng handles) (x.`2, D))) { - handles.[chandle] <- (x.`2, D); - chandle <- chandle + 1; - } - hx2 <- oget (hinvD handles x.`2); - if (mem (dom mhi) (x.`1, hx2)) { - (y1,hy2) <- oget mhi.[(x.`1, hx2)]; - y2 <$ cdistr; - y <- (y1,y2); - handles.[hy2] <- (y.`2, D); - (* bad <- bad \/ mem X2 y.`2; *) - mi.[x] <- y; - mhi.[(x.`1, hx2)] <- (y.`1, hy2); - m.[y] <- x; - mh.[(y.`1, hy2)] <- (x.`1, hx2); - } else { - y <$ dstate; - hy2 <- chandle; - chandle <- chandle + 1; - handles.[hy2] <- (y.`2, D); - 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; - } - - (** Distinguisher interface **) - proc init() = { } - - } - - - - proc main(): bool = { - var b; - - m <- map0; - mi <- map0; - bext <- false; - - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - handles <- map0.[0 <- (c0, D)]; - paths <- map0.[c0 <- ([<:block>],b0)]; - chandle <- 1; - b <@ D(C,S).distinguish(); - return b; - } - }. - - - - - local module Game1 = { - var m, mi : (hstate,hstate) fmap - var paths : (handle,(block list * block) list) fmap - var handles : (handle, ccapacity) fmap - var bext, bred, bcoll : bool - var chandle : int - - module S = { - (** Inner interface **) - proc fg(o : caller, x : state): state = { - var o', p, v, y, y1, y2, ox2, hx2, y1h; - - ox2 <- hinv handles x.`2; - hx2 <- oget ox2; - bext <- bext \/ - (o = D /\ ox2 <> None /\ paths.[hx2] <> None /\ - find_path m D paths hx2 = None); - - - if (ox2 = None) { - handles.[chandle] <- (x.`2,o); - hx2 <- chandle; - chandle <- chandle + 1; - } - - if (!mem (dom m) (x.`1, hx2) || (oget handles.[hx2]).`2 = I /\ o = D) { - if (mem (dom paths) hx2 /\ find_path m o paths hx2 <> None) { - (p,v) <- oget (find_path m o paths hx2); - y1 <- RO.f (rcons p (v +^ x.`1)); - y2 <$ cdistr; - y <- (y1, y2); - if (hinv handles y.`2 = None) - paths.[chandle (*y2*)] <- extend_paths x.`1 y.`1 (oget paths.[hx2]); - } else { - y <$ dstate; - } - if (hinv handles y.`2 = None) { - y1h <- (y.`1, chandle); - handles.[chandle] <- (y.`2, o); - m.[(x.`1, hx2)] <- y1h; - mi.[y1h] <- (x.`1, hx2); - handles.[hx2] <- (x.`2, max o (oget handles.[hx2]).`2); (* Warning: not sure we want it *) - chandle <- chandle + 1; - } else { - bcoll <- true; - } - } else { (* mem (dom m) (x.`1, hx2) /\ (!dom m with I \/ o <> D) *) - y1h <- oget m.[(x.`1,hx2)]; - (y2,o') <- oget handles.[y1h.`2]; - handles.[y1h.`2] <- (y2, max o o'); - handles.[hx2] <- (x.`2, max o (oget handles.[hx2]).`2); - y <- (y1h.`1, y2); - } - return y; - } - - proc f(x:state):state = { - var r; - r <@ fg(D,x); - return r; - } - - proc fi(x : state): state = { - var o', y, y2, ox2, hx2, y1h; - - ox2 <- hinv handles x.`2; - hx2 <- oget ox2; - - if (ox2 = None) { - handles.[chandle] <- (x.`2,D); - hx2 <- chandle; - chandle <- chandle + 1; - } - - if (!mem (dom mi) (x.`1,hx2) || (oget handles.[hx2]).`2 = I) { - y <$ dstate; - if ( hinv handles y.`2 = None) { - y1h <- (y.`1, chandle); - handles.[chandle] <- (y.`2, D); - mi.[(x.`1, hx2)] <- y1h; - m.[y1h] <- (x.`1, hx2); - handles.[hx2] <- ((oget handles.[hx2]).`1, D); - chandle <- chandle + 1; - } else { - bcoll <- true; - } - - } else { - y1h <- oget mi.[(x.`1,hx2)]; - (y2,o') <- oget handles.[y1h.`2]; - bred <- bred \/ o' = I; - handles.[y1h.`2] <- (y2, D); - handles.[hx2] <- (x.`2, D); - y <- (y1h.`1, y2); - - } - return y; - } - - (** Distinguisher interface **) - proc init() = { } - - } - - module C = { - proc init(): unit = { } - - proc f(p : block list): block = { - var (sa,sc) <- (b0,c0); - - if (1 <= size p /\ p <> [b0]) { - while (p <> []) { - (sa,sc) <@ S.fg(I,(sa ^ head witness p,sc)); - p <- behead p; - } - } - return sa; - } - } - - proc main(): bool = { - var b; - - m <- map0; - mi <- map0; - bext <- false; - bred <- false; - bcoll <- false; - bsuff <- false; - bmitm <- false; - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - handles <- map0.[0 <- (c0, D)]; - paths <- map0.[0 <- ([<:block>],b0,D)]; - chandle <- 1; - b <@ D(C,S).distinguish(); - return b; - } - }. - - - - - -module M = { - proc f () : unit = { - var x; - var l:int list; - l = []; - } -}. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - (** Result: the instrumented system and the concrete system are - perfectly equivalent **) - local equiv Game0_P_S_eq: - Concrete_F.P.f ~ Game0.S.fg: - arg{1} = arg{2}.`2 - /\ ={m,mi}(Concrete_F,Game0) - /\ is_pre_permutation (Concrete_F.m){1} (Concrete_F.mi){1} - ==> ={res} - /\ ={m,mi}(Concrete_F,Game0) - /\ is_pre_permutation (Concrete_F.m){1} (Concrete_F.mi){1}. - proof. - proc. inline *. - sp; if=> //=; 2:by auto. - auto; progress [-split]. - by rewrite pre_permutation_set. - qed. - - local equiv Game0_Pi_Si_eq: - Concrete_F.P.fi ~ Game0.S.fi: - ={arg} - /\ ={m,mi}(Concrete_F,Game0) - /\ is_pre_permutation (Concrete_F.m){1} (Concrete_F.mi){1} - ==> ={res} - /\ ={m,mi}(Concrete_F,Game0) - /\ is_pre_permutation (Concrete_F.m){1} (Concrete_F.mi){1}. - proof. - proc. inline *. - sp; if=> //=; 2:by auto. - auto; progress [-split]. - by rewrite pre_permutation_set. - qed. - - local lemma Game0_pr &m: - `|Pr[Concrete_F.main() @ &m: res] - - Pr[Ideal.main() @ &m: res]| - = `|Pr[Game0.main() @ &m: res] - - Pr[Ideal.main() @ &m: res]|. - proof. - do !congr. - byequiv=> //=. - proc. - call (_: ={m,mi}(Concrete_F,Game0) - /\ is_pre_permutation Concrete_F.m{1} Concrete_F.mi{1}). - + by proc *;inline Game0.S.f;wp;call Game0_P_S_eq;auto. - + by proc *;call Game0_Pi_Si_eq. - + proc. sp; if=> //=. - while ( ={sa,sc,p} - /\ ={m,mi}(Concrete_F,Game0) - /\ is_pre_permutation Concrete_F.m{1} Concrete_F.mi{1}). - wp; call Game0_P_S_eq. - by auto. - by auto. - by auto; smt. - qed. - - (** Split the simulator map into distinct rate and capacity maps **) - pred map_split (m0 : (state,state) fmap) (a1 : (state,block) fmap) (c1 : (state,capacity) fmap) = - (forall x, mem (dom m0) x = mem (dom a1) x) - /\ (forall x, mem (dom m0) x = mem (dom c1) x) - /\ (forall x, mem (dom m0) x => m0.[x] = Some (oget a1.[x],oget c1.[x])). - - lemma map_split_set m0 a1 c1 s a c: - map_split m0 a1 c1 => - map_split m0.[s <- (a,c)] a1.[s <- a] c1.[s <- c] - by []. - - local module Game1 = { - var mcol,micol : (state,caller) fmap - var rate, ratei : (state,block) fmap - var cap, capi : (state,capacity) fmap - var pathscol : (capacity,caller) fmap - var paths : (capacity,block list * block) fmap - var bext, bred : bool - var bcoll, bsuff, bmitm : bool - - module S = { - (** Inner interface **) - proc fg(o : caller, x : state): state = { - var o', ya, yc, pv, p, v; - - o' <- odflt D pathscol.[x.`2]; - bext <- bext \/ (o' <= o); - - if (!mem (dom rate) x) { - (ya,yc) <$ dstate; - if (mem (dom paths) x.`2) { - o' <- oget pathscol.[x.`2]; - pv <- oget paths.[x.`2]; - (p,v) <- pv; - bcoll <- bcoll \/ (mem (dom paths) yc); - bsuff <- bsuff \/ (mem (rng cap) yc); - pathscol.[yc] <- max o o'; - paths.[yc] <- (rcons p (v ^ x.`1),ya); - } - rate.[x] <- ya; - ratei.[(ya,yc)] <- x.`1; - cap.[x] <- yc; - capi.[(ya,yc)] <- x.`2; - mcol.[x] <- o; - micol.[(ya,yc)] <- o; - } else { - o' <- oget mcol.[x]; - mcol.[x] <- max o o'; - ya <- oget rate.[x]; - yc <- oget cap.[x]; - o' <- oget micol.[(ya,yc)]; - micol.[(ya,yc)] <- max o o'; - } - return (oget rate.[x],oget cap.[x]); - } - - proc f(x:state):state = { - var r; - r <@ fg(D,x); - return r; - } - - proc fi(x : state): state = { - var ya, yc; - - if (!mem (dom ratei) x) { - (ya,yc) <$ dstate; - micol.[x] <- D; - ratei.[x] <- ya; - capi.[x] <- yc; - mcol.[(ya,yc)] <- D; - rate.[(ya,yc)] <- x.`1; - cap.[(ya,yc)] <- x.`2; - bmitm <- bmitm \/ (mem (dom paths) yc); - } else { - bred <- bred \/ oget micol.[x] = I; - micol.[x] <- D; - ya <- oget ratei.[x]; - yc <- oget capi.[x]; - mcol.[(ya,yc)] <- D; - } - return (oget ratei.[x],oget capi.[x]); - } - - (** Distinguisher interface **) - proc init() = { } - - } - - module C = { - proc init(): unit = { } - - proc f(p : block list): block = { - var (sa,sc) <- (b0,c0); - - if (1<= size p /\ p <> [b0]) { - while (p <> []) { - (sa,sc) <@ S.fg(I,(sa ^ head witness p,sc)); - p <- behead p; - } - } - return sa; - } - } - - proc main(): bool = { - var b; - - mcol <- map0; - micol <- map0; - rate <- map0; - ratei <- map0; - cap <- map0; - capi <- map0; - bext <- false; - bred <- false; - bcoll <- false; - bsuff <- false; - bmitm <- false; - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - pathscol <- map0.[c0 <- D]; - paths <- map0.[c0 <- ([<:block>],b0)]; - b <@ D(C,S).distinguish(); - return b; - } - }. - - local equiv Game1_S_S_eq: - Game0.S.fg ~ Game1.S.fg: - ={arg} - /\ ={pathscol,paths}(Game0,Game1) - /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} - /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} - /\ is_pre_permutation (Game0.m){1} (Game0.mi){1} - ==> ={res} - /\ ={pathscol,paths}(Game0,Game1) - /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} - /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} - /\ is_pre_permutation (Game0.m){1} (Game0.mi){1}. - proof. - proc. inline *. - sp; if; 1:by progress [-split]; move: H=> [->]. - + auto; progress [-split]. - move: H3; case yL=> ya yc H3; case (x{2})=> xa xc. - by rewrite !getP_eq !map_split_set ?pre_permutation_set. - + auto; progress [-split]. - rewrite H H0 H1 /=. - by move: H=> [_ [_ ->]]. - qed. - - local equiv Game1_Si_Si_eq: - Game0.S.fi ~ Game1.S.fi: - ={arg} - /\ ={pathscol,paths}(Game0,Game1) - /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} - /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} - /\ is_pre_permutation (Game0.m){1} (Game0.mi){1} - ==> ={res} - /\ ={pathscol,paths}(Game0,Game1) - /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} - /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} - /\ is_pre_permutation (Game0.m){1} (Game0.mi){1}. - proof. - proc. inline *. - sp; if; 1:by progress [-split]; move: H0=> [->]. - + auto; progress [-split]. - move: H3; case yL=> ya yc H3; case (x{2})=> xa xc. - by rewrite !getP_eq !map_split_set ?pre_permutation_set. - + auto; progress [-split]. - rewrite H H0 H1 /=. - by move: H0=> [_ [_ ->]]. - qed. - - local lemma Game1_pr &m: - `|Pr[Game0.main() @ &m: res] - - Pr[Ideal.main() @ &m: res]| - = `|Pr[Game1.main() @ &m: res] - - Pr[Ideal.main() @ &m: res]|. - proof. - do !congr. byequiv=> //=; proc. - call (_: ={pathscol,paths}(Game0,Game1) - /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} - /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} - /\ is_pre_permutation Game0.m{1} Game0.mi{1}). - + by proc;call Game1_S_S_eq. - + by apply Game1_Si_Si_eq. - + proc; sp; if=> //=. - while ( ={sa,sc,p} - /\ ={pathscol,paths}(Game0,Game1) - /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} - /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} - /\ is_pre_permutation Game0.m{1} Game0.mi{1})=> //. - by wp; call Game1_S_S_eq. - by auto; smt. - qed. - -(*un jeu avec indirection. -jeu avec indirection -> simulateur. *) - type handle = int. - type hstate = block * handle. - - - local module Game2 = { - - var mcol,micol : (hstate,caller) fmap - var rate, ratei : (hstate,block) fmap - var cap, capi : (hstate,handle) fmap - var handles : (handle,capacity) fmap - var pathscol : (handle,caller) fmap - var paths : (handle,block list * block) fmap - var bext, bred : bool - var bcoll, bsuff, bmitm : bool - - module S = { - (** Inner interface **) - proc fg(o : caller, x : state): state = { - var o', ya, yc, pv, p, v, x2; - - (* Fait chier ici *) -(* o' <- odflt D pathscol.[x.`2]; - bext <- bext \/ (o' <= o); *) - - if (!mem (dom rate) x) { - x2 <- hinv handles x.`2; - (ya,yc) <$ dstate; - if (mem (dom paths) x.`2) { - o' <- oget pathscol.[x.`2]; - pv <- oget paths.[x.`2]; - (p,v) <- pv; - bcoll <- bcoll \/ (mem (dom paths) yc); - bsuff <- bsuff \/ (mem (rng cap) yc); - pathscol.[yc] <- max o o'; - paths.[yc] <- (rcons p (v ^ x.`1),ya); - } - rate.[x] <- ya; - ratei.[(ya,yc)] <- x.`1; - cap.[x] <- yc; - capi.[(ya,yc)] <- x.`2; - mcol.[x] <- o; - micol.[(ya,yc)] <- o; - } else { - o' <- oget mcol.[x]; - mcol.[x] <- max o o'; - ya <- oget rate.[x]; - yc <- oget cap.[x]; - o' <- oget micol.[(ya,yc)]; - micol.[(ya,yc)] <- max o o'; - } - return (oget rate.[x],oget cap.[x]); - } - - proc f(x:state):state = { - var r; - r <@ fg(D,x); - return r; - } - - proc fi(x : state): state = { - var ya, yc; - - if (!mem (dom ratei) x) { - (ya,yc) <$ dstate; - micol.[x] <- D; - ratei.[x] <- ya; - capi.[x] <- yc; - mcol.[(ya,yc)] <- D; - rate.[(ya,yc)] <- x.`1; - cap.[(ya,yc)] <- x.`2; - bmitm <- bmitm \/ (mem (dom paths) yc); - } else { - bred <- bred \/ oget micol.[x] = I; - micol.[x] <- D; - ya <- oget ratei.[x]; - yc <- oget capi.[x]; - mcol.[(ya,yc)] <- D; - } - return (oget ratei.[x],oget capi.[x]); - } - - (** Distinguisher interface **) - proc init() = { } - - } - - module C = { - proc init(): unit = { } - - proc f(p : block list): block = { - var (sa,sc) <- (b0,c0); - - if (1<= size p /\ p <> [b0]) { - while (p <> []) { - (sa,sc) <@ S.fg(I,(sa ^ head witness p,sc)); - p <- behead p; - } - } - return sa; - } - } - - proc main(): bool = { - var b; - - mcol <- map0; - micol <- map0; - rate <- map0; - ratei <- map0; - cap <- map0; - capi <- map0; - bext <- false; - bred <- false; - bcoll <- false; - bsuff <- false; - bmitm <- false; - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - pathscol <- map0.[c0 <- D]; - paths <- map0.[c0 <- ([<:block>],b0)]; - b <@ D(C,S).distinguish(); - return b; - } - }. - -end section. - -(* That Self is unfortunate *) -lemma PermutationLemma: - exists epsilon, - forall (D <: Self.DISTINGUISHER) &m, - `|Pr[RealIndif(SqueezelessSponge,P,D).main() @ &m: res] - - Pr[IdealIndif(H,S,D).main() @ &m: res]| - < epsilon. -proof. admit. qed. From 13fe8772fafe70825144cec7cab1257adb83d147 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 22 Jan 2016 17:51:10 +0100 Subject: [PATCH 123/394] Progress on Top Level. --- sha3/proof/TopLevel.ec | 123 ++++++++++++++++++++++++++++++----------- 1 file changed, 91 insertions(+), 32 deletions(-) diff --git a/sha3/proof/TopLevel.ec b/sha3/proof/TopLevel.ec index 9276ec5..7d66bf3 100644 --- a/sha3/proof/TopLevel.ec +++ b/sha3/proof/TopLevel.ec @@ -1,7 +1,7 @@ (*------------------------- Sponge Construction ------------------------*) -require import Pair Int IntDiv Real List Option FSet NewFMap DBool. -require import Fun Common. +require import Fun Pair Int IntDiv Real List Option FSet NewFMap DBool. +require import Common StdOrder. import IntOrder. require (*--*) IRO Block. (*------------------------- Indifferentiability ------------------------*) @@ -186,7 +186,7 @@ local module RaiseBIROBLazy (F : BLOCK_IRO_BITS) : FUNCTIONALITY = { var cs; cs <@ F.g(pad2blocks bs, n); - return take n cs; + return cs; } }. @@ -214,36 +214,58 @@ case (valid_block xs{1}). rcondt{1} 3; first auto. rcondt{2} 4; first auto. inline *. rcondt{1} 7; first auto. seq 6 3 : - (={n, n0} /\ xs{1} = xs0{2} /\ n0{1} = n{1} * r /\ + (={i, n0} /\ bs{1} = bs0{2} /\ LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2} /\ - valid_block xs{1} /\ pad2blocks x{1} = xs0{2}). + pad2blocks x{1} = xs0{2}). auto; progress; have {2}<- /# := unpadBlocksK xs0{2}. -admit. +wp. +while + (={i, n0} /\ bs{1} = bs0{2} /\ + LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2} /\ + pad2blocks x{1} = xs0{2}). +sp; auto. +if. +progress; smt ml=0. +rnd; auto; progress; smt. (* will get rid of smt's *) +auto; progress; smt. +auto. rcondf{1} 3; first auto. rcondf{2} 4; first auto. auto; progress; by rewrite bits2blocks_nil. qed. -(* TODO: - - IRO.f ~ RaiseBIROBLazy(BlockIROBitsLazy).f *) - -(* TODO: -BlockIROBitsEager.f ~ Block.BIRO.IRO.f - -BlockIROBitsEager.fi ~ Block.BIRO.IRO.fi - -RaiseFun(BlockIROBitsEager).f ~ RaiseFun(Block.BIRO.IRO).f -*) +local lemma IRO_RaiseBIROBLazy_BlockIROBitsLazy_f : + equiv[IRO.f ~ RaiseBIROBLazy(BlockIROBitsLazy).f : + ={n} /\ x{1} = bs{2} /\ + LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2} ==> + ={res} /\ LazyInvar IRO.mp{1} BlockIROBitsLazy.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} /\ + LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2}); first auto. +wp. +while + (={i, n} /\ n{1} = n0{2} /\ xs{2} = pad2blocks x{1} /\ bs{1} = bs0{2} /\ + LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2}). +wp; sp. +if. +progress; smt. (* will get rid of smt's *) +rnd; skip; progress; smt. +auto; progress; smt. +auto. +qed. local lemma BlockIROBitsEager (D <: BLOCK_IRO_BITS_DIST) : equiv[D(BlockIROBitsEager).distinguish ~ D(BlockIROBitsLazy).distinguish : ={glob D} /\ BlockIROBitsEager.mp{1} = BlockIROBitsLazy.mp{2} ==> ={glob D}]. proof. -admit. +admit. (* use RndO.ec result *) qed. -pred BlockIROBits_Eager_Invar +pred EagerInvar (mp1 : (block list * int, block) fmap, mp2 : (block list * int, bool) fmap) = (forall (xs : block list, i : int), @@ -256,6 +278,39 @@ pred BlockIROBits_Eager_Invar mem (dom mp2) (xs, j) => 0 <= j /\ mem (dom mp1) (xs, j %/ r)). +local lemma BlockIROBitsEager_BlockIRO_f : + equiv[BlockIROBitsEager.f ~ Block.BIRO.IRO.f : + xs{1} = x{2} /\ ={n} /\ + EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> + ={res} /\ EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}]. +proof. +proc=> /=. +inline BlockIROBitsEager.g. +seq 5 2 : + (xs0{1} = x{2} /\ bs0{1} = [] /\ bs{2} = [] /\ n0{1} = n{2} * r /\ + n0{1} = m{1} /\ + EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}). +auto; progress. +rewrite -addzA divzMDl 1:gtr_eqF 1:gt0_r //. +have -> // : (r - 1) %/ r = 0 by smt. (* TODO *) +if=> //. +(* +second while loop in {1} is redundant +what's left is to deal with sampling... *) +admit. +auto; progress; by rewrite bits2blocks_nil. +qed. + +local lemma RaiseFun_BlockIROBitsEager_BlockIRO_f : + equiv[RaiseFun(BlockIROBitsEager).f ~ RaiseFun(Block.BIRO.IRO).f : + ={bs, n} /\ + EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> + ={res} /\ + EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}]. +proof. +proc=> /=; by call BlockIROBitsEager_BlockIRO_f. +qed. + local lemma Sponge_Raise_Block_Sponge_f : equiv[Sponge(Perm).f ~ RaiseFun(Block.Sponge(Perm)).f : ={bs, n, glob Perm} ==> ={res, glob Perm}]. @@ -311,12 +366,14 @@ call ={glob Dist, glob BlockSim} /\ IRO.mp{1} = map0 /\ BlockIROBitsLazy.mp{2} = map0 ==> ={res}). -proc (={glob BlockSim}). -smt. -smt. -admit. -admit. -admit. +proc (={glob BlockSim} /\ LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2}). +smt. (* will remove this *) +trivial. +proc (LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2})=> //. +apply LowerFun_IRO_BlockIROBitsLazy_f. +proc (LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2})=> //. +apply LowerFun_IRO_BlockIROBitsLazy_f. +by conseq IRO_RaiseBIROBLazy_BlockIROBitsLazy_f. auto. qed. @@ -352,13 +409,15 @@ call ={glob Dist, glob BlockSim} /\ BlockIROBitsEager.mp{1} = map0 /\ Block.BIRO.IRO.mp{2} = map0 ==> ={res}). -proc (={glob BlockSim}). -smt. -smt. -proc (true); first 2 smt. -admit. -admit. -admit. +proc + (={glob BlockSim} /\ + EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}) => //. +smt. (* TODO *) +proc (EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //. +conseq BlockIROBitsEager_BlockIRO_f=> //. +proc (EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //. +conseq BlockIROBitsEager_BlockIRO_f=> //. +conseq RaiseFun_BlockIROBitsEager_BlockIRO_f=> //. auto. qed. From 1ad6fe326539e3e81445f2947b3d6334e5bcd9e1 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 22 Jan 2016 19:58:12 +0100 Subject: [PATCH 124/394] A bit more progress on top level. Has some smt calls, which will shortly be removed. --- sha3/proof/TopLevel.ec | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/sha3/proof/TopLevel.ec b/sha3/proof/TopLevel.ec index 7d66bf3..796d9cb 100644 --- a/sha3/proof/TopLevel.ec +++ b/sha3/proof/TopLevel.ec @@ -287,16 +287,20 @@ proof. proc=> /=. inline BlockIROBitsEager.g. seq 5 2 : - (xs0{1} = x{2} /\ bs0{1} = [] /\ bs{2} = [] /\ n0{1} = n{2} * r /\ + (={i} /\ xs0{1} = x{2} /\ bs0{1} = [] /\ bs{2} = [] /\ n0{1} = n{2} * r /\ n0{1} = m{1} /\ EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}). auto; progress. rewrite -addzA divzMDl 1:gtr_eqF 1:gt0_r //. have -> // : (r - 1) %/ r = 0 by smt. (* TODO *) if=> //. -(* -second while loop in {1} is redundant -what's left is to deal with sampling... *) +rcondf{1} 2; auto; first while (true); auto. +conseq + (_ : + ={i} /\ n0{1} = n{2} * r /\ xs0{1} = x{2} /\ bs0{1} = [] /\ bs{2} = [] /\ + EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> + bits2blocks bs0{1} = bs{2} /\ + EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //. admit. auto; progress; by rewrite bits2blocks_nil. qed. @@ -413,10 +417,10 @@ proc (={glob BlockSim} /\ EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}) => //. smt. (* TODO *) -proc (EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //. -conseq BlockIROBitsEager_BlockIRO_f=> //. -proc (EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //. -conseq BlockIROBitsEager_BlockIRO_f=> //. +proc (EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //; + conseq BlockIROBitsEager_BlockIRO_f=> //. +proc (EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //; + conseq BlockIROBitsEager_BlockIRO_f=> //. conseq RaiseFun_BlockIROBitsEager_BlockIRO_f=> //. auto. qed. From 0c51d0bdf18113fb90d3304e44d1d6db79d2ed15 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 22 Jan 2016 20:40:06 +0100 Subject: [PATCH 125/394] almost the end for bounding the probability of bext. --- sha3/proof/old/G2.eca | 307 +++++++++++++++++++++++++++++++----------- 1 file changed, 231 insertions(+), 76 deletions(-) diff --git a/sha3/proof/old/G2.eca b/sha3/proof/old/G2.eca index c1464d0..1e77061 100644 --- a/sha3/proof/old/G2.eca +++ b/sha3/proof/old/G2.eca @@ -7,9 +7,9 @@ require (*..*) Gcol. clone export Gcol as Gcol0. -op bad_ext (m:smap) y = - mem (map snd (elems (dom m))) y \/ - mem (map snd (elems (rng m))) y. +op bad_ext (m mi:smap) y = + mem (image snd (dom m)) y \/ + mem (image snd (dom mi)) y. op hinvc (m:(handle,capacity)fmap) (c:capacity) = find (+ pred1 c) m. @@ -71,7 +71,7 @@ module G2(D:DISTINGUISHER,HS:FRO) = { if (mem (dom G1.mh) (x.`1, hx2) /\ t) { hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; y2 <@ HS.get(hy2); - G1.bext <- G1.bext \/ bad_ext G1.m y2 \/ y2 = x.`2; + 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; @@ -107,7 +107,7 @@ module G2(D:DISTINGUISHER,HS:FRO) = { (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; y2 <@ HS.get(hy2); y <- (y.`1, y2); - G1.bext <- G1.bext \/ bad_ext G1.m y2 \/ y2 = x.`2; + G1.bext <- G1.bext \/ bad_ext G1.m G1.mi y2 \/ y2 = x.`2; G1.mi.[x] <- y; G1.m.[y] <- x; } else { @@ -150,8 +150,11 @@ section. declare module D: DISTINGUISHER{G1, G2, FRO}. - op inv_ext1 bext1 bext2 (G1m:smap) (FROm:handles) = - bext1 => (bext2 \/ exists x h, mem (dom G1m `|` rng G1m) x /\ FROm.[h] = Some (x.`2, Unknown)). + op inv_ext (m mi:smap) (FROm:handles) = + exists x h, mem (dom m `|` dom 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: mem (rng (restr f m)) x <=> mem (rng m) (x,f). @@ -161,15 +164,15 @@ section. qed. equiv G1_G2 : G1(D).main ~ Eager(G2(D)).main1 : - ={glob D} ==> ={res} /\ inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} FRO.m{2}. + ={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. call (_: ={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m} /\ - inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} FRO.m{2} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ (forall h, mem (dom FRO.m) h => h < G1.chandle){1}). + proc;if=>//;last by auto. seq 1 1: (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,x,y} /\ - inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} FRO.m{2} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ ! mem (dom G1.m{1}) x{1}). + by if=>//;auto;call (_: ={F.RO.m});[sim |auto]. @@ -177,11 +180,10 @@ section. (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,hx2,x,y,hx2} /\ t{2} = (in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1} /\ (G1.bext{1} => (G1.bext{2} \/ (mem (rng FRO.m) (x.`2, Unknown)){2} \/ - exists x h, mem (dom G1.m{2} `|` rng G1.m{2}) x /\ - FRO.m{2}.[h] = Some (x.`2, Unknown))) /\ + inv_ext G1.m{2} G1.mi{2} FRO.m{2})) /\ (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ ! mem (dom G1.m{1}) x{1}). - + inline *;auto=> &ml&mr[*]10!-> Hi Hhand -> /=. + + inline *;auto=> &ml&mr[#]10!-> Hi Hhand -> /=. rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. + rewrite rng_set !inE rem_id 1:/#;move:H0=>[/Hi[->|[x' h][]H1 H2]|->]//. right;right;exists x', h;rewrite getP. @@ -196,29 +198,29 @@ section. + case (h = (oget G1.mh{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + by left;rewrite Hh oget_some. by right;exists x{2}, h;rewrite dom_set getP Hneq !inE. - case (h = (oget G1.mh{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + rewrite Hh /bad_ext oget_some /= !mem_map_snd. - by left;right;left <@ Hx;rewrite !inE=>-[|]Hx;[left|right];exists x1; - rewrite -memE. - right;exists (x1,x2), h;rewrite dom_set rng_set getP Hneq rem_id //=. + case (h = (oget G1.mh{2}.[(x{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 !dom_set getP Hneq //=. by move:Hx;rewrite !inE Hh=>-[]->. by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. + right;exists x{2}, h;rewrite getP dom_set !inE /=. by move:(H0 h);rewrite in_dom Hh /#. - right;exists x', h;rewrite getP dom_set !inE. - move:(H0 h) Hx;rewrite in_dom rng_set Hh !inE rem_id //= /#. + right;exists x', h;rewrite getP !dom_set !inE;split. + + by move:Hx;rewrite !inE=>-[]->. + by move:(H0 h);rewrite !in_dom Hh /#. + proc;if=>//;last by auto. seq 4 6: (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,hx2,x,y,hx2} /\ t{2} = (in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1} /\ (G1.bext{1} => (G1.bext{2} \/ (mem (rng FRO.m) (x.`2, Unknown)){2} \/ - exists x h, mem (dom G1.m{2} `|` rng G1.m{2}) x /\ - FRO.m{2}.[h] = Some (x.`2, Unknown))) /\ + inv_ext G1.m{2} G1.mi{2} FRO.m{2})) /\ (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ ! mem (dom G1.mi{1}) x{1}). - + inline *;auto=> &ml&mr[*]9!-> Hi Hhand -> /=. + + inline *;auto=> &ml&mr[#]9!-> Hi Hhand -> /=. rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. + rewrite rng_set !inE rem_id 1:/#;move:H2=>[/Hi[->|[x' h][]HH1 HH2]|->]//. right;right;exists x', h;rewrite getP. @@ -230,48 +232,48 @@ section. auto;progress. + by apply DWord.cdistr_ll. + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. - + case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq /=]. + + case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + by left;rewrite Hh oget_some. - by right;exists x{2}, h;rewrite rng_set getP Hneq !inE. - case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + rewrite Hh /bad_ext oget_some /= !mem_map_snd. - by left;right;left <@ Hx;rewrite !inE=>-[|]?;[left|right]; - exists x1;rewrite -memE. - right;exists (x1,x2), h;rewrite dom_set rng_set getP Hneq !inE Hh /= rng_rem. - move:Hx;rewrite !inE in_rng. - - -search mem rng. -print rngP. - - case ((x1,x2) = - (y{2}.`1, (oget FRO.m{2}.[(oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2]).`1))=> - [/=->//|Hneq']. - right;left;exists (x1,x2);rewrite Hneq'. - move:Hx;rewrite inE in_rng=>-[->//|[[a1 a2]]] /#. -search mem rng. -search rng rem. - Hh. - Hx. + by right;exists x{2}, h;rewrite !dom_set getP Hneq !inE. + case (h = (oget G1.mhi{2}.[(x{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 !dom_set getP Hneq //=. + by move:Hx;rewrite !inE Hh=>-[]->. by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. - + right;exists x{2}, h;rewrite getP dom_set !inE /=. + + right;exists x{2}, h;rewrite getP !dom_set !inE /=. by move:(H0 h);rewrite in_dom Hh /#. - right;exists x', h;rewrite getP dom_set !inE. - by move:(H0 h);rewrite in_dom Hh Hx /#. - - + right;exists x', h;rewrite getP !dom_set !inE;split. + + by move:Hx;rewrite !inE=>-[]->. + by move:(H0 h);rewrite !in_dom Hh /#. - (************) - inline*;auto. - - auto=> //. -sim. - admit. - qed. + + proc; + conseq (_: ={sa,G1.mh,G1.mhi,F.RO.m, G1.chandle, FRO.m} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ + forall (h0 : handle), mem (dom FRO.m{1}) h0 => h0 < G1.chandle{1})=>//. + sp 3 3;if=>//;call (_: ={F.RO.m});1:by sim. + while (={sa,G1.mh,G1.mhi,F.RO.m,G1.chandle,FRO.m,i,h,sa,p} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ + forall (h0 : handle), mem (dom FRO.m{1}) h0 => h0 < G1.chandle{1})=>//. + if=>//;inline *;1:by auto. + rcondt{2} 3;1:by auto=>/#. + auto=> &m1&m2 [#] 10!-> Hinv Hhand Hi _ _ /= ?->?->/=;split=>/= _;split. + + move:Hinv;rewrite /inv_ext1=> H/H{H}[->//|[x h]];rewrite inE=>-[Hmem Hh]. + by right;exists x,h;rewrite !inE Hmem getP;smt w=in_dom. + + by move=>h;rewrite dom_set !inE /#. + + move:Hinv;rewrite /inv_ext1=> H/H{H}[->//|[x h]];rewrite inE=>-[Hmem Hh]. + by right;exists x,h;rewrite !inE Hmem getP;smt w=in_dom. + by move=>h;rewrite dom_set !inE /#. + + (* **************** *) + inline *;auto;progress. + by move:H;rewrite dom_set dom0 !inE=>->. + qed. equiv Eager_1_2: Eager(G2(D)).main1 ~ Eager(G2(D)).main2 : - ={glob G2(D)} ==> ={G1.m,FRO.m,G1.bext}. + ={glob G2(D)} ==> ={G1.m,G1.mi,FRO.m,G1.bext}. proof. by conseq (Eager_1_2 (G2(D))). qed. end section. @@ -282,14 +284,28 @@ section EXT. local module ReSample = { var count:int - proc f (x:handle) = { + proc f (h:handle) = { var c; c <$ cdistr; - if (card (dom G1.m) < max_size /\ count < max_size) { - G1.bext <- G1.bext \/ bad_ext G1.m c; - FRO.m.[x] <- (c,Unknown); + if (card (dom G1.m) <= max_size /\ + card (dom G1.mi) <= max_size /\ count < max_size) { + G1.bext <- G1.bext \/ mem (image snd (dom G1.m `|` dom G1.mi)) c; + FRO.m.[h] <- (c,Unknown); + count = count + 1 ; } } + + proc f1 (x:capacity,h:handle) = { + var c; + c <$ cdistr; + if (card (dom G1.m) < max_size /\ + card (dom G1.mi) < max_size /\ count < max_size) { + G1.bext <- G1.bext \/ mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x) c; + FRO.m.[h] <- (c,Unknown); + count = count + 1; + } + } + }. local module Gext = { @@ -352,8 +368,8 @@ section EXT. t <@ RRO.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); if (mem (dom G1.mh) (x.`1, hx2) /\ t) { hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; - ReSample.f(hy2); - y2 <@ RRO.get(hy2); + ReSample.f1(x.`2, hy2); + y2 <@ FRO.get(hy2); y <- (y.`1, y2); G1.m.[x] <- y; G1.mi.[y] <- x; @@ -384,11 +400,11 @@ section EXT. handles_ <@ RRO.restrK(); hx2 <- oget (hinvc handles_ x.`2); y <$ dstate; - t <@ RRO.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); + t <@ RRO.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; - ReSample.f(hy2); - y2 <@ RRO.get(hy2); + ReSample.f1(x.`2,hy2); + y2 <@ FRO.get(hy2); y <- (y.`1, y2); G1.mi.[x] <- y; @@ -413,6 +429,7 @@ section EXT. proc distinguish(): bool = { var b; + SLCommon.C.c <- 0; F.RO.m <- map0; G1.m <- map0; G1.mi <- map0; @@ -426,27 +443,165 @@ section EXT. RRO.set(0,c0); G1.paths <- map0.[c0 <- ([<:block>],b0)]; G1.chandle <- 1; - b <@ D(C,S).distinguish(); + b <@ DRestr(D,C,S).distinguish(); resample(); return b; } }. + op inv_lt (m2 mi2:smap) c1 (Fm2:handles) count2 = + size m2 < c1 /\ size mi2 < c1 /\ + count2 + size (restr Unknown Fm2) < c1 /\ + c1 <= max_size. + + op inv_le (m2 mi2:smap) c1 (Fm2:handles) count2 = + size m2 <= c1 /\ size mi2 <= c1 /\ + count2 + size (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): + size (m.[x<-y]) = if mem (dom m) x then size m else size m + 1. + proof. + rewrite sizeE dom_set;case (mem (dom m) x)=> Hx. + + by rewrite fsetUC subset_fsetU_id 2:sizeE 2:// => z; rewrite ?inE. + rewrite fcardUI_indep 1:fset0_eqP=>[z|]. + + by rewrite !inE;case (z=x)=>//. + by rewrite fcard1 sizeE. + qed. + + lemma size_set_le (m:('a,'b)fmap) (x:'a) (y:'b): size (m.[x<-y]) <= size m + 1. + proof. rewrite size_set /#. qed. + + lemma size_rem (m:('a,'b)fmap) (x:'a): + size (rem x m) = if mem (dom m) x then size m - 1 else size m. + proof. + rewrite !sizeE dom_rem fcardD;case (mem (dom m) x)=> Hx. + + by rewrite subset_fsetI_id 2:fcard1// => z;rewrite !inE. + by rewrite (eq_fcards0 (_ `&` _)) 2:// fset0_eqP=>z;rewrite !inE /#. + qed. + + lemma size_rem_le (m:('a,'b)fmap) x : size (rem x m) <= size m. + proof. by rewrite size_rem /#. qed. + + lemma size_ge0 (m:('a,'b)fmap) : 0 <= size m. + proof. rewrite sizeE fcard_ge0. qed. + + lemma size0 : size map0<:'a,'b> = 0. + proof. by rewrite sizeE dom0 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 equiv EG2_Gext : Eager(G2(DRestr(D))).main2 ~ Gext.distinguish: ={glob D} ==> - (G1.bext{1} \/ - exists x h, mem (dom G1.m{1}) x /\ FRO.m{1}.[h] = Some (x.`2, Unknown)) => + (G1.bext{1} \/ inv_ext G1.m{1} G1.mi{1} FRO.m{1}) => G1.bext{2}. - proof. - admit. - qed. + proof. + proc;inline *;wp. + while (={l,FRO.m,G1.m,G1.mi} /\ card (dom G1.m){2} <= max_size /\ + card (dom G1.mi){2} <= max_size /\ + ReSample.count{2} + size l{2} <= max_size /\ + ((G1.bext{1} \/ + exists (x : state) (h : handle), + mem (dom G1.m{1} `|` dom G1.mi{1}) x /\ + FRO.m{1}.[h] = Some (x.`2, Unknown) /\ !mem l{1} h) => + G1.bext{2})). + + rcondt{2} 3. + + by 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 getP;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} /\ + inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}). + + proc;sp;if=> //. + 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 1 1 : + (={y,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}). + + 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} /\ + 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.in_dom; wp;call (_: ={FRO.m});1:by sim. + inline RRO.restrK;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=(sizeE size_ge0). + rcondt{2} 10. by auto;progress;rewrite dom_set !inE. + wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. + rewrite DWord.cdistr_ll /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. + 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. - local lemma Pr_ext &m: - Pr[Gext.distinguish()@ &m : G1.bext] <= (max_size^2)%r / (2^c)%r. - proof. - admit. - qed. + + proc;sp;if=> //. + 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 6 6 : + (={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.in_dom; auto;call (_: ={FRO.m});1:by sim. + inline RRO.restrK;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=(sizeE size_ge0). + rcondt{2} 10. by auto;progress;rewrite dom_set !inE. + wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. + rewrite DWord.cdistr_ll /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. + 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=>//. + inline G2(DRestr(D), RRO).C.f Gext.C.f. + sp 5 5;elim *=> c0L c0R;if => //;last by auto;smt w=List.size_ge0. + wp;call (_: ={F.RO.m});1:by sim. + while (={i,p,G1.mh,sa,h,FRO.m,F.RO.m,G1.mh,G1.mhi,G1.chandle} /\ 0 <= i{1} <= size p{1}/\ + c0R + size p{1} <= max_size /\ + inv_le G1.m{2} G1.mi{2} (c0R + i){2} FRO.m{2} ReSample.count{2});last by auto=>/#. + if=> //;1:by auto=>/#. + auto;call (_: ={F.RO.m});1:by sim. + (*inline *;auto=>/> ?&mr. BUG anomaly: EcLowGoal.InvalidProofTerm *) + inline *;auto=> ?&mr [#]!->@/inv_le Hi [#]. + case (p{mr})=> [/#|/=p1 p2] 4?_ /= 2?-> /=;split=>/= Hmem 4? [#]2->/= => [|/#]. + by rewrite restr_set /= size_set dom_restr /in_dom_with Hmem/= /#. + + (* auto=> />. BUG *) + auto;progress[delta];rewrite ?(size0,restr0,restr_set,rem0,max_ge0,-sizeE,-cardE) //=. + + smt ml=0. + smt ml=0. + smt ml=0. + + elim H7=>// [[x h] [#]];rewrite -memE dom_restr /in_dom_with in_dom=> _ ->/=. + by rewrite oget_some. + apply H10=>//. + qed. + + local lemma Pr_ext &m: + Pr[Gext.distinguish()@ &m : G1.bext] <= (max_size^2)%r / (2^c)%r. + proof. + admit. + qed. end section EXT. From 7a80bcd5a3e96987085d1234aa6348ff5b43e051 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 22 Jan 2016 22:02:08 +0100 Subject: [PATCH 126/394] lemmas for bounding Pr bext done. Need to add some glue. --- sha3/proof/old/G2.eca | 57 +++++++++++++++++++++++++++++++++-------- sha3/proof/old/Gcol.eca | 26 +++++++++---------- 2 files changed, 60 insertions(+), 23 deletions(-) diff --git a/sha3/proof/old/G2.eca b/sha3/proof/old/G2.eca index 1e77061..2834520 100644 --- a/sha3/proof/old/G2.eca +++ b/sha3/proof/old/G2.eca @@ -287,8 +287,7 @@ section EXT. proc f (h:handle) = { var c; c <$ cdistr; - if (card (dom G1.m) <= max_size /\ - card (dom G1.mi) <= max_size /\ count < max_size) { + if (size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size) { G1.bext <- G1.bext \/ mem (image snd (dom G1.m `|` dom G1.mi)) c; FRO.m.[h] <- (c,Unknown); count = count + 1 ; @@ -298,8 +297,7 @@ section EXT. proc f1 (x:capacity,h:handle) = { var c; c <$ cdistr; - if (card (dom G1.m) < max_size /\ - card (dom G1.mi) < max_size /\ count < max_size) { + if (size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size) { G1.bext <- G1.bext \/ mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x) c; FRO.m.[h] <- (c,Unknown); count = count + 1; @@ -505,20 +503,21 @@ section EXT. 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 (dom G1.m){2} <= max_size /\ - card (dom G1.mi){2} <= max_size /\ + while (={l,FRO.m,G1.m,G1.mi} /\ size G1.m{2} <= max_size /\ + size G1.mi{2} <= max_size /\ ReSample.count{2} + size l{2} <= max_size /\ ((G1.bext{1} \/ exists (x : state) (h : handle), mem (dom G1.m{1} `|` dom G1.mi{1}) x /\ FRO.m{1}.[h] = Some (x.`2, Unknown) /\ !mem l{1} h) => G1.bext{2})). - + rcondt{2} 3. - + by move=> &m;auto=> &m'[#] 6!-> /= + _ _;case (l{m'})=>//=; smt w=List.size_ge0. + + 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. @@ -598,9 +597,47 @@ section EXT. qed. local lemma Pr_ext &m: - Pr[Gext.distinguish()@ &m : G1.bext] <= (max_size^2)%r / (2^c)%r. + Pr[Gext.distinguish()@&m : G1.bext /\ ReSample.count <= max_size] <= + max_size%r * ((2*max_size)%r / (2^c)%r). proof. - admit. + fel 8 ReSample.count (fun x=> (2*max_size)%r / (2^c)%r) + max_size G1.bext + [ReSample.f : + (size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size); + ReSample.f1 : + (size G1.m < max_size /\ size 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. + case ((size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size)); + [rcondt 2 | rcondf 2]; 1,3:by auto. + + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi)));skip=> &hr[#]?->/=???. + rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr})) cdistr (1%r/(2^c)%r))//. + + move=>x _;apply DWord.muxP. + apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. + rewrite imageU fcardU le_fromint. + move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). + rewrite -!sizeE;smt w=fcard_ge0. + by hoare=>[??|];[apply eps_ge0|auto]. + + by move=>c1;proc;auto=> &hr [^H 2->]/#. + + by move=> b1 c1;proc;auto=> &hr [^H 2->]. + + proc. + case ((size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size)); + [rcondt 2 | rcondf 2]; 1,3:by auto. + + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi ) `|` fset1 x));skip=> &hr[#]?->/=???. + rewrite (Mu_mem.mu_mem + (image snd (dom G1.m{hr} `|` dom G1.mi{hr}) `|` fset1 x{hr}) + cdistr (1%r/(2^c)%r))//. + + move=>x _;apply DWord.muxP. + apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. + rewrite imageU !fcardU le_fromint fcard1. + move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). + rewrite -!sizeE;smt w=fcard_ge0. + by hoare=>[??|];[apply eps_ge0|auto]. + + by move=>c1;proc;auto=> &hr [^H 2->]/#. + by move=> b1 c1;proc;auto=> &hr [^H 2->]. qed. end section EXT. diff --git a/sha3/proof/old/Gcol.eca b/sha3/proof/old/Gcol.eca index 24778fd..399492d 100644 --- a/sha3/proof/old/Gcol.eca +++ b/sha3/proof/old/Gcol.eca @@ -9,6 +9,19 @@ clone export Handle as Handle0. (* -------------------------------------------------------------------------- *) + (* TODO: move this *) + lemma c_gt0r : 0%r < (2^c)%r. + proof. by rewrite lt_fromint;apply /powPos. 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}. @@ -282,19 +295,6 @@ section PROOF. by apply max_ge0. qed. - (* TODO: move this *) - lemma c_gt0r : 0%r < (2^c)%r. - proof. by rewrite lt_fromint;apply /powPos. qed. - - lemma c_ge0r : 0%r <= (2^c)%r. - proof. by apply /ltrW/c_gt0r. qed. - - local 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. - 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). From ec3a5757eab4b9503eaaf75fc8177217d9c02f68 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 22 Jan 2016 23:13:06 +0100 Subject: [PATCH 127/394] add glue between the different lemmas. --- sha3/proof/old/G2.eca | 35 ++++++++++++++++++++++++++++------- sha3/proof/old/Gcol.eca | 8 ++++++++ 2 files changed, 36 insertions(+), 7 deletions(-) diff --git a/sha3/proof/old/G2.eca b/sha3/proof/old/G2.eca index 2834520..547bedd 100644 --- a/sha3/proof/old/G2.eca +++ b/sha3/proof/old/G2.eca @@ -272,15 +272,11 @@ section. by move:H;rewrite dom_set dom0 !inE=>->. qed. - equiv Eager_1_2: Eager(G2(D)).main1 ~ Eager(G2(D)).main2 : - ={glob G2(D)} ==> ={G1.m,G1.mi,FRO.m,G1.bext}. - proof. by conseq (Eager_1_2 (G2(D))). qed. - end section. section EXT. - declare module D: DISTINGUISHER{C, PF, G1, G2 }. + declare module D: DISTINGUISHER{C, PF, G1, G2, Perm, RO }. local module ReSample = { var count:int @@ -504,8 +500,7 @@ section EXT. 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}. + ((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} /\ size G1.m{2} <= max_size /\ @@ -640,6 +635,32 @@ section EXT. by move=> b1 c1;proc;auto=> &hr [^H 2->]. qed. + axiom D_ll: + forall (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}), + islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. + + (* TODO Francois : on peut pas avoir max_size au lieu de (max_size + 1)? *) + lemma Real_G2 &m: + Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= + Pr[Eager(G2(DRestr(D))).main2() @ &m: res] + + ((max_size + 1) ^ 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 => //. + + cut ->: Pr[G1(DRestr(D)).main() @ &m : res] = Pr[Eager(G2(DRestr(D))).main1() @ &m : res]. + + by byequiv (G1_G2 (DRestr(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 (DRestr(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/old/Gcol.eca b/sha3/proof/old/Gcol.eca index 399492d..504d172 100644 --- a/sha3/proof/old/Gcol.eca +++ b/sha3/proof/old/Gcol.eca @@ -316,6 +316,14 @@ section PROOF. move=> b c;proc;sp;if;auto;smt ml=0. 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 G1col=> //#. + apply (Pr_col &m). + qed. + end section PROOF. From 264a576012149bcc83b0df7b37d6aa458c6e33a6 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 22 Jan 2016 23:16:33 +0100 Subject: [PATCH 128/394] rename file --- sha3/proof/old/{G2.eca => Gext.eca} | 1 + 1 file changed, 1 insertion(+) rename sha3/proof/old/{G2.eca => Gext.eca} (99%) diff --git a/sha3/proof/old/G2.eca b/sha3/proof/old/Gext.eca similarity index 99% rename from sha3/proof/old/G2.eca rename to sha3/proof/old/Gext.eca index 547bedd..6201a58 100644 --- a/sha3/proof/old/G2.eca +++ b/sha3/proof/old/Gext.eca @@ -56,6 +56,7 @@ module G2(D:DISTINGUISHER,HS:FRO) = { y <- (y1, y2); G1.paths.[y2] <- (rcons p (v +^ x.`1), y.`1); } else { + y <$ dstate; } (* exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) From 6a8d254cbae381723f5b323f3d7a162efffa02a0 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 25 Jan 2016 09:35:17 +0100 Subject: [PATCH 129/394] align --- sha3/proof/old/Handle.eca | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/proof/old/Handle.eca b/sha3/proof/old/Handle.eca index c35ae48..7027bf0 100644 --- a/sha3/proof/old/Handle.eca +++ b/sha3/proof/old/Handle.eca @@ -71,7 +71,7 @@ module G1(D:DISTINGUISHER) = { if (mem (dom mh) (x.`1, hx2) /\ 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); + FRO.m.[hy2] <- (y.`2, Known); (* bad <- bad \/ mem X2 y.`2; *) m.[x] <- y; mi.[y] <- x; From baa270d2d957264adb6e70a2ff54ff6d716f11bf Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 25 Jan 2016 13:33:28 +0100 Subject: [PATCH 130/394] propagate modifications allowing to do the final transition. --- sha3/proof/old/Gcol.eca | 31 +++++++++------------ sha3/proof/old/Gext.eca | 58 +++++++++++++++++++++++---------------- sha3/proof/old/Handle.eca | 19 ++++++++----- 3 files changed, 60 insertions(+), 48 deletions(-) diff --git a/sha3/proof/old/Gcol.eca b/sha3/proof/old/Gcol.eca index 504d172..ef8c42c 100644 --- a/sha3/proof/old/Gcol.eca +++ b/sha3/proof/old/Gcol.eca @@ -84,18 +84,16 @@ section PROOF. G1.chandle <- G1.chandle + 1; } hx2 <- oget (hinvK FRO.m x.`2); - if (mem (dom G1.paths) x.`2) { (p,v) <- oget G1.paths.[x.`2]; y1 <- F.RO.get (rcons p (v +^ x.`1)); y2 <@ sample_c(); - y <- (y1, y2); - G1.paths.[y2] <- (rcons p (v +^ x.`1), y.`1); } else { y1 <$ bdistr; y2 <@ sample_c(); - y <- (y1,y2); + } + y <- (y1,y2); if (mem (dom G1.mh) (x.`1, hx2) /\ in_dom_with FRO.m (oget G1.mh.[(x.`1,hx2)]).`2 Unknown) { hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; @@ -112,6 +110,10 @@ section PROOF. G1.mi.[y] <- x; G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); } + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } } else { y <- oget G1.m.[x]; } @@ -205,36 +207,29 @@ section PROOF. (card(rng FRO.m) + 2 <= 2*C.c + 1/\ Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. if=>//;last by auto=>/#. - swap{1}[2..4]-1. + swap{1}[3..5]-2. seq 3 2:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, C.c,x0,hx2} /\ (G1.bcol{1} => G1.bcol{2}) /\ (card (rng FRO.m) + 1 <= 2 * C.c + 1/\ Gcol.count + 1 <= C.c <= max_size){2}). + auto;smt ml=0 w=card_rng_set. - seq 1 1: + seq 2 2: (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, C.c,x0,hx2,y0} /\ ((G1.bcol\/hinv FRO.m y0.`2 <> None){1} => G1.bcol{2}) /\ (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ Gcol.count <= C.c <= max_size){2});last by auto;smt ml=0 w=card_rng_set. - if=>//;inline Gcol.sample_c. + wp;if=>//;inline Gcol.sample_c. + rcondt{2}4. + auto;conseq (_:true)=>//;progress;2: smt ml=0. - cut /#:= fcard_image_leq fst (rng FRO.m{hr}). + by cut /#:= fcard_image_leq fst (rng FRO.m{hr}). wp;conseq (_: ={p,v,F.RO.m,y1} /\ y2{1}=c{2})=>//;1:smt ml=0 w=hinv_image. - sim. + by sim. rcondt{2}3. + by auto;progress;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). - swap{2}2-1;sp 0 1;wp;conseq(_:y0{1}=(y1,c){2})=>//;1:smt ml=0 w=hinv_image. - transitivity{1} {y0 <- S.sample();} - (true ==> ={y0}) - (true ==> y0{1}=(y1,c){2})=>//;1:by inline*;auto. - transitivity{2} {(y1,c) <- S.sample2();} - (true==>y0{1}=(y1,c){2}) - (true==> ={y1,c})=>//;2:by inline*;auto. - by call sample_sample2;auto=> /=?[??]->. - + auto;progress;smt w=hinv_image. + + proc;sp 1 1;if=>//. inline G1(DRestr(D)).S.fi Gcol.S.fi. seq 2 2 : (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, diff --git a/sha3/proof/old/Gext.eca b/sha3/proof/old/Gext.eca index 6201a58..8ebfed0 100644 --- a/sha3/proof/old/Gext.eca +++ b/sha3/proof/old/Gext.eca @@ -53,13 +53,11 @@ module G2(D:DISTINGUISHER,HS:FRO) = { (p,v) <- oget G1.paths.[x.`2]; y1 <- F.RO.get (rcons p (v +^ x.`1)); y2 <$ cdistr; - y <- (y1, y2); - G1.paths.[y2] <- (rcons p (v +^ x.`1), y.`1); } else { - - y <$ dstate; + y1 <$ bdistr; + y2 <$ cdistr; } - (* exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) + y <- (y1, y2); handles_ <@ HS.restrK(); if (!mem (rng handles_) x.`2) { @@ -85,6 +83,10 @@ module G2(D:DISTINGUISHER,HS:FRO) = { G1.mi.[y] <- x; G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); } + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } } else { y <- oget G1.m.[x]; } @@ -172,7 +174,7 @@ section. inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ (forall h, mem (dom FRO.m) h => h < G1.chandle){1}). + proc;if=>//;last by auto. - seq 1 1: (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,x,y} /\ + seq 2 2: (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,x,y} /\ inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ ! mem (dom G1.m{1}) x{1}). @@ -190,9 +192,13 @@ section. right;right;exists x', h;rewrite getP. by cut ->//:(h<> G1.chandle{mr});move:(Hhand h);rewrite in_dom H2 /#. by move:H0;rewrite dom_set !inE /#. + seq 1 1: (={x,y,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ + forall (h : handle), mem (dom FRO.m{1}) h => h < G1.chandle{1});2:by auto. if=>//. + inline *;rcondt{2} 4. + by move=> &m;auto;rewrite /in_dom_with. +(* auto=> |>. (* Bug ???? *) *) auto;progress. + by apply DWord.cdistr_ll. + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. @@ -345,12 +351,11 @@ section EXT. if (mem (dom G1.paths) x.`2) { (p,v) <- oget G1.paths.[x.`2]; y1 <- F.RO.get (rcons p (v +^ x.`1)); - y2 <$ cdistr; - y <- (y1, y2); - G1.paths.[y2] <- (rcons p (v +^ x.`1), y.`1); } else { - y <$ dstate; + y1 <$ bdistr; } + y2 <$ cdistr; + y <- (y1, y2); (* exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) handles_ <@ RRO.restrK(); @@ -377,6 +382,10 @@ section EXT. G1.mi.[y] <- x; G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); } + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } } else { y <- oget G1.m.[x]; } @@ -528,7 +537,10 @@ section EXT. ={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 1 1 : + 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} /\ + 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} /\ 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. @@ -607,33 +619,33 @@ section EXT. apply ler_wpmul2r;1:by apply eps_ge0. by rewrite le_fromint;smt ml=0 w=max_ge0. + proc. - case ((size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size)); + case ((size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size)); [rcondt 2 | rcondf 2]; 1,3:by auto. - + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi)));skip=> &hr[#]?->/=???. - rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr})) cdistr (1%r/(2^c)%r))//. + + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi ) `|` fset1 x));skip=> &hr[#]?->/=???. + rewrite (Mu_mem.mu_mem + (image snd (dom G1.m{hr} `|` dom G1.mi{hr}) `|` fset1 x{hr}) + cdistr (1%r/(2^c)%r))//. + move=>x _;apply DWord.muxP. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU fcardU le_fromint. + rewrite imageU !fcardU le_fromint fcard1. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). rewrite -!sizeE;smt w=fcard_ge0. by hoare=>[??|];[apply eps_ge0|auto]. + by move=>c1;proc;auto=> &hr [^H 2->]/#. + by move=> b1 c1;proc;auto=> &hr [^H 2->]. + proc. - case ((size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size)); - [rcondt 2 | rcondf 2]; 1,3:by auto. - + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi ) `|` fset1 x));skip=> &hr[#]?->/=???. - rewrite (Mu_mem.mu_mem - (image snd (dom G1.m{hr} `|` dom G1.mi{hr}) `|` fset1 x{hr}) - cdistr (1%r/(2^c)%r))//. + case ((size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size)); + [rcondt 2 | rcondf 2];1,3:by auto. + + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi)));skip=> &hr[#]?->/=???. + rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr})) cdistr (1%r/(2^c)%r))//. + move=>x _;apply DWord.muxP. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU !fcardU le_fromint fcard1. + rewrite imageU fcardU le_fromint. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). rewrite -!sizeE;smt w=fcard_ge0. by hoare=>[??|];[apply eps_ge0|auto]. + by move=>c1;proc;auto=> &hr [^H 2->]/#. - by move=> b1 c1;proc;auto=> &hr [^H 2->]. + by move=> b1 c1;proc;auto=> &hr [^H 2->]. qed. axiom D_ll: diff --git a/sha3/proof/old/Handle.eca b/sha3/proof/old/Handle.eca index 7027bf0..22fa30a 100644 --- a/sha3/proof/old/Handle.eca +++ b/sha3/proof/old/Handle.eca @@ -56,13 +56,13 @@ module G1(D:DISTINGUISHER) = { (p,v) <- oget paths.[x.`2]; y1 <- F.RO.get (rcons p (v +^ x.`1)); y2 <$ cdistr; - y <- (y1, y2); - paths.[y2] <- (rcons p (v +^ x.`1), y.`1); } else { - y <$ dstate; + y1 <$ bdistr; + y2 <$ cdistr; + } + y <- (y1, y2); bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); - (* exists x2 h, handles.[h] = Some (X2,I) *) if (!(mem (rng FRO.m) (x.`2, Known))) { FRO.m.[chandle] <- (x.`2, Known); chandle <- chandle + 1; @@ -72,7 +72,6 @@ module G1(D:DISTINGUISHER) = { hy2 <- (oget mh.[(x.`1, hx2)]).`2; y <- (y.`1, (oget FRO.m.[hy2]).`1); FRO.m.[hy2] <- (y.`2, Known); - (* bad <- bad \/ mem X2 y.`2; *) m.[x] <- y; mi.[y] <- x; } else { @@ -85,6 +84,11 @@ module G1(D:DISTINGUISHER) = { mi.[y] <- x; mhi.[(y.`1, hy2)] <- (x.`1, hx2); } + if (mem (dom paths) x.`2) { + (p,v) <- oget paths.[x.`2]; + paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } + } else { y <- oget m.[x]; } @@ -96,7 +100,6 @@ module G1(D:DISTINGUISHER) = { if (!mem (dom mi) x) { bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); - (* exists x2 h, handles.[h] = Some (X2,I) *) if (!(mem (rng FRO.m) (x.`2, Known))) { FRO.m.[chandle] <- (x.`2, Known); chandle <- chandle + 1; @@ -108,7 +111,6 @@ module G1(D:DISTINGUISHER) = { (y1,hy2) <- oget mhi.[(x.`1, hx2)]; y <- (y.`1, (oget FRO.m.[hy2]).`1); FRO.m.[hy2] <- (y.`2, Known); - (* bad <- bad \/ mem X2 y.`2; *) mi.[x] <- y; m.[y] <- x; } else { @@ -426,6 +428,8 @@ section AUX. equiv CF_G1 : CF(D).main ~ G1(D).main: ={glob D} ==> !(G1.bcol \/ G1.bext){2} => ={res}. proof. + admit. +(* proc. call (_:(G1.bcol \/ G1.bext), INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} @@ -582,6 +586,7 @@ section AUX. + move: H; rewrite in_dom getP; case (h = 0)=> //=. by rewrite map0P. + by move: H1=> /H0 [#]. +*) qed. end section AUX. From d0a61d99dd2c90d0fc1450b2cb8430d5087dc2fb Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 25 Jan 2016 14:31:25 +0100 Subject: [PATCH 131/394] split all sampling of y in two. --- sha3/proof/old/Gcol.eca | 17 ++++++--------- sha3/proof/old/Gext.eca | 44 +++++++++++++++++++++------------------ sha3/proof/old/Handle.eca | 10 +++++---- 3 files changed, 36 insertions(+), 35 deletions(-) diff --git a/sha3/proof/old/Gcol.eca b/sha3/proof/old/Gcol.eca index ef8c42c..78d8136 100644 --- a/sha3/proof/old/Gcol.eca +++ b/sha3/proof/old/Gcol.eca @@ -1,3 +1,4 @@ +pragma -oldip. require import Pred Fun Option Pair Int Real RealExtra StdOrder Ring StdBigop. require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. (*...*) import Dprod Dexcepted Capacity IntOrder Bigreal RealOrder BRA. @@ -244,24 +245,18 @@ section PROOF. (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ Gcol.count + 1 <= C.c <= max_size){2}). + by auto;smt ml=0 w=card_rng_set. - seq 1 2: + seq 3 3: (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, - C.c,x0,hx2} /\ y0{1} = (y1,y2){2} /\ + C.c,x0,hx2,y0,y1,y2} /\ y0{1} = (y1,y2){1} /\ ((G1.bcol\/hinv FRO.m y0.`2 <> None){1} => G1.bcol{2}) /\ (card (rng 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;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). - swap{2}2-1;sp 0 1;wp;conseq(_:y0{1}=(y1,c){2})=>//;1:smt ml=0 w=hinv_image. - transitivity{1} {y0 <- S.sample();} - (true ==> ={y0}) - (true ==> y0{1}=(y1,c){2})=>//;1:by inline*;auto. - transitivity{2} {(y1,c) <- S.sample2();} - (true==>y0{1}=(y1,c){2}) - (true==> ={y1,c})=>//;2:by inline*;auto. - by call sample_sample2;auto=> /=?[??]->. - +(* BUG: auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | H]. marche pas ???? *) + auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | X];right;apply hinv_image=> //. + + proc;sp 1 1;if=>//. inline G1(DRestr(D)).C.f Gcol.C.f. seq 5 5: diff --git a/sha3/proof/old/Gext.eca b/sha3/proof/old/Gext.eca index 8ebfed0..a38aff6 100644 --- a/sha3/proof/old/Gext.eca +++ b/sha3/proof/old/Gext.eca @@ -104,7 +104,9 @@ module G2(D:DISTINGUISHER,HS:FRO) = { } handles_ <@ HS.restrK(); hx2 <- oget (hinvc handles_ x.`2); - y <$ dstate; + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); t <@ HS.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; @@ -220,7 +222,7 @@ section. by move:(H0 h);rewrite !in_dom Hh /#. + proc;if=>//;last by auto. - seq 4 6: + seq 6 8: (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,hx2,x,y,hx2} /\ t{2} = (in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1} /\ (G1.bext{1} => (G1.bext{2} \/ (mem (rng FRO.m) (x.`2, Unknown)){2} \/ @@ -229,10 +231,10 @@ section. ! mem (dom G1.mi{1}) x{1}). + inline *;auto=> &ml&mr[#]9!-> Hi Hhand -> /=. rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. - + rewrite rng_set !inE rem_id 1:/#;move:H2=>[/Hi[->|[x' h][]HH1 HH2]|->]//. + + rewrite rng_set !inE rem_id 1:/#;move:H4=>[/Hi[->|[x' h][]HH1 HH2]|->]//. right;right;exists x', h;rewrite getP. by cut ->//:(h<> G1.chandle{mr});move:(Hhand h);rewrite in_dom HH2 /#. - by move:H2;rewrite dom_set !inE /#. + by move:H4;rewrite dom_set !inE /#. if=>//. + inline *;rcondt{2} 4. + by move=> &m;auto;rewrite /in_dom_with. @@ -403,7 +405,9 @@ section EXT. } handles_ <@ RRO.restrK(); hx2 <- oget (hinvc handles_ x.`2); - y <$ dstate; + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); t <@ RRO.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; @@ -566,7 +570,7 @@ section EXT. ={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 6 6 : + 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}). @@ -619,33 +623,33 @@ section EXT. apply ler_wpmul2r;1:by apply eps_ge0. by rewrite le_fromint;smt ml=0 w=max_ge0. + proc. - case ((size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size)); - [rcondt 2 | rcondf 2]; 1,3:by auto. - + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi ) `|` fset1 x));skip=> &hr[#]?->/=???. - rewrite (Mu_mem.mu_mem - (image snd (dom G1.m{hr} `|` dom G1.mi{hr}) `|` fset1 x{hr}) - cdistr (1%r/(2^c)%r))//. + case ((size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size)); + [rcondt 2 | rcondf 2];1,3:by auto. + + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi)));skip=> &hr[#]?->/=???. + rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr})) cdistr (1%r/(2^c)%r))//. + move=>x _;apply DWord.muxP. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU !fcardU le_fromint fcard1. + rewrite imageU fcardU le_fromint. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). rewrite -!sizeE;smt w=fcard_ge0. by hoare=>[??|];[apply eps_ge0|auto]. + by move=>c1;proc;auto=> &hr [^H 2->]/#. - + by move=> b1 c1;proc;auto=> &hr [^H 2->]. + by move=> b1 c1;proc;auto=> &hr [^H 2->]. + proc. - case ((size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size)); - [rcondt 2 | rcondf 2];1,3:by auto. - + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi)));skip=> &hr[#]?->/=???. - rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr})) cdistr (1%r/(2^c)%r))//. + case ((size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size)); + [rcondt 2 | rcondf 2]; 1,3:by auto. + + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi ) `|` fset1 x));skip=> &hr[#]?->/=???. + rewrite (Mu_mem.mu_mem + (image snd (dom G1.m{hr} `|` dom G1.mi{hr}) `|` fset1 x{hr}) + cdistr (1%r/(2^c)%r))//. + move=>x _;apply DWord.muxP. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU fcardU le_fromint. + rewrite imageU !fcardU le_fromint fcard1. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). rewrite -!sizeE;smt w=fcard_ge0. by hoare=>[??|];[apply eps_ge0|auto]. + by move=>c1;proc;auto=> &hr [^H 2->]/#. - by move=> b1 c1;proc;auto=> &hr [^H 2->]. + by move=> b1 c1;proc;auto=> &hr [^H 2->]. qed. axiom D_ll: diff --git a/sha3/proof/old/Handle.eca b/sha3/proof/old/Handle.eca index 22fa30a..1794696 100644 --- a/sha3/proof/old/Handle.eca +++ b/sha3/proof/old/Handle.eca @@ -96,7 +96,7 @@ module G1(D:DISTINGUISHER) = { } proc fi(x : state): state = { - var y, y1, hx2, hy2; + var y, y1, y2, hx2, hy2; if (!mem (dom mi) x) { bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); @@ -105,19 +105,21 @@ module G1(D:DISTINGUISHER) = { chandle <- chandle + 1; } hx2 <- oget (hinvK FRO.m x.`2); - y <$ dstate; + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); if (mem (dom mhi) (x.`1,hx2) /\ 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); + 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); + FRO.m.[hy2] <- (y.`2, Known); mi.[x] <- y; mhi.[(x.`1, hx2)] <- (y.`1, hy2); m.[y] <- x; From c3194618b61df2250039cc79f2244ebe1c05f521 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 25 Jan 2016 14:44:55 +0100 Subject: [PATCH 132/394] improve RndO lemmas. --- sha3/proof/RndO.ec | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/sha3/proof/RndO.ec b/sha3/proof/RndO.ec index 2e8757f..5e0a450 100644 --- a/sha3/proof/RndO.ec +++ b/sha3/proof/RndO.ec @@ -192,7 +192,7 @@ qed. lemma RO_FRO_D (D<:RO_Distinguisher{RO,FRO}) : equiv [D(RO).distinguish ~ D(FRO).distinguish : ={glob D} /\ RO.m{1} = map (+fst) FRO.m{2} ==> - ={glob D} /\ RO.m{1} = map (+fst) FRO.m{2} ]. + ={res,glob D} /\ RO.m{1} = map (+fst) FRO.m{2} ]. proof. proc (RO.m{1} = map (+fst) FRO.m{2})=>//. + by conseq RO_FRO_init. + by conseq RO_FRO_get. + by conseq RO_FRO_set. @@ -626,7 +626,7 @@ qed. lemma LRO_RRO_D (D<:RO_Distinguisher{RO,FRO}) : equiv [D(LRO).distinguish ~ D(RRO).distinguish : ={glob D} /\ RO.m{1} = restr Known FRO.m{2} ==> - ={glob D} /\ RO.m{1} = restr Known FRO.m{2} ]. + ={res,glob D} /\ RO.m{1} = restr Known FRO.m{2} ]. proof. proc (RO.m{1} = restr Known FRO.m{2})=>//. + by conseq LRO_RRO_init. + by conseq LRO_RRO_get. + by conseq LRO_RRO_set. @@ -655,23 +655,23 @@ local module M = { lemma RO_LRO_D : equiv [D(RO).distinguish ~ D(LRO).distinguish : - ={glob D,RO.m} ==> ={glob D}]. + ={glob D,RO.m} ==> ={res,glob D}]. proof. transitivity M.main1 (={glob D} /\ FRO.m{2} = map (fun _ c => (c,Known)) RO.m{1} ==> - ={glob D}) + ={res,glob D}) (={glob D} /\ FRO.m{1} = map (fun _ c => (c,Known)) RO.m{2} ==> - ={glob D})=>//. + ={res,glob D})=>//. + by move=>?&mr[]2!->;exists (glob D){mr},(map(fun _ c =>(c,Known))RO.m{mr}). + proc*;inline M.main1;wp;call (RO_FRO_D D);inline *. rcondf{2}2;auto. + move=> &mr[]_->;apply mem_eq0=>z;rewrite -memE dom_restr /in_dom_with mapP dom_map in_dom. by case(RO.m{m}.[_]). - by move=>?&mr[]2!->/=;rewrite map_comp /fst/= map_id. + by move=>?&mr[]2!->/=;rewrite map_comp /fst/= map_id. transitivity M.main2 - (={glob D, FRO.m} ==> ={glob D}) + (={glob D, FRO.m} ==> ={res, glob D}) (={glob D} /\ FRO.m{1} = map (fun _ c => (c,Known)) RO.m{2} ==> - ={glob D})=>//. + ={res,glob D})=>//. + by move=>?&mr[]2!->;exists (glob D){mr},(map(fun _ c =>(c,Known))RO.m{mr}). + by proc; eager call (eager_D D);auto. proc*;inline M.main2;wp;call{1} RRO_resample_ll. From 8868e37bcd377144216101bd7e6b8a6add962226 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 25 Jan 2016 16:57:44 +0100 Subject: [PATCH 133/394] almost done. need to remove on test in C.f. --- sha3/proof/old/Gconcl.ec | 405 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 405 insertions(+) create mode 100644 sha3/proof/old/Gconcl.ec diff --git a/sha3/proof/old/Gconcl.ec b/sha3/proof/old/Gconcl.ec new file mode 100644 index 0000000..dccbcbc --- /dev/null +++ b/sha3/proof/old/Gconcl.ec @@ -0,0 +1,405 @@ +pragma -oldip. +require import Pred Fun Option Pair Int Real RealExtra StdOrder Ring StdBigop. +require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. +(*...*) import Dprod Dexcepted Capacity IntOrder Bigreal RealOrder BRA. + +require (*..*) Gext. + +module IF = { + proc init = F.RO.init + proc f(p:block list) = { + var sa <- b0; + if (1 <= size p /\ p <> [b0]) { + sa <@ F.RO.get(p); + } + return sa; + } +}. + +module S(F : DFUNCTIONALITY) = { + var m, mi : smap + var paths : (capacity, block list * block) fmap + + proc init() = { + m <- map0; + mi <- map0; + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + paths <- map0.[c0 <- ([<:block>],b0)]; + } + + proc f(x : state): state = { + var p, v, y, y1, y2; + + if (!mem (dom m) x) { + if (mem (dom paths) x.`2) { + (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 (mem (dom paths) x.`2) { + (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 (!mem (dom mi) x) { + 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 }. +local clone import Gext as Gext0. + +local module G3(RO:F.RO) = { + + module C = { + + proc f(p : block list): block = { + var sa, sa'; + var h, i <- 0; + sa <- b0; + if (1 <= size p /\ p <> [b0]) { + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + RO.sample(take (i+1) p); + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + 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; + } + 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 (!mem (dom G1.m) x) { + if (mem (dom G1.paths) x.`2) { + (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.restrK(); + if (!mem (rng handles_) x.`2) { + RRO.set(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <- RRO.restrK(); + hx2 <- oget (hinvc handles_ x.`2); + t <@ RRO.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); + if (mem (dom G1.mh) (x.`1, hx2) /\ 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 (mem (dom G1.paths) x.`2) { + (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 (!mem (dom G1.mi) x) { + handles_ <@ RRO.restrK(); + if (!mem (rng handles_) x.`2) { + RRO.set(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <@ RRO.restrK(); + hx2 <- oget (hinvc handles_ x.`2); + t <@ RRO.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + if (mem (dom G1.mhi) (x.`1, hx2) /\ 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 <- map0; + G1.mi <- map0; + G1.mh <- map0; + G1.mhi <- map0; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + RRO.init(); + RRO.set(0,c0); + G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.chandle <- 1; + b <@ DRestr(D,C,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}); last by auto. + + + proc;sp;if=> //. + call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c});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} /\ + (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}); + 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} + /\ (t = in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1}). + + by inline *;auto=> /> ? _;rewrite Block.DWord.bdistr_ll. + case ((mem (dom G1.mh) (x.`1, hx2) /\ 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=>/>. + wp;rnd;auto;progress[-split];rewrite DWord.cdistr_ll /= => ?_?->. + by rewrite !getP /= oget_some. + case ((mem (dom G1.mh) (x.`1, hx2) /\ 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=>/>. + wp;rnd;auto;rnd{1};auto;progress[-split]. + rewrite Block.DWord.supportP DWord.cdistr_ll /==> ?_?->. + by rewrite !getP /= oget_some. + + + proc;sp;if=>//. + call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c});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} + /\ (t = in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1}). + + by inline *;auto. + case ((mem (dom G1.mhi) (x.`1, hx2) /\ 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=>/>. + wp;rnd;auto;progress[-split];rewrite DWord.cdistr_ll /= => ?_?->. + by rewrite !getP /= oget_some. + + proc;sp;if=>//. + call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c});2:by auto. + by inline F.LRO.sample;sim. +qed. + +local equiv G3_G3: G3(F.LRO).distinguish ~ G3(F.RO).distinguish : ={glob G3,F.RO.m} ==> ={res}. +proof. symmetry;conseq (F.RO_LRO_D G3)=> //. qed. + +local module G4(RO:F.RO) = { + + module C = { + + proc f(p : block list): block = { + var sa; + var h, i <- 0; + sa <- b0; + if (1 <= size p /\ p <> [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 (!mem (dom G1.m) x) { + if (mem (dom G1.paths) x.`2) { + (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 (mem (dom G1.paths) x.`2) { + (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 (!mem (dom G1.mi) x) { + 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 <- map0; + G1.mi <- map0; + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + G1.paths <- map0.[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});last by auto. + + proc;sp;if=>//. + call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. + if => //;2:sim. + seq 3 3: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by sim. + sim;seq 5 0: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by inline *;auto. + by if{1};sim;inline *;auto. + + proc;sp;if=>//. + call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. + if => //;2:sim. + seq 5 0: (={x,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by inline *;auto. + seq 3 3: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by sim. + by if{1};sim;inline *;auto. + proc;sp;if=>//. + call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. + sp;if=>//;sim; while(={i,p,F.RO.m})=>//. + inline F.RO.sample F.RO.get;if{1};1:by auto. + by sim;inline *;auto;progress;apply DWord.cdistr_ll. +qed. + +local equiv G4_G4 : G4(F.RO).distinguish ~ G4(F.LRO).distinguish : ={glob G4,F.RO.m} ==> ={res}. +proof. conseq (F.RO_LRO_D G4)=> //. 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,F.RO.m} /\ G1.m{1}=S.m{2} /\ G1.mi{1}=S.mi{2} /\ G1.paths{1}=S.paths{2}). + + proc;sp;if=>//. + call (_: ={C.c,F.RO.m} /\ G1.m{1}=S.m{2} /\ G1.mi{1}=S.mi{2} /\ G1.paths{1}=S.paths{2}); + 2: by auto. + if=>//;sim;if=> //;2:by auto. + inline{2} IF.f;rcondt{2} 4. + + auto;progress. smt w=(size_rcons List.size_ge0). + admit. + by inline *;sim. + + by sim. + + proc;sp;if=>//. + call (_: ={F.RO.m});2:by auto. + sp;if=>//;sim. + by while{1} (true) (size p - i){1};auto;1:inline*;auto=>/#. + by auto. +qed. + +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 + 1) ^ 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]);1:by byequiv G3_G3. + 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]);1:by byequiv G4_G4. + by byequiv G4_Ideal. +qed. + +end section. From a9c5d089437f825d0953c0396d4a02aadf2a0a42 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 25 Jan 2016 18:30:36 +0100 Subject: [PATCH 134/394] End of the last part of the proof. --- sha3/proof/old/Gcol.eca | 33 ++++++++--------- sha3/proof/old/Gconcl.ec | 73 +++++++++++++------------------------- sha3/proof/old/Gext.eca | 65 ++++++++++++++++----------------- sha3/proof/old/Handle.eca | 32 ++++++++--------- sha3/proof/old/SLCommon.ec | 9 +++-- 5 files changed, 89 insertions(+), 123 deletions(-) diff --git a/sha3/proof/old/Gcol.eca b/sha3/proof/old/Gcol.eca index 78d8136..8603f9f 100644 --- a/sha3/proof/old/Gcol.eca +++ b/sha3/proof/old/Gcol.eca @@ -52,24 +52,22 @@ section PROOF. var sa, sa', sc; var h, i <- 0; sa <- b0; - if (1 <= size p /\ p <> [b0]) { - while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; - } else { - 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; - } - i <- i + 1; + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + 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; } - sa <- F.RO.get(p); + i <- i + 1; } + sa <- F.RO.get(p); return sa; } } @@ -265,8 +263,7 @@ section PROOF. (G1.bcol{1} => G1.bcol{2}) /\ card (rng FRO.m{2}) + 2*(size p{2}) <= 2 * C.c{2} + 1 /\ Gcol.count{2} + size p{2} <= C.c{2} <= max_size);1:by auto=>/#. - wp;if=>//;2:by auto;smt ml=0 w=size_ge0. - call (_: ={F.RO.m});1:by sim. + wp;call (_: ={F.RO.m});1:by sim. 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} /\ (i <= size p){1} /\ diff --git a/sha3/proof/old/Gconcl.ec b/sha3/proof/old/Gconcl.ec index dccbcbc..a3d7948 100644 --- a/sha3/proof/old/Gconcl.ec +++ b/sha3/proof/old/Gconcl.ec @@ -7,13 +7,7 @@ require (*..*) Gext. module IF = { proc init = F.RO.init - proc f(p:block list) = { - var sa <- b0; - if (1 <= size p /\ p <> [b0]) { - sa <@ F.RO.get(p); - } - return sa; - } + proc f = F.RO.get }. module S(F : DFUNCTIONALITY) = { @@ -81,24 +75,22 @@ local module G3(RO:F.RO) = { var sa, sa'; var h, i <- 0; sa <- b0; - if (1 <= size p /\ p <> [b0]) { - while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { - RO.sample(take (i+1) p); - (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; - } else { - 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; - } - i <- i + 1; + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + RO.sample(take (i+1) p); + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + 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; } - sa <- RO.get(p); + i <- i + 1; } + sa <- RO.get(p); return sa; } } @@ -256,9 +248,6 @@ proof. by inline F.LRO.sample;sim. qed. -local equiv G3_G3: G3(F.LRO).distinguish ~ G3(F.RO).distinguish : ={glob G3,F.RO.m} ==> ={res}. -proof. symmetry;conseq (F.RO_LRO_D G3)=> //. qed. - local module G4(RO:F.RO) = { module C = { @@ -267,13 +256,11 @@ local module G4(RO:F.RO) = { var sa; var h, i <- 0; sa <- b0; - if (1 <= size p /\ p <> [b0]) { - while (i < size p ) { - RO.sample(take (i+1) p); - i <- i + 1; - } - sa <- RO.get(p); + while (i < size p ) { + RO.sample(take (i+1) p); + i <- i + 1; } + sa <- RO.get(p); return sa; } } @@ -352,31 +339,20 @@ proof. by if{1};sim;inline *;auto. proc;sp;if=>//. call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. - sp;if=>//;sim; while(={i,p,F.RO.m})=>//. + sp;sim; while(={i,p,F.RO.m})=>//. inline F.RO.sample F.RO.get;if{1};1:by auto. by sim;inline *;auto;progress;apply DWord.cdistr_ll. qed. -local equiv G4_G4 : G4(F.RO).distinguish ~ G4(F.LRO).distinguish : ={glob G4,F.RO.m} ==> ={res}. -proof. conseq (F.RO_LRO_D G4)=> //. 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,F.RO.m} /\ G1.m{1}=S.m{2} /\ G1.mi{1}=S.mi{2} /\ G1.paths{1}=S.paths{2}). - + proc;sp;if=>//. - call (_: ={C.c,F.RO.m} /\ G1.m{1}=S.m{2} /\ G1.mi{1}=S.mi{2} /\ G1.paths{1}=S.paths{2}); - 2: by auto. - if=>//;sim;if=> //;2:by auto. - inline{2} IF.f;rcondt{2} 4. - + auto;progress. smt w=(size_rcons List.size_ge0). - admit. - by inline *;sim. - + by sim. + + by sim. + by sim. + proc;sp;if=>//. call (_: ={F.RO.m});2:by auto. - sp;if=>//;sim. + 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. @@ -396,9 +372,10 @@ 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]);1:by byequiv G3_G3. + apply (eq_trans _ Pr[G3(F.RO ).distinguish() @ &m : res]). + + by byequiv (_: ={glob G3, F.RO.m} ==> _)=>//;symmetry;conseq (F.RO_LRO_D G3). 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]);1:by byequiv G4_G4. + apply (eq_trans _ Pr[G4(F.LRO).distinguish() @ &m : res]);1:by byequiv (F.RO_LRO_D G4). by byequiv G4_Ideal. qed. diff --git a/sha3/proof/old/Gext.eca b/sha3/proof/old/Gext.eca index a38aff6..102c49b 100644 --- a/sha3/proof/old/Gext.eca +++ b/sha3/proof/old/Gext.eca @@ -22,23 +22,21 @@ module G2(D:DISTINGUISHER,HS:FRO) = { var sa, sa'; var h, i <- 0; sa <- b0; - if (1 <= size p /\ p <> [b0]) { - while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; - } else { - 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; - } - i <- i + 1; + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + 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; } - sa <- F.RO.get(p); + i <- i + 1; } + sa <- F.RO.get(p); return sa; } } @@ -262,7 +260,7 @@ section. conseq (_: ={sa,G1.mh,G1.mhi,F.RO.m, G1.chandle, FRO.m} /\ inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ forall (h0 : handle), mem (dom FRO.m{1}) h0 => h0 < G1.chandle{1})=>//. - sp 3 3;if=>//;call (_: ={F.RO.m});1:by sim. + sp 3 3;call (_: ={F.RO.m});1:by sim. while (={sa,G1.mh,G1.mhi,F.RO.m,G1.chandle,FRO.m,i,h,sa,p} /\ inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ forall (h0 : handle), mem (dom FRO.m{1}) h0 => h0 < G1.chandle{1})=>//. @@ -323,23 +321,21 @@ section EXT. var sa, sa'; var h, i <- 0; sa <- b0; - if (1 <= size p /\ p <> [b0]) { - while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; - } else { - 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; - } - i <- i + 1; + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + 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; } - sa <- F.RO.get(p); + i <- i + 1; } + sa <- F.RO.get(p); return sa; } } @@ -588,19 +584,18 @@ section EXT. + proc;sp 1 1;if=>//. inline G2(DRestr(D), RRO).C.f Gext.C.f. - sp 5 5;elim *=> c0L c0R;if => //;last by auto;smt w=List.size_ge0. + sp 5 5;elim *=> c0L c0R. wp;call (_: ={F.RO.m});1:by sim. while (={i,p,G1.mh,sa,h,FRO.m,F.RO.m,G1.mh,G1.mhi,G1.chandle} /\ 0 <= i{1} <= size p{1}/\ c0R + size p{1} <= max_size /\ - inv_le G1.m{2} G1.mi{2} (c0R + i){2} FRO.m{2} ReSample.count{2});last by auto=>/#. + inv_le G1.m{2} G1.mi{2} (c0R + i){2} FRO.m{2} ReSample.count{2}); + last by auto;smt w=List.size_ge0. if=> //;1:by auto=>/#. auto;call (_: ={F.RO.m});1:by sim. - (*inline *;auto=>/> ?&mr. BUG anomaly: EcLowGoal.InvalidProofTerm *) inline *;auto=> ?&mr [#]!->@/inv_le Hi [#]. case (p{mr})=> [/#|/=p1 p2] 4?_ /= 2?-> /=;split=>/= Hmem 4? [#]2->/= => [|/#]. by rewrite restr_set /= size_set dom_restr /in_dom_with Hmem/= /#. - (* auto=> />. BUG *) auto;progress[delta];rewrite ?(size0,restr0,restr_set,rem0,max_ge0,-sizeE,-cardE) //=. + smt ml=0. + smt ml=0. + smt ml=0. + elim H7=>// [[x h] [#]];rewrite -memE dom_restr /in_dom_with in_dom=> _ ->/=. diff --git a/sha3/proof/old/Handle.eca b/sha3/proof/old/Handle.eca index 1794696..944b652 100644 --- a/sha3/proof/old/Handle.eca +++ b/sha3/proof/old/Handle.eca @@ -23,25 +23,23 @@ module G1(D:DISTINGUISHER) = { var sa, sa', sc; var h, i <- 0; sa <- b0; - if (1 <= size p /\ p <> [b0]) { - while (i < size p ) { - if (mem (dom mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; - } else { - 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; - } - i <- i + 1; + while (i < size p ) { + if (mem (dom mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; + } else { + 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; } - sa <- F.RO.get(p); + i <- i + 1; } + sa <- F.RO.get(p); return sa; } } diff --git a/sha3/proof/old/SLCommon.ec b/sha3/proof/old/SLCommon.ec index 2073e0f..ec26f5c 100644 --- a/sha3/proof/old/SLCommon.ec +++ b/sha3/proof/old/SLCommon.ec @@ -48,12 +48,11 @@ module SqueezelessSponge (P:DPRIMITIVE): FUNCTIONALITY = { proc f(p : block list): block = { var (sa,sc) <- (b0,c0); - if (1 <= size p (*/\ p <> [b0]*)) { - while (p <> []) { (* Absorption *) - (sa,sc) <@ P.f((sa +^ head witness p,sc)); - p <- behead p; - } + while (p <> []) { (* Absorption *) + (sa,sc) <@ P.f((sa +^ head witness p,sc)); + p <- behead p; } + return sa; (* Squeezing phase (non-iterated) *) } }. From 55e14456302e2f8a4aa9c4140072f3c28be55ef9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 26 Jan 2016 14:36:27 +0100 Subject: [PATCH 135/394] Fixing defs and proofs w.r.t new distributions. --- sha3/proof/LazyRP.eca | 10 ++++------ sha3/proof/old/ConcreteF.eca | 8 ++++---- 2 files changed, 8 insertions(+), 10 deletions(-) diff --git a/sha3/proof/LazyRP.eca b/sha3/proof/LazyRP.eca index 012268d..b262f0d 100644 --- a/sha3/proof/LazyRP.eca +++ b/sha3/proof/LazyRP.eca @@ -19,7 +19,7 @@ module P : RP, RP_ = { var y; if (!mem (dom m) x) { - y <$ d \ rng m; + y <$ d \ (mem (rng m)); m.[x] <- y; mi.[y] <- x; } @@ -30,7 +30,7 @@ module P : RP, RP_ = { var y; if (!mem (dom mi) x) { - y <$ d \ rng mi; + y <$ d \ (mem (rng mi)); mi.[x] <- y; m.[y] <- x; } @@ -45,14 +45,12 @@ lemma P_f_ll: is_lossless d => support d = predT => islossless P.f. proof. move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. have h:= endo_dom_rng P.m{m} _; first by exists x{m}. -apply/lossless_restr; first by rewrite d_ll. -smt. (* needs help *) +apply/dexcepted_ll=> //; smt. (* needs help *) qed. lemma P_fi_ll: is_lossless d => support d = predT => islossless P.fi. proof. move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. have h:= endo_dom_rng P.mi{m} _; first by exists x{m}. -apply/lossless_restr; first by rewrite d_ll. -smt. (* needs help *) +apply/dexcepted_ll=> //; smt. (* needs help *) qed. diff --git a/sha3/proof/old/ConcreteF.eca b/sha3/proof/old/ConcreteF.eca index 23e2ba1..20ad629 100644 --- a/sha3/proof/old/ConcreteF.eca +++ b/sha3/proof/old/ConcreteF.eca @@ -120,15 +120,15 @@ section. + exact/Block.DWord.bdistr_ll. exact/Capacity.DWord.cdistr_ll. + apply/fun_ext=> x; rewrite Dprod.supp_def /bdistr /cdistr. - rewrite -/(Distr.support _ _) NewDistr.MUniform.support_duniform Block.enumP. - by rewrite -/(Distr.support _ _) NewDistr.MUniform.support_duniform Capacity.enumP. + rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Block.enumP. + by rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Capacity.enumP. have pi_ll := P_fi_ll _ _. + apply/Dprod.lossless. + exact/Block.DWord.bdistr_ll. exact/Capacity.DWord.cdistr_ll. + apply/fun_ext=> x; rewrite Dprod.supp_def /bdistr /cdistr. - rewrite -/(Distr.support _ _) NewDistr.MUniform.support_duniform Block.enumP. - by rewrite -/(Distr.support _ _) NewDistr.MUniform.support_duniform Capacity.enumP. + rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Block.enumP. + by rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Capacity.enumP. have f_ll : islossless SqueezelessSponge(Perm).f. + proc; sp; if=> //=. while true (size p) (size p) 1%r=> //=. From ca951a27cd8332167f14d3a4a44d6da87cfce850 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 26 Jan 2016 15:28:46 +0100 Subject: [PATCH 136/394] Pushing ConcreteF back through. --- sha3/proof/old/ConcreteF.eca | 20 +++++++------------- 1 file changed, 7 insertions(+), 13 deletions(-) diff --git a/sha3/proof/old/ConcreteF.eca b/sha3/proof/old/ConcreteF.eca index 20ad629..b100f1a 100644 --- a/sha3/proof/old/ConcreteF.eca +++ b/sha3/proof/old/ConcreteF.eca @@ -91,7 +91,6 @@ section. rcondt{2} 4; 1: by auto=> /#. by wp; call (_: true); auto. + proc; sp; if=> //=; inline *. - sp; if=> //=; last by wp; auto; smt w=size_ge0. wp; while ( ={glob C, glob P, p, sa, sc} /\ C.c{2} <= max_size /\ DBounder.FBounder.c{2} = C.c{2} - size p{2}). @@ -110,11 +109,9 @@ section. res /\ C.c <= max_size] = Pr[GReal'.main()@ &m: res/\ C.c <= max_size]. + byequiv=>//;proc;inline *;call (_: ={C.c,glob Perm});last by auto. + by sim. + by sim. - proc;inline *;sp 1 0;if{1};wp;[rcondt{2}5|rcondf{2}5];1,3:by auto. - + while (={glob Perm,sc,sa,p} /\ (C.c + size p){1} = C.c{2});2:by auto. - by wp;sp 1 1;if{2};[rcondt{1} 3|rcondf{1} 3];auto; - progress;rewrite size_behead//;ring. - by auto; smt w=size_ge0. + proc; inline *; wp. + while (={glob Perm,sc,sa,p} /\ (C.c + size p){1} = C.c{2});2:by auto. + by sp; if=> //=; auto=> /> &2 cL /size_behead=> ->; progress; ring. have p_ll := P_f_ll _ _. + apply/Dprod.lossless. + exact/Block.DWord.bdistr_ll. @@ -130,12 +127,9 @@ section. rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Block.enumP. by rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Capacity.enumP. have f_ll : islossless SqueezelessSponge(Perm).f. - + proc; sp; if=> //=. - while true (size p) (size p) 1%r=> //=. - * smt w=(size_ge0 size_eq0). - * by move=> hind; seq 2: true 1%r 1%r 0%r _=> //=; wp; call p_ll. - * by wp; call p_ll. - by move=> z; conseq (_: _ : =1%r); wp; call p_ll; skip; smt w=size_behead. + + proc; while true (size p)=> //=. + * by move=> z; wp; call p_ll; skip=> /> &hr /size_behead /#. + 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] @@ -155,7 +149,7 @@ section. + apply D_ll. + by proc; sp; if=> //=; call O_f_ll; auto. + by proc; sp; if=> //=; call O_fi_ll; auto. - + proc; inline *; sp; if=> //=; sp; if=> //=; auto. + + proc; inline *; sp; if=> //=; auto. while true (size p). * by auto; call O_f_ll; auto=> /#. by auto; smt w=size_ge0. From 5cc1f71157a70c3a0ad0684d89e6a673532d0ac8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 26 Jan 2016 15:40:38 +0100 Subject: [PATCH 137/394] ConcreteF: split sampling. --- sha3/proof/old/ConcreteF.eca | 45 ++++++++++++++++++++++++++++-------- 1 file changed, 36 insertions(+), 9 deletions(-) diff --git a/sha3/proof/old/ConcreteF.eca b/sha3/proof/old/ConcreteF.eca index b100f1a..304840e 100644 --- a/sha3/proof/old/ConcreteF.eca +++ b/sha3/proof/old/ConcreteF.eca @@ -14,23 +14,25 @@ module PF = { } proc f(x : state): state = { - var y; + var y1, y2; if (!mem (dom m) x) { - y <$ dstate; - m.[x] <- y; - mi.[y] <- x; + y1 <$ bdistr; + y2 <$ cdistr; + m.[x] <- (y1,y2); + mi.[(y1,y2)] <- x; } return oget m.[x]; } proc fi(x : state): state = { - var y; + var y1, y2; if (!mem (dom mi) x) { - y <$ dstate; - mi.[x] <- y; - m.[y] <- x; + y1 <$ bdistr; + y2 <$ cdistr; + mi.[x] <- (y1,y2); + m.[(y1,y2)] <- x; } return oget mi.[x]; } @@ -100,6 +102,12 @@ section. by wp; call (_: true). qed. + local clone import Sample with + type t1 <- block, + op d1 <- bdistr, + type t2 <- capacity, + op d2 <- cdistr. + lemma Real_Concrete &m : Pr[GReal(D).main()@ &m: res /\ C.c <= max_size] <= Pr[CF(DRestr(D)).main()@ &m: res] + ((max_size + 1) ^ 2)%r * mu dstate (pred1 witness). @@ -142,7 +150,26 @@ section. = Pr[PRPt.IND(ARP,DBounder(D')).main() @ &m: res]. + rewrite -(DoubleBounding ARP &m). byequiv=> //=; proc; inline *; sim (_: ={m,mi}(PF,ARP)). - * by proc; if=> //=; auto. + * proc; if=> //=; auto; conseq (_: true ==> (y1,y2){1} = x{2})=> //=. + transitivity{1} { (y1,y2) <@ S.sample2(); } + (true ==> ={y1,y2}) + (true ==> (y1,y2){1} = x{2})=> //=. + - by inline *; auto. + transitivity{2} { x <@ S.sample(); } + (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(); } + (true ==> ={y1,y2}) + (true ==> (y1,y2){1} = y{2})=> //=. + - by inline *; auto. + transitivity{2} { y <@ S.sample(); } + (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; call (_: true)=> //=. From b90eaa3fb623cc2fcffee4407b710f1a33481c92 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 26 Jan 2016 19:38:06 +0100 Subject: [PATCH 138/394] Update files that are still relevant. This is to stick to latest revision of stdlib. --- sha3/proof/Common.ec | 6 +++--- sha3/proof/RndO.ec | 4 ++-- sha3/proof/RndOrcl.eca | 6 +++--- sha3/proof/old/ConcreteF.eca | 18 +++++++++--------- sha3/proof/old/Gcol.eca | 3 ++- sha3/proof/old/Gconcl.ec | 3 ++- sha3/proof/old/Gext.eca | 3 ++- sha3/proof/old/Handle.eca | 3 ++- sha3/proof/old/SLCommon.ec | 8 ++++---- sha3/proof/variant/RndOrcl.eca | 4 ++-- 10 files changed, 31 insertions(+), 27 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 115c5ce..51bf821 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -1,9 +1,9 @@ (*------------------- Common Definitions and Lemmas --------------------*) require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. -require import Ring StdRing StdOrder StdBigop BitEncoding. +require import Ring StdRing StdOrder StdBigop BitEncoding DProd. require (*--*) FinType BitWord LazyRP Monoid. -(*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv Dprod. +(*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv. require import NewLogic. pragma +implicits. @@ -87,7 +87,7 @@ qed. clone export LazyRP as Perm with type D <- block * capacity, - op d <- bdistr * Capacity.cdistr + op d <- bdistr `*` Capacity.cdistr rename [module type] "RP" as "PRIMITIVE" [module] "P" as "Perm". diff --git a/sha3/proof/RndO.ec b/sha3/proof/RndO.ec index 5e0a450..367870b 100644 --- a/sha3/proof/RndO.ec +++ b/sha3/proof/RndO.ec @@ -1,5 +1,5 @@ pragma -oldip. -require import Pair Option List FSet NewFMap. +require import Pair Option List FSet NewFMap NewDistr. import NewLogic Fun. require IterProc. @@ -168,7 +168,7 @@ proof. by proc;auto=>/=;rewrite map_map0. qed. equiv RO_FRO_get : RO.get ~ FRO.get : ={x} /\ RO.m{1} = map (+fst) FRO.m{2} ==> ={res} /\ RO.m{1} = map (+fst) FRO.m{2}. -proof. +proof. proc;auto=>?&ml[]->->/=?->/=. rewrite !dom_map !map_set/fst/= getP_eq oget_some;progress. + by rewrite mapP oget_omap_some // -in_dom. diff --git a/sha3/proof/RndOrcl.eca b/sha3/proof/RndOrcl.eca index 4b15b5c..07fd6ba 100644 --- a/sha3/proof/RndOrcl.eca +++ b/sha3/proof/RndOrcl.eca @@ -1,4 +1,4 @@ -require import Option FSet NewFMap. +require import Option FSet NewFMap NewDistr. (* TODO move this in NewFMap *) lemma dom_set (m:('a,'b) fmap) a b : dom m.[a<-b] = dom m `|` fset1 a. proof. by apply fsetP=> x;smt. qed. @@ -45,7 +45,7 @@ abstract theory Ideal. section LL. - axiom sample_ll : forall x, Distr.weight (sample x) = 1%r. + axiom sample_ll : forall x, weight (sample x) = 1%r. lemma f_ll : phoare[RO.f : true ==> true] = 1%r. proof. proc;auto;progress;apply sample_ll. qed. @@ -149,7 +149,7 @@ abstract theory GenIdeal. + case ((pick work = x){2})=> pick_x; last smt. subst x{2}; move: H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. by apply fmapP=> x0; case (pick work{2} = x0); smt. - by auto; smt. + by auto; smt w=@NewFMap. by auto;progress [-split];rewrite H0 /= getP_eq;smt. qed. diff --git a/sha3/proof/old/ConcreteF.eca b/sha3/proof/old/ConcreteF.eca index 304840e..73cf914 100644 --- a/sha3/proof/old/ConcreteF.eca +++ b/sha3/proof/old/ConcreteF.eca @@ -1,7 +1,7 @@ require import Pred Fun Option Pair Int Real StdOrder Ring. -require import List FSet NewFMap Utils Common SLCommon. +require import List FSet NewFMap Utils Common SLCommon DProd Dexcepted. -(*...*) import Dprod Dexcepted Capacity IntOrder RealOrder. +(*...*) import Capacity IntOrder RealOrder. require (*..*) Strong_RP_RF. @@ -61,9 +61,9 @@ section. realize gt0_q by smt w=max_ge0. realize uD_uf_fu. split. - case=> [x y]; rewrite Dprod.supp_def /fst /snd /=. + case=> [x y]; rewrite support_dprod /=. by rewrite Block.DWord.supportP Capacity.DWord.supportP. - apply/dprodU. + apply/dprod_uf. by rewrite Block.DWord.bdistr_uf. by rewrite Capacity.DWord.cdistr_uf. qed. @@ -102,7 +102,7 @@ section. by wp; call (_: true). qed. - local clone import Sample with + local clone import ProdSampling with type t1 <- block, op d1 <- bdistr, type t2 <- capacity, @@ -121,17 +121,17 @@ section. while (={glob Perm,sc,sa,p} /\ (C.c + size p){1} = C.c{2});2:by auto. by sp; if=> //=; auto=> /> &2 cL /size_behead=> ->; progress; ring. have p_ll := P_f_ll _ _. - + apply/Dprod.lossless. + + apply/dprod_ll; split. + exact/Block.DWord.bdistr_ll. exact/Capacity.DWord.cdistr_ll. - + apply/fun_ext=> x; rewrite Dprod.supp_def /bdistr /cdistr. + + apply/fun_ext=>- [] a b; rewrite support_dprod. rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Block.enumP. by rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Capacity.enumP. have pi_ll := P_fi_ll _ _. - + apply/Dprod.lossless. + + apply/dprod_ll; split. + exact/Block.DWord.bdistr_ll. exact/Capacity.DWord.cdistr_ll. - + apply/fun_ext=> x; rewrite Dprod.supp_def /bdistr /cdistr. + + apply/fun_ext=>- [] a b; rewrite support_dprod. rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Block.enumP. by rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Capacity.enumP. have f_ll : islossless SqueezelessSponge(Perm).f. diff --git a/sha3/proof/old/Gcol.eca b/sha3/proof/old/Gcol.eca index 8603f9f..8405281 100644 --- a/sha3/proof/old/Gcol.eca +++ b/sha3/proof/old/Gcol.eca @@ -1,7 +1,8 @@ pragma -oldip. require import Pred Fun Option Pair Int Real RealExtra StdOrder Ring StdBigop. require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. -(*...*) import Dprod Dexcepted Capacity IntOrder Bigreal RealOrder BRA. +require import DProd Dexcepted. +(*...*) import Capacity IntOrder Bigreal RealOrder BRA. require (*..*) Handle. diff --git a/sha3/proof/old/Gconcl.ec b/sha3/proof/old/Gconcl.ec index a3d7948..d984261 100644 --- a/sha3/proof/old/Gconcl.ec +++ b/sha3/proof/old/Gconcl.ec @@ -1,7 +1,8 @@ pragma -oldip. require import Pred Fun Option Pair Int Real RealExtra StdOrder Ring StdBigop. require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. -(*...*) import Dprod Dexcepted Capacity IntOrder Bigreal RealOrder BRA. +require import DProd Dexcepted. +(*...*) import Capacity IntOrder Bigreal RealOrder BRA. require (*..*) Gext. diff --git a/sha3/proof/old/Gext.eca b/sha3/proof/old/Gext.eca index 102c49b..e42d96e 100644 --- a/sha3/proof/old/Gext.eca +++ b/sha3/proof/old/Gext.eca @@ -1,7 +1,8 @@ pragma -oldip. require import Pred Fun Option Pair Int Real RealExtra StdOrder Ring StdBigop. require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. -(*...*) import Dprod Dexcepted Capacity IntOrder Bigreal RealOrder BRA. +require import DProd Dexcepted. +(*...*) import Capacity IntOrder Bigreal RealOrder BRA. require (*..*) Gcol. diff --git a/sha3/proof/old/Handle.eca b/sha3/proof/old/Handle.eca index 944b652..136ff79 100644 --- a/sha3/proof/old/Handle.eca +++ b/sha3/proof/old/Handle.eca @@ -1,6 +1,7 @@ require import Pred Fun Option Pair Int Real StdOrder Ring. require import List FSet NewFMap Utils Common SLCommon RndO. -(*...*) import Dprod Dexcepted Capacity IntOrder. +require import DProd Dexcepted. +(*...*) import Capacity IntOrder. require ConcreteF. diff --git a/sha3/proof/old/SLCommon.ec b/sha3/proof/old/SLCommon.ec index ec26f5c..6f9fd1a 100644 --- a/sha3/proof/old/SLCommon.ec +++ b/sha3/proof/old/SLCommon.ec @@ -4,13 +4,13 @@ length is the input block size. We prove its security even when padding is not prefix-free. **) require import Pred Fun Option Pair Int Real StdOrder Ring. -require import List FSet NewFMap Utils Common RndO. +require import List FSet NewFMap Utils Common RndO DProd Dexcepted. require (*..*) Indifferentiability. -(*...*) import Dprod Dexcepted Capacity IntOrder. +(*...*) import Capacity IntOrder. type state = block * capacity. -op dstate = bdistr * cdistr. +op dstate = bdistr `*` cdistr. clone include Indifferentiability with type p <- state, @@ -57,7 +57,7 @@ module SqueezelessSponge (P:DPRIMITIVE): FUNCTIONALITY = { } }. -clone export Pair.Dprod.Sample as Sample2 with +clone export DProd.ProdSampling as Sample2 with type t1 <- block, type t2 <- capacity, op d1 <- bdistr, diff --git a/sha3/proof/variant/RndOrcl.eca b/sha3/proof/variant/RndOrcl.eca index 4b15b5c..4f8b612 100644 --- a/sha3/proof/variant/RndOrcl.eca +++ b/sha3/proof/variant/RndOrcl.eca @@ -1,4 +1,4 @@ -require import Option FSet NewFMap. +require import Option FSet NewFMap NewDistr. (* TODO move this in NewFMap *) lemma dom_set (m:('a,'b) fmap) a b : dom m.[a<-b] = dom m `|` fset1 a. proof. by apply fsetP=> x;smt. qed. @@ -45,7 +45,7 @@ abstract theory Ideal. section LL. - axiom sample_ll : forall x, Distr.weight (sample x) = 1%r. + axiom sample_ll : forall x, weight (sample x) = 1%r. lemma f_ll : phoare[RO.f : true ==> true] = 1%r. proof. proc;auto;progress;apply sample_ll. qed. From 574163f99e525c1f4e423394bb7cd0e74bf7193c Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 26 Jan 2016 14:58:53 -0500 Subject: [PATCH 139/394] Added lemmas relating to (n + r - 1) %/ r. --- sha3/proof/Common.ec | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 51bf821..df16091 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -92,6 +92,40 @@ clone export LazyRP as Perm with [module type] "RP" as "PRIMITIVE" [module] "P" as "Perm". +(*---------------------- Needed Blocks Computation ---------------------*) + +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 ml=0 w=(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_nec (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)) /=. +cut -> : 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. + (* ------------------------- Padding/Unpadding ------------------------ *) op num0 (n : int) = (-(n + 2)) %% r. From bd530ea27cbdc7e93da7d9be9dcd23fb35937c38 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 26 Jan 2016 15:03:14 -0500 Subject: [PATCH 140/394] Renaming. --- sha3/proof/Common.ec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index df16091..3d452fc 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -112,7 +112,7 @@ by rewrite -(@addzA n) -(@addzA n) lez_addl subz_ge0 -ltzS -(@addzA r) /= ltz_pmod gt0_r. qed. -lemma needed_blocks_nec (n : int) : +lemma needed_blocks_correct (n : int) : 0 <= (n + r - 1) %/ r * r - n < r. proof. split=> [| _]. From 8744051155864bd9b9d94ea3bad807dc02db1e8e Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 26 Jan 2016 18:36:31 -0500 Subject: [PATCH 141/394] Renamed the three Sponge theories: TopLevel => Sponge Block => BlockSponge Absorb => AbsorbSponge Added injectivity lemma for pad2blocks to Common. Fixed a glitch in the game structure of Sponge (was TopLevel). Also got rid of smt (without ml=0) calls. --- sha3/proof/{Absorb.ec => AbsorbSponge.ec} | 0 sha3/proof/{Block.ec => BlockSponge.ec} | 2 +- sha3/proof/Common.ec | 19 +- sha3/proof/{TopLevel.ec => Sponge.ec} | 306 ++++++++++++++++------ 4 files changed, 238 insertions(+), 89 deletions(-) rename sha3/proof/{Absorb.ec => AbsorbSponge.ec} (100%) rename sha3/proof/{Block.ec => BlockSponge.ec} (98%) rename sha3/proof/{TopLevel.ec => Sponge.ec} (53%) diff --git a/sha3/proof/Absorb.ec b/sha3/proof/AbsorbSponge.ec similarity index 100% rename from sha3/proof/Absorb.ec rename to sha3/proof/AbsorbSponge.ec diff --git a/sha3/proof/Block.ec b/sha3/proof/BlockSponge.ec similarity index 98% rename from sha3/proof/Block.ec rename to sha3/proof/BlockSponge.ec index 8887e5e..2a0b693 100644 --- a/sha3/proof/Block.ec +++ b/sha3/proof/BlockSponge.ec @@ -57,7 +57,7 @@ module Sponge (P : DPRIMITIVE) : FUNCTIONALITY, CONSTRUCTION(P) = { op eps : real. -lemma top: +lemma conclusion : exists (S <: SIMULATOR), forall (D <: DISTINGUISHER) &m, `| Pr[RealIndif(Sponge, Perm, D).main() @ &m : res] diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 3d452fc..2cf8061 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -126,6 +126,13 @@ cut -> : 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 ml=0 w=(gt0_n). +qed. + (* ------------------------- Padding/Unpadding ------------------------ *) op num0 (n : int) = (-(n + 2)) %% r. @@ -383,6 +390,12 @@ have -> : pad(oget(unpad bs)) = bs by rewrite /bs blocks2bitsK. qed. +lemma pad2blocks_inj : injective pad2blocks. +proof. +search pcancel injective. +apply /(pcan_inj pad2blocks unpad_blocks) /pad2blocksK. +qed. + (*-------------------------- Extending/Stripping -----------------------*) op extend (xs : block list) (n : int) = @@ -436,11 +449,11 @@ qed. (*------------------------------ Validity ------------------------------*) -(* in TopLevel *) +(* in Sponge *) op valid_toplevel (_ : bool list) = true. -(* in Block *) +(* in BlockSponge *) op valid_block (xs : block list) = unpad_blocks xs <> None. @@ -608,7 +621,7 @@ rewrite xs_eq 2!blocks2bits_cat 2!blocks2bits_sing -!catA; congr. by rewrite {1}w2bits_y_eq -catA w2b_z_eq. qed. -(* in Absorb *) +(* in AbsorbSponge *) op valid_absorb (xs : block list) = valid_block((strip xs).`1). diff --git a/sha3/proof/TopLevel.ec b/sha3/proof/Sponge.ec similarity index 53% rename from sha3/proof/TopLevel.ec rename to sha3/proof/Sponge.ec index 796d9cb..e75b026 100644 --- a/sha3/proof/TopLevel.ec +++ b/sha3/proof/Sponge.ec @@ -2,7 +2,7 @@ require import Fun Pair Int IntDiv Real List Option FSet NewFMap DBool. require import Common StdOrder. import IntOrder. -require (*--*) IRO Block. +require (*--*) IRO BlockSponge. (*------------------------- Indifferentiability ------------------------*) @@ -53,7 +53,7 @@ module Sponge (P : DPRIMITIVE) : FUNCTIONALITY, CONSTRUCTION(P) = { (*------------- Simulator and Distinguisher Constructions --------------*) -module LowerFun (F : DFUNCTIONALITY) : Block.DFUNCTIONALITY = { +module LowerFun (F : DFUNCTIONALITY) : BlockSponge.DFUNCTIONALITY = { proc f(xs : block list, n : int) = { var cs, ds : bool list; var obs : bool list option; @@ -68,7 +68,7 @@ module LowerFun (F : DFUNCTIONALITY) : Block.DFUNCTIONALITY = { } }. -module RaiseFun (F : Block.DFUNCTIONALITY) : DFUNCTIONALITY = { +module RaiseFun (F : BlockSponge.DFUNCTIONALITY) : DFUNCTIONALITY = { proc f(bs : bool list, n : int) = { var xs; @@ -77,16 +77,18 @@ module RaiseFun (F : Block.DFUNCTIONALITY) : DFUNCTIONALITY = { } }. -module LowerDist (D : DISTINGUISHER, F : Block.DFUNCTIONALITY) = D(RaiseFun(F)). +module LowerDist (D : DISTINGUISHER, F : BlockSponge.DFUNCTIONALITY) = + D(RaiseFun(F)). -module RaiseSim (S : Block.SIMULATOR, F : DFUNCTIONALITY) = S(LowerFun(F)). +module RaiseSim (S : BlockSponge.SIMULATOR, F : DFUNCTIONALITY) = + S(LowerFun(F)). (*------------------------------- Proof --------------------------------*) section. -declare module BlockSim : Block.SIMULATOR{IRO, Block.BIRO.IRO}. -declare module Dist : DISTINGUISHER{Perm, BlockSim, IRO, Block.BIRO.IRO}. +declare module BlockSim : BlockSponge.SIMULATOR{IRO, BlockSponge.BIRO.IRO}. +declare module Dist : DISTINGUISHER{Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}. module type BLOCK_IRO_BITS = { proc init() : unit @@ -95,10 +97,10 @@ module type BLOCK_IRO_BITS = { }. module type BLOCK_IRO_BITS_DIST(BIROB : BLOCK_IRO_BITS) = { - proc distinguish(): bool + proc distinguish(): bool {BIROB.g BIROB.f} }. -local module BlockIROBitsEager : BLOCK_IRO_BITS, Block.BIRO.IRO = { +local module BlockIROBitsEager : BLOCK_IRO_BITS, BlockSponge.BIRO.IRO = { var mp : (block list * int, bool) fmap proc init() : unit = { @@ -140,7 +142,7 @@ local module BlockIROBitsEager : BLOCK_IRO_BITS, Block.BIRO.IRO = { } }. -local module BlockIROBitsLazy : BLOCK_IRO_BITS, Block.BIRO.IRO = { +local module BlockIROBitsLazy : BLOCK_IRO_BITS, BlockSponge.BIRO.IRO = { var mp : (block list * int, bool) fmap proc init() : unit = { @@ -177,6 +179,14 @@ local module BlockIROBitsLazy : BLOCK_IRO_BITS, Block.BIRO.IRO = { } }. +local lemma BlockIROBitsEager (D <: BLOCK_IRO_BITS_DIST) : + equiv[D(BlockIROBitsEager).distinguish ~ D(BlockIROBitsLazy).distinguish : + ={glob D} /\ BlockIROBitsEager.mp{1} = BlockIROBitsLazy.mp{2} ==> + ={glob D}]. +proof. +admit. (* use RndO.ec result *) +qed. + local module RaiseBIROBLazy (F : BLOCK_IRO_BITS) : FUNCTIONALITY = { proc init() = { F.init(); @@ -201,6 +211,60 @@ pred LazyInvar mem (dom mp1) (bs, n) => oget mp1.[(bs, n)] = oget mp2.[(pad2blocks bs, n)]). +local 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) : + LazyInvar mp1 mp2 => + mem (dom mp1.[(bs, n) <- b]) (cs, m) <=> + mem (dom mp2.[(pad2blocks bs, n) <- b]) (pad2blocks cs, m). +proof. +move=> LI; split=> [mem_upd_mp1 | mem_upd_mp2]. +rewrite domP in_fsetU1; rewrite domP in_fsetU1 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 ml=0. +rewrite domP in_fsetU1; rewrite domP in_fsetU1 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. + +local 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) : + LazyInvar mp1 mp2 => + mem (dom mp2.[(pad2blocks bs, n) <- b]) (xs, m) => + valid_block xs. +proof. +move=> LI mem_upd_mp2. +rewrite domP in_fsetU1 in mem_upd_mp2. +elim mem_upd_mp2=> [/# | [-> _]]. +apply/valid_pad2blocks. +qed. + +local 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) : + LazyInvar mp1 mp2 => + mem (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]. +smt ml=0 w=(getP_eq). +rewrite domP in_fsetU1 in mem_upd_mp1. +elim mem_upd_mp1=> [mem_mp1 | [->->]]. +case: ((pad2blocks bs, n) = (pad2blocks cs, m))=> + [[p2b_bs_p2b_cs eq_mn] | p2b_bs_n_neq_p2b_cs_m]. +smt ml=0 w=(pad2blocks_inj). +smt ml=0 w=(getP). +smt ml=0 w=(getP). +qed. + local lemma LowerFun_IRO_BlockIROBitsLazy_f : equiv[LowerFun(IRO).f ~ BlockIROBitsLazy.f : ={xs, n} /\ LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2} ==> @@ -226,8 +290,13 @@ while sp; auto. if. progress; smt ml=0. -rnd; auto; progress; smt. (* will get rid of smt's *) -auto; progress; smt. +rnd; auto; progress; + [smt ml=0 w=(getP_eq) | + smt ml=0 w=(lazy_invar_upd_mem_dom_iff) | + smt ml=0 w=(lazy_invar_upd_mem_dom_iff) | + smt ml=0 w=(lazy_invar_upd2_vb) | + smt ml=0 w=(lazy_invar_upd_lu_eq)]. +auto; progress; smt ml=0. auto. rcondf{1} 3; first auto. rcondf{2} 4; first auto. auto; progress; by rewrite bits2blocks_nil. @@ -251,20 +320,17 @@ while LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2}). wp; sp. if. -progress; smt. (* will get rid of smt's *) -rnd; skip; progress; smt. -auto; progress; smt. +progress; smt ml=0. +rnd; skip; progress; + [smt ml=0 w=(getP_eq) | + smt ml=0 w=(lazy_invar_upd_mem_dom_iff) | + smt ml=0 w=(lazy_invar_upd_mem_dom_iff) | + smt ml=0 w=(lazy_invar_upd2_vb) | + smt ml=0 w=(lazy_invar_upd_lu_eq)]. +auto; progress; smt ml=0. auto. qed. -local lemma BlockIROBitsEager (D <: BLOCK_IRO_BITS_DIST) : - equiv[D(BlockIROBitsEager).distinguish ~ D(BlockIROBitsLazy).distinguish : - ={glob D} /\ BlockIROBitsEager.mp{1} = BlockIROBitsLazy.mp{2} ==> - ={glob D}]. -proof. -admit. (* use RndO.ec result *) -qed. - pred EagerInvar (mp1 : (block list * int, block) fmap, mp2 : (block list * int, bool) fmap) = @@ -278,48 +344,119 @@ pred EagerInvar mem (dom mp2) (xs, j) => 0 <= j /\ mem (dom mp1) (xs, j %/ r)). -local lemma BlockIROBitsEager_BlockIRO_f : - equiv[BlockIROBitsEager.f ~ Block.BIRO.IRO.f : - xs{1} = x{2} /\ ={n} /\ - EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> - ={res} /\ EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}]. +local lemma BlockIROBitsEager_f_BlockIRO_g : + equiv[BlockIROBitsEager.f ~ BlockIROBitsEager.g : + ={xs, BlockIROBitsEager.mp} /\ n{1} * r = n{2} ==> + res{1} = bits2blocks res{2} /\ ={BlockIROBitsEager.mp}]. +proof. +proc=> /=; inline *. +seq 5 3 : + (={i, BlockIROBitsEager.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 rewrite -addzA divzMDl 1:gtr_eqF 1:gt0_r // divz_small //; + smt ml=0 w=(gt0_n). +if=> //; wp. +while + (={i, BlockIROBitsEager.mp} /\ xs0{1} = xs{2} /\ + bs0{1} = bs{2} /\ n0{1} = n{2} /\ m{1} = n0{1} /\ + m{2} = n{2}). +sp; wp; if=> //; rnd; auto. +while + (={i, BlockIROBitsEager.mp} /\ xs0{1} = xs{2} /\ + bs0{1} = bs{2} /\ n0{1} = n{2} /\ m{1} = n0{1} /\ + m{2} = n{2})=> //. +sp; wp; if=> //; rnd; auto. +auto. +qed. + +local lemma BlockIROBitsEager_g_Block_IRO_f + (n' : int) (x' : block list) : + equiv[BlockIROBitsEager.g ~ BlockSponge.BIRO.IRO.f : + n' = n{1} /\ xs{1} = x{2} /\ x' = x{2} /\ + n{2} = (n{1} + r - 1) %/ r /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> + EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} /\ + (valid_block x' => + res{1} = take n' (blocks2bits res{2}) /\ + size res{2} = (n' + r - 1) %/ r) /\ + (! valid_block x' => res{1} = [] /\ res{2} = [])]. proof. proc=> /=. -inline BlockIROBitsEager.g. -seq 5 2 : - (={i} /\ xs0{1} = x{2} /\ bs0{1} = [] /\ bs{2} = [] /\ n0{1} = n{2} * r /\ - n0{1} = m{1} /\ - EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}). +seq 3 2 : + (n' = n{1} /\ xs{1} = x{2} /\ x' = x{2} /\ + n{2} = (n{1} + r - 1) %/ r /\ n{2} * r = m{1} /\ + i{1} = 0 /\ i{2} = 0 /\ bs{1} = [] /\ bs{2} = [] /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}). auto; progress. -rewrite -addzA divzMDl 1:gtr_eqF 1:gt0_r //. -have -> // : (r - 1) %/ r = 0 by smt. (* TODO *) if=> //. -rcondf{1} 2; auto; first while (true); auto. conseq (_ : - ={i} /\ n0{1} = n{2} * r /\ xs0{1} = x{2} /\ bs0{1} = [] /\ bs{2} = [] /\ - EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> - bits2blocks bs0{1} = bs{2} /\ - EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //. -admit. -auto; progress; by rewrite bits2blocks_nil. + xs{1} = x{2} /\ n' = n{1} /\ 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} = [] /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> + bs{1} = take n' (blocks2bits bs{2}) /\ + size bs{2} = (n' + r - 1) %/ r /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //. +progress; apply/needed_blocks_suff. +admit. +qed. + +local lemma BlockIROBitsEager_BlockIRO_f : + equiv[BlockIROBitsEager.f ~ BlockSponge.BIRO.IRO.f : + xs{1} = x{2} /\ ={n} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> + ={res} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}]. +proof. +transitivity + BlockIROBitsEager.g + (={xs, BlockIROBitsEager.mp} /\ n{2} = n{1} * r /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> + res{1} = bits2blocks res{2} /\ ={BlockIROBitsEager.mp}) + (xs{1} = x{2} /\ n{1} = n{2} * r /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> + res{1} = (blocks2bits res{2}) /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}). +progress. +exists BlockSponge.BIRO.IRO.mp{2}, BlockIROBitsEager.mp{1}, (xs{1}, n{1} * r). + progress; by rewrite H0. +progress; apply blocks2bitsK. +conseq BlockIROBitsEager_f_BlockIRO_g. +progress; by rewrite H0. +exists* n{1}; elim*=> n1. exists* xs{1}; elim*=> xs'. +conseq (BlockIROBitsEager_g_Block_IRO_f n1 xs')=> //. +progress; rewrite H0; by rewrite needed_blocks_prod_r. +progress. +case (valid_block xs{1})=> [vb_xs1 | not_vb_xs1]. +have [-> size_result_R] := H3 vb_xs1. +have -> : n{1} = size(blocks2bits result_R) + by rewrite size_blocks2bits size_result_R H0 + needed_blocks_prod_r mulzC. +by rewrite take_size. +by have [->->] := H4 not_vb_xs1. qed. -local lemma RaiseFun_BlockIROBitsEager_BlockIRO_f : - equiv[RaiseFun(BlockIROBitsEager).f ~ RaiseFun(Block.BIRO.IRO).f : - ={bs, n} /\ - EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> - ={res} /\ - EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}]. +local lemma RaiseBIROBLazy_BlockIROBitsEager_RaiseFun_Block_IRO_f : + equiv[RaiseBIROBLazy(BlockIROBitsEager).f ~ RaiseFun(BlockSponge.BIRO.IRO).f : + ={bs, n} /\ ={glob BlockSim} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> + ={res} /\ ={glob BlockSim} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}]. proof. -proc=> /=; by call BlockIROBitsEager_BlockIRO_f. +proc=> /=. +exists* n{1}; elim*=> n'. +exists* (pad2blocks bs{2}); elim*=> xs2. +call (BlockIROBitsEager_g_Block_IRO_f n' xs2). +auto; progress. +by have [-> _] := H2 _; first apply/valid_pad2blocks. qed. local lemma Sponge_Raise_Block_Sponge_f : - equiv[Sponge(Perm).f ~ RaiseFun(Block.Sponge(Perm)).f : + equiv[Sponge(Perm).f ~ RaiseFun(BlockSponge.Sponge(Perm)).f : ={bs, n, glob Perm} ==> ={res, glob Perm}]. proof. -proc; inline Block.Sponge(Perm).f. +proc; inline BlockSponge.Sponge(Perm).f. conseq (_ : ={bs, n, glob Perm} ==> _)=> //. swap{2} [3..5] -2. seq 4 4 : @@ -344,8 +481,8 @@ qed. local lemma RealIndif &m : Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] = - Pr[Block.RealIndif - (Block.Sponge, Perm, LowerDist(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. @@ -371,7 +508,7 @@ call IRO.mp{1} = map0 /\ BlockIROBitsLazy.mp{2} = map0 ==> ={res}). proc (={glob BlockSim} /\ LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2}). -smt. (* will remove this *) +progress; rewrite dom0 in_fset0 in H; elim H. trivial. proc (LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2})=> //. apply LowerFun_IRO_BlockIROBitsLazy_f. @@ -385,50 +522,49 @@ local lemma IdealIndifLazy &m : Pr[Experiment (RaiseBIROBLazy(BlockIROBitsLazy), BlockSim(BlockIROBitsLazy), Dist).main() @ &m : res] = - Pr[Block.IdealIndif - (BlockIROBitsEager, BlockSim, LowerDist(Dist)).main() @ &m : res]. + Pr[Experiment + (RaiseBIROBLazy(BlockIROBitsEager), BlockSim(BlockIROBitsEager), + Dist).main() @ &m : res]. proof. -byequiv=> //; proc. -seq 2 2 : - (={glob Dist, glob BlockSim} /\ BlockIROBitsLazy.mp{1} = NewFMap.map0 /\ - BlockIROBitsEager.mp{2} = NewFMap.map0). -inline *; wp; call (_ : true); auto. -(* reduction to BlockIROBitsEager *) +(* reduction to eager *) admit. qed. local lemma IdealIndifEager &m : - Pr[Block.IdealIndif - (BlockIROBitsEager, BlockSim, LowerDist(Dist)).main() @ &m : res] = - Pr[Block.IdealIndif - (Block.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res]. + Pr[Experiment + (RaiseBIROBLazy(BlockIROBitsEager), BlockSim(BlockIROBitsEager), + 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} /\ BlockIROBitsEager.mp{1} = NewFMap.map0 /\ - Block.BIRO.IRO.mp{2} = NewFMap.map0). + BlockSponge.BIRO.IRO.mp{2} = NewFMap.map0). inline *; wp; call (_ : true); auto. call (_ : ={glob Dist, glob BlockSim} /\ - BlockIROBitsEager.mp{1} = map0 /\ Block.BIRO.IRO.mp{2} = map0 ==> + BlockIROBitsEager.mp{1} = map0 /\ BlockSponge.BIRO.IRO.mp{2} = map0 ==> ={res}). proc (={glob BlockSim} /\ - EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}) => //. -smt. (* TODO *) -proc (EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //; + EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}) => //. +progress; rewrite dom0 in_fset0 in H; elim H. + +proc (EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //; conseq BlockIROBitsEager_BlockIRO_f=> //. -proc (EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //; +proc (EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //; conseq BlockIROBitsEager_BlockIRO_f=> //. -conseq RaiseFun_BlockIROBitsEager_BlockIRO_f=> //. +exists* n{1}; elim *=> n'. +conseq RaiseBIROBLazy_BlockIROBitsEager_RaiseFun_Block_IRO_f=> //. auto. qed. local lemma IdealIndif &m : Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = - Pr[Block.IdealIndif - (Block.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res]. + Pr[BlockSponge.IdealIndif + (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res]. proof. by rewrite (IdealIndifIROLazy &m) (IdealIndifLazy &m) (IdealIndifEager &m). qed. @@ -436,10 +572,10 @@ qed. lemma Conclusion' &m : `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] - Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res]| = - `|Pr[Block.RealIndif - (Block.Sponge, Perm, LowerDist(Dist)).main() @ &m : res] - - Pr[Block.IdealIndif - (Block.BIRO.IRO, BlockSim, LowerDist(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 &m) (IdealIndif &m). qed. @@ -448,13 +584,13 @@ end section. (*----------------------------- Conclusion -----------------------------*) -lemma Conclusion (BlockSim <: Block.SIMULATOR{IRO, Block.BIRO.IRO}) - (Dist <: DISTINGUISHER{Perm, BlockSim, IRO, Block.BIRO.IRO}) +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[Block.RealIndif - (Block.Sponge, Perm, LowerDist(Dist)).main() @ &m : res] - - Pr[Block.IdealIndif - (Block.BIRO.IRO, BlockSim, LowerDist(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/(Conclusion' BlockSim Dist &m). qed. From cf7ffbe7e01d272fb242cf292bb96262dfeb4884 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 26 Jan 2016 18:47:09 -0500 Subject: [PATCH 142/394] Removed [search] command. --- sha3/proof/Common.ec | 1 - 1 file changed, 1 deletion(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 2cf8061..16e8ac0 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -392,7 +392,6 @@ qed. lemma pad2blocks_inj : injective pad2blocks. proof. -search pcancel injective. apply /(pcan_inj pad2blocks unpad_blocks) /pad2blocksK. qed. From 35fb61928df2967780a0afc29011d453795f3316 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 26 Jan 2016 18:57:24 -0500 Subject: [PATCH 143/394] Nit. --- sha3/proof/Sponge.ec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index e75b026..0e1879b 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -182,7 +182,7 @@ local module BlockIROBitsLazy : BLOCK_IRO_BITS, BlockSponge.BIRO.IRO = { local lemma BlockIROBitsEager (D <: BLOCK_IRO_BITS_DIST) : equiv[D(BlockIROBitsEager).distinguish ~ D(BlockIROBitsLazy).distinguish : ={glob D} /\ BlockIROBitsEager.mp{1} = BlockIROBitsLazy.mp{2} ==> - ={glob D}]. + ={res, glob D}]. proof. admit. (* use RndO.ec result *) qed. From 172c5e3950f63d3034d4e8987875fe519c6d23b9 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 27 Jan 2016 17:20:05 -0500 Subject: [PATCH 144/394] About to apply RndO. --- sha3/proof/Sponge.ec | 233 +++++++++++++++++++++++++------------------ 1 file changed, 134 insertions(+), 99 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 0e1879b..58d540d 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -2,7 +2,7 @@ require import Fun Pair Int IntDiv Real List Option FSet NewFMap DBool. require import Common StdOrder. import IntOrder. -require (*--*) IRO BlockSponge. +require (*--*) IRO BlockSponge RndO. (*------------------------- Indifferentiability ------------------------*) @@ -85,22 +85,19 @@ module RaiseSim (S : BlockSponge.SIMULATOR, F : DFUNCTIONALITY) = (*------------------------------- Proof --------------------------------*) -section. - -declare module BlockSim : BlockSponge.SIMULATOR{IRO, BlockSponge.BIRO.IRO}. -declare module Dist : DISTINGUISHER{Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}. +abstract theory HybridIRO. -module type BLOCK_IRO_BITS = { +module type HYBRID_IRO = { proc init() : unit proc g(x : block list, n : int) : bool list proc f(x : block list, n : int) : block list }. -module type BLOCK_IRO_BITS_DIST(BIROB : BLOCK_IRO_BITS) = { - proc distinguish(): bool {BIROB.g BIROB.f} +module type HYBRID_IRO_DIST(HI : HYBRID_IRO) = { + proc distinguish(): bool }. -local module BlockIROBitsEager : BLOCK_IRO_BITS, BlockSponge.BIRO.IRO = { +module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { var mp : (block list * int, bool) fmap proc init() : unit = { @@ -142,7 +139,7 @@ local module BlockIROBitsEager : BLOCK_IRO_BITS, BlockSponge.BIRO.IRO = { } }. -local module BlockIROBitsLazy : BLOCK_IRO_BITS, BlockSponge.BIRO.IRO = { +module HybridIROLazy : HYBRID_IRO, BlockSponge.BIRO.IRO = { var mp : (block list * int, bool) fmap proc init() : unit = { @@ -179,23 +176,31 @@ local module BlockIROBitsLazy : BLOCK_IRO_BITS, BlockSponge.BIRO.IRO = { } }. -local lemma BlockIROBitsEager (D <: BLOCK_IRO_BITS_DIST) : - equiv[D(BlockIROBitsEager).distinguish ~ D(BlockIROBitsLazy).distinguish : - ={glob D} /\ BlockIROBitsEager.mp{1} = BlockIROBitsLazy.mp{2} ==> - ={res, glob D}]. +section. + +declare module D : HYBRID_IRO_DIST. + +local clone RndO.GenEager as RO. + +lemma HybridIROLazyEager (D <: HYBRID_IRO_DIST) &m : + Pr[D(HybridIROLazy).distinguish() @ &m : res] = + Pr[D(HybridIROEager).distinguish() @ &m : res]. proof. +byequiv=> //. admit. (* use RndO.ec result *) qed. -local module RaiseBIROBLazy (F : BLOCK_IRO_BITS) : FUNCTIONALITY = { +end section. + +module RaiseHybridIRO (HI : HYBRID_IRO) : FUNCTIONALITY = { proc init() = { - F.init(); + HI.init(); } proc f(bs : bool list, n : int) = { var cs; - cs <@ F.g(pad2blocks bs, n); + cs <@ HI.g(pad2blocks bs, n); return cs; } }. @@ -211,7 +216,7 @@ pred LazyInvar mem (dom mp1) (bs, n) => oget mp1.[(bs, n)] = oget mp2.[(pad2blocks bs, n)]). -local lemma lazy_invar_upd_mem_dom_iff +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) : @@ -230,7 +235,7 @@ elim mem_upd_mp2=> [/# | [p2b_cs_p2b_bs eq_mn]]. have /# : cs = bs by apply pad2blocks_inj. qed. -local lemma lazy_invar_upd2_vb +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) : @@ -244,7 +249,7 @@ elim mem_upd_mp2=> [/# | [-> _]]. apply/valid_pad2blocks. qed. -local lemma lazy_invar_upd_lu_eq +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) : @@ -265,27 +270,27 @@ smt ml=0 w=(getP). smt ml=0 w=(getP). qed. -local lemma LowerFun_IRO_BlockIROBitsLazy_f : - equiv[LowerFun(IRO).f ~ BlockIROBitsLazy.f : - ={xs, n} /\ LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2} ==> - ={res} /\ LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2}]. +lemma LowerFun_IRO_HybridIROLazy_f : + equiv[LowerFun(IRO).f ~ HybridIROLazy.f : + ={xs, n} /\ LazyInvar IRO.mp{1} HybridIROLazy.mp{2} ==> + ={res} /\ LazyInvar IRO.mp{1} HybridIROLazy.mp{2}]. proof. -proc=> /=; inline BlockIROBitsLazy.g. +proc=> /=; inline HybridIROLazy.g. seq 0 1 : (={n} /\ xs{1} = xs0{2} /\ - LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2}); first auto. + LazyInvar 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} /\ - LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2} /\ + LazyInvar IRO.mp{1} HybridIROLazy.mp{2} /\ pad2blocks x{1} = xs0{2}). auto; progress; have {2}<- /# := unpadBlocksK xs0{2}. wp. while (={i, n0} /\ bs{1} = bs0{2} /\ - LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2} /\ + LazyInvar IRO.mp{1} HybridIROLazy.mp{2} /\ pad2blocks x{1} = xs0{2}). sp; auto. if. @@ -302,22 +307,22 @@ rcondf{1} 3; first auto. rcondf{2} 4; first auto. auto; progress; by rewrite bits2blocks_nil. qed. -local lemma IRO_RaiseBIROBLazy_BlockIROBitsLazy_f : - equiv[IRO.f ~ RaiseBIROBLazy(BlockIROBitsLazy).f : +lemma IRO_RaiseHybridIRO_HybridIROLazy_f : + equiv[IRO.f ~ RaiseHybridIRO(HybridIROLazy).f : ={n} /\ x{1} = bs{2} /\ - LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2} ==> - ={res} /\ LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2}]. + LazyInvar IRO.mp{1} HybridIROLazy.mp{2} ==> + ={res} /\ LazyInvar 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} /\ - LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2}); first auto. + LazyInvar 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} /\ - LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2}). + LazyInvar IRO.mp{1} HybridIROLazy.mp{2}). wp; sp. if. progress; smt ml=0. @@ -344,39 +349,38 @@ pred EagerInvar mem (dom mp2) (xs, j) => 0 <= j /\ mem (dom mp1) (xs, j %/ r)). -local lemma BlockIROBitsEager_f_BlockIRO_g : - equiv[BlockIROBitsEager.f ~ BlockIROBitsEager.g : - ={xs, BlockIROBitsEager.mp} /\ n{1} * r = n{2} ==> - res{1} = bits2blocks res{2} /\ ={BlockIROBitsEager.mp}]. +lemma HybridIROEager_f_g : + equiv[HybridIROEager.f ~ HybridIROEager.g : + ={xs, HybridIROEager.mp} /\ n{1} * r = n{2} ==> + res{1} = bits2blocks res{2} /\ ={HybridIROEager.mp}]. proof. proc=> /=; inline *. seq 5 3 : - (={i, BlockIROBitsEager.mp} /\ xs0{1} = xs{2} /\ + (={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 rewrite -addzA divzMDl 1:gtr_eqF 1:gt0_r // divz_small //; smt ml=0 w=(gt0_n). if=> //; wp. while - (={i, BlockIROBitsEager.mp} /\ xs0{1} = xs{2} /\ + (={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=> //; rnd; auto. while - (={i, BlockIROBitsEager.mp} /\ xs0{1} = xs{2} /\ + (={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=> //; rnd; auto. auto. qed. -local lemma BlockIROBitsEager_g_Block_IRO_f - (n' : int) (x' : block list) : - equiv[BlockIROBitsEager.g ~ BlockSponge.BIRO.IRO.f : +lemma HybridIROEager_g_BlockIRO_f (n' : int) (x' : block list) : + equiv[HybridIROEager.g ~ BlockSponge.BIRO.IRO.f : n' = n{1} /\ xs{1} = x{2} /\ x' = x{2} /\ n{2} = (n{1} + r - 1) %/ r /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> - EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ (valid_block x' => res{1} = take n' (blocks2bits res{2}) /\ size res{2} = (n' + r - 1) %/ r) /\ @@ -387,7 +391,7 @@ seq 3 2 : (n' = n{1} /\ xs{1} = x{2} /\ x' = x{2} /\ n{2} = (n{1} + r - 1) %/ r /\ n{2} * r = m{1} /\ i{1} = 0 /\ i{2} = 0 /\ bs{1} = [] /\ bs{2} = [] /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}). + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). auto; progress. if=> //. conseq @@ -395,37 +399,37 @@ conseq xs{1} = x{2} /\ n' = n{1} /\ 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} = [] /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = take n' (blocks2bits bs{2}) /\ size bs{2} = (n' + r - 1) %/ r /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //. + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. progress; apply/needed_blocks_suff. admit. qed. -local lemma BlockIROBitsEager_BlockIRO_f : - equiv[BlockIROBitsEager.f ~ BlockSponge.BIRO.IRO.f : +lemma HybridIROEager_BlockIRO_f : + equiv[HybridIROEager.f ~ BlockSponge.BIRO.IRO.f : xs{1} = x{2} /\ ={n} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> - ={res} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}]. + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + ={res} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}]. proof. transitivity - BlockIROBitsEager.g - (={xs, BlockIROBitsEager.mp} /\ n{2} = n{1} * r /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> - res{1} = bits2blocks res{2} /\ ={BlockIROBitsEager.mp}) + HybridIROEager.g + (={xs, HybridIROEager.mp} /\ n{2} = n{1} * r /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + res{1} = bits2blocks res{2} /\ ={HybridIROEager.mp}) (xs{1} = x{2} /\ n{1} = n{2} * r /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> res{1} = (blocks2bits res{2}) /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}). + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). progress. -exists BlockSponge.BIRO.IRO.mp{2}, BlockIROBitsEager.mp{1}, (xs{1}, n{1} * r). +exists BlockSponge.BIRO.IRO.mp{2}, HybridIROEager.mp{1}, (xs{1}, n{1} * r). progress; by rewrite H0. progress; apply blocks2bitsK. -conseq BlockIROBitsEager_f_BlockIRO_g. +conseq HybridIROEager_f_g. progress; by rewrite H0. exists* n{1}; elim*=> n1. exists* xs{1}; elim*=> xs'. -conseq (BlockIROBitsEager_g_Block_IRO_f n1 xs')=> //. +conseq (HybridIROEager_g_BlockIRO_f n1 xs')=> //. progress; rewrite H0; by rewrite needed_blocks_prod_r. progress. case (valid_block xs{1})=> [vb_xs1 | not_vb_xs1]. @@ -437,22 +441,31 @@ by rewrite take_size. by have [->->] := H4 not_vb_xs1. qed. -local lemma RaiseBIROBLazy_BlockIROBitsEager_RaiseFun_Block_IRO_f : - equiv[RaiseBIROBLazy(BlockIROBitsEager).f ~ RaiseFun(BlockSponge.BIRO.IRO).f : +end HybridIRO. + +section. + +declare module BlockSim : BlockSponge.SIMULATOR{IRO, BlockSponge.BIRO.IRO}. +declare module Dist : DISTINGUISHER{Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}. + +local clone import HybridIRO as HIRO. + +local lemma RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f : + equiv[RaiseHybridIRO(HybridIROEager).f ~ RaiseFun(BlockSponge.BIRO.IRO).f : ={bs, n} /\ ={glob BlockSim} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> ={res} /\ ={glob BlockSim} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}]. + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}]. proof. proc=> /=. exists* n{1}; elim*=> n'. exists* (pad2blocks bs{2}); elim*=> xs2. -call (BlockIROBitsEager_g_Block_IRO_f n' xs2). +call (HybridIROEager_g_BlockIRO_f n' xs2). auto; progress. by have [-> _] := H2 _; first apply/valid_pad2blocks. qed. -local lemma Sponge_Raise_Block_Sponge_f : +local lemma Sponge_Raise_BlockSponge_f : equiv[Sponge(Perm).f ~ RaiseFun(BlockSponge.Sponge(Perm)).f : ={bs, n, glob Perm} ==> ={res, glob Perm}]. proof. @@ -479,7 +492,7 @@ auto; progress; by rewrite -cats1 blocks2bits_cat blocks2bits_sing. auto. qed. -local lemma RealIndif &m : +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]. @@ -487,86 +500,108 @@ proof. byequiv=> //; proc. seq 2 2 : (={glob Dist, glob Perm}); first sim. call (_ : ={glob Perm}); first 2 sim. -conseq Sponge_Raise_Block_Sponge_f=> //. +conseq Sponge_Raise_BlockSponge_f=> //. auto. qed. -local lemma IdealIndifIROLazy &m : +local lemma Ideal_IRO_Experiment_HybridLazy &m : Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = Pr[Experiment - (RaiseBIROBLazy(BlockIROBitsLazy), BlockSim(BlockIROBitsLazy), + (RaiseHybridIRO(HybridIROLazy), BlockSim(HybridIROLazy), Dist).main() @ &m : res]. proof. byequiv=> //; proc. seq 2 2 : (={glob Dist, glob BlockSim} /\ IRO.mp{1} = NewFMap.map0 /\ - BlockIROBitsLazy.mp{2} = NewFMap.map0). + HybridIROLazy.mp{2} = NewFMap.map0). inline *; wp; call (_ : true); auto. call (_ : ={glob Dist, glob BlockSim} /\ - IRO.mp{1} = map0 /\ BlockIROBitsLazy.mp{2} = map0 ==> + IRO.mp{1} = map0 /\ HybridIROLazy.mp{2} = map0 ==> ={res}). -proc (={glob BlockSim} /\ LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2}). +proc (={glob BlockSim} /\ LazyInvar IRO.mp{1} HybridIROLazy.mp{2}). progress; rewrite dom0 in_fset0 in H; elim H. trivial. -proc (LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2})=> //. -apply LowerFun_IRO_BlockIROBitsLazy_f. -proc (LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2})=> //. -apply LowerFun_IRO_BlockIROBitsLazy_f. -by conseq IRO_RaiseBIROBLazy_BlockIROBitsLazy_f. +proc (LazyInvar IRO.mp{1} HybridIROLazy.mp{2})=> //. +apply LowerFun_IRO_HybridIROLazy_f. +proc (LazyInvar IRO.mp{1} HybridIROLazy.mp{2})=> //. +apply LowerFun_IRO_HybridIROLazy_f. +by conseq IRO_RaiseHybridIRO_HybridIROLazy_f. auto. qed. -local lemma IdealIndifLazy &m : +local module HybridIRODist(HI : HYBRID_IRO) : HYBRID_IRO_DIST (HI) = { + + proc distinguish() : bool = { + var b : bool; + b <@ Experiment(RaiseHybridIRO(HI), BlockSim(HI), Dist).main(); + return b; + } +}. + +local lemma Experiment_Hybrid_Lazy_Eager &m : Pr[Experiment - (RaiseBIROBLazy(BlockIROBitsLazy), BlockSim(BlockIROBitsLazy), + (RaiseHybridIRO(HybridIROLazy), BlockSim(HybridIROLazy), Dist).main() @ &m : res] = Pr[Experiment - (RaiseBIROBLazy(BlockIROBitsEager), BlockSim(BlockIROBitsEager), + (RaiseHybridIRO(HybridIROEager), BlockSim(HybridIROEager), Dist).main() @ &m : res]. proof. -(* reduction to eager *) -admit. +have -> : + Pr[Experiment + (RaiseHybridIRO(HybridIROLazy), BlockSim(HybridIROLazy), + Dist).main() @ &m : res] = + Pr[HybridIRODist(HybridIROLazy).distinguish() @ &m : res]. + byequiv=> //; proc; inline *; sim. +rewrite (HybridIROLazyEager(HybridIRODist) &m). +have -> : + Pr[HybridIRODist(HybridIROEager).distinguish() @ &m : res] = + Pr[Experiment + (RaiseHybridIRO(HybridIROEager), BlockSim(HybridIROEager), + Dist).main() @ &m : res]. + byequiv=> //; proc; inline *; sim. +done. qed. -local lemma IdealIndifEager &m : +local lemma Experiment_HybridEager_Ideal_BlockIRO &m : Pr[Experiment - (RaiseBIROBLazy(BlockIROBitsEager), BlockSim(BlockIROBitsEager), + (RaiseHybridIRO(HybridIROEager), BlockSim(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} /\ BlockIROBitsEager.mp{1} = NewFMap.map0 /\ + (={glob Dist, glob BlockSim} /\ HybridIROEager.mp{1} = NewFMap.map0 /\ BlockSponge.BIRO.IRO.mp{2} = NewFMap.map0). inline *; wp; call (_ : true); auto. call (_ : ={glob Dist, glob BlockSim} /\ - BlockIROBitsEager.mp{1} = map0 /\ BlockSponge.BIRO.IRO.mp{2} = map0 ==> + HybridIROEager.mp{1} = map0 /\ BlockSponge.BIRO.IRO.mp{2} = map0 ==> ={res}). proc (={glob BlockSim} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}) => //. + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) => //. progress; rewrite dom0 in_fset0 in H; elim H. - -proc (EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //; - conseq BlockIROBitsEager_BlockIRO_f=> //. -proc (EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //; - conseq BlockIROBitsEager_BlockIRO_f=> //. +proc (EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //; + conseq HybridIROEager_BlockIRO_f=> //. +proc (EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //; + conseq HybridIROEager_BlockIRO_f=> //. exists* n{1}; elim *=> n'. -conseq RaiseBIROBLazy_BlockIROBitsEager_RaiseFun_Block_IRO_f=> //. +conseq RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f=> //. auto. qed. -local lemma IdealIndif &m : +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 (IdealIndifIROLazy &m) (IdealIndifLazy &m) (IdealIndifEager &m). +by rewrite (Ideal_IRO_Experiment_HybridLazy &m) + (Experiment_Hybrid_Lazy_Eager &m) + (Experiment_HybridEager_Ideal_BlockIRO &m). qed. lemma Conclusion' &m : @@ -577,7 +612,7 @@ lemma Conclusion' &m : Pr[BlockSponge.IdealIndif (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main() @ &m : res]|. proof. -by rewrite (RealIndif &m) (IdealIndif &m). +by rewrite (RealIndif_Sponge_BlockSponge &m) (IdealIndif_IRO_BlockIRO &m). qed. end section. From 0983ebcc385d5bd12c6174da95867f5deee5b818 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 28 Jan 2016 09:44:31 -0500 Subject: [PATCH 145/394] Completed application of RndO. --- sha3/proof/Sponge.ec | 256 +++++++++++++++++++++++++++++++++++++++---- 1 file changed, 232 insertions(+), 24 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 58d540d..51d29af 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -85,6 +85,8 @@ module RaiseSim (S : BlockSponge.SIMULATOR, F : DFUNCTIONALITY) = (*------------------------------- Proof --------------------------------*) +(*------------------- abstract theory of hybrid IROs -------------------*) + abstract theory HybridIRO. module type HYBRID_IRO = { @@ -94,7 +96,7 @@ module type HYBRID_IRO = { }. module type HYBRID_IRO_DIST(HI : HYBRID_IRO) = { - proc distinguish(): bool + proc distinguish() : bool }. module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { @@ -176,18 +178,209 @@ module HybridIROLazy : HYBRID_IRO, BlockSponge.BIRO.IRO = { } }. +module HybridIROExper(HI : HYBRID_IRO, D : HYBRID_IRO_DIST) = { + proc main() : bool = { + var b : bool; + HI.init(); + b <@ D(HI).distinguish(); + return b; + } +}. + section. -declare module D : HYBRID_IRO_DIST. +declare module D : HYBRID_IRO_DIST{HybridIROEager, HybridIROLazy}. + +local clone RndO.GenEager as ERO with + type from <- block list * int, + type to <- bool, + op sampleto <- fun _ => dbool. + +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(ERO.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. +symmetry; call (ERO.RO_LRO_D D); auto. +qed. + +local module HIRO(RO : ERO.RO) = { + proc init() : unit = { + RO.init(); + } + + proc g(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; + } + + proc f(xs, n) = { + var bs, ys; + bs <@ g(xs, n * r); + ys <- bits2blocks bs; + return ys; + } +}. + +local lemma HybridIROLazy_fill_in_LRO_get : + equiv[HybridIROLazy.fill_in ~ ERO.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: (mem (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_init : + equiv[HybridIROLazy.init ~ HIRO(ERO.LRO).init : + true ==> HybridIROLazy.mp{1} = ERO.RO.m{2}]. +proof. proc; inline*; auto. qed. + +local lemma HybridIROLazy_HIRO_LRO_g : + equiv[HybridIROLazy.g ~ HIRO(ERO.LRO).g : + ={xs, n} /\ HybridIROLazy.mp{1} = ERO.RO.m{2} ==> + ={res} /\ HybridIROLazy.mp{1} = ERO.RO.m{2}]. +proof. +proc; inline ERO.LRO.sample; sp=> /=. +if=> //. +while{2} (true) (m{2} - i{2}). +progress; auto; progress; smt ml=0. +while (={xs, n, i, bs} /\ HybridIROLazy.mp{1} = ERO.RO.m{2}). +wp; call HybridIROLazy_fill_in_LRO_get; auto. +auto; progress; smt ml=0. +qed. + +local lemma HybridIROLazy_HIRO_LRO_f : + equiv[HybridIROLazy.f ~ HIRO(ERO.LRO).f : + ={xs, n} /\ HybridIROLazy.mp{1} = ERO.RO.m{2} ==> + ={res} /\ HybridIROLazy.mp{1} = ERO.RO.m{2}]. +proof. +proc; wp; call HybridIROLazy_HIRO_LRO_g; 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: (mem (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: (mem (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_init : + equiv[HIRO(ERO.RO).init ~ HybridIROEager.init : + true ==> ={res} /\ ERO.RO.m{1} = HybridIROEager.mp{2}]. +proof. proc; inline*; auto. qed. + +local lemma HIRO_RO_HybridIROEager_g : + equiv[HIRO(ERO.RO).g ~ HybridIROEager.g : + ={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. + +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; wp; call HIRO_RO_HybridIROEager_g; auto. +qed. + +local module RODist(RO : ERO.RO) = { + proc distinguish() : bool = { + var b : bool; + b <@ D(HIRO(RO)).distinguish(); + return b; + } +}. + +local lemma Exper_HybridLazy_ERO_LRO &m : + Pr[HybridIROExper(HybridIROLazy, D).main() @ &m : res] = + Pr[EROExper(ERO.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_init. +conseq HybridIROLazy_HIRO_LRO_g. +conseq HybridIROLazy_HIRO_LRO_f. +auto. +qed. -local clone RndO.GenEager as RO. +local lemma ERO_RO_Exper_HybridEager &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_init. +conseq HIRO_RO_HybridIROEager_g. +conseq HIRO_RO_HybridIROEager_f. +auto. +qed. -lemma HybridIROLazyEager (D <: HYBRID_IRO_DIST) &m : - Pr[D(HybridIROLazy).distinguish() @ &m : res] = - Pr[D(HybridIROEager).distinguish() @ &m : res]. +lemma HybridIROExper_Lazy_Eager &m : + Pr[HybridIROExper(HybridIROLazy, D).main() @ &m : res] = + Pr[HybridIROExper(HybridIROEager, D).main() @ &m : res]. proof. -byequiv=> //. -admit. (* use RndO.ec result *) +by rewrite (Exper_HybridLazy_ERO_LRO &m) + (LRO_RO RODist &m) + (ERO_RO_Exper_HybridEager &m). qed. end section. @@ -281,7 +474,7 @@ seq 0 1 : LazyInvar 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. +inline*. rcondt{1} 7; first auto. seq 6 3 : (={i, n0} /\ bs{1} = bs0{2} /\ LazyInvar IRO.mp{1} HybridIROLazy.mp{2} /\ @@ -313,7 +506,7 @@ lemma IRO_RaiseHybridIRO_HybridIROLazy_f : LazyInvar IRO.mp{1} HybridIROLazy.mp{2} ==> ={res} /\ LazyInvar IRO.mp{1} HybridIROLazy.mp{2}]. proof. -proc=> /=; inline *. +proc=> /=; inline*. rcondt{1} 3; first auto. rcondt{2} 5; first auto; progress; apply valid_pad2blocks. seq 2 4 : @@ -354,7 +547,7 @@ lemma HybridIROEager_f_g : ={xs, HybridIROEager.mp} /\ n{1} * r = n{2} ==> res{1} = bits2blocks res{2} /\ ={HybridIROEager.mp}]. proof. -proc=> /=; inline *. +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}). @@ -404,6 +597,8 @@ conseq size bs{2} = (n' + r - 1) %/ r /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. progress; apply/needed_blocks_suff. +splitwhile{1} 1 : i < (n' %/ r) * r. +splitwhile{2} 1 : i < n' %/ r. admit. qed. @@ -514,7 +709,7 @@ byequiv=> //; proc. seq 2 2 : (={glob Dist, glob BlockSim} /\ IRO.mp{1} = NewFMap.map0 /\ HybridIROLazy.mp{2} = NewFMap.map0). -inline *; wp; call (_ : true); auto. +inline*; wp; call (_ : true); auto. call (_ : ={glob Dist, glob BlockSim} /\ @@ -532,36 +727,49 @@ auto. qed. local module HybridIRODist(HI : HYBRID_IRO) : HYBRID_IRO_DIST (HI) = { - proc distinguish() : bool = { var b : bool; - b <@ Experiment(RaiseHybridIRO(HI), BlockSim(HI), Dist).main(); + BlockSim(HI).init(); + b <@ Dist(RaiseHybridIRO(HI), BlockSim(HI)).distinguish(); return b; } }. -local lemma Experiment_Hybrid_Lazy_Eager &m : +local lemma Experiment_HybridIROExper_Lazy &m : Pr[Experiment (RaiseHybridIRO(HybridIROLazy), BlockSim(HybridIROLazy), Dist).main() @ &m : res] = + Pr[HybridIROExper(HybridIROLazy, HybridIRODist).main() @ &m : res]. +proof. +byequiv=> //; proc; inline*. +seq 2 2 : (={glob Dist, glob BlockSim, HybridIROLazy.mp}). +swap{2} 1 1; wp; call (_ : true); auto. +sim. +qed. + +local lemma HybridIROExper_Experiment_Eager &m : + Pr[HybridIROExper(HybridIROEager, HybridIRODist).main() @ &m : res] = Pr[Experiment (RaiseHybridIRO(HybridIROEager), BlockSim(HybridIROEager), Dist).main() @ &m : res]. proof. -have -> : +byequiv=> //; proc; inline*. +seq 2 2 : (={glob Dist, glob BlockSim, HybridIROEager.mp}). +swap{2} 1 1; wp; call (_ : true); auto. +sim. +qed. + +local lemma Experiment_Hybrid_Lazy_Eager &m : Pr[Experiment (RaiseHybridIRO(HybridIROLazy), BlockSim(HybridIROLazy), Dist).main() @ &m : res] = - Pr[HybridIRODist(HybridIROLazy).distinguish() @ &m : res]. - byequiv=> //; proc; inline *; sim. -rewrite (HybridIROLazyEager(HybridIRODist) &m). -have -> : - Pr[HybridIRODist(HybridIROEager).distinguish() @ &m : res] = Pr[Experiment (RaiseHybridIRO(HybridIROEager), BlockSim(HybridIROEager), Dist).main() @ &m : res]. - byequiv=> //; proc; inline *; sim. -done. +proof. +by rewrite (Experiment_HybridIROExper_Lazy &m) + (HybridIROExper_Lazy_Eager HybridIRODist &m) + (HybridIROExper_Experiment_Eager &m). qed. local lemma Experiment_HybridEager_Ideal_BlockIRO &m : @@ -575,7 +783,7 @@ byequiv=> //; proc. seq 2 2 : (={glob Dist, glob BlockSim} /\ HybridIROEager.mp{1} = NewFMap.map0 /\ BlockSponge.BIRO.IRO.mp{2} = NewFMap.map0). -inline *; wp; call (_ : true); auto. +inline*; wp; call (_ : true); auto. call (_ : ={glob Dist, glob BlockSim} /\ From 0c166a317004d114f221b8ec431cb716f45a60a7 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Sat, 30 Jan 2016 17:05:12 -0500 Subject: [PATCH 146/394] Isolated the two places (admits now) where must move from bits to blocks. --- sha3/proof/Common.ec | 63 ++++++++++++++- sha3/proof/Sponge.ec | 182 +++++++++++++++++++++++++++++-------------- 2 files changed, 186 insertions(+), 59 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 16e8ac0..5e28a29 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -94,6 +94,11 @@ clone export LazyRP as Perm with (*---------------------- Needed Blocks Computation ---------------------*) +lemma needed_blocks0 : (0 + r - 1) %/ r = 0. +proof. +rewrite -divz_eq0 1:gt0_r; smt ml=0 w=(gt0_r). +qed. + lemma needed_blocks_non_pos (n : int) : n <= 0 => (n + r - 1) %/ r <= 0. proof. @@ -130,7 +135,63 @@ 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 ml=0 w=(gt0_n). +smt ml=0 w=(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 ml=0. +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 ------------------------ *) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 51d29af..11f338b 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -99,7 +99,7 @@ module type HYBRID_IRO_DIST(HI : HYBRID_IRO) = { proc distinguish() : bool }. -module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { +module HybridIROLazy : HYBRID_IRO, BlockSponge.BIRO.IRO = { var mp : (block list * int, bool) fmap proc init() : unit = { @@ -115,7 +115,6 @@ module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { proc g(xs, n) = { var b, bs; - var m <- ((n + r - 1) %/ r) * r; var i <- 0; bs <- []; @@ -125,10 +124,6 @@ module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { bs <- rcons bs b; i <- i + 1; } - while (i < m) { (* eager part *) - fill_in(xs, i); - i <- i + 1; - } } return bs; } @@ -141,7 +136,16 @@ module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { } }. -module HybridIROLazy : HYBRID_IRO, BlockSponge.BIRO.IRO = { +module HybridIROExper(HI : HYBRID_IRO, D : HYBRID_IRO_DIST) = { + proc main() : bool = { + var b : bool; + HI.init(); + b <@ D(HI).distinguish(); + return b; + } +}. + +module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { var mp : (block list * int, bool) fmap proc init() : unit = { @@ -157,6 +161,7 @@ module HybridIROLazy : HYBRID_IRO, BlockSponge.BIRO.IRO = { proc g(xs, n) = { var b, bs; + var m <- ((n + r - 1) %/ r) * r; var i <- 0; bs <- []; @@ -166,6 +171,10 @@ module HybridIROLazy : HYBRID_IRO, BlockSponge.BIRO.IRO = { bs <- rcons bs b; i <- i + 1; } + while (i < m) { (* eager part *) + fill_in(xs, i); + i <- i + 1; + } } return bs; } @@ -178,15 +187,6 @@ module HybridIROLazy : HYBRID_IRO, BlockSponge.BIRO.IRO = { } }. -module HybridIROExper(HI : HYBRID_IRO, D : HYBRID_IRO_DIST) = { - proc main() : bool = { - var b : bool; - HI.init(); - b <@ D(HI).distinguish(); - return b; - } -}. - section. declare module D : HYBRID_IRO_DIST{HybridIROEager, HybridIROLazy}. @@ -551,9 +551,7 @@ 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 rewrite -addzA divzMDl 1:gtr_eqF 1:gt0_r // divz_small //; - smt ml=0 w=(gt0_n). +auto; progress; first 2 by rewrite needed_blocks_prod_r. if=> //; wp. while (={i, HybridIROEager.mp} /\ xs0{1} = xs{2} /\ @@ -568,37 +566,95 @@ sp; wp; if=> //; rnd; auto. auto. qed. -lemma HybridIROEager_g_BlockIRO_f (n' : int) (x' : block list) : +lemma HybridIROEager_g_BlockIRO_f (n1 : int) (x2 : block list) : equiv[HybridIROEager.g ~ BlockSponge.BIRO.IRO.f : - n' = n{1} /\ xs{1} = x{2} /\ x' = x{2} /\ + n1 = n{1} /\ x2 = x{2} /\ xs{1} = x{2} /\ n{2} = (n{1} + r - 1) %/ r /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ - (valid_block x' => - res{1} = take n' (blocks2bits res{2}) /\ - size res{2} = (n' + r - 1) %/ r) /\ - (! valid_block x' => res{1} = [] /\ res{2} = [])]. + (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 : - (n' = n{1} /\ xs{1} = x{2} /\ x' = x{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} = [] /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). auto; progress. if=> //. +case: (n1 < 0). +rcondf{1} 1; first auto; progress; smt ml=0. +rcondf{2} 1; first auto; progress; smt ml=0 w=(needed_blocks_non_pos). +rcondf{1} 1; first auto; progress; smt ml=0 w=(needed_blocks_non_pos gt0_r). +auto; progress; + [by rewrite blocks2bits_nil | by smt ml=0 w=(needed_blocks0)]. +(* 0 <= n1 *) conseq (_ : - xs{1} = x{2} /\ n' = n{1} /\ n{2} = (n{1} + r - 1) %/ r /\ + 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} = [] /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> - bs{1} = take n' (blocks2bits bs{2}) /\ - size bs{2} = (n' + r - 1) %/ r /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. -progress; apply/needed_blocks_suff. -splitwhile{1} 1 : i < (n' %/ r) * r. -splitwhile{2} 1 : i < n' %/ r. + bs{1} = take n1 (blocks2bits bs{2}) /\ + size bs{2} = (n1 + r - 1) %/ r /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). +progress; [smt ml=0 | apply/needed_blocks_suff]. +move=> |> &1 &2 ? ? ? mp1 mp2 bs ? ? ?; + smt ml=0 w=(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} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). +admit. +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} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + (i{2} = n{2} \/ i{2} + 1 = n{2}) ==> + _). +progress; by apply/needed_blocks_rel_div_r. +case: (i{2} = n{2}). +rcondf{2} 1; first auto; progress; smt ml=0. +rcondf{1} 1; first auto; progress; smt ml=0. +rcondf{1} 1; first auto; progress; smt ml=0. +auto=> |> &1 &2 ? ? sz_eq ? ? need_blks_eq. +split. +have -> : n{1} = 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} *) +rcondt{2} 1; first auto; progress; smt ml=0. +rcondf{2} 4; first auto; call (_ : true). +if=> //. auto; progress; smt ml=0. +wp; exists* i{1}; elim*=> i1; exists* bs{2}; elim*=> bs2. +conseq + (_ : + n1 = n{1} /\ 0 <= n1 /\ i1 = i{1} /\ bs2 = bs{2} /\ xs{1} = x{2} /\ + i{1} = i{2} * r /\ n{1} <= m{1} /\ m{1} - i{1} = r /\ + bs{1} = blocks2bits bs2 /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + bs{1} = blocks2bits bs2 ++ take (n1 - i1) (w2bits b{2}) /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). +progress; smt ml=0. +move=> |> &1 &2 ? ? sz_eq ? ? ? mp1 mp2 b ?. +split. +rewrite -cats1 blocks2bits_cat blocks2bits_sing take_cat. +have -> /= : !(n{1} < size(blocks2bits bs{2})). + rewrite size_blocks2bits sz_eq. + by smt ml=0 w=(needed_blocks_correct). +by rewrite size_blocks2bits sz_eq; congr; congr; smt ml=0. +by rewrite size_rcons; smt ml=0. admit. qed. @@ -617,23 +673,27 @@ transitivity EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> res{1} = (blocks2bits res{2}) /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). -progress. +move=> |> &1 &2 ? n_eq inv. exists BlockSponge.BIRO.IRO.mp{2}, HybridIROEager.mp{1}, (xs{1}, n{1} * r). - progress; by rewrite H0. +move=> |>; by rewrite n_eq. progress; apply blocks2bitsK. conseq HybridIROEager_f_g. -progress; by rewrite H0. +move=> |> &1 &2 ? -> ? //. exists* n{1}; elim*=> n1. exists* xs{1}; elim*=> xs'. conseq (HybridIROEager_g_BlockIRO_f n1 xs')=> //. -progress; rewrite H0; by rewrite needed_blocks_prod_r. -progress. +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 [-> size_result_R] := H3 vb_xs1. -have -> : n{1} = size(blocks2bits result_R) - by rewrite size_blocks2bits size_result_R H0 - needed_blocks_prod_r mulzC. +have [le0_n1_imp gt0_n1_imp] := vb_imp vb_xs1. +case: (n{1} <= 0)=> [le0_n1 | not_le0_n1]. +smt ml=0. +have gt0_n1 : 0 < n{1} by smt ml=0. +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 [->->] := H4 not_vb_xs1. +by have [->->] := not_vb_imp not_vb_xs1. qed. end HybridIRO. @@ -645,21 +705,6 @@ declare module Dist : DISTINGUISHER{Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}. local clone import HybridIRO as HIRO. -local lemma RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f : - equiv[RaiseHybridIRO(HybridIROEager).f ~ RaiseFun(BlockSponge.BIRO.IRO).f : - ={bs, n} /\ ={glob BlockSim} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> - ={res} /\ ={glob BlockSim} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}]. -proof. -proc=> /=. -exists* n{1}; elim*=> n'. -exists* (pad2blocks bs{2}); elim*=> xs2. -call (HybridIROEager_g_BlockIRO_f n' xs2). -auto; progress. -by have [-> _] := H2 _; first apply/valid_pad2blocks. -qed. - local lemma Sponge_Raise_BlockSponge_f : equiv[Sponge(Perm).f ~ RaiseFun(BlockSponge.Sponge(Perm)).f : ={bs, n, glob Perm} ==> ={res, glob Perm}]. @@ -699,6 +744,27 @@ conseq Sponge_Raise_BlockSponge_f=> //. auto. qed. +local lemma RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f : + equiv[RaiseHybridIRO(HybridIROEager).f ~ RaiseFun(BlockSponge.BIRO.IRO).f : + ={bs, n} /\ ={glob BlockSim} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + ={res} /\ ={glob BlockSim} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}]. +proof. +proc=> /=. +exists* n{1}; elim*=> n'. +exists* (pad2blocks bs{2}); elim*=> xs2. +call (HybridIROEager_g_BlockIRO_f n' xs2). +auto=> |> &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{2} <= 0)=> [le0_n2 | not_le0_n2]. +smt ml=0. +have gt0_n2 : 0 < n{2} by smt ml=0. +by have [-> _] := gt0_n2_imp gt0_n2. +have [-> ->] := not_vb_imp not_vb; by rewrite blocks2bits_nil. +qed. + local lemma Ideal_IRO_Experiment_HybridLazy &m : Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = Pr[Experiment From de50a60d760f4611865bc23260ba9b8826a33021 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 2 Feb 2016 10:37:45 -0500 Subject: [PATCH 147/394] Killed an [smt ml=0] that was now failing. --- sha3/proof/Common.ec | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 5e28a29..8222121 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -44,9 +44,16 @@ clone export BitWord as Block with lemma dvdz_close (n : int) : r %| n => 0 < n < 2 * r => n = r. proof. -move=> dvd_rn [gt0_n lt_n_2r]. -have [m] n_eq /# : exists m, m * r = n - by exists (n %/ r); apply dvdz_eq. +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>] = []. From 1f14e400cafa06c8265fa113314c6038d21138ed Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 3 Feb 2016 11:14:03 -0500 Subject: [PATCH 148/394] Made Common.ec and Sponge.ec check with *both* Alt-Ergo and Z3 (so not relying on a single SMT-solver being sound). --- sha3/proof/Common.ec | 14 +++++++++++++- sha3/proof/Sponge.ec | 34 ++++++++++++++++++++-------------- 2 files changed, 33 insertions(+), 15 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 8222121..5359872 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -90,6 +90,10 @@ case (zs = [])=> // zs_non_nil. elim ih=> // ->. by rewrite (@last_nonempty y z). qed. +lemma not_none ['a] (x : 'a option) : + x <> None => x = Some(oget x). +proof. case: (x)=> //. qed. + (*------------------------------ Primitive -----------------------------*) clone export LazyRP as Perm with @@ -556,7 +560,15 @@ rewrite vb_xs /= in bp. move: bp=> [s n] _ b2b_xs_eq. case: (last b0 xs <> b0)=> [// | last_xs_eq_b0]. rewrite nnot in last_xs_eq_b0. -have xs_non_nil : xs <> [] by smt ml=0. +have xs_non_nil : xs <> []. + case: xs b2b_xs_eq last_xs_eq_b0 vb_xs=> // contrad. + rewrite blocks2bits_nil in contrad. + have contrad_last : + false = last false (s ++ [true] ++ nseq n false ++ [true]). + have {1}-> : false = last false [] by trivial. + by rewrite {1}contrad. + rewrite last_cat /= in contrad_last. + elim contrad_last. 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. diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 11f338b..36928de 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -479,7 +479,9 @@ seq 6 3 : (={i, n0} /\ bs{1} = bs0{2} /\ LazyInvar IRO.mp{1} HybridIROLazy.mp{2} /\ pad2blocks x{1} = xs0{2}). -auto; progress; have {2}<- /# := unpadBlocksK xs0{2}. +auto; progress; + have {2}<- := unpadBlocksK xs0{2}; first + by rewrite (@not_none (unpad_blocks xs0{2})). wp. while (={i, n0} /\ bs{1} = bs0{2} /\ @@ -489,11 +491,12 @@ sp; auto. if. progress; smt ml=0. rnd; auto; progress; - [smt ml=0 w=(getP_eq) | - smt ml=0 w=(lazy_invar_upd_mem_dom_iff) | - smt ml=0 w=(lazy_invar_upd_mem_dom_iff) | - smt ml=0 w=(lazy_invar_upd2_vb) | - smt ml=0 w=(lazy_invar_upd_lu_eq)]. + [by rewrite !getP_eq | + by rewrite -(@lazy_invar_upd_mem_dom_iff IRO.mp{1}) | + by rewrite (@lazy_invar_upd_mem_dom_iff IRO.mp{1} HybridIROLazy.mp{2}) | + by rewrite (@lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} + x{1} xs2 i{2} n2 mpL) | + by rewrite (@lazy_invar_upd_lu_eq IRO.mp{1} HybridIROLazy.mp{2})]. auto; progress; smt ml=0. auto. rcondf{1} 3; first auto. rcondf{2} 4; first auto. @@ -519,12 +522,13 @@ while wp; sp. if. progress; smt ml=0. -rnd; skip; progress; - [smt ml=0 w=(getP_eq) | - smt ml=0 w=(lazy_invar_upd_mem_dom_iff) | - smt ml=0 w=(lazy_invar_upd_mem_dom_iff) | - smt ml=0 w=(lazy_invar_upd2_vb) | - smt ml=0 w=(lazy_invar_upd_lu_eq)]. +rnd; auto; progress; + [by rewrite !getP_eq | + by rewrite -(@lazy_invar_upd_mem_dom_iff IRO.mp{1}) | + by rewrite (@lazy_invar_upd_mem_dom_iff IRO.mp{1} HybridIROLazy.mp{2}) | + by rewrite (@lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} + x{1} xs1 i{2} n1 mpL) | + by rewrite (@lazy_invar_upd_lu_eq IRO.mp{1} HybridIROLazy.mp{2})]. auto; progress; smt ml=0. auto. qed. @@ -589,8 +593,10 @@ auto; progress. if=> //. case: (n1 < 0). rcondf{1} 1; first auto; progress; smt ml=0. -rcondf{2} 1; first auto; progress; smt ml=0 w=(needed_blocks_non_pos). -rcondf{1} 1; first auto; progress; smt ml=0 w=(needed_blocks_non_pos gt0_r). +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. auto; progress; [by rewrite blocks2bits_nil | by smt ml=0 w=(needed_blocks0)]. (* 0 <= n1 *) From ca3432b6a12eda55cd2bbbaf13d9736f3f05b722 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 3 Feb 2016 11:24:35 -0500 Subject: [PATCH 149/394] Make IRO work for Z3 as well as Alt-Ergo. --- sha3/proof/IRO.eca | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sha3/proof/IRO.eca b/sha3/proof/IRO.eca index 697902f..1519b1d 100644 --- a/sha3/proof/IRO.eca +++ b/sha3/proof/IRO.eca @@ -29,8 +29,8 @@ pred prefix_closed' (m : (from * int,to) fmap) = 0 <= i < n => mem (dom m) (x,i). -lemma prefix_closed_equiv m: prefix_closed m <=> prefix_closed' m -by []. +lemma prefix_closed_equiv m: prefix_closed m <=> prefix_closed' m. +proof. smt ml=0. qed. (* official version: *) From 87933d43d1421d97891dd439ce5250ba505906cd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 3 Feb 2016 18:36:23 +0100 Subject: [PATCH 150/394] Filling in admits. Moving a lemma to stdlib. --- sha3/proof/Common.ec | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 5359872..dea1847 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -69,13 +69,16 @@ qed. lemma b0 : b0 = bits2w(nseq r false). proof. -admit. (* FIXME *) +rewrite wordP=> i ge0_i_ltr; rewrite offunifE ge0_i_ltr /= getE ge0_i_ltr /=. +rewrite ofwordK 1:Array.size_mkarray 1:size_nseq 1:/#. +by rewrite Array.getE Array.ofarrayK nth_nseq. qed. lemma bits2w_inj_eq (cs ds : bool list) : size cs = r => size ds = r => bits2w cs = bits2w ds <=> cs = ds. proof. -admit. (* FIXME *) +rewrite -!Array.size_mkarray=> s_cs_r s_ds_r; split=> //=. +by move=> @/bits2w /(mkword_pinj _ _ s_cs_r s_ds_r) /Array.mkarray_inj. qed. lemma last_drop_all_but_last (y : 'a, xs : 'a list) : @@ -90,10 +93,6 @@ case (zs = [])=> // zs_non_nil. elim ih=> // ->. by rewrite (@last_nonempty y z). qed. -lemma not_none ['a] (x : 'a option) : - x <> None => x = Some(oget x). -proof. case: (x)=> //. qed. - (*------------------------------ Primitive -----------------------------*) clone export LazyRP as Perm with From 4417210c9e6f5912344f063e924ed7303ac6bf24 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 3 Feb 2016 18:43:36 +0100 Subject: [PATCH 151/394] Move old to core. --- sha3/proof/.dir-locals.el | 2 +- sha3/proof/{old => core}/ConcreteF.eca | 0 sha3/proof/{old => core}/Gcol.eca | 0 sha3/proof/{old => core}/Gconcl.ec | 0 sha3/proof/{old => core}/Gext.eca | 0 sha3/proof/{old => core}/Handle.eca | 0 sha3/proof/{old => core}/IndifPadding.ec | 0 sha3/proof/{old => core}/LazyRO.eca | 0 sha3/proof/{old => core}/NBRO.eca | 0 sha3/proof/{old => core}/SLCommon.ec | 0 sha3/proof/{old => core}/Utils.ec | 0 11 files changed, 1 insertion(+), 1 deletion(-) rename sha3/proof/{old => core}/ConcreteF.eca (100%) rename sha3/proof/{old => core}/Gcol.eca (100%) rename sha3/proof/{old => core}/Gconcl.ec (100%) rename sha3/proof/{old => core}/Gext.eca (100%) rename sha3/proof/{old => core}/Handle.eca (100%) rename sha3/proof/{old => core}/IndifPadding.ec (100%) rename sha3/proof/{old => core}/LazyRO.eca (100%) rename sha3/proof/{old => core}/NBRO.eca (100%) rename sha3/proof/{old => core}/SLCommon.ec (100%) rename sha3/proof/{old => core}/Utils.ec (100%) diff --git a/sha3/proof/.dir-locals.el b/sha3/proof/.dir-locals.el index fbf2dcd..e868573 100644 --- a/sha3/proof/.dir-locals.el +++ b/sha3/proof/.dir-locals.el @@ -1,4 +1,4 @@ ((easycrypt-mode . ((eval . (flet ((pre (s) (concat (locate-dominating-file buffer-file-name ".dir-locals.el") s))) - (setq easycrypt-load-path `(,(pre ".") ,(pre "variant") ,(pre "old")))))))) + (setq easycrypt-load-path `(,(pre ".") ,(pre "variant") ,(pre "core")))))))) diff --git a/sha3/proof/old/ConcreteF.eca b/sha3/proof/core/ConcreteF.eca similarity index 100% rename from sha3/proof/old/ConcreteF.eca rename to sha3/proof/core/ConcreteF.eca diff --git a/sha3/proof/old/Gcol.eca b/sha3/proof/core/Gcol.eca similarity index 100% rename from sha3/proof/old/Gcol.eca rename to sha3/proof/core/Gcol.eca diff --git a/sha3/proof/old/Gconcl.ec b/sha3/proof/core/Gconcl.ec similarity index 100% rename from sha3/proof/old/Gconcl.ec rename to sha3/proof/core/Gconcl.ec diff --git a/sha3/proof/old/Gext.eca b/sha3/proof/core/Gext.eca similarity index 100% rename from sha3/proof/old/Gext.eca rename to sha3/proof/core/Gext.eca diff --git a/sha3/proof/old/Handle.eca b/sha3/proof/core/Handle.eca similarity index 100% rename from sha3/proof/old/Handle.eca rename to sha3/proof/core/Handle.eca diff --git a/sha3/proof/old/IndifPadding.ec b/sha3/proof/core/IndifPadding.ec similarity index 100% rename from sha3/proof/old/IndifPadding.ec rename to sha3/proof/core/IndifPadding.ec diff --git a/sha3/proof/old/LazyRO.eca b/sha3/proof/core/LazyRO.eca similarity index 100% rename from sha3/proof/old/LazyRO.eca rename to sha3/proof/core/LazyRO.eca diff --git a/sha3/proof/old/NBRO.eca b/sha3/proof/core/NBRO.eca similarity index 100% rename from sha3/proof/old/NBRO.eca rename to sha3/proof/core/NBRO.eca diff --git a/sha3/proof/old/SLCommon.ec b/sha3/proof/core/SLCommon.ec similarity index 100% rename from sha3/proof/old/SLCommon.ec rename to sha3/proof/core/SLCommon.ec diff --git a/sha3/proof/old/Utils.ec b/sha3/proof/core/Utils.ec similarity index 100% rename from sha3/proof/old/Utils.ec rename to sha3/proof/core/Utils.ec From b929281e4fe6390a0e6617d41b4a8b5b590b6dae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 3 Feb 2016 18:51:17 +0100 Subject: [PATCH 152/394] Alpha: not_none -> some_oget. --- sha3/proof/Sponge.ec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 36928de..de71e97 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -481,7 +481,7 @@ seq 6 3 : pad2blocks x{1} = xs0{2}). auto; progress; have {2}<- := unpadBlocksK xs0{2}; first - by rewrite (@not_none (unpad_blocks xs0{2})). + by rewrite (@some_oget (unpad_blocks xs0{2})). wp. while (={i, n0} /\ bs{1} = bs0{2} /\ From f4374b15e550c83c914dfd246409778f926c36c9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 3 Feb 2016 18:51:41 +0100 Subject: [PATCH 153/394] Dealing with old theory renames. --- sha3/proof/AbsorbToBlocks.ec | 94 +++++++++++++++---------------- sha3/proof/variant/LeakyAbsorb.ec | 7 +-- sha3/proof/variant/RndOrcl.eca | 2 +- 3 files changed, 51 insertions(+), 52 deletions(-) diff --git a/sha3/proof/AbsorbToBlocks.ec b/sha3/proof/AbsorbToBlocks.ec index f22d47c..d2c27a7 100644 --- a/sha3/proof/AbsorbToBlocks.ec +++ b/sha3/proof/AbsorbToBlocks.ec @@ -1,6 +1,6 @@ (* -------------------------------------------------------------------- *) require import Option Pair Int Real List FSet NewFMap. -require (*--*) Absorb Block. +require (*--*) AbsorbSponge BlockSponge. (* -------------------------------------------------------------------- *) require import Common. @@ -8,7 +8,7 @@ require import Common. op cast: 'a NewDistr.distr -> 'a distr. (* -------------------------------------------------------------------- *) -module LowerFun(F : Self.Block.DFUNCTIONALITY) : Absorb.DFUNCTIONALITY = { +module LowerFun(F : Self.BlockSponge.DFUNCTIONALITY) : AbsorbSponge.DFUNCTIONALITY = { proc init() = {} proc f(xs : block list) : block = { @@ -22,9 +22,9 @@ module LowerFun(F : Self.Block.DFUNCTIONALITY) : Absorb.DFUNCTIONALITY = { } }. -module Sim (S : Absorb.SIMULATOR, F : Self.Block.DFUNCTIONALITY) = S(LowerFun(F)). +module Sim (S : AbsorbSponge.SIMULATOR, F : Self.BlockSponge.DFUNCTIONALITY) = S(LowerFun(F)). -module UpperFun (F : Absorb.DFUNCTIONALITY) = { +module UpperFun (F : AbsorbSponge.DFUNCTIONALITY) = { proc init() = {} proc f(xs : block list, n : int) : block list = { @@ -43,17 +43,17 @@ module UpperFun (F : Absorb.DFUNCTIONALITY) = { } }. -module BlocksOfAbsorbBlockSponge (P : Self.Block.DPRIMITIVE) = - UpperFun(Absorb.BlockSponge(P)). +module BlocksOfAbsorbBlockSponge (P : Self.BlockSponge.DPRIMITIVE) = + UpperFun(AbsorbSponge.BlockSponge(P)). -module Dist (D : Self.Block.DISTINGUISHER, F : Absorb.DFUNCTIONALITY) = D(UpperFun(F)). +module Dist (D : Self.BlockSponge.DISTINGUISHER, F : AbsorbSponge.DFUNCTIONALITY) = D(UpperFun(F)). section. - declare module AbsorbSim : Absorb.SIMULATOR { Perm, Self.Block.BIRO.IRO', Absorb.Ideal.RO }. - declare module BlocksDist : Self.Block.DISTINGUISHER { Perm, Self.Block.BIRO.IRO', Absorb.Ideal.RO, AbsorbSim }. + declare module AbsorbSim : AbsorbSponge.SIMULATOR { Perm, Self.BlockSponge.BIRO.IRO', AbsorbSponge.Ideal.RO }. + declare module BlocksDist : Self.BlockSponge.DISTINGUISHER { Perm, Self.BlockSponge.BIRO.IRO', AbsorbSponge.Ideal.RO, AbsorbSim }. local equiv ModularBlocks_Real: - UpperFun(Absorb.BlockSponge(Perm)).f ~ Self.Block.Sponge(Perm).f: + UpperFun(AbsorbSponge.BlockSponge(Perm)).f ~ Self.BlockSponge.Sponge(Perm).f: ={arg} /\ ={m,mi}(Perm,Perm) /\ (forall x, mem (dom Perm.m){1} x) @@ -62,23 +62,23 @@ section. /\ (forall x, mem (dom Perm.m){1} x). proof. proc. sp; if=> //=. - inline Absorb.BlockSponge(Perm).f. + inline AbsorbSponge.BlockSponge(Perm).f. admit. (* Fun with loops *) qed. pred lower (ro : (block list,block) fmap) (iro : (block list * int,block) fmap) = - Self.Block.BIRO.prefix_closed iro /\ + Self.BlockSponge.BIRO.prefix_closed iro /\ forall x n, valid_block x => iro.[(x,n)] = ro.[extend x n]. local equiv ModularAbsorb: - UpperFun(Absorb.Ideal.RO).f ~ Self.Block.BIRO.IRO'.f: + UpperFun(AbsorbSponge.Ideal.RO).f ~ Self.BlockSponge.BIRO.IRO'.f: ={arg} - /\ lower Absorb.Ideal.RO.m{1} Self.Block.BIRO.IRO'.mp{2} + /\ lower AbsorbSponge.Ideal.RO.m{1} Self.BlockSponge.BIRO.IRO'.mp{2} ==> ={res} - /\ lower Absorb.Ideal.RO.m{1} Self.Block.BIRO.IRO'.mp{2}. + /\ lower AbsorbSponge.Ideal.RO.m{1} Self.BlockSponge.BIRO.IRO'.mp{2}. proof. proc. sp; if=> //=. - inline Absorb.BlockSponge(Perm).f. + inline AbsorbSponge.BlockSponge(Perm).f. admit. (* Fun with loops *) qed. @@ -91,14 +91,14 @@ section. n <= n' /\ mem (dom ro) (extend x n')). - module LowIRO' : Absorb.FUNCTIONALITY = { - proc init = Self.Block.BIRO.IRO'.init + module LowIRO' : AbsorbSponge.FUNCTIONALITY = { + proc init = Self.BlockSponge.BIRO.IRO'.init proc f(xs : block list) = { var b <- b0; var (ys, n) = strip xs; if (valid_block ys) { - b <@ Self.Block.BIRO.IRO'.f_lazy(ys, n); + b <@ Self.BlockSponge.BIRO.IRO'.f_lazy(ys, n); } return b; @@ -106,7 +106,7 @@ section. }. pred holey_map (iro iro_lazy : (block list * int,block) fmap) = - Self.Block.BIRO.prefix_closed iro + Self.BlockSponge.BIRO.prefix_closed iro /\ (forall xn, mem (dom iro_lazy) xn => iro_lazy.[xn] = iro.[xn]) @@ -120,13 +120,13 @@ section. whose index is not in the index of the right map, as they have not ben given to the adversary. **) local lemma LazifyIRO: - eager [Self.Block.BIRO.IRO'.resample_invisible(); , LowerFun(Self.Block.BIRO.IRO').f ~ LowIRO'.f, Self.Block.BIRO.IRO'.resample_invisible();: - ={arg, Self.Block.BIRO.IRO'.visible} - /\ holey_map Self.Block.BIRO.IRO'.mp{1} Self.Block.BIRO.IRO'.mp{2} - /\ Self.Block.BIRO.IRO'.visible{2} = dom (Self.Block.BIRO.IRO'.mp){2} - ==> ={res, Self.Block.BIRO.IRO'.visible} - /\ holey_map Self.Block.BIRO.IRO'.mp{1} Self.Block.BIRO.IRO'.mp{2} - /\ Self.Block.BIRO.IRO'.visible{2} = dom (Self.Block.BIRO.IRO'.mp){2}]. + eager [Self.BlockSponge.BIRO.IRO'.resample_invisible(); , LowerFun(Self.BlockSponge.BIRO.IRO').f ~ LowIRO'.f, Self.BlockSponge.BIRO.IRO'.resample_invisible();: + ={arg, Self.BlockSponge.BIRO.IRO'.visible} + /\ holey_map Self.BlockSponge.BIRO.IRO'.mp{1} Self.BlockSponge.BIRO.IRO'.mp{2} + /\ Self.BlockSponge.BIRO.IRO'.visible{2} = dom (Self.BlockSponge.BIRO.IRO'.mp){2} + ==> ={res, Self.BlockSponge.BIRO.IRO'.visible} + /\ holey_map Self.BlockSponge.BIRO.IRO'.mp{1} Self.BlockSponge.BIRO.IRO'.mp{2} + /\ Self.BlockSponge.BIRO.IRO'.visible{2} = dom (Self.BlockSponge.BIRO.IRO'.mp){2}]. proof. (* eager proc. @@ -191,20 +191,20 @@ section. - on actual queries, the two maps agree; - blocks in the IRO that are just generated on the way to answering actual queries can be resampled. **) - (* Absorb.Ideal.RO.f ~ LowerFun(Blocks.BIRO.IRO).f: + (* AbsorbSponge.Ideal.RO.f ~ LowerFun(Blocks.BIRO.IRO).f: ={arg} /\ true ==> ={res}. *) lemma Intermediate &m: - `|Pr[Self.Block.RealIndif(Self.Block.Sponge,Perm,BlocksDist).main() @ &m :res] - - Pr[Self.Block.IdealIndif(Self.Block.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]| - = `|Pr[Self.Block.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] - - Pr[Self.Block.IdealIndif(UpperFun(Absorb.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res]|. + `|Pr[Self.BlockSponge.RealIndif(Self.BlockSponge.Sponge,Perm,BlocksDist).main() @ &m :res] + - Pr[Self.BlockSponge.IdealIndif(Self.BlockSponge.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]| + = `|Pr[Self.BlockSponge.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] + - Pr[Self.BlockSponge.IdealIndif(UpperFun(AbsorbSponge.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res]|. proof. - have ->: Pr[Self.Block.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] - = Pr[Self.Block.RealIndif(Self.Block.Sponge,Perm,BlocksDist).main() @ &m :res]. + have ->: Pr[Self.BlockSponge.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] + = Pr[Self.BlockSponge.RealIndif(Self.BlockSponge.Sponge,Perm,BlocksDist).main() @ &m :res]. byequiv=> //=; proc. call (_: ={m,mi}(Perm,Perm) /\ (forall x, mem (dom Perm.m){1} x)). @@ -219,14 +219,14 @@ section. (* Now the other initialization is dead code. *) call (_: true ==> true)=> //. by proc; auto. - have ->: Pr[Self.Block.IdealIndif(UpperFun(Absorb.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res] - = Pr[Self.Block.IdealIndif(Self.Block.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]. + have ->: Pr[Self.BlockSponge.IdealIndif(UpperFun(AbsorbSponge.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res] + = Pr[Self.BlockSponge.IdealIndif(Self.BlockSponge.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]. byequiv=> //=; proc. - call (_: ={glob AbsorbSim} /\ lower Absorb.Ideal.RO.m{1} Self.Block.BIRO.IRO'.mp{2}). - proc (lower Absorb.Ideal.RO.m{1} Self.Block.BIRO.IRO'.mp{2})=> //=. + call (_: ={glob AbsorbSim} /\ lower AbsorbSponge.Ideal.RO.m{1} Self.BlockSponge.BIRO.IRO'.mp{2}). + proc (lower AbsorbSponge.Ideal.RO.m{1} Self.BlockSponge.BIRO.IRO'.mp{2})=> //=. proc; sp; if=> //=. smt. call ModularAbsorb; auto; smt. - proc (lower Absorb.Ideal.RO.m{1} Self.Block.BIRO.IRO'.mp{2})=> //=. + proc (lower AbsorbSponge.Ideal.RO.m{1} Self.BlockSponge.BIRO.IRO'.mp{2})=> //=. proc; sp; if=> //=. smt. call ModularAbsorb; auto; smt. (* Re-Bug *) @@ -238,16 +238,16 @@ section. qed. lemma Remainder &m: - `|Pr[Self.Block.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] - - Pr[Self.Block.IdealIndif(UpperFun(Absorb.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res]| - = `|Pr[Absorb.RealIndif(Absorb.BlockSponge,Perm,Dist(BlocksDist)).main() @ &m: res] - - Pr[Absorb.IdealIndif(Absorb.Ideal.RO,AbsorbSim,Dist(BlocksDist)).main() @ &m: res]|. + `|Pr[Self.BlockSponge.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] + - Pr[Self.BlockSponge.IdealIndif(UpperFun(AbsorbSponge.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res]| + = `|Pr[AbsorbSponge.RealIndif(AbsorbSponge.BlockSponge,Perm,Dist(BlocksDist)).main() @ &m: res] + - Pr[AbsorbSponge.IdealIndif(AbsorbSponge.Ideal.RO,AbsorbSim,Dist(BlocksDist)).main() @ &m: res]|. proof. admit. qed. lemma Conclusion &m: - `|Pr[Self.Block.RealIndif(Self.Block.Sponge,Perm,BlocksDist).main() @ &m: res] - - Pr[Self.Block.IdealIndif(Self.Block.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]| - = `|Pr[Absorb.RealIndif(Absorb.BlockSponge,Perm,Dist(BlocksDist)).main() @ &m: res] - - Pr[Absorb.IdealIndif(Absorb.Ideal.RO,AbsorbSim,Dist(BlocksDist)).main() @ &m: res]|. + `|Pr[Self.BlockSponge.RealIndif(Self.BlockSponge.Sponge,Perm,BlocksDist).main() @ &m: res] + - Pr[Self.BlockSponge.IdealIndif(Self.BlockSponge.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]| + = `|Pr[AbsorbSponge.RealIndif(AbsorbSponge.BlockSponge,Perm,Dist(BlocksDist)).main() @ &m: res] + - Pr[AbsorbSponge.IdealIndif(AbsorbSponge.Ideal.RO,AbsorbSim,Dist(BlocksDist)).main() @ &m: res]|. proof. by rewrite (Intermediate &m) (Remainder &m). qed. end section. diff --git a/sha3/proof/variant/LeakyAbsorb.ec b/sha3/proof/variant/LeakyAbsorb.ec index 3ebe579..8f03201 100644 --- a/sha3/proof/variant/LeakyAbsorb.ec +++ b/sha3/proof/variant/LeakyAbsorb.ec @@ -1,7 +1,6 @@ (* -------------------------------------------------------------------- *) -require import Option Pair Int Real Distr List FSet NewFMap. -require (*--*) LazyRP RndOrcl. -(*---*) import Dprod. +require import Option Pair Int Real Distr List FSet NewFMap DProd. +require (*--*) LazyRP RndOrcl. (* -------------------------------------------------------------------- *) @@ -22,7 +21,7 @@ op (^) : block -> block -> block. (* -------------------------------------------------------------------- *) clone import LazyRP as Perm with type D <- block * capacity, - op d <- bdist * cdist + op d <- bdist `*` cdist rename [module] "P" as "Perm". diff --git a/sha3/proof/variant/RndOrcl.eca b/sha3/proof/variant/RndOrcl.eca index 4f8b612..07fd6ba 100644 --- a/sha3/proof/variant/RndOrcl.eca +++ b/sha3/proof/variant/RndOrcl.eca @@ -149,7 +149,7 @@ abstract theory GenIdeal. + case ((pick work = x){2})=> pick_x; last smt. subst x{2}; move: H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. by apply fmapP=> x0; case (pick work{2} = x0); smt. - by auto; smt. + by auto; smt w=@NewFMap. by auto;progress [-split];rewrite H0 /= getP_eq;smt. qed. From 5cd8c8df8e3cb0b75ccaface72f5a4772b8c8b15 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 3 Feb 2016 19:06:14 +0100 Subject: [PATCH 154/394] Pushing a proof back through after oracles got swapped for some reason. This may need to be investigated further. --- sha3/proof/core/Gext.eca | 23 ++++++++++------------- 1 file changed, 10 insertions(+), 13 deletions(-) diff --git a/sha3/proof/core/Gext.eca b/sha3/proof/core/Gext.eca index e42d96e..e2cb45d 100644 --- a/sha3/proof/core/Gext.eca +++ b/sha3/proof/core/Gext.eca @@ -619,28 +619,28 @@ section EXT. apply ler_wpmul2r;1:by apply eps_ge0. by rewrite le_fromint;smt ml=0 w=max_ge0. + proc. - case ((size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size)); + case ((size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size)); [rcondt 2 | rcondf 2];1,3:by auto. - + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi)));skip=> &hr[#]?->/=???. - rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr})) cdistr (1%r/(2^c)%r))//. - + move=>x _;apply DWord.muxP. + + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x));skip=> &hr[#]?->/=???. + rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. + + by move=>x _;apply DWord.muxP. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. rewrite imageU fcardU le_fromint. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). - rewrite -!sizeE;smt w=fcard_ge0. + by rewrite -!sizeE fcardU fcard1; smt w=fcard_ge0. by hoare=>[??|];[apply eps_ge0|auto]. + by move=>c1;proc;auto=> &hr [^H 2->]/#. by move=> b1 c1;proc;auto=> &hr [^H 2->]. - + proc. - case ((size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size)); + + proc. + case ((size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size)); [rcondt 2 | rcondf 2]; 1,3:by auto. - + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi ) `|` fset1 x));skip=> &hr[#]?->/=???. + + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi )));skip=> &hr[#]?->/=???. rewrite (Mu_mem.mu_mem - (image snd (dom G1.m{hr} `|` dom G1.mi{hr}) `|` fset1 x{hr}) + (image snd (dom G1.m{hr} `|` dom G1.mi{hr})) cdistr (1%r/(2^c)%r))//. + move=>x _;apply DWord.muxP. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU !fcardU le_fromint fcard1. + rewrite imageU !fcardU le_fromint. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). rewrite -!sizeE;smt w=fcard_ge0. by hoare=>[??|];[apply eps_ge0|auto]. @@ -675,6 +675,3 @@ section EXT. qed. end section EXT. - - - From fb0f327179351e33ec86209ae6634abe912b245e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 3 Feb 2016 19:36:50 +0100 Subject: [PATCH 155/394] Revert "Pushing a proof back through after oracles got swapped for some reason." This reverts commit 7e32f742fa318b19e41ab7d99d39496645304427. --- sha3/proof/core/Gext.eca | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/sha3/proof/core/Gext.eca b/sha3/proof/core/Gext.eca index e2cb45d..e42d96e 100644 --- a/sha3/proof/core/Gext.eca +++ b/sha3/proof/core/Gext.eca @@ -619,28 +619,28 @@ section EXT. apply ler_wpmul2r;1:by apply eps_ge0. by rewrite le_fromint;smt ml=0 w=max_ge0. + proc. - case ((size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size)); + case ((size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size)); [rcondt 2 | rcondf 2];1,3:by auto. - + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x));skip=> &hr[#]?->/=???. - rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. - + by move=>x _;apply DWord.muxP. + + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi)));skip=> &hr[#]?->/=???. + rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr})) cdistr (1%r/(2^c)%r))//. + + move=>x _;apply DWord.muxP. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. rewrite imageU fcardU le_fromint. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). - by rewrite -!sizeE fcardU fcard1; smt w=fcard_ge0. + rewrite -!sizeE;smt w=fcard_ge0. by hoare=>[??|];[apply eps_ge0|auto]. + by move=>c1;proc;auto=> &hr [^H 2->]/#. by move=> b1 c1;proc;auto=> &hr [^H 2->]. - + proc. - case ((size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size)); + + proc. + case ((size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size)); [rcondt 2 | rcondf 2]; 1,3:by auto. - + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi )));skip=> &hr[#]?->/=???. + + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi ) `|` fset1 x));skip=> &hr[#]?->/=???. rewrite (Mu_mem.mu_mem - (image snd (dom G1.m{hr} `|` dom G1.mi{hr})) + (image snd (dom G1.m{hr} `|` dom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. + move=>x _;apply DWord.muxP. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU !fcardU le_fromint. + rewrite imageU !fcardU le_fromint fcard1. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). rewrite -!sizeE;smt w=fcard_ge0. by hoare=>[??|];[apply eps_ge0|auto]. @@ -675,3 +675,6 @@ section EXT. qed. end section EXT. + + + From 29d88ac5a2a0f7c7a6966f861e61c2d51fbaae42 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 3 Feb 2016 19:40:35 +0100 Subject: [PATCH 156/394] Cleaning up the core bound. --- sha3/proof/core/ConcreteF.eca | 7 +++---- sha3/proof/core/Gconcl.ec | 2 +- sha3/proof/core/Gext.eca | 3 +-- sha3/proof/core/Handle.eca | 2 +- 4 files changed, 6 insertions(+), 8 deletions(-) diff --git a/sha3/proof/core/ConcreteF.eca b/sha3/proof/core/ConcreteF.eca index 73cf914..b357211 100644 --- a/sha3/proof/core/ConcreteF.eca +++ b/sha3/proof/core/ConcreteF.eca @@ -55,10 +55,9 @@ section. op uD <- dstate, type K <- unit, op dK <- (NewDistr.MUnit.dunit<:unit> tt), - op q <- max_size + 1 + op q <- max_size proof *. - - realize gt0_q by smt w=max_ge0. + realize ge0_q by smt w=max_ge0. realize uD_uf_fu. split. case=> [x y]; rewrite support_dprod /=. @@ -110,7 +109,7 @@ section. lemma Real_Concrete &m : Pr[GReal(D).main()@ &m: res /\ C.c <= max_size] <= - Pr[CF(DRestr(D)).main()@ &m: res] + ((max_size + 1) ^ 2)%r * mu dstate (pred1 witness). + Pr[CF(DRestr(D)).main()@ &m: res] + (max_size ^ 2)%r * mu dstate (pred1 witness). proof. cut->: Pr[RealIndif(SqueezelessSponge,PC(Perm),D).main()@ &m: diff --git a/sha3/proof/core/Gconcl.ec b/sha3/proof/core/Gconcl.ec index d984261..0476021 100644 --- a/sha3/proof/core/Gconcl.ec +++ b/sha3/proof/core/Gconcl.ec @@ -366,7 +366,7 @@ axiom D_ll : 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 + 1) ^ 2)%r * mu dstate (pred1 witness) + + (max_size ^ 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. diff --git a/sha3/proof/core/Gext.eca b/sha3/proof/core/Gext.eca index e42d96e..ec98425 100644 --- a/sha3/proof/core/Gext.eca +++ b/sha3/proof/core/Gext.eca @@ -652,11 +652,10 @@ section EXT. forall (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}), islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. - (* TODO Francois : on peut pas avoir max_size au lieu de (max_size + 1)? *) lemma Real_G2 &m: Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= Pr[Eager(G2(DRestr(D))).main2() @ &m: res] + - ((max_size + 1) ^ 2)%r * mu dstate (pred1 witness) + + (max_size ^ 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. diff --git a/sha3/proof/core/Handle.eca b/sha3/proof/core/Handle.eca index 136ff79..5e528f0 100644 --- a/sha3/proof/core/Handle.eca +++ b/sha3/proof/core/Handle.eca @@ -602,7 +602,7 @@ section. lemma Real_G1 &m: Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= - Pr[G1(DRestr(D)).main() @ &m: res] + ((max_size + 1) ^ 2)%r * mu dstate (pred1 witness) + + Pr[G1(DRestr(D)).main() @ &m: res] + (max_size ^ 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 D_ll &m)). From 643a449123ea6ef489d4119db665d7ac1976614a Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Wed, 3 Feb 2016 23:44:54 +0100 Subject: [PATCH 157/394] push include paths in tests.config --- sha3/config/tests.config | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/sha3/config/tests.config b/sha3/config/tests.config index 3879c44..b386ecb 100644 --- a/sha3/config/tests.config +++ b/sha3/config/tests.config @@ -1,5 +1,6 @@ [default] -bin = ec.native +bin = ec.native +args = -I proof -I proof/variant -I proof/core [test-sha3] okdirs = !proof From 70c4fcc7fab7beeb17b655625f8096972b86e273 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 4 Feb 2016 17:19:51 +0100 Subject: [PATCH 158/394] Remove old and unused files. the folder may have contained useful stuff. Check history if needed. --- sha3/proof/.dir-locals.el | 2 +- sha3/proof/AbsorbSponge.ec | 56 ---- sha3/proof/AbsorbToBlocks.ec | 253 ------------------ sha3/proof/RndOrcl.eca | 385 --------------------------- sha3/proof/variant/LeakyAbsorb.ec | 416 ------------------------------ sha3/proof/variant/RndOrcl.eca | 385 --------------------------- 6 files changed, 1 insertion(+), 1496 deletions(-) delete mode 100644 sha3/proof/AbsorbSponge.ec delete mode 100644 sha3/proof/AbsorbToBlocks.ec delete mode 100644 sha3/proof/RndOrcl.eca delete mode 100644 sha3/proof/variant/LeakyAbsorb.ec delete mode 100644 sha3/proof/variant/RndOrcl.eca diff --git a/sha3/proof/.dir-locals.el b/sha3/proof/.dir-locals.el index e868573..a0bbb33 100644 --- a/sha3/proof/.dir-locals.el +++ b/sha3/proof/.dir-locals.el @@ -1,4 +1,4 @@ ((easycrypt-mode . ((eval . (flet ((pre (s) (concat (locate-dominating-file buffer-file-name ".dir-locals.el") s))) - (setq easycrypt-load-path `(,(pre ".") ,(pre "variant") ,(pre "core")))))))) + (setq easycrypt-load-path `(,(pre ".") ,(pre "core")))))))) diff --git a/sha3/proof/AbsorbSponge.ec b/sha3/proof/AbsorbSponge.ec deleted file mode 100644 index bdbbc80..0000000 --- a/sha3/proof/AbsorbSponge.ec +++ /dev/null @@ -1,56 +0,0 @@ -(* -------------------------------------------------------------------- *) -require import Option Pair Int Real List. -require (*--*) Common LazyRP RndOrcl Indifferentiability. - -op cast: 'a NewDistr.distr -> 'a distr. - -(* -------------------------------------------------------------------- *) -require import Common. - -(* -------------------------------------------------------------------- *) - -clone import RndOrcl as RO with - type from <- block list, - type to <- block, - op Ideal.sample (x : block list) <- cast bdistr. -clone import Ideal. (* ?? Nested abstract theories... we don't like them *) - -(* -------------------------------------------------------------------- *) -clone include Indifferentiability with - type p <- block * capacity, - type f_in <- block list, - type f_out <- block - - rename - [module] "Indif" as "Experiment" - [module] "GReal" as "RealIndif" - [module] "GIdeal" as "IdealIndif". - -(* -------------------------------------------------------------------- *) -module BlockSponge (P : DPRIMITIVE) : FUNCTIONALITY, CONSTRUCTION(P) = { - proc init() = {} - - proc f(p : block list): block = { - var (sa,sc) <- (b0, Capacity.c0); - - if (valid_absorb p) { - (* Absorption *) - while (p <> []) { - (sa,sc) <@ P.f(sa +^ head b0 p, sc); - p <- behead p; - } - } - return sa; - } -}. - -(* -------------------------------------------------------------------- *) -op eps : real. - -lemma top: - exists (S <: SIMULATOR), - forall (D <: DISTINGUISHER) &m, - `| Pr[Experiment(BlockSponge(Perm), Perm, D).main() @ &m : res] - - Pr[Experiment(RO, S(RO), D).main() @ &m : res]| - < eps. -proof. admit. qed. diff --git a/sha3/proof/AbsorbToBlocks.ec b/sha3/proof/AbsorbToBlocks.ec deleted file mode 100644 index d2c27a7..0000000 --- a/sha3/proof/AbsorbToBlocks.ec +++ /dev/null @@ -1,253 +0,0 @@ -(* -------------------------------------------------------------------- *) -require import Option Pair Int Real List FSet NewFMap. -require (*--*) AbsorbSponge BlockSponge. - -(* -------------------------------------------------------------------- *) -require import Common. - -op cast: 'a NewDistr.distr -> 'a distr. - -(* -------------------------------------------------------------------- *) -module LowerFun(F : Self.BlockSponge.DFUNCTIONALITY) : AbsorbSponge.DFUNCTIONALITY = { - proc init() = {} - - proc f(xs : block list) : block = { - var (ys, n) <- strip xs; - var zs <- []; - - if (valid_block ys) { - zs <@ F.f(ys, n + 1); - } - return last b0 zs; - } -}. - -module Sim (S : AbsorbSponge.SIMULATOR, F : Self.BlockSponge.DFUNCTIONALITY) = S(LowerFun(F)). - -module UpperFun (F : AbsorbSponge.DFUNCTIONALITY) = { - proc init() = {} - - proc f(xs : block list, n : int) : block list = { - var y <- b0; - var ys <- []; - var i <- 0; - - if (valid_block xs) { - while (i < n) { - y <@ F.f(extend xs i); - ys <- rcons ys y; - i <- i + 1; - } - } - return ys; - } -}. - -module BlocksOfAbsorbBlockSponge (P : Self.BlockSponge.DPRIMITIVE) = - UpperFun(AbsorbSponge.BlockSponge(P)). - -module Dist (D : Self.BlockSponge.DISTINGUISHER, F : AbsorbSponge.DFUNCTIONALITY) = D(UpperFun(F)). - -section. - declare module AbsorbSim : AbsorbSponge.SIMULATOR { Perm, Self.BlockSponge.BIRO.IRO', AbsorbSponge.Ideal.RO }. - declare module BlocksDist : Self.BlockSponge.DISTINGUISHER { Perm, Self.BlockSponge.BIRO.IRO', AbsorbSponge.Ideal.RO, AbsorbSim }. - - local equiv ModularBlocks_Real: - UpperFun(AbsorbSponge.BlockSponge(Perm)).f ~ Self.BlockSponge.Sponge(Perm).f: - ={arg} - /\ ={m,mi}(Perm,Perm) - /\ (forall x, mem (dom Perm.m){1} x) - ==> ={res} - /\ ={m,mi}(Perm,Perm) - /\ (forall x, mem (dom Perm.m){1} x). - proof. - proc. sp; if=> //=. - inline AbsorbSponge.BlockSponge(Perm).f. - admit. (* Fun with loops *) - qed. - - pred lower (ro : (block list,block) fmap) (iro : (block list * int,block) fmap) = - Self.BlockSponge.BIRO.prefix_closed iro /\ - forall x n, valid_block x => iro.[(x,n)] = ro.[extend x n]. - - local equiv ModularAbsorb: - UpperFun(AbsorbSponge.Ideal.RO).f ~ Self.BlockSponge.BIRO.IRO'.f: - ={arg} - /\ lower AbsorbSponge.Ideal.RO.m{1} Self.BlockSponge.BIRO.IRO'.mp{2} - ==> ={res} - /\ lower AbsorbSponge.Ideal.RO.m{1} Self.BlockSponge.BIRO.IRO'.mp{2}. - proof. - proc. sp; if=> //=. - inline AbsorbSponge.BlockSponge(Perm).f. - admit. (* Fun with loops *) - qed. - - pred upper (ro : (block list,block) fmap) (iro : (block list * int,block) fmap) = - (forall x y, valid_absorb x => ro.[x] = y => iro.[strip x] = y) - /\ (forall x n y, - valid_block x => - iro.[(x,n)] = Some y => - exists n', - n <= n' - /\ mem (dom ro) (extend x n')). - - module LowIRO' : AbsorbSponge.FUNCTIONALITY = { - proc init = Self.BlockSponge.BIRO.IRO'.init - proc f(xs : block list) = { - var b <- b0; - var (ys, n) = strip xs; - - if (valid_block ys) { - b <@ Self.BlockSponge.BIRO.IRO'.f_lazy(ys, n); - } - - return b; - } - }. - - pred holey_map (iro iro_lazy : (block list * int,block) fmap) = - Self.BlockSponge.BIRO.prefix_closed iro - /\ (forall xn, - mem (dom iro_lazy) xn => - iro_lazy.[xn] = iro.[xn]) - /\ (forall x n, - mem (dom iro) (x,n) => - exists n', - n <= n' - /\ mem (dom iro_lazy) (x,n')). - - (** Essentially, we can delay sampling every entry in the left map - whose index is not in the index of the right map, as they have - not ben given to the adversary. **) - local lemma LazifyIRO: - eager [Self.BlockSponge.BIRO.IRO'.resample_invisible(); , LowerFun(Self.BlockSponge.BIRO.IRO').f ~ LowIRO'.f, Self.BlockSponge.BIRO.IRO'.resample_invisible();: - ={arg, Self.BlockSponge.BIRO.IRO'.visible} - /\ holey_map Self.BlockSponge.BIRO.IRO'.mp{1} Self.BlockSponge.BIRO.IRO'.mp{2} - /\ Self.BlockSponge.BIRO.IRO'.visible{2} = dom (Self.BlockSponge.BIRO.IRO'.mp){2} - ==> ={res, Self.BlockSponge.BIRO.IRO'.visible} - /\ holey_map Self.BlockSponge.BIRO.IRO'.mp{1} Self.BlockSponge.BIRO.IRO'.mp{2} - /\ Self.BlockSponge.BIRO.IRO'.visible{2} = dom (Self.BlockSponge.BIRO.IRO'.mp){2}]. - proof. -(* - eager proc. - case (!valid_lower p{1})=> /=. - rcondf{1} 3; 1: by auto; inline *; auto; while (true); auto. - rcondf{2} 2; 1: by auto. - inline *; auto. - rcondf{2} 4; 1: by auto; smt. - while{1} ( work{1} <= dom (Blocks.BIRO.IRO'.mp){1} - /\ holey_map Blocks.BIRO.IRO'.mp{1} Blocks.BIRO.IRO'.mp{2} - /\ forall x, mem work{1} x => mem (dom Blocks.BIRO.IRO'.mp){1} x /\ !mem (dom Blocks.BIRO.IRO'.mp){2} x) - (card work{1}). - auto; progress. - + admit. (* TODO: dto lossless *) - + move=> x; rewrite domP in_fsetD in_fsetU !in_fset1. - by case (x = pick work{hr})=> //= _ /H1 [->]. - + smt. - + smt. - + have [_] [_] /(_ x1 n0 _) //= := H0. - move: H5; rewrite domP in_fsetU in_fset1=> -[//=|h]. - by have [->]:= H1 (x1,n0) _; first by rewrite h mem_pick // H2. - + move: H5; rewrite domP in_fsetD in_fsetU !in_fset1. - by case (x1 = pick work{hr})=> //= _ /H1 [->]. - + move: H5; rewrite in_fsetD in_fset1. - by case (x1 = pick work{hr})=> //= _ /H1 [_ ->]. - + smt. - by auto; smt. - rcondt{1} 3; 1: by auto; inline *; auto; while (true); auto. - rcondt{2} 2; 1: by auto. - inline Blocks.BIRO.IRO'.f Blocks.BIRO.IRO'.f_lazy. - rcondt{1} 8; 1: by auto; inline *; auto; while (true); auto; smt. - rcondt{2} 4; 1: by auto; smt. - case ((mem (dom Blocks.BIRO.IRO'.mp) (strip p)){1} /\ !(mem (dom Blocks.BIRO.IRO'.mp) (strip x)){2}). - admit. (* this is the bad case where we need to bring down the sampling from resample_invisible *) - inline{2} Blocks.BIRO.IRO'.resample_invisible. - rcondf{2} 9; 1: by auto; inline *; sp; if; auto; smt. - seq 1 0: ((((p{1} = x{2} /\ ={Blocks.BIRO.IRO'.visible}) /\ - holey_map Blocks.BIRO.IRO'.mp{1} Blocks.BIRO.IRO'.mp{2} /\ - Blocks.BIRO.IRO'.visible{2} = dom Blocks.BIRO.IRO'.mp{2}) /\ - valid_lower p{1}) /\ - ! (mem (dom Blocks.BIRO.IRO'.mp{1}) (strip p{1}) /\ - ! mem (dom Blocks.BIRO.IRO'.mp{2}) (strip x{2}))). (* disgusting copy-paste. we need seq* *) - admit. - splitwhile{1} 8: (i < n0 - 1). - rcondt{1} 9. - move=> &m; while (0 <= i < n0). - by inline*; sp; if; auto; smt. - by auto; smt. - rcondf{1} 12. - move=> &m; seq 8: (i = n0 - 1). - * wp; while (0 <= i < n0). - by inline*; sp; if; auto; smt. - by auto; smt. - * inline*; sp; if; auto; smt. - admit. (* just pushing the proof through *) -*) - admit. - qed. - - - (** This is an eager statement: - - on actual queries, the two maps agree; - - blocks in the IRO that are just generated on the way - to answering actual queries can be resampled. **) - (* AbsorbSponge.Ideal.RO.f ~ LowerFun(Blocks.BIRO.IRO).f: - ={arg} - /\ true - ==> ={res}. - *) - - lemma Intermediate &m: - `|Pr[Self.BlockSponge.RealIndif(Self.BlockSponge.Sponge,Perm,BlocksDist).main() @ &m :res] - - Pr[Self.BlockSponge.IdealIndif(Self.BlockSponge.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]| - = `|Pr[Self.BlockSponge.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] - - Pr[Self.BlockSponge.IdealIndif(UpperFun(AbsorbSponge.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res]|. - proof. - have ->: Pr[Self.BlockSponge.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] - = Pr[Self.BlockSponge.RealIndif(Self.BlockSponge.Sponge,Perm,BlocksDist).main() @ &m :res]. - byequiv=> //=; proc. - call (_: ={m,mi}(Perm,Perm) - /\ (forall x, mem (dom Perm.m){1} x)). - by proc; if; auto; smt. - by proc; if; auto; smt. - (* BUG: arg should be handled much earlier and automatically *) - by conseq ModularBlocks_Real=> //= &1 &2; case (arg{1}); case (arg{2})=> //=. - call (_: true - ==> ={glob Perm} - /\ (forall x, mem (dom Perm.m){1} x)). - admit. (* Do this with an eagerly sampled RP *) - (* Now the other initialization is dead code. *) - call (_: true ==> true)=> //. - by proc; auto. - have ->: Pr[Self.BlockSponge.IdealIndif(UpperFun(AbsorbSponge.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res] - = Pr[Self.BlockSponge.IdealIndif(Self.BlockSponge.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]. - byequiv=> //=; proc. - call (_: ={glob AbsorbSim} /\ lower AbsorbSponge.Ideal.RO.m{1} Self.BlockSponge.BIRO.IRO'.mp{2}). - proc (lower AbsorbSponge.Ideal.RO.m{1} Self.BlockSponge.BIRO.IRO'.mp{2})=> //=. - proc; sp; if=> //=. smt. - call ModularAbsorb; auto; smt. - proc (lower AbsorbSponge.Ideal.RO.m{1} Self.BlockSponge.BIRO.IRO'.mp{2})=> //=. - proc; sp; if=> //=. smt. - call ModularAbsorb; auto; smt. - (* Re-Bug *) - by conseq ModularAbsorb=> &1 &2; case (arg{1}); case (arg{2}). - inline *; wp;call (_: true)=> //=. - auto; progress [-split]; split=> //=. - admit. - done. - qed. - - lemma Remainder &m: - `|Pr[Self.BlockSponge.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] - - Pr[Self.BlockSponge.IdealIndif(UpperFun(AbsorbSponge.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res]| - = `|Pr[AbsorbSponge.RealIndif(AbsorbSponge.BlockSponge,Perm,Dist(BlocksDist)).main() @ &m: res] - - Pr[AbsorbSponge.IdealIndif(AbsorbSponge.Ideal.RO,AbsorbSim,Dist(BlocksDist)).main() @ &m: res]|. - proof. admit. qed. - - lemma Conclusion &m: - `|Pr[Self.BlockSponge.RealIndif(Self.BlockSponge.Sponge,Perm,BlocksDist).main() @ &m: res] - - Pr[Self.BlockSponge.IdealIndif(Self.BlockSponge.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]| - = `|Pr[AbsorbSponge.RealIndif(AbsorbSponge.BlockSponge,Perm,Dist(BlocksDist)).main() @ &m: res] - - Pr[AbsorbSponge.IdealIndif(AbsorbSponge.Ideal.RO,AbsorbSim,Dist(BlocksDist)).main() @ &m: res]|. - proof. by rewrite (Intermediate &m) (Remainder &m). qed. -end section. diff --git a/sha3/proof/RndOrcl.eca b/sha3/proof/RndOrcl.eca deleted file mode 100644 index 07fd6ba..0000000 --- a/sha3/proof/RndOrcl.eca +++ /dev/null @@ -1,385 +0,0 @@ -require import Option FSet NewFMap NewDistr. -(* TODO move this in NewFMap *) -lemma dom_set (m:('a,'b) fmap) a b : dom m.[a<-b] = dom m `|` fset1 a. -proof. by apply fsetP=> x;smt. qed. - -type from, to. - -module type RO = { - proc init() : unit - proc f(x : from): to -}. - -module type Distinguisher(G : RO) = { - proc distinguish(): bool {G.f} -}. - -module IND(G:RO, D:Distinguisher) = { - proc main(): bool = { - var b; - - G.init(); - b <@ D(G).distinguish(); - return b; - } -}. - -abstract theory Ideal. - - op sample : from -> to distr. - - module RO = { - var m : (from, to) fmap - - proc init() : unit = { - m <- map0; - } - - proc f(x : from) : to = { - var rd; - rd <$ sample x; - if (! mem (dom m) x) m.[x] <- rd; - return oget m.[x]; - } - }. - - section LL. - - axiom sample_ll : forall x, weight (sample x) = 1%r. - - lemma f_ll : phoare[RO.f : true ==> true] = 1%r. - proof. proc;auto;progress;apply sample_ll. qed. - - end section LL. - -end Ideal. - - -abstract theory GenIdeal. - - clone include Ideal. - axiom sample_ll : forall x, Distr.weight (sample x) = 1%r. - - op RO_dom : from fset. - - module ERO = { - proc sample() = { - var work; - work <- RO_dom; - while (work <> fset0) { - RO.f(pick work); - work = work `\` fset1 (pick work); - } - } - - proc init() = { - RO.m <- map0; - sample(); - } - - proc f = RO.f - }. - - module IND_S(D:Distinguisher) = { - proc main(): bool = { - var b; - RO.init(); - b <@ D(RO).distinguish(); - ERO.sample(); - return b; - } - }. - - section EAGER. - - local lemma eager_query: - eager [ERO.sample(); , RO.f ~ ERO.f, ERO.sample(); : - ={x,RO.m} ==> ={res,RO.m} ]. - proof. - eager proc. - inline ERO.sample;swap{2} 4 -3. - seq 1 1: (={x,work,RO.m});first by sim. - wp;case ((mem (dom RO.m) x){1}). - + rnd{1}. - alias{1} 1 mx = oget RO.m.[x]. - while (={work,RO.m} /\ (RO.m.[x] = Some mx){1}). - + by inline *;auto;progress;smt. - auto;progress [- split]; rewrite sample_ll H /=;smt. - case ((!mem work x){1}). - + swap{1} 2 -1;while (={work,x} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ - (!mem work x){1} /\ (RO.m.[x] = Some rd){2} /\ (!mem (dom RO.m) x){1}). - + inline *;auto;progress [-split]. - cut -> : mem (dom RO.m{2}) (pick work{2}) = mem (dom RO.m{1}) (pick work{2}) by rewrite !in_dom;smt. - smt. - auto;progress [-split];rewrite !getP_eq;smt. - inline RO.f. - transitivity{1} { rd <$ sample x; - while (work <> fset0) { - x0 <- pick work; - rd0 <$ sample x0; - if (!mem (dom RO.m) x0) - RO.m.[x0] <- if x0 = x then rd else rd0; - work <- work `\` fset1 (pick work); - } } - (={x,work,RO.m} ==> ={x,RO.m}) - ((={x,work,RO.m} /\ mem work{1} x{1}) /\ ! mem (dom RO.m{2}) x{2} ==> - ={x,RO.m} /\ (result = oget RO.m.[x]){2} /\ mem (dom RO.m{1}) x{1}) => //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. - + transitivity{1} { while (work <> fset0) { - x0 <- pick work; - rd0 <$ sample x0; - if (!mem (dom RO.m) x0) RO.m.[x0] <- rd0; - work <- work `\` fset1 (pick work); - } - rd <$ sample x; } - (={x,work,RO.m} ==> ={x,RO.m}) - (={x,work,RO.m} ==> ={x,RO.m})=> //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. - + by sim; rnd{2}; sim : (={x,IND_Eager.H.m}); smt. - symmetry; eager while (H: rd <$ sample x; ~ rd <$ sample x; : ={x} ==> ={rd})=> //; sim. - swap{2} 5 -4; swap [2..3] -1; case ((x = pick work){1}). - + by wp; rnd{2}; rnd; rnd{1}; wp; skip; smt. - by auto; smt. - + while (={x, work} /\ - (!mem work x => mem (dom RO.m) x){1} /\ - RO.m.[x]{2} = Some rd{1} /\ - if (mem (dom RO.m) x){1} then ={RO.m} - else eq_except RO.m{1} RO.m{2} (fset1 x{1})). - + auto;progress; 1..9,12:smt. - + case ((pick work = x){2})=> pick_x; last smt. - subst x{2}; move: H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. - by apply fmapP=> x0; case (pick work{2} = x0); smt. - by auto; smt w=@NewFMap. - by auto;progress [-split];rewrite H0 /= getP_eq;smt. - qed. - - equiv Eager_S (D <: Distinguisher{RO}): IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. - proof. - proc; inline ERO.init RO.init. - seq 1 1: (={glob D, RO.m});first by wp. - symmetry; eager (H: ERO.sample(); ~ ERO.sample();: ={RO.m} ==> ={RO.m}): - (={glob D, RO.m}) => //; first by sim. - eager proc H (={RO.m}) => //; [by apply eager_query | by sim]. - qed. - - equiv Eager (D <: Distinguisher{RO}): IND(RO,D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. - proof. - transitivity IND_S(D).main - (={glob D} ==> ={res,glob D}) - (={glob D} ==> ={res,RO.m,glob D}) => //. - + by progress;exists (glob D){2}. - + proc;inline{2} ERO.sample. - while{2} true (card work{2}). - + move=> &m1 z;wp;call (f_ll sample_ll);auto;smt. - conseq (_: _ ==> ={b,glob D}) => //;[smt | by sim]. - apply (Eager_S D). - qed. - - end section EAGER. - -end GenIdeal. - -abstract theory FiniteIdeal. - - clone include Ideal. - axiom sample_ll (x : from): Distr.weight (sample x) = 1%r. - - op univ : from fset. - axiom univP (x:from) : mem univ x. - - module ERO = { - proc sample() = { - var work; - work <- univ; - while (work <> fset0) { - RO.f(pick work); - work = work `\` fset1 (pick work); - } - } - - proc init() = { - RO.m <- map0; - sample(); - } - - proc f(x:from):to = { return oget RO.m.[x]; } - }. - - module IND_S(D:Distinguisher) = { - proc main(): bool = { - var b; - RO.init(); - b <@ D(RO).distinguish(); - ERO.sample(); - return b; - } - }. - - section EAGER. - - declare module D: Distinguisher { RO }. - - local clone GenIdeal as GI with - op sample <- sample, - op RO_dom <- univ - proof sample_ll by apply sample_ll. - - local equiv ERO_main: - IND(GI.ERO, D).main ~ IND(ERO, D).main : ={glob D} ==> ={res, glob D} /\ GI.RO.m{1} = RO.m{2}. - proof. - proc. - call (_:GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ). - + proc; rcondf{1} 2;auto;progress;[ by rewrite H univP | by apply sample_ll]. - inline *. - while (={work} /\ GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ `\` work{2});auto;smt. - qed. - - equiv Eager_S : IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. - proof. - transitivity GI.IND_S(D).main - (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) - (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. - + by progress;exists (glob D){2}. - + by sim. - transitivity IND(GI.ERO,D).main - (={glob D} ==> ={res,glob D, GI.RO.m}) - (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. - + by progress;exists (glob D){2}. - + by conseq (GI.Eager_S D). - by apply ERO_main. - qed. - - equiv Eager : IND(RO, D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. - proof. - transitivity IND(GI.RO,D).main - (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) - (={glob D} ==> ={res,glob D}) => //. - + by progress;exists (glob D){2}. - + by sim. - transitivity IND(GI.ERO,D).main - (={glob D} ==> ={res,glob D}) - (={glob D} ==> ={res,glob D}) => //. - + by progress;exists (glob D){2}. - + by conseq (GI.Eager D). - by conseq ERO_main. - qed. - - end section EAGER. - -end FiniteIdeal. - - -abstract theory RestrIdeal. - - clone include Ideal. - axiom sample_ll (x : from): Distr.weight (sample x) = 1%r. - - op test : from -> bool. - op univ : from fset. - op dfl : to. - - axiom testP x : test x <=> mem univ x. - - module Restr (O:RO) = { - proc init = RO.init - proc f (x:from) : to = { - var r <- dfl; - if (test x) r <@ RO.f(x); - return r; - } - }. - - module ERO = { - proc sample() = { - var work; - work <- univ; - while (work <> fset0) { - RO.f(pick work); - work = work `\` fset1 (pick work); - } - } - - proc init() = { - RO.m <- map0; - sample(); - } - - proc f(x:from):to = { - return (if test x then oget RO.m.[x] else dfl); - } - }. - - module IND_S(D:Distinguisher) = { - proc main(): bool = { - var b; - RO.init(); - b <@ D(Restr(RO)).distinguish(); - ERO.sample(); - return b; - } - }. - - section EAGER. - - declare module D: Distinguisher { RO }. - - local clone GenIdeal as GI with - op sample <- sample, - op RO_dom <- univ. - - local module Restr' (O:RO) = { - proc init() = { } - proc f(x:from) = { - var r <- dfl; - if (test x) r <@ O.f(x); - return r; - } - }. - - local module RD (O:RO) = D(Restr'(O)). - - local equiv ERO_main: - IND(GI.ERO, RD).main ~ IND(ERO, D).main : ={glob D} ==> ={res, glob D} /\ GI.RO.m{1} = RO.m{2}. - proof. - proc. - call (_:GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ). - + proc. - case (test x{1});[ rcondt{1} 2 | rcondf{1} 2];auto;last smt ml=0. - by inline *;rcondf{1} 4;auto;progress;2:(by apply sample_ll);rewrite ?H0 ?H -?testP. - inline *. - while (={work} /\ GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} `|` work{2} = univ);auto;1:progress; smt. - qed. - - equiv Eager_S : IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. - proof. - transitivity GI.IND_S(RD).main - (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) - (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. - + by progress;exists (glob D){2}. - + by sim. - transitivity IND(GI.ERO,RD).main - (={glob D} ==> ={res,glob D, GI.RO.m}) - (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. - + by progress;exists (glob D){2}. - + by conseq (GI.Eager_S RD). - by apply ERO_main. - qed. - - equiv Eager : IND(Restr(RO), D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. - proof. - transitivity IND(GI.RO,RD).main - (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) - (={glob D} ==> ={res,glob D}) => //. - + by progress;exists (glob D){2}. - + by sim. - transitivity IND(GI.ERO,RD).main - (={glob D} ==> ={res,glob D}) - (={glob D} ==> ={res,glob D}) => //. - + by progress;exists (glob D){2}. - + by conseq (GI.Eager RD). - by conseq ERO_main. - qed. - - end section EAGER. - -end RestrIdeal. \ No newline at end of file diff --git a/sha3/proof/variant/LeakyAbsorb.ec b/sha3/proof/variant/LeakyAbsorb.ec deleted file mode 100644 index 8f03201..0000000 --- a/sha3/proof/variant/LeakyAbsorb.ec +++ /dev/null @@ -1,416 +0,0 @@ -(* -------------------------------------------------------------------- *) -require import Option Pair Int Real Distr List FSet NewFMap DProd. -require (*--*) LazyRP RndOrcl. - -(* -------------------------------------------------------------------- *) - -type block. (* = {0,1}^r *) -type capacity. (* = {0,1}^c *) - -op cdist : capacity distr. -op bdist : block distr. -axiom bdist_ll : weight bdist = 1%r. - -(* isomorphic to the {0,1}^? uniform distributions *) - -op b0 : block. -op c0 : capacity. - -op (^) : block -> block -> block. - -(* -------------------------------------------------------------------- *) -clone import LazyRP as Perm with - type D <- block * capacity, - op d <- bdist `*` cdist - - rename [module] "P" as "Perm". - - -(* -------------------------------------------------------------------- *) -module type WeirdIRO = { - proc init(): unit - - proc f(_: block list * int): block list -}. - -module type WeirdIRO_ = { - proc f(_: block list * int): block list -}. - -op valid_query : block list -> int -> bool. -op valid_queries : (block list) fset. -axiom valid_queryP : forall m n, valid_query m n => forall k, 0 <= k <= n => mem valid_queries (m ++ mkseq (fun x => b0) k). -axiom valid_query_take : forall m n, valid_query m n => forall i, 0 <= i <= size m => mem valid_queries (take i m). -axiom valid_query_take1 : - forall m n, valid_query m n => forall i, 0 <= i <= size m => valid_query (take i m) 1. -axiom valid_query_size : forall m n, valid_query m n => 1 <= size m. - -module type RO = { - proc init () : unit - proc f(_:block list) : block -}. - -module Ro = { - var h : (block list,block) fmap - - proc init() = { h = map0; } - - proc f(m : block list) = { - var r; - r <$ bdist; - if (!mem (dom h) m) h.[m] <- r ; - return oget h.[m]; - } -}. - -module GenIdealFunctionalityThatDoesNotAbsorb(Ro:RO) = { - proc init = Ro.init - - proc f(m : block list, n : int) = { - var i <- 1; - var j <- 1; - var z <- []; - var b <- b0; - - if (valid_query m n) { - while (j <= size m) { - z <- rcons z b; - b <@ Ro.f(take j m); - j <- j + 1; - } - while (i < n) { - z <- rcons z b; - m <- rcons m b0; - b <@ Ro.f(m); - i <- i + 1; - } - } - return z; - } -}. - -module IdealFunctionalityThatDoesNotAbsorb = GenIdealFunctionalityThatDoesNotAbsorb(Ro). - -module GenIdealFunctionalityThatAbsorbs(Ro:RO) = { - proc init = Ro.init - - proc f(m : block list, n : int) = { - var i <- 1; - var z <- []; - var b; - - if (valid_query m n) { - b <@ Ro.f(m); - while (i < n) { - z <- rcons z b; - m <- rcons m b0; - b <@ Ro.f(m); - i<- i + 1; - } - } - return z; - } -}. - -module IdealFunctionalityThatAbsorbs = GenIdealFunctionalityThatAbsorbs(Ro). - -(* -------------------------------------------------------------------- *) -module type CONSTRUCTION(P : RP) = { - proc init() : unit - - proc f(bp : block list, n : int) : block list -}. - -module type SIMULATOR(F : WeirdIRO_) = { - proc init() : unit - - proc f(_ : block * capacity) : block * capacity - - proc fi(_ : block * capacity) : block * capacity -}. - -module type DISTINGUISHER(F : WeirdIRO_, P : RP_) = { - proc distinguish() : bool -}. - -(* -------------------------------------------------------------------- *) -module Experiment(F : WeirdIRO, P : RP, D : DISTINGUISHER) = { - proc main() : bool = { - var b; - - F.init(); - P.init(); - b <@ D(F, P).distinguish(); - - return b; - } -}. - -(* -------------------------------------------------------------------- *) -module SpongeThatDoesNotAbsorb (P : RP) : WeirdIRO, CONSTRUCTION(P) = { - proc init () = { } - - proc f(p : block list, n : int): block list = { - var z <- []; - var (sa,sc) <- (b0, c0); - var i <- 0; - var l <- size p; - - if (valid_query p n) { - (* Absorption *) - while (p <> []) { - z <- rcons z sa; - (sa,sc) <@ P.f(sa ^ head b0 p, sc); - p <- behead p; - } - (* Squeezing *) - while (i < n) { - z <- rcons z sa; - (sa,sc) <@ P.f(sa,sc); - } - } - - return z; - } -}. - -module SpongeThatAbsorbs (P : RP) : WeirdIRO, CONSTRUCTION(P) = { - proc init () = {} - - proc f(p : block list, n : int): block list = { - var z <- []; - var (sa,sc) <- (b0, c0); - var i <- 0; - - if (valid_query p n) { - (* Absorption *) - while (p <> []) { - (sa,sc) <@ P.f(sa ^ head b0 p, sc); - p <- behead p; - } - (* Squeezing *) - while (i < n) { - z <- rcons z sa; - (sa,sc) <@ P.f(sa,sc); - } - } - - return z; - } -}. - -(* -------------------------------------------------------------------- *) -section PROOF. - declare module S:SIMULATOR { IdealFunctionalityThatDoesNotAbsorb }. - declare module D:DISTINGUISHER { Perm, IdealFunctionalityThatDoesNotAbsorb, S }. - - (* From DoNot to Absorb *) - - module MkF(F:WeirdIRO_) = { - proc f(m:block list, n:int) = { - var r = []; - if (valid_query m n) { - r <@ F.f(m,n); - r <- drop (size m) r; - } - return r; - } - }. - - (* From Absord to do Not *) - module MkD (D:DISTINGUISHER, F:WeirdIRO_, P:RP_) = D(MkF(F),P). - - module MkFdoNot1 (F:WeirdIRO_) = { - proc f(m:block list, n:int) : block list = { - var i, r, tl, b; - r <- []; - if (valid_query m n) { - i <- 1; - b <- [b0]; - while (i <= size m) { - r <- r ++ b; - b <- F.f(take i m, 1); - i <- i + 1; - - } - tl <- F.f(m,n); - r <- r ++ tl; - } - return r; - } - }. - - module MkFdoNot (F:WeirdIRO) = { - proc init = F.init - proc f = MkFdoNot1(F).f - }. - - module MkS(S:SIMULATOR, F:WeirdIRO) = S(MkFdoNot(F)). - - local clone RndOrcl as RndOrcl0 with - type from <- block list, - type to <- block. - - local clone RndOrcl0.RestrIdeal as RI with - op sample <- fun (bl:block list) => bdist, - op test <- (mem valid_queries), - op univ <- valid_queries, - op dfl <- b0 - proof *. - realize sample_ll. by move=> _;apply bdist_ll. qed. - realize testP. by []. qed. - import RI. - - local module E1 (Ro:RO) = { - module F = { - proc f = GenIdealFunctionalityThatDoesNotAbsorb(Ro).f - } - module P = S(F) - proc distinguish () : bool = { - var b; - P.init(); - b <@ MkD(D, F, P).distinguish(); - return b; - } - }. - - local module E2 (Ro:RO) = { - module F = { - proc f = GenIdealFunctionalityThatAbsorbs(Ro).f - } - module P = S(MkFdoNot1(F)) - proc distinguish () : bool = { - var b; - P.init(); - b <@ D(F, P).distinguish(); - return b; - } - }. - - local equiv f_f : - GenIdealFunctionalityThatDoesNotAbsorb(Ro).f ~ E1(Restr(RO)).F.f : - ={m, n} /\ Ro.h{1} = RO.m{2} ==> ={res} /\ Ro.h{1} = RO.m{2}. - proof. - proc;sp;if => //. - inline{2} Restr(RO).f. - while (={z,i,n,b,m} /\ Ro.h{1} = RO.m{2} /\ - (forall k, 0 <= k <= n - i => mem valid_queries (m ++ map (fun x => b0) (iota_ 0 k))){2}). - + rcondt{2} 5=> //. - + auto;progress; rewrite - cats1;cut := H 1 _; [by smt| by rewrite iota1]. - auto; call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress]. - cut := H (k+1) _;1:by smt. - rewrite iotaS //= -cats1 -catA /= (_: map (fun (x : int) => b0) (iota_ 1 k) = map (fun (x : int) => b0) (iota_ 0 k)) //. - by rewrite (iota_addl 1 0 k) -map_comp;apply eq_map. - while (={z,j,n,b,m} /\ Ro.h{1} = RO.m{2} /\ valid_query m{1} n{1} /\ 0 <= j{1}). - + rcondt{2} 4=> //. - + auto;progress;apply (valid_query_take _ _ H)=> //. - auto; call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress;smt]. - skip;progress;apply (valid_queryP _ _ H2);smt. - qed. - - local equiv f_f_a : GenIdealFunctionalityThatAbsorbs(Ro).f ~ E2(Restr(RO)).F.f : ={m,n} /\ Ro.h{1} = RO.m{2} ==> ={res} /\ Ro.h{1} = RO.m{2}. - proof. - proc; sp;if=> //;inline{2} Restr(RO).f;sp. - rcondt{2} 1=> //. - + auto;progress;cut := valid_query_take _ _ H (size m{hr}). - rewrite take_size=> HH;apply HH;smt. - while (={z,i,n,b,m} /\ Ro.h{1} = RO.m{2} /\ - (forall k, 0 <= k <= n - i => mem valid_queries (m ++ map (fun x => b0) (iota_ 0 k))){2}). - + rcondt{2} 5=> //. - + auto;progress; rewrite -cats1;cut := H 1 _; [by smt| by rewrite iota1]. - auto; call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress]. - cut := H (k+1) _;1:by smt. - rewrite iotaS //= -cats1 -catA /= (_: map (fun (x : int) => b0) (iota_ 1 k) = map (fun (x : int) => b0) (iota_ 0 k)) //. - by rewrite (iota_addl 1 0 k) -map_comp;apply eq_map. - wp;call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress]. - apply (valid_queryP _ _ H);smt. - qed. - - local equiv f_f' : - MkFdoNot(GenIdealFunctionalityThatAbsorbs(Ro)).f ~ MkFdoNot1(E2(Restr(RO)).F).f : - ={m, n} /\ Ro.h{1} = RO.m{2} ==> - ={res} /\ Ro.h{1} = RO.m{2}. - proof. - proc;sp;if => //;wp. - call f_f_a. - while (={i,m,r,b} /\ Ro.h{1} = RO.m{2} /\ valid_query m{1} n{1} /\ 0 <= i{1});last by auto. - wp; call f_f_a;auto;progress;smt. - qed. - - local equiv f_dN : E1(ERO).F.f ~ MkFdoNot1(E2(ERO).F).f : ={m, n} /\ ={RO.m} ==> ={res, RO.m}. - proof. - proc;sp;if=> //;sp. - inline {2} E2(ERO).F.f. - rcondt{2} 6;auto; 1: by conseq (_: _ ==> true). - while (={RO.m} /\ z{1} = r{2} ++ z0{2} /\ i{1} = i1{2} /\ n{1} = n1{2} /\ b{1} = b1{2} /\ - m{1} = m1{2}). - + inline *;auto;progress;smt. - inline ERO.f;auto. - while (={RO.m,m,n} /\ z{1} = r{2} /\ b{2} = [b{1}] /\ valid_query m{1} n{1} /\ - j{1} = i{2} /\ 0 <= i{2} /\ - (1 < j => b = mem valid_queries (take j m) ? oget RO.m.[x] : Self.b0){1}). - + rcondt{2} 6;1:by auto;progress;smt. - rcondf{2} 8;1:by auto. - auto;progress;smt. - auto;progress;smt. - qed. - - lemma conclusion &m: - `| Pr[Experiment(SpongeThatDoesNotAbsorb(Perm), Perm, MkD(D)).main() @ &m : res] - - Pr[Experiment(IdealFunctionalityThatDoesNotAbsorb, - S(IdealFunctionalityThatDoesNotAbsorb), MkD(D)).main() @ &m : res] | = - `|Pr[Experiment(SpongeThatAbsorbs(Perm),Perm,D).main() @ &m : res] - - Pr[Experiment(IdealFunctionalityThatAbsorbs, MkS(S,IdealFunctionalityThatAbsorbs), D).main() @ &m : res]|. - proof. - do 3?congr. - + byequiv (_: ={glob D} ==> _) => //;proc;inline *. - call (_: ={glob Perm});1,2:(by sim); last by auto. - proc;inline{1}SpongeThatDoesNotAbsorb(Perm).f;sp 1 3;if=> //. - sp;rcondt{1} 1=> //;wp. - while (={glob Perm, i, sa, sc} /\ n0{1} = n{2} /\ z{1} = take (size m{1}) z{1} ++ z{2} /\ size m{1} <= size z{1}). - + call (_ : ={glob Perm});[by sim|auto;progress [-split];smt]. - while (={glob Perm, p, sa,sc} /\ (size z = size m - size p){1}). - + wp;call (_ : ={glob Perm});[by sim|auto;progress [-split]]. - by rewrite size_rcons H; move: H0; case: (p{2})=> //= x xs; ring. - by auto;progress [-split];smt. - cut -> : Pr[Experiment(IdealFunctionalityThatDoesNotAbsorb, S(IdealFunctionalityThatDoesNotAbsorb), MkD(D)).main () @ &m : res] = - Pr[RndOrcl0.IND(Restr(RO), E1).main() @ &m : res]. - + byequiv=> //. (* PY: BUG printer res *) - proc;inline{2} E1(Restr(RO)).distinguish;auto. - call (_: ={glob S} /\ Ro.h{1} = RO.m{2}). - + by proc (Ro.h{1} = RO.m{2}) => //;apply f_f. - + by proc (Ro.h{1} = RO.m{2}) => //;apply f_f. - + by proc;sp;if=> //;wp;call f_f. - by inline *; call (_: Ro.h{1} = RO.m{2});auto;apply f_f. - cut -> : Pr[Experiment(IdealFunctionalityThatAbsorbs, MkS(S, IdealFunctionalityThatAbsorbs), D).main() @ &m : res] = - Pr[RndOrcl0.IND(Restr(RO), E2).main() @ &m : res]. - + byequiv=> //. - proc;inline{2} E2(Restr(RO)).distinguish;auto. - call (_: ={glob S} /\ Ro.h{1} = RO.m{2}). - + proc (Ro.h{1} = RO.m{2}) => //; apply f_f'. - + by proc (Ro.h{1} = RO.m{2}) => //;apply f_f'. - + conseq f_f_a => //. - by inline *;call (_:Ro.h{1} = RO.m{2});[apply f_f'|auto]. - cut -> : Pr[RndOrcl0.IND(Restr(RO), E1).main() @ &m : res] = - Pr[RndOrcl0.IND(ERO, E1).main() @ &m : res]. - + byequiv (Eager E1)=> //. - cut -> : Pr[RndOrcl0.IND(Restr(RO), E2).main() @ &m : res] = - Pr[RndOrcl0.IND(ERO, E2).main() @ &m : res]. - + byequiv (Eager E2)=> //. - byequiv=> //. - proc; inline *;wp. - call (_: ={RO.m, glob S}). - + by proc (={RO.m})=> //;apply f_dN. - + by proc (={RO.m})=> //;apply f_dN. - + proc;sp;if => //. - inline{1} E1(ERO).F.f;sp;rcondt{1} 1; 1:by auto. - wp;while (={RO.m,i,b} /\ n0{1} = n{2} /\ m0{1} = m{2} /\ z{1} = take (size m{1}) z{1} ++ z{2} /\ (size m <= size z){1}). - + inline *;auto;progress [-split]; smt. - inline *;splitwhile{1} 1 : (j < size m0). - wp;seq 1 0 : (={i,RO.m, m, glob S} /\ n0{1} = n{2} /\ m0{1} = m{2} /\ size m0{1} - 1 = size z{1} /\ size m0{1} = j{1} /\ z{2} = []). - while{1} (size z{1} = j{1} - 1 /\ j{1} <= size m0{1}) ((size m0 - j){1});auto;progress [-split]; smt. - rcondt{1} 1;1:by auto. - rcondf{1} 5;auto;progress[-split];smt. - call (_: ={RO.m})=> //;1:by apply f_dN. - sim : (={glob S, glob D, RO.m})=> //. - qed. diff --git a/sha3/proof/variant/RndOrcl.eca b/sha3/proof/variant/RndOrcl.eca deleted file mode 100644 index 07fd6ba..0000000 --- a/sha3/proof/variant/RndOrcl.eca +++ /dev/null @@ -1,385 +0,0 @@ -require import Option FSet NewFMap NewDistr. -(* TODO move this in NewFMap *) -lemma dom_set (m:('a,'b) fmap) a b : dom m.[a<-b] = dom m `|` fset1 a. -proof. by apply fsetP=> x;smt. qed. - -type from, to. - -module type RO = { - proc init() : unit - proc f(x : from): to -}. - -module type Distinguisher(G : RO) = { - proc distinguish(): bool {G.f} -}. - -module IND(G:RO, D:Distinguisher) = { - proc main(): bool = { - var b; - - G.init(); - b <@ D(G).distinguish(); - return b; - } -}. - -abstract theory Ideal. - - op sample : from -> to distr. - - module RO = { - var m : (from, to) fmap - - proc init() : unit = { - m <- map0; - } - - proc f(x : from) : to = { - var rd; - rd <$ sample x; - if (! mem (dom m) x) m.[x] <- rd; - return oget m.[x]; - } - }. - - section LL. - - axiom sample_ll : forall x, weight (sample x) = 1%r. - - lemma f_ll : phoare[RO.f : true ==> true] = 1%r. - proof. proc;auto;progress;apply sample_ll. qed. - - end section LL. - -end Ideal. - - -abstract theory GenIdeal. - - clone include Ideal. - axiom sample_ll : forall x, Distr.weight (sample x) = 1%r. - - op RO_dom : from fset. - - module ERO = { - proc sample() = { - var work; - work <- RO_dom; - while (work <> fset0) { - RO.f(pick work); - work = work `\` fset1 (pick work); - } - } - - proc init() = { - RO.m <- map0; - sample(); - } - - proc f = RO.f - }. - - module IND_S(D:Distinguisher) = { - proc main(): bool = { - var b; - RO.init(); - b <@ D(RO).distinguish(); - ERO.sample(); - return b; - } - }. - - section EAGER. - - local lemma eager_query: - eager [ERO.sample(); , RO.f ~ ERO.f, ERO.sample(); : - ={x,RO.m} ==> ={res,RO.m} ]. - proof. - eager proc. - inline ERO.sample;swap{2} 4 -3. - seq 1 1: (={x,work,RO.m});first by sim. - wp;case ((mem (dom RO.m) x){1}). - + rnd{1}. - alias{1} 1 mx = oget RO.m.[x]. - while (={work,RO.m} /\ (RO.m.[x] = Some mx){1}). - + by inline *;auto;progress;smt. - auto;progress [- split]; rewrite sample_ll H /=;smt. - case ((!mem work x){1}). - + swap{1} 2 -1;while (={work,x} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ - (!mem work x){1} /\ (RO.m.[x] = Some rd){2} /\ (!mem (dom RO.m) x){1}). - + inline *;auto;progress [-split]. - cut -> : mem (dom RO.m{2}) (pick work{2}) = mem (dom RO.m{1}) (pick work{2}) by rewrite !in_dom;smt. - smt. - auto;progress [-split];rewrite !getP_eq;smt. - inline RO.f. - transitivity{1} { rd <$ sample x; - while (work <> fset0) { - x0 <- pick work; - rd0 <$ sample x0; - if (!mem (dom RO.m) x0) - RO.m.[x0] <- if x0 = x then rd else rd0; - work <- work `\` fset1 (pick work); - } } - (={x,work,RO.m} ==> ={x,RO.m}) - ((={x,work,RO.m} /\ mem work{1} x{1}) /\ ! mem (dom RO.m{2}) x{2} ==> - ={x,RO.m} /\ (result = oget RO.m.[x]){2} /\ mem (dom RO.m{1}) x{1}) => //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. - + transitivity{1} { while (work <> fset0) { - x0 <- pick work; - rd0 <$ sample x0; - if (!mem (dom RO.m) x0) RO.m.[x0] <- rd0; - work <- work `\` fset1 (pick work); - } - rd <$ sample x; } - (={x,work,RO.m} ==> ={x,RO.m}) - (={x,work,RO.m} ==> ={x,RO.m})=> //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. - + by sim; rnd{2}; sim : (={x,IND_Eager.H.m}); smt. - symmetry; eager while (H: rd <$ sample x; ~ rd <$ sample x; : ={x} ==> ={rd})=> //; sim. - swap{2} 5 -4; swap [2..3] -1; case ((x = pick work){1}). - + by wp; rnd{2}; rnd; rnd{1}; wp; skip; smt. - by auto; smt. - + while (={x, work} /\ - (!mem work x => mem (dom RO.m) x){1} /\ - RO.m.[x]{2} = Some rd{1} /\ - if (mem (dom RO.m) x){1} then ={RO.m} - else eq_except RO.m{1} RO.m{2} (fset1 x{1})). - + auto;progress; 1..9,12:smt. - + case ((pick work = x){2})=> pick_x; last smt. - subst x{2}; move: H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. - by apply fmapP=> x0; case (pick work{2} = x0); smt. - by auto; smt w=@NewFMap. - by auto;progress [-split];rewrite H0 /= getP_eq;smt. - qed. - - equiv Eager_S (D <: Distinguisher{RO}): IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. - proof. - proc; inline ERO.init RO.init. - seq 1 1: (={glob D, RO.m});first by wp. - symmetry; eager (H: ERO.sample(); ~ ERO.sample();: ={RO.m} ==> ={RO.m}): - (={glob D, RO.m}) => //; first by sim. - eager proc H (={RO.m}) => //; [by apply eager_query | by sim]. - qed. - - equiv Eager (D <: Distinguisher{RO}): IND(RO,D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. - proof. - transitivity IND_S(D).main - (={glob D} ==> ={res,glob D}) - (={glob D} ==> ={res,RO.m,glob D}) => //. - + by progress;exists (glob D){2}. - + proc;inline{2} ERO.sample. - while{2} true (card work{2}). - + move=> &m1 z;wp;call (f_ll sample_ll);auto;smt. - conseq (_: _ ==> ={b,glob D}) => //;[smt | by sim]. - apply (Eager_S D). - qed. - - end section EAGER. - -end GenIdeal. - -abstract theory FiniteIdeal. - - clone include Ideal. - axiom sample_ll (x : from): Distr.weight (sample x) = 1%r. - - op univ : from fset. - axiom univP (x:from) : mem univ x. - - module ERO = { - proc sample() = { - var work; - work <- univ; - while (work <> fset0) { - RO.f(pick work); - work = work `\` fset1 (pick work); - } - } - - proc init() = { - RO.m <- map0; - sample(); - } - - proc f(x:from):to = { return oget RO.m.[x]; } - }. - - module IND_S(D:Distinguisher) = { - proc main(): bool = { - var b; - RO.init(); - b <@ D(RO).distinguish(); - ERO.sample(); - return b; - } - }. - - section EAGER. - - declare module D: Distinguisher { RO }. - - local clone GenIdeal as GI with - op sample <- sample, - op RO_dom <- univ - proof sample_ll by apply sample_ll. - - local equiv ERO_main: - IND(GI.ERO, D).main ~ IND(ERO, D).main : ={glob D} ==> ={res, glob D} /\ GI.RO.m{1} = RO.m{2}. - proof. - proc. - call (_:GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ). - + proc; rcondf{1} 2;auto;progress;[ by rewrite H univP | by apply sample_ll]. - inline *. - while (={work} /\ GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ `\` work{2});auto;smt. - qed. - - equiv Eager_S : IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. - proof. - transitivity GI.IND_S(D).main - (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) - (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. - + by progress;exists (glob D){2}. - + by sim. - transitivity IND(GI.ERO,D).main - (={glob D} ==> ={res,glob D, GI.RO.m}) - (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. - + by progress;exists (glob D){2}. - + by conseq (GI.Eager_S D). - by apply ERO_main. - qed. - - equiv Eager : IND(RO, D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. - proof. - transitivity IND(GI.RO,D).main - (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) - (={glob D} ==> ={res,glob D}) => //. - + by progress;exists (glob D){2}. - + by sim. - transitivity IND(GI.ERO,D).main - (={glob D} ==> ={res,glob D}) - (={glob D} ==> ={res,glob D}) => //. - + by progress;exists (glob D){2}. - + by conseq (GI.Eager D). - by conseq ERO_main. - qed. - - end section EAGER. - -end FiniteIdeal. - - -abstract theory RestrIdeal. - - clone include Ideal. - axiom sample_ll (x : from): Distr.weight (sample x) = 1%r. - - op test : from -> bool. - op univ : from fset. - op dfl : to. - - axiom testP x : test x <=> mem univ x. - - module Restr (O:RO) = { - proc init = RO.init - proc f (x:from) : to = { - var r <- dfl; - if (test x) r <@ RO.f(x); - return r; - } - }. - - module ERO = { - proc sample() = { - var work; - work <- univ; - while (work <> fset0) { - RO.f(pick work); - work = work `\` fset1 (pick work); - } - } - - proc init() = { - RO.m <- map0; - sample(); - } - - proc f(x:from):to = { - return (if test x then oget RO.m.[x] else dfl); - } - }. - - module IND_S(D:Distinguisher) = { - proc main(): bool = { - var b; - RO.init(); - b <@ D(Restr(RO)).distinguish(); - ERO.sample(); - return b; - } - }. - - section EAGER. - - declare module D: Distinguisher { RO }. - - local clone GenIdeal as GI with - op sample <- sample, - op RO_dom <- univ. - - local module Restr' (O:RO) = { - proc init() = { } - proc f(x:from) = { - var r <- dfl; - if (test x) r <@ O.f(x); - return r; - } - }. - - local module RD (O:RO) = D(Restr'(O)). - - local equiv ERO_main: - IND(GI.ERO, RD).main ~ IND(ERO, D).main : ={glob D} ==> ={res, glob D} /\ GI.RO.m{1} = RO.m{2}. - proof. - proc. - call (_:GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ). - + proc. - case (test x{1});[ rcondt{1} 2 | rcondf{1} 2];auto;last smt ml=0. - by inline *;rcondf{1} 4;auto;progress;2:(by apply sample_ll);rewrite ?H0 ?H -?testP. - inline *. - while (={work} /\ GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} `|` work{2} = univ);auto;1:progress; smt. - qed. - - equiv Eager_S : IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. - proof. - transitivity GI.IND_S(RD).main - (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) - (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. - + by progress;exists (glob D){2}. - + by sim. - transitivity IND(GI.ERO,RD).main - (={glob D} ==> ={res,glob D, GI.RO.m}) - (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. - + by progress;exists (glob D){2}. - + by conseq (GI.Eager_S RD). - by apply ERO_main. - qed. - - equiv Eager : IND(Restr(RO), D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. - proof. - transitivity IND(GI.RO,RD).main - (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) - (={glob D} ==> ={res,glob D}) => //. - + by progress;exists (glob D){2}. - + by sim. - transitivity IND(GI.ERO,RD).main - (={glob D} ==> ={res,glob D}) - (={glob D} ==> ={res,glob D}) => //. - + by progress;exists (glob D){2}. - + by conseq (GI.Eager RD). - by conseq ERO_main. - qed. - - end section EAGER. - -end RestrIdeal. \ No newline at end of file From b03640ba77c623018f4db2f6a6e1bdf80e89560d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 4 Feb 2016 17:21:47 +0100 Subject: [PATCH 159/394] One more obsolete file. --- sha3/proof/core/NBRO.eca | 155 --------------------------------------- 1 file changed, 155 deletions(-) delete mode 100644 sha3/proof/core/NBRO.eca diff --git a/sha3/proof/core/NBRO.eca b/sha3/proof/core/NBRO.eca deleted file mode 100644 index e744ecb..0000000 --- a/sha3/proof/core/NBRO.eca +++ /dev/null @@ -1,155 +0,0 @@ -require import Option Int Real List FSet NewFMap. -require RndOrcl Indifferentiability. - -type p. - -type from. - -type block. -op dblock : block distr. -axiom dblock_ll: Distr.weight dblock = 1%r. - -op univ : (from * int) fset. -op test : from * int -> bool. -op dfl : block. - -clone RndOrcl as ROB with - type from <- from * int, - type to <- block. - -clone include ROB.RestrIdeal with - op sample <- fun (x:from*int) => dblock, - op dfl <- dfl, - op univ <- univ, - op test <- test - proof sample_ll by apply dblock_ll. - -(* axiom testP (x:from * int): test x <=> mem univ x. *) -axiom test_neg (x:from) (n:int): n < 0 => !test (x,n). -axiom test_le (x:from) (n p:int) : 0 <= p <= n => test (x,n) => test (x,p). - -clone import Indifferentiability as IndB with - type p <- p, - type f_in <- from * int, - type f_out <- block. - -clone import Indifferentiability as IndNB with - type p <- p, - type f_in <- from * int, - type f_out <- block list. - -module RONB (Ob:IndB.FUNCTIONALITY) = { - proc init = Ob.init - - proc f(x:from, n:int) : block list = { - var b, bs; - bs <- []; - while (size bs < n) { - b <@ Ob.f(x,size bs); - bs <- rcons bs b; - } - return bs; - } -}. - -module DNB(D:IndNB.DISTINGUISHER, F:IndB.FUNCTIONALITY, P:IndB.PRIMITIVE) = { - proc distinguish = D(RONB(F), P).distinguish -}. - -module CNB (C: IndB.CONSTRUCTION, P:IndB.PRIMITIVE) = RONB(C(P)). - -module FNB_B(F:IndNB.FUNCTIONALITY) = { - proc init () = {} - - proc f(x:from,n:int) : block = { - var bs; - bs <@ F.f(x,n+1); - return nth dfl bs n; - } -}. - -module SNB(S:IndB.SIMULATOR, F:IndNB.FUNCTIONALITY) = { - - proc init = S(FNB_B(F)).init - - proc f = S(FNB_B(F)).f - proc fi = S(FNB_B(F)).fi -}. - -section PROOF. - - declare module P:IndB.PRIMITIVE. - declare module C:IndB.CONSTRUCTION {P}. - declare module S:IndB.SIMULATOR {RO}. - - declare module D: IndNB.DISTINGUISHER {P, RO, S, C}. - - local equiv equivReal: IndNB.GReal(CNB(C), P, D).main ~ IndB.GReal(C, P, DNB(D)).main: - ={glob P, glob C, glob D} ==> - ={glob P, glob C, glob D,res}. - proof. proc;inline *; sim. qed. - - local module DRO (O:ROB.RO) = { - proc distinguish () : bool = { - var b; - SNB(S, RONB(O)).init(); - b <@ D(RONB(O), SNB(S, RONB(O))).distinguish(); - return b; - } - }. - - local module DNB'(O:ROB.RO) : ROB.Distinguisher(O)= { - proc distinguish () : bool = { - var b; - S(O).init(); - b <@ DNB(D, O, S(O)).distinguish(); - return b; - } - }. - - local equiv feq : - FNB_B(RONB(ERO)).f ~ ERO.f : (x, n){1} = x{2} /\ ={RO.m} ==> ={res, RO.m}. - proof. - proc;inline *;wp. - while{1} ((0 <= n0 => size bs0 <= n0){1} /\ forall i, 0 <= i < size bs0{1} => - nth dfl bs0{1} i = - if test (x0{1},i) - then oget RO.m{1}.[(x0{1},i)] - else dfl) ((n0 - size bs0){1}). - + move=> &m2 z;auto;progress [-split]. - rewrite size_rcons;split;2:smt ml=0;split;1:smt ml=0. - move=> i [Hi0 Hi1];rewrite nth_rcons. - case (i < size bs0{hr})=> Hi';first by apply H0. - by cut -> : i = size bs0{hr} by smt ml=0. - auto;progress;1,2: smt ml=0. - case (n{1} < 0)=> Hn. - + by rewrite nth_neg // test_neg. - apply H1=> {H1} //;smt ml=0. - qed. - - lemma conclusion &m: - `|Pr[IndNB.GReal(CNB(C), P, D).main()@ &m:res] - Pr[IndNB.GIdeal(RONB(Restr(RO)), SNB(S), D).main()@ &m:res] | = - `|Pr[IndB.GReal(C, P, DNB(D)).main()@ &m:res] - Pr[IndB.GIdeal(Restr(RO),S,DNB(D)).main()@ &m:res] |. - proof. - cut -> : Pr[IndNB.GReal(CNB(C), P, D).main()@ &m:res] = Pr[IndB.GReal(C, P, DNB(D)).main()@ &m:res]. - + byequiv equivReal=> //. - cut -> : Pr[GIdeal(RONB(Restr(RO)), SNB(S), D).main() @ &m : res] = - Pr[ROB.IND(Restr(RO), DRO).main() @ &m : res]. - + by byequiv=> //; proc;inline *;swap{1} 1 1;sim. - cut -> : Pr[ROB.IND(Restr(RO), DRO).main() @ &m : res] = - Pr[ROB.IND(ERO,DRO).main () @ &m : res]. - + by byequiv (Eager DRO)=> //. - do 2! congr. - cut -> : Pr[IndB.GIdeal(Restr(RO), S, DNB(D)).main() @ &m : res] = - Pr[ROB.IND(Restr(RO), DNB').main() @ &m : res]. - + by byequiv=> //; proc;inline *;swap{1} 1 1;sim. - cut -> : Pr[ROB.IND(Restr(RO), DNB').main() @ &m : res] = - Pr[ROB.IND(ERO, DNB').main() @ &m : res]. - + by byequiv (Eager DNB')=> //. - byequiv=> //;proc;inline DRO(ERO).distinguish DNB'(ERO).distinguish;wp. - call (_: ={RO.m, glob S});1,2:by proc (={RO.m}) => //;apply feq. - + sim. - by conseq (_: _ ==> ={glob S, glob D, RO.m})=> //;sim. - qed. - -end section PROOF. From 03d5a3c76565672de5d6b68e278ef9aeb8c714c7 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 4 Feb 2016 12:16:36 -0500 Subject: [PATCH 160/394] Merged RP and LazyRP => RP. There's an unrestricted smt left in RP.ec, because of the goal: d_ll: is_lossless dt d_fu: support dt = predT &m: memory h : exists (x : t), ! mem (rng P.m{m}) x ------------------------------------------------------------------------ mu dt (mem (rng P.m{m})) < 1%r After a quick look, I'm not seeing what combination of distribution lemmas says that if the support of a distribution d is all of a type t and some element of t doesn't satisfy a predicate P, that mu d P < 1. --- sha3/proof/Common.ec | 8 ++--- sha3/proof/LazyRP.eca | 56 --------------------------------- sha3/proof/RP.eca | 72 +++++++++++++++++++++++++++++++++---------- 3 files changed, 59 insertions(+), 77 deletions(-) delete mode 100644 sha3/proof/LazyRP.eca diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index dea1847..c4ff7ee 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -2,7 +2,7 @@ require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. require import Ring StdRing StdOrder StdBigop BitEncoding DProd. -require (*--*) FinType BitWord LazyRP Monoid. +require (*--*) FinType BitWord RP Monoid. (*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv. require import NewLogic. @@ -95,9 +95,9 @@ qed. (*------------------------------ Primitive -----------------------------*) -clone export LazyRP as Perm with - type D <- block * capacity, - op d <- bdistr `*` Capacity.cdistr +clone export RP as Perm with + type t <- block * capacity, + op dt <- bdistr `*` Capacity.cdistr rename [module type] "RP" as "PRIMITIVE" [module] "P" as "Perm". diff --git a/sha3/proof/LazyRP.eca b/sha3/proof/LazyRP.eca deleted file mode 100644 index b262f0d..0000000 --- a/sha3/proof/LazyRP.eca +++ /dev/null @@ -1,56 +0,0 @@ -require import Option Real FSet NewFMap Distr. -require import Dexcepted. -require (*..*) RP. - -type D. -op d: D distr. - -clone include RP with - type from <- D, - type to <- D. - -module P : RP, RP_ = { - var m : (D, D) fmap - var mi: (D, D) fmap - - proc init() = { m = map0; mi = map0; } - - proc f(x) = { - var y; - - if (!mem (dom m) x) { - y <$ d \ (mem (rng m)); - m.[x] <- y; - mi.[y] <- x; - } - return oget m.[x]; - } - - proc fi(x) = { - var y; - - if (!mem (dom mi) x) { - y <$ d \ (mem (rng mi)); - mi.[x] <- y; - m.[y] <- x; - } - return oget mi.[x]; - } -}. - -lemma P_init_ll: islossless P.init. -proof. by proc; auto. qed. - -lemma P_f_ll: is_lossless d => support d = predT => islossless P.f. -proof. -move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. -have h:= endo_dom_rng P.m{m} _; first by exists x{m}. -apply/dexcepted_ll=> //; smt. (* needs help *) -qed. - -lemma P_fi_ll: is_lossless d => support d = predT => islossless P.fi. -proof. -move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. -have h:= endo_dom_rng P.mi{m} _; first by exists x{m}. -apply/dexcepted_ll=> //; smt. (* needs help *) -qed. diff --git a/sha3/proof/RP.eca b/sha3/proof/RP.eca index eafe094..8f28a87 100644 --- a/sha3/proof/RP.eca +++ b/sha3/proof/RP.eca @@ -1,26 +1,64 @@ -type from, to. +(*************************- Random Permutation -*************************) + +require import Option Real FSet NewFMap Distr. +require import Dexcepted. + +type t. +op dt : t distr. module type RP = { - proc init() : unit - proc f (x : from): to - proc fi(x : to ): from + proc init() : unit + proc f(x : t) : t + proc fi(x : t) : t }. -module type RP_ = { - proc f (x : from): to - proc fi(x : to ): from +module type DRP = { + proc f(x : t) : t + proc fi(x : t) : t }. -module type Distinguisher(G : RP_) = { - proc distinguish(): bool -}. +module P : RP, DRP = { + var m : (t, t) fmap + var mi : (t, t) fmap + + proc init() = { m = map0; mi = map0; } + + proc f(x) = { + var y; -module IND(G:RP, D:Distinguisher) = { - proc main(): bool = { - var b; + if (! mem (dom m) x) { + y <$ dt \ (mem (rng m)); + m.[x] <- y; + mi.[y] <- x; + } + return oget m.[x]; + } - G.init(); - b <@ D(G).distinguish(); - return b; - } + proc fi(x) = { + var y; + + if (! mem (dom mi) x) { + y <$ dt \ (mem (rng mi)); + mi.[x] <- y; + m.[y] <- x; + } + return oget mi.[x]; + } }. + +lemma P_init_ll: islossless P.init. +proof. by proc; auto. qed. + +lemma P_f_ll: is_lossless dt => support dt = predT => islossless P.f. +proof. +move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. +have h:= endo_dom_rng P.m{m} _; first by exists x{m}. +apply/dexcepted_ll=> //; smt. (* needs help *) +qed. + +lemma P_fi_ll: is_lossless dt => support dt = predT => islossless P.fi. +proof. +move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. +have h:= endo_dom_rng P.mi{m} _; first by exists x{m}. +apply/dexcepted_ll=> //; smt. (* needs help *) +qed. From 19ce06f625170e8740e2d5ce5d0541a04bad7a84 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 4 Feb 2016 20:15:50 -0500 Subject: [PATCH 161/394] Removing unrestricted smt. Maybe the following lemma would be useful addition to EC Library, as it works well with dexcepted_ll? lemma mu_except ['a] (d : 'a distr, y : 'a, P : 'a -> bool) : is_lossless d => support d = predT => ! P y => mu d P < 1%r. (Francois just used this logic in IdealPRP.ec; as he says, maybe we should be using that instead of RP.ec.) --- sha3/proof/RP.eca | 27 ++++++++++++++++++++++----- 1 file changed, 22 insertions(+), 5 deletions(-) diff --git a/sha3/proof/RP.eca b/sha3/proof/RP.eca index 8f28a87..6c0bf1d 100644 --- a/sha3/proof/RP.eca +++ b/sha3/proof/RP.eca @@ -1,7 +1,8 @@ (*************************- Random Permutation -*************************) require import Option Real FSet NewFMap Distr. -require import Dexcepted. +require import Dexcepted StdOrder. import RealOrder. +require import Ring StdRing. import RField. type t. op dt : t distr. @@ -49,16 +50,32 @@ module P : RP, DRP = { lemma P_init_ll: islossless P.init. proof. by proc; auto. qed. +(* maybe a useful standard lemma? *) + +lemma mu_except ['a] (d : 'a distr, y : 'a, P : 'a -> bool) : + is_lossless d => support d = predT => ! P y => mu d P < 1%r. +proof. +move=> d_ll supp_d_all notP_y. +have splitP : mu d P + mu d (predC P) = 1%r + by rewrite -d_ll (mu_split d predT P) mu_not mu_and. +have -> : mu d P = 1%r - mu d (predC P) by rewrite -splitP #ring. +rewrite ltr_subl_addl addrC -(ltr_add2l (-1%r)) addrA /=. +rewrite (ltr_le_trans (mu d (pred1 y))) 1:witness_support. +exists y; split=> //. +by rewrite -/(support d y) supp_d_all. +by rewrite mu_sub=> z @/pred1. +qed. + lemma P_f_ll: is_lossless dt => support dt = predT => islossless P.f. proof. move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. -have h:= endo_dom_rng P.m{m} _; first by exists x{m}. -apply/dexcepted_ll=> //; smt. (* needs help *) +have [y not_mem_y_rng_m] := endo_dom_rng P.m{m} _; first by exists x{m}. +by apply /dexcepted_ll /(mu_except dt y (mem (rng P.m{m}))). qed. lemma P_fi_ll: is_lossless dt => support dt = predT => islossless P.fi. proof. move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. -have h:= endo_dom_rng P.mi{m} _; first by exists x{m}. -apply/dexcepted_ll=> //; smt. (* needs help *) +have [y not_mem_y_rng_mi] := endo_dom_rng P.mi{m} _; first by exists x{m}. +by apply /dexcepted_ll /(mu_except dt y (mem (rng P.mi{m}))). qed. From 057ef7e8ea1700eb6b3d587823a658e816e09712 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 4 Feb 2016 22:26:58 -0500 Subject: [PATCH 162/394] Shortening of proof. --- sha3/proof/RP.eca | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/sha3/proof/RP.eca b/sha3/proof/RP.eca index 6c0bf1d..0edf05e 100644 --- a/sha3/proof/RP.eca +++ b/sha3/proof/RP.eca @@ -56,13 +56,11 @@ lemma mu_except ['a] (d : 'a distr, y : 'a, P : 'a -> bool) : is_lossless d => support d = predT => ! P y => mu d P < 1%r. proof. move=> d_ll supp_d_all notP_y. -have splitP : mu d P + mu d (predC P) = 1%r - by rewrite -d_ll (mu_split d predT P) mu_not mu_and. -have -> : mu d P = 1%r - mu d (predC P) by rewrite -splitP #ring. +have -> : mu d P = 1%r - mu d (predC P) + by rewrite -d_ll (mu_split d predT P) mu_not mu_and #ring. rewrite ltr_subl_addl addrC -(ltr_add2l (-1%r)) addrA /=. rewrite (ltr_le_trans (mu d (pred1 y))) 1:witness_support. -exists y; split=> //. -by rewrite -/(support d y) supp_d_all. +exists y; split=> //; by rewrite -/(support d y) supp_d_all. by rewrite mu_sub=> z @/pred1. qed. From 729eb292026f8d99ba54e52590f839f2e4435734 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 5 Feb 2016 00:31:27 -0500 Subject: [PATCH 163/394] Simplified statement of lemma mu_except ['a] (d : 'a distr, y : 'a, P : 'a -> bool) : in_supp y d => ! P y => mu d P < mu d predT. And simplified use of it. --- sha3/proof/RP.eca | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/sha3/proof/RP.eca b/sha3/proof/RP.eca index 0edf05e..a943a7e 100644 --- a/sha3/proof/RP.eca +++ b/sha3/proof/RP.eca @@ -3,6 +3,7 @@ require import Option Real FSet NewFMap Distr. require import Dexcepted StdOrder. import RealOrder. require import Ring StdRing. import RField. +require Monoid. import AddMonoid. type t. op dt : t distr. @@ -53,27 +54,26 @@ proof. by proc; auto. qed. (* maybe a useful standard lemma? *) lemma mu_except ['a] (d : 'a distr, y : 'a, P : 'a -> bool) : - is_lossless d => support d = predT => ! P y => mu d P < 1%r. + in_supp y d => ! P y => mu d P < mu d predT. proof. -move=> d_ll supp_d_all notP_y. -have -> : mu d P = 1%r - mu d (predC P) - by rewrite -d_ll (mu_split d predT P) mu_not mu_and #ring. -rewrite ltr_subl_addl addrC -(ltr_add2l (-1%r)) addrA /=. -rewrite (ltr_le_trans (mu d (pred1 y))) 1:witness_support. -exists y; split=> //; by rewrite -/(support d y) supp_d_all. -by rewrite mu_sub=> z @/pred1. +move=> in_supp_yd notP_y. +have -> : mu d P = mu d predT - mu d (predC P) + by rewrite (mu_split d predT P) mu_not mu_and #ring. +rewrite ltr_subl_addl (ltr_le_trans (mu d (pred1 y) + mu d predT)). +by rewrite -(add0r (mu _ _)) 1:ltr_le_add. +by rewrite ler_add mu_sub /pred1; first move=> ?. qed. lemma P_f_ll: is_lossless dt => support dt = predT => islossless P.f. proof. move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. have [y not_mem_y_rng_m] := endo_dom_rng P.m{m} _; first by exists x{m}. -by apply /dexcepted_ll /(mu_except dt y (mem (rng P.m{m}))). +by rewrite dexcepted_ll // -d_ll (mu_except dt y) -/(support _ _) 1:d_fu. qed. lemma P_fi_ll: is_lossless dt => support dt = predT => islossless P.fi. proof. move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. have [y not_mem_y_rng_mi] := endo_dom_rng P.mi{m} _; first by exists x{m}. -by apply /dexcepted_ll /(mu_except dt y (mem (rng P.mi{m}))). +by rewrite dexcepted_ll // -d_ll (mu_except dt y) -/(support _ _) 1:d_fu. qed. From 3f8dec469e8d853461f9ef411f81f1e3a930ec81 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 19 Feb 2016 16:12:45 -0500 Subject: [PATCH 164/394] Updating top-level scripts to Benjamin's new parameterized module syntax. I haven't updated the files in the "core" subdirectory, several of which are now failing to parse. --- sha3/proof/BlockSponge.ec | 2 +- sha3/proof/Sponge.ec | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/sha3/proof/BlockSponge.ec b/sha3/proof/BlockSponge.ec index 2a0b693..08219e5 100644 --- a/sha3/proof/BlockSponge.ec +++ b/sha3/proof/BlockSponge.ec @@ -26,7 +26,7 @@ clone import IRO as BIRO with (*------------------------- Sponge Construction ------------------------*) -module Sponge (P : DPRIMITIVE) : FUNCTIONALITY, CONSTRUCTION(P) = { +module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { proc init() = {} proc f(xs : block list, n : int) : block list = { diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index de71e97..4610d80 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -26,7 +26,7 @@ clone import IRO as BIRO with (*------------------------- Sponge Construction ------------------------*) -module Sponge (P : DPRIMITIVE) : FUNCTIONALITY, CONSTRUCTION(P) = { +module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { proc init() : unit = {} proc f(bs : bool list, n : int) : bool list = { @@ -798,7 +798,7 @@ by conseq IRO_RaiseHybridIRO_HybridIROLazy_f. auto. qed. -local module HybridIRODist(HI : HYBRID_IRO) : HYBRID_IRO_DIST (HI) = { +local module (HybridIRODist : HYBRID_IRO_DIST) (HI : HYBRID_IRO) = { proc distinguish() : bool = { var b : bool; BlockSim(HI).init(); From 0243f3ac5f3bbf75b28e5e0b08bba67d09751a09 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 24 Feb 2016 17:44:52 +0100 Subject: [PATCH 165/394] Module definitions to type-check. New and improved functor system really helped with debugging. --- sha3/proof/core/ConcreteF.eca | 2 +- sha3/proof/core/IndifPadding.ec | 9 +++------ 2 files changed, 4 insertions(+), 7 deletions(-) diff --git a/sha3/proof/core/ConcreteF.eca b/sha3/proof/core/ConcreteF.eca index b357211..7f8bc18 100644 --- a/sha3/proof/core/ConcreteF.eca +++ b/sha3/proof/core/ConcreteF.eca @@ -74,7 +74,7 @@ section. lemma size_behead (l : 'a list) : l <> [] => size (behead l) = size l - 1. proof. by case l=> // ?? /=; ring. qed. - local module D'(P' : PRPt.Oracles): PRPt.Distinguisher(P') = { + local module (D': PRPt.Distinguisher) (P' : PRPt.Oracles) = { proc distinguish = DRestr(D,SqueezelessSponge(P'),P').distinguish }. diff --git a/sha3/proof/core/IndifPadding.ec b/sha3/proof/core/IndifPadding.ec index cf80091..192ca69 100644 --- a/sha3/proof/core/IndifPadding.ec +++ b/sha3/proof/core/IndifPadding.ec @@ -21,7 +21,7 @@ clone import LazyRO as RO2 type to <- Ind1.f_out, op d <- RO1.d. -module ConstrPad (FC:Ind1.CONSTRUCTION, P:Ind1.PRIMITIVE) = { +module ConstrPad (FC:Ind1.CONSTRUCTION, P:Ind1.DPRIMITIVE) = { module C = FC(P) proc init = C.init @@ -33,10 +33,8 @@ module ConstrPad (FC:Ind1.CONSTRUCTION, P:Ind1.PRIMITIVE) = { } }. -module DistPad(FD: Ind2.DISTINGUISHER, F:Ind1.FUNCTIONALITY, P:Ind1.PRIMITIVE) = { +module DistPad(FD: Ind2.DISTINGUISHER, F:Ind1.DFUNCTIONALITY, P:Ind1.DPRIMITIVE) = { module Fpad = { - proc init = F.init - proc f(x:Ind2.f_in) : f_out = { var r; r = F.f(pad x); @@ -47,9 +45,8 @@ module DistPad(FD: Ind2.DISTINGUISHER, F:Ind1.FUNCTIONALITY, P:Ind1.PRIMITIVE) = proc distinguish = FD(Fpad,P).distinguish }. -module SimPadinv(S:Ind1.SIMULATOR, F2:Ind2.FUNCTIONALITY) = { +module SimPadinv(S:Ind1.SIMULATOR, F2:Ind2.DFUNCTIONALITY) = { module F1 = { - proc init = F2.init proc f(x:Ind1.f_in):Ind1.f_out = { var r; r = F2.f(padinv x); From 1e8608d252ab3821fae518803595cc811fac8360 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 25 Feb 2016 16:52:53 +0100 Subject: [PATCH 166/394] fix proof due to change in few --- sha3/proof/core/Gext.eca | 44 +++++++++++++++++----------------------- 1 file changed, 19 insertions(+), 25 deletions(-) diff --git a/sha3/proof/core/Gext.eca b/sha3/proof/core/Gext.eca index ec98425..24c5bab 100644 --- a/sha3/proof/core/Gext.eca +++ b/sha3/proof/core/Gext.eca @@ -618,34 +618,28 @@ section EXT. + 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. - case ((size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size)); - [rcondt 2 | rcondf 2];1,3:by auto. - + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi)));skip=> &hr[#]?->/=???. - rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr})) cdistr (1%r/(2^c)%r))//. - + move=>x _;apply DWord.muxP. - apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU fcardU le_fromint. - move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). - rewrite -!sizeE;smt w=fcard_ge0. - by hoare=>[??|];[apply eps_ge0|auto]. - + by move=>c1;proc;auto=> &hr [^H 2->]/#. - by move=> b1 c1;proc;auto=> &hr [^H 2->]. - + proc. - case ((size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size)); - [rcondt 2 | rcondf 2]; 1,3:by auto. - + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi ) `|` fset1 x));skip=> &hr[#]?->/=???. - rewrite (Mu_mem.mu_mem + + proc;rcondt 2;1:by auto. + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi ) `|` fset1 x));skip=> /> &hr ?? -> /= ??. + rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr} `|` dom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. - + move=>x _;apply DWord.muxP. - apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU !fcardU le_fromint fcard1. - move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). - rewrite -!sizeE;smt w=fcard_ge0. - by hoare=>[??|];[apply eps_ge0|auto]. + + by move=>x _;apply DWord.muxP. + apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. + rewrite imageU !fcardU le_fromint fcard1. + move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). + by rewrite -!sizeE;smt w=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 (dom G1.m `|` dom G1.mi)));skip=> /> &hr ??-> /= ??. + rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr})) cdistr (1%r/(2^c)%r))//. + + by move=>x _;apply DWord.muxP. + apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. + rewrite imageU fcardU le_fromint. + move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). + by rewrite -!sizeE;smt w=fcard_ge0. + by move=>c1;proc;auto=> &hr [^H 2->]/#. - by move=> b1 c1;proc;auto=> &hr [^H 2->]. + move=> b1 c1;proc;auto=> /#. qed. axiom D_ll: From 43501cccf717f213c1c6606c8770d274b347a0a3 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 11 Mar 2016 10:13:07 -0500 Subject: [PATCH 167/394] Using new [smt(...)] shorthand :-) --- sha3/proof/Common.ec | 18 +++++++------- sha3/proof/IRO.eca | 2 +- sha3/proof/Sponge.ec | 56 ++++++++++++++++++++++---------------------- 3 files changed, 38 insertions(+), 38 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index c4ff7ee..a5e452a 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -106,7 +106,7 @@ clone export RP as Perm with lemma needed_blocks0 : (0 + r - 1) %/ r = 0. proof. -rewrite -divz_eq0 1:gt0_r; smt ml=0 w=(gt0_r). +rewrite -divz_eq0 1:gt0_r; smt(gt0_r). qed. lemma needed_blocks_non_pos (n : int) : @@ -115,7 +115,7 @@ 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 ml=0 w=(gt0_r). + by rewrite -divz_eq0 1:gt0_r; smt(gt0_r). qed. lemma needed_blocks_suff (n : int) : @@ -145,7 +145,7 @@ 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 ml=0 w=(gt0_r). +smt(gt0_r). qed. lemma needed_blocks_eq_div_r (n : int) : @@ -192,7 +192,7 @@ have [m [-> [ge0_m lt_mr]]] : 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 ml=0. +have not_eq_dvd : n %/ r <> (n + r - 1) %/ r by smt(). by rewrite needed_blocks_eq_div_r. qed. @@ -637,7 +637,7 @@ rewrite -(@cat_take_drop (size s %/ r * r) s) -!catA -/tke -/drp 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 ml=0. + have {1}-> : r = n + 1 by smt(). rewrite modzDmr. have -> : size drp + 1 + (n + 1) = size drp + n + 2 by ring. by rewrite -dvdzE. @@ -655,11 +655,11 @@ rewrite xs_eq (@catA drp [true]) bits2blocks_cat 1:size_cat // 1:size_cat 1:size_nseq /= 1:max_ler 1:ge0_n /#. rewrite tolistK 1:size_cat //= cats1 last_rcons. rewrite n_eq_r_min1 tolistK 1:size_cat //= size_nseq max_ler /#. -have lt_n_r_min1 : n < r - 1 by smt ml=0. +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 ml=0. + 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. @@ -680,7 +680,7 @@ by rewrite tolistK 1:!size_cat /= 1:size_nseq 1:max_ler 1:ge0_n 1:-sz_drp_plus_n_plus_2_eq_r 1:#ring -!catA cat1s. have sz_w2b_x_eq_r : size(w2bits x) = r by apply size_tolist. rewrite w2b_x_eq !size_cat /= size_nseq max_ler // in sz_w2b_x_eq_r. -have lt_nr : n < r by smt ml=0 w=(size_ge0). +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. @@ -694,7 +694,7 @@ have w2bits_y_eq : w2bits y = take (r - 1) (w2bits y) ++ [true]. by rewrite -drop_w2b_y_last size_tolist. apply (@ValidBlock xs (blocks2bits ys ++ (take (r - 1) (w2bits y))) (r - 1)). -smt ml=0 w=(ge2_r). +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. diff --git a/sha3/proof/IRO.eca b/sha3/proof/IRO.eca index 1519b1d..e957130 100644 --- a/sha3/proof/IRO.eca +++ b/sha3/proof/IRO.eca @@ -30,7 +30,7 @@ pred prefix_closed' (m : (from * int,to) fmap) = mem (dom m) (x,i). lemma prefix_closed_equiv m: prefix_closed m <=> prefix_closed' m. -proof. smt ml=0. qed. +proof. smt(). qed. (* official version: *) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 4610d80..d5a929a 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -273,10 +273,10 @@ proof. proc; inline ERO.LRO.sample; sp=> /=. if=> //. while{2} (true) (m{2} - i{2}). -progress; auto; progress; smt ml=0. +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 ml=0. +auto; progress; smt(). qed. local lemma HybridIROLazy_HIRO_LRO_f : @@ -421,7 +421,7 @@ move=> LI; split=> [mem_upd_mp1 | mem_upd_mp2]. rewrite domP in_fsetU1; rewrite domP in_fsetU1 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 ml=0. +left; smt(). rewrite domP in_fsetU1; rewrite domP in_fsetU1 in mem_upd_mp2. case: ((cs, m) = (bs, n))=> [// | cs_m_neq_bs_n]. elim mem_upd_mp2=> [/# | [p2b_cs_p2b_bs eq_mn]]. @@ -453,14 +453,14 @@ lemma lazy_invar_upd_lu_eq proof. move=> LI mem_upd_mp1. case: ((cs, m) = (bs, n))=> [[->->] | cs_m_neq_bs_n]. -smt ml=0 w=(getP_eq). +smt(getP_eq). rewrite domP in_fsetU1 in mem_upd_mp1. elim mem_upd_mp1=> [mem_mp1 | [->->]]. case: ((pad2blocks bs, n) = (pad2blocks cs, m))=> [[p2b_bs_p2b_cs eq_mn] | p2b_bs_n_neq_p2b_cs_m]. -smt ml=0 w=(pad2blocks_inj). -smt ml=0 w=(getP). -smt ml=0 w=(getP). +smt(pad2blocks_inj). +smt(getP). +smt(getP). qed. lemma LowerFun_IRO_HybridIROLazy_f : @@ -489,7 +489,7 @@ while pad2blocks x{1} = xs0{2}). sp; auto. if. -progress; smt ml=0. +progress; smt(). rnd; auto; progress; [by rewrite !getP_eq | by rewrite -(@lazy_invar_upd_mem_dom_iff IRO.mp{1}) | @@ -497,7 +497,7 @@ rnd; auto; progress; by rewrite (@lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} x{1} xs2 i{2} n2 mpL) | by rewrite (@lazy_invar_upd_lu_eq IRO.mp{1} HybridIROLazy.mp{2})]. -auto; progress; smt ml=0. +auto; progress; smt(). auto. rcondf{1} 3; first auto. rcondf{2} 4; first auto. auto; progress; by rewrite bits2blocks_nil. @@ -521,7 +521,7 @@ while LazyInvar IRO.mp{1} HybridIROLazy.mp{2}). wp; sp. if. -progress; smt ml=0. +progress; smt(). rnd; auto; progress; [by rewrite !getP_eq | by rewrite -(@lazy_invar_upd_mem_dom_iff IRO.mp{1}) | @@ -529,7 +529,7 @@ rnd; auto; progress; by rewrite (@lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} x{1} xs1 i{2} n1 mpL) | by rewrite (@lazy_invar_upd_lu_eq IRO.mp{1} HybridIROLazy.mp{2})]. -auto; progress; smt ml=0. +auto; progress; smt(). auto. qed. @@ -592,13 +592,13 @@ seq 3 2 : auto; progress. if=> //. case: (n1 < 0). -rcondf{1} 1; first auto; progress; smt ml=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. auto; progress; - [by rewrite blocks2bits_nil | by smt ml=0 w=(needed_blocks0)]. + [by rewrite blocks2bits_nil | by smt(needed_blocks0)]. (* 0 <= n1 *) conseq (_ : @@ -609,9 +609,9 @@ conseq bs{1} = take n1 (blocks2bits bs{2}) /\ size bs{2} = (n1 + r - 1) %/ r /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). -progress; [smt ml=0 | apply/needed_blocks_suff]. +progress; [smt() | apply/needed_blocks_suff]. move=> |> &1 &2 ? ? ? mp1 mp2 bs ? ? ?; - smt ml=0 w=(size_eq0 needed_blocks0 take0). + smt(size_eq0 needed_blocks0 take0). splitwhile{1} 1 : i < (n1 %/ r) * r. splitwhile{2} 1 : i < n1 %/ r. seq 1 1 : @@ -630,9 +630,9 @@ conseq _). progress; by apply/needed_blocks_rel_div_r. case: (i{2} = n{2}). -rcondf{2} 1; first auto; progress; smt ml=0. -rcondf{1} 1; first auto; progress; smt ml=0. -rcondf{1} 1; first auto; progress; smt ml=0. +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 -> : n{1} = size (blocks2bits bs{2}) @@ -640,9 +640,9 @@ have -> : n{1} = size (blocks2bits bs{2}) by rewrite take_size. by rewrite sz_eq need_blks_eq. (* i{2} <> n{2}, so i{2} + 1 = n{2} *) -rcondt{2} 1; first auto; progress; smt ml=0. +rcondt{2} 1; first auto; progress; smt(). rcondf{2} 4; first auto; call (_ : true). -if=> //. auto; progress; smt ml=0. +if=> //. auto; progress; smt(). wp; exists* i{1}; elim*=> i1; exists* bs{2}; elim*=> bs2. conseq (_ : @@ -652,15 +652,15 @@ conseq EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs2 ++ take (n1 - i1) (w2bits b{2}) /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). -progress; smt ml=0. +progress; smt(). move=> |> &1 &2 ? ? sz_eq ? ? ? mp1 mp2 b ?. split. rewrite -cats1 blocks2bits_cat blocks2bits_sing take_cat. have -> /= : !(n{1} < size(blocks2bits bs{2})). rewrite size_blocks2bits sz_eq. - by smt ml=0 w=(needed_blocks_correct). -by rewrite size_blocks2bits sz_eq; congr; congr; smt ml=0. -by rewrite size_rcons; smt ml=0. + by smt(needed_blocks_correct). +by rewrite size_blocks2bits sz_eq; congr; congr; smt(). +by rewrite size_rcons; smt(). admit. qed. @@ -692,8 +692,8 @@ 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]. -smt ml=0. -have gt0_n1 : 0 < n{1} by smt ml=0. +smt(). +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 @@ -765,8 +765,8 @@ auto=> |> &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{2} <= 0)=> [le0_n2 | not_le0_n2]. -smt ml=0. -have gt0_n2 : 0 < n{2} by smt ml=0. +smt(). +have gt0_n2 : 0 < n{2} by smt(). by have [-> _] := gt0_n2_imp gt0_n2. have [-> ->] := not_vb_imp not_vb; by rewrite blocks2bits_nil. qed. From c91238e36a9d158a2036355b6f9ac22a9ce26f77 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 27 Jun 2016 17:53:59 +0100 Subject: [PATCH 168/394] Updating proof scripts to reflect library changes. --- sha3/proof/Common.ec | 81 +++++++++++++++++------------------ sha3/proof/RndO.ec | 36 ++++++++-------- sha3/proof/Sponge.ec | 6 +-- sha3/proof/core/ConcreteF.eca | 2 +- sha3/proof/core/Gcol.eca | 2 +- sha3/proof/core/Gconcl.ec | 4 +- sha3/proof/core/Gext.eca | 16 +++---- sha3/proof/core/SLCommon.ec | 2 +- 8 files changed, 74 insertions(+), 75 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index a5e452a..f19f6fb 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -28,7 +28,8 @@ clone BitWord as Capacity with op n <- c proof gt0_n by apply/gt0_c - rename "dword" as "cdistr" + rename "word" as "cap" + "dword" as "cdistr" "zerow" as "c0". clone export BitWord as Block with @@ -36,7 +37,8 @@ clone export BitWord as Block with op n <- r proof gt0_n by apply/gt0_r - rename "dword" as "bdistr" + rename "word" as "block" + "dword" as "bdistr" "zerow" as "b0". (* ------------------------- Auxiliary Lemmas ------------------------- *) @@ -67,19 +69,16 @@ 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 b0 : b0 = bits2w(nseq r false). +lemma b0 : b0 = mkblock (nseq r false). proof. -rewrite wordP=> i ge0_i_ltr; rewrite offunifE ge0_i_ltr /= getE ge0_i_ltr /=. -rewrite ofwordK 1:Array.size_mkarray 1:size_nseq 1:/#. -by rewrite Array.getE Array.ofarrayK nth_nseq. +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 => bits2w cs = bits2w ds <=> cs = ds. -proof. -rewrite -!Array.size_mkarray=> s_cs_r s_ds_r; split=> //=. -by move=> @/bits2w /(mkword_pinj _ _ s_cs_r s_ds_r) /Array.mkarray_inj. -qed. + 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]. @@ -234,14 +233,14 @@ 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 max_ler. -by rewrite modz_ge0 gtr_eqF ?gt0_r. by ring. +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 modNz 1:/# 1:gt0_r -(@addrA _ 2) /= modzE #ring. +by rewrite /num0 modNz 1:/# 1:gt0_r -(@addrA _ 2) /= modzE #ring. qed. lemma size_padE (s : bool list) : @@ -259,16 +258,16 @@ lemma dvd_r_num0 (m : int) : r %| (m + num0 m + 2). proof. by rewrite /num0 /(%|) addrAC modzDmr subrr mod0z. qed. lemma num0_ge0 (m : int) : 0 <= num0 m. -proof. by rewrite modz_ge0 ?gtr_eqF ?gt0_r. qed. +proof. by rewrite /num0 modz_ge0 ?gtr_eqF ?gt0_r. qed. lemma num0_ltr (m : int) : num0 m < r. -proof. by rewrite ltz_pmod gt0_r. qed. +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 max_ler // modz_ge0 gtr_eqF ?gt0_r. +by rewrite max_ler // /num0 modz_ge0 gtr_eqF ?gt0_r. qed. lemma padE (s : bool list, n : int) : @@ -376,12 +375,12 @@ proof. by apply/BitChunking.flattenK/gt0_r. qed. (*--------------- Converting Between Block Lists and Bits --------------*) -op blocks2bits (xs:block list) : bool list = flatten (map w2bits xs). +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] = w2bits x. +lemma blocks2bits_sing (x : block) : blocks2bits [x] = ofblock x. proof. by rewrite /blocks2bits /flatten /= cats0. qed. lemma blocks2bits_cat (xs ys : block list) : @@ -393,19 +392,19 @@ lemma size_blocks2bits (xs : block list) : proof. elim: xs=> [| x xs ih]; first by rewrite blocks2bits_nil. rewrite -cat1s blocks2bits_cat blocks2bits_sing size_cat //. -rewrite size_cat size_tolist ih /= #ring. +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 bits2w (chunk xs). +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 = [bits2w xs]. + 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 => @@ -418,9 +417,9 @@ qed. lemma blocks2bitsK : cancel blocks2bits bits2blocks. proof. move=> xs; rewrite /blocks2bits /bits2blocks flattenK. - by move=> b /mapP [x [_ ->]];rewrite size_tolist. + by move=> b /mapP [x [_ ->]];rewrite size_block. rewrite -map_comp -{2}(@map_id xs) /(\o) /=. -by apply eq_map=> @/idfun x /=; apply oflistK. +by apply eq_map=> @/idfun x /=; exact/mkblockK. qed. lemma bits2blocksK (bs : bool list) : @@ -430,9 +429,9 @@ 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 (w2bits \o bits2w) xss = xss. + map (ofblock \o mkblock) xss = xss. + elim=> [// | xs yss ih eqr_sz /=]; split. - by apply tolistK; rewrite eqr_sz. + 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. @@ -575,7 +574,7 @@ rewrite drop_xs last_xs_eq_b0 b0 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 tolistK + by rewrite xs_take_drop blocks2bits_cat blocks2bits_sing ofblockK 1:size_nseq 1:max_ler 1:ge0_r // last_cat last_nseq 1:gt0_r. by rewrite last_b2b_xs_true in last_b2b_xs_false. @@ -585,11 +584,11 @@ 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) - & (w2bits x = s ++ [true] ++ nseq n false ++ [true]) + & (ofblock x = s ++ [true] ++ nseq n false ++ [true]) | ValidBlockStruct2 (ys : block list, y z : block) of (xs = ys ++ [y; z]) - & (last false (w2bits y)) - & (w2bits z = nseq (r - 1) false ++ [true]). + & (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. @@ -647,14 +646,14 @@ have sz_drp_plus1_eq_r : size drp + 1 = r. 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) - (bits2w (drp ++ [true])) (bits2w (nseq n false ++ [true]))). + (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:max_ler 1:ge0_n /= 1:/# (@bits2blocks_sing (drp ++ [true])) 1:size_cat // (@bits2blocks_sing (nseq n false ++ [true])) 1:size_cat 1:size_nseq /= 1:max_ler 1:ge0_n /#. -rewrite tolistK 1:size_cat //= cats1 last_rcons. -rewrite n_eq_r_min1 tolistK 1:size_cat //= size_nseq max_ler /#. +rewrite ofblockK 1:size_cat //= cats1 last_rcons. +rewrite n_eq_r_min1 ofblockK 1:size_cat //= size_nseq max_ler /#. 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. @@ -674,25 +673,25 @@ rewrite (@bits2blocks_sing + have -> : size s %% r + (1 + (n + 1)) = size s %%r + n + 2 by ring. + by rewrite -sz_drp. apply (@ValidBlockStruct1 xs (bits2blocks tke) - (bits2w(drp ++ ([true] ++ (nseq n false ++ [true])))) + (mkblock (drp ++ ([true] ++ (nseq n false ++ [true])))) drp n)=> //. -by rewrite tolistK 1:!size_cat /= 1:size_nseq 1:max_ler 1:ge0_n +by rewrite ofblockK 1:!size_cat /= 1:size_nseq 1:max_ler 1:ge0_n 1:-sz_drp_plus_n_plus_2_eq_r 1:#ring -!catA cat1s. -have sz_w2b_x_eq_r : size(w2bits x) = r by apply size_tolist. +have sz_w2b_x_eq_r : size (ofblock x) = r by apply size_block. rewrite w2b_x_eq !size_cat /= size_nseq max_ler // 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 : w2bits y = take (r - 1) (w2bits y) ++ [true]. - rewrite -{1}(@cat_take_drop (r - 1) (w2bits y)); congr. - elim (last_drop_all_but_last false (w2bits y))=> +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 (w2bits y) by rewrite w2b_y_nil. + 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_tolist. -apply (@ValidBlock xs (blocks2bits ys ++ (take (r - 1) (w2bits y))) + 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. diff --git a/sha3/proof/RndO.ec b/sha3/proof/RndO.ec index 367870b..7036303 100644 --- a/sha3/proof/RndO.ec +++ b/sha3/proof/RndO.ec @@ -330,9 +330,9 @@ proof. qed. equiv I_f_eqex x1 mx1 mx2: RRO.I.f ~ RRO.I.f : - ={x} /\ x1 <> x{1} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x1) /\ + ={x} /\ x1 <> x{1} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x1) /\ FRO.m{1}.[x1] = mx1 /\ FRO.m{2}.[x1] = mx2 ==> - eq_except FRO.m{1} FRO.m{2} (fset1 x1) /\ + eq_except FRO.m{1} FRO.m{2} (pred1 x1) /\ FRO.m{1}.[x1] = mx1 /\ FRO.m{2}.[x1] = mx2. proof. by proc;auto=>?&mr[#]->Hneq Heq/= Heq1 Heq2?->/=;rewrite !getP Hneq eq_except_set. @@ -365,7 +365,7 @@ proof. (={x,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown ==> ={x,FRO.m}) (={x,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown==> - ={x} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + ={x} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ FRO.m{1}.[x{2}] = Some (result{2},Unknown) /\ FRO.m{2}.[x{2}] = Some (result{2},Known)). + by move=>?&mr[#]-> -> ??;exists FRO.m{mr}, x{mr}=>/#. @@ -377,7 +377,7 @@ proof. skip=> &1 &2 [[->> ->>]] [Hdom Hm];split=>//=. by apply /perm_eq_sym/perm_to_rem/dom_restr;rewrite /in_dom_with Hdom Hm. inline Iter(RRO.I).iter_1s RRO.I.f RRO.resample. - seq 5 3 : (={x} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + seq 5 3 : (={x} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ (l =elems(dom (restr Unknown FRO.m) `\` fset1 x)){1} /\ FRO.m{1}.[x{2}] = Some (result{2}, Unknown) /\ FRO.m{2}.[x{2}] = Some (result{2}, Known)). @@ -385,7 +385,7 @@ proof. by rewrite !getP /=oget_some !restr_set/= dom_set set2_eq_except fsetDK. exists*x{1}, FRO.m{1}.[x{2}], FRO.m{2}.[x{2}];elim*=>x1 mx1 mx2. call (iter_inv RRO.I (fun z=>x1<>z) - (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) + (fun o1 o2 => eq_except o1 o2 (pred1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[#]4->^H->->^H1->^H2->/=;split. + congr;rewrite fsetP=>z;rewrite !inE !dom_restr /in_dom_with !in_dom; smt. by move=>x;rewrite -memE in_fsetD1 eq_sym. @@ -409,7 +409,7 @@ proof. (={x,y,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown ==> ={x,y,FRO.m}) (={x,y,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown==> - ={x,y} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + ={x,y} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ FRO.m{2}.[x{2}] = Some (y{2},Known)). + by move=>?&mr[#]2->???;exists FRO.m{mr}, y{mr}, x{mr}=>/#. + move=>?&m&mr[#]<*>[#]2->Hex Hm2. @@ -417,18 +417,18 @@ proof. + symmetry;call (iter1_perm RRO.I iter_perm2);auto=>?&mr[#]3-> Hdom Hm;split=>//=. by apply /perm_eq_sym/perm_to_rem/dom_restr;rewrite /in_dom_with Hdom. inline{1}Iter(RRO.I).iter_1s. - seq 3 1: (={x,y} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + seq 3 1: (={x,y} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ l{1} = (elems (dom (restr Unknown FRO.m))){2} /\ !mem l{1} x{1} /\ (FRO.m.[x]=Some(y, Known)){2}). + inline *;auto=>?&mr[#]3->/=Hmem Hget;rewrite sampleto_ll=>?_. by rewrite set2_eq_except getP_eq restr_set /= dom_rem -memE !inE negb_and. exists* x{1},y{1},(FRO.m.[x]{1});elim*=>x1 y1 mx1;pose mx2:=Some(y1,Known). call (iter_inv RRO.I (fun z=>x1<>z) - (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) + (fun o1 o2 => eq_except o1 o2 (pred1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[#]-><-2!->->>2!->Hmem->/#. exists* x{1},y{1},(FRO.m.[x]{1});elim*=>x1 y1 mx1;pose mx2:=Some(y1,Known). call (iter_inv RRO.I (fun z=>x1<>z) - (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) + (fun o1 o2 => eq_except o1 o2 (pred1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[#]-><-2!->->>->/= Hidm. rewrite restr_set getP_eq/mx2 eq_except_sym set_eq_except/=;split;[split|]. + by congr;apply fsetP=>z;rewrite !(dom_rem,inE,dom_restr) /#. @@ -452,30 +452,30 @@ proof. + symmetry;call (iter1_perm RRO.I iter_perm2);skip=>?&mr[#]2!->?/=;split=>//. by apply /perm_eq_sym/perm_to_rem/dom_restr. inline{1}Iter(RRO.I).iter_1s. - seq 3 1: (={x} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + seq 3 1: (={x} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ l{1} = (elems (dom (restr Unknown FRO.m))){2} /\ !mem l{1} x{1} /\ (FRO.m.[x]=None){2}). + inline *;auto=>??[#]2->Hidm/=;rewrite sampleto_ll=>?_. - rewrite eq_except_rem 1:!inE 2:set_eq_except // remP -memE in_fsetD1 negb_and /=. + rewrite eq_except_rem 2:set_eq_except // remP -memE in_fsetD1 negb_and /=. by rewrite restr_rem Hidm /= dom_rem. exists* x{1},(FRO.m.[x]{1});elim*=>x1 mx1. call (iter_inv RRO.I (fun z=>x1<>z) - (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=None) _). + (fun o1 o2 => eq_except o1 o2 (pred1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=None) _). + by conseq (I_f_eqex x1 mx1 None). auto=>?&mr[#]3->^Hex 2!->Hmem ^Hx->/=;split=>[/#|_ mL mR[#]/eq_exceptP Hex'?Heq]. apply fmapP=>z;rewrite remP;case (z=x{mr})=>[->/=|Hneq];1:by rewrite Heq. - by apply Hex';rewrite inE. + by apply Hex'. inline RRO.resample;wp. exists *x{1},(FRO.m.[x]{1});elim*=>x1 mx1. call (iter_inv RRO.I (fun z=>x1<>z) - (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=None) _). + (fun o1 o2 => eq_except o1 o2 (pred1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=None) _). + by conseq (I_f_eqex x1 mx1 None). auto=>?&mr[#]4->Hin/=. - rewrite restr_rem Hin/= remP eq_except_rem 1:inE // 1:eq_except_refl /=;split. + rewrite restr_rem Hin/= remP eq_except_rem // 1:eq_except_refl /=;split. + by move=>z;rewrite -memE dom_restr /#. move=>_ mL mR[#] /eq_exceptP Hex'?Heq. apply fmapP=>z;rewrite remP;case (z=x{mr})=>[->/=|Hneq];1:by rewrite Heq. - by apply Hex';rewrite inE. + by apply Hex'. qed. lemma eager_in_dom: @@ -520,7 +520,7 @@ proof. by apply /perm_eq_sym/perm_to_rem;rewrite restr_set/=dom_set !inE. + by move=>?&mr[#]2->?;exists FRO.m{mr}, x{mr}. inline Iter(RRO.I).iter_1s RRO.I.f RRO.resample;wp;swap{1}-1. - seq 1 7 : (={x} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + seq 1 7 : (={x} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ l{2} = (elems (dom (restr Unknown FRO.m))){1} /\ (FRO.m.[x]){2} = Some(c{1},Unknown) /\ (FRO.m.[x]){1} = None). + wp;rnd;auto=>?&mr[#]2->;rewrite in_dom sampleto_ll/==>Heq?_?->. @@ -528,7 +528,7 @@ proof. congr;apply fsetP=>z;rewrite in_fsetD1 dom_restr /in_dom_with !in_dom /#. exists*x{1},c{1};elim*=>x1 c1;pose mx2:=Some(c1,Unknown). call (iter_inv RRO.I (fun z=>x1<>z) - (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= None /\ o2.[x1]=mx2) _). + (fun o1 o2 => eq_except o1 o2 (pred1 x1) /\ o1.[x1]= None /\ o2.[x1]=mx2) _). + by conseq (I_f_eqex x1 None mx2). auto=>?&mr[#]2<-->^Hex 3!->^Hx1-> @/mx2/=;split=>[z|_ mL mR[#]]. + rewrite -memE dom_restr /in_dom_with in_dom /#. diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index d5a929a..acf6b34 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -42,7 +42,7 @@ module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { } (* squeezing *) while (i < (n + r - 1) %/ r) { - z <- z ++ w2bits sa; + z <- z ++ ofblock sa; (sa, sc) <@ P.f(sa, sc); i <- i + 1; } @@ -541,7 +541,7 @@ pred EagerInvar 0 <= i /\ (forall (j : int), 0 <= j < i => mem (dom mp1) (xs, j)) /\ (forall (j : int), i * r <= j < (i + 1) * r => - mp2.[(xs, j)] = Some(nth false (w2bits(oget mp1.[(xs, i)])) j))) /\ + mp2.[(xs, j)] = Some(nth false (ofblock (oget mp1.[(xs, i)])) j))) /\ (forall (xs : block list, j : int), mem (dom mp2) (xs, j) => 0 <= j /\ mem (dom mp1) (xs, j %/ r)). @@ -650,7 +650,7 @@ conseq i{1} = i{2} * r /\ n{1} <= m{1} /\ m{1} - i{1} = r /\ bs{1} = blocks2bits bs2 /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> - bs{1} = blocks2bits bs2 ++ take (n1 - i1) (w2bits b{2}) /\ + bs{1} = blocks2bits bs2 ++ take (n1 - i1) (ofblock b{2}) /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). progress; smt(). move=> |> &1 &2 ? ? sz_eq ? ? ? mp1 mp2 b ?. diff --git a/sha3/proof/core/ConcreteF.eca b/sha3/proof/core/ConcreteF.eca index 7f8bc18..8c5367b 100644 --- a/sha3/proof/core/ConcreteF.eca +++ b/sha3/proof/core/ConcreteF.eca @@ -61,7 +61,7 @@ section. realize uD_uf_fu. split. case=> [x y]; rewrite support_dprod /=. - by rewrite Block.DWord.supportP Capacity.DWord.supportP. + by rewrite Block.DWord.support_bdistr Capacity.DWord.support_cdistr. apply/dprod_uf. by rewrite Block.DWord.bdistr_uf. by rewrite Capacity.DWord.cdistr_uf. diff --git a/sha3/proof/core/Gcol.eca b/sha3/proof/core/Gcol.eca index 8405281..3f680bf 100644 --- a/sha3/proof/core/Gcol.eca +++ b/sha3/proof/core/Gcol.eca @@ -297,7 +297,7 @@ section PROOF. wp. rnd (mem (image fst (rng FRO.m)));skip;progress;2:smt ml=0. rewrite (Mu_mem.mu_mem (image fst (rng FRO.m{hr})) cdistr (1%r/(2^c)%r))//. - + move=>x _;apply DWord.muxP. + + move=>x _; apply DWord.cdistr1E. apply ler_wpmul2r;2:by rewrite le_fromint. by apply divr_ge0=>//;apply /c_ge0r. + move=>ci;proc;rcondt 2;auto=>/#. diff --git a/sha3/proof/core/Gconcl.ec b/sha3/proof/core/Gconcl.ec index 0476021..6027e1a 100644 --- a/sha3/proof/core/Gconcl.ec +++ b/sha3/proof/core/Gconcl.ec @@ -226,8 +226,8 @@ proof. [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=>/>. - wp;rnd;auto;rnd{1};auto;progress[-split]. - rewrite Block.DWord.supportP DWord.cdistr_ll /==> ?_?->. + wp;rnd;auto;rnd{1};auto;progress[-split]. + rewrite Block.DWord.support_bdistr DWord.cdistr_ll /==> ?_?->. by rewrite !getP /= oget_some. + proc;sp;if=>//. diff --git a/sha3/proof/core/Gext.eca b/sha3/proof/core/Gext.eca index 24c5bab..0fe42ad 100644 --- a/sha3/proof/core/Gext.eca +++ b/sha3/proof/core/Gext.eca @@ -619,23 +619,23 @@ section EXT. 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 (dom G1.m `|` dom G1.mi ) `|` fset1 x));skip=> /> &hr ?? -> /= ??. + wp; rnd (mem (image snd (dom G1.m `|` dom G1.mi ))); skip=> /> &hr ? ? -> /= ? ?. rewrite (Mu_mem.mu_mem - (image snd (dom G1.m{hr} `|` dom G1.mi{hr}) `|` fset1 x{hr}) + (image snd (dom G1.m{hr} `|` dom G1.mi{hr})) cdistr (1%r/(2^c)%r))//. - + by move=>x _;apply DWord.muxP. + + by move=>x _;apply DWord.cdistr1E. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU !fcardU le_fromint fcard1. + rewrite imageU fcardU le_fromint. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). by rewrite -!sizeE;smt w=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 (dom G1.m `|` dom G1.mi)));skip=> /> &hr ??-> /= ??. - rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr})) cdistr (1%r/(2^c)%r))//. - + by move=>x _;apply DWord.muxP. + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x));skip=> /> &hr ??-> /= ??. + rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. + + by move=>x _;apply DWord.cdistr1E. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU fcardU le_fromint. + rewrite imageU !fcardU le_fromint fcard1. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). by rewrite -!sizeE;smt w=fcard_ge0. + by move=>c1;proc;auto=> &hr [^H 2->]/#. diff --git a/sha3/proof/core/SLCommon.ec b/sha3/proof/core/SLCommon.ec index 6f9fd1a..92f7e0c 100644 --- a/sha3/proof/core/SLCommon.ec +++ b/sha3/proof/core/SLCommon.ec @@ -26,7 +26,7 @@ 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.words + 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)). From cbe731432595cdfbd113b08e6b6cb3178b36a23c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 29 Jun 2016 16:55:58 +0100 Subject: [PATCH 169/394] Trying to get back into the invariant -- First attempt --- sha3/proof/core/Handle.eca | 848 ++++++++++++++++++++----------------- 1 file changed, 471 insertions(+), 377 deletions(-) diff --git a/sha3/proof/core/Handle.eca b/sha3/proof/core/Handle.eca index 5e528f0..f05c336 100644 --- a/sha3/proof/core/Handle.eca +++ b/sha3/proof/core/Handle.eca @@ -1,4 +1,5 @@ -require import Pred Fun Option Pair Int Real StdOrder Ring. +pragma -oldip. pragma +implicits. +require import Pred Fun Option Pair Int Real StdOrder Ring NewLogic. require import List FSet NewFMap Utils Common SLCommon RndO. require import DProd Dexcepted. (*...*) import Capacity IntOrder. @@ -58,7 +59,6 @@ module G1(D:DISTINGUISHER) = { } else { y1 <$ bdistr; y2 <$ cdistr; - } y <- (y1, y2); bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); @@ -77,7 +77,7 @@ module G1(D:DISTINGUISHER) = { bcol <- bcol \/ hinv FRO.m y.`2 <> None; hy2 <- chandle; chandle <- chandle + 1; - FRO.m.[hy2] <- (y.`2, Known); + FRO.m.[hy2] <- (y.`2, Known); m.[x] <- y; mh.[(x.`1, hx2)] <- (y.`1, hy2); mi.[y] <- x; @@ -104,9 +104,9 @@ module G1(D:DISTINGUISHER) = { chandle <- chandle + 1; } hx2 <- oget (hinvK FRO.m x.`2); - y1 <$ bdistr; - y2 <$ cdistr; - y <- (y1,y2); + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); if (mem (dom mhi) (x.`1,hx2) /\ in_dom_with FRO.m (oget mhi.[(x.`1,hx2)]).`2 Unknown) { (y1,hy2) <- oget mhi.[(x.`1, hx2)]; @@ -135,7 +135,7 @@ module G1(D:DISTINGUISHER) = { proc main(): bool = { var b; - F.RO.m <- map0; + F.RO.m <- map0; m <- map0; mi <- map0; mh <- map0; @@ -144,7 +144,7 @@ module G1(D:DISTINGUISHER) = { bcol <- false; (* the empty path is initially known by the adversary to lead to capacity 0^c *) - FRO.m <- map0.[0 <- (c0, Known)]; + FRO.m <- map0.[0 <- (c0, Known)]; paths <- map0.[c0 <- ([<:block>],b0)]; chandle <- 1; b <@ D(C,S).distinguish(); @@ -153,269 +153,355 @@ module G1(D:DISTINGUISHER) = { }. (* -------------------------------------------------------------------------- *) - -op eqm_handles (handles:handles) (m:smap) (mh:hsmap) = - (forall bc bc', m.[bc] = Some bc' => - exists h h' f f', - handles.[h ] = Some(bc .`2,f ) /\ - handles.[h'] = Some(bc'.`2,f') /\ - mh.[(bc.`1, h)] = Some (bc'.`1,h')) /\ - (forall bh bh', mh.[bh] = Some bh' => - exists c c' f f', - handles.[bh .`2] = Some(c ,f) /\ - handles.[bh'.`2] = Some(c',f') /\ - m.[(bh.`1, c)] = Some (bh'.`1,c')). - -op mh_spec (handles:handles) (m2:smap) (mh:hsmap) (ro:(block list, block)fmap) = - (forall bh bh', mh.[bh] = Some bh' => - exists c c' f f', - handles.[bh .`2]=Some(c,f) /\ - handles.[bh'.`2]=Some(c',f') /\ - if f' = Known then m2.[(bh.`1,c)] = Some(bh'.`1,c') /\ f = Known - else - exists p v b, - ro.[rcons p b] = Some bh'.`1 /\ - build_hpath mh p = Some(v,bh.`2) /\ - bh.`1 = v +^ b) /\ - (forall p b, mem (dom ro) (rcons p b) <=> - exists v h h', - build_hpath mh p = Some (v,h) /\ - mh.[(v +^ b,h)] = Some (oget ro.[rcons p b], h')). - -op paths_spec (handles:handles) (mh:hsmap) (paths:(capacity,block list * block)fmap) = - forall c p v, paths.[c] = Some(p,v) <=> - exists h, - build_hpath mh p = Some(v,h) /\ - handles.[h] = Some(c,Known). - -op handles_spec handles chandle = - huniq handles /\ handles.[0] = Some (c0,Known) /\ forall h, mem (dom handles) h => h < chandle. - -op INV_CF_G1 (handles:handles) chandle (m1 mi1 m2 mi2:smap) (mh2 mhi2:hsmap) (ro:(block list, block) fmap) paths = - (eqm_handles handles m1 mh2 /\ eqm_handles handles mi1 mhi2) /\ - (incl m2 m1 /\ incl mi2 mi1) /\ - (mh_spec handles m2 mh2 ro /\ paths_spec handles mh2 paths /\ handles_spec handles chandle). - -lemma eqm_of_INV (chandle : handle) - (mi1 m2 mi2 : smap) (mhi2 : hsmap) - (ro : (block list, block) fmap) - (paths : (capacity, block list * block) fmap) - handles m1 mh2: - INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => - eqm_handles handles m1 mh2. -proof. by move=> @/INV_CF_G1 [#]. qed. - -lemma eqmi_of_INV (chandle : handle) - (m1 m2 mi2 : smap) (mh2 : hsmap) - (ro : (block list, block) fmap) - (paths : (capacity, block list * block) fmap) - handles mi1 mhi2: - INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => - eqm_handles handles mi1 mhi2. -proof. by move=> @/INV_CF_G1 [#]. qed. - -lemma incl_of_INV (handles : handles) (chandle : handle) - (mi1 mi2 : smap) (mh2 mhi2: hsmap) - (ro : (block list, block) fmap) - (paths : (capacity, block list * block) fmap) - m1 m2: - INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => - incl m2 m1. -proof. by move=> @/INV_CF_G1 [#]. qed. - -lemma incli_of_INV (handles : handles) (chandle : handle) - (m1 m2 : smap) (mh2 mhi2: hsmap) - (ro : (block list, block) fmap) - (paths : (capacity, block list * block) fmap) - mi1 mi2: - INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => - incl mi2 mi1. -proof. by move=> @/INV_CF_G1 [#]. qed. - -lemma mh_of_INV (chandle : handle) - (m1 mi1 mi2 : smap) (mhi2 : hsmap) - (paths : (capacity, block list * block) fmap) - handles m2 mh2 ro: - INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => - mh_spec handles m2 mh2 ro. -proof. by move=> @/INV_CF_G1 [#]. qed. - -lemma paths_of_INV (chandle : handle) - (m1 m2 mi1 mi2: smap) (mhi2: hsmap) - (ro : (block list, block) fmap) - handles mh2 paths: - INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => - paths_spec handles mh2 paths. -proof. by move=> @/INV_CF_G1 [#]. qed. - -lemma handles_of_INV (m1 m2 mi1 mi2 : smap) (mh2 mhi2 : hsmap) - (ro : (block list, block) fmap) - (paths : (capacity, block list * block) fmap) - handles chandle: - INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => - handles_spec handles chandle. -proof. by move=> @/INV_CF_G1 [#]. qed. - -lemma eqm_dom_mh_m handles m mh hx2 f (x:state): - eqm_handles handles m mh => - handles.[hx2] = Some (x.`2, f) => - mem (dom mh) (x.`1, hx2) => mem (dom m) x. -proof. - move=>[]H1 H2 Hhx2;rewrite !in_dom. - case: (mh.[_]) (H2 (x.`1,hx2))=> //= bh' /(_ bh') [c c' f1 f1']. - by rewrite Hhx2=> /= -[][]<<- _;case:(x)=> ??[]_->. -qed. - -lemma chandle_ge0 handles chandle : handles_spec handles chandle => 0 < chandle. -proof. by move=>[]_[]Heq Hlt;apply Hlt;rewrite in_dom Heq. qed. - -lemma chandle_0 handles chandle : handles_spec handles chandle => 0 <> chandle. -proof. move=> Hh;apply /IntOrder.ltr_eqF/(chandle_ge0 _ _ Hh). qed. - -lemma eqm_up_handles handles chandle m mh x2 : - handles_spec handles chandle => - eqm_handles handles m mh => - eqm_handles handles.[chandle <- (x2, Known)] m mh. +(** NOTE: this invariant is NOT the one we want: it is missing the constraints on the inverse maps. **) +inductive invariant (hs : handles) (ch : handle) (m1 m2 : smap) (mh : hsmap) (ro : (block list, block) fmap) (pi : (capacity, (block list * block)) fmap) = + | Inv of (forall xa xc ya yc, + m1.[(xa,xc)] = Some (ya,yc) => + exists xh yh xf yf, + hs.[xh] = Some (xc,xf) + /\ hs.[yh] = Some (yc,yf) + /\ mh.[(xa,xh)] = Some (ya,yh)) + & (forall xa xh ya yh, + mh.[(xa,xh)] = Some (ya,yh) => + exists xc yc xf yf, + hs.[xh] = Some (xc,xf) + /\ hs.[yh] = Some (yc,yf) + /\ m1.[(xa,xc)] = Some (ya,yc)) + & (incl m2 m1) + & (forall xa xh ya yh, + mh.[(xa,xh)] = Some (ya,yh) => + exists xc yc xf yf, + hs.[xh] = Some (xc,xf) + /\ hs.[yh] = Some (yc,yf) + /\ if yf = Known + then m2.[(xa,xc)] = Some (ya,yc) + /\ xf = Known + else exists p v b, + ro.[rcons p b] = Some ya + /\ build_hpath mh p = Some (v,xh) + /\ xa = v +^ b) + & (forall p xa b, + ro.[rcons p xa] = Some b <=> + exists v xh yh, + build_hpath mh p = Some (v,xh) + /\ mh.[(v +^ xa,xh)] = Some (b,yh)) + & (forall c p v, + pi.[c] = Some (p,v) <=> + exists h, + build_hpath mh p = Some(v,h) + /\ hs.[h] = Some (c,Known)) + & (huniq hs) + & (hs.[0] = Some (c0,Known)) + & (forall h, mem (dom hs) h => h < ch). + +(* inductive eqm_handles (handles:handles) (m:smap) (mh:hsmap) = *) +(* | MH of (forall bc bc', m.[bc] = Some bc' => *) +(* exists h h' f f', *) +(* handles.[h ] = Some(bc .`2,f ) /\ *) +(* handles.[h'] = Some(bc'.`2,f') /\ *) +(* mh.[(bc.`1, h)] = Some (bc'.`1,h')) *) +(* & (forall bh bh', mh.[bh] = Some bh' => *) +(* exists c c' f f', *) +(* handles.[bh .`2] = Some(c ,f) /\ *) +(* handles.[bh'.`2] = Some(c',f') /\ *) +(* m.[(bh.`1, c)] = Some (bh'.`1,c')). *) + +(* inductive mh_spec (handles:handles) (m2:smap) (mh:hsmap) (ro:(block list, block)fmap) = *) +(* | H of (forall bh bh', mh.[bh] = Some bh' => *) +(* exists c c' f f', *) +(* handles.[bh .`2]=Some(c,f) /\ *) +(* handles.[bh'.`2]=Some(c',f') /\ *) +(* if f' = Known *) +(* then m2.[(bh.`1,c)] = Some(bh'.`1,c') /\ f = Known *) +(* else exists p v b, *) +(* ro.[rcons p b] = Some bh'.`1 /\ *) +(* build_hpath mh p = Some(v,bh.`2) /\ *) +(* bh.`1 = v +^ b) *) +(* & (forall p b, mem (dom ro) (rcons p b) <=> *) +(* exists v h h', *) +(* build_hpath mh p = Some (v,h) /\ *) +(* mh.[(v +^ b,h)] = Some (oget ro.[rcons p b], h')). *) + +(* inductive paths_spec (handles:handles) (mh:hsmap) (paths:(capacity,block list * block)fmap) = *) +(* | P of (forall c p v, paths.[c] = Some(p,v) <=> *) +(* exists h, *) +(* build_hpath mh p = Some(v,h) /\ *) +(* handles.[h] = Some(c,Known)). *) + +(* inductive handles_spec handles chandle = *) +(* | Hs of (huniq handles) *) +(* & (handles.[0] = Some (c0,Known)) *) +(* & (forall h, mem (dom handles) h => h < chandle). *) + +(* inductive INV_CF_G1 (handles:handles) chandle (m1 mi1 m2 mi2:smap) (mh2 mhi2:hsmap) (ro:(block list, block) fmap) paths = *) +(* | CF_G1 of (eqm_handles handles m1 mh2) *) +(* & (eqm_handles handles mi1 mhi2) *) +(* & (incl m2 m1) *) +(* & (incl mi2 mi1) *) +(* & (mh_spec handles m2 mh2 ro) *) +(* & (paths_spec handles mh2 paths) *) +(* & (handles_spec handles chandle). *) + +(* lemma eqm_of_INV (chandle : handle) *) +(* (mi1 m2 mi2 : smap) (mhi2 : hsmap) *) +(* (ro : (block list, block) fmap) *) +(* (paths : (capacity, block list * block) fmap) *) +(* handles m1 mh2: *) +(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) +(* eqm_handles handles m1 mh2. *) +(* proof. by case. qed. *) + +(* lemma eqmi_of_INV (chandle : handle) *) +(* (m1 m2 mi2 : smap) (mh2 : hsmap) *) +(* (ro : (block list, block) fmap) *) +(* (paths : (capacity, block list * block) fmap) *) +(* handles mi1 mhi2: *) +(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) +(* eqm_handles handles mi1 mhi2. *) +(* proof. by case. qed. *) + +(* lemma incl_of_INV (handles : handles) (chandle : handle) *) +(* (mi1 mi2 : smap) (mh2 mhi2: hsmap) *) +(* (ro : (block list, block) fmap) *) +(* (paths : (capacity, block list * block) fmap) *) +(* m1 m2: *) +(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) +(* incl m2 m1. *) +(* proof. by case. qed. *) + +(* lemma incli_of_INV (handles : handles) (chandle : handle) *) +(* (m1 m2 : smap) (mh2 mhi2: hsmap) *) +(* (ro : (block list, block) fmap) *) +(* (paths : (capacity, block list * block) fmap) *) +(* mi1 mi2: *) +(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) +(* incl mi2 mi1. *) +(* proof. by case. qed. *) + +(* lemma mh_of_INV (chandle : handle) *) +(* (m1 mi1 mi2 : smap) (mhi2 : hsmap) *) +(* (paths : (capacity, block list * block) fmap) *) +(* handles m2 mh2 ro: *) +(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) +(* mh_spec handles m2 mh2 ro. *) +(* proof. by case. qed. *) + +(* lemma paths_of_INV (chandle : handle) *) +(* (m1 m2 mi1 mi2: smap) (mhi2: hsmap) *) +(* (ro : (block list, block) fmap) *) +(* handles mh2 paths: *) +(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) +(* paths_spec handles mh2 paths. *) +(* proof. by case. qed. *) + +(* lemma handles_of_INV (m1 m2 mi1 mi2 : smap) (mh2 mhi2 : hsmap) *) +(* (ro : (block list, block) fmap) *) +(* (paths : (capacity, block list * block) fmap) *) +(* handles chandle: *) +(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) +(* handles_spec handles chandle. *) +(* proof. by case. qed. *) + +(* lemma eqm_dom_mh_m handles m mh hx2 f (x:state): *) +(* eqm_handles handles m mh => *) +(* handles.[hx2] = Some (x.`2, f) => *) +(* mem (dom mh) (x.`1, hx2) => mem (dom m) x. *) +(* proof. *) +(* move=>[]H1 H2 Hhx2;rewrite !in_dom. *) +(* case: (mh.[_]) (H2 (x.`1,hx2))=> //= bh' /(_ bh') [c c' f1 f1']. *) +(* by rewrite Hhx2=> /= -[][]<<- _;case:(x)=> ??[]_->. *) +(* qed. *) + +(* lemma chandle_ge0 handles chandle : handles_spec handles chandle => 0 < chandle. *) +(* proof. by case=> _ Heq Hlt; apply Hlt; rewrite in_dom Heq. qed. *) + +(* lemma chandle_0 handles chandle : handles_spec handles chandle => 0 <> chandle. *) +(* proof. by move=> Hh;apply/ltr_eqF/(@chandle_ge0 _ _ Hh). qed. *) + +(* lemma eqm_up_handles handles chandle m mh x2 : *) +(* handles_spec handles chandle => *) +(* eqm_handles handles m mh => *) +(* eqm_handles handles.[chandle <- (x2, Known)] m mh. *) +(* proof. *) +(* case=> Hu Hh0 Hlt [] m_some mh_some; split. *) +(* + move=> bc bc' /m_some [h h' f f'] [#] Hh Hh' Hmh. *) +(* exists h, h', f, f'; rewrite !getP Hmh -Hh -Hh' /=. *) +(* rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. *) +(* by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. *) +(* move=> bh bh' /mh_some [c c' f f'] [#] Hh Hh' Hm. *) +(* exists c, c', f, f'; rewrite !getP Hm -Hh -Hh'. *) +(* rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. *) +(* by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. *) +(* qed. *) + +(* lemma mh_up_handles handles chandle m2 mh ro cf: *) +(* handles_spec handles chandle => *) +(* mh_spec handles m2 mh ro => *) +(* mh_spec handles.[chandle <- cf] m2 mh ro. *) +(* proof. *) +(* move=> + [] mh_some ?=> -[] _ _ Hlt; split=> // bh bh' /mh_some [c c' f f'] [#] Hh Hh' Hif. *) +(* exists c,c',f,f'; rewrite Hif -Hh -Hh' !getP. *) +(* rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. *) +(* by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. *) +(* qed. *) + +(* lemma paths_up_handles m2 ro handles mh paths cf chandle: *) +(* mh_spec handles m2 mh ro => *) +(* handles_spec handles chandle => *) +(* paths_spec handles mh paths => *) +(* paths_spec handles.[chandle <- cf] mh paths. *) +(* proof. *) +(* move=> Hmh Hh [] Hp; split=> c p v; rewrite Hp; apply exists_iff=> x /=. *) +(* split=>- [] ^Hbu -> /=; rewrite getP. *) +(* + case: Hh=> _ _ Hlt x_in_handles. *) +(* by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom x_in_handles. *) +(* case: (x = chandle)=> //=. *) +(* move: Hbu=> /build_hpathP [[#] _ _ ->|[p' b v' h' [#] _ _ Hh']]. *) +(* + by rewrite (@chandle_0 _ _ Hh). *) +(* case: Hh=> _ _ /(_ x) Hlt; rewrite ltr_eqF //. *) +(* by apply/Hlt; rewrite in_dom; case: Hmh=> /(_ _ _ Hh') [????] [#] _ ->. *) +(* qed. *) + +(* lemma handles_up_handles handles chandle x2 f': *) +(* (forall (f : flag), ! mem (rng handles) (x2, f)) => *) +(* handles_spec handles chandle => *) +(* handles_spec handles.[chandle <- (x2, f')] (chandle + 1). *) +(* proof. *) +(* move=> Hx2 ^Hh [] Hu Hh0 Hlt; split. *) +(* + move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. *) +(* case: (h1 = chandle)=> /= [-> [] ->> ->|_]; (case: (h2 = chandle)=> [-> //= |_]). *) +(* + by move=> Heq ->>; move: (Hx2 f2); rewrite in_rng negb_exists=> /= /(_ h2). *) +(* + by move=> Heq [] ->> <<- ->>; move: (Hx2 f1); rewrite in_rng negb_exists=> /= /(_ h1). *) +(* by apply Hu. *) +(* + by rewrite getP (@chandle_0 _ _ Hh). *) +(* + by move=> h; rewrite dom_set !inE /#. *) +(* qed. *) + +(* lemma INV_CF_G1_up_handles handles chandle m1 mi1 m2 mi2 mh mhi ro paths x2: *) +(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh mhi ro paths => *) +(* (forall f, ! mem (rng handles) (x2, f)) => *) +(* INV_CF_G1 handles.[chandle <- (x2, Known)](chandle+1) m1 mi1 m2 mi2 mh mhi ro paths. *) +(* proof. *) +(* case=> Heqm Heqmi Hincl Hincli Hmh Hp Hh Hx2; split. *) +(* + exact/eqm_up_handles. *) +(* + exact/eqm_up_handles. *) +(* + done. *) +(* + done. *) +(* + exact/mh_up_handles. *) +(* + exact/(paths_up_handles m2 ro). *) +(* exact/handles_up_handles. *) +(* qed. *) + +(* lemma eqm_handles_up (handles : handles) m mh (h hx:handle) (x y : state) f: *) +(* huniq handles => *) +(* handles.[h] = None => *) +(* handles.[hx] = Some (x.`2, f) => *) +(* eqm_handles handles m mh => *) +(* eqm_handles handles.[h <- (y.`2,Known)] m.[x <- y] mh.[(x.`1,hx) <- (y.`1,h)]. *) +(* proof. *) +(* move=> uniq_h h_h h_hx @/eqm_handles [] hmmh hmhm; split. *) +(* + move=> bc bc'; rewrite getP; case (bc = x)=> /= [->> <<- {bc bc'}|]. *) +(* * by exists hx, h, f, Known; rewrite !getP /= [smt (in_dom)]. *) +(* move=> bc_neq_x /hmmh [] h0 h0' f0 f0' [#] h_h0 h_h0' mhi_bc. *) +(* by exists h0, h0', f0, f0'; rewrite !getP [smt (in_dom)]. *) +(* move=> bh bh'; rewrite getP; case (bh = (x.`1,hx))=> /= [->> <<- {bh bh'}|]. *) +(* * by exists x.`2, y.`2, f, Known; rewrite !getP [smt (in_dom)]. *) +(* case bh=> b h0 /=. *) +(* rewrite anda_and negb_and=> bh_neq_x1hx /hmhm /= [] c0 c0' f0 f0' [#] h_h0 h_bh' m_bc. *) +(* exists c0, c0', f0, f0'; rewrite !getP. *) +(* split; 1:smt (in_dom). *) +(* split; 1:smt (in_dom). *) +(* case x bh_neq_x1hx h_hx=> x1 x2 /= => - [/#|h0_neq_hx h_hx]. *) +(* have -> //=: c0 <> x2; move: h0_neq_hx; apply/contra. *) +(* exact/(@uniq_h _ _ _ _ h_h0 h_hx). *) +(* qed. *) + +(* lemma eqmi_handles_up (handles : handles) mi mhi (h hx : handle) (x y : state) f: *) +(* (!exists f', mem (rng handles) (y.`2,f')) => *) +(* handles.[h] = None => *) +(* handles.[hx] = Some (x.`2, f) => *) +(* eqm_handles handles mi mhi => *) +(* eqm_handles handles.[h <- (y.`2,Known)] mi.[y <- x] mhi.[(y.`1,h) <- (x.`1,hx)]. *) +(* proof. *) +(* move=> y_notinr1_handles h_h h_hx @/eqm_handles [] hmmh hmhm; split. *) +(* + move=> bc bc'; rewrite getP; case (bc = y)=> /= [->> <<- {bc bc'}|]. *) +(* * by exists h, hx, Known, f; rewrite !getP /= [smt (in_dom)]. *) +(* move=> bc_neq_y /hmmh [] h0 h0' f0 f0' [#] h_h0 h_h0' mhi_bc. *) +(* by exists h0, h0', f0, f0'; rewrite !getP [smt (in_dom)]. *) +(* move=> bh bh'; rewrite getP; case (bh = (y.`1,h))=> /= [->> <<- {bh bh'}|]. *) +(* * by exists y.`2, x.`2, Known, f; rewrite !getP [smt (in_dom)]. *) +(* case bh=> b h0 /=. *) +(* rewrite anda_and negb_and=> bh_neq_y1h /hmhm /= [] c0 c0' f0 f0' [#] h_bh h_bh' mi_bh. *) +(* exists c0, c0', f0, f0'; rewrite !getP. *) +(* split; 1:smt (in_dom). *) +(* split; 1:smt (in_dom). *) +(* case y bh_neq_y1h y_notinr1_handles=> y1 y2 /= [/#|h0_neq_h y_notinr1_handles]. *) +(* have /#: c0 = y2 => false; move=> /(congr1 (fun x=> exists f', mem (rng handles) (x,f'))) /=. *) +(* rewrite y_notinr1_handles /= neqF /=; exists f0. *) +(* by rewrite in_rng; exists h0. *) +(* qed. *) + +(* lemma incl_set (m m' : ('a,'b) fmap) x y: *) +(* incl m m' => *) +(* incl m.[x <- y] m'.[x <- y]. *) +(* proof. smt (in_dom getP). qed. *) + +(* lemma hinv_notin_rng m y2: *) +(* SLCommon.hinv m y2 = None => *) +(* (forall h f, m.[h] <> Some (y2,f)). *) +(* proof. by move=> hinv_none; have:= hinvP m y2; rewrite hinv_none. qed. *) + +(* lemma handles_spec_notin_dom m h: *) +(* handles_spec m h => *) +(* !mem (dom m) h. *) +(* proof. case; smt (in_dom). qed. *) + +(* lemma neq_Known f: f <> Known <=> f = Unknown. *) +(* proof. by case f. qed. *) + +(* lemma neq_Unkwown f: f <> Unknown <=> f = Known. *) +(* proof. by case f. qed. *) + +op getflag (hs : handles) xc = + omap snd (obind ("_.[_]" hs) (hinv hs xc)). + +(* lemma getflagP hs xc f: *) +(* huniq hs => *) +(* (mem (rng hs) (xc,f) <=> getflag hs xc = Some f). *) +(* proof. *) +(* move=> huniq_hs; split. *) +(* + rewrite in_rng=> -[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. *) +(* rewrite /getflag; case: (hinvP hs xc)=> [-> //|]. *) +(* rewrite in_rng; case: (hinv hs xc)=> //= h [f']. *) +(* rewrite oget_some=> ^ hs_h -> @/snd /= ->>. *) +(* by exists h. *) +(* qed. *) + +(* lemma paths_prefix handles m2 mh ro paths c b p v: *) +(* mh_spec handles m2 mh ro => *) +(* paths_spec handles mh paths => *) +(* paths.[c] = Some (rcons p b,v) => *) +(* (exists c' v', paths.[c'] = Some (p,v')). *) +(* proof. *) +(* move=> [] mh_some _ [] hpaths ^paths_c. *) +(* move=> /hpaths [h] [#] /build_hpathP [/#|] [p' b' v' h'] [#] ^/rconsIs + /rconssI- <*>. *) +(* move=> hpath + handles_h - /mh_some /= [c' c0 f' f]; rewrite handles_h /= => /> handles_h' _. *) +(* by exists c', v'; rewrite hpaths; exists h'. *) +(* qed. *) + +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')). proof. - move=> []Hu[Hh0 Hlt][]H1 H2;split=> - [bc bc'/H1 [h h' f f'][]Hh[]Hh' Hmh| bh bh'/H2 [c c' f f'][]Hh []Hh' Hm]. - + exists h,h',f,f';rewrite !getP Hmh/=-Hh-Hh'(_:h<>chandle)2:(_:h'<>chandle) //. - + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. - by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. - exists c,c',f,f';rewrite !getP Hm/=-Hh-Hh'(_:bh.`2<>chandle)2:(_:bh'.`2<>chandle) //. - + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. - by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. +move=> /build_hpathP [/#|] [p' b' v' h'] [#] + + _. +move=> ^/rconsIs <<- {b'} /rconssI <<- {p'} H. +by exists v', h'. qed. -lemma mh_up_handles handles chandle m2 mh ro cf: - handles_spec handles chandle => - mh_spec handles m2 mh ro => - mh_spec handles.[chandle <- cf] m2 mh ro. -proof. - move=> Hh Hmh. - move:Hmh Hh=>[H1 ?][_[]_ Hlt];split=>// bh bh' /H1 [c f c' f'][]Hh[]Hh' Hif. - exists c,f,c',f';rewrite Hif-Hh-Hh'!getP(_:bh.`2<>chandle)2:(_:bh'.`2<>chandle) //. - + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. - by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. -qed. - -lemma paths_up_handles m2 ro handles mh paths cf chandle: - mh_spec handles m2 mh ro => - handles_spec handles chandle => - paths_spec handles mh paths => - paths_spec handles.[chandle <- cf] mh paths. -proof. - move=> Hmh Hh Hp c p v;rewrite Hp;apply NewLogic.exists_iff=> h/=;split=> -[^Hbu->] /=; - rewrite getP. - + move:Hh=>[]_[]_/(_ h)Hlt Hh;rewrite (_:h<>chandle)//. - by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. - rewrite (_:h<>chandle)//. - cut [[]_[]_->|[p' b v' h'[]_[]_ Hh']]:= build_hpathP _ _ _ _ Hbu. - + by rewrite (chandle_0 _ _ Hh). - move:Hh=>[]_[]_/(_ h)Hlt;apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom. - by cut [/(_ _ _ Hh')[????][]_[]->]:= Hmh. -qed. - -lemma handles_up_handles handles chandle x2 f': - (forall (f : flag), ! mem (rng handles) (x2, f)) => - handles_spec handles chandle => - handles_spec handles.[chandle <- (x2, f')] (chandle + 1). -proof. - move=> Hx2^Hh[]Hu[]Hh0 Hlt;split;[ | split]. - + move=> h1 h2 [c1 f1] [c2 f2];rewrite !getP. - case (h1=chandle)=>[->/=[]->> ->|_]; (case (h2=chandle)=>[->//=|_]). - + by move=>Heq ->>;move:(Hx2 f2);rewrite in_rng NewLogic.negb_exists=>/=/(_ h2); - rewrite Heq. - + by move=>Heq[]->> <<- ->>;move:(Hx2 f1);rewrite in_rng NewLogic.negb_exists=>/=/(_ h1); - rewrite Heq. - by apply Hu. - + by rewrite getP (chandle_0 _ _ Hh). - move=>h;rewrite dom_set !inE /#. -qed. - -lemma INV_CF_G1_up_handles handles chandle m1 mi1 m2 mi2 mh mhi ro paths x2: - INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh mhi ro paths => - (forall f, ! mem (rng handles) (x2, f)) => - INV_CF_G1 handles.[chandle <- (x2, Known)](chandle+1) m1 mi1 m2 mi2 mh mhi ro paths. -proof. - move=>[][]Heqm Heqmi[]Hincl[]Hmh[]Hp Hh Hx2;split. - + by split;apply eqm_up_handles. - split=>//;split;[|split]. - + by apply mh_up_handles. - + by apply (paths_up_handles m2 ro). - by apply handles_up_handles. -qed. - -lemma eqm_handles_up (handles : handles) m mh (h hx:handle) (x y : state) f: - huniq handles => - handles.[h] = None => - handles.[hx] = Some (x.`2, f) => - eqm_handles handles m mh => - eqm_handles handles.[h <- (y.`2,Known)] m.[x <- y] mh.[(x.`1,hx) <- (y.`1,h)]. -proof. -move=> uniq_h h_h h_hx @/eqm_handles [] hmmh hmhm; split. -+ move=> bc bc'; rewrite getP; case (bc = x)=> /= [->> <<- {bc bc'}|]. - * by exists hx, h, f, Known; rewrite !getP /= [smt w=in_dom]. - move=> bc_neq_x /hmmh [] h0 h0' f0 f0' [#] h_h0 h_h0' mhi_bc. - by exists h0, h0', f0, f0'; rewrite !getP [smt w=in_dom]. -move=> bh bh'; rewrite getP; case (bh = (x.`1,hx))=> /= [->> <<- {bh bh'}|]. - * by exists x.`2, y.`2, f, Known; rewrite !getP [smt w=in_dom]. -case bh=> b h0 /=. -rewrite anda_and NewLogic.negb_and=> bh_neq_x1hx /hmhm /= [] c0 c0' f0 f0' [#] h_h0 h_bh' m_bc. -exists c0, c0', f0, f0'; rewrite !getP. -split; 1:smt w=in_dom. -split; 1:smt w=in_dom. -case x bh_neq_x1hx h_hx=> x1 x2 /= => - [/#|h0_neq_hx h_hx]. -have -> //=: c0 <> x2; move: h0_neq_hx; apply/contra. -exact/(uniq_h _ _ _ _ h_h0 h_hx). -qed. - -lemma eqmi_handles_up (handles : handles) mi mhi (h hx : handle) (x y : state) f: - (!exists f', mem (rng handles) (y.`2,f')) => - handles.[h] = None => - handles.[hx] = Some (x.`2, f) => - eqm_handles handles mi mhi => - eqm_handles handles.[h <- (y.`2,Known)] mi.[y <- x] mhi.[(y.`1,h) <- (x.`1,hx)]. -proof. -move=> y_notinr1_handles h_h h_hx @/eqm_handles [] hmmh hmhm; split. -+ move=> bc bc'; rewrite getP; case (bc = y)=> /= [->> <<- {bc bc'}|]. - * by exists h, hx, Known, f; rewrite !getP /= [smt w=in_dom]. - move=> bc_neq_y /hmmh [] h0 h0' f0 f0' [#] h_h0 h_h0' mhi_bc. - by exists h0, h0', f0, f0'; rewrite !getP [smt w=in_dom]. -move=> bh bh'; rewrite getP; case (bh = (y.`1,h))=> /= [->> <<- {bh bh'}|]. - * by exists y.`2, x.`2, Known, f; rewrite !getP [smt w=in_dom]. -case bh=> b h0 /=. -rewrite anda_and NewLogic.negb_and=> bh_neq_y1h /hmhm /= [] c0 c0' f0 f0' [#] h_bh h_bh' mi_bh. -exists c0, c0', f0, f0'; rewrite !getP. -split; 1:smt w=in_dom. -split; 1:smt w=in_dom. -case y bh_neq_y1h y_notinr1_handles=> y1 y2 /= [/#|h0_neq_h y_notinr1_handles]. -have /#: c0 = y2 => false; move=> /(congr1 (fun x=> exists f', mem (rng handles) (x,f'))) /=. -rewrite y_notinr1_handles /= neqF /=; exists f0. -by rewrite in_rng; exists h0. -qed. - -lemma incl_set (m m' : ('a,'b) fmap) x y: - incl m m' => - incl m.[x <- y] m'.[x <- y]. -proof. smt w=(in_dom getP). qed. - -lemma hinv_notin_rng m y2: - SLCommon.hinv m y2 = None => - (forall h f, m.[h] <> Some (y2,f)). -proof. by move=> hinv_none; have:= hinvP m y2; rewrite hinv_none. qed. - -lemma handles_spec_notin_dom m h: - handles_spec m h => - !mem (dom m) h. -proof. smt w=in_dom. qed. - -lemma neq_Known f: f <> Known <=> f = Unknown. -proof. by case f. qed. - -lemma neq_Unkwown f: f <> Unknown <=> f = Known. -proof. by case f. qed. - clone export ConcreteF as ConcreteF1. section AUX. @@ -429,68 +515,72 @@ section AUX. equiv CF_G1 : CF(D).main ~ G1(D).main: ={glob D} ==> !(G1.bcol \/ G1.bext){2} => ={res}. proof. - admit. -(* - proc. - call (_:(G1.bcol \/ G1.bext), - 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}). - (* lossless D *) - + apply D_ll. - (** proofs for G1.S.f *) - (* equiv PF.P.f G1.S.f *) - + proc;if{1}=>/=. - (* x is not in m{1} so forall h, (x.1,h) is not in mh{2} *) - + rcondt{2} 1. - + move=> &hr;skip=> &hr'[][]_[]<-[]_[][]Hincl Hincli _. - rewrite !in_dom/==>H; by case:(G1.m{hr'}.[x{hr}]) (Hincl x{hr})=> //=;rewrite H. - exists* F.RO.m{2}, G1.paths{2};elim*=>ro0 paths0. - seq 1 2 : (!G1.bcol{2} /\ (G1.bext = mem (rng FRO.m) (x.`2, Unknown)){2} /\ - ={x,y} /\ - 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} ro0 paths0 /\ - ! mem (dom PF.m{1}) x{1} /\ - (if mem (dom paths0) x.`2 then - let (p,v) = oget paths0.[x.`2] in - F.RO.m{2} = ro0.[rcons p (v+^x.`1) <- y.`1] /\ - G1.paths = paths0.[y.`2 <- (rcons p (v +^ x.`1), y.`1)] - else F.RO.m = ro0 /\ G1.paths = paths0){2}). - + wp 1 1;conseq (_: ={y} /\ - if mem (dom paths0) x{2}.`2 then - let (p0, v0) = oget paths0.[x{2}.`2] in - F.RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ - G1.paths{2} = paths0.[y{2}.`2 <- (rcons p0 (v0 +^ x{2}.`1), y{2}.`1)] - else F.RO.m{2} = ro0 /\ G1.paths{2} = paths0);1:smt ml=0. - if{2};2:by auto=>/#. - inline{2} F.RO.get;rcondt{2} 4. - + move=> &ml;auto=>/= &mr[][]_[][]_[]->[][][]_ Heqm _[]_[][]_ Hro[] Hpath _ HnPFm. - rewrite in_dom;case:(G1.paths{mr}.[_]) (Hpath x{mr}.`2)=>//[[p v]]/(_ p v)/=[h][]Hbu Hh b _. - rewrite -not_def=> /Hro [??h'];rewrite oget_some Hbu => -[][]<- <- /=. - rewrite Block.xorwA Block.xorwK Block.xorwC Block.xorw0 -not_def=>/Heqm [c c' f f']. - by rewrite Hh=> -[][]<- _[]_ Hm;move:HnPFm;rewrite in_dom;case:(x{mr}) Hm=> ??->. - swap{2} 3-2;swap{2}6-4;wp;conseq (_:y{1} =(r,y2){2}). - + progress [-split];rewrite getP_eq oget_some H2/=. - by move:H2;rewrite in_dom;case:(G1.paths{2}.[_]). - transitivity{1} {y <- S.sample();} (true ==> ={y}) (true==>y{1}=(r,y2){2})=>//;1:by inline*;auto. - transitivity{2} {(r,y2) <- S.sample2();} (true==>y{1}=(r,y2){2}) (true==> ={r,y2})=>//;2:by inline*;auto. - by call sample_sample2;auto=> /=?[??]->. - case (mem (rng FRO.m{2}) (x{2}.`2, Unknown)). - + conseq (_:true);[by move=> ??[][]_[]->_->|auto]. - conseq (_: !G1.bcol{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}). - + by move=> ??[][]_[]->[][]-> _ _ ->. - seq 0 2: ((!G1.bcol{2} /\ ={x, y} /\ - 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} ro0 paths0 /\ - ! mem (dom PF.m{1}) x{1} /\ - if mem (dom paths0) x{2}.`2 then - let (p0, v0) = oget paths0.[x{2}.`2] in - F.RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ - G1.paths{2} = paths0.[y{2}.`2 <- (rcons p0 (v0 +^ x{2}.`1), y{2}.`1)] - else F.RO.m{2} = ro0 /\ G1.paths{2} = paths0) /\ - !mem (rng FRO.m{2}) (x{2}.`2, Unknown) /\ - (FRO.m.[hx2]=Some(x.`2,Known)){2}). + proc. + call (_: G1.bcol \/ G1.bext, + invariant FRO.m{2} G1.chandle{2} PF.m{1} G1.m{2} G1.mh{2} F.RO.m{2} G1.paths{2}). + (* lossless D *) + + exact/D_ll. + (** proofs for G1.S.f *) + (* equivalence up to bad of PF.f and G1.S.f *) + + proc; if{1}=> //=. + (* x is not in m{1} so forall h, (x.1,h) is not in mh{2} *) + + rcondt{2} 1. + + move=> &m; auto=> &m' [#] _ <- Hinv. + by rewrite !in_dom; apply/contra=> ^ h; case: Hinv=> _ _ ->. + exists* F.RO.m{2}; elim*=> ro0. + seq 2 3: ( !G1.bcol{2} + /\ (G1.bext <=> mem (rng FRO.m) (x.`2, Unknown)){2} + /\ ={x,y1,y2} + /\ invariant FRO.m{2} G1.chandle{2} PF.m{1} G1.m{2} G1.mh{2} ro0 G1.paths{2} + /\ ! mem (dom PF.m{1}) x{1} + /\ (if mem (dom G1.paths) x.`2 + then let (p,v) = oget G1.paths.[x.`2] in + F.RO.m{2} = ro0.[rcons p (v+^x.`1) <- y.`1] + else F.RO.m = ro0){2}). + + if{2}; last first. + + by auto=> |> &1 &2; rewrite negb_or; case=> -> ->. + inline{2} F.RO.get; rcondt{2} 4. + + auto=> |> &m'; case: (x{m'})=> /= _x1 _x2 _ [] + m_some mh_some leq in_mh in_ro in_pi hs_inj hs0 hs_dom + + r0 _ - {r0} + x2_in_pi. + have:= x2_in_pi; rewrite in_dom. + case: {-1}(G1.paths.[_x2]{m'}) (eq_refl (G1.paths.[_x2]{m'}))=> //= -[] p v paths_x2. + rewrite oget_some /=; have /in_pi [h_x2] [#] pv_hx2 hs_h_x2:= paths_x2. + apply/contra; rewrite !in_dom. + case: {-1}(F.RO.m.[rcons p (v +^ _x1)]{m'}) (eq_refl (F.RO.m.[rcons p (v +^ _x1)]{m'}))=> //= b. + move=> ^ro_pv_x1 /in_ro [v' xh yh] [#]. + rewrite pv_hx2 /= => [#] <<- <<-. + rewrite Block.xorwA Block.xorwK Block.xorwC Block.xorw0. + by move=> /mh_some [xc yc xf yf] [#]; rewrite hs_h_x2 /= => [#] <<- <<- _ ->. + auto=> |> &1 &2; rewrite negb_or; case=> -> -> /= Hinv x_notin_PF ^x2_in_paths. + rewrite in_dom; case: {-1}(G1.paths.[x.`2]{2}) (eq_refl G1.paths.[x.`2]{2})=> //=. + move=> [p v] paths_x2 y1' _ y2' _; rewrite oget_some /=. + rewrite getP /= oget_some /= => x1 x2 [] <- <-. + by rewrite getP /= oget_some. + admit. +(* swap{2} 3-2;swap{2}6-4;wp;conseq (_:y{1} =(r,y2){2}). + + progress [-split];rewrite getP_eq oget_some H2/=. + by move:H2;rewrite in_dom;case:(G1.paths{2}.[_]). + transitivity{1} {y <- S.sample();} (true ==> ={y}) (true==>y{1}=(r,y2){2})=>//;1:by inline*;auto. + transitivity{2} {(r,y2) <- S.sample2();} (true==>y{1}=(r,y2){2}) (true==> ={r,y2})=>//;2:by inline*;auto. + by call sample_sample2;auto=> /=?[??]->. + case (mem (rng FRO.m{2}) (x{2}.`2, Unknown)). + + conseq (_:true);[by move=> ??[][]_[]->_->|auto]. + conseq (_: !G1.bcol{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}). + by move=> ??[][]_[]->[][]-> _ _ ->. *) + admit. +(* seq 0 2: ((!G1.bcol{2} /\ ={x, y} /\ + 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} ro0 paths0 /\ + ! mem (dom PF.m{1}) x{1} /\ + if mem (dom paths0) x{2}.`2 then + let (p0, v0) = oget paths0.[x{2}.`2] in + F.RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ + G1.paths{2} = paths0.[y{2}.`2 <- (rcons p0 (v0 +^ x{2}.`1), y{2}.`1)] + else F.RO.m{2} = ro0 /\ G1.paths{2} = paths0) /\ + !mem (rng FRO.m{2}) (x{2}.`2, Unknown) /\ + (FRO.m.[hx2]=Some(x.`2,Known)){2}). + auto=> &ml&mr[][]->[]_[][]-> ->[]Hinv []-> -> ^Hrng-> /=. case (mem (rng FRO.m{mr}) (x{mr}.`2, Known))=> Hmem /=. + by split=>//;apply /huniq_hinvK=>//;move:Hinv;rewrite /INV_CF_G1/handles_spec. @@ -508,7 +598,7 @@ section AUX. rewrite getP /= oget_some /= /INV_CF_G1. rewrite (eqm_handles_up FRO.m{2} PF.m{1} G1.mh{2} G1.chandle{2} hx2{2} x{2} y{2} Known _ _ _ _) //= 1..3:[smt w=in_dom]. rewrite (eqmi_handles_up FRO.m{2} PF.mi{1} G1.mhi{2} G1.chandle{2} hx2{2} x{2} y{2} Known _ _ _ _) //= 2..3:[smt w=in_dom]. - + rewrite NewLogic.negb_exists=> f /=; rewrite in_rng NewLogic.negb_exists=> h. + + rewrite negb_exists=> f /=; rewrite in_rng negb_exists=> h. exact/(y2_notinr1_FRO h f). have /eqT -> /= := incl_set G1.m{2} PF.m{1} x{2} y{2} _; 1: by smt ml=0. have /eqT -> /= := incl_set G1.mi{2} PF.mi{1} y{2} x{2} _; 1: by smt ml=0. @@ -523,7 +613,7 @@ section AUX. move=> /(congr1 (fun x=> FRO.m{2}.[x])) /=; rewrite FRO_hx2. have:= handles_spec_notin_dom FRO.m{2} G1.chandle{2} _; 1: smt ml=0. by rewrite in_dom /= => ->. - elim bh=> b' h' /=; rewrite anda_and NewLogic.negb_and=> bh_neq_xhx ^mh_bh. + elim bh=> b' h' /=; rewrite anda_and negb_and=> bh_neq_xhx ^mh_bh. have @/eqm_handles [] hmmh hmhm := eqm_of_INV _ _ _ _ _ _ _ _ _ _ hinv. move=> /hmhm=>- [c c' f f'] /= [#] FRO_h' FRO_ch PF_b'c. exists c, c', f, f'=> //=. @@ -544,51 +634,55 @@ section AUX. admit. (* this one should be a lot easier *) admit. (* some pain here *) admit. (* will be painful as well *) - (* Stopped here *) - admit. - (* lossless PF.P.f *) - + admit. - (* lossless and do not reset bad G1.S.f *) - + admit. - (** proofs for G1.S.fi *) - (* equiv PF.P.fi G1.S.fi *) - + admit. - (* lossless PF.P.fi *) - + admit. - (* lossless and do not reset bad G1.S.fi *) - + admit. - (** proofs for G1.C.f *) - (* equiv PF.C.f G1.C.f *) - + admit. - (* lossless PF.C.f *) - + admit. - (* lossless and do not reset bad G1.C.f *) - + admit. - (* Init ok *) - inline *. auto; progress=> //=. - + smt w=map0P. - + smt w=map0P. - + smt w=map0P. - + smt w=map0P. - + smt w=map0P. - + smt w=(map0P in_dom). - + smt w=map0P. - + rewrite /paths_spec=> c p v. rewrite !getP; case (c = c0)=> //=. - rewrite anda_and=> c_c0; split=> [[] <<- <<-|]. - + by exists 0; rewrite /build_hpath /= getP /= c_c0. - move=> [h] @/build_hpath [] h0; rewrite getP; case (h = 0). - + by move=> /= ->> ->>; move: h0; smt. - smt w=map0P. - move=> c_c0; rewrite map0P /= NewLogic.negb_exists /= => h. - rewrite NewLogic.negb_and getP; case (h = 0)=> //=; [|by rewrite map0P]. - by move=> _; right; rewrite eq_sym. - + smt w=(map0P getP). - + by rewrite getP. - + move: H; rewrite in_dom getP; case (h = 0)=> //=. - by rewrite map0P. - + by move: H1=> /H0 [#]. *) - qed. + (* Stopped here *) + + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. + smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). + (* lossless and do not reset bad G1.S.f *) + + move=> _; proc; if; auto. + conseq (_: _ ==> G1.bcol \/ G1.bext); 1:smt (). + inline *; if=> //=; wp; rnd predT; wp; rnd predT; auto. + + smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). + smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). + (** proofs for G1.S.fi *) + (* equiv PF.P.fi G1.S.fi *) + + admit. + (* lossless PF.P.fi *) + + admit. + (* lossless and do not reset bad G1.S.fi *) + + admit. + (** proofs for G1.C.f *) + (* equiv PF.C.f G1.C.f *) + + admit. + (* lossless PF.C.f *) + + admit. + (* lossless and do not reset bad G1.C.f *) + + admit. + (* Init ok *) + admit. +(*inline *. auto; progress=> //=. + + smt w=map0P. + + smt w=map0P. + + smt w=map0P. + + smt w=map0P. + + smt w=map0P. + + smt w=(map0P in_dom). + + smt w=map0P. + + rewrite /paths_spec=> c p v. rewrite !getP; case (c = c0)=> //=. + rewrite anda_and=> c_c0; split=> [[] <<- <<-|]. + + by exists 0; rewrite /build_hpath /= getP /= c_c0. + move=> [h] @/build_hpath [] h0; rewrite getP; case (h = 0). + + by move=> /= ->> ->>; move: h0; smt. + smt w=map0P. + move=> c_c0; rewrite map0P /= negb_exists /= => h. + rewrite negb_and getP; case (h = 0)=> //=; [|by rewrite map0P]. + by move=> _; right; rewrite eq_sym. + + smt w=(map0P getP). + + by rewrite getP. + + move: H; rewrite in_dom getP; case (h = 0)=> //=. + by rewrite map0P. + + by move: H1=> /H0 [#].*) +qed. end section AUX. @@ -605,7 +699,7 @@ section. Pr[G1(DRestr(D)).main() @ &m: res] + (max_size ^ 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 D_ll &m)). + apply (@RealOrder.ler_trans _ _ _ (Real_Concrete D D_ll &m)). cut : Pr[CF(DRestr(D)).main() @ &m : res] <= Pr[G1(DRestr(D)).main() @ &m : res] + Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext]. From 6d0bd779a9c4193f0e7bc27d09010dacd43583c7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 8 Jul 2016 12:38:54 +0100 Subject: [PATCH 170/394] Retrieving the full invariant with better behaviour w.r.t. case. --- sha3/proof/core/Handle.eca | 656 ++++++++++++++++++------------------- 1 file changed, 318 insertions(+), 338 deletions(-) diff --git a/sha3/proof/core/Handle.eca b/sha3/proof/core/Handle.eca index f05c336..755444b 100644 --- a/sha3/proof/core/Handle.eca +++ b/sha3/proof/core/Handle.eca @@ -153,345 +153,307 @@ module G1(D:DISTINGUISHER) = { }. (* -------------------------------------------------------------------------- *) -(** NOTE: this invariant is NOT the one we want: it is missing the constraints on the inverse maps. **) -inductive invariant (hs : handles) (ch : handle) (m1 m2 : smap) (mh : hsmap) (ro : (block list, block) fmap) (pi : (capacity, (block list * block)) fmap) = - | Inv of (forall xa xc ya yc, - m1.[(xa,xc)] = Some (ya,yc) => - exists xh yh xf yf, - hs.[xh] = Some (xc,xf) - /\ hs.[yh] = Some (yc,yf) - /\ mh.[(xa,xh)] = Some (ya,yh)) - & (forall xa xh ya yh, - mh.[(xa,xh)] = Some (ya,yh) => - exists xc yc xf yf, - hs.[xh] = Some (xc,xf) - /\ hs.[yh] = Some (yc,yf) - /\ m1.[(xa,xc)] = Some (ya,yc)) - & (incl m2 m1) - & (forall xa xh ya yh, - mh.[(xa,xh)] = Some (ya,yh) => - exists xc yc xf yf, - hs.[xh] = Some (xc,xf) - /\ hs.[yh] = Some (yc,yf) - /\ if yf = Known - then m2.[(xa,xc)] = Some (ya,yc) - /\ xf = Known - else exists p v b, - ro.[rcons p b] = Some ya - /\ build_hpath mh p = Some (v,xh) - /\ xa = v +^ b) - & (forall p xa b, - ro.[rcons p xa] = Some b <=> - exists v xh yh, - build_hpath mh p = Some (v,xh) - /\ mh.[(v +^ xa,xh)] = Some (b,yh)) - & (forall c p v, - pi.[c] = Some (p,v) <=> - exists h, - build_hpath mh p = Some(v,h) - /\ hs.[h] = Some (c,Known)) - & (huniq hs) - & (hs.[0] = Some (c0,Known)) - & (forall h, mem (dom hs) h => h < ch). - -(* inductive eqm_handles (handles:handles) (m:smap) (mh:hsmap) = *) -(* | MH of (forall bc bc', m.[bc] = Some bc' => *) -(* exists h h' f f', *) -(* handles.[h ] = Some(bc .`2,f ) /\ *) -(* handles.[h'] = Some(bc'.`2,f') /\ *) -(* mh.[(bc.`1, h)] = Some (bc'.`1,h')) *) -(* & (forall bh bh', mh.[bh] = Some bh' => *) -(* exists c c' f f', *) -(* handles.[bh .`2] = Some(c ,f) /\ *) -(* handles.[bh'.`2] = Some(c',f') /\ *) -(* m.[(bh.`1, c)] = Some (bh'.`1,c')). *) - -(* inductive mh_spec (handles:handles) (m2:smap) (mh:hsmap) (ro:(block list, block)fmap) = *) -(* | H of (forall bh bh', mh.[bh] = Some bh' => *) -(* exists c c' f f', *) -(* handles.[bh .`2]=Some(c,f) /\ *) -(* handles.[bh'.`2]=Some(c',f') /\ *) -(* if f' = Known *) -(* then m2.[(bh.`1,c)] = Some(bh'.`1,c') /\ f = Known *) -(* else exists p v b, *) -(* ro.[rcons p b] = Some bh'.`1 /\ *) -(* build_hpath mh p = Some(v,bh.`2) /\ *) -(* bh.`1 = v +^ b) *) -(* & (forall p b, mem (dom ro) (rcons p b) <=> *) -(* exists v h h', *) -(* build_hpath mh p = Some (v,h) /\ *) -(* mh.[(v +^ b,h)] = Some (oget ro.[rcons p b], h')). *) - -(* inductive paths_spec (handles:handles) (mh:hsmap) (paths:(capacity,block list * block)fmap) = *) -(* | P of (forall c p v, paths.[c] = Some(p,v) <=> *) -(* exists h, *) -(* build_hpath mh p = Some(v,h) /\ *) -(* handles.[h] = Some(c,Known)). *) - -(* inductive handles_spec handles chandle = *) -(* | Hs of (huniq handles) *) -(* & (handles.[0] = Some (c0,Known)) *) -(* & (forall h, mem (dom handles) h => h < chandle). *) - -(* inductive INV_CF_G1 (handles:handles) chandle (m1 mi1 m2 mi2:smap) (mh2 mhi2:hsmap) (ro:(block list, block) fmap) paths = *) -(* | CF_G1 of (eqm_handles handles m1 mh2) *) -(* & (eqm_handles handles mi1 mhi2) *) -(* & (incl m2 m1) *) -(* & (incl mi2 mi1) *) -(* & (mh_spec handles m2 mh2 ro) *) -(* & (paths_spec handles mh2 paths) *) -(* & (handles_spec handles chandle). *) - -(* lemma eqm_of_INV (chandle : handle) *) -(* (mi1 m2 mi2 : smap) (mhi2 : hsmap) *) -(* (ro : (block list, block) fmap) *) -(* (paths : (capacity, block list * block) fmap) *) -(* handles m1 mh2: *) -(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) -(* eqm_handles handles m1 mh2. *) -(* proof. by case. qed. *) - -(* lemma eqmi_of_INV (chandle : handle) *) -(* (m1 m2 mi2 : smap) (mh2 : hsmap) *) -(* (ro : (block list, block) fmap) *) -(* (paths : (capacity, block list * block) fmap) *) -(* handles mi1 mhi2: *) -(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) -(* eqm_handles handles mi1 mhi2. *) -(* proof. by case. qed. *) - -(* lemma incl_of_INV (handles : handles) (chandle : handle) *) -(* (mi1 mi2 : smap) (mh2 mhi2: hsmap) *) -(* (ro : (block list, block) fmap) *) -(* (paths : (capacity, block list * block) fmap) *) -(* m1 m2: *) -(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) -(* incl m2 m1. *) -(* proof. by case. qed. *) - -(* lemma incli_of_INV (handles : handles) (chandle : handle) *) -(* (m1 m2 : smap) (mh2 mhi2: hsmap) *) -(* (ro : (block list, block) fmap) *) -(* (paths : (capacity, block list * block) fmap) *) -(* mi1 mi2: *) -(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) -(* incl mi2 mi1. *) -(* proof. by case. qed. *) - -(* lemma mh_of_INV (chandle : handle) *) -(* (m1 mi1 mi2 : smap) (mhi2 : hsmap) *) -(* (paths : (capacity, block list * block) fmap) *) -(* handles m2 mh2 ro: *) -(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) -(* mh_spec handles m2 mh2 ro. *) -(* proof. by case. qed. *) - -(* lemma paths_of_INV (chandle : handle) *) -(* (m1 m2 mi1 mi2: smap) (mhi2: hsmap) *) -(* (ro : (block list, block) fmap) *) -(* handles mh2 paths: *) -(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) -(* paths_spec handles mh2 paths. *) -(* proof. by case. qed. *) - -(* lemma handles_of_INV (m1 m2 mi1 mi2 : smap) (mh2 mhi2 : hsmap) *) -(* (ro : (block list, block) fmap) *) -(* (paths : (capacity, block list * block) fmap) *) -(* handles chandle: *) -(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) -(* handles_spec handles chandle. *) -(* proof. by case. qed. *) - -(* lemma eqm_dom_mh_m handles m mh hx2 f (x:state): *) -(* eqm_handles handles m mh => *) -(* handles.[hx2] = Some (x.`2, f) => *) -(* mem (dom mh) (x.`1, hx2) => mem (dom m) x. *) -(* proof. *) -(* move=>[]H1 H2 Hhx2;rewrite !in_dom. *) -(* case: (mh.[_]) (H2 (x.`1,hx2))=> //= bh' /(_ bh') [c c' f1 f1']. *) -(* by rewrite Hhx2=> /= -[][]<<- _;case:(x)=> ??[]_->. *) -(* qed. *) - -(* lemma chandle_ge0 handles chandle : handles_spec handles chandle => 0 < chandle. *) -(* proof. by case=> _ Heq Hlt; apply Hlt; rewrite in_dom Heq. qed. *) - -(* lemma chandle_0 handles chandle : handles_spec handles chandle => 0 <> chandle. *) -(* proof. by move=> Hh;apply/ltr_eqF/(@chandle_ge0 _ _ Hh). qed. *) - -(* lemma eqm_up_handles handles chandle m mh x2 : *) -(* handles_spec handles chandle => *) -(* eqm_handles handles m mh => *) -(* eqm_handles handles.[chandle <- (x2, Known)] m mh. *) -(* proof. *) -(* case=> Hu Hh0 Hlt [] m_some mh_some; split. *) -(* + move=> bc bc' /m_some [h h' f f'] [#] Hh Hh' Hmh. *) -(* exists h, h', f, f'; rewrite !getP Hmh -Hh -Hh' /=. *) -(* rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. *) -(* by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. *) -(* move=> bh bh' /mh_some [c c' f f'] [#] Hh Hh' Hm. *) -(* exists c, c', f, f'; rewrite !getP Hm -Hh -Hh'. *) -(* rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. *) -(* by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. *) -(* qed. *) - -(* lemma mh_up_handles handles chandle m2 mh ro cf: *) -(* handles_spec handles chandle => *) -(* mh_spec handles m2 mh ro => *) -(* mh_spec handles.[chandle <- cf] m2 mh ro. *) -(* proof. *) -(* move=> + [] mh_some ?=> -[] _ _ Hlt; split=> // bh bh' /mh_some [c c' f f'] [#] Hh Hh' Hif. *) -(* exists c,c',f,f'; rewrite Hif -Hh -Hh' !getP. *) -(* rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. *) -(* by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. *) -(* qed. *) - -(* lemma paths_up_handles m2 ro handles mh paths cf chandle: *) -(* mh_spec handles m2 mh ro => *) -(* handles_spec handles chandle => *) -(* paths_spec handles mh paths => *) -(* paths_spec handles.[chandle <- cf] mh paths. *) -(* proof. *) -(* move=> Hmh Hh [] Hp; split=> c p v; rewrite Hp; apply exists_iff=> x /=. *) -(* split=>- [] ^Hbu -> /=; rewrite getP. *) -(* + case: Hh=> _ _ Hlt x_in_handles. *) -(* by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom x_in_handles. *) -(* case: (x = chandle)=> //=. *) -(* move: Hbu=> /build_hpathP [[#] _ _ ->|[p' b v' h' [#] _ _ Hh']]. *) -(* + by rewrite (@chandle_0 _ _ Hh). *) -(* case: Hh=> _ _ /(_ x) Hlt; rewrite ltr_eqF //. *) -(* by apply/Hlt; rewrite in_dom; case: Hmh=> /(_ _ _ Hh') [????] [#] _ ->. *) -(* qed. *) - -(* lemma handles_up_handles handles chandle x2 f': *) -(* (forall (f : flag), ! mem (rng handles) (x2, f)) => *) -(* handles_spec handles chandle => *) -(* handles_spec handles.[chandle <- (x2, f')] (chandle + 1). *) -(* proof. *) -(* move=> Hx2 ^Hh [] Hu Hh0 Hlt; split. *) -(* + move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. *) -(* case: (h1 = chandle)=> /= [-> [] ->> ->|_]; (case: (h2 = chandle)=> [-> //= |_]). *) -(* + by move=> Heq ->>; move: (Hx2 f2); rewrite in_rng negb_exists=> /= /(_ h2). *) -(* + by move=> Heq [] ->> <<- ->>; move: (Hx2 f1); rewrite in_rng negb_exists=> /= /(_ h1). *) -(* by apply Hu. *) -(* + by rewrite getP (@chandle_0 _ _ Hh). *) -(* + by move=> h; rewrite dom_set !inE /#. *) -(* qed. *) - -(* lemma INV_CF_G1_up_handles handles chandle m1 mi1 m2 mi2 mh mhi ro paths x2: *) -(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh mhi ro paths => *) -(* (forall f, ! mem (rng handles) (x2, f)) => *) -(* INV_CF_G1 handles.[chandle <- (x2, Known)](chandle+1) m1 mi1 m2 mi2 mh mhi ro paths. *) -(* proof. *) -(* case=> Heqm Heqmi Hincl Hincli Hmh Hp Hh Hx2; split. *) -(* + exact/eqm_up_handles. *) -(* + exact/eqm_up_handles. *) -(* + done. *) -(* + done. *) -(* + exact/mh_up_handles. *) -(* + exact/(paths_up_handles m2 ro). *) -(* exact/handles_up_handles. *) -(* qed. *) - -(* lemma eqm_handles_up (handles : handles) m mh (h hx:handle) (x y : state) f: *) -(* huniq handles => *) -(* handles.[h] = None => *) -(* handles.[hx] = Some (x.`2, f) => *) -(* eqm_handles handles m mh => *) -(* eqm_handles handles.[h <- (y.`2,Known)] m.[x <- y] mh.[(x.`1,hx) <- (y.`1,h)]. *) -(* proof. *) -(* move=> uniq_h h_h h_hx @/eqm_handles [] hmmh hmhm; split. *) -(* + move=> bc bc'; rewrite getP; case (bc = x)=> /= [->> <<- {bc bc'}|]. *) -(* * by exists hx, h, f, Known; rewrite !getP /= [smt (in_dom)]. *) -(* move=> bc_neq_x /hmmh [] h0 h0' f0 f0' [#] h_h0 h_h0' mhi_bc. *) -(* by exists h0, h0', f0, f0'; rewrite !getP [smt (in_dom)]. *) -(* move=> bh bh'; rewrite getP; case (bh = (x.`1,hx))=> /= [->> <<- {bh bh'}|]. *) -(* * by exists x.`2, y.`2, f, Known; rewrite !getP [smt (in_dom)]. *) -(* case bh=> b h0 /=. *) -(* rewrite anda_and negb_and=> bh_neq_x1hx /hmhm /= [] c0 c0' f0 f0' [#] h_h0 h_bh' m_bc. *) -(* exists c0, c0', f0, f0'; rewrite !getP. *) -(* split; 1:smt (in_dom). *) -(* split; 1:smt (in_dom). *) -(* case x bh_neq_x1hx h_hx=> x1 x2 /= => - [/#|h0_neq_hx h_hx]. *) -(* have -> //=: c0 <> x2; move: h0_neq_hx; apply/contra. *) -(* exact/(@uniq_h _ _ _ _ h_h0 h_hx). *) -(* qed. *) - -(* lemma eqmi_handles_up (handles : handles) mi mhi (h hx : handle) (x y : state) f: *) -(* (!exists f', mem (rng handles) (y.`2,f')) => *) -(* handles.[h] = None => *) -(* handles.[hx] = Some (x.`2, f) => *) -(* eqm_handles handles mi mhi => *) -(* eqm_handles handles.[h <- (y.`2,Known)] mi.[y <- x] mhi.[(y.`1,h) <- (x.`1,hx)]. *) -(* proof. *) -(* move=> y_notinr1_handles h_h h_hx @/eqm_handles [] hmmh hmhm; split. *) -(* + move=> bc bc'; rewrite getP; case (bc = y)=> /= [->> <<- {bc bc'}|]. *) -(* * by exists h, hx, Known, f; rewrite !getP /= [smt (in_dom)]. *) -(* move=> bc_neq_y /hmmh [] h0 h0' f0 f0' [#] h_h0 h_h0' mhi_bc. *) -(* by exists h0, h0', f0, f0'; rewrite !getP [smt (in_dom)]. *) -(* move=> bh bh'; rewrite getP; case (bh = (y.`1,h))=> /= [->> <<- {bh bh'}|]. *) -(* * by exists y.`2, x.`2, Known, f; rewrite !getP [smt (in_dom)]. *) -(* case bh=> b h0 /=. *) -(* rewrite anda_and negb_and=> bh_neq_y1h /hmhm /= [] c0 c0' f0 f0' [#] h_bh h_bh' mi_bh. *) -(* exists c0, c0', f0, f0'; rewrite !getP. *) -(* split; 1:smt (in_dom). *) -(* split; 1:smt (in_dom). *) -(* case y bh_neq_y1h y_notinr1_handles=> y1 y2 /= [/#|h0_neq_h y_notinr1_handles]. *) -(* have /#: c0 = y2 => false; move=> /(congr1 (fun x=> exists f', mem (rng handles) (x,f'))) /=. *) -(* rewrite y_notinr1_handles /= neqF /=; exists f0. *) -(* by rewrite in_rng; exists h0. *) -(* qed. *) - -(* lemma incl_set (m m' : ('a,'b) fmap) x y: *) -(* incl m m' => *) -(* incl m.[x <- y] m'.[x <- y]. *) -(* proof. smt (in_dom getP). qed. *) - -(* lemma hinv_notin_rng m y2: *) -(* SLCommon.hinv m y2 = None => *) -(* (forall h f, m.[h] <> Some (y2,f)). *) -(* proof. by move=> hinv_none; have:= hinvP m y2; rewrite hinv_none. qed. *) - -(* lemma handles_spec_notin_dom m h: *) -(* handles_spec m h => *) -(* !mem (dom m) h. *) -(* proof. case; smt (in_dom). qed. *) - -(* lemma neq_Known f: f <> Known <=> f = Unknown. *) -(* proof. by case f. qed. *) - -(* lemma neq_Unkwown f: f <> Unknown <=> f = Known. *) -(* proof. by case f. qed. *) +inductive eqm_handles (hs : handles) (m : smap) (mh : hsmap) = + | MH of (forall xa xc ya yc, + m.[(xa,xc)] = Some (ya,yc) => + exists xh yh xf yf, + hs.[xh] = Some (xc,xf) + /\ hs.[yh] = Some (yc,yf) + /\ mh.[(xa,xh)] = Some (ya,yh)) + & (forall xa xh ya yh, + mh.[(xa,xh)] = Some (ya,yh) => + exists xc yc xf yf, + hs.[xh] = Some (xc,xf) + /\ hs.[yh] = Some (yc,yf) + /\ m.[(xa,xc)] = Some (ya,yc)). + +inductive mh_spec (hs : handles) (m2 : smap) (mh : hsmap) (ro : (block list,block) fmap) = + | H of (forall xa xh ya yh, + mh.[(xa,xh)] = Some (ya,yh) => + exists xc yc xf yf, + hs.[xh] = Some (xc,xf) + /\ hs.[yh] = Some (yc,yf) + /\ if yf = Known + then m2.[(xa,xc)] = Some (ya,yc) + /\ xf = Known + else exists p v b, + ro.[rcons p b] = Some ya + /\ build_hpath mh p = Some (v,xh) + /\ xa = v +^ b) + & (forall p xa b, + ro.[rcons p xa] = Some b <=> + exists v xh yh, + build_hpath mh p = Some (v,xh) + /\ mh.[(v +^ xa,xh)] = Some (b,yh)). + +inductive paths_spec (hs : handles) (mh : hsmap) (pi : (capacity,block list*block) fmap) = + | P of (forall c p v, + pi.[c] = Some (p,v) <=> + exists h, + build_hpath mh p = Some(v,h) + /\ hs.[h] = Some (c,Known)). + +inductive handles_spec hs ch = + | Hs of (huniq hs) + & (hs.[0] = Some (c0,Known)) + & (forall h, mem (dom hs) h => h < ch). + +inductive INV_CF_G1 (hs : handles) ch (m1 mi1 m2 mi2 : smap) + (mh2 mhi2 : hsmap) (ro : (block list,block) fmap) pi = + | HCF_G1 of (eqm_handles hs m1 mh2) + & (eqm_handles hs mi1 mhi2) + & (incl m2 m1) + & (incl mi2 mi1) + & (mh_spec hs m2 mh2 ro) + & (paths_spec hs mh2 pi) + & (handles_spec hs ch). + +lemma eqm_of_INV (ch : handle) + (mi1 m2 mi2 : smap) (mhi2 : hsmap) + (ro : (block list, block) fmap) + (pi : (capacity, block list * block) fmap) + hs m1 mh2: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + eqm_handles hs m1 mh2. +proof. by case. qed. + +lemma eqmi_of_INV (ch : handle) + (m1 m2 mi2 : smap) (mh2 : hsmap) + (ro : (block list, block) fmap) + (pi : (capacity, block list * block) fmap) + hs mi1 mhi2: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + eqm_handles 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: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + 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: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + 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: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + mh_spec hs m2 mh2 ro. +proof. by case. qed. + +lemma paths_of_INV (ch : handle) + (m1 m2 mi1 mi2: smap) (mhi2: hsmap) + (ro : (block list, block) fmap) + hs mh2 pi: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + paths_spec hs mh2 pi. +proof. by case. qed. + +lemma handles_of_INV (m1 m2 mi1 mi2 : smap) (mh2 mhi2 : hsmap) + (ro : (block list, block) fmap) + (pi : (capacity, block list * block) fmap) + hs ch: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + handles_spec hs ch. +proof. by case. qed. + +lemma eqm_dom_mh_m hs m mh hx2 f (x:state): + eqm_handles hs m mh => + hs.[hx2] = Some (x.`2, f) => + mem (dom mh) (x.`1, hx2) => mem (dom m) x. +proof. +move=>[]H1 H2 Hhx2;rewrite !in_dom. +case: (mh.[_]) (H2 x.`1 hx2) => //= -[] b' h' /(_ b' h') [c c' f1 f1']. +by rewrite Hhx2=> /= -[][]<<- _;case:(x)=> ??[]_->. +qed. + +lemma chandle_ge0 hs ch : handles_spec hs ch => 0 < ch. +proof. by case=> _ Heq Hlt; apply Hlt; rewrite in_dom Heq. qed. + +lemma chandle_0 hs ch : handles_spec hs ch => 0 <> ch. +proof. by move=> Hh;apply/ltr_eqF/(@chandle_ge0 _ _ Hh). qed. + +lemma eqm_up_handles hs ch m mh x2 : + handles_spec hs ch => + eqm_handles hs m mh => + eqm_handles hs.[ch <- (x2, Known)] m mh. +proof. +case=> Hu Hh0 Hlt [] m_some mh_some; split. ++ move=> xb xc xb' xc' /m_some [h h' f f'] [#] Hh Hh' Hmh. + exists h, h', f, f'; rewrite !getP Hmh -Hh -Hh' /=. + rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. + by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. +move=> xb xh xb' xh' /mh_some [c c' f f'] [#] Hh Hh' Hm. +exists c, c', f, f'; rewrite !getP Hm -Hh -Hh'. +rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. +by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. +qed. + +lemma mh_up_handles hs ch m2 mh ro cf: + handles_spec hs ch => + mh_spec hs m2 mh ro => + mh_spec hs.[ch <- cf] m2 mh ro. +proof. +move=> + [] mh_some ?=> -[] _ _ Hlt; split=> // b h b' h' /mh_some [c c' f f'] [#] Hh Hh' Hif. +exists c,c',f,f'; rewrite Hif -Hh -Hh' !getP. +rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. +by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. +qed. + +lemma paths_up_handles m2 ro hs mh pi cf ch: + mh_spec hs m2 mh ro => + handles_spec hs ch => + paths_spec hs mh pi => + paths_spec hs.[ch <- cf] mh pi. +proof. +move=> Hmh Hh [] Hp; split=> c p v; rewrite Hp; apply exists_iff=> x /=. +split=>- [] ^Hbu -> /=; rewrite getP. ++ case: Hh=> _ _ Hlt x_in_handles. + by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom x_in_handles. +case: (x = ch)=> //=. +move: Hbu=> /build_hpathP [[#] _ _ ->|[p' b v' h' [#] _ _ Hh']]. ++ by rewrite (@chandle_0 _ _ Hh). +case: Hh=> _ _ /(_ x) Hlt; rewrite ltr_eqF //. +by apply/Hlt; rewrite in_dom; case: Hmh=> /(_ _ _ _ _ Hh') [????] [#] _ ->. +qed. + +lemma handles_up_handles hs ch x2 f': + (forall (f : flag), ! mem (rng hs) (x2, f)) => + handles_spec hs ch => + handles_spec hs.[ch <- (x2, f')] (ch + 1). +proof. +move=> Hx2 ^Hh [] Hu Hh0 Hlt; split. ++ move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. + case: (h1 = ch)=> /= [-> [] ->> ->|_]; (case: (h2 = ch)=> [-> //= |_]). + + by move=> Heq ->>; move: (Hx2 f2); rewrite in_rng negb_exists=> /= /(_ h2). + + by move=> Heq [] ->> <<- ->>; move: (Hx2 f1); rewrite in_rng negb_exists=> /= /(_ h1). + by apply Hu. ++ by rewrite getP (@chandle_0 _ _ Hh). ++ by move=> h; rewrite dom_set !inE /#. +qed. + +lemma INV_CF_G1_up_handles hs ch m1 mi1 m2 mi2 mh mhi ro pi x2: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh mhi ro pi => + (forall f, !mem (rng hs) (x2, f)) => + INV_CF_G1 hs.[ch <- (x2, Known)] (ch + 1) m1 mi1 m2 mi2 mh mhi ro pi. +proof. +case=> Heqm Heqmi Hincl Hincli Hmh Hp Hh Hx2. +exact/(HCF_G1 (eqm_up_handles Hh Heqm) (eqm_up_handles Hh Heqmi) + _ _ + (:@mh_up_handles _ _ _ _ _ (x2,Known) Hh Hmh) + (:@paths_up_handles m2 ro _ _ _ (x2,Known) _ Hmh Hh Hp) + (:@handles_up_handles _ _ x2 Known _ Hh)). +qed. + +lemma eqm_handles_up (hs : handles) m mh (h hx:handle) (x y : state) f: + huniq hs => + hs.[h] = None => + hs.[hx] = Some (x.`2, f) => + eqm_handles hs m mh => + eqm_handles hs.[h <- (y.`2,Known)] m.[x <- y] mh.[(x.`1,hx) <- (y.`1,h)]. +proof. +move=> uniq_h h_h h_hx @/eqm_handles [] hmmh hmhm; split. ++ move=> b c b' c'; rewrite getP; case ((b,c) = x)=> /= [<<- ->> {x y} /=|]. + * by exists hx, h, f, Known; rewrite !getP /= [smt (in_dom)]. + move=> bc_neq_x /hmmh [] h0 h0' f0 f0' [#] h_h0 h_h0' mhi_bc. + by exists h0, h0', f0, f0'; rewrite !getP [smt (in_dom)]. +move=> xb xh b' h'; rewrite getP; case ((xb,xh) = (x.`1,hx))=> /= [[#] <*> [#] <*>|]. + * by exists x.`2, y.`2, f, Known; rewrite !getP [smt (in_dom)]. +rewrite anda_and negb_and=> bh_neq_x1hx /hmhm /= [] c0 c0' f0 f0' [#] h_h0 h_bh' m_bc. +exists c0, c0', f0, f0'; rewrite !getP. +split; 1:smt (in_dom). +split; 1:smt (in_dom). +case x bh_neq_x1hx h_hx=> x1 x2 /= => - [/#|h0_neq_hx h_hx]. +have -> //=: c0 <> x2; move: h0_neq_hx; apply/contra. +exact/(@uniq_h _ _ _ _ h_h0 h_hx). +qed. + +lemma eqmi_handles_up (hs : handles) mi mhi (h hx : handle) (x y : state) f: + (!exists f', mem (rng hs) (y.`2,f')) => + hs.[h] = None => + hs.[hx] = Some (x.`2, f) => + eqm_handles hs mi mhi => + eqm_handles hs.[h <- (y.`2,Known)] mi.[y <- x] mhi.[(y.`1,h) <- (x.`1,hx)]. +proof. +move=> y_notinr1_handles h_h h_hx @/eqm_handles [] hmmh hmhm; split. ++ move=> xb xc xb' xc'; rewrite getP; case ((xb,xc) = y)=> /= [<<- ->> {x y}|]. + * by exists h, hx, Known, f; rewrite !getP /= [smt (in_dom)]. + move=> bc_neq_y /hmmh [] h0 h0' f0 f0' [#] h_h0 h_h0' mhi_bc. + by exists h0, h0', f0, f0'; rewrite !getP [smt (in_dom)]. +move=> xb xh xb' xh'; rewrite getP; case ((xb,xh) = (y.`1,h))=> /= [[#] <*> [#] <*>|]. + * by exists y.`2, x.`2, Known, f; rewrite !getP [smt (in_dom)]. +rewrite anda_and negb_and=> bh_neq_y1h /hmhm /= [] c0 c0' f0 f0' [#] h_bh h_bh' mi_bh. +exists c0, c0', f0, f0'; rewrite !getP. +split; 1:smt (in_dom). +split; 1:smt (in_dom). +case y bh_neq_y1h y_notinr1_handles=> y1 y2 /= [/#|h0_neq_h y_notinr1_handles]. +have /#: c0 = y2 => false; move=> /(congr1 (fun x=> exists f', mem (rng hs) (x,f'))) /=. +rewrite y_notinr1_handles /= neqF /=; exists f0. +by rewrite in_rng; exists xh. +qed. + +lemma incl_set (m m' : ('a,'b) fmap) x y: + incl m m' => + incl m.[x <- y] m'.[x <- y]. +proof. smt (in_dom getP). qed. + +lemma hinv_notin_rng m y2: + SLCommon.hinv m y2 = None => + (forall h f, m.[h] <> Some (y2,f)). +proof. by move=> hinv_none; have:= hinvP m y2; rewrite hinv_none. qed. + +lemma handles_spec_notin_dom m h: + handles_spec m h => + !mem (dom m) h. +proof. case; smt (in_dom). qed. + +lemma neq_Known f: f <> Known <=> f = Unknown. +proof. by case f. qed. + +lemma neq_Unkwown f: f <> Unknown <=> f = Known. +proof. by case f. qed. op getflag (hs : handles) xc = omap snd (obind ("_.[_]" hs) (hinv hs xc)). -(* lemma getflagP hs xc f: *) -(* huniq hs => *) -(* (mem (rng hs) (xc,f) <=> getflag hs xc = Some f). *) -(* proof. *) -(* move=> huniq_hs; split. *) -(* + rewrite in_rng=> -[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. *) -(* rewrite /getflag; case: (hinvP hs xc)=> [-> //|]. *) -(* rewrite in_rng; case: (hinv hs xc)=> //= h [f']. *) -(* rewrite oget_some=> ^ hs_h -> @/snd /= ->>. *) -(* by exists h. *) -(* qed. *) - -(* lemma paths_prefix handles m2 mh ro paths c b p v: *) -(* mh_spec handles m2 mh ro => *) -(* paths_spec handles mh paths => *) -(* paths.[c] = Some (rcons p b,v) => *) -(* (exists c' v', paths.[c'] = Some (p,v')). *) -(* proof. *) -(* move=> [] mh_some _ [] hpaths ^paths_c. *) -(* move=> /hpaths [h] [#] /build_hpathP [/#|] [p' b' v' h'] [#] ^/rconsIs + /rconssI- <*>. *) -(* move=> hpath + handles_h - /mh_some /= [c' c0 f' f]; rewrite handles_h /= => /> handles_h' _. *) -(* by exists c', v'; rewrite hpaths; exists h'. *) -(* qed. *) +lemma getflagP hs xc f: + huniq hs => + (mem (rng hs) (xc,f) <=> getflag hs xc = Some f). +proof. +move=> huniq_hs; split. ++ rewrite in_rng=> -[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. +rewrite /getflag; case: (hinvP hs xc)=> [-> //|]. +rewrite in_rng; case: (hinv hs xc)=> //= h [f']. +rewrite oget_some=> ^ hs_h -> @/snd /= ->>. +by exists h. +qed. + +lemma paths_prefix handles m2 mh ro paths c b p v: + mh_spec handles m2 mh ro => + paths_spec handles mh paths => + paths.[c] = Some (rcons p b,v) => + (exists c' v', paths.[c'] = Some (p,v')). +proof. +move=> [] mh_some _ [] hpaths ^paths_c. +move=> /hpaths [h] [#] /build_hpathP [/#|] [p' b' v' h'] [#] ^/rconsIs + /rconssI- <*>. +move=> hpath + handles_h - /mh_some /= [c' c0 f' f]; rewrite handles_h /= => /> handles_h' _. +by exists c', v'; rewrite hpaths; exists h'. +qed. lemma build_hpath_prefix mh p b v h: build_hpath mh (rcons p b) = Some (v,h) => @@ -504,6 +466,17 @@ qed. clone export ConcreteF as ConcreteF1. +inductive if_ind (b t e: bool) = + | Then of b & (b => t) + | Else of (!b) & (!b => e). + +lemma ifP (b t e : bool): (if b then t else e) <=> if_ind b t e. +proof. +split; case: b=> _ => [t_|e_|[]//|[]//]. ++ exact/Then. +exact/Else. +qed. + section AUX. declare module D : DISTINGUISHER {PF, RO, G1}. @@ -517,7 +490,8 @@ section AUX. proof. proc. call (_: G1.bcol \/ G1.bext, - invariant FRO.m{2} G1.chandle{2} PF.m{1} G1.m{2} G1.mh{2} F.RO.m{2} G1.paths{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}). (* lossless D *) + exact/D_ll. (** proofs for G1.S.f *) @@ -531,7 +505,7 @@ section AUX. seq 2 3: ( !G1.bcol{2} /\ (G1.bext <=> mem (rng FRO.m) (x.`2, Unknown)){2} /\ ={x,y1,y2} - /\ invariant FRO.m{2} G1.chandle{2} PF.m{1} G1.m{2} G1.mh{2} ro0 G1.paths{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} ro0 G1.paths{2} /\ ! mem (dom PF.m{1}) x{1} /\ (if mem (dom G1.paths) x.`2 then let (p,v) = oget G1.paths.[x.`2] in @@ -541,7 +515,7 @@ section AUX. + by auto=> |> &1 &2; rewrite negb_or; case=> -> ->. inline{2} F.RO.get; rcondt{2} 4. + auto=> |> &m'; case: (x{m'})=> /= _x1 _x2 _ [] - m_some mh_some leq in_mh in_ro in_pi hs_inj hs0 hs_dom + + r0 _ - {r0} + x2_in_pi. + [] m_some mh_some _ leq _ [] in_mh in_ro [] in_pi [] hs_inj hs0 hs_dom + + r0 _ - {r0} + x2_in_pi. have:= x2_in_pi; rewrite in_dom. case: {-1}(G1.paths.[_x2]{m'}) (eq_refl (G1.paths.[_x2]{m'}))=> //= -[] p v paths_x2. rewrite oget_some /=; have /in_pi [h_x2] [#] pv_hx2 hs_h_x2:= paths_x2. @@ -556,6 +530,12 @@ section AUX. move=> [p v] paths_x2 y1' _ y2' _; rewrite oget_some /=. rewrite getP /= oget_some /= => x1 x2 [] <- <-. by rewrite getP /= oget_some. + auto=> &1 &2; case: (x{2})=> [] x1 x2 /= [#] not_bcol bext_upd <*>. + rewrite ifP=> Hinv x_notin_PF ROupd. + split=> /= [x2K_notin_rFRO|x2K_in_rFRO]. + + split=> /= [#]. + + admit. + admit. admit. (* swap{2} 3-2;swap{2}6-4;wp;conseq (_:y{1} =(r,y2){2}). + progress [-split];rewrite getP_eq oget_some H2/=. From 9787f7591909ee176e64158af33a3373dd711b34 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Mon, 11 Jul 2016 22:50:06 -0400 Subject: [PATCH 171/394] Work in progress on top-level proof; more tomorrow. --- sha3/proof/Sponge.ec | 30 ++++++++++++++++++++++++++---- 1 file changed, 26 insertions(+), 4 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index acf6b34..67439ae 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -647,12 +647,12 @@ wp; exists* i{1}; elim*=> i1; exists* bs{2}; elim*=> bs2. conseq (_ : n1 = n{1} /\ 0 <= n1 /\ i1 = i{1} /\ bs2 = bs{2} /\ xs{1} = x{2} /\ - i{1} = i{2} * r /\ n{1} <= m{1} /\ m{1} - i{1} = r /\ - bs{1} = blocks2bits bs2 /\ + i{1} = i{2} * r /\ n{1} <= m{1} /\ m{1} - i{1} = r /\ i{1} <= n{1} /\ + bs{1} = blocks2bits bs2 /\ size bs{1} = i1 /\ size bs{2} = i{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs2 ++ take (n1 - i1) (ofblock b{2}) /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). -progress; smt(). +progress; smt(lez_floor size_blocks2bits). move=> |> &1 &2 ? ? sz_eq ? ? ? mp1 mp2 b ?. split. rewrite -cats1 blocks2bits_cat blocks2bits_sing take_cat. @@ -661,7 +661,29 @@ have -> /= : !(n{1} < size(blocks2bits bs{2})). by smt(needed_blocks_correct). by rewrite size_blocks2bits sz_eq; congr; congr; smt(). by rewrite size_rcons; smt(). -admit. +transitivity{1} + { while (i < m) { + b <@ HybridIROEager.fill_in(xs, i); + bs <- rcons bs b; + i <- i + 1; + } + } + (={bs, m, i, HybridIROEager.mp} /\ n1 = n{1} /\ i1 = i{1} /\ + i1 <= n1 /\ n1 <= m{1} /\ size bs{1} = i1 ==> + ={HybridIROEager.mp} /\ i1 <= n1 /\ bs{1} = take n1 bs{2}) + (n1 = n{1} /\ 0 <= n1 /\ i1 = i{1} /\ i1 <= n1 /\ bs2 = bs{2} /\ + xs{1} = x{2} /\ i{1} = i{2} * r /\ n1 <= m{1} /\ m{1} - i{1} = r /\ + bs{1} = blocks2bits bs2 /\ size(blocks2bits bs2) = i1 /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + bs{1} = blocks2bits bs2 ++ ofblock b{2} /\ size(blocks2bits bs2) = i1 /\ + n1 - i1 <= size(ofblock b{2}) /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). +progress; exists HybridIROEager.mp{1}, (blocks2bits bs{2}); + smt(size_blocks2bits). +progress; smt(take_cat). +splitwhile{2} 1 : i < n. +admit. +admit. qed. lemma HybridIROEager_BlockIRO_f : From 8341f0048bc049fa84dc754ee15487733126f22a Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 12 Jul 2016 14:10:17 -0400 Subject: [PATCH 172/394] More progress on top-level proof. --- sha3/proof/Sponge.ec | 48 +++++++++++++++++++++++++++++++++++--------- 1 file changed, 38 insertions(+), 10 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 67439ae..6bdee16 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -668,21 +668,49 @@ transitivity{1} i <- i + 1; } } - (={bs, m, i, HybridIROEager.mp} /\ n1 = n{1} /\ i1 = i{1} /\ - i1 <= n1 /\ n1 <= m{1} /\ size bs{1} = i1 ==> + (={bs, m, i, xs, HybridIROEager.mp} /\ n1 = n{1} /\ i1 <= n1 /\ + i{1} <= n1 /\ size bs{1} = i{1} /\ n1 <= m{1} ==> ={HybridIROEager.mp} /\ i1 <= n1 /\ bs{1} = take n1 bs{2}) - (n1 = n{1} /\ 0 <= n1 /\ i1 = i{1} /\ i1 <= n1 /\ bs2 = bs{2} /\ - xs{1} = x{2} /\ i{1} = i{2} * r /\ n1 <= m{1} /\ m{1} - i{1} = r /\ - bs{1} = blocks2bits bs2 /\ size(blocks2bits bs2) = i1 /\ + (i1 = i{1} /\ xs{1} = x{2} /\ i{1} = i{2} * r /\ n1 = n{1} /\ + n1 <= m{1} /\ bs{1} = blocks2bits bs2 /\ size(blocks2bits bs2) = i1 /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs2 ++ ofblock b{2} /\ size(blocks2bits bs2) = i1 /\ - n1 - i1 <= size(ofblock b{2}) /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). -progress; exists HybridIROEager.mp{1}, (blocks2bits bs{2}); - smt(size_blocks2bits). +progress; + exists HybridIROEager.mp{1}, (blocks2bits bs{2}), n{1}, m{1}, + (size bs{2} * r), x{2}; + smt(). progress; smt(take_cat). -splitwhile{2} 1 : i < n. -admit. +splitwhile{2} 1 : i < n1. +seq 1 1 : + (={HybridIROEager.mp, xs, bs, i, m} /\ i{1} = n1 /\ n1 <= m{1} /\ + i1 <= n1 /\ 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}). +if => //; 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}). +if => //; rnd; auto. +skip; progress; + [smt() | smt() | smt(size_rcons) | + rewrite -cats1 take_cat; + smt(size_rcons take_oversize cats1 cats0)]. +skip; smt(take_size). +conseq + (_ : + xs{1} = x{2} /\ i{1} = i{2} * r /\ bs{1} = blocks2bits bs2 /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + bs{1} = blocks2bits bs2 ++ ofblock b{2} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) => //. admit. qed. From e3fc1d8ef6942227999e6a87f0871abcda03cbd5 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 12 Jul 2016 15:32:04 -0400 Subject: [PATCH 173/394] Forgot part of precondition. --- sha3/proof/Sponge.ec | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 6bdee16..21b72d7 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -669,10 +669,11 @@ transitivity{1} } } (={bs, m, i, xs, HybridIROEager.mp} /\ n1 = n{1} /\ i1 <= n1 /\ - i{1} <= n1 /\ size bs{1} = i{1} /\ n1 <= m{1} ==> + i{1} <= n1 /\ n1 <= m{1} /\ size bs{1} = i{1} ==> ={HybridIROEager.mp} /\ i1 <= n1 /\ bs{1} = take n1 bs{2}) (i1 = i{1} /\ xs{1} = x{2} /\ i{1} = i{2} * r /\ n1 = n{1} /\ - n1 <= m{1} /\ bs{1} = blocks2bits bs2 /\ size(blocks2bits bs2) = i1 /\ + n1 <= m{1} /\ m{1} - i{1} = r /\ + bs{1} = blocks2bits bs2 /\ size(blocks2bits bs2) = i1 /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs2 ++ ofblock b{2} /\ size(blocks2bits bs2) = i1 /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). @@ -707,7 +708,8 @@ skip; progress; skip; smt(take_size). conseq (_ : - xs{1} = x{2} /\ i{1} = i{2} * r /\ bs{1} = blocks2bits bs2 /\ + xs{1} = x{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ + bs{1} = blocks2bits bs2 /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs2 ++ ofblock b{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) => //. From 38440ef160ea09fac13312f1f948a1405dae441f Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 12 Jul 2016 17:41:48 -0400 Subject: [PATCH 174/394] Refactoring. --- sha3/proof/Sponge.ec | 50 +++++++++++++++++--------------------------- 1 file changed, 19 insertions(+), 31 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 21b72d7..098e4f6 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -627,7 +627,8 @@ conseq i{2} = n1 %/ r /\ size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ EagerInvar 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} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) => //. progress; by apply/needed_blocks_rel_div_r. case: (i{2} = n{2}). rcondf{2} 1; first auto; progress; smt(). @@ -643,24 +644,19 @@ by rewrite sz_eq need_blks_eq. rcondt{2} 1; first auto; progress; smt(). rcondf{2} 4; first auto; call (_ : true). if=> //. auto; progress; smt(). -wp; exists* i{1}; elim*=> i1; exists* bs{2}; elim*=> bs2. conseq (_ : - n1 = n{1} /\ 0 <= n1 /\ i1 = i{1} /\ bs2 = bs{2} /\ xs{1} = x{2} /\ - i{1} = i{2} * r /\ n{1} <= m{1} /\ m{1} - i{1} = r /\ i{1} <= n{1} /\ - bs{1} = blocks2bits bs2 /\ size bs{1} = i1 /\ size bs{2} = i{2} /\ + n1 = n{1} /\ 0 <= n1 /\ xs{1} = x{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} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> - bs{1} = blocks2bits bs2 ++ take (n1 - i1) (ofblock b{2}) /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). + bs{1} = take n1 (blocks2bits bs{2}) /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) + _ + (_ : size bs = n - 1 ==> size bs = n). progress; smt(lez_floor size_blocks2bits). -move=> |> &1 &2 ? ? sz_eq ? ? ? mp1 mp2 b ?. -split. -rewrite -cats1 blocks2bits_cat blocks2bits_sing take_cat. -have -> /= : !(n{1} < size(blocks2bits bs{2})). - rewrite size_blocks2bits sz_eq. - by smt(needed_blocks_correct). -by rewrite size_blocks2bits sz_eq; congr; congr; smt(). -by rewrite size_rcons; smt(). +smt(). +wp. call (_ : true). auto. skip; smt(size_rcons). transitivity{1} { while (i < m) { b <@ HybridIROEager.fill_in(xs, i); @@ -668,24 +664,23 @@ transitivity{1} i <- i + 1; } } - (={bs, m, i, xs, HybridIROEager.mp} /\ n1 = n{1} /\ i1 <= n1 /\ - i{1} <= n1 /\ n1 <= m{1} /\ size bs{1} = i{1} ==> - ={HybridIROEager.mp} /\ i1 <= n1 /\ bs{1} = take n1 bs{2}) - (i1 = i{1} /\ xs{1} = x{2} /\ i{1} = i{2} * r /\ n1 = n{1} /\ - n1 <= m{1} /\ m{1} - i{1} = r /\ - bs{1} = blocks2bits bs2 /\ size(blocks2bits bs2) = i1 /\ + (={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} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ + bs{1} = blocks2bits bs{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> - bs{1} = blocks2bits bs2 ++ ofblock b{2} /\ size(blocks2bits bs2) = i1 /\ + bs{1} = blocks2bits bs{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). progress; - exists HybridIROEager.mp{1}, (blocks2bits bs{2}), n{1}, m{1}, + exists HybridIROEager.mp{1}, (blocks2bits bs{2}), m{1}, (size bs{2} * r), x{2}; smt(). progress; smt(take_cat). splitwhile{2} 1 : i < n1. seq 1 1 : (={HybridIROEager.mp, xs, bs, i, m} /\ i{1} = n1 /\ n1 <= m{1} /\ - i1 <= n1 /\ size bs{1} = n1). + 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}). @@ -706,13 +701,6 @@ skip; progress; rewrite -cats1 take_cat; smt(size_rcons take_oversize cats1 cats0)]. skip; smt(take_size). -conseq - (_ : - xs{1} = x{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ - bs{1} = blocks2bits bs2 /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> - bs{1} = blocks2bits bs2 ++ ofblock b{2} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) => //. admit. qed. From ed5db520efaf8a4bfb5a058012e34365a7911691 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 13 Jul 2016 09:33:23 -0400 Subject: [PATCH 175/394] More progress on top-level proof. --- sha3/proof/Sponge.ec | 143 ++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 142 insertions(+), 1 deletion(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 098e4f6..a349a60 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -570,6 +570,88 @@ sp; wp; if=> //; rnd; auto. auto. qed. +(* modules needed for applying transitivity tactic *) + +module HybridIROEagerTrans = { + (* from HybridIROEager; need copy for transitivity + to work *) + + proc g(xs, n) = { + var b, bs; + var m <- ((n + r - 1) %/ r) * r; + var i <- 0; + + bs <- []; + if (valid_block xs) { + while (i < n) { + b <@ HybridIROEager.fill_in(xs, i); + bs <- rcons bs b; + i <- i + 1; + } + while (i < m) { + HybridIROEager.fill_in(xs, i); + i <- i + 1; + } + } + return bs; + } + + proc next_block(i, m : int, xs, bs) = { + var b; + + while (i < m) { + b <@ HybridIROEager.fill_in(xs, i); + bs <- rcons bs b; + i <- i + 1; + } + return (bs, i); + } +}. + +module BlockSpongeTrans = { + (* from BlockSponge.BIRO.IRO; need copy for transitivity + to work *) + + proc f(x, n) = { + var b, bs; + var i <- 0; + + bs <- []; + if (valid_block x) { + while (i < n) { + b <@ BlockSponge.BIRO.IRO.fill_in(x, i); + bs <- rcons bs b; + i <- i + 1; + } + } + + return bs; + } + + 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); + } +}. + +lemma HybridIROEager_next (i2 : int) : + equiv + [HybridIROEagerTrans.next_block ~ BlockSpongeTrans.next_block : + i2 = i{2} /\ xs{1} = x{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ + bs{1} = blocks2bits bs{2} /\ + EagerInvar 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 /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}]. +proof. +proc=> /=. +admit. +qed. + lemma HybridIROEager_g_BlockIRO_f (n1 : int) (x2 : block list) : equiv[HybridIROEager.g ~ BlockSponge.BIRO.IRO.f : n1 = n{1} /\ x2 = x{2} /\ xs{1} = x{2} /\ @@ -583,6 +665,34 @@ lemma HybridIROEager_g_BlockIRO_f (n1 : int) (x2 : block list) : size res{2} = (n1 + r - 1) %/ r)) /\ (! valid_block x2 => res{1} = [] /\ res{2} = [])]. proof. +transitivity + HybridIROEagerTrans.g + (={n, xs, HybridIROEager.mp} ==> ={res, HybridIROEager.mp}) + (n1 = n{1} /\ x2 = x{2} /\ xs{1} = x{2} /\ + n{2} = (n{1} + r - 1) %/ r /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + EagerInvar 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} = [])); + [smt() | smt() | sim | idtac]. +transitivity + BlockSpongeTrans.f + (n1 = n{1} /\ x2 = x{2} /\ xs{1} = x{2} /\ + n{2} = (n{1} + r - 1) %/ r /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + EagerInvar 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} = [])) + (={x, n, BlockSponge.BIRO.IRO.mp} ==> ={res, BlockSponge.BIRO.IRO.mp}); + last first; [sim | smt() | smt() | idtac]. proc=> /=. seq 3 2 : (n1 = n{1} /\ xs{1} = x{2} /\ x2 = x{2} /\ @@ -701,7 +811,38 @@ skip; progress; rewrite -cats1 take_cat; smt(size_rcons take_oversize cats1 cats0)]. skip; smt(take_size). -admit. +transitivity{1} + { (bs, i) <@ HybridIROEagerTrans.next_block(i, m, xs, bs); + } + (={i, m, xs, bs, HybridIROEager.mp} ==> + ={i, m, xs, bs, HybridIROEager.mp}) + (xs{1} = x{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ + bs{1} = blocks2bits bs{2} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + bs{1} = blocks2bits bs{2} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). +progress; +exists HybridIROEager.mp{1}, (blocks2bits bs{2}), m{1}, (i{2} * r), x{2}; + trivial. +trivial. +inline HybridIROEagerTrans.next_block; sim. +transitivity{2} + { (bs, i) <@ BlockSpongeTrans.next_block(x, i, bs); + } + (xs{1} = x{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ + bs{1} = blocks2bits bs{2} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + bs{1} = blocks2bits bs{2} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) + (={bs, i, x, BlockSponge.BIRO.IRO.mp} ==> + ={bs, i, x, BlockSponge.BIRO.IRO.mp}). +progress. +exists BlockSponge.BIRO.IRO.mp{2}, bs{2}, i{2}, x{2}; trivial. +trivial. +exists* i{2}; elim*=> i2. +call (HybridIROEager_next i2). +auto. +inline BlockSpongeTrans.next_block; sim. qed. lemma HybridIROEager_BlockIRO_f : From a7ecede7d116f60a3acf045850402375a951a2cf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 13 Jul 2016 18:50:26 +0100 Subject: [PATCH 176/394] Strengthening a core result --- sha3/proof/core/SLCommon.ec | 45 +++++++++++++++++++++++++++++++------ 1 file changed, 38 insertions(+), 7 deletions(-) diff --git a/sha3/proof/core/SLCommon.ec b/sha3/proof/core/SLCommon.ec index 92f7e0c..f325091 100644 --- a/sha3/proof/core/SLCommon.ec +++ b/sha3/proof/core/SLCommon.ec @@ -114,19 +114,50 @@ op step_hpath (mh:hsmap) (sah:hstate option) (b:block) = 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 rewrite anda_and; split=> [!~#] <*>; [exact/Empty|move=> [] /#]. +rewrite -{1}cats1 foldl_cat {1}/step_hpath /=. +case: {-1}(foldl _ _ _) (eq_refl (foldl (step_hpath mh) (Some (b0,0)) p))=> //=. ++ apply/NewLogic.implybN; case=> [/#|p' b0 v' h']. + move=> ^/rconssI <<- {p'} /rconsIs ->> {b}. + by rewrite /build_hpath=> ->. +move=> [v' h']; rewrite oget_some /= -/(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'' ^/rconssI <<- {p'} /rconsIs <<- {b'}. +by rewrite build /= => [#] <*>. +qed. +*) + lemma build_hpathP mh p v h: - build_hpath mh p = Some (v, h) => + build_hpath mh p = Some (v, h) <=> (p = [] /\ v=b0 /\ h=0) \/ exists p' b v' h', p = rcons p' b /\ build_hpath mh p' = Some(v',h') /\ mh.[(v'+^b, h')] = Some(v,h). -proof. - elim/last_ind:p=>@/build_hpath //= p' b _. - rewrite -cats1 foldl_cat /= => H;right;exists p',b. - move:H;rewrite {1}/step_hpath;case (foldl _ _ _)=> //= -[v' h']. - by rewrite oget_some /==>Heq; exists v',h';rewrite -cats1. +proof. (* this is not an induction, but only a case analysis *) +elim/last_ind: p v h => //= [v h|p b _ v h]. ++ by rewrite /build_hpath /= anda_and; split=> [!~#] <*>; [left|move=> [] /#]. +rewrite -{1}cats1 foldl_cat /= -/(build_hpath _ _) /=. +have -> /=: rcons p b <> [] by smt (). (* inelegant -- need lemma in List.ec *) +case: {-1}(build_hpath _ _) (eq_refl (build_hpath mh p))=> //=. ++ by rewrite /step_hpath //= NewLogic.implybN=> -[] p' b0 b' h' [#] /rconssI <*> ->. +move=> [v' h'] build_path; split=> [step_path|[] p' b' v'' h'']. ++ by exists p, b, v', h'. +by move=> [#] ^/rconssI <<- /rconsIs <<-; rewrite build_path=> ->. qed. - (* -------------------------------------------------------------------------- *) module C = { From 9c996825021b9f6c4213e726ca0357e2708b5d5a Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 22 Jul 2016 17:38:18 -0400 Subject: [PATCH 177/394] Working toward next step of top-level proof. --- sha3/proof/Sponge.ec | 44 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index a349a60..a25bbf2 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -572,6 +572,11 @@ qed. (* modules needed for applying transitivity tactic *) +pred EagerBitsOfBlockDom + (xs : block list, i : int, mp : (block list * int, bool) fmap) = + (forall (j : int), i <= j < i + r => mem (dom mp) (xs, j)) \/ + (forall (j : int), i <= j < i + r => ! mem (dom mp) (xs, j)). + module HybridIROEagerTrans = { (* from HybridIROEager; need copy for transitivity to work *) @@ -606,8 +611,47 @@ module HybridIROEagerTrans = { } return (bs, i); } + + proc next_block_split(i, m : int, xs, bs) = { + var b, j, cs; + + (* assuming EagerBitsOfBlockDom xs i HybridIROEager.mp *) + + if (mem (dom HybridIROEager.mp) (xs, i)) { + while (i < m) { + b <- oget HybridIROEager.mp.[(xs, i)]; + bs <- rcons bs b; + i <- i + 1; + } + } else { + j <- i; + while (i < m) { + b <$ dbool; + bs <- rcons bs b; + i <- i + 1; + } + cs <- bs; + while (j < m) { + HybridIROEager.mp.[(xs, j)] <- head true cs; + cs <- behead cs; + j <- j + 1; + } + } + return (bs, i); + } }. +lemma HybridIROEagerTrans_next_block_split : + equiv + [HybridIROEagerTrans.next_block ~ HybridIROEagerTrans.next_block_split : + ={i, m, xs, HybridIROEager.mp} /\ + EagerBitsOfBlockDom xs{1} i{1} HybridIROEager.mp{1} ==> + ={res, HybridIROEager.mp}]. +proof. +proc=> /=. +admit. +qed. + module BlockSpongeTrans = { (* from BlockSponge.BIRO.IRO; need copy for transitivity to work *) From 613d5ac72bf1400a4f2cc5db32ce17e280a24f6c Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 26 Jul 2016 23:26:14 -0400 Subject: [PATCH 178/394] More progress on top-level proof. --- sha3/proof/Sponge.ec | 83 ++++++++++++++++++++++++++++++++++++-------- 1 file changed, 68 insertions(+), 15 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index a25bbf2..41066eb 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -546,6 +546,42 @@ pred EagerInvar mem (dom mp2) (xs, j) => 0 <= j /\ mem (dom mp1) (xs, j %/ r)). +pred BlockBitsAllInDom + (xs : block list, i : int, mp : (block list * int, bool) fmap) = + forall (j : int), i <= j < i + r => mem (dom mp) (xs, j). + +pred BlockBitsAllNotInDom + (xs : block list, i : int, mp : (block list * int, bool) fmap) = + forall (j : int), i <= j < i + r => ! mem (dom mp) (xs, j). + +pred BlockBitsDomAllInOrOut + (xs : block list, i : int, mp : (block list * int, bool) fmap) = + BlockBitsAllInDom xs i mp \/ BlockBitsAllNotInDom xs i mp. + +lemma eager_inv_imp_block_bits_dom + (mp1 : (block list * int, bool) fmap, + mp2 : (block list * int, block) fmap, + xs : block list, i : int) : + 0 <= i => r %| i => EagerInvar mp2 mp1 => + BlockBitsDomAllInOrOut xs i mp1. +proof. +move=> ge0_i r_dvd_i [ei1 ei2]. +case (mem (dom mp2) (xs, i %/ r))=> [mem_mp2 | not_mem_mp2]. +have ei1_xs_i_div_r := ei1 xs (i %/ r). +have [_ [_ mp1_eq_block_bits]] := ei1_xs_i_div_r mem_mp2. +left=> j j_rng. +have mp1_eq_block_bits_j := mp1_eq_block_bits j _. + by rewrite divzK // mulzDl /= divzK. +rewrite in_dom /#. +right=> j j_rng. +case (mem (dom mp1) (xs, j))=> // mem_mp1 /=. +have [_ mem_mp2] := ei2 xs j mem_mp1. +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 HybridIROEager_f_g : equiv[HybridIROEager.f ~ HybridIROEager.g : ={xs, HybridIROEager.mp} /\ n{1} * r = n{2} ==> @@ -572,11 +608,6 @@ qed. (* modules needed for applying transitivity tactic *) -pred EagerBitsOfBlockDom - (xs : block list, i : int, mp : (block list * int, bool) fmap) = - (forall (j : int), i <= j < i + r => mem (dom mp) (xs, j)) \/ - (forall (j : int), i <= j < i + r => ! mem (dom mp) (xs, j)). - module HybridIROEagerTrans = { (* from HybridIROEager; need copy for transitivity to work *) @@ -615,7 +646,8 @@ module HybridIROEagerTrans = { proc next_block_split(i, m : int, xs, bs) = { var b, j, cs; - (* assuming EagerBitsOfBlockDom xs i HybridIROEager.mp *) + (* assuming BlockBitsDomAllInOrOut xs i HybridIROEager.mp + and m = i + r *) if (mem (dom HybridIROEager.mp) (xs, i)) { while (i < m) { @@ -644,8 +676,8 @@ module HybridIROEagerTrans = { lemma HybridIROEagerTrans_next_block_split : equiv [HybridIROEagerTrans.next_block ~ HybridIROEagerTrans.next_block_split : - ={i, m, xs, HybridIROEager.mp} /\ - EagerBitsOfBlockDom xs{1} i{1} HybridIROEager.mp{1} ==> + ={i, m, xs, bs, HybridIROEager.mp} /\ m{1} = i{1} + r /\ + BlockBitsDomAllInOrOut xs{1} i{1} HybridIROEager.mp{1} ==> ={res, HybridIROEager.mp}]. proof. proc=> /=. @@ -685,13 +717,34 @@ module BlockSpongeTrans = { lemma HybridIROEager_next (i2 : int) : equiv [HybridIROEagerTrans.next_block ~ BlockSpongeTrans.next_block : - i2 = i{2} /\ xs{1} = x{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ - bs{1} = blocks2bits bs{2} /\ + 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} /\ EagerInvar 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 /\ EagerInvar 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 /\ + BlockBitsDomAllInOrOut 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 /\ bs{1} = blocks2bits bs{2} /\ + EagerInvar 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 /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). +progress; exists HybridIROEager.mp{1}, (i{1}, m{1}, xs{1}, bs{1}). +progress. smt(). +apply + (eager_inv_imp_block_bits_dom HybridIROEager.mp{1} + BlockSponge.BIRO.IRO.mp{2} xs{1} i{1}). +smt(ge0_r). +rewrite H1; smt(dvdz_mulr dvdzz). +trivial. +trivial. +apply HybridIROEagerTrans_next_block_split. proc=> /=. admit. qed. @@ -800,7 +853,7 @@ rcondf{2} 4; first auto; call (_ : true). if=> //. auto; progress; smt(). conseq (_ : - n1 = n{1} /\ 0 <= n1 /\ xs{1} = x{2} /\ i{1} = i{2} * r /\ + 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} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> @@ -808,7 +861,7 @@ conseq EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) _ (_ : size bs = n - 1 ==> size bs = n). -progress; smt(lez_floor size_blocks2bits). +progress; smt(divz_ge0 gt0_r lez_floor size_blocks2bits). smt(). wp. call (_ : true). auto. skip; smt(size_rcons). transitivity{1} @@ -821,7 +874,7 @@ transitivity{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} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ + (xs{1} = x{2} /\ 0 <= i{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ bs{1} = blocks2bits bs{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs{2} /\ @@ -860,7 +913,7 @@ transitivity{1} } (={i, m, xs, bs, HybridIROEager.mp} ==> ={i, m, xs, bs, HybridIROEager.mp}) - (xs{1} = x{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ + (xs{1} = x{2} /\ 0 <= i{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ bs{1} = blocks2bits bs{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs{2} /\ @@ -873,7 +926,7 @@ inline HybridIROEagerTrans.next_block; sim. transitivity{2} { (bs, i) <@ BlockSpongeTrans.next_block(x, i, bs); } - (xs{1} = x{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ + (xs{1} = x{2} /\ 0 <= i{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ bs{1} = blocks2bits bs{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs{2} /\ From 8752c33d60ef6921394f015b762afc08b6940fd1 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 27 Jul 2016 11:32:56 -0400 Subject: [PATCH 179/394] Housekeeping. --- sha3/proof/Common.ec | 1 + sha3/proof/Sponge.ec | 133 ++++++++++++++++++++++++++++++------------- 2 files changed, 94 insertions(+), 40 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index f19f6fb..3d1cf7e 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -1,4 +1,5 @@ (*------------------- Common Definitions and Lemmas --------------------*) +(* checks with both Alt-Ergo and Z3 *) require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. require import Ring StdRing StdOrder StdBigop BitEncoding DProd. diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 41066eb..cd8f3a2 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -1,4 +1,5 @@ (*------------------------- Sponge Construction ------------------------*) +(* checks with both Alt-Ergo and Z3 *) require import Fun Pair Int IntDiv Real List Option FSet NewFMap DBool. require import Common StdOrder. import IntOrder. @@ -409,6 +410,44 @@ pred LazyInvar mem (dom mp1) (bs, n) => oget mp1.[(bs, n)] = oget mp2.[(pad2blocks bs, n)]). +lemma lazy_invar0 : LazyInvar map0 map0. +proof. +split; first smt(in_fset0 dom0). +split; smt(in_fset0 dom0). +qed. + +lemma lazy_invar_mem_pad2blocks_l2r + (mp1 : (bool list * int, bool) fmap, + mp2 : (block list * int, bool) fmap, + bs : bool list, i : int) : + LazyInvar mp1 mp2 => mem (dom mp1) (bs, i) => + mem (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) : + LazyInvar mp1 mp2 => mem (dom mp2) (pad2blocks bs, i) => + mem (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) : + LazyInvar mp1 mp2 => mem (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) : + LazyInvar mp1 mp2 => mem (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, @@ -489,7 +528,11 @@ while pad2blocks x{1} = xs0{2}). sp; auto. if. -progress; smt(). +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})]. rnd; auto; progress; [by rewrite !getP_eq | by rewrite -(@lazy_invar_upd_mem_dom_iff IRO.mp{1}) | @@ -497,7 +540,8 @@ rnd; auto; progress; by rewrite (@lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} x{1} xs2 i{2} n2 mpL) | by rewrite (@lazy_invar_upd_lu_eq IRO.mp{1} HybridIROLazy.mp{2})]. -auto; progress; smt(). +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. @@ -521,7 +565,11 @@ while LazyInvar IRO.mp{1} HybridIROLazy.mp{2}). wp; sp. if. -progress; smt(). +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})]. rnd; auto; progress; [by rewrite !getP_eq | by rewrite -(@lazy_invar_upd_mem_dom_iff IRO.mp{1}) | @@ -529,7 +577,8 @@ rnd; auto; progress; by rewrite (@lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} x{1} xs1 i{2} n1 mpL) | by rewrite (@lazy_invar_upd_lu_eq IRO.mp{1} HybridIROLazy.mp{2})]. -auto; progress; smt(). +auto; progress [-delta]; + by rewrite (lazy_invar_lookup_eq IRO.mp{1} HybridIROLazy.mp{2} x{1} i{2}). auto. qed. @@ -558,6 +607,9 @@ pred BlockBitsDomAllInOrOut (xs : block list, i : int, mp : (block list * int, bool) fmap) = BlockBitsAllInDom xs i mp \/ BlockBitsAllNotInDom xs i mp. +lemma eager_invar0 : EagerInvar map0 map0. +proof. split; smt(dom0 in_fset0). qed. + lemma eager_inv_imp_block_bits_dom (mp1 : (block list * int, bool) fmap, mp2 : (block list * int, block) fmap, @@ -775,7 +827,7 @@ transitivity res{1} = take n1 (blocks2bits res{2}) /\ size res{2} = (n1 + r - 1) %/ r)) /\ (! valid_block x2 => res{1} = [] /\ res{2} = [])); - [smt() | smt() | sim | idtac]. + [smt() | trivial | sim | idtac]. transitivity BlockSpongeTrans.f (n1 = n{1} /\ x2 = x{2} /\ xs{1} = x{2} /\ @@ -987,7 +1039,7 @@ section. declare module BlockSim : BlockSponge.SIMULATOR{IRO, BlockSponge.BIRO.IRO}. declare module Dist : DISTINGUISHER{Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}. -local clone import HybridIRO as HIRO. +local clone HybridIRO as HIRO. local lemma Sponge_Raise_BlockSponge_f : equiv[Sponge(Perm).f ~ RaiseFun(BlockSponge.Sponge(Perm)).f : @@ -1029,16 +1081,17 @@ auto. qed. local lemma RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f : - equiv[RaiseHybridIRO(HybridIROEager).f ~ RaiseFun(BlockSponge.BIRO.IRO).f : + equiv[HIRO.RaiseHybridIRO(HIRO.HybridIROEager).f ~ + RaiseFun(BlockSponge.BIRO.IRO).f : ={bs, n} /\ ={glob BlockSim} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + HIRO.EagerInvar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1} ==> ={res} /\ ={glob BlockSim} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}]. + HIRO.EagerInvar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1}]. proof. proc=> /=. exists* n{1}; elim*=> n'. exists* (pad2blocks bs{2}); elim*=> xs2. -call (HybridIROEager_g_BlockIRO_f n' xs2). +call (HIRO.HybridIROEager_g_BlockIRO_f n' xs2). auto=> |> &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. @@ -1052,101 +1105,101 @@ qed. local lemma Ideal_IRO_Experiment_HybridLazy &m : Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = Pr[Experiment - (RaiseHybridIRO(HybridIROLazy), BlockSim(HybridIROLazy), + (HIRO.RaiseHybridIRO(HIRO.HybridIROLazy), BlockSim(HIRO.HybridIROLazy), Dist).main() @ &m : res]. proof. byequiv=> //; proc. seq 2 2 : (={glob Dist, glob BlockSim} /\ IRO.mp{1} = NewFMap.map0 /\ - HybridIROLazy.mp{2} = NewFMap.map0). + HIRO.HybridIROLazy.mp{2} = NewFMap.map0). inline*; wp; call (_ : true); auto. call (_ : ={glob Dist, glob BlockSim} /\ - IRO.mp{1} = map0 /\ HybridIROLazy.mp{2} = map0 ==> + IRO.mp{1} = map0 /\ HIRO.HybridIROLazy.mp{2} = map0 ==> ={res}). -proc (={glob BlockSim} /\ LazyInvar IRO.mp{1} HybridIROLazy.mp{2}). -progress; rewrite dom0 in_fset0 in H; elim H. +proc (={glob BlockSim} /\ HIRO.LazyInvar IRO.mp{1} HIRO.HybridIROLazy.mp{2}). +progress [-delta]; apply HIRO.lazy_invar0. trivial. -proc (LazyInvar IRO.mp{1} HybridIROLazy.mp{2})=> //. -apply LowerFun_IRO_HybridIROLazy_f. -proc (LazyInvar IRO.mp{1} HybridIROLazy.mp{2})=> //. -apply LowerFun_IRO_HybridIROLazy_f. -by conseq IRO_RaiseHybridIRO_HybridIROLazy_f. +proc (HIRO.LazyInvar IRO.mp{1} HIRO.HybridIROLazy.mp{2})=> //. +apply HIRO.LowerFun_IRO_HybridIROLazy_f. +proc (HIRO.LazyInvar IRO.mp{1} HIRO.HybridIROLazy.mp{2})=> //. +apply HIRO.LowerFun_IRO_HybridIROLazy_f. +by conseq HIRO.IRO_RaiseHybridIRO_HybridIROLazy_f. auto. qed. -local module (HybridIRODist : HYBRID_IRO_DIST) (HI : HYBRID_IRO) = { +local module (HybridIRODist : HIRO.HYBRID_IRO_DIST) (HI : HIRO.HYBRID_IRO) = { proc distinguish() : bool = { var b : bool; BlockSim(HI).init(); - b <@ Dist(RaiseHybridIRO(HI), BlockSim(HI)).distinguish(); + b <@ Dist(HIRO.RaiseHybridIRO(HI), BlockSim(HI)).distinguish(); return b; } }. local lemma Experiment_HybridIROExper_Lazy &m : Pr[Experiment - (RaiseHybridIRO(HybridIROLazy), BlockSim(HybridIROLazy), + (HIRO.RaiseHybridIRO(HIRO.HybridIROLazy), BlockSim(HIRO.HybridIROLazy), Dist).main() @ &m : res] = - Pr[HybridIROExper(HybridIROLazy, HybridIRODist).main() @ &m : res]. + Pr[HIRO.HybridIROExper(HIRO.HybridIROLazy, HybridIRODist).main() @ &m : res]. proof. byequiv=> //; proc; inline*. -seq 2 2 : (={glob Dist, glob BlockSim, HybridIROLazy.mp}). +seq 2 2 : (={glob Dist, glob BlockSim, HIRO.HybridIROLazy.mp}). swap{2} 1 1; wp; call (_ : true); auto. sim. qed. local lemma HybridIROExper_Experiment_Eager &m : - Pr[HybridIROExper(HybridIROEager, HybridIRODist).main() @ &m : res] = + Pr[HIRO.HybridIROExper(HIRO.HybridIROEager, HybridIRODist).main() @ &m : res] = Pr[Experiment - (RaiseHybridIRO(HybridIROEager), BlockSim(HybridIROEager), + (HIRO.RaiseHybridIRO(HIRO.HybridIROEager), BlockSim(HIRO.HybridIROEager), Dist).main() @ &m : res]. proof. byequiv=> //; proc; inline*. -seq 2 2 : (={glob Dist, glob BlockSim, HybridIROEager.mp}). +seq 2 2 : (={glob Dist, glob BlockSim, HIRO.HybridIROEager.mp}). swap{2} 1 1; wp; call (_ : true); auto. sim. qed. local lemma Experiment_Hybrid_Lazy_Eager &m : Pr[Experiment - (RaiseHybridIRO(HybridIROLazy), BlockSim(HybridIROLazy), + (HIRO.RaiseHybridIRO(HIRO.HybridIROLazy), BlockSim(HIRO.HybridIROLazy), Dist).main() @ &m : res] = Pr[Experiment - (RaiseHybridIRO(HybridIROEager), BlockSim(HybridIROEager), + (HIRO.RaiseHybridIRO(HIRO.HybridIROEager), BlockSim(HIRO.HybridIROEager), Dist).main() @ &m : res]. proof. by rewrite (Experiment_HybridIROExper_Lazy &m) - (HybridIROExper_Lazy_Eager HybridIRODist &m) + (HIRO.HybridIROExper_Lazy_Eager HybridIRODist &m) (HybridIROExper_Experiment_Eager &m). qed. local lemma Experiment_HybridEager_Ideal_BlockIRO &m : Pr[Experiment - (RaiseHybridIRO(HybridIROEager), BlockSim(HybridIROEager), + (HIRO.RaiseHybridIRO(HIRO.HybridIROEager), BlockSim(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} /\ HybridIROEager.mp{1} = NewFMap.map0 /\ + (={glob Dist, glob BlockSim} /\ HIRO.HybridIROEager.mp{1} = NewFMap.map0 /\ BlockSponge.BIRO.IRO.mp{2} = NewFMap.map0). inline*; wp; call (_ : true); auto. call (_ : ={glob Dist, glob BlockSim} /\ - HybridIROEager.mp{1} = map0 /\ BlockSponge.BIRO.IRO.mp{2} = map0 ==> + HIRO.HybridIROEager.mp{1} = map0 /\ BlockSponge.BIRO.IRO.mp{2} = map0 ==> ={res}). proc (={glob BlockSim} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) => //. -progress; rewrite dom0 in_fset0 in H; elim H. -proc (EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //; - conseq HybridIROEager_BlockIRO_f=> //. -proc (EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //; - conseq HybridIROEager_BlockIRO_f=> //. + HIRO.EagerInvar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1}) => //. +progress [-delta]; apply HIRO.eager_invar0. +proc (HIRO.EagerInvar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1})=> //; + conseq HIRO.HybridIROEager_BlockIRO_f=> //. +proc (HIRO.EagerInvar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1})=> //; + conseq HIRO.HybridIROEager_BlockIRO_f=> //. exists* n{1}; elim *=> n'. conseq RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f=> //. auto. From 5ad71d141c3e74e0804f3d2d3e92218f3455701f Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 27 Jul 2016 18:26:48 -0400 Subject: [PATCH 180/394] Progress on top-level proof (but some commented-out script that I'll rework tomorrow). --- sha3/proof/Sponge.ec | 161 ++++++++++++++++++++++++++++++++++--------- 1 file changed, 129 insertions(+), 32 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index cd8f3a2..75115be 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -599,41 +599,83 @@ pred BlockBitsAllInDom (xs : block list, i : int, mp : (block list * int, bool) fmap) = forall (j : int), i <= j < i + r => mem (dom mp) (xs, j). -pred BlockBitsAllNotInDom +pred BlockBitsAllOutDom (xs : block list, i : int, mp : (block list * int, bool) fmap) = forall (j : int), i <= j < i + r => ! mem (dom mp) (xs, j). pred BlockBitsDomAllInOrOut (xs : block list, i : int, mp : (block list * int, bool) fmap) = - BlockBitsAllInDom xs i mp \/ BlockBitsAllNotInDom xs i mp. + BlockBitsAllInDom xs i mp \/ BlockBitsAllOutDom xs i mp. lemma eager_invar0 : EagerInvar map0 map0. proof. split; smt(dom0 in_fset0). qed. lemma eager_inv_imp_block_bits_dom - (mp1 : (block list * int, bool) fmap, - mp2 : (block list * int, block) fmap, + (mp1 : (block list * int, block) fmap, + mp2 : (block list * int, bool) fmap, xs : block list, i : int) : - 0 <= i => r %| i => EagerInvar mp2 mp1 => - BlockBitsDomAllInOrOut xs i mp1. + 0 <= i => r %| i => EagerInvar mp1 mp2 => + BlockBitsDomAllInOrOut xs i mp2. proof. move=> ge0_i r_dvd_i [ei1 ei2]. -case (mem (dom mp2) (xs, i %/ r))=> [mem_mp2 | not_mem_mp2]. +case (mem (dom mp1) (xs, i %/ r))=> [mem_mp1 | not_mem_mp1]. have ei1_xs_i_div_r := ei1 xs (i %/ r). -have [_ [_ mp1_eq_block_bits]] := ei1_xs_i_div_r mem_mp2. +have [_ [_ mp2_eq_block_bits]] := ei1_xs_i_div_r mem_mp1. left=> j j_rng. -have mp1_eq_block_bits_j := mp1_eq_block_bits j _. +have mp2_eq_block_bits_j := mp2_eq_block_bits j _. by rewrite divzK // mulzDl /= divzK. rewrite in_dom /#. right=> j j_rng. -case (mem (dom mp1) (xs, j))=> // mem_mp1 /=. -have [_ mem_mp2] := ei2 xs j mem_mp1. +case (mem (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_dom2 + (mp1 : (block list * int, block) fmap, + mp2 : (block list * int, bool) fmap, + xs : block list, i : int) : + EagerInvar mp1 mp2 => mem (dom mp1) (xs, i) => + BlockBitsAllInDom xs (i * r) mp2. +proof. +move=> [ei1 _] mem j j_ran. +have [ge0_i [_ eq_mp2_block_i]] := ei1 xs i mem. +rewrite in_dom. +have /# := eq_mp2_block_i j _; smt(). +qed. + +lemma eager_inv_not_mem_dom2 + (mp1 : (block list * int, bool) fmap, + mp2 : (block list * int, block) fmap, + xs : block list, i : int) : + EagerInvar mp2 mp1 => 0 <= i => ! mem (dom mp2) (xs, i) => + BlockBitsAllOutDom xs (i * r) mp1. +proof. +move=> [_ ei2] ge0_i not_mem_mp2_i j j_ran. +case (mem (dom mp1) (xs, j))=> // mem_mp1_j. +have [ge0_j mem_mp2_j_div_r] := ei2 xs j mem_mp1_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) : + BlockBitsDomAllInOrOut xs i mp => mem (dom mp) (xs, i) => + BlockBitsAllInDom 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) : + BlockBitsDomAllInOrOut xs i mp => ! mem (dom mp) (xs, i) => + BlockBitsAllOutDom xs i mp. +proof. smt(). qed. + lemma HybridIROEager_f_g : equiv[HybridIROEager.f ~ HybridIROEager.g : ={xs, HybridIROEager.mp} /\ n{1} * r = n{2} ==> @@ -696,10 +738,10 @@ module HybridIROEagerTrans = { } proc next_block_split(i, m : int, xs, bs) = { - var b, j, cs; + var b, i'; (* assuming BlockBitsDomAllInOrOut xs i HybridIROEager.mp - and m = i + r *) + and m = i + r and size bs = i *) if (mem (dom HybridIROEager.mp) (xs, i)) { while (i < m) { @@ -708,17 +750,16 @@ module HybridIROEagerTrans = { i <- i + 1; } } else { - j <- i; + i' <- i; while (i < m) { b <$ dbool; bs <- rcons bs b; i <- i + 1; } - cs <- bs; - while (j < m) { - HybridIROEager.mp.[(xs, j)] <- head true cs; - cs <- behead cs; - j <- j + 1; + i <- i'; + while (i < m) { + HybridIROEager.mp.[(xs, i)] <- nth true bs i; + i <- i + 1; } } return (bs, i); @@ -729,10 +770,62 @@ 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} /\ BlockBitsDomAllInOrOut xs{1} i{1} HybridIROEager.mp{1} ==> ={res, HybridIROEager.mp}]. proof. proc=> /=. +(* +ROUGH WORK -- will rework tomorrow (invariants were faulty) + +case (mem (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} => + mem (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} => + mem (dom HybridIROEager.mp{1}) (xs{1}, j))). +wp; inline*. +rcondf{1} 3; first auto; smt(). +auto; smt(). +auto. +rcondf{2} 1; first auto. +sp; exists* i{1}; elim*=> i''. +conseq + (_ : + ={i, m, xs, bs, HybridIROEager.mp} /\ i'' = i{1} /\ + i'' = i'{2} /\ i'' + r = m{1} /\ + (forall (j : int), + i{1} <= j < m{1} => + ! mem (dom HybridIROEager.mp{1}) (xs{1}, j)) ==> + _). +progress; smt(gt0_r). +seq 1 1 : + (={i, m, xs, bs, HybridIROEager.mp} /\ i'{2} = i'' /\ i{1} = i'' + r /\ + size bs{1} = r /\ + (forall (j : int), + i'' <= j < i{1} => + HybridIROEager.mp{1}.[(xs{1}, j)] = Some(nth true bs{1} (j - i'')))). +while + (={i, m, xs, bs} /\ i'' = i'{2} /\ i'' + r = m{1} /\ i'' <= i{1} /\ + i{1} <= m{1} /\ size bs{1} = i{1} - i'' /\ + (forall (j : int), + i'' <= j < i{1} => + HybridIROEager.mp{1}.[(xs{1}, j)] = Some(nth true bs{1} (j - i''))) /\ + (forall (j : int), + i{1} <= j < m{1} => + ! mem (dom HybridIROEager.mp{1}) (xs{1}, j))). +inline*; rcondt{1} 3; first auto; smt(). +sp; wp; rnd; skip. +*) admit. qed. @@ -770,7 +863,7 @@ lemma HybridIROEager_next (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} /\ + m{1} - i{1} = r /\ bs{1} = blocks2bits bs{2} /\ size bs{2} = i{2} /\ EagerInvar 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 /\ @@ -779,25 +872,29 @@ proof. transitivity HybridIROEagerTrans.next_block_split (={i, m, xs, bs, HybridIROEager.mp} /\ m{1} = i{1} + r /\ - BlockBitsDomAllInOrOut xs{1} i{1} HybridIROEager.mp{1}==> + size bs{1} = i{1} /\ + BlockBitsDomAllInOrOut 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 /\ bs{1} = blocks2bits bs{2} /\ + m{1} - i{1} = r /\ size bs{1} = i{1} /\ bs{1} = blocks2bits bs{2} /\ EagerInvar 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 /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). progress; exists HybridIROEager.mp{1}, (i{1}, m{1}, xs{1}, bs{1}). progress. smt(). +smt(size_blocks2bits). apply - (eager_inv_imp_block_bits_dom HybridIROEager.mp{1} - BlockSponge.BIRO.IRO.mp{2} xs{1} i{1}). + (eager_inv_imp_block_bits_dom BlockSponge.BIRO.IRO.mp{2} + HybridIROEager.mp{1} xs{1} i{1}). smt(ge0_r). rewrite H1; smt(dvdz_mulr dvdzz). trivial. +smt(size_blocks2bits). trivial. apply HybridIROEagerTrans_next_block_split. proc=> /=. +inline*. admit. qed. @@ -927,7 +1024,7 @@ transitivity{1} 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 /\ - bs{1} = blocks2bits bs{2} /\ + size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). @@ -966,27 +1063,27 @@ transitivity{1} (={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 /\ - bs{1} = blocks2bits bs{2} /\ + size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). -progress; -exists HybridIROEager.mp{1}, (blocks2bits bs{2}), m{1}, (i{2} * r), x{2}; - trivial. +progress [-delta]; +exists HybridIROEager.mp{1}, (blocks2bits bs{2}), m{1}, + (size bs{2} * r), x{2}=> //. trivial. 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 /\ - bs{1} = blocks2bits bs{2} /\ + size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) (={bs, i, x, BlockSponge.BIRO.IRO.mp} ==> ={bs, i, x, BlockSponge.BIRO.IRO.mp}). -progress. -exists BlockSponge.BIRO.IRO.mp{2}, bs{2}, i{2}, x{2}; trivial. +progress [-delta]; +exists BlockSponge.BIRO.IRO.mp{2}, bs{2}, (size bs{2}), x{2}=> //. trivial. exists* i{2}; elim*=> i2. call (HybridIROEager_next i2). From f1786577e0268317e8d78d6dca1db57e3769dfef Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 2 Aug 2016 16:11:20 -0400 Subject: [PATCH 181/394] Progress on top-level proof. --- sha3/proof/Sponge.ec | 149 +++++++++++++++++++++++++++++++++++-------- 1 file changed, 124 insertions(+), 25 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 75115be..a28b46b 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -588,12 +588,10 @@ pred EagerInvar (forall (xs : block list, i : int), mem (dom mp1) (xs, i) => 0 <= i /\ - (forall (j : int), 0 <= j < i => mem (dom mp1) (xs, j)) /\ (forall (j : int), i * r <= j < (i + 1) * r => mp2.[(xs, j)] = Some(nth false (ofblock (oget mp1.[(xs, i)])) j))) /\ (forall (xs : block list, j : int), - mem (dom mp2) (xs, j) => - 0 <= j /\ mem (dom mp1) (xs, j %/ r)). + mem (dom mp2) (xs, j) => mem (dom mp1) (xs, j %/ r)). pred BlockBitsAllInDom (xs : block list, i : int, mp : (block list * int, bool) fmap) = @@ -607,6 +605,25 @@ pred BlockBitsDomAllInOrOut (xs : block list, i : int, mp : (block list * int, bool) fmap) = BlockBitsAllInDom xs i mp \/ BlockBitsAllOutDom 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) : + EagerInvar mp1 mp2 => mem (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) : + EagerInvar mp1 mp2 => mem (dom mp2) (xs, j) => 0 <= j. +proof. +move=> [ei1 ei2] mem_mp2_j. +have mem_mp1_j_div_r : mem (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 : EagerInvar map0 map0. proof. split; smt(dom0 in_fset0). qed. @@ -620,14 +637,14 @@ proof. move=> ge0_i r_dvd_i [ei1 ei2]. case (mem (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. +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 in_dom /#. right=> j j_rng. case (mem (dom mp2) (xs, j))=> // mem_mp2 /=. -have [_ mem_mp1] := ei2 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 @@ -642,7 +659,7 @@ lemma eager_inv_mem_dom2 BlockBitsAllInDom xs (i * r) mp2. proof. move=> [ei1 _] mem j j_ran. -have [ge0_i [_ eq_mp2_block_i]] := ei1 xs i mem. +have [ge0_i eq_mp2_block_i] := ei1 xs i mem. rewrite in_dom. have /# := eq_mp2_block_i j _; smt(). qed. @@ -656,7 +673,7 @@ lemma eager_inv_not_mem_dom2 proof. move=> [_ ei2] ge0_i not_mem_mp2_i j j_ran. case (mem (dom mp1) (xs, j))=> // mem_mp1_j. -have [ge0_j mem_mp2_j_div_r] := ei2 xs j mem_mp1_j. +have mem_mp2_j_div_r := ei2 xs j mem_mp1_j. have /# : j %/ r = i. have [k] [k_ran ->] : exists k, 0 <= k < r /\ j = i * r + k by exists (j - i * r); smt(). @@ -766,6 +783,48 @@ module HybridIROEagerTrans = { } }. +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_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(getP). +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(getP). +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 fmapP=> p. +have [ys k] -> /# : exists ys k, p = (ys, k) + by exists p.`1, p.`2; smt(). +qed. + lemma HybridIROEagerTrans_next_block_split : equiv [HybridIROEagerTrans.next_block ~ HybridIROEagerTrans.next_block_split : @@ -775,9 +834,6 @@ lemma HybridIROEagerTrans_next_block_split : ={res, HybridIROEager.mp}]. proof. proc=> /=. -(* -ROUGH WORK -- will rework tomorrow (invariants were faulty) - case (mem (dom HybridIROEager.mp{2}) (xs{2}, i{2})). rcondt{2} 1; first auto. conseq @@ -802,31 +858,75 @@ sp; exists* i{1}; elim*=> i''. conseq (_ : ={i, m, xs, bs, HybridIROEager.mp} /\ i'' = i{1} /\ - i'' = i'{2} /\ i'' + r = m{1} /\ + i'' = i'{2} /\ i'' + r = m{1} /\ size bs{1} = i'' /\ (forall (j : int), i{1} <= j < m{1} => ! mem (dom HybridIROEager.mp{1}) (xs{1}, j)) ==> _). progress; smt(gt0_r). seq 1 1 : - (={i, m, xs, bs, HybridIROEager.mp} /\ i'{2} = i'' /\ i{1} = i'' + r /\ - size bs{1} = r /\ + (={i, m, xs, bs} /\ i'{2} = i'' /\ i{1} = i'' + r /\ + size bs{1} = i'' + r /\ m{1} = i'' + r /\ (forall (j : int), - i'' <= j < i{1} => - HybridIROEager.mp{1}.[(xs{1}, j)] = Some(nth true bs{1} (j - i'')))). + i'' <= j < i'' + r => + HybridIROEager.mp{1}.[(xs{1}, j)] = Some(nth true bs{1} j)) /\ + (forall (j : int), + i'' <= j < i'' + 1 => + ! mem (dom HybridIROEager.mp{2}) (xs{1}, j)) /\ + eager_eq_except xs{1} i'' i{1} HybridIROEager.mp{1} HybridIROEager.mp{2}). while - (={i, m, xs, bs} /\ i'' = i'{2} /\ i'' + r = m{1} /\ i'' <= i{1} /\ - i{1} <= m{1} /\ size bs{1} = i{1} - i'' /\ + (={i, m, xs, bs} /\ i'{2} = i'' /\ m{1} = i'' + r /\ + i'' <= i{1} <= i'' + r /\ size bs{1} = i{1} /\ (forall (j : int), i'' <= j < i{1} => - HybridIROEager.mp{1}.[(xs{1}, j)] = Some(nth true bs{1} (j - i''))) /\ + HybridIROEager.mp{1}.[(xs{1}, j)] = Some(nth true bs{1} j)) /\ (forall (j : int), - i{1} <= j < m{1} => - ! mem (dom HybridIROEager.mp{1}) (xs{1}, j))). + i{1} <= j < i'' + r => + ! mem (dom HybridIROEager.mp{1}) (xs{1}, j)) /\ + (forall (j : int), + i'' <= j < i'' + r => + ! mem (dom HybridIROEager.mp{2}) (xs{1}, j)) /\ + 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. -*) -admit. +sp; wp; rnd; skip; progress. +by rewrite getP_eq oget_some. +smt(). smt(). smt(getP_eq size_rcons). +rewrite nth_rcons /=. +case (j = size bs{2})=> [-> /= | ne_j_size_bs]. +by rewrite getP_eq oget_some. +have -> /= : j < size bs{2} by smt(). +rewrite getP ne_j_size_bs /= /#. +rewrite domP in_fsetU1 /#. +by apply eager_eq_except_upd1_eq_in. +skip; progress; smt(gt0_r). +sp; elim*=> i_R. +conseq + (_ : + ={xs, bs, m} /\ i{2} = i'' /\ i{1} = i'' + r /\ m{1} = i'' + r /\ + size bs{1} = i'' + r /\ + (forall (j : int), + i'' <= j < i'' + r => + HybridIROEager.mp{1}.[(xs{1}, j)] = Some (nth true bs{1} j)) /\ + 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 (j : int), + i'' <= j < i{2} => + HybridIROEager.mp{1}.[(xs{1}, j)] = HybridIROEager.mp{2}.[(xs{1}, j)]) /\ + (forall (j : int), + i{2} <= j < i'' + r => + HybridIROEager.mp{1}.[(xs{1}, j)] = Some (nth true bs{1} j)) /\ + 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(getP) | 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 BlockSpongeTrans = { @@ -893,8 +993,7 @@ trivial. smt(size_blocks2bits). trivial. apply HybridIROEagerTrans_next_block_split. -proc=> /=. -inline*. +proc=> /=; inline*. admit. qed. From 75ef311268382a343db7504f84444f859c03ba2c Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 3 Aug 2016 15:14:31 -0400 Subject: [PATCH 182/394] More progress on top-level proof. --- sha3/proof/Sponge.ec | 152 +++++++++++++++++++++++++++++++++++++------ 1 file changed, 132 insertions(+), 20 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index a28b46b..d45a533 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -589,7 +589,8 @@ pred EagerInvar mem (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))) /\ + mp2.[(xs, j)] = + Some(nth false (ofblock (oget mp1.[(xs, i)])) (j - i * r)))) /\ (forall (xs : block list, j : int), mem (dom mp2) (xs, j) => mem (dom mp1) (xs, j %/ r)). @@ -651,7 +652,7 @@ have /# : (i + k) %/r = i %/ r by rewrite divzDl // (divz_small k r) 1:ger0_norm 1:ge0_r. qed. -lemma eager_inv_mem_dom2 +lemma eager_inv_mem_dom1 (mp1 : (block list * int, block) fmap, mp2 : (block list * int, bool) fmap, xs : block list, i : int) : @@ -664,16 +665,16 @@ rewrite in_dom. have /# := eq_mp2_block_i j _; smt(). qed. -lemma eager_inv_not_mem_dom2 - (mp1 : (block list * int, bool) fmap, - mp2 : (block list * int, block) fmap, +lemma eager_inv_not_mem_dom1 + (mp1 : (block list * int, block) fmap, + mp2 : (block list * int, bool) fmap, xs : block list, i : int) : - EagerInvar mp2 mp1 => 0 <= i => ! mem (dom mp2) (xs, i) => - BlockBitsAllOutDom xs (i * r) mp1. + EagerInvar mp1 mp2 => 0 <= i => ! mem (dom mp1) (xs, i) => + BlockBitsAllOutDom xs (i * r) mp2. proof. -move=> [_ ei2] ge0_i not_mem_mp2_i j j_ran. -case (mem (dom mp1) (xs, j))=> // mem_mp1_j. -have mem_mp2_j_div_r := ei2 xs j mem_mp1_j. +move=> [_ ei2] ge0_i not_mem_mp1_i j j_ran. +case (mem (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(). @@ -980,20 +981,131 @@ transitivity EagerInvar 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 /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). -progress; exists HybridIROEager.mp{1}, (i{1}, m{1}, xs{1}, bs{1}). -progress. smt(). -smt(size_blocks2bits). + EagerInvar 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}, (i{1}, m{1}, x{2}, blocks2bits bs{2})=> |>. +split. split. smt(gt0_r). split. smt(size_blocks2bits). apply (eager_inv_imp_block_bits_dom BlockSponge.BIRO.IRO.mp{2} - HybridIROEager.mp{1} xs{1} i{1}). -smt(ge0_r). -rewrite H1; smt(dvdz_mulr dvdzz). -trivial. + 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. smt(size_blocks2bits). -trivial. apply HybridIROEagerTrans_next_block_split. -proc=> /=; inline*. +proc=> /=; inline*; sp; wp. +case (mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2})). +(* mem (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 : BlockBitsAllInDom x{m} (i{m} * r) HybridIROEager.mp{hr} + by apply (eager_inv_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{1} = i{1} /\ + bs{1} = blocks2bits bs{2} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2}) /\ + BlockBitsAllInDom xs{1} i{1} HybridIROEager.mp{1} ==> + _). +move=> |> &1 &2 ge0_i m_min_i_tim_r_eq_r sz_b2b_bs_eq_i_tim_r ei mem_mp2_x_i. +by apply (eager_inv_mem_dom1 BlockSponge.BIRO.IRO.mp{2}). +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 bs1 = i1 /\ bs1 = blocks2bits bs{2} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + mem (dom BlockSponge.BIRO.IRO.mp{2}) (xs{1}, i2) /\ + BlockBitsAllInDom xs{1} i1 HybridIROEager.mp{1} ==> + bs{1} = + blocks2bits (rcons bs{2} (oget BlockSponge.BIRO.IRO.mp{2}.[(xs{1}, i2)])) /\ + i{1} = (i2 + 1) * r /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. +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)]))) /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + BlockBitsAllInDom xs{1} i1 HybridIROEager.mp{1} /\ + mem (dom BlockSponge.BIRO.IRO.mp{2}) (xs{1}, i2)) + (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 ei + bb_all_in mem_blk_mp_xs_i2 sz_bs_lt_m. +split. split. split=> [| _]; smt(). split. +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. (* getting anomaly from => |> *) +move=> &1 &2 [-> [ge0_i2 [i1_eq_i2_tim_r H]]]. +elim H=> [m_min_i1_eq_r [->> [sz_bs1_eq_i1 H]]]. +elim H=> ->> [ei [mem_dom_mp2_xs_i2 bb_all_in]]. +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=> i_L bs_L. +split=> [| lt_i_L_m]; first smt(). +move=> [i1_le_i_L_le_m [_ [sz_bs_L_eq_i_L [m1_min_i1_eq_r H]]]]. +elim H=> [bs_L_eq [_ [_ mem_mp2_xs_i2]]]. +split. +have i_L_eq_m : i_L = m{1} by smt(). +rewrite bs_L_eq -cats1 blocks2bits_cat; congr. +rewrite i_L_eq_m m1_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(). +(* ! mem (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 : BlockBitsAllOutDom x{m} (i{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{1} = i{1} /\ + bs{1} = blocks2bits bs{2} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2}) /\ + BlockBitsAllOutDom xs{1} i{1} HybridIROEager.mp{1} ==> + _). +progress [-delta]. +have bb_all_in : BlockBitsAllOutDom x{2} (i{2} * r) HybridIROEager.mp{1} + by apply (eager_inv_not_mem_dom1 BlockSponge.BIRO.IRO.mp{2}). +smt(gt0_r). +sp. +exists* i{1}; elim*=> i1. exists* bs{2}; elim*=> bs2. +conseq + (_ : + 0 <= i2 /\ x0{2} = xs{1} /\ n{2} = i2 /\ + i{1} = i1 /\ i'{1} = i1 /\ i1 = i2 * r /\ m{1} - i1 = r /\ + bs{1} = blocks2bits bs2 /\ size bs{1} = i1 /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, i2) /\ + BlockBitsAllOutDom xs{1} i1 HybridIROEager.mp{1} ==> + bs{1} = + blocks2bits (rcons bs2 (oget BlockSponge.BIRO.IRO.mp{2}.[(x0{2}, i2)])) /\ + i{1} = (i2 + 1) * r /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. admit. qed. From 0eb7b9618acb27bfcd1bec74cd8a7f3e8a125652 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 3 Aug 2016 22:24:28 -0400 Subject: [PATCH 183/394] Saving work for today. --- sha3/proof/Sponge.ec | 266 +++++++++++++++++++++++++------------------ 1 file changed, 155 insertions(+), 111 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index d45a533..fd5889b 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -399,7 +399,7 @@ module RaiseHybridIRO (HI : HYBRID_IRO) : FUNCTIONALITY = { } }. -pred LazyInvar +pred lazy_invar (mp1 : (bool list * int, bool) fmap, mp2 : (block list * int, bool) fmap) = (forall (bs : bool list, n : int), @@ -410,7 +410,7 @@ pred LazyInvar mem (dom mp1) (bs, n) => oget mp1.[(bs, n)] = oget mp2.[(pad2blocks bs, n)]). -lemma lazy_invar0 : LazyInvar map0 map0. +lemma lazy_invar0 : lazy_invar map0 map0. proof. split; first smt(in_fset0 dom0). split; smt(in_fset0 dom0). @@ -420,7 +420,7 @@ lemma lazy_invar_mem_pad2blocks_l2r (mp1 : (bool list * int, bool) fmap, mp2 : (block list * int, bool) fmap, bs : bool list, i : int) : - LazyInvar mp1 mp2 => mem (dom mp1) (bs, i) => + lazy_invar mp1 mp2 => mem (dom mp1) (bs, i) => mem (dom mp2) (pad2blocks bs, i). proof. smt(). qed. @@ -428,7 +428,7 @@ lemma lazy_invar_mem_pad2blocks_r2l (mp1 : (bool list * int, bool) fmap, mp2 : (block list * int, bool) fmap, bs : bool list, i : int) : - LazyInvar mp1 mp2 => mem (dom mp2) (pad2blocks bs, i) => + lazy_invar mp1 mp2 => mem (dom mp2) (pad2blocks bs, i) => mem (dom mp1) (bs, i). proof. smt(). qed. @@ -436,7 +436,7 @@ lemma lazy_invar_vb (mp1 : (bool list * int, bool) fmap, mp2 : (block list * int, bool) fmap, xs : block list, n : int) : - LazyInvar mp1 mp2 => mem (dom mp2) (xs, n) => + lazy_invar mp1 mp2 => mem (dom mp2) (xs, n) => valid_block xs. proof. smt(). qed. @@ -444,7 +444,7 @@ lemma lazy_invar_lookup_eq (mp1 : (bool list * int, bool) fmap, mp2 : (block list * int, bool) fmap, bs : bool list, n : int) : - LazyInvar mp1 mp2 => mem (dom mp1) (bs, n) => + lazy_invar mp1 mp2 => mem (dom mp1) (bs, n) => oget mp1.[(bs, n)] = oget mp2.[(pad2blocks bs, n)]. proof. smt(). qed. @@ -452,7 +452,7 @@ 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) : - LazyInvar mp1 mp2 => + lazy_invar mp1 mp2 => mem (dom mp1.[(bs, n) <- b]) (cs, m) <=> mem (dom mp2.[(pad2blocks bs, n) <- b]) (pad2blocks cs, m). proof. @@ -471,7 +471,7 @@ 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) : - LazyInvar mp1 mp2 => + lazy_invar mp1 mp2 => mem (dom mp2.[(pad2blocks bs, n) <- b]) (xs, m) => valid_block xs. proof. @@ -485,7 +485,7 @@ 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) : - LazyInvar mp1 mp2 => + lazy_invar mp1 mp2 => mem (dom mp1.[(bs, n) <- b]) (cs, m) => oget mp1.[(bs, n) <- b].[(cs, m)] = oget mp2.[(pad2blocks bs, n) <- b].[(pad2blocks cs, m)]. @@ -504,19 +504,19 @@ qed. lemma LowerFun_IRO_HybridIROLazy_f : equiv[LowerFun(IRO).f ~ HybridIROLazy.f : - ={xs, n} /\ LazyInvar IRO.mp{1} HybridIROLazy.mp{2} ==> - ={res} /\ LazyInvar IRO.mp{1} HybridIROLazy.mp{2}]. + ={xs, n} /\ lazy_invar IRO.mp{1} HybridIROLazy.mp{2} ==> + ={res} /\ lazy_invar IRO.mp{1} HybridIROLazy.mp{2}]. proof. proc=> /=; inline HybridIROLazy.g. seq 0 1 : (={n} /\ xs{1} = xs0{2} /\ - LazyInvar IRO.mp{1} HybridIROLazy.mp{2}); first auto. + 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} /\ - LazyInvar IRO.mp{1} HybridIROLazy.mp{2} /\ + lazy_invar IRO.mp{1} HybridIROLazy.mp{2} /\ pad2blocks x{1} = xs0{2}). auto; progress; have {2}<- := unpadBlocksK xs0{2}; first @@ -524,7 +524,7 @@ auto; progress; wp. while (={i, n0} /\ bs{1} = bs0{2} /\ - LazyInvar IRO.mp{1} HybridIROLazy.mp{2} /\ + lazy_invar IRO.mp{1} HybridIROLazy.mp{2} /\ pad2blocks x{1} = xs0{2}). sp; auto. if. @@ -550,19 +550,19 @@ qed. lemma IRO_RaiseHybridIRO_HybridIROLazy_f : equiv[IRO.f ~ RaiseHybridIRO(HybridIROLazy).f : ={n} /\ x{1} = bs{2} /\ - LazyInvar IRO.mp{1} HybridIROLazy.mp{2} ==> - ={res} /\ LazyInvar IRO.mp{1} HybridIROLazy.mp{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} /\ - LazyInvar IRO.mp{1} HybridIROLazy.mp{2}); first auto. + 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} /\ - LazyInvar IRO.mp{1} HybridIROLazy.mp{2}). + lazy_invar IRO.mp{1} HybridIROLazy.mp{2}). wp; sp. if. progress; @@ -572,7 +572,7 @@ progress; HybridIROLazy.mp{2} x{1} i{2})]. rnd; auto; progress; [by rewrite !getP_eq | - by rewrite -(@lazy_invar_upd_mem_dom_iff IRO.mp{1}) | + by rewrite -(lazy_invar_upd_mem_dom_iff IRO.mp{1}) | by rewrite (@lazy_invar_upd_mem_dom_iff IRO.mp{1} HybridIROLazy.mp{2}) | by rewrite (@lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} x{1} xs1 i{2} n1 mpL) | @@ -582,7 +582,7 @@ auto; progress [-delta]; auto. qed. -pred EagerInvar +pred eager_invar (mp1 : (block list * int, block) fmap, mp2 : (block list * int, bool) fmap) = (forall (xs : block list, i : int), @@ -594,30 +594,30 @@ pred EagerInvar (forall (xs : block list, j : int), mem (dom mp2) (xs, j) => mem (dom mp1) (xs, j %/ r)). -pred BlockBitsAllInDom +pred block_bits_all_in_dom (xs : block list, i : int, mp : (block list * int, bool) fmap) = forall (j : int), i <= j < i + r => mem (dom mp) (xs, j). -pred BlockBitsAllOutDom +pred block_bits_all_out_dom (xs : block list, i : int, mp : (block list * int, bool) fmap) = forall (j : int), i <= j < i + r => ! mem (dom mp) (xs, j). -pred BlockBitsDomAllInOrOut +pred block_bits_dom_all_in_or_out (xs : block list, i : int, mp : (block list * int, bool) fmap) = - BlockBitsAllInDom xs i mp \/ BlockBitsAllOutDom xs i mp. + 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) : - EagerInvar mp1 mp2 => mem (dom mp1) (xs, i) => 0 <= i. + eager_invar mp1 mp2 => mem (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) : - EagerInvar mp1 mp2 => mem (dom mp2) (xs, j) => 0 <= j. + eager_invar mp1 mp2 => mem (dom mp2) (xs, j) => 0 <= j. proof. move=> [ei1 ei2] mem_mp2_j. have mem_mp1_j_div_r : mem (dom mp1) (xs, j %/ r) by smt(). @@ -625,15 +625,15 @@ have ge0_j_div_r : 0 <= j %/ r by smt(). smt(divz_ge0 gt0_r). qed. -lemma eager_invar0 : EagerInvar map0 map0. +lemma eager_invar0 : eager_invar map0 map0. proof. split; smt(dom0 in_fset0). 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 => EagerInvar mp1 mp2 => - BlockBitsDomAllInOrOut xs i mp2. + 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 (mem (dom mp1) (xs, i %/ r))=> [mem_mp1 | not_mem_mp1]. @@ -656,8 +656,8 @@ lemma eager_inv_mem_dom1 (mp1 : (block list * int, block) fmap, mp2 : (block list * int, bool) fmap, xs : block list, i : int) : - EagerInvar mp1 mp2 => mem (dom mp1) (xs, i) => - BlockBitsAllInDom xs (i * r) mp2. + eager_invar mp1 mp2 => mem (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. @@ -669,8 +669,8 @@ lemma eager_inv_not_mem_dom1 (mp1 : (block list * int, block) fmap, mp2 : (block list * int, bool) fmap, xs : block list, i : int) : - EagerInvar mp1 mp2 => 0 <= i => ! mem (dom mp1) (xs, i) => - BlockBitsAllOutDom xs (i * r) mp2. + eager_invar mp1 mp2 => 0 <= i => ! mem (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 (mem (dom mp2) (xs, j))=> // mem_mp2_j. @@ -684,14 +684,14 @@ qed. lemma block_bits_dom_first_in_imp_all_in (xs : block list, i : int, mp : (block list * int, bool) fmap) : - BlockBitsDomAllInOrOut xs i mp => mem (dom mp) (xs, i) => - BlockBitsAllInDom xs i mp. + block_bits_dom_all_in_or_out xs i mp => mem (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) : - BlockBitsDomAllInOrOut xs i mp => ! mem (dom mp) (xs, i) => - BlockBitsAllOutDom xs i mp. + block_bits_dom_all_in_or_out xs i mp => ! mem (dom mp) (xs, i) => + block_bits_all_out_dom xs i mp. proof. smt(). qed. lemma HybridIROEager_f_g : @@ -756,9 +756,9 @@ module HybridIROEagerTrans = { } proc next_block_split(i, m : int, xs, bs) = { - var b, i'; + var b, i', cs; - (* assuming BlockBitsDomAllInOrOut xs i HybridIROEager.mp + (* assuming block_bits_dom_all_in_or_out xs i HybridIROEager.mp and m = i + r and size bs = i *) if (mem (dom HybridIROEager.mp) (xs, i)) { @@ -768,13 +768,13 @@ module HybridIROEagerTrans = { i <- i + 1; } } else { - i' <- i; + i' <- i; cs <- []; while (i < m) { b <$ dbool; - bs <- rcons bs b; + cs <- rcons cs b; i <- i + 1; } - i <- i'; + i <- i'; bs <- bs ++ cs; while (i < m) { HybridIROEager.mp.[(xs, i)] <- nth true bs i; i <- i + 1; @@ -831,7 +831,7 @@ lemma HybridIROEagerTrans_next_block_split : [HybridIROEagerTrans.next_block ~ HybridIROEagerTrans.next_block_split : ={i, m, xs, bs, HybridIROEager.mp} /\ m{1} = i{1} + r /\ size bs{1} = i{1} /\ - BlockBitsDomAllInOrOut xs{1} i{1} HybridIROEager.mp{1} ==> + block_bits_dom_all_in_or_out xs{1} i{1} HybridIROEager.mp{1} ==> ={res, HybridIROEager.mp}]. proof. proc=> /=. @@ -858,26 +858,26 @@ rcondf{2} 1; first auto. sp; exists* i{1}; elim*=> i''. conseq (_ : - ={i, m, xs, bs, HybridIROEager.mp} /\ i'' = i{1} /\ - i'' = i'{2} /\ i'' + r = m{1} /\ size bs{1} = i'' /\ + ={i, m, xs, bs, HybridIROEager.mp} /\ i'' = i{1} /\ i'' = i'{2} /\ + i'' + r = m{1} /\ size bs{1} = i'' /\ cs{2} = [] /\ (forall (j : int), i{1} <= j < m{1} => ! mem (dom HybridIROEager.mp{1}) (xs{1}, j)) ==> _). progress; smt(gt0_r). seq 1 1 : - (={i, m, xs, bs} /\ i'{2} = i'' /\ i{1} = i'' + r /\ + (={i, m, xs} /\ i'{2} = i'' /\ i{1} = i'' + r /\ bs{1} = bs{2} ++ cs{2} /\ size bs{1} = i'' + r /\ m{1} = i'' + r /\ (forall (j : int), i'' <= j < i'' + r => HybridIROEager.mp{1}.[(xs{1}, j)] = Some(nth true bs{1} j)) /\ (forall (j : int), - i'' <= j < i'' + 1 => + i'' <= j < i'' + r => ! mem (dom HybridIROEager.mp{2}) (xs{1}, j)) /\ eager_eq_except xs{1} i'' i{1} HybridIROEager.mp{1} HybridIROEager.mp{2}). while - (={i, m, xs, bs} /\ i'{2} = i'' /\ m{1} = i'' + r /\ - i'' <= i{1} <= i'' + r /\ size bs{1} = i{1} /\ + (={i, m, xs} /\ i'{2} = i'' /\ m{1} = i'' + r /\ + i'' <= i{1} <= i'' + r /\ size bs{1} = i{1} /\ bs{1} = bs{2} ++ cs{2} /\ (forall (j : int), i'' <= j < i{1} => HybridIROEager.mp{1}.[(xs{1}, j)] = Some(nth true bs{1} j)) /\ @@ -890,17 +890,20 @@ while 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_rcons size_cat). +rewrite -2!cats1 catA; congr; congr. by rewrite getP_eq oget_some. -smt(). smt(). smt(getP_eq size_rcons). rewrite nth_rcons /=. -case (j = size bs{2})=> [-> /= | ne_j_size_bs]. +case (j = size (bs{2} ++ cs{2}))=> [-> /= | ne_j_size_bs_cat_cs]. by rewrite getP_eq oget_some. -have -> /= : j < size bs{2} by smt(). -rewrite getP ne_j_size_bs /= /#. +have -> /= : j < size(bs{2} ++ cs{2}) by smt(). +rewrite getP ne_j_size_bs_cat_cs /= /#. rewrite domP in_fsetU1 /#. by apply eager_eq_except_upd1_eq_in. -skip; progress; smt(gt0_r). -sp; elim*=> i_R. +skip; progress; smt(gt0_r cats0 size_cat). +sp 0 1; elim*=> i_R. sp; elim*=> cs_R. conseq (_ : ={xs, bs, m} /\ i{2} = i'' /\ i{1} = i'' + r /\ m{1} = i'' + r /\ @@ -965,23 +968,23 @@ lemma HybridIROEager_next (i2 : int) : [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} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + 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 /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{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} /\ - BlockBitsDomAllInOrOut xs{1} i{1} HybridIROEager.mp{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{1} = i{1} /\ bs{1} = blocks2bits bs{2} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + 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 /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{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}, (i{1}, m{1}, x{2}, blocks2bits bs{2})=> |>. split. split. smt(gt0_r). split. smt(size_blocks2bits). @@ -997,7 +1000,7 @@ case (mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2})). (* mem (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 : BlockBitsAllInDom x{m} (i{m} * r) HybridIROEager.mp{hr} +have bb_all_in : block_bits_all_in_dom x{m} (i{m} * r) HybridIROEager.mp{hr} by apply (eager_inv_mem_dom1 BlockSponge.BIRO.IRO.mp{m}). smt(gt0_r). simplify. conseq @@ -1005,9 +1008,9 @@ 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{1} = i{1} /\ bs{1} = blocks2bits bs{2} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2}) /\ - BlockBitsAllInDom xs{1} i{1} HybridIROEager.mp{1} ==> + block_bits_all_in_dom xs{1} i{1} HybridIROEager.mp{1} ==> _). move=> |> &1 &2 ge0_i m_min_i_tim_r_eq_r sz_b2b_bs_eq_i_tim_r ei mem_mp2_x_i. by apply (eager_inv_mem_dom1 BlockSponge.BIRO.IRO.mp{2}). @@ -1016,13 +1019,13 @@ conseq (_ : i1 = i{1} /\ 0 <= i2 /\ i1 = i2 * r /\ m{1} - i1 = r /\ bs1 = bs{1} /\ size bs1 = i1 /\ bs1 = blocks2bits bs{2} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ mem (dom BlockSponge.BIRO.IRO.mp{2}) (xs{1}, i2) /\ - BlockBitsAllInDom xs{1} i1 HybridIROEager.mp{1} ==> + block_bits_all_in_dom xs{1} i1 HybridIROEager.mp{1} ==> bs{1} = blocks2bits (rcons bs{2} (oget BlockSponge.BIRO.IRO.mp{2}.[(xs{1}, i2)])) /\ i{1} = (i2 + 1) * r /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. while{1} (i1 <= i{1} <= m{1} /\ i1 = i2 * r /\ size bs{1} = i{1} /\ m{1} - i1 = r /\ @@ -1030,8 +1033,8 @@ while{1} bs1 ++ take (i{1} - i1) (ofblock (oget(BlockSponge.BIRO.IRO.mp{2}.[(xs{1}, i2)]))) /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ - BlockBitsAllInDom xs{1} i1 HybridIROEager.mp{1} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + block_bits_all_in_dom xs{1} i1 HybridIROEager.mp{1} /\ mem (dom BlockSponge.BIRO.IRO.mp{2}) (xs{1}, i2)) (m{1} - i{1}). move=> &m z. @@ -1076,7 +1079,7 @@ split=> //; smt(). (* ! mem (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 : BlockBitsAllOutDom x{m} (i{m} * r) HybridIROEager.mp{hr} +have bb_all_not_in : block_bits_all_out_dom x{m} (i{m} * r) HybridIROEager.mp{hr} by apply (eager_inv_not_mem_dom1 BlockSponge.BIRO.IRO.mp{m}). smt(gt0_r). simplify. conseq @@ -1084,28 +1087,69 @@ 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{1} = i{1} /\ bs{1} = blocks2bits bs{2} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2}) /\ - BlockBitsAllOutDom xs{1} i{1} HybridIROEager.mp{1} ==> + block_bits_all_out_dom xs{1} i{1} HybridIROEager.mp{1} ==> _). progress [-delta]. -have bb_all_in : BlockBitsAllOutDom x{2} (i{2} * r) HybridIROEager.mp{1} +have bb_all_in : block_bits_all_out_dom x{2} (i{2} * r) HybridIROEager.mp{1} by apply (eager_inv_not_mem_dom1 BlockSponge.BIRO.IRO.mp{2}). smt(gt0_r). -sp. -exists* i{1}; elim*=> i1. exists* bs{2}; elim*=> bs2. +sp. exists* i{1}; elim*=> i1. exists* bs{2}; elim*=> bs2. conseq (_ : 0 <= i2 /\ x0{2} = xs{1} /\ n{2} = i2 /\ i{1} = i1 /\ i'{1} = i1 /\ i1 = i2 * r /\ m{1} - i1 = r /\ - bs{1} = blocks2bits bs2 /\ size bs{1} = i1 /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + bs{1} = blocks2bits bs2 /\ size bs{1} = i1 /\ cs{1} = [] /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, i2) /\ - BlockBitsAllOutDom xs{1} i1 HybridIROEager.mp{1} ==> + block_bits_all_out_dom xs{1} i1 HybridIROEager.mp{1} ==> bs{1} = blocks2bits (rcons bs2 (oget BlockSponge.BIRO.IRO.mp{2}.[(x0{2}, i2)])) /\ i{1} = (i2 + 1) * r /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. +alias{2} 1 with w. +seq 1 1 : + (0 <= i2 /\ x0{2} = xs{1} /\ n{2} = i2 /\ + i{1} = m{1} /\ i'{1} = i1 /\ i1 = i2 * r /\ m{1} - i1 = r /\ + bs{1} = blocks2bits bs2 /\ size bs{1} = i1 /\ cs{1} = ofblock w{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, i2) /\ + block_bits_all_out_dom xs{1} i1 HybridIROEager.mp{1}). +conseq + (_ : + cs{1} = [] /\ m{1} - i{1} = r /\ 0 <= i{1} ==> + cs{1} = ofblock w{2} /\ i{1} = m{1})=> //. +progress; rewrite mulr_ge0 // ge0_r. +admit. +wp; simplify. sp; elim*=> bs_L _. +exists* HybridIROEager.mp{1}; elim*=> mp1'. +conseq + (_ : + i{1} = i1 /\ bs{1} = blocks2bits bs2 ++ (ofblock w{2}) /\ + 0 <= i2 /\ x0{2} = xs{1} /\ n{2} = i2 /\ i1 = i2 * r /\ + m{1} - i1 = r /\ size(blocks2bits bs2) = i1 /\ + mp1' = HybridIROEager.mp{1} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} mp1' /\ + ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, i2) /\ + block_bits_all_out_dom xs{1} i1 mp1' ==> + _)=> //. +(* this probably needs work -- tomorrow! *) +while{1} + (bs{1} = blocks2bits bs2 ++ (ofblock w{2}) /\ + 0 <= i2 /\ x0{2} = xs{1} /\ n{2} = i2 /\ i1 = i2 * r /\ + m{1} - i1 = r /\ size(blocks2bits bs2) = i1 /\ + 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)) /\ + (forall (j : int), + i{1} <= j < m{1} => ! mem (dom HybridIROEager.mp{1}) (xs{1}, j))) + (m{1} - i{1}). +admit. admit. qed. @@ -1113,8 +1157,8 @@ lemma HybridIROEager_g_BlockIRO_f (n1 : int) (x2 : block list) : equiv[HybridIROEager.g ~ BlockSponge.BIRO.IRO.f : n1 = n{1} /\ x2 = x{2} /\ xs{1} = x{2} /\ n{2} = (n{1} + r - 1) %/ r /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + 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 => @@ -1127,8 +1171,8 @@ transitivity (={n, xs, HybridIROEager.mp} ==> ={res, HybridIROEager.mp}) (n1 = n{1} /\ x2 = x{2} /\ xs{1} = x{2} /\ n{2} = (n{1} + r - 1) %/ r /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + 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 => @@ -1140,8 +1184,8 @@ transitivity BlockSpongeTrans.f (n1 = n{1} /\ x2 = x{2} /\ xs{1} = x{2} /\ n{2} = (n{1} + r - 1) %/ r /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + 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 => @@ -1155,7 +1199,7 @@ 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} = [] /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). auto; progress. if=> //. case: (n1 < 0). @@ -1172,10 +1216,10 @@ 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} = [] /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = take n1 (blocks2bits bs{2}) /\ size bs{2} = (n1 + r - 1) %/ r /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). + 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). @@ -1185,17 +1229,17 @@ 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} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). admit. 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} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + 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} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) => //. + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) => //. progress; by apply/needed_blocks_rel_div_r. case: (i{2} = n{2}). rcondf{2} 1; first auto; progress; smt(). @@ -1216,9 +1260,9 @@ 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} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = take n1 (blocks2bits bs{2}) /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) + 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). @@ -1236,9 +1280,9 @@ transitivity{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} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs{2} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). progress; exists HybridIROEager.mp{1}, (blocks2bits bs{2}), m{1}, (size bs{2} * r), x{2}; @@ -1275,9 +1319,9 @@ transitivity{1} ={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} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs{2} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). progress [-delta]; exists HybridIROEager.mp{1}, (blocks2bits bs{2}), m{1}, (size bs{2} * r), x{2}=> //. @@ -1288,9 +1332,9 @@ transitivity{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} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs{2} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) (={bs, i, x, BlockSponge.BIRO.IRO.mp} ==> ={bs, i, x, BlockSponge.BIRO.IRO.mp}). progress [-delta]; @@ -1305,18 +1349,18 @@ qed. lemma HybridIROEager_BlockIRO_f : equiv[HybridIROEager.f ~ BlockSponge.BIRO.IRO.f : xs{1} = x{2} /\ ={n} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> - ={res} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}]. + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + ={res} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}]. proof. transitivity HybridIROEager.g (={xs, HybridIROEager.mp} /\ n{2} = n{1} * r /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + 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 /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> res{1} = (blocks2bits res{2}) /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). move=> |> &1 &2 ? n_eq inv. exists BlockSponge.BIRO.IRO.mp{2}, HybridIROEager.mp{1}, (xs{1}, n{1} * r). move=> |>; by rewrite n_eq. @@ -1392,9 +1436,9 @@ local lemma RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f : equiv[HIRO.RaiseHybridIRO(HIRO.HybridIROEager).f ~ RaiseFun(BlockSponge.BIRO.IRO).f : ={bs, n} /\ ={glob BlockSim} /\ - HIRO.EagerInvar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1} ==> + HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1} ==> ={res} /\ ={glob BlockSim} /\ - HIRO.EagerInvar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1}]. + HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1}]. proof. proc=> /=. exists* n{1}; elim*=> n'. @@ -1426,12 +1470,12 @@ call ={glob Dist, glob BlockSim} /\ IRO.mp{1} = map0 /\ HIRO.HybridIROLazy.mp{2} = map0 ==> ={res}). -proc (={glob BlockSim} /\ HIRO.LazyInvar IRO.mp{1} HIRO.HybridIROLazy.mp{2}). +proc (={glob BlockSim} /\ HIRO.lazy_invar IRO.mp{1} HIRO.HybridIROLazy.mp{2}). progress [-delta]; apply HIRO.lazy_invar0. trivial. -proc (HIRO.LazyInvar IRO.mp{1} HIRO.HybridIROLazy.mp{2})=> //. +proc (HIRO.lazy_invar IRO.mp{1} HIRO.HybridIROLazy.mp{2})=> //. apply HIRO.LowerFun_IRO_HybridIROLazy_f. -proc (HIRO.LazyInvar IRO.mp{1} HIRO.HybridIROLazy.mp{2})=> //. +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. @@ -1502,11 +1546,11 @@ call ={res}). proc (={glob BlockSim} /\ - HIRO.EagerInvar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1}) => //. + HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1}) => //. progress [-delta]; apply HIRO.eager_invar0. -proc (HIRO.EagerInvar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1})=> //; +proc (HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1})=> //; conseq HIRO.HybridIROEager_BlockIRO_f=> //. -proc (HIRO.EagerInvar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1})=> //; +proc (HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1})=> //; conseq HIRO.HybridIROEager_BlockIRO_f=> //. exists* n{1}; elim *=> n'. conseq RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f=> //. From 11a6b740081b37b1d43aa8619684fbb737037604 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 5 Aug 2016 12:08:53 -0400 Subject: [PATCH 184/394] More progress with top-level proof. --- sha3/proof/Sponge.ec | 378 ++++++++++++++++++++++++++----------------- 1 file changed, 231 insertions(+), 147 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index fd5889b..c5dc472 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -2,6 +2,7 @@ (* checks with both Alt-Ergo and Z3 *) require import Fun Pair Int IntDiv Real List Option FSet NewFMap DBool. +import IntExtra. require import Common StdOrder. import IntOrder. require (*--*) IRO BlockSponge RndO. @@ -520,7 +521,7 @@ seq 6 3 : pad2blocks x{1} = xs0{2}). auto; progress; have {2}<- := unpadBlocksK xs0{2}; first - by rewrite (@some_oget (unpad_blocks xs0{2})). + by rewrite (some_oget (unpad_blocks xs0{2})). wp. while (={i, n0} /\ bs{1} = bs0{2} /\ @@ -535,11 +536,11 @@ progress; HybridIROLazy.mp{2} x{1} i{2})]. rnd; auto; progress; [by rewrite !getP_eq | - by rewrite -(@lazy_invar_upd_mem_dom_iff IRO.mp{1}) | - by rewrite (@lazy_invar_upd_mem_dom_iff IRO.mp{1} HybridIROLazy.mp{2}) | - by rewrite (@lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} + by rewrite -(lazy_invar_upd_mem_dom_iff IRO.mp{1}) | + by rewrite (lazy_invar_upd_mem_dom_iff IRO.mp{1} HybridIROLazy.mp{2}) | + by rewrite (lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} x{1} xs2 i{2} n2 mpL) | - by rewrite (@lazy_invar_upd_lu_eq IRO.mp{1} HybridIROLazy.mp{2})]. + by rewrite (lazy_invar_upd_lu_eq IRO.mp{1} HybridIROLazy.mp{2})]. auto; progress [-delta]. by rewrite (lazy_invar_lookup_eq IRO.mp{1} HybridIROLazy.mp{2} x{1} i{2}). auto. @@ -573,10 +574,10 @@ progress; rnd; auto; progress; [by rewrite !getP_eq | by rewrite -(lazy_invar_upd_mem_dom_iff IRO.mp{1}) | - by rewrite (@lazy_invar_upd_mem_dom_iff IRO.mp{1} HybridIROLazy.mp{2}) | - by rewrite (@lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} + by rewrite (lazy_invar_upd_mem_dom_iff IRO.mp{1} HybridIROLazy.mp{2}) | + by rewrite (lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} x{1} xs1 i{2} n1 mpL) | - by rewrite (@lazy_invar_upd_lu_eq IRO.mp{1} HybridIROLazy.mp{2})]. + by rewrite (lazy_invar_upd_lu_eq IRO.mp{1} HybridIROLazy.mp{2})]. auto; progress [-delta]; by rewrite (lazy_invar_lookup_eq IRO.mp{1} HybridIROLazy.mp{2} x{1} i{2}). auto. @@ -756,7 +757,7 @@ module HybridIROEagerTrans = { } proc next_block_split(i, m : int, xs, bs) = { - var b, i', cs; + var b, j, cs; (* assuming block_bits_dom_all_in_or_out xs i HybridIROEager.mp and m = i + r and size bs = i *) @@ -768,13 +769,13 @@ module HybridIROEagerTrans = { i <- i + 1; } } else { - i' <- i; cs <- []; - while (i < m) { + j <- 0; cs <- []; + while (j < r) { b <$ dbool; cs <- rcons cs b; - i <- i + 1; + j <- j + 1; } - i <- i'; bs <- bs ++ cs; + bs <- bs ++ cs; while (i < m) { HybridIROEager.mp.[(xs, i)] <- nth true bs i; i <- i + 1; @@ -790,6 +791,14 @@ pred eager_eq_except 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 => + mem (dom mp1) (ys, k) <=> mem (dom mp2) (ys, k). +proof. smt(in_dom get_oget). qed. + lemma eager_eq_except_upd1_eq_in (xs : block list, i j k : int, y : bool, mp1 mp2 : (block list * int, bool) fmap) : @@ -826,6 +835,73 @@ 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 getP_eq mp2'_ran_eq -eq_k_i. +rewrite domP in_fsetU1 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 : mem (dom mp1) (ys, k) by smt(). +split; first smt(eager_inv_mem_mp2_ge0). +move=> j j_ran; rewrite getP. +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 domP in_fsetU1 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 : mem (dom mp1) (ys, k) by smt(). +split; first smt(eager_inv_mem_mp2_ge0). +move=> j j_ran; rewrite getP. +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 domP in_fsetU1. +case (xs = ys)=> [-> | ne_xs_ys]. +case (k < i * r)=> [lt_k_i_tim_r | not_lt_k_i_tim_r]. +smt(eager_eq_except_mem_iff). +case ((i + 1) * r <= k)=> [i_add1_tim_r_le_k | not_i_add1_tim_r_le_k]. +smt(eager_eq_except_mem_iff). +right. +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(eager_eq_except_mem_iff). +qed. + lemma HybridIROEagerTrans_next_block_split : equiv [HybridIROEagerTrans.next_block ~ HybridIROEagerTrans.next_block_split : @@ -836,6 +912,7 @@ lemma HybridIROEagerTrans_next_block_split : proof. proc=> /=. case (mem (dom HybridIROEager.mp{2}) (xs{2}, i{2})). +(* mem (dom HybridIROEager.mp{2}) (xs{2}, i{2}) *) rcondt{2} 1; first auto. conseq (_ : @@ -854,76 +931,73 @@ wp; inline*. rcondf{1} 3; first auto; smt(). auto; smt(). auto. +(* ! mem (dom HybridIROEager.mp{2}) (xs{2}, i{2}) *) rcondf{2} 1; first auto. -sp; exists* i{1}; elim*=> i''. +sp; exists* i{1}; elim*=> i'. conseq (_ : - ={i, m, xs, bs, HybridIROEager.mp} /\ i'' = i{1} /\ i'' = i'{2} /\ - i'' + r = m{1} /\ size bs{1} = i'' /\ cs{2} = [] /\ + ={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{1} <= j < m{1} => + i' <= j < i' + r => ! mem (dom HybridIROEager.mp{1}) (xs{1}, j)) ==> _). progress; smt(gt0_r). -seq 1 1 : - (={i, m, xs} /\ i'{2} = i'' /\ i{1} = i'' + r /\ bs{1} = bs{2} ++ cs{2} /\ - size bs{1} = i'' + r /\ m{1} = i'' + r /\ - (forall (j : int), - i'' <= j < i'' + r => - HybridIROEager.mp{1}.[(xs{1}, j)] = Some(nth true bs{1} j)) /\ - (forall (j : int), - i'' <= j < i'' + r => - ! mem (dom HybridIROEager.mp{2}) (xs{1}, j)) /\ - eager_eq_except xs{1} i'' i{1} HybridIROEager.mp{1} HybridIROEager.mp{2}). +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 - (={i, m, xs} /\ i'{2} = i'' /\ m{1} = i'' + r /\ - i'' <= i{1} <= i'' + r /\ size bs{1} = i{1} /\ bs{1} = bs{2} ++ cs{2} /\ - (forall (j : int), - i'' <= j < i{1} => - HybridIROEager.mp{1}.[(xs{1}, j)] = Some(nth true bs{1} j)) /\ - (forall (j : int), - i{1} <= j < i'' + r => - ! mem (dom HybridIROEager.mp{1}) (xs{1}, j)) /\ - (forall (j : int), - i'' <= j < i'' + r => - ! mem (dom HybridIROEager.mp{2}) (xs{1}, j)) /\ - eager_eq_except xs{1} i'' (i'' + r) HybridIROEager.mp{1} HybridIROEager.mp{2}). + (={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 => + ! mem (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_rcons size_cat). +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 getP_eq oget_some. rewrite nth_rcons /=. -case (j = size (bs{2} ++ cs{2}))=> [-> /= | ne_j_size_bs_cat_cs]. +case (k = size (bs{2} ++ cs{2}))=> [-> /= | ne_k_size_bs_cat_cs]. by rewrite getP_eq oget_some. -have -> /= : j < size(bs{2} ++ cs{2}) by smt(). -rewrite getP ne_j_size_bs_cat_cs /= /#. +have -> /= : k < size(bs{2} ++ cs{2}) by smt(). +rewrite getP ne_k_size_bs_cat_cs /= /#. rewrite domP in_fsetU1 /#. by apply eager_eq_except_upd1_eq_in. +smt(size_cat). smt(size_cat). skip; progress; smt(gt0_r cats0 size_cat). -sp 0 1; elim*=> i_R. sp; elim*=> cs_R. conseq (_ : - ={xs, bs, m} /\ i{2} = i'' /\ i{1} = i'' + r /\ m{1} = i'' + r /\ - size bs{1} = i'' + r /\ - (forall (j : int), - i'' <= j < i'' + r => - HybridIROEager.mp{1}.[(xs{1}, j)] = Some (nth true bs{1} j)) /\ - eager_eq_except xs{1} i'' (i'' + r) + ={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 (j : int), - i'' <= j < i{2} => - HybridIROEager.mp{1}.[(xs{1}, j)] = HybridIROEager.mp{2}.[(xs{1}, j)]) /\ - (forall (j : int), - i{2} <= j < i'' + r => - HybridIROEager.mp{1}.[(xs{1}, j)] = Some (nth true bs{1} j)) /\ - eager_eq_except xs{1} i'' (i'' + r) + (={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; @@ -971,6 +1045,7 @@ lemma HybridIROEager_next (i2 : int) : 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 @@ -980,52 +1055,44 @@ transitivity 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{1} = i{1} /\ bs{1} = blocks2bits bs{2} /\ + 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}, (i{1}, m{1}, x{2}, blocks2bits bs{2})=> |>. -split. split. smt(gt0_r). split. smt(size_blocks2bits). +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. -smt(size_blocks2bits). apply HybridIROEagerTrans_next_block_split. proc=> /=; inline*; sp; wp. case (mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2})). (* mem (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} (i{m} * r) HybridIROEager.mp{hr} +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. -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{1} = i{1} /\ - bs{1} = blocks2bits bs{2} /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ - mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2}) /\ - block_bits_all_in_dom xs{1} i{1} HybridIROEager.mp{1} ==> - _). -move=> |> &1 &2 ge0_i m_min_i_tim_r_eq_r sz_b2b_bs_eq_i_tim_r ei mem_mp2_x_i. -by apply (eager_inv_mem_dom1 BlockSponge.BIRO.IRO.mp{2}). 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 bs1 = i1 /\ bs1 = blocks2bits bs{2} /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + bs1 = bs{1} /\ size bs{2} = i2 /\ size bs1 = i1 /\ + bs1 = blocks2bits bs{2} /\ mem (dom BlockSponge.BIRO.IRO.mp{2}) (xs{1}, i2) /\ - block_bits_all_in_dom xs{1} i1 HybridIROEager.mp{1} ==> + 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 /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. + 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. while{1} (i1 <= i{1} <= m{1} /\ i1 = i2 * r /\ size bs{1} = i{1} /\ m{1} - i1 = r /\ @@ -1033,14 +1100,13 @@ while{1} bs1 ++ take (i{1} - i1) (ofblock (oget(BlockSponge.BIRO.IRO.mp{2}.[(xs{1}, i2)]))) /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ - block_bits_all_in_dom xs{1} i1 HybridIROEager.mp{1} /\ - mem (dom BlockSponge.BIRO.IRO.mp{2}) (xs{1}, i2)) + mem (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 ei - bb_all_in mem_blk_mp_xs_i2 sz_bs_lt_m. + |> &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. by rewrite -cats1 size_cat. rewrite -cats1 {1}bs_eq -catA; congr. @@ -1058,14 +1124,14 @@ by rewrite some_form_mp_hr_lookup_eq oget_some. smt(). skip. (* getting anomaly from => |> *) move=> &1 &2 [-> [ge0_i2 [i1_eq_i2_tim_r H]]]. -elim H=> [m_min_i1_eq_r [->> [sz_bs1_eq_i1 H]]]. -elim H=> ->> [ei [mem_dom_mp2_xs_i2 bb_all_in]]. +elim H=> [m_min_i1_eq_r [->> [sz_bs2_eq_i2 H]]]. +elim H=> [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=> i_L bs_L. -split=> [| lt_i_L_m]; first smt(). +move=> bs_L i_L. +split=> [| not_lt_i_L_m]; first smt(). move=> [i1_le_i_L_le_m [_ [sz_bs_L_eq_i_L [m1_min_i1_eq_r H]]]]. elim H=> [bs_L_eq [_ [_ mem_mp2_xs_i2]]]. split. @@ -1075,82 +1141,100 @@ rewrite i_L_eq_m m1_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; first smt(). +split=> //. split=> //; smt(). (* ! mem (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} (i{m} * r) HybridIROEager.mp{hr} +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{1} = i{1} /\ + 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} /\ - ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2}) /\ - block_bits_all_out_dom xs{1} i{1} HybridIROEager.mp{1} ==> - _). -progress [-delta]. -have bb_all_in : block_bits_all_out_dom x{2} (i{2} * r) HybridIROEager.mp{1} - by apply (eager_inv_not_mem_dom1 BlockSponge.BIRO.IRO.mp{2}). -smt(gt0_r). -sp. exists* i{1}; elim*=> i1. exists* bs{2}; elim*=> bs2. -conseq - (_ : - 0 <= i2 /\ x0{2} = xs{1} /\ n{2} = i2 /\ - i{1} = i1 /\ i'{1} = i1 /\ i1 = i2 * r /\ m{1} - i1 = r /\ - bs{1} = blocks2bits bs2 /\ size bs{1} = i1 /\ cs{1} = [] /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ - ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, i2) /\ - block_bits_all_out_dom xs{1} i1 HybridIROEager.mp{1} ==> - bs{1} = - blocks2bits (rcons bs2 (oget BlockSponge.BIRO.IRO.mp{2}.[(x0{2}, i2)])) /\ - i{1} = (i2 + 1) * r /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + _)=> //. alias{2} 1 with w. -seq 1 1 : - (0 <= i2 /\ x0{2} = xs{1} /\ n{2} = i2 /\ - i{1} = m{1} /\ i'{1} = i1 /\ i1 = i2 * r /\ m{1} - i1 = r /\ - bs{1} = blocks2bits bs2 /\ size bs{1} = i1 /\ cs{1} = ofblock w{2} /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ - ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, i2) /\ - block_bits_all_out_dom xs{1} i1 HybridIROEager.mp{1}). -conseq - (_ : - cs{1} = [] /\ m{1} - i{1} = r /\ 0 <= i{1} ==> - cs{1} = ofblock w{2} /\ i{1} = m{1})=> //. -progress; rewrite mulr_ge0 // ge0_r. +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}). +progress; [by rewrite size_block | by rewrite mkblockK]. admit. -wp; simplify. sp; elim*=> bs_L _. -exists* HybridIROEager.mp{1}; elim*=> mp1'. +wp; simplify; sp; elim*=> bs_l. +exists* HybridIROEager.mp{1}; elim*=> mp1. +exists* i{1}; elim*=> i1. conseq (_ : - i{1} = i1 /\ bs{1} = blocks2bits bs2 ++ (ofblock w{2}) /\ - 0 <= i2 /\ x0{2} = xs{1} /\ n{2} = i2 /\ i1 = i2 * r /\ - m{1} - i1 = r /\ size(blocks2bits bs2) = i1 /\ - mp1' = HybridIROEager.mp{1} /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} mp1' /\ - ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, i2) /\ - block_bits_all_out_dom xs{1} i1 mp1' ==> - _)=> //. -(* this probably needs work -- tomorrow! *) + 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 getP_eq + oget_some ofblockK. +by rewrite size_rcons. while{1} - (bs{1} = blocks2bits bs2 ++ (ofblock w{2}) /\ - 0 <= i2 /\ x0{2} = xs{1} /\ n{2} = i2 /\ i1 = i2 * r /\ - m{1} - i1 = r /\ size(blocks2bits bs2) = i1 /\ + (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} /\ + 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)) /\ - (forall (j : int), - i{1} <= j < m{1} => ! mem (dom HybridIROEager.mp{1}) (xs{1}, j))) + HybridIROEager.mp{1}.[(xs{1}, j)] = Some(nth false bs{1} j))) (m{1} - i{1}). -admit. -admit. +progress; auto. +move=> |> &hr ge0_i1 m_min_i1_eq_r sz_bs_eq_i1_plus_r il_le_i _ ee. +move=> 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 getP /=; smt(nth_onth onth_nth). +rewrite getP. +have -> /= : (xs{hr}, j) <> (xs{hr}, i{hr}) by smt(). +rewrite mp_ran_eq /#. +smt(). +skip=> &1 &2 [-> [ge0_i2 [eq_i_i1 [i1_eq_i2_tim_r [m_min_i1_eq_r H]]]]]. +elim H=> [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. +split; smt(ge0_r). +split; first smt(). +smt(). +move=> mp_L i_L. +split; first smt(). +move=> not_i_L_lt_m H. +elim H=> [_ [_ [_ [[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 HybridIROEager_g_BlockIRO_f (n1 : int) (x2 : block list) : From 9de12f959de2b0e03ad51ea15cdfb1b5d647a30e Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 5 Aug 2016 15:51:32 -0400 Subject: [PATCH 185/394] More work on top-level proof. --- sha3/proof/Sponge.ec | 50 +++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 49 insertions(+), 1 deletion(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index c5dc472..036df39 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -1037,6 +1037,38 @@ module BlockSpongeTrans = { } }. +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 : w = res] = 1%r / (2 ^ r)%r. + byphoare=> //. + proc; rnd; skip; progress; rewrite DWord.bdistrE. + have -> : (fun x => w = x) = (Pred.pred1 w) + by apply ExtEq.fun_ext=> x; by rewrite (eq_sym w x). + by rewrite count_uniq_mem 1:enum_uniq enumP b2i1. +admit. +qed. + lemma HybridIROEager_next (i2 : int) : equiv [HybridIROEagerTrans.next_block ~ BlockSpongeTrans.next_block : @@ -1166,7 +1198,23 @@ seq 3 1 : eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). conseq (_ : true ==> cs{1} = ofblock w{2}). progress; [by rewrite size_block | by rewrite mkblockK]. -admit. +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. From 77d12f631e047ffc56a9b5317a8e80fdce9da8b9 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Sat, 6 Aug 2016 09:25:04 -0400 Subject: [PATCH 186/394] Application of DList.Program. --- sha3/proof/Sponge.ec | 73 +++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 69 insertions(+), 4 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 036df39..c3abb12 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -2,8 +2,10 @@ (* checks with both Alt-Ergo and Z3 *) require import Fun Pair Int IntDiv Real List Option FSet NewFMap DBool. -import IntExtra. -require import Common StdOrder. import IntOrder. +import Pred IntExtra. +require import DList StdBigop. +require import StdOrder. import IntOrder. +require import Common. require (*--*) IRO BlockSponge RndO. (*------------------------- Indifferentiability ------------------------*) @@ -1056,6 +1058,42 @@ module BlockGen = { } }. +(* 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 : bs = res] = + mu (dlist {0,1} r) (pred1 bs). +proof. +have -> : + Pr[Prog.LoopSnoc.sample(r) @ &m: bs = res] = + Pr[Prog.Sample.sample(r) @ &m: bs = res]. + 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 pow1 /#. +by rewrite iterS // IH 1:/# powS // RealExtra.fromintM + StdRing.RField.invfM. +qed. + lemma BlockGen_loop_direct : equiv[BlockGen.loop ~ BlockGen.direct : true ==> ={res}]. proof. @@ -1063,10 +1101,37 @@ bypr res{1} res{2}=> // &1 &2 w. have -> : Pr[BlockGen.direct() @ &2 : w = res] = 1%r / (2 ^ r)%r. byphoare=> //. proc; rnd; skip; progress; rewrite DWord.bdistrE. - have -> : (fun x => w = x) = (Pred.pred1 w) + have -> : (fun x => w = x) = (pred1 w) by apply ExtEq.fun_ext=> x; by rewrite (eq_sym w x). by rewrite count_uniq_mem 1:enum_uniq enumP b2i1. -admit. +have -> : + Pr[BlockGen.loop() @ &1 : w = res] = + Pr[Prog.LoopSnoc.sample(r) @ &1 : ofblock w = res]. + 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 [r_eq [j_eq [j_init [cs_eq cs_init]]]]. + split; first smt(gt0_r). + move=> j_L cs_L l_R i_r not_j_L_lt_r not_i_r_lt_n. + move=> [_ [j_L_eq [cs_L_eq [j_L_le_r sz_cs_L_eq_j_L]]]]. + have sz_cs_L_eq_r : size cs_L = r by smt(). + progress; [by rewrite ofblockK | by rewrite cs_L_eq mkblockK]. +rewrite (PrLoopSnoc_sample &1 (ofblock w)). +rewrite mux_dlist 1:ge0_r size_block /=. +have -> : + (fun (x : bool) => mu {0,1} (pred1 x)) = + (fun (x : bool) => 1%r / 2%r). + apply ExtEq.fun_ext=> x; by rewrite dboolb. +by rewrite Bigreal.BRM.big_const count_predT size_block + iter_mul_one_half_pos 1:gt0_r. qed. lemma HybridIROEager_next (i2 : int) : From 7f650b8e6e75bcb4d17cceced691732b7cc4c1bc Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Sat, 6 Aug 2016 16:38:06 -0400 Subject: [PATCH 187/394] Fixed Common.ec to track PY's change in ordering of cloning renamings. --- sha3/proof/Common.ec | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 3d1cf7e..2580617 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -29,8 +29,8 @@ clone BitWord as Capacity with op n <- c proof gt0_n by apply/gt0_c - rename "word" as "cap" - "dword" as "cdistr" + rename "dword" as "cdistr" + "word" as "cap" "zerow" as "c0". clone export BitWord as Block with @@ -38,8 +38,8 @@ clone export BitWord as Block with op n <- r proof gt0_n by apply/gt0_r - rename "word" as "block" - "dword" as "bdistr" + rename "dword" as "bdistr" + "word" as "block" "zerow" as "b0". (* ------------------------- Auxiliary Lemmas ------------------------- *) From 284594dec9eba1018095bf3850a130ccfdf41023 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Sat, 6 Aug 2016 16:39:05 -0400 Subject: [PATCH 188/394] Isolation of last lemma of top-level proof. --- sha3/proof/Sponge.ec | 138 ++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 135 insertions(+), 3 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index c3abb12..3439750 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -785,6 +785,16 @@ module HybridIROEagerTrans = { } return (bs, i); } + + 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); + } }. pred eager_eq_except @@ -1037,6 +1047,16 @@ module BlockSpongeTrans = { i <- i + 1; return (bs, i); } + + 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); + } }. module BlockGen = { @@ -1134,7 +1154,7 @@ by rewrite Bigreal.BRM.big_const count_predT size_block iter_mul_one_half_pos 1:gt0_r. qed. -lemma HybridIROEager_next (i2 : int) : +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 /\ @@ -1350,6 +1370,19 @@ have -> : size(blocks2bits bs{2}) = i2 * r 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. +proc=> /=. +admit. +qed. + lemma HybridIROEager_g_BlockIRO_f (n1 : int) (x2 : block list) : equiv[HybridIROEager.g ~ BlockSponge.BIRO.IRO.f : n1 = n{1} /\ x2 = x{2} /\ xs{1} = x{2} /\ @@ -1427,7 +1460,106 @@ seq 1 1 : 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}). -admit. +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}, [], n{1}, 0, x{2}; smt(). +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})=> //. +progress; + exists BlockSponge.BIRO.IRO.mp{2}, [], 0, x{2}, ((n{1} + r - 1) %/ r); + smt(). +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}; smt(). +smt(). +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=> //; 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}). +progress; exists BlockSponge.BIRO.IRO.mp{2}, x{2}; smt(). +smt(). +call (HybridIROEagerTrans_BlockSpongeTrans_loop (n1 %/ r)). +skip; progress; smt(divz_ge0 gt0_r). +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=> //; rnd; auto. +auto. auto. +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 (_ : n1 = n{1} /\ 0 <= n1 /\ xs{1} = x{2} /\ n{2} = (n1 + r - 1) %/ r /\ @@ -1538,7 +1670,7 @@ progress [-delta]; exists BlockSponge.BIRO.IRO.mp{2}, bs{2}, (size bs{2}), x{2}=> //. trivial. exists* i{2}; elim*=> i2. -call (HybridIROEager_next i2). +call (HybridIROEagerTrans_BlockSpongeTrans_next_block i2). auto. inline BlockSpongeTrans.next_block; sim. qed. From daa984ee9ce49715d0c14c6b759d0d43c354ec48 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Sun, 7 Aug 2016 09:49:59 -0400 Subject: [PATCH 189/394] Finished top-level proof. :-) Updated comments to make clear that Common.ec and Sponge.ec check with both Alt-Ergo and Z3 and only make use of restricted smt calls (restricted to specified lemmas). --- sha3/proof/Common.ec | 9 ++- sha3/proof/Sponge.ec | 150 ++++++++++++++++++++++++++++++++++++------- 2 files changed, 136 insertions(+), 23 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 2580617..9425328 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -1,5 +1,12 @@ (*------------------- Common Definitions and Lemmas --------------------*) -(* checks with both Alt-Ergo and Z3 *) + +(* checks with both Alt-Ergo and Z3; all smt applications are + restricted to specific lemmas *) + +(* +prover ["Z3"]. +prover ["Alt-Ergo"]. +*) require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. require import Ring StdRing StdOrder StdBigop BitEncoding DProd. diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 3439750..eb3106a 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -1,8 +1,15 @@ (*------------------------- Sponge Construction ------------------------*) -(* checks with both Alt-Ergo and Z3 *) + +(* checks with both Alt-Ergo and Z3; all smt applications are + restricted to specific lemmas *) + +(* +prover ["Z3"]. +prover ["Alt-Ergo"]. +*) require import Fun Pair Int IntDiv Real List Option FSet NewFMap DBool. -import Pred IntExtra. +(*---*) import Pred IntExtra. require import DList StdBigop. require import StdOrder. import IntOrder. require import Common. @@ -747,7 +754,7 @@ module HybridIROEagerTrans = { return bs; } - proc next_block(i, m : int, xs, bs) = { + proc next_block(xs, i, m : int, bs) = { var b; while (i < m) { @@ -758,7 +765,7 @@ module HybridIROEagerTrans = { return (bs, i); } - proc next_block_split(i, m : int, xs, bs) = { + proc next_block_split(xs, i, m : int, bs) = { var b, j, cs; (* assuming block_bits_dom_all_in_or_out xs i HybridIROEager.mp @@ -1179,7 +1186,7 @@ transitivity 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}, (i{1}, m{1}, x{2}, blocks2bits bs{2})=> |>. +exists HybridIROEager.mp{1}, (x{2}, i{1}, m{1}, blocks2bits bs{2})=> |>. split; first smt(). split; first smt(size_blocks2bits). apply @@ -1379,8 +1386,108 @@ lemma HybridIROEagerTrans_BlockSpongeTrans_loop (n' : int) : 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=> /=. -admit. +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=> //; 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=> //; rnd; auto. +auto; smt(). +auto; smt(). +unroll{2} 1. +rcondt{2} 1; first auto; progress; smt(). +rcondf{2} 4. auto. +call (_ : true). if=> //. +skip; smt(). +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}, (size bs{2} * r), (blocks2bits bs{2}), 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=> //; 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}, (size bs{2}), 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=> //; rnd; skip; smt(). +auto. qed. lemma HybridIROEager_g_BlockIRO_f (n1 : int) (x2 : block list) : @@ -1483,7 +1590,7 @@ transitivity{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}, [], n{1}, 0, x{2}; smt(). +progress; exists HybridIROEager.mp{1}, [], n{1}, 0, 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). @@ -1504,8 +1611,7 @@ transitivity{2} (={i, x, bs, BlockSponge.BIRO.IRO.mp} /\ n{2} = (n1 + r - 1) %/ r ==> ={i, x, bs, BlockSponge.BIRO.IRO.mp})=> //. progress; - exists BlockSponge.BIRO.IRO.mp{2}, [], 0, x{2}, ((n{1} + r - 1) %/ r); - smt(). + exists BlockSponge.BIRO.IRO.mp{2}, [], 0, x{2}, ((n{1} + r - 1) %/ r)=> //. conseq (_ : xs{1} = x{2} /\ 0 <= n1 /\ @@ -1515,7 +1621,7 @@ conseq 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); } + { (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} = [] /\ @@ -1523,8 +1629,8 @@ transitivity{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}; smt(). -smt(). +progress; exists HybridIROEager.mp{1}, (n1 %/ r), x{2}=> //. +trivial. inline HybridIROEagerTrans.loop; sp; wp. while (={HybridIROEager.mp} /\ i{1} = i0{2} /\ bs{1} = bs0{2} /\ @@ -1532,16 +1638,15 @@ while wp. call (_ : ={HybridIROEager.mp}). if=> //; rnd; auto. auto. auto. transitivity{2} - { (i, bs) = BlockSpongeTrans.loop(n1 %/ r, x); } + { (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}). -progress; exists BlockSponge.BIRO.IRO.mp{2}, x{2}; smt(). -smt(). + ={i, x, bs, BlockSponge.BIRO.IRO.mp})=> //. +progress; exists BlockSponge.BIRO.IRO.mp{2}, x{2}=> //. call (HybridIROEagerTrans_BlockSpongeTrans_loop (n1 %/ r)). skip; progress; smt(divz_ge0 gt0_r). inline BlockSpongeTrans.loop; sp; wp. @@ -1642,7 +1747,7 @@ skip; progress; smt(size_rcons take_oversize cats1 cats0)]. skip; smt(take_size). transitivity{1} - { (bs, i) <@ HybridIROEagerTrans.next_block(i, m, xs, bs); + { (bs, i) <@ HybridIROEagerTrans.next_block(xs, i, m, bs); } (={i, m, xs, bs, HybridIROEager.mp} ==> ={i, m, xs, bs, HybridIROEager.mp}) @@ -1896,7 +2001,7 @@ by rewrite (Ideal_IRO_Experiment_HybridLazy &m) (Experiment_HybridEager_Ideal_BlockIRO &m). qed. -lemma Conclusion' &m : +lemma conclu &m : `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] - Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res]| = `|Pr[BlockSponge.RealIndif @@ -1911,13 +2016,14 @@ end section. (*----------------------------- Conclusion -----------------------------*) -lemma Conclusion (BlockSim <: BlockSponge.SIMULATOR{IRO, BlockSponge.BIRO.IRO}) - (Dist <: DISTINGUISHER{Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}) - &m : +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/(Conclusion' BlockSim Dist &m). qed. +proof. by apply/(conclu BlockSim Dist &m). qed. From 7ab1eaa1bfd4e186079813c45c0e69039bf2527b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 8 Aug 2016 13:12:46 +0100 Subject: [PATCH 190/394] Use inductives for path specifications --- sha3/proof/core/SLCommon.ec | 20 -------------------- 1 file changed, 20 deletions(-) diff --git a/sha3/proof/core/SLCommon.ec b/sha3/proof/core/SLCommon.ec index f325091..fbb4548 100644 --- a/sha3/proof/core/SLCommon.ec +++ b/sha3/proof/core/SLCommon.ec @@ -1,4 +1,3 @@ - (** 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 @@ -114,7 +113,6 @@ op step_hpath (mh:hsmap) (sah:hstate option) (b:block) = 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) @@ -139,24 +137,6 @@ split. case=> [/#|] p' b' v'' h'' ^/rconssI <<- {p'} /rconsIs <<- {b'}. by rewrite build /= => [#] <*>. qed. -*) - -lemma build_hpathP mh p v h: - build_hpath mh p = Some (v, h) <=> - (p = [] /\ v=b0 /\ h=0) \/ - exists p' b v' h', - p = rcons p' b /\ build_hpath mh p' = Some(v',h') /\ mh.[(v'+^b, h')] = Some(v,h). -proof. (* this is not an induction, but only a case analysis *) -elim/last_ind: p v h => //= [v h|p b _ v h]. -+ by rewrite /build_hpath /= anda_and; split=> [!~#] <*>; [left|move=> [] /#]. -rewrite -{1}cats1 foldl_cat /= -/(build_hpath _ _) /=. -have -> /=: rcons p b <> [] by smt (). (* inelegant -- need lemma in List.ec *) -case: {-1}(build_hpath _ _) (eq_refl (build_hpath mh p))=> //=. -+ by rewrite /step_hpath //= NewLogic.implybN=> -[] p' b0 b' h' [#] /rconssI <*> ->. -move=> [v' h'] build_path; split=> [step_path|[] p' b' v'' h'']. -+ by exists p, b, v', h'. -by move=> [#] ^/rconssI <<- /rconsIs <<-; rewrite build_path=> ->. -qed. (* -------------------------------------------------------------------------- *) From cca16d508ad1b84241f8b1c576f716817d0a4886 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 8 Aug 2016 13:18:13 +0100 Subject: [PATCH 191/394] Goals got reordered. This may need reverted (again). --- sha3/proof/core/Gext.eca | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/sha3/proof/core/Gext.eca b/sha3/proof/core/Gext.eca index 0fe42ad..1605283 100644 --- a/sha3/proof/core/Gext.eca +++ b/sha3/proof/core/Gext.eca @@ -619,23 +619,23 @@ section EXT. 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 (dom G1.m `|` dom G1.mi ))); skip=> /> &hr ? ? -> /= ? ?. - rewrite (Mu_mem.mu_mem - (image snd (dom G1.m{hr} `|` dom G1.mi{hr})) - cdistr (1%r/(2^c)%r))//. + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x));skip=> /> &hr ??-> /= ??. + rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. + by move=>x _;apply DWord.cdistr1E. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU fcardU le_fromint. + rewrite imageU !fcardU le_fromint fcard1. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). by rewrite -!sizeE;smt w=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 (dom G1.m `|` dom G1.mi) `|` fset1 x));skip=> /> &hr ??-> /= ??. - rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. - + by move=>x _;apply DWord.cdistr1E. + wp; rnd (mem (image snd (dom G1.m `|` dom G1.mi ))); skip=> /> &hr ? ? -> /= ? ?. + rewrite (Mu_mem.mu_mem + (image snd (dom G1.m{hr} `|` dom G1.mi{hr})) + cdistr (1%r/(2^c)%r))//. + + by move=>x _;apply DWord.cdistr1E. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU !fcardU le_fromint fcard1. + rewrite imageU fcardU le_fromint. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). by rewrite -!sizeE;smt w=fcard_ge0. + by move=>c1;proc;auto=> &hr [^H 2->]/#. From 63d09341620cb463f825be8953c5d1d09ed1573c Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Mon, 8 Aug 2016 10:10:52 -0400 Subject: [PATCH 192/394] Nits. --- sha3/proof/Sponge.ec | 33 ++++++++++++++++++--------------- 1 file changed, 18 insertions(+), 15 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index eb3106a..a7a2c08 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -1145,10 +1145,11 @@ have -> : size cs{1} = j{1}). wp; rnd; skip. progress; smt(cats1 gt0_r size_rcons). - skip=> &m1 &m2 [r_eq [j_eq [j_init [cs_eq cs_init]]]]. + skip=> &m1 &m2 [# r_eq j_eq j_init cs_eq cs_init]. split; first smt(gt0_r). - move=> j_L cs_L l_R i_r not_j_L_lt_r not_i_r_lt_n. - move=> [_ [j_L_eq [cs_L_eq [j_L_le_r sz_cs_L_eq_j_L]]]]. + move=> + j_L cs_L l_R i_r not_j_L_lt_r not_i_r_lt_n + [# _ j_L_eq cs_L_eq j_L_le_r sz_cs_L_eq_j_L]. have sz_cs_L_eq_r : size cs_L = r by smt(). progress; [by rewrite ofblockK | by rewrite cs_L_eq mkblockK]. rewrite (PrLoopSnoc_sample &1 (ofblock w)). @@ -1246,18 +1247,20 @@ have some_form_mp_hr_lookup_eq : by rewrite ei1_xs_i2 1:/#. by rewrite some_form_mp_hr_lookup_eq oget_some. smt(). -skip. (* getting anomaly from => |> *) -move=> &1 &2 [-> [ge0_i2 [i1_eq_i2_tim_r H]]]. -elim H=> [m_min_i1_eq_r [->> [sz_bs2_eq_i2 H]]]. -elim H=> [sz_b2b_bs2_eq_i1 [->> [mem_dom_mp2_xs_i2 ei]]]. +skip. +move=> + &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=> bs_L i_L. split=> [| not_lt_i_L_m]; first smt(). -move=> [i1_le_i_L_le_m [_ [sz_bs_L_eq_i_L [m1_min_i1_eq_r H]]]]. -elim H=> [bs_L_eq [_ [_ mem_mp2_xs_i2]]]. +move=> + [# i1_le_i_L_le_m _ _ sz_bs_L_eq_i_L m1_min_i1_eq_r + bs_L_eq mem_mp2_xs_i2 _]. split. have i_L_eq_m : i_L = m{1} by smt(). rewrite bs_L_eq -cats1 blocks2bits_cat; congr. @@ -1348,8 +1351,10 @@ rewrite getP. have -> /= : (xs{hr}, j) <> (xs{hr}, i{hr}) by smt(). rewrite mp_ran_eq /#. smt(). -skip=> &1 &2 [-> [ge0_i2 [eq_i_i1 [i1_eq_i2_tim_r [m_min_i1_eq_r H]]]]]. -elim H=> [bs1_eq [sz_bs2_eq_i2 [sz_bs1_eq_i1_add_r [-> ei]]]]. +skip=> + &1 &2 + [# -> ge0_i2 eq_i_i1 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. @@ -1358,12 +1363,10 @@ split; first smt(ge0_r). split; first smt(). split. split; smt(ge0_r). -split; first smt(). -smt(). +split; smt(). move=> mp_L i_L. split; first smt(). -move=> not_i_L_lt_m H. -elim H=> [_ [_ [_ [[i1_le_i_L i_L_le_m] [ee mp_L_ran_eq]]]]]. +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} From 91894d31db70e9ec189ae15c81f168ea56dd509c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 9 Aug 2016 21:14:50 +0100 Subject: [PATCH 193/394] Almost back to before code change. But much more disgusting. The invariant seems to be the right one, but is not expressed in the right way for the new code, which can't be split horizontally as well anymore because the invariant is only true at function boundaries. --- sha3/proof/core/Handle.eca | 610 ++++++++++++++++++++++++++----------- 1 file changed, 440 insertions(+), 170 deletions(-) diff --git a/sha3/proof/core/Handle.eca b/sha3/proof/core/Handle.eca index 755444b..7f3e0e1 100644 --- a/sha3/proof/core/Handle.eca +++ b/sha3/proof/core/Handle.eca @@ -7,10 +7,10 @@ require import DProd Dexcepted. require ConcreteF. clone import GenEager as ROhandle with - type from <- handle, - type to <- capacity, - op sampleto <- fun (_:int) => cdistr - proof sampleto_ll by apply DWord.cdistr_ll. + type from <- handle, + type to <- capacity, + op sampleto <- fun (_:int) => cdistr + proof sampleto_ll by apply DWord.cdistr_ll. module G1(D:DISTINGUISHER) = { var m, mi : smap @@ -156,13 +156,13 @@ module G1(D:DISTINGUISHER) = { inductive eqm_handles (hs : handles) (m : smap) (mh : hsmap) = | MH of (forall xa xc ya yc, m.[(xa,xc)] = Some (ya,yc) => - exists xh yh xf yf, + exists xh xf yh yf, hs.[xh] = Some (xc,xf) /\ hs.[yh] = Some (yc,yf) /\ mh.[(xa,xh)] = Some (ya,yh)) & (forall xa xh ya yh, mh.[(xa,xh)] = Some (ya,yh) => - exists xc yc xf yf, + exists xc xf yc yf, hs.[xh] = Some (xc,xf) /\ hs.[yh] = Some (yc,yf) /\ m.[(xa,xc)] = Some (ya,yc)). @@ -170,16 +170,15 @@ inductive eqm_handles (hs : handles) (m : smap) (mh : hsmap) = inductive mh_spec (hs : handles) (m2 : smap) (mh : hsmap) (ro : (block list,block) fmap) = | H of (forall xa xh ya yh, mh.[(xa,xh)] = Some (ya,yh) => - exists xc yc xf yf, + exists xc xf yc yf, hs.[xh] = Some (xc,xf) /\ hs.[yh] = Some (yc,yf) /\ if yf = Known then m2.[(xa,xc)] = Some (ya,yc) /\ xf = Known - else exists p v b, - ro.[rcons p b] = Some ya - /\ build_hpath mh p = Some (v,xh) - /\ xa = v +^ b) + else exists p v, + ro.[rcons p (v +^ xa)] = Some ya + /\ build_hpath mh p = Some (v,xh)) & (forall p xa b, ro.[rcons p xa] = Some b <=> exists v xh yh, @@ -268,6 +267,7 @@ lemma handles_of_INV (m1 m2 mi1 mi2 : smap) (mh2 mhi2 : hsmap) handles_spec hs ch. proof. by case. qed. +(** ?? **) lemma eqm_dom_mh_m hs m mh hx2 f (x:state): eqm_handles hs m mh => hs.[hx2] = Some (x.`2, f) => @@ -284,6 +284,7 @@ proof. by case=> _ Heq Hlt; apply Hlt; rewrite in_dom Heq. qed. lemma chandle_0 hs ch : handles_spec hs ch => 0 <> ch. proof. by move=> Hh;apply/ltr_eqF/(@chandle_ge0 _ _ Hh). qed. +(** Adding handles **) lemma eqm_up_handles hs ch m mh x2 : handles_spec hs ch => eqm_handles hs m mh => @@ -322,7 +323,7 @@ split=>- [] ^Hbu -> /=; rewrite getP. + case: Hh=> _ _ Hlt x_in_handles. by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom x_in_handles. case: (x = ch)=> //=. -move: Hbu=> /build_hpathP [[#] _ _ ->|[p' b v' h' [#] _ _ Hh']]. +move: Hbu=> /build_hpathP [[#] _ _ ->|p' b v' h' [#] _ _ Hh']. + by rewrite (@chandle_0 _ _ Hh). case: Hh=> _ _ /(_ x) Hlt; rewrite ltr_eqF //. by apply/Hlt; rewrite in_dom; case: Hmh=> /(_ _ _ _ _ Hh') [????] [#] _ ->. @@ -337,10 +338,10 @@ move=> Hx2 ^Hh [] Hu Hh0 Hlt; split. + move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. case: (h1 = ch)=> /= [-> [] ->> ->|_]; (case: (h2 = ch)=> [-> //= |_]). + by move=> Heq ->>; move: (Hx2 f2); rewrite in_rng negb_exists=> /= /(_ h2). - + by move=> Heq [] ->> <<- ->>; move: (Hx2 f1); rewrite in_rng negb_exists=> /= /(_ h1). + + by move=> Heq [] ->> <<- ->>; move: (Hx2 f1); rewrite in_rng negb_exists=> /= /(_ h1). by apply Hu. + by rewrite getP (@chandle_0 _ _ Hh). -+ by move=> h; rewrite dom_set !inE /#. +by move=> h; rewrite dom_set !inE /#. qed. lemma INV_CF_G1_up_handles hs ch m1 mi1 m2 mi2 mh mhi ro pi x2: @@ -356,6 +357,7 @@ exact/(HCF_G1 (eqm_up_handles Hh Heqm) (eqm_up_handles Hh Heqmi) (:@handles_up_handles _ _ x2 Known _ Hh)). qed. +(** Updating forward map **) lemma eqm_handles_up (hs : handles) m mh (h hx:handle) (x y : state) f: huniq hs => hs.[h] = None => @@ -365,13 +367,13 @@ lemma eqm_handles_up (hs : handles) m mh (h hx:handle) (x y : state) f: proof. move=> uniq_h h_h h_hx @/eqm_handles [] hmmh hmhm; split. + move=> b c b' c'; rewrite getP; case ((b,c) = x)=> /= [<<- ->> {x y} /=|]. - * by exists hx, h, f, Known; rewrite !getP /= [smt (in_dom)]. - move=> bc_neq_x /hmmh [] h0 h0' f0 f0' [#] h_h0 h_h0' mhi_bc. - by exists h0, h0', f0, f0'; rewrite !getP [smt (in_dom)]. + * by exists hx, f, h, Known; rewrite !getP /= [smt (in_dom)]. + move=> bc_neq_x /hmmh [] h0 f0 h0' f0' [#] h_h0 h_h0' mhi_bc. + by exists h0, f0, h0', f0'; rewrite !getP [smt (in_dom)]. move=> xb xh b' h'; rewrite getP; case ((xb,xh) = (x.`1,hx))=> /= [[#] <*> [#] <*>|]. - * by exists x.`2, y.`2, f, Known; rewrite !getP [smt (in_dom)]. -rewrite anda_and negb_and=> bh_neq_x1hx /hmhm /= [] c0 c0' f0 f0' [#] h_h0 h_bh' m_bc. -exists c0, c0', f0, f0'; rewrite !getP. + * by exists x.`2, f, y.`2, Known; rewrite !getP [smt (in_dom)]. +rewrite anda_and negb_and=> bh_neq_x1hx /hmhm /= [] c0 f0 c0' f0' [#] h_h0 h_bh' m_bc. +exists c0, f0, c0', f0'; rewrite !getP. split; 1:smt (in_dom). split; 1:smt (in_dom). case x bh_neq_x1hx h_hx=> x1 x2 /= => - [/#|h0_neq_hx h_hx]. @@ -379,6 +381,7 @@ have -> //=: c0 <> x2; move: h0_neq_hx; apply/contra. exact/(@uniq_h _ _ _ _ h_h0 h_hx). qed. +(** Updating backward map **) lemma eqmi_handles_up (hs : handles) mi mhi (h hx : handle) (x y : state) f: (!exists f', mem (rng hs) (y.`2,f')) => hs.[h] = None => @@ -388,13 +391,13 @@ lemma eqmi_handles_up (hs : handles) mi mhi (h hx : handle) (x y : state) f: proof. move=> y_notinr1_handles h_h h_hx @/eqm_handles [] hmmh hmhm; split. + move=> xb xc xb' xc'; rewrite getP; case ((xb,xc) = y)=> /= [<<- ->> {x y}|]. - * by exists h, hx, Known, f; rewrite !getP /= [smt (in_dom)]. - move=> bc_neq_y /hmmh [] h0 h0' f0 f0' [#] h_h0 h_h0' mhi_bc. - by exists h0, h0', f0, f0'; rewrite !getP [smt (in_dom)]. + * by exists h, Known, hx, f; rewrite !getP /= [smt (in_dom)]. + move=> bc_neq_y /hmmh [] h0 f0 h0' f0' [#] h_h0 h_h0' mhi_bc. + by exists h0, f0, h0', f0'; rewrite !getP [smt (in_dom)]. move=> xb xh xb' xh'; rewrite getP; case ((xb,xh) = (y.`1,h))=> /= [[#] <*> [#] <*>|]. - * by exists y.`2, x.`2, Known, f; rewrite !getP [smt (in_dom)]. -rewrite anda_and negb_and=> bh_neq_y1h /hmhm /= [] c0 c0' f0 f0' [#] h_bh h_bh' mi_bh. -exists c0, c0', f0, f0'; rewrite !getP. + * by exists y.`2, Known, x.`2, f; rewrite !getP [smt (in_dom)]. +rewrite anda_and negb_and=> bh_neq_y1h /hmhm /= [] c0 f0 c0' f0' [#] h_bh h_bh' mi_bh. +exists c0, f0, c0', f0'; rewrite !getP. split; 1:smt (in_dom). split; 1:smt (in_dom). case y bh_neq_y1h y_notinr1_handles=> y1 y2 /= [/#|h0_neq_h y_notinr1_handles]. @@ -427,20 +430,28 @@ proof. by case f. qed. op getflag (hs : handles) xc = omap snd (obind ("_.[_]" hs) (hinv hs xc)). -lemma getflagP hs xc f: +lemma getflagP_none hs xc: + (getflag hs xc = None <=> forall f, !mem (rng hs) (xc,f)). +proof. +rewrite /getflag; case: (hinvP hs xc)=> [->|] //=. ++ smt (in_rng). +smt (in_rng). +qed. + +lemma getflagP_some hs xc f: huniq hs => - (mem (rng hs) (xc,f) <=> getflag hs xc = Some f). + (getflag hs xc = Some f <=> mem (rng hs) (xc,f)). proof. move=> huniq_hs; split. -+ rewrite in_rng=> -[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. -rewrite /getflag; case: (hinvP hs xc)=> [-> //|]. -rewrite in_rng; case: (hinv hs xc)=> //= h [f']. -rewrite oget_some=> ^ hs_h -> @/snd /= ->>. -by exists h. ++ rewrite /getflag; case: (hinvP hs xc)=> [-> //|]. + rewrite in_rng; case: (hinv hs xc)=> //= h [f']. + rewrite oget_some=> ^ hs_h -> @/snd /= ->>. + by exists h. +rewrite in_rng=> -[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. lemma paths_prefix handles m2 mh ro paths c b p v: @@ -450,33 +461,200 @@ lemma paths_prefix handles m2 mh ro paths c b p v: (exists c' v', paths.[c'] = Some (p,v')). proof. move=> [] mh_some _ [] hpaths ^paths_c. -move=> /hpaths [h] [#] /build_hpathP [/#|] [p' b' v' h'] [#] ^/rconsIs + /rconssI- <*>. +move=> /hpaths [h] [#] /build_hpathP [/#|] p' b' v' h' [#] ^/rconsIs + /rconssI- <*>. move=> hpath + handles_h - /mh_some /= [c' c0 f' f]; rewrite handles_h /= => /> handles_h' _. by exists c', v'; rewrite hpaths; exists h'. qed. 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')). + 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. -move=> /build_hpathP [/#|] [p' b' v' h'] [#] + + _. -move=> ^/rconsIs <<- {b'} /rconssI <<- {p'} H. -by exists v', h'. +rewrite build_hpathP; split=> [[/#|p' b' v' h' [#] + Hhpath Hmh]|[v' h'] [] Hhpath Hmh]. ++ by move=> ^/rconsIs <<- {b'} /rconssI <<- {p'}; exists v', h'. +exact/(Extend _ _ _ _ _ Hhpath Hmh). qed. -clone export ConcreteF as ConcreteF1. +lemma iter_step_path_from_None mh p: foldl (step_hpath mh) None p = None. +proof. by elim: p. qed. + +lemma build_hpath_up mh xc xh yc yh p b h: + !mem (dom mh) (xc,xh) => + build_hpath mh p = Some (b,h) => + build_hpath mh.[(xc,xh) <- (yc,yh)] p = Some (b,h). +proof. +move=> xch_notin_mh @/build_hpath. +have: (exists p' v h, build_hpath mh p' = Some (v +^ b0,h)). ++ by exists [], b0, 0; rewrite build_hpathP Block.xorw0; exact/Empty. +pose root:= b0; elim: p root 0=> //= b1 p ih bn hn. +rewrite /(step_hpath _ (Some _)) /= oget_some /= /(step_hpath _ (Some _)) /= oget_some /= getP. +case: (mem (dom mh) (bn +^ b1,hn))=> [bnb1hn_in_mh extend_path|]. ++ have -> /= : (bn +^ b1,hn) <> (xc,xh). + + apply/contraT=> /(congr1 (mem (dom mh)) (bn +^ b1,hn) (xc,xh)). + by rewrite xch_notin_mh bnb1hn_in_mh. + case: {-1}(mh.[(bn +^ b1,hn)]) (eq_refl (mh.[(bn +^ b1,hn)]))=> //=. + + smt. (* figure out *) + move=> [] b2 h2 mh_bnb1hn. + apply/(@ih b2 h2). + case: extend_path=> p' v hp' build_path. + by exists p', (v +^ bn +^ b2), hp'; rewrite build_path //= #ring. +by rewrite in_dom /= => mh_bnb1hn _; rewrite mh_bnb1hn iter_step_path_from_None. +qed. + +lemma build_hpath_down mh xc xh yc yh p v h: + 0 <> xh + => (forall c' h' xc', mh.[(c',h')] <> Some (xc',xh)) + => build_hpath mh.[(xc,xh) <- (yc,yh)] p = Some (v,h) + => build_hpath mh p = Some (v,h). +proof. +move=> xh_neq_0 xh_notin_rng2_mh. +elim/last_ind: p v h=> [v h /build_hpathP [<*>|/#] //=|p b ih]. +move=> v h /build_hpathP [/#|p' b' + + ^/rconsIs <<- /rconssI <<-]. +move=> v' h' /ih; rewrite getP. +case: ((v' +^ b,h') = (xc,xh))=> [[#] <*> + [#] <*>|_ Hpath Hmh]. ++ by move=> /build_hpathP [|] /#. +exact/build_hpathP/(Extend _ _ _ _ _ Hpath Hmh). +qed. -inductive if_ind (b t e: bool) = - | Then of b & (b => t) - | Else of (!b) & (!b => e). +lemma INV_CF_G1_notin_PFm_notin_G1m hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x: + INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi => + PFm.[x] = None => + G1m.[x] = None. +proof. by move=> /incl_of_INV G1m_le_PFm; apply/contraLR=> ^h; rewrite G1m_le_PFm. qed. -lemma ifP (b t e : bool): (if b then t else e) <=> if_ind b t e. +lemma INV_CF_G1_0 hs PFm PFmi G1m G1mi G1mh G1mhi ro pi: + !INV_CF_G1 hs 0 PFm PFmi G1m G1mi G1mh G1mhi ro pi. proof. -split; case: b=> _ => [t_|e_|[]//|[]//]. -+ exact/Then. -exact/Else. +rewrite -negP=> -[] _ _ _ _ _ _ [] _ + /(_ 0) /=. +by rewrite in_dom=> ->. qed. +(** Clean this up and tidy intermediate results, more particularly + anything that is derived from individual components of INV_CF_G1 **) +lemma lemma1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro (pi : (capacity,block list * block) fmap) x1 x2 y1 y2: + x2 <> y2 => + PFm.[(x1,x2)] = None => + G1m.[(x1,x2)] = None => + pi.[x2] = None => + (forall f, !mem (rng hs) (x2,f)) => + (forall f, !mem (rng hs) (y2,f)) => + INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi => + INV_CF_G1 hs.[ch <- (x2,Known)].[ch + 1 <- (y2,Known)] (ch + 2) + PFm.[(x1,x2) <- (y1,y2)] PFmi.[(y1,y2) <- (x1,x2)] + G1m.[(x1,x2) <- (y1,y2)] G1mi.[(y1,y2) <- (x1,x2)] + G1mh.[(x1,ch) <- (y1,ch + 1)] G1mhi.[(y1,ch + 1) <- (x1,ch)] + ro pi. +proof. +move=> x2_neq_y2 PFm_x G1m_x pi_x2 x2_notin_hs y2_notin_hs Hinv; split. ++ apply/(@eqm_handles_up hs.[ch <- (x2,Known)] PFm G1mh (ch + 1) ch (x1,x2) (y1,y2) Known). + + move=> @/huniq h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. + case: (h1 = ch); case: (h2 = ch)=> //=. + + move=> + + [#] - + <*>. + by move: (x2_notin_hs f2); rewrite in_rng negb_exists /= => ->. + + move=> <*> + + [#] <*>. + by move: (x2_notin_hs f1); rewrite in_rng negb_exists /= => ->. + case: Hinv=> _ _ _ _ _ _ [] + _ _ _ _ - h. + exact/(@h h1 h2 (c1,f1) (c2,f2)). + + by rewrite getP; case: Hinv=> _ _ _ _ _ _ [] _ _; smt (in_dom). + + by rewrite getP. + by apply/eqm_up_handles; case: Hinv. ++ apply/(@eqmi_handles_up hs.[ch <- (x2,Known)] PFmi G1mhi (ch + 1) ch (x1,x2) (y1,y2) Known). + + rewrite negb_exists /= => f; rewrite in_rng negb_exists /= => h. + rewrite getP; case: (h = ch)=> _; first by rewrite /= x2_neq_y2. + by move: (y2_notin_hs f); rewrite in_rng negb_exists /= => ->. + + by rewrite getP; case: Hinv=> _ _ _ _ _ _ [] _ _; smt (in_dom). + + by rewrite getP. + by apply/eqm_up_handles; case: Hinv. ++ move=> z; rewrite !getP; case: (z = (x1,x2))=> //= _. + by case: Hinv=> _ _ + _ _ _ _ - @/incl /(_ z). ++ move=> z; rewrite !getP; case: (z = (y1,y2))=> //= _. + by case: Hinv=> _ _ _ + _ _ _ - @/incl /(_ z). ++ split. + + move=> xa xh ya yh; rewrite getP; case: ((xa,xh) = (x1,ch)). + + move=> /= [#] <*> [#] <*>; exists x2, Known, y2, Known=> //=. + by rewrite !getP /#. + rewrite /= anda_and negb_and=> h hG1mh. (* This one needs cleaned up in priority. These are things that should be deduced instantly. *) + have := Hinv=>- [] _ _ _ _ [] + _ _ _ - h0. + have [xc xf yc yf] [#] hs_xh hs_yh ite:= h0 _ _ _ _ hG1mh. + have yh_lt_ch: xh < ch by case: Hinv=> _ _ _ _ _ _ [] _ _ -> //; rewrite in_dom hs_xh. + have xh_lt_ch: yh < ch by case: Hinv=> _ _ _ _ _ _ [] _ _ -> //; rewrite in_dom hs_yh. + exists xc, xf, yc, yf. + split; first by smt (getP). + split; first by smt (getP). + split=> /=. + + by move: ite=> <*> /= [#] hG1m -> //=; rewrite getP; case: ((xa,xc) = (x1,x2))=> [<*> /#|]. + move: ite=> + hrw; move: hrw=> -> /= [p v] [#] ro_pv hpath. + exists p, v; rewrite ro_pv /=. + apply/build_hpath_up=> //=; case: Hinv=> _ _ _ _ _ _ [] _ _ hh. + rewrite -negP in_dom; case: {-1}(G1mh.[(x1,ch)]) (eq_refl (G1mh.[(x1,ch)]))=> [//=|[xa' xh']]. + move=> /h0 [xc0 xf0 ? ?] [] + _. + by move: (hh ch)=> /=; rewrite in_dom /= => ->. + (* These two are going to be painful: -> are easy. <- rely on the fact that neither x not y had an associated handle, and therefore cannot be involved in a path. This is crucial. Maybe some other permutation of the goals/invariant's conjuncts would help clarify. *) + + move=> p xa b; have:= Hinv=>- [] _ _ _ _ [] _ -> _ _. + apply/exists_iff=> v /=; apply/exists_iff=> xh /=; apply/exists_iff=> yh /=. + have G1mh_x1ch: G1mh.[(x1,ch)] = None. + + have /# : forall x1' xh', G1mh.[(x1,ch)] <> Some (x1',xh'). + move=> x1' xh'; rewrite -negP=> G1mh_xh'. + have [] [] _ ht _ _ _ _ _ _ := Hinv. + move: (ht _ _ _ _ G1mh_xh')=> [xc xf yc yf] [#] + _ _ {ht}. + have [] _ _ _ _ _ _ [] _ _ /(_ ch):= Hinv. + by rewrite in_dom=> /= ->. + have ch_notin_G1mh: forall cx, !mem (rng G1mh) (cx,ch). + + move=> cx; rewrite in_rng negb_exists=> - [b0 h0] /=; rewrite -negP=> G1mh_cxch. + by case: Hinv=> - [] _ + _ _ _ _ _ [] _ _ + - /(_ ch) + /(_ _ _ _ _ G1mh_cxch) [xc xf yc yf] [#] _ hs_ch _ - /=; rewrite in_dom hs_ch. + split=> -[#]. + + move=> hpath hG1mh. + rewrite getP; case: ((v +^ xa,xh) = (x1,ch))=> [/#|_]. + rewrite hG1mh //=. + by apply/build_hpath_up=> //=; rewrite in_dom G1mh_x1ch. + (* The following case should be built into the lemma (build_hpath_down) *) + rewrite getP; case: ((v +^ xa,xh) = (x1,ch))=> [[#] <*> + [#] <*>|]. + + have ht /ht {ht} /= := (build_hpath_down G1mh (v +^ xa) ch b (ch + 1) p v ch _ _). + + by case: Hinv=> _ _ _ _ _ _ [] _ + +; smt (in_dom). + + move=> c' h' xc'; move: (ch_notin_G1mh xc'). + by rewrite in_rng negb_exists /= => ->. + move=> /build_hpathP [<*>|p' b' v' h' <*>]; first by rewrite INV_CF_G1_0 in Hinv; smt (). + by move: (ch_notin_G1mh v); rewrite in_rng negb_exists /= => ->. + move=> _. + have ht /ht {ht} /= -> //= := build_hpath_down G1mh x1 ch y1 (ch + 1) p v xh _ _. + + by case: Hinv=> _ _ _ _ _ _ [] _ + +; smt (in_dom). + by move=> c' h' xc'; move: (ch_notin_G1mh xc'); rewrite in_rng negb_exists /= => ->. ++ split=> c p v; have [] _ _ _ _ _ [] -> _:= Hinv. + apply/exists_iff=> h /=; split=> [#]. + have ht /ht {ht} -> /= := build_hpath_up G1mh x1 ch y1 (ch +1) p v h _. + + rewrite in_dom /=; case: {-1}(G1mh.[(x1,ch)]) (eq_refl (G1mh.[(x1,ch)]))=> [|[x1' xh'] G1mh_x1'xh'] //=. + case: Hinv=> - [] _ /(_ _ _ _ _ G1mh_x1'xh') [xc xf ct ft] [#] hs_ch _ _ _ _ _ _ _ [] _ _ /(_ ch) /=. + by rewrite in_dom hs_ch. + move=> hs_h; rewrite !getP hs_h. + have /#: h < ch. + by case: Hinv=> _ _ _ _ _ _ [] _ _ /(_ h); rewrite in_dom hs_h. + have ch_notin_G1mh: forall cx, !mem (rng G1mh) (cx,ch). + + move=> cx; rewrite in_rng negb_exists=> - [b0 h0] /=; rewrite -negP=> G1mh_cxch. + by case: Hinv=> - [] _ + _ _ _ _ _ [] _ _ + - /(_ ch) + /(_ _ _ _ _ G1mh_cxch) [xc xf yc yf] [#] _ hs_ch _ - /=; rewrite in_dom hs_ch. + have Sch_notin_G1mh: forall cx, !mem (rng G1mh) (cx,ch + 1). + + move=> cx; rewrite in_rng negb_exists=> - [b0 h0] /=; rewrite -negP=> G1mh_cxch. + by case: Hinv=> - [] _ + _ _ _ _ _ [] _ _ + - /(_ (ch + 1)) + /(_ _ _ _ _ G1mh_cxch) [xc xf yc yf] [#] _ hs_ch _ - /=; rewrite in_dom hs_ch /#. + have ht /ht {ht} /= := build_hpath_down G1mh x1 ch y1 (ch + 1) p v h _ _. + + by case: Hinv=> _ _ _ _ _ _ [] _ + +; smt (in_dom). + + by move=> c' h' xc'; move: (ch_notin_G1mh xc'); rewrite in_rng negb_exists /= => ->. + move=> Hpath; rewrite Hpath /=. + have: h <> ch /\ h <> ch + 1; last by smt (getP). + case: (h = 0)=> [<*>|]. + + by case: Hinv=> _ _ _ _ _ _ [] _ + /(_ 0) //=; rewrite in_dom=> /#. + move=> h_neq_0; move: Hpath=> /build_hpathP [<*> /#|p' b' v' h' <*> _]. + move: (ch_notin_G1mh v); rewrite in_rng negb_exists /= => /(_ (v' +^ b',h')). + move: (Sch_notin_G1mh v); rewrite in_rng negb_exists /= => /(_ (v' +^ b',h')). + smt (). +have ->: ch + 2 = ch + 1 + 1 by rewrite -addzA. +apply/(@handles_up_handles hs.[ch <- (x2,Known)] (ch + 1) y2 Known). ++ move=> f; rewrite in_rng negb_exists /= => h; rewrite !getP. + case: (h = ch)=> [<*> /=|_]; first by rewrite x2_neq_y2. + by move: (y2_notin_hs f); rewrite in_rng negb_exists /= => ->. +by apply/handles_up_handles=> //=; case: Hinv. +qed. + +clone export ConcreteF as ConcreteF1. + section AUX. declare module D : DISTINGUISHER {PF, RO, G1}. @@ -487,7 +665,7 @@ section AUX. equiv CF_G1 : CF(D).main ~ G1(D).main: ={glob D} ==> !(G1.bcol \/ G1.bext){2} => ={res}. - proof. + proof. proc. call (_: G1.bcol \/ G1.bext, INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} @@ -496,125 +674,217 @@ section AUX. + exact/D_ll. (** proofs for G1.S.f *) (* equivalence up to bad of PF.f and G1.S.f *) - + proc; if{1}=> //=. - (* x is not in m{1} so forall h, (x.1,h) is not in mh{2} *) - + rcondt{2} 1. - + move=> &m; auto=> &m' [#] _ <- Hinv. - by rewrite !in_dom; apply/contra=> ^ h; case: Hinv=> _ _ ->. - exists* F.RO.m{2}; elim*=> ro0. - seq 2 3: ( !G1.bcol{2} - /\ (G1.bext <=> mem (rng FRO.m) (x.`2, Unknown)){2} - /\ ={x,y1,y2} - /\ 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} ro0 G1.paths{2} - /\ ! mem (dom PF.m{1}) x{1} - /\ (if mem (dom G1.paths) x.`2 - then let (p,v) = oget G1.paths.[x.`2] in - F.RO.m{2} = ro0.[rcons p (v+^x.`1) <- y.`1] - else F.RO.m = ro0){2}). - + if{2}; last first. - + by auto=> |> &1 &2; rewrite negb_or; case=> -> ->. - inline{2} F.RO.get; rcondt{2} 4. - + auto=> |> &m'; case: (x{m'})=> /= _x1 _x2 _ [] - [] m_some mh_some _ leq _ [] in_mh in_ro [] in_pi [] hs_inj hs0 hs_dom + + r0 _ - {r0} + x2_in_pi. - have:= x2_in_pi; rewrite in_dom. - case: {-1}(G1.paths.[_x2]{m'}) (eq_refl (G1.paths.[_x2]{m'}))=> //= -[] p v paths_x2. - rewrite oget_some /=; have /in_pi [h_x2] [#] pv_hx2 hs_h_x2:= paths_x2. - apply/contra; rewrite !in_dom. - case: {-1}(F.RO.m.[rcons p (v +^ _x1)]{m'}) (eq_refl (F.RO.m.[rcons p (v +^ _x1)]{m'}))=> //= b. - move=> ^ro_pv_x1 /in_ro [v' xh yh] [#]. - rewrite pv_hx2 /= => [#] <<- <<-. - rewrite Block.xorwA Block.xorwK Block.xorwC Block.xorw0. - by move=> /mh_some [xc yc xf yf] [#]; rewrite hs_h_x2 /= => [#] <<- <<- _ ->. - auto=> |> &1 &2; rewrite negb_or; case=> -> -> /= Hinv x_notin_PF ^x2_in_paths. - rewrite in_dom; case: {-1}(G1.paths.[x.`2]{2}) (eq_refl G1.paths.[x.`2]{2})=> //=. - move=> [p v] paths_x2 y1' _ y2' _; rewrite oget_some /=. - rewrite getP /= oget_some /= => x1 x2 [] <- <-. - by rewrite getP /= oget_some. - auto=> &1 &2; case: (x{2})=> [] x1 x2 /= [#] not_bcol bext_upd <*>. - rewrite ifP=> Hinv x_notin_PF ROupd. - split=> /= [x2K_notin_rFRO|x2K_in_rFRO]. - + split=> /= [#]. - + admit. - admit. - admit. -(* swap{2} 3-2;swap{2}6-4;wp;conseq (_:y{1} =(r,y2){2}). - + progress [-split];rewrite getP_eq oget_some H2/=. - by move:H2;rewrite in_dom;case:(G1.paths{2}.[_]). - transitivity{1} {y <- S.sample();} (true ==> ={y}) (true==>y{1}=(r,y2){2})=>//;1:by inline*;auto. - transitivity{2} {(r,y2) <- S.sample2();} (true==>y{1}=(r,y2){2}) (true==> ={r,y2})=>//;2:by inline*;auto. - by call sample_sample2;auto=> /=?[??]->. - case (mem (rng FRO.m{2}) (x{2}.`2, Unknown)). - + conseq (_:true);[by move=> ??[][]_[]->_->|auto]. - conseq (_: !G1.bcol{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}). - by move=> ??[][]_[]->[][]-> _ _ ->. *) - admit. -(* seq 0 2: ((!G1.bcol{2} /\ ={x, y} /\ - 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} ro0 paths0 /\ - ! mem (dom PF.m{1}) x{1} /\ - if mem (dom paths0) x{2}.`2 then - let (p0, v0) = oget paths0.[x{2}.`2] in - F.RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ - G1.paths{2} = paths0.[y{2}.`2 <- (rcons p0 (v0 +^ x{2}.`1), y{2}.`1)] - else F.RO.m{2} = ro0 /\ G1.paths{2} = paths0) /\ - !mem (rng FRO.m{2}) (x{2}.`2, Unknown) /\ - (FRO.m.[hx2]=Some(x.`2,Known)){2}). - + auto=> &ml&mr[][]->[]_[][]-> ->[]Hinv []-> -> ^Hrng-> /=. - case (mem (rng FRO.m{mr}) (x{mr}.`2, Known))=> Hmem /=. - + by split=>//;apply /huniq_hinvK=>//;move:Hinv;rewrite /INV_CF_G1/handles_spec. - rewrite -anda_and;split=> [ | {Hinv}Hinv]. - + by apply INV_CF_G1_up_handles=>//[[]]. - rewrite rng_set (huniq_hinvK_h G1.chandle{mr}) ?getP//. - + by move:Hinv;rewrite /INV_CF_G1/handles_spec. - by rewrite oget_some /=!inE/=;move:Hrng;apply NewLogic.contraLR=>/=;apply rng_rem_le. + + conseq (_: !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} + ==> !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}). + + by move=> &1 &2; rewrite negb_or. + + by move=> &1 &2 _ ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? [#]; rewrite negb_or. + (* 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. *) + (* We want to name everything for now, to make it easier to manage complexity *) + 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}. + elim * => hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 [] 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) + (eq_refl (INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0)); 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=> x1x2_notin_PFm. + move: (INV_CF_G1_notin_PFm_notin_G1m _ _ _ _ _ _ _ _ _ _ _ inv0 x1x2_notin_PFm). + move=> x1x2_notin_G1m. + rcondt{1} 1; 1:by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom x1x2_notin_PFm. + rcondt{2} 1; 1:by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom x1x2_notin_G1m. + case @[ambient]: {-1}(pi0.[x2]) (eq_refl (pi0.[x2])). + + move=> x2_in_pi; rcondf{2} 1. + + by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom x2_in_pi. + rcondf{2} 8. + + by move=> //= &1; auto=> &2 [#] !<<-; rewrite !in_dom 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} + /\ (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). + + by auto. + case @[ambient]: {-1}(getflag hs0 x2) (eq_refl (getflag hs0 x2)). + + rewrite getflagP_none => x2f_notin_rng_hs0; rcondt{2} 3. + + by move=> &1; auto=> &2 />; rewrite x2f_notin_rng_hs0. + 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 !getP; case: (hx = G1.chandle{2}); case: (hy = G1.chandle{2})=> //=. + + move=> _ + [#] - <*>. + by have:= (x2f_notin_rng_hs0 yf); rewrite in_rng negb_exists /= => ->. + + move=> + _ + [#] - <*>. + by have:= (x2f_notin_rng_hs0 xf); rewrite in_rng negb_exists /= => ->. + by move=> _ _; case: inv0=> _ _ _ _ _ _ [] + _ _ - /(_ hx hy (xc,xf) (yc,yf)). + by rewrite !getP. + rewrite oget_some=> _ _ _. + have -> //: !mem (dom G1.mh{2}) (x1,G1.chandle{2}). + rewrite in_dom /=; case: {-1}(G1.mh.[(x1,G1.chandle)]{2}) (eq_refl (G1.mh.[(x1,G1.chandle)]{2}))=> //= -[xa xh]; rewrite -negP. + case: inv0=> - [] _ + _ _ _ _ _ [] _ _ h_handles. + move=> /(_ x1 G1.chandle{2} xa xh) h /h [] xc xf yc yf. + by have ->: FRO.m.[G1.chandle]{2} = None by smt (in_dom). + case: (x2 <> y2{2} /\ (forall f, !mem (rng hs0) (y2{2},f))). + + auto=> &1 &2 [#] !<<- -> -> !->> {&1} /= _ x2_neq_y2 y2_notin_hs _ _. + rewrite getP /= oget_some /= -addzA /=. + rewrite (@huniq_hinvK_h ch0 hs0.[ch0 <- (x2,Known)] x2); 2:by rewrite getP. + + move=> @/huniq h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. + case: (h1 = ch0); case: (h2 = ch0)=> //=. + + by move=> _ + [#] - <*>; move: (x2f_notin_rng_hs0 f2); rewrite in_rng negb_exists=> /= ->. + + by move=> + _ + [#] <*> - <*>; move: (x2f_notin_rng_hs0 f1); rewrite in_rng negb_exists=> /= ->. + move=> _ _; case: inv0=> _ _ _ _ _ _ [] + _ _ - h. + by apply/h; rewrite getP. + by rewrite oget_some; exact/lemma1. + conseq (_: _ ==> G1.bcol{2})=> //=. + auto=> &1 &2 [#] !<<- -> _ ->> !<<- _ /=. + case: (hinvP hs0.[ch0 <- (x2,Known)] y2{1})=> //= -> /=. + move=> hs0_spec; split=> [|f]. + + by have:= hs0_spec ch0 Known; rewrite getP. + rewrite in_rng negb_exists /= => h. + have:= hs0_spec h f; rewrite getP; case: (h = ch0)=> [<*>|//=]. + by have -> //=: hs0.[ch0] = None; case: inv0=> _ _ _ _ _ _ [] _ _; smt (in_dom). + case; rewrite getflagP_some; 1,3:by case: inv0=> _ _ _ _ _ _ []. + + by move=> x2_is_U; conseq (_: G1.bext{2})=> //=; auto=> &1 &2 />; rewrite x2_is_U. + move=> x2_is_K; rcondf{2} 3; 1:by move=> &1; auto. + have:= x2_is_K; rewrite in_rng=> - [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} + /\ (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). + + auto=> &1 &2 /> _ -> /= _; split. + + move: x2_is_K; rewrite in_rng /= => -[hx2] hs_hx2. + rewrite in_rng negb_exists /==> h; rewrite -negP=> hs_h. + case: inv0=> _ _ _ _ _ _ [] Hhuniq _ _. + by move: (Hhuniq _ _ _ _ hs_hx2 hs_h)=> ht; move: ht hs_h=> /= <*>; rewrite hs_hx2. + rewrite (@huniq_hinvK_h hx FRO.m{2} x2) //. + by case: inv0=> _ _ _ _ _ _ []. + have x1hx_notin_G1m: !mem (dom G1mh) (x1,hx). + + rewrite in_dom; case: {-1}(G1mh.[(x1,hx)]) (eq_refl G1mh.[(x1,hx)])=> //=. + move=> [mhx1 mhx2]; rewrite -negP=> h. + have:= inv0=> -[] [] _ hg _ _ _ _ _ _. + have [xa xh ya yh] := hg _ _ _ _ h. + by rewrite hs0_hx=> [#] <*>; rewrite x1x2_notin_PFm. rcondf{2} 1. - + move=> &ml;skip=> &mr[][]_[][]-> _ []Hinv[]Hndom _[]_ Hh;rewrite -not_def in_dom=> -[]. - move:Hinv=>[][][]_ /(_ (x{mr}.`1, hx2{mr}));case (G1.mh{mr}.[_])=>// bh' /(_ bh') [c c' f f'] /=. - by rewrite Hh/= => -[][]<- _ []_ H;case: (x{mr}) H Hndom => [x1 x2];rewrite in_dom=>->. - auto=> &1 &2 [#] -> ->> ->> hinv x_notin_PF disj x2U_notinr_FRO FRO_hx2 /= hinv_y2. - have:= hinvP FRO.m{2} y{2}.`2; rewrite hinv_y2 //= => y2_notinr1_FRO. - rewrite getP /= oget_some /= /INV_CF_G1. - rewrite (eqm_handles_up FRO.m{2} PF.m{1} G1.mh{2} G1.chandle{2} hx2{2} x{2} y{2} Known _ _ _ _) //= 1..3:[smt w=in_dom]. - rewrite (eqmi_handles_up FRO.m{2} PF.mi{1} G1.mhi{2} G1.chandle{2} hx2{2} x{2} y{2} Known _ _ _ _) //= 2..3:[smt w=in_dom]. - + rewrite negb_exists=> f /=; rewrite in_rng negb_exists=> h. - exact/(y2_notinr1_FRO h f). - have /eqT -> /= := incl_set G1.m{2} PF.m{1} x{2} y{2} _; 1: by smt ml=0. - have /eqT -> /= := incl_set G1.mi{2} PF.mi{1} y{2} x{2} _; 1: by smt ml=0. - rewrite handles_up_handles 1:[smt w=in_rng] 1:/# /=. - split. - rewrite /mh_spec; split. - move=> bh [] b ch; rewrite getP; case (bh = (x.`1,hx2){2})=> [<*> /=|]. - rewrite anda_and=> [#] <*>. - exists x{2}.`2, y{2}.`2, Known, Known=> //=. - rewrite !getP /=; elim: (x{2}) FRO_hx2=> x1 x2 FRO_hx2; elim (y{2})=> y1 y2 /=. - have /#: hx2{2} = G1.chandle{2} => false. - move=> /(congr1 (fun x=> FRO.m{2}.[x])) /=; rewrite FRO_hx2. - have:= handles_spec_notin_dom FRO.m{2} G1.chandle{2} _; 1: smt ml=0. - by rewrite in_dom /= => ->. - elim bh=> b' h' /=; rewrite anda_and negb_and=> bh_neq_xhx ^mh_bh. - have @/eqm_handles [] hmmh hmhm := eqm_of_INV _ _ _ _ _ _ _ _ _ _ hinv. - move=> /hmhm=>- [c c' f f'] /= [#] FRO_h' FRO_ch PF_b'c. - exists c, c', f, f'=> //=. - rewrite !getP /=; elim: (x{2}) FRO_hx2 mh_bh x2U_notinr_FRO x_notin_PF bh_neq_xhx=> x1 x2 /= FRO_hx2 mh_bh x2U_notinr_FRO x_notin_PF bh_neq_xhx. - elim: (y{2}) y2_notinr1_FRO hinv_y2=> y1 y2 /= y2_notinr1_FRO hinv_y2. - have -> /=: h' <> G1.chandle{2} by smt w=in_dom. - rewrite FRO_h' /=. - have -> /=: ch <> G1.chandle{2} by smt w=in_dom. - rewrite FRO_ch /=; split=> /= [|/neq_Known ->> {f'}]. - case bh_neq_xhx=> [-> /#|h'_neq_hx2]. - have /#: c <> x2. - have @/handles_spec [] huniq _ := handles_of_INV _ _ _ _ _ _ _ _ _ _ hinv. - by move: h'_neq_hx2; apply/contra/(huniq _ _ (c,f) (x2,Known)). - case disj. - rewrite in_dom; case (paths0.[x{2}.`2])=> @/oget //= [[p0 v]] /= [#] <*>. - admit. (** KEY observation: if two hstates lead to hstates that - share the same handle through mh, then they are equal **) - admit. (* this one should be a lot easier *) - admit. (* some pain here *) - admit. (* will be painful as well *) -*) + + by move=> &m; auto=> //= &hr [#] <*>; rewrite x1hx_notin_G1m. + auto=> &1 &2 [#] !<<- -> -> !->> _ /= hinv_y2_none. + rewrite getP /= oget_some /=. + admit. + (* lemma 2: + PFm.[(x1,x2)] = None => + G1m.[(x1,x2)] = None => + pi0.[x2] = None => + mem (rng hs (x2,Known) => + hinv hs y2 = None => + INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi => + INV_CF_G1 hs.[ch <- (y2,Known)] (ch + 1) + PFm.[(x,1x2) <- (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. *) + move=> [p0 v0] ^ pi_x2. have [] _ _ _ _ _ [] -> _ [hx2] [#] Hpath hs_hx2:= inv0. + rcondt{2} 1. by move=> &m; auto=> &hr [#] !<<- _ _ ->> /= _; rewrite in_dom pi_x2. + rcondf{2} 6. + + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= + _ - _ + _ - _ /=. + by rewrite in_rng; exists hx2. + rcondf{2} 7. + + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= + _ - _ + _ - _ /=. + rewrite negb_and; left; rewrite (@huniq_hinvK_h hx2 hs0 x2) // 2:oget_some. + + by case: inv0=> _ _ _ _ _ _ []. + rewrite in_dom; case: {-1}(G1mh.[(x1,hx2)]) (eq_refl (G1mh.[(x1,hx2)]))=> [//=|[xa xc] G1mh_x1hx2]. + have [] [] _ /(_ _ _ _ _ G1mh_x1hx2) [xc0 xf0 yc0 yf0] + _ _ _ _ _ _:= inv0. + by move=> [#]; rewrite hs_hx2=> [#] !<<- {xc0 xf0}; rewrite x1x2_notin_PFm. + rcondt{2} 15. + + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= + _ - _ + _ - _ /=. + by rewrite in_dom pi_x2. + inline F.RO.get. rcondt{2} 4. + + auto=> &hr [#] !<<- _ _ !->> _ /= + _ - _; rewrite pi_x2 oget_some /=. + rewrite in_dom; case: {-1}(ro0.[rcons p0 (v0 +^ x1)]) (eq_refl (ro0.[rcons p0 (v0 +^ x1)])). + + done. + move=> bo ^ro_pvx1 /=. have [] _ _ _ _ [] _ -> _ _:= 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 [] [] _ /(_ _ _ _ _ G1mh_x1hx2) + _ _ _ _ _ _ := inv0. + move=> [xc xf yc yf] [#]; rewrite hs_hx2=> [#] <*>. + by rewrite x1x2_notin_PFm. + auto. admit. (* this is the easy case *) + move=> [xa xc] PFm_x1x2. rcondf{1} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom PFm_x1x2. + have [] [] /(_ _ _ _ _ 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 in_dom G1m_x1x2. + auto=> &1 &2 [#] <*> -> -> -> /=; have [] _ _ /(_ (x1,x2)) + _ _ _ _ := inv0. + by rewrite PFm_x1x2 G1m_x1x2 /= => [#] !<<- {ya yc}. + move=> x1x2_notin_G1m; rcondt{2} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom x1x2_notin_G1m. + have <*>: fy2 = Unknown. + + case: inv0=> _ _ _ _ [] /(_ _ _ _ _ G1mh_x1hx2) + _ _ _. + move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0}. + 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: (G1.bext{2}); last by inline*; if{2}; auto; smt (@Block @Capacity). + by auto=> ? ? [#] !<<- _ -> ->> _ /=; rewrite in_rng; exists hx2. + have [] _ _ _ _ [] /(_ _ _ _ _ G1mh_x1hx2) + _ _ _:= inv0. + move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0} /= [p0 v0] [#] Hro Hpath. + have [] _ _ _ _ _ [] /(_ x2 p0 v0) /iffRL Hpi _:= inv0. + move: (Hpi _); first by exists hx2. + move=> pi_x2; rcondt{2} 1; 1:by auto=> &hr [#] <*>; rewrite in_dom pi_x2. + inline F.RO.get. + rcondf{2} 4; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite pi_x2 oget_some /= in_dom Hro. + rcondf{2} 8; first by auto=> &hr [#] !<<- _ _ ->> _ /= + _ - _ + _ - _; rewrite in_rng; exists hx2. + rcondt{2} 9. + + auto=> &hr [#] !<<- _ _ ->> _ /= + _ - _ + _ - _. + rewrite (@huniq_hinvK_h hx2 hs0 x2) // 2:in_dom 2:G1mh_x1hx2 2:!oget_some /=. + + by case: inv0=> _ _ _ _ _ _ []. + by rewrite /in_dom_with in_dom hs_hy2. + rcondt{2} 14; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite in_dom pi_x2. + auto=> &1 &2 [#] !<<- -> -> ->> _ /=; rewrite Block.DWord.bdistr_ll Capacity.DWord.cdistr_ll /=. + move=> + _ - _ + _ - _; rewrite PFm_x1x2 pi_x2 !oget_some //=. + rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. + + by case: inv0=> _ _ _ _ _ _ []. + rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //=. + (* lemma 3 *) admit. (* Stopped here *) + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). From ab27099d2964f4cc131e373d90a419fdd349a231 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 9 Aug 2016 18:25:57 -0400 Subject: [PATCH 194/394] Cleaning up top-level proof. --- sha3/proof/Sponge.ec | 357 ++++++++++++++++++++++++------------------- 1 file changed, 200 insertions(+), 157 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index a7a2c08..3fa6796 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -8,10 +8,10 @@ prover ["Z3"]. prover ["Alt-Ergo"]. *) -require import Fun Pair Int IntDiv Real List Option FSet NewFMap DBool. +require import Bool Fun Pair Option Int IntDiv Real List FSet NewFMap. (*---*) import Pred IntExtra. -require import DList StdBigop. -require import StdOrder. import IntOrder. +require import NewDistr DBool DList. +require import StdBigop StdOrder. import IntOrder. require import Common. require (*--*) IRO BlockSponge RndO. @@ -23,9 +23,9 @@ clone include Indifferentiability with type f_out <- bool list rename - [module] "Indif" as "Experiment" + [module] "Indif" as "Experiment" [module] "GReal" as "RealIndif" - [module] "GIdeal" as "IdealIndif". + [module] "GIdeal" as "IdealIndif". (*------------------------- Ideal Functionality ------------------------*) @@ -49,7 +49,7 @@ module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { (* absorption *) while (xs <> []) { (sa, sc) <@ P.f(sa +^ head b0 xs, sc); - xs <- behead xs; + xs <- behead xs; } (* squeezing *) while (i < (n + r - 1) %/ r) { @@ -72,8 +72,8 @@ module LowerFun (F : DFUNCTIONALITY) : BlockSponge.DFUNCTIONALITY = { obs <- unpad_blocks xs; if (obs <> None) { - cs <@ F.f(oget obs, n * r); (* size cs = n * r *) - ys <- bits2blocks cs; (* size ys = n *) + cs <@ F.f(oget obs, n * r); (* size cs = n * r *) + ys <- bits2blocks cs; (* size ys = n *) } return ys; } @@ -96,20 +96,40 @@ module RaiseSim (S : BlockSponge.SIMULATOR, F : DFUNCTIONALITY) = (*------------------------------- Proof --------------------------------*) -(*------------------- abstract theory of hybrid IROs -------------------*) +(*------------------- abstract theory of Hybrid IROs -------------------*) abstract theory HybridIRO. module type HYBRID_IRO = { + (* initialization *) proc init() : unit + + (* hashing blocks, giving n bits *) proc g(x : block list, n : int) : bool list + + (* hashing blocks, giving n blocks *) proc f(x : block list, n : int) : block list }. +(* distinguisher for Hybrid IROs *) + module type HYBRID_IRO_DIST(HI : HYBRID_IRO) = { proc distinguish() : bool }. +(* 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, BlockSponge.BIRO.IRO = { var mp : (block list * int, bool) fmap @@ -139,7 +159,7 @@ module HybridIROLazy : HYBRID_IRO, BlockSponge.BIRO.IRO = { return bs; } - proc f(xs, n) = { + proc f(xs, n) = { (* implemented using g *) var bs, ys; bs <@ g(xs, n * r); ys <- bits2blocks bs; @@ -147,16 +167,10 @@ module HybridIROLazy : HYBRID_IRO, BlockSponge.BIRO.IRO = { } }. -module HybridIROExper(HI : HYBRID_IRO, D : HYBRID_IRO_DIST) = { - proc main() : bool = { - var b : bool; - HI.init(); - b <@ D(HI).distinguish(); - return b; - } -}. +(* eager implementation of Hybrid IROs *) module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { + (* same as lazy implementation, except for indicated part *) var mp : (block list * int, bool) fmap proc init() : unit = { @@ -198,6 +212,14 @@ module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { } }. +(* we are going to use RndO.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}. @@ -225,9 +247,11 @@ seq 1 1 : (={glob D, ERO.RO.m}); first sim. symmetry; call (ERO.RO_LRO_D D); auto. qed. -local module HIRO(RO : ERO.RO) = { +(* make a Hybrid IRO out of a random oracle *) + +local module HIRO(RO : ERO.RO) : HYBRID_IRO = { proc init() : unit = { - RO.init(); + RO.init(); } proc g(xs, n) = { @@ -258,24 +282,24 @@ local module HIRO(RO : ERO.RO) = { } }. +local lemma HybridIROLazy_HIRO_LRO_init : + equiv[HybridIROLazy.init ~ HIRO(ERO.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 ~ ERO.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: (mem (dom HybridIROLazy.mp{1}) (xs{1}, i{1})). +case (mem (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. +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_init : - equiv[HybridIROLazy.init ~ HIRO(ERO.LRO).init : - true ==> HybridIROLazy.mp{1} = ERO.RO.m{2}]. -proof. proc; inline*; auto. qed. - local lemma HybridIROLazy_HIRO_LRO_g : equiv[HybridIROLazy.g ~ HIRO(ERO.LRO).g : ={xs, n} /\ HybridIROLazy.mp{1} = ERO.RO.m{2} ==> @@ -294,9 +318,12 @@ local lemma HybridIROLazy_HIRO_LRO_f : equiv[HybridIROLazy.f ~ HIRO(ERO.LRO).f : ={xs, n} /\ HybridIROLazy.mp{1} = ERO.RO.m{2} ==> ={res} /\ HybridIROLazy.mp{1} = ERO.RO.m{2}]. -proof. -proc; wp; call HybridIROLazy_HIRO_LRO_g; auto. -qed. +proof. proc; wp; call HybridIROLazy_HIRO_LRO_g; auto. 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 : @@ -304,9 +331,9 @@ local lemma RO_get_HybridIROEager_fill_in : ={res} /\ ERO.RO.m{1} = HybridIROEager.mp{2}]. proof. proc=> /=. -case: (mem (dom HybridIROEager.mp{2}) (xs{2}, i{2})). +case (mem (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. +rnd{1}; auto; progress; apply dbool_ll. rcondt{1} 2; first auto. rcondt{2} 1; first auto. wp; rnd; auto. qed. @@ -317,18 +344,13 @@ local lemma RO_sample_HybridIROEager_fill_in : ERO.RO.m{1} = HybridIROEager.mp{2}]. proof. proc=> /=; inline ERO.RO.get; sp. -case: (mem (dom HybridIROEager.mp{2}) (xs{2}, i{2})). +case (mem (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. +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_init : - equiv[HIRO(ERO.RO).init ~ HybridIROEager.init : - true ==> ={res} /\ ERO.RO.m{1} = HybridIROEager.mp{2}]. -proof. proc; inline*; auto. qed. - local lemma HIRO_RO_HybridIROEager_g : equiv[HIRO(ERO.RO).g ~ HybridIROEager.g : ={xs, n} /\ ERO.RO.m{1} = HybridIROEager.mp{2} ==> @@ -347,9 +369,9 @@ 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; wp; call HIRO_RO_HybridIROEager_g; auto. -qed. +proof. proc; wp; call HIRO_RO_HybridIROEager_g; auto. qed. + +(* make distinguisher for random oracles out of HIRO and D *) local module RODist(RO : ERO.RO) = { proc distinguish() : bool = { @@ -359,7 +381,7 @@ local module RODist(RO : ERO.RO) = { } }. -local lemma Exper_HybridLazy_ERO_LRO &m : +local lemma Exper_HybridIROLazy_LRO &m : Pr[HybridIROExper(HybridIROLazy, D).main() @ &m : res] = Pr[EROExper(ERO.LRO, RODist).main() @ &m : res]. proof. @@ -372,7 +394,7 @@ conseq HybridIROLazy_HIRO_LRO_f. auto. qed. -local lemma ERO_RO_Exper_HybridEager &m : +local lemma Exper_RO_HybridIROEager &m : Pr[EROExper(ERO.RO, RODist).main() @ &m : res] = Pr[HybridIROExper(HybridIROEager, D).main() @ &m : res]. proof. @@ -385,17 +407,26 @@ conseq HIRO_RO_HybridIROEager_f. auto. qed. -lemma HybridIROExper_Lazy_Eager &m : +lemma HybridIROExper_Lazy_Eager' &m : Pr[HybridIROExper(HybridIROLazy, D).main() @ &m : res] = Pr[HybridIROExper(HybridIROEager, D).main() @ &m : res]. proof. -by rewrite (Exper_HybridLazy_ERO_LRO &m) +by rewrite (Exper_HybridIROLazy_LRO &m) (LRO_RO RODist &m) - (ERO_RO_Exper_HybridEager &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(); @@ -403,12 +434,13 @@ module RaiseHybridIRO (HI : HYBRID_IRO) : FUNCTIONALITY = { proc f(bs : bool list, n : int) = { var cs; - cs <@ HI.g(pad2blocks bs, n); return cs; } }. +(* invariant relating maps of BIRO.IRO and HybridIROLazy *) + pred lazy_invar (mp1 : (bool list * int, bool) fmap, mp2 : (block list * int, bool) fmap) = @@ -466,10 +498,10 @@ lemma lazy_invar_upd_mem_dom_iff mem (dom mp1.[(bs, n) <- b]) (cs, m) <=> mem (dom mp2.[(pad2blocks bs, n) <- b]) (pad2blocks cs, m). proof. -move=> LI; split=> [mem_upd_mp1 | mem_upd_mp2]. +move=> li; split=> [mem_upd_mp1 | mem_upd_mp2]. rewrite domP in_fsetU1; rewrite domP in_fsetU1 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=> ->->. +right; by elim cs_m_eq_bs_n=> -> ->. left; smt(). rewrite domP in_fsetU1; rewrite domP in_fsetU1 in mem_upd_mp2. case: ((cs, m) = (bs, n))=> [// | cs_m_neq_bs_n]. @@ -485,10 +517,10 @@ lemma lazy_invar_upd2_vb mem (dom mp2.[(pad2blocks bs, n) <- b]) (xs, m) => valid_block xs. proof. -move=> LI mem_upd_mp2. +move=> li mem_upd_mp2. rewrite domP in_fsetU1 in mem_upd_mp2. elim mem_upd_mp2=> [/# | [-> _]]. -apply/valid_pad2blocks. +apply valid_pad2blocks. qed. lemma lazy_invar_upd_lu_eq @@ -500,16 +532,14 @@ lemma lazy_invar_upd_lu_eq 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]. +move=> li mem_upd_mp1. +case: ((cs, m) = (bs, n))=> [[-> ->] | cs_m_neq_bs_n]. smt(getP_eq). rewrite domP in_fsetU1 in mem_upd_mp1. -elim mem_upd_mp1=> [mem_mp1 | [->->]]. +elim mem_upd_mp1=> [mem_mp1 | [-> ->]]. case: ((pad2blocks bs, n) = (pad2blocks cs, m))=> [[p2b_bs_p2b_cs eq_mn] | p2b_bs_n_neq_p2b_cs_m]. -smt(pad2blocks_inj). -smt(getP). -smt(getP). +smt(pad2blocks_inj). smt(getP). smt(getP). qed. lemma LowerFun_IRO_HybridIROLazy_f : @@ -528,9 +558,9 @@ seq 6 3 : (={i, n0} /\ bs{1} = bs0{2} /\ lazy_invar IRO.mp{1} HybridIROLazy.mp{2} /\ pad2blocks x{1} = xs0{2}). -auto; progress; +auto; progress. have {2}<- := unpadBlocksK xs0{2}; first - by rewrite (some_oget (unpad_blocks xs0{2})). + by rewrite (some_oget (unpad_blocks xs0{2})). wp. while (={i, n0} /\ bs{1} = bs0{2} /\ @@ -592,6 +622,8 @@ auto; progress [-delta]; auto. qed. +(* invariant relating maps of HybridIROEager and BlockSponge.BIRO.IRO *) + pred eager_invar (mp1 : (block list * int, block) fmap, mp2 : (block list * int, bool) fmap) = @@ -646,7 +678,7 @@ lemma eager_inv_imp_block_bits_dom block_bits_dom_all_in_or_out xs i mp2. proof. move=> ge0_i r_dvd_i [ei1 ei2]. -case (mem (dom mp1) (xs, i %/ r))=> [mem_mp1 | not_mem_mp1]. +case: (mem (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. @@ -654,7 +686,7 @@ have mp2_eq_block_bits_j := mp2_eq_block_bits j _. by rewrite divzK // mulzDl /= divzK. rewrite in_dom /#. right=> j j_rng. -case (mem (dom mp2) (xs, j))=> // mem_mp2 /=. +case: (mem (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(). @@ -728,7 +760,8 @@ sp; wp; if=> //; rnd; auto. auto. qed. -(* modules needed for applying transitivity tactic *) +(* module needed for applying transitivity tactic in connection + with HybridIROEager *) module HybridIROEagerTrans = { (* from HybridIROEager; need copy for transitivity @@ -754,6 +787,8 @@ module HybridIROEagerTrans = { return bs; } + (* getting next block of bits; assuming m = i + r and size bs = i *) + proc next_block(xs, i, m : int, bs) = { var b; @@ -765,12 +800,12 @@ module HybridIROEagerTrans = { 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; - (* assuming block_bits_dom_all_in_or_out xs i HybridIROEager.mp - and m = i + r and size bs = i *) - if (mem (dom HybridIROEager.mp) (xs, i)) { while (i < m) { b <- oget HybridIROEager.mp.[(xs, i)]; @@ -793,6 +828,8 @@ module HybridIROEagerTrans = { 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) { @@ -804,6 +841,9 @@ module HybridIROEagerTrans = { } }. +(* 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) = @@ -868,8 +908,8 @@ lemma eager_invar_eq_except_upd1 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]. +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 getP_eq mp2'_ran_eq -eq_k_i. @@ -906,10 +946,10 @@ have <- /# : Some (nth false (ofblock (oget mp1.[(ys, k)])) (j - k * r)) by rewrite ei1_ys_k_snd. rewrite domP in_fsetU1. -case (xs = ys)=> [-> | ne_xs_ys]. -case (k < i * r)=> [lt_k_i_tim_r | not_lt_k_i_tim_r]. +case: (xs = ys)=> [-> | ne_xs_ys]. +case: (k < i * r)=> [lt_k_i_tim_r | not_lt_k_i_tim_r]. smt(eager_eq_except_mem_iff). -case ((i + 1) * r <= k)=> [i_add1_tim_r_le_k | not_i_add1_tim_r_le_k]. +case: ((i + 1) * r <= k)=> [i_add1_tim_r_le_k | not_i_add1_tim_r_le_k]. smt(eager_eq_except_mem_iff). right. have le_i_tim_r_k : i * r <= k by smt(). @@ -989,7 +1029,7 @@ rewrite -cats1; smt(size_cat). rewrite -2!cats1 catA; congr; congr. by rewrite getP_eq oget_some. rewrite nth_rcons /=. -case (k = size (bs{2} ++ cs{2}))=> [-> /= | ne_k_size_bs_cat_cs]. +case: (k = size (bs{2} ++ cs{2}))=> [-> /= | ne_k_size_bs_cat_cs]. by rewrite getP_eq oget_some. have -> /= : k < size(bs{2} ++ cs{2}) by smt(). rewrite getP ne_k_size_bs_cat_cs /= /#. @@ -1026,6 +1066,9 @@ 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 = { (* from BlockSponge.BIRO.IRO; need copy for transitivity to work *) @@ -1046,6 +1089,8 @@ module BlockSpongeTrans = { return bs; } + (* getting next block; assumes size bs = i *) + proc next_block(x, i, bs) = { var b; @@ -1055,6 +1100,8 @@ module BlockSpongeTrans = { 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) { @@ -1066,25 +1113,6 @@ module BlockSpongeTrans = { } }. -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; - } -}. - (* use Program abstract theory of DList *) clone Program as Prog with @@ -1115,12 +1143,33 @@ 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]. +case: (i = 0)=> [-> /= | ne_i0]. rewrite iter1 pow1 /#. by rewrite iterS // IH 1:/# powS // RealExtra.fromintM StdRing.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. @@ -1134,8 +1183,7 @@ have -> : Pr[BlockGen.direct() @ &2 : w = res] = 1%r / (2 ^ r)%r. have -> : Pr[BlockGen.loop() @ &1 : w = res] = Pr[Prog.LoopSnoc.sample(r) @ &1 : ofblock w = res]. - byequiv=> //. - proc. + byequiv=> //; proc. seq 2 2 : (r = n{2} /\ j{1} = i{2} /\ j{1} = 0 /\ cs{1} = l{2} /\ cs{1} = []); @@ -1201,10 +1249,11 @@ case (mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2})). (* mem (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} +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. +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 /\ @@ -1247,8 +1296,7 @@ have some_form_mp_hr_lookup_eq : by rewrite ei1_xs_i2 1:/#. by rewrite some_form_mp_hr_lookup_eq oget_some. smt(). -skip. -move=> +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]. @@ -1277,7 +1325,8 @@ 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. +smt(gt0_r). +simplify. conseq (_ : x0{2} = x{2} /\ n{2} = i{2} /\ i2 = i{2} /\ 0 <= i{2} /\ xs{1} = x{2} /\ @@ -1291,8 +1340,8 @@ seq 3 1 : 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}). -progress; [by rewrite size_block | by rewrite mkblockK]. +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}) @@ -1311,8 +1360,7 @@ transitivity{2} 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. +exists* HybridIROEager.mp{1}; elim*=> mp1; exists* i{1}; elim*=> i1. conseq (_ : xs{1} = x0{2} /\ 0 <= i2 /\ i{1} = i1 /\ i1 = i2 * r /\ @@ -1323,13 +1371,13 @@ conseq 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})=> //. + HybridIROEager.mp{1}). progress; [by rewrite ofblockK | rewrite size_cat size_blocks2bits /#]. -progress. -by rewrite -cats1 blocks2bits_cat blocks2bits_sing getP_eq - oget_some ofblockK. -by rewrite size_rcons. +progress; + [by rewrite -cats1 blocks2bits_cat blocks2bits_sing getP_eq + 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} /\ @@ -1339,13 +1387,14 @@ while{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. -move=> mp_ran_eq lt_im. +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]. +case: (i{hr} = j)=> [-> | ne_ij]. rewrite getP /=; smt(nth_onth onth_nth). rewrite getP. have -> /= : (xs{hr}, j) <> (xs{hr}, i{hr}) by smt(). @@ -1361,9 +1410,7 @@ split. split=> //. split; first smt(ge0_r). split; first smt(). -split. split; smt(ge0_r). -split; smt(). 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]. @@ -1394,8 +1441,7 @@ 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). +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} /\ @@ -1449,11 +1495,8 @@ while wp. call (_ : ={BlockSponge.BIRO.IRO.mp}). if=> //; rnd; auto. auto; smt(). auto; smt(). -unroll{2} 1. -rcondt{2} 1; first auto; progress; smt(). -rcondf{2} 4. auto. -call (_ : true). if=> //. -skip; 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 ==> @@ -1465,14 +1508,14 @@ transitivity{1} bs{1} = blocks2bits bs{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. progress; - exists HybridIROEager.mp{1}, (size bs{2} * r), (blocks2bits bs{2}), xs{2}=> //. + exists HybridIROEager.mp{1}, (size bs{2} * r), + (blocks2bits bs{2}), 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=> //; rnd; auto. +wp. call (_ : ={HybridIROEager.mp}). if=> //; rnd; auto. auto. auto. transitivity{2} { (bs, i) <@ BlockSpongeTrans.next_block(xs, i, bs); } @@ -1488,8 +1531,7 @@ progress; exists BlockSponge.BIRO.IRO.mp{2}, (size bs{2}), 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=> //; rnd; skip; smt(). +wp; sp. call (_ : ={BlockSponge.BIRO.IRO.mp}). if=> //; rnd; skip; smt(). auto. qed. @@ -1542,7 +1584,7 @@ seq 3 2 : eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). auto; progress. if=> //. -case: (n1 < 0). +case (n1 < 0). rcondf{1} 1; first auto; progress; smt(). rcondf{2} 1; first auto; progress; by rewrite -lezNgt needed_blocks_non_pos ltzW. @@ -1563,8 +1605,7 @@ conseq 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. +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 /\ @@ -1678,7 +1719,7 @@ conseq 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}). +case (i{2} = n{2}). rcondf{2} 1; first auto; progress; smt(). rcondf{1} 1; first auto; progress; smt(). rcondf{1} 1; first auto; progress; smt(). @@ -1722,8 +1763,7 @@ transitivity{1} eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). progress; exists HybridIROEager.mp{1}, (blocks2bits bs{2}), m{1}, - (size bs{2} * r), x{2}; - smt(). + (size bs{2} * r), x{2}=> //. progress; smt(take_cat). splitwhile{2} 1 : i < n1. seq 1 1 : @@ -1758,11 +1798,10 @@ transitivity{1} 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}). + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. progress [-delta]; -exists HybridIROEager.mp{1}, (blocks2bits bs{2}), m{1}, - (size bs{2} * r), x{2}=> //. -trivial. + exists HybridIROEager.mp{1}, (blocks2bits bs{2}), m{1}, + (size bs{2} * r), x{2}=> //. inline HybridIROEagerTrans.next_block; sim. transitivity{2} { (bs, i) <@ BlockSpongeTrans.next_block(x, i, bs); @@ -1773,10 +1812,9 @@ transitivity{2} 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}). + ={bs, i, x, BlockSponge.BIRO.IRO.mp})=> //. progress [-delta]; -exists BlockSponge.BIRO.IRO.mp{2}, bs{2}, (size bs{2}), x{2}=> //. -trivial. + exists BlockSponge.BIRO.IRO.mp{2}, bs{2}, (size bs{2}), x{2}=> //. exists* i{2}; elim*=> i2. call (HybridIROEagerTrans_BlockSpongeTrans_next_block i2). auto. @@ -1804,21 +1842,20 @@ move=> |>; by rewrite n_eq. progress; apply blocks2bitsK. conseq HybridIROEager_f_g. move=> |> &1 &2 ? -> ? //. -exists* n{1}; elim*=> n1. exists* xs{1}; elim*=> xs'. +exists* n{1}; elim*=> n1; exists* xs{1}; elim*=> xs'. conseq (HybridIROEager_g_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]. +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]. -smt(). +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. +by have [-> ->] := not_vb_imp not_vb_xs1. qed. end HybridIRO. @@ -1841,8 +1878,7 @@ 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. +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} = []). @@ -1881,11 +1917,10 @@ proc=> /=. exists* n{1}; elim*=> n'. exists* (pad2blocks bs{2}); elim*=> xs2. call (HIRO.HybridIROEager_g_BlockIRO_f n' xs2). -auto=> |> &1 &2 ? res1 res2 mp1 mp2 ? vb_imp not_vb_imp. +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{2} <= 0)=> [le0_n2 | not_le0_n2]. -smt(). +case: (n{2} <= 0)=> [le0_n2 /# | not_le0_n2]. have gt0_n2 : 0 < n{2} by smt(). by have [-> _] := gt0_n2_imp gt0_n2. have [-> ->] := not_vb_imp not_vb; by rewrite blocks2bits_nil. @@ -1907,9 +1942,10 @@ call ={glob Dist, glob BlockSim} /\ IRO.mp{1} = map0 /\ HIRO.HybridIROLazy.mp{2} = map0 ==> ={res}). -proc (={glob BlockSim} /\ HIRO.lazy_invar IRO.mp{1} HIRO.HybridIROLazy.mp{2}). +proc + (={glob BlockSim} /\ + HIRO.lazy_invar IRO.mp{1} HIRO.HybridIROLazy.mp{2})=> //. progress [-delta]; apply HIRO.lazy_invar0. -trivial. 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})=> //. @@ -1918,6 +1954,10 @@ by conseq HIRO.IRO_RaiseHybridIRO_HybridIROLazy_f. auto. qed. +(* 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; @@ -1940,7 +1980,8 @@ sim. qed. local lemma HybridIROExper_Experiment_Eager &m : - Pr[HIRO.HybridIROExper(HIRO.HybridIROEager, HybridIRODist).main() @ &m : res] = + Pr[HIRO.HybridIROExper(HIRO.HybridIROEager, HybridIRODist).main() @ + &m : res] = Pr[Experiment (HIRO.RaiseHybridIRO(HIRO.HybridIROEager), BlockSim(HIRO.HybridIROEager), Dist).main() @ &m : res]. @@ -1982,12 +2023,14 @@ call HIRO.HybridIROEager.mp{1} = map0 /\ BlockSponge.BIRO.IRO.mp{2} = map0 ==> ={res}). proc - (={glob BlockSim} /\ - HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1}) => //. + (={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})=> //; +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})=> //; +proc (HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} + HIRO.HybridIROEager.mp{1})=> //; conseq HIRO.HybridIROEager_BlockIRO_f=> //. exists* n{1}; elim *=> n'. conseq RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f=> //. @@ -2029,4 +2072,4 @@ lemma conclusion (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. +proof. by apply (conclu BlockSim Dist &m). qed. From 6032f950807d9c7f777e6aa44ffe083d073155d3 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 10 Aug 2016 15:57:14 -0400 Subject: [PATCH 195/394] Simplifications. --- sha3/proof/Sponge.ec | 305 ++++++++++++++++--------------------------- 1 file changed, 112 insertions(+), 193 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 3fa6796..295aab4 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -424,8 +424,8 @@ lemma HybridIROExper_Lazy_Eager 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 *) +(* turn a Hybrid IRO implementation (lazy or eager) into top-level + ideal functionality; its f procedure only uses IH.g *) module RaiseHybridIRO (HI : HYBRID_IRO) : FUNCTIONALITY = { proc init() = { @@ -764,29 +764,6 @@ qed. with HybridIROEager *) module HybridIROEagerTrans = { - (* from HybridIROEager; need copy for transitivity - to work *) - - proc g(xs, n) = { - var b, bs; - var m <- ((n + r - 1) %/ r) * r; - var i <- 0; - - bs <- []; - if (valid_block xs) { - while (i < n) { - b <@ HybridIROEager.fill_in(xs, i); - bs <- rcons bs b; - i <- i + 1; - } - while (i < m) { - HybridIROEager.fill_in(xs, i); - i <- i + 1; - } - } - return bs; - } - (* getting next block of bits; assuming m = i + r and size bs = i *) proc next_block(xs, i, m : int, bs) = { @@ -1070,25 +1047,6 @@ qed. with BlockSponge.BIRO.IRO *) module BlockSpongeTrans = { - (* from BlockSponge.BIRO.IRO; need copy for transitivity - to work *) - - proc f(x, n) = { - var b, bs; - var i <- 0; - - bs <- []; - if (valid_block x) { - while (i < n) { - b <@ BlockSponge.BIRO.IRO.fill_in(x, i); - bs <- rcons bs b; - i <- i + 1; - } - } - - return bs; - } - (* getting next block; assumes size bs = i *) proc next_block(x, i, bs) = { @@ -1264,12 +1222,10 @@ conseq 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. + 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 /\ + (i1 <= i{1} <= m{1} /\ i1 = i2 * r /\ size bs{1} = i{1} /\ m{1} - i1 = r /\ bs{1} = bs1 ++ take (i{1} - i1) @@ -1281,8 +1237,7 @@ 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. -by rewrite -cats1 size_cat. +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). @@ -1300,8 +1255,7 @@ 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. split=> [// | _]; rewrite i1_eq_i2_tim_r; smt(ge0_r). split=> //. split; first smt(). split=> //. split; first by rewrite /= take0 cats0. split=> //. move=> bs_L i_L. @@ -1311,17 +1265,14 @@ move=> bs_L_eq mem_mp2_xs_i2 _]. split. have i_L_eq_m : i_L = m{1} by smt(). -rewrite bs_L_eq -cats1 blocks2bits_cat; congr. -rewrite i_L_eq_m m1_min_i1_eq_r blocks2bits_sing. +rewrite bs_L_eq -cats1 blocks2bits_cat + i_L_eq_m m1_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; first smt(). -split=> //. -split=> //; smt(). +split; smt(). (* ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2}) *) -rcondt{2} 1; first auto. -rcondf{1} 1; first auto; progress [-delta]. +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}). @@ -1390,8 +1341,7 @@ 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. 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]. @@ -1404,13 +1354,9 @@ skip=> &1 &2 [# -> ge0_i2 eq_i_i1 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). +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]. @@ -1420,8 +1366,7 @@ 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. +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(). @@ -1548,34 +1493,6 @@ lemma HybridIROEager_g_BlockIRO_f (n1 : int) (x2 : block list) : size res{2} = (n1 + r - 1) %/ r)) /\ (! valid_block x2 => res{1} = [] /\ res{2} = [])]. proof. -transitivity - HybridIROEagerTrans.g - (={n, xs, HybridIROEager.mp} ==> ={res, HybridIROEager.mp}) - (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} = [])); - [smt() | trivial | sim | idtac]. -transitivity - BlockSpongeTrans.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} = [])) - (={x, n, BlockSponge.BIRO.IRO.mp} ==> ={res, BlockSponge.BIRO.IRO.mp}); - last first; [sim | smt() | smt() | idtac]. proc=> /=. seq 3 2 : (n1 = n{1} /\ xs{1} = x{2} /\ x2 = x{2} /\ @@ -1605,12 +1522,15 @@ conseq 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. +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 /\ @@ -1639,23 +1559,34 @@ 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})=> //. -progress; - exists BlockSponge.BIRO.IRO.mp{2}, [], 0, x{2}, ((n{1} + r - 1) %/ 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, x{2}, + ((n{1} + r - 1) %/ r)=> //); + 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 /\ @@ -1672,43 +1603,35 @@ transitivity{1} 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}). + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. progress; exists HybridIROEager.mp{1}, (n1 %/ r), x{2}=> //. -trivial. 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=> //; 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})=> //. -progress; exists BlockSponge.BIRO.IRO.mp{2}, x{2}=> //. -call (HybridIROEagerTrans_BlockSpongeTrans_loop (n1 %/ r)). -skip; progress; smt(divz_ge0 gt0_r). +(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=> //; rnd; auto. auto. auto. -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). +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 /\ @@ -1719,7 +1642,7 @@ conseq 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}). +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(). @@ -1729,10 +1652,10 @@ have -> : n{1} = 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} *) +(* 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; first auto; call (_ : true). -if=> //. 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 /\ @@ -1742,9 +1665,8 @@ conseq bs{1} = take n1 (blocks2bits bs{2}) /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) _ - (_ : size bs = n - 1 ==> size bs = n). + (_ : size bs = n - 1 ==> size bs = n)=> //. progress; smt(divz_ge0 gt0_r lez_floor size_blocks2bits). -smt(). wp. call (_ : true). auto. skip; smt(size_rcons). transitivity{1} { while (i < m) { @@ -1772,23 +1694,20 @@ seq 1 1 : 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}). -if => //; rnd; auto. +wp; call (_ : ={HybridIROEager.mp}); first if => //; 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}). -if => //; rnd; auto. +wp; call (_ : ={HybridIROEager.mp}); first if => //; 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); } @@ -1803,22 +1722,23 @@ progress [-delta]; exists HybridIROEager.mp{1}, (blocks2bits bs{2}), m{1}, (size bs{2} * r), 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})=> //. -progress [-delta]; - exists BlockSponge.BIRO.IRO.mp{2}, bs{2}, (size bs{2}), x{2}=> //. +(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. -inline BlockSpongeTrans.next_block; sim. qed. lemma HybridIROEager_BlockIRO_f : @@ -1840,8 +1760,7 @@ move=> |> &1 &2 ? n_eq inv. exists BlockSponge.BIRO.IRO.mp{2}, HybridIROEager.mp{1}, (xs{1}, n{1} * r). move=> |>; by rewrite n_eq. progress; apply blocks2bitsK. -conseq HybridIROEager_f_g. -move=> |> &1 &2 ? -> ? //. +by conseq HybridIROEager_f_g=> |> &1 &2 ? -> ?. exists* n{1}; elim*=> n1; exists* xs{1}; elim*=> xs'. conseq (HybridIROEager_g_BlockIRO_f n1 xs')=> //. move=> |> &1 &2 ? -> inv; by rewrite needed_blocks_prod_r. @@ -1905,27 +1824,6 @@ conseq Sponge_Raise_BlockSponge_f=> //. auto. qed. -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_g_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{2} <= 0)=> [le0_n2 /# | not_le0_n2]. -have gt0_n2 : 0 < n{2} by smt(). -by have [-> _] := gt0_n2_imp gt0_n2. -have [-> ->] := not_vb_imp not_vb; by rewrite blocks2bits_nil. -qed. - local lemma Ideal_IRO_Experiment_HybridLazy &m : Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = Pr[Experiment @@ -1946,10 +1844,10 @@ 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. +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. @@ -2005,6 +1903,27 @@ by rewrite (Experiment_HybridIROExper_Lazy &m) (HybridIROExper_Experiment_Eager &m). qed. +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_g_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{2} <= 0)=> [le0_n2 /# | not_le0_n2]. +have gt0_n2 : 0 < n{2} by smt(). +by have [-> _] := gt0_n2_imp gt0_n2. +have [-> ->] := not_vb_imp not_vb; by rewrite blocks2bits_nil. +qed. + local lemma Experiment_HybridEager_Ideal_BlockIRO &m : Pr[Experiment (HIRO.RaiseHybridIRO(HIRO.HybridIROEager), BlockSim(HIRO.HybridIROEager), From 38b1b8cc686713cec2e30b041c5795d47d502b09 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 10 Aug 2016 22:38:19 -0400 Subject: [PATCH 196/394] Fixing scripts in top-level directory wrt PY's new stable ordering. --- sha3/proof/RndO.ec | 2 +- sha3/proof/Sponge.ec | 26 +++++++++++++------------- 2 files changed, 14 insertions(+), 14 deletions(-) diff --git a/sha3/proof/RndO.ec b/sha3/proof/RndO.ec index 7036303..97b5c14 100644 --- a/sha3/proof/RndO.ec +++ b/sha3/proof/RndO.ec @@ -411,7 +411,7 @@ proof. (={x,y,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown==> ={x,y} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ FRO.m{2}.[x{2}] = Some (y{2},Known)). - + by move=>?&mr[#]2->???;exists FRO.m{mr}, y{mr}, x{mr}=>/#. + + by move=>?&mr[#]2->???;exists FRO.m{mr}, x{mr}, y{mr}=>/#. + move=>?&m&mr[#]<*>[#]2->Hex Hm2. by rewrite (eq_except_set_eq FRO.m{mr} FRO.m{m} x{mr}) ?in_dom ?Hm2// eq_except_sym. + symmetry;call (iter1_perm RRO.I iter_perm2);auto=>?&mr[#]3-> Hdom Hm;split=>//=. diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 295aab4..2c357a3 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -1154,7 +1154,7 @@ have -> : skip=> &m1 &m2 [# r_eq j_eq j_init cs_eq cs_init]. split; first smt(gt0_r). move=> - j_L cs_L l_R i_r not_j_L_lt_r not_i_r_lt_n + cs_L j_L i_r l_R not_j_L_lt_r not_i_r_lt_n [# _ j_L_eq cs_L_eq j_L_le_r sz_cs_L_eq_j_L]. have sz_cs_L_eq_r : size cs_L = r by smt(). progress; [by rewrite ofblockK | by rewrite cs_L_eq mkblockK]. @@ -1452,9 +1452,9 @@ transitivity{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}, (size bs{2} * r), - (blocks2bits bs{2}), xs{2}=> //. +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 /\ @@ -1472,7 +1472,7 @@ transitivity{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}, (size bs{2}), bs{2}, xs{2}=> //. +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. @@ -1554,7 +1554,7 @@ transitivity{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}, [], n{1}, 0, x{2}=> //. +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). @@ -1575,8 +1575,8 @@ auto; progress; smt(leq_trunc_div ge0_r). (={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, x{2}, - ((n{1} + r - 1) %/ r)=> //); + 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). @@ -1684,8 +1684,8 @@ transitivity{1} bs{1} = blocks2bits bs{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). progress; - exists HybridIROEager.mp{1}, (blocks2bits bs{2}), m{1}, - (size bs{2} * r), x{2}=> //. + 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 : @@ -1719,8 +1719,8 @@ transitivity{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}), m{1}, - (size bs{2} * r), x{2}=> //. + 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); @@ -1757,7 +1757,7 @@ transitivity res{1} = (blocks2bits res{2}) /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). move=> |> &1 &2 ? n_eq inv. -exists BlockSponge.BIRO.IRO.mp{2}, HybridIROEager.mp{1}, (xs{1}, n{1} * r). +exists HybridIROEager.mp{1}, BlockSponge.BIRO.IRO.mp{2}, (xs{1}, n{1} * r). move=> |>; by rewrite n_eq. progress; apply blocks2bitsK. by conseq HybridIROEager_f_g=> |> &1 &2 ? -> ?. From 684c0b6de0ca5d9a8a68490f1853b9c725e1cc27 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 11 Aug 2016 12:41:42 -0400 Subject: [PATCH 197/394] Nits. --- sha3/proof/Sponge.ec | 34 ++++++++++++++-------------------- 1 file changed, 14 insertions(+), 20 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 2c357a3..53d4499 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -1151,13 +1151,11 @@ have -> : size cs{1} = j{1}). wp; rnd; skip. progress; smt(cats1 gt0_r size_rcons). - skip=> &m1 &m2 [# r_eq j_eq j_init cs_eq cs_init]. + skip=> &m1 &m2 [# <- <- -> <- ->]. split; first smt(gt0_r). - move=> - cs_L j_L i_r l_R not_j_L_lt_r not_i_r_lt_n - [# _ j_L_eq cs_L_eq j_L_le_r sz_cs_L_eq_j_L]. - have sz_cs_L_eq_r : size cs_L = r by smt(). - progress; [by rewrite ofblockK | by rewrite cs_L_eq mkblockK]. + 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 mux_dlist 1:ge0_r size_block /=. have -> : @@ -1253,20 +1251,17 @@ 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 + [# <- 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=> bs_L i_L. -split=> [| not_lt_i_L_m]; first smt(). -move=> - [# i1_le_i_L_le_m _ _ sz_bs_L_eq_i_L m1_min_i1_eq_r - bs_L_eq mem_mp2_xs_i2 _]. +clear bs1; 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 i_L_eq_m : i_L = m{1} by smt(). -rewrite bs_L_eq -cats1 blocks2bits_cat - i_L_eq_m m1_min_i1_eq_r blocks2bits_sing. +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. @@ -1351,9 +1346,8 @@ have -> /= : (xs{hr}, j) <> (xs{hr}, i{hr}) by smt(). rewrite mp_ran_eq /#. smt(). skip=> - &1 &2 - [# -> ge0_i2 eq_i_i1 i1_eq_i2_tim_r m_min_i1_eq_r - bs1_eq sz_bs2_eq_i2 sz_bs1_eq_i1_add_r -> ei]. + &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). @@ -1452,7 +1446,7 @@ transitivity{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. +progress; exists HybridIROEager.mp{1}, (blocks2bits bs{2}), (size bs{2} * r), xs{2}=> //. inline HybridIROEagerTrans.next_block; sp; wp. @@ -1472,7 +1466,7 @@ transitivity{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}=> //. +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. From e6a0dc813ff894d2c0f0533136b248bfe412e16a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 11 Aug 2016 17:44:34 +0100 Subject: [PATCH 198/394] Simplifying intro patterns with laziness. --- sha3/proof/core/Handle.eca | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/sha3/proof/core/Handle.eca b/sha3/proof/core/Handle.eca index 7f3e0e1..55fef06 100644 --- a/sha3/proof/core/Handle.eca +++ b/sha3/proof/core/Handle.eca @@ -826,20 +826,20 @@ section AUX. move=> [p0 v0] ^ pi_x2. have [] _ _ _ _ _ [] -> _ [hx2] [#] Hpath hs_hx2:= inv0. rcondt{2} 1. by move=> &m; auto=> &hr [#] !<<- _ _ ->> /= _; rewrite in_dom pi_x2. rcondf{2} 6. - + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= + _ - _ + _ - _ /=. + + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. by rewrite in_rng; exists hx2. rcondf{2} 7. - + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= + _ - _ + _ - _ /=. + + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. rewrite negb_and; left; rewrite (@huniq_hinvK_h hx2 hs0 x2) // 2:oget_some. + by case: inv0=> _ _ _ _ _ _ []. rewrite in_dom; case: {-1}(G1mh.[(x1,hx2)]) (eq_refl (G1mh.[(x1,hx2)]))=> [//=|[xa xc] G1mh_x1hx2]. have [] [] _ /(_ _ _ _ _ G1mh_x1hx2) [xc0 xf0 yc0 yf0] + _ _ _ _ _ _:= inv0. by move=> [#]; rewrite hs_hx2=> [#] !<<- {xc0 xf0}; rewrite x1x2_notin_PFm. rcondt{2} 15. - + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= + _ - _ + _ - _ /=. + + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. by rewrite in_dom pi_x2. inline F.RO.get. rcondt{2} 4. - + auto=> &hr [#] !<<- _ _ !->> _ /= + _ - _; rewrite pi_x2 oget_some /=. + + auto=> &hr [#] !<<- _ _ !->> _ /= _ _; rewrite pi_x2 oget_some /=. rewrite in_dom; case: {-1}(ro0.[rcons p0 (v0 +^ x1)]) (eq_refl (ro0.[rcons p0 (v0 +^ x1)])). + done. move=> bo ^ro_pvx1 /=. have [] _ _ _ _ [] _ -> _ _:= inv0. @@ -872,15 +872,15 @@ section AUX. move=> pi_x2; rcondt{2} 1; 1:by auto=> &hr [#] <*>; rewrite in_dom pi_x2. inline F.RO.get. rcondf{2} 4; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite pi_x2 oget_some /= in_dom Hro. - rcondf{2} 8; first by auto=> &hr [#] !<<- _ _ ->> _ /= + _ - _ + _ - _; rewrite in_rng; exists hx2. + rcondf{2} 8; first by auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _; rewrite in_rng; exists hx2. rcondt{2} 9. - + auto=> &hr [#] !<<- _ _ ->> _ /= + _ - _ + _ - _. + + auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _. rewrite (@huniq_hinvK_h hx2 hs0 x2) // 2:in_dom 2:G1mh_x1hx2 2:!oget_some /=. + by case: inv0=> _ _ _ _ _ _ []. by rewrite /in_dom_with in_dom hs_hy2. rcondt{2} 14; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite in_dom pi_x2. auto=> &1 &2 [#] !<<- -> -> ->> _ /=; rewrite Block.DWord.bdistr_ll Capacity.DWord.cdistr_ll /=. - move=> + _ - _ + _ - _; rewrite PFm_x1x2 pi_x2 !oget_some //=. + move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 !oget_some //=. rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. + by case: inv0=> _ _ _ _ _ _ []. rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //=. From e38bfc37958404eac0d250dda384a8f75f2f1a23 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 8 Aug 2016 13:18:13 +0100 Subject: [PATCH 199/394] Revert "Goals got reordered. This may need reverted (again)." This reverts commit 26cce50e87620f435d4610ef400f7cb7a8017342. --- sha3/proof/core/Gext.eca | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/sha3/proof/core/Gext.eca b/sha3/proof/core/Gext.eca index 1605283..0fe42ad 100644 --- a/sha3/proof/core/Gext.eca +++ b/sha3/proof/core/Gext.eca @@ -619,23 +619,23 @@ section EXT. 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 (dom G1.m `|` dom G1.mi) `|` fset1 x));skip=> /> &hr ??-> /= ??. - rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. + wp; rnd (mem (image snd (dom G1.m `|` dom G1.mi ))); skip=> /> &hr ? ? -> /= ? ?. + rewrite (Mu_mem.mu_mem + (image snd (dom G1.m{hr} `|` dom G1.mi{hr})) + cdistr (1%r/(2^c)%r))//. + by move=>x _;apply DWord.cdistr1E. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU !fcardU le_fromint fcard1. + rewrite imageU fcardU le_fromint. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). by rewrite -!sizeE;smt w=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 (dom G1.m `|` dom G1.mi ))); skip=> /> &hr ? ? -> /= ? ?. - rewrite (Mu_mem.mu_mem - (image snd (dom G1.m{hr} `|` dom G1.mi{hr})) - cdistr (1%r/(2^c)%r))//. - + by move=>x _;apply DWord.cdistr1E. + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x));skip=> /> &hr ??-> /= ??. + rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. + + by move=>x _;apply DWord.cdistr1E. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU fcardU le_fromint. + rewrite imageU !fcardU le_fromint fcard1. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). by rewrite -!sizeE;smt w=fcard_ge0. + by move=>c1;proc;auto=> &hr [^H 2->]/#. From f0bee1db0903b939fb425ac54b110c895c7d489d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 19 Aug 2016 13:33:49 +0100 Subject: [PATCH 200/394] Updating EC. Proofs not moving forward very fast. --- sha3/proof/RndO.ec | 12 +- sha3/proof/Sponge.ec | 32 ++- sha3/proof/core/Gext.eca | 26 +-- sha3/proof/core/Handle.eca | 414 ++++++++++++++++++++++++++++++++----- 4 files changed, 395 insertions(+), 89 deletions(-) diff --git a/sha3/proof/RndO.ec b/sha3/proof/RndO.ec index 97b5c14..b533c6e 100644 --- a/sha3/proof/RndO.ec +++ b/sha3/proof/RndO.ec @@ -368,7 +368,7 @@ proof. ={x} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ FRO.m{1}.[x{2}] = Some (result{2},Unknown) /\ FRO.m{2}.[x{2}] = Some (result{2},Known)). - + by move=>?&mr[#]-> -> ??;exists FRO.m{mr}, x{mr}=>/#. + + by move=>?&mr[#]-> -> ??;exists FRO.m{mr} x{mr}=>/#. + move=>???;rewrite in_dom=>[#]<*>[#]->/eq_except_sym H Hxm Hx2. rewrite sampleto_ll=> r _;rewrite /= Hxm oget_some /=;apply /eq_sym. have /(congr1 oget):= Hx2 => <-;apply eq_except_set_eq=>//. @@ -411,7 +411,7 @@ proof. (={x,y,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown==> ={x,y} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ FRO.m{2}.[x{2}] = Some (y{2},Known)). - + by move=>?&mr[#]2->???;exists FRO.m{mr}, x{mr}, y{mr}=>/#. + + by move=>?&mr[#]2->???;exists FRO.m{mr} x{mr} y{mr}=>/#. + move=>?&m&mr[#]<*>[#]2->Hex Hm2. by rewrite (eq_except_set_eq FRO.m{mr} FRO.m{m} x{mr}) ?in_dom ?Hm2// eq_except_sym. + symmetry;call (iter1_perm RRO.I iter_perm2);auto=>?&mr[#]3-> Hdom Hm;split=>//=. @@ -448,7 +448,7 @@ proof. { Iter(RRO.I).iter_1s(x,elems (dom (restr Unknown FRO.m) `\` fset1 x)); } (={x,FRO.m}/\(in_dom_with FRO.m x Unknown){1}==> ={x,FRO.m}) (={x,FRO.m}/\ (in_dom_with FRO.m x Unknown){1} ==> (rem x FRO.m){1} = FRO.m{2})=>//. - + by move=>?&mr[#]2->?;exists FRO.m{mr}, x{mr}. + + by move=>?&mr[#]2->?;exists FRO.m{mr} x{mr}. + symmetry;call (iter1_perm RRO.I iter_perm2);skip=>?&mr[#]2!->?/=;split=>//. by apply /perm_eq_sym/perm_to_rem/dom_restr. inline{1}Iter(RRO.I).iter_1s. @@ -518,7 +518,7 @@ proof. (={x,FRO.m} /\ ! mem (dom FRO.m{2}) x{2} ==> ={x,FRO.m})=>//;last first. + inline{2} RRO.resample;call (iter1_perm RRO.I iter_perm2);auto=>?&mr[#]2->Hmem/=?->/=. by apply /perm_eq_sym/perm_to_rem;rewrite restr_set/=dom_set !inE. - + by move=>?&mr[#]2->?;exists FRO.m{mr}, x{mr}. + + by move=>?&mr[#]2->?;exists FRO.m{mr} x{mr}. inline Iter(RRO.I).iter_1s RRO.I.f RRO.resample;wp;swap{1}-1. seq 1 7 : (={x} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ l{2} = (elems (dom (restr Unknown FRO.m))){1} /\ @@ -662,7 +662,7 @@ proof. ={res,glob D}) (={glob D} /\ FRO.m{1} = map (fun _ c => (c,Known)) RO.m{2} ==> ={res,glob D})=>//. - + by move=>?&mr[]2!->;exists (glob D){mr},(map(fun _ c =>(c,Known))RO.m{mr}). + + by move=>?&mr[]2!->;exists (glob D){mr}(map(fun _ c =>(c,Known))RO.m{mr}). + proc*;inline M.main1;wp;call (RO_FRO_D D);inline *. rcondf{2}2;auto. + move=> &mr[]_->;apply mem_eq0=>z;rewrite -memE dom_restr /in_dom_with mapP dom_map in_dom. @@ -672,7 +672,7 @@ proof. (={glob D, FRO.m} ==> ={res, glob D}) (={glob D} /\ FRO.m{1} = map (fun _ c => (c,Known)) RO.m{2} ==> ={res,glob D})=>//. - + by move=>?&mr[]2!->;exists (glob D){mr},(map(fun _ c =>(c,Known))RO.m{mr}). + + by move=>?&mr[]2!->;exists (glob D){mr} (map(fun _ c =>(c,Known))RO.m{mr}). + by proc; eager call (eager_D D);auto. proc*;inline M.main2;wp;call{1} RRO_resample_ll. symmetry;call (LRO_RRO_D D);auto=> &ml&mr[#]2->;split=>//=. diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 53d4499..e7b6054 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -868,7 +868,7 @@ proof. move=> lt_ij eee ran_k. apply fmapP=> p. have [ys k] -> /# : exists ys k, p = (ys, k) - by exists p.`1, p.`2; smt(). + by exists p.`1 p.`2; smt(). qed. lemma eager_invar_eq_except_upd1 @@ -1191,7 +1191,7 @@ transitivity 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})=> |>. +exists HybridIROEager.mp{1} (x{2}, i{1}, m{1}, blocks2bits bs{2})=> |>. split; first smt(). split; first smt(size_blocks2bits). apply @@ -1407,7 +1407,7 @@ transitivity{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}=> //. +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=> //; rnd; auto. skip; progress; smt(ge0_r). @@ -1427,7 +1427,7 @@ transitivity{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}=> //. +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). @@ -1447,8 +1447,7 @@ transitivity{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}=> //. + 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 /\ @@ -1466,7 +1465,7 @@ transitivity{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}=> //. +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. @@ -1548,7 +1547,7 @@ transitivity{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}=> //. +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). @@ -1569,8 +1568,7 @@ auto; progress; smt(leq_trunc_div ge0_r). (={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}=> //); + 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). @@ -1598,7 +1596,7 @@ transitivity{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}=> //. +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} /\ @@ -1614,7 +1612,7 @@ auto. auto. 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}=> //); + first progress; exists BlockSponge.BIRO.IRO.mp{2} x{2}=> //); last first. inline BlockSpongeTrans.loop; sp; wp. while @@ -1678,8 +1676,7 @@ transitivity{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}=> //. + 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 : @@ -1713,8 +1710,7 @@ transitivity{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}=> //. + 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); @@ -1727,7 +1723,7 @@ inline HybridIROEagerTrans.next_block; sim. (={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}=> //); + 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. @@ -1751,7 +1747,7 @@ transitivity 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). +exists HybridIROEager.mp{1} BlockSponge.BIRO.IRO.mp{2} (xs{1}, n{1} * r). move=> |>; by rewrite n_eq. progress; apply blocks2bitsK. by conseq HybridIROEager_f_g=> |> &1 &2 ? -> ?. diff --git a/sha3/proof/core/Gext.eca b/sha3/proof/core/Gext.eca index 0fe42ad..f467cc0 100644 --- a/sha3/proof/core/Gext.eca +++ b/sha3/proof/core/Gext.eca @@ -190,7 +190,7 @@ section. + inline *;auto=> &ml&mr[#]10!-> Hi Hhand -> /=. rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. + rewrite rng_set !inE rem_id 1:/#;move:H0=>[/Hi[->|[x' h][]H1 H2]|->]//. - right;right;exists x', h;rewrite getP. + right;right;exists x' h;rewrite getP. by cut ->//:(h<> G1.chandle{mr});move:(Hhand h);rewrite in_dom H2 /#. by move:H0;rewrite dom_set !inE /#. seq 1 1: (={x,y,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m} /\ @@ -205,18 +205,18 @@ section. + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. + case (h = (oget G1.mh{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + by left;rewrite Hh oget_some. - by right;exists x{2}, h;rewrite dom_set getP Hneq !inE. + by right;exists x{2} h;rewrite dom_set getP Hneq !inE. case (h = (oget G1.mh{2}.[(x{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 !dom_set getP Hneq //=. + right;exists (x1,x2) h;rewrite !dom_set getP Hneq //=. by move:Hx;rewrite !inE Hh=>-[]->. by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. - + right;exists x{2}, h;rewrite getP dom_set !inE /=. + + right;exists x{2} h;rewrite getP dom_set !inE /=. by move:(H0 h);rewrite in_dom Hh /#. - right;exists x', h;rewrite getP !dom_set !inE;split. + right;exists x' h;rewrite getP !dom_set !inE;split. + by move:Hx;rewrite !inE=>-[]->. by move:(H0 h);rewrite !in_dom Hh /#. @@ -231,7 +231,7 @@ section. + inline *;auto=> &ml&mr[#]9!-> Hi Hhand -> /=. rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. + rewrite rng_set !inE rem_id 1:/#;move:H4=>[/Hi[->|[x' h][]HH1 HH2]|->]//. - right;right;exists x', h;rewrite getP. + right;right;exists x' h;rewrite getP. by cut ->//:(h<> G1.chandle{mr});move:(Hhand h);rewrite in_dom HH2 /#. by move:H4;rewrite dom_set !inE /#. if=>//. @@ -242,18 +242,18 @@ section. + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. + case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + by left;rewrite Hh oget_some. - by right;exists x{2}, h;rewrite !dom_set getP Hneq !inE. + by right;exists x{2} h;rewrite !dom_set getP Hneq !inE. case (h = (oget G1.mhi{2}.[(x{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 !dom_set getP Hneq //=. + right;exists (x1,x2) h;rewrite !dom_set getP Hneq //=. by move:Hx;rewrite !inE Hh=>-[]->. by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. - + right;exists x{2}, h;rewrite getP !dom_set !inE /=. + + right;exists x{2} h;rewrite getP !dom_set !inE /=. by move:(H0 h);rewrite in_dom Hh /#. - right;exists x', h;rewrite getP !dom_set !inE;split. + right;exists x' h;rewrite getP !dom_set !inE;split. + by move:Hx;rewrite !inE=>-[]->. by move:(H0 h);rewrite !in_dom Hh /#. @@ -269,10 +269,10 @@ section. rcondt{2} 3;1:by auto=>/#. auto=> &m1&m2 [#] 10!-> Hinv Hhand Hi _ _ /= ?->?->/=;split=>/= _;split. + move:Hinv;rewrite /inv_ext1=> H/H{H}[->//|[x h]];rewrite inE=>-[Hmem Hh]. - by right;exists x,h;rewrite !inE Hmem getP;smt w=in_dom. + by right;exists x h;rewrite !inE Hmem getP;smt w=in_dom. + by move=>h;rewrite dom_set !inE /#. + move:Hinv;rewrite /inv_ext1=> H/H{H}[->//|[x h]];rewrite inE=>-[Hmem Hh]. - by right;exists x,h;rewrite !inE Hmem getP;smt w=in_dom. + by right;exists x h;rewrite !inE Hmem getP;smt w=in_dom. by move=>h;rewrite dom_set !inE /#. (* **************** *) @@ -529,7 +529,7 @@ section EXT. rewrite drop0=>-[H|[x h][#]];1:by rewrite Hext // H. rewrite getP;case (h=h1)=> [/=->Hin->_ | Hneq ???]. + by right;apply (mem_image snd _ x). - by rewrite Hext 2://;right;exists x, h;rewrite Hneq. + 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} /\ inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}). + proc;sp;if=> //. diff --git a/sha3/proof/core/Handle.eca b/sha3/proof/core/Handle.eca index 55fef06..b768aa4 100644 --- a/sha3/proof/core/Handle.eca +++ b/sha3/proof/core/Handle.eca @@ -153,6 +153,7 @@ module G1(D:DISTINGUISHER) = { }. (* -------------------------------------------------------------------------- *) +(** RELATIONAL: Map, Handle-Map and Handles are compatible **) inductive eqm_handles (hs : handles) (m : smap) (mh : hsmap) = | MH of (forall xa xc ya yc, m.[(xa,xc)] = Some (ya,yc) => @@ -167,6 +168,157 @@ inductive eqm_handles (hs : handles) (m : smap) (mh : hsmap) = /\ hs.[yh] = Some (yc,yf) /\ m.[(xa,xc)] = Some (ya,yc)). +(* Consequences of (xa,xc) \in (dom m) *) +lemma eqm_handles_m_some (hs : handles) (m : smap) (mh : hsmap) + xa xc ya yc: + huniq hs + => eqm_handles hs m mh + => 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). +proof. by move=> hs_huniq [] + _ m_xaxc - /(_ _ _ _ _ m_xaxc). qed. + +lemma eqm_handles_m_some_xy (hs : handles) (m : smap) (mh : hsmap) + xa xc ya yc hx fx hy fy: + huniq hs + => eqm_handles hs m mh + => m.[(xa,xc)] = Some (ya,yc) + => hs.[hx] = Some (xc,fx) + => hs.[hy] = Some (yc,fy) + => mh.[(xa,hx)] = Some (ya,hy). +proof. +move=> hs_huniq [] + _ m_xaxc hs_hx hs_hy - /(_ _ _ _ _ m_xaxc) [xh xf yh yf] [#]. +by move=> /(hs_huniq _ _ _ _ hs_hx) /= <<*> /(hs_huniq _ _ _ _ hs_hy) /= <<*>. +qed. + +lemma eqm_handles_m_some_x (hs : handles) (m : smap) (mh : hsmap) + xa xc ya yc hx fx: + huniq hs + => eqm_handles hs m mh + => m.[(xa,xc)] = Some (ya,yc) + => hs.[hx] = Some (xc,fx) + => exists hy fy, + hs.[hy] = Some (yc,fy) + /\ mh.[(xa,hx)] = Some (ya,hy). +proof. +move=> hs_huniq [] + _ m_xaxc hs_hx - /(_ _ _ _ _ m_xaxc) [xh xf yh yf] [#]. +by move=> /(hs_huniq _ _ _ _ hs_hx) /= <<*> hs_hy mh_xaxc; exists yh yf. +qed. + +lemma eqm_handles_m_some_y (hs : handles) (m : smap) (mh : hsmap) + xa xc ya yc hy fy: + huniq hs + => eqm_handles hs m mh + => m.[(xa,xc)] = Some (ya,yc) + => hs.[hy] = Some (yc,fy) + => exists hx fx, + hs.[hx] = Some (xc,fx) + /\ mh.[(xa,hx)] = Some (ya,hy). +proof. +move=> hs_huniq [] + _ m_xaxc hs_hy - /(_ _ _ _ _ m_xaxc) [xh xf yh yf] [#]. +by move=> hs_hx /(hs_huniq _ _ _ _ hs_hy) /= <<*> mh_xaxc; exists xh xf. +qed. + +(* Consequence of (xa,xc) \notin (dom m) *) +lemma eqm_handles_m_none_in_mh (hs : handles) (m : smap) (mh : hsmap) + xa xc ya yc hx: + eqm_handles hs m mh + => m.[(xa,xc)] = None + => mh.[(xa,hx)] = Some (ya,yc) + => (forall fx, hs.[hx] <> Some (xc,fx)). +proof. by move=> [] _ Hmh m_xaxc /Hmh [xc0 fx yc0 fy] [#] -> /#. qed. + +lemma eqm_handles_m_none_in_hs (hs : handles) (m : smap) (mh : hsmap) + xa xc hx fx: + eqm_handles hs m mh + => m.[(xa,xc)] = None + => hs.[hx] = Some (xc,fx) + => mh.[(xa,hx)] = None. +proof. +move=> [] _ Hmh m_xaxc. +case: {-1}(mh.[(xa,hx)]) (eq_refl (mh.[(xa,hx)]))=> [//|]. (* TODO: contra *) +by move=> [ya hy] /Hmh [xc0 fx0 yc fy] [#] /#. +qed. + +(* Consequence of (xa,hx) \in (dom mh) *) +lemma eqm_handles_mh_some (hs : handles) (m : smap) (mh : hsmap) + xa hx ya hy: + huniq hs + => eqm_handles hs m mh + => 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). +proof. by move=> hs_huniq [] _ + mh_xaxc - /(_ _ _ _ _ mh_xaxc). qed. + +lemma eqm_handles_mh_some_xy (hs : handles) (m : smap) (mh : hsmap) + xa hx ya hy xc fx yc fy: + huniq hs + => eqm_handles hs m mh + => mh.[(xa,hx)] = Some (ya,hy) + => hs.[hx] = Some (xc,fx) + => hs.[hy] = Some (yc,fy) + => m.[(xa,xc)] = Some (ya,yc). +proof. +move=> hs_huniq [] _ + mh_xaxc hs_hx hs_hy - /(_ _ _ _ _ mh_xaxc) [xc' xf' yc' yf'] [#]. +by rewrite hs_hx hs_hy /= => [#] <<*> [#] <<*>. +qed. + +lemma eqm_handles_mh_some_x (hs : handles) (m : smap) (mh : hsmap) + xa hx ya hy xc fx: + huniq hs + => eqm_handles hs m mh + => mh.[(xa,hx)] = Some (ya,hy) + => hs.[hx] = Some (xc,fx) + => exists yc fy, + hs.[hy] = Some (yc,fy) + /\ m.[(xa,xc)] = Some (ya,yc). +proof. +move=> hs_huniq [] _ + mh_xaxc hs_hx - /(_ _ _ _ _ mh_xaxc) [xc' fx' yc fy] [#]. +by rewrite hs_hx /= => [#] <<*> hs_hy m_xaxc; exists yc fy. +qed. + +lemma eqm_handles_mh_some_y (hs : handles) (m : smap) (mh : hsmap) + xa hx ya hy yc fy: + huniq hs + => eqm_handles hs m mh + => mh.[(xa,hx)] = Some (ya,hy) + => hs.[hy] = Some (yc,fy) + => exists xc fx, + hs.[hx] = Some (xc,fx) + /\ m.[(xa,xc)] = Some (ya,yc). +proof. +move=> hs_huniq [] _ + mh_xaxc hs_hy - /(_ _ _ _ _ mh_xaxc) [xc fx yc' fy'] [#] hs_hx. +by rewrite hs_hy /= => [#] <<*> m_xaxc; exists xc fx. +qed. + +(* Consequences of (xa,hx) \notin (dom mh) *) +lemma eqm_handles_mh_none_in_m (hs : handles) (m : smap) (mh : hsmap) + xa xc ya yc hx: + huniq hs + => eqm_handles hs m mh + => mh.[(xa,hx)] = None + => m.[(xa,xc)] = Some (ya,yc) + => (forall fx, hs.[hx] <> Some (xc,fx)). +proof. by move=> hs_huniq [] Hm _ mh_xaxc /Hm [hx0 fx hy0 fy] [#] /#. qed. + +lemma eqm_handles_mh_none_in_hs (hs : handles) (m : smap) (mh : hsmap) + xa hx xc fx: + huniq hs + => eqm_handles hs m mh + => mh.[(xa,hx)] = None + => hs.[hx] = Some (xc,fx) + => m.[(xa,xc)] = None. +proof. +move=> hs_huniq [] Hm _ m_xaxc. +case: {-1}(m.[(xa,xc)]) (eq_refl (m.[(xa,xc)]))=> [//|]. (* TODO: contra *) +by move=> [ya hy] /Hm [xc0 fx0 yc fy] [#] /#. +qed. + +(* WELL-FORMEDNESS<2>: Handles, Map, Handle-Map and RO are compatible *) inductive mh_spec (hs : handles) (m2 : smap) (mh : hsmap) (ro : (block list,block) fmap) = | H of (forall xa xh ya yh, mh.[(xa,xh)] = Some (ya,yh) => @@ -185,6 +337,99 @@ inductive mh_spec (hs : handles) (m2 : smap) (mh : hsmap) (ro : (block list,bloc build_hpath mh p = Some (v,xh) /\ mh.[(v +^ xa,xh)] = Some (b,yh)). +(* Consequences of (xa,hx) \in (dom mh) *) +lemma mh_spec_mh_some (hs : handles) (Gm : smap) (mh : hsmap) ro + xa hx ya hy: + mh_spec hs Gm mh ro + => 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). +proof. by move=> [] + _ mh_xaxc - /(_ _ _ _ _ mh_xaxc). qed. + +lemma mh_spec_mh_some_y (hs : handles) (Gm : smap) (mh : hsmap) ro + xa hx ya hy yc fy: + mh_spec hs Gm mh ro + => mh.[(xa,hx)] = Some (ya,hy) + => hs.[hy] = Some (yc,fy) + => exists xc fx, + hs.[hx] = Some (xc,fx) + /\ 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). +proof. +move=> Hmh /(mh_spec_mh_some _ _ _ _ _ _ _ _ Hmh) [xc fx yc0 fy0] [#] -> ->. +by move=> + [#] <<*> - H; exists xc fx. +qed. + +lemma mh_spec_mh_some_yK (hs : handles) (Gm : smap) (mh : hsmap) ro + xa hx ya hy yc: + mh_spec hs Gm mh ro + => mh.[(xa,hx)] = Some (ya,hy) + => hs.[hy] = Some (yc,Known) + => exists xc, + hs.[hx] = Some (xc,Known) + /\ Gm.[(xa,xc)] = Some (ya,yc). +proof. +move=> Hmh mh_xaxc /(mh_spec_mh_some_y _ _ _ _ _ _ _ _ _ _ Hmh mh_xaxc) [xc fx] [#] /=. +by move=> hs_hx Gm_xaxc <*>; exists xc. +qed. + +lemma mh_spec_mh_some_yU (hs : handles) (Gm : smap) (mh : hsmap) ro + xa hx ya hy yc: + mh_spec hs Gm mh ro + => mh.[(xa,hx)] = Some (ya,hy) + => hs.[hy] = Some (yc,Unknown) + => exists xc fx p v, + hs.[hx] = Some (xc,fx) + /\ ro.[rcons p (v +^ xa)] = Some ya + /\ build_hpath mh p = Some (v,hx). +proof. +move=> Hmh mh_xaxc /(mh_spec_mh_some_y _ _ _ _ _ _ _ _ _ _ Hmh mh_xaxc) [xc fx] [#] /=. +by move=> hs_hx [p v] H; exists xc fx p v. +qed. + +lemma mh_spec_mh_some_x (hs : handles) (Gm : smap) (mh : hsmap) ro + xa hx ya hy xc fx: + mh_spec hs Gm mh ro + => mh.[(xa,hx)] = Some (ya,hy) + => hs.[hx] = Some (xc,fx) + => exists yc fy, + 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). +proof. +move=> Hmh /(mh_spec_mh_some _ _ _ _ _ _ _ _ Hmh) [xc0 fx0 yc fy] [#] -> ->. +by move=> + [#] <<*> - H; exists yc fy. +qed. + +lemma mh_spec_mh_some_xU (hs : handles) (Gm : smap) (mh : hsmap) ro + xa hx ya hy xc: + mh_spec hs Gm mh ro + => mh.[(xa,hx)] = Some (ya,hy) + => hs.[hx] = Some (xc,Unknown) + => exists yc p v, + hs.[hy] = Some (yc,Unknown) + /\ ro.[rcons p (v +^ xa)] = Some ya + /\ build_hpath mh p = Some (v,hx). +proof. +move=> Hmh mh_xaxc /(mh_spec_mh_some_x _ _ _ _ _ _ _ _ _ _ Hmh mh_xaxc) [yc fy] [#] ->. +by case: fy=> //= - [p v] H; exists yc p v. +qed. + inductive paths_spec (hs : handles) (mh : hsmap) (pi : (capacity,block list*block) fmap) = | P of (forall c p v, pi.[c] = Some (p,v) <=> @@ -197,6 +442,9 @@ inductive handles_spec hs ch = & (hs.[0] = Some (c0,Known)) & (forall h, mem (dom hs) h => h < ch). +inductive inverse_spec (m:('a,'b) fmap) mi = + | Is of (forall x y, m.[x] = Some y <=> mi.[y] = Some x). + inductive INV_CF_G1 (hs : handles) ch (m1 mi1 m2 mi2 : smap) (mh2 mhi2 : hsmap) (ro : (block list,block) fmap) pi = | HCF_G1 of (eqm_handles hs m1 mh2) @@ -292,11 +540,11 @@ lemma eqm_up_handles hs ch m mh x2 : proof. case=> Hu Hh0 Hlt [] m_some mh_some; split. + move=> xb xc xb' xc' /m_some [h h' f f'] [#] Hh Hh' Hmh. - exists h, h', f, f'; rewrite !getP Hmh -Hh -Hh' /=. + exists h h' f f'; rewrite !getP Hmh -Hh -Hh' /=. rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. move=> xb xh xb' xh' /mh_some [c c' f f'] [#] Hh Hh' Hm. -exists c, c', f, f'; rewrite !getP Hm -Hh -Hh'. +exists c c' f f'; rewrite !getP Hm -Hh -Hh'. rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. qed. @@ -307,7 +555,7 @@ lemma mh_up_handles hs ch m2 mh ro cf: mh_spec hs.[ch <- cf] m2 mh ro. proof. move=> + [] mh_some ?=> -[] _ _ Hlt; split=> // b h b' h' /mh_some [c c' f f'] [#] Hh Hh' Hif. -exists c,c',f,f'; rewrite Hif -Hh -Hh' !getP. +exists c c' f f'; rewrite Hif -Hh -Hh' !getP. rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. qed. @@ -344,18 +592,18 @@ move=> Hx2 ^Hh [] Hu Hh0 Hlt; split. by move=> h; rewrite dom_set !inE /#. qed. -lemma INV_CF_G1_up_handles hs ch m1 mi1 m2 mi2 mh mhi ro pi x2: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh mhi ro pi => - (forall f, !mem (rng hs) (x2, f)) => - INV_CF_G1 hs.[ch <- (x2, Known)] (ch + 1) m1 mi1 m2 mi2 mh mhi ro pi. -proof. -case=> Heqm Heqmi Hincl Hincli Hmh Hp Hh Hx2. -exact/(HCF_G1 (eqm_up_handles Hh Heqm) (eqm_up_handles Hh Heqmi) - _ _ - (:@mh_up_handles _ _ _ _ _ (x2,Known) Hh Hmh) - (:@paths_up_handles m2 ro _ _ _ (x2,Known) _ Hmh Hh Hp) - (:@handles_up_handles _ _ x2 Known _ Hh)). -qed. +(* lemma INV_CF_G1_up_handles hs ch m1 mi1 m2 mi2 mh mhi ro pi x2: *) +(* INV_CF_G1 hs ch m1 mi1 m2 mi2 mh mhi ro pi => *) +(* (forall f, !mem (rng hs) (x2, f)) => *) +(* INV_CF_G1 hs.[ch <- (x2, Known)] (ch + 1) m1 mi1 m2 mi2 mh mhi ro pi. *) +(* proof. *) +(* case=> Heqm Heqmi Hincl Hincli Hmh Hp Hh Hx2. *) +(* exact/(HCF_G1 (eqm_up_handles Hh Heqm) (eqm_up_handles Hh Heqmi) *) +(* _ _ *) +(* (:@mh_up_handles _ _ _ _ _ (x2,Known) Hh Hmh) *) +(* (:@paths_up_handles m2 ro _ _ _ (x2,Known) _ Hmh Hh Hp) *) +(* (:@handles_up_handles _ _ x2 Known _ Hh)). *) +(* qed. *) (** Updating forward map **) lemma eqm_handles_up (hs : handles) m mh (h hx:handle) (x y : state) f: @@ -367,13 +615,13 @@ lemma eqm_handles_up (hs : handles) m mh (h hx:handle) (x y : state) f: proof. move=> uniq_h h_h h_hx @/eqm_handles [] hmmh hmhm; split. + move=> b c b' c'; rewrite getP; case ((b,c) = x)=> /= [<<- ->> {x y} /=|]. - * by exists hx, f, h, Known; rewrite !getP /= [smt (in_dom)]. + * by exists hx f h Known; rewrite !getP /= [smt (in_dom)]. move=> bc_neq_x /hmmh [] h0 f0 h0' f0' [#] h_h0 h_h0' mhi_bc. - by exists h0, f0, h0', f0'; rewrite !getP [smt (in_dom)]. + by exists h0 f0 h0' f0'; rewrite !getP [smt (in_dom)]. move=> xb xh b' h'; rewrite getP; case ((xb,xh) = (x.`1,hx))=> /= [[#] <*> [#] <*>|]. - * by exists x.`2, f, y.`2, Known; rewrite !getP [smt (in_dom)]. + * by exists x.`2 f y.`2 Known; rewrite !getP [smt (in_dom)]. rewrite anda_and negb_and=> bh_neq_x1hx /hmhm /= [] c0 f0 c0' f0' [#] h_h0 h_bh' m_bc. -exists c0, f0, c0', f0'; rewrite !getP. +exists c0 f0 c0' f0'; rewrite !getP. split; 1:smt (in_dom). split; 1:smt (in_dom). case x bh_neq_x1hx h_hx=> x1 x2 /= => - [/#|h0_neq_hx h_hx]. @@ -391,13 +639,13 @@ lemma eqmi_handles_up (hs : handles) mi mhi (h hx : handle) (x y : state) f: proof. move=> y_notinr1_handles h_h h_hx @/eqm_handles [] hmmh hmhm; split. + move=> xb xc xb' xc'; rewrite getP; case ((xb,xc) = y)=> /= [<<- ->> {x y}|]. - * by exists h, Known, hx, f; rewrite !getP /= [smt (in_dom)]. + * by exists h Known hx f; rewrite !getP /= [smt (in_dom)]. move=> bc_neq_y /hmmh [] h0 f0 h0' f0' [#] h_h0 h_h0' mhi_bc. - by exists h0, f0, h0', f0'; rewrite !getP [smt (in_dom)]. + by exists h0 f0 h0' f0'; rewrite !getP [smt (in_dom)]. move=> xb xh xb' xh'; rewrite getP; case ((xb,xh) = (y.`1,h))=> /= [[#] <*> [#] <*>|]. - * by exists y.`2, Known, x.`2, f; rewrite !getP [smt (in_dom)]. + * by exists y.`2 Known x.`2 f; rewrite !getP [smt (in_dom)]. rewrite anda_and negb_and=> bh_neq_y1h /hmhm /= [] c0 f0 c0' f0' [#] h_bh h_bh' mi_bh. -exists c0, f0, c0', f0'; rewrite !getP. +exists c0 f0 c0' f0'; rewrite !getP. split; 1:smt (in_dom). split; 1:smt (in_dom). case y bh_neq_y1h y_notinr1_handles=> y1 y2 /= [/#|h0_neq_h y_notinr1_handles]. @@ -463,7 +711,7 @@ proof. move=> [] mh_some _ [] hpaths ^paths_c. move=> /hpaths [h] [#] /build_hpathP [/#|] p' b' v' h' [#] ^/rconsIs + /rconssI- <*>. move=> hpath + handles_h - /mh_some /= [c' c0 f' f]; rewrite handles_h /= => /> handles_h' _. -by exists c', v'; rewrite hpaths; exists h'. +by exists c' v'; rewrite hpaths; exists h'. qed. lemma build_hpath_prefix mh p b v h: @@ -471,7 +719,7 @@ lemma build_hpath_prefix mh p b 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]. -+ by move=> ^/rconsIs <<- {b'} /rconssI <<- {p'}; exists v', h'. ++ by move=> ^/rconsIs <<- {b'} /rconssI <<- {p'}; exists v' h'. exact/(Extend _ _ _ _ _ Hhpath Hmh). qed. @@ -485,7 +733,7 @@ lemma build_hpath_up mh xc xh yc yh p b h: proof. move=> xch_notin_mh @/build_hpath. have: (exists p' v h, build_hpath mh p' = Some (v +^ b0,h)). -+ by exists [], b0, 0; rewrite build_hpathP Block.xorw0; exact/Empty. ++ by exists [] b0 0; rewrite build_hpathP Block.xorw0; exact/Empty. pose root:= b0; elim: p root 0=> //= b1 p ih bn hn. rewrite /(step_hpath _ (Some _)) /= oget_some /= /(step_hpath _ (Some _)) /= oget_some /= getP. case: (mem (dom mh) (bn +^ b1,hn))=> [bnb1hn_in_mh extend_path|]. @@ -497,12 +745,12 @@ case: (mem (dom mh) (bn +^ b1,hn))=> [bnb1hn_in_mh extend_path|]. move=> [] b2 h2 mh_bnb1hn. apply/(@ih b2 h2). case: extend_path=> p' v hp' build_path. - by exists p', (v +^ bn +^ b2), hp'; rewrite build_path //= #ring. + by exists p' (v +^ bn +^ b2) hp'; rewrite build_path //= #ring. by rewrite in_dom /= => mh_bnb1hn _; rewrite mh_bnb1hn iter_step_path_from_None. qed. lemma build_hpath_down mh xc xh yc yh p v h: - 0 <> xh + xh <> 0 => (forall c' h' xc', mh.[(c',h')] <> Some (xc',xh)) => build_hpath mh.[(xc,xh) <- (yc,yh)] p = Some (v,h) => build_hpath mh p = Some (v,h). @@ -512,7 +760,7 @@ elim/last_ind: p v h=> [v h /build_hpathP [<*>|/#] //=|p b ih]. move=> v h /build_hpathP [/#|p' b' + + ^/rconsIs <<- /rconssI <<-]. move=> v' h' /ih; rewrite getP. case: ((v' +^ b,h') = (xc,xh))=> [[#] <*> + [#] <*>|_ Hpath Hmh]. -+ by move=> /build_hpathP [|] /#. ++ by move=> /build_hpathP [/#|] /#. exact/build_hpathP/(Extend _ _ _ _ _ Hpath Hmh). qed. @@ -555,36 +803,36 @@ move=> x2_neq_y2 PFm_x G1m_x pi_x2 x2_notin_hs y2_notin_hs Hinv; split. by move: (x2_notin_hs f1); rewrite in_rng negb_exists /= => ->. case: Hinv=> _ _ _ _ _ _ [] + _ _ _ _ - h. exact/(@h h1 h2 (c1,f1) (c2,f2)). - + by rewrite getP; case: Hinv=> _ _ _ _ _ _ [] _ _; smt (in_dom). + + by rewrite getP; case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). + by rewrite getP. by apply/eqm_up_handles; case: Hinv. + apply/(@eqmi_handles_up hs.[ch <- (x2,Known)] PFmi G1mhi (ch + 1) ch (x1,x2) (y1,y2) Known). + rewrite negb_exists /= => f; rewrite in_rng negb_exists /= => h. rewrite getP; case: (h = ch)=> _; first by rewrite /= x2_neq_y2. by move: (y2_notin_hs f); rewrite in_rng negb_exists /= => ->. - + by rewrite getP; case: Hinv=> _ _ _ _ _ _ [] _ _; smt (in_dom). + + by rewrite getP; case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). + by rewrite getP. by apply/eqm_up_handles; case: Hinv. + move=> z; rewrite !getP; case: (z = (x1,x2))=> //= _. by case: Hinv=> _ _ + _ _ _ _ - @/incl /(_ z). + move=> z; rewrite !getP; case: (z = (y1,y2))=> //= _. - by case: Hinv=> _ _ _ + _ _ _ - @/incl /(_ z). + by case: Hinv=> _ _ _ + - @/incl /(_ z). + split. + move=> xa xh ya yh; rewrite getP; case: ((xa,xh) = (x1,ch)). - + move=> /= [#] <*> [#] <*>; exists x2, Known, y2, Known=> //=. + + move=> /= [#] <*> [#] <*>; exists x2 Known y2 Known=> //=. by rewrite !getP /#. rewrite /= anda_and negb_and=> h hG1mh. (* This one needs cleaned up in priority. These are things that should be deduced instantly. *) have := Hinv=>- [] _ _ _ _ [] + _ _ _ - h0. have [xc xf yc yf] [#] hs_xh hs_yh ite:= h0 _ _ _ _ hG1mh. have yh_lt_ch: xh < ch by case: Hinv=> _ _ _ _ _ _ [] _ _ -> //; rewrite in_dom hs_xh. have xh_lt_ch: yh < ch by case: Hinv=> _ _ _ _ _ _ [] _ _ -> //; rewrite in_dom hs_yh. - exists xc, xf, yc, yf. + exists xc xf yc yf. split; first by smt (getP). split; first by smt (getP). split=> /=. + by move: ite=> <*> /= [#] hG1m -> //=; rewrite getP; case: ((xa,xc) = (x1,x2))=> [<*> /#|]. move: ite=> + hrw; move: hrw=> -> /= [p v] [#] ro_pv hpath. - exists p, v; rewrite ro_pv /=. + exists p v; rewrite ro_pv /=. apply/build_hpath_up=> //=; case: Hinv=> _ _ _ _ _ _ [] _ _ hh. rewrite -negP in_dom; case: {-1}(G1mh.[(x1,ch)]) (eq_refl (G1mh.[(x1,ch)]))=> [//=|[xa' xh']]. move=> /h0 [xc0 xf0 ? ?] [] + _. @@ -601,7 +849,7 @@ move=> x2_neq_y2 PFm_x G1m_x pi_x2 x2_notin_hs y2_notin_hs Hinv; split. by rewrite in_dom=> /= ->. have ch_notin_G1mh: forall cx, !mem (rng G1mh) (cx,ch). + move=> cx; rewrite in_rng negb_exists=> - [b0 h0] /=; rewrite -negP=> G1mh_cxch. - by case: Hinv=> - [] _ + _ _ _ _ _ [] _ _ + - /(_ ch) + /(_ _ _ _ _ G1mh_cxch) [xc xf yc yf] [#] _ hs_ch _ - /=; rewrite in_dom hs_ch. + by case: Hinv=> - [] _ + _ _ _ _ _ [] _ _ + - /(_ _ _ _ _ G1mh_cxch) [xc xf yc yf] [#] _ hs_ch _ /(_ ch) /=; rewrite in_dom hs_ch. split=> -[#]. + move=> hpath hG1mh. rewrite getP; case: ((v +^ xa,xh) = (x1,ch))=> [/#|_]. @@ -619,7 +867,7 @@ move=> x2_neq_y2 PFm_x G1m_x pi_x2 x2_notin_hs y2_notin_hs Hinv; split. have ht /ht {ht} /= -> //= := build_hpath_down G1mh x1 ch y1 (ch + 1) p v xh _ _. + by case: Hinv=> _ _ _ _ _ _ [] _ + +; smt (in_dom). by move=> c' h' xc'; move: (ch_notin_G1mh xc'); rewrite in_rng negb_exists /= => ->. -+ split=> c p v; have [] _ _ _ _ _ [] -> _:= Hinv. ++ split=> c p v; have [] _ _ _ _ _ [] -> _ := Hinv. apply/exists_iff=> h /=; split=> [#]. have ht /ht {ht} -> /= := build_hpath_up G1mh x1 ch y1 (ch +1) p v h _. + rewrite in_dom /=; case: {-1}(G1mh.[(x1,ch)]) (eq_refl (G1mh.[(x1,ch)]))=> [|[x1' xh'] G1mh_x1'xh'] //=. @@ -630,10 +878,10 @@ move=> x2_neq_y2 PFm_x G1m_x pi_x2 x2_notin_hs y2_notin_hs Hinv; split. by case: Hinv=> _ _ _ _ _ _ [] _ _ /(_ h); rewrite in_dom hs_h. have ch_notin_G1mh: forall cx, !mem (rng G1mh) (cx,ch). + move=> cx; rewrite in_rng negb_exists=> - [b0 h0] /=; rewrite -negP=> G1mh_cxch. - by case: Hinv=> - [] _ + _ _ _ _ _ [] _ _ + - /(_ ch) + /(_ _ _ _ _ G1mh_cxch) [xc xf yc yf] [#] _ hs_ch _ - /=; rewrite in_dom hs_ch. + by case: Hinv=> - [] _ + _ _ _ _ _ [] _ _ + - /(_ _ _ _ _ G1mh_cxch) [xc xf yc yf] [#] _ hs_ch _ /(_ ch) /=; rewrite in_dom hs_ch. have Sch_notin_G1mh: forall cx, !mem (rng G1mh) (cx,ch + 1). + move=> cx; rewrite in_rng negb_exists=> - [b0 h0] /=; rewrite -negP=> G1mh_cxch. - by case: Hinv=> - [] _ + _ _ _ _ _ [] _ _ + - /(_ (ch + 1)) + /(_ _ _ _ _ G1mh_cxch) [xc xf yc yf] [#] _ hs_ch _ - /=; rewrite in_dom hs_ch /#. + by case: Hinv=> - [] _ + _ _ _ _ _ [] _ _ + - /(_ _ _ _ _ G1mh_cxch) [xc xf yc yf] [#] _ hs_ch _ /(_ (ch + 1)) /=; rewrite in_dom hs_ch /#. have ht /ht {ht} /= := build_hpath_down G1mh x1 ch y1 (ch + 1) p v h _ _. + by case: Hinv=> _ _ _ _ _ _ [] _ + +; smt (in_dom). + by move=> c' h' xc'; move: (ch_notin_G1mh xc'); rewrite in_rng negb_exists /= => ->. @@ -653,6 +901,80 @@ apply/(@handles_up_handles hs.[ch <- (x2,Known)] (ch + 1) y2 Known). by apply/handles_up_handles=> //=; case: Hinv. qed. +lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x1 x2 y1 y2 hx: + INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi => + PFm.[(x1,x2)] = None => + G1m.[(x1,x2)] = None => + pi.[x2] = None => + hs.[hx] = Some (x2,Known) => + hinv hs y2 = None => + 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. +proof. +move=> Hinv x1x2_notin_PFm x1x2_notin_G1m x2_notin_pi hs_hx y2_notinrng_hs. +split. ++ apply/(@eqm_handles_up _ _ _ _ _ (x1,x2) (y1,y2) Known). + + by case: Hinv=> _ _ _ _ _ _ []. + + by case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). + + by rewrite hs_hx. + + by case: Hinv. ++ apply/(@eqmi_handles_up _ _ _ _ _ (x1,x2) (y1,y2) Known). + + move: y2_notinrng_hs=> /hinv_notin_rng y2_notinrng_hs. + rewrite negb_exists /= => f; rewrite in_rng negb_exists /= => h. + by rewrite y2_notinrng_hs. + + by case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). + + by rewrite hs_hx. + + by case: Hinv. ++ move=> [xa xc]; rewrite !getP; case: ((xa,xc) = (x1,x2))=> //= _ h. + by case: Hinv=> _ _ ->. ++ move=> [xa xc]; rewrite !getP; case: ((xa,xc) = (y1,y2))=> //= _ h. + by case: Hinv=> _ _ _ ->. ++ split. + + move=> xa xh ya yh; rewrite getP; case: ((xa,xh) = (x1,hx))=> [[#] <*>> [#] <<*> /=|]. + + exists x2 Known y2 Known=> //=; rewrite !getP hs_hx /=. + by case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). + move=> xaxh_neq_x1hx mh_xaxh. + have [] _ _ _ _ [] + _ _ _ - /(_ _ _ _ _ mh_xaxh):= Hinv. + move=> [xc xf yc] [] /= - [#] hs_xh hs_yh h. + + exists xc xf yc Unknown=> /=; rewrite !getP hs_xh hs_yh. + split; first by case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). + split; first by case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). + elim: h=> p v [#] Hro Hpath; exists p v; rewrite Hro /=. + apply/build_hpath_up=> //=. + rewrite in_dom -negP; case: {-1}(G1mh.[(x1,hx)]) (eq_refl G1mh.[(x1,hx)])=> [//=|[x' hx'] mh_x1hx]. + have [] [] _ /(_ _ _ _ _ mh_x1hx) + _ _ _ _ _ _:= Hinv. + by move=> [xc0 xf0 yc0 yf0] [#] <<*>; rewrite hs_hx => [#] <<*>; rewrite x1x2_notin_PFm. + move=> ->> {xf} /=; exists xc Known yc Known=> //=. + rewrite !getP. + have -> //=: (xa,xc) <> (x1,x2). + + move: xaxh_neq_x1hx; apply/contra=> [#] <*>> /=. + by case: Hinv=> _ _ _ _ _ _ [] /(_ xh hx _ _ hs_xh hs_hx). + by rewrite h; case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). + move=> p xa b; have [] _ _ _ _ [] _ -> _ _ := Hinv. + apply/exists_iff=> v /=; apply/exists_iff=> xh /=; apply/exists_iff=> yh /=. + split=> -[#]. + + move=> hpath hG1mh; rewrite getP; case: ((v +^ xa,xh) = (x1,hx))=> [[#] <<*>|_]. + + have [] [] _ + _ _ _ _ _ _ -/(_ _ _ _ _ hG1mh):= Hinv. + by move=> [xc xf yc yf] [#]; rewrite hs_hx /= => [#] <<*>; rewrite x1x2_notin_PFm. + rewrite hG1mh //=. + apply/build_hpath_up=> //=; rewrite in_dom. + case: {-1}(G1mh.[(x1,hx)]) (eq_refl G1mh.[(x1,hx)])=> [//|[xa' xc'] G1mh_xaxc']. + have [] [] _ /(_ _ _ _ _ G1mh_xaxc') + _ _ _ _ _ _:= Hinv. + by move=> [xc xf yc yf] [#]; rewrite hs_hx=> [#] <<*>; rewrite x1x2_notin_PFm. + rewrite getP; case: ((v +^ xa,xh) = (x1,hx))=> [[#] <*> + [#] <*>|]. + + move=> /build_hpathP [<*> /=|]. + + have [] _ _ _ _ _ _ [] _ + _:= Hinv. + rewrite hs_hx => /= [#] <*>. + have [] _ _ _ _ _ [] /(_ c0 [] b0) /iffRL + _ := Hinv. + move=> /(_ _); 1:by exists 0=> /#. + by rewrite x2_notin_pi. + move=> p' b' v' h' ->> Hpath Hextend; split. + + apply/build_hpathP/(@Extend G1mh (rcons p' b') v hx p' b' v' h')=> //. +admitted. + clone export ConcreteF as ConcreteF1. section AUX. @@ -810,19 +1132,7 @@ section AUX. + by move=> &m; auto=> //= &hr [#] <*>; rewrite x1hx_notin_G1m. auto=> &1 &2 [#] !<<- -> -> !->> _ /= hinv_y2_none. rewrite getP /= oget_some /=. - admit. - (* lemma 2: - PFm.[(x1,x2)] = None => - G1m.[(x1,x2)] = None => - pi0.[x2] = None => - mem (rng hs (x2,Known) => - hinv hs y2 = None => - INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi => - INV_CF_G1 hs.[ch <- (y2,Known)] (ch + 1) - PFm.[(x,1x2) <- (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. *) + exact/lemma2. move=> [p0 v0] ^ pi_x2. have [] _ _ _ _ _ [] -> _ [hx2] [#] Hpath hs_hx2:= inv0. rcondt{2} 1. by move=> &m; auto=> &hr [#] !<<- _ _ ->> /= _; rewrite in_dom pi_x2. rcondf{2} 6. From 5acb9e7381f77aa48e971144ee988afa20a281fa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 22 Aug 2016 21:48:40 +0100 Subject: [PATCH 201/394] Progress in Core proof. --- sha3/proof/core/Handle.eca | 1468 ++++++++++++++++++------------------ 1 file changed, 746 insertions(+), 722 deletions(-) diff --git a/sha3/proof/core/Handle.eca b/sha3/proof/core/Handle.eca index b768aa4..01d62d5 100644 --- a/sha3/proof/core/Handle.eca +++ b/sha3/proof/core/Handle.eca @@ -154,323 +154,325 @@ module G1(D:DISTINGUISHER) = { (* -------------------------------------------------------------------------- *) (** RELATIONAL: Map, Handle-Map and Handles are compatible **) -inductive eqm_handles (hs : handles) (m : smap) (mh : hsmap) = - | MH of (forall xa xc ya yc, - m.[(xa,xc)] = Some (ya,yc) => - exists xh xf yh yf, - hs.[xh] = Some (xc,xf) - /\ hs.[yh] = Some (yc,yf) - /\ mh.[(xa,xh)] = Some (ya,yh)) - & (forall xa xh ya yh, - mh.[(xa,xh)] = Some (ya,yh) => - exists xc xf yc yf, - hs.[xh] = Some (xc,xf) - /\ hs.[yh] = Some (yc,yf) - /\ m.[(xa,xc)] = Some (ya,yc)). - -(* Consequences of (xa,xc) \in (dom m) *) -lemma eqm_handles_m_some (hs : handles) (m : smap) (mh : hsmap) - xa xc ya yc: - huniq hs - => eqm_handles hs m mh - => 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). -proof. by move=> hs_huniq [] + _ m_xaxc - /(_ _ _ _ _ m_xaxc). qed. - -lemma eqm_handles_m_some_xy (hs : handles) (m : smap) (mh : hsmap) - xa xc ya yc hx fx hy fy: - huniq hs - => eqm_handles hs m mh - => m.[(xa,xc)] = Some (ya,yc) - => hs.[hx] = Some (xc,fx) - => hs.[hy] = Some (yc,fy) - => mh.[(xa,hx)] = Some (ya,hy). -proof. -move=> hs_huniq [] + _ m_xaxc hs_hx hs_hy - /(_ _ _ _ _ m_xaxc) [xh xf yh yf] [#]. -by move=> /(hs_huniq _ _ _ _ hs_hx) /= <<*> /(hs_huniq _ _ _ _ hs_hy) /= <<*>. -qed. - -lemma eqm_handles_m_some_x (hs : handles) (m : smap) (mh : hsmap) - xa xc ya yc hx fx: - huniq hs - => eqm_handles hs m mh - => m.[(xa,xc)] = Some (ya,yc) - => hs.[hx] = Some (xc,fx) - => exists hy fy, - hs.[hy] = Some (yc,fy) - /\ mh.[(xa,hx)] = Some (ya,hy). -proof. -move=> hs_huniq [] + _ m_xaxc hs_hx - /(_ _ _ _ _ m_xaxc) [xh xf yh yf] [#]. -by move=> /(hs_huniq _ _ _ _ hs_hx) /= <<*> hs_hy mh_xaxc; exists yh yf. -qed. - -lemma eqm_handles_m_some_y (hs : handles) (m : smap) (mh : hsmap) - xa xc ya yc hy fy: - huniq hs - => eqm_handles hs m mh - => m.[(xa,xc)] = Some (ya,yc) - => hs.[hy] = Some (yc,fy) - => exists hx fx, - hs.[hx] = Some (xc,fx) - /\ mh.[(xa,hx)] = Some (ya,hy). -proof. -move=> hs_huniq [] + _ m_xaxc hs_hy - /(_ _ _ _ _ m_xaxc) [xh xf yh yf] [#]. -by move=> hs_hx /(hs_huniq _ _ _ _ hs_hy) /= <<*> mh_xaxc; exists xh xf. -qed. +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)). + +(* (* Consequences of (xa,xc) \in (dom m) *) *) +(* lemma eqm_handles_m_some (hs : handles) (m : smap) (mh : hsmap) *) +(* xa xc ya yc: *) +(* huniq hs *) +(* => eqm_handles hs m mh *) +(* => 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). *) +(* proof. by move=> hs_huniq [] + _ m_xaxc - /(_ _ _ _ _ m_xaxc). qed. *) + +(* lemma eqm_handles_m_some_xy (hs : handles) (m : smap) (mh : hsmap) *) +(* xa xc ya yc hx fx hy fy: *) +(* huniq hs *) +(* => eqm_handles hs m mh *) +(* => m.[(xa,xc)] = Some (ya,yc) *) +(* => hs.[hx] = Some (xc,fx) *) +(* => hs.[hy] = Some (yc,fy) *) +(* => mh.[(xa,hx)] = Some (ya,hy). *) +(* proof. *) +(* move=> hs_huniq [] + _ m_xaxc hs_hx hs_hy - /(_ _ _ _ _ m_xaxc) [xh xf yh yf] [#]. *) +(* by move=> /(hs_huniq _ _ _ _ hs_hx) /= <<*> /(hs_huniq _ _ _ _ hs_hy) /= <<*>. *) +(* qed. *) -(* Consequence of (xa,xc) \notin (dom m) *) -lemma eqm_handles_m_none_in_mh (hs : handles) (m : smap) (mh : hsmap) - xa xc ya yc hx: - eqm_handles hs m mh - => m.[(xa,xc)] = None - => mh.[(xa,hx)] = Some (ya,yc) - => (forall fx, hs.[hx] <> Some (xc,fx)). -proof. by move=> [] _ Hmh m_xaxc /Hmh [xc0 fx yc0 fy] [#] -> /#. qed. +(* lemma eqm_handles_m_some_x (hs : handles) (m : smap) (mh : hsmap) *) +(* xa xc ya yc hx fx: *) +(* huniq hs *) +(* => eqm_handles hs m mh *) +(* => m.[(xa,xc)] = Some (ya,yc) *) +(* => hs.[hx] = Some (xc,fx) *) +(* => exists hy fy, *) +(* hs.[hy] = Some (yc,fy) *) +(* /\ mh.[(xa,hx)] = Some (ya,hy). *) +(* proof. *) +(* move=> hs_huniq [] + _ m_xaxc hs_hx - /(_ _ _ _ _ m_xaxc) [xh xf yh yf] [#]. *) +(* by move=> /(hs_huniq _ _ _ _ hs_hx) /= <<*> hs_hy mh_xaxc; exists yh yf. *) +(* qed. *) -lemma eqm_handles_m_none_in_hs (hs : handles) (m : smap) (mh : hsmap) - xa xc hx fx: - eqm_handles hs m mh - => m.[(xa,xc)] = None - => hs.[hx] = Some (xc,fx) - => mh.[(xa,hx)] = None. -proof. -move=> [] _ Hmh m_xaxc. -case: {-1}(mh.[(xa,hx)]) (eq_refl (mh.[(xa,hx)]))=> [//|]. (* TODO: contra *) -by move=> [ya hy] /Hmh [xc0 fx0 yc fy] [#] /#. -qed. +(* lemma eqm_handles_m_some_y (hs : handles) (m : smap) (mh : hsmap) *) +(* xa xc ya yc hy fy: *) +(* huniq hs *) +(* => eqm_handles hs m mh *) +(* => m.[(xa,xc)] = Some (ya,yc) *) +(* => hs.[hy] = Some (yc,fy) *) +(* => exists hx fx, *) +(* hs.[hx] = Some (xc,fx) *) +(* /\ mh.[(xa,hx)] = Some (ya,hy). *) +(* proof. *) +(* move=> hs_huniq [] + _ m_xaxc hs_hy - /(_ _ _ _ _ m_xaxc) [xh xf yh yf] [#]. *) +(* by move=> hs_hx /(hs_huniq _ _ _ _ hs_hy) /= <<*> mh_xaxc; exists xh xf. *) +(* qed. *) -(* Consequence of (xa,hx) \in (dom mh) *) -lemma eqm_handles_mh_some (hs : handles) (m : smap) (mh : hsmap) - xa hx ya hy: - huniq hs - => eqm_handles hs m mh - => 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). -proof. by move=> hs_huniq [] _ + mh_xaxc - /(_ _ _ _ _ mh_xaxc). qed. - -lemma eqm_handles_mh_some_xy (hs : handles) (m : smap) (mh : hsmap) - xa hx ya hy xc fx yc fy: - huniq hs - => eqm_handles hs m mh - => mh.[(xa,hx)] = Some (ya,hy) - => hs.[hx] = Some (xc,fx) - => hs.[hy] = Some (yc,fy) - => m.[(xa,xc)] = Some (ya,yc). -proof. -move=> hs_huniq [] _ + mh_xaxc hs_hx hs_hy - /(_ _ _ _ _ mh_xaxc) [xc' xf' yc' yf'] [#]. -by rewrite hs_hx hs_hy /= => [#] <<*> [#] <<*>. -qed. +(* (* Consequence of (xa,xc) \notin (dom m) *) *) +(* lemma eqm_handles_m_none_in_mh (hs : handles) (m : smap) (mh : hsmap) *) +(* xa xc ya yc hx: *) +(* eqm_handles hs m mh *) +(* => m.[(xa,xc)] = None *) +(* => mh.[(xa,hx)] = Some (ya,yc) *) +(* => (forall fx, hs.[hx] <> Some (xc,fx)). *) +(* proof. by move=> [] _ Hmh m_xaxc /Hmh [xc0 fx yc0 fy] [#] -> /#. qed. *) + +(* lemma eqm_handles_m_none_in_hs (hs : handles) (m : smap) (mh : hsmap) *) +(* xa xc hx fx: *) +(* eqm_handles hs m mh *) +(* => m.[(xa,xc)] = None *) +(* => hs.[hx] = Some (xc,fx) *) +(* => mh.[(xa,hx)] = None. *) +(* proof. *) +(* move=> [] _ Hmh m_xaxc. *) +(* case: {-1}(mh.[(xa,hx)]) (eq_refl (mh.[(xa,hx)]))=> [//|]. (* TODO: contra *) *) +(* by move=> [ya hy] /Hmh [xc0 fx0 yc fy] [#] /#. *) +(* qed. *) -lemma eqm_handles_mh_some_x (hs : handles) (m : smap) (mh : hsmap) - xa hx ya hy xc fx: - huniq hs - => eqm_handles hs m mh - => mh.[(xa,hx)] = Some (ya,hy) - => hs.[hx] = Some (xc,fx) - => exists yc fy, - hs.[hy] = Some (yc,fy) - /\ m.[(xa,xc)] = Some (ya,yc). -proof. -move=> hs_huniq [] _ + mh_xaxc hs_hx - /(_ _ _ _ _ mh_xaxc) [xc' fx' yc fy] [#]. -by rewrite hs_hx /= => [#] <<*> hs_hy m_xaxc; exists yc fy. -qed. +(* (* Consequence of (xa,hx) \in (dom mh) *) *) +(* lemma eqm_handles_mh_some (hs : handles) (m : smap) (mh : hsmap) *) +(* xa hx ya hy: *) +(* huniq hs *) +(* => eqm_handles hs m mh *) +(* => 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). *) +(* proof. by move=> hs_huniq [] _ + mh_xaxc - /(_ _ _ _ _ mh_xaxc). qed. *) + +(* lemma eqm_handles_mh_some_xy (hs : handles) (m : smap) (mh : hsmap) *) +(* xa hx ya hy xc fx yc fy: *) +(* huniq hs *) +(* => eqm_handles hs m mh *) +(* => mh.[(xa,hx)] = Some (ya,hy) *) +(* => hs.[hx] = Some (xc,fx) *) +(* => hs.[hy] = Some (yc,fy) *) +(* => m.[(xa,xc)] = Some (ya,yc). *) +(* proof. *) +(* move=> hs_huniq [] _ + mh_xaxc hs_hx hs_hy - /(_ _ _ _ _ mh_xaxc) [xc' xf' yc' yf'] [#]. *) +(* by rewrite hs_hx hs_hy /= => [#] <<*> [#] <<*>. *) +(* qed. *) -lemma eqm_handles_mh_some_y (hs : handles) (m : smap) (mh : hsmap) - xa hx ya hy yc fy: - huniq hs - => eqm_handles hs m mh - => mh.[(xa,hx)] = Some (ya,hy) - => hs.[hy] = Some (yc,fy) - => exists xc fx, - hs.[hx] = Some (xc,fx) - /\ m.[(xa,xc)] = Some (ya,yc). -proof. -move=> hs_huniq [] _ + mh_xaxc hs_hy - /(_ _ _ _ _ mh_xaxc) [xc fx yc' fy'] [#] hs_hx. -by rewrite hs_hy /= => [#] <<*> m_xaxc; exists xc fx. -qed. +(* lemma eqm_handles_mh_some_x (hs : handles) (m : smap) (mh : hsmap) *) +(* xa hx ya hy xc fx: *) +(* huniq hs *) +(* => eqm_handles hs m mh *) +(* => mh.[(xa,hx)] = Some (ya,hy) *) +(* => hs.[hx] = Some (xc,fx) *) +(* => exists yc fy, *) +(* hs.[hy] = Some (yc,fy) *) +(* /\ m.[(xa,xc)] = Some (ya,yc). *) +(* proof. *) +(* move=> hs_huniq [] _ + mh_xaxc hs_hx - /(_ _ _ _ _ mh_xaxc) [xc' fx' yc fy] [#]. *) +(* by rewrite hs_hx /= => [#] <<*> hs_hy m_xaxc; exists yc fy. *) +(* qed. *) -(* Consequences of (xa,hx) \notin (dom mh) *) -lemma eqm_handles_mh_none_in_m (hs : handles) (m : smap) (mh : hsmap) - xa xc ya yc hx: - huniq hs - => eqm_handles hs m mh - => mh.[(xa,hx)] = None - => m.[(xa,xc)] = Some (ya,yc) - => (forall fx, hs.[hx] <> Some (xc,fx)). -proof. by move=> hs_huniq [] Hm _ mh_xaxc /Hm [hx0 fx hy0 fy] [#] /#. qed. +(* lemma eqm_handles_mh_some_y (hs : handles) (m : smap) (mh : hsmap) *) +(* xa hx ya hy yc fy: *) +(* huniq hs *) +(* => eqm_handles hs m mh *) +(* => mh.[(xa,hx)] = Some (ya,hy) *) +(* => hs.[hy] = Some (yc,fy) *) +(* => exists xc fx, *) +(* hs.[hx] = Some (xc,fx) *) +(* /\ m.[(xa,xc)] = Some (ya,yc). *) +(* proof. *) +(* move=> hs_huniq [] _ + mh_xaxc hs_hy - /(_ _ _ _ _ mh_xaxc) [xc fx yc' fy'] [#] hs_hx. *) +(* by rewrite hs_hy /= => [#] <<*> m_xaxc; exists xc fx. *) +(* qed. *) -lemma eqm_handles_mh_none_in_hs (hs : handles) (m : smap) (mh : hsmap) - xa hx xc fx: - huniq hs - => eqm_handles hs m mh - => mh.[(xa,hx)] = None - => hs.[hx] = Some (xc,fx) - => m.[(xa,xc)] = None. -proof. -move=> hs_huniq [] Hm _ m_xaxc. -case: {-1}(m.[(xa,xc)]) (eq_refl (m.[(xa,xc)]))=> [//|]. (* TODO: contra *) -by move=> [ya hy] /Hm [xc0 fx0 yc fy] [#] /#. -qed. +(* (* Consequences of (xa,hx) \notin (dom mh) *) *) +(* lemma eqm_handles_mh_none_in_m (hs : handles) (m : smap) (mh : hsmap) *) +(* xa xc ya yc hx: *) +(* huniq hs *) +(* => eqm_handles hs m mh *) +(* => mh.[(xa,hx)] = None *) +(* => m.[(xa,xc)] = Some (ya,yc) *) +(* => (forall fx, hs.[hx] <> Some (xc,fx)). *) +(* proof. by move=> hs_huniq [] Hm _ mh_xaxc /Hm [hx0 fx hy0 fy] [#] /#. qed. *) + +(* lemma eqm_handles_mh_none_in_hs (hs : handles) (m : smap) (mh : hsmap) *) +(* xa hx xc fx: *) +(* huniq hs *) +(* => eqm_handles hs m mh *) +(* => mh.[(xa,hx)] = None *) +(* => hs.[hx] = Some (xc,fx) *) +(* => m.[(xa,xc)] = None. *) +(* proof. *) +(* move=> hs_huniq [] Hm _ m_xaxc. *) +(* case: {-1}(m.[(xa,xc)]) (eq_refl (m.[(xa,xc)]))=> [//|]. (* TODO: contra *) *) +(* by move=> [ya hy] /Hm [xc0 fx0 yc fy] [#] /#. *) +(* qed. *) (* WELL-FORMEDNESS<2>: Handles, Map, Handle-Map and RO are compatible *) -inductive mh_spec (hs : handles) (m2 : smap) (mh : hsmap) (ro : (block list,block) fmap) = - | H of (forall xa xh ya yh, - mh.[(xa,xh)] = Some (ya,yh) => - exists xc xf yc yf, - hs.[xh] = Some (xc,xf) - /\ hs.[yh] = Some (yc,yf) - /\ if yf = Known - then m2.[(xa,xc)] = Some (ya,yc) - /\ xf = Known - else exists p v, - ro.[rcons p (v +^ xa)] = Some ya - /\ build_hpath mh p = Some (v,xh)) - & (forall p xa b, - ro.[rcons p xa] = Some b <=> - exists v xh yh, - build_hpath mh p = Some (v,xh) - /\ mh.[(v +^ xa,xh)] = Some (b,yh)). - -(* Consequences of (xa,hx) \in (dom mh) *) -lemma mh_spec_mh_some (hs : handles) (Gm : smap) (mh : hsmap) ro - xa hx ya hy: - mh_spec hs Gm mh ro - => 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). -proof. by move=> [] + _ mh_xaxc - /(_ _ _ _ _ mh_xaxc). qed. - -lemma mh_spec_mh_some_y (hs : handles) (Gm : smap) (mh : hsmap) ro - xa hx ya hy yc fy: - mh_spec hs Gm mh ro - => mh.[(xa,hx)] = Some (ya,hy) - => hs.[hy] = Some (yc,fy) - => exists xc fx, - hs.[hx] = Some (xc,fx) - /\ 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). -proof. -move=> Hmh /(mh_spec_mh_some _ _ _ _ _ _ _ _ Hmh) [xc fx yc0 fy0] [#] -> ->. -by move=> + [#] <<*> - H; exists xc fx. -qed. +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)). + +(* (* Consequences of (xa,hx) \in (dom mh) *) *) +(* lemma mh_spec_mh_some (hs : handles) (Gm : smap) (mh : hsmap) ro *) +(* xa hx ya hy: *) +(* mh_spec hs Gm mh ro *) +(* => 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). *) +(* proof. by move=> [] + _ mh_xaxc - /(_ _ _ _ _ mh_xaxc). qed. *) + +(* lemma mh_spec_mh_some_y (hs : handles) (Gm : smap) (mh : hsmap) ro *) +(* xa hx ya hy yc fy: *) +(* mh_spec hs Gm mh ro *) +(* => mh.[(xa,hx)] = Some (ya,hy) *) +(* => hs.[hy] = Some (yc,fy) *) +(* => exists xc fx, *) +(* hs.[hx] = Some (xc,fx) *) +(* /\ 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). *) +(* proof. *) +(* move=> Hmh /(mh_spec_mh_some _ _ _ _ _ _ _ _ Hmh) [xc fx yc0 fy0] [#] -> ->. *) +(* by move=> + [#] <<*> - H; exists xc fx. *) +(* qed. *) -lemma mh_spec_mh_some_yK (hs : handles) (Gm : smap) (mh : hsmap) ro - xa hx ya hy yc: - mh_spec hs Gm mh ro - => mh.[(xa,hx)] = Some (ya,hy) - => hs.[hy] = Some (yc,Known) - => exists xc, - hs.[hx] = Some (xc,Known) - /\ Gm.[(xa,xc)] = Some (ya,yc). -proof. -move=> Hmh mh_xaxc /(mh_spec_mh_some_y _ _ _ _ _ _ _ _ _ _ Hmh mh_xaxc) [xc fx] [#] /=. -by move=> hs_hx Gm_xaxc <*>; exists xc. -qed. +(* lemma mh_spec_mh_some_yK (hs : handles) (Gm : smap) (mh : hsmap) ro *) +(* xa hx ya hy yc: *) +(* mh_spec hs Gm mh ro *) +(* => mh.[(xa,hx)] = Some (ya,hy) *) +(* => hs.[hy] = Some (yc,Known) *) +(* => exists xc, *) +(* hs.[hx] = Some (xc,Known) *) +(* /\ Gm.[(xa,xc)] = Some (ya,yc). *) +(* proof. *) +(* move=> Hmh mh_xaxc /(mh_spec_mh_some_y _ _ _ _ _ _ _ _ _ _ Hmh mh_xaxc) [xc fx] [#] /=. *) +(* by move=> hs_hx Gm_xaxc <*>; exists xc. *) +(* qed. *) -lemma mh_spec_mh_some_yU (hs : handles) (Gm : smap) (mh : hsmap) ro - xa hx ya hy yc: - mh_spec hs Gm mh ro - => mh.[(xa,hx)] = Some (ya,hy) - => hs.[hy] = Some (yc,Unknown) - => exists xc fx p v, - hs.[hx] = Some (xc,fx) - /\ ro.[rcons p (v +^ xa)] = Some ya - /\ build_hpath mh p = Some (v,hx). -proof. -move=> Hmh mh_xaxc /(mh_spec_mh_some_y _ _ _ _ _ _ _ _ _ _ Hmh mh_xaxc) [xc fx] [#] /=. -by move=> hs_hx [p v] H; exists xc fx p v. -qed. +(* lemma mh_spec_mh_some_yU (hs : handles) (Gm : smap) (mh : hsmap) ro *) +(* xa hx ya hy yc: *) +(* mh_spec hs Gm mh ro *) +(* => mh.[(xa,hx)] = Some (ya,hy) *) +(* => hs.[hy] = Some (yc,Unknown) *) +(* => exists xc fx p v, *) +(* hs.[hx] = Some (xc,fx) *) +(* /\ ro.[rcons p (v +^ xa)] = Some ya *) +(* /\ build_hpath mh p = Some (v,hx). *) +(* proof. *) +(* move=> Hmh mh_xaxc /(mh_spec_mh_some_y _ _ _ _ _ _ _ _ _ _ Hmh mh_xaxc) [xc fx] [#] /=. *) +(* by move=> hs_hx [p v] H; exists xc fx p v. *) +(* qed. *) -lemma mh_spec_mh_some_x (hs : handles) (Gm : smap) (mh : hsmap) ro - xa hx ya hy xc fx: - mh_spec hs Gm mh ro - => mh.[(xa,hx)] = Some (ya,hy) - => hs.[hx] = Some (xc,fx) - => exists yc fy, - 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). -proof. -move=> Hmh /(mh_spec_mh_some _ _ _ _ _ _ _ _ Hmh) [xc0 fx0 yc fy] [#] -> ->. -by move=> + [#] <<*> - H; exists yc fy. -qed. +(* lemma mh_spec_mh_some_x (hs : handles) (Gm : smap) (mh : hsmap) ro *) +(* xa hx ya hy xc fx: *) +(* mh_spec hs Gm mh ro *) +(* => mh.[(xa,hx)] = Some (ya,hy) *) +(* => hs.[hx] = Some (xc,fx) *) +(* => exists yc fy, *) +(* 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). *) +(* proof. *) +(* move=> Hmh /(mh_spec_mh_some _ _ _ _ _ _ _ _ Hmh) [xc0 fx0 yc fy] [#] -> ->. *) +(* by move=> + [#] <<*> - H; exists yc fy. *) +(* qed. *) -lemma mh_spec_mh_some_xU (hs : handles) (Gm : smap) (mh : hsmap) ro - xa hx ya hy xc: - mh_spec hs Gm mh ro - => mh.[(xa,hx)] = Some (ya,hy) - => hs.[hx] = Some (xc,Unknown) - => exists yc p v, - hs.[hy] = Some (yc,Unknown) - /\ ro.[rcons p (v +^ xa)] = Some ya - /\ build_hpath mh p = Some (v,hx). -proof. -move=> Hmh mh_xaxc /(mh_spec_mh_some_x _ _ _ _ _ _ _ _ _ _ Hmh mh_xaxc) [yc fy] [#] ->. -by case: fy=> //= - [p v] H; exists yc p v. -qed. +(* lemma mh_spec_mh_some_xU (hs : handles) (Gm : smap) (mh : hsmap) ro *) +(* xa hx ya hy xc: *) +(* mh_spec hs Gm mh ro *) +(* => mh.[(xa,hx)] = Some (ya,hy) *) +(* => hs.[hx] = Some (xc,Unknown) *) +(* => exists yc p v, *) +(* hs.[hy] = Some (yc,Unknown) *) +(* /\ ro.[rcons p (v +^ xa)] = Some ya *) +(* /\ build_hpath mh p = Some (v,hx). *) +(* proof. *) +(* move=> Hmh mh_xaxc /(mh_spec_mh_some_x _ _ _ _ _ _ _ _ _ _ Hmh mh_xaxc) [yc fy] [#] ->. *) +(* by case: fy=> //= - [p v] H; exists yc p v. *) +(* qed. *) -inductive paths_spec (hs : handles) (mh : hsmap) (pi : (capacity,block list*block) fmap) = - | P of (forall c p v, - pi.[c] = Some (p,v) <=> - exists h, - build_hpath mh p = Some(v,h) - /\ hs.[h] = Some (c,Known)). - -inductive handles_spec hs ch = - | Hs of (huniq hs) - & (hs.[0] = Some (c0,Known)) - & (forall h, mem (dom hs) h => h < ch). - -inductive inverse_spec (m:('a,'b) fmap) mi = - | Is of (forall x y, m.[x] = Some y <=> mi.[y] = Some x). - -inductive INV_CF_G1 (hs : handles) ch (m1 mi1 m2 mi2 : smap) - (mh2 mhi2 : hsmap) (ro : (block list,block) fmap) pi = - | HCF_G1 of (eqm_handles hs m1 mh2) - & (eqm_handles hs mi1 mhi2) - & (incl m2 m1) - & (incl mi2 mi1) - & (mh_spec hs m2 mh2 ro) - & (paths_spec hs mh2 pi) - & (handles_spec hs ch). - -lemma eqm_of_INV (ch : handle) - (mi1 m2 mi2 : smap) (mhi2 : hsmap) - (ro : (block list, block) fmap) - (pi : (capacity, block list * block) fmap) - hs m1 mh2: +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)). + +inductive hs_spec hs ch = + | INV_hs of (huniq hs) + & (hs.[0] = Some (c0,Known)) + & (forall cf h, hs.[h] = Some cf => h < ch). + +inductive inv_spec (m:('a,'b) fmap) mi = + | INV_inv of (forall x y, m.[x] = Some y <=> mi.[y] = Some x). + +inductive INV_CF_G1 (hs : handles) ch (Pm Pmi Gm Gmi : smap) + (mh mhi : hsmap) (ro : (block list,block) fmap) pi = + | HCF_G1 of (hs_spec hs ch) +(* & (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). + +(** 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: INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => - eqm_handles hs m1 mh2. + m_mh hs m1 mh2. proof. by case. qed. -lemma eqmi_of_INV (ch : handle) - (m1 m2 mi2 : smap) (mh2 : hsmap) - (ro : (block list, block) fmap) - (pi : (capacity, block list * block) fmap) - hs mi1 mhi2: +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: INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => - eqm_handles hs mi1 mhi2. + m_mh hs mi1 mhi2. proof. by case. qed. lemma incl_of_INV (hs : handles) (ch : handle) @@ -499,196 +501,280 @@ lemma mh_of_INV (ch : handle) mh_spec hs m2 mh2 ro. proof. by case. qed. -lemma paths_of_INV (ch : handle) - (m1 m2 mi1 mi2: smap) (mhi2: hsmap) - (ro : (block list, block) fmap) - hs mh2 pi: +lemma pi_of_INV (ch : handle) + (m1 m2 mi1 mi2: smap) (mhi2: hsmap) + (ro : (block list, block) fmap) + hs mh2 pi: INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => - paths_spec hs mh2 pi. + pi_spec hs mh2 pi. proof. by case. qed. -lemma handles_of_INV (m1 m2 mi1 mi2 : smap) (mh2 mhi2 : hsmap) - (ro : (block list, block) fmap) - (pi : (capacity, block list * block) fmap) - hs ch: +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: INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => - handles_spec hs ch. + hs_spec hs ch. proof. by case. qed. -(** ?? **) -lemma eqm_dom_mh_m hs m mh hx2 f (x:state): - eqm_handles hs m mh => - hs.[hx2] = Some (x.`2, f) => - mem (dom mh) (x.`1, hx2) => mem (dom m) x. +(* lemma inv_of_INV hs ch m1 mi1 m2 mi2 ro pi *) +(* mh2 mhi2: *) +(* INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => *) +(* inv_spec mh2 mhi2. *) +(* 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_notin_dom_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_notin_dom_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_notin_dom2_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_notin_dom2_mh hs m mh xa ch: + m_mh hs m mh + => hs_spec hs ch + => mh.[(xa,ch + 1)] = None. proof. -move=>[]H1 H2 Hhx2;rewrite !in_dom. -case: (mh.[_]) (H2 x.`1 hx2) => //= -[] b' h' /(_ b' h') [c c' f1 f1']. -by rewrite Hhx2=> /= -[][]<<- _;case:(x)=> ??[]_->. +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 chandle_ge0 hs ch : handles_spec hs ch => 0 < ch. -proof. by case=> _ Heq Hlt; apply Hlt; rewrite in_dom Heq. 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 chandle_0 hs ch : handles_spec hs ch => 0 <> ch. -proof. by move=> Hh;apply/ltr_eqF/(@chandle_ge0 _ _ Hh). 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. -(** Adding handles **) -lemma eqm_up_handles hs ch m mh x2 : - handles_spec hs ch => - eqm_handles hs m mh => - eqm_handles hs.[ch <- (x2, Known)] m mh. +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_notin_dom2_mh hs m mh xa hx: + m_mh hs m mh + => hs.[hx] = None + => mh.[(xa,hx)] = None. proof. -case=> Hu Hh0 Hlt [] m_some mh_some; split. -+ move=> xb xc xb' xc' /m_some [h h' f f'] [#] Hh Hh' Hmh. - exists h h' f f'; rewrite !getP Hmh -Hh -Hh' /=. - rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. - by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. -move=> xb xh xb' xh' /mh_some [c c' f f'] [#] Hh Hh' Hm. -exists c c' f f'; rewrite !getP Hm -Hh -Hh'. -rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. -by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. +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. -lemma mh_up_handles hs ch m2 mh ro cf: - handles_spec hs ch => - mh_spec hs m2 mh ro => - mh_spec hs.[ch <- cf] m2 mh ro. +(** Adding handles **) +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=> + [] mh_some ?=> -[] _ _ Hlt; split=> // b h b' h' /mh_some [c c' f f'] [#] Hh Hh' Hif. -exists c c' f f'; rewrite Hif -Hh -Hh' !getP. -rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. -by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. +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 !getP 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 !getP m_xaxc0 hs_hx hs_hy. +move: hs_hx=> /dom_hs/ltr_eqF -> /=. +by move: hs_hy=> /dom_hs/ltr_eqF -> /=. qed. -lemma paths_up_handles m2 ro hs mh pi cf ch: - mh_spec hs m2 mh ro => - handles_spec hs ch => - paths_spec hs mh pi => - paths_spec hs.[ch <- cf] mh pi. +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=> Hmh Hh [] Hp; split=> c p v; rewrite Hp; apply exists_iff=> x /=. -split=>- [] ^Hbu -> /=; rewrite getP. -+ case: Hh=> _ _ Hlt x_in_handles. - by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom x_in_handles. -case: (x = ch)=> //=. -move: Hbu=> /build_hpathP [[#] _ _ ->|p' b v' h' [#] _ _ Hh']. -+ by rewrite (@chandle_0 _ _ Hh). -case: Hh=> _ _ /(_ x) Hlt; rewrite ltr_eqF //. -by apply/Hlt; rewrite in_dom; case: Hmh=> /(_ _ _ _ _ Hh') [????] [#] _ ->. +move=> ^Hhs [] Hhuniq hs_0 dom_hs xc_notin_rng1_hs; split. ++ move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. + case: (h1 = ch); case: (h2 = ch)=> //= [+ + [#]|+ + + [#]|]=> <*>; + first 2 by rewrite xc_notin_rng1_hs. + by move=> _ _ hs_h1 /(Hhuniq _ _ _ _ hs_h1). ++ by rewrite getP (ch_neq0 _ Hhs). ++ move=> [c f] h; rewrite !getP; case: (h = ch)=> [<*> /#|_]. +by move=> /dom_hs /#. qed. -lemma handles_up_handles hs ch x2 f': - (forall (f : flag), ! mem (rng hs) (x2, f)) => - handles_spec hs ch => - handles_spec hs.[ch <- (x2, f')] (ch + 1). +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=> Hx2 ^Hh [] Hu Hh0 Hlt; split. -+ move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. - case: (h1 = ch)=> /= [-> [] ->> ->|_]; (case: (h2 = ch)=> [-> //= |_]). - + by move=> Heq ->>; move: (Hx2 f2); rewrite in_rng negb_exists=> /= /(_ h2). - + by move=> Heq [] ->> <<- ->>; move: (Hx2 f1); rewrite in_rng negb_exists=> /= /(_ h1). - by apply Hu. -+ by rewrite getP (@chandle_0 _ _ Hh). -by move=> h; rewrite dom_set !inE /#. +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 !getP 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. -(* lemma INV_CF_G1_up_handles hs ch m1 mi1 m2 mi2 mh mhi ro pi x2: *) -(* INV_CF_G1 hs ch m1 mi1 m2 mi2 mh mhi ro pi => *) -(* (forall f, !mem (rng hs) (x2, f)) => *) -(* INV_CF_G1 hs.[ch <- (x2, Known)] (ch + 1) m1 mi1 m2 mi2 mh mhi ro pi. *) +(* lemma paths_up_handles m2 ro hs mh pi cf ch: *) +(* mh_spec hs m2 mh ro => *) +(* handles_spec hs ch => *) +(* paths_spec hs mh pi => *) +(* paths_spec hs.[ch <- cf] mh pi. *) (* proof. *) -(* case=> Heqm Heqmi Hincl Hincli Hmh Hp Hh Hx2. *) -(* exact/(HCF_G1 (eqm_up_handles Hh Heqm) (eqm_up_handles Hh Heqmi) *) -(* _ _ *) -(* (:@mh_up_handles _ _ _ _ _ (x2,Known) Hh Hmh) *) -(* (:@paths_up_handles m2 ro _ _ _ (x2,Known) _ Hmh Hh Hp) *) -(* (:@handles_up_handles _ _ x2 Known _ Hh)). *) +(* move=> Hmh Hh [] Hp; split=> c p v; rewrite Hp; apply exists_iff=> x /=. *) +(* split=>- [] ^Hbu -> /=; rewrite getP. *) +(* + case: Hh=> _ _ Hlt x_in_handles. *) +(* by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom x_in_handles. *) +(* case: (x = ch)=> //=. *) +(* move: Hbu=> /build_hpathP [[#] _ _ ->|p' b v' h' [#] _ _ Hh']. *) +(* + by rewrite (@chandle_0 _ _ Hh). *) +(* case: Hh=> _ _ /(_ x) Hlt; rewrite ltr_eqF //. *) +(* by apply/Hlt; rewrite in_dom; case: Hmh=> /(_ _ _ _ _ Hh') [????] [#] _ ->. *) (* qed. *) +(* lemma handles_up_handles hs ch x2 f': *) +(* (forall (f : flag), ! mem (rng hs) (x2, f)) => *) +(* handles_spec hs ch => *) +(* handles_spec hs.[ch <- (x2, f')] (ch + 1). *) +(* proof. *) +(* move=> Hx2 ^Hh [] Hu Hh0 Hlt; split. *) +(* + move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. *) +(* case: (h1 = ch)=> /= [-> [] ->> ->|_]; (case: (h2 = ch)=> [-> //= |_]). *) +(* + by move=> Heq ->>; move: (Hx2 f2); rewrite in_rng negb_exists=> /= /(_ h2). *) +(* + by move=> Heq [] ->> <<- ->>; move: (Hx2 f1); rewrite in_rng negb_exists=> /= /(_ h1). *) +(* by apply Hu. *) +(* + by rewrite getP (@chandle_0 _ _ Hh). *) +(* by move=> h; rewrite dom_set !inE /#. *) +(* qed. *) + +(* (* lemma INV_CF_G1_up_handles hs ch m1 mi1 m2 mi2 mh mhi ro pi x2: *) *) +(* (* INV_CF_G1 hs ch m1 mi1 m2 mi2 mh mhi ro pi => *) *) +(* (* (forall f, !mem (rng hs) (x2, f)) => *) *) +(* (* INV_CF_G1 hs.[ch <- (x2, Known)] (ch + 1) m1 mi1 m2 mi2 mh mhi ro pi. *) *) +(* (* proof. *) *) +(* (* case=> Heqm Heqmi Hincl Hincli Hmh Hp Hh Hx2. *) *) +(* (* exact/(HCF_G1 (eqm_up_handles Hh Heqm) (eqm_up_handles Hh Heqmi) *) *) +(* (* _ _ *) *) +(* (* (:@mh_up_handles _ _ _ _ _ (x2,Known) Hh Hmh) *) *) +(* (* (:@paths_up_handles m2 ro _ _ _ (x2,Known) _ Hmh Hh Hp) *) *) +(* (* (:@handles_up_handles _ _ x2 Known _ Hh)). *) *) +(* (* qed. *) *) + (** Updating forward map **) -lemma eqm_handles_up (hs : handles) m mh (h hx:handle) (x y : state) f: +lemma m_mh_addh_addm hs Pm mh hx xa xc hy ya yc f: + m_mh hs Pm mh => huniq hs => - hs.[h] = None => - hs.[hx] = Some (x.`2, f) => - eqm_handles hs m mh => - eqm_handles hs.[h <- (y.`2,Known)] m.[x <- y] mh.[(x.`1,hx) <- (y.`1,h)]. + hs.[hx] = Some (xc, f) => + hs.[hy] = None => + m_mh hs.[hy <- (yc,Known)] Pm.[(xa,xc) <- (ya,yc)] mh.[(xa,hx) <- (ya,hy)]. proof. -move=> uniq_h h_h h_hx @/eqm_handles [] hmmh hmhm; split. -+ move=> b c b' c'; rewrite getP; case ((b,c) = x)=> /= [<<- ->> {x y} /=|]. - * by exists hx f h Known; rewrite !getP /= [smt (in_dom)]. - move=> bc_neq_x /hmmh [] h0 f0 h0' f0' [#] h_h0 h_h0' mhi_bc. - by exists h0 f0 h0' f0'; rewrite !getP [smt (in_dom)]. -move=> xb xh b' h'; rewrite getP; case ((xb,xh) = (x.`1,hx))=> /= [[#] <*> [#] <*>|]. - * by exists x.`2 f y.`2 Known; rewrite !getP [smt (in_dom)]. -rewrite anda_and negb_and=> bh_neq_x1hx /hmhm /= [] c0 f0 c0' f0' [#] h_h0 h_bh' m_bc. -exists c0 f0 c0' f0'; rewrite !getP. -split; 1:smt (in_dom). -split; 1:smt (in_dom). -case x bh_neq_x1hx h_hx=> x1 x2 /= => - [/#|h0_neq_hx h_hx]. -have -> //=: c0 <> x2; move: h0_neq_hx; apply/contra. -exact/(@uniq_h _ _ _ _ h_h0 h_hx). +move=> [] Hm_mh Hmh_m Hhuniq hs_hx hs_hy. +split=> [xa0 xc0 ya0 yc0|xa0 hx0 ya0 hy0]; rewrite getP. ++ case: ((xa0,xc0) = (xa,xc))=> [[#] <<*> [#] <<*>|] /=. + + by exists hx f hy Known; rewrite !getP /= /#. + move=> xaxc0_neq_xaxc /Hm_mh [hx0 fx0 hy0 fy0] [#] hs_hx0 hs_hy0 mh_xahx0. + by exists hx0 fx0 hy0 fy0; rewrite !getP /#. +case: ((xa0,hx0) = (xa,hx))=> [[#] <*>> [#] <<*>|] /=. ++ by exists xc f yc Known; rewrite !getP /= /#. +rewrite anda_and=> /negb_and xahx0_neq_xahx /Hmh_m [xc0 fx0 yc0 fy0] [#] hs_hx0 hs_hy0 Pm_xaxc0. +exists xc0 fx0 yc0 fy0; rewrite !getP; do !split=> [/#|/#|/=]. +move: xahx0_neq_xahx; case: (xa0 = xa)=> [/= <*>>|//=]; case: (xc0 = xc)=> [<*>>|//=]. +by move: hs_hx=> /(Hhuniq _ _ _ _ hs_hx0). qed. (** Updating backward map **) -lemma eqmi_handles_up (hs : handles) mi mhi (h hx : handle) (x y : state) f: - (!exists f', mem (rng hs) (y.`2,f')) => - hs.[h] = None => - hs.[hx] = Some (x.`2, f) => - eqm_handles hs mi mhi => - eqm_handles hs.[h <- (y.`2,Known)] mi.[y <- x] mhi.[(y.`1,h) <- (x.`1,hx)]. +lemma mi_mhi_addh_addmi (hs : handles) mi mhi hx xa xc hy ya yc fx: + 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,Known)] mi.[(ya,yc) <- (xa,xc)] mhi.[(ya,hy) <- (xa,hx)]. proof. -move=> y_notinr1_handles h_h h_hx @/eqm_handles [] hmmh hmhm; split. -+ move=> xb xc xb' xc'; rewrite getP; case ((xb,xc) = y)=> /= [<<- ->> {x y}|]. - * by exists h Known hx f; rewrite !getP /= [smt (in_dom)]. - move=> bc_neq_y /hmmh [] h0 f0 h0' f0' [#] h_h0 h_h0' mhi_bc. - by exists h0 f0 h0' f0'; rewrite !getP [smt (in_dom)]. -move=> xb xh xb' xh'; rewrite getP; case ((xb,xh) = (y.`1,h))=> /= [[#] <*> [#] <*>|]. - * by exists y.`2 Known x.`2 f; rewrite !getP [smt (in_dom)]. -rewrite anda_and negb_and=> bh_neq_y1h /hmhm /= [] c0 f0 c0' f0' [#] h_bh h_bh' mi_bh. -exists c0 f0 c0' f0'; rewrite !getP. -split; 1:smt (in_dom). -split; 1:smt (in_dom). -case y bh_neq_y1h y_notinr1_handles=> y1 y2 /= [/#|h0_neq_h y_notinr1_handles]. -have /#: c0 = y2 => false; move=> /(congr1 (fun x=> exists f', mem (rng hs) (x,f'))) /=. -rewrite y_notinr1_handles /= neqF /=; exists f0. -by rewrite in_rng; exists xh. +move=> [] Hm_mh Hmh_m yc_notin_rng1_hs hs_hx hs_hy; split. ++ move=> ya0 yc0 xa0 xc0; rewrite getP; case: ((ya0,yc0) = (ya,yc))=> [[#] <*>> [#] <*>>|]. + + by exists hy Known hx fx; rewrite !getP /= /#. + move=> yayc0_neq_yayc /Hm_mh [hy0 fy0 hx0 fx0] [#] hs_hy0 hs_hx0 mhi_yayc0. + by exists hy0 fy0 hx0 fx0; rewrite !getP /#. +move=> ya0 hy0 xa0 hx0; rewrite getP; case: ((ya0,hy0) = (ya,hy))=> [[#] <*>> [#] <<*>|]. ++ by exists yc Known xc fx; rewrite !getP //= /#. +rewrite /= anda_and=> /negb_and yahy0_neq_yahy /Hmh_m [yc0 fy0 xc0 fx0] [#] hs_hy0 hs_hx0 mi_yayc0. +exists yc0 fy0 xc0 fx0; rewrite !getP; do !split=> [/#|/#|]. +move: yahy0_neq_yahy; case: (ya0 = ya)=> [<<*> //=|/#]; case: (yc0 = yc)=> [<*>> /=|//=]. +by move: hs_hy0; rewrite yc_notin_rng1_hs. qed. -lemma incl_set (m m' : ('a,'b) fmap) x y: - incl m m' => - incl m.[x <- y] m'.[x <- y]. -proof. smt (in_dom getP). qed. +(** Inversion **) +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 !getP; split. ++ case: (x' = x)=> /= [[#] <*> //=|_ /Hinv ^ + ->]. + by move: mi_y; case: (y' = y)=> [[#] <*> ->|]. +case: (y' = y)=> /= [[#] <*> //=|_ /Hinv ^ + ->]. +by move: m_x; case: (x' = x)=> [[#] <*> ->|]. +qed. -lemma hinv_notin_rng m y2: - SLCommon.hinv m y2 = None => - (forall h f, m.[h] <> Some (y2,f)). -proof. by move=> hinv_none; have:= hinvP m y2; rewrite hinv_none. qed. +(** Map Inclusion **) +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 !getP; case: (x' = x)=> [|_ /m_leq_m']. qed. -lemma handles_spec_notin_dom m h: - handles_spec m h => - !mem (dom m) h. -proof. case; smt (in_dom). qed. +(* lemma hinv_notin_rng m y2: *) +(* SLCommon.hinv m y2 = None => *) +(* (forall h f, m.[h] <> Some (y2,f)). *) +(* proof. by move=> hinv_none; have:= hinvP m y2; rewrite hinv_none. qed. *) -lemma neq_Known f: f <> Known <=> f = Unknown. -proof. by case f. qed. +(* lemma handles_spec_notin_dom m h: *) +(* handles_spec m h => *) +(* !mem (dom m) h. *) +(* proof. case; smt (in_dom). qed. *) -lemma neq_Unkwown f: f <> Unknown <=> f = Known. -proof. by case f. qed. +(* lemma neq_Known f: f <> Known <=> f = Unknown. *) +(* proof. by case f. qed. *) + +(* lemma neq_Unkwown f: f <> Unknown <=> f = Known. *) +(* proof. by case f. qed. *) op getflag (hs : handles) xc = omap snd (obind ("_.[_]" hs) (hinv hs xc)). lemma getflagP_none hs xc: - (getflag hs xc = None <=> forall f, !mem (rng hs) (xc,f)). -proof. -rewrite /getflag; case: (hinvP hs xc)=> [->|] //=. -+ smt (in_rng). -smt (in_rng). -qed. + (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 <=> mem (rng hs) (xc,f)). + huniq hs + => (getflag hs xc = Some f <=> mem (rng hs) (xc,f)). proof. move=> huniq_hs; split. + rewrite /getflag; case: (hinvP hs xc)=> [-> //|]. @@ -702,278 +788,220 @@ move=> /(huniq_hs _ h _ (xc,f)) /(_ hs_h) /= ->>. by rewrite hs_h. qed. -lemma paths_prefix handles m2 mh ro paths c b p v: - mh_spec handles m2 mh ro => - paths_spec handles mh paths => - paths.[c] = Some (rcons p b,v) => - (exists c' v', paths.[c'] = Some (p,v')). -proof. -move=> [] mh_some _ [] hpaths ^paths_c. -move=> /hpaths [h] [#] /build_hpathP [/#|] p' b' v' h' [#] ^/rconsIs + /rconssI- <*>. -move=> hpath + handles_h - /mh_some /= [c' c0 f' f]; rewrite handles_h /= => /> handles_h' _. -by exists c' v'; rewrite hpaths; exists h'. -qed. +(* lemma paths_prefix handles m2 mh ro paths c b p v: *) +(* mh_spec handles m2 mh ro => *) +(* paths_spec handles mh paths => *) +(* paths.[c] = Some (rcons p b,v) => *) +(* (exists c' v', paths.[c'] = Some (p,v')). *) +(* proof. *) +(* move=> [] mh_some _ [] hpaths ^paths_c. *) +(* move=> /hpaths [h] [#] /build_hpathP [/#|] p' b' v' h' [#] ^/rconsIs + /rconssI- <*>. *) +(* move=> hpath + handles_h - /mh_some /= [c' c0 f' f]; rewrite handles_h /= => /> handles_h' _. *) +(* by exists c' v'; rewrite hpaths; exists h'. *) +(* qed. *) 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)). + 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]. + by move=> ^/rconsIs <<- {b'} /rconssI <<- {p'}; exists v' h'. exact/(Extend _ _ _ _ _ Hhpath Hmh). qed. -lemma iter_step_path_from_None mh p: foldl (step_hpath mh) None p = None. +lemma foldl_step_hpath_None mh p: foldl (step_hpath mh) None p = None. proof. by elim: p. qed. -lemma build_hpath_up mh xc xh yc yh p b h: - !mem (dom mh) (xc,xh) => - build_hpath mh p = Some (b,h) => - build_hpath mh.[(xc,xh) <- (yc,yh)] p = Some (b,h). +(** This proof is not understood **) +lemma build_hpath_up mh xa hx ya hy p b h: + build_hpath mh p = Some (b,h) + => mh.[(xa,hx)] = None + => build_hpath mh.[(xa,hx) <- (ya,hy)] p = Some (b,h). proof. -move=> xch_notin_mh @/build_hpath. +move=> + mh_xahx - @/build_hpath. have: (exists p' v h, build_hpath mh p' = Some (v +^ b0,h)). + by exists [] b0 0; rewrite build_hpathP Block.xorw0; exact/Empty. pose root:= b0; elim: p root 0=> //= b1 p ih bn hn. rewrite /(step_hpath _ (Some _)) /= oget_some /= /(step_hpath _ (Some _)) /= oget_some /= getP. -case: (mem (dom mh) (bn +^ b1,hn))=> [bnb1hn_in_mh extend_path|]. -+ have -> /= : (bn +^ b1,hn) <> (xc,xh). - + apply/contraT=> /(congr1 (mem (dom mh)) (bn +^ b1,hn) (xc,xh)). - by rewrite xch_notin_mh bnb1hn_in_mh. - case: {-1}(mh.[(bn +^ b1,hn)]) (eq_refl (mh.[(bn +^ b1,hn)]))=> //=. - + smt. (* figure out *) - move=> [] b2 h2 mh_bnb1hn. - apply/(@ih b2 h2). - case: extend_path=> p' v hp' build_path. - by exists p' (v +^ bn +^ b2) hp'; rewrite build_path //= #ring. -by rewrite in_dom /= => mh_bnb1hn _; rewrite mh_bnb1hn iter_step_path_from_None. +case: {-1}(mh.[(bn +^ b1,hn)]) (eq_refl mh.[(bn +^ b1,hn)])=> [|[xc' hx'] mh_bnb1hn]; last first. ++ have -> /= : (bn +^ b1,hn) <> (xa,hx). + + apply/contraT=> /(congr1 (fun ch=> mh.[ch]) (bn +^ b1,hn) (xa,hx)). + by rewrite mh_xahx mh_bnb1hn. + smt. (* figure out *) +by rewrite foldl_step_hpath_None. qed. -lemma build_hpath_down mh xc xh yc yh p v h: - xh <> 0 - => (forall c' h' xc', mh.[(c',h')] <> Some (xc',xh)) - => build_hpath mh.[(xc,xh) <- (yc,yh)] p = Some (v,h) +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=> xh_neq_0 xh_notin_rng2_mh. +move=> no_path_to_hx. elim/last_ind: p v h=> [v h /build_hpathP [<*>|/#] //=|p b ih]. move=> v h /build_hpathP [/#|p' b' + + ^/rconsIs <<- /rconssI <<-]. move=> v' h' /ih; rewrite getP. -case: ((v' +^ b,h') = (xc,xh))=> [[#] <*> + [#] <*>|_ Hpath Hmh]. -+ by move=> /build_hpathP [/#|] /#. -exact/build_hpathP/(Extend _ _ _ _ _ Hpath Hmh). +case: ((v' +^ b,h') = (xa,hx))=> [/#|_ Hpath Hextend]. +exact/build_hpathP/(Extend _ _ _ _ _ Hpath Hextend). qed. -lemma INV_CF_G1_notin_PFm_notin_G1m hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x: - INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi => - PFm.[x] = None => - G1m.[x] = None. -proof. by move=> /incl_of_INV G1m_le_PFm; apply/contraLR=> ^h; rewrite G1m_le_PFm. qed. - -lemma INV_CF_G1_0 hs PFm PFmi G1m G1mi G1mh G1mhi ro pi: - !INV_CF_G1 hs 0 PFm PFmi G1m G1mi G1mh G1mhi ro pi. -proof. -rewrite -negP=> -[] _ _ _ _ _ _ [] _ + /(_ 0) /=. -by rewrite in_dom=> ->. -qed. - -(** Clean this up and tidy intermediate results, more particularly - anything that is derived from individual components of INV_CF_G1 **) -lemma lemma1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro (pi : (capacity,block list * block) fmap) x1 x2 y1 y2: - x2 <> y2 => - PFm.[(x1,x2)] = None => - G1m.[(x1,x2)] = None => - pi.[x2] = None => - (forall f, !mem (rng hs) (x2,f)) => - (forall f, !mem (rng hs) (y2,f)) => - INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi => - INV_CF_G1 hs.[ch <- (x2,Known)].[ch + 1 <- (y2,Known)] (ch + 2) - PFm.[(x1,x2) <- (y1,y2)] PFmi.[(y1,y2) <- (x1,x2)] - G1m.[(x1,x2) <- (y1,y2)] G1mi.[(y1,y2) <- (x1,x2)] - G1mh.[(x1,ch) <- (y1,ch + 1)] G1mhi.[(y1,ch + 1) <- (x1,ch)] - ro pi. +lemma lemma1 hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi + => x2 <> y2 + => Pm.[(x1,x2)] = None + => Gm.[(x1,x2)] = None + => pi.[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. proof. -move=> x2_neq_y2 PFm_x G1m_x pi_x2 x2_notin_hs y2_notin_hs Hinv; split. -+ apply/(@eqm_handles_up hs.[ch <- (x2,Known)] PFm G1mh (ch + 1) ch (x1,x2) (y1,y2) Known). - + move=> @/huniq h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. - case: (h1 = ch); case: (h2 = ch)=> //=. - + move=> + + [#] - + <*>. - by move: (x2_notin_hs f2); rewrite in_rng negb_exists /= => ->. - + move=> <*> + + [#] <*>. - by move: (x2_notin_hs f1); rewrite in_rng negb_exists /= => ->. - case: Hinv=> _ _ _ _ _ _ [] + _ _ _ _ - h. - exact/(@h h1 h2 (c1,f1) (c2,f2)). - + by rewrite getP; case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). +move=> HINV x2_neq_y2 Pm_x Gm_x pi_x2 x2_notin_rng1_hs y2_notin_rng1_hs; split. ++ rewrite (@addzA ch 1 1); apply/hs_addh. + + by move: HINV=> /hs_of_INV/hs_addh=> ->. + by move=> f h; rewrite getP; case: (h = ch)=> [/#|_]; exact/y2_notin_rng1_hs. +(* + apply/inv_addm; 1:by case: HINV. *) +(* + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. *) +(* by apply/(ch_notin_dom2_mh _ _ Hm_mh Hhs). *) +(* have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. *) +(* by apply/(Sch_notin_dom2_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 getP. - by apply/eqm_up_handles; case: Hinv. -+ apply/(@eqmi_handles_up hs.[ch <- (x2,Known)] PFmi G1mhi (ch + 1) ch (x1,x2) (y1,y2) Known). - + rewrite negb_exists /= => f; rewrite in_rng negb_exists /= => h. - rewrite getP; case: (h = ch)=> _; first by rewrite /= x2_neq_y2. - by move: (y2_notin_hs f); rewrite in_rng negb_exists /= => ->. - + by rewrite getP; case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). + by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. ++ apply/(@mi_mhi_addh_addmi 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). + + move=> f h; rewrite getP; case: (h = ch)=> [_ //=|_ //=]; first by rewrite x2_neq_y2. + by rewrite y2_notin_rng1_hs. + by rewrite getP. - by apply/eqm_up_handles; case: Hinv. -+ move=> z; rewrite !getP; case: (z = (x1,x2))=> //= _. - by case: Hinv=> _ _ + _ _ _ _ - @/incl /(_ z). -+ move=> z; rewrite !getP; case: (z = (y1,y2))=> //= _. - by case: Hinv=> _ _ _ + - @/incl /(_ z). + by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. ++ by apply/incl_addm; case: HINV. ++ by apply/incl_addm; case: HINV. + split. - + move=> xa xh ya yh; rewrite getP; case: ((xa,xh) = (x1,ch)). - + move=> /= [#] <*> [#] <*>; exists x2 Known y2 Known=> //=. - by rewrite !getP /#. - rewrite /= anda_and negb_and=> h hG1mh. (* This one needs cleaned up in priority. These are things that should be deduced instantly. *) - have := Hinv=>- [] _ _ _ _ [] + _ _ _ - h0. - have [xc xf yc yf] [#] hs_xh hs_yh ite:= h0 _ _ _ _ hG1mh. - have yh_lt_ch: xh < ch by case: Hinv=> _ _ _ _ _ _ [] _ _ -> //; rewrite in_dom hs_xh. - have xh_lt_ch: yh < ch by case: Hinv=> _ _ _ _ _ _ [] _ _ -> //; rewrite in_dom hs_yh. - exists xc xf yc yf. - split; first by smt (getP). - split; first by smt (getP). - split=> /=. - + by move: ite=> <*> /= [#] hG1m -> //=; rewrite getP; case: ((xa,xc) = (x1,x2))=> [<*> /#|]. - move: ite=> + hrw; move: hrw=> -> /= [p v] [#] ro_pv hpath. - exists p v; rewrite ro_pv /=. - apply/build_hpath_up=> //=; case: Hinv=> _ _ _ _ _ _ [] _ _ hh. - rewrite -negP in_dom; case: {-1}(G1mh.[(x1,ch)]) (eq_refl (G1mh.[(x1,ch)]))=> [//=|[xa' xh']]. - move=> /h0 [xc0 xf0 ? ?] [] + _. - by move: (hh ch)=> /=; rewrite in_dom /= => ->. - (* These two are going to be painful: -> are easy. <- rely on the fact that neither x not y had an associated handle, and therefore cannot be involved in a path. This is crucial. Maybe some other permutation of the goals/invariant's conjuncts would help clarify. *) - + move=> p xa b; have:= Hinv=>- [] _ _ _ _ [] _ -> _ _. - apply/exists_iff=> v /=; apply/exists_iff=> xh /=; apply/exists_iff=> yh /=. - have G1mh_x1ch: G1mh.[(x1,ch)] = None. - + have /# : forall x1' xh', G1mh.[(x1,ch)] <> Some (x1',xh'). - move=> x1' xh'; rewrite -negP=> G1mh_xh'. - have [] [] _ ht _ _ _ _ _ _ := Hinv. - move: (ht _ _ _ _ G1mh_xh')=> [xc xf yc yf] [#] + _ _ {ht}. - have [] _ _ _ _ _ _ [] _ _ /(_ ch):= Hinv. - by rewrite in_dom=> /= ->. - have ch_notin_G1mh: forall cx, !mem (rng G1mh) (cx,ch). - + move=> cx; rewrite in_rng negb_exists=> - [b0 h0] /=; rewrite -negP=> G1mh_cxch. - by case: Hinv=> - [] _ + _ _ _ _ _ [] _ _ + - /(_ _ _ _ _ G1mh_cxch) [xc xf yc yf] [#] _ hs_ch _ /(_ ch) /=; rewrite in_dom hs_ch. - split=> -[#]. - + move=> hpath hG1mh. - rewrite getP; case: ((v +^ xa,xh) = (x1,ch))=> [/#|_]. - rewrite hG1mh //=. - by apply/build_hpath_up=> //=; rewrite in_dom G1mh_x1ch. - (* The following case should be built into the lemma (build_hpath_down) *) - rewrite getP; case: ((v +^ xa,xh) = (x1,ch))=> [[#] <*> + [#] <*>|]. - + have ht /ht {ht} /= := (build_hpath_down G1mh (v +^ xa) ch b (ch + 1) p v ch _ _). - + by case: Hinv=> _ _ _ _ _ _ [] _ + +; smt (in_dom). - + move=> c' h' xc'; move: (ch_notin_G1mh xc'). - by rewrite in_rng negb_exists /= => ->. - move=> /build_hpathP [<*>|p' b' v' h' <*>]; first by rewrite INV_CF_G1_0 in Hinv; smt (). - by move: (ch_notin_G1mh v); rewrite in_rng negb_exists /= => ->. - move=> _. - have ht /ht {ht} /= -> //= := build_hpath_down G1mh x1 ch y1 (ch + 1) p v xh _ _. - + by case: Hinv=> _ _ _ _ _ _ [] _ + +; smt (in_dom). - by move=> c' h' xc'; move: (ch_notin_G1mh xc'); rewrite in_rng negb_exists /= => ->. -+ split=> c p v; have [] _ _ _ _ _ [] -> _ := Hinv. + + move=> xa hx ya hy; rewrite getP; case: ((xa,hx) = (x1,ch))=> [|]. + + by move=> [#] <*> [#] <*>; exists x2 Known y2 Known; rewrite !getP /#. + 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 getP). + case: fy Hite hs_hy=> /= [[p v] [Hro Hpath] hs_hy|[#] Gm_xaxc <*> hs_hy] /=; last first. + + by rewrite getP; case: ((xa,xc) = (x1,x2))=> [/#|]. + exists p v; rewrite Hro /=; apply/build_hpath_up=> //. + have /m_mh_of_INV /notin_hs_notin_dom2_mh H:= HINV. + exact/H/ch_notin_dom_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_notin_dom2_mh hs Pm)/ch_notin_dom_hs; case: HINV. + have ch_notin_rng2_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_notin_dom_hs; case: HINV. + split=> -[#]. + + move=> Hpath mh_vxahx; rewrite getP; 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_notin_rng2_mh. + move=> ^ /build_hpathP + -> /=; rewrite getP. + by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. ++ split=> c p v; have ^/hs_of_INV [] _ _ dom_hs /pi_of_INV [] -> := HINV. apply/exists_iff=> h /=; split=> [#]. - have ht /ht {ht} -> /= := build_hpath_up G1mh x1 ch y1 (ch +1) p v h _. - + rewrite in_dom /=; case: {-1}(G1mh.[(x1,ch)]) (eq_refl (G1mh.[(x1,ch)]))=> [|[x1' xh'] G1mh_x1'xh'] //=. - case: Hinv=> - [] _ /(_ _ _ _ _ G1mh_x1'xh') [xc xf ct ft] [#] hs_ch _ _ _ _ _ _ _ [] _ _ /(_ ch) /=. - by rewrite in_dom hs_ch. - move=> hs_h; rewrite !getP hs_h. - have /#: h < ch. - by case: Hinv=> _ _ _ _ _ _ [] _ _ /(_ h); rewrite in_dom hs_h. - have ch_notin_G1mh: forall cx, !mem (rng G1mh) (cx,ch). - + move=> cx; rewrite in_rng negb_exists=> - [b0 h0] /=; rewrite -negP=> G1mh_cxch. - by case: Hinv=> - [] _ + _ _ _ _ _ [] _ _ + - /(_ _ _ _ _ G1mh_cxch) [xc xf yc yf] [#] _ hs_ch _ /(_ ch) /=; rewrite in_dom hs_ch. - have Sch_notin_G1mh: forall cx, !mem (rng G1mh) (cx,ch + 1). - + move=> cx; rewrite in_rng negb_exists=> - [b0 h0] /=; rewrite -negP=> G1mh_cxch. - by case: Hinv=> - [] _ + _ _ _ _ _ [] _ _ + - /(_ _ _ _ _ G1mh_cxch) [xc xf yc yf] [#] _ hs_ch _ /(_ (ch + 1)) /=; rewrite in_dom hs_ch /#. - have ht /ht {ht} /= := build_hpath_down G1mh x1 ch y1 (ch + 1) p v h _ _. - + by case: Hinv=> _ _ _ _ _ _ [] _ + +; smt (in_dom). - + by move=> c' h' xc'; move: (ch_notin_G1mh xc'); rewrite in_rng negb_exists /= => ->. - move=> Hpath; rewrite Hpath /=. - have: h <> ch /\ h <> ch + 1; last by smt (getP). - case: (h = 0)=> [<*>|]. - + by case: Hinv=> _ _ _ _ _ _ [] _ + /(_ 0) //=; rewrite in_dom=> /#. - move=> h_neq_0; move: Hpath=> /build_hpathP [<*> /#|p' b' v' h' <*> _]. - move: (ch_notin_G1mh v); rewrite in_rng negb_exists /= => /(_ (v' +^ b',h')). - move: (Sch_notin_G1mh v); rewrite in_rng negb_exists /= => /(_ (v' +^ b',h')). - smt (). -have ->: ch + 2 = ch + 1 + 1 by rewrite -addzA. -apply/(@handles_up_handles hs.[ch <- (x2,Known)] (ch + 1) y2 Known). -+ move=> f; rewrite in_rng negb_exists /= => h; rewrite !getP. - case: (h = ch)=> [<*> /=|_]; first by rewrite x2_neq_y2. - by move: (y2_notin_hs f); rewrite in_rng negb_exists /= => ->. -by apply/handles_up_handles=> //=; case: Hinv. + + move=> /(build_hpath_up mh x1 ch y1 (ch + 1) p v h) /(_ _). + + by apply/(notin_hs_notin_dom2_mh hs Pm)/ch_notin_dom_hs; case: HINV. + by move=> -> /= ^ /dom_hs; rewrite !getP /#. + have ch_notin_rng2_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_notin_dom_hs; case: HINV. + have Sch_notin_rng2_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_notin_dom_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_notin_rng2_mh. + move=> ^ /build_hpathP + -> /=; rewrite !getP. + by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. qed. lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x1 x2 y1 y2 hx: - INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi => - PFm.[(x1,x2)] = None => - G1m.[(x1,x2)] = None => - pi.[x2] = None => - hs.[hx] = Some (x2,Known) => - hinv hs y2 = None => - 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. + INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi + => 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. proof. -move=> Hinv x1x2_notin_PFm x1x2_notin_G1m x2_notin_pi hs_hx y2_notinrng_hs. +move=> HINV PFm_x1x2 G1m_x1x2 pi_x2 hs_hx y2_notin_rng1_hs. split. -+ apply/(@eqm_handles_up _ _ _ _ _ (x1,x2) (y1,y2) Known). - + by case: Hinv=> _ _ _ _ _ _ []. - + by case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). - + by rewrite hs_hx. - + by case: Hinv. -+ apply/(@eqmi_handles_up _ _ _ _ _ (x1,x2) (y1,y2) Known). - + move: y2_notinrng_hs=> /hinv_notin_rng y2_notinrng_hs. - rewrite negb_exists /= => f; rewrite in_rng negb_exists /= => h. - by rewrite y2_notinrng_hs. - + by case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). - + by rewrite hs_hx. - + by case: Hinv. -+ move=> [xa xc]; rewrite !getP; case: ((xa,xc) = (x1,x2))=> //= _ h. - by case: Hinv=> _ _ ->. -+ move=> [xa xc]; rewrite !getP; case: ((xa,xc) = (y1,y2))=> //= _ h. - by case: Hinv=> _ _ _ ->. ++ by apply/hs_addh=> //=; case: HINV. +(* + 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_notin_dom2_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 Hhuniq hs_hx _) //. + exact/ch_notin_dom_hs. ++ have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /mi_mhi_of_INV := HINV. + move=> /mi_mhi_addh_addmi /(_ hx x1 x2 ch y1 y2 Known _ hs_hx _) //. + exact/ch_notin_dom_hs. ++ by have /incl_of_INV/incl_addm ->:= HINV. ++ by have /incli_of_INV/incl_addm ->:= HINV. + split. - + move=> xa xh ya yh; rewrite getP; case: ((xa,xh) = (x1,hx))=> [[#] <*>> [#] <<*> /=|]. - + exists x2 Known y2 Known=> //=; rewrite !getP hs_hx /=. - by case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). - move=> xaxh_neq_x1hx mh_xaxh. - have [] _ _ _ _ [] + _ _ _ - /(_ _ _ _ _ mh_xaxh):= Hinv. - move=> [xc xf yc] [] /= - [#] hs_xh hs_yh h. - + exists xc xf yc Unknown=> /=; rewrite !getP hs_xh hs_yh. - split; first by case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). - split; first by case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). - elim: h=> p v [#] Hro Hpath; exists p v; rewrite Hro /=. - apply/build_hpath_up=> //=. - rewrite in_dom -negP; case: {-1}(G1mh.[(x1,hx)]) (eq_refl G1mh.[(x1,hx)])=> [//=|[x' hx'] mh_x1hx]. - have [] [] _ /(_ _ _ _ _ mh_x1hx) + _ _ _ _ _ _:= Hinv. - by move=> [xc0 xf0 yc0 yf0] [#] <<*>; rewrite hs_hx => [#] <<*>; rewrite x1x2_notin_PFm. - move=> ->> {xf} /=; exists xc Known yc Known=> //=. - rewrite !getP. - have -> //=: (xa,xc) <> (x1,x2). - + move: xaxh_neq_x1hx; apply/contra=> [#] <*>> /=. - by case: Hinv=> _ _ _ _ _ _ [] /(_ xh hx _ _ hs_xh hs_hx). - by rewrite h; case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). - move=> p xa b; have [] _ _ _ _ [] _ -> _ _ := Hinv. - apply/exists_iff=> v /=; apply/exists_iff=> xh /=; apply/exists_iff=> yh /=. - split=> -[#]. - + move=> hpath hG1mh; rewrite getP; case: ((v +^ xa,xh) = (x1,hx))=> [[#] <<*>|_]. - + have [] [] _ + _ _ _ _ _ _ -/(_ _ _ _ _ hG1mh):= Hinv. - by move=> [xc xf yc yf] [#]; rewrite hs_hx /= => [#] <<*>; rewrite x1x2_notin_PFm. - rewrite hG1mh //=. - apply/build_hpath_up=> //=; rewrite in_dom. - case: {-1}(G1mh.[(x1,hx)]) (eq_refl G1mh.[(x1,hx)])=> [//|[xa' xc'] G1mh_xaxc']. - have [] [] _ /(_ _ _ _ _ G1mh_xaxc') + _ _ _ _ _ _:= Hinv. - by move=> [xc xf yc yf] [#]; rewrite hs_hx=> [#] <<*>; rewrite x1x2_notin_PFm. - rewrite getP; case: ((v +^ xa,xh) = (x1,hx))=> [[#] <*> + [#] <*>|]. - + move=> /build_hpathP [<*> /=|]. - + have [] _ _ _ _ _ _ [] _ + _:= Hinv. - rewrite hs_hx => /= [#] <*>. - have [] _ _ _ _ _ [] /(_ c0 [] b0) /iffRL + _ := Hinv. - move=> /(_ _); 1:by exists 0=> /#. - by rewrite x2_notin_pi. - move=> p' b' v' h' ->> Hpath Hextend; split. - + apply/build_hpathP/(@Extend G1mh (rcons p' b') v hx p' b' v' h')=> //. -admitted. + + move=> xa' hx' ya' hy'; rewrite getP; case: ((xa',hx') = (x1,hx))=> [[#] <*>> [#] <<*> /=|]. + + exists x2 Known y2 Known=> //=; rewrite !getP /=. + 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 !getP 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 !getP; 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 getP; 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 getP. case: ((v +^ xa,hi) = (x1,hx))=> [[#] <*>|_ Hpath Hextend]. + + by rewrite no_path_to_hx. + by exists v hi hf. ++ 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 getP. + 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 getP; 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. +qed. clone export ConcreteF as ConcreteF1. @@ -1028,11 +1056,10 @@ section AUX. (eq_refl (INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0)); 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=> x1x2_notin_PFm. - move: (INV_CF_G1_notin_PFm_notin_G1m _ _ _ _ _ _ _ _ _ _ _ inv0 x1x2_notin_PFm). - move=> x1x2_notin_G1m. - rcondt{1} 1; 1:by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom x1x2_notin_PFm. - rcondt{2} 1; 1:by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom x1x2_notin_G1m. + + 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 in_dom PFm_x1x2. + rcondt{2} 1; 1:by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom Gm_x1x2. case @[ambient]: {-1}(pi0.[x2]) (eq_refl (pi0.[x2])). + move=> x2_in_pi; rcondf{2} 1. + by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom x2_in_pi. @@ -1056,34 +1083,32 @@ section AUX. + by auto. case @[ambient]: {-1}(getflag hs0 x2) (eq_refl (getflag hs0 x2)). + rewrite getflagP_none => x2f_notin_rng_hs0; rcondt{2} 3. - + by move=> &1; auto=> &2 />; rewrite x2f_notin_rng_hs0. + + move=> &1; auto=> &2 /> _ _ _; rewrite in_rng negb_exists /=. + exact/(@x2f_notin_rng_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 !getP; case: (hx = G1.chandle{2}); case: (hy = G1.chandle{2})=> //=. - + move=> _ + [#] - <*>. - by have:= (x2f_notin_rng_hs0 yf); rewrite in_rng negb_exists /= => ->. - + move=> + _ + [#] - <*>. - by have:= (x2f_notin_rng_hs0 xf); rewrite in_rng negb_exists /= => ->. - by move=> _ _; case: inv0=> _ _ _ _ _ _ [] + _ _ - /(_ hx hy (xc,xf) (yc,yf)). + + by move=> _ + [#] - <*>; have:= (x2f_notin_rng_hs0 yf hy). + + by move=> + _ + [#] - <*>; have:= (x2f_notin_rng_hs0 xf hx). + by move=> _ _; have /hs_of_INV [] + _ _ - /(_ hx hy (xc,xf) (yc,yf)) := inv0. by rewrite !getP. rewrite oget_some=> _ _ _. have -> //: !mem (dom G1.mh{2}) (x1,G1.chandle{2}). rewrite in_dom /=; case: {-1}(G1.mh.[(x1,G1.chandle)]{2}) (eq_refl (G1.mh.[(x1,G1.chandle)]{2}))=> //= -[xa xh]; rewrite -negP. - case: inv0=> - [] _ + _ _ _ _ _ [] _ _ h_handles. - move=> /(_ x1 G1.chandle{2} xa xh) h /h [] xc xf yc yf. - by have ->: FRO.m.[G1.chandle]{2} = None by smt (in_dom). - case: (x2 <> y2{2} /\ (forall f, !mem (rng hs0) (y2{2},f))). + 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 [#] !<<- -> -> !->> {&1} /= _ x2_neq_y2 y2_notin_hs _ _. rewrite getP /= oget_some /= -addzA /=. rewrite (@huniq_hinvK_h ch0 hs0.[ch0 <- (x2,Known)] x2); 2:by rewrite getP. + move=> @/huniq h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. case: (h1 = ch0); case: (h2 = ch0)=> //=. - + by move=> _ + [#] - <*>; move: (x2f_notin_rng_hs0 f2); rewrite in_rng negb_exists=> /= ->. - + by move=> + _ + [#] <*> - <*>; move: (x2f_notin_rng_hs0 f1); rewrite in_rng negb_exists=> /= ->. - move=> _ _; case: inv0=> _ _ _ _ _ _ [] + _ _ - h. + + by move=> _ + [#] - <*>; move: (x2f_notin_rng_hs0 f2 h2). + + by move=> + _ + [#] <*> - <*>; move: (x2f_notin_rng_hs0 f1 h1). + have /hs_of_INV [] + _ _ _ _ - h := inv0. by apply/h; rewrite getP. by rewrite oget_some; exact/lemma1. conseq (_: _ ==> G1.bcol{2})=> //=. @@ -1091,10 +1116,9 @@ section AUX. case: (hinvP hs0.[ch0 <- (x2,Known)] y2{1})=> //= -> /=. move=> hs0_spec; split=> [|f]. + by have:= hs0_spec ch0 Known; rewrite getP. - rewrite in_rng negb_exists /= => h. - have:= hs0_spec h f; rewrite getP; case: (h = ch0)=> [<*>|//=]. - by have -> //=: hs0.[ch0] = None; case: inv0=> _ _ _ _ _ _ [] _ _; smt (in_dom). - case; rewrite getflagP_some; 1,3:by case: inv0=> _ _ _ _ _ _ []. + move=> h; have:= hs0_spec h f; rewrite getP; 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. + by move=> x2_is_U; conseq (_: G1.bext{2})=> //=; auto=> &1 &2 />; rewrite x2_is_U. move=> x2_is_K; rcondf{2} 3; 1:by move=> &1; auto. have:= x2_is_K; rewrite in_rng=> - [hx] hs0_hx. @@ -1118,22 +1142,22 @@ section AUX. + auto=> &1 &2 /> _ -> /= _; split. + move: x2_is_K; rewrite in_rng /= => -[hx2] hs_hx2. rewrite in_rng negb_exists /==> h; rewrite -negP=> hs_h. - case: inv0=> _ _ _ _ _ _ [] Hhuniq _ _. + 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 FRO.m{2} x2) //. - by case: inv0=> _ _ _ _ _ _ []. + by have /hs_of_INV [] := inv0. have x1hx_notin_G1m: !mem (dom G1mh) (x1,hx). + rewrite in_dom; case: {-1}(G1mh.[(x1,hx)]) (eq_refl G1mh.[(x1,hx)])=> //=. move=> [mhx1 mhx2]; rewrite -negP=> h. - have:= inv0=> -[] [] _ hg _ _ _ _ _ _. + have /m_mh_of_INV [] _ hg := inv0. have [xa xh ya yh] := hg _ _ _ _ h. - by rewrite hs0_hx=> [#] <*>; rewrite x1x2_notin_PFm. + by rewrite hs0_hx=> [#] <*>; rewrite PFm_x1x2. rcondf{2} 1. + by move=> &m; auto=> //= &hr [#] <*>; rewrite x1hx_notin_G1m. auto=> &1 &2 [#] !<<- -> -> !->> _ /= hinv_y2_none. - rewrite getP /= oget_some /=. - exact/lemma2. - move=> [p0 v0] ^ pi_x2. have [] _ _ _ _ _ [] -> _ [hx2] [#] Hpath hs_hx2:= inv0. + rewrite getP /= oget_some /=; apply/lemma2=> //. + + by case: (hinvP hs0 y2{2})=> [_ + f h|//=] - ->. + move=> [p0 v0] ^ pi_x2. have /pi_of_INV [] -> [hx2] [#] Hpath hs_hx2:= inv0. rcondt{2} 1. by move=> &m; auto=> &hr [#] !<<- _ _ ->> /= _; rewrite in_dom pi_x2. rcondf{2} 6. + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. @@ -1141,10 +1165,10 @@ section AUX. rcondf{2} 7. + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. rewrite negb_and; left; rewrite (@huniq_hinvK_h hx2 hs0 x2) // 2:oget_some. - + by case: inv0=> _ _ _ _ _ _ []. + + by have /hs_of_INV []:= inv0. rewrite in_dom; case: {-1}(G1mh.[(x1,hx2)]) (eq_refl (G1mh.[(x1,hx2)]))=> [//=|[xa xc] G1mh_x1hx2]. - have [] [] _ /(_ _ _ _ _ G1mh_x1hx2) [xc0 xf0 yc0 yf0] + _ _ _ _ _ _:= inv0. - by move=> [#]; rewrite hs_hx2=> [#] !<<- {xc0 xf0}; rewrite x1x2_notin_PFm. + have /m_mh_of_INV [] _ /(_ _ _ _ _ G1mh_x1hx2) [xc0 xf0 yc0 yf0] := inv0. + by move=> [#]; rewrite hs_hx2=> [#] !<<- {xc0 xf0}; rewrite PFm_x1x2. rcondt{2} 15. + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. by rewrite in_dom pi_x2. @@ -1152,32 +1176,32 @@ section AUX. + auto=> &hr [#] !<<- _ _ !->> _ /= _ _; rewrite pi_x2 oget_some /=. rewrite in_dom; case: {-1}(ro0.[rcons p0 (v0 +^ x1)]) (eq_refl (ro0.[rcons p0 (v0 +^ x1)])). + done. - move=> bo ^ro_pvx1 /=. have [] _ _ _ _ [] _ -> _ _:= inv0. + 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 [] [] _ /(_ _ _ _ _ G1mh_x1hx2) + _ _ _ _ _ _ := inv0. + have /m_mh_of_INV [] _ /(_ _ _ _ _ G1mh_x1hx2) := inv0. move=> [xc xf yc yf] [#]; rewrite hs_hx2=> [#] <*>. - by rewrite x1x2_notin_PFm. + by rewrite PFm_x1x2. auto. admit. (* this is the easy case *) move=> [xa xc] PFm_x1x2. rcondf{1} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom PFm_x1x2. - have [] [] /(_ _ _ _ _ PFm_x1x2) + _ _ _ _ _ _ _ := inv0. + 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 in_dom G1m_x1x2. - auto=> &1 &2 [#] <*> -> -> -> /=; have [] _ _ /(_ (x1,x2)) + _ _ _ _ := inv0. + auto=> &1 &2 [#] <*> -> -> -> /=; have /incl_of_INV /(_ (x1,x2)) := inv0. by rewrite PFm_x1x2 G1m_x1x2 /= => [#] !<<- {ya yc}. move=> x1x2_notin_G1m; rcondt{2} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom x1x2_notin_G1m. have <*>: fy2 = Unknown. - + case: inv0=> _ _ _ _ [] /(_ _ _ _ _ G1mh_x1hx2) + _ _ _. + + have /mh_of_INV [] /(_ _ _ _ _ G1mh_x1hx2) + _ := inv0. move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0}. 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: (G1.bext{2}); last by inline*; if{2}; auto; smt (@Block @Capacity). by auto=> ? ? [#] !<<- _ -> ->> _ /=; rewrite in_rng; exists hx2. - have [] _ _ _ _ [] /(_ _ _ _ _ G1mh_x1hx2) + _ _ _:= inv0. + have /mh_of_INV []/(_ _ _ _ _ G1mh_x1hx2) + _:= inv0. move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0} /= [p0 v0] [#] Hro Hpath. - have [] _ _ _ _ _ [] /(_ x2 p0 v0) /iffRL Hpi _:= inv0. + have /pi_of_INV [] /(_ x2 p0 v0) /iffRL Hpi:= inv0. move: (Hpi _); first by exists hx2. move=> pi_x2; rcondt{2} 1; 1:by auto=> &hr [#] <*>; rewrite in_dom pi_x2. inline F.RO.get. @@ -1186,13 +1210,13 @@ section AUX. rcondt{2} 9. + auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _. rewrite (@huniq_hinvK_h hx2 hs0 x2) // 2:in_dom 2:G1mh_x1hx2 2:!oget_some /=. - + by case: inv0=> _ _ _ _ _ _ []. + + by have /hs_of_INV []:= inv0. by rewrite /in_dom_with in_dom hs_hy2. rcondt{2} 14; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite in_dom pi_x2. auto=> &1 &2 [#] !<<- -> -> ->> _ /=; rewrite Block.DWord.bdistr_ll Capacity.DWord.cdistr_ll /=. move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 !oget_some //=. rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. - + by case: inv0=> _ _ _ _ _ _ []. + + by have /hs_of_INV []:= inv0. rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //=. (* lemma 3 *) admit. (* Stopped here *) From a6d95214eabc11139518e991fc3905ed10f8eacd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 24 Aug 2016 09:55:21 +0100 Subject: [PATCH 202/394] Pushing for discussion with Benjamin. --- sha3/proof/core/Handle.eca | 381 +++++++++++++------------------------ 1 file changed, 134 insertions(+), 247 deletions(-) diff --git a/sha3/proof/core/Handle.eca b/sha3/proof/core/Handle.eca index 01d62d5..afa7766 100644 --- a/sha3/proof/core/Handle.eca +++ b/sha3/proof/core/Handle.eca @@ -74,7 +74,7 @@ module G1(D:DISTINGUISHER) = { m.[x] <- y; mi.[y] <- x; } else { - bcol <- bcol \/ hinv FRO.m y.`2 <> None; + bcol <- bcol \/ hinv FRO.m y.`2 <> None; hy2 <- chandle; chandle <- chandle + 1; FRO.m.[hy2] <- (y.`2, Known); @@ -87,7 +87,6 @@ module G1(D:DISTINGUISHER) = { (p,v) <- oget paths.[x.`2]; paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); } - } else { y <- oget m.[x]; } @@ -153,6 +152,16 @@ module G1(D:DISTINGUISHER) = { }. (* -------------------------------------------------------------------------- *) +(** The state of CF contains only the map PF.m. + 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, @@ -168,156 +177,6 @@ inductive m_mh (hs : handles) (m : smap) (mh : hsmap) = /\ hs.[hy] = Some (yc,fy) /\ m.[(xa,xc)] = Some (ya,yc)). -(* (* Consequences of (xa,xc) \in (dom m) *) *) -(* lemma eqm_handles_m_some (hs : handles) (m : smap) (mh : hsmap) *) -(* xa xc ya yc: *) -(* huniq hs *) -(* => eqm_handles hs m mh *) -(* => 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). *) -(* proof. by move=> hs_huniq [] + _ m_xaxc - /(_ _ _ _ _ m_xaxc). qed. *) - -(* lemma eqm_handles_m_some_xy (hs : handles) (m : smap) (mh : hsmap) *) -(* xa xc ya yc hx fx hy fy: *) -(* huniq hs *) -(* => eqm_handles hs m mh *) -(* => m.[(xa,xc)] = Some (ya,yc) *) -(* => hs.[hx] = Some (xc,fx) *) -(* => hs.[hy] = Some (yc,fy) *) -(* => mh.[(xa,hx)] = Some (ya,hy). *) -(* proof. *) -(* move=> hs_huniq [] + _ m_xaxc hs_hx hs_hy - /(_ _ _ _ _ m_xaxc) [xh xf yh yf] [#]. *) -(* by move=> /(hs_huniq _ _ _ _ hs_hx) /= <<*> /(hs_huniq _ _ _ _ hs_hy) /= <<*>. *) -(* qed. *) - -(* lemma eqm_handles_m_some_x (hs : handles) (m : smap) (mh : hsmap) *) -(* xa xc ya yc hx fx: *) -(* huniq hs *) -(* => eqm_handles hs m mh *) -(* => m.[(xa,xc)] = Some (ya,yc) *) -(* => hs.[hx] = Some (xc,fx) *) -(* => exists hy fy, *) -(* hs.[hy] = Some (yc,fy) *) -(* /\ mh.[(xa,hx)] = Some (ya,hy). *) -(* proof. *) -(* move=> hs_huniq [] + _ m_xaxc hs_hx - /(_ _ _ _ _ m_xaxc) [xh xf yh yf] [#]. *) -(* by move=> /(hs_huniq _ _ _ _ hs_hx) /= <<*> hs_hy mh_xaxc; exists yh yf. *) -(* qed. *) - -(* lemma eqm_handles_m_some_y (hs : handles) (m : smap) (mh : hsmap) *) -(* xa xc ya yc hy fy: *) -(* huniq hs *) -(* => eqm_handles hs m mh *) -(* => m.[(xa,xc)] = Some (ya,yc) *) -(* => hs.[hy] = Some (yc,fy) *) -(* => exists hx fx, *) -(* hs.[hx] = Some (xc,fx) *) -(* /\ mh.[(xa,hx)] = Some (ya,hy). *) -(* proof. *) -(* move=> hs_huniq [] + _ m_xaxc hs_hy - /(_ _ _ _ _ m_xaxc) [xh xf yh yf] [#]. *) -(* by move=> hs_hx /(hs_huniq _ _ _ _ hs_hy) /= <<*> mh_xaxc; exists xh xf. *) -(* qed. *) - -(* (* Consequence of (xa,xc) \notin (dom m) *) *) -(* lemma eqm_handles_m_none_in_mh (hs : handles) (m : smap) (mh : hsmap) *) -(* xa xc ya yc hx: *) -(* eqm_handles hs m mh *) -(* => m.[(xa,xc)] = None *) -(* => mh.[(xa,hx)] = Some (ya,yc) *) -(* => (forall fx, hs.[hx] <> Some (xc,fx)). *) -(* proof. by move=> [] _ Hmh m_xaxc /Hmh [xc0 fx yc0 fy] [#] -> /#. qed. *) - -(* lemma eqm_handles_m_none_in_hs (hs : handles) (m : smap) (mh : hsmap) *) -(* xa xc hx fx: *) -(* eqm_handles hs m mh *) -(* => m.[(xa,xc)] = None *) -(* => hs.[hx] = Some (xc,fx) *) -(* => mh.[(xa,hx)] = None. *) -(* proof. *) -(* move=> [] _ Hmh m_xaxc. *) -(* case: {-1}(mh.[(xa,hx)]) (eq_refl (mh.[(xa,hx)]))=> [//|]. (* TODO: contra *) *) -(* by move=> [ya hy] /Hmh [xc0 fx0 yc fy] [#] /#. *) -(* qed. *) - -(* (* Consequence of (xa,hx) \in (dom mh) *) *) -(* lemma eqm_handles_mh_some (hs : handles) (m : smap) (mh : hsmap) *) -(* xa hx ya hy: *) -(* huniq hs *) -(* => eqm_handles hs m mh *) -(* => 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). *) -(* proof. by move=> hs_huniq [] _ + mh_xaxc - /(_ _ _ _ _ mh_xaxc). qed. *) - -(* lemma eqm_handles_mh_some_xy (hs : handles) (m : smap) (mh : hsmap) *) -(* xa hx ya hy xc fx yc fy: *) -(* huniq hs *) -(* => eqm_handles hs m mh *) -(* => mh.[(xa,hx)] = Some (ya,hy) *) -(* => hs.[hx] = Some (xc,fx) *) -(* => hs.[hy] = Some (yc,fy) *) -(* => m.[(xa,xc)] = Some (ya,yc). *) -(* proof. *) -(* move=> hs_huniq [] _ + mh_xaxc hs_hx hs_hy - /(_ _ _ _ _ mh_xaxc) [xc' xf' yc' yf'] [#]. *) -(* by rewrite hs_hx hs_hy /= => [#] <<*> [#] <<*>. *) -(* qed. *) - -(* lemma eqm_handles_mh_some_x (hs : handles) (m : smap) (mh : hsmap) *) -(* xa hx ya hy xc fx: *) -(* huniq hs *) -(* => eqm_handles hs m mh *) -(* => mh.[(xa,hx)] = Some (ya,hy) *) -(* => hs.[hx] = Some (xc,fx) *) -(* => exists yc fy, *) -(* hs.[hy] = Some (yc,fy) *) -(* /\ m.[(xa,xc)] = Some (ya,yc). *) -(* proof. *) -(* move=> hs_huniq [] _ + mh_xaxc hs_hx - /(_ _ _ _ _ mh_xaxc) [xc' fx' yc fy] [#]. *) -(* by rewrite hs_hx /= => [#] <<*> hs_hy m_xaxc; exists yc fy. *) -(* qed. *) - -(* lemma eqm_handles_mh_some_y (hs : handles) (m : smap) (mh : hsmap) *) -(* xa hx ya hy yc fy: *) -(* huniq hs *) -(* => eqm_handles hs m mh *) -(* => mh.[(xa,hx)] = Some (ya,hy) *) -(* => hs.[hy] = Some (yc,fy) *) -(* => exists xc fx, *) -(* hs.[hx] = Some (xc,fx) *) -(* /\ m.[(xa,xc)] = Some (ya,yc). *) -(* proof. *) -(* move=> hs_huniq [] _ + mh_xaxc hs_hy - /(_ _ _ _ _ mh_xaxc) [xc fx yc' fy'] [#] hs_hx. *) -(* by rewrite hs_hy /= => [#] <<*> m_xaxc; exists xc fx. *) -(* qed. *) - -(* (* Consequences of (xa,hx) \notin (dom mh) *) *) -(* lemma eqm_handles_mh_none_in_m (hs : handles) (m : smap) (mh : hsmap) *) -(* xa xc ya yc hx: *) -(* huniq hs *) -(* => eqm_handles hs m mh *) -(* => mh.[(xa,hx)] = None *) -(* => m.[(xa,xc)] = Some (ya,yc) *) -(* => (forall fx, hs.[hx] <> Some (xc,fx)). *) -(* proof. by move=> hs_huniq [] Hm _ mh_xaxc /Hm [hx0 fx hy0 fy] [#] /#. qed. *) - -(* lemma eqm_handles_mh_none_in_hs (hs : handles) (m : smap) (mh : hsmap) *) -(* xa hx xc fx: *) -(* huniq hs *) -(* => eqm_handles hs m mh *) -(* => mh.[(xa,hx)] = None *) -(* => hs.[hx] = Some (xc,fx) *) -(* => m.[(xa,xc)] = None. *) -(* proof. *) -(* move=> hs_huniq [] Hm _ m_xaxc. *) -(* case: {-1}(m.[(xa,xc)]) (eq_refl (m.[(xa,xc)]))=> [//|]. (* TODO: contra *) *) -(* by move=> [ya hy] /Hm [xc0 fx0 yc fy] [#] /#. *) -(* qed. *) - (* 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, @@ -337,99 +196,7 @@ inductive mh_spec (hs : handles) (Gm : smap) (mh : hsmap) (ro : (block list,bloc build_hpath mh p = Some (v,hx) /\ mh.[(v +^ bn,hx)] = Some (b,hy)). -(* (* Consequences of (xa,hx) \in (dom mh) *) *) -(* lemma mh_spec_mh_some (hs : handles) (Gm : smap) (mh : hsmap) ro *) -(* xa hx ya hy: *) -(* mh_spec hs Gm mh ro *) -(* => 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). *) -(* proof. by move=> [] + _ mh_xaxc - /(_ _ _ _ _ mh_xaxc). qed. *) - -(* lemma mh_spec_mh_some_y (hs : handles) (Gm : smap) (mh : hsmap) ro *) -(* xa hx ya hy yc fy: *) -(* mh_spec hs Gm mh ro *) -(* => mh.[(xa,hx)] = Some (ya,hy) *) -(* => hs.[hy] = Some (yc,fy) *) -(* => exists xc fx, *) -(* hs.[hx] = Some (xc,fx) *) -(* /\ 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). *) -(* proof. *) -(* move=> Hmh /(mh_spec_mh_some _ _ _ _ _ _ _ _ Hmh) [xc fx yc0 fy0] [#] -> ->. *) -(* by move=> + [#] <<*> - H; exists xc fx. *) -(* qed. *) - -(* lemma mh_spec_mh_some_yK (hs : handles) (Gm : smap) (mh : hsmap) ro *) -(* xa hx ya hy yc: *) -(* mh_spec hs Gm mh ro *) -(* => mh.[(xa,hx)] = Some (ya,hy) *) -(* => hs.[hy] = Some (yc,Known) *) -(* => exists xc, *) -(* hs.[hx] = Some (xc,Known) *) -(* /\ Gm.[(xa,xc)] = Some (ya,yc). *) -(* proof. *) -(* move=> Hmh mh_xaxc /(mh_spec_mh_some_y _ _ _ _ _ _ _ _ _ _ Hmh mh_xaxc) [xc fx] [#] /=. *) -(* by move=> hs_hx Gm_xaxc <*>; exists xc. *) -(* qed. *) - -(* lemma mh_spec_mh_some_yU (hs : handles) (Gm : smap) (mh : hsmap) ro *) -(* xa hx ya hy yc: *) -(* mh_spec hs Gm mh ro *) -(* => mh.[(xa,hx)] = Some (ya,hy) *) -(* => hs.[hy] = Some (yc,Unknown) *) -(* => exists xc fx p v, *) -(* hs.[hx] = Some (xc,fx) *) -(* /\ ro.[rcons p (v +^ xa)] = Some ya *) -(* /\ build_hpath mh p = Some (v,hx). *) -(* proof. *) -(* move=> Hmh mh_xaxc /(mh_spec_mh_some_y _ _ _ _ _ _ _ _ _ _ Hmh mh_xaxc) [xc fx] [#] /=. *) -(* by move=> hs_hx [p v] H; exists xc fx p v. *) -(* qed. *) - -(* lemma mh_spec_mh_some_x (hs : handles) (Gm : smap) (mh : hsmap) ro *) -(* xa hx ya hy xc fx: *) -(* mh_spec hs Gm mh ro *) -(* => mh.[(xa,hx)] = Some (ya,hy) *) -(* => hs.[hx] = Some (xc,fx) *) -(* => exists yc fy, *) -(* 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). *) -(* proof. *) -(* move=> Hmh /(mh_spec_mh_some _ _ _ _ _ _ _ _ Hmh) [xc0 fx0 yc fy] [#] -> ->. *) -(* by move=> + [#] <<*> - H; exists yc fy. *) -(* qed. *) - -(* lemma mh_spec_mh_some_xU (hs : handles) (Gm : smap) (mh : hsmap) ro *) -(* xa hx ya hy xc: *) -(* mh_spec hs Gm mh ro *) -(* => mh.[(xa,hx)] = Some (ya,hy) *) -(* => hs.[hx] = Some (xc,Unknown) *) -(* => exists yc p v, *) -(* hs.[hy] = Some (yc,Unknown) *) -(* /\ ro.[rcons p (v +^ xa)] = Some ya *) -(* /\ build_hpath mh p = Some (v,hx). *) -(* proof. *) -(* move=> Hmh mh_xaxc /(mh_spec_mh_some_x _ _ _ _ _ _ _ _ _ _ Hmh mh_xaxc) [yc fy] [#] ->. *) -(* by case: fy=> //= - [p v] H; exists yc p v. *) -(* qed. *) - +(* 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) <=> @@ -437,14 +204,17 @@ inductive pi_spec (hs : handles) (mh : hsmap) (pi : (capacity,block list * block 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 = | HCF_G1 of (hs_spec hs ch) @@ -629,6 +399,19 @@ move=> ^Hhs [] Hhuniq hs_0 dom_hs xc_notin_rng1_hs; split. 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. ++ by move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /= /#. ++ by rewrite getP hx_neq0. +move=> cf h; rewrite getP; case: (h = hx)=> [<*> _|_ /dom_hs //]. +by move: hs_hx=> /dom_hs. +qed. + lemma mh_addh hs ch Gm mh ro xc fx: hs_spec hs ch => mh_spec hs Gm mh ro @@ -1003,6 +786,109 @@ split. by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. qed. +lemma lemma3 hs ch Pm Pmi Gm Gmi mh mhi ro pi xa xc hx ya yc hy p b: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi + => 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)]. +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. ++ split. (* Pull out *) + + move=> xa' xc' ya' yc'; have /m_mh_of_INV [] H _ /H {H}:= HINV. + move=> [hx' fx' hy' fy'] [#] hs_hx' hs_hy' mh_xahx'. + case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|hy'_neq_hy|hx'_neq_hy|Hhx' Hhy']. + + by exists hy Known hy Known; rewrite !getP /= /#. + + by exists hy Known hy' fy'; rewrite !getP hy'_neq_hy /#. + + by exists hx' fx' hy Known; rewrite !getP hx'_neq_hy /#. + by exists hx' fx' hy' fy'; rewrite !getP Hhx' Hhy'. + move=> xa' hx' ya' hy'; have /m_mh_of_INV [] _ H /H {H}:= HINV. + move=> [xc' fx' yc' fy'] [#] hs_hx' hs_hy' m_xaxc'. + case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|hy'_neq_hy|hx'_neq_hy|Hhx' Hhy']. + + by exists yc Known yc Known; rewrite !getP /= /#. + + by exists yc Known yc' fy'; rewrite !getP hy'_neq_hy /#. + + by exists xc' fx' yc Known; rewrite !getP hx'_neq_hy /#. + by exists xc' fx' yc' fy'; rewrite !getP Hhx' Hhy'. ++ split. (* Pull out *) + + move=> xa' xc' ya' yc'; have /mi_mhi_of_INV [] H _ /H {H}:= HINV. + move=> [hx' fx' hy' fy'] [#] hs_hx' hs_hy' mh_xahx'. + case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|hy'_neq_hy|hx'_neq_hy|Hhx' Hhy']. + + by exists hy Known hy Known; rewrite !getP /= /#. + + by exists hy Known hy' fy'; rewrite !getP hy'_neq_hy /#. + + by exists hx' fx' hy Known; rewrite !getP hx'_neq_hy /#. + by exists hx' fx' hy' fy'; rewrite !getP Hhx' Hhy'. + move=> xa' hx' ya' hy'; have /mi_mhi_of_INV [] _ H /H {H}:= HINV. + move=> [xc' fx' yc' fy'] [#] hs_hx' hs_hy' m_xaxc'. + case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|hy'_neq_hy|hx'_neq_hy|Hhx' Hhy']. + + by exists yc Known yc Known; rewrite !getP /= /#. + + by exists yc Known yc' fy'; rewrite !getP hy'_neq_hy /#. + + by exists xc' fx' yc Known; rewrite !getP hx'_neq_hy /#. + by exists xc' fx' yc' fy'; rewrite !getP Hhx' Hhy'. ++ move=> [za zc]; rewrite getP; case: ((za,zc) = (xa,xc))=> // _. + by have /incl_of_INV H /H {H}:= HINV. ++ (* inverse or pre-inverse - probably on mh/mhi *) admit. ++ split; last by have /mh_of_INV [] _:= HINV. + have pi_yc: pi.[yc] = None. + + have /#: forall p b, pi.[yc] <> Some (p,b). + move=> p0 b0; rewrite -negP. + have /pi_of_INV [] -> [h] [#] _ := HINV. + have /hs_of_INV [] Hhuniq _ _^hs_h - /Hhuniq /(_ _ _ hs_hy) := HINV. + by move: hs_h; case: (h = hy)=> [<*>|//=]; rewrite hs_hy. +(* have path_hx: build_hpath mh p = Some (b,hx). + + move: pi_xc; have /pi_of_INV [] -> [h] [#] Hpath := HINV. + by have /hs_of_INV [] Hhuniq _ _ ^hs_h - /Hhuniq /(_ _ _ hs_hx) /= <*>:= HINV. + have ro_pbxa: ro.[rcons p (b +^ xa)] = Some ya. + + have /mh_of_INV [] _ -> := HINV. + by exists b hx hy; rewrite xorwA xorwK xorwC xorw0. + have path_hy: build_hpath mh (rcons p (b +^ xa)) = Some (ya,hy). + + apply/build_hpathP/(@Extend _ _ _ _ p (b +^ xa) b hx)=> //. + by rewrite xorwA xorwK xorwC xorw0. *) + move=> xa' hx' ya' hy'; have /mh_of_INV [] H _ /H {H} [xc' fx' yc' fy'] [#] hs_hx' := HINV. + case: (hy' = hy)=> /= [<*>|]. + + rewrite hs_hy=> /= [#] <*> /= [p' b'] [#] ro_pbxa'. + case: fx' hs_hx'=> hs_hx'. + + case: (hx' = hy)=> /= [<*>|]. + + rewrite hs_hy=> /= [#] <<*>; case: fy'=> //= hs_hy' ?. + exists yc Known yc' Unknown. + + + + + case: ((ya',hy') = (ya,hy))=> [[#] <*>|yahy'_neq_yahy]. + + have /mh_of_INV [] H _ /H {H} [xc' fx' yc0 fy0] [#] hs_hx':= HINV. + rewrite hs_hy=> /= [#] <<*> /= h. + exists xc' fx' yc Known=> /=. + split. admit. + + rewrite getP /=. + have /mh_of_INV [] H _ /H {H} [xc' fx' yc' fy'] [#] hs_hx' hs_hy' Hite:= HINV. + have xaxc'_neq_xaxc: ((xa',xc') <> (xa,xc)). + + move: xahx'_neq_xahx=> /=; case: (xa' = xa)=> [<*> /= hx'_neq_hx|/#]. + rewrite -negP=> [#] <<*>; have /hs_of_INV [] Hhuniq _ _:= HINV. + by move: (Hhuniq _ _ _ _ hs_hx' hs_hx). + case: (hx' = hy); case: (hy' = hy)=> <*>. + + move: hs_hx' hs_hy'; rewrite hs_hy=> /= [#] <<*> [#] <<*>. + exists yc Known yc Known=> /=; rewrite !getP xaxc'_neq_xaxc /=. +print mh_spec. + exists xc' fx' yc' fy'; rewrite !getP xaxc'_neq_xaxc /= Hite /=. + +print mh_spec. + +have /mh_of_INV [] H _ /H {H}:= HINV. + move=> [xc' fx' yc' fy'] [#] hs_hx' hs_hy' Hite. + exists xc' fx' yc' fy'; case: fy' hs_hy' Hite=> //= hs_hy'. + + move=> [p' v'] [#] Hro Hpi. +admitted. + clone export ConcreteF as ConcreteF1. section AUX. @@ -1201,8 +1087,8 @@ section AUX. by auto=> ? ? [#] !<<- _ -> ->> _ /=; rewrite in_rng; exists hx2. have /mh_of_INV []/(_ _ _ _ _ G1mh_x1hx2) + _:= inv0. move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0} /= [p0 v0] [#] Hro Hpath. - have /pi_of_INV [] /(_ x2 p0 v0) /iffRL Hpi:= inv0. - move: (Hpi _); first by exists hx2. + have /pi_of_INV [] /(_ x2 p0 v0) /iffRL /(_ _) := inv0. + + by exists hx2. move=> pi_x2; rcondt{2} 1; 1:by auto=> &hr [#] <*>; rewrite in_dom pi_x2. inline F.RO.get. rcondf{2} 4; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite pi_x2 oget_some /= in_dom Hro. @@ -1218,6 +1104,7 @@ section AUX. rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. + by have /hs_of_INV []:= inv0. rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //=. + (* lemma 3 *) admit. (* Stopped here *) + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. From fd319a7a0b1b3cc0cb8749fade65e5648da817a7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 24 Aug 2016 12:01:25 +0100 Subject: [PATCH 203/394] Some progress -- Facts about paths. --- sha3/proof/core/Handle.eca | 75 +++++++++++--------------------------- 1 file changed, 22 insertions(+), 53 deletions(-) diff --git a/sha3/proof/core/Handle.eca b/sha3/proof/core/Handle.eca index afa7766..8b5ed43 100644 --- a/sha3/proof/core/Handle.eca +++ b/sha3/proof/core/Handle.eca @@ -583,6 +583,7 @@ qed. (* by exists c' v'; rewrite hpaths; exists 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)). @@ -592,26 +593,16 @@ rewrite build_hpathP; split=> [[/#|p' b' v' h' [#] + Hhpath Hmh]|[v' h'] [] Hhpa exact/(Extend _ _ _ _ _ Hhpath Hmh). qed. -lemma foldl_step_hpath_None mh p: foldl (step_hpath mh) None p = None. -proof. by elim: p. qed. - -(** This proof is not understood **) -lemma build_hpath_up mh xa hx ya hy p b h: - build_hpath mh p = Some (b,h) +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 (b,h). + => build_hpath mh.[(xa,hx) <- (ya,hy)] p = Some (za,hz). proof. -move=> + mh_xahx - @/build_hpath. -have: (exists p' v h, build_hpath mh p' = Some (v +^ b0,h)). -+ by exists [] b0 0; rewrite build_hpathP Block.xorw0; exact/Empty. -pose root:= b0; elim: p root 0=> //= b1 p ih bn hn. -rewrite /(step_hpath _ (Some _)) /= oget_some /= /(step_hpath _ (Some _)) /= oget_some /= getP. -case: {-1}(mh.[(bn +^ b1,hn)]) (eq_refl mh.[(bn +^ b1,hn)])=> [|[xc' hx'] mh_bnb1hn]; last first. -+ have -> /= : (bn +^ b1,hn) <> (xa,hx). - + apply/contraT=> /(congr1 (fun ch=> mh.[ch]) (bn +^ b1,hn) (xa,hx)). - by rewrite mh_xahx mh_bnb1hn. - smt. (* figure out *) -by rewrite foldl_step_hpath_None. +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 getP /#. qed. lemma build_hpath_down mh xa hx ya hy p v h: @@ -627,6 +618,19 @@ 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. + lemma lemma1 hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2: INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi => x2 <> y2 @@ -853,40 +857,6 @@ split. have path_hy: build_hpath mh (rcons p (b +^ xa)) = Some (ya,hy). + apply/build_hpathP/(@Extend _ _ _ _ p (b +^ xa) b hx)=> //. by rewrite xorwA xorwK xorwC xorw0. *) - move=> xa' hx' ya' hy'; have /mh_of_INV [] H _ /H {H} [xc' fx' yc' fy'] [#] hs_hx' := HINV. - case: (hy' = hy)=> /= [<*>|]. - + rewrite hs_hy=> /= [#] <*> /= [p' b'] [#] ro_pbxa'. - case: fx' hs_hx'=> hs_hx'. - - case: (hx' = hy)=> /= [<*>|]. - + rewrite hs_hy=> /= [#] <<*>; case: fy'=> //= hs_hy' ?. - exists yc Known yc' Unknown. - - - + - case: ((ya',hy') = (ya,hy))=> [[#] <*>|yahy'_neq_yahy]. - + have /mh_of_INV [] H _ /H {H} [xc' fx' yc0 fy0] [#] hs_hx':= HINV. - rewrite hs_hy=> /= [#] <<*> /= h. - exists xc' fx' yc Known=> /=. - split. admit. - + rewrite getP /=. - have /mh_of_INV [] H _ /H {H} [xc' fx' yc' fy'] [#] hs_hx' hs_hy' Hite:= HINV. - have xaxc'_neq_xaxc: ((xa',xc') <> (xa,xc)). - + move: xahx'_neq_xahx=> /=; case: (xa' = xa)=> [<*> /= hx'_neq_hx|/#]. - rewrite -negP=> [#] <<*>; have /hs_of_INV [] Hhuniq _ _:= HINV. - by move: (Hhuniq _ _ _ _ hs_hx' hs_hx). - case: (hx' = hy); case: (hy' = hy)=> <*>. - + move: hs_hx' hs_hy'; rewrite hs_hy=> /= [#] <<*> [#] <<*>. - exists yc Known yc Known=> /=; rewrite !getP xaxc'_neq_xaxc /=. -print mh_spec. - exists xc' fx' yc' fy'; rewrite !getP xaxc'_neq_xaxc /= Hite /=. - -print mh_spec. - -have /mh_of_INV [] H _ /H {H}:= HINV. - move=> [xc' fx' yc' fy'] [#] hs_hx' hs_hy' Hite. - exists xc' fx' yc' fy'; case: fy' hs_hy' Hite=> //= hs_hy'. - + move=> [p' v'] [#] Hro Hpi. admitted. clone export ConcreteF as ConcreteF1. @@ -1104,7 +1074,6 @@ section AUX. rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. + by have /hs_of_INV []:= inv0. rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //=. - (* lemma 3 *) admit. (* Stopped here *) + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. From 32d064ca4f5ce7547c320a44e8a0ef7899bde569 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 24 Aug 2016 12:35:49 +0100 Subject: [PATCH 204/394] Adding the inversion invariant back in. --- sha3/proof/core/Handle.eca | 39 ++++++++++++++++++++------------------ 1 file changed, 21 insertions(+), 18 deletions(-) diff --git a/sha3/proof/core/Handle.eca b/sha3/proof/core/Handle.eca index 8b5ed43..bae2f0d 100644 --- a/sha3/proof/core/Handle.eca +++ b/sha3/proof/core/Handle.eca @@ -148,7 +148,7 @@ module G1(D:DISTINGUISHER) = { chandle <- 1; b <@ D(C,S).distinguish(); return b; - } + } }. (* -------------------------------------------------------------------------- *) @@ -218,7 +218,7 @@ inductive inv_spec (m:('a,'b) fmap) mi = inductive INV_CF_G1 (hs : handles) ch (Pm Pmi Gm Gmi : smap) (mh mhi : hsmap) (ro : (block list,block) fmap) pi = | HCF_G1 of (hs_spec hs ch) -(* & (inv_spec mh mhi) *) + & (inv_spec mh mhi) & (m_mh hs Pm mh) & (m_mh hs Pmi mhi) & (incl Gm Pm) @@ -287,11 +287,11 @@ lemma hs_of_INV (m1 m2 mi1 mi2 : smap) (mh2 mhi2 : hsmap) hs_spec hs ch. proof. by case. qed. -(* lemma inv_of_INV hs ch m1 mi1 m2 mi2 ro pi *) -(* mh2 mhi2: *) -(* INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => *) -(* inv_spec mh2 mhi2. *) -(* proof. by case. qed. *) +lemma inv_of_INV hs ch m1 mi1 m2 mi2 ro pi + mh2 mhi2: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + inv_spec mh2 mhi2. +proof. by case. qed. (** Useful Lemmas **) lemma ch_gt0 hs ch : hs_spec hs ch => 0 < ch. @@ -631,6 +631,7 @@ have /iffRL /(_ _):= Ipi xc p' xa'; first by exists hx. by move=> ->. qed. +(** Path-specific lemmas **) lemma lemma1 hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2: INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi => x2 <> y2 @@ -650,11 +651,11 @@ move=> HINV x2_neq_y2 Pm_x Gm_x pi_x2 x2_notin_rng1_hs y2_notin_rng1_hs; split. + rewrite (@addzA ch 1 1); apply/hs_addh. + by move: HINV=> /hs_of_INV/hs_addh=> ->. by move=> f h; rewrite getP; case: (h = ch)=> [/#|_]; exact/y2_notin_rng1_hs. -(* + apply/inv_addm; 1:by case: HINV. *) -(* + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. *) -(* by apply/(ch_notin_dom2_mh _ _ Hm_mh Hhs). *) -(* have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. *) -(* by apply/(Sch_notin_dom2_mh _ _ Hmi_mhi Hhs). *) ++ apply/inv_addm; 1:by case: HINV. + + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. + by apply/(ch_notin_dom2_mh _ _ Hm_mh Hhs). + have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. + by apply/(Sch_notin_dom2_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 _) // []. @@ -730,11 +731,11 @@ proof. move=> HINV PFm_x1x2 G1m_x1x2 pi_x2 hs_hx y2_notin_rng1_hs. split. + by apply/hs_addh=> //=; case: HINV. -(* + 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_notin_dom2_mh _ _ Hmi_mhi Hhs). *) ++ 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_notin_dom2_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 Hhuniq hs_hx _) //. exact/ch_notin_dom_hs. @@ -808,6 +809,7 @@ 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. ++ admit. + split. (* Pull out *) + move=> xa' xc' ya' yc'; have /m_mh_of_INV [] H _ /H {H}:= HINV. move=> [hx' fx' hy' fy'] [#] hs_hx' hs_hy' mh_xahx'. @@ -840,7 +842,8 @@ split. by exists xc' fx' yc' fy'; rewrite !getP Hhx' Hhy'. + move=> [za zc]; rewrite getP; case: ((za,zc) = (xa,xc))=> // _. by have /incl_of_INV H /H {H}:= HINV. -+ (* inverse or pre-inverse - probably on mh/mhi *) admit. ++ case HINV. ++ (** inverse or pre-inverse - probably on mh/mhi *) admit. + split; last by have /mh_of_INV [] _:= HINV. have pi_yc: pi.[yc] = None. + have /#: forall p b, pi.[yc] <> Some (p,b). From 70f856da5cbc63ddc83bb0609fecc325a81e0856 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 24 Aug 2016 14:54:45 +0100 Subject: [PATCH 205/394] Cleanup. --- sha3/proof/core/Handle.eca | 286 +++++++++++++++++-------------------- 1 file changed, 132 insertions(+), 154 deletions(-) diff --git a/sha3/proof/core/Handle.eca b/sha3/proof/core/Handle.eca index bae2f0d..91253a8 100644 --- a/sha3/proof/core/Handle.eca +++ b/sha3/proof/core/Handle.eca @@ -367,7 +367,7 @@ 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. -(** Adding handles **) +(** Preservation of m_mh **) lemma m_mh_addh hs ch m mh xc fx: hs_spec hs ch => m_mh hs m mh @@ -384,92 +384,28 @@ move: hs_hx=> /dom_hs/ltr_eqF -> /=. by move: hs_hy=> /dom_hs/ltr_eqF -> /=. 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 !getP /=. - case: (h1 = ch); case: (h2 = ch)=> //= [+ + [#]|+ + + [#]|]=> <*>; - first 2 by rewrite xc_notin_rng1_hs. - by move=> _ _ hs_h1 /(Hhuniq _ _ _ _ hs_h1). -+ by rewrite getP (ch_neq0 _ Hhs). -+ move=> [c f] h; rewrite !getP; 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. -+ by move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /= /#. -+ by rewrite getP hx_neq0. -move=> cf h; rewrite getP; case: (h = hx)=> [<*> _|_ /dom_hs //]. -by move: hs_hx=> /dom_hs. -qed. - -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. +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=> [] _ _ 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 !getP 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). +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 !getP /= /#. + + by exists hy fy hy' fy'; rewrite !getP Hhy' /#. + + by exists hx' fx' hy fy; rewrite !getP Hhx' /#. + by exists hx' fx' hy' fy'; rewrite !getP 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 !getP /= /#. ++ by exists yc fy yc' fy'; rewrite !getP Hhy' /#. ++ by exists xc' fx' yc fy; rewrite !getP Hhx' /#. +by exists xc' fx' yc' fy'; rewrite !getP Hhx' Hhy'. qed. -(* lemma paths_up_handles m2 ro hs mh pi cf ch: *) -(* mh_spec hs m2 mh ro => *) -(* handles_spec hs ch => *) -(* paths_spec hs mh pi => *) -(* paths_spec hs.[ch <- cf] mh pi. *) -(* proof. *) -(* move=> Hmh Hh [] Hp; split=> c p v; rewrite Hp; apply exists_iff=> x /=. *) -(* split=>- [] ^Hbu -> /=; rewrite getP. *) -(* + case: Hh=> _ _ Hlt x_in_handles. *) -(* by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom x_in_handles. *) -(* case: (x = ch)=> //=. *) -(* move: Hbu=> /build_hpathP [[#] _ _ ->|p' b v' h' [#] _ _ Hh']. *) -(* + by rewrite (@chandle_0 _ _ Hh). *) -(* case: Hh=> _ _ /(_ x) Hlt; rewrite ltr_eqF //. *) -(* by apply/Hlt; rewrite in_dom; case: Hmh=> /(_ _ _ _ _ Hh') [????] [#] _ ->. *) -(* qed. *) - -(* lemma handles_up_handles hs ch x2 f': *) -(* (forall (f : flag), ! mem (rng hs) (x2, f)) => *) -(* handles_spec hs ch => *) -(* handles_spec hs.[ch <- (x2, f')] (ch + 1). *) -(* proof. *) -(* move=> Hx2 ^Hh [] Hu Hh0 Hlt; split. *) -(* + move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. *) -(* case: (h1 = ch)=> /= [-> [] ->> ->|_]; (case: (h2 = ch)=> [-> //= |_]). *) -(* + by move=> Heq ->>; move: (Hx2 f2); rewrite in_rng negb_exists=> /= /(_ h2). *) -(* + by move=> Heq [] ->> <<- ->>; move: (Hx2 f1); rewrite in_rng negb_exists=> /= /(_ h1). *) -(* by apply Hu. *) -(* + by rewrite getP (@chandle_0 _ _ Hh). *) -(* by move=> h; rewrite dom_set !inE /#. *) -(* qed. *) - -(* (* lemma INV_CF_G1_up_handles hs ch m1 mi1 m2 mi2 mh mhi ro pi x2: *) *) -(* (* INV_CF_G1 hs ch m1 mi1 m2 mi2 mh mhi ro pi => *) *) -(* (* (forall f, !mem (rng hs) (x2, f)) => *) *) -(* (* INV_CF_G1 hs.[ch <- (x2, Known)] (ch + 1) m1 mi1 m2 mi2 mh mhi ro pi. *) *) -(* (* proof. *) *) -(* (* case=> Heqm Heqmi Hincl Hincli Hmh Hp Hh Hx2. *) *) -(* (* exact/(HCF_G1 (eqm_up_handles Hh Heqm) (eqm_up_handles Hh Heqmi) *) *) -(* (* _ _ *) *) -(* (* (:@mh_up_handles _ _ _ _ _ (x2,Known) Hh Hmh) *) *) -(* (* (:@paths_up_handles m2 ro _ _ _ (x2,Known) _ Hmh Hh Hp) *) *) -(* (* (:@handles_up_handles _ _ x2 Known _ Hh)). *) *) -(* (* qed. *) *) - -(** Updating forward map **) lemma m_mh_addh_addm hs Pm mh hx xa xc hy ya yc f: m_mh hs Pm mh => huniq hs => @@ -491,7 +427,6 @@ move: xahx0_neq_xahx; case: (xa0 = xa)=> [/= <*>>|//=]; case: (xc0 = xc)=> [<*>> by move: hs_hx=> /(Hhuniq _ _ _ _ hs_hx0). qed. -(** Updating backward map **) lemma mi_mhi_addh_addmi (hs : handles) mi mhi hx xa xc hy ya yc fx: m_mh hs mi mhi => (forall f h, hs.[h] <> Some (yc,f)) => @@ -512,7 +447,49 @@ move: yahy0_neq_yahy; case: (ya0 = ya)=> [<<*> //=|/#]; case: (yc0 = yc)=> [<*>> by move: hs_hy0; rewrite yc_notin_rng1_hs. qed. -(** Inversion **) +(** Preservation of hs_spec **) +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 !getP /=. + case: (h1 = ch); case: (h2 = ch)=> //= [+ + [#]|+ + + [#]|]=> <*>; + first 2 by rewrite xc_notin_rng1_hs. + by move=> _ _ hs_h1 /(Hhuniq _ _ _ _ hs_h1). ++ by rewrite getP (ch_neq0 _ Hhs). ++ move=> [c f] h; rewrite !getP; 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. ++ by move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /= /#. ++ by rewrite getP hx_neq0. +move=> cf h; rewrite getP; 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 !getP 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 @@ -526,7 +503,7 @@ case: (y' = y)=> /= [[#] <*> //=|_ /Hinv ^ + ->]. by move: m_x; case: (x' = x)=> [[#] <*> ->|]. qed. -(** Map Inclusion **) +(** Preservation of incl **) lemma incl_addm (m m' : ('a,'b) fmap) x y: incl m m' => incl m.[x <- y] m'.[x <- y]. @@ -631,6 +608,31 @@ 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. +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: INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi @@ -696,23 +698,23 @@ move=> HINV x2_neq_y2 Pm_x Gm_x pi_x2 x2_notin_rng1_hs y2_notin_rng1_hs; split. by move=> p' b' v' h' <*>; rewrite ch_notin_rng2_mh. move=> ^ /build_hpathP + -> /=; rewrite getP. by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. -+ 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_notin_dom2_mh hs Pm)/ch_notin_dom_hs; case: HINV. - by move=> -> /= ^ /dom_hs; rewrite !getP /#. - have ch_notin_rng2_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_notin_dom_hs; case: HINV. - have Sch_notin_rng2_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_notin_dom_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_notin_rng2_mh. - move=> ^ /build_hpathP + -> /=; rewrite !getP. - by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. +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_notin_dom2_mh hs Pm)/ch_notin_dom_hs; case: HINV. + by move=> -> /= ^ /dom_hs; rewrite !getP /#. +have ch_notin_rng2_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_notin_dom_hs; case: HINV. +have Sch_notin_rng2_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_notin_dom_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_notin_rng2_mh. +move=> ^ /build_hpathP + -> /=; rewrite !getP. +by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. qed. lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x1 x2 y1 y2 hx: @@ -774,21 +776,21 @@ split. rewrite getP. case: ((v +^ xa,hi) = (x1,hx))=> [[#] <*>|_ Hpath Hextend]. + by rewrite no_path_to_hx. by exists v hi hf. -+ 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 getP. - 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 getP; 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. +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 getP. + 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 getP; 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. qed. lemma lemma3 hs ch Pm Pmi Gm Gmi mh mhi ro pi xa xc hx ya yc hy p b: @@ -809,49 +811,24 @@ 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. -+ admit. -+ split. (* Pull out *) - + move=> xa' xc' ya' yc'; have /m_mh_of_INV [] H _ /H {H}:= HINV. - move=> [hx' fx' hy' fy'] [#] hs_hx' hs_hy' mh_xahx'. - case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|hy'_neq_hy|hx'_neq_hy|Hhx' Hhy']. - + by exists hy Known hy Known; rewrite !getP /= /#. - + by exists hy Known hy' fy'; rewrite !getP hy'_neq_hy /#. - + by exists hx' fx' hy Known; rewrite !getP hx'_neq_hy /#. - by exists hx' fx' hy' fy'; rewrite !getP Hhx' Hhy'. - move=> xa' hx' ya' hy'; have /m_mh_of_INV [] _ H /H {H}:= HINV. - move=> [xc' fx' yc' fy'] [#] hs_hx' hs_hy' m_xaxc'. - case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|hy'_neq_hy|hx'_neq_hy|Hhx' Hhy']. - + by exists yc Known yc Known; rewrite !getP /= /#. - + by exists yc Known yc' fy'; rewrite !getP hy'_neq_hy /#. - + by exists xc' fx' yc Known; rewrite !getP hx'_neq_hy /#. - by exists xc' fx' yc' fy'; rewrite !getP Hhx' Hhy'. -+ split. (* Pull out *) - + move=> xa' xc' ya' yc'; have /mi_mhi_of_INV [] H _ /H {H}:= HINV. - move=> [hx' fx' hy' fy'] [#] hs_hx' hs_hy' mh_xahx'. - case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|hy'_neq_hy|hx'_neq_hy|Hhx' Hhy']. - + by exists hy Known hy Known; rewrite !getP /= /#. - + by exists hy Known hy' fy'; rewrite !getP hy'_neq_hy /#. - + by exists hx' fx' hy Known; rewrite !getP hx'_neq_hy /#. - by exists hx' fx' hy' fy'; rewrite !getP Hhx' Hhy'. - move=> xa' hx' ya' hy'; have /mi_mhi_of_INV [] _ H /H {H}:= HINV. - move=> [xc' fx' yc' fy'] [#] hs_hx' hs_hy' m_xaxc'. - case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|hy'_neq_hy|hx'_neq_hy|Hhx' Hhy']. - + by exists yc Known yc Known; rewrite !getP /= /#. - + by exists yc Known yc' fy'; rewrite !getP hy'_neq_hy /#. - + by exists xc' fx' yc Known; rewrite !getP hx'_neq_hy /#. - by exists xc' fx' yc' fy'; rewrite !getP Hhx' Hhy'. ++ by case: HINV. ++ by apply/(m_mh_updh Unknown)=> //; case: HINV. ++ by apply/(m_mh_updh Unknown)=> //; case: HINV. + move=> [za zc]; rewrite getP; case: ((za,zc) = (xa,xc))=> // _. by have /incl_of_INV H /H {H}:= HINV. -+ case HINV. -+ (** inverse or pre-inverse - probably on mh/mhi *) admit. ++ 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!<<- {xct fxt} [#] 2!<<- {yct fyt} Pmi_yayc. + move=> [za zc]; rewrite getP; case: ((za,zc) = (ya,yc))=> // _. + by have /incli_of_INV H /H {H}:= HINV. + split; last by have /mh_of_INV [] _:= HINV. - have pi_yc: pi.[yc] = None. +(* have pi_yc: pi.[yc] = None. + have /#: forall p b, pi.[yc] <> Some (p,b). move=> p0 b0; rewrite -negP. have /pi_of_INV [] -> [h] [#] _ := HINV. have /hs_of_INV [] Hhuniq _ _^hs_h - /Hhuniq /(_ _ _ hs_hy) := HINV. by move: hs_h; case: (h = hy)=> [<*>|//=]; rewrite hs_hy. -(* have path_hx: build_hpath mh p = Some (b,hx). + have path_hx: build_hpath mh p = Some (b,hx). + move: pi_xc; have /pi_of_INV [] -> [h] [#] Hpath := HINV. by have /hs_of_INV [] Hhuniq _ _ ^hs_h - /Hhuniq /(_ _ _ hs_hx) /= <*>:= HINV. have ro_pbxa: ro.[rcons p (b +^ xa)] = Some ya. @@ -860,6 +837,7 @@ split. have path_hy: build_hpath mh (rcons p (b +^ xa)) = Some (ya,hy). + apply/build_hpathP/(@Extend _ _ _ _ p (b +^ xa) b hx)=> //. by rewrite xorwA xorwK xorwC xorw0. *) + admitted. clone export ConcreteF as ConcreteF1. From 23abfb406d8faa70b0299485b3966513862def4e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 24 Aug 2016 19:06:36 +0100 Subject: [PATCH 206/394] Saving state. --- sha3/proof/core/Handle.eca | 55 +++++++++++++++++++++++++++----------- 1 file changed, 40 insertions(+), 15 deletions(-) diff --git a/sha3/proof/core/Handle.eca b/sha3/proof/core/Handle.eca index 91253a8..fc52215 100644 --- a/sha3/proof/core/Handle.eca +++ b/sha3/proof/core/Handle.eca @@ -822,22 +822,47 @@ split. move=> [za zc]; rewrite getP; case: ((za,zc) = (ya,yc))=> // _. by have /incli_of_INV H /H {H}:= HINV. + split; last by have /mh_of_INV [] _:= HINV. -(* have pi_yc: pi.[yc] = None. - + have /#: forall p b, pi.[yc] <> Some (p,b). - move=> p0 b0; rewrite -negP. - have /pi_of_INV [] -> [h] [#] _ := HINV. - have /hs_of_INV [] Hhuniq _ _^hs_h - /Hhuniq /(_ _ _ hs_hy) := HINV. - by move: hs_h; case: (h = hy)=> [<*>|//=]; rewrite hs_hy. - have path_hx: build_hpath mh p = Some (b,hx). - + move: pi_xc; have /pi_of_INV [] -> [h] [#] Hpath := HINV. - by have /hs_of_INV [] Hhuniq _ _ ^hs_h - /Hhuniq /(_ _ _ hs_hx) /= <*>:= HINV. - have ro_pbxa: ro.[rcons p (b +^ xa)] = Some ya. - + have /mh_of_INV [] _ -> := HINV. - by exists b hx hy; rewrite xorwA xorwK xorwC xorw0. - have path_hy: build_hpath mh (rcons p (b +^ xa)) = Some (ya,hy). + move=> xa' hx' ya' hy'; case: ((xa',hx') = (xa,hx))=> [[#] <*>|]. + + rewrite mh_xahx=> /= [#] <<*>; rewrite !getP /=. + case: (hx = hy)=> [<*>|_]; first by move: hs_hx; rewrite hs_hy. + by exists xc Known yc Known; rewrite getP. + move=> Hxahx' ^mh_xahx'; have /mh_of_INV [] H _ /H {H} := HINV. + move=> [xc' fx' yc' fy'] [#] hs_hx' hs_hy' Hite. + have Hxaxc': ((xa',xc') <> (xa,xc)). + + move: Hxahx'=> /=; case: (xa' = xa)=> [<*> /=|//=]; apply/contra=> <*>. + by move: hs_hx; have /hs_of_INV [] H _ _ /H {H} /(_ _ _ hs_hx' _):= HINV. + exists xc' (if hx' = hy then Known else fx') yc' (if hy' = hy then Known else fy'). + rewrite !getP Hxaxc' /=; case: (hy' = hy)=> [<*> /=|]. + + move: hs_hy' Hite; rewrite hs_hy=> /= [#] <<*> /=. + move=> [p' b'] [#] ro_pbxa' path_hx'. + case: (hx' = hy)=> [<*> /=|]. + + move: hs_hx' ; rewrite hs_hy=> /= [#] <<*> /=. + admit. (** Really not sure, but looks surprising that we could have mh.[(.,hy)] = Some (.,hy) in a well-formed map. **) + admit. + case: (hx' = hy)=> [<*> /=|//=]. + move: hs_hx'; rewrite hs_hy' hs_hy=> /= [#] <<*> /=. + by move: Hite=> /= [#]; case: fy' hs_hy'=> //= _ ->. +split=> c p' b'; rewrite !getP; case: (yc = c)=> [<<*> /=|yc_neq_c]. ++ admit. (* weird things going on here *) +(* + split=> [[#] <<*>|]. + + exists hy; rewrite getP /=. + apply/build_hpathP/(@Extend _ _ _ _ p (b +^ xa) b hx)=> //. + + move: pi_xc; have /pi_of_INV [] -> [h] [#] Hpath := HINV. + by have /hs_of_INV [] H _ _ /H {H} /(_ _ _ hs_hx _) // := HINV. + by rewrite xorwA xorwK xorwC xorw0. + move=> [h] [#] Hpath; rewrite getP; case: (h = hy)=> [<*> /=|]; last first. + + by move=> + hs_h; move: hs_h; have /hs_of_INV [] H _ _ /H {H} /(_ _ _ hs_hy _):= HINV. + move: pi_xc; have /pi_of_INV [] -> [ht] [#] path_p := HINV. + have /hs_of_INV [] H _ _ /H {H} /(_ _ _ hs_hx _) // <*> := HINV. + have: build_hpath mh (rcons p (b +^ xa)) = Some (ya,hy). + apply/build_hpathP/(@Extend _ _ _ _ p (b +^ xa) b hx)=> //. - by rewrite xorwA xorwK xorwC xorw0. *) - + by rewrite xorwA xorwK xorwC xorw0. + elim/last_ind: p' Hpath. + + rewrite /build_hpath /= => [#] <*>. + by move: hs_hy; have /hs_of_INV [] _ -> := HINV. *) +rewrite (@eq_sym c) yc_neq_c /=; have /pi_of_INV [] -> := HINV. +apply/exists_iff=> h /=; rewrite getP; case: (h = hy)=> [<*> /=|//=]. +by rewrite yc_neq_c hs_hy /=. admitted. clone export ConcreteF as ConcreteF1. From 17b90a2ab75d988425cb962c59c4e3f271801440 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 25 Aug 2016 11:02:02 +0100 Subject: [PATCH 207/394] Handle: augmenting invariant and finishing lemma 3. --- sha3/proof/core/Handle.eca | 189 ++++++++++++++++++------------------- 1 file changed, 90 insertions(+), 99 deletions(-) diff --git a/sha3/proof/core/Handle.eca b/sha3/proof/core/Handle.eca index fc52215..27cb51e 100644 --- a/sha3/proof/core/Handle.eca +++ b/sha3/proof/core/Handle.eca @@ -194,7 +194,11 @@ inductive mh_spec (hs : handles) (Gm : smap) (mh : hsmap) (ro : (block list,bloc ro.[rcons p bn] = Some b <=> exists v hx hy, build_hpath mh p = Some (v,hx) - /\ mh.[(v +^ bn,hx)] = Some (b,hy)). + /\ 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) = @@ -482,7 +486,7 @@ lemma mh_addh hs ch Gm mh ro xc fx: => mh_spec hs Gm mh ro => mh_spec hs.[ch <- (xc,fx)] Gm mh ro. proof. -move=> [] _ _ dom_hs [] Hmh ?; split=> //. +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 !getP Hite hs_hx hs_hy /=. rewrite ltr_eqF /=; 1:by apply/(dom_hs _ hs_hx). @@ -509,22 +513,7 @@ lemma incl_addm (m m' : ('a,'b) fmap) x y: => incl m.[x <- y] m'.[x <- y]. proof. by move=> m_leq_m' x'; rewrite !getP; case: (x' = x)=> [|_ /m_leq_m']. qed. -(* lemma hinv_notin_rng m y2: *) -(* SLCommon.hinv m y2 = None => *) -(* (forall h f, m.[h] <> Some (y2,f)). *) -(* proof. by move=> hinv_none; have:= hinvP m y2; rewrite hinv_none. qed. *) - -(* lemma handles_spec_notin_dom m h: *) -(* handles_spec m h => *) -(* !mem (dom m) h. *) -(* proof. case; smt (in_dom). qed. *) - -(* lemma neq_Known f: f <> Known <=> f = Unknown. *) -(* proof. by case f. qed. *) - -(* lemma neq_Unkwown f: f <> Unknown <=> f = Known. *) -(* proof. by case f. qed. *) - +(** getflag: retrieve the flag of a capacity **) op getflag (hs : handles) xc = omap snd (obind ("_.[_]" hs) (hinv hs xc)). @@ -548,18 +537,6 @@ move=> /(huniq_hs _ h _ (xc,f)) /(_ hs_h) /= ->>. by rewrite hs_h. qed. -(* lemma paths_prefix handles m2 mh ro paths c b p v: *) -(* mh_spec handles m2 mh ro => *) -(* paths_spec handles mh paths => *) -(* paths.[c] = Some (rcons p b,v) => *) -(* (exists c' v', paths.[c'] = Some (p,v')). *) -(* proof. *) -(* move=> [] mh_some _ [] hpaths ^paths_c. *) -(* move=> /hpaths [h] [#] /build_hpathP [/#|] p' b' v' h' [#] ^/rconsIs + /rconssI- <*>. *) -(* move=> hpath + handles_h - /mh_some /= [c' c0 f' f]; rewrite handles_h /= => /> handles_h' _. *) -(* by exists c' v'; rewrite hpaths; exists h'. *) -(* qed. *) - (** Stuff about paths **) lemma build_hpath_prefix mh p b v h: build_hpath mh (rcons p b) = Some (v,h) @@ -674,7 +651,7 @@ move=> HINV x2_neq_y2 Pm_x Gm_x pi_x2 x2_notin_rng1_hs y2_notin_rng1_hs; split. + split. + move=> xa hx ya hy; rewrite getP; case: ((xa,hx) = (x1,ch))=> [|]. + by move=> [#] <*> [#] <*>; exists x2 Known y2 Known; rewrite !getP /#. - move=> xahx_neq_x1ch; have ^ /hs_of_INV Hhs /mh_of_INV [] Hmh _ /Hmh {Hmh} := HINV. + 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 getP). case: fy Hite hs_hy=> /= [[p v] [Hro Hpath] hs_hy|[#] Gm_xaxc <*> hs_hy] /=; last first. @@ -682,22 +659,30 @@ move=> HINV x2_neq_y2 Pm_x Gm_x pi_x2 x2_notin_rng1_hs y2_notin_rng1_hs; split. exists p v; rewrite Hro /=; apply/build_hpath_up=> //. have /m_mh_of_INV /notin_hs_notin_dom2_mh H:= HINV. exact/H/ch_notin_dom_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_notin_dom2_mh hs Pm)/ch_notin_dom_hs; case: HINV. - have ch_notin_rng2_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_notin_dom_hs; case: HINV. - split=> -[#]. - + move=> Hpath mh_vxahx; rewrite getP; 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=> 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_notin_dom2_mh hs Pm)/ch_notin_dom_hs; case: HINV. + have ch_notin_rng2_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_notin_dom_hs; case: HINV. + split=> -[#]. + + move=> Hpath mh_vxahx; rewrite getP; 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_notin_rng2_mh. + move=> ^ /build_hpathP + -> /=; rewrite getP. + 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. - by move=> p' b' v' h' <*>; rewrite ch_notin_rng2_mh. - move=> ^ /build_hpathP + -> /=; rewrite getP. - by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. + 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) /(_ _). @@ -750,7 +735,7 @@ split. + move=> xa' hx' ya' hy'; rewrite getP; case: ((xa',hx') = (x1,hx))=> [[#] <*>> [#] <<*> /=|]. + exists x2 Known y2 Known=> //=; rewrite !getP /=. by have /hs_of_INV [] _ _ dom_hs /#:= HINV. - move=> xahx'_neq_x1hx; have /mh_of_INV [] Hmh _ /Hmh {Hmh} := 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 !getP hs_hx' hs_hy'. rewrite (dom_hs_neq_ch hs xc fx _ hs_hx') /=; 1:by case: HINV. @@ -761,21 +746,27 @@ split. exists xc Known yc Known=> //=; rewrite !getP; 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 getP; 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). + + move=> p xa b; have /mh_of_INV [] _ -> _ := HINV; split. + + move=> [v hi hf] [#] Hpath mh_vxahi; exists v hi hf. + rewrite getP; 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 getP. 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. - have H /H {H} := build_hpath_down G1mh x1 hx y1 ch p v hi no_path_to_hx. - rewrite getP. case: ((v +^ xa,hi) = (x1,hx))=> [[#] <*>|_ Hpath Hextend]. - + by rewrite no_path_to_hx. - by exists v hi hf. + 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 _). @@ -821,49 +812,49 @@ split. rewrite hs_hx hs_hy=> /= [#] 2!<<- {xct fxt} [#] 2!<<- {yct fyt} Pmi_yayc. move=> [za zc]; rewrite getP; case: ((za,zc) = (ya,yc))=> // _. by have /incli_of_INV H /H {H}:= HINV. -+ split; last by have /mh_of_INV [] _:= HINV. ++ split; last 2 by have /mh_of_INV [] _:= HINV. move=> xa' hx' ya' hy'; case: ((xa',hx') = (xa,hx))=> [[#] <*>|]. + rewrite mh_xahx=> /= [#] <<*>; rewrite !getP /=. case: (hx = hy)=> [<*>|_]; first by move: hs_hx; rewrite hs_hy. by exists xc Known yc Known; rewrite getP. - move=> Hxahx' ^mh_xahx'; have /mh_of_INV [] H _ /H {H} := HINV. - move=> [xc' fx' yc' fy'] [#] hs_hx' hs_hy' Hite. - have Hxaxc': ((xa',xc') <> (xa,xc)). - + move: Hxahx'=> /=; case: (xa' = xa)=> [<*> /=|//=]; apply/contra=> <*>. - by move: hs_hx; have /hs_of_INV [] H _ _ /H {H} /(_ _ _ hs_hx' _):= HINV. - exists xc' (if hx' = hy then Known else fx') yc' (if hy' = hy then Known else fy'). - rewrite !getP Hxaxc' /=; case: (hy' = hy)=> [<*> /=|]. - + move: hs_hy' Hite; rewrite hs_hy=> /= [#] <<*> /=. - move=> [p' b'] [#] ro_pbxa' path_hx'. - case: (hx' = hy)=> [<*> /=|]. - + move: hs_hx' ; rewrite hs_hy=> /= [#] <<*> /=. - admit. (** Really not sure, but looks surprising that we could have mh.[(.,hy)] = Some (.,hy) in a well-formed map. **) - admit. - case: (hx' = hy)=> [<*> /=|//=]. - move: hs_hx'; rewrite hs_hy' hs_hy=> /= [#] <<*> /=. + 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 (@getP _ _ _ hy') Hhy'=> /= hs_hx' ^ hs_hy' -> Hite. + exists xc' (if hx' = hy then Known else fx') yc' fy'. + rewrite (@getP Gm) (_: (xa',xc') <> (xa,xc)) /=. + + move: Hxahx'=> /=; case: (xa' = xa)=> [<*> /=|//]. + by apply/contra=> <*>; have /hs_of_INV [] + _ _ - /(_ _ _ _ _ hs_hx' hs_hx _) := HINV. + rewrite getP; case: (hx' = hy)=> /= [<*>|//]. + move: hs_hx'; rewrite hs_hy=> /= [#] <<*> /=. by move: Hite=> /= [#]; case: fy' hs_hy'=> //= _ ->. -split=> c p' b'; rewrite !getP; case: (yc = c)=> [<<*> /=|yc_neq_c]. -+ admit. (* weird things going on here *) -(* + split=> [[#] <<*>|]. - + exists hy; rewrite getP /=. - apply/build_hpathP/(@Extend _ _ _ _ p (b +^ xa) b hx)=> //. - + move: pi_xc; have /pi_of_INV [] -> [h] [#] Hpath := HINV. - by have /hs_of_INV [] H _ _ /H {H} /(_ _ _ hs_hx _) // := HINV. - by rewrite xorwA xorwK xorwC xorw0. - move=> [h] [#] Hpath; rewrite getP; case: (h = hy)=> [<*> /=|]; last first. - + by move=> + hs_h; move: hs_h; have /hs_of_INV [] H _ _ /H {H} /(_ _ _ hs_hy _):= HINV. - move: pi_xc; have /pi_of_INV [] -> [ht] [#] path_p := HINV. - have /hs_of_INV [] H _ _ /H {H} /(_ _ _ hs_hx _) // <*> := HINV. - have: build_hpath mh (rcons p (b +^ xa)) = Some (ya,hy). - + apply/build_hpathP/(@Extend _ _ _ _ p (b +^ xa) b hx)=> //. - by rewrite xorwA xorwK xorwC xorw0. - elim/last_ind: p' Hpath. - + rewrite /build_hpath /= => [#] <*>. - by move: hs_hy; have /hs_of_INV [] _ -> := HINV. *) -rewrite (@eq_sym c) yc_neq_c /=; have /pi_of_INV [] -> := HINV. -apply/exists_iff=> h /=; rewrite getP; case: (h = hy)=> [<*> /=|//=]. -by rewrite yc_neq_c hs_hy /=. -admitted. +split=> c p' b'; rewrite !getP; 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 getP; case: (h = hy)=> [<*> /=|//=]. + by rewrite yc_neq_c hs_hy /=. +split=> [[#] <<*>|]. ++ exists hy; rewrite getP /=; 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 getP; 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. +qed. clone export ConcreteF as ConcreteF1. @@ -1038,7 +1029,7 @@ section AUX. + auto=> &hr [#] !<<- _ _ !->> _ /= _ _; rewrite pi_x2 oget_some /=. rewrite in_dom; case: {-1}(ro0.[rcons p0 (v0 +^ x1)]) (eq_refl (ro0.[rcons p0 (v0 +^ x1)])). + done. - move=> bo ^ro_pvx1 /=. have /mh_of_INV [] _ ->:= inv0. + 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. @@ -1061,7 +1052,7 @@ section AUX. case @[ambient]: fx2 hs_hx2=> hs_hx2. + swap{2} 3 -2; seq 0 1: (G1.bext{2}); last by inline*; if{2}; auto; smt (@Block @Capacity). by auto=> ? ? [#] !<<- _ -> ->> _ /=; rewrite in_rng; exists hx2. - have /mh_of_INV []/(_ _ _ _ _ G1mh_x1hx2) + _:= inv0. + have /mh_of_INV []/(_ _ _ _ _ G1mh_x1hx2) + _ _:= inv0. move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0} /= [p0 v0] [#] Hro Hpath. have /pi_of_INV [] /(_ x2 p0 v0) /iffRL /(_ _) := inv0. + by exists hx2. From e9d8430548905a1aad3e79f9dbb39220dabfd627 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 25 Aug 2016 11:38:26 +0100 Subject: [PATCH 208/394] Initialization. --- sha3/proof/core/Handle.eca | 32 ++++++++------------------------ sha3/proof/core/SLCommon.ec | 8 ++++++++ 2 files changed, 16 insertions(+), 24 deletions(-) diff --git a/sha3/proof/core/Handle.eca b/sha3/proof/core/Handle.eca index 27cb51e..d929a12 100644 --- a/sha3/proof/core/Handle.eca +++ b/sha3/proof/core/Handle.eca @@ -1070,8 +1070,8 @@ section AUX. move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 !oget_some //=. rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. + by have /hs_of_INV []:= inv0. - rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //=. - (* lemma 3 *) admit. + rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //= => _. + exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). (* Stopped here *) + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). @@ -1096,29 +1096,13 @@ section AUX. (* lossless and do not reset bad G1.C.f *) + admit. (* Init ok *) - admit. -(*inline *. auto; progress=> //=. - + smt w=map0P. - + smt w=map0P. - + smt w=map0P. - + smt w=map0P. - + smt w=map0P. - + smt w=(map0P in_dom). - + smt w=map0P. - + rewrite /paths_spec=> c p v. rewrite !getP; case (c = c0)=> //=. - rewrite anda_and=> c_c0; split=> [[] <<- <<-|]. - + by exists 0; rewrite /build_hpath /= getP /= c_c0. - move=> [h] @/build_hpath [] h0; rewrite getP; case (h = 0). - + by move=> /= ->> ->>; move: h0; smt. - smt w=map0P. - move=> c_c0; rewrite map0P /= negb_exists /= => h. - rewrite negb_and getP; case (h = 0)=> //=; [|by rewrite map0P]. - by move=> _; right; rewrite eq_sym. - + smt w=(map0P getP). + inline *; auto=> />; split=> [|/#]. + (do !split; last 3 smt (getP map0P build_hpath_map0)); last 5 by move=> ? ? ? ?; rewrite map0P. + + move=> h1 h2 ? ?; rewrite !getP !map0P. + by case: (h1 = 0); case: (h2 = 0)=> //=. + by rewrite getP. - + move: H; rewrite in_dom getP; case (h = 0)=> //=. - by rewrite map0P. - + by move: H1=> /H0 [#].*) + + by move=> ? h; rewrite getP map0P; case: (h = 0). + by move=> ? ?; rewrite !map0P. qed. end section AUX. diff --git a/sha3/proof/core/SLCommon.ec b/sha3/proof/core/SLCommon.ec index fbb4548..01ac9dc 100644 --- a/sha3/proof/core/SLCommon.ec +++ b/sha3/proof/core/SLCommon.ec @@ -138,6 +138,14 @@ case=> [/#|] p' b' v'' h'' ^/rconssI <<- {p'} /rconsIs <<- {b'}. by rewrite build /= => [#] <*>. qed. +lemma build_hpath_map0 p: + build_hpath map0 p + = if p = [] then Some (b0,0) else None. +proof. +elim/last_ind: p=> //= p b _. +by rewrite -{1}cats1 foldl_cat {1}/step_hpath /= map0P /= /#. +qed. + (* -------------------------------------------------------------------------- *) module C = { From d386c77a478c94eab9af317c0c3241c67481e54c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 25 Aug 2016 12:43:31 +0100 Subject: [PATCH 209/394] Sorting out the easy things. --- sha3/proof/core/Handle.eca | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/sha3/proof/core/Handle.eca b/sha3/proof/core/Handle.eca index d929a12..b962b2e 100644 --- a/sha3/proof/core/Handle.eca +++ b/sha3/proof/core/Handle.eca @@ -1072,7 +1072,7 @@ section AUX. + by have /hs_of_INV []:= inv0. rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //= => _. exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). - (* Stopped here *) + (* lossless PF.f *) + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). (* lossless and do not reset bad G1.S.f *) @@ -1085,16 +1085,26 @@ section AUX. (* equiv PF.P.fi G1.S.fi *) + admit. (* lossless PF.P.fi *) - + admit. + + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. + smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). (* lossless and do not reset bad G1.S.fi *) - + admit. + + move=> _; proc; if; 2:by auto. + by wp; do 2!rnd predT; auto => &hr [#]; smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). (** proofs for G1.C.f *) (* equiv PF.C.f G1.C.f *) + admit. (* lossless PF.C.f *) - + admit. + + move=> &2 _; proc; inline *; while (true) (size p); auto. + + sp; if; 2:by auto; smt (size_behead). + by wp; do 2!rnd predT; auto; smt (size_behead Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). + smt (size_ge0). (* lossless and do not reset bad G1.C.f *) - + admit. + + move=> _; proc; inline *; wp; rnd predT; auto. + while (G1.bcol \/ G1.bext) (size p - i)=> [z|]. + + if; 1:by auto=> /#. + wp; rnd predT; wp; rnd predT; auto. + smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). + by auto; smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). (* Init ok *) inline *; auto=> />; split=> [|/#]. (do !split; last 3 smt (getP map0P build_hpath_map0)); last 5 by move=> ? ? ? ?; rewrite map0P. From 35bf3dc71cf0eb94fa1d8ddd2b24f417596a59fb Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 25 Aug 2016 16:54:54 +0200 Subject: [PATCH 210/394] some progress, need a lot of simplification --- sha3/proof/core/Handle.eca | 131 ++++++++++++++++++++++++++++++++++++- 1 file changed, 130 insertions(+), 1 deletion(-) diff --git a/sha3/proof/core/Handle.eca b/sha3/proof/core/Handle.eca index b962b2e..64d1f09 100644 --- a/sha3/proof/core/Handle.eca +++ b/sha3/proof/core/Handle.eca @@ -858,6 +858,48 @@ qed. clone export ConcreteF as ConcreteF1. +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_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 oget_some. + rewrite getP. 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 getP;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 /= getP_neq /= ?Hha // Hmh build_hpath_None. +qed. + +(* we should do a lemma to have the equivalence *) + section AUX. declare module D : DISTINGUISHER {PF, RO, G1}. @@ -1036,7 +1078,94 @@ section AUX. have /m_mh_of_INV [] _ /(_ _ _ _ _ G1mh_x1hx2) := inv0. move=> [xc xf yc yf] [#]; rewrite hs_hx2=> [#] <*>. by rewrite PFm_x1x2. - auto. admit. (* this is the easy case *) + auto => &m1 &m2 [#] !<- _ _ -> /= _ y1L -> y2L -> /=. + rewrite !getP_eq pi_x2 !oget_some /=. + have /hs_of_INV [] Hu _ _:= inv0; have -> := huniq_hinvK_h _ _ _ Hu hs_hx2. + rewrite oget_some -!nor => /= -[] ? Hy2L [*]. + case:inv0=> Hhs Hinv Hmmh Hmmhi Hincl Hincli Hmh Hpi; apply HCF_G1. + + by apply hs_addh => //;have /# := hinvP hs0 y2L. + + apply inv_addm=>//;first by move: hs_hx2 PFm_x1x2;apply: m_mh_None. + by apply (ch_notin_dom2_mh _ _ Hmmhi Hhs). + + by apply (m_mh_addh_addm _ Hmmh _ hs_hx2)=>//;apply ch_notin_dom_hs. + + apply (mi_mhi_addh_addmi _ Hmmhi _ hs_hx2);last by apply ch_notin_dom_hs. + by have := hinvP hs0 y2L;rewrite Hy2L /#. + + by apply incl_addm. + by apply incl_addm. + + split. + + move=> xa hx ya hy;rewrite getP;case ((xa, hx) = (x1, hx2))=> /=. + + move=> [] !-> [] !<-; exists x2 Known y2L Known. + by rewrite !getP_eq /= getP_neq // eq_sym; apply (dom_hs_neq_ch _ _ _ Hhs hs_hx2). + move=> Hdiff Hxa; case Hmh=> /(_ _ _ _ _ Hxa) [] xc fx yc fy [#] Hhx Hhy HG1 _. + exists xc fx yc fy;rewrite !getP_neq //. + + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhx). + + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhy). + + rewrite /= -negP=> -[] <<- <<-;apply Hdiff=> /=. + by apply (Hu hx (x2, fx) (x2, Known)). + rewrite Hhx Hhy=> /=;move: HG1. + case: fy Hhy=> Hhy //= [p v [Hro Hbu]]. + exists p v;split. + + rewrite getP_neq // -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 getP. + case (rcons p bn = rcons p0 (v0 +^ x1)). + + move=> ^ /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 getP_eq. + move=> [v hx hy] [];rewrite getP ;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. + move=> Hdiff; case Hmh => _ ->. + apply exists_iff=> v /= ;apply exists_iff => hx /=;apply exists_iff => hy /=;split. + + move=> [Hp Hhx]. + have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. + have -> /= := build_hpath_up_None _ _ (y1L, ch0) _ _ HG1 Hp. + by rewrite getP_neq //= -negP => -[->> <<-]; move: Hhx;rewrite HG1. + rewrite getP; case ((v +^ bn, hx) = (x1, hx2))=> /=. + + move=> [<<- ->>] [+ [!<<-]]. + have Hhx2:= dom_hs_neq_ch _ _ _ _ _ Hhs hs_hx2. + move=> Hbui;have := build_hpath_down_None _ _ _ _ _ _ _ _ _ _ _ Hbui=> //. + + move=> ya;case Hmmh=> _ /(_ ya ch0);case (G1mh.[(ya, ch0)]) => //. + move=> [ya1 hy1] /(_ ya1 hy1) /=;rewrite -negP => -[xc fx yc fy [#] Hch]. + by have := dom_hs_neq_ch _ _ _ _ _ Hhs Hch. + move=>{Hbui} Hbui; have : pi0.[x2] = Some (p, v). + + by case: Hpi => ->;exists hx2. + by rewrite pi_x2 /= => -[!->>];move:Hdiff; rewrite xorwA xorwK Block.WRing.add0r. + move=> _ [+ ^ H ->] /=. apply build_hpath_down_None. + + case: Hmmh => _ /(_ _ _ _ _ H) [xc fx yc fy [#] Hch] _ _. + by apply (dom_hs_neq_ch _ _ _ Hhs Hch). + + by apply (dom_hs_neq_ch _ _ _ Hhs hs_hx2). + move=> ya; case Hmmh=> _ /(_ ya ch0); case (G1mh.[(ya, ch0)])=> //. + move=>[ya1 ha1] /(_ ya1 ha1) [xc fx yc fy [#] Hch]. + by have := dom_hs_neq_ch _ _ _ _ _ Hhs Hch. + split=> c p v;rewrite getP. case (c = y2L) => [->> /= | ?]. + + split. + + move=> [!<<-];exists ch0;rewrite getP_eq /= build_hpath_prefix. + exists v0 hx2;rewrite xorwA xorwK Block.WRing.add0r getP_eq /=. + have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. + by apply build_hpath_up_None. + have Hhx2:= dom_hs_neq_ch _ _ _ _ _ Hhs hs_hx2. + move=> [h []];rewrite getP;case (h=ch0)=> [->> /= | Hh]. + + admit. + move=> Hbui;have := build_hpath_down_None _ _ _ _ _ _ _ _ _ _ _ Hbui=> //. + + move=> ya;case Hmmh=> _ /(_ ya ch0);case (G1mh.[(ya, ch0)]) => //. + move=> [ya1 hy1] /(_ ya1 hy1) /=;rewrite -negP => -[xc fx yc fy [#] Hch]. + by have := dom_hs_neq_ch _ _ _ _ _ Hhs Hch. + by move=> _ Hhsh;have := hinvP hs0 y2L;rewrite Hy2L /= => /(_ h Known);rewrite Hhsh. + case Hpi=> ->;apply exists_iff=> /= h;rewrite getP;case (h = ch0) => [->> /= | Hdiff]. + + split => [|/#]. + by rewrite build_hpathP=> -[_ Hch]; have := dom_hs_neq_ch _ _ _ _ _ Hhs Hch. + split=> -[+ ->] /=. + + have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. + by apply build_hpath_up_None. + have Hhx2:= dom_hs_neq_ch _ _ _ _ _ Hhs hs_hx2. + apply build_hpath_down_None=> //. + move=> ya;case Hmmh=> _ /(_ ya ch0);case (G1mh.[(ya, ch0)]) => //. + move=> [ya1 hy1] /(_ ya1 hy1) /=;rewrite -negP => -[xc fx yc fy [#] Hch]. + by have := dom_hs_neq_ch _ _ _ _ _ Hhs Hch. + (* this is the easy case *) move=> [xa xc] PFm_x1x2. rcondf{1} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom PFm_x1x2. have /m_mh_of_INV [] + _ - /(_ _ _ _ _ PFm_x1x2) := inv0. move=> [hx2 fx2 hy2 fy2] [#] hs_hx2 hs_hy2 G1mh_x1hx2. From 75647917cfeea118bfc14b3b3ca0f76ad76cffe8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 25 Aug 2016 18:32:20 +0100 Subject: [PATCH 211/394] Moving forward with proof for inversion. We really need to make the lemmas slightly more abstract. --- sha3/proof/core/Handle.eca | 275 ++++++++++++++++++++++++++++++++++++- 1 file changed, 272 insertions(+), 3 deletions(-) diff --git a/sha3/proof/core/Handle.eca b/sha3/proof/core/Handle.eca index 64d1f09..2e399aa 100644 --- a/sha3/proof/core/Handle.eca +++ b/sha3/proof/core/Handle.eca @@ -452,6 +452,18 @@ by move: hs_hy0; rewrite yc_notin_rng1_hs. 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 !getP. +case: (h1 = h); case: (h2 = h)=> //= [Hh2 + [#]|+ Hh1 + [#]|_ _] - <*>. ++ by rewrite c_notin_rng1_hs. ++ by rewrite c_notin_rng1_hs. +exact/Hhuniq. +qed. + lemma hs_addh hs ch xc fx: hs_spec hs ch => (forall f h, hs.[h] <> Some (xc,f)) @@ -616,7 +628,6 @@ lemma lemma1 hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2: => x2 <> y2 => Pm.[(x1,x2)] = None => Gm.[(x1,x2)] = None - => pi.[x2] = None => (forall f h, hs.[h] <> Some (x2,f)) => (forall f h, hs.[h] <> Some (y2,f)) => INV_CF_G1 @@ -626,7 +637,7 @@ lemma lemma1 hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2: mh.[(x1,ch) <- (y1,ch + 1)] mhi.[(y1,ch + 1) <- (x1,ch)] ro pi. proof. -move=> HINV x2_neq_y2 Pm_x Gm_x pi_x2 x2_notin_rng1_hs y2_notin_rng1_hs; split. +move=> HINV x2_neq_y2 Pm_x Gm_x x2_notin_rng1_hs y2_notin_rng1_hs; split. + rewrite (@addzA ch 1 1); apply/hs_addh. + by move: HINV=> /hs_of_INV/hs_addh=> ->. by move=> f h; rewrite getP; case: (h = ch)=> [/#|_]; exact/y2_notin_rng1_hs. @@ -702,6 +713,95 @@ move=> ^ /build_hpathP + -> /=; rewrite !getP. by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. qed. +lemma lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi + => 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. +proof. +move=> HINV x2_neq_y2 Pm_x Gm_x xc_notin_rng1_hs yc_notin_rng1_hs; split. ++ rewrite (@addzA ch 1 1); apply/hs_addh. + + by move: HINV=> /hs_of_INV/hs_addh=> ->. + by move=> f h; rewrite getP; case: (h = ch)=> [/#|_]; exact/yc_notin_rng1_hs. ++ apply/inv_addm; 1:by case: HINV. + + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. + by apply/(Sch_notin_dom2_mh _ _ Hm_mh Hhs). + have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. + by apply/(ch_notin_dom2_mh _ _ Hmi_mhi Hhs). ++ apply/(@mi_mhi_addh_addmi 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=> f h; rewrite getP; case: (h = ch)=> [<*> /#|]; rewrite yc_notin_rng1_hs. + + by rewrite getP. + by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_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 getP. + by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. ++ by apply/incl_addm; case: HINV. ++ by apply/incl_addm; case: HINV. ++ split. + + move=> ya hy xa hx; rewrite getP; case: ((ya,hy) = (y1,ch + 1))=> [|]. + + by move=> [#] <*> [#] <*>; exists y2 Known x2 Known; rewrite !getP /#. + 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 getP). + case: fx Hite hs_hx=> /= [[p v] [Hro Hpath] hs_hx|[#] Gm_yayc <*> hs_hx] /=; last first. + + by rewrite getP; case: ((ya,yc) = (y1,y2))=> [/#|]. + exists p v; rewrite Hro /=; apply/build_hpath_up=> //. + have /m_mh_of_INV /notin_hs_notin_dom2_mh H:= HINV. + exact/H/Sch_notin_dom_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_notin_dom2_mh hs Pm)/Sch_notin_dom_hs; case: HINV. + have Sch_notin_rng2_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_notin_dom_hs; case: HINV. + split=> -[#]. + + move=> Hpath mh_vxahx; rewrite getP; 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_notin_rng2_mh. + move=> ^ /build_hpathP + -> /=; rewrite getP. + 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_notin_dom2_mh hs Pm)/Sch_notin_dom_hs; case: HINV. + by move=> -> /= ^ /dom_hs; rewrite !getP /#. +have ch_notin_rng2_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_notin_dom_hs; case: HINV. +have Sch_notin_rng2_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_notin_dom_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_notin_rng2_mh. +move=> ^ /build_hpathP + -> /=; rewrite !getP. +by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. +qed. + lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x1 x2 y1 y2 hx: INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi => PFm.[(x1,x2)] = None @@ -784,6 +884,97 @@ 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. qed. +lemma lemma2' hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x1 x2 y1 y2 hx: + INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi + => 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. +proof. +move=> HINV PFmi_x1x2 G1mi_x1x2 hs_hx y2_notin_rng1_hs. +split. ++ by apply/hs_addh=> //=; case: HINV. ++ apply/inv_addm; 1:by case: HINV. + + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. + by apply/(ch_notin_dom2_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 _ hs_hx _) //. + exact/ch_notin_dom_hs. ++ have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /mi_mhi_of_INV := HINV. + move=> /m_mh_addh_addm /(_ hx x1 x2 ch y1 y2 Known _ hs_hx _) //. + exact/ch_notin_dom_hs. ++ by have /incl_of_INV/incl_addm ->:= HINV. ++ by have /incli_of_INV/incl_addm ->:= HINV. ++ split. + + move=> ya' hy' xa' hx'; rewrite getP; case: ((ya',hy') = (y1,ch))=> [[#] <*>> [#] <<*> /=|]. + + exists y2 Known x2 Known=> //=; rewrite !getP /=. + 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 !getP 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 !getP; 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=> [#]. + + admit. + 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 getP. 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 getP. + 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 getP; 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. +qed. + lemma lemma3 hs ch Pm Pmi Gm Gmi mh mhi ro pi xa xc hx ya yc hy p b: INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi => Pm.[(xa,xc)] = Some (ya,yc) @@ -900,6 +1091,84 @@ qed. (* we should do a lemma to have the equivalence *) +equiv eq_fi (D <: DISTINGUISHER {PF, RO, G1}): PF.fi ~ G1(D).S.fi: + !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} + ==> !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}. +proof. +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}. +elim* => hs ch Pm Pmi Gm Gmi mh mhi ro pi [xa xc]. +case @[ambient]: + {-1}(INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi) + (eq_refl (INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi)); 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 in_dom Pmi_xaxc. + rcondt{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. + case @[ambient]: {-1}(getflag hs xc) (eq_refl (getflag hs xc)). + + move=> /getflagP_none xc_notin_rng1_hs. + rcondt{2} 2. + + auto=> &hr [#] <<*> _ _ _; rewrite in_rng negb_exists=> h /=. + by rewrite xc_notin_rng1_hs. + rcondf{2} 8. + + auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _. + rewrite negb_and in_dom; left. + rewrite (@huniq_hinvK_h ch) 3:oget_some /=. + + by apply/huniq_addh=> //; have /hs_of_INV [] := inv0. + + by rewrite getP. + apply/(@notin_m_notin_mh hs.[ch <- (xc,Known)] Pmi _ _ xc ch Known)=> //. + + by apply/m_mh_addh=> //; case: inv0. + by rewrite getP. + auto=> ? ? [#] !<<- -> -> ->> _ /= ya -> /= yc -> /=. + case: (hinvP (hs.[ch <- (xc,Known)]) yc)=> [_|-> //] yc_notin_rng1_hs_addh _ _. + rewrite getP /= oget_some /= -addzA /=. + rewrite(@huniq_hinvK_h ch) 3:oget_some /=. + + by apply/huniq_addh=> //; have /hs_of_INV [] := inv0. + + by rewrite getP. + apply/(@lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi xa xc ya yc inv0 _ Pmi_xaxc Gmi_xaxc)=> //. + + rewrite -negP=> <*>; move: yc_notin_rng1_hs_addh => /=. + apply/negb_forall=> /=; exists ch; apply/negb_forall=> /=; exists Known. + by rewrite getP. + + move=> f h; move: (yc_notin_rng1_hs_addh h f); rewrite getP. + case: (h = ch)=> <*> //= _; rewrite -negP. + by have /hs_of_INV [] _ _ H /H {H} := inv0. + 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; rewrite in_rng=> -[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 in_dom /=; 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_notin_rng1_hs _ _|/#]. + rewrite getP /= oget_some /=. + by apply/lemma2'=> // f h; exact/y2_notin_rng1_hs. +rcondf{1} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Pmi_xaxc. +admit. (* more things *) +qed. + section AUX. declare module D : DISTINGUISHER {PF, RO, G1}. @@ -1212,7 +1481,7 @@ section AUX. smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). (** proofs for G1.S.fi *) (* equiv PF.P.fi G1.S.fi *) - + admit. + + by conseq (eq_fi D)=> /#. (* lossless PF.P.fi *) + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). From a07b0b49aec3a1f8c8315a6a20793f74ac312251 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 26 Aug 2016 13:03:52 +0200 Subject: [PATCH 212/394] some progress --- sha3/proof/Common.ec | 2 +- sha3/proof/core/Handle.eca | 147 ++++++++++++++++++++++--------------- 2 files changed, 90 insertions(+), 59 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 9425328..35a95ef 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -77,7 +77,7 @@ 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 b0 : b0 = mkblock (nseq r false). +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:/#. diff --git a/sha3/proof/core/Handle.eca b/sha3/proof/core/Handle.eca index 2e399aa..54d49c6 100644 --- a/sha3/proof/core/Handle.eca +++ b/sha3/proof/core/Handle.eca @@ -1063,6 +1063,26 @@ 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 getP /=;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)=> [->> _ _ _ /Hch //|??? Hbu Hg]. + by rewrite build_hpath_prefix;exists v' h'. +qed. + lemma build_hpath_up_None (G1mh:hsmap) bi1 bi2 bi p: G1mh.[bi1] = None => build_hpath G1mh p = Some bi => @@ -1076,6 +1096,7 @@ proof. 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) => @@ -1088,7 +1109,27 @@ proof. move=> {Hrec};case: p=> /= [[_ ->>]| b' p];1: by move:Hh. by rewrite {2}/step_hpath /= oget_some /= getP_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 getP_eq /=;apply build_hpath_up_None. +qed. + + + (* we should do a lemma to have the equivalence *) equiv eq_fi (D <: DISTINGUISHER {PF, RO, G1}): PF.fi ~ G1(D).S.fi: @@ -1351,10 +1392,18 @@ section AUX. rewrite !getP_eq pi_x2 !oget_some /=. have /hs_of_INV [] Hu _ _:= inv0; have -> := huniq_hinvK_h _ _ _ Hu hs_hx2. rewrite oget_some -!nor => /= -[] ? Hy2L [*]. - case:inv0=> Hhs Hinv Hmmh Hmmhi Hincl Hincli Hmh Hpi; apply HCF_G1. + case:inv0=> Hhs Hinv Hmmh Hmmhi Hincl Hincli Hmh Hpi. + 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=>//;first by move: hs_hx2 PFm_x1x2;apply: m_mh_None. - by apply (ch_notin_dom2_mh _ _ Hmmhi Hhs). + + by apply inv_addm=>//; apply (ch_notin_dom2_mh _ _ Hmmhi Hhs). + by apply (m_mh_addh_addm _ Hmmh _ hs_hx2)=>//;apply ch_notin_dom_hs. + apply (mi_mhi_addh_addmi _ Hmmhi _ hs_hx2);last by apply ch_notin_dom_hs. by have := hinvP hs0 y2L;rewrite Hy2L /#. @@ -1363,7 +1412,7 @@ section AUX. + move=> xa hx ya hy;rewrite getP;case ((xa, hx) = (x1, hx2))=> /=. + move=> [] !-> [] !<-; exists x2 Known y2L Known. by rewrite !getP_eq /= getP_neq // eq_sym; apply (dom_hs_neq_ch _ _ _ Hhs hs_hx2). - move=> Hdiff Hxa; case Hmh=> /(_ _ _ _ _ Hxa) [] xc fx yc fy [#] Hhx Hhy HG1 _. + move=> Hdiff Hxa; case Hmh=> /(_ _ _ _ _ Hxa) [] xc fx yc fy [#] Hhx Hhy HG1 _ _. exists xc fx yc fy;rewrite !getP_neq //. + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhx). + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhy). @@ -1376,65 +1425,47 @@ section AUX. 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 getP. - case (rcons p bn = rcons p0 (v0 +^ x1)). - + move=> ^ /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 getP_eq. - move=> [v hx hy] [];rewrite getP ;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. - move=> Hdiff; case Hmh => _ ->. - apply exists_iff=> v /= ;apply exists_iff => hx /=;apply exists_iff => hy /=;split. - + move=> [Hp Hhx]. - have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. - have -> /= := build_hpath_up_None _ _ (y1L, ch0) _ _ HG1 Hp. - by rewrite getP_neq //= -negP => -[->> <<-]; move: Hhx;rewrite HG1. - rewrite getP; case ((v +^ bn, hx) = (x1, hx2))=> /=. - + move=> [<<- ->>] [+ [!<<-]]. - have Hhx2:= dom_hs_neq_ch _ _ _ _ _ Hhs hs_hx2. - move=> Hbui;have := build_hpath_down_None _ _ _ _ _ _ _ _ _ _ _ Hbui=> //. - + move=> ya;case Hmmh=> _ /(_ ya ch0);case (G1mh.[(ya, ch0)]) => //. - move=> [ya1 hy1] /(_ ya1 hy1) /=;rewrite -negP => -[xc fx yc fy [#] Hch]. - by have := dom_hs_neq_ch _ _ _ _ _ Hhs Hch. - move=>{Hbui} Hbui; have : pi0.[x2] = Some (p, v). - + by case: Hpi => ->;exists hx2. - by rewrite pi_x2 /= => -[!->>];move:Hdiff; rewrite xorwA xorwK Block.WRing.add0r. - move=> _ [+ ^ H ->] /=. apply build_hpath_down_None. - + case: Hmmh => _ /(_ _ _ _ _ H) [xc fx yc fy [#] Hch] _ _. - by apply (dom_hs_neq_ch _ _ _ Hhs Hch). - + by apply (dom_hs_neq_ch _ _ _ Hhs hs_hx2). - move=> ya; case Hmmh=> _ /(_ ya ch0); case (G1mh.[(ya, ch0)])=> //. - move=>[ya1 ha1] /(_ ya1 ha1) [xc fx yc fy [#] Hch]. - by have := dom_hs_neq_ch _ _ _ _ _ Hhs Hch. - split=> c p v;rewrite getP. case (c = y2L) => [->> /= | ?]. + + move=> p bn b; rewrite getP. + case (rcons p bn = rcons p0 (v0 +^ x1)). + + move=> ^ /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 getP_eq. + move=> [v hx hy] [];rewrite getP ;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. + move=> 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'. + by rewrite getP_neq /= ?Hhx2 // => /ch_None. + rewrite getP;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 getP. case (c = y2L) => [->> /= | Hc]. + split. + move=> [!<<-];exists ch0;rewrite getP_eq /= build_hpath_prefix. exists v0 hx2;rewrite xorwA xorwK Block.WRing.add0r getP_eq /=. have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. by apply build_hpath_up_None. - have Hhx2:= dom_hs_neq_ch _ _ _ _ _ Hhs hs_hx2. - move=> [h []];rewrite getP;case (h=ch0)=> [->> /= | Hh]. - + admit. - move=> Hbui;have := build_hpath_down_None _ _ _ _ _ _ _ _ _ _ _ Hbui=> //. - + move=> ya;case Hmmh=> _ /(_ ya ch0);case (G1mh.[(ya, ch0)]) => //. - move=> [ya1 hy1] /(_ ya1 hy1) /=;rewrite -negP => -[xc fx yc fy [#] Hch]. - by have := dom_hs_neq_ch _ _ _ _ _ Hhs Hch. - by move=> _ Hhsh;have := hinvP hs0 y2L;rewrite Hy2L /= => /(_ h Known);rewrite Hhsh. - case Hpi=> ->;apply exists_iff=> /= h;rewrite getP;case (h = ch0) => [->> /= | Hdiff]. - + split => [|/#]. - by rewrite build_hpathP=> -[_ Hch]; have := dom_hs_neq_ch _ _ _ _ _ Hhs Hch. - split=> -[+ ->] /=. - + have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. - by apply build_hpath_up_None. - have Hhx2:= dom_hs_neq_ch _ _ _ _ _ Hhs hs_hx2. - apply build_hpath_down_None=> //. - move=> ya;case Hmmh=> _ /(_ ya ch0);case (G1mh.[(ya, ch0)]) => //. - move=> [ya1 hy1] /(_ ya1 hy1) /=;rewrite -negP => -[xc fx yc fy [#] Hch]. - by have := dom_hs_neq_ch _ _ _ _ _ Hhs Hch. - (* this is the easy case *) + move=> [h []];rewrite getP build_hpath_upd_ch_iff //. + case (h=ch0)=> [->> /= [??[# H1 -> ->]]| Hh] /=. + + by case Hmh => _ _ /(_ _ _ _ _ _ Hpath H1). + by have := hinvP hs0 y2L;rewrite Hy2L /= => ->. + case Hpi => ->;apply exists_iff => h /=. + rewrite build_hpath_upd_ch_iff // getP;case (h = ch0) => [->> | //]. + split;1: by move=> [_ /(dom_hs_neq_ch _ _ _ _ _ Hhs)]. + by move=> /= [_ <<-];move:Hc. + move=> [xa xc] PFm_x1x2. rcondf{1} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom PFm_x1x2. have /m_mh_of_INV [] + _ - /(_ _ _ _ _ PFm_x1x2) := inv0. move=> [hx2 fx2 hy2 fy2] [#] hs_hx2 hs_hy2 G1mh_x1hx2. From b1d9d98c2b20d1e5b2e15c9a3ef6856080a8c400 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 26 Aug 2016 12:32:12 +0100 Subject: [PATCH 213/394] Finishing proof for inverse queries. Had to add a component to the invariant, but I'm not updating the rest of the proof to avoid conflicts with Benjamin at this stage. --- sha3/proof/core/Handle.eca | 84 +++++++++++++++++++++++++++++++++++++- 1 file changed, 83 insertions(+), 1 deletion(-) diff --git a/sha3/proof/core/Handle.eca b/sha3/proof/core/Handle.eca index 54d49c6..3a683d8 100644 --- a/sha3/proof/core/Handle.eca +++ b/sha3/proof/core/Handle.eca @@ -222,6 +222,7 @@ inductive inv_spec (m:('a,'b) fmap) mi = inductive INV_CF_G1 (hs : handles) ch (Pm Pmi Gm Gmi : smap) (mh mhi : hsmap) (ro : (block list,block) fmap) pi = | 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) @@ -297,6 +298,11 @@ lemma inv_of_INV hs ch m1 mi1 m2 mi2 ro pi inv_spec mh2 mhi2. proof. by case. qed. +lemma invG_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + inv_spec m2 mi2. +proof. by case. qed. + (** Useful Lemmas **) lemma ch_gt0 hs ch : hs_spec hs ch => 0 < ch. proof. by case=> _ + Hlt -/Hlt. qed. @@ -451,6 +457,40 @@ 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 @@ -641,6 +681,11 @@ move=> HINV x2_neq_y2 Pm_x Gm_x x2_notin_rng1_hs y2_notin_rng1_hs; split. + rewrite (@addzA ch 1 1); apply/hs_addh. + by move: HINV=> /hs_of_INV/hs_addh=> ->. by move=> f h; rewrite getP; case: (h = ch)=> [/#|_]; exact/y2_notin_rng1_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_notin_rng1_hs. + apply/inv_addm; 1:by case: HINV. + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. by apply/(ch_notin_dom2_mh _ _ Hm_mh Hhs). @@ -731,6 +776,11 @@ move=> HINV x2_neq_y2 Pm_x Gm_x xc_notin_rng1_hs yc_notin_rng1_hs; split. + rewrite (@addzA ch 1 1); apply/hs_addh. + by move: HINV=> /hs_of_INV/hs_addh=> ->. by move=> f h; rewrite getP; case: (h = ch)=> [/#|_]; exact/yc_notin_rng1_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_notin_rng1_hs. + apply/inv_addm; 1:by case: HINV. + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. by apply/(Sch_notin_dom2_mh _ _ Hm_mh Hhs). @@ -818,6 +868,11 @@ proof. move=> HINV PFm_x1x2 G1m_x1x2 pi_x2 hs_hx y2_notin_rng1_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_notin_rng1_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). @@ -899,6 +954,11 @@ proof. move=> HINV PFmi_x1x2 G1mi_x1x2 hs_hx y2_notin_rng1_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_notin_rng1_hs. + apply/inv_addm; 1:by case: HINV. + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. by apply/(ch_notin_dom2_mh _ _ Hm_mh Hhs). @@ -993,6 +1053,13 @@ 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 anda_and -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. @@ -1207,7 +1274,22 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] rewrite getP /= oget_some /=. by apply/lemma2'=> // f h; exact/y2_notin_rng1_hs. rcondf{1} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Pmi_xaxc. -admit. (* more things *) +case @[ambient]: {-1}(Gmi.[(xa,xc)]) (eq_refl Gmi.[(xa,xc)])=> [|[ya' yc'] ^] Gmi_xaxc. ++ rcondt{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. + conseq (_: _ ==> G1.bext{2})=> //. + auto=> &1 &2 [#] !<<- _ -> ->> _ />. + rewrite !in_rng; 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.DWord.bdistr_uf Capacity.DWord.cdistr_uf). +have /incli_of_INV <- := inv0; 1:by rewrite Gmi_xaxc. +rewrite Pmi_xaxc=> /= [#] <<*>. +rcondf{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. +by auto=> &1 &2 /#. qed. section AUX. From 5a407d9d2f8a4fe6d6ae66cf15411c4c3ca3b95f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 26 Aug 2016 12:51:48 +0100 Subject: [PATCH 214/394] Actually finishing the proof. --- sha3/proof/core/Handle.eca | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/sha3/proof/core/Handle.eca b/sha3/proof/core/Handle.eca index 3a683d8..73249f7 100644 --- a/sha3/proof/core/Handle.eca +++ b/sha3/proof/core/Handle.eca @@ -991,7 +991,11 @@ split. + move=> p ya b; have /mh_of_INV [] _ -> _ := HINV. apply/exists_iff=> v /=; apply/exists_iff=> hx' /=; apply/exists_iff=> hy' /=. split=> [#]. - + admit. + + move=> /(@build_hpath_up _ y1 ch x1 hx) /(_ _). + + apply/(@notin_hs_notin_dom2_mh hs PFm)/(ch_notin_dom_hs); by case: HINV. + move=> -> /=; rewrite getP /=; 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. From b9faf66f1c049c4020cf3b9ac4e6ddef71c3d8a6 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 26 Aug 2016 07:59:30 -0400 Subject: [PATCH 215/394] The lemma Benjamin renamed was used later on, so made the change there. --- sha3/proof/Common.ec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 35a95ef..4ebce78 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -578,7 +578,7 @@ have xs_non_nil : 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 b0 in xs_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 From 4aeea267d2174c6f9f367def65cdff8911c41722 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 26 Aug 2016 13:31:44 +0100 Subject: [PATCH 216/394] Propagating new invariant through. --- sha3/proof/core/Handle.eca | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/sha3/proof/core/Handle.eca b/sha3/proof/core/Handle.eca index 73249f7..799ff4f 100644 --- a/sha3/proof/core/Handle.eca +++ b/sha3/proof/core/Handle.eca @@ -1478,7 +1478,7 @@ section AUX. rewrite !getP_eq pi_x2 !oget_some /=. have /hs_of_INV [] Hu _ _:= inv0; have -> := huniq_hinvK_h _ _ _ Hu hs_hx2. rewrite oget_some -!nor => /= -[] ? Hy2L [*]. - case:inv0=> Hhs Hinv Hmmh Hmmhi Hincl Hincli Hmh Hpi. + case:inv0=> Hhs Hinv HinvG Hmmh Hmmhi Hincl Hincli Hmh Hpi. 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) /=. @@ -1489,6 +1489,10 @@ section AUX. 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 Hy2L => H _ + /H {H} [hx fx hy fy] [#]. + by case: (hinvP hs0 y2L)=> [_ ->|//]. + by apply inv_addm=>//; apply (ch_notin_dom2_mh _ _ Hmmhi Hhs). + by apply (m_mh_addh_addm _ Hmmh _ hs_hx2)=>//;apply ch_notin_dom_hs. + apply (mi_mhi_addh_addmi _ Hmmhi _ hs_hx2);last by apply ch_notin_dom_hs. @@ -1627,6 +1631,7 @@ section AUX. by case: (h1 = 0); case: (h2 = 0)=> //=. + by rewrite getP. + by move=> ? h; rewrite getP map0P; case: (h = 0). + + by move=> ? ?; rewrite !map0P. by move=> ? ?; rewrite !map0P. qed. From f7c1b757286fe757f0e1159128a88946790479c3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 29 Aug 2016 11:18:40 +0100 Subject: [PATCH 217/394] Starting relation of security of core to security of BlockSponge. BlockSponge is used as assumption in top-level proof. There are some things that need thought about regarding what valid queries are and what we should do on invalid queries. --- sha3/proof/IRO.eca | 36 ------- sha3/proof/core/CoreToBlockSponge.eca | 144 ++++++++++++++++++++++++++ 2 files changed, 144 insertions(+), 36 deletions(-) create mode 100644 sha3/proof/core/CoreToBlockSponge.eca diff --git a/sha3/proof/IRO.eca b/sha3/proof/IRO.eca index e957130..cff25e3 100644 --- a/sha3/proof/IRO.eca +++ b/sha3/proof/IRO.eca @@ -121,39 +121,3 @@ module IRO' : IRO = { return b; } }. - -(* -another implementation, but probably not useful - -module IRO : IRO = { - var mp : (from, to list) fmap - - proc init() = { mp = map0; } - - proc choose(n) = { - var b, bs; - - bs <- []; - while (0 < n) { - b <$ dto; - bs <- rcons bs b; - n <- n - 1; - } - return bs; - } - - proc f(x, n) = { - var ys, zs, aout; - - aout <- []; - if (valid x) { - ys <- odflt [] mp.[x]; - zs <@ choose (max 0 (n - size ys)); - mp.[x] <- ys ++ zs; - aout <- take n (oget mp.[x]); - } - - return aout; - } -}. -*) diff --git a/sha3/proof/core/CoreToBlockSponge.eca b/sha3/proof/core/CoreToBlockSponge.eca new file mode 100644 index 0000000..640d086 --- /dev/null +++ b/sha3/proof/core/CoreToBlockSponge.eca @@ -0,0 +1,144 @@ +(* -------------------------------------------------------------------- *) +require import Option Pair Int Real Distr List FSet NewFMap DProd. +require import BlockSponge Gconcl. + +(*---*) import Common Perm. + +(* -------------------------------------------------------------------- *) +section PROOF. + declare module D:DISTINGUISHER { Perm, Gconcl.IF, SLCommon.C, Gconcl.S, BIRO.IRO }. + + module Wrap (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + module WF = { + proc f(x : block list * int) = { + var r <- []; + var p, n; + + (p,n) <- x; + if (valid_block p /\ 0 < n) { + r <@ F.f(x); + } + return r; + } + } + + proc distinguish = D(WF,P).distinguish + }. + + module LowerF (F:DFUNCTIONALITY) = { + proc f(m:block list) : block = { + var r <- []; + var p, n; + + (p,n) <- strip m; + if (p <> []) { + r <- F.f(p,n); + } + return last b0 r; + } + }. + + module RaiseF (F:SLCommon.DFUNCTIONALITY) = { + proc f(m:block list, n:int) : block list = { + var i, r, b; + r <- []; + + if (m <> []) { + i <- 0; + b <- b0; + while (i < n) { + b <- F.f(extend m i); + r <- rcons r b; + i <- i + 1; + + } + } + return r; + } + }. + + module LowerDist(D : DISTINGUISHER, F : SLCommon.DFUNCTIONALITY) = + D(RaiseF(F)). + + module RaiseSim(S:SLCommon.SIMULATOR, F:DFUNCTIONALITY) = + S(LowerF(F)). + + local equiv f_f: BIRO.IRO.f ~ RaiseF(Gconcl.IF).f: + ={n} /\ x{1} = m{2} + /\ 0 <= n{2} + /\ valid_block x{1} + /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) + /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p]) + ==> ={res} + /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) + /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p]). + proof. + proc. rcondt{2} 2; 1:by auto=> /#. rcondt{1} 3; 1:by auto=> /#. + inline *. wp. + while ( ={i,n} /\ x{1} = m{2} /\ bs{1} = r{2} + /\ 0 <= i{2} <= n{2} + /\ last b0 x{1} <> b0 + /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) + /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p])). + + sp; if{1}. + + rcondt{2} 2. + + auto=> &hr [#] !->> i_ge0 i_lt_n wf hinv1 hinv2 _ _ + _ _. + by rewrite !in_dom /= hinv2 extendK. + auto=> &1 &2 /= [#] !->> i_ge0 _ wf inv1 inv2 i_lt_n _. + rewrite in_dom wf=> mp_xi r -> /=; split; first by rewrite !getP. + split=> [/#|]; split=> [p n|p]. + + by rewrite getP; case: ((p,n) = (m,i){2})=> [[#] <*>|_ /inv1]. + rewrite !getP; case: (strip p = (m,i){2})=> [strip_p|]. + + by have := stripK p; rewrite strip_p=> /= ->. + case: (p = extend m{2} i{2})=> [<*>|_ _]; first by rewrite extendK. + exact/inv2. + rcondf{2} 2. + + auto=> &hr [#] !->> i_ge0 i_lt_n wf hinv1 hinv2 _ _ + _ _. + by rewrite !in_dom /= hinv2 extendK. + by auto=> &1 &2; smt (DWord.bdistr_ll extendK). + by auto; smt (valid_block_ends_not_b0). + qed. + + lemma conclusion &m: + `| Pr[RealIndif(Sponge,Perm,Wrap(D)).main() @ &m : res] + - Pr[IdealIndif(BIRO.IRO,RaiseSim(Gconcl.S),Wrap(D)).main() @ &m : res] | + = `| Pr[SLCommon.RealIndif(SLCommon.SqueezelessSponge,SLCommon.PC(Perm),LowerDist(Wrap(D))).main() @ &m : res] + - Pr[SLCommon.IdealIndif(Gconcl.IF,Gconcl.S,LowerDist(Wrap(D))).main() @ &m : res] |. + proof. + do 3?congr. + + byequiv (_: ={glob D} ==> _)=> //; proc; inline *. + call (_: ={glob Perm}). + + by proc; inline *; wp; sim. + + by proc; inline *; wp; sim. + + proc; sp; if=> //. + call (_: ={glob Perm, arg} + /\ valid_block xs{1} /\ 0 < n{1} + ==> ={glob Perm, res}). + + proc. rcondt{1} 4; 1:by auto. rcondt{2} 2; 1:by auto; smt (valid_block_ends_not_b0). + rcondt{2} 4; 1:by auto. + inline{2} SLCommon.SqueezelessSponge(SLCommon.PC(Perm)).f. + seq 4 6: ( ={glob Perm, n, i, sa, sc} + /\ (* some notion of path through Perm.m *) true). + + while ( ={glob Perm, sa, sc} + /\ xs{1} = p{2} + /\ (* some notion of path through Perm.m *) true). + + wp; call (_: ={glob Perm}). + + by inline *; wp; sim. + by auto=> /> /#. + by auto=> &1 &2 [#] !<<- vblock n_gt0 /=; rewrite /extend nseq0 cats0. + (* make sure that the notion of path guarantees that only the last call of each iteration adds something to the map, and that it is exactly the right call *) + admit. + by auto=> /#. + by auto. + byequiv (_: ={glob D} ==> _)=> //; proc; inline *. + call (_: ={glob S} + /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) + /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p]) + /\ (* relation between S.paths and presence in the RO map *) true). + + proc. if=> //=; last by auto. if=> //=; last by auto. + inline *. admit. (* something about valid queries *) + + admit. (* prove: S(LowerF(BIRO.IRO)).fi ~ S(IF).fi *) + + by proc; sp; if=> //; call (f_f); auto=> /#. + by auto=> />; split=> [?|] ?; rewrite !map0P. + qed. +end section PROOF. From 0c897f81b59421abaddda80616762c2213af21c3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 29 Aug 2016 11:19:56 +0100 Subject: [PATCH 218/394] Whitespace. --- sha3/proof/core/Handle.eca | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/proof/core/Handle.eca b/sha3/proof/core/Handle.eca index 799ff4f..9fe7f89 100644 --- a/sha3/proof/core/Handle.eca +++ b/sha3/proof/core/Handle.eca @@ -648,7 +648,7 @@ lemma path_split hs ch m mh xc hx p xa: /\ build_hpath mh pk = Some (ya,hy) /\ hs.[hy] = Some (yc,Known) /\ mh.[(ya +^ b,hy)] = Some (za,hz) - /\ hs.[hz] = Some (zc,Unknown). + /\ hs.[hz] = Some (zc,Unknown). proof. move=> Ihs [] _ Imh_m. elim/last_ind: p hx xa xc=> [hx xa xc + /build_hpathP [_ <*>|/#]|]. From 0dccdd5606f297dd14c426a9cb06817c879dd001 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 31 Aug 2016 12:15:47 +0100 Subject: [PATCH 219/394] Isolating known statements for the Core Construction. --- sha3/proof/core/Core.eca | 306 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 306 insertions(+) create mode 100644 sha3/proof/core/Core.eca diff --git a/sha3/proof/core/Core.eca b/sha3/proof/core/Core.eca new file mode 100644 index 0000000..cb39bc3 --- /dev/null +++ b/sha3/proof/core/Core.eca @@ -0,0 +1,306 @@ +require import Pred Fun Option Pair Int Real List FSet NewFMap NewDistr. +require import StdOrder Ring DProd. +(*---*) import IntOrder. + +require (*..*) RP Indifferentiability. + +(*** THEORY PARAMETERS ***) +(** Block/Rate **) +theory Block. + op r : int. + axiom r_ge0: 0 <= r. + + type block. + + op b0: block. + op (+^): block -> block -> block. + + axiom addbA b1 b2 b3: b1 +^ (b2 +^ b3) = b1 +^ b2 +^ b3. + axiom addbC b1 b2: b1 +^ b2 = b2 +^ b1. + axiom add0b b: b0 +^ b = b. + axiom addbK b: b +^ b = b0. + + op enum: block list. + axiom block_enum b: count (pred1 b) enum = 1. + axiom card_block: size enum = 2^r. + + clone import Ring.ZModule as BlockMonoid with + type t <- block, + op zeror <- b0, + op ( + ) <- (+^), + op [ - ] (b : block) <- b + proof *. + realize addrA by exact/addbA. + realize addrC by exact/addbC. + realize add0r by exact/add0b. + realize addNr by exact/addbK. + + clone import MFinite as DBlock with + type t <- block, + op Support.enum <- enum + rename "dunifin" as "bdistr" + "duniform" as "bdistr" + proof *. + realize Support.enum_spec by exact/block_enum. +end Block. +import Block DBlock. + +(** Capacity **) +theory Capacity. + op c : int. + axiom c_ge0: 0 <= c. + + type capacity. + + op c0: capacity. + + op enum: capacity list. + axiom capacity_enum b: count (pred1 b) enum = 1. + axiom card_capacity: size enum = 2^c. + + clone import MFinite as DCapacity with + type t <- capacity, + op Support.enum <- enum + rename "dunifin" as "cdistr" + "duniform" as "cdistr" + proof *. + realize Support.enum_spec by exact/capacity_enum. +end Capacity. +import Capacity DCapacity. + +(** Validity of Functionality Queries **) +op valid: block list -> bool. +axiom valid_not_nil m: valid m => m <> []. + +(** Adversary's Query Cost **) +op max_query: int. +axiom max_query_ge0: 0 <= max_query. + +(*** DEFINITIONS ***) +type state = block * capacity. +op dstate = bdistr `*` cdistr. + +(** Indifferentiability Experiment **) +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". + +(** Query Counting **) +module C = { + var c:int + proc init() = { c <- 0; } +}. + +module PC (P : PRIMITIVE) : PRIMITIVE = { + proc init () = { + C.init(); + P.init(); + } + + proc f (x : state) = { + var y; + + C.c <- C.c + 1; + y <@ P.f(x); + return y; + } + + proc fi(x : state) = { + var y; + + C.c <- C.c + 1; + y <@ P.fi(x); + return y; + } +}. + +module DPRestr (P : DPRIMITIVE) : DPRIMITIVE = { + proc f (x : state) = { + var y <- (b0,c0); + + if (C.c + 1 <= max_query) { + C.c <- C.c + 1; + y <@ P.f(x); + } + return y; + } + + proc fi(x : state) = { + var y <- (b0,c0); + + if (C.c + 1 <= max_query) { + C.c <- C.c + 1; + y <@ P.fi(x); + } + return y; + } +}. + +module PRestr (P : PRIMITIVE) : PRIMITIVE = { + proc init () = { + C.init(); + P.init(); + } + + proc f = DPRestr(P).f + proc fi = DPRestr(P).fi +}. + +module FC (F : FUNCTIONALITY) : FUNCTIONALITY = { + proc init = F.init + + proc f (p : block list) = { + var b <- witness; + + if (valid p) { + C.c <- C.c + size p; + b <@ F.f(p); + } + return b; + } +}. + +module DFRestr (F : DFUNCTIONALITY) : DFUNCTIONALITY = { + proc f (bs : block list) = { + var b <- b0; + + if (C.c + size bs <= max_query) { + C.c <- C.c + size bs; + b <@ F.f(bs); + } + return b; + } +}. + +module FRestr(F : FUNCTIONALITY) : FUNCTIONALITY = { + proc init = F.init + proc f = DFRestr(F).f +}. + +module (DRestr (D : DISTINGUISHER) : DISTINGUISHER) + (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + proc distinguish() = { + var b; + + C.init(); + b <@ D(DFRestr(F), DPRestr(P)).distinguish(); + return b; + } +}. + +(** Ideal Primitive **) +clone import RP as Perm with + type t <- block * capacity, + op dt <- bdistr `*` cdistr + rename + [module type] "RP" as "PRIMITIVE" + [module] "P" as "Perm". + +(** Core Construction **) +module (Core : CONSTRUCTION) (P:DPRIMITIVE): FUNCTIONALITY = { + proc init () = {} + + proc f(p : block list): block = { + var (sa,sc) <- (b0,c0); + + while (p <> []) { + (sa,sc) <@ P.f((sa +^ head witness p,sc)); + p <- behead p; + } + return sa; + } +}. + +(** Ideal Core Functionality **) +module ICore: FUNCTIONALITY = { + var m : (block list,block) fmap + + proc init() = { + m = map0; + } + + proc f(p : block list): block = { + var r <- witness; + + if (valid p) { + if (!mem (dom m) p) { + m.[p] <$ bdistr; + } + r <- oget m.[p]; + } + return r; + } +}. + +(** Core Simulator **) +module (S : SIMULATOR) (F : DFUNCTIONALITY) : PRIMITIVE = { + var m, mi : (state,state) fmap + var pi : (capacity, block list * block) fmap + + proc init() = { + m <- map0; + mi <- map0; + pi <- map0.[c0 <- ([<:block>],b0)]; + } + + proc f(x : state): state = { + var p, v, y, y1, y2; + + if (!mem (dom m) x) { + if (mem (dom pi) x.`2) { + (p,v) <- oget pi.[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 (mem (dom pi) x.`2) { + (p,v) <- oget pi.[x.`2]; + pi.[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 (!mem (dom mi) x) { + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + mi.[x] <- y; + m.[y] <- x; + } else { + y <- oget mi.[x]; + } + return y; + } +}. + +(*** PROOF ***) +(** TODO -- This is not indifferentiability -- clean up and fix **) +(** However, this is what's proven (modulo the additional validity + check in ICore, not present in IF. The validity checks may be + problematic in combination with counting, so we need to make sure + both are present throughout before diving in. **) +lemma CoreIndiff (D <: DISTINGUISHER {C, Perm, Core, ICore, S}) &m: + (forall (F <: DFUNCTIONALITY {D}) (P <: DPRIMITIVE {D}), + islossless P.f + => islossless P.fi + => islossless F.f + => islossless D(F,P).distinguish) + => Pr[RealIndif(Core,PC(Perm),D).main() @ &m: res /\ C.c <= max_query] + <= Pr[IdealIndif(ICore,S,DRestr(D)).main() @ &m :res] + + (max_query ^ 2)%r / (2^(r + c))%r + + max_query%r * ((2*max_query)%r / (2^c)%r) + + max_query%r * ((2*max_query)%r / (2^c)%r). +abort. From 1e62ac05be24f60de6b72f6f1ac7314488a554b8 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Wed, 31 Aug 2016 15:32:27 +0200 Subject: [PATCH 220/394] almost the end of core --- sha3/proof/core/Handle.eca | 227 ++++++++++++++++++++++++++++++++++--- 1 file changed, 212 insertions(+), 15 deletions(-) diff --git a/sha3/proof/core/Handle.eca b/sha3/proof/core/Handle.eca index 9fe7f89..0905386 100644 --- a/sha3/proof/core/Handle.eca +++ b/sha3/proof/core/Handle.eca @@ -416,41 +416,41 @@ case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|Hhy'|Hhx'|Hhx' Hhy']. by exists xc' fx' yc' fy'; rewrite !getP Hhx' Hhy'. qed. -lemma m_mh_addh_addm hs Pm mh hx xa xc hy ya yc f: +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,Known)] Pm.[(xa,xc) <- (ya,yc)] mh.[(xa,hx) <- (ya,hy)]. + 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 getP. + case: ((xa0,xc0) = (xa,xc))=> [[#] <<*> [#] <<*>|] /=. - + by exists hx f hy Known; rewrite !getP /= /#. + + by exists hx f hy f'; rewrite !getP /= /#. move=> xaxc0_neq_xaxc /Hm_mh [hx0 fx0 hy0 fy0] [#] hs_hx0 hs_hy0 mh_xahx0. by exists hx0 fx0 hy0 fy0; rewrite !getP /#. case: ((xa0,hx0) = (xa,hx))=> [[#] <*>> [#] <<*>|] /=. -+ by exists xc f yc Known; rewrite !getP /= /#. ++ by exists xc f yc f'; rewrite !getP /= /#. rewrite anda_and=> /negb_and xahx0_neq_xahx /Hmh_m [xc0 fx0 yc0 fy0] [#] hs_hx0 hs_hy0 Pm_xaxc0. exists xc0 fx0 yc0 fy0; rewrite !getP; 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: +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,Known)] mi.[(ya,yc) <- (xa,xc)] mhi.[(ya,hy) <- (xa,hx)]. + 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 getP; case: ((ya0,yc0) = (ya,yc))=> [[#] <*>> [#] <*>>|]. - + by exists hy Known hx fx; rewrite !getP /= /#. + + by exists hy fy hx fx; rewrite !getP /= /#. move=> yayc0_neq_yayc /Hm_mh [hy0 fy0 hx0 fx0] [#] hs_hy0 hs_hx0 mhi_yayc0. by exists hy0 fy0 hx0 fx0; rewrite !getP /#. move=> ya0 hy0 xa0 hx0; rewrite getP; case: ((ya0,hy0) = (ya,hy))=> [[#] <*>> [#] <<*>|]. -+ by exists yc Known xc fx; rewrite !getP //= /#. ++ by exists yc fy xc fx; rewrite !getP //= /#. rewrite /= anda_and=> /negb_and yahy0_neq_yahy /Hmh_m [yc0 fy0 xc0 fx0] [#] hs_hy0 hs_hx0 mi_yayc0. exists yc0 fy0 xc0 fx0; rewrite !getP; do !split=> [/#|/#|]. move: yahy0_neq_yahy; case: (ya0 = ya)=> [<<*> //=|/#]; case: (yc0 = yc)=> [<*>> /=|//=]. @@ -696,7 +696,7 @@ move=> HINV x2_neq_y2 Pm_x Gm_x x2_notin_rng1_hs y2_notin_rng1_hs; split. + by move: HINV => /hs_of_INV /hs_addh /(_ x2 Known _) // []. + by rewrite getP. by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. -+ apply/(@mi_mhi_addh_addmi hs.[ch <- (x2,Known)] Pmi mhi ch x1 x2 (ch + 1) y1 y2 Known). ++ 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 getP; case: (h = ch)=> [_ //=|_ //=]; first by rewrite x2_neq_y2. by rewrite y2_notin_rng1_hs. @@ -786,7 +786,7 @@ move=> HINV x2_neq_y2 Pm_x Gm_x xc_notin_rng1_hs yc_notin_rng1_hs; split. by apply/(Sch_notin_dom2_mh _ _ Hm_mh Hhs). have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. by apply/(ch_notin_dom2_mh _ _ Hmi_mhi Hhs). -+ apply/(@mi_mhi_addh_addmi hs.[ch <- (x2,Known)] Pm mh ch x1 x2 (ch + 1) y1 y2 Known). ++ 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 getP; case: (h = ch)=> [<*> /#|]; rewrite yc_notin_rng1_hs. + by rewrite getP. @@ -879,10 +879,10 @@ split. have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. by apply/(ch_notin_dom2_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 Hhuniq hs_hx _) //. + move=> /m_mh_addh_addm /(_ hx x1 x2 ch y1 y2 Known Known Hhuniq hs_hx _) //. exact/ch_notin_dom_hs. + have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /mi_mhi_of_INV := HINV. - move=> /mi_mhi_addh_addmi /(_ hx x1 x2 ch y1 y2 Known _ hs_hx _) //. + move=> /mi_mhi_addh_addmi /(_ hx x1 x2 ch y1 y2 Known Known _ hs_hx _) //. exact/ch_notin_dom_hs. + by have /incl_of_INV/incl_addm ->:= HINV. + by have /incli_of_INV/incl_addm ->:= HINV. @@ -965,10 +965,10 @@ split. 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 _ hs_hx _) //. + move=> /mi_mhi_addh_addmi /(_ hx x1 x2 ch y1 y2 Known Known _ hs_hx _) //. exact/ch_notin_dom_hs. + have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /mi_mhi_of_INV := HINV. - move=> /m_mh_addh_addm /(_ hx x1 x2 ch y1 y2 Known _ hs_hx _) //. + move=> /m_mh_addh_addm /(_ hx x1 x2 ch y1 y2 Known Known _ hs_hx _) //. exact/ch_notin_dom_hs. + by have /incl_of_INV/incl_addm ->:= HINV. + by have /incli_of_INV/incl_addm ->:= HINV. @@ -1296,6 +1296,203 @@ rcondf{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. by auto=> &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 => !mem (dom m2) x => incl m1 m2.[x <- y]. +proof. + move=> Hincl Hdom w ^/Hincl <- => Hw. + rewrite getP_neq // -negP => ->>. + by move: Hdom;rewrite in_dom. +qed. + + + +equiv PFf_Cf (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1(D).C.f : + ! (G1.bcol{2} \/ G1.bext{2}) /\ + ={p} /\ p{1} <> [] /\ + 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} ==> + ! (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}. +proof. + proc; seq 2 4: + ((!(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} /\ + F.RO.m.[p]{2} = Some sa{1})));last first. + + case : (! (G1.bcol{2} \/ G1.bext{2})); + 2: by conseq (_:_ ==> true)=> //; inline *;auto;rewrite Block.DWord.bdistr_ll. + inline *; rcondf{2} 3. + + by move=> &m;auto=> &hr [#] H /H[_ H1] ??;rewrite in_dom H1. + by auto=> /> &m1 &m2;rewrite Block.DWord.bdistr_ll /= => H /H [-> ->];rewrite oget_some. + while ( + p{1} = (drop i p){2} /\ (0 <= i <= size p){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} /\ + ={sa} /\ + (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})));last first. + + auto=> &m1 &m2 [#] -> -> Hp ^ Hinv -> /=;rewrite drop0 size_ge0 /=;split. + + split;[split|];1: by exists Known;case Hinv => -[] _ ->. + + by rewrite take0. + by case (p{m2}) => //=;smt w=size_ge0. + move=> ????? ????? ?? iR ? ->> ?[#] _ ?? H /H{H} [#] -> ->> _ ?. + have -> : iR = size p{m2} by smt (). + have -> /= : size p{m2} <> 0 by smt (size_ge0). + by rewrite take_size. + inline *;sp 1 0;wp=> /=. + conseq (_: _ ==> (! (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} /\ + (oget PF.m{1}.[x{1}]).`1 = sa{2} /\ + (exists (f : flag), FRO.m{2}.[h{2}] = Some ((oget PF.m{1}.[x{1}]).`2, f)) /\ + (build_hpath G1.mh (take (i + 1) p) = Some (sa,h)){2} /\ + if i{2} + 1 = 0 then sa{2} = b0 && h{2} = 0 + else F.RO.m{2}.[take (i{2} + 1) p{2}] = Some (oget PF.m{1}.[x{1}]).`1)). + + move=> &m1 &m2 [#] 2!->> ?? H ?? ?????????? H'. + rewrite behead_drop -drop_add //=;split=>[/#|]. + by have := size_drop (i{m2} + 1) p{m2};case (drop (i{m2} + 1) p{m2}) => //= [/#| ];smt w=size_ge0. + case ((G1.bcol{2} \/ G1.bext{2})). + + wp;conseq (_: _ ==> (G1.bcol{2} \/ G1.bext{2}))=> //. + by if{1};if{2};auto;2:(swap{2} 4 -3;auto); smt w=(Block.DWord.bdistr_ll DWord.cdistr_ll). + conseq (_: (x{1} = (sa{1} +^ head witness p{1}, sc{1}) /\ + (p{1} = drop i{2} p{2} /\ + 0 <= i{2} <= size p{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} /\ + ={sa} /\ + (exists (f : flag), FRO.m{2}.[h{2}] = Some (sc{1}, f)) /\ + (build_hpath G1.mh (take i p) = Some (sa,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})) /\ + p{1} <> [] /\ i{2} < size p{2}) /\ + ! (G1.bcol{2} \/ G1.bext{2}) /\ + (mem (dom PF.m) x){1} = (mem (dom G1.mh) (sa +^ nth witness p i, h)){2} ==> _). + + move=> &m1 &m2 [#] 2!->> ?? H ?? ^ /H [#] /= Hinv ->> Hf -> -> ? /= />. + case: Hf=> f Hm; rewrite head_nth nth_drop // addz0 !in_dom. + pose X := sa{m2} +^ nth witness p{m2} i{m2}. + case (Hinv)=> -[Hu _ _] _ _ [] /(_ X sc{m1}) Hpf ^ HG1 /(_ X h{m2}) Hmh _ _ _ _ _. + case: {-1}(PF.m{m1}.[(X,sc{m1})]) (eq_refl (PF.m{m1}.[(X,sc{m1})])) Hpf Hmh. + + case (G1.mh{m2}.[(X, h{m2})]) => //= -[ya hy] Hpf. + by rewrite -negP => /(_ ya hy) [] ????[#];rewrite Hm /= => -[<-];rewrite Hpf. + move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. + rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _. + by have /= <<- -> := Hu _ _ _ _ Hm Hhx. + if{1};[rcondf{2} 1| rcondt{2} 1];1,3:(by auto;smt ());last first. + + auto => /> /= &m1 &m2 ?? [] Hhs Hinv Hinvi Hmmh Hmmhi Hincl Hincli Hmh Hpi f. + rewrite head_nth nth_drop // addz0 => Heq Hbu ????. + rewrite !in_dom. + have -> /= : i{m2} + 1 <> 0 by smt (). + pose sa' := sa{m2} +^ nth witness p{m2} i{m2}. + case (Hmmh) => /(_ sa' sc{m1});case (PF.m{m1}.[(sa', sc{m1})])=> //= -[ya yc] /(_ ya yc) /=. + move=> [hx fx hy fy]; case (Hhs) => Hu _ _ [#] Heq'. + have /= <<- /= Hhy ^? ->:= Hu _ _ _ _ Heq Heq'. + rewrite !oget_some /= => _;split;1: by exists fy. + rewrite (@take_nth witness) 1://. + case (Hmh) => _ -> _;rewrite build_hpath_prefix Hbu /#. + rcondt{2} 5. + + move=> &m;auto=> &hr /> ?? Hinv f. + rewrite head_nth nth_drop // addz0; pose sa' := sa{hr} +^ nth witness p{hr} i{hr}. + move=> ?Hbu????->Hmem ????. + case (Hinv) => ??????? [] H1 H2 H3 ?. + rewrite (@take_nth witness) 1:// -negP in_dom. + pose p' := (take i{hr} p{hr}); pose w:= (nth witness p{hr} i{hr}). + case {-1}(F.RO.m{hr}.[rcons p' w]) (eq_refl (F.RO.m{hr}.[rcons p' w]))=> //. + move=> ? /H2 [???];rewrite Hbu => -[] [!<<-] HG1. + by move: Hmem;rewrite in_dom HG1. + swap{2} 4 -3;auto => &m1 &m2 [#] 2!->?? [] Hhs Hinv Hinvi Hmmh Hmmhi Hincl Hincli Hmh Hpi -> /=. + move=> Hsc Hpa Hif Hdrop Hlt Hbad. + rewrite head_nth nth_drop // addz0; pose sa' := sa{m2} +^ nth witness p{m2} i{m2}. + move=> Heq Hdom y1L-> /= y2L-> /=. + have -> /= : i{m2} + 1 <> 0 by smt (). + rewrite !getP_eq !oget_some /=. + pose p' := (take (i{m2} + 1) p{m2});rewrite -!nor=> [#] ? /= Hy2 ?. + split;last first. + + split;1: by exists Unknown. + rewrite /p' (@take_nth witness) 1:// build_hpath_prefix. + exists sa{m2} h{m2}. + rewrite /sa' getP_eq /=;apply build_hpath_up => //. + by move: Hdom;rewrite Heq /sa' in_dom. + have Hy1L := ch_notin_dom2_mh _ _ _ y1L G1.chandle{m2} Hmmhi Hhs. + have := hinvP FRO.m{m2} y2L;rewrite Hy2 /= => Hy2L. + have g1_sa' : G1.mh{m2}.[(sa', h{m2})] = None by move: Hdom;rewrite Heq in_dom. + case :Hsc => f Hsc; have Hh := dom_hs_neq_ch _ _ _ _ _ Hhs Hsc. + have Hch : FRO.m{m2}.[G1.chandle{m2}] = None. + + case Hhs => _ _ H. + by case {-1}(FRO.m{m2}.[G1.chandle{m2}]) (eq_refl (FRO.m{m2}.[G1.chandle{m2}])) => // ? /H. + have Hy2_mi: ! mem (dom PF.mi{m1}) (y1L, y2L). + + rewrite in_dom;case {-1}( PF.mi{m1}.[(y1L, y2L)]) (eq_refl (PF.mi{m1}.[(y1L, y2L)])) => //. + by move=> [] ??;case Hmmhi=> H _ /H [] ????;rewrite Hy2L. + have ch_0 := ch_neq0 _ _ Hhs. + have ch_None : + forall xa xb ha hb, G1.mh{m2}.[(xa,ha)] = Some(xb, hb) => + ha <> G1.chandle{m2} /\ hb <> G1.chandle{m2}. + + 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 => // ??;apply Hy2L. + + by apply inv_addm. + + by apply (m_mh_addh_addm f) => //;case Hhs. + + by apply (mi_mhi_addh_addmi f)=> // ??;apply Hy2L. + + by apply incl_upd_nin. + + by apply incl_upd_nin. + + case (Hmh)=> H1 H2 H3;split. + + move=> xa hx ya hy;rewrite getP;case((xa, hx) = (sa', h{m2}))=> [[2!->>] [2!<<-] | Hdiff]. + + exists sc{m1} f y2L Unknown. + rewrite getP_eq getP_neq 1:eq_sym //= Hsc /=. + exists (take i{m2} p{m2}) sa{m2}. + rewrite /p' (@take_nth witness) 1:// /sa' xorwA xorwK xorwC xorw0 getP_eq /=. + by apply build_hpath_up_None. + move=> /H1 [xc fx yc fy] [#] Hhx Hhy Hfy; exists xc fx yc fy. + rewrite !getP_neq. + + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhx). + + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhy). + rewrite Hhx Hhy /=;case: fy Hhy Hfy => //= Hhy [p v [Hro Hpath]]. + exists p v;rewrite getP_neq 1:-negP 1:/p' 1:(@take_nth witness) 1://. + + move => ^ /rconssI <<-;move: Hpath;rewrite Hpa=> -[!<<-] /rconsIs Heq'. + by move:Hdiff=> /=;rewrite /sa' Heq' xorwA xorwK xorwC xorw0. + by rewrite Hro /=;apply build_hpath_up_None. + + move=> p1 bn b; rewrite getP /p' (@take_nth witness) //. + case (rcons p1 bn = rcons (take i{m2} p{m2}) (nth witness p{m2} i{m2})). + + move=> ^ /rconssI ->> /rconsIs ->> /=; split => [<<- | ]. + + exists sa{m2} h{m2} G1.chandle{m2}. + by rewrite /sa' getP_eq /= (build_hpath_up Hpa) //. + move=> [v hx hy []] Heq1;rewrite getP /sa'. + case ((v +^ nth witness p{m2} i{m2}, hx) = (sa{m2} +^ nth witness p{m2} i{m2}, h{m2})) => //. + have := build_hpath_up_None G1.mh{m2} (sa', h{m2}) (y1L, G1.chandle{m2}) _ _ g1_sa' Hpa. + by rewrite Heq1 => -[!->>]. + move=> Hdiff;rewrite H2. + apply exists_iff=> v /= ;apply exists_iff => hx /=;apply exists_iff => hy /=. + have Hhx2 := dom_hs_neq_ch _ _ _ _ _ Hhs Hsc. + rewrite build_hpath_upd_ch_iff //. + case (hx = G1.chandle{m2}) => [->>|?]. + + split;1: by move=> [] _ /ch_None. + move=> [[p0' x [Hhx2']]]. + have [!<<-] [!->>]:= H3 _ _ _ _ _ Hpa Hhx2'. + by rewrite getP_neq /= ?Hhx2 // => /ch_None. + rewrite getP; case ((v +^ bn, hx) = (sa', h{m2})) => //= -[Hsa' ->>]. + rewrite Hsa' g1_sa' /= -negP => [#] Hbu !<<-. + have [!<<-]:= H3 _ _ _ _ _ Hpa Hbu. + move: Hsa'=> /Block.WRing.addrI /#. + move=> p1 v p2 v' hx. + rewrite !build_hpath_upd_ch_iff //. + case (hx = G1.chandle{m2})=> [->> | Hdiff ];2:by apply H3. + by move=> /> ?? Hp1 ?? Hp2;have [!->>] := H3 _ _ _ _ _ Hp1 Hp2. + case (Hpi) => H1;split=> c p1 v1;rewrite H1 => {H1}. + apply exists_iff => h1 /=. rewrite getP build_hpath_upd_ch_iff //. + by case (h1 = G1.chandle{m2}) => [->> /#|]. +qed. + section AUX. declare module D : DISTINGUISHER {PF, RO, G1}. @@ -1611,7 +1808,7 @@ section AUX. by wp; do 2!rnd predT; auto => &hr [#]; smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). (** proofs for G1.C.f *) (* equiv PF.C.f G1.C.f *) - + admit. + + proc. (* lossless PF.C.f *) + move=> &2 _; proc; inline *; while (true) (size p); auto. + sp; if; 2:by auto; smt (size_behead). From 82ed12ed42132e375c12e0fbb5c271072b6f4d5e Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 31 Aug 2016 09:47:34 -0400 Subject: [PATCH 221/394] Formatting. --- sha3/proof/Sponge.ec | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index e7b6054..102db36 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -828,7 +828,7 @@ pred eager_eq_except 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, + (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 => @@ -1084,8 +1084,8 @@ lemma PrLoopSnoc_sample &m (bs : bool list) : mu (dlist {0,1} r) (pred1 bs). proof. have -> : - Pr[Prog.LoopSnoc.sample(r) @ &m: bs = res] = - Pr[Prog.Sample.sample(r) @ &m: bs = res]. + Pr[Prog.LoopSnoc.sample(r) @ &m : bs = res] = + Pr[Prog.Sample.sample(r) @ &m : bs = res]. byequiv=> //. symmetry. conseq (_ : ={n} ==> ={res})=> //. @@ -1676,7 +1676,8 @@ transitivity{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}=> //. + 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 : @@ -1710,7 +1711,8 @@ transitivity{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}=> //. + 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); @@ -1803,7 +1805,7 @@ auto. qed. local lemma RealIndif_Sponge_BlockSponge &m : - Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] = + Pr[RealIndif(Sponge, Perm, Dist).main() @ &m : res] = Pr[BlockSponge.RealIndif (BlockSponge.Sponge, Perm, LowerDist(Dist)).main() @ &m : res]. proof. @@ -1957,7 +1959,7 @@ by rewrite (Ideal_IRO_Experiment_HybridLazy &m) qed. lemma conclu &m : - `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] - + `|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] - @@ -1975,7 +1977,7 @@ 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[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] - From 6b1325d2a6b7a2b3e737857a4bb7637185bb2ef4 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 31 Aug 2016 11:13:40 -0400 Subject: [PATCH 222/394] A little more code documentation. Some more to follow. --- sha3/proof/Sponge.ec | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 102db36..9583cb7 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -1778,6 +1778,8 @@ declare module Dist : DISTINGUISHER{Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}. local clone HybridIRO as HIRO. +(* working toward the Real side of the top-level theorem *) + local lemma Sponge_Raise_BlockSponge_f : equiv[Sponge(Perm).f ~ RaiseFun(BlockSponge.Sponge(Perm)).f : ={bs, n, glob Perm} ==> ={res, glob Perm}]. @@ -1804,6 +1806,8 @@ auto; progress; by rewrite -cats1 blocks2bits_cat blocks2bits_sing. auto. qed. +(* the Real side of top-level theorem *) + local lemma RealIndif_Sponge_BlockSponge &m : Pr[RealIndif(Sponge, Perm, Dist).main() @ &m : res] = Pr[BlockSponge.RealIndif @@ -1816,6 +1820,11 @@ conseq Sponge_Raise_BlockSponge_f=> //. auto. qed. +(* working toward the Ideal side of the top-level theorem *) + +(* 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 @@ -1844,6 +1853,11 @@ 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) *) @@ -1857,6 +1871,8 @@ local module (HybridIRODist : HIRO.HYBRID_IRO_DIST) (HI : HIRO.HYBRID_IRO) = { } }. +(* initial bridging step *) + local lemma Experiment_HybridIROExper_Lazy &m : Pr[Experiment (HIRO.RaiseHybridIRO(HIRO.HybridIROLazy), BlockSim(HIRO.HybridIROLazy), @@ -1869,6 +1885,8 @@ 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] = @@ -1882,6 +1900,9 @@ 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.HybridIROLazy), @@ -1895,6 +1916,8 @@ by rewrite (Experiment_HybridIROExper_Lazy &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 : @@ -1916,6 +1939,9 @@ by have [-> _] := gt0_n2_imp gt0_n2. 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.HybridIROEager), @@ -1948,6 +1974,8 @@ conseq RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f=> //. auto. qed. +(* the Ideal side of top-level theorem *) + local lemma IdealIndif_IRO_BlockIRO &m : Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = Pr[BlockSponge.IdealIndif From 7eac6cfc0c67c0a9c2394180cf82e6b8f0bd404b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 31 Aug 2016 12:42:15 +0100 Subject: [PATCH 223/394] Core.eca slightly more usable. --- sha3/proof/core/Core.eca | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/sha3/proof/core/Core.eca b/sha3/proof/core/Core.eca index cb39bc3..edf5fe1 100644 --- a/sha3/proof/core/Core.eca +++ b/sha3/proof/core/Core.eca @@ -29,6 +29,7 @@ theory Block. op zeror <- b0, op ( + ) <- (+^), op [ - ] (b : block) <- b + remove abbrev (-) proof *. realize addrA by exact/addbA. realize addrC by exact/addbC. @@ -155,10 +156,8 @@ module FC (F : FUNCTIONALITY) : FUNCTIONALITY = { proc f (p : block list) = { var b <- witness; - if (valid p) { - C.c <- C.c + size p; - b <@ F.f(p); - } + C.c <- C.c + size p; + b <@ F.f(p); return b; } }. @@ -192,7 +191,7 @@ module (DRestr (D : DISTINGUISHER) : DISTINGUISHER) }. (** Ideal Primitive **) -clone import RP as Perm with +clone export RP as Perm with type t <- block * capacity, op dt <- bdistr `*` cdistr rename @@ -286,6 +285,11 @@ module (S : SIMULATOR) (F : DFUNCTIONALITY) : PRIMITIVE = { } }. +(** Initial and Final Games **) +module GReal (D : DISTINGUISHER) = RealIndif(Core,PC(Perm),D). + +module GIdeal (D : DISTINGUISHER) = IdealIndif(ICore,S,D). + (*** PROOF ***) (** TODO -- This is not indifferentiability -- clean up and fix **) (** However, this is what's proven (modulo the additional validity From 619b6b656caa041c155ef7787d2fb0e21adae7d4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 31 Aug 2016 13:56:37 +0100 Subject: [PATCH 224/394] Old stuff. --- sha3/proof/attic/LeakyAbsorb.ec | 416 ++++++++++++++++++++++++++++++++ 1 file changed, 416 insertions(+) create mode 100644 sha3/proof/attic/LeakyAbsorb.ec diff --git a/sha3/proof/attic/LeakyAbsorb.ec b/sha3/proof/attic/LeakyAbsorb.ec new file mode 100644 index 0000000..8f03201 --- /dev/null +++ b/sha3/proof/attic/LeakyAbsorb.ec @@ -0,0 +1,416 @@ +(* -------------------------------------------------------------------- *) +require import Option Pair Int Real Distr List FSet NewFMap DProd. +require (*--*) LazyRP RndOrcl. + +(* -------------------------------------------------------------------- *) + +type block. (* = {0,1}^r *) +type capacity. (* = {0,1}^c *) + +op cdist : capacity distr. +op bdist : block distr. +axiom bdist_ll : weight bdist = 1%r. + +(* isomorphic to the {0,1}^? uniform distributions *) + +op b0 : block. +op c0 : capacity. + +op (^) : block -> block -> block. + +(* -------------------------------------------------------------------- *) +clone import LazyRP as Perm with + type D <- block * capacity, + op d <- bdist `*` cdist + + rename [module] "P" as "Perm". + + +(* -------------------------------------------------------------------- *) +module type WeirdIRO = { + proc init(): unit + + proc f(_: block list * int): block list +}. + +module type WeirdIRO_ = { + proc f(_: block list * int): block list +}. + +op valid_query : block list -> int -> bool. +op valid_queries : (block list) fset. +axiom valid_queryP : forall m n, valid_query m n => forall k, 0 <= k <= n => mem valid_queries (m ++ mkseq (fun x => b0) k). +axiom valid_query_take : forall m n, valid_query m n => forall i, 0 <= i <= size m => mem valid_queries (take i m). +axiom valid_query_take1 : + forall m n, valid_query m n => forall i, 0 <= i <= size m => valid_query (take i m) 1. +axiom valid_query_size : forall m n, valid_query m n => 1 <= size m. + +module type RO = { + proc init () : unit + proc f(_:block list) : block +}. + +module Ro = { + var h : (block list,block) fmap + + proc init() = { h = map0; } + + proc f(m : block list) = { + var r; + r <$ bdist; + if (!mem (dom h) m) h.[m] <- r ; + return oget h.[m]; + } +}. + +module GenIdealFunctionalityThatDoesNotAbsorb(Ro:RO) = { + proc init = Ro.init + + proc f(m : block list, n : int) = { + var i <- 1; + var j <- 1; + var z <- []; + var b <- b0; + + if (valid_query m n) { + while (j <= size m) { + z <- rcons z b; + b <@ Ro.f(take j m); + j <- j + 1; + } + while (i < n) { + z <- rcons z b; + m <- rcons m b0; + b <@ Ro.f(m); + i <- i + 1; + } + } + return z; + } +}. + +module IdealFunctionalityThatDoesNotAbsorb = GenIdealFunctionalityThatDoesNotAbsorb(Ro). + +module GenIdealFunctionalityThatAbsorbs(Ro:RO) = { + proc init = Ro.init + + proc f(m : block list, n : int) = { + var i <- 1; + var z <- []; + var b; + + if (valid_query m n) { + b <@ Ro.f(m); + while (i < n) { + z <- rcons z b; + m <- rcons m b0; + b <@ Ro.f(m); + i<- i + 1; + } + } + return z; + } +}. + +module IdealFunctionalityThatAbsorbs = GenIdealFunctionalityThatAbsorbs(Ro). + +(* -------------------------------------------------------------------- *) +module type CONSTRUCTION(P : RP) = { + proc init() : unit + + proc f(bp : block list, n : int) : block list +}. + +module type SIMULATOR(F : WeirdIRO_) = { + proc init() : unit + + proc f(_ : block * capacity) : block * capacity + + proc fi(_ : block * capacity) : block * capacity +}. + +module type DISTINGUISHER(F : WeirdIRO_, P : RP_) = { + proc distinguish() : bool +}. + +(* -------------------------------------------------------------------- *) +module Experiment(F : WeirdIRO, P : RP, D : DISTINGUISHER) = { + proc main() : bool = { + var b; + + F.init(); + P.init(); + b <@ D(F, P).distinguish(); + + return b; + } +}. + +(* -------------------------------------------------------------------- *) +module SpongeThatDoesNotAbsorb (P : RP) : WeirdIRO, CONSTRUCTION(P) = { + proc init () = { } + + proc f(p : block list, n : int): block list = { + var z <- []; + var (sa,sc) <- (b0, c0); + var i <- 0; + var l <- size p; + + if (valid_query p n) { + (* Absorption *) + while (p <> []) { + z <- rcons z sa; + (sa,sc) <@ P.f(sa ^ head b0 p, sc); + p <- behead p; + } + (* Squeezing *) + while (i < n) { + z <- rcons z sa; + (sa,sc) <@ P.f(sa,sc); + } + } + + return z; + } +}. + +module SpongeThatAbsorbs (P : RP) : WeirdIRO, CONSTRUCTION(P) = { + proc init () = {} + + proc f(p : block list, n : int): block list = { + var z <- []; + var (sa,sc) <- (b0, c0); + var i <- 0; + + if (valid_query p n) { + (* Absorption *) + while (p <> []) { + (sa,sc) <@ P.f(sa ^ head b0 p, sc); + p <- behead p; + } + (* Squeezing *) + while (i < n) { + z <- rcons z sa; + (sa,sc) <@ P.f(sa,sc); + } + } + + return z; + } +}. + +(* -------------------------------------------------------------------- *) +section PROOF. + declare module S:SIMULATOR { IdealFunctionalityThatDoesNotAbsorb }. + declare module D:DISTINGUISHER { Perm, IdealFunctionalityThatDoesNotAbsorb, S }. + + (* From DoNot to Absorb *) + + module MkF(F:WeirdIRO_) = { + proc f(m:block list, n:int) = { + var r = []; + if (valid_query m n) { + r <@ F.f(m,n); + r <- drop (size m) r; + } + return r; + } + }. + + (* From Absord to do Not *) + module MkD (D:DISTINGUISHER, F:WeirdIRO_, P:RP_) = D(MkF(F),P). + + module MkFdoNot1 (F:WeirdIRO_) = { + proc f(m:block list, n:int) : block list = { + var i, r, tl, b; + r <- []; + if (valid_query m n) { + i <- 1; + b <- [b0]; + while (i <= size m) { + r <- r ++ b; + b <- F.f(take i m, 1); + i <- i + 1; + + } + tl <- F.f(m,n); + r <- r ++ tl; + } + return r; + } + }. + + module MkFdoNot (F:WeirdIRO) = { + proc init = F.init + proc f = MkFdoNot1(F).f + }. + + module MkS(S:SIMULATOR, F:WeirdIRO) = S(MkFdoNot(F)). + + local clone RndOrcl as RndOrcl0 with + type from <- block list, + type to <- block. + + local clone RndOrcl0.RestrIdeal as RI with + op sample <- fun (bl:block list) => bdist, + op test <- (mem valid_queries), + op univ <- valid_queries, + op dfl <- b0 + proof *. + realize sample_ll. by move=> _;apply bdist_ll. qed. + realize testP. by []. qed. + import RI. + + local module E1 (Ro:RO) = { + module F = { + proc f = GenIdealFunctionalityThatDoesNotAbsorb(Ro).f + } + module P = S(F) + proc distinguish () : bool = { + var b; + P.init(); + b <@ MkD(D, F, P).distinguish(); + return b; + } + }. + + local module E2 (Ro:RO) = { + module F = { + proc f = GenIdealFunctionalityThatAbsorbs(Ro).f + } + module P = S(MkFdoNot1(F)) + proc distinguish () : bool = { + var b; + P.init(); + b <@ D(F, P).distinguish(); + return b; + } + }. + + local equiv f_f : + GenIdealFunctionalityThatDoesNotAbsorb(Ro).f ~ E1(Restr(RO)).F.f : + ={m, n} /\ Ro.h{1} = RO.m{2} ==> ={res} /\ Ro.h{1} = RO.m{2}. + proof. + proc;sp;if => //. + inline{2} Restr(RO).f. + while (={z,i,n,b,m} /\ Ro.h{1} = RO.m{2} /\ + (forall k, 0 <= k <= n - i => mem valid_queries (m ++ map (fun x => b0) (iota_ 0 k))){2}). + + rcondt{2} 5=> //. + + auto;progress; rewrite - cats1;cut := H 1 _; [by smt| by rewrite iota1]. + auto; call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress]. + cut := H (k+1) _;1:by smt. + rewrite iotaS //= -cats1 -catA /= (_: map (fun (x : int) => b0) (iota_ 1 k) = map (fun (x : int) => b0) (iota_ 0 k)) //. + by rewrite (iota_addl 1 0 k) -map_comp;apply eq_map. + while (={z,j,n,b,m} /\ Ro.h{1} = RO.m{2} /\ valid_query m{1} n{1} /\ 0 <= j{1}). + + rcondt{2} 4=> //. + + auto;progress;apply (valid_query_take _ _ H)=> //. + auto; call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress;smt]. + skip;progress;apply (valid_queryP _ _ H2);smt. + qed. + + local equiv f_f_a : GenIdealFunctionalityThatAbsorbs(Ro).f ~ E2(Restr(RO)).F.f : ={m,n} /\ Ro.h{1} = RO.m{2} ==> ={res} /\ Ro.h{1} = RO.m{2}. + proof. + proc; sp;if=> //;inline{2} Restr(RO).f;sp. + rcondt{2} 1=> //. + + auto;progress;cut := valid_query_take _ _ H (size m{hr}). + rewrite take_size=> HH;apply HH;smt. + while (={z,i,n,b,m} /\ Ro.h{1} = RO.m{2} /\ + (forall k, 0 <= k <= n - i => mem valid_queries (m ++ map (fun x => b0) (iota_ 0 k))){2}). + + rcondt{2} 5=> //. + + auto;progress; rewrite -cats1;cut := H 1 _; [by smt| by rewrite iota1]. + auto; call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress]. + cut := H (k+1) _;1:by smt. + rewrite iotaS //= -cats1 -catA /= (_: map (fun (x : int) => b0) (iota_ 1 k) = map (fun (x : int) => b0) (iota_ 0 k)) //. + by rewrite (iota_addl 1 0 k) -map_comp;apply eq_map. + wp;call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress]. + apply (valid_queryP _ _ H);smt. + qed. + + local equiv f_f' : + MkFdoNot(GenIdealFunctionalityThatAbsorbs(Ro)).f ~ MkFdoNot1(E2(Restr(RO)).F).f : + ={m, n} /\ Ro.h{1} = RO.m{2} ==> + ={res} /\ Ro.h{1} = RO.m{2}. + proof. + proc;sp;if => //;wp. + call f_f_a. + while (={i,m,r,b} /\ Ro.h{1} = RO.m{2} /\ valid_query m{1} n{1} /\ 0 <= i{1});last by auto. + wp; call f_f_a;auto;progress;smt. + qed. + + local equiv f_dN : E1(ERO).F.f ~ MkFdoNot1(E2(ERO).F).f : ={m, n} /\ ={RO.m} ==> ={res, RO.m}. + proof. + proc;sp;if=> //;sp. + inline {2} E2(ERO).F.f. + rcondt{2} 6;auto; 1: by conseq (_: _ ==> true). + while (={RO.m} /\ z{1} = r{2} ++ z0{2} /\ i{1} = i1{2} /\ n{1} = n1{2} /\ b{1} = b1{2} /\ + m{1} = m1{2}). + + inline *;auto;progress;smt. + inline ERO.f;auto. + while (={RO.m,m,n} /\ z{1} = r{2} /\ b{2} = [b{1}] /\ valid_query m{1} n{1} /\ + j{1} = i{2} /\ 0 <= i{2} /\ + (1 < j => b = mem valid_queries (take j m) ? oget RO.m.[x] : Self.b0){1}). + + rcondt{2} 6;1:by auto;progress;smt. + rcondf{2} 8;1:by auto. + auto;progress;smt. + auto;progress;smt. + qed. + + lemma conclusion &m: + `| Pr[Experiment(SpongeThatDoesNotAbsorb(Perm), Perm, MkD(D)).main() @ &m : res] + - Pr[Experiment(IdealFunctionalityThatDoesNotAbsorb, + S(IdealFunctionalityThatDoesNotAbsorb), MkD(D)).main() @ &m : res] | = + `|Pr[Experiment(SpongeThatAbsorbs(Perm),Perm,D).main() @ &m : res] + - Pr[Experiment(IdealFunctionalityThatAbsorbs, MkS(S,IdealFunctionalityThatAbsorbs), D).main() @ &m : res]|. + proof. + do 3?congr. + + byequiv (_: ={glob D} ==> _) => //;proc;inline *. + call (_: ={glob Perm});1,2:(by sim); last by auto. + proc;inline{1}SpongeThatDoesNotAbsorb(Perm).f;sp 1 3;if=> //. + sp;rcondt{1} 1=> //;wp. + while (={glob Perm, i, sa, sc} /\ n0{1} = n{2} /\ z{1} = take (size m{1}) z{1} ++ z{2} /\ size m{1} <= size z{1}). + + call (_ : ={glob Perm});[by sim|auto;progress [-split];smt]. + while (={glob Perm, p, sa,sc} /\ (size z = size m - size p){1}). + + wp;call (_ : ={glob Perm});[by sim|auto;progress [-split]]. + by rewrite size_rcons H; move: H0; case: (p{2})=> //= x xs; ring. + by auto;progress [-split];smt. + cut -> : Pr[Experiment(IdealFunctionalityThatDoesNotAbsorb, S(IdealFunctionalityThatDoesNotAbsorb), MkD(D)).main () @ &m : res] = + Pr[RndOrcl0.IND(Restr(RO), E1).main() @ &m : res]. + + byequiv=> //. (* PY: BUG printer res *) + proc;inline{2} E1(Restr(RO)).distinguish;auto. + call (_: ={glob S} /\ Ro.h{1} = RO.m{2}). + + by proc (Ro.h{1} = RO.m{2}) => //;apply f_f. + + by proc (Ro.h{1} = RO.m{2}) => //;apply f_f. + + by proc;sp;if=> //;wp;call f_f. + by inline *; call (_: Ro.h{1} = RO.m{2});auto;apply f_f. + cut -> : Pr[Experiment(IdealFunctionalityThatAbsorbs, MkS(S, IdealFunctionalityThatAbsorbs), D).main() @ &m : res] = + Pr[RndOrcl0.IND(Restr(RO), E2).main() @ &m : res]. + + byequiv=> //. + proc;inline{2} E2(Restr(RO)).distinguish;auto. + call (_: ={glob S} /\ Ro.h{1} = RO.m{2}). + + proc (Ro.h{1} = RO.m{2}) => //; apply f_f'. + + by proc (Ro.h{1} = RO.m{2}) => //;apply f_f'. + + conseq f_f_a => //. + by inline *;call (_:Ro.h{1} = RO.m{2});[apply f_f'|auto]. + cut -> : Pr[RndOrcl0.IND(Restr(RO), E1).main() @ &m : res] = + Pr[RndOrcl0.IND(ERO, E1).main() @ &m : res]. + + byequiv (Eager E1)=> //. + cut -> : Pr[RndOrcl0.IND(Restr(RO), E2).main() @ &m : res] = + Pr[RndOrcl0.IND(ERO, E2).main() @ &m : res]. + + byequiv (Eager E2)=> //. + byequiv=> //. + proc; inline *;wp. + call (_: ={RO.m, glob S}). + + by proc (={RO.m})=> //;apply f_dN. + + by proc (={RO.m})=> //;apply f_dN. + + proc;sp;if => //. + inline{1} E1(ERO).F.f;sp;rcondt{1} 1; 1:by auto. + wp;while (={RO.m,i,b} /\ n0{1} = n{2} /\ m0{1} = m{2} /\ z{1} = take (size m{1}) z{1} ++ z{2} /\ (size m <= size z){1}). + + inline *;auto;progress [-split]; smt. + inline *;splitwhile{1} 1 : (j < size m0). + wp;seq 1 0 : (={i,RO.m, m, glob S} /\ n0{1} = n{2} /\ m0{1} = m{2} /\ size m0{1} - 1 = size z{1} /\ size m0{1} = j{1} /\ z{2} = []). + while{1} (size z{1} = j{1} - 1 /\ j{1} <= size m0{1}) ((size m0 - j){1});auto;progress [-split]; smt. + rcondt{1} 1;1:by auto. + rcondf{1} 5;auto;progress[-split];smt. + call (_: ={RO.m})=> //;1:by apply f_dN. + sim : (={glob S, glob D, RO.m})=> //. + qed. From ab714f410c4abe4041f7ae9ec613f974852d80e4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 31 Aug 2016 17:53:43 +0100 Subject: [PATCH 225/394] Clean trasnfer of Indifferentiability from to by injective extension. In theory, axioms on valid, extend, strip are minimal --- sha3/proof/{core => clean}/Core.eca | 4 +- sha3/proof/clean/CoreExtension.eca | 417 ++++++++++++++++++++++++++++ 2 files changed, 419 insertions(+), 2 deletions(-) rename sha3/proof/{core => clean}/Core.eca (99%) create mode 100644 sha3/proof/clean/CoreExtension.eca diff --git a/sha3/proof/core/Core.eca b/sha3/proof/clean/Core.eca similarity index 99% rename from sha3/proof/core/Core.eca rename to sha3/proof/clean/Core.eca index edf5fe1..29d1fa3 100644 --- a/sha3/proof/core/Core.eca +++ b/sha3/proof/clean/Core.eca @@ -154,7 +154,7 @@ module FC (F : FUNCTIONALITY) : FUNCTIONALITY = { proc init = F.init proc f (p : block list) = { - var b <- witness; + var b <- b0; C.c <- C.c + size p; b <@ F.f(p); @@ -222,7 +222,7 @@ module ICore: FUNCTIONALITY = { } proc f(p : block list): block = { - var r <- witness; + var r <- b0; if (valid p) { if (!mem (dom m) p) { diff --git a/sha3/proof/clean/CoreExtension.eca b/sha3/proof/clean/CoreExtension.eca new file mode 100644 index 0000000..87cdc7b --- /dev/null +++ b/sha3/proof/clean/CoreExtension.eca @@ -0,0 +1,417 @@ +pragma -oldip. pragma +implicits. +require import Pred Fun Option Pair Int Real List FSet NewFMap NewDistr. +require import StdOrder Ring DProd. +(*---*) import IntOrder. + +require (*..*) RP Indifferentiability. + +(*** THEORY PARAMETERS ***) +(** Block/Rate **) +theory Block. + op r : int. + axiom r_ge0: 0 <= r. + + type block. + + op b0: block. + op (+^): block -> block -> block. + + axiom addbA b1 b2 b3: b1 +^ (b2 +^ b3) = b1 +^ b2 +^ b3. + axiom addbC b1 b2: b1 +^ b2 = b2 +^ b1. + axiom add0b b: b0 +^ b = b. + axiom addbK b: b +^ b = b0. + + op blocks: block list. + axiom blocks_spec b: count (pred1 b) blocks = 1. + axiom card_block: size blocks = 2^r. + + clone import Ring.ZModule as BlockMonoid with + type t <- block, + op zeror <- b0, + op ( + ) <- (+^), + op [ - ] (b : block) <- b + remove abbrev (-) + proof *. + realize addrA by exact/addbA. + realize addrC by exact/addbC. + realize add0r by exact/add0b. + realize addNr by exact/addbK. + + clone import MFinite as DBlock with + type t <- block, + op Support.enum <- blocks + rename "dunifin" as "bdistr" + "duniform" as "bdistr" + proof *. + realize Support.enum_spec by exact/blocks_spec. +end Block. +import Block DBlock. + +(** Capacity **) +theory Capacity. + op c : int. + axiom c_ge0: 0 <= c. + + type capacity. + + op c0: capacity. + + op caps: capacity list. + axiom caps_spec b: count (pred1 b) caps = 1. + axiom card_capacity: size caps = 2^c. + + clone import MFinite as DCapacity with + type t <- capacity, + op Support.enum <- caps + rename "dunifin" as "cdistr" + "duniform" as "cdistr" + proof *. + realize Support.enum_spec by exact/caps_spec. +end Capacity. +import Capacity DCapacity. + +(** Validity of Functionality Queries and Partial Bijection **) +op valid: block list -> bool. + +op extend: block list -> int -> block list. +op strip: block list -> (block list * int). + +axiom stripK bs: extend (strip bs).`1 (strip bs).`2 = bs. +axiom extendK bs n: 0 <= n => valid bs => strip (extend bs n) = (bs,n). + +lemma injective_strip: injective strip. +proof. +by move=> bs1 bs2 eq_strip; rewrite -stripK eq_strip; exact/(@stripK bs2). +qed. + +(** Adversary's Query Cost **) +op max_query: int. +axiom max_query_ge0: 0 <= max_query. + +(*** DEFINITIONS ***) +type state = block * capacity. +op dstate = bdistr `*` cdistr. + +(** Indifferentiability Experiment **) +clone include Indifferentiability with + type p <- state, + type f_in <- block list * int, + type f_out <- block + rename [module] "GReal" as "RealIndif" + [module] "GIdeal" as "IdealIndif". + +(** Query Counting **) +module C = { + var c:int + proc init() = { c <- 0; } +}. + +module PC (P : PRIMITIVE) : PRIMITIVE = { + proc init () = { + C.init(); + P.init(); + } + + proc f (x : state) = { + var y; + + C.c <- C.c + 1; + y <@ P.f(x); + return y; + } + + proc fi(x : state) = { + var y; + + C.c <- C.c + 1; + y <@ P.fi(x); + return y; + } +}. + +module DPRestr (P : DPRIMITIVE) : DPRIMITIVE = { + proc f (x : state) = { + var y <- (b0,c0); + + if (C.c + 1 <= max_query) { + C.c <- C.c + 1; + y <@ P.f(x); + } + return y; + } + + proc fi(x : state) = { + var y <- (b0,c0); + + if (C.c + 1 <= max_query) { + C.c <- C.c + 1; + y <@ P.fi(x); + } + return y; + } +}. + +module PRestr (P : PRIMITIVE) : PRIMITIVE = { + proc init () = { + C.init(); + P.init(); + } + + proc f = DPRestr(P).f + proc fi = DPRestr(P).fi +}. + +module FC (F : FUNCTIONALITY) : FUNCTIONALITY = { + proc init = F.init + + proc f (p : block list, n : int) = { + var b <- b0; + + C.c <- C.c + size p; + b <@ F.f(p,n); + return b; + } +}. + +module DFRestr (F : DFUNCTIONALITY) : DFUNCTIONALITY = { + proc f (p : block list, n : int) = { + var b <- b0; + + if (C.c + size p <= max_query) { + C.c <- C.c + size p; + b <@ F.f(p, n); + } + return b; + } +}. + +module FRestr(F : FUNCTIONALITY) : FUNCTIONALITY = { + proc init = F.init + proc f = DFRestr(F).f +}. + +module (DRestr (D : DISTINGUISHER) : DISTINGUISHER) + (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + proc distinguish() = { + var b; + + C.init(); + b <@ D(DFRestr(F), DPRestr(P)).distinguish(); + return b; + } +}. + +(** Core Extension Construction **) +module (CoreExtension : CONSTRUCTION) (P:DPRIMITIVE): FUNCTIONALITY = { + proc init () = {} + + proc f(p : block list, n : int): block = { + var (sa,sc) <- (b0,c0); + + if (valid p /\ 0 <= n) { + p <- extend p n; + while (p <> []) { + (sa,sc) <@ P.f((sa +^ head witness p,sc)); + p <- behead p; + } + } + return sa; + } +}. + +(** Ideal Core Extension Functionality **) +module ICoreExtension: FUNCTIONALITY = { + var m : (block list * int,block) fmap + + proc init() = { + m = map0; + } + + proc f(p : block list, n : int): block = { + var r <- b0; + + if (valid p /\ 0 <= n) { + if (!mem (dom m) (p,n)) { + m.[(p,n)] <$ bdistr; + } + r <- oget m.[(p,n)]; + } + return r; + } +}. + +(** Initial and Final Games **) +module GReal (D : DISTINGUISHER, P : PRIMITIVE) = RealIndif(CoreExtension,P,D). + +module GIdeal (D : DISTINGUISHER, S : SIMULATOR) = IdealIndif(ICoreExtension,S,D). + +(*** PROOF ***) +require (*--*) Core. + +section PROOF. + local clone Core as CoreSim with + op Block.r <- r, + type Block.block <- block, + op Block.b0 <- b0, + op Block.(+^) <- (+^), + op Block.enum <- blocks, + op Capacity.c <- c, + type Capacity.capacity <- capacity, + op Capacity.c0 <- c0, + op Capacity.enum <- caps, + op max_query <- max_query, + op valid (bs) <- valid (strip bs).`1 /\ 0 <= (strip bs).`2 + proof *. + realize Block.r_ge0 by exact/r_ge0. + realize Block.addbA by exact/addbA. + realize Block.addbC by exact/addbC. + realize Block.add0b by exact/add0b. + realize Block.addbK by exact/addbK. + realize Block.block_enum by exact/blocks_spec. + realize Block.card_block by exact/card_block. + realize Capacity.c_ge0 by exact/c_ge0. + realize Capacity.capacity_enum by exact/caps_spec. + realize Capacity.card_capacity by exact/card_capacity. + realize valid_not_nil by admit. + realize max_query_ge0 by exact/max_query_ge0. + + (** Simulator and Distinguisher constructions **) + module (RaiseSim (S : CoreSim.SIMULATOR) : SIMULATOR) + (F : DFUNCTIONALITY) = { + module LowerF = { + proc f(p : block list) = { + var n, b; + + (p,n) <- strip p; + b <@ F.f(p,n); + return b; + } + } + + proc init = S(LowerF).init + proc f = S(LowerF).f + proc fi = S(LowerF).fi + }. + + module (LowerDist (D : DISTINGUISHER) : CoreSim.DISTINGUISHER) + (F : CoreSim.DFUNCTIONALITY) (P : CoreSim.DPRIMITIVE) = { + module RaiseF = { + proc f(p : block list, n : int) = { + var b <- b0; + + if (valid p /\ 0 <= n) { + p <- extend p n; + b <@ F.f(p); + } + return b; + } + } + + proc distinguish = D(RaiseF,P).distinguish + }. + + declare module D : DISTINGUISHER { CoreSim.Core, CoreSim.Perm.Perm, CoreSim.ICore, CoreSim.S, CoreSim.C, ICoreExtension }. + + local lemma LiftIndif &m: + `| Pr[CoreSim.GReal(LowerDist(D)).main() @ &m: res] + - Pr[CoreSim.GIdeal(LowerDist(D)).main() @ &m: res] | + = `| Pr[GReal(D,CoreSim.Perm.Perm).main() @ &m: res] + - Pr[GIdeal(D,RaiseSim(CoreSim.S)).main() @ &m: res] |. + proof. + do !congr. + + byequiv (_: ={glob D} ==> _)=> //; proc. + seq 2 2: (={glob CoreSim.Perm.Perm, glob D}). + + by inline *; auto. + call (_: ={glob CoreSim.Perm.Perm})=> //. + + by proc; inline{1} 2; wp; sim. + + by proc; inline{1} 2; wp; sim. + proc; sp; if=> //=. inline{1} 2; wp. + while (={glob CoreSim.Perm.Perm, sa, sc} /\ p0{1} = p{2}); auto. + by inline *; sp; if=> //=; auto. + byequiv (_: ={glob CoreSim.S, glob D} ==> _)=> //; proc. + seq 2 2: ( ={glob D, glob CoreSim.S} + /\ (forall p n, + mem (dom ICoreExtension.m) (p,n) + => valid p + /\ 0 <= n){2} + /\ (forall p n, valid p => 0 <= n => + ICoreExtension.m.[(p,n)]{2} = CoreSim.ICore.m.[extend p n]{1})). + + by inline *; auto; smt (in_dom map0P). + call (_: ={glob CoreSim.S} + /\ (forall p n, + mem (dom ICoreExtension.m) (p,n) + => valid p + /\ 0 <= n){2} + /\ (forall p n, valid p => 0 <= n => + ICoreExtension.m.[(p,n)]{2} = CoreSim.ICore.m.[extend p n]{1}))=> //. + + proc; if=> //=; last by auto. + if=> //=. + + rcondt{1} 7=> [&m0|]. + + inline *; sp; if=> //=; last by auto; smt (bdistr_ll). + if=> //=; last by auto; smt (bdistr_ll). + by auto; smt (bdistr_ll cdistr_ll). + rcondt{2} 7=> [&m0|]. + + inline *; sp; if=> //=; last by auto; smt (bdistr_ll). + if=> //=; last by auto; smt (bdistr_ll). + by auto; smt (bdistr_ll cdistr_ll). + auto; sp. + conseq (_: ={x, p, v, glob CoreSim.S} + /\ CoreSim.S.pi.[x.`2]{2} = Some (p,v){2} + /\ CoreSim.S.m.[x]{1} = None + /\ (forall p n, + mem (dom ICoreExtension.m) (p,n) + => valid p + /\ 0 <= n){2} + /\ (forall p n, valid p => 0 <= n => + ICoreExtension.m.[(p,n)]{2} = CoreSim.ICore.m.[extend p n]{1}) + ==> ={glob CoreSim.S, y1, p, v, x} + /\ (forall p n, + mem (dom ICoreExtension.m) (p,n) + => valid p + /\ 0 <= n){2} + /\ (forall p n, valid p => 0 <= n => + ICoreExtension.m.[(p,n)]{2} = CoreSim.ICore.m.[extend p n]{1}))=> //. + + auto=> /> &1 &2 ^pv_def <- [#] <*> h1 h2; rewrite !in_dom=> /= -> /=. + by case: (CoreSim.S.pi.[x.`2]{2}) pv_def=> //= x @/oget /=. + inline *; sp; if=> //=. + + by move=> /> &1 &2; case: (strip (rcons p (v +^ x.`1)){2})=> p' n' [#] !->>. + if=> //=. + + move=> /> &1 &2; case _: (strip (rcons p (v +^ x.`1)){2})=> p' n' h_def [#] !->>. + move=> _ _ h1 h2 /= valid_p ge0_n; rewrite !in_dom. + rewrite h2 //. + have ->: p' = (strip (rcons p (v +^ x.`1)){2}).`1 by rewrite h_def. + have ->: n' = (strip (rcons p (v +^ x.`1)){2}).`2 by rewrite h_def. + by rewrite (@stripK (rcons p (v +^ x.`1)){2}). + + auto=> /> &1 &2; case _: (strip (rcons p (v +^ x.`1)){2})=> p' n' h_def [#] !->>. + move=> pi_x2 m_x h1 h2 /= valid_p n_ge0; rewrite in_dom=> /= m_pvx1. + move=> _ b _ _; rewrite getP /= oget_some getP /= oget_some /=; split. + + move=> p n; rewrite in_dom getP; case ((p,n) = (p',n'))=> //= _. + by rewrite -in_dom=> /h1. + move=> p0 n0 valid_p' n'_ge0; rewrite !getP h2 // -h_def. + case: (extend p0 n0 = (rcons p (v +^ x.`1)){2})=> //=. + + by rewrite -extendK=> // ->. + case: ((p0,n0) = (strip (rcons p (v +^ x.`1))){2})=> //=. + smt (stripK). + + auto=> /> &1 &2; case _: (strip (rcons p (v +^ x.`1)){2})=> p' n' h_def [#] !->>. + by move=> _ _ h1 h2 /= valid_p' n'_ge0 _; rewrite h2 //; smt (stripK). + by auto. + rcondf{1} 6; 1:by auto. + rcondf{2} 6; 1:by auto. + by auto. + + by proc; if=> //=; auto. + proc; sp; if=> //=; inline{1} 2. + rcondt{1} 4; 1:auto. + + by move=> &hr [#] !->> h1 h2 valid_p n_ge0 /=; rewrite extendK. + sp; if=> //=. + + by move=> /> &1 &2 h1 h2 valid_p n_ge0; rewrite !in_dom h2 // -extendK. + + auto=> /> &1 &2 h1 h2 valid_p n_ge0; rewrite in_dom=> /= ^extend_pn_notin_m. + rewrite -h2=> // pn_notin_m _ b _ _; rewrite 2!getP /=; split. + + move=> p' n'; rewrite in_dom getP; case ((p',n') = (p{2},n{2}))=> //= _. + by rewrite -in_dom=> /h1. + move=> p0 m0 valid_p0 n0_ge0; rewrite !getP h2 // -!extendK //. + case: (extend p0 m0 = extend p{2} n{2})=> [->|] //. + by have /contra H /H ->:= (injective_strip (extend p0 m0) (extend p{2} n{2})). + by auto=> /> &1 &2 h1 h2 valid_p n_ge0 _; rewrite -h2. + qed. + +end section PROOF. From 90a372b6e8576b2782a96e6f75bc028a8da6debc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 1 Sep 2016 10:49:00 +0100 Subject: [PATCH 226/394] Figuring out abstract gluing: adding query counters. --- sha3/proof/clean/Core.eca | 177 ++++++++------- sha3/proof/clean/CoreExtension.eca | 302 ++++++++++++++++---------- sha3/proof/core/CoreToBlockSponge.eca | 23 +- 3 files changed, 302 insertions(+), 200 deletions(-) diff --git a/sha3/proof/clean/Core.eca b/sha3/proof/clean/Core.eca index 29d1fa3..5302fc9 100644 --- a/sha3/proof/clean/Core.eca +++ b/sha3/proof/clean/Core.eca @@ -90,105 +90,109 @@ clone include Indifferentiability with [module] "GIdeal" as "IdealIndif". (** Query Counting **) -module C = { - var c:int - proc init() = { c <- 0; } -}. - -module PC (P : PRIMITIVE) : PRIMITIVE = { - proc init () = { - C.init(); - P.init(); - } - - proc f (x : state) = { - var y; - - C.c <- C.c + 1; - y <@ P.f(x); - return y; - } - - proc fi(x : state) = { - var y; - - C.c <- C.c + 1; - y <@ P.fi(x); - return y; - } -}. +theory Counting. + module C = { + var c:int + proc init() = { c <- 0; } + }. + + module PC (P : PRIMITIVE) : PRIMITIVE = { + proc init () = { + C.init(); + P.init(); + } -module DPRestr (P : DPRIMITIVE) : DPRIMITIVE = { - proc f (x : state) = { - var y <- (b0,c0); + proc f (x : state) = { + var y; - if (C.c + 1 <= max_query) { C.c <- C.c + 1; y <@ P.f(x); + return y; } - return y; - } - proc fi(x : state) = { - var y <- (b0,c0); + proc fi(x : state) = { + var y; - if (C.c + 1 <= max_query) { C.c <- C.c + 1; y <@ P.fi(x); + return y; } - return y; - } -}. + }. -module PRestr (P : PRIMITIVE) : PRIMITIVE = { - proc init () = { - C.init(); - P.init(); - } + module DPRestr (P : DPRIMITIVE) : DPRIMITIVE = { + proc f (x : state) = { + var y <- (b0,c0); - proc f = DPRestr(P).f - proc fi = DPRestr(P).fi -}. + if (C.c + 1 <= max_query) { + C.c <- C.c + 1; + y <@ P.f(x); + } + return y; + } -module FC (F : FUNCTIONALITY) : FUNCTIONALITY = { - proc init = F.init + proc fi(x : state) = { + var y <- (b0,c0); - proc f (p : block list) = { - var b <- b0; + if (C.c + 1 <= max_query) { + C.c <- C.c + 1; + y <@ P.fi(x); + } + return y; + } + }. - C.c <- C.c + size p; - b <@ F.f(p); - return b; - } -}. + module PRestr (P : PRIMITIVE) : PRIMITIVE = { + proc init () = { + C.init(); + P.init(); + } + + proc f = DPRestr(P).f + proc fi = DPRestr(P).fi + }. + + module FC (F : FUNCTIONALITY) : FUNCTIONALITY = { + proc init = F.init -module DFRestr (F : DFUNCTIONALITY) : DFUNCTIONALITY = { - proc f (bs : block list) = { - var b <- b0; + proc f (p : block list) = { + var b <- b0; - if (C.c + size bs <= max_query) { - C.c <- C.c + size bs; - b <@ F.f(bs); + if (valid p) { + C.c <- C.c + size p; + b <@ F.f(p); + } + return b; } - return b; - } -}. + }. -module FRestr(F : FUNCTIONALITY) : FUNCTIONALITY = { - proc init = F.init - proc f = DFRestr(F).f -}. + module DFRestr (F : DFUNCTIONALITY) : DFUNCTIONALITY = { + proc f (bs : block list) = { + var b <- b0; -module (DRestr (D : DISTINGUISHER) : DISTINGUISHER) - (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { - proc distinguish() = { - var b; + if (valid bs /\ C.c + size bs <= max_query) { + C.c <- C.c + size bs; + b <@ F.f(bs); + } + return b; + } + }. - C.init(); - b <@ D(DFRestr(F), DPRestr(P)).distinguish(); - return b; - } -}. + module FRestr(F : FUNCTIONALITY) : FUNCTIONALITY = { + proc init = F.init + proc f = DFRestr(F).f + }. + + module (DRestr (D : DISTINGUISHER) : DISTINGUISHER) + (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + proc distinguish() = { + var b; + + C.init(); + b <@ D(DFRestr(F), DPRestr(P)).distinguish(); + return b; + } + }. +end Counting. (** Ideal Primitive **) clone export RP as Perm with @@ -284,27 +288,22 @@ module (S : SIMULATOR) (F : DFUNCTIONALITY) : PRIMITIVE = { return y; } }. +import Counting. (** Initial and Final Games **) -module GReal (D : DISTINGUISHER) = RealIndif(Core,PC(Perm),D). - +module GReal (D : DISTINGUISHER) = RealIndif(Core,Perm,D). module GIdeal (D : DISTINGUISHER) = IdealIndif(ICore,S,D). (*** PROOF ***) -(** TODO -- This is not indifferentiability -- clean up and fix **) -(** However, this is what's proven (modulo the additional validity - check in ICore, not present in IF. The validity checks may be - problematic in combination with counting, so we need to make sure - both are present throughout before diving in. **) lemma CoreIndiff (D <: DISTINGUISHER {C, Perm, Core, ICore, S}) &m: (forall (F <: DFUNCTIONALITY {D}) (P <: DPRIMITIVE {D}), islossless P.f => islossless P.fi => islossless F.f => islossless D(F,P).distinguish) - => Pr[RealIndif(Core,PC(Perm),D).main() @ &m: res /\ C.c <= max_query] - <= Pr[IdealIndif(ICore,S,DRestr(D)).main() @ &m :res] - + (max_query ^ 2)%r / (2^(r + c))%r + => `| Pr[RealIndif(Core,Perm,DRestr(D)).main() @ &m: res] + - Pr[IdealIndif(ICore,S,DRestr(D)).main() @ &m :res] | + <= (max_query ^ 2)%r / (2^(r + c))%r + max_query%r * ((2*max_query)%r / (2^c)%r) + max_query%r * ((2*max_query)%r / (2^c)%r). -abort. +admitted. diff --git a/sha3/proof/clean/CoreExtension.eca b/sha3/proof/clean/CoreExtension.eca index 87cdc7b..e2144f8 100644 --- a/sha3/proof/clean/CoreExtension.eca +++ b/sha3/proof/clean/CoreExtension.eca @@ -71,13 +71,16 @@ end Capacity. import Capacity DCapacity. (** Validity of Functionality Queries and Partial Bijection **) -op valid: block list -> bool. +op valid: block list -> int -> bool. +axiom nil_not_valid bs n: valid bs n => bs <> []. op extend: block list -> int -> block list. op strip: block list -> (block list * int). +axiom strip_nil bs: (strip bs).`1 <> [] => bs <> []. axiom stripK bs: extend (strip bs).`1 (strip bs).`2 = bs. -axiom extendK bs n: 0 <= n => valid bs => strip (extend bs n) = (bs,n). +axiom extendK bs n: valid bs n => strip (extend bs n) = (bs,n). +axiom size_extend bs n: valid bs n => size (extend bs n) = size bs + n. lemma injective_strip: injective strip. proof. @@ -100,106 +103,111 @@ clone include Indifferentiability with rename [module] "GReal" as "RealIndif" [module] "GIdeal" as "IdealIndif". -(** Query Counting **) -module C = { - var c:int - proc init() = { c <- 0; } -}. - -module PC (P : PRIMITIVE) : PRIMITIVE = { - proc init () = { - C.init(); - P.init(); - } - - proc f (x : state) = { - var y; - - C.c <- C.c + 1; - y <@ P.f(x); - return y; - } - - proc fi(x : state) = { - var y; +(** Query Counting -- Note that we only count **adversary** queries **) +theory Counting. + module C = { + var c:int + proc init() = { c <- 0; } + }. - C.c <- C.c + 1; - y <@ P.fi(x); - return y; - } -}. + module PC (P : PRIMITIVE) : PRIMITIVE = { + proc init () = { + C.init(); + P.init(); + } -module DPRestr (P : DPRIMITIVE) : DPRIMITIVE = { - proc f (x : state) = { - var y <- (b0,c0); + proc f (x : state) = { + var y; - if (C.c + 1 <= max_query) { C.c <- C.c + 1; y <@ P.f(x); + return y; } - return y; - } - proc fi(x : state) = { - var y <- (b0,c0); + proc fi(x : state) = { + var y; - if (C.c + 1 <= max_query) { C.c <- C.c + 1; y <@ P.fi(x); + return y; } - return y; - } -}. + }. -module PRestr (P : PRIMITIVE) : PRIMITIVE = { - proc init () = { - C.init(); - P.init(); - } + module DPRestr (P : DPRIMITIVE) : DPRIMITIVE = { + proc f (x : state) = { + var y <- (b0,c0); - proc f = DPRestr(P).f - proc fi = DPRestr(P).fi -}. + if (C.c + 1 <= max_query) { + C.c <- C.c + 1; + y <@ P.f(x); + } + return y; + } -module FC (F : FUNCTIONALITY) : FUNCTIONALITY = { - proc init = F.init + proc fi(x : state) = { + var y <- (b0,c0); - proc f (p : block list, n : int) = { - var b <- b0; + if (C.c + 1 <= max_query) { + C.c <- C.c + 1; + y <@ P.fi(x); + } + return y; + } + }. - C.c <- C.c + size p; - b <@ F.f(p,n); - return b; - } -}. + module PRestr (P : PRIMITIVE) : PRIMITIVE = { + proc init () = { + C.init(); + P.init(); + } -module DFRestr (F : DFUNCTIONALITY) : DFUNCTIONALITY = { - proc f (p : block list, n : int) = { - var b <- b0; + proc f = DPRestr(P).f + proc fi = DPRestr(P).fi + }. - if (C.c + size p <= max_query) { - C.c <- C.c + size p; - b <@ F.f(p, n); + module FC (F : FUNCTIONALITY) : FUNCTIONALITY = { + proc init = F.init + + proc f (p : block list, n : int) = { + var b <- b0; + + if (valid p n) { + C.c <- C.c + size p + n; + b <@ F.f(p,n); + } + return b; } - return b; - } -}. + }. -module FRestr(F : FUNCTIONALITY) : FUNCTIONALITY = { - proc init = F.init - proc f = DFRestr(F).f -}. + module DFRestr (F : DFUNCTIONALITY) : DFUNCTIONALITY = { + proc f (p : block list, n : int) = { + var b <- b0; -module (DRestr (D : DISTINGUISHER) : DISTINGUISHER) - (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { - proc distinguish() = { - var b; + if (valid p n /\ C.c + size p + n <= max_query) { + C.c <- C.c + size p + n; + b <@ F.f(p, n); + } + return b; + } + }. - C.init(); - b <@ D(DFRestr(F), DPRestr(P)).distinguish(); - return b; - } -}. + module FRestr(F : FUNCTIONALITY) : FUNCTIONALITY = { + proc init = F.init + proc f = DFRestr(F).f + }. + + module (DRestr (D : DISTINGUISHER) : DISTINGUISHER) + (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + proc distinguish() = { + var b; + + C.init(); + b <@ D(DFRestr(F), DPRestr(P)).distinguish(); + return b; + } + }. +end Counting. +import Counting. (** Core Extension Construction **) module (CoreExtension : CONSTRUCTION) (P:DPRIMITIVE): FUNCTIONALITY = { @@ -208,7 +216,7 @@ module (CoreExtension : CONSTRUCTION) (P:DPRIMITIVE): FUNCTIONALITY = { proc f(p : block list, n : int): block = { var (sa,sc) <- (b0,c0); - if (valid p /\ 0 <= n) { + if (valid p n) { p <- extend p n; while (p <> []) { (sa,sc) <@ P.f((sa +^ head witness p,sc)); @@ -230,7 +238,7 @@ module ICoreExtension: FUNCTIONALITY = { proc f(p : block list, n : int): block = { var r <- b0; - if (valid p /\ 0 <= n) { + if (valid p n) { if (!mem (dom m) (p,n)) { m.[(p,n)] <$ bdistr; } @@ -260,7 +268,7 @@ section PROOF. op Capacity.c0 <- c0, op Capacity.enum <- caps, op max_query <- max_query, - op valid (bs) <- valid (strip bs).`1 /\ 0 <= (strip bs).`2 + op valid (bs) <- valid (strip bs).`1 (strip bs).`2 proof *. realize Block.r_ge0 by exact/r_ge0. realize Block.addbA by exact/addbA. @@ -272,8 +280,9 @@ section PROOF. realize Capacity.c_ge0 by exact/c_ge0. realize Capacity.capacity_enum by exact/caps_spec. realize Capacity.card_capacity by exact/card_capacity. - realize valid_not_nil by admit. realize max_query_ge0 by exact/max_query_ge0. + realize valid_not_nil. + proof. by move=> m /nil_not_valid; exact/(@strip_nil m). qed. (** Simulator and Distinguisher constructions **) module (RaiseSim (S : CoreSim.SIMULATOR) : SIMULATOR) @@ -299,7 +308,7 @@ section PROOF. proc f(p : block list, n : int) = { var b <- b0; - if (valid p /\ 0 <= n) { + if (valid p n) { p <- extend p n; b <@ F.f(p); } @@ -310,9 +319,54 @@ section PROOF. proc distinguish = D(RaiseF,P).distinguish }. - declare module D : DISTINGUISHER { CoreSim.Core, CoreSim.Perm.Perm, CoreSim.ICore, CoreSim.S, CoreSim.C, ICoreExtension }. - local lemma LiftIndif &m: + (** Transferring Query Counting -- We need to give two lemmas because of restrictions **) + local equiv DRestr_LowerDist_Real + (D <: DISTINGUISHER { CoreSim.Counting.C, Self.Counting.C }) + (C <: CoreSim.CONSTRUCTION {D, CoreSim.Counting.C, Self.Counting.C}) + (P <: DPRIMITIVE {D, C, CoreSim.Counting.C, Self.Counting.C}): + LowerDist(DRestr(D),C(P),P).distinguish ~ CoreSim.Counting.DRestr(LowerDist(D),C(P),P).distinguish: + ={glob D, glob C, glob P} + ==> ={res, glob D, glob C, glob P} /\ Counting.C.c{1} = CoreSim.Counting.C.c{2}. + proof. + proc; call (_: ={glob C, glob P} + /\ Counting.C.c{1} = CoreSim.Counting.C.c{2}); + first 2 by sim. + + proc; sp; if{2}=> //=; last by rcondf{1} 1; 1:by auto=> /> ->. + inline{2} 2; inline{1} 1.2. + sp; if; auto. + + by move=> /> &1 &2 ^ ^ ^ valid_pn /extendK -> /= /size_extend -> -> /#. + rcondt{1} 5; 1:by auto. + by sim; auto=> /> &1 &2 /size_extend -> /#. + by inline *; auto. + qed. + + local equiv DRestr_LowerDist_Ideal + (D <: DISTINGUISHER { CoreSim.Counting.C, Self.Counting.C }) + (F <: CoreSim.DFUNCTIONALITY {D, CoreSim.Counting.C, Self.Counting.C}) + (S <: CoreSim.SIMULATOR {D, F, CoreSim.Counting.C, Self.Counting.C}): + LowerDist(DRestr(D),F,S(F)).distinguish ~ CoreSim.Counting.DRestr(LowerDist(D),F,S(F)).distinguish: + ={glob D, glob F, glob S} + ==> ={res, glob D, glob F, glob S} /\ Counting.C.c{1} = CoreSim.Counting.C.c{2}. + proof. + proc; call (_: ={glob F, glob S} + /\ Counting.C.c{1} = CoreSim.Counting.C.c{2}); + first 2 by sim. + + proc; sp; if{2}=> //=; last by rcondf{1} 1; 1:by auto=> /> ->. + inline{2} 2; inline{1} 1.2. + sp; if; auto. + + by move=> /> &1 &2 ^ ^ ^ valid_pn /extendK -> /= /size_extend -> -> /#. + rcondt{1} 5; 1:by auto. + by sim; auto=> /> &1 &2 /size_extend -> /#. + by inline *; auto. + qed. + + (** The raised simulator is such that the indifferentiability + advantage of any high-level adversary is exactly that of the + lowered distinguisher against the low-level simulator. **) + local lemma LiftIndif + (D <: DISTINGUISHER { CoreSim.Perm.Perm, CoreSim.ICore, CoreSim.S, ICoreExtension }) + &m: `| Pr[CoreSim.GReal(LowerDist(D)).main() @ &m: res] - Pr[CoreSim.GIdeal(LowerDist(D)).main() @ &m: res] | = `| Pr[GReal(D,CoreSim.Perm.Perm).main() @ &m: res] @@ -322,9 +376,7 @@ section PROOF. + byequiv (_: ={glob D} ==> _)=> //; proc. seq 2 2: (={glob CoreSim.Perm.Perm, glob D}). + by inline *; auto. - call (_: ={glob CoreSim.Perm.Perm})=> //. - + by proc; inline{1} 2; wp; sim. - + by proc; inline{1} 2; wp; sim. + call (_: ={glob CoreSim.Perm.Perm})=> //; first 2 by sim. proc; sp; if=> //=. inline{1} 2; wp. while (={glob CoreSim.Perm.Perm, sa, sc} /\ p0{1} = p{2}); auto. by inline *; sp; if=> //=; auto. @@ -332,17 +384,15 @@ section PROOF. seq 2 2: ( ={glob D, glob CoreSim.S} /\ (forall p n, mem (dom ICoreExtension.m) (p,n) - => valid p - /\ 0 <= n){2} - /\ (forall p n, valid p => 0 <= n => + => valid p n){2} + /\ (forall p n, valid p n => ICoreExtension.m.[(p,n)]{2} = CoreSim.ICore.m.[extend p n]{1})). + by inline *; auto; smt (in_dom map0P). call (_: ={glob CoreSim.S} /\ (forall p n, mem (dom ICoreExtension.m) (p,n) - => valid p - /\ 0 <= n){2} - /\ (forall p n, valid p => 0 <= n => + => valid p n){2} + /\ (forall p n, valid p n => ICoreExtension.m.[(p,n)]{2} = CoreSim.ICore.m.[extend p n]{1}))=> //. + proc; if=> //=; last by auto. if=> //=. @@ -360,16 +410,14 @@ section PROOF. /\ CoreSim.S.m.[x]{1} = None /\ (forall p n, mem (dom ICoreExtension.m) (p,n) - => valid p - /\ 0 <= n){2} - /\ (forall p n, valid p => 0 <= n => + => valid p n){2} + /\ (forall p n, valid p n => ICoreExtension.m.[(p,n)]{2} = CoreSim.ICore.m.[extend p n]{1}) ==> ={glob CoreSim.S, y1, p, v, x} /\ (forall p n, mem (dom ICoreExtension.m) (p,n) - => valid p - /\ 0 <= n){2} - /\ (forall p n, valid p => 0 <= n => + => valid p n){2} + /\ (forall p n, valid p n => ICoreExtension.m.[(p,n)]{2} = CoreSim.ICore.m.[extend p n]{1}))=> //. + auto=> /> &1 &2 ^pv_def <- [#] <*> h1 h2; rewrite !in_dom=> /= -> /=. by case: (CoreSim.S.pi.[x.`2]{2}) pv_def=> //= x @/oget /=. @@ -377,23 +425,23 @@ section PROOF. + by move=> /> &1 &2; case: (strip (rcons p (v +^ x.`1)){2})=> p' n' [#] !->>. if=> //=. + move=> /> &1 &2; case _: (strip (rcons p (v +^ x.`1)){2})=> p' n' h_def [#] !->>. - move=> _ _ h1 h2 /= valid_p ge0_n; rewrite !in_dom. + move=> _ _ h1 h2 /= valid_pn; rewrite !in_dom. rewrite h2 //. have ->: p' = (strip (rcons p (v +^ x.`1)){2}).`1 by rewrite h_def. have ->: n' = (strip (rcons p (v +^ x.`1)){2}).`2 by rewrite h_def. by rewrite (@stripK (rcons p (v +^ x.`1)){2}). + auto=> /> &1 &2; case _: (strip (rcons p (v +^ x.`1)){2})=> p' n' h_def [#] !->>. - move=> pi_x2 m_x h1 h2 /= valid_p n_ge0; rewrite in_dom=> /= m_pvx1. + move=> pi_x2 m_x h1 h2 /= valid_pn; rewrite in_dom=> /= m_pvx1. move=> _ b _ _; rewrite getP /= oget_some getP /= oget_some /=; split. + move=> p n; rewrite in_dom getP; case ((p,n) = (p',n'))=> //= _. by rewrite -in_dom=> /h1. - move=> p0 n0 valid_p' n'_ge0; rewrite !getP h2 // -h_def. + move=> p0 n0 valid_pn'; rewrite !getP h2 // -h_def. case: (extend p0 n0 = (rcons p (v +^ x.`1)){2})=> //=. + by rewrite -extendK=> // ->. case: ((p0,n0) = (strip (rcons p (v +^ x.`1))){2})=> //=. smt (stripK). + auto=> /> &1 &2; case _: (strip (rcons p (v +^ x.`1)){2})=> p' n' h_def [#] !->>. - by move=> _ _ h1 h2 /= valid_p' n'_ge0 _; rewrite h2 //; smt (stripK). + by move=> _ _ h1 h2 /= valid_pn' _; rewrite h2 //; smt (stripK). by auto. rcondf{1} 6; 1:by auto. rcondf{2} 6; 1:by auto. @@ -403,15 +451,49 @@ section PROOF. rcondt{1} 4; 1:auto. + by move=> &hr [#] !->> h1 h2 valid_p n_ge0 /=; rewrite extendK. sp; if=> //=. - + by move=> /> &1 &2 h1 h2 valid_p n_ge0; rewrite !in_dom h2 // -extendK. - + auto=> /> &1 &2 h1 h2 valid_p n_ge0; rewrite in_dom=> /= ^extend_pn_notin_m. + + by move=> /> &1 &2 h1 h2 valid_pn; rewrite !in_dom h2 // -extendK. + + auto=> /> &1 &2 h1 h2 valid_pn; rewrite in_dom=> /= ^extend_pn_notin_m. rewrite -h2=> // pn_notin_m _ b _ _; rewrite 2!getP /=; split. + move=> p' n'; rewrite in_dom getP; case ((p',n') = (p{2},n{2}))=> //= _. by rewrite -in_dom=> /h1. - move=> p0 m0 valid_p0 n0_ge0; rewrite !getP h2 // -!extendK //. + move=> p0 m0 valid_pn0; rewrite !getP h2 // -!extendK //. case: (extend p0 m0 = extend p{2} n{2})=> [->|] //. by have /contra H /H ->:= (injective_strip (extend p0 m0) (extend p{2} n{2})). - by auto=> /> &1 &2 h1 h2 valid_p n_ge0 _; rewrite -h2. + by auto=> /> &1 &2 h1 h2 valid_pn _; rewrite -h2. qed. + (** And we conclude with a bound on indifferentiability of the + high-level construction **) + (** TODO: Arrange that this lemma be non-local **) + local lemma ExtensionIndif + (D <: DISTINGUISHER { CoreSim.Perm.Perm, CoreSim.ICore, CoreSim.S, + ICoreExtension, CoreSim.Counting.C, Self.Counting.C }) + &m: + (forall (F <: DFUNCTIONALITY {D}) (P <: DPRIMITIVE {D}), + islossless P.f + => islossless P.fi + => islossless F.f + => islossless D(F,P).distinguish) + => `| Pr[GReal(DRestr(D),CoreSim.Perm.Perm).main() @ &m: res] + - Pr[GIdeal(DRestr(D),RaiseSim(CoreSim.S)).main() @ &m: res] | + <= (max_query ^ 2)%r / (2^(r + c))%r + + max_query%r * ((2*max_query)%r / (2^c)%r) + + max_query%r * ((2*max_query)%r / (2^c)%r). + proof. + move=> D_ll. + rewrite -(LiftIndif (DRestr(D)) &m). + have ->: Pr[CoreSim.GReal(LowerDist(DRestr(D))).main() @ &m: res] + = Pr[CoreSim.GReal(CoreSim.Counting.DRestr(LowerDist(D))).main() @ &m: res]. + + byequiv (_: ={glob D} ==> _)=> //=; proc. + call (DRestr_LowerDist_Real D CoreSim.Core CoreSim.Perm.Perm). + by inline *; auto. + have ->: Pr[CoreSim.GIdeal(LowerDist(DRestr(D))).main() @ &m: res] + = Pr[CoreSim.GIdeal(CoreSim.Counting.DRestr(LowerDist(D))).main() @ &m: res]. + + byequiv (_: ={glob D} ==> _)=> //=; proc. + call (DRestr_LowerDist_Ideal D CoreSim.ICore CoreSim.S). + by inline *; auto. + apply/(CoreSim.CoreIndiff (LowerDist(D)) &m _). + move=> F P Pf_ll Pfi_ll Ff_ll; proc (true)=> //. + by proc; sp; if=> //=; call Ff_ll; auto. + qed. end section PROOF. diff --git a/sha3/proof/core/CoreToBlockSponge.eca b/sha3/proof/core/CoreToBlockSponge.eca index 640d086..6cf2b01 100644 --- a/sha3/proof/core/CoreToBlockSponge.eca +++ b/sha3/proof/core/CoreToBlockSponge.eca @@ -1,6 +1,27 @@ (* -------------------------------------------------------------------- *) require import Option Pair Int Real Distr List FSet NewFMap DProd. -require import BlockSponge Gconcl. +require import BlockSponge. + +require (*--*) Core. + +op max_query : int. +axiom max_query_ge0: 0 <= max_query. + +clone Core as CoreConstruction with + op Block.r <- Common.r, + type Block.block <- Common.block, + op Block.b0 <- Common.Block.b0, + op Block.(+^) <- Common.Block.(+^), + op Block.enum <- Common.Block.blocks, + op Capacity.c <- Common.c, + type Capacity.capacity <- Common.capacity, + op Capacity.c0 <- Common.Capacity.c0, + op Capacity.enum <- Common.Capacity.caps, + op max_query <- max_query +proof *. +realize Block.r_ge0 by exact/Common.ge0_r. +search Common.Block.(+^). +realize Block.addbA by exact/Common.Block.addwA. (*---*) import Common Perm. From 0aa526a0d44421756242e9d0e16a850cbca88a08 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 1 Sep 2016 13:32:24 +0100 Subject: [PATCH 227/394] NewCore --- sha3/proof/clean/NewCore.eca | 324 +++++++++++++++++++++++++++++++++++ 1 file changed, 324 insertions(+) create mode 100644 sha3/proof/clean/NewCore.eca diff --git a/sha3/proof/clean/NewCore.eca b/sha3/proof/clean/NewCore.eca new file mode 100644 index 0000000..39fc5c0 --- /dev/null +++ b/sha3/proof/clean/NewCore.eca @@ -0,0 +1,324 @@ +require import Pred Fun Option Pair Int Real List FSet NewFMap NewDistr. +require import StdOrder Ring DProd. +(*---*) import IntOrder. + +require (*..*) RP Indifferentiability. + +(*** THEORY PARAMETERS ***) +(** Block/Rate **) +theory Block. + op r : int. + axiom r_ge0: 0 <= r. + + type block. + + op b0: block. + op (+^): block -> block -> block. + + axiom addbA b1 b2 b3: b1 +^ (b2 +^ b3) = b1 +^ b2 +^ b3. + axiom addbC b1 b2: b1 +^ b2 = b2 +^ b1. + axiom add0b b: b0 +^ b = b. + axiom addbK b: b +^ b = b0. + + op enum: block list. + axiom block_enum b: count (pred1 b) enum = 1. + axiom card_block: size enum = 2^r. + + clone import Ring.ZModule as BlockMonoid with + type t <- block, + op zeror <- b0, + op ( + ) <- (+^), + op [ - ] (b : block) <- b + remove abbrev (-) + proof *. + realize addrA by exact/addbA. + realize addrC by exact/addbC. + realize add0r by exact/add0b. + realize addNr by exact/addbK. + + clone import MFinite as DBlock with + type t <- block, + op Support.enum <- enum + rename "dunifin" as "bdistr" + "duniform" as "bdistr" + proof *. + realize Support.enum_spec by exact/block_enum. +end Block. +import Block DBlock. + +(** Capacity **) +theory Capacity. + op c : int. + axiom c_ge0: 0 <= c. + + type capacity. + + op c0: capacity. + + op enum: capacity list. + axiom capacity_enum b: count (pred1 b) enum = 1. + axiom card_capacity: size enum = 2^c. + + clone import MFinite as DCapacity with + type t <- capacity, + op Support.enum <- enum + rename "dunifin" as "cdistr" + "duniform" as "cdistr" + proof *. + realize Support.enum_spec by exact/capacity_enum. +end Capacity. +import Capacity DCapacity. + +(** Validity of Functionality Queries **) +op valid: block list -> bool. +axiom valid_not_nil m: valid m => m <> []. + +(** Adversary's Query Cost **) +op max_query: int. +axiom max_query_ge0: 0 <= max_query. + +(*** DEFINITIONS ***) +type state = block * capacity. +op dstate = bdistr `*` cdistr. + +(** Indifferentiability Experiment **) +clone include Indifferentiability with + type p <- state, + type f_in <- block list, + type f_out <- block list + rename [module] "GReal" as "RealIndif" + [module] "GIdeal" as "IdealIndif". + +(** Query Counting **) +theory Counting. + module C = { + var c:int + proc init() = { c <- 0; } + }. + + module PC (P : PRIMITIVE) : PRIMITIVE = { + proc init () = { + C.init(); + P.init(); + } + + proc f (x : state) = { + var y; + + C.c <- C.c + 1; + y <@ P.f(x); + return y; + } + + proc fi(x : state) = { + var y; + + C.c <- C.c + 1; + y <@ P.fi(x); + return y; + } + }. + + module DPRestr (P : DPRIMITIVE) : DPRIMITIVE = { + proc f (x : state) = { + var y <- (b0,c0); + + if (C.c + 1 <= max_query) { + C.c <- C.c + 1; + y <@ P.f(x); + } + return y; + } + + proc fi(x : state) = { + var y <- (b0,c0); + + if (C.c + 1 <= max_query) { + C.c <- C.c + 1; + y <@ P.fi(x); + } + return y; + } + }. + + module PRestr (P : PRIMITIVE) : PRIMITIVE = { + proc init () = { + C.init(); + P.init(); + } + + proc f = DPRestr(P).f + proc fi = DPRestr(P).fi + }. + + module FC (F : FUNCTIONALITY) : FUNCTIONALITY = { + proc init = F.init + + proc f (p : block list) = { + var r <- []; + + if (valid p) { + C.c <- C.c + size p; + r <@ F.f(p); + } + return r; + } + }. + + module DFRestr (F : DFUNCTIONALITY) : DFUNCTIONALITY = { + proc f (bs : block list) = { + var r <- []; + + if (valid bs /\ C.c + size bs <= max_query) { + C.c <- C.c + size bs; + r <@ F.f(bs); + } + return r; + } + }. + + module FRestr(F : FUNCTIONALITY) : FUNCTIONALITY = { + proc init = F.init + proc f = DFRestr(F).f + }. + + module (DRestr (D : DISTINGUISHER) : DISTINGUISHER) + (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + proc distinguish() = { + var b; + + C.init(); + b <@ D(DFRestr(F), DPRestr(P)).distinguish(); + return b; + } + }. +end Counting. + +(** Ideal Primitive **) +clone export RP as Perm with + type t <- block * capacity, + op dt <- bdistr `*` cdistr + rename + [module type] "RP" as "PRIMITIVE" + [module] "P" as "Perm". + +(** Core Construction **) +module (Core : CONSTRUCTION) (P:DPRIMITIVE): FUNCTIONALITY = { + proc init () = {} + + proc f(p : block list): block list = { + var (sa,sc) <- (b0,c0); + var r <- []; + + while (p <> []) { + (sa,sc) <@ P.f((sa +^ head witness p,sc)); + r <- rcons r sa; + p <- behead p; + } + return r; + } +}. + +(** Ideal Core Functionality **) +module ICore : FUNCTIONALITY = { + var m : (block list,block) fmap + + proc init() = { + m = map0; + } + + proc fill_in(p : block list) = { + if (!mem (dom m) p) { + m.[p] <$ bdistr; + } + return oget m.[p]; + } + + proc f(p : block list): block list = { + var r <- []; + var i <- 0; + var b; + + if (valid p) { + while (i < size p) { + b <@ fill_in(take i p); + r <- rcons r b; + i <- i + 1; + } + } + return r; + } +}. + +(** Core Simulator **) +module (S : SIMULATOR) (F : DFUNCTIONALITY) : PRIMITIVE = { + var m, mi : (state,state) fmap + var pi : (capacity, block list * block) fmap + + proc init() = { + m <- map0; + mi <- map0; + pi <- map0.[c0 <- ([<:block>],b0)]; + } + + proc f(x : state): state = { + var p, v, y, y1, y2; + var b; + + if (!mem (dom m) x) { + if (mem (dom pi) x.`2) { + (p,v) <- oget pi.[x.`2]; + (* Not sure *) + b <- F.f (rcons p (v +^ x.`1)); + y1 <- last b0 b; + } else { + y1 <$ bdistr; + } + y2 <$ cdistr; + y <- (y1,y2); + m.[x] <- y; + mi.[y] <- x; + if (mem (dom pi) x.`2) { + (p,v) <- oget pi.[x.`2]; + pi.[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 (!mem (dom mi) x) { + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + mi.[x] <- y; + m.[y] <- x; + } else { + y <- oget mi.[x]; + } + return y; + } +}. + +(** Initial and Final Games **) +module GReal (D : DISTINGUISHER) = RealIndif(Core,Perm,D). +module GIdeal (D : DISTINGUISHER) = IdealIndif(ICore,S,D). + +(*** PROOF ***) +import Counting. +lemma CoreIndiff (D <: DISTINGUISHER {C, Perm, Core, ICore, S}) &m: + (forall (F <: DFUNCTIONALITY {D}) (P <: DPRIMITIVE {D}), + islossless P.f + => islossless P.fi + => islossless F.f + => islossless D(F,P).distinguish) + => `| Pr[RealIndif(Core,Perm,DRestr(D)).main() @ &m: res] + - Pr[IdealIndif(ICore,S,DRestr(D)).main() @ &m :res] | + <= (max_query ^ 2)%r / (2^(r + c))%r + + max_query%r * ((2*max_query)%r / (2^c)%r) + + max_query%r * ((2*max_query)%r / (2^c)%r). +admitted. From 60d717baec49795b6b09385e5d3e44c26d7cf81c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 1 Sep 2016 13:51:12 +0100 Subject: [PATCH 228/394] Removing newly obsolete files. --- sha3/proof/clean/Core.eca | 309 ------------------ sha3/proof/clean/CoreExtension.eca | 499 ----------------------------- 2 files changed, 808 deletions(-) delete mode 100644 sha3/proof/clean/Core.eca delete mode 100644 sha3/proof/clean/CoreExtension.eca diff --git a/sha3/proof/clean/Core.eca b/sha3/proof/clean/Core.eca deleted file mode 100644 index 5302fc9..0000000 --- a/sha3/proof/clean/Core.eca +++ /dev/null @@ -1,309 +0,0 @@ -require import Pred Fun Option Pair Int Real List FSet NewFMap NewDistr. -require import StdOrder Ring DProd. -(*---*) import IntOrder. - -require (*..*) RP Indifferentiability. - -(*** THEORY PARAMETERS ***) -(** Block/Rate **) -theory Block. - op r : int. - axiom r_ge0: 0 <= r. - - type block. - - op b0: block. - op (+^): block -> block -> block. - - axiom addbA b1 b2 b3: b1 +^ (b2 +^ b3) = b1 +^ b2 +^ b3. - axiom addbC b1 b2: b1 +^ b2 = b2 +^ b1. - axiom add0b b: b0 +^ b = b. - axiom addbK b: b +^ b = b0. - - op enum: block list. - axiom block_enum b: count (pred1 b) enum = 1. - axiom card_block: size enum = 2^r. - - clone import Ring.ZModule as BlockMonoid with - type t <- block, - op zeror <- b0, - op ( + ) <- (+^), - op [ - ] (b : block) <- b - remove abbrev (-) - proof *. - realize addrA by exact/addbA. - realize addrC by exact/addbC. - realize add0r by exact/add0b. - realize addNr by exact/addbK. - - clone import MFinite as DBlock with - type t <- block, - op Support.enum <- enum - rename "dunifin" as "bdistr" - "duniform" as "bdistr" - proof *. - realize Support.enum_spec by exact/block_enum. -end Block. -import Block DBlock. - -(** Capacity **) -theory Capacity. - op c : int. - axiom c_ge0: 0 <= c. - - type capacity. - - op c0: capacity. - - op enum: capacity list. - axiom capacity_enum b: count (pred1 b) enum = 1. - axiom card_capacity: size enum = 2^c. - - clone import MFinite as DCapacity with - type t <- capacity, - op Support.enum <- enum - rename "dunifin" as "cdistr" - "duniform" as "cdistr" - proof *. - realize Support.enum_spec by exact/capacity_enum. -end Capacity. -import Capacity DCapacity. - -(** Validity of Functionality Queries **) -op valid: block list -> bool. -axiom valid_not_nil m: valid m => m <> []. - -(** Adversary's Query Cost **) -op max_query: int. -axiom max_query_ge0: 0 <= max_query. - -(*** DEFINITIONS ***) -type state = block * capacity. -op dstate = bdistr `*` cdistr. - -(** Indifferentiability Experiment **) -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". - -(** Query Counting **) -theory Counting. - module C = { - var c:int - proc init() = { c <- 0; } - }. - - module PC (P : PRIMITIVE) : PRIMITIVE = { - proc init () = { - C.init(); - P.init(); - } - - proc f (x : state) = { - var y; - - C.c <- C.c + 1; - y <@ P.f(x); - return y; - } - - proc fi(x : state) = { - var y; - - C.c <- C.c + 1; - y <@ P.fi(x); - return y; - } - }. - - module DPRestr (P : DPRIMITIVE) : DPRIMITIVE = { - proc f (x : state) = { - var y <- (b0,c0); - - if (C.c + 1 <= max_query) { - C.c <- C.c + 1; - y <@ P.f(x); - } - return y; - } - - proc fi(x : state) = { - var y <- (b0,c0); - - if (C.c + 1 <= max_query) { - C.c <- C.c + 1; - y <@ P.fi(x); - } - return y; - } - }. - - module PRestr (P : PRIMITIVE) : PRIMITIVE = { - proc init () = { - C.init(); - P.init(); - } - - proc f = DPRestr(P).f - proc fi = DPRestr(P).fi - }. - - module FC (F : FUNCTIONALITY) : FUNCTIONALITY = { - proc init = F.init - - proc f (p : block list) = { - var b <- b0; - - if (valid p) { - C.c <- C.c + size p; - b <@ F.f(p); - } - return b; - } - }. - - module DFRestr (F : DFUNCTIONALITY) : DFUNCTIONALITY = { - proc f (bs : block list) = { - var b <- b0; - - if (valid bs /\ C.c + size bs <= max_query) { - C.c <- C.c + size bs; - b <@ F.f(bs); - } - return b; - } - }. - - module FRestr(F : FUNCTIONALITY) : FUNCTIONALITY = { - proc init = F.init - proc f = DFRestr(F).f - }. - - module (DRestr (D : DISTINGUISHER) : DISTINGUISHER) - (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { - proc distinguish() = { - var b; - - C.init(); - b <@ D(DFRestr(F), DPRestr(P)).distinguish(); - return b; - } - }. -end Counting. - -(** Ideal Primitive **) -clone export RP as Perm with - type t <- block * capacity, - op dt <- bdistr `*` cdistr - rename - [module type] "RP" as "PRIMITIVE" - [module] "P" as "Perm". - -(** Core Construction **) -module (Core : CONSTRUCTION) (P:DPRIMITIVE): FUNCTIONALITY = { - proc init () = {} - - proc f(p : block list): block = { - var (sa,sc) <- (b0,c0); - - while (p <> []) { - (sa,sc) <@ P.f((sa +^ head witness p,sc)); - p <- behead p; - } - return sa; - } -}. - -(** Ideal Core Functionality **) -module ICore: FUNCTIONALITY = { - var m : (block list,block) fmap - - proc init() = { - m = map0; - } - - proc f(p : block list): block = { - var r <- b0; - - if (valid p) { - if (!mem (dom m) p) { - m.[p] <$ bdistr; - } - r <- oget m.[p]; - } - return r; - } -}. - -(** Core Simulator **) -module (S : SIMULATOR) (F : DFUNCTIONALITY) : PRIMITIVE = { - var m, mi : (state,state) fmap - var pi : (capacity, block list * block) fmap - - proc init() = { - m <- map0; - mi <- map0; - pi <- map0.[c0 <- ([<:block>],b0)]; - } - - proc f(x : state): state = { - var p, v, y, y1, y2; - - if (!mem (dom m) x) { - if (mem (dom pi) x.`2) { - (p,v) <- oget pi.[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 (mem (dom pi) x.`2) { - (p,v) <- oget pi.[x.`2]; - pi.[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 (!mem (dom mi) x) { - y1 <$ bdistr; - y2 <$ cdistr; - y <- (y1,y2); - mi.[x] <- y; - m.[y] <- x; - } else { - y <- oget mi.[x]; - } - return y; - } -}. -import Counting. - -(** Initial and Final Games **) -module GReal (D : DISTINGUISHER) = RealIndif(Core,Perm,D). -module GIdeal (D : DISTINGUISHER) = IdealIndif(ICore,S,D). - -(*** PROOF ***) -lemma CoreIndiff (D <: DISTINGUISHER {C, Perm, Core, ICore, S}) &m: - (forall (F <: DFUNCTIONALITY {D}) (P <: DPRIMITIVE {D}), - islossless P.f - => islossless P.fi - => islossless F.f - => islossless D(F,P).distinguish) - => `| Pr[RealIndif(Core,Perm,DRestr(D)).main() @ &m: res] - - Pr[IdealIndif(ICore,S,DRestr(D)).main() @ &m :res] | - <= (max_query ^ 2)%r / (2^(r + c))%r - + max_query%r * ((2*max_query)%r / (2^c)%r) - + max_query%r * ((2*max_query)%r / (2^c)%r). -admitted. diff --git a/sha3/proof/clean/CoreExtension.eca b/sha3/proof/clean/CoreExtension.eca deleted file mode 100644 index e2144f8..0000000 --- a/sha3/proof/clean/CoreExtension.eca +++ /dev/null @@ -1,499 +0,0 @@ -pragma -oldip. pragma +implicits. -require import Pred Fun Option Pair Int Real List FSet NewFMap NewDistr. -require import StdOrder Ring DProd. -(*---*) import IntOrder. - -require (*..*) RP Indifferentiability. - -(*** THEORY PARAMETERS ***) -(** Block/Rate **) -theory Block. - op r : int. - axiom r_ge0: 0 <= r. - - type block. - - op b0: block. - op (+^): block -> block -> block. - - axiom addbA b1 b2 b3: b1 +^ (b2 +^ b3) = b1 +^ b2 +^ b3. - axiom addbC b1 b2: b1 +^ b2 = b2 +^ b1. - axiom add0b b: b0 +^ b = b. - axiom addbK b: b +^ b = b0. - - op blocks: block list. - axiom blocks_spec b: count (pred1 b) blocks = 1. - axiom card_block: size blocks = 2^r. - - clone import Ring.ZModule as BlockMonoid with - type t <- block, - op zeror <- b0, - op ( + ) <- (+^), - op [ - ] (b : block) <- b - remove abbrev (-) - proof *. - realize addrA by exact/addbA. - realize addrC by exact/addbC. - realize add0r by exact/add0b. - realize addNr by exact/addbK. - - clone import MFinite as DBlock with - type t <- block, - op Support.enum <- blocks - rename "dunifin" as "bdistr" - "duniform" as "bdistr" - proof *. - realize Support.enum_spec by exact/blocks_spec. -end Block. -import Block DBlock. - -(** Capacity **) -theory Capacity. - op c : int. - axiom c_ge0: 0 <= c. - - type capacity. - - op c0: capacity. - - op caps: capacity list. - axiom caps_spec b: count (pred1 b) caps = 1. - axiom card_capacity: size caps = 2^c. - - clone import MFinite as DCapacity with - type t <- capacity, - op Support.enum <- caps - rename "dunifin" as "cdistr" - "duniform" as "cdistr" - proof *. - realize Support.enum_spec by exact/caps_spec. -end Capacity. -import Capacity DCapacity. - -(** Validity of Functionality Queries and Partial Bijection **) -op valid: block list -> int -> bool. -axiom nil_not_valid bs n: valid bs n => bs <> []. - -op extend: block list -> int -> block list. -op strip: block list -> (block list * int). - -axiom strip_nil bs: (strip bs).`1 <> [] => bs <> []. -axiom stripK bs: extend (strip bs).`1 (strip bs).`2 = bs. -axiom extendK bs n: valid bs n => strip (extend bs n) = (bs,n). -axiom size_extend bs n: valid bs n => size (extend bs n) = size bs + n. - -lemma injective_strip: injective strip. -proof. -by move=> bs1 bs2 eq_strip; rewrite -stripK eq_strip; exact/(@stripK bs2). -qed. - -(** Adversary's Query Cost **) -op max_query: int. -axiom max_query_ge0: 0 <= max_query. - -(*** DEFINITIONS ***) -type state = block * capacity. -op dstate = bdistr `*` cdistr. - -(** Indifferentiability Experiment **) -clone include Indifferentiability with - type p <- state, - type f_in <- block list * int, - type f_out <- block - rename [module] "GReal" as "RealIndif" - [module] "GIdeal" as "IdealIndif". - -(** Query Counting -- Note that we only count **adversary** queries **) -theory Counting. - module C = { - var c:int - proc init() = { c <- 0; } - }. - - module PC (P : PRIMITIVE) : PRIMITIVE = { - proc init () = { - C.init(); - P.init(); - } - - proc f (x : state) = { - var y; - - C.c <- C.c + 1; - y <@ P.f(x); - return y; - } - - proc fi(x : state) = { - var y; - - C.c <- C.c + 1; - y <@ P.fi(x); - return y; - } - }. - - module DPRestr (P : DPRIMITIVE) : DPRIMITIVE = { - proc f (x : state) = { - var y <- (b0,c0); - - if (C.c + 1 <= max_query) { - C.c <- C.c + 1; - y <@ P.f(x); - } - return y; - } - - proc fi(x : state) = { - var y <- (b0,c0); - - if (C.c + 1 <= max_query) { - C.c <- C.c + 1; - y <@ P.fi(x); - } - return y; - } - }. - - module PRestr (P : PRIMITIVE) : PRIMITIVE = { - proc init () = { - C.init(); - P.init(); - } - - proc f = DPRestr(P).f - proc fi = DPRestr(P).fi - }. - - module FC (F : FUNCTIONALITY) : FUNCTIONALITY = { - proc init = F.init - - proc f (p : block list, n : int) = { - var b <- b0; - - if (valid p n) { - C.c <- C.c + size p + n; - b <@ F.f(p,n); - } - return b; - } - }. - - module DFRestr (F : DFUNCTIONALITY) : DFUNCTIONALITY = { - proc f (p : block list, n : int) = { - var b <- b0; - - if (valid p n /\ C.c + size p + n <= max_query) { - C.c <- C.c + size p + n; - b <@ F.f(p, n); - } - return b; - } - }. - - module FRestr(F : FUNCTIONALITY) : FUNCTIONALITY = { - proc init = F.init - proc f = DFRestr(F).f - }. - - module (DRestr (D : DISTINGUISHER) : DISTINGUISHER) - (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { - proc distinguish() = { - var b; - - C.init(); - b <@ D(DFRestr(F), DPRestr(P)).distinguish(); - return b; - } - }. -end Counting. -import Counting. - -(** Core Extension Construction **) -module (CoreExtension : CONSTRUCTION) (P:DPRIMITIVE): FUNCTIONALITY = { - proc init () = {} - - proc f(p : block list, n : int): block = { - var (sa,sc) <- (b0,c0); - - if (valid p n) { - p <- extend p n; - while (p <> []) { - (sa,sc) <@ P.f((sa +^ head witness p,sc)); - p <- behead p; - } - } - return sa; - } -}. - -(** Ideal Core Extension Functionality **) -module ICoreExtension: FUNCTIONALITY = { - var m : (block list * int,block) fmap - - proc init() = { - m = map0; - } - - proc f(p : block list, n : int): block = { - var r <- b0; - - if (valid p n) { - if (!mem (dom m) (p,n)) { - m.[(p,n)] <$ bdistr; - } - r <- oget m.[(p,n)]; - } - return r; - } -}. - -(** Initial and Final Games **) -module GReal (D : DISTINGUISHER, P : PRIMITIVE) = RealIndif(CoreExtension,P,D). - -module GIdeal (D : DISTINGUISHER, S : SIMULATOR) = IdealIndif(ICoreExtension,S,D). - -(*** PROOF ***) -require (*--*) Core. - -section PROOF. - local clone Core as CoreSim with - op Block.r <- r, - type Block.block <- block, - op Block.b0 <- b0, - op Block.(+^) <- (+^), - op Block.enum <- blocks, - op Capacity.c <- c, - type Capacity.capacity <- capacity, - op Capacity.c0 <- c0, - op Capacity.enum <- caps, - op max_query <- max_query, - op valid (bs) <- valid (strip bs).`1 (strip bs).`2 - proof *. - realize Block.r_ge0 by exact/r_ge0. - realize Block.addbA by exact/addbA. - realize Block.addbC by exact/addbC. - realize Block.add0b by exact/add0b. - realize Block.addbK by exact/addbK. - realize Block.block_enum by exact/blocks_spec. - realize Block.card_block by exact/card_block. - realize Capacity.c_ge0 by exact/c_ge0. - realize Capacity.capacity_enum by exact/caps_spec. - realize Capacity.card_capacity by exact/card_capacity. - realize max_query_ge0 by exact/max_query_ge0. - realize valid_not_nil. - proof. by move=> m /nil_not_valid; exact/(@strip_nil m). qed. - - (** Simulator and Distinguisher constructions **) - module (RaiseSim (S : CoreSim.SIMULATOR) : SIMULATOR) - (F : DFUNCTIONALITY) = { - module LowerF = { - proc f(p : block list) = { - var n, b; - - (p,n) <- strip p; - b <@ F.f(p,n); - return b; - } - } - - proc init = S(LowerF).init - proc f = S(LowerF).f - proc fi = S(LowerF).fi - }. - - module (LowerDist (D : DISTINGUISHER) : CoreSim.DISTINGUISHER) - (F : CoreSim.DFUNCTIONALITY) (P : CoreSim.DPRIMITIVE) = { - module RaiseF = { - proc f(p : block list, n : int) = { - var b <- b0; - - if (valid p n) { - p <- extend p n; - b <@ F.f(p); - } - return b; - } - } - - proc distinguish = D(RaiseF,P).distinguish - }. - - - (** Transferring Query Counting -- We need to give two lemmas because of restrictions **) - local equiv DRestr_LowerDist_Real - (D <: DISTINGUISHER { CoreSim.Counting.C, Self.Counting.C }) - (C <: CoreSim.CONSTRUCTION {D, CoreSim.Counting.C, Self.Counting.C}) - (P <: DPRIMITIVE {D, C, CoreSim.Counting.C, Self.Counting.C}): - LowerDist(DRestr(D),C(P),P).distinguish ~ CoreSim.Counting.DRestr(LowerDist(D),C(P),P).distinguish: - ={glob D, glob C, glob P} - ==> ={res, glob D, glob C, glob P} /\ Counting.C.c{1} = CoreSim.Counting.C.c{2}. - proof. - proc; call (_: ={glob C, glob P} - /\ Counting.C.c{1} = CoreSim.Counting.C.c{2}); - first 2 by sim. - + proc; sp; if{2}=> //=; last by rcondf{1} 1; 1:by auto=> /> ->. - inline{2} 2; inline{1} 1.2. - sp; if; auto. - + by move=> /> &1 &2 ^ ^ ^ valid_pn /extendK -> /= /size_extend -> -> /#. - rcondt{1} 5; 1:by auto. - by sim; auto=> /> &1 &2 /size_extend -> /#. - by inline *; auto. - qed. - - local equiv DRestr_LowerDist_Ideal - (D <: DISTINGUISHER { CoreSim.Counting.C, Self.Counting.C }) - (F <: CoreSim.DFUNCTIONALITY {D, CoreSim.Counting.C, Self.Counting.C}) - (S <: CoreSim.SIMULATOR {D, F, CoreSim.Counting.C, Self.Counting.C}): - LowerDist(DRestr(D),F,S(F)).distinguish ~ CoreSim.Counting.DRestr(LowerDist(D),F,S(F)).distinguish: - ={glob D, glob F, glob S} - ==> ={res, glob D, glob F, glob S} /\ Counting.C.c{1} = CoreSim.Counting.C.c{2}. - proof. - proc; call (_: ={glob F, glob S} - /\ Counting.C.c{1} = CoreSim.Counting.C.c{2}); - first 2 by sim. - + proc; sp; if{2}=> //=; last by rcondf{1} 1; 1:by auto=> /> ->. - inline{2} 2; inline{1} 1.2. - sp; if; auto. - + by move=> /> &1 &2 ^ ^ ^ valid_pn /extendK -> /= /size_extend -> -> /#. - rcondt{1} 5; 1:by auto. - by sim; auto=> /> &1 &2 /size_extend -> /#. - by inline *; auto. - qed. - - (** The raised simulator is such that the indifferentiability - advantage of any high-level adversary is exactly that of the - lowered distinguisher against the low-level simulator. **) - local lemma LiftIndif - (D <: DISTINGUISHER { CoreSim.Perm.Perm, CoreSim.ICore, CoreSim.S, ICoreExtension }) - &m: - `| Pr[CoreSim.GReal(LowerDist(D)).main() @ &m: res] - - Pr[CoreSim.GIdeal(LowerDist(D)).main() @ &m: res] | - = `| Pr[GReal(D,CoreSim.Perm.Perm).main() @ &m: res] - - Pr[GIdeal(D,RaiseSim(CoreSim.S)).main() @ &m: res] |. - proof. - do !congr. - + byequiv (_: ={glob D} ==> _)=> //; proc. - seq 2 2: (={glob CoreSim.Perm.Perm, glob D}). - + by inline *; auto. - call (_: ={glob CoreSim.Perm.Perm})=> //; first 2 by sim. - proc; sp; if=> //=. inline{1} 2; wp. - while (={glob CoreSim.Perm.Perm, sa, sc} /\ p0{1} = p{2}); auto. - by inline *; sp; if=> //=; auto. - byequiv (_: ={glob CoreSim.S, glob D} ==> _)=> //; proc. - seq 2 2: ( ={glob D, glob CoreSim.S} - /\ (forall p n, - mem (dom ICoreExtension.m) (p,n) - => valid p n){2} - /\ (forall p n, valid p n => - ICoreExtension.m.[(p,n)]{2} = CoreSim.ICore.m.[extend p n]{1})). - + by inline *; auto; smt (in_dom map0P). - call (_: ={glob CoreSim.S} - /\ (forall p n, - mem (dom ICoreExtension.m) (p,n) - => valid p n){2} - /\ (forall p n, valid p n => - ICoreExtension.m.[(p,n)]{2} = CoreSim.ICore.m.[extend p n]{1}))=> //. - + proc; if=> //=; last by auto. - if=> //=. - + rcondt{1} 7=> [&m0|]. - + inline *; sp; if=> //=; last by auto; smt (bdistr_ll). - if=> //=; last by auto; smt (bdistr_ll). - by auto; smt (bdistr_ll cdistr_ll). - rcondt{2} 7=> [&m0|]. - + inline *; sp; if=> //=; last by auto; smt (bdistr_ll). - if=> //=; last by auto; smt (bdistr_ll). - by auto; smt (bdistr_ll cdistr_ll). - auto; sp. - conseq (_: ={x, p, v, glob CoreSim.S} - /\ CoreSim.S.pi.[x.`2]{2} = Some (p,v){2} - /\ CoreSim.S.m.[x]{1} = None - /\ (forall p n, - mem (dom ICoreExtension.m) (p,n) - => valid p n){2} - /\ (forall p n, valid p n => - ICoreExtension.m.[(p,n)]{2} = CoreSim.ICore.m.[extend p n]{1}) - ==> ={glob CoreSim.S, y1, p, v, x} - /\ (forall p n, - mem (dom ICoreExtension.m) (p,n) - => valid p n){2} - /\ (forall p n, valid p n => - ICoreExtension.m.[(p,n)]{2} = CoreSim.ICore.m.[extend p n]{1}))=> //. - + auto=> /> &1 &2 ^pv_def <- [#] <*> h1 h2; rewrite !in_dom=> /= -> /=. - by case: (CoreSim.S.pi.[x.`2]{2}) pv_def=> //= x @/oget /=. - inline *; sp; if=> //=. - + by move=> /> &1 &2; case: (strip (rcons p (v +^ x.`1)){2})=> p' n' [#] !->>. - if=> //=. - + move=> /> &1 &2; case _: (strip (rcons p (v +^ x.`1)){2})=> p' n' h_def [#] !->>. - move=> _ _ h1 h2 /= valid_pn; rewrite !in_dom. - rewrite h2 //. - have ->: p' = (strip (rcons p (v +^ x.`1)){2}).`1 by rewrite h_def. - have ->: n' = (strip (rcons p (v +^ x.`1)){2}).`2 by rewrite h_def. - by rewrite (@stripK (rcons p (v +^ x.`1)){2}). - + auto=> /> &1 &2; case _: (strip (rcons p (v +^ x.`1)){2})=> p' n' h_def [#] !->>. - move=> pi_x2 m_x h1 h2 /= valid_pn; rewrite in_dom=> /= m_pvx1. - move=> _ b _ _; rewrite getP /= oget_some getP /= oget_some /=; split. - + move=> p n; rewrite in_dom getP; case ((p,n) = (p',n'))=> //= _. - by rewrite -in_dom=> /h1. - move=> p0 n0 valid_pn'; rewrite !getP h2 // -h_def. - case: (extend p0 n0 = (rcons p (v +^ x.`1)){2})=> //=. - + by rewrite -extendK=> // ->. - case: ((p0,n0) = (strip (rcons p (v +^ x.`1))){2})=> //=. - smt (stripK). - + auto=> /> &1 &2; case _: (strip (rcons p (v +^ x.`1)){2})=> p' n' h_def [#] !->>. - by move=> _ _ h1 h2 /= valid_pn' _; rewrite h2 //; smt (stripK). - by auto. - rcondf{1} 6; 1:by auto. - rcondf{2} 6; 1:by auto. - by auto. - + by proc; if=> //=; auto. - proc; sp; if=> //=; inline{1} 2. - rcondt{1} 4; 1:auto. - + by move=> &hr [#] !->> h1 h2 valid_p n_ge0 /=; rewrite extendK. - sp; if=> //=. - + by move=> /> &1 &2 h1 h2 valid_pn; rewrite !in_dom h2 // -extendK. - + auto=> /> &1 &2 h1 h2 valid_pn; rewrite in_dom=> /= ^extend_pn_notin_m. - rewrite -h2=> // pn_notin_m _ b _ _; rewrite 2!getP /=; split. - + move=> p' n'; rewrite in_dom getP; case ((p',n') = (p{2},n{2}))=> //= _. - by rewrite -in_dom=> /h1. - move=> p0 m0 valid_pn0; rewrite !getP h2 // -!extendK //. - case: (extend p0 m0 = extend p{2} n{2})=> [->|] //. - by have /contra H /H ->:= (injective_strip (extend p0 m0) (extend p{2} n{2})). - by auto=> /> &1 &2 h1 h2 valid_pn _; rewrite -h2. - qed. - - (** And we conclude with a bound on indifferentiability of the - high-level construction **) - (** TODO: Arrange that this lemma be non-local **) - local lemma ExtensionIndif - (D <: DISTINGUISHER { CoreSim.Perm.Perm, CoreSim.ICore, CoreSim.S, - ICoreExtension, CoreSim.Counting.C, Self.Counting.C }) - &m: - (forall (F <: DFUNCTIONALITY {D}) (P <: DPRIMITIVE {D}), - islossless P.f - => islossless P.fi - => islossless F.f - => islossless D(F,P).distinguish) - => `| Pr[GReal(DRestr(D),CoreSim.Perm.Perm).main() @ &m: res] - - Pr[GIdeal(DRestr(D),RaiseSim(CoreSim.S)).main() @ &m: res] | - <= (max_query ^ 2)%r / (2^(r + c))%r - + max_query%r * ((2*max_query)%r / (2^c)%r) - + max_query%r * ((2*max_query)%r / (2^c)%r). - proof. - move=> D_ll. - rewrite -(LiftIndif (DRestr(D)) &m). - have ->: Pr[CoreSim.GReal(LowerDist(DRestr(D))).main() @ &m: res] - = Pr[CoreSim.GReal(CoreSim.Counting.DRestr(LowerDist(D))).main() @ &m: res]. - + byequiv (_: ={glob D} ==> _)=> //=; proc. - call (DRestr_LowerDist_Real D CoreSim.Core CoreSim.Perm.Perm). - by inline *; auto. - have ->: Pr[CoreSim.GIdeal(LowerDist(DRestr(D))).main() @ &m: res] - = Pr[CoreSim.GIdeal(CoreSim.Counting.DRestr(LowerDist(D))).main() @ &m: res]. - + byequiv (_: ={glob D} ==> _)=> //=; proc. - call (DRestr_LowerDist_Ideal D CoreSim.ICore CoreSim.S). - by inline *; auto. - apply/(CoreSim.CoreIndiff (LowerDist(D)) &m _). - move=> F P Pf_ll Pfi_ll Ff_ll; proc (true)=> //. - by proc; sp; if=> //=; call Ff_ll; auto. - qed. -end section PROOF. From 5b5475d906d3611cbb729ad8e5ed0d643f8d1d26 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 1 Sep 2016 14:16:35 +0100 Subject: [PATCH 229/394] NewCore: name fixes. --- sha3/proof/clean/NewCore.eca | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/sha3/proof/clean/NewCore.eca b/sha3/proof/clean/NewCore.eca index 39fc5c0..08dc975 100644 --- a/sha3/proof/clean/NewCore.eca +++ b/sha3/proof/clean/NewCore.eca @@ -20,9 +20,9 @@ theory Block. axiom add0b b: b0 +^ b = b. axiom addbK b: b +^ b = b0. - op enum: block list. - axiom block_enum b: count (pred1 b) enum = 1. - axiom card_block: size enum = 2^r. + op blocks: block list. + axiom blocks_spec b: count (pred1 b) blocks = 1. + axiom card_block: size blocks = 2^r. clone import Ring.ZModule as BlockMonoid with type t <- block, @@ -38,11 +38,11 @@ theory Block. clone import MFinite as DBlock with type t <- block, - op Support.enum <- enum + op Support.enum <- blocks rename "dunifin" as "bdistr" "duniform" as "bdistr" proof *. - realize Support.enum_spec by exact/block_enum. + realize Support.enum_spec by exact/blocks_spec. end Block. import Block DBlock. @@ -55,17 +55,17 @@ theory Capacity. op c0: capacity. - op enum: capacity list. - axiom capacity_enum b: count (pred1 b) enum = 1. - axiom card_capacity: size enum = 2^c. + op caps: capacity list. + axiom caps_spec b: count (pred1 b) caps = 1. + axiom card_capacity: size caps = 2^c. clone import MFinite as DCapacity with type t <- capacity, - op Support.enum <- enum + op Support.enum <- caps rename "dunifin" as "cdistr" "duniform" as "cdistr" proof *. - realize Support.enum_spec by exact/capacity_enum. + realize Support.enum_spec by exact/caps_spec. end Capacity. import Capacity DCapacity. @@ -83,7 +83,7 @@ op dstate = bdistr `*` cdistr. (** Indifferentiability Experiment **) clone include Indifferentiability with - type p <- state, + type p <- state, type f_in <- block list, type f_out <- block list rename [module] "GReal" as "RealIndif" From c6659ce0b7cffac690cb68f4f67344601ec102a4 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 1 Sep 2016 15:13:47 -0400 Subject: [PATCH 230/394] A few documentation things. --- sha3/proof/Sponge.ec | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 9583cb7..94a2ac9 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -1771,6 +1771,8 @@ qed. end HybridIRO. +(* now we use HybridIRO to prove the main result *) + section. declare module BlockSim : BlockSponge.SIMULATOR{IRO, BlockSponge.BIRO.IRO}. @@ -1778,7 +1780,7 @@ declare module Dist : DISTINGUISHER{Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}. local clone HybridIRO as HIRO. -(* working toward the Real side of the top-level theorem *) +(* working toward the Real side of the main result *) local lemma Sponge_Raise_BlockSponge_f : equiv[Sponge(Perm).f ~ RaiseFun(BlockSponge.Sponge(Perm)).f : @@ -1806,7 +1808,7 @@ auto; progress; by rewrite -cats1 blocks2bits_cat blocks2bits_sing. auto. qed. -(* the Real side of top-level theorem *) +(* the Real side of main result *) local lemma RealIndif_Sponge_BlockSponge &m : Pr[RealIndif(Sponge, Perm, Dist).main() @ &m : res] = @@ -1820,7 +1822,7 @@ conseq Sponge_Raise_BlockSponge_f=> //. auto. qed. -(* working toward the Ideal side of the top-level theorem *) +(* working toward the Ideal side of the main result *) (* first step of Ideal side: express in terms of Experiment and HIRO.HybridIROLazy *) @@ -1838,9 +1840,9 @@ seq 2 2 : inline*; wp; call (_ : true); auto. call (_ : - ={glob Dist, glob BlockSim} /\ - IRO.mp{1} = map0 /\ HIRO.HybridIROLazy.mp{2} = map0 ==> - ={res}). + ={glob Dist, glob BlockSim} /\ + IRO.mp{1} = map0 /\ HIRO.HybridIROLazy.mp{2} = map0 ==> + ={res}). proc (={glob BlockSim} /\ HIRO.lazy_invar IRO.mp{1} HIRO.HybridIROLazy.mp{2})=> //. @@ -1974,7 +1976,7 @@ conseq RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f=> //. auto. qed. -(* the Ideal side of top-level theorem *) +(* the Ideal side of main result *) local lemma IdealIndif_IRO_BlockIRO &m : Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = From 286733fe0639a46e69bdef63e54b3378047b2435 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 1 Sep 2016 16:56:57 -0400 Subject: [PATCH 231/394] Implementing change to squeezing loops in BlockSponge/Sponge, avoiding superfluous application of primitive. Adapted top-level proof to track this change. --- sha3/proof/BlockSponge.ec | 8 +++++--- sha3/proof/Sponge.ec | 10 ++++++++-- 2 files changed, 13 insertions(+), 5 deletions(-) diff --git a/sha3/proof/BlockSponge.ec b/sha3/proof/BlockSponge.ec index 08219e5..d4302de 100644 --- a/sha3/proof/BlockSponge.ec +++ b/sha3/proof/BlockSponge.ec @@ -42,9 +42,11 @@ module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { } (* Squeezing *) while (i < n) { - z <- rcons z sa; - (sa, sc) <@ P.f(sa, sc); - i <- i + 1; + z <- rcons z sa; + i <- i + 1; + if (i < n) { + (sa, sc) <@ P.f(sa, sc); + } } } return z; diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 94a2ac9..575c58e 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -54,8 +54,10 @@ module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { (* squeezing *) while (i < (n + r - 1) %/ r) { z <- z ++ ofblock sa; - (sa, sc) <@ P.f(sa, sc); i <- i + 1; + if (i < (n + r - 1) %/ r) { + (sa, sc) <@ P.f(sa, sc); + } } return take n z; @@ -1803,7 +1805,11 @@ seq 0 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). -wp. call (_ : ={glob Perm}); first sim. auto. +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. From 86a2bc96268f0875dab96769997277ecd9697028 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 1 Sep 2016 17:19:20 -0400 Subject: [PATCH 232/394] Nit. --- sha3/proof/BlockSponge.ec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/proof/BlockSponge.ec b/sha3/proof/BlockSponge.ec index d4302de..b6f50ac 100644 --- a/sha3/proof/BlockSponge.ec +++ b/sha3/proof/BlockSponge.ec @@ -40,7 +40,7 @@ module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { (sa, sc) <@ P.f(sa +^ head b0 xs, sc); xs <- behead xs; } - (* Squeezing *) + (* squeezing *) while (i < n) { z <- rcons z sa; i <- i + 1; From f35b1dd7e2fae70e1db8b23a578b6e4d12511ae9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 2 Sep 2016 09:03:55 +0100 Subject: [PATCH 233/394] Pulling out common abstractions in Clean. --- sha3/proof/clean/NewCommon.ec | 73 +++++++++++++++++++++++++++++++++++ sha3/proof/clean/NewCore.eca | 71 +--------------------------------- 2 files changed, 75 insertions(+), 69 deletions(-) create mode 100644 sha3/proof/clean/NewCommon.ec diff --git a/sha3/proof/clean/NewCommon.ec b/sha3/proof/clean/NewCommon.ec new file mode 100644 index 0000000..892511d --- /dev/null +++ b/sha3/proof/clean/NewCommon.ec @@ -0,0 +1,73 @@ +require import Pred Fun NewLogic NewDistr. +require import Int Real List NewFMap FSet. +require import StdOrder. +(*---*) import IntOrder. + +(*** THEORY PARAMETERS ***) +(** Block/Rate **) +theory Block. + op r : int. + axiom r_ge0: 0 <= r. + + type block. + + op b0: block. + op (+^): block -> block -> block. + + axiom addbA b1 b2 b3: b1 +^ (b2 +^ b3) = b1 +^ b2 +^ b3. + axiom addbC b1 b2: b1 +^ b2 = b2 +^ b1. + axiom add0b b: b0 +^ b = b. + axiom addbK b: b +^ b = b0. + + op blocks: block list. + axiom blocks_spec b: count (pred1 b) blocks = 1. + axiom card_block: size blocks = 2^r. + + clone import Ring.ZModule as BlockMonoid with + type t <- block, + op zeror <- b0, + op ( + ) <- (+^), + op [ - ] (b : block) <- b + remove abbrev (-) + proof *. + realize addrA by exact/addbA. + realize addrC by exact/addbC. + realize add0r by exact/add0b. + realize addNr by exact/addbK. + + clone import MFinite as DBlock with + type t <- block, + op Support.enum <- blocks + rename "dunifin" as "bdistr" + "duniform" as "bdistr" + proof *. + realize Support.enum_spec by exact/blocks_spec. +end Block. +import Block DBlock. + +(** Capacity **) +theory Capacity. + op c : int. + axiom c_ge0: 0 <= c. + + type capacity. + + op c0: capacity. + + op caps: capacity list. + axiom caps_spec b: count (pred1 b) caps = 1. + axiom card_capacity: size caps = 2^c. + + clone import MFinite as DCapacity with + type t <- capacity, + op Support.enum <- caps + rename "dunifin" as "cdistr" + "duniform" as "cdistr" + proof *. + realize Support.enum_spec by exact/caps_spec. +end Capacity. +import Capacity DCapacity. + +(** Query Bound **) +op max_query: int. +axiom max_query_ge0: 0 <= max_query. \ No newline at end of file diff --git a/sha3/proof/clean/NewCore.eca b/sha3/proof/clean/NewCore.eca index 08dc975..aea1710 100644 --- a/sha3/proof/clean/NewCore.eca +++ b/sha3/proof/clean/NewCore.eca @@ -4,78 +4,11 @@ require import StdOrder Ring DProd. require (*..*) RP Indifferentiability. -(*** THEORY PARAMETERS ***) -(** Block/Rate **) -theory Block. - op r : int. - axiom r_ge0: 0 <= r. - - type block. - - op b0: block. - op (+^): block -> block -> block. - - axiom addbA b1 b2 b3: b1 +^ (b2 +^ b3) = b1 +^ b2 +^ b3. - axiom addbC b1 b2: b1 +^ b2 = b2 +^ b1. - axiom add0b b: b0 +^ b = b. - axiom addbK b: b +^ b = b0. - - op blocks: block list. - axiom blocks_spec b: count (pred1 b) blocks = 1. - axiom card_block: size blocks = 2^r. - - clone import Ring.ZModule as BlockMonoid with - type t <- block, - op zeror <- b0, - op ( + ) <- (+^), - op [ - ] (b : block) <- b - remove abbrev (-) - proof *. - realize addrA by exact/addbA. - realize addrC by exact/addbC. - realize add0r by exact/add0b. - realize addNr by exact/addbK. - - clone import MFinite as DBlock with - type t <- block, - op Support.enum <- blocks - rename "dunifin" as "bdistr" - "duniform" as "bdistr" - proof *. - realize Support.enum_spec by exact/blocks_spec. -end Block. -import Block DBlock. - -(** Capacity **) -theory Capacity. - op c : int. - axiom c_ge0: 0 <= c. - - type capacity. - - op c0: capacity. - - op caps: capacity list. - axiom caps_spec b: count (pred1 b) caps = 1. - axiom card_capacity: size caps = 2^c. - - clone import MFinite as DCapacity with - type t <- capacity, - op Support.enum <- caps - rename "dunifin" as "cdistr" - "duniform" as "cdistr" - proof *. - realize Support.enum_spec by exact/caps_spec. -end Capacity. -import Capacity DCapacity. +require import NewCommon. +(*---*) import Block DBlock Capacity DCapacity. (** Validity of Functionality Queries **) op valid: block list -> bool. -axiom valid_not_nil m: valid m => m <> []. - -(** Adversary's Query Cost **) -op max_query: int. -axiom max_query_ge0: 0 <= max_query. (*** DEFINITIONS ***) type state = block * capacity. From 3c9273a7b182d7a9dfa3cdc0a39922be0615350f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 2 Sep 2016 11:54:25 +0100 Subject: [PATCH 234/394] Progress on NewCore -> BlockSponge. Some changes to NewCore definitions. --- sha3/proof/clean/BlockSponge.eca | 218 +++++++++++++++++++++++++++++++ sha3/proof/clean/NewCore.eca | 131 +------------------ 2 files changed, 224 insertions(+), 125 deletions(-) create mode 100644 sha3/proof/clean/BlockSponge.eca diff --git a/sha3/proof/clean/BlockSponge.eca b/sha3/proof/clean/BlockSponge.eca new file mode 100644 index 0000000..2df60aa --- /dev/null +++ b/sha3/proof/clean/BlockSponge.eca @@ -0,0 +1,218 @@ +require import Pred Fun NewLogic NewDistr. +require import Option Int Real List NewFMap FSet. +require import StdOrder. +(*---*) import IntOrder. + +require import NewCommon. +(*---*) import Block DBlock Capacity DCapacity. + +(*** THEORY PARAMETERS ***) +(** Validity of Functionality Queries **) +op valid: block list -> int -> bool. + +(** Validity and Parsing/Formatting of Functionality Queries **) +op format (p : block list) (n : int) = p ++ nseq n b0. +op parse: block list -> (block list * int). + +axiom formatK bs: format (parse bs).`1 (parse bs).`2 = bs. +axiom parseK t n: valid t n => parse (format t n) = (t,n). + +lemma parse_injective: injective parse. +proof. by move=> bs1 bs2 eq_format; rewrite -formatK eq_format (@formatK bs2). qed. + +(*** DEFINITIONS ***) +(** Low-Level Definitions **) +require (*--*) NewCore. + +clone import NewCore as Low with + op valid bs <- valid (parse bs).`1 (parse bs).`2 +proof * by done. + +(** High-Level Definitions **) +(* Indifferentiability *) +clone import Indifferentiability as BS_Ind with + type p <- block * capacity, + type f_in <- block list * int, + type f_out <- block list +proof * by done. + +(* BlockSponge Construction *) +module (BlockSponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { + proc init() = {} + + proc f(p : block list, n : int) : block list = { + var r <- []; + var (sa,sc) <- (b0,c0); + var i <- 0; + + while (i < size p) { + (sa,sc) <@ P.f((sa +^ nth witness p i,sc)); + i <- i + 1; + } + i <- 0; + while (i < n) { + r <- rcons r sa; + i <- i + 1; + if (i < n) { + (sa,sc) <@ P.f(sa,sc); + } + } + return r; + } +}. + +(* Ideal Block Sponge Functionality *) +module IBlockSponge : FUNCTIONALITY = { + var m : (block list * int,block) fmap + + proc init() = { + m <- map0; + } + + proc fill_in(x, n) = { + if (!mem (dom m) (x, n)) { + m.[(x,n)] <$ bdistr; + } + return oget m.[(x,n)]; + } + + proc f(x, n) = { + var b, bs; + var i <- 0; + + bs <- []; + if (valid x n) { + while (i < n) { + b <@ fill_in(x, i); + bs <- rcons bs b; + i <- i + 1; + } + } + return bs; + } +}. + +(* Parametric Simulator *) +module (HiSim (S : Low.SIMULATOR) : SIMULATOR) (F : DFUNCTIONALITY) = { + module LoF = { + proc f(x : block list): block list = { + var r <- []; + var (p,n) <- parse x; + var b <- []; + var i <- 1; + + while (i <= n) { + b <- F.f(take i p,1); + r <- r ++ b; + i <- i + 1; + } + return r; + } + } + + proc init = S(LoF).init + proc f = S(LoF).f + proc fi = S(LoF).fi +}. + +(* Constructed Distinguisher *) +module (LoDist (D : DISTINGUISHER) : Low.DISTINGUISHER) + (F : Low.DFUNCTIONALITY) (P : Low.DPRIMITIVE) = { + module HiF = { + proc f(p : block list, n : int) = { + var r <- []; + + r <@ F.f(format p (n - 1)); + if (n <= 0) { + r <- drop (size p) r; + } else { + r <- drop (size p - 1) r; + } + return r; + } + } + + proc distinguish = D(HiF,P).distinguish +}. + +(*** PROOF + forall P D S, + LoDist(D)^{Core(P),P} ~ LoDist(D)^{ICore,S(ICore)} + => D^{BlockSponge(P),P} ~ D^{IBlockSponge,HiSim(S)(IBlockSponge)} ***) +section PROOF. + declare module P : PRIMITIVE { Low.ICore, IBlockSponge }. + declare module S : Low.SIMULATOR { Low.ICore, IBlockSponge, P }. + declare module D : DISTINGUISHER { Low.ICore, IBlockSponge, P, S }. + + lemma LiftInd &m: + `| Pr[Low.Indif(Core(P),P,LoDist(D)).main() @ &m: res] + - Pr[Low.Indif(ICore,S(ICore),LoDist(D)).main() @ &m: res] | + = `| Pr[Indif(BlockSponge(P),P,D).main() @ &m: res] + - Pr[Indif(IBlockSponge,HiSim(S,IBlockSponge),D).main() @ &m: res] |. + proof. + do !congr. + + byequiv (_: ={glob D, glob P} ==> _ )=> //=; proc. + call (_: ={glob P}); first 2 by sim. + + proc=> /=; inline{1} 2. + seq 5 3: ( ={glob P, p, n, r, sa, sc, i} + /\ sa{1} = b0 + /\ i{1} = 0 + /\ r{1} = [] + /\ r0{1} = [] + /\ p0{1} = p{1} ++ nseq (n{1} - 1) b0); 1: by auto. + splitwhile{1} 1: (i < size p); wp. + seq 1 1: ( ={glob P, p, n, r, sa, sc, i} + /\ r{2} = [] + /\ i{1} = size p{1} + /\ size r0{1} = size p{1} + /\ last b0 r0{1} = sa{2} + /\ p0{1} = p{1} ++ nseq (n{1} - 1) b0). + + while ( ={glob P, p, n, r, sa, sc, i} + /\ i{1} <= size p{1} + /\ size r0{1} = i{1} + /\ last b0 r0{1} = sa{2} + /\ p0{1} = p{1} ++ nseq (n{1} - 1) b0). + + wp; call (_: true); auto=> /> &1 &2 _ _ r_p. + rewrite nth_cat r_p=> /= -[sa sc] /=. + by rewrite last_rcons size_rcons /= size_cat size_nseq /#. + by auto=> /> &2; rewrite size_cat size_nseq; smt (size_ge0). + case: (n{1} <= 0). + + rcondf{1} 1; 1:by auto=> /> &hr; rewrite size_cat size_nseq /#. + rcondf{2} 2; 1:by auto=> /> &hr /#. + by auto=> /> &1 &2 <-; rewrite drop_size. + splitwhile{2} 2: (i < n - 1). rcondt{2} 3. + + auto; while (i < n); 2:by auto=> /#. + rcondt 3; 1:by auto=> /#. + by call (_: true)=> //; auto=> /#. + rcondf{2} 5. + + auto; while (i < n); 2:by auto=> /#. + rcondt 3; 1:by auto=> /#. + by call (_: true)=> //; auto=> /#. + rcondf{2} 5. + + auto; while (i < n); 2:by auto=> /#. + rcondt 3; 1:by auto=> /#. + by call (_: true)=> //; auto=> /#. + wp. + while ( ={glob P, n, sa, sc} + /\ 0 < n{1} + /\ i{1} = i{2} + size p{1} + /\ size p{1} <= size r0{1} + /\ size p{1} <= i{1} + /\ drop (size p{1} - 1) r0{1} = rcons r{2} sa{2} + /\ p0{1} = p{1} ++ nseq (n{1} - 1) b0). + + rcondt{2} 3; 1:by auto=> /> &hr /#. + wp; call (_: true); auto=> /> &1 &2 In Is Ii Ir. + rewrite size_cat size_nseq=> ? _ ?. + rewrite nth_cat ltzNge Ii /= nth_nseq 1:/#. + rewrite BlockMonoid.AddMonoid.addm0=> /= -[sa sc] /=. + by rewrite size_rcons -Ir -cats1 drop_cat !cats1 /#. + auto=> &1 &2 [#] <*> ^Hsize <- /ltzNge ^n_gt0 -> /=. + rewrite size_cat size_nseq /= -Hsize; do 2?split=> [|/#|/#]. + have: r0{1} <> [] by smt (size_eq0). + move=> {p_not_nil Hsize}; elim/last_ind: (r0{1})=> //= r sa ih _. + + by rewrite last_rcons size_rcons -cats1 addzK drop_cat. + by inline *; call (_: true). + byequiv=> //=. + admit. + qed. +end section PROOF. \ No newline at end of file diff --git a/sha3/proof/clean/NewCore.eca b/sha3/proof/clean/NewCore.eca index aea1710..eee1b99 100644 --- a/sha3/proof/clean/NewCore.eca +++ b/sha3/proof/clean/NewCore.eca @@ -22,111 +22,6 @@ clone include Indifferentiability with rename [module] "GReal" as "RealIndif" [module] "GIdeal" as "IdealIndif". -(** Query Counting **) -theory Counting. - module C = { - var c:int - proc init() = { c <- 0; } - }. - - module PC (P : PRIMITIVE) : PRIMITIVE = { - proc init () = { - C.init(); - P.init(); - } - - proc f (x : state) = { - var y; - - C.c <- C.c + 1; - y <@ P.f(x); - return y; - } - - proc fi(x : state) = { - var y; - - C.c <- C.c + 1; - y <@ P.fi(x); - return y; - } - }. - - module DPRestr (P : DPRIMITIVE) : DPRIMITIVE = { - proc f (x : state) = { - var y <- (b0,c0); - - if (C.c + 1 <= max_query) { - C.c <- C.c + 1; - y <@ P.f(x); - } - return y; - } - - proc fi(x : state) = { - var y <- (b0,c0); - - if (C.c + 1 <= max_query) { - C.c <- C.c + 1; - y <@ P.fi(x); - } - return y; - } - }. - - module PRestr (P : PRIMITIVE) : PRIMITIVE = { - proc init () = { - C.init(); - P.init(); - } - - proc f = DPRestr(P).f - proc fi = DPRestr(P).fi - }. - - module FC (F : FUNCTIONALITY) : FUNCTIONALITY = { - proc init = F.init - - proc f (p : block list) = { - var r <- []; - - if (valid p) { - C.c <- C.c + size p; - r <@ F.f(p); - } - return r; - } - }. - - module DFRestr (F : DFUNCTIONALITY) : DFUNCTIONALITY = { - proc f (bs : block list) = { - var r <- []; - - if (valid bs /\ C.c + size bs <= max_query) { - C.c <- C.c + size bs; - r <@ F.f(bs); - } - return r; - } - }. - - module FRestr(F : FUNCTIONALITY) : FUNCTIONALITY = { - proc init = F.init - proc f = DFRestr(F).f - }. - - module (DRestr (D : DISTINGUISHER) : DISTINGUISHER) - (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { - proc distinguish() = { - var b; - - C.init(); - b <@ D(DFRestr(F), DPRestr(P)).distinguish(); - return b; - } - }. -end Counting. - (** Ideal Primitive **) clone export RP as Perm with type t <- block * capacity, @@ -142,11 +37,12 @@ module (Core : CONSTRUCTION) (P:DPRIMITIVE): FUNCTIONALITY = { proc f(p : block list): block list = { var (sa,sc) <- (b0,c0); var r <- []; + var i <- 0; - while (p <> []) { - (sa,sc) <@ P.f((sa +^ head witness p,sc)); + while (i < size p) { + (sa,sc) <@ P.f((sa +^ nth witness p i,sc)); r <- rcons r sa; - p <- behead p; + i <- i + 1; } return r; } @@ -169,11 +65,11 @@ module ICore : FUNCTIONALITY = { proc f(p : block list): block list = { var r <- []; - var i <- 0; + var i <- 1; var b; if (valid p) { - while (i < size p) { + while (i <= size p) { b <@ fill_in(take i p); r <- rcons r b; i <- i + 1; @@ -240,18 +136,3 @@ module (S : SIMULATOR) (F : DFUNCTIONALITY) : PRIMITIVE = { (** Initial and Final Games **) module GReal (D : DISTINGUISHER) = RealIndif(Core,Perm,D). module GIdeal (D : DISTINGUISHER) = IdealIndif(ICore,S,D). - -(*** PROOF ***) -import Counting. -lemma CoreIndiff (D <: DISTINGUISHER {C, Perm, Core, ICore, S}) &m: - (forall (F <: DFUNCTIONALITY {D}) (P <: DPRIMITIVE {D}), - islossless P.f - => islossless P.fi - => islossless F.f - => islossless D(F,P).distinguish) - => `| Pr[RealIndif(Core,Perm,DRestr(D)).main() @ &m: res] - - Pr[IdealIndif(ICore,S,DRestr(D)).main() @ &m :res] | - <= (max_query ^ 2)%r / (2^(r + c))%r - + max_query%r * ((2*max_query)%r / (2^c)%r) - + max_query%r * ((2*max_query)%r / (2^c)%r). -admitted. From f92176f4ef354f38349ed4e2d1b68db1c79b859d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 6 Sep 2016 21:32:36 +0100 Subject: [PATCH 235/394] Trying to figure things out. --- sha3/proof/clean/BlockSponge.eca | 261 +++++++++++++++++++++---------- sha3/proof/clean/NewCore.eca | 15 +- 2 files changed, 176 insertions(+), 100 deletions(-) diff --git a/sha3/proof/clean/BlockSponge.eca b/sha3/proof/clean/BlockSponge.eca index 2df60aa..dccae19 100644 --- a/sha3/proof/clean/BlockSponge.eca +++ b/sha3/proof/clean/BlockSponge.eca @@ -1,5 +1,5 @@ require import Pred Fun NewLogic NewDistr. -require import Option Int Real List NewFMap FSet. +require import Option Int IntExtra Real List NewFMap FSet. require import StdOrder. (*---*) import IntOrder. @@ -8,14 +8,15 @@ require import NewCommon. (*** THEORY PARAMETERS ***) (** Validity of Functionality Queries **) -op valid: block list -> int -> bool. +op valid: block list -> bool. +axiom valid_spec p: valid p => p <> []. (** Validity and Parsing/Formatting of Functionality Queries **) -op format (p : block list) (n : int) = p ++ nseq n b0. +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 t n: valid t n => parse (format t n) = (t,n). +axiom parseK p n: 0 < n => valid p => parse (format p n) = (p,n). lemma parse_injective: injective parse. proof. by move=> bs1 bs2 eq_format; rewrite -formatK eq_format (@formatK bs2). qed. @@ -25,7 +26,7 @@ proof. by move=> bs1 bs2 eq_format; rewrite -formatK eq_format (@formatK bs2). q require (*--*) NewCore. clone import NewCore as Low with - op valid bs <- valid (parse bs).`1 (parse bs).`2 + op valid bs <- valid (parse bs).`1 /\ 0 < (parse bs).`2 proof * by done. (** High-Level Definitions **) @@ -45,16 +46,18 @@ module (BlockSponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { var (sa,sc) <- (b0,c0); var i <- 0; - while (i < size p) { - (sa,sc) <@ P.f((sa +^ nth witness p i,sc)); - i <- i + 1; - } - i <- 0; - while (i < n) { - r <- rcons r sa; - i <- i + 1; - if (i < n) { - (sa,sc) <@ P.f(sa,sc); + if (valid p /\ 0 < n) { + while (i < size p) { + (sa,sc) <@ P.f((sa +^ nth witness p i,sc)); + i <- i + 1; + } + i <- 0; + while (i < n) { + r <- rcons r sa; + i <- i + 1; + if (i < n) { + (sa,sc) <@ P.f(sa,sc); + } } } return r; @@ -78,11 +81,11 @@ module IBlockSponge : FUNCTIONALITY = { proc f(x, n) = { var b, bs; - var i <- 0; + var i <- 1; bs <- []; - if (valid x n) { - while (i < n) { + if (valid x /\ 0 < n) { + while (i <= n) { b <@ fill_in(x, i); bs <- rcons bs b; i <- i + 1; @@ -101,10 +104,15 @@ module (HiSim (S : Low.SIMULATOR) : SIMULATOR) (F : DFUNCTIONALITY) = { var b <- []; var i <- 1; - while (i <= n) { - b <- F.f(take i p,1); + if (valid p /\ 0 < n) + { + while (i <= size p) { + b <@ F.f(take i p,1); + r <- r ++ b; + i <- i + 1; + } + b <@ F.f(p,n); r <- r ++ b; - i <- i + 1; } return r; } @@ -115,6 +123,9 @@ module (HiSim (S : Low.SIMULATOR) : SIMULATOR) (F : DFUNCTIONALITY) = { proc fi = S(LoF).fi }. +pred INV (mc : (block list,block) fmap) (mb : (block list * int,block) fmap) = + forall p, mc.[p] = mb.[parse p]. + (* Constructed Distinguisher *) module (LoDist (D : DISTINGUISHER) : Low.DISTINGUISHER) (F : Low.DFUNCTIONALITY) (P : Low.DPRIMITIVE) = { @@ -122,11 +133,9 @@ module (LoDist (D : DISTINGUISHER) : Low.DISTINGUISHER) proc f(p : block list, n : int) = { var r <- []; - r <@ F.f(format p (n - 1)); - if (n <= 0) { - r <- drop (size p) r; - } else { - r <- drop (size p - 1) r; + if (valid p /\ 0 < n) { + r <@ F.f(format p n); + r <- drop (size p - b2i (n <> 0)) r; } return r; } @@ -140,9 +149,9 @@ module (LoDist (D : DISTINGUISHER) : Low.DISTINGUISHER) LoDist(D)^{Core(P),P} ~ LoDist(D)^{ICore,S(ICore)} => D^{BlockSponge(P),P} ~ D^{IBlockSponge,HiSim(S)(IBlockSponge)} ***) section PROOF. - declare module P : PRIMITIVE { Low.ICore, IBlockSponge }. - declare module S : Low.SIMULATOR { Low.ICore, IBlockSponge, P }. - declare module D : DISTINGUISHER { Low.ICore, IBlockSponge, P, S }. + declare module P : PRIMITIVE { Low.ICore, IBlockSponge, HiSim }. + declare module S : Low.SIMULATOR { Low.ICore, IBlockSponge, HiSim, P }. + declare module D : DISTINGUISHER { Low.ICore, IBlockSponge, HiSim, P, S }. lemma LiftInd &m: `| Pr[Low.Indif(Core(P),P,LoDist(D)).main() @ &m: res] @@ -153,66 +162,146 @@ section PROOF. do !congr. + byequiv (_: ={glob D, glob P} ==> _ )=> //=; proc. call (_: ={glob P}); first 2 by sim. - + proc=> /=; inline{1} 2. - seq 5 3: ( ={glob P, p, n, r, sa, sc, i} + + proc=> /=; sp; if=>//=; inline{1} 1. + seq 4 0: ( ={glob P, p, n, r, sa, sc, i} + /\ p{1} <> [] + /\ 0 < n{1} /\ sa{1} = b0 /\ i{1} = 0 /\ r{1} = [] /\ r0{1} = [] - /\ p0{1} = p{1} ++ nseq (n{1} - 1) b0); 1: by auto. - splitwhile{1} 1: (i < size p); wp. - seq 1 1: ( ={glob P, p, n, r, sa, sc, i} - /\ r{2} = [] - /\ i{1} = size p{1} - /\ size r0{1} = size p{1} - /\ last b0 r0{1} = sa{2} /\ p0{1} = p{1} ++ nseq (n{1} - 1) b0). - + while ( ={glob P, p, n, r, sa, sc, i} - /\ i{1} <= size p{1} - /\ size r0{1} = i{1} - /\ last b0 r0{1} = sa{2} - /\ p0{1} = p{1} ++ nseq (n{1} - 1) b0). - + wp; call (_: true); auto=> /> &1 &2 _ _ r_p. - rewrite nth_cat r_p=> /= -[sa sc] /=. - by rewrite last_rcons size_rcons /= size_cat size_nseq /#. - by auto=> /> &2; rewrite size_cat size_nseq; smt (size_ge0). - case: (n{1} <= 0). - + rcondf{1} 1; 1:by auto=> /> &hr; rewrite size_cat size_nseq /#. - rcondf{2} 2; 1:by auto=> /> &hr /#. - by auto=> /> &1 &2 <-; rewrite drop_size. - splitwhile{2} 2: (i < n - 1). rcondt{2} 3. - + auto; while (i < n); 2:by auto=> /#. - rcondt 3; 1:by auto=> /#. - by call (_: true)=> //; auto=> /#. - rcondf{2} 5. - + auto; while (i < n); 2:by auto=> /#. - rcondt 3; 1:by auto=> /#. - by call (_: true)=> //; auto=> /#. - rcondf{2} 5. - + auto; while (i < n); 2:by auto=> /#. - rcondt 3; 1:by auto=> /#. - by call (_: true)=> //; auto=> /#. - wp. - while ( ={glob P, n, sa, sc} - /\ 0 < n{1} - /\ i{1} = i{2} + size p{1} - /\ size p{1} <= size r0{1} - /\ size p{1} <= i{1} - /\ drop (size p{1} - 1) r0{1} = rcons r{2} sa{2} - /\ p0{1} = p{1} ++ nseq (n{1} - 1) b0). - + rcondt{2} 3; 1:by auto=> /> &hr /#. - wp; call (_: true); auto=> /> &1 &2 In Is Ii Ir. - rewrite size_cat size_nseq=> ? _ ?. - rewrite nth_cat ltzNge Ii /= nth_nseq 1:/#. - rewrite BlockMonoid.AddMonoid.addm0=> /= -[sa sc] /=. - by rewrite size_rcons -Ir -cats1 drop_cat !cats1 /#. - auto=> &1 &2 [#] <*> ^Hsize <- /ltzNge ^n_gt0 -> /=. - rewrite size_cat size_nseq /= -Hsize; do 2?split=> [|/#|/#]. - have: r0{1} <> [] by smt (size_eq0). - move=> {p_not_nil Hsize}; elim/last_ind: (r0{1})=> //= r sa ih _. - + by rewrite last_rcons size_rcons -cats1 addzK drop_cat. - by inline *; call (_: true). - byequiv=> //=. - admit. + + by auto=> /> &2 /valid_spec. + splitwhile{1} 1: (i < size p). + splitwhile{2} 3: (i < n - 1). + rcondt{2} 4. + + auto; while (i < n); 2:by wp; conseq (_: _ ==> true)=> // /#. + by sp; if; 1:call (_: true); auto=> /#. + rcondf{2} 6. + + auto; while (i < n); 2:by wp; conseq (_: _ ==> true)=> // /#. + by sp; if; 1:call (_: true); auto=> /#. + rcondf{2} 6. + + auto; while (i < n); 2:by wp; conseq (_: _ ==> true)=> // /#. + by sp; if; 1:call (_: true); auto=> /#. + wp; while ( ={glob P, p, n, sa, sc} + /\ i{1} = i{2} + size p{2} + /\ drop (size p - 1){1} r0{1} = rcons r{2} sa{2} + /\ 0 <= i{2} + /\ p{1} <> [] + /\ 0 < n{1} + /\ p0{1} = p{1} ++ nseq (n{1} - 1) b0). + + rcondt{2} 3; 1:by auto=> /#. + wp; call (_: true); auto=> /> &1 &2 eq_r i_ge0 p_neq_nil n_ge0 i1_lt_szp0 _ i2_lt_Pn. + rewrite nth_cat -subr_lt0 addzK ltzNge i_ge0 /=. + rewrite nth_nseq // BlockMonoid.AddMonoid.addm0=> /= -[sa sc] /=. + rewrite size_cat size_nseq; split=> [|/#]; split=> [/#|]; split=> [|/#]. + smt (@List). + wp; while ( ={glob P, p, n, sa, sc, i} + /\ i{1} <= size p{1} + /\ size r0{1} = i{1} + /\ last b0 r0{1} = sa{2} + /\ p0{1} = p{1} ++ nseq (n{1} - 1) b0). + + wp; call (_: true); auto=> /> &1 &2. + rewrite size_cat size_nseq=> _ _ szr0_lt_szp. + rewrite nth_cat szr0_lt_szp=> /= -[sa sc] /=. + by rewrite size_rcons last_rcons /= /#. + auto=> /> &2 p_neq_nil n_gt0. + rewrite size_cat size_nseq size_ge0; split=> [/#|r _]. + rewrite ltzNge=> /= szp_le_szr szr_le_szp; split=> [|/#]; split=> [|/#]; split=> [/#|]. + smt (@List). + by inline *; call (_: true). + byequiv (_: ={glob D, glob S} ==> _)=> //=; proc. + call (_: ={glob S} + /\ INV ICore.m{1} IBlockSponge.m{2}). + + proc (INV ICore.m{1} IBlockSponge.m{2})=> //. + proc=> /=; sp; if=> [&1 &2 [#] <*> <-| |] //. + conseq (_: ={r, i} + /\ r{2} = [] + /\ b{2} = [] + /\ i{2} = 1 + /\ parse p{1} = (p{2},n{2}) + /\ valid p{2} + /\ 0 < n{2} + /\ INV ICore.m{1} IBlockSponge.m{2} + ==> _)=> />. + + by move=> &1 &2=> <-. + splitwhile{1} 1: (i <= size (parse p).`1); inline{2} 2. + rcondt{2} 6; first by auto; while (true)=> //; auto=> /> &hr <- //. + wp; while ( i{1} = i0{2} + size x0{2} - 1 + /\ p{1} = x0{2} ++ nseq (n0 - 1){2} b0 + /\ r{1} = r{2} ++ bs{2} + /\ 0 < i0{2} + /\ valid x0{2} + /\ INV ICore.m{1} IBlockSponge.m{2}). + + wp; call (_: arg{1} = format arg{2}.`1 arg{2}.`2 + /\ 0 < arg{2}.`2 + /\ valid arg{2}.`1 + /\ INV ICore.m{1} IBlockSponge.m{2} + ==> ={res} + /\ INV ICore.m{1} IBlockSponge.m{2}). + + proc; if=> //=. + + by move=> /> &1 &2 n_gt0 valid_x; rewrite !in_dom -parseK=> // ->. + + auto=> /> &1 &2 n_gt0 valid_x HINV _ b _; rewrite !getP /=. + move=> p'; rewrite !getP; case: (parse p' = (x,n){2}). + + by rewrite -parseK=> // /parse_injective ->. + by case: (p' = format x{2} n{2})=> //= [<*>|_ _]; [rewrite parseK|exact/HINV]. + by auto=> /> &1 &2 n_gt0 valid_x ->; rewrite parseK. + auto=> /> &1 &2 i0_gt0 + + _ i0_le_n0. + have ->: take (i0 + size x0 - 1){2} (x0 ++ nseq (n0 - 1) Block.b0){2} + = x0{2} ++ nseq (i0 - 1){2} b0. + + rewrite take_cat. + have -> /=: !i0{2} + size x0{2} - 1 < size x0{2} by smt (). + congr; apply/(eq_from_nth witness). + + by rewrite size_take ?size_nseq /#. + move=> j; rewrite size_take ?size_nseq 1:/#. + by move=> [j_ge0 j_lt_i0]; rewrite nth_take ?nth_nseq /#. + rewrite /format size_cat size_nseq=> /= _ _ b mc mb _. + by rewrite rcons_cat /= /#. + wp; conseq (_: ={r, i} + /\ r{2} = [] + /\ b{2} = [] + /\ i{2} = 1 + /\ parse p{1} = (p,n){2} + /\ valid p{2} + /\ 0 < n{2} + /\ INV ICore.m{1} IBlockSponge.m{2} + ==> ={r} + /\ i{1} = size p{2} + /\ INV ICore.m{1} IBlockSponge.m{2})=> //=. + + move=> &1 &2 [#] !<<- !->> parse_p valid_p n_gt0 _ mc i r1 mb ? [#] <<*> HINV. + move: n_gt0 valid_p=> ^n_gt0 /parseK H ^valid_p /H {H}. + rewrite -parse_p cats0 valid_p HINV=> /parse_injective <<- @/format /=. + by rewrite size_cat size_nseq /= /#. + while ( ={r, i} + /\ valid p{2} + /\ 0 < n{2} + /\ p{1} = p{2} ++ nseq (n - 1){2} b0 + /\ 0 < i{1} + /\ INV ICore.m{1} IBlockSponge.m{2}). + + wp; call (_: arg{1} = arg{2}.`1 + /\ arg{2}.`2 = 1 + /\ INV ICore.m{1} IBlockSponge.m{2} + ==> res{2} = [res{1}] + /\ INV ICore.m{1} IBlockSponge.m{2}). + + admit. (* This is false because of the validity check. Figure it out. *) + auto=> /> &1 &2 valid_p n_gt0 i_gt0 _ _ _ i_le_szp. + have ->: take i{2} (p{2} ++ nseq (n{2} - 1) b0) = take i{2} p{2}. + + rewrite take_cat; case: (i{2} = size p{2})=> [-> /=|/#]. + by rewrite take0 take_size cats0. + move: n_gt0 valid_p=> ^n_gt0 /parseK H ^valid_p /H {H} @/format -> /=. + by move=> b mc mb _; rewrite cats1 /= size_cat size_nseq /#. + (* BUG: auto=> />. anomaly: ECLowGOal.InvalidProofTerm *) + auto=> &1 &2 [#] !->> parse_p valid_p n_gt0 HINV /=; rewrite valid_p n_gt0 HINV. + move: n_gt0 valid_p=> ^n_gt0 /parseK H ^valid_p /H {H}. + rewrite -parse_p=> /parse_injective <<- @/format /=. + rewrite parse_p size_cat size_nseq /=. + split=> [/#|mc i r mb ? ? + + [#] <*> /=]. + (* stupid off-by-one *) admit. + + admit. + + proc; sp; if=> //=; inline{1} 1; rcondt{1} 4. + + by auto=> /> &hr _ ^valid_x+ ^n_gt0 /parseK H - /H {H} ->. + (* same as the second loop in LoF.f *) + admit. + by inline *; auto; call (_: true); auto=> /> p; rewrite !map0P. qed. -end section PROOF. \ No newline at end of file +end section PROOF. diff --git a/sha3/proof/clean/NewCore.eca b/sha3/proof/clean/NewCore.eca index eee1b99..ca801f8 100644 --- a/sha3/proof/clean/NewCore.eca +++ b/sha3/proof/clean/NewCore.eca @@ -22,16 +22,8 @@ clone include Indifferentiability with rename [module] "GReal" as "RealIndif" [module] "GIdeal" as "IdealIndif". -(** Ideal Primitive **) -clone export RP as Perm with - type t <- block * capacity, - op dt <- bdistr `*` cdistr - rename - [module type] "RP" as "PRIMITIVE" - [module] "P" as "Perm". - (** Core Construction **) -module (Core : CONSTRUCTION) (P:DPRIMITIVE): FUNCTIONALITY = { +module (Core : CONSTRUCTION) (P : DPRIMITIVE): FUNCTIONALITY = { proc init () = {} proc f(p : block list): block list = { @@ -97,7 +89,6 @@ module (S : SIMULATOR) (F : DFUNCTIONALITY) : PRIMITIVE = { if (!mem (dom m) x) { if (mem (dom pi) x.`2) { (p,v) <- oget pi.[x.`2]; - (* Not sure *) b <- F.f (rcons p (v +^ x.`1)); y1 <- last b0 b; } else { @@ -132,7 +123,3 @@ module (S : SIMULATOR) (F : DFUNCTIONALITY) : PRIMITIVE = { return y; } }. - -(** Initial and Final Games **) -module GReal (D : DISTINGUISHER) = RealIndif(Core,Perm,D). -module GIdeal (D : DISTINGUISHER) = IdealIndif(ICore,S,D). From 4a256a5aaf4c1cd84f0c89d1f80986a7bc13914a Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 6 Sep 2016 19:46:07 -0400 Subject: [PATCH 236/394] Finished documentation of top-level proof. --- sha3/proof/Sponge.ec | 90 +++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 88 insertions(+), 2 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 575c58e..6b38d51 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -96,8 +96,94 @@ module LowerDist (D : DISTINGUISHER, F : BlockSponge.DFUNCTIONALITY) = 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 procedures + + (* hashing block lists, giving n bits *) + proc g(x : block list, n : int) : bool list + + (* hashing block lists, giving n blocks *) + proc f(x : block list, n : int) : block 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, f is defined in terms of g. In the lazy + version, g 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 were + 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 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(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(HybridIROLazy), + Dist).main() @ &m : res] = + Pr[Experiment + (RaiseHybridIRO(HybridIROEager), BlockSim(HybridIROEager), + Dist).main() @ &m : res] + + This step is proved using the eager sampling lemma provided by + RndO. + + Step 3: + + Pr[Experiment + (RaiseHybridIRO(HybridIROEager), BlockSim(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. @@ -106,10 +192,10 @@ module type HYBRID_IRO = { (* initialization *) proc init() : unit - (* hashing blocks, giving n bits *) + (* hashing block lists, giving n bits *) proc g(x : block list, n : int) : bool list - (* hashing blocks, giving n blocks *) + (* hashing block lists, giving n blocks *) proc f(x : block list, n : int) : block list }. From 218eeb9a2c458b55b9c111d0b4527b08917b7910 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 6 Sep 2016 20:08:01 -0400 Subject: [PATCH 237/394] Nit. --- sha3/proof/Sponge.ec | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 6b38d51..3873aaa 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -145,8 +145,8 @@ module RaiseSim (S : BlockSponge.SIMULATOR, F : DFUNCTIONALITY) = 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 split the proof - of the Ideal side into three steps: + IRO into a FUNCTIONALITY in the obvious way (not using f), and we + split the proof of the Ideal side into three steps: Step 1: From 8b713cee6ac5f5eb8092b71d957627d2d5d5fbd5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 14 Dec 2017 17:29:10 +0100 Subject: [PATCH 238/394] The first admit has been killed. The second admit, I cannot say. The third admit is false. --- sha3/proof/clean/BlockSponge.eca | 148 +++++++++++++++---------------- sha3/proof/clean/NewCommon.ec | 4 +- sha3/proof/clean/NewCore.eca | 12 +-- 3 files changed, 80 insertions(+), 84 deletions(-) diff --git a/sha3/proof/clean/BlockSponge.eca b/sha3/proof/clean/BlockSponge.eca index dccae19..81f2751 100644 --- a/sha3/proof/clean/BlockSponge.eca +++ b/sha3/proof/clean/BlockSponge.eca @@ -1,5 +1,5 @@ -require import Pred Fun NewLogic NewDistr. -require import Option Int IntExtra Real List NewFMap FSet. +require import Core Logic Distr. +require import Int IntExtra Real List NewFMap FSet. require import StdOrder. (*---*) import IntOrder. @@ -10,6 +10,8 @@ require import NewCommon. (** Validity of Functionality Queries **) op valid: block list -> bool. axiom valid_spec p: valid p => p <> []. +(* FIXME : verify if this axiom is correct. *) +axiom valid_take p i: valid p => 0 < i => valid (take i p). (** Validity and Parsing/Formatting of Functionality Queries **) op format (p : block list) (n : int) = p ++ nseq (n - 1) b0. @@ -21,6 +23,25 @@ axiom parseK p n: 0 < n => valid p => parse (format p n) = (p,n). lemma parse_injective: injective parse. proof. by move=> bs1 bs2 eq_format; rewrite -formatK eq_format (@formatK bs2). qed. +lemma parse_valid p: valid p => parse p = (p,1). +proof. +move=>h;cut{1}->:p=format p 1;2:smt(parseK). +by rewrite/format/=nseq0 cats0. +qed. + +(******************* Useful lemmas ******************) +lemma take_nseq (b:block) i j : take i (nseq j b) = nseq (min i j) b. +proof. +move:i;elim/natind=>//=. ++ smt(take_le0 nseq0_le). +move=>i hi0 hind. +case(i + 1 <= j)=>hi1j. ++ rewrite (take_nth b);1:smt(size_nseq). + rewrite hind nth_nseq 1:/# //=-nseqSr/#. +rewrite take_oversize;smt(size_nseq). +qed. + + (*** DEFINITIONS ***) (** Low-Level Definitions **) require (*--*) NewCore. @@ -106,7 +127,7 @@ module (HiSim (S : Low.SIMULATOR) : SIMULATOR) (F : DFUNCTIONALITY) = { if (valid p /\ 0 < n) { - while (i <= size p) { + while (i < size p) { b <@ F.f(take i p,1); r <- r ++ b; i <- i + 1; @@ -149,13 +170,13 @@ module (LoDist (D : DISTINGUISHER) : Low.DISTINGUISHER) LoDist(D)^{Core(P),P} ~ LoDist(D)^{ICore,S(ICore)} => D^{BlockSponge(P),P} ~ D^{IBlockSponge,HiSim(S)(IBlockSponge)} ***) section PROOF. - declare module P : PRIMITIVE { Low.ICore, IBlockSponge, HiSim }. - declare module S : Low.SIMULATOR { Low.ICore, IBlockSponge, HiSim, P }. - declare module D : DISTINGUISHER { Low.ICore, IBlockSponge, HiSim, P, S }. + declare module P : PRIMITIVE { Low.ICORE, IBlockSponge, HiSim }. + declare module S : Low.SIMULATOR { Low.ICORE, IBlockSponge, HiSim, P }. + declare module D : DISTINGUISHER { Low.ICORE, IBlockSponge, HiSim, P, S }. lemma LiftInd &m: - `| Pr[Low.Indif(Core(P),P,LoDist(D)).main() @ &m: res] - - Pr[Low.Indif(ICore,S(ICore),LoDist(D)).main() @ &m: res] | + `| Pr[Low.Indif(CORE(P),P,LoDist(D)).main() @ &m: res] + - Pr[Low.Indif(ICORE,S(ICORE),LoDist(D)).main() @ &m: res] | = `| Pr[Indif(BlockSponge(P),P,D).main() @ &m: res] - Pr[Indif(IBlockSponge,HiSim(S,IBlockSponge),D).main() @ &m: res] |. proof. @@ -212,8 +233,8 @@ section PROOF. by inline *; call (_: true). byequiv (_: ={glob D, glob S} ==> _)=> //=; proc. call (_: ={glob S} - /\ INV ICore.m{1} IBlockSponge.m{2}). - + proc (INV ICore.m{1} IBlockSponge.m{2})=> //. + /\ INV ICORE.m{1} IBlockSponge.m{2}). + + proc (INV ICORE.m{1} IBlockSponge.m{2})=> //. proc=> /=; sp; if=> [&1 &2 [#] <*> <-| |] //. conseq (_: ={r, i} /\ r{2} = [] @@ -222,84 +243,59 @@ section PROOF. /\ parse p{1} = (p{2},n{2}) /\ valid p{2} /\ 0 < n{2} - /\ INV ICore.m{1} IBlockSponge.m{2} + /\ INV ICORE.m{1} IBlockSponge.m{2} ==> _)=> />. + by move=> &1 &2=> <-. - splitwhile{1} 1: (i <= size (parse p).`1); inline{2} 2. + splitwhile{1} 1: (i < size (parse p).`1); inline{2} 2. rcondt{2} 6; first by auto; while (true)=> //; auto=> /> &hr <- //. - wp; while ( i{1} = i0{2} + size x0{2} - 1 + wp. while ( i{1} = i0{2} + size x0{2} - 1 /\ p{1} = x0{2} ++ nseq (n0 - 1){2} b0 /\ r{1} = r{2} ++ bs{2} /\ 0 < i0{2} /\ valid x0{2} - /\ INV ICore.m{1} IBlockSponge.m{2}). - + wp; call (_: arg{1} = format arg{2}.`1 arg{2}.`2 - /\ 0 < arg{2}.`2 - /\ valid arg{2}.`1 - /\ INV ICore.m{1} IBlockSponge.m{2} - ==> ={res} - /\ INV ICore.m{1} IBlockSponge.m{2}). - + proc; if=> //=. - + by move=> /> &1 &2 n_gt0 valid_x; rewrite !in_dom -parseK=> // ->. - + auto=> /> &1 &2 n_gt0 valid_x HINV _ b _; rewrite !getP /=. - move=> p'; rewrite !getP; case: (parse p' = (x,n){2}). - + by rewrite -parseK=> // /parse_injective ->. - by case: (p' = format x{2} n{2})=> //= [<*>|_ _]; [rewrite parseK|exact/HINV]. - by auto=> /> &1 &2 n_gt0 valid_x ->; rewrite parseK. - auto=> /> &1 &2 i0_gt0 + + _ i0_le_n0. - have ->: take (i0 + size x0 - 1){2} (x0 ++ nseq (n0 - 1) Block.b0){2} - = x0{2} ++ nseq (i0 - 1){2} b0. - + rewrite take_cat. - have -> /=: !i0{2} + size x0{2} - 1 < size x0{2} by smt (). - congr; apply/(eq_from_nth witness). - + by rewrite size_take ?size_nseq /#. - move=> j; rewrite size_take ?size_nseq 1:/#. - by move=> [j_ge0 j_lt_i0]; rewrite nth_take ?nth_nseq /#. - rewrite /format size_cat size_nseq=> /= _ _ b mc mb _. - by rewrite rcons_cat /= /#. - wp; conseq (_: ={r, i} - /\ r{2} = [] - /\ b{2} = [] - /\ i{2} = 1 - /\ parse p{1} = (p,n){2} - /\ valid p{2} - /\ 0 < n{2} - /\ INV ICore.m{1} IBlockSponge.m{2} - ==> ={r} - /\ i{1} = size p{2} - /\ INV ICore.m{1} IBlockSponge.m{2})=> //=. - + move=> &1 &2 [#] !<<- !->> parse_p valid_p n_gt0 _ mc i r1 mb ? [#] <<*> HINV. - move: n_gt0 valid_p=> ^n_gt0 /parseK H ^valid_p /H {H}. - rewrite -parse_p cats0 valid_p HINV=> /parse_injective <<- @/format /=. - by rewrite size_cat size_nseq /= /#. - while ( ={r, i} + /\ n{2} = n0{2} + /\ INV ICORE.m{1} IBlockSponge.m{2} + /\ parse p{1} = (p{2}, n{2})). + + wp;inline*;sp;wp;if;auto;smt(parseK min_lel size_nseq take_nseq + rcons_cat parse_injective getP in_dom oget_some take_size take0 + take_cat parse_valid valid_take cat_rcons cats0 size_cat size_ge0). + wp=>/=. + conseq(:_==> ={r, i} /\ valid p{2} /\ 0 < n{2} - /\ p{1} = p{2} ++ nseq (n - 1){2} b0 - /\ 0 < i{1} - /\ INV ICore.m{1} IBlockSponge.m{2}). - + wp; call (_: arg{1} = arg{2}.`1 - /\ arg{2}.`2 = 1 - /\ INV ICore.m{1} IBlockSponge.m{2} - ==> res{2} = [res{1}] - /\ INV ICore.m{1} IBlockSponge.m{2}). - + admit. (* This is false because of the validity check. Figure it out. *) - auto=> /> &1 &2 valid_p n_gt0 i_gt0 _ _ _ i_le_szp. - have ->: take i{2} (p{2} ++ nseq (n{2} - 1) b0) = take i{2} p{2}. - + rewrite take_cat; case: (i{2} = size p{2})=> [-> /=|/#]. - by rewrite take0 take_size cats0. - move: n_gt0 valid_p=> ^n_gt0 /parseK H ^valid_p /H {H} @/format -> /=. - by move=> b mc mb _; rewrite cats1 /= size_cat size_nseq /#. - (* BUG: auto=> />. anomaly: ECLowGOal.InvalidProofTerm *) - auto=> &1 &2 [#] !->> parse_p valid_p n_gt0 HINV /=; rewrite valid_p n_gt0 HINV. - move: n_gt0 valid_p=> ^n_gt0 /parseK H ^valid_p /H {H}. - rewrite -parse_p=> /parse_injective <<- @/format /=. - rewrite parse_p size_cat size_nseq /=. - split=> [/#|mc i r mb ? ? + + [#] <*> /=]. - (* stupid off-by-one *) admit. + /\ p{1} = p{2} ++ nseq (n{2} - 1) Block.b0 + /\ i{1} = size p{2} + /\ parse p{1} = (p{2}, n{2}) + /\ INV ICORE.m{1} IBlockSponge.m{2});progress;..-2:smt(cats0 size_cat size_ge0). + while( ={r,i} + /\ valid p{2} + /\ 0 < n{2} + /\ p{1} = p{2} ++ nseq (n{2} - 1) Block.b0 + /\ 0 < i{1} <= size p{2} + /\ parse p{1} = (p{2}, n{2}) + /\ INV ICORE.m{1} IBlockSponge.m{2}). + + inline*;auto;sp;rcondt{2}1;1:(auto;smt(valid_take)). + rcondt{2}1;1:auto;sp;rcondf{2}5;1:auto;if;auto; + smt(parse_injective getP oget_some in_dom take_size take0 take_cat + parse_valid valid_take cat_rcons cats0 size_cat size_ge0). + auto;smt(parseK min_lel size_nseq take_nseq valid_spec + rcons_cat parse_injective getP in_dom oget_some take_size take0 + take_cat parse_valid valid_take cat_rcons cats0 size_cat size_ge0). + admit. + proc; sp; if=> //=; inline{1} 1; rcondt{1} 4. + by auto=> /> &hr _ ^valid_x+ ^n_gt0 /parseK H - /H {H} ->. + sp;wp. + conseq(:_==> drop (size p{1} - 1) r0{1} = bs{2} + /\ ={glob S} + /\ INV ICORE.m{1} IBlockSponge.m{2});progress. + by do !congr;rewrite b2i_eq1/#. + inline*;rewrite/INV. +(* This is false : because ICORE.m{1} will be bigger than IBlockSponge.m{2} *) + splitwhile{1}1:i<=size p;rcondt{2}1;1:auto=>/#. + inline*. + while( i{1} = i{2} + size p{1} - 1 + /\ + (* same as the second loop in LoF.f *) admit. by inline *; auto; call (_: true); auto=> /> p; rewrite !map0P. diff --git a/sha3/proof/clean/NewCommon.ec b/sha3/proof/clean/NewCommon.ec index 892511d..e2055d1 100644 --- a/sha3/proof/clean/NewCommon.ec +++ b/sha3/proof/clean/NewCommon.ec @@ -1,5 +1,5 @@ -require import Pred Fun NewLogic NewDistr. -require import Int Real List NewFMap FSet. +require import Core Logic Distr. +require import Int IntExtra Real List NewFMap FSet. require import StdOrder. (*---*) import IntOrder. diff --git a/sha3/proof/clean/NewCore.eca b/sha3/proof/clean/NewCore.eca index ca801f8..c37730d 100644 --- a/sha3/proof/clean/NewCore.eca +++ b/sha3/proof/clean/NewCore.eca @@ -1,4 +1,4 @@ -require import Pred Fun Option Pair Int Real List FSet NewFMap NewDistr. +require import Core Int Real List FSet NewFMap Distr. require import StdOrder Ring DProd. (*---*) import IntOrder. @@ -22,8 +22,8 @@ clone include Indifferentiability with rename [module] "GReal" as "RealIndif" [module] "GIdeal" as "IdealIndif". -(** Core Construction **) -module (Core : CONSTRUCTION) (P : DPRIMITIVE): FUNCTIONALITY = { +(** CORE Construction **) +module (CORE : CONSTRUCTION) (P : DPRIMITIVE): FUNCTIONALITY = { proc init () = {} proc f(p : block list): block list = { @@ -40,8 +40,8 @@ module (Core : CONSTRUCTION) (P : DPRIMITIVE): FUNCTIONALITY = { } }. -(** Ideal Core Functionality **) -module ICore : FUNCTIONALITY = { +(** Ideal CORE Functionality **) +module ICORE : FUNCTIONALITY = { var m : (block list,block) fmap proc init() = { @@ -71,7 +71,7 @@ module ICore : FUNCTIONALITY = { } }. -(** Core Simulator **) +(** CORE Simulator **) module (S : SIMULATOR) (F : DFUNCTIONALITY) : PRIMITIVE = { var m, mi : (state,state) fmap var pi : (capacity, block list * block) fmap From ab6166f7c16f76c261f6efe16715f441a83c6c5e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 2 Jan 2018 16:15:07 +0100 Subject: [PATCH 239/394] a little step for the second admit. --- sha3/proof/clean/BlockSponge.eca | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/sha3/proof/clean/BlockSponge.eca b/sha3/proof/clean/BlockSponge.eca index 81f2751..58beb10 100644 --- a/sha3/proof/clean/BlockSponge.eca +++ b/sha3/proof/clean/BlockSponge.eca @@ -281,7 +281,19 @@ section PROOF. auto;smt(parseK min_lel size_nseq take_nseq valid_spec rcons_cat parse_injective getP in_dom oget_some take_size take0 take_cat parse_valid valid_take cat_rcons cats0 size_cat size_ge0). - + admit. + + proc (INV ICORE.m{1} IBlockSponge.m{2})=> //. + proc. + sp;if;1:progress=>/#. + splitwhile{1} 1 : i < size (parse p).`1. + rcondt{1}2;progress. + + while(i <= size (parse p).`1);auto;1:call(:true);auto;progress. + + rewrite/#. + + smt(size_ge0 valid_spec). + cut/#:size (parse x{m0}).`1 <= size x{m0}. + by rewrite-{2}(formatK x{m0}) -H/=/format size_cat size_nseq/#. + inline*;auto. +(* now we should manage the while loops *) + + proc; sp; if=> //=; inline{1} 1; rcondt{1} 4. + by auto=> /> &hr _ ^valid_x+ ^n_gt0 /parseK H - /H {H} ->. sp;wp. From bd0521c892fa388046f39e594c10ab816aa8e251 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 2 Jan 2018 16:17:00 +0100 Subject: [PATCH 240/394] clean --- sha3/proof/clean/BlockSponge.eca | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/sha3/proof/clean/BlockSponge.eca b/sha3/proof/clean/BlockSponge.eca index 58beb10..d287e46 100644 --- a/sha3/proof/clean/BlockSponge.eca +++ b/sha3/proof/clean/BlockSponge.eca @@ -293,6 +293,8 @@ section PROOF. by rewrite-{2}(formatK x{m0}) -H/=/format size_cat size_nseq/#. inline*;auto. (* now we should manage the while loops *) + admit. + + auto. + proc; sp; if=> //=; inline{1} 1; rcondt{1} 4. + by auto=> /> &hr _ ^valid_x+ ^n_gt0 /parseK H - /H {H} ->. @@ -305,9 +307,6 @@ section PROOF. (* This is false : because ICORE.m{1} will be bigger than IBlockSponge.m{2} *) splitwhile{1}1:i<=size p;rcondt{2}1;1:auto=>/#. inline*. - while( i{1} = i{2} + size p{1} - 1 - /\ - (* same as the second loop in LoF.f *) admit. by inline *; auto; call (_: true); auto=> /> p; rewrite !map0P. From f73fea59024c2f3e4c213dc208eea02a240dc65f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 4 Jan 2018 09:58:42 +0100 Subject: [PATCH 241/394] . --- sha3/proof/clean/BlockSponge.eca | 124 +++++++++++++++---------------- sha3/proof/clean/NewCore.eca | 39 ++++++---- 2 files changed, 82 insertions(+), 81 deletions(-) diff --git a/sha3/proof/clean/BlockSponge.eca b/sha3/proof/clean/BlockSponge.eca index d287e46..8db0169 100644 --- a/sha3/proof/clean/BlockSponge.eca +++ b/sha3/proof/clean/BlockSponge.eca @@ -24,20 +24,20 @@ lemma parse_injective: injective parse. proof. by move=> bs1 bs2 eq_format; rewrite -formatK eq_format (@formatK bs2). qed. lemma parse_valid p: valid p => parse p = (p,1). -proof. -move=>h;cut{1}->:p=format p 1;2:smt(parseK). +proof. +move=>h;cut{1}->:p=format p 1;2:smt(parseK). by rewrite/format/=nseq0 cats0. qed. (******************* Useful lemmas ******************) lemma take_nseq (b:block) i j : take i (nseq j b) = nseq (min i j) b. -proof. +proof. move:i;elim/natind=>//=. -+ smt(take_le0 nseq0_le). -move=>i hi0 hind. -case(i + 1 <= j)=>hi1j. ++ smt(take_le0 nseq0_le). +move=>i hi0 hind. +case(i + 1 <= j)=>hi1j. + rewrite (take_nth b);1:smt(size_nseq). - rewrite hind nth_nseq 1:/# //=-nseqSr/#. + rewrite hind nth_nseq 1:/# //=-nseqSr/#. rewrite take_oversize;smt(size_nseq). qed. @@ -47,7 +47,7 @@ qed. require (*--*) NewCore. clone import NewCore as Low with - op valid bs <- valid (parse bs).`1 /\ 0 < (parse bs).`2 + op valid bs <- let (b,s) = bs in valid b /\ 0 < s proof * by done. (** High-Level Definitions **) @@ -102,10 +102,15 @@ module IBlockSponge : FUNCTIONALITY = { proc f(x, n) = { var b, bs; - var i <- 1; + var i <- 0; bs <- []; if (valid x /\ 0 < n) { + while (i < size x) { + b <@ fill_in(take i x,1); + i <- i + 1; + } + i <- 1; while (i <= n) { b <@ fill_in(x, i); bs <- rcons bs b; @@ -116,12 +121,11 @@ module IBlockSponge : FUNCTIONALITY = { } }. -(* Parametric Simulator *) +(* Parametric Simulator *) module (HiSim (S : Low.SIMULATOR) : SIMULATOR) (F : DFUNCTIONALITY) = { module LoF = { - proc f(x : block list): block list = { + proc f(p : block list, n : int): block list = { var r <- []; - var (p,n) <- parse x; var b <- []; var i <- 1; @@ -155,8 +159,7 @@ module (LoDist (D : DISTINGUISHER) : Low.DISTINGUISHER) var r <- []; if (valid p /\ 0 < n) { - r <@ F.f(format p n); - r <- drop (size p - b2i (n <> 0)) r; + r <@ F.f(p,n); } return r; } @@ -184,58 +187,22 @@ section PROOF. + byequiv (_: ={glob D, glob P} ==> _ )=> //=; proc. call (_: ={glob P}); first 2 by sim. + proc=> /=; sp; if=>//=; inline{1} 1. - seq 4 0: ( ={glob P, p, n, r, sa, sc, i} - /\ p{1} <> [] - /\ 0 < n{1} - /\ sa{1} = b0 - /\ i{1} = 0 - /\ r{1} = [] - /\ r0{1} = [] - /\ p0{1} = p{1} ++ nseq (n{1} - 1) b0). - + by auto=> /> &2 /valid_spec. - splitwhile{1} 1: (i < size p). - splitwhile{2} 3: (i < n - 1). - rcondt{2} 4. - + auto; while (i < n); 2:by wp; conseq (_: _ ==> true)=> // /#. - by sp; if; 1:call (_: true); auto=> /#. - rcondf{2} 6. - + auto; while (i < n); 2:by wp; conseq (_: _ ==> true)=> // /#. - by sp; if; 1:call (_: true); auto=> /#. - rcondf{2} 6. - + auto; while (i < n); 2:by wp; conseq (_: _ ==> true)=> // /#. - by sp; if; 1:call (_: true); auto=> /#. - wp; while ( ={glob P, p, n, sa, sc} - /\ i{1} = i{2} + size p{2} - /\ drop (size p - 1){1} r0{1} = rcons r{2} sa{2} - /\ 0 <= i{2} - /\ p{1} <> [] - /\ 0 < n{1} - /\ p0{1} = p{1} ++ nseq (n{1} - 1) b0). - + rcondt{2} 3; 1:by auto=> /#. - wp; call (_: true); auto=> /> &1 &2 eq_r i_ge0 p_neq_nil n_ge0 i1_lt_szp0 _ i2_lt_Pn. - rewrite nth_cat -subr_lt0 addzK ltzNge i_ge0 /=. - rewrite nth_nseq // BlockMonoid.AddMonoid.addm0=> /= -[sa sc] /=. - rewrite size_cat size_nseq; split=> [|/#]; split=> [/#|]; split=> [|/#]. - smt (@List). - wp; while ( ={glob P, p, n, sa, sc, i} - /\ i{1} <= size p{1} - /\ size r0{1} = i{1} - /\ last b0 r0{1} = sa{2} - /\ p0{1} = p{1} ++ nseq (n{1} - 1) b0). - + wp; call (_: true); auto=> /> &1 &2. - rewrite size_cat size_nseq=> _ _ szr0_lt_szp. - rewrite nth_cat szr0_lt_szp=> /= -[sa sc] /=. - by rewrite size_rcons last_rcons /= /#. - auto=> /> &2 p_neq_nil n_gt0. - rewrite size_cat size_nseq size_ge0; split=> [/#|r _]. - rewrite ltzNge=> /= szp_le_szr szr_le_szp; split=> [|/#]; split=> [|/#]; split=> [/#|]. - smt (@List). - by inline *; call (_: true). + sp;wp. + rcondt{1}3;progress. + + by wp;while(valid p0 /\ 0 < n0);auto;call(:true);auto. + while( ={sa,sc,glob P} /\ i{1} = i{2} + 1 /\ r0{1} = r{2} + /\ n{2} = n0{1});auto. + + sp;if;1:progress=>/#;1:call(:true);auto=>/#. + by conseq(:_==> ={sa, sc, glob P} /\ r0{1} = r{2} /\ n{2} = n0{1}); + 2:sim;progress=>/#. + + by inline*;auto;call(:true);auto. + byequiv (_: ={glob D, glob S} ==> _)=> //=; proc. - call (_: ={glob S} - /\ INV ICORE.m{1} IBlockSponge.m{2}). - + proc (INV ICORE.m{1} IBlockSponge.m{2})=> //. - proc=> /=; sp; if=> [&1 &2 [#] <*> <-| |] //. + call (_: ={glob S} /\ ={m}(ICORE,IBlockSponge) ). + + proc (ICORE.m{1} = IBlockSponge.m{2})=> //. + proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //. + inline *. conseq (_: ={r, i} /\ r{2} = [] /\ b{2} = [] @@ -291,7 +258,32 @@ section PROOF. + smt(size_ge0 valid_spec). cut/#:size (parse x{m0}).`1 <= size x{m0}. by rewrite-{2}(formatK x{m0}) -H/=/format size_cat size_nseq/#. - inline*;auto. + inline*;auto. + replace{2} { + while { + setup; + if { + (while as loop) + }; + setup_end + }; + after + } by { + while(i < size p) { + setup; + loop; + setup_end; + } + after; + } + (r{2} = [] /\ (p{2}, n{2}) = parse x{2} /\ b{2} = [] /\ + i{2} = 1 /\ r{1} = [] /\ i{1} = 1 /\ p{1} = x{2} /\ + INV ICORE.m{1} IBlockSponge.m{2} /\ valid (parse p{1}).`1 /\ + 0 < (parse p{1}).`2 + ==> r{1} = r{2} ++ bs0{2} /\ INV ICORE.m{1} IBlockSponge.m{2}) + (={i,p,n,x,r,b,IBlockSponge.m, + + (* now we should manage the while loops *) admit. + auto. diff --git a/sha3/proof/clean/NewCore.eca b/sha3/proof/clean/NewCore.eca index c37730d..27fb1af 100644 --- a/sha3/proof/clean/NewCore.eca +++ b/sha3/proof/clean/NewCore.eca @@ -8,7 +8,7 @@ require import NewCommon. (*---*) import Block DBlock Capacity DCapacity. (** Validity of Functionality Queries **) -op valid: block list -> bool. +op valid: block list * int -> bool. (*** DEFINITIONS ***) type state = block * capacity. @@ -17,7 +17,7 @@ op dstate = bdistr `*` cdistr. (** Indifferentiability Experiment **) clone include Indifferentiability with type p <- state, - type f_in <- block list, + type f_in <- block list * int, type f_out <- block list rename [module] "GReal" as "RealIndif" [module] "GIdeal" as "IdealIndif". @@ -26,43 +26,52 @@ clone include Indifferentiability with module (CORE : CONSTRUCTION) (P : DPRIMITIVE): FUNCTIONALITY = { proc init () = {} - proc f(p : block list): block list = { + proc f(p : block list, n : int): block list = { var (sa,sc) <- (b0,c0); var r <- []; var i <- 0; while (i < size p) { (sa,sc) <@ P.f((sa +^ nth witness p i,sc)); - r <- rcons r sa; i <- i + 1; } + i <- 1; + if (valid (p,n)) { + while(i <= n) { + r <- rcons r sa; + i <- i + 1; + if (i <= n) { + (sa,sc) <@ P.f(sa,sc); + } + } + } return r; } }. (** Ideal CORE Functionality **) module ICORE : FUNCTIONALITY = { - var m : (block list,block) fmap + var m : (block list * int,block) fmap proc init() = { m = map0; } - proc fill_in(p : block list) = { - if (!mem (dom m) p) { - m.[p] <$ bdistr; + proc fill_in(p : block list, n : int): block = { + if (!mem (dom m) (p,n)) { + m.[(p,n)] <$ bdistr; } - return oget m.[p]; + return oget m.[(p,n)]; } - proc f(p : block list): block list = { + proc f(p : block list, n : int): block list = { var r <- []; var i <- 1; var b; - if (valid p) { - while (i <= size p) { - b <@ fill_in(take i p); + if (valid (p,n)) { + while (i <= n) { + b <@ fill_in(p,i); r <- rcons r b; i <- i + 1; } @@ -71,7 +80,7 @@ module ICORE : FUNCTIONALITY = { } }. -(** CORE Simulator **) +(** CORE Simulator **) module (S : SIMULATOR) (F : DFUNCTIONALITY) : PRIMITIVE = { var m, mi : (state,state) fmap var pi : (capacity, block list * block) fmap @@ -89,7 +98,7 @@ module (S : SIMULATOR) (F : DFUNCTIONALITY) : PRIMITIVE = { if (!mem (dom m) x) { if (mem (dom pi) x.`2) { (p,v) <- oget pi.[x.`2]; - b <- F.f (rcons p (v +^ x.`1)); + b <- F.f (rcons p (v +^ x.`1),1); y1 <- last b0 b; } else { y1 <$ bdistr; From 9250f366b48c305712dbe0d3b077f966d5d43359 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 4 Jan 2018 10:24:41 +0100 Subject: [PATCH 242/394] . --- sha3/proof/BlockSponge.ec | 6 ++++-- sha3/proof/Common.ec | 18 +++++++++++------- sha3/proof/IRO.eca | 2 +- sha3/proof/RP.eca | 4 ++-- sha3/proof/clean/BlockSponge.eca | 13 ++++++++----- 5 files changed, 26 insertions(+), 17 deletions(-) diff --git a/sha3/proof/BlockSponge.ec b/sha3/proof/BlockSponge.ec index b6f50ac..5c9956d 100644 --- a/sha3/proof/BlockSponge.ec +++ b/sha3/proof/BlockSponge.ec @@ -1,6 +1,6 @@ (*-------------------- Padded Block Sponge Construction ----------------*) -require import Option Pair Int Real List. +require import Core Int Real List. require (*--*) IRO Indifferentiability. require import Common. @@ -65,4 +65,6 @@ lemma conclusion : `| Pr[RealIndif(Sponge, Perm, D).main() @ &m : res] - Pr[IdealIndif(IRO, S, D).main() @ &m : res]| < eps. -proof. admit. qed. +proof. +admit. +qed. diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 4ebce78..08fbb22 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -8,11 +8,11 @@ prover ["Z3"]. prover ["Alt-Ergo"]. *) -require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. +require import Core Int IntExtra IntDiv Real List Distr. require import Ring StdRing StdOrder StdBigop BitEncoding DProd. require (*--*) FinType BitWord RP Monoid. (*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv. -require import NewLogic. +(* require import NewLogic. *) pragma +implicits. @@ -40,15 +40,19 @@ clone BitWord as Capacity with "word" as "cap" "zerow" as "c0". +op cdistr = Capacity.DWord.dunifin. + clone export BitWord as Block with type word <- block, op n <- r proof gt0_n by apply/gt0_r - rename "dword" as "bdistr" - "word" as "block" + rename "word" as "block" + "Word" as "Block" "zerow" as "b0". +op bdistr = DBlock.dunifin. + (* ------------------------- Auxiliary Lemmas ------------------------- *) lemma dvdz_close (n : int) : @@ -104,7 +108,7 @@ qed. clone export RP as Perm with type t <- block * capacity, - op dt <- bdistr `*` Capacity.cdistr + op dt <- bdistr `*` cdistr rename [module type] "RP" as "PRIMITIVE" [module] "P" as "Perm". @@ -564,8 +568,8 @@ 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 nnot in last_xs_eq_b0. +case: (last b0 xs <> b0)=> [// | last_xs_eq_b0]. +rewrite negbK in last_xs_eq_b0. have xs_non_nil : xs <> []. case: xs b2b_xs_eq last_xs_eq_b0 vb_xs=> // contrad. rewrite blocks2bits_nil in contrad. diff --git a/sha3/proof/IRO.eca b/sha3/proof/IRO.eca index cff25e3..05d512d 100644 --- a/sha3/proof/IRO.eca +++ b/sha3/proof/IRO.eca @@ -3,7 +3,7 @@ independently. We obviously make it lazy. Inputs not satisfying a validity predicate are mapped to the empty list *) -require import Option Int Bool List FSet NewFMap. +require import Core Int Bool List FSet NewFMap. type to, from. diff --git a/sha3/proof/RP.eca b/sha3/proof/RP.eca index a943a7e..6c54150 100644 --- a/sha3/proof/RP.eca +++ b/sha3/proof/RP.eca @@ -1,6 +1,6 @@ (*************************- Random Permutation -*************************) -require import Option Real FSet NewFMap Distr. +require import Core Real FSet NewFMap Distr. require import Dexcepted StdOrder. import RealOrder. require import Ring StdRing. import RField. require Monoid. import AddMonoid. @@ -54,7 +54,7 @@ proof. by proc; auto. qed. (* maybe a useful standard lemma? *) lemma mu_except ['a] (d : 'a distr, y : 'a, P : 'a -> bool) : - in_supp y d => ! P y => mu d P < mu d predT. + y \in d => ! P y => mu d P < mu d predT. proof. move=> in_supp_yd notP_y. have -> : mu d P = mu d predT - mu d (predC P) diff --git a/sha3/proof/clean/BlockSponge.eca b/sha3/proof/clean/BlockSponge.eca index 8db0169..ade0646 100644 --- a/sha3/proof/clean/BlockSponge.eca +++ b/sha3/proof/clean/BlockSponge.eca @@ -72,11 +72,11 @@ module (BlockSponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { (sa,sc) <@ P.f((sa +^ nth witness p i,sc)); i <- i + 1; } - i <- 0; - while (i < n) { + i <- 1; + while (i <= n) { r <- rcons r sa; - i <- i + 1; - if (i < n) { + i <- i + 1; + if (i <= n) { (sa,sc) <@ P.f(sa,sc); } } @@ -112,10 +112,13 @@ module IBlockSponge : FUNCTIONALITY = { } i <- 1; while (i <= n) { - b <@ fill_in(x, i); bs <- rcons bs b; i <- i + 1; + if (i <= n) { + b <@ fill_in(x, i); + } } + bs <- rcons bs b; } return bs; } From 2e6a29ac79f8b5ae2220d4a662019367e6812139 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 4 Jan 2018 11:07:14 +0100 Subject: [PATCH 243/394] . --- sha3/proof/clean/BlockSponge.eca | 268 +++++++++++++++++-------------- sha3/proof/clean/NewCore.eca | 17 +- 2 files changed, 151 insertions(+), 134 deletions(-) diff --git a/sha3/proof/clean/BlockSponge.eca b/sha3/proof/clean/BlockSponge.eca index ade0646..98a309d 100644 --- a/sha3/proof/clean/BlockSponge.eca +++ b/sha3/proof/clean/BlockSponge.eca @@ -73,12 +73,11 @@ module (BlockSponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { i <- i + 1; } i <- 1; - while (i <= n) { + r <- rcons r sa; + while (i < n) { + (sa,sc) <@ P.f(sa,sc); r <- rcons r sa; i <- i + 1; - if (i <= n) { - (sa,sc) <@ P.f(sa,sc); - } } } return r; @@ -102,28 +101,28 @@ module IBlockSponge : FUNCTIONALITY = { proc f(x, n) = { var b, bs; - var i <- 0; + var i <- 1; bs <- []; if (valid x /\ 0 < n) { - while (i < size x) { - b <@ fill_in(take i x,1); + (* while (i < size x) { *) + (* b <@ fill_in(take i x,1); *) + (* i <- i + 1; *) + (* } *) + (* i <- 1; *) + b <@ fill_in(x, 1); + bs <- rcons bs b; + while (i < n) { i <- i + 1; - } - i <- 1; - while (i <= n) { + b <@ fill_in(x, i); bs <- rcons bs b; - i <- i + 1; - if (i <= n) { - b <@ fill_in(x, i); - } } - bs <- rcons bs b; } return bs; } }. + (* Parametric Simulator *) module (HiSim (S : Low.SIMULATOR) : SIMULATOR) (F : DFUNCTIONALITY) = { module LoF = { @@ -134,11 +133,11 @@ module (HiSim (S : Low.SIMULATOR) : SIMULATOR) (F : DFUNCTIONALITY) = { if (valid p /\ 0 < n) { - while (i < size p) { - b <@ F.f(take i p,1); - r <- r ++ b; - i <- i + 1; - } + (* while (i < size p) { *) + (* b <@ F.f(take i p,1); *) + (* r <- r ++ b; *) + (* i <- i + 1; *) + (* } *) b <@ F.f(p,n); r <- r ++ b; } @@ -191,11 +190,8 @@ section PROOF. call (_: ={glob P}); first 2 by sim. + proc=> /=; sp; if=>//=; inline{1} 1. sp;wp. - rcondt{1}3;progress. - + by wp;while(valid p0 /\ 0 < n0);auto;call(:true);auto. - while( ={sa,sc,glob P} /\ i{1} = i{2} + 1 /\ r0{1} = r{2} - /\ n{2} = n0{1});auto. - + sp;if;1:progress=>/#;1:call(:true);auto=>/#. + rcondt{1}1;progress. + while( ={sa,sc,glob P,i} /\ r0{1} = r{2} /\ n{2} = n0{1});auto;1:call(:true);auto. by conseq(:_==> ={sa, sc, glob P} /\ r0{1} = r{2} /\ n{2} = n0{1}); 2:sim;progress=>/#. @@ -205,105 +201,127 @@ section PROOF. call (_: ={glob S} /\ ={m}(ICORE,IBlockSponge) ). + proc (ICORE.m{1} = IBlockSponge.m{2})=> //. proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //. - inline *. - conseq (_: ={r, i} - /\ r{2} = [] - /\ b{2} = [] - /\ i{2} = 1 - /\ parse p{1} = (p{2},n{2}) - /\ valid p{2} - /\ 0 < n{2} - /\ INV ICORE.m{1} IBlockSponge.m{2} - ==> _)=> />. - + by move=> &1 &2=> <-. - splitwhile{1} 1: (i < size (parse p).`1); inline{2} 2. - rcondt{2} 6; first by auto; while (true)=> //; auto=> /> &hr <- //. - wp. while ( i{1} = i0{2} + size x0{2} - 1 - /\ p{1} = x0{2} ++ nseq (n0 - 1){2} b0 - /\ r{1} = r{2} ++ bs{2} - /\ 0 < i0{2} - /\ valid x0{2} - /\ n{2} = n0{2} - /\ INV ICORE.m{1} IBlockSponge.m{2} - /\ parse p{1} = (p{2}, n{2})). - + wp;inline*;sp;wp;if;auto;smt(parseK min_lel size_nseq take_nseq - rcons_cat parse_injective getP in_dom oget_some take_size take0 - take_cat parse_valid valid_take cat_rcons cats0 size_cat size_ge0). - wp=>/=. - conseq(:_==> ={r, i} - /\ valid p{2} - /\ 0 < n{2} - /\ p{1} = p{2} ++ nseq (n{2} - 1) Block.b0 - /\ i{1} = size p{2} - /\ parse p{1} = (p{2}, n{2}) - /\ INV ICORE.m{1} IBlockSponge.m{2});progress;..-2:smt(cats0 size_cat size_ge0). - while( ={r,i} - /\ valid p{2} - /\ 0 < n{2} - /\ p{1} = p{2} ++ nseq (n{2} - 1) Block.b0 - /\ 0 < i{1} <= size p{2} - /\ parse p{1} = (p{2}, n{2}) - /\ INV ICORE.m{1} IBlockSponge.m{2}). - + inline*;auto;sp;rcondt{2}1;1:(auto;smt(valid_take)). - rcondt{2}1;1:auto;sp;rcondf{2}5;1:auto;if;auto; - smt(parse_injective getP oget_some in_dom take_size take0 take_cat - parse_valid valid_take cat_rcons cats0 size_cat size_ge0). - auto;smt(parseK min_lel size_nseq take_nseq valid_spec - rcons_cat parse_injective getP in_dom oget_some take_size take0 - take_cat parse_valid valid_take cat_rcons cats0 size_cat size_ge0). - + proc (INV ICORE.m{1} IBlockSponge.m{2})=> //. - proc. - sp;if;1:progress=>/#. - splitwhile{1} 1 : i < size (parse p).`1. - rcondt{1}2;progress. - + while(i <= size (parse p).`1);auto;1:call(:true);auto;progress. - + rewrite/#. - + smt(size_ge0 valid_spec). - cut/#:size (parse x{m0}).`1 <= size x{m0}. - by rewrite-{2}(formatK x{m0}) -H/=/format size_cat size_nseq/#. - inline*;auto. - replace{2} { - while { - setup; - if { - (while as loop) - }; - setup_end - }; - after - } by { - while(i < size p) { - setup; - loop; - setup_end; - } - after; - } - (r{2} = [] /\ (p{2}, n{2}) = parse x{2} /\ b{2} = [] /\ - i{2} = 1 /\ r{1} = [] /\ i{1} = 1 /\ p{1} = x{2} /\ - INV ICORE.m{1} IBlockSponge.m{2} /\ valid (parse p{1}).`1 /\ - 0 < (parse p{1}).`2 - ==> r{1} = r{2} ++ bs0{2} /\ INV ICORE.m{1} IBlockSponge.m{2}) - (={i,p,n,x,r,b,IBlockSponge.m, - - -(* now we should manage the while loops *) - admit. - + auto. - - + proc; sp; if=> //=; inline{1} 1; rcondt{1} 4. - + by auto=> /> &hr _ ^valid_x+ ^n_gt0 /parseK H - /H {H} ->. - sp;wp. - conseq(:_==> drop (size p{1} - 1) r0{1} = bs{2} - /\ ={glob S} - /\ INV ICORE.m{1} IBlockSponge.m{2});progress. - by do !congr;rewrite b2i_eq1/#. - inline*;rewrite/INV. -(* This is false : because ICORE.m{1} will be bigger than IBlockSponge.m{2} *) - splitwhile{1}1:i<=size p;rcondt{2}1;1:auto=>/#. inline*. - (* same as the second loop in LoF.f *) - admit. - by inline *; auto; call (_: true); auto=> /> p; rewrite !map0P. - qed. + sp;rcondt{2}1;auto. + rcondt{1}1;1:auto=>/#. + conseq(:_ ==> r{1} = bs{2} /\ ICORE.m{1} = IBlockSponge.m{2});progress. + by while( i{1} = i0{2} + 1 /\ n{1} = n0{2} /\ x{2} = p{1} + /\ ICORE.m{1} = IBlockSponge.m{2} /\ r{1} = bs{2});sp;if;auto=>/#. + + + proc(={m}(ICORE,IBlockSponge))=>//=. + proc;inline*;sp;if;auto;sp;rcondt{2}1;auto;sp. + rcondt{1}1;1:auto=>/#;sp. + conseq(:_ ==> r{1} = bs{2} /\ ICORE.m{1} = IBlockSponge.m{2});progress. + by while( i{1} = i0{2} + 1 /\ n{1} = n0{2} /\ x{2} = p{1} + /\ ICORE.m{1} = IBlockSponge.m{2} /\ r{1} = bs{2});sp;if;auto=>/#. + + + proc;inline*;sp;if;auto;sp;rcondt{1}1;auto;progress. + rcondt{1}1;1:auto=>/#;sp. + conseq(:_ ==> r0{1} = bs{2} /\ ICORE.m{1} = IBlockSponge.m{2});progress. + by while( i{1} = i{2} + 1 /\ n0{1} = n{2} /\ x{2} = p0{1} + /\ ICORE.m{1} = IBlockSponge.m{2} /\ r0{1} = bs{2});sp;if;auto=>/#. + + by inline*;auto;call(:true);auto. +qed. + +(* conseq (_: ={r, i} *) +(* /\ r{2} = [] *) +(* /\ b{2} = [] *) +(* /\ i{2} = 1 *) +(* /\ parse p{1} = (p{2},n{2}) *) +(* /\ valid p{2} *) +(* /\ 0 < n{2} *) +(* /\ INV ICORE.m{1} IBlockSponge.m{2} *) +(* ==> _)=> />. *) +(* + by move=> &1 &2=> <-. *) +(* splitwhile{1} 1: (i < size (parse p).`1); inline{2} 2. *) +(* rcondt{2} 6; first by auto; while (true)=> //; auto=> /> &hr <- //. *) +(* wp. while ( i{1} = i0{2} + size x0{2} - 1 *) +(* /\ p{1} = x0{2} ++ nseq (n0 - 1){2} b0 *) +(* /\ r{1} = r{2} ++ bs{2} *) +(* /\ 0 < i0{2} *) +(* /\ valid x0{2} *) +(* /\ n{2} = n0{2} *) +(* /\ INV ICORE.m{1} IBlockSponge.m{2} *) +(* /\ parse p{1} = (p{2}, n{2})). *) +(* + wp;inline*;sp;wp;if;auto;smt(parseK min_lel size_nseq take_nseq *) +(* rcons_cat parse_injective getP in_dom oget_some take_size take0 *) +(* take_cat parse_valid valid_take cat_rcons cats0 size_cat size_ge0). *) +(* wp=>/=. *) +(* conseq(:_==> ={r, i} *) +(* /\ valid p{2} *) +(* /\ 0 < n{2} *) +(* /\ p{1} = p{2} ++ nseq (n{2} - 1) Block.b0 *) +(* /\ i{1} = size p{2} *) +(* /\ parse p{1} = (p{2}, n{2}) *) +(* /\ INV ICORE.m{1} IBlockSponge.m{2});progress;..-2:smt(cats0 size_cat size_ge0). *) +(* while( ={r,i} *) +(* /\ valid p{2} *) +(* /\ 0 < n{2} *) +(* /\ p{1} = p{2} ++ nseq (n{2} - 1) Block.b0 *) +(* /\ 0 < i{1} <= size p{2} *) +(* /\ parse p{1} = (p{2}, n{2}) *) +(* /\ INV ICORE.m{1} IBlockSponge.m{2}). *) +(* + inline*;auto;sp;rcondt{2}1;1:(auto;smt(valid_take)). *) +(* rcondt{2}1;1:auto;sp;rcondf{2}5;1:auto;if;auto; *) +(* smt(parse_injective getP oget_some in_dom take_size take0 take_cat *) +(* parse_valid valid_take cat_rcons cats0 size_cat size_ge0). *) +(* auto;smt(parseK min_lel size_nseq take_nseq valid_spec *) +(* rcons_cat parse_injective getP in_dom oget_some take_size take0 *) +(* take_cat parse_valid valid_take cat_rcons cats0 size_cat size_ge0). *) +(* + proc (INV ICORE.m{1} IBlockSponge.m{2})=> //. *) +(* proc. *) +(* sp;if;1:progress=>/#. *) +(* splitwhile{1} 1 : i < size (parse p).`1. *) +(* rcondt{1}2;progress. *) +(* + while(i <= size (parse p).`1);auto;1:call(:true);auto;progress. *) +(* + rewrite/#. *) +(* + smt(size_ge0 valid_spec). *) +(* cut/#:size (parse x{m0}).`1 <= size x{m0}. *) +(* by rewrite-{2}(formatK x{m0}) -H/=/format size_cat size_nseq/#. *) +(* inline*;auto. *) +(* replace{2} { *) +(* while { *) +(* setup; *) +(* if { *) +(* (while as loop) *) +(* }; *) +(* setup_end *) +(* }; *) +(* after *) +(* } by { *) +(* while(i < size p) { *) +(* setup; *) +(* loop; *) +(* setup_end; *) +(* } *) +(* after; *) +(* } *) +(* (r{2} = [] /\ (p{2}, n{2}) = parse x{2} /\ b{2} = [] /\ *) +(* i{2} = 1 /\ r{1} = [] /\ i{1} = 1 /\ p{1} = x{2} /\ *) +(* INV ICORE.m{1} IBlockSponge.m{2} /\ valid (parse p{1}).`1 /\ *) +(* 0 < (parse p{1}).`2 *) +(* ==> r{1} = r{2} ++ bs0{2} /\ INV ICORE.m{1} IBlockSponge.m{2}) *) +(* (={i,p,n,x,r,b,IBlockSponge.m, *) + + +(* (* now we should manage the while loops *) *) +(* admit. *) +(* + auto. *) + +(* + proc; sp; if=> //=; inline{1} 1; rcondt{1} 4. *) +(* + by auto=> /> &hr _ ^valid_x+ ^n_gt0 /parseK H - /H {H} ->. *) +(* sp;wp. *) +(* conseq(:_==> drop (size p{1} - 1) r0{1} = bs{2} *) +(* /\ ={glob S} *) +(* /\ INV ICORE.m{1} IBlockSponge.m{2});progress. *) +(* by do !congr;rewrite b2i_eq1/#. *) +(* inline*;rewrite/INV. *) +(* (* This is false : because ICORE.m{1} will be bigger than IBlockSponge.m{2} *) *) +(* splitwhile{1}1:i<=size p;rcondt{2}1;1:auto=>/#. *) +(* inline*. *) +(* (* same as the second loop in LoF.f *) *) +(* admit. *) +(* by inline *; auto; call (_: true); auto=> /> p; rewrite !map0P. *) +(* qed. *) end section PROOF. diff --git a/sha3/proof/clean/NewCore.eca b/sha3/proof/clean/NewCore.eca index 27fb1af..89d5c13 100644 --- a/sha3/proof/clean/NewCore.eca +++ b/sha3/proof/clean/NewCore.eca @@ -31,18 +31,17 @@ module (CORE : CONSTRUCTION) (P : DPRIMITIVE): FUNCTIONALITY = { var r <- []; var i <- 0; - while (i < size p) { - (sa,sc) <@ P.f((sa +^ nth witness p i,sc)); - i <- i + 1; - } - i <- 1; if (valid (p,n)) { - while(i <= n) { + while (i < size p) { + (sa,sc) <@ P.f((sa +^ nth witness p i,sc)); + i <- i + 1; + } + i <- 1; + r <- rcons r sa; + while(i < n) { + (sa,sc) <@ P.f(sa,sc); r <- rcons r sa; i <- i + 1; - if (i <= n) { - (sa,sc) <@ P.f(sa,sc); - } } } return r; From 77a952675067604ac9471a2efdf018731ea2cdaf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 4 Jan 2018 17:51:59 +0100 Subject: [PATCH 244/394] clean/BlockSponge.eca : - Low : BlockSponge(P).f(p,n) outputs a n-length list - Hi : BlockSponge(P).f(x) outputs only the last block We want to prove that distinguishing in the Low environnement is equivalent to distinguish in the Hi environnement. --- sha3/proof/clean/BlockSponge.eca | 814 ++++++++++++++++++++++++++++--- sha3/proof/clean/NewCore.eca | 6 + 2 files changed, 765 insertions(+), 55 deletions(-) diff --git a/sha3/proof/clean/BlockSponge.eca b/sha3/proof/clean/BlockSponge.eca index 98a309d..822ef5a 100644 --- a/sha3/proof/clean/BlockSponge.eca +++ b/sha3/proof/clean/BlockSponge.eca @@ -54,70 +54,73 @@ proof * by done. (* Indifferentiability *) clone import Indifferentiability as BS_Ind with type p <- block * capacity, - type f_in <- block list * int, - type f_out <- block list + type f_in <- block list, + type f_out <- block proof * by done. (* BlockSponge Construction *) module (BlockSponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { proc init() = {} - proc f(p : block list, n : int) : block list = { - var r <- []; + proc f(p : block list) : block = { var (sa,sc) <- (b0,c0); var i <- 0; + var (x,n) <- parse p; - if (valid p /\ 0 < n) { + if (valid x /\ 0 < n) { while (i < size p) { (sa,sc) <@ P.f((sa +^ nth witness p i,sc)); i <- i + 1; } - i <- 1; - r <- rcons r sa; - while (i < n) { - (sa,sc) <@ P.f(sa,sc); - r <- rcons r sa; - i <- i + 1; - } } - return r; + return sa; } }. (* Ideal Block Sponge Functionality *) module IBlockSponge : FUNCTIONALITY = { - var m : (block list * int,block) fmap + var m : (block list,block) fmap proc init() = { m <- map0; } - proc fill_in(x, n) = { - if (!mem (dom m) (x, n)) { - m.[(x,n)] <$ bdistr; + proc fill_in(x) = { + if (!mem (dom m) x) { + m.[x] <$ bdistr; } - return oget m.[(x,n)]; + return oget m.[x]; } - proc f(x, n) = { - var b, bs; + proc f(x : block list) = { + var b,bs <- b0; var i <- 1; - bs <- []; - if (valid x /\ 0 < n) { - (* while (i < size x) { *) - (* b <@ fill_in(take i x,1); *) - (* i <- i + 1; *) - (* } *) - (* i <- 1; *) - b <@ fill_in(x, 1); - bs <- rcons bs b; - while (i < n) { + var (p,n) <- parse x; + + if (valid p /\ 0 < n) { + while (i < size x) { + b <@ fill_in(take i x); i <- i + 1; - b <@ fill_in(x, i); - bs <- rcons bs b; } + bs <@ fill_in(x); } + + (* bs <- []; *) + (* if (valid x /\ 0 < n) { *) + (* (* while (i < size x) { *) *) + (* (* b <@ fill_in(take i x,1); *) *) + (* (* i <- i + 1; *) *) + (* (* } *) *) + (* (* i <- 1; *) *) + (* b <@ fill_in(x, 1); *) + (* bs <- rcons bs b; *) + (* while (i < n) { *) + (* i <- i + 1; *) + (* b <@ fill_in(x, i); *) + (* bs <- rcons bs b; *) + (* } *) + (* } *) return bs; } }. @@ -128,18 +131,17 @@ module (HiSim (S : Low.SIMULATOR) : SIMULATOR) (F : DFUNCTIONALITY) = { module LoF = { proc f(p : block list, n : int): block list = { var r <- []; - var b <- []; - var i <- 1; + var b; + var i <- 0; if (valid p /\ 0 < n) { - (* while (i < size p) { *) - (* b <@ F.f(take i p,1); *) - (* r <- r ++ b; *) - (* i <- i + 1; *) - (* } *) - b <@ F.f(p,n); - r <- r ++ b; + while (i < n) { + b <@ F.f(p ++ nseq i b0); + r <- rcons r b; + i <- i + 1; + } + } return r; } @@ -157,19 +159,26 @@ pred INV (mc : (block list,block) fmap) (mb : (block list * int,block) fmap) = module (LoDist (D : DISTINGUISHER) : Low.DISTINGUISHER) (F : Low.DFUNCTIONALITY) (P : Low.DPRIMITIVE) = { module HiF = { - proc f(p : block list, n : int) = { + proc f(p : block list) = { var r <- []; + var b <- b0; + var x,n; + - if (valid p /\ 0 < n) { - r <@ F.f(p,n); + (x,n) <- parse p; + + if (valid x /\ 0 < n) { + r <@ F.f(x,n); + b <- last b0 r; } - return r; + return b; } } proc distinguish = D(HiF,P).distinguish }. + (*** PROOF forall P D S, LoDist(D)^{Core(P),P} ~ LoDist(D)^{ICore,S(ICore)} @@ -178,6 +187,636 @@ section PROOF. declare module P : PRIMITIVE { Low.ICORE, IBlockSponge, HiSim }. declare module S : Low.SIMULATOR { Low.ICORE, IBlockSponge, HiSim, P }. declare module D : DISTINGUISHER { Low.ICORE, IBlockSponge, HiSim, P, S }. +print ICORE. + +local module ICORE_eager : Low.FUNCTIONALITY = { + var order : block list list + var dist_res : bool + + proc init() : unit = { + order <- []; + dist_res <- false; + ICORE.init(); + } + + proc fill_in (x : block list) = { + var i <- 1; + var c; + var (p,n) <- parse x; + + while (i < size p) { + ICORE.fill_in(take i p, 1); + order <- rcons order (take i p); + i <- i + 1; + } + i <- 1; + while (i <= n) { + ICORE.fill_in(p, i); + order <- rcons order (format p i); + i <- i + 1; + } + c <@ ICORE.fill_in(p,n); + return c; + } + + proc f(p : block list, n : int) : block list = { + var r : block list; + var i : int <- 1; + var b : block; + + r <- []; + if (valid p /\ 0 < n) { + while (i <= n) { + b <@ fill_in(format p i); + r <- rcons r b; + i <- i + 1; + } + } + return r; + } + proc ewhile() : unit = { + var world <- order; + + var y <- []; + while(world <> []) { + y <- head ([]) world; + fill_in(y); + world <- behead world; + } + } + }. + + local module ICORE_e = { + proc init = ICORE_eager.init + + + proc fill_in (x : block list) = { + var i <- 1; + var c; + var (p,n) <- parse x; + + while (i < size p) { + ICORE_eager.order <- rcons ICORE_eager.order (take i p); + i <- i + 1; + } + i <- 1; + while (i <= n) { + ICORE_eager.order <- rcons ICORE_eager.order (format p i); + i <- i + 1; + } + c <@ ICORE.fill_in(p,n); + return c; + } + + + proc f(p : block list, n : int) : block list = { + var r : block list; + var i : int <- 1; + var b : block; + + r <- []; + if (valid p /\ 0 < n) { + while (i <= n) { + b <@ fill_in(format p i); + r <- rcons r b; + i <- i + 1; + } + } + return r; + } + }. + + local lemma eager_ICORE_e_f : + eager[ ICORE_eager.ewhile();, ICORE_eager.f + ~ ICORE_e.f, ICORE_eager.ewhile(); : + ={p, n} /\ ={ICORE_eager.dist_res, ICORE_eager.order, ICORE.m} + ==> + ={res, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}]. + proof. + eager proc. + swap{1}2;swap{2}-1;sp;wp. + if{2};1:rcondt{1}2;last first;1:rcondf{1}2;progress;2:sim. + + inline*;sp;while(! (valid p /\ 0 < n));auto. + sp;seq 1 : (! (valid p /\ 0 < n));1:by while(! (valid p /\ 0 < n));auto;sp;if;auto. + by sp;seq 1 : (! (valid p /\ 0 < n));1:while(! (valid p /\ 0 < n));auto;sp;if;auto. + + inline*;sp;while( (valid p /\ 0 < n));auto. + sp;seq 1 : ( (valid p /\ 0 < n));1:by while( (valid p /\ 0 < n));auto;sp;if;auto. + by sp;seq 1 : ( (valid p /\ 0 < n));1:while( (valid p /\ 0 < n));auto;sp;if;auto. + conseq(: ={p, n, glob ICORE_eager, i, r} ==> + ={p, n, glob ICORE_eager, i, r});progress. + eager while(J : ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + ={p, n, glob ICORE_eager, i, r} ==> ={p, n, glob ICORE_eager, i, r});progress;1,3:sim. + swap{2}-1;wp 3 3. + swap{2}-1;sim. + conseq(:_==> ={p, n, b, glob ICORE_eager});progress. + inline{1}2;inline{2}1. + (* TODO : a lot of eager while to prepare. *) + + replace{2} { while;_ as loop1; (while;_ as loop2); eage } by { + loop1; + eage; + loop2; + } + (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} + /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}) + (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} + /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}); + progress;1:rewrite/#. + + sim. + conseq(: ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} + ==> ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); + progress. + eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); + progress;1,3:sim. + swap{2}-1;sim. + inline*. + splitwhile{2}4:world <> [(take i p)]. + sp. swap{1}-4;sp. + seq 1 1: ( ={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} + /\ world{2} = [(take i{2} p{2})] + /\ world{1} = [] + /\ world{2} = rcons world{1} (take i{2} p{2}));last first. + + rcondt{2}1;1:auto=>/#. + by rcondf{2}6;auto;sp;if;auto. + while(={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} + /\ world{2} = rcons world{1} (take i{2} p{2}));last auto=>/#. + by sp;if;auto;smt(head_behead). + swap{1}3 -1;seq 2 2 :(={glob ICORE_eager,n,p,r,i});1:sim. + eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); + progress;1,3:sim. + inline ICORE_eager.ewhile. + swap{2}[4..6]-2;sim;swap{2}2;sp. + symmetry;conseq(: ={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress. + replace{1} { all } by { b <- b0; all; } + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;1:sim. + replace{2} { all } by { b <- b0; all; } + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;2:sim. + sp;conseq(: ={world,ICORE.m,p,i,b} ==> ={world,ICORE.m,p,i,b});progress. + eager while(J: b <@ ICORE.fill_in(p,i); ~ b <@ ICORE.fill_in(p,i); : + ={world, p, ICORE.m, i, b} ==> ={world, p, ICORE.m, i, b}); + progress;1,3:sim. + inline*;sp;wp. + swap{1}[3..5]-2;swap{2}[3..4]-2;sp. + case(((p0,n0)=(p1,n1)){1})=>//=. + - if;auto;1:rcondf{1}3;1:auto;1:smt(dom_set in_fsetU1). + + by rcondf{2}3;auto;smt(dom_set in_fsetU1). + by sp;if;auto. + if{2};last first;2:rcondt{1}3;1:rcondf{1}3;progress. + + if;auto;smt(dom_set in_fsetU1). + + sp;if;auto;smt(dom_set in_fsetU1). + + sp;if;auto;smt(dom_set in_fsetU1). + if{1};last first;2:rcondt{2}3;1:rcondf{2}3;progress. + + auto;smt(dom_set in_fsetU1). + + auto;smt(dom_set getP in_fsetU1). + + auto;smt(dom_set in_fsetU1). + swap{2}-1;wp;conseq(:_==> ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p1{2}, n1{2})]);progress. + alias{1} 1 c = b0. + transitivity{1} { + b <$ bdistr; + c <$ bdistr; + ICORE.m.[(p0, n0)] <- b; + ICORE.m.[(p1, n1)] <- c; + } + (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p0{2}, n0{2})]) + (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} + /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); + progress;1:rewrite/#. + + swap{2}3-1;wp;rnd=>/=. + wp 2 2;conseq(:_==> ={ICORE.m});1:smt(getP). + by wp;rnd;auto. + transitivity{1} { + b <$ bdistr; + c <$ bdistr; + ICORE.m.[(p1, n1)] <- b; + ICORE.m.[(p0, n0)] <- c; + } + (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m,p0,p1,n0,n1}) + (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} + /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); + progress;1:rewrite/#. + + swap{1}1;wp;conseq(:_==> (b,c){1} = (c,b){2});progress;2:(rnd;rnd;auto). + by rewrite set_set H0. + by swap{1}3-1;wp;rnd;wp;rnd;auto. + qed. + eager proc. + + local lemma eager_ICORE &m : + Pr[Low.Indif(ICORE, S(ICORE), LoDist(D)).main() @ &m : res] = + Pr[Low.Indif(ICORE_eager, S(ICORE_eager), LoDist(D)).main() @ &m : res]. + + proof. + cut->:Pr[Low.Indif(ICORE, S(ICORE), LoDist(D)).main() @ &m : res] = + Pr[Low.Indif(ICORE_e, S(ICORE_e), LoDist(D)).main() @ &m : res]. + + byequiv (_: ={glob D, glob S} ==> _ )=> //=; proc. + call(: ={glob S,glob ICORE})=>//=;auto. + + proc(={glob ICORE});auto;proc. + sp;if;auto;sp;inline*. + while(={ICORE.m,r,i,p,n} /\ valid p{1} /\ 0 < n{1} /\ 0 < i{1})=>//=;1:auto. + swap{2}[7..8]-3;sp. + conseq(:_==> ={ICORE.m,r,p,n});1:smt(parseK). + sim. + conseq(:_==> ={ICORE.m,r,p,n});1:smt(parseK). + while{2}(={n, p, r, ICORE.m})(n0{2} - i0{2} + 1);1:auto;1:progress=>/#. + conseq(:_==> ={n, p, r, ICORE.m});1:progress=>/#. + wp;while{2}(={n, p, r, ICORE.m})(size p0{2} - i0{2});auto=>/#. + + proc(={glob ICORE});auto;proc. + sp;if;auto;sp;inline*. + while(={ICORE.m,r,i,p,n} /\ valid p{1} /\ 0 < n{1} /\ 0 < i{1})=>//=;1:auto. + swap{2}[7..8]-3;sp. + conseq(:_==> ={ICORE.m,r,p,n});1:smt(parseK). + sim. + conseq(:_==> ={ICORE.m,r,p,n});1:smt(parseK). + while{2}(={n, p, r, ICORE.m})(n0{2} - i0{2} + 1);1:auto;1:progress=>/#. + conseq(:_==> ={n, p, r, ICORE.m});1:progress=>/#. + wp;while{2}(={n, p, r, ICORE.m})(size p0{2} - i0{2});auto=>/#. + + proc;inline*;sp;if;auto;1:progress=>/#;sp. + sp;if;1:auto=>/#;sp;inline*. + while(={ICORE.m,r0,i,p0,n0} /\ valid p0{1} /\ 0 < n0{1} /\ 0 < i{1})=>//=;1:auto. + swap{2}[7..8]-3;sp. + conseq(:_==> ={ICORE.m,r0,p0,n0});1:smt(parseK). + sim. + conseq(:_==> ={ICORE.m,r0,p0,n0});1:smt(parseK). + while{2}(={n0, p0, r0, ICORE.m})(n1{2} - i0{2} + 1);1:auto;1:progress=>/#. + conseq(:_==> ={n0, p0, r0, ICORE.m});1:progress=>/#. + by wp;while{2}(={n0, p0, r0, ICORE.m})(size p1{2} - i0{2});auto=>/#. + + by auto=>/#. + + by auto=>/#. + by inline*;auto;call(:true);auto. + + byequiv (_: ={glob D, glob S} ==> _ )=> //=; proc. + replace{1} { all; <@ } by { + all; + ICORE_eager.dist_res <@ LoDist(D, ICORE_e, S(ICORE_e)).distinguish(); + b <- ICORE_eager.dist_res; + ICORE_eager.ewhile(); + } + (={glob D, glob S} ==> ={b}) + (={glob D, glob S} ==> ={b});progress. + + rewrite/#. + + seq 3 4 : (={b});inline*;auto. + - call(: ={glob S,glob ICORE_e});auto. + + by proc(={glob ICORE_e});auto;proc;sim. + + by proc(={glob ICORE_e});auto;proc;sim. + + by proc;sim. + by call(:true);auto. + by sp;while{2}(={b})(size world{2});auto;1:(sp;if);auto; + smt(bdistr_ll head_behead size_eq0 size_ge0). + + + replace{2} { all; <@ } by { + all; + ICORE_eager.ewhile(); + ICORE_eager.dist_res <@ LoDist(D, ICORE_eager, S(ICORE_eager)).distinguish(); + b <- ICORE_eager.dist_res; + } + (={glob D, glob S} ==> ={b}) + (={glob D, glob S} ==> ={b});progress;last first. + + by inline*;rcondf{1}7;auto;2:sim;call(:true);auto. + + by rewrite/#. + + swap{1}-1;sim. + + symmetry;seq 2 2 : (={glob S,glob D,glob ICORE_eager});1:sim;progress. + + eager call(: ={arg, glob D, glob S,glob ICORE_eager} ==> + ={res, glob D, glob S,glob ICORE_eager} );auto. + eager proc(H : ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + ={glob S, glob ICORE_eager} ==> ={glob S, glob ICORE_eager}) + (={glob S, glob ICORE_eager});auto;progress;1,3,5,7:sim. + + + eager proc(H': ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + ={glob ICORE_eager} ==> ={glob ICORE_eager}) + (={glob ICORE_eager});auto;progress;1,3:sim. + + (* eager : ewhile; ICORE_eager.f ~ ICORE_e.f ; ewhile *) + eager proc. + swap{1}2;swap{2}-1;sp;wp. + if{2};1:rcondt{1}2;last first;1:rcondf{1}2;progress;2:sim. + + inline*;sp;while(! (valid p /\ 0 < n));auto;sp;if;auto. + + inline*;sp;while(valid p /\ 0 < n);auto;sp;if;auto. + replace{2} { while as loop1; (<-;while as loop2); eage } by { + loop1; + eage; + loop2; + } + (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} + /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}) + (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} + /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}); + progress;1:rewrite/#. + + sim. + conseq(: ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} + ==> ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); + progress. + eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); + progress;1,3:sim. + swap{2}-1;sim. + inline*. + splitwhile{2}4:world <> [(take i p)]. + sp. swap{1}-4;sp. + seq 1 1: ( ={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} + /\ world{2} = [(take i{2} p{2})] + /\ world{1} = [] + /\ world{2} = rcons world{1} (take i{2} p{2}));last first. + + rcondt{2}1;1:auto=>/#. + by rcondf{2}6;auto;sp;if;auto. + while(={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} + /\ world{2} = rcons world{1} (take i{2} p{2}));last auto=>/#. + by sp;if;auto;smt(head_behead). + swap{1}3 -1;seq 2 2 :(={glob ICORE_eager,n,p,r,i});1:sim. + eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); + progress;1,3:sim. + inline ICORE_eager.ewhile. + swap{2}[4..6]-2;sim;swap{2}2;sp. + symmetry;conseq(: ={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress. + replace{1} { all } by { b <- b0; all; } + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;1:sim. + replace{2} { all } by { b <- b0; all; } + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;2:sim. + sp;conseq(: ={world,ICORE.m,p,i,b} ==> ={world,ICORE.m,p,i,b});progress. + eager while(J: b <@ ICORE.fill_in(p,i); ~ b <@ ICORE.fill_in(p,i); : + ={world, p, ICORE.m, i, b} ==> ={world, p, ICORE.m, i, b}); + progress;1,3:sim. + inline*;sp;wp. + swap{1}[3..5]-2;swap{2}[3..4]-2;sp. + case(((p0,n0)=(p1,n1)){1})=>//=. + - if;auto;1:rcondf{1}3;1:auto;1:smt(dom_set in_fsetU1). + + by rcondf{2}3;auto;smt(dom_set in_fsetU1). + by sp;if;auto. + if{2};last first;2:rcondt{1}3;1:rcondf{1}3;progress. + + if;auto;smt(dom_set in_fsetU1). + + sp;if;auto;smt(dom_set in_fsetU1). + + sp;if;auto;smt(dom_set in_fsetU1). + if{1};last first;2:rcondt{2}3;1:rcondf{2}3;progress. + + auto;smt(dom_set in_fsetU1). + + auto;smt(dom_set getP in_fsetU1). + + auto;smt(dom_set in_fsetU1). + swap{2}-1;wp;conseq(:_==> ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p1{2}, n1{2})]);progress. + alias{1} 1 c = b0. + transitivity{1} { + b <$ bdistr; + c <$ bdistr; + ICORE.m.[(p0, n0)] <- b; + ICORE.m.[(p1, n1)] <- c; + } + (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p0{2}, n0{2})]) + (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} + /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); + progress;1:rewrite/#. + + swap{2}3-1;wp;rnd=>/=. + wp 2 2;conseq(:_==> ={ICORE.m});1:smt(getP). + by wp;rnd;auto. + transitivity{1} { + b <$ bdistr; + c <$ bdistr; + ICORE.m.[(p1, n1)] <- b; + ICORE.m.[(p0, n0)] <- c; + } + (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m,p0,p1,n0,n1}) + (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} + /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); + progress;1:rewrite/#. + + swap{1}1;wp;conseq(:_==> (b,c){1} = (c,b){2});progress;2:(rnd;rnd;auto). + by rewrite set_set H0. + by swap{1}3-1;wp;rnd;wp;rnd;auto. + + + eager proc(H': ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + ={glob ICORE_eager} ==> ={glob ICORE_eager}) + (={glob ICORE_eager});auto;progress;1,3:sim. + eager proc. + swap{1}2;swap{2}-1;sp;wp. + if{2};1:rcondt{1}2;last first;1:rcondf{1}2;progress;2:sim. + + inline*;sp;while(! (valid p /\ 0 < n));auto;sp;if;auto. + + inline*;sp;while(valid p /\ 0 < n);auto;sp;if;auto. + replace{2} { while as loop1; (<-;while as loop2); eage } by { + loop1; + eage; + loop2; + } + (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} + /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}) + (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} + /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}); + progress;1:rewrite/#. + + sim. + conseq(: ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} + ==> ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); + progress. + eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); + progress;1,3:sim. + swap{2}-1;sim. + inline*. + splitwhile{2}4:world <> [(take i p)]. + sp. swap{1}-4;sp. + seq 1 1: ( ={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} + /\ world{2} = [(take i{2} p{2})] + /\ world{1} = [] + /\ world{2} = rcons world{1} (take i{2} p{2}));last first. + + rcondt{2}1;1:auto=>/#. + by rcondf{2}6;auto;sp;if;auto. + while(={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} + /\ world{2} = rcons world{1} (take i{2} p{2}));last auto=>/#. + by sp;if;auto;smt(head_behead). + swap{1}3 -1;seq 2 2 :(={glob ICORE_eager,n,p,r,i});1:sim. + eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); + progress;1,3:sim. + inline ICORE_eager.ewhile. + swap{2}[4..6]-2;sim;swap{2}2;sp. + symmetry;conseq(: ={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress. + replace{1} { all } by { b <- b0; all; } + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;1:sim. + replace{2} { all } by { b <- b0; all; } + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;2:sim. + sp;conseq(: ={world,ICORE.m,p,i,b} ==> ={world,ICORE.m,p,i,b});progress. + eager while(J: b <@ ICORE.fill_in(p,i); ~ b <@ ICORE.fill_in(p,i); : + ={world, p, ICORE.m, i, b} ==> ={world, p, ICORE.m, i, b}); + progress;1,3:sim. + inline*;sp;wp. + swap{1}[3..5]-2;swap{2}[3..4]-2;sp. + case(((p0,n0)=(p1,n1)){1})=>//=. + - if;auto;1:rcondf{1}3;1:auto;1:smt(dom_set in_fsetU1). + + by rcondf{2}3;auto;smt(dom_set in_fsetU1). + by sp;if;auto. + if{2};last first;2:rcondt{1}3;1:rcondf{1}3;progress. + + if;auto;smt(dom_set in_fsetU1). + + sp;if;auto;smt(dom_set in_fsetU1). + + sp;if;auto;smt(dom_set in_fsetU1). + if{1};last first;2:rcondt{2}3;1:rcondf{2}3;progress. + + auto;smt(dom_set in_fsetU1). + + auto;smt(dom_set getP in_fsetU1). + + auto;smt(dom_set in_fsetU1). + swap{2}-1;wp;conseq(:_==> ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p1{2}, n1{2})]);progress. + alias{1} 1 c = b0. + transitivity{1} { + b <$ bdistr; + c <$ bdistr; + ICORE.m.[(p0, n0)] <- b; + ICORE.m.[(p1, n1)] <- c; + } + (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p0{2}, n0{2})]) + (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} + /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); + progress;1:rewrite/#. + + swap{2}3-1;wp;rnd=>/=. + wp 2 2;conseq(:_==> ={ICORE.m});1:smt(getP). + by wp;rnd;auto. + transitivity{1} { + b <$ bdistr; + c <$ bdistr; + ICORE.m.[(p1, n1)] <- b; + ICORE.m.[(p0, n0)] <- c; + } + (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m,p0,p1,n0,n1}) + (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} + /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); + progress;1:rewrite/#. + + swap{1}1;wp;conseq(:_==> (b,c){1} = (c,b){2});progress;2:(rnd;rnd;auto). + by rewrite set_set H0. + by swap{1}3-1;wp;rnd;wp;rnd;auto. + + eager proc. + swap{1}3;sp;swap{2}-1;sim. + if{2};last first;2:rcondt{1}2;1:rcondf{1}2;progress;2:sim. + + by inline*;sp;while(! (valid x /\ 0 < n));auto;1:(sp;if);auto=>/#. + + by inline*;sp;while( valid x /\ 0 < n );auto;1:(sp;if);auto=>/#. + swap{2}-1;sim. + eager call(: ={p, n, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m} + ==> ={res, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}). + + (* eager : ewhile; ICORE_eager.f ~ ICORE_e.f ; ewhile *) + eager proc. + swap{1}2;swap{2}-1;sp;wp. + if{2};1:rcondt{1}2;last first;1:rcondf{1}2;progress;2:sim. + + inline*;sp;while(! (valid p /\ 0 < n));auto;sp;if;auto. + + inline*;sp;while(valid p /\ 0 < n);auto;sp;if;auto. + replace{2} { while as loop1; (<-;while as loop2); eage } by { + loop1; + eage; + loop2; + } + (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} + /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}) + (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} + /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}); + progress;1:rewrite/#. + + sim. + conseq(: ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} + ==> ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); + progress. + eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); + progress;1,3:sim. + swap{2}-1;sim. + inline*. + splitwhile{2}4:world <> [(take i p)]. + sp. swap{1}-4;sp. + seq 1 1: ( ={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} + /\ world{2} = [(take i{2} p{2})] + /\ world{1} = [] + /\ world{2} = rcons world{1} (take i{2} p{2}));last first. + + rcondt{2}1;1:auto=>/#. + by rcondf{2}6;auto;sp;if;auto. + while(={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} + /\ world{2} = rcons world{1} (take i{2} p{2}));last auto=>/#. + by sp;if;auto;smt(head_behead). + swap{1}3 -1;seq 2 2 :(={glob ICORE_eager,n,p,r,i});1:sim. + eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); + progress;1,3:sim. + inline ICORE_eager.ewhile. + swap{2}[4..6]-2;sim;swap{2}2;sp. + symmetry;conseq(: ={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress. + replace{1} { all } by { b <- b0; all; } + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;1:sim. + replace{2} { all } by { b <- b0; all; } + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;2:sim. + sp;conseq(: ={world,ICORE.m,p,i,b} ==> ={world,ICORE.m,p,i,b});progress. + eager while(J: b <@ ICORE.fill_in(p,i); ~ b <@ ICORE.fill_in(p,i); : + ={world, p, ICORE.m, i, b} ==> ={world, p, ICORE.m, i, b}); + progress;1,3:sim. + inline*;sp;wp. + swap{1}[3..5]-2;swap{2}[3..4]-2;sp. + case(((p0,n0)=(p1,n1)){1})=>//=. + - if;auto;1:rcondf{1}3;1:auto;1:smt(dom_set in_fsetU1). + + by rcondf{2}3;auto;smt(dom_set in_fsetU1). + by sp;if;auto. + if{2};last first;2:rcondt{1}3;1:rcondf{1}3;progress. + + if;auto;smt(dom_set in_fsetU1). + + sp;if;auto;smt(dom_set in_fsetU1). + + sp;if;auto;smt(dom_set in_fsetU1). + if{1};last first;2:rcondt{2}3;1:rcondf{2}3;progress. + + auto;smt(dom_set in_fsetU1). + + auto;smt(dom_set getP in_fsetU1). + + auto;smt(dom_set in_fsetU1). + swap{2}-1;wp;conseq(:_==> ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p1{2}, n1{2})]);progress. + alias{1} 1 c = b0. + transitivity{1} { + b <$ bdistr; + c <$ bdistr; + ICORE.m.[(p0, n0)] <- b; + ICORE.m.[(p1, n1)] <- c; + } + (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p0{2}, n0{2})]) + (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} + /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); + progress;1:rewrite/#. + + swap{2}3-1;wp;rnd=>/=. + wp 2 2;conseq(:_==> ={ICORE.m});1:smt(getP). + by wp;rnd;auto. + transitivity{1} { + b <$ bdistr; + c <$ bdistr; + ICORE.m.[(p1, n1)] <- b; + ICORE.m.[(p0, n0)] <- c; + } + (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m,p0,p1,n0,n1}) + (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} + /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); + progress;1:rewrite/#. + + swap{1}1;wp;conseq(:_==> (b,c){1} = (c,b){2});progress;2:(rnd;rnd;auto). + by rewrite set_set H0. + by swap{1}3-1;wp;rnd;wp;rnd;auto. + + by auto;progress=>/#. + qed. lemma LiftInd &m: `| Pr[Low.Indif(CORE(P),P,LoDist(D)).main() @ &m: res] @@ -188,21 +827,86 @@ section PROOF. do !congr. + byequiv (_: ={glob D, glob P} ==> _ )=> //=; proc. call (_: ={glob P}); first 2 by sim. - + proc=> /=; sp; if=>//=; inline{1} 1. - sp;wp. + + proc=> /=; sp;if=>//=;1:progress=>/#. + inline*;sp;wp. rcondt{1}1;progress. - while( ={sa,sc,glob P,i} /\ r0{1} = r{2} /\ n{2} = n0{1});auto;1:call(:true);auto. - by conseq(:_==> ={sa, sc, glob P} /\ r0{1} = r{2} /\ n{2} = n0{1}); - 2:sim;progress=>/#. + splitwhile{2}1: i < size x. + seq 3 1:( ={glob P,sa,sc,p} + /\ (x,n,p0,n0){1} = (x,n,x,n){2} + /\ valid x{1} + /\ i{2} = size x{2} + /\ i{1} = 1 + /\ r0{1} = [sa{1}] + /\ (x{2}, n{2}) = parse p{2} + /\ 0 < n{1}). + + wp;conseq(:_==> ={glob P,sa,sc,i,p,x,n} + /\ i{2} = size x{2} + /\ (x,n,p0,n0){1} = (x,n,x,n){2});progress. + while( ={glob P,sa,sc,i,p,x,n} + /\ (x{2}, n{2}) = parse p{2} + /\ (p0,n0){1} = (x,n){2} + /\ 0 <= i{2} <= size x{2} <= size p{2});auto;1:call(:true);auto;progress;2..9,-3..-1:smt(size_ge0). + + by rewrite-(formatK p{2})-H/=/format nth_cat H3. + + by rewrite-(formatK p{2})-H/=/format size_cat;smt(size_ge0). + by rewrite-(formatK p{2})-H/=/format size_cat;smt(size_ge0). - by inline*;auto;call(:true);auto. + while( ={glob P,sa,sc,p} + /\ i{1} - 1 = i{2} - size x{2} + /\ size x{2} <= i{2} <= size p{2} + /\ sa{1} = last b0 r0{1} + /\ (x{2}, n{2}) = parse p{2} + /\ (x{1}, n{1}) = parse p{1} + /\ valid x{1} + /\ 0 < n{1} + /\ size p{2} = size x{2} + n{2} - 1 + /\ n0{1} = n{2} + );auto;last first. + + progress. + + by rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. + + by rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. + + by rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. + by move:H2;rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. + call(:true);auto;progress;2..5,-2..:smt(last_rcons). + rewrite -(formatK p{2})-H2/=/format nth_cat nth_nseq_if. + cut->//=:!i{2} < size x{2} by rewrite/#. + cut->//=: 0 <= i{2} - size x{2} by rewrite/#. + rewrite-H. + cut->/=:i{1} - 1 < n{2} - 1 by rewrite/#. + by rewrite BlockMonoid.addr0. + + by inline*;auto;call(:true);auto. print HiSim. print ICORE. + + (* TODO : Introduce an equivalent module to ICORE whose fill_in procedure + makes the same calls as IBlockSponge *) + (* rewrite (eager_ICORE &m). *) byequiv (_: ={glob D, glob S} ==> _)=> //=; proc. - call (_: ={glob S} /\ ={m}(ICORE,IBlockSponge) ). - + proc (ICORE.m{1} = IBlockSponge.m{2})=> //. - proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //. + + call (_: ={glob S} /\ INV IBlockSponge.m{2} ICORE.m{1}). + + proc (INV IBlockSponge.m{2} ICORE.m{1})=> //. + proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. + inline{2} 1.1. inline*. - sp;rcondt{2}1;auto. + while( INV IBlockSponge.m{2} ICORE.m{1} + /\ i{1} = i{2} + 1 + /\ 0 < i{1} + /\ ={n,p,r} + /\ valid p{1} /\ 0 < n{1});last auto=>/#. + rcondt{2}6;auto;progress. + + by cut:=parseK p{hr} (i{hr}+1) H0 H1;rewrite/format-addzA/==>->/=. + + by cut:=parseK p{hr} (i{hr}+1) H0 H1;rewrite/format-addzA/==>->/=. + sp. + conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ x1{2} = x{2} /\ );1:progress. + rewrite/#. + congr;congr;rewrite H6 -H;congr;congr;2:rewrite/#. + rewrite/#. + rewrite/#. + rewrite/#. + rewrite/#. + rewrite/#. + rewrite/#. + /\ ={r + rcondt{1}1;1:auto=>/#. conseq(:_ ==> r{1} = bs{2} /\ ICORE.m{1} = IBlockSponge.m{2});progress. by while( i{1} = i0{2} + 1 /\ n{1} = n0{2} /\ x{2} = p{1} diff --git a/sha3/proof/clean/NewCore.eca b/sha3/proof/clean/NewCore.eca index 89d5c13..56a5c10 100644 --- a/sha3/proof/clean/NewCore.eca +++ b/sha3/proof/clean/NewCore.eca @@ -131,3 +131,9 @@ module (S : SIMULATOR) (F : DFUNCTIONALITY) : PRIMITIVE = { return y; } }. + + +(* we want to build S such that, + forall D, + D^{Core(P),P} ~ D^{ICore,S(ICore)} +*) \ No newline at end of file From 47a5ce48a67b24fcdd1ffd16eb5244b778702f4a Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 4 Jan 2018 17:01:15 -0500 Subject: [PATCH 245/394] Brought RndO.ec and Sponge.ec up-to-date with current library. --- sha3/proof/RndO.ec | 40 +++++++++++++++++++++++++++------------- sha3/proof/Sponge.ec | 32 ++++++++++++++++---------------- 2 files changed, 43 insertions(+), 29 deletions(-) diff --git a/sha3/proof/RndO.ec b/sha3/proof/RndO.ec index b533c6e..fdc6799 100644 --- a/sha3/proof/RndO.ec +++ b/sha3/proof/RndO.ec @@ -1,6 +1,5 @@ pragma -oldip. -require import Pair Option List FSet NewFMap NewDistr. - import NewLogic Fun. +require import Core List FSet NewFMap Distr. require IterProc. (* FIXME notation *) @@ -302,7 +301,8 @@ module LRO : RO = { lemma RRO_resample_ll : islossless RRO.resample. proof. - proc;call (iter_ll RRO.I _)=>//;proc;auto=>/=?;apply sampleto_ll. + proc;call (iter_ll RRO.I _)=>//;proc;auto=>/=?; + by split; first apply sampleto_ll. qed. lemma eager_init : @@ -355,9 +355,13 @@ proof. exists*x{1}, ((oget FRO.m.[x{2}]){1});elim*=>x1 mx;inline RRO.resample. call (iter_inv RRO.I (fun z=>x1<>z) (fun o1 o2 => o1 = o2 /\ o1.[x1]= Some mx) _)=>/=. + by conseq (I_f_neq x1 (Some mx))=>//. - auto=>?&mr[#]4->Hd Hget;rewrite sampleto_ll /==>?_;split. + auto=>?&mr[#]4->Hd Hget. + split; first apply sampleto_ll. + move=> /=_?_; split. + by rewrite get_oget//oget_some/==> x;rewrite -memE dom_restr/#. - by move=>[#]_ Heq?mr[#]->Heq'?_;rewrite in_dom Heq' oget_some /= set_eq /#. + move=>[#]_ Heq?mr[#]->Heq'. + split=> [| _ r _]; first apply sampleto_ll. + rewrite in_dom Heq' oget_some /= set_eq /#. case ((mem (dom FRO.m) x){1}). + inline{1} RRO.resample=>/=;rnd{1}. transitivity{1} @@ -370,7 +374,8 @@ proof. FRO.m{2}.[x{2}] = Some (result{2},Known)). + by move=>?&mr[#]-> -> ??;exists FRO.m{mr} x{mr}=>/#. + move=>???;rewrite in_dom=>[#]<*>[#]->/eq_except_sym H Hxm Hx2. - rewrite sampleto_ll=> r _;rewrite /= Hxm oget_some /=;apply /eq_sym. + split=> [| _ r _]; first apply sampleto_ll. + rewrite /= Hxm oget_some /=;apply /eq_sym. have /(congr1 oget):= Hx2 => <-;apply eq_except_set_eq=>//. by rewrite in_dom Hx2. + symmetry;call (iter1_perm RRO.I iter_perm2). @@ -420,7 +425,8 @@ proof. seq 3 1: (={x,y} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ l{1} = (elems (dom (restr Unknown FRO.m))){2} /\ !mem l{1} x{1} /\ (FRO.m.[x]=Some(y, Known)){2}). - + inline *;auto=>?&mr[#]3->/=Hmem Hget;rewrite sampleto_ll=>?_. + + inline *;auto=>?&mr[#]3->/=Hmem Hget. + split=> [|_ c _]; first apply sampleto_ll. by rewrite set2_eq_except getP_eq restr_set /= dom_rem -memE !inE negb_and. exists* x{1},y{1},(FRO.m.[x]{1});elim*=>x1 y1 mx1;pose mx2:=Some(y1,Known). call (iter_inv RRO.I (fun z=>x1<>z) @@ -455,7 +461,8 @@ proof. seq 3 1: (={x} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ l{1} = (elems (dom (restr Unknown FRO.m))){2} /\ !mem l{1} x{1} /\ (FRO.m.[x]=None){2}). - + inline *;auto=>??[#]2->Hidm/=;rewrite sampleto_ll=>?_. + + inline *;auto=>??[#]2->Hidm/=. + split=> [| _ c _]; first apply sampleto_ll. rewrite eq_except_rem 2:set_eq_except // remP -memE in_fsetD1 negb_and /=. by rewrite restr_rem Hidm /= dom_rem. exists* x{1},(FRO.m.[x]{1});elim*=>x1 mx1. @@ -486,7 +493,10 @@ proof. while (={l,FRO.m} /\ (forall z, mem l z => in_dom_with FRO.m z Unknown){1} /\ in_dom_with FRO.m{1} x{1} f{1} = result{2}). + auto=>?&mr[#]2->Hz <-?_/=?->/=. - split=>[z /mem_drop Hm|];rewrite /in_dom_with dom_set getP !inE /#. + split=>[z /mem_drop Hm|]. + rewrite /in_dom_with dom_set getP !inE /#. + rewrite /in_dom_with in Hz. + rewrite /in_dom_with dom_set getP !inE; smt(mem_head_behead). by auto=>?&mr/=[#]3->/=;split=>// z;rewrite -memE dom_restr. qed. @@ -523,7 +533,9 @@ proof. seq 1 7 : (={x} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ l{2} = (elems (dom (restr Unknown FRO.m))){1} /\ (FRO.m.[x]){2} = Some(c{1},Unknown) /\ (FRO.m.[x]){1} = None). - + wp;rnd;auto=>?&mr[#]2->;rewrite in_dom sampleto_ll/==>Heq?_?->. + + wp;rnd;auto=>?&mr[#]2->; rewrite in_dom /=. + move=> Heq; split; first apply sampleto_ll. + move=> _ c _ ??; split=> // _. rewrite getP_eq restr_set/=dom_set fsetDK eq_except_sym set_set Heq/=set_eq_except/=. congr;apply fsetP=>z;rewrite in_fsetD1 dom_restr /in_dom_with !in_dom /#. exists*x{1},c{1};elim*=>x1 c1;pose mx2:=Some(c1,Unknown). @@ -599,7 +611,7 @@ equiv LRO_RRO_get : LRO.get ~ RRO.get : ={x} /\ RO.m{1} = restr Known FRO.m{2} ==> ={res} /\ RO.m{1} = restr Known FRO.m{2}. proof. proc;auto=>?&ml[]->->/=?->/=. - rewrite dom_restr negb_and ora_or neqK_eqU. + rewrite dom_restr orabP negb_and neqK_eqU. rewrite !restr_set/= !getP_eq oget_some;progress. by move:H;rewrite negb_or/= restrP in_dom /#. qed. @@ -619,8 +631,10 @@ qed. equiv LRO_RRO_sample : LRO.sample ~ RRO.sample: ={x} /\ RO.m{1} = restr Known FRO.m{2} ==> RO.m{1} = restr Known FRO.m{2}. proof. - proc;auto=>?&ml[]_->;rewrite sampleto_ll=> ??;rewrite restr_set /==>Hnd. - by rewrite rem_id // dom_restr /in_dom_with Hnd. + proc;auto=>?&ml[]_->. +split=> [| _ ? _]; first apply sampleto_ll. +rewrite restr_set /==>Hnd. +by rewrite rem_id // dom_restr /in_dom_with Hnd. qed. lemma LRO_RRO_D (D<:RO_Distinguisher{RO,FRO}) : diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 3873aaa..f812a3a 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -8,9 +8,9 @@ prover ["Z3"]. prover ["Alt-Ergo"]. *) -require import Bool Fun Pair Option Int IntDiv Real List FSet NewFMap. -(*---*) import Pred IntExtra. -require import NewDistr DBool DList. +require import Core Int IntDiv Real List FSet NewFMap. +(*---*) import IntExtra. +require import Distr DBool DList. require import StdBigop StdOrder. import IntOrder. require import Common. require (*--*) IRO BlockSponge RndO. @@ -1168,12 +1168,12 @@ proof *. (* nothing to be proved *) lemma PrLoopSnoc_sample &m (bs : bool list) : - Pr[Prog.LoopSnoc.sample(r) @ &m : bs = res] = + Pr[Prog.LoopSnoc.sample(r) @ &m : res = bs] = mu (dlist {0,1} r) (pred1 bs). proof. have -> : - Pr[Prog.LoopSnoc.sample(r) @ &m : bs = res] = - Pr[Prog.Sample.sample(r) @ &m : bs = res]. + Pr[Prog.LoopSnoc.sample(r) @ &m : res = bs] = + Pr[Prog.Sample.sample(r) @ &m : res = bs]. byequiv=> //. symmetry. conseq (_ : ={n} ==> ={res})=> //. @@ -1220,15 +1220,15 @@ 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 : w = res] = 1%r / (2 ^ r)%r. +have -> : Pr[BlockGen.direct() @ &2 : res = w] = 1%r / (2 ^ r)%r. byphoare=> //. - proc; rnd; skip; progress; rewrite DWord.bdistrE. - have -> : (fun x => w = x) = (pred1 w) - by apply ExtEq.fun_ext=> x; by rewrite (eq_sym w x). - by rewrite count_uniq_mem 1:enum_uniq enumP b2i1. + 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 : w = res] = - Pr[Prog.LoopSnoc.sample(r) @ &1 : ofblock w = res]. + 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 /\ @@ -1245,11 +1245,11 @@ have -> : have sz_ds_eq_r : size ds = r by smt(). progress; [by rewrite ofblockK | by rewrite mkblockK]. rewrite (PrLoopSnoc_sample &1 (ofblock w)). -rewrite mux_dlist 1:ge0_r size_block /=. +rewrite dlist1E 1:ge0_r size_block /=. have -> : - (fun (x : bool) => mu {0,1} (pred1 x)) = + (fun (x : bool) => mu1 {0,1} x) = (fun (x : bool) => 1%r / 2%r). - apply ExtEq.fun_ext=> x; by rewrite dboolb. +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. From 7d398d1774090bb68b372a67c867e277374a6e8a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Fri, 5 Jan 2018 19:52:18 +0100 Subject: [PATCH 246/394] . --- sha3/proof/clean/BlockSponge.eca | 856 ++++++++++++++----------------- 1 file changed, 399 insertions(+), 457 deletions(-) diff --git a/sha3/proof/clean/BlockSponge.eca b/sha3/proof/clean/BlockSponge.eca index 822ef5a..67e2782 100644 --- a/sha3/proof/clean/BlockSponge.eca +++ b/sha3/proof/clean/BlockSponge.eca @@ -132,12 +132,12 @@ module (HiSim (S : Low.SIMULATOR) : SIMULATOR) (F : DFUNCTIONALITY) = { proc f(p : block list, n : int): block list = { var r <- []; var b; - var i <- 0; + var i <- 1; if (valid p /\ 0 < n) { - while (i < n) { - b <@ F.f(p ++ nseq i b0); + while (i <= n) { + b <@ F.f(format p i); r <- rcons r b; i <- i + 1; } @@ -205,17 +205,16 @@ local module ICORE_eager : Low.FUNCTIONALITY = { var (p,n) <- parse x; while (i < size p) { - ICORE.fill_in(take i p, 1); - order <- rcons order (take i p); + ICORE.fill_in(parse(take i p)); i <- i + 1; } i <- 1; - while (i <= n) { + while (i < n) { ICORE.fill_in(p, i); - order <- rcons order (format p i); i <- i + 1; } - c <@ ICORE.fill_in(p,n); + c <@ ICORE.fill_in(parse(format p n)); + order <- rcons order x; return c; } @@ -236,35 +235,39 @@ local module ICORE_eager : Low.FUNCTIONALITY = { } proc ewhile() : unit = { var world <- order; + var i <- 1; + var (p,n); var y <- []; + while(world <> []) { y <- head ([]) world; - fill_in(y); + i <- 1; + (p,n) <- parse y; + while (i < size p) { + ICORE.fill_in(parse(take i p)); + i <- i + 1; + } + i <- 1; + while (i < n) { + ICORE.fill_in(parse(format p i)); + i <- i + 1; + } world <- behead world; } } }. - local module ICORE_e = { + local module ICORE_e : Low.FUNCTIONALITY = { proc init = ICORE_eager.init proc fill_in (x : block list) = { - var i <- 1; var c; var (p,n) <- parse x; - while (i < size p) { - ICORE_eager.order <- rcons ICORE_eager.order (take i p); - i <- i + 1; - } - i <- 1; - while (i <= n) { - ICORE_eager.order <- rcons ICORE_eager.order (format p i); - i <- i + 1; - } c <@ ICORE.fill_in(p,n); + ICORE_eager.order <- rcons ICORE_eager.order (x); return c; } @@ -286,6 +289,223 @@ local module ICORE_eager : Low.FUNCTIONALITY = { } }. + local lemma eager_ICORE_fill_in : + eager[ ICORE_eager.ewhile();, ICORE.fill_in + ~ ICORE.fill_in, ICORE_eager.ewhile(); + : ={arg, ICORE_eager.order, ICORE.m} + ==> + ={res, ICORE_eager.order, ICORE.m}]. + proof. + eager proc. + inline ICORE_eager.ewhile;symmetry. + swap{1}[1..2]2. + replace{1} { all } by { + result <- b0; + all; + } + (={p,n,ICORE_eager.order,ICORE.m} + ==> ={result,ICORE_eager.order,ICORE.m}) + (={p,n,ICORE_eager.order,ICORE.m} + ==> ={result,ICORE_eager.order,ICORE.m}); + progress;1:rewrite/#;1:sim. + replace{2} { all } by { + result <- b0; + all; + } + (={p,n,ICORE_eager.order,ICORE.m} + ==> ={result,ICORE_eager.order,ICORE.m}) + (={p,n,ICORE_eager.order,ICORE.m} + ==> ={result,ICORE_eager.order,ICORE.m}); + progress;1:rewrite/#;2:sim. + sp;swap{1}3-2;sp. + conseq(: ={world, ICORE_eager.order, ICORE.m, p, n, result} + ==> ={world, ICORE_eager.order, ICORE.m, p, n, result});progress. + eager while(J: + if (!((p,n) \in dom ICORE.m)) { + ICORE.m.[(p,n)] <$ bdistr; + } + result <- oget ICORE.m.[(p, n)]; + ~ + if (!((p,n) \in dom ICORE.m)) { + ICORE.m.[(p,n)] <$ bdistr; + } + result <- oget ICORE.m.[(p, n)]; + : + ={world, ICORE_eager.order, ICORE.m, p, n, result} + ==> + ={world, ICORE_eager.order, ICORE.m, p, n, result});progress;1,3:sim. + swap{2}7 2;sim;swap{1}3-2;sp 1 1. + conseq(: ={y,p,n,ICORE.m,ICORE_eager.order} + ==> ={result,ICORE.m,ICORE_eager.order});progress. + + replace{1} { (if;<-); body } by { + result <@ ICORE.fill_in(p,n); + body; + } + (={y,p,n,ICORE.m,ICORE_eager.order} + ==> ={result,ICORE.m,ICORE_eager.order}) + (={y,p,n,ICORE.m,ICORE_eager.order} + ==> ={result,ICORE.m,ICORE_eager.order}); + progress;1:rewrite/#;1:(inline{2}1;sim). + replace{2} { body;(if;<-) } by { + body; + result <@ ICORE.fill_in(p,n); + } + (={y,p,n,ICORE.m,ICORE_eager.order} + ==> ={result,ICORE.m,ICORE_eager.order}) + (={y,p,n,ICORE.m,ICORE_eager.order} + ==> ={result,ICORE.m,ICORE_eager.order}); + progress;1:rewrite/#;2:(inline*;sim). + + replace{2} { begin; (while as loop); (<@ as result) } by { + begin; + result; + loop; + } + (={y,p,n,ICORE.m,ICORE_eager.order} + ==> ={n0,p0,result,ICORE.m,ICORE_eager.order}) + (={y,p,n,ICORE.m,ICORE_eager.order} + ==> ={n0,p0,result,ICORE.m,ICORE_eager.order}); + progress;1:rewrite/#;last first. + + + seq 4 4:(={i,n0,p,p0,n,ICORE_eager.order,ICORE.m});1:sim. + replace{1} { all } by { result <- b0; all; } + (={i, n0, p, p0, n, ICORE_eager.order, ICORE.m} + ==> ={n0,p0,result, ICORE.m, ICORE_eager.order}) + (={i, n0, p, p0, n, ICORE_eager.order, ICORE.m} + ==> ={n0,p0,result, ICORE.m, ICORE_eager.order}); + progress;1:rewrite/#;1:sim. + replace{2} { all } by { result <- b0; all; } + (={i, n0, p, p0, n, ICORE_eager.order, ICORE.m} + ==> ={n0,p0,result, ICORE.m, ICORE_eager.order}) + (={i, n0, p, p0, n, ICORE_eager.order, ICORE.m} + ==> ={n0,p0,result, ICORE.m, ICORE_eager.order}); + progress;1:rewrite/#;2:sim. + sp;conseq(: ={i, n0, p, p0, n, ICORE_eager.order, ICORE.m, result} + ==> _);progress. + eager while(K: + result <@ ICORE.fill_in(p, n); ~ + result <@ ICORE.fill_in(p, n); : + ={i, n0, p, p0, n, ICORE_eager.order, ICORE.m, result} ==> + ={i, n0, p, p0, n, ICORE_eager.order, ICORE.m, result}); + progress;1,3:sim. + swap{2}-1;sim;conseq(:_==> ={result,ICORE.m});progress. + inline *. (* TODO : reprendre d'ici. Il y avait un pb de parse/format. *) + + + case((p, n){1} = (p0, i){1}). + + sp;rcondf{1}5;first auto;if;auto;smt(dom_set in_fsetU1). + by rcondf{2}4;auto;if;auto;smt(dom_set in_fsetU1). + sp;if{1};last first;2:rcondt{2}4;1:rcondf{2}4;progress;2:sim. + + auto;if;auto;smt(dom_set in_fsetU1). + + if{2};last first;2:rcondt{1}4;1:rcondf{1}4;auto;smt(getP). + + auto;if;auto;smt(dom_set in_fsetU1). + if{2};last first;2:rcondt{1}5;1:rcondf{1}5;progress. + + auto;smt(dom_set in_fsetU1). + + auto;smt(getP). + + auto;smt(dom_set in_fsetU1). + conseq(:_==> ={ICORE.m,result});progress. + alias{1} 1 c = b0; + transitivity{1} { + c <$ bdistr; + result <$ bdistr; + ICORE.m.[(p,n)] <- result; + ICORE.m.[(p0,i)] <- c; + } + (={p0,i,p,n,ICORE.m} /\ p1{1} = p{1} /\ n1{1} = n{1} + /\ ! (p{1} = p0{1} && n{1} = i{1}) ==> ={ICORE.m,result}) + (={p0,i,p,n,ICORE.m} /\ p1{2} = p0{2} /\ n1{2} = i{2} + /\ ! (p{1} = p0{1} && n{1} = i{1}) ==> ={ICORE.m,result}); + progress;1:rewrite/#. + + by swap{2}2;wp;rnd;wp;rnd;auto;smt(getP). + transitivity{1} { + c <$ bdistr; + result <$ bdistr; + ICORE.m.[(p,n)] <- result; + ICORE.m.[(p0,i)] <- c; + } + (={p0,i,p,n,ICORE.m} /\ ! (p{1} = p0{1} && n{1} = i{1}) + ==> ={ICORE.m,result}) + (={p0,i,p,n,ICORE.m} /\ p1{2} = p0{2} /\ n1{2} = i{2} + /\ ! (p{1} = p0{1} && n{1} = i{1}) ==> ={ICORE.m,result}); + progress;1:rewrite/#. + + by wp;rnd;rnd;auto;smt(set_set). + by wp;rnd;wp;rnd;auto;progress;smt(set_set getP). + sim;swap{2}-1;sim;swap{1}2;sp. + + conseq(: ={p,n,p0,n0,i,ICORE.m,ICORE_eager.order} + ==> ={result,ICORE_eager.order,ICORE.m});first 2 progress=>/#. + replace{1} { all } by { + result <- b0; + all; + } + (={p,n,p0,i,ICORE_eager.order,ICORE.m} + ==> ={result,ICORE_eager.order,ICORE.m}) + (={p,n,p0,i,ICORE_eager.order,ICORE.m} + ==> ={result,ICORE_eager.order,ICORE.m}); + progress;1:rewrite/#;1:sim. + replace{2} { all } by { + result <- b0; + all; + } + (={p,n,p0,i,ICORE_eager.order,ICORE.m} + ==> ={result,ICORE_eager.order,ICORE.m}) + (={p,n,p0,i,ICORE_eager.order,ICORE.m} + ==> ={result,ICORE_eager.order,ICORE.m}); + progress;1:rewrite/#;2:sim. + sp;conseq(: ={p,n,p0,i,ICORE.m,ICORE_eager.order,result} ==> _); + progress. + eager while(K: + result <@ ICORE.fill_in(p, n); ~ + result <@ ICORE.fill_in(p, n); : + ={p, n, p0, i, ICORE.m, ICORE_eager.order, result} ==> + ={p, n, p0, i, ICORE.m, ICORE_eager.order, result}); + progress;1,3:sim. + + swap{2}-1;sim;conseq(:_==> ={result,ICORE.m});progress. + inline *. + case((p, n){1} = parse (take i p0){1}). + + sp;rcondf{1}4;first auto;if;auto;smt(dom_set in_fsetU1). + by rcondf{2}4;auto;if;auto;smt(dom_set in_fsetU1). + sp;if{1};last first;2:rcondt{2}4;1:rcondf{2}4;progress;2:sim. + + auto;if;auto;smt(dom_set in_fsetU1). + + if{2};last first;2:rcondt{1}3;1:rcondf{1}3;auto;smt(getP). + + auto;if;auto;smt(dom_set in_fsetU1). + if{2};last first;2:rcondt{1}4;1:rcondf{1}4;progress. + + auto;smt(dom_set in_fsetU1). + + auto;smt(getP). + + auto;smt(dom_set in_fsetU1). + conseq(:_==> ={ICORE.m,result});progress. + alias{1} 1 c = b0. + transitivity{1} { + c <$ bdistr; + result <$ bdistr; + ICORE.m.[(p,n)] <- result; + ICORE.m.[parse(take i p0)] <- c; + } + (={p0,i,p,n,ICORE.m} /\ p1{1} = p{1} /\ n1{1} = n{1} + /\ (p1{1},n1{1}) <> parse (take i{1} p0{1}) ==> ={ICORE.m,result}) + (={p0,i,p,n,ICORE.m} /\ (p1{2},n1{2}) = parse(take i{1} p0{2}) + /\ (p1{1},n1{1}) <> parse (take i{1} p0{1}) ==> ={ICORE.m,result}); + progress;1:rewrite/#. + + by swap{2}2;wp;rnd;wp;rnd;auto;smt(getP). + transitivity{1} { + c <$ bdistr; + result <$ bdistr; + ICORE.m.[(p,n)] <- result; + ICORE.m.[parse(take i p0)] <- c; + } + (={p0,i,p,n,ICORE.m} /\ (p1{1},n1{1}) <> parse (take i{1} p0{1}) + ==> ={ICORE.m,result}) + (={p0,i,p,n,ICORE.m} /\ (p1{2},n1{2}) = parse(take i{1} p0{2}) + /\ (p1{1},n1{1}) <> parse (take i{1} p0{1}) ==> ={ICORE.m,result}); + progress;1:rewrite/#. + + by wp;rnd;rnd;auto;smt(set_set). + wp;rnd;wp;rnd;auto;progress. smt(set_set getP). + + qed. + + local lemma eager_ICORE_e_f : eager[ ICORE_eager.ewhile();, ICORE_eager.f ~ ICORE_e.f, ICORE_eager.ewhile(); : @@ -304,111 +524,83 @@ local module ICORE_eager : Low.FUNCTIONALITY = { by sp;seq 1 : ( (valid p /\ 0 < n));1:while( (valid p /\ 0 < n));auto;sp;if;auto. conseq(: ={p, n, glob ICORE_eager, i, r} ==> ={p, n, glob ICORE_eager, i, r});progress. - eager while(J : ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : - ={p, n, glob ICORE_eager, i, r} ==> ={p, n, glob ICORE_eager, i, r});progress;1,3:sim. + + eager while(J : + ICORE_eager.ewhile(); ~ + ICORE_eager.ewhile(); : + ={p, n, glob ICORE_eager, i, r} ==> + ={p, n, glob ICORE_eager, i, r}); + progress;1,3:sim. swap{2}-1;wp 3 3. swap{2}-1;sim. conseq(:_==> ={p, n, b, glob ICORE_eager});progress. - inline{1}2;inline{2}1. - (* TODO : a lot of eager while to prepare. *) - - replace{2} { while;_ as loop1; (while;_ as loop2); eage } by { - loop1; - eage; - loop2; - } - (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} - /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}) - (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} - /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}); - progress;1:rewrite/#. - + sim. - conseq(: ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} - ==> ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); - progress. - eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); - progress;1,3:sim. - swap{2}-1;sim. - inline*. - splitwhile{2}4:world <> [(take i p)]. - sp. swap{1}-4;sp. - seq 1 1: ( ={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} - /\ world{2} = [(take i{2} p{2})] - /\ world{1} = [] - /\ world{2} = rcons world{1} (take i{2} p{2}));last first. - + rcondt{2}1;1:auto=>/#. - by rcondf{2}6;auto;sp;if;auto. - while(={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} - /\ world{2} = rcons world{1} (take i{2} p{2}));last auto=>/#. - by sp;if;auto;smt(head_behead). - swap{1}3 -1;seq 2 2 :(={glob ICORE_eager,n,p,r,i});1:sim. - eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); - progress;1,3:sim. - inline ICORE_eager.ewhile. - swap{2}[4..6]-2;sim;swap{2}2;sp. - symmetry;conseq(: ={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress. - replace{1} { all } by { b <- b0; all; } - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;1:sim. - replace{2} { all } by { b <- b0; all; } - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;2:sim. - sp;conseq(: ={world,ICORE.m,p,i,b} ==> ={world,ICORE.m,p,i,b});progress. - eager while(J: b <@ ICORE.fill_in(p,i); ~ b <@ ICORE.fill_in(p,i); : - ={world, p, ICORE.m, i, b} ==> ={world, p, ICORE.m, i, b}); - progress;1,3:sim. - inline*;sp;wp. - swap{1}[3..5]-2;swap{2}[3..4]-2;sp. - case(((p0,n0)=(p1,n1)){1})=>//=. - - if;auto;1:rcondf{1}3;1:auto;1:smt(dom_set in_fsetU1). - + by rcondf{2}3;auto;smt(dom_set in_fsetU1). - by sp;if;auto. - if{2};last first;2:rcondt{1}3;1:rcondf{1}3;progress. - + if;auto;smt(dom_set in_fsetU1). - + sp;if;auto;smt(dom_set in_fsetU1). - + sp;if;auto;smt(dom_set in_fsetU1). - if{1};last first;2:rcondt{2}3;1:rcondf{2}3;progress. - + auto;smt(dom_set in_fsetU1). - + auto;smt(dom_set getP in_fsetU1). - + auto;smt(dom_set in_fsetU1). - swap{2}-1;wp;conseq(:_==> ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p1{2}, n1{2})]);progress. - alias{1} 1 c = b0. - transitivity{1} { - b <$ bdistr; - c <$ bdistr; - ICORE.m.[(p0, n0)] <- b; - ICORE.m.[(p1, n1)] <- c; - } - (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p0{2}, n0{2})]) - (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} - /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); - progress;1:rewrite/#. - + swap{2}3-1;wp;rnd=>/=. - wp 2 2;conseq(:_==> ={ICORE.m});1:smt(getP). - by wp;rnd;auto. - transitivity{1} { - b <$ bdistr; - c <$ bdistr; - ICORE.m.[(p1, n1)] <- b; - ICORE.m.[(p0, n0)] <- c; - } - (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m,p0,p1,n0,n1}) - (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} - /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); - progress;1:rewrite/#. - + swap{1}1;wp;conseq(:_==> (b,c){1} = (c,b){2});progress;2:(rnd;rnd;auto). - by rewrite set_set H0. - by swap{1}3-1;wp;rnd;wp;rnd;auto. + inline{2}1. + swap{2}3 1;swap{2}-1. + replace{2} { (<@ as fill_in);(<@ as ewhile) } by { + ewhile; + fill_in; + } + (={i, r, p, n, glob ICORE_eager} ==> ={b, p, n, glob ICORE_eager}) + (={i, r, p, n, glob ICORE_eager} ==> ={b, p, n, glob ICORE_eager}); + progress;1:rewrite/#;last first. + + sim;conseq(:_==> ={ICORE_eager.order, ICORE.m,c});progress. + seq 3 3:(={p0,n0,ICORE_eager.order, ICORE.m});1:sim. + by eager call(eager_ICORE_fill_in);auto. + inline{1}2;sim;swap{1}-1;sim. + + inline{2}4. + splitwhile{2}7: 1 < size world. + rcondt{2}8;progress. + + sp;while(last (head [] (behead world)) world = format p i /\ 1 <= size world); + auto;last smt(last_rcons size_rcons size_ge0 size_eq0). + inline*=>//=. + sp;seq 1 : (last (head [] (behead world)) (behead world) = format p i + /\ 1 <= size (behead world)). + + while(last (head [] (behead world)) (behead world) = format p i + /\ 1 <= size (behead world));auto. + + by sp;if;auto. + by progress;smt(head_behead). + sp;seq 1 : (last (head [] (behead world)) (behead world) = format p i + /\ 1 <= size (behead world)). + + while(last (head [] (behead world)) (behead world) = format p i + /\ 1 <= size (behead world));auto. + by sp;if;auto. + by auto;progress;smt(head_behead). + rcondf{2}15;progress. + + seq 8 : (world = [format p i]). + + wp;sp;while(last (head [] world) world = format p i /\ 1 <= size world); + auto;last first. + + smt(last_rcons size_rcons size_ge0 head_behead size_eq0). + inline*=>//=. + sp;seq 1 : (last (head [] world) (behead world) = format p i + /\ 1 <= size (behead world)). + + while(last (head [] world) (behead world) = format p i + /\ 1 <= size (behead world));auto. + + by sp;if;auto. + by progress;smt(head_behead). + sp;seq 1 : (last (head [] world) (behead world) = format p i + /\ 1 <= size (behead world)). + + while(last (head [] world) (behead world) = format p i + /\ 1 <= size (behead world));auto. + by sp;if;auto. + by auto;progress;smt(head_behead). + inline*=>/=. + sp;seq 1:(world = [format p i]);1:while(world = [format p i]);1:(sp;if);auto. + by sp;seq 1:(world = [format p i]);1:while(world = [format p i]);1:(sp;if);auto. + + swap{1}-3;sim. + inline*;sim;swap{1}[5..8]-1;wp;sp=>/=. + conseq(:_==> ={ICORE.m,ICORE_eager.order} + /\ world{1} = [] /\ world{2} = [format p{2} i{2}]); + 1:smt(parseK). + + while(={ICORE.m} /\ world{2} = rcons world{1} (format p{2} i{2})); + auto;last smt(size_eq0 size_rcons size_ge0). + rewrite/=. + sp;conseq(:_==> ={ICORE.m}); + 1:smt(head_behead size_eq0 size_rcons size_ge0);sim. + smt(head_behead). qed. - eager proc. local lemma eager_ICORE &m : Pr[Low.Indif(ICORE, S(ICORE), LoDist(D)).main() @ &m : res] = @@ -422,33 +614,15 @@ local module ICORE_eager : Low.FUNCTIONALITY = { + proc(={glob ICORE});auto;proc. sp;if;auto;sp;inline*. while(={ICORE.m,r,i,p,n} /\ valid p{1} /\ 0 < n{1} /\ 0 < i{1})=>//=;1:auto. - swap{2}[7..8]-3;sp. - conseq(:_==> ={ICORE.m,r,p,n});1:smt(parseK). - sim. - conseq(:_==> ={ICORE.m,r,p,n});1:smt(parseK). - while{2}(={n, p, r, ICORE.m})(n0{2} - i0{2} + 1);1:auto;1:progress=>/#. - conseq(:_==> ={n, p, r, ICORE.m});1:progress=>/#. - wp;while{2}(={n, p, r, ICORE.m})(size p0{2} - i0{2});auto=>/#. + sp;if;auto;smt(parseK). + proc(={glob ICORE});auto;proc. sp;if;auto;sp;inline*. while(={ICORE.m,r,i,p,n} /\ valid p{1} /\ 0 < n{1} /\ 0 < i{1})=>//=;1:auto. - swap{2}[7..8]-3;sp. - conseq(:_==> ={ICORE.m,r,p,n});1:smt(parseK). - sim. - conseq(:_==> ={ICORE.m,r,p,n});1:smt(parseK). - while{2}(={n, p, r, ICORE.m})(n0{2} - i0{2} + 1);1:auto;1:progress=>/#. - conseq(:_==> ={n, p, r, ICORE.m});1:progress=>/#. - wp;while{2}(={n, p, r, ICORE.m})(size p0{2} - i0{2});auto=>/#. + sp;if;auto;smt(parseK). + proc;inline*;sp;if;auto;1:progress=>/#;sp. sp;if;1:auto=>/#;sp;inline*. while(={ICORE.m,r0,i,p0,n0} /\ valid p0{1} /\ 0 < n0{1} /\ 0 < i{1})=>//=;1:auto. - swap{2}[7..8]-3;sp. - conseq(:_==> ={ICORE.m,r0,p0,n0});1:smt(parseK). - sim. - conseq(:_==> ={ICORE.m,r0,p0,n0});1:smt(parseK). - while{2}(={n0, p0, r0, ICORE.m})(n1{2} - i0{2} + 1);1:auto;1:progress=>/#. - conseq(:_==> ={n0, p0, r0, ICORE.m});1:progress=>/#. - by wp;while{2}(={n0, p0, r0, ICORE.m})(size p1{2} - i0{2});auto=>/#. + sp;if;auto;smt(parseK). + by auto=>/#. + by auto=>/#. by inline*;auto;call(:true);auto. @@ -469,9 +643,12 @@ local module ICORE_eager : Low.FUNCTIONALITY = { + by proc(={glob ICORE_e});auto;proc;sim. + by proc;sim. by call(:true);auto. - by sp;while{2}(={b})(size world{2});auto;1:(sp;if);auto; - smt(bdistr_ll head_behead size_eq0 size_ge0). - + sp;while{2}(={b})(size world{2});auto;2:smt(size_eq0 size_ge0). + while(b = b{m0} /\ size (behead world) < z)(n+1-i); + first progress;sp;if;auto;smt(bdistr_ll head_behead size_eq0 size_ge0). + wp;while(b = b{m0} /\ size (behead world) < z)(size p-i); + first progress;sp;if;auto;smt(bdistr_ll head_behead size_eq0 size_ge0). + auto;smt(head_behead). replace{2} { all; <@ } by { all; @@ -480,9 +657,8 @@ local module ICORE_eager : Low.FUNCTIONALITY = { b <- ICORE_eager.dist_res; } (={glob D, glob S} ==> ={b}) - (={glob D, glob S} ==> ={b});progress;last first. - + by inline*;rcondf{1}7;auto;2:sim;call(:true);auto. - + by rewrite/#. + (={glob D, glob S} ==> ={b});progress;1:rewrite/#;last first. + + by inline*;rcondf{1}8;auto;2:sim;call(:true);auto. swap{1}-1;sim. @@ -494,328 +670,65 @@ local module ICORE_eager : Low.FUNCTIONALITY = { ={glob S, glob ICORE_eager} ==> ={glob S, glob ICORE_eager}) (={glob S, glob ICORE_eager});auto;progress;1,3,5,7:sim. - + eager proc(H': ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + +eager proc(H': ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : ={glob ICORE_eager} ==> ={glob ICORE_eager}) (={glob ICORE_eager});auto;progress;1,3:sim. - + (* eager : ewhile; ICORE_eager.f ~ ICORE_e.f ; ewhile *) eager proc. - swap{1}2;swap{2}-1;sp;wp. - if{2};1:rcondt{1}2;last first;1:rcondf{1}2;progress;2:sim. - + inline*;sp;while(! (valid p /\ 0 < n));auto;sp;if;auto. - + inline*;sp;while(valid p /\ 0 < n);auto;sp;if;auto. - replace{2} { while as loop1; (<-;while as loop2); eage } by { - loop1; - eage; - loop2; - } - (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} - /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}) - (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} - /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}); - progress;1:rewrite/#. - + sim. - conseq(: ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} - ==> ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); - progress. - eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); - progress;1,3:sim. - swap{2}-1;sim. - inline*. - splitwhile{2}4:world <> [(take i p)]. - sp. swap{1}-4;sp. - seq 1 1: ( ={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} - /\ world{2} = [(take i{2} p{2})] - /\ world{1} = [] - /\ world{2} = rcons world{1} (take i{2} p{2}));last first. - + rcondt{2}1;1:auto=>/#. - by rcondf{2}6;auto;sp;if;auto. - while(={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} - /\ world{2} = rcons world{1} (take i{2} p{2}));last auto=>/#. - by sp;if;auto;smt(head_behead). - swap{1}3 -1;seq 2 2 :(={glob ICORE_eager,n,p,r,i});1:sim. - eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); - progress;1,3:sim. - inline ICORE_eager.ewhile. - swap{2}[4..6]-2;sim;swap{2}2;sp. - symmetry;conseq(: ={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress. - replace{1} { all } by { b <- b0; all; } - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;1:sim. - replace{2} { all } by { b <- b0; all; } - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;2:sim. - sp;conseq(: ={world,ICORE.m,p,i,b} ==> ={world,ICORE.m,p,i,b});progress. - eager while(J: b <@ ICORE.fill_in(p,i); ~ b <@ ICORE.fill_in(p,i); : - ={world, p, ICORE.m, i, b} ==> ={world, p, ICORE.m, i, b}); - progress;1,3:sim. - inline*;sp;wp. - swap{1}[3..5]-2;swap{2}[3..4]-2;sp. - case(((p0,n0)=(p1,n1)){1})=>//=. - - if;auto;1:rcondf{1}3;1:auto;1:smt(dom_set in_fsetU1). - + by rcondf{2}3;auto;smt(dom_set in_fsetU1). - by sp;if;auto. - if{2};last first;2:rcondt{1}3;1:rcondf{1}3;progress. - + if;auto;smt(dom_set in_fsetU1). - + sp;if;auto;smt(dom_set in_fsetU1). - + sp;if;auto;smt(dom_set in_fsetU1). - if{1};last first;2:rcondt{2}3;1:rcondf{2}3;progress. - + auto;smt(dom_set in_fsetU1). - + auto;smt(dom_set getP in_fsetU1). - + auto;smt(dom_set in_fsetU1). - swap{2}-1;wp;conseq(:_==> ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p1{2}, n1{2})]);progress. - alias{1} 1 c = b0. - transitivity{1} { - b <$ bdistr; - c <$ bdistr; - ICORE.m.[(p0, n0)] <- b; - ICORE.m.[(p1, n1)] <- c; + replace{1} { <@ as ewhile; rest } by { + ewhile; + result <@ ICORE_eager.f(p,n); } - (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p0{2}, n0{2})]) - (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} - /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); - progress;1:rewrite/#. - + swap{2}3-1;wp;rnd=>/=. - wp 2 2;conseq(:_==> ={ICORE.m});1:smt(getP). - by wp;rnd;auto. - transitivity{1} { - b <$ bdistr; - c <$ bdistr; - ICORE.m.[(p1, n1)] <- b; - ICORE.m.[(p0, n0)] <- c; + (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}) + (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}); + progress;1:rewrite/#;1:(inline*;sim). + replace{2} { rest; (<@ as ewhile) } by { + result <@ ICORE_e.f(p,n); + ewhile; } - (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m,p0,p1,n0,n1}) - (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} - /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); - progress;1:rewrite/#. - + swap{1}1;wp;conseq(:_==> (b,c){1} = (c,b){2});progress;2:(rnd;rnd;auto). - by rewrite set_set H0. - by swap{1}3-1;wp;rnd;wp;rnd;auto. - - + eager proc(H': ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}) + (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}); + progress;1:rewrite/#;2:(inline*;sim). + + by eager call(eager_ICORE_e_f);auto. + + + +eager proc(H': ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : ={glob ICORE_eager} ==> ={glob ICORE_eager}) (={glob ICORE_eager});auto;progress;1,3:sim. + + (* eager : ewhile; ICORE_eager.f ~ ICORE_e.f ; ewhile *) eager proc. - swap{1}2;swap{2}-1;sp;wp. - if{2};1:rcondt{1}2;last first;1:rcondf{1}2;progress;2:sim. - + inline*;sp;while(! (valid p /\ 0 < n));auto;sp;if;auto. - + inline*;sp;while(valid p /\ 0 < n);auto;sp;if;auto. - replace{2} { while as loop1; (<-;while as loop2); eage } by { - loop1; - eage; - loop2; + replace{1} { <@ as ewhile; rest } by { + ewhile; + result <@ ICORE_eager.f(p,n); } - (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} - /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}) - (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} - /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}); - progress;1:rewrite/#. - + sim. - conseq(: ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} - ==> ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); - progress. - eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); - progress;1,3:sim. - swap{2}-1;sim. - inline*. - splitwhile{2}4:world <> [(take i p)]. - sp. swap{1}-4;sp. - seq 1 1: ( ={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} - /\ world{2} = [(take i{2} p{2})] - /\ world{1} = [] - /\ world{2} = rcons world{1} (take i{2} p{2}));last first. - + rcondt{2}1;1:auto=>/#. - by rcondf{2}6;auto;sp;if;auto. - while(={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} - /\ world{2} = rcons world{1} (take i{2} p{2}));last auto=>/#. - by sp;if;auto;smt(head_behead). - swap{1}3 -1;seq 2 2 :(={glob ICORE_eager,n,p,r,i});1:sim. - eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); - progress;1,3:sim. - inline ICORE_eager.ewhile. - swap{2}[4..6]-2;sim;swap{2}2;sp. - symmetry;conseq(: ={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress. - replace{1} { all } by { b <- b0; all; } - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;1:sim. - replace{2} { all } by { b <- b0; all; } - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;2:sim. - sp;conseq(: ={world,ICORE.m,p,i,b} ==> ={world,ICORE.m,p,i,b});progress. - eager while(J: b <@ ICORE.fill_in(p,i); ~ b <@ ICORE.fill_in(p,i); : - ={world, p, ICORE.m, i, b} ==> ={world, p, ICORE.m, i, b}); - progress;1,3:sim. - inline*;sp;wp. - swap{1}[3..5]-2;swap{2}[3..4]-2;sp. - case(((p0,n0)=(p1,n1)){1})=>//=. - - if;auto;1:rcondf{1}3;1:auto;1:smt(dom_set in_fsetU1). - + by rcondf{2}3;auto;smt(dom_set in_fsetU1). - by sp;if;auto. - if{2};last first;2:rcondt{1}3;1:rcondf{1}3;progress. - + if;auto;smt(dom_set in_fsetU1). - + sp;if;auto;smt(dom_set in_fsetU1). - + sp;if;auto;smt(dom_set in_fsetU1). - if{1};last first;2:rcondt{2}3;1:rcondf{2}3;progress. - + auto;smt(dom_set in_fsetU1). - + auto;smt(dom_set getP in_fsetU1). - + auto;smt(dom_set in_fsetU1). - swap{2}-1;wp;conseq(:_==> ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p1{2}, n1{2})]);progress. - alias{1} 1 c = b0. - transitivity{1} { - b <$ bdistr; - c <$ bdistr; - ICORE.m.[(p0, n0)] <- b; - ICORE.m.[(p1, n1)] <- c; + (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}) + (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}); + progress;1:rewrite/#;1:(inline*;sim). + replace{2} { rest; (<@ as ewhile) } by { + result <@ ICORE_e.f(p,n); + ewhile; } - (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p0{2}, n0{2})]) - (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} - /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); - progress;1:rewrite/#. - + swap{2}3-1;wp;rnd=>/=. - wp 2 2;conseq(:_==> ={ICORE.m});1:smt(getP). - by wp;rnd;auto. - transitivity{1} { - b <$ bdistr; - c <$ bdistr; - ICORE.m.[(p1, n1)] <- b; - ICORE.m.[(p0, n0)] <- c; - } - (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m,p0,p1,n0,n1}) - (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} - /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); - progress;1:rewrite/#. - + swap{1}1;wp;conseq(:_==> (b,c){1} = (c,b){2});progress;2:(rnd;rnd;auto). - by rewrite set_set H0. - by swap{1}3-1;wp;rnd;wp;rnd;auto. + (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}) + (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}); + progress;1:rewrite/#;2:(inline*;sim). + + by eager call(eager_ICORE_e_f);auto. eager proc. swap{1}3;sp;swap{2}-1;sim. if{2};last first;2:rcondt{1}2;1:rcondf{1}2;progress;2:sim. - + by inline*;sp;while(! (valid x /\ 0 < n));auto;1:(sp;if);auto=>/#. - + by inline*;sp;while( valid x /\ 0 < n );auto;1:(sp;if);auto=>/#. + + inline*;sp;while(! (valid x /\ 0 < n));auto;2:rewrite/#. + while(! (valid x /\ 0 < n));1:(sp;if);auto. + while(! (valid x /\ 0 < n));1:(sp;if);auto. + + inline*;sp;while( (valid x /\ 0 < n));auto;2:rewrite/#. + while( (valid x /\ 0 < n));1:(sp;if);auto. + while( (valid x /\ 0 < n));1:(sp;if);auto. swap{2}-1;sim. - eager call(: ={p, n, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m} - ==> ={res, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}). - - (* eager : ewhile; ICORE_eager.f ~ ICORE_e.f ; ewhile *) - eager proc. - swap{1}2;swap{2}-1;sp;wp. - if{2};1:rcondt{1}2;last first;1:rcondf{1}2;progress;2:sim. - + inline*;sp;while(! (valid p /\ 0 < n));auto;sp;if;auto. - + inline*;sp;while(valid p /\ 0 < n);auto;sp;if;auto. - replace{2} { while as loop1; (<-;while as loop2); eage } by { - loop1; - eage; - loop2; - } - (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} - /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}) - (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} - /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}); - progress;1:rewrite/#. - + sim. - conseq(: ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} - ==> ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); - progress. - eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); - progress;1,3:sim. - swap{2}-1;sim. - inline*. - splitwhile{2}4:world <> [(take i p)]. - sp. swap{1}-4;sp. - seq 1 1: ( ={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} - /\ world{2} = [(take i{2} p{2})] - /\ world{1} = [] - /\ world{2} = rcons world{1} (take i{2} p{2}));last first. - + rcondt{2}1;1:auto=>/#. - by rcondf{2}6;auto;sp;if;auto. - while(={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} - /\ world{2} = rcons world{1} (take i{2} p{2}));last auto=>/#. - by sp;if;auto;smt(head_behead). - swap{1}3 -1;seq 2 2 :(={glob ICORE_eager,n,p,r,i});1:sim. - eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); - progress;1,3:sim. - inline ICORE_eager.ewhile. - swap{2}[4..6]-2;sim;swap{2}2;sp. - symmetry;conseq(: ={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress. - replace{1} { all } by { b <- b0; all; } - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;1:sim. - replace{2} { all } by { b <- b0; all; } - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;2:sim. - sp;conseq(: ={world,ICORE.m,p,i,b} ==> ={world,ICORE.m,p,i,b});progress. - eager while(J: b <@ ICORE.fill_in(p,i); ~ b <@ ICORE.fill_in(p,i); : - ={world, p, ICORE.m, i, b} ==> ={world, p, ICORE.m, i, b}); - progress;1,3:sim. - inline*;sp;wp. - swap{1}[3..5]-2;swap{2}[3..4]-2;sp. - case(((p0,n0)=(p1,n1)){1})=>//=. - - if;auto;1:rcondf{1}3;1:auto;1:smt(dom_set in_fsetU1). - + by rcondf{2}3;auto;smt(dom_set in_fsetU1). - by sp;if;auto. - if{2};last first;2:rcondt{1}3;1:rcondf{1}3;progress. - + if;auto;smt(dom_set in_fsetU1). - + sp;if;auto;smt(dom_set in_fsetU1). - + sp;if;auto;smt(dom_set in_fsetU1). - if{1};last first;2:rcondt{2}3;1:rcondf{2}3;progress. - + auto;smt(dom_set in_fsetU1). - + auto;smt(dom_set getP in_fsetU1). - + auto;smt(dom_set in_fsetU1). - swap{2}-1;wp;conseq(:_==> ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p1{2}, n1{2})]);progress. - alias{1} 1 c = b0. - transitivity{1} { - b <$ bdistr; - c <$ bdistr; - ICORE.m.[(p0, n0)] <- b; - ICORE.m.[(p1, n1)] <- c; - } - (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p0{2}, n0{2})]) - (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} - /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); - progress;1:rewrite/#. - + swap{2}3-1;wp;rnd=>/=. - wp 2 2;conseq(:_==> ={ICORE.m});1:smt(getP). - by wp;rnd;auto. - transitivity{1} { - b <$ bdistr; - c <$ bdistr; - ICORE.m.[(p1, n1)] <- b; - ICORE.m.[(p0, n0)] <- c; - } - (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m,p0,p1,n0,n1}) - (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} - /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); - progress;1:rewrite/#. - + swap{1}1;wp;conseq(:_==> (b,c){1} = (c,b){2});progress;2:(rnd;rnd;auto). - by rewrite set_set H0. - by swap{1}3-1;wp;rnd;wp;rnd;auto. - - by auto;progress=>/#. + eager call(eager_ICORE_e_f). + auto=>/#. qed. lemma LiftInd &m: @@ -875,11 +788,11 @@ local module ICORE_eager : Low.FUNCTIONALITY = { cut->/=:i{1} - 1 < n{2} - 1 by rewrite/#. by rewrite BlockMonoid.addr0. - by inline*;auto;call(:true);auto. print HiSim. print ICORE. + by inline*;auto;call(:true);auto. (* TODO : Introduce an equivalent module to ICORE whose fill_in procedure makes the same calls as IBlockSponge *) - (* rewrite (eager_ICORE &m). *) + rewrite (eager_ICORE &m). byequiv (_: ={glob D, glob S} ==> _)=> //=; proc. call (_: ={glob S} /\ INV IBlockSponge.m{2} ICORE.m{1}). @@ -894,8 +807,37 @@ local module ICORE_eager : Low.FUNCTIONALITY = { /\ valid p{1} /\ 0 < n{1});last auto=>/#. rcondt{2}6;auto;progress. + by cut:=parseK p{hr} (i{hr}+1) H0 H1;rewrite/format-addzA/==>->/=. - + by cut:=parseK p{hr} (i{hr}+1) H0 H1;rewrite/format-addzA/==>->/=. + + by cut:=parseK p{hr} (i{hr}+1) H0 H1;rewrite/format-addzA/==>->/=. sp. + conseq(:_==> (INV IBlockSponge.m{2} ICORE.m{1} /\ + rcons r{1} (oget ICORE.m{1}.[(p3{1}, n3{1})]) = + rcons r{2} (oget IBlockSponge.m{2}.[x1{2}])));1:progress=>/#. + seq 3 1:(x{2} = format p0{1} n0{1} /\ INV IBlockSponge.m{2} ICORE.m{1} + /\ valid p0{1} /\ 0 < n0{1} /\ ={r});last first. + sp;if;auto;smt(in_dom parseK getP formatK). + + splitwhile{2}1:i0 < size p. + conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1});1:smt(parseK). + while(INV IBlockSponge.m{2} ICORE.m{1} + /\ valid p0{1} + /\ 0 < i0{1} + /\ 0 < n0{1} + /\ i0{1} = i0{2} - size p0{1} + 1 + /\ format p0{1} i0{1} = take i0{2} x{2} + /\ x{2} = format p0{1} n0{1});auto. + + sp;if;auto;smt(parseK formatK in_dom getP take_cat size_cat + size_nseq take_nseq). + conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ + i0{2} = size p0{1});1:smt(parseK formatK take_cat nseq0 cats0 take0 size_cat size_nseq). + while(={i0} /\ 0 < i0{1} <= size p0{1} /\ p0{1} = p{2} /\ + valid p0{1} /\ 0 < n0{1} /\ + x{2} = format p0{1} n0{1} /\ INV IBlockSponge.m{2} ICORE.m{1});auto. + + sp;if;auto;progress. move:H7;rewrite 2!in_dom take_cat H6/=H3. smt(in_dom take_cat nseq0 cats0). rewrite in_dom/=H3. +smt(in_dom take_cat parseK formatK). + + + + sp;sim. conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ x1{2} = x{2} /\ );1:progress. rewrite/#. congr;congr;rewrite H6 -H;congr;congr;2:rewrite/#. From da638112bd98688448aa7917c3118b7e2816f7c6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Mon, 8 Jan 2018 17:02:39 +0100 Subject: [PATCH 247/394] updated existing proof to the last version of EasyCrypt and finish the proof in clean/BlockSponge.eca Now we need a trick for the counters. --- sha3/proof/clean/BlockSponge.eca | 877 +++++-------------------------- sha3/proof/core/ConcreteF.eca | 37 +- sha3/proof/core/Gcol.eca | 8 +- sha3/proof/core/Gconcl.ec | 11 +- sha3/proof/core/Gext.eca | 22 +- sha3/proof/core/Handle.eca | 57 +- sha3/proof/core/SLCommon.ec | 17 +- sha3/proof/core/Utils.ec | 3 +- 8 files changed, 218 insertions(+), 814 deletions(-) diff --git a/sha3/proof/clean/BlockSponge.eca b/sha3/proof/clean/BlockSponge.eca index 67e2782..80675ae 100644 --- a/sha3/proof/clean/BlockSponge.eca +++ b/sha3/proof/clean/BlockSponge.eca @@ -10,8 +10,6 @@ require import NewCommon. (** Validity of Functionality Queries **) op valid: block list -> bool. axiom valid_spec p: valid p => p <> []. -(* FIXME : verify if this axiom is correct. *) -axiom valid_take p i: valid p => 0 < i => valid (take i p). (** Validity and Parsing/Formatting of Functionality Queries **) op format (p : block list) (n : int) = p ++ nseq (n - 1) b0. @@ -93,34 +91,18 @@ module IBlockSponge : FUNCTIONALITY = { } proc f(x : block list) = { - var b,bs <- b0; - var i <- 1; + var bs <- b0; + var i <- 0; var (p,n) <- parse x; - if (valid p /\ 0 < n) { - while (i < size x) { - b <@ fill_in(take i x); + while (i < n) { + fill_in(take (size p + i) x); i <- i + 1; } bs <@ fill_in(x); } - (* bs <- []; *) - (* if (valid x /\ 0 < n) { *) - (* (* while (i < size x) { *) *) - (* (* b <@ fill_in(take i x,1); *) *) - (* (* i <- i + 1; *) *) - (* (* } *) *) - (* (* i <- 1; *) *) - (* b <@ fill_in(x, 1); *) - (* bs <- rcons bs b; *) - (* while (i < n) { *) - (* i <- i + 1; *) - (* b <@ fill_in(x, i); *) - (* bs <- rcons bs b; *) - (* } *) - (* } *) return bs; } }. @@ -187,549 +169,6 @@ section PROOF. declare module P : PRIMITIVE { Low.ICORE, IBlockSponge, HiSim }. declare module S : Low.SIMULATOR { Low.ICORE, IBlockSponge, HiSim, P }. declare module D : DISTINGUISHER { Low.ICORE, IBlockSponge, HiSim, P, S }. -print ICORE. - -local module ICORE_eager : Low.FUNCTIONALITY = { - var order : block list list - var dist_res : bool - - proc init() : unit = { - order <- []; - dist_res <- false; - ICORE.init(); - } - - proc fill_in (x : block list) = { - var i <- 1; - var c; - var (p,n) <- parse x; - - while (i < size p) { - ICORE.fill_in(parse(take i p)); - i <- i + 1; - } - i <- 1; - while (i < n) { - ICORE.fill_in(p, i); - i <- i + 1; - } - c <@ ICORE.fill_in(parse(format p n)); - order <- rcons order x; - return c; - } - - proc f(p : block list, n : int) : block list = { - var r : block list; - var i : int <- 1; - var b : block; - - r <- []; - if (valid p /\ 0 < n) { - while (i <= n) { - b <@ fill_in(format p i); - r <- rcons r b; - i <- i + 1; - } - } - return r; - } - proc ewhile() : unit = { - var world <- order; - var i <- 1; - var (p,n); - - var y <- []; - - while(world <> []) { - y <- head ([]) world; - i <- 1; - (p,n) <- parse y; - while (i < size p) { - ICORE.fill_in(parse(take i p)); - i <- i + 1; - } - i <- 1; - while (i < n) { - ICORE.fill_in(parse(format p i)); - i <- i + 1; - } - world <- behead world; - } - } - }. - - local module ICORE_e : Low.FUNCTIONALITY = { - proc init = ICORE_eager.init - - - proc fill_in (x : block list) = { - var c; - var (p,n) <- parse x; - - c <@ ICORE.fill_in(p,n); - ICORE_eager.order <- rcons ICORE_eager.order (x); - return c; - } - - - proc f(p : block list, n : int) : block list = { - var r : block list; - var i : int <- 1; - var b : block; - - r <- []; - if (valid p /\ 0 < n) { - while (i <= n) { - b <@ fill_in(format p i); - r <- rcons r b; - i <- i + 1; - } - } - return r; - } - }. - - local lemma eager_ICORE_fill_in : - eager[ ICORE_eager.ewhile();, ICORE.fill_in - ~ ICORE.fill_in, ICORE_eager.ewhile(); - : ={arg, ICORE_eager.order, ICORE.m} - ==> - ={res, ICORE_eager.order, ICORE.m}]. - proof. - eager proc. - inline ICORE_eager.ewhile;symmetry. - swap{1}[1..2]2. - replace{1} { all } by { - result <- b0; - all; - } - (={p,n,ICORE_eager.order,ICORE.m} - ==> ={result,ICORE_eager.order,ICORE.m}) - (={p,n,ICORE_eager.order,ICORE.m} - ==> ={result,ICORE_eager.order,ICORE.m}); - progress;1:rewrite/#;1:sim. - replace{2} { all } by { - result <- b0; - all; - } - (={p,n,ICORE_eager.order,ICORE.m} - ==> ={result,ICORE_eager.order,ICORE.m}) - (={p,n,ICORE_eager.order,ICORE.m} - ==> ={result,ICORE_eager.order,ICORE.m}); - progress;1:rewrite/#;2:sim. - sp;swap{1}3-2;sp. - conseq(: ={world, ICORE_eager.order, ICORE.m, p, n, result} - ==> ={world, ICORE_eager.order, ICORE.m, p, n, result});progress. - eager while(J: - if (!((p,n) \in dom ICORE.m)) { - ICORE.m.[(p,n)] <$ bdistr; - } - result <- oget ICORE.m.[(p, n)]; - ~ - if (!((p,n) \in dom ICORE.m)) { - ICORE.m.[(p,n)] <$ bdistr; - } - result <- oget ICORE.m.[(p, n)]; - : - ={world, ICORE_eager.order, ICORE.m, p, n, result} - ==> - ={world, ICORE_eager.order, ICORE.m, p, n, result});progress;1,3:sim. - swap{2}7 2;sim;swap{1}3-2;sp 1 1. - conseq(: ={y,p,n,ICORE.m,ICORE_eager.order} - ==> ={result,ICORE.m,ICORE_eager.order});progress. - - replace{1} { (if;<-); body } by { - result <@ ICORE.fill_in(p,n); - body; - } - (={y,p,n,ICORE.m,ICORE_eager.order} - ==> ={result,ICORE.m,ICORE_eager.order}) - (={y,p,n,ICORE.m,ICORE_eager.order} - ==> ={result,ICORE.m,ICORE_eager.order}); - progress;1:rewrite/#;1:(inline{2}1;sim). - replace{2} { body;(if;<-) } by { - body; - result <@ ICORE.fill_in(p,n); - } - (={y,p,n,ICORE.m,ICORE_eager.order} - ==> ={result,ICORE.m,ICORE_eager.order}) - (={y,p,n,ICORE.m,ICORE_eager.order} - ==> ={result,ICORE.m,ICORE_eager.order}); - progress;1:rewrite/#;2:(inline*;sim). - - replace{2} { begin; (while as loop); (<@ as result) } by { - begin; - result; - loop; - } - (={y,p,n,ICORE.m,ICORE_eager.order} - ==> ={n0,p0,result,ICORE.m,ICORE_eager.order}) - (={y,p,n,ICORE.m,ICORE_eager.order} - ==> ={n0,p0,result,ICORE.m,ICORE_eager.order}); - progress;1:rewrite/#;last first. - - + seq 4 4:(={i,n0,p,p0,n,ICORE_eager.order,ICORE.m});1:sim. - replace{1} { all } by { result <- b0; all; } - (={i, n0, p, p0, n, ICORE_eager.order, ICORE.m} - ==> ={n0,p0,result, ICORE.m, ICORE_eager.order}) - (={i, n0, p, p0, n, ICORE_eager.order, ICORE.m} - ==> ={n0,p0,result, ICORE.m, ICORE_eager.order}); - progress;1:rewrite/#;1:sim. - replace{2} { all } by { result <- b0; all; } - (={i, n0, p, p0, n, ICORE_eager.order, ICORE.m} - ==> ={n0,p0,result, ICORE.m, ICORE_eager.order}) - (={i, n0, p, p0, n, ICORE_eager.order, ICORE.m} - ==> ={n0,p0,result, ICORE.m, ICORE_eager.order}); - progress;1:rewrite/#;2:sim. - sp;conseq(: ={i, n0, p, p0, n, ICORE_eager.order, ICORE.m, result} - ==> _);progress. - eager while(K: - result <@ ICORE.fill_in(p, n); ~ - result <@ ICORE.fill_in(p, n); : - ={i, n0, p, p0, n, ICORE_eager.order, ICORE.m, result} ==> - ={i, n0, p, p0, n, ICORE_eager.order, ICORE.m, result}); - progress;1,3:sim. - swap{2}-1;sim;conseq(:_==> ={result,ICORE.m});progress. - inline *. (* TODO : reprendre d'ici. Il y avait un pb de parse/format. *) - - - case((p, n){1} = (p0, i){1}). - + sp;rcondf{1}5;first auto;if;auto;smt(dom_set in_fsetU1). - by rcondf{2}4;auto;if;auto;smt(dom_set in_fsetU1). - sp;if{1};last first;2:rcondt{2}4;1:rcondf{2}4;progress;2:sim. - + auto;if;auto;smt(dom_set in_fsetU1). - + if{2};last first;2:rcondt{1}4;1:rcondf{1}4;auto;smt(getP). - + auto;if;auto;smt(dom_set in_fsetU1). - if{2};last first;2:rcondt{1}5;1:rcondf{1}5;progress. - + auto;smt(dom_set in_fsetU1). - + auto;smt(getP). - + auto;smt(dom_set in_fsetU1). - conseq(:_==> ={ICORE.m,result});progress. - alias{1} 1 c = b0; - transitivity{1} { - c <$ bdistr; - result <$ bdistr; - ICORE.m.[(p,n)] <- result; - ICORE.m.[(p0,i)] <- c; - } - (={p0,i,p,n,ICORE.m} /\ p1{1} = p{1} /\ n1{1} = n{1} - /\ ! (p{1} = p0{1} && n{1} = i{1}) ==> ={ICORE.m,result}) - (={p0,i,p,n,ICORE.m} /\ p1{2} = p0{2} /\ n1{2} = i{2} - /\ ! (p{1} = p0{1} && n{1} = i{1}) ==> ={ICORE.m,result}); - progress;1:rewrite/#. - + by swap{2}2;wp;rnd;wp;rnd;auto;smt(getP). - transitivity{1} { - c <$ bdistr; - result <$ bdistr; - ICORE.m.[(p,n)] <- result; - ICORE.m.[(p0,i)] <- c; - } - (={p0,i,p,n,ICORE.m} /\ ! (p{1} = p0{1} && n{1} = i{1}) - ==> ={ICORE.m,result}) - (={p0,i,p,n,ICORE.m} /\ p1{2} = p0{2} /\ n1{2} = i{2} - /\ ! (p{1} = p0{1} && n{1} = i{1}) ==> ={ICORE.m,result}); - progress;1:rewrite/#. - + by wp;rnd;rnd;auto;smt(set_set). - by wp;rnd;wp;rnd;auto;progress;smt(set_set getP). - sim;swap{2}-1;sim;swap{1}2;sp. - - conseq(: ={p,n,p0,n0,i,ICORE.m,ICORE_eager.order} - ==> ={result,ICORE_eager.order,ICORE.m});first 2 progress=>/#. - replace{1} { all } by { - result <- b0; - all; - } - (={p,n,p0,i,ICORE_eager.order,ICORE.m} - ==> ={result,ICORE_eager.order,ICORE.m}) - (={p,n,p0,i,ICORE_eager.order,ICORE.m} - ==> ={result,ICORE_eager.order,ICORE.m}); - progress;1:rewrite/#;1:sim. - replace{2} { all } by { - result <- b0; - all; - } - (={p,n,p0,i,ICORE_eager.order,ICORE.m} - ==> ={result,ICORE_eager.order,ICORE.m}) - (={p,n,p0,i,ICORE_eager.order,ICORE.m} - ==> ={result,ICORE_eager.order,ICORE.m}); - progress;1:rewrite/#;2:sim. - sp;conseq(: ={p,n,p0,i,ICORE.m,ICORE_eager.order,result} ==> _); - progress. - eager while(K: - result <@ ICORE.fill_in(p, n); ~ - result <@ ICORE.fill_in(p, n); : - ={p, n, p0, i, ICORE.m, ICORE_eager.order, result} ==> - ={p, n, p0, i, ICORE.m, ICORE_eager.order, result}); - progress;1,3:sim. - - swap{2}-1;sim;conseq(:_==> ={result,ICORE.m});progress. - inline *. - case((p, n){1} = parse (take i p0){1}). - + sp;rcondf{1}4;first auto;if;auto;smt(dom_set in_fsetU1). - by rcondf{2}4;auto;if;auto;smt(dom_set in_fsetU1). - sp;if{1};last first;2:rcondt{2}4;1:rcondf{2}4;progress;2:sim. - + auto;if;auto;smt(dom_set in_fsetU1). - + if{2};last first;2:rcondt{1}3;1:rcondf{1}3;auto;smt(getP). - + auto;if;auto;smt(dom_set in_fsetU1). - if{2};last first;2:rcondt{1}4;1:rcondf{1}4;progress. - + auto;smt(dom_set in_fsetU1). - + auto;smt(getP). - + auto;smt(dom_set in_fsetU1). - conseq(:_==> ={ICORE.m,result});progress. - alias{1} 1 c = b0. - transitivity{1} { - c <$ bdistr; - result <$ bdistr; - ICORE.m.[(p,n)] <- result; - ICORE.m.[parse(take i p0)] <- c; - } - (={p0,i,p,n,ICORE.m} /\ p1{1} = p{1} /\ n1{1} = n{1} - /\ (p1{1},n1{1}) <> parse (take i{1} p0{1}) ==> ={ICORE.m,result}) - (={p0,i,p,n,ICORE.m} /\ (p1{2},n1{2}) = parse(take i{1} p0{2}) - /\ (p1{1},n1{1}) <> parse (take i{1} p0{1}) ==> ={ICORE.m,result}); - progress;1:rewrite/#. - + by swap{2}2;wp;rnd;wp;rnd;auto;smt(getP). - transitivity{1} { - c <$ bdistr; - result <$ bdistr; - ICORE.m.[(p,n)] <- result; - ICORE.m.[parse(take i p0)] <- c; - } - (={p0,i,p,n,ICORE.m} /\ (p1{1},n1{1}) <> parse (take i{1} p0{1}) - ==> ={ICORE.m,result}) - (={p0,i,p,n,ICORE.m} /\ (p1{2},n1{2}) = parse(take i{1} p0{2}) - /\ (p1{1},n1{1}) <> parse (take i{1} p0{1}) ==> ={ICORE.m,result}); - progress;1:rewrite/#. - + by wp;rnd;rnd;auto;smt(set_set). - wp;rnd;wp;rnd;auto;progress. smt(set_set getP). - - qed. - - - local lemma eager_ICORE_e_f : - eager[ ICORE_eager.ewhile();, ICORE_eager.f - ~ ICORE_e.f, ICORE_eager.ewhile(); : - ={p, n} /\ ={ICORE_eager.dist_res, ICORE_eager.order, ICORE.m} - ==> - ={res, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}]. - proof. - eager proc. - swap{1}2;swap{2}-1;sp;wp. - if{2};1:rcondt{1}2;last first;1:rcondf{1}2;progress;2:sim. - + inline*;sp;while(! (valid p /\ 0 < n));auto. - sp;seq 1 : (! (valid p /\ 0 < n));1:by while(! (valid p /\ 0 < n));auto;sp;if;auto. - by sp;seq 1 : (! (valid p /\ 0 < n));1:while(! (valid p /\ 0 < n));auto;sp;if;auto. - + inline*;sp;while( (valid p /\ 0 < n));auto. - sp;seq 1 : ( (valid p /\ 0 < n));1:by while( (valid p /\ 0 < n));auto;sp;if;auto. - by sp;seq 1 : ( (valid p /\ 0 < n));1:while( (valid p /\ 0 < n));auto;sp;if;auto. - conseq(: ={p, n, glob ICORE_eager, i, r} ==> - ={p, n, glob ICORE_eager, i, r});progress. - - eager while(J : - ICORE_eager.ewhile(); ~ - ICORE_eager.ewhile(); : - ={p, n, glob ICORE_eager, i, r} ==> - ={p, n, glob ICORE_eager, i, r}); - progress;1,3:sim. - swap{2}-1;wp 3 3. - swap{2}-1;sim. - conseq(:_==> ={p, n, b, glob ICORE_eager});progress. - inline{2}1. - swap{2}3 1;swap{2}-1. - replace{2} { (<@ as fill_in);(<@ as ewhile) } by { - ewhile; - fill_in; - } - (={i, r, p, n, glob ICORE_eager} ==> ={b, p, n, glob ICORE_eager}) - (={i, r, p, n, glob ICORE_eager} ==> ={b, p, n, glob ICORE_eager}); - progress;1:rewrite/#;last first. - + sim;conseq(:_==> ={ICORE_eager.order, ICORE.m,c});progress. - seq 3 3:(={p0,n0,ICORE_eager.order, ICORE.m});1:sim. - by eager call(eager_ICORE_fill_in);auto. - inline{1}2;sim;swap{1}-1;sim. - - inline{2}4. - splitwhile{2}7: 1 < size world. - rcondt{2}8;progress. - + sp;while(last (head [] (behead world)) world = format p i /\ 1 <= size world); - auto;last smt(last_rcons size_rcons size_ge0 size_eq0). - inline*=>//=. - sp;seq 1 : (last (head [] (behead world)) (behead world) = format p i - /\ 1 <= size (behead world)). - + while(last (head [] (behead world)) (behead world) = format p i - /\ 1 <= size (behead world));auto. - + by sp;if;auto. - by progress;smt(head_behead). - sp;seq 1 : (last (head [] (behead world)) (behead world) = format p i - /\ 1 <= size (behead world)). - + while(last (head [] (behead world)) (behead world) = format p i - /\ 1 <= size (behead world));auto. - by sp;if;auto. - by auto;progress;smt(head_behead). - rcondf{2}15;progress. - + seq 8 : (world = [format p i]). - + wp;sp;while(last (head [] world) world = format p i /\ 1 <= size world); - auto;last first. - + smt(last_rcons size_rcons size_ge0 head_behead size_eq0). - inline*=>//=. - sp;seq 1 : (last (head [] world) (behead world) = format p i - /\ 1 <= size (behead world)). - + while(last (head [] world) (behead world) = format p i - /\ 1 <= size (behead world));auto. - + by sp;if;auto. - by progress;smt(head_behead). - sp;seq 1 : (last (head [] world) (behead world) = format p i - /\ 1 <= size (behead world)). - + while(last (head [] world) (behead world) = format p i - /\ 1 <= size (behead world));auto. - by sp;if;auto. - by auto;progress;smt(head_behead). - inline*=>/=. - sp;seq 1:(world = [format p i]);1:while(world = [format p i]);1:(sp;if);auto. - by sp;seq 1:(world = [format p i]);1:while(world = [format p i]);1:(sp;if);auto. - - swap{1}-3;sim. - inline*;sim;swap{1}[5..8]-1;wp;sp=>/=. - conseq(:_==> ={ICORE.m,ICORE_eager.order} - /\ world{1} = [] /\ world{2} = [format p{2} i{2}]); - 1:smt(parseK). - - while(={ICORE.m} /\ world{2} = rcons world{1} (format p{2} i{2})); - auto;last smt(size_eq0 size_rcons size_ge0). - rewrite/=. - sp;conseq(:_==> ={ICORE.m}); - 1:smt(head_behead size_eq0 size_rcons size_ge0);sim. - smt(head_behead). - qed. - - local lemma eager_ICORE &m : - Pr[Low.Indif(ICORE, S(ICORE), LoDist(D)).main() @ &m : res] = - Pr[Low.Indif(ICORE_eager, S(ICORE_eager), LoDist(D)).main() @ &m : res]. - - proof. - cut->:Pr[Low.Indif(ICORE, S(ICORE), LoDist(D)).main() @ &m : res] = - Pr[Low.Indif(ICORE_e, S(ICORE_e), LoDist(D)).main() @ &m : res]. - + byequiv (_: ={glob D, glob S} ==> _ )=> //=; proc. - call(: ={glob S,glob ICORE})=>//=;auto. - + proc(={glob ICORE});auto;proc. - sp;if;auto;sp;inline*. - while(={ICORE.m,r,i,p,n} /\ valid p{1} /\ 0 < n{1} /\ 0 < i{1})=>//=;1:auto. - sp;if;auto;smt(parseK). - + proc(={glob ICORE});auto;proc. - sp;if;auto;sp;inline*. - while(={ICORE.m,r,i,p,n} /\ valid p{1} /\ 0 < n{1} /\ 0 < i{1})=>//=;1:auto. - sp;if;auto;smt(parseK). - + proc;inline*;sp;if;auto;1:progress=>/#;sp. - sp;if;1:auto=>/#;sp;inline*. - while(={ICORE.m,r0,i,p0,n0} /\ valid p0{1} /\ 0 < n0{1} /\ 0 < i{1})=>//=;1:auto. - sp;if;auto;smt(parseK). - + by auto=>/#. - + by auto=>/#. - by inline*;auto;call(:true);auto. - - byequiv (_: ={glob D, glob S} ==> _ )=> //=; proc. - replace{1} { all; <@ } by { - all; - ICORE_eager.dist_res <@ LoDist(D, ICORE_e, S(ICORE_e)).distinguish(); - b <- ICORE_eager.dist_res; - ICORE_eager.ewhile(); - } - (={glob D, glob S} ==> ={b}) - (={glob D, glob S} ==> ={b});progress. - + rewrite/#. - + seq 3 4 : (={b});inline*;auto. - - call(: ={glob S,glob ICORE_e});auto. - + by proc(={glob ICORE_e});auto;proc;sim. - + by proc(={glob ICORE_e});auto;proc;sim. - + by proc;sim. - by call(:true);auto. - sp;while{2}(={b})(size world{2});auto;2:smt(size_eq0 size_ge0). - while(b = b{m0} /\ size (behead world) < z)(n+1-i); - first progress;sp;if;auto;smt(bdistr_ll head_behead size_eq0 size_ge0). - wp;while(b = b{m0} /\ size (behead world) < z)(size p-i); - first progress;sp;if;auto;smt(bdistr_ll head_behead size_eq0 size_ge0). - auto;smt(head_behead). - - replace{2} { all; <@ } by { - all; - ICORE_eager.ewhile(); - ICORE_eager.dist_res <@ LoDist(D, ICORE_eager, S(ICORE_eager)).distinguish(); - b <- ICORE_eager.dist_res; - } - (={glob D, glob S} ==> ={b}) - (={glob D, glob S} ==> ={b});progress;1:rewrite/#;last first. - + by inline*;rcondf{1}8;auto;2:sim;call(:true);auto. - - swap{1}-1;sim. - - symmetry;seq 2 2 : (={glob S,glob D,glob ICORE_eager});1:sim;progress. - - eager call(: ={arg, glob D, glob S,glob ICORE_eager} ==> - ={res, glob D, glob S,glob ICORE_eager} );auto. - eager proc(H : ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : - ={glob S, glob ICORE_eager} ==> ={glob S, glob ICORE_eager}) - (={glob S, glob ICORE_eager});auto;progress;1,3,5,7:sim. - - +eager proc(H': ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : - ={glob ICORE_eager} ==> ={glob ICORE_eager}) - (={glob ICORE_eager});auto;progress;1,3:sim. - - (* eager : ewhile; ICORE_eager.f ~ ICORE_e.f ; ewhile *) - eager proc. - replace{1} { <@ as ewhile; rest } by { - ewhile; - result <@ ICORE_eager.f(p,n); - } - (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}) - (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}); - progress;1:rewrite/#;1:(inline*;sim). - replace{2} { rest; (<@ as ewhile) } by { - result <@ ICORE_e.f(p,n); - ewhile; - } - (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}) - (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}); - progress;1:rewrite/#;2:(inline*;sim). - - by eager call(eager_ICORE_e_f);auto. - - - +eager proc(H': ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : - ={glob ICORE_eager} ==> ={glob ICORE_eager}) - (={glob ICORE_eager});auto;progress;1,3:sim. - - (* eager : ewhile; ICORE_eager.f ~ ICORE_e.f ; ewhile *) - eager proc. - replace{1} { <@ as ewhile; rest } by { - ewhile; - result <@ ICORE_eager.f(p,n); - } - (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}) - (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}); - progress;1:rewrite/#;1:(inline*;sim). - replace{2} { rest; (<@ as ewhile) } by { - result <@ ICORE_e.f(p,n); - ewhile; - } - (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}) - (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}); - progress;1:rewrite/#;2:(inline*;sim). - - by eager call(eager_ICORE_e_f);auto. - - eager proc. - swap{1}3;sp;swap{2}-1;sim. - if{2};last first;2:rcondt{1}2;1:rcondf{1}2;progress;2:sim. - + inline*;sp;while(! (valid x /\ 0 < n));auto;2:rewrite/#. - while(! (valid x /\ 0 < n));1:(sp;if);auto. - while(! (valid x /\ 0 < n));1:(sp;if);auto. - + inline*;sp;while( (valid x /\ 0 < n));auto;2:rewrite/#. - while( (valid x /\ 0 < n));1:(sp;if);auto. - while( (valid x /\ 0 < n));1:(sp;if);auto. - swap{2}-1;sim. - eager call(eager_ICORE_e_f). - auto=>/#. - qed. lemma LiftInd &m: `| Pr[Low.Indif(CORE(P),P,LoDist(D)).main() @ &m: res] @@ -790,184 +229,148 @@ local module ICORE_eager : Low.FUNCTIONALITY = { by inline*;auto;call(:true);auto. - (* TODO : Introduce an equivalent module to ICORE whose fill_in procedure - makes the same calls as IBlockSponge *) - rewrite (eager_ICORE &m). byequiv (_: ={glob D, glob S} ==> _)=> //=; proc. - call (_: ={glob S} /\ INV IBlockSponge.m{2} ICORE.m{1}). + proc (INV IBlockSponge.m{2} ICORE.m{1})=> //. proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. inline{2} 1.1. inline*. while( INV IBlockSponge.m{2} ICORE.m{1} - /\ i{1} = i{2} + 1 - /\ 0 < i{1} - /\ ={n,p,r} - /\ valid p{1} /\ 0 < n{1});last auto=>/#. - rcondt{2}6;auto;progress. - + by cut:=parseK p{hr} (i{hr}+1) H0 H1;rewrite/format-addzA/==>->/=. - + by cut:=parseK p{hr} (i{hr}+1) H0 H1;rewrite/format-addzA/==>->/=. - sp. - conseq(:_==> (INV IBlockSponge.m{2} ICORE.m{1} /\ - rcons r{1} (oget ICORE.m{1}.[(p3{1}, n3{1})]) = - rcons r{2} (oget IBlockSponge.m{2}.[x1{2}])));1:progress=>/#. - seq 3 1:(x{2} = format p0{1} n0{1} /\ INV IBlockSponge.m{2} ICORE.m{1} - /\ valid p0{1} /\ 0 < n0{1} /\ ={r});last first. - sp;if;auto;smt(in_dom parseK getP formatK). - - splitwhile{2}1:i0 < size p. - conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1});1:smt(parseK). - while(INV IBlockSponge.m{2} ICORE.m{1} - /\ valid p0{1} - /\ 0 < i0{1} - /\ 0 < n0{1} - /\ i0{1} = i0{2} - size p0{1} + 1 - /\ format p0{1} i0{1} = take i0{2} x{2} - /\ x{2} = format p0{1} n0{1});auto. - + sp;if;auto;smt(parseK formatK in_dom getP take_cat size_cat - size_nseq take_nseq). - conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ - i0{2} = size p0{1});1:smt(parseK formatK take_cat nseq0 cats0 take0 size_cat size_nseq). - while(={i0} /\ 0 < i0{1} <= size p0{1} /\ p0{1} = p{2} /\ - valid p0{1} /\ 0 < n0{1} /\ - x{2} = format p0{1} n0{1} /\ INV IBlockSponge.m{2} ICORE.m{1});auto. - + sp;if;auto;progress. move:H7;rewrite 2!in_dom take_cat H6/=H3. smt(in_dom take_cat nseq0 cats0). rewrite in_dom/=H3. -smt(in_dom take_cat parseK formatK). - - - - sp;sim. - conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ x1{2} = x{2} /\ );1:progress. - rewrite/#. - congr;congr;rewrite H6 -H;congr;congr;2:rewrite/#. - rewrite/#. - rewrite/#. - rewrite/#. - rewrite/#. - rewrite/#. - rewrite/#. - /\ ={r - - rcondt{1}1;1:auto=>/#. - conseq(:_ ==> r{1} = bs{2} /\ ICORE.m{1} = IBlockSponge.m{2});progress. - by while( i{1} = i0{2} + 1 /\ n{1} = n0{2} /\ x{2} = p{1} - /\ ICORE.m{1} = IBlockSponge.m{2} /\ r{1} = bs{2});sp;if;auto=>/#. - - + proc(={m}(ICORE,IBlockSponge))=>//=. - proc;inline*;sp;if;auto;sp;rcondt{2}1;auto;sp. - rcondt{1}1;1:auto=>/#;sp. - conseq(:_ ==> r{1} = bs{2} /\ ICORE.m{1} = IBlockSponge.m{2});progress. - by while( i{1} = i0{2} + 1 /\ n{1} = n0{2} /\ x{2} = p{1} - /\ ICORE.m{1} = IBlockSponge.m{2} /\ r{1} = bs{2});sp;if;auto=>/#. - - + proc;inline*;sp;if;auto;sp;rcondt{1}1;auto;progress. - rcondt{1}1;1:auto=>/#;sp. - conseq(:_ ==> r0{1} = bs{2} /\ ICORE.m{1} = IBlockSponge.m{2});progress. - by while( i{1} = i{2} + 1 /\ n0{1} = n{2} /\ x{2} = p0{1} - /\ ICORE.m{1} = IBlockSponge.m{2} /\ r0{1} = bs{2});sp;if;auto=>/#. - - by inline*;auto;call(:true);auto. -qed. + /\ 0 < i{1} <= n{1} + 1 + /\ ={n,p,r,i} + /\ valid p{1} + /\ 0 < n{1} + /\ (forall j, 0 < j < i{1} => + format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. + rcondt{2}5;auto;1:smt(parseK). + swap{2}6-1;sp. + conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ + (forall j, 0 < j <= n0{1} => + format p0{1} j \in dom IBlockSponge.m{2}));1:smt(parseK formatK). + conseq(: INV IBlockSponge.m{2} ICORE.m{1} /\ (forall (j : int), + 0 < j < n0{1} => format p0{1} j \in dom IBlockSponge.m{2}) /\ + (p0,n0){1} = parse x1{2} /\ (x=x1){2} /\ ={p0,n0} /\ + n0{1} = i{2} /\ 0 <= i0{2} < i{2} + ==> _);1:smt(parseK formatK). + seq 1 1 : (INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < n0{2} /\ + (forall (j : int), 0 < j <= n0{1} => + format p0{1} j \in dom IBlockSponge.m{2}) /\ + (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. + + rcondf{2}1;auto;smt(parseK formatK). + splitwhile{2}1:(i0+1 + format p0{1} j \in dom IBlockSponge.m{2}) /\ + (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. + + rcondt{2}1;1:auto=>/#;rcondf{2}4;1: by progress;sp;if;auto=>/#. + sp;if;auto;progress. + + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. + smt(in_dom formatK). + + move:H3;rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. + smt(in_dom formatK). + + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + smt(getP parseK formatK). + + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + smt(in_dom getP parseK formatK). + + case(j=i0{2} + 1)=>//=;2:rewrite/#. + smt(in_dom getP parseK formatK). + while{2}((p0{2}, n0{2}) = parse x1{2} /\ (x=x1){2} /\ 0 <= i0{2} < n0{2} /\ + INV IBlockSponge.m{2} ICORE.m{1} /\ (p0,n0){1} = parse x1{2} /\ + ={p0,n0} /\ (forall (j : int), 0 < j < n0{2} => + format p0{2} j \in dom IBlockSponge.m{2}))(n0{2}-i0{2});progress. + + sp;rcondf 1;auto;progress. + + rewrite-(formatK x1{hr})-H3/=take_cat addzAC/=/=take_nseq/min/=. + cut->/=:!size p0{hr} + i0{hr} < size p0{hr} by rewrite/#. + by cut/#:=H4 (i0{hr}+1). + + by rewrite/#. + by rewrite/#. + by auto=>/#. -(* conseq (_: ={r, i} *) -(* /\ r{2} = [] *) -(* /\ b{2} = [] *) -(* /\ i{2} = 1 *) -(* /\ parse p{1} = (p{2},n{2}) *) -(* /\ valid p{2} *) -(* /\ 0 < n{2} *) -(* /\ INV ICORE.m{1} IBlockSponge.m{2} *) -(* ==> _)=> />. *) -(* + by move=> &1 &2=> <-. *) -(* splitwhile{1} 1: (i < size (parse p).`1); inline{2} 2. *) -(* rcondt{2} 6; first by auto; while (true)=> //; auto=> /> &hr <- //. *) -(* wp. while ( i{1} = i0{2} + size x0{2} - 1 *) -(* /\ p{1} = x0{2} ++ nseq (n0 - 1){2} b0 *) -(* /\ r{1} = r{2} ++ bs{2} *) -(* /\ 0 < i0{2} *) -(* /\ valid x0{2} *) -(* /\ n{2} = n0{2} *) -(* /\ INV ICORE.m{1} IBlockSponge.m{2} *) -(* /\ parse p{1} = (p{2}, n{2})). *) -(* + wp;inline*;sp;wp;if;auto;smt(parseK min_lel size_nseq take_nseq *) -(* rcons_cat parse_injective getP in_dom oget_some take_size take0 *) -(* take_cat parse_valid valid_take cat_rcons cats0 size_cat size_ge0). *) -(* wp=>/=. *) -(* conseq(:_==> ={r, i} *) -(* /\ valid p{2} *) -(* /\ 0 < n{2} *) -(* /\ p{1} = p{2} ++ nseq (n{2} - 1) Block.b0 *) -(* /\ i{1} = size p{2} *) -(* /\ parse p{1} = (p{2}, n{2}) *) -(* /\ INV ICORE.m{1} IBlockSponge.m{2});progress;..-2:smt(cats0 size_cat size_ge0). *) -(* while( ={r,i} *) -(* /\ valid p{2} *) -(* /\ 0 < n{2} *) -(* /\ p{1} = p{2} ++ nseq (n{2} - 1) Block.b0 *) -(* /\ 0 < i{1} <= size p{2} *) -(* /\ parse p{1} = (p{2}, n{2}) *) -(* /\ INV ICORE.m{1} IBlockSponge.m{2}). *) -(* + inline*;auto;sp;rcondt{2}1;1:(auto;smt(valid_take)). *) -(* rcondt{2}1;1:auto;sp;rcondf{2}5;1:auto;if;auto; *) -(* smt(parse_injective getP oget_some in_dom take_size take0 take_cat *) -(* parse_valid valid_take cat_rcons cats0 size_cat size_ge0). *) -(* auto;smt(parseK min_lel size_nseq take_nseq valid_spec *) -(* rcons_cat parse_injective getP in_dom oget_some take_size take0 *) -(* take_cat parse_valid valid_take cat_rcons cats0 size_cat size_ge0). *) -(* + proc (INV ICORE.m{1} IBlockSponge.m{2})=> //. *) -(* proc. *) -(* sp;if;1:progress=>/#. *) -(* splitwhile{1} 1 : i < size (parse p).`1. *) -(* rcondt{1}2;progress. *) -(* + while(i <= size (parse p).`1);auto;1:call(:true);auto;progress. *) -(* + rewrite/#. *) -(* + smt(size_ge0 valid_spec). *) -(* cut/#:size (parse x{m0}).`1 <= size x{m0}. *) -(* by rewrite-{2}(formatK x{m0}) -H/=/format size_cat size_nseq/#. *) -(* inline*;auto. *) -(* replace{2} { *) -(* while { *) -(* setup; *) -(* if { *) -(* (while as loop) *) -(* }; *) -(* setup_end *) -(* }; *) -(* after *) -(* } by { *) -(* while(i < size p) { *) -(* setup; *) -(* loop; *) -(* setup_end; *) -(* } *) -(* after; *) -(* } *) -(* (r{2} = [] /\ (p{2}, n{2}) = parse x{2} /\ b{2} = [] /\ *) -(* i{2} = 1 /\ r{1} = [] /\ i{1} = 1 /\ p{1} = x{2} /\ *) -(* INV ICORE.m{1} IBlockSponge.m{2} /\ valid (parse p{1}).`1 /\ *) -(* 0 < (parse p{1}).`2 *) -(* ==> r{1} = r{2} ++ bs0{2} /\ INV ICORE.m{1} IBlockSponge.m{2}) *) -(* (={i,p,n,x,r,b,IBlockSponge.m, *) - - -(* (* now we should manage the while loops *) *) -(* admit. *) -(* + auto. *) - -(* + proc; sp; if=> //=; inline{1} 1; rcondt{1} 4. *) -(* + by auto=> /> &hr _ ^valid_x+ ^n_gt0 /parseK H - /H {H} ->. *) -(* sp;wp. *) -(* conseq(:_==> drop (size p{1} - 1) r0{1} = bs{2} *) -(* /\ ={glob S} *) -(* /\ INV ICORE.m{1} IBlockSponge.m{2});progress. *) -(* by do !congr;rewrite b2i_eq1/#. *) -(* inline*;rewrite/INV. *) -(* (* This is false : because ICORE.m{1} will be bigger than IBlockSponge.m{2} *) *) -(* splitwhile{1}1:i<=size p;rcondt{2}1;1:auto=>/#. *) -(* inline*. *) -(* (* same as the second loop in LoF.f *) *) -(* admit. *) -(* by inline *; auto; call (_: true); auto=> /> p; rewrite !map0P. *) -(* qed. *) + + proc (INV IBlockSponge.m{2} ICORE.m{1})=> //. + proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. + inline{2} 1.1. + inline*. + while( INV IBlockSponge.m{2} ICORE.m{1} + /\ 0 < i{1} <= n{1} + 1 + /\ ={n,p,r,i} + /\ valid p{1} + /\ 0 < n{1} + /\ (forall j, 0 < j < i{1} => + format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. + rcondt{2}5;auto;1:smt(parseK). + swap{2}6-1;sp. + conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ + (forall j, 0 < j <= n0{1} => + format p0{1} j \in dom IBlockSponge.m{2}));1:smt(parseK formatK). + conseq(: INV IBlockSponge.m{2} ICORE.m{1} /\ (forall (j : int), + 0 < j < n0{1} => format p0{1} j \in dom IBlockSponge.m{2}) /\ + (p0,n0){1} = parse x1{2} /\ (x=x1){2} /\ ={p0,n0} /\ + n0{1} = i{2} /\ 0 <= i0{2} < i{2} + ==> _);1:smt(parseK formatK). + seq 1 1 : (INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < n0{2} /\ + (forall (j : int), 0 < j <= n0{1} => + format p0{1} j \in dom IBlockSponge.m{2}) /\ + (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. + + rcondf{2}1;auto;smt(parseK formatK). + splitwhile{2}1:(i0+1 + format p0{1} j \in dom IBlockSponge.m{2}) /\ + (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. + + rcondt{2}1;1:auto=>/#;rcondf{2}4;1: by progress;sp;if;auto=>/#. + sp;if;auto;progress. + + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. + smt(in_dom formatK). + + move:H3;rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. + smt(in_dom formatK). + + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + smt(getP parseK formatK). + + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + smt(in_dom getP parseK formatK). + + case(j=i0{2} + 1)=>//=;2:rewrite/#. + smt(in_dom getP parseK formatK). + while{2}((p0{2}, n0{2}) = parse x1{2} /\ (x=x1){2} /\ 0 <= i0{2} < n0{2} /\ + INV IBlockSponge.m{2} ICORE.m{1} /\ (p0,n0){1} = parse x1{2} /\ + ={p0,n0} /\ (forall (j : int), 0 < j < n0{2} => + format p0{2} j \in dom IBlockSponge.m{2}))(n0{2}-i0{2});progress. + + sp;rcondf 1;auto;progress. + + rewrite-(formatK x1{hr})-H3/=take_cat addzAC/=/=take_nseq/min/=. + cut->/=:!size p0{hr} + i0{hr} < size p0{hr} by rewrite/#. + by cut/#:=H4 (i0{hr}+1). + + by rewrite/#. + by rewrite/#. + by auto=>/#. + + + proc. + sp;if=> [&1 &2 [#] <*>/#| |] //=. + inline*;sp;rcondt{1}1;auto. + swap{2}1;sp. + conseq(:_==> last Block.b0 r0{1} = oget IBlockSponge.m{2}.[x{2}] /\ + INV IBlockSponge.m{2} ICORE.m{1});progress. + seq 1 1 :(last Block.b0 r0{1} = oget IBlockSponge.m{2}.[x{2}] /\ + INV IBlockSponge.m{2} ICORE.m{1} /\ + x1{2} \in dom IBlockSponge.m{2});last by rcondf{2}1;auto=>/#. + conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ i{2} = n{2} /\ + Some (last Block.b0 r0{1}) = + IBlockSponge.m{2}.[take (size p + i){2} x{2}]);progress. + + move:H5;rewrite take_oversize;2:smt(oget_some). + by rewrite-formatK/=-H/=size_cat size_nseq/#. + + move:H5;rewrite take_oversize. + + by rewrite-formatK/=-H/=size_cat size_nseq/#. + by rewrite in_dom/#. + while( i{1} = i{2}+1 /\ n0{1} = n{2} /\ p{2} = p0{1} + /\ valid p0{1} /\ 0 < i{1} /\ i{2} <= n{2} + /\ (i{2} = n{2} => Some (last Block.b0 r0{1}) = + IBlockSponge.m{2}.[take (size p{2} + i{2}) x{2}]) + /\ INV IBlockSponge.m{2} ICORE.m{1} + /\ parse x{2} = (p0{1},n0{1}));auto;last first. + + progress=>/#. + sp;if;auto;smt(take_nseq parseK in_dom formatK take_cat getP last_rcons). + + by inline*;auto;call(:true);auto;smt(in_dom dom0 in_fset0). +qed. end section PROOF. diff --git a/sha3/proof/core/ConcreteF.eca b/sha3/proof/core/ConcreteF.eca index 8c5367b..dde9a3c 100644 --- a/sha3/proof/core/ConcreteF.eca +++ b/sha3/proof/core/ConcreteF.eca @@ -1,4 +1,4 @@ -require import Pred Fun Option Pair Int Real StdOrder Ring. +require import Core Int Real StdOrder Ring Distr IntExtra. require import List FSet NewFMap Utils Common SLCommon DProd Dexcepted. (*...*) import Capacity IntOrder RealOrder. @@ -54,20 +54,23 @@ section. type D <- state, op uD <- dstate, type K <- unit, - op dK <- (NewDistr.MUnit.dunit<:unit> tt), + 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 support_dprod /=. - by rewrite Block.DWord.support_bdistr Capacity.DWord.support_cdistr. - apply/dprod_uf. - by rewrite Block.DWord.bdistr_uf. - by rewrite Capacity.DWord.cdistr_uf. + case=> [x y]; rewrite supp_dprod /=. + rewrite Block.DBlock.supp_dunifin Capacity.DWord.supp_dunifin/=. + smt(dprod1E Block.DBlock.dunifin_funi Capacity.DWord.dunifin_funi). + split. + smt(dprod_ll Block.DBlock.dunifin_ll Capacity.DWord.dunifin_ll). + apply/dprod_fu. + rewrite Block.DBlock.dunifin_fu. + by rewrite Capacity.DWord.dunifin_fu. qed. realize dK_ll. - by rewrite /is_lossless NewDistr.MUnit.dunit_ll. + by rewrite /is_lossless MUnit.dunit_ll. qed. (* TODO move this *) @@ -121,18 +124,16 @@ section. by sp; if=> //=; auto=> /> &2 cL /size_behead=> ->; progress; ring. have p_ll := P_f_ll _ _. + apply/dprod_ll; split. - + exact/Block.DWord.bdistr_ll. - exact/Capacity.DWord.cdistr_ll. - + apply/fun_ext=>- [] a b; rewrite support_dprod. - rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Block.enumP. - by rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Capacity.enumP. + + exact/Block.DBlock.dunifin_ll. + exact/Capacity.DWord.dunifin_ll. + + apply/fun_ext=>- [] a b; rewrite supp_dprod. + by rewrite/=/predT/=Block.DBlock.dunifin_fu Capacity.DWord.dunifin_fu. have pi_ll := P_fi_ll _ _. + apply/dprod_ll; split. - + exact/Block.DWord.bdistr_ll. - exact/Capacity.DWord.cdistr_ll. - + apply/fun_ext=>- [] a b; rewrite support_dprod. - rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Block.enumP. - by rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Capacity.enumP. + + exact/Block.DBlock.dunifin_ll. + exact/Capacity.DWord.dunifin_ll. + + apply/fun_ext=>- [] a b; rewrite supp_dprod. + by rewrite/=/predT/=Block.DBlock.dunifin_fu Capacity.DWord.dunifin_fu. have f_ll : islossless SqueezelessSponge(Perm).f. + proc; while true (size p)=> //=. * by move=> z; wp; call p_ll; skip=> /> &hr /size_behead /#. diff --git a/sha3/proof/core/Gcol.eca b/sha3/proof/core/Gcol.eca index 3f680bf..fcc397c 100644 --- a/sha3/proof/core/Gcol.eca +++ b/sha3/proof/core/Gcol.eca @@ -1,5 +1,5 @@ pragma -oldip. -require import Pred Fun Option Pair Int Real RealExtra StdOrder Ring StdBigop. +require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. require import DProd Dexcepted. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. @@ -295,9 +295,9 @@ section PROOF. by rewrite le_fromint;smt ml=0 w=max_ge0. + proc;sp;if;2:by hoare=>//??;apply eps_ge0. wp. - rnd (mem (image fst (rng FRO.m)));skip;progress;2:smt ml=0. - rewrite (Mu_mem.mu_mem (image fst (rng FRO.m{hr})) cdistr (1%r/(2^c)%r))//. - + move=>x _; apply DWord.cdistr1E. + rnd (mem (image fst (rng FRO.m)));skip;progress;2:smt ml=0. + cut->:=(Mu_mem.mu_mem (image fst (rng FRO.m{hr})) cdistr (1%r/(2^c)%r) _). + + move=>x _; rewrite DWord.dunifin1E;do !congr;exact cap_card. apply ler_wpmul2r;2:by rewrite le_fromint. by apply divr_ge0=>//;apply /c_ge0r. + move=>ci;proc;rcondt 2;auto=>/#. diff --git a/sha3/proof/core/Gconcl.ec b/sha3/proof/core/Gconcl.ec index 6027e1a..1215e7e 100644 --- a/sha3/proof/core/Gconcl.ec +++ b/sha3/proof/core/Gconcl.ec @@ -1,10 +1,11 @@ pragma -oldip. -require import Pred Fun Option Pair Int Real RealExtra StdOrder Ring StdBigop. +require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. require import DProd Dexcepted. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. require (*..*) Gext. +print F.RO. module IF = { proc init = F.RO.init @@ -220,14 +221,14 @@ proof. [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=>/>. - wp;rnd;auto;progress[-split];rewrite DWord.cdistr_ll /= => ?_?->. + wp;rnd;auto;progress[-split];rewrite DWord.dunifin_ll /= => ?_?->. by rewrite !getP /= oget_some. case ((mem (dom G1.mh) (x.`1, hx2) /\ 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=>/>. wp;rnd;auto;rnd{1};auto;progress[-split]. - rewrite Block.DWord.support_bdistr DWord.cdistr_ll /==> ?_?->. + rewrite Block.DBlock.supp_dunifin DWord.dunifin_ll /==> ?_?->. by rewrite !getP /= oget_some. + proc;sp;if=>//. @@ -241,7 +242,7 @@ proof. [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=>/>. - wp;rnd;auto;progress[-split];rewrite DWord.cdistr_ll /= => ?_?->. + wp;rnd;auto;progress[-split];rewrite DWord.dunifin_ll /= => ?_?->. by rewrite !getP /= oget_some. proc;sp;if=>//. @@ -342,7 +343,7 @@ proof. call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. sp;sim; while(={i,p,F.RO.m})=>//. inline F.RO.sample F.RO.get;if{1};1:by auto. - by sim;inline *;auto;progress;apply DWord.cdistr_ll. + by sim;inline *;auto;progress;apply DWord.dunifin_ll. qed. local equiv G4_Ideal : G4(F.LRO).distinguish ~ IdealIndif(IF,S,DRestr(D)).main : diff --git a/sha3/proof/core/Gext.eca b/sha3/proof/core/Gext.eca index f467cc0..c7439d7 100644 --- a/sha3/proof/core/Gext.eca +++ b/sha3/proof/core/Gext.eca @@ -1,5 +1,5 @@ pragma -oldip. -require import Pred Fun Option Pair Int Real RealExtra StdOrder Ring StdBigop. +require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. require import DProd Dexcepted. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. @@ -201,7 +201,7 @@ section. + by move=> &m;auto;rewrite /in_dom_with. (* auto=> |>. (* Bug ???? *) *) auto;progress. - + by apply DWord.cdistr_ll. + + by apply DWord.dunifin_ll. + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. + case (h = (oget G1.mh{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + by left;rewrite Hh oget_some. @@ -238,7 +238,7 @@ section. + inline *;rcondt{2} 4. + by move=> &m;auto;rewrite /in_dom_with. auto;progress. - + by apply DWord.cdistr_ll. + + by apply DWord.dunifin_ll. + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. + case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + by left;rewrite Hh oget_some. @@ -557,7 +557,7 @@ section EXT. rcondt{2} 5;1:by auto;smt w=(sizeE size_ge0). rcondt{2} 10. by auto;progress;rewrite dom_set !inE. wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. - rewrite DWord.cdistr_ll /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. + rewrite DWord.dunifin_ll /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. 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. @@ -579,7 +579,7 @@ section EXT. rcondt{2} 5;1:by auto;smt w=(sizeE size_ge0). rcondt{2} 10. by auto;progress;rewrite dom_set !inE. wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. - rewrite DWord.cdistr_ll /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. + rewrite DWord.dunifin_ll /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. 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. @@ -622,22 +622,24 @@ section EXT. wp; rnd (mem (image snd (dom G1.m `|` dom G1.mi ))); skip=> /> &hr ? ? -> /= ? ?. rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr} `|` dom G1.mi{hr})) - cdistr (1%r/(2^c)%r))//. - + by move=>x _;apply DWord.cdistr1E. - apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. + cdistr (1%r/(2^c)%r))//. + + by move=>x _;rewrite DWord.dunifin1E cap_card. + rewrite ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. rewrite imageU fcardU le_fromint. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). by rewrite -!sizeE;smt w=fcard_ge0. + + rewrite/#. + 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 (dom G1.m `|` dom G1.mi) `|` fset1 x));skip=> /> &hr ??-> /= ??. rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. - + by move=>x _;apply DWord.cdistr1E. - apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. + + by move=>x _;rewrite DWord.dunifin1E cap_card. + rewrite ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. rewrite imageU !fcardU le_fromint fcard1. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). by rewrite -!sizeE;smt w=fcard_ge0. + + rewrite/#. + by move=>c1;proc;auto=> &hr [^H 2->]/#. move=> b1 c1;proc;auto=> /#. qed. diff --git a/sha3/proof/core/Handle.eca b/sha3/proof/core/Handle.eca index 0905386..9fb10b9 100644 --- a/sha3/proof/core/Handle.eca +++ b/sha3/proof/core/Handle.eca @@ -1,5 +1,5 @@ pragma -oldip. pragma +implicits. -require import Pred Fun Option Pair Int Real StdOrder Ring NewLogic. +require import Core Int Real StdOrder Ring IntExtra. require import List FSet NewFMap Utils Common SLCommon RndO. require import DProd Dexcepted. (*...*) import Capacity IntOrder. @@ -10,7 +10,7 @@ clone import GenEager as ROhandle with type from <- handle, type to <- capacity, op sampleto <- fun (_:int) => cdistr - proof sampleto_ll by apply DWord.cdistr_ll. + proof sampleto_ll by apply DWord.dunifin_ll. module G1(D:DISTINGUISHER) = { var m, mi : smap @@ -431,7 +431,7 @@ split=> [xa0 xc0 ya0 yc0|xa0 hx0 ya0 hy0]; rewrite getP. by exists hx0 fx0 hy0 fy0; rewrite !getP /#. case: ((xa0,hx0) = (xa,hx))=> [[#] <*>> [#] <<*>|] /=. + by exists xc f yc f'; rewrite !getP /= /#. -rewrite anda_and=> /negb_and xahx0_neq_xahx /Hmh_m [xc0 fx0 yc0 fy0] [#] hs_hx0 hs_hy0 Pm_xaxc0. +rewrite andaE=> /negb_and xahx0_neq_xahx /Hmh_m [xc0 fx0 yc0 fy0] [#] hs_hx0 hs_hy0 Pm_xaxc0. exists xc0 fx0 yc0 fy0; rewrite !getP; do !split=> [/#|/#|/=]. move: xahx0_neq_xahx; case: (xa0 = xa)=> [/= <*>>|//=]; case: (xc0 = xc)=> [<*>>|//=]. by move: hs_hx=> /(Hhuniq _ _ _ _ hs_hx0). @@ -451,7 +451,7 @@ move=> [] Hm_mh Hmh_m yc_notin_rng1_hs hs_hx hs_hy; split. by exists hy0 fy0 hx0 fx0; rewrite !getP /#. move=> ya0 hy0 xa0 hx0; rewrite getP; case: ((ya0,hy0) = (ya,hy))=> [[#] <*>> [#] <<*>|]. + by exists yc fy xc fx; rewrite !getP //= /#. -rewrite /= anda_and=> /negb_and yahy0_neq_yahy /Hmh_m [yc0 fy0 xc0 fx0] [#] hs_hy0 hs_hx0 mi_yayc0. +rewrite /= andaE=> /negb_and yahy0_neq_yahy /Hmh_m [yc0 fy0 xc0 fx0] [#] hs_hy0 hs_hx0 mi_yayc0. exists yc0 fy0 xc0 fx0; rewrite !getP; do !split=> [/#|/#|]. move: yahy0_neq_yahy; case: (ya0 = ya)=> [<<*> //=|/#]; case: (yc0 = yc)=> [<*>> /=|//=]. by move: hs_hy0; rewrite yc_notin_rng1_hs. @@ -1061,7 +1061,7 @@ split. 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 anda_and -negP=> [#] <<*>. + rewrite andaE -negP=> [#] <<*>. move: h; have /invG_of_INV [] <- := HINV. by rewrite Gm_xaxc. + by case: HINV. @@ -1288,8 +1288,8 @@ case @[ambient]: {-1}(Gmi.[(xa,xc)]) (eq_refl Gmi.[(xa,xc)])=> [|[ya' yc'] ^] Gm 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.DWord.bdistr_uf Capacity.DWord.cdistr_uf). + by have /invG_of_INV [] -> := inv0; rewrite Gmi_xaxc. print Block.DBlock. + smt (@Block.DBlock @Capacity.DWord). have /incli_of_INV <- := inv0; 1:by rewrite Gmi_xaxc. rewrite Pmi_xaxc=> /= [#] <<*>. rcondf{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. @@ -1329,10 +1329,10 @@ proof. (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} /\ F.RO.m.[p]{2} = Some sa{1})));last first. + case : (! (G1.bcol{2} \/ G1.bext{2})); - 2: by conseq (_:_ ==> true)=> //; inline *;auto;rewrite Block.DWord.bdistr_ll. + 2: by conseq (_:_ ==> true)=> //; inline *;auto;rewrite Block.DBlock.dunifin_ll. inline *; rcondf{2} 3. + by move=> &m;auto=> &hr [#] H /H[_ H1] ??;rewrite in_dom H1. - by auto=> /> &m1 &m2;rewrite Block.DWord.bdistr_ll /= => H /H [-> ->];rewrite oget_some. + by auto=> /> &m1 &m2;rewrite Block.DBlock.dunifin_ll /= => H /H [-> ->];rewrite oget_some. while ( p{1} = (drop i p){2} /\ (0 <= i <= size p){2} /\ (!(G1.bcol{2} \/ G1.bext{2}) => @@ -1364,7 +1364,7 @@ proof. by have := size_drop (i{m2} + 1) p{m2};case (drop (i{m2} + 1) p{m2}) => //= [/#| ];smt w=size_ge0. case ((G1.bcol{2} \/ G1.bext{2})). + wp;conseq (_: _ ==> (G1.bcol{2} \/ G1.bext{2}))=> //. - by if{1};if{2};auto;2:(swap{2} 4 -3;auto); smt w=(Block.DWord.bdistr_ll DWord.cdistr_ll). + by if{1};if{2};auto;2:(swap{2} 4 -3;auto); smt w=(Block.DBlock.dunifin_ll DWord.dunifin_ll). conseq (_: (x{1} = (sa{1} +^ head witness p{1}, sc{1}) /\ (p{1} = drop i{2} p{2} /\ 0 <= i{2} <= size p{2} /\ @@ -1416,7 +1416,7 @@ proof. move=> Heq Hdom y1L-> /= y2L-> /=. have -> /= : i{m2} + 1 <> 0 by smt (). rewrite !getP_eq !oget_some /=. - pose p' := (take (i{m2} + 1) p{m2});rewrite -!nor=> [#] ? /= Hy2 ?. + pose p' := (take (i{m2} + 1) p{m2});rewrite/==> [#] ? /=. split;last first. + split;1: by exists Unknown. rewrite /p' (@take_nth witness) 1:// build_hpath_prefix. @@ -1424,7 +1424,7 @@ proof. rewrite /sa' getP_eq /=;apply build_hpath_up => //. by move: Hdom;rewrite Heq /sa' in_dom. have Hy1L := ch_notin_dom2_mh _ _ _ y1L G1.chandle{m2} Hmmhi Hhs. - have := hinvP FRO.m{m2} y2L;rewrite Hy2 /= => Hy2L. + have := hinvP FRO.m{m2} y2L;rewrite /= => Hy2L. have g1_sa' : G1.mh{m2}.[(sa', h{m2})] = None by move: Hdom;rewrite Heq in_dom. case :Hsc => f Hsc; have Hh := dom_hs_neq_ch _ _ _ _ _ Hhs Hsc. have Hch : FRO.m{m2}.[G1.chandle{m2}] = None. @@ -1432,7 +1432,7 @@ proof. by case {-1}(FRO.m{m2}.[G1.chandle{m2}]) (eq_refl (FRO.m{m2}.[G1.chandle{m2}])) => // ? /H. have Hy2_mi: ! mem (dom PF.mi{m1}) (y1L, y2L). + rewrite in_dom;case {-1}( PF.mi{m1}.[(y1L, y2L)]) (eq_refl (PF.mi{m1}.[(y1L, y2L)])) => //. - by move=> [] ??;case Hmmhi=> H _ /H [] ????;rewrite Hy2L. + by move=> [] ??;case Hmmhi=> H _ /H [] ????/#. have ch_0 := ch_neq0 _ _ Hhs. have ch_None : forall xa xb ha hb, G1.mh{m2}.[(xa,ha)] = Some(xb, hb) => @@ -1440,10 +1440,10 @@ proof. + 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 => // ??;apply Hy2L. + + by apply hs_addh => // ??/#. + by apply inv_addm. + by apply (m_mh_addh_addm f) => //;case Hhs. - + by apply (mi_mhi_addh_addmi f)=> // ??;apply Hy2L. + + by apply (mi_mhi_addh_addmi f)=> // ??/#. + by apply incl_upd_nin. + by apply incl_upd_nin. + case (Hmh)=> H1 H2 H3;split. @@ -1674,7 +1674,7 @@ section AUX. auto => &m1 &m2 [#] !<- _ _ -> /= _ y1L -> y2L -> /=. rewrite !getP_eq pi_x2 !oget_some /=. have /hs_of_INV [] Hu _ _:= inv0; have -> := huniq_hinvK_h _ _ _ Hu hs_hx2. - rewrite oget_some -!nor => /= -[] ? Hy2L [*]. + rewrite oget_some => /= ? Hy2L . case:inv0=> Hhs Hinv HinvG Hmmh Hmmhi Hincl Hincli Hmh Hpi. have Hhx2:= dom_hs_neq_ch _ _ _ _ _ Hhs hs_hx2. have mh_hx2: G1mh.[(x1,hx2)] = None. @@ -1689,11 +1689,11 @@ section AUX. + 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 Hy2L => H _ + /H {H} [hx fx hy fy] [#]. - by case: (hinvP hs0 y2L)=> [_ ->|//]. + by case: (hinvP hs0 y2L)=> [_ ->|//]/#. + by apply inv_addm=>//; apply (ch_notin_dom2_mh _ _ Hmmhi Hhs). + by apply (m_mh_addh_addm _ Hmmh _ hs_hx2)=>//;apply ch_notin_dom_hs. + apply (mi_mhi_addh_addmi _ Hmmhi _ hs_hx2);last by apply ch_notin_dom_hs. - by have := hinvP hs0 y2L;rewrite Hy2L /#. + by have := hinvP hs0 y2L;rewrite /#. + by apply incl_addm. + by apply incl_addm. + split. + move=> xa hx ya hy;rewrite getP;case ((xa, hx) = (x1, hx2))=> /=. @@ -1747,7 +1747,7 @@ section AUX. move=> [h []];rewrite getP build_hpath_upd_ch_iff //. case (h=ch0)=> [->> /= [??[# H1 -> ->]]| Hh] /=. + by case Hmh => _ _ /(_ _ _ _ _ _ Hpath H1). - by have := hinvP hs0 y2L;rewrite Hy2L /= => ->. + by have := hinvP hs0 y2L;rewrite /= => /#. case Hpi => ->;apply exists_iff => h /=. rewrite build_hpath_upd_ch_iff // getP;case (h = ch0) => [->> | //]. split;1: by move=> [_ /(dom_hs_neq_ch _ _ _ _ _ Hhs)]. @@ -1782,7 +1782,7 @@ section AUX. + by have /hs_of_INV []:= inv0. by rewrite /in_dom_with in_dom hs_hy2. rcondt{2} 14; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite in_dom pi_x2. - auto=> &1 &2 [#] !<<- -> -> ->> _ /=; rewrite Block.DWord.bdistr_ll Capacity.DWord.cdistr_ll /=. + auto=> &1 &2 [#] !<<- -> -> ->> _ /=; rewrite Block.DBlock.dunifin_ll Capacity.DWord.dunifin_ll /=. move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 !oget_some //=. rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. + by have /hs_of_INV []:= inv0. @@ -1790,37 +1790,38 @@ section AUX. exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). (* lossless PF.f *) + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. - smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). + smt (@Block.DBlock @Capacity.DWord). (* lossless and do not reset bad G1.S.f *) + move=> _; proc; if; auto. conseq (_: _ ==> G1.bcol \/ G1.bext); 1:smt (). inline *; if=> //=; wp; rnd predT; wp; rnd predT; auto. - + smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). - smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). + + smt (@Block.DBlock @Capacity.DWord). + smt (@Block.DBlock @Capacity.DWord). (** proofs for G1.S.fi *) (* equiv PF.P.fi G1.S.fi *) + by conseq (eq_fi D)=> /#. (* lossless PF.P.fi *) + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. - smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). + smt (@Block.DBlock @Capacity.DWord). (* lossless and do not reset bad G1.S.fi *) + move=> _; proc; if; 2:by auto. - by wp; do 2!rnd predT; auto => &hr [#]; smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). + by wp; do 2!rnd predT; auto => &hr [#]; smt (@Block.DBlock @Capacity.DWord). (** proofs for G1.C.f *) (* equiv PF.C.f G1.C.f *) + proc. + inline*;sp. admit. (* this is false *) (* lossless PF.C.f *) + move=> &2 _; proc; inline *; while (true) (size p); auto. + sp; if; 2:by auto; smt (size_behead). - by wp; do 2!rnd predT; auto; smt (size_behead Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). + by wp; do 2!rnd predT; auto; smt (size_behead @Block.DBlock @Capacity.DWord). smt (size_ge0). (* lossless and do not reset bad G1.C.f *) + move=> _; proc; inline *; wp; rnd predT; auto. while (G1.bcol \/ G1.bext) (size p - i)=> [z|]. + if; 1:by auto=> /#. wp; rnd predT; wp; rnd predT; auto. - smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). - by auto; smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). + smt (@Block.DBlock @Capacity.DWord). + by auto; smt (@Block.DBlock @Capacity.DWord). (* Init ok *) inline *; auto=> />; split=> [|/#]. (do !split; last 3 smt (getP map0P build_hpath_map0)); last 5 by move=> ? ? ? ?; rewrite map0P. diff --git a/sha3/proof/core/SLCommon.ec b/sha3/proof/core/SLCommon.ec index 01ac9dc..d46259d 100644 --- a/sha3/proof/core/SLCommon.ec +++ b/sha3/proof/core/SLCommon.ec @@ -2,7 +2,7 @@ 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 Pred Fun Option Pair Int Real StdOrder Ring. +require import Core Int Real StdOrder Ring. require import List FSet NewFMap Utils Common RndO DProd Dexcepted. require (*..*) Indifferentiability. @@ -33,12 +33,11 @@ op bl_univ = FSet.oflist bl_enum. (* -------------------------------------------------------------------------- *) (* Random oracle from block list to block *) - clone import RndO.GenEager as F with type from <- block list, type to <- block, op sampleto <- fun (_:block list)=> bdistr - proof * by exact Block.DWord.bdistr_ll. + proof * by exact Block.DBlock.dunifin_ll. (** We can now define the squeezeless sponge construction **) module SqueezelessSponge (P:DPRIMITIVE): FUNCTIONALITY = { @@ -124,11 +123,11 @@ inductive build_hpath_spec mh p 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 rewrite anda_and; split=> [!~#] <*>; [exact/Empty|move=> [] /#]. +elim/last_ind: p v h=> @/build_hpath //= [v h|p b ih v h]. ++ by rewrite andaE; split=> [!~#] <*>; [exact/Empty|move=> [] /#]. rewrite -{1}cats1 foldl_cat {1}/step_hpath /=. case: {-1}(foldl _ _ _) (eq_refl (foldl (step_hpath mh) (Some (b0,0)) p))=> //=. -+ apply/NewLogic.implybN; case=> [/#|p' b0 v' h']. ++ apply/implybN; case=> [/#|p' b0 v' h']. move=> ^/rconssI <<- {p'} /rconsIs ->> {b}. by rewrite /build_hpath=> ->. move=> [v' h']; rewrite oget_some /= -/(build_hpath _ _)=> build. @@ -355,7 +354,7 @@ proof. cut @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := findP (fun (_ : handle) => pred1 c \o fst) handles. + by exists (oget handles.[h]).`2;rewrite oget_some get_oget;2:case (oget handles.[h]). - by rewrite -not_def=> Heq; cut := H h;rewrite in_dom Heq. + cut := H h;rewrite in_dom/#. qed. lemma huniq_hinv (handles:handles) (h:handle): @@ -374,7 +373,7 @@ proof. rewrite /hinvK. cut @/pred1/= [[h]|][->/=]:= findP (+ pred1 c) (restr Known handles). + by rewrite oget_some in_dom restrP;case (handles.[h])=>//= /#. - by move=>+h-/(_ h);rewrite in_dom restrP -!not_def=> H1 H2;apply H1;rewrite H2. + by move=>+h-/(_ h);rewrite in_dom restrP => H1/#. qed. lemma huniq_hinvK (handles:handles) c: @@ -394,5 +393,3 @@ qed. (* -------------------------------------------------------------------------- *) (** The initial Game *) module GReal(D:DISTINGUISHER) = RealIndif(SqueezelessSponge, PC(Perm), D). - - diff --git a/sha3/proof/core/Utils.ec b/sha3/proof/core/Utils.ec index 549d1ac..3f2b506 100644 --- a/sha3/proof/core/Utils.ec +++ b/sha3/proof/core/Utils.ec @@ -1,5 +1,5 @@ (** These should make it into the standard libs **) -require import Option Pair List FSet NewFMap. +require import Core List FSet NewFMap. (* -------------------------------------------------------------------- *) (* In NewFMap *) @@ -24,7 +24,6 @@ proof. by move=> y; rewrite getE mem_assoc_uniq 1:uniq_keys. qed. -require import Fun. lemma reindex_injective_on (f : 'a -> 'c) (m : ('a, 'b) fmap): (forall x y, mem (dom m) x => f x = f y => x = y) => From 08b91f7504fbd88a3d1736f9239b2b6ae7a425a7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 9 Jan 2018 18:16:43 +0100 Subject: [PATCH 248/394] . --- sha3/proof/clean/BlockSponge.eca | 321 +++++++++++++++++++++++++++++-- 1 file changed, 303 insertions(+), 18 deletions(-) diff --git a/sha3/proof/clean/BlockSponge.eca b/sha3/proof/clean/BlockSponge.eca index 80675ae..00f2d31 100644 --- a/sha3/proof/clean/BlockSponge.eca +++ b/sha3/proof/clean/BlockSponge.eca @@ -138,22 +138,22 @@ pred INV (mc : (block list,block) fmap) (mb : (block list * int,block) fmap) = forall p, mc.[p] = mb.[parse p]. (* Constructed Distinguisher *) -module (LoDist (D : DISTINGUISHER) : Low.DISTINGUISHER) - (F : Low.DFUNCTIONALITY) (P : Low.DPRIMITIVE) = { +module (HiDist (D : Low.DISTINGUISHER) : DISTINGUISHER) + (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { module HiF = { - proc f(p : block list) = { + proc f(p : block list, n : int) = { var r <- []; var b <- b0; - var x,n; + var i <- 1; - - (x,n) <- parse p; - - if (valid x /\ 0 < n) { - r <@ F.f(x,n); - b <- last b0 r; + if (valid p /\ 0 < n) { + while(i <= n) { + b <@ F.f(format p i); + r <- rcons r b; + i <- i + 1; + } } - return b; + return r; } } @@ -163,18 +163,288 @@ module (LoDist (D : DISTINGUISHER) : Low.DISTINGUISHER) (*** PROOF forall P D S, - LoDist(D)^{Core(P),P} ~ LoDist(D)^{ICore,S(ICore)} - => D^{BlockSponge(P),P} ~ D^{IBlockSponge,HiSim(S)(IBlockSponge)} ***) + HiDist(D)^{BlockSponge(P),P} ~ HiDist(D)^{IBlockSponge,HiSim(S)(IBlockSponge)} + => D^{Core(P),P} ~ D^{ICore,S(ICore)} ***) section PROOF. declare module P : PRIMITIVE { Low.ICORE, IBlockSponge, HiSim }. declare module S : Low.SIMULATOR { Low.ICORE, IBlockSponge, HiSim, P }. - declare module D : DISTINGUISHER { Low.ICORE, IBlockSponge, HiSim, P, S }. + declare module D : Low.DISTINGUISHER { Low.ICORE, IBlockSponge, HiSim, P, S }. + + + + (* FIXME : is this the eager we want ? *) + local module EagerCORE (P : Low.PRIMITIVE) : Low.FUNCTIONALITY = { + var order : block list + var capa : capacity + var blo : block + proc init() = { + order <- []; + capa <- c0; + blo <- b0; + CORE(P).init(); + } + proc f (p : block list, n : int) = { + var r : block list; + var i : int; + + (blo,capa) <- (b0,c0); + r <- []; + i <- 0; + if (valid p /\ 0 < n) { + while(i < size p) { + (blo,capa) <@ P.f(blo +^ nth witness p i, capa); + i <- i + 1; + } + i <- 1; + order <- p; + r <- rcons r blo; + while (i < n) { + (blo,capa) <@ P.f(blo,capa); + order <- rcons order b0; + r <- rcons r blo; + i <- i + 1; + } + } + return r; + } + proc ewhile() = { + var i : int <- 0; + while(i < size order) { + (blo,capa) <@ P.f(blo +^ nth witness order i,capa); + i <- i + 1; + } + } + }. + + lemma core_blocksponge &m : + Pr[Low.Indif(CORE(P),P,D).main() @ &m: res] = + Pr[Indif(BlockSponge(P),P,HiDist(D)).main() @ &m: res]. + proof. + (* cut->: *) + (* Pr[Low.Indif(EagerCORE(P),P,D).main() @ &m: res] = *) + (* Pr[Low.Indif(CORE(P),P,D).main() @ &m: res]. *) + byequiv(: ={glob D, glob P} ==>_)=>//=;proc. + call (_: ={glob P}); first 2 by sim. + + proc=> /=; sp;if=>//=. + inline*;sp;wp. + (* eager part *) + admit. + + by inline*;auto;call(:true);auto. + qed. + + + + lemma icore_iblocksponge &m : + Pr[Low.Indif(ICORE,S(ICORE),D).main() @ &m: res] = + Pr[Indif(IBlockSponge,HiSim(S,IBlockSponge),HiDist(D)).main() @ &m: res]. + proof. + byequiv(: ={glob D, glob S} ==>_)=>//=;proc. + call (_: ={glob S} /\ INV IBlockSponge.m{2} ICORE.m{1}). + + proc (INV IBlockSponge.m{2} ICORE.m{1})=> //. + proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. + inline{2} 1.1. + inline*. + while( INV IBlockSponge.m{2} ICORE.m{1} + /\ 0 < i{1} <= n{1} + 1 + /\ ={n,p,r,i} + /\ valid p{1} + /\ 0 < n{1} + /\ (forall j, 0 < j < i{1} => + format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. + rcondt{2}5;auto;1:smt(parseK). + swap{2}6-1;sp. + conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ + (forall j, 0 < j <= n0{1} => + format p0{1} j \in dom IBlockSponge.m{2}));1:smt(parseK formatK). + conseq(: INV IBlockSponge.m{2} ICORE.m{1} /\ (forall (j : int), + 0 < j < n0{1} => format p0{1} j \in dom IBlockSponge.m{2}) /\ + (p0,n0){1} = parse x1{2} /\ (x=x1){2} /\ ={p0,n0} /\ + n0{1} = i{2} /\ 0 <= i0{2} < i{2} + ==> _);1:smt(parseK formatK). + seq 1 1 : (INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < n0{2} /\ + (forall (j : int), 0 < j <= n0{1} => + format p0{1} j \in dom IBlockSponge.m{2}) /\ + (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. + + rcondf{2}1;auto;smt(parseK formatK). + splitwhile{2}1:(i0+1 + format p0{1} j \in dom IBlockSponge.m{2}) /\ + (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. + + rcondt{2}1;1:auto=>/#;rcondf{2}4;1: by progress;sp;if;auto=>/#. + sp;if;auto;progress. + + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. + smt(in_dom formatK). + + move:H3;rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. + smt(in_dom formatK). + + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + smt(getP parseK formatK). + + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + smt(in_dom getP parseK formatK). + + case(j=i0{2} + 1)=>//=;2:rewrite/#. + smt(in_dom getP parseK formatK). + while{2}((p0{2}, n0{2}) = parse x1{2} /\ (x=x1){2} /\ 0 <= i0{2} < n0{2} /\ + INV IBlockSponge.m{2} ICORE.m{1} /\ (p0,n0){1} = parse x1{2} /\ + ={p0,n0} /\ (forall (j : int), 0 < j < n0{2} => + format p0{2} j \in dom IBlockSponge.m{2}))(n0{2}-i0{2});progress. + + sp;rcondf 1;auto;progress. + + rewrite-(formatK x1{hr})-H3/=take_cat addzAC/=/=take_nseq/min/=. + cut->/=:!size p0{hr} + i0{hr} < size p0{hr} by rewrite/#. + by cut/#:=H4 (i0{hr}+1). + + by rewrite/#. + by rewrite/#. + by auto=>/#. + + + proc (INV IBlockSponge.m{2} ICORE.m{1})=> //. + proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. + inline{2} 1.1. + inline*. + while( INV IBlockSponge.m{2} ICORE.m{1} + /\ 0 < i{1} <= n{1} + 1 + /\ ={n,p,r,i} + /\ valid p{1} + /\ 0 < n{1} + /\ (forall j, 0 < j < i{1} => + format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. + rcondt{2}5;auto;1:smt(parseK). + swap{2}6-1;sp. + conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ + (forall j, 0 < j <= n0{1} => + format p0{1} j \in dom IBlockSponge.m{2}));1:smt(parseK formatK). + conseq(: INV IBlockSponge.m{2} ICORE.m{1} /\ (forall (j : int), + 0 < j < n0{1} => format p0{1} j \in dom IBlockSponge.m{2}) /\ + (p0,n0){1} = parse x1{2} /\ (x=x1){2} /\ ={p0,n0} /\ + n0{1} = i{2} /\ 0 <= i0{2} < i{2} + ==> _);1:smt(parseK formatK). + seq 1 1 : (INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < n0{2} /\ + (forall (j : int), 0 < j <= n0{1} => + format p0{1} j \in dom IBlockSponge.m{2}) /\ + (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. + + rcondf{2}1;auto;smt(parseK formatK). + splitwhile{2}1:(i0+1 + format p0{1} j \in dom IBlockSponge.m{2}) /\ + (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. + + rcondt{2}1;1:auto=>/#;rcondf{2}4;1: by progress;sp;if;auto=>/#. + sp;if;auto;progress. + + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. + smt(in_dom formatK). + + move:H3;rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. + smt(in_dom formatK). + + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + smt(getP parseK formatK). + + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + smt(in_dom getP parseK formatK). + + case(j=i0{2} + 1)=>//=;2:rewrite/#. + smt(in_dom getP parseK formatK). + while{2}((p0{2}, n0{2}) = parse x1{2} /\ (x=x1){2} /\ 0 <= i0{2} < n0{2} /\ + INV IBlockSponge.m{2} ICORE.m{1} /\ (p0,n0){1} = parse x1{2} /\ + ={p0,n0} /\ (forall (j : int), 0 < j < n0{2} => + format p0{2} j \in dom IBlockSponge.m{2}))(n0{2}-i0{2});progress. + + sp;rcondf 1;auto;progress. + + rewrite-(formatK x1{hr})-H3/=take_cat addzAC/=/=take_nseq/min/=. + cut->/=:!size p0{hr} + i0{hr} < size p0{hr} by rewrite/#. + by cut/#:=H4 (i0{hr}+1). + + by rewrite/#. + by rewrite/#. + by auto=>/#. + + + + proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. + inline{2} 1.1. + inline*. + while( INV IBlockSponge.m{2} ICORE.m{1} + /\ 0 < i{1} <= n{1} + 1 + /\ ={n,p,r,i} + /\ valid p{1} + /\ 0 < n{1} + /\ (forall j, 0 < j < i{1} => + format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. + rcondt{2}5;auto;1:smt(parseK). + swap{2}6-1;sp. + conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ + (forall (j : int), 0 < j <= i{2} => + format p{2} j \in dom IBlockSponge.m{2}));1:smt(formatK parseK). + seq 1 1 :(INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < i{2} /\ + (forall (j : int), 0 < j <= i{2} => + format p{2} j \in dom IBlockSponge.m{2}) /\ + x1{2} = format p{2} i{2});last first. + + rcondf{2}1;auto=>/#. + conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ + (forall (j : int), 0 < j <= i{2} => + format p{2} j \in dom IBlockSponge.m{2}));1:smt(formatK parseK). + if{1}. + + splitwhile{2}1:i0+1/#. + by while(i0 i0=n0-1 /\ IBlockSponge.m = m /\ p = p0 /\ i = n0);progress. + + by rewrite take_cat addzAC/=take_nseq/min/=;smt(in_dom formatK parseK). + conseq(:_==> i0=n0-1 /\ IBlockSponge.m = m);1:smt(formatK parseK). + while(0 <= i0 < n0 /\ (forall (j : int), 0 <= j < n0 - 1 => + take (size p0 + j) x \in dom m) /\ IBlockSponge.m = m);progress. + + rcondf 2;auto=>/#. + auto;progress;1,3:smt(formatK parseK). + rewrite take_cat addzAC/=take_nseq. + cut->/=:p0{hr}=p{hr} by smt(parseK formatK). + cut h:i{hr}=n0{hr} by smt(formatK parseK). + by rewrite h;cut/#:=H5 (j+1). + wp;rnd=>/=. + alias{2} 1 m = IBlockSponge.m;sp. + conseq(:_==> i0{2} = n0{2} - 1 /\ IBlockSponge.m{2} = m{2} /\ + x0{2} = format p{2} n0{2});1:smt(formatK parseK getP dom_set in_dom). + wp;conseq(:_==> i0{2} = n0{2} - 1 /\ m{2} = IBlockSponge.m{2});progress. + + rewrite take_cat addzAC/=take_nseq. + cut->/=:p0{2}=p{2} by smt(parseK formatK). + cut h:i{2}=n0{2} by smt(formatK parseK). + by rewrite h min_lel///format;smt(nseq0 cats0). + while{2}(0 <= i0{2} < n0{2} /\ (forall (j : int), 0 <= j < n0{2} - 1 => + take (size p0{2} + j) x{2} \in dom m{2}) /\ + IBlockSponge.m{2} = m{2})(n0{2}-i0{2}-1);progress. + + rcondf 2;auto=>/#. + auto;progress;1,3..:smt(formatK parseK). + rewrite take_cat addzAC/=take_nseq. + cut->/=:p0{2}=p{2} by smt(parseK formatK). + cut h:i{2}=n0{2} by smt(formatK parseK). + by rewrite h;cut/#:=H5 (j+1). + rewrite/=. + alias{2}1 m = IBlockSponge.m;sp. + conseq(:_==> m{2} = IBlockSponge.m{2});1:smt(in_dom formatK parseK). + while{2}(0 <= i0{2} <= n0{2} /\ (forall (j : int), 0 <= j < n0{2} => + take (size p0{2} + j) x{2} \in dom m{2}) /\ + IBlockSponge.m{2} = m{2})(n0{2}-i0{2});progress. + + rcondf 2;auto=>/#. + auto;progress;1,3..:smt(formatK parseK). + rewrite take_cat addzAC/=take_nseq. + cut->/=:p0{2}=p{2} by smt(parseK formatK). + cut h:i{2}=n0{2} by smt(formatK parseK). + rewrite h;case(j=0)=>[->/=|]. + + rewrite-take_nseq take0 cats0. + by cut/=:=H5 1;smt(in_dom parseK formatK nseq0 cats0). + cut->/=:!size p{2} + j < size p{2} by rewrite/#. + by cut:=H5 (j+1);smt(in_dom parseK formatK nseq0 cats0). + + by inline*;auto;call(:true);auto;smt(in_dom dom0 in_fset0). + qed. + + + lemma LiftInd &m: - `| Pr[Low.Indif(CORE(P),P,LoDist(D)).main() @ &m: res] - - Pr[Low.Indif(ICORE,S(ICORE),LoDist(D)).main() @ &m: res] | - = `| Pr[Indif(BlockSponge(P),P,D).main() @ &m: res] - - Pr[Indif(IBlockSponge,HiSim(S,IBlockSponge),D).main() @ &m: res] |. + `| Pr[Low.Indif(CORE(P),P,D).main() @ &m: res] + - Pr[Low.Indif(ICORE,S(ICORE),D).main() @ &m: res] | + = `| Pr[Indif(BlockSponge(P),P,HiDist(D)).main() @ &m: res] + - Pr[Indif(IBlockSponge,HiSim(S,IBlockSponge),HiDist(D)).main() @ &m: res] |. proof. do !congr. + byequiv (_: ={glob D, glob P} ==> _ )=> //=; proc. @@ -374,3 +644,18 @@ section PROOF. by inline*;auto;call(:true);auto;smt(in_dom dom0 in_fset0). qed. end section PROOF. + + +require import Gconcl. +print Gconcl. +print SLCommon.GReal. +print SLCommon.SqueezelessSponge. +print SLCommon.IdealIndif. +print SLCommon.RealIndif. +print SLCommon.DPRestr. +print SLCommon.DISTINGUISHER. +print DISTINGUISHER. +print SLCommon.DFUNCTIONALITY. +print SLCommon.DPRIMITIVE. +print DFUNCTIONALITY. +print DPRIMITIVE. \ No newline at end of file From 2e2d65301b0c871be337dc0e4cb526563049035f Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 9 Jan 2018 17:28:48 -0500 Subject: [PATCH 249/394] Fix two typos in documentation. --- sha3/proof/Sponge.ec | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index f812a3a..333ab74 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -513,7 +513,7 @@ lemma HybridIROExper_Lazy_Eager proof. by apply (HybridIROExper_Lazy_Eager' D &m). qed. (* turn a Hybrid IRO implementation (lazy or eager) into top-level - ideal functionality; its f procedure only uses IH.g *) + ideal functionality; its f procedure only uses HI.g *) module RaiseHybridIRO (HI : HYBRID_IRO) : FUNCTIONALITY = { proc init() = { @@ -710,7 +710,7 @@ auto; progress [-delta]; auto. qed. -(* invariant relating maps of HybridIROEager and BlockSponge.BIRO.IRO *) +(* invariant relating maps of BlockSponge.BIRO.IRO and HybridIROEager *) pred eager_invar (mp1 : (block list * int, block) fmap, From 8e2e767548697cd5c52ad80eee7bd2262dcf1a09 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Wed, 10 Jan 2018 18:29:59 +0100 Subject: [PATCH 250/394] . --- sha3/proof/clean/BlockSponge.eca | 586 +++++++++++++++++++------------ 1 file changed, 367 insertions(+), 219 deletions(-) diff --git a/sha3/proof/clean/BlockSponge.eca b/sha3/proof/clean/BlockSponge.eca index 00f2d31..bf27b16 100644 --- a/sha3/proof/clean/BlockSponge.eca +++ b/sha3/proof/clean/BlockSponge.eca @@ -1,8 +1,11 @@ require import Core Logic Distr. require import Int IntExtra Real List NewFMap FSet. +require (*--*) StdBigop. +(*---*) import StdBigop.Bigint. require import StdOrder. (*---*) import IntOrder. +print StdBigop. require import NewCommon. (*---*) import Block DBlock Capacity DCapacity. @@ -160,20 +163,71 @@ module (HiDist (D : Low.DISTINGUISHER) : DISTINGUISHER) proc distinguish = D(HiF,P).distinguish }. +print Low. + +module (C (P : PRIMITIVE) : PRIMITIVE) = { + var c : int + proc init() = { + c <- 0; + P.init(); + } + proc f(x) = { + var y; + c <- c + 1; + y <@ P.f(x); + return y; + } + proc fi(x) = { + var y; + c <- c + 1; + y <@ P.fi(x); + return y; + } +}. + +module DFCn (F : Low.FUNCTIONALITY) : Low.FUNCTIONALITY = { + proc init() = { + C.c <- 0; + F.init(); + } + proc f(bs,n) = { + var r : block list <- []; + if (valid bs /\ 0 < n) { + C.c <- C.c + sumid (size bs) (size bs + n); + r <@ F.f(bs,n); + } + return r; + } +}. + +module DFC1 (F : FUNCTIONALITY) : FUNCTIONALITY = { + proc init() = { + C.c <- 0; + F.init(); + } + proc f(x) = { + var b : block <- b0; + if (let (bs,n) = parse x in valid bs /\ 0 < n) { + C.c <- C.c + size x; + b <@ F.f(x); + } + return b; + } +}. (*** PROOF forall P D S, HiDist(D)^{BlockSponge(P),P} ~ HiDist(D)^{IBlockSponge,HiSim(S)(IBlockSponge)} => D^{Core(P),P} ~ D^{ICore,S(ICore)} ***) section PROOF. - declare module P : PRIMITIVE { Low.ICORE, IBlockSponge, HiSim }. - declare module S : Low.SIMULATOR { Low.ICORE, IBlockSponge, HiSim, P }. - declare module D : Low.DISTINGUISHER { Low.ICORE, IBlockSponge, HiSim, P, S }. + declare module P : PRIMITIVE { Low.ICORE, IBlockSponge, HiSim, C }. + declare module S : Low.SIMULATOR { Low.ICORE, IBlockSponge, HiSim, C, P }. + declare module D : Low.DISTINGUISHER { Low.ICORE, IBlockSponge, HiSim, C, P, S }. (* FIXME : is this the eager we want ? *) - local module EagerCORE (P : Low.PRIMITIVE) : Low.FUNCTIONALITY = { + local module EagerCORE (P : Low.PRIMITIVE) = { var order : block list var capa : capacity var blo : block @@ -199,8 +253,8 @@ section PROOF. order <- p; r <- rcons r blo; while (i < n) { - (blo,capa) <@ P.f(blo,capa); order <- rcons order b0; + (blo,capa) <@ P.f(blo,capa); r <- rcons r blo; i <- i + 1; } @@ -209,6 +263,8 @@ section PROOF. } proc ewhile() = { var i : int <- 0; + blo <- b0; + capa <- c0; while(i < size order) { (blo,capa) <@ P.f(blo +^ nth witness order i,capa); i <- i + 1; @@ -216,21 +272,111 @@ section PROOF. } }. - lemma core_blocksponge &m : - Pr[Low.Indif(CORE(P),P,D).main() @ &m: res] = - Pr[Indif(BlockSponge(P),P,HiDist(D)).main() @ &m: res]. + local module EagCORE (P : Low.PRIMITIVE) : Low.FUNCTIONALITY = { + proc init = EagerCORE(P).init + + + proc f (p : block list, n : int) = { + var r : block list; + var i : int; + + (EagerCORE.blo,EagerCORE.capa) <- (b0,c0); + r <- []; + i <- 0; + if (valid p /\ 0 < n) { + i <- 1; + EagerCORE.order <- p; + EagerCORE(P).ewhile(); + r <- rcons r EagerCORE.blo; + while (i < n) { + EagerCORE.order <- rcons EagerCORE.order b0; + EagerCORE(P).ewhile(); + r <- rcons r EagerCORE.blo; + i <- i + 1; + } + } + return r; + } + }. + + equiv core_blocksponge : + Low.Indif(DFCn(CORE(P)),C(P),D).main ~ + Indif(DFC1(BlockSponge(P)),C(P),HiDist(D)).main : + ={glob D, glob P} ==> ={res, C.c}. proof. - (* cut->: *) - (* Pr[Low.Indif(EagerCORE(P),P,D).main() @ &m: res] = *) - (* Pr[Low.Indif(CORE(P),P,D).main() @ &m: res]. *) - byequiv(: ={glob D, glob P} ==>_)=>//=;proc. - call (_: ={glob P}); first 2 by sim. - + proc=> /=; sp;if=>//=. - inline*;sp;wp. - (* eager part *) - admit. - - by inline*;auto;call(:true);auto. + transitivity Low.Indif(DFCn(EagerCORE(P)),C(P),D).main + (={glob D, glob P} ==> ={res, C.c}) + (={glob D, glob P} ==> ={res, C.c});progress;1:rewrite/#. + + proc=>/=;call (_: ={glob P, C.c}); first 2 by sim. + + proc=> /=;inline*;sp;if=>//=;sim;sp;if;progress;sim. + by while( ={i,p,glob P} /\ sc{1} = EagerCORE.capa{2} + /\ sa{1} = EagerCORE.blo{2});auto;call(:true);auto. + + by inline*;auto;call(:true);auto. + + transitivity Low.Indif(DFCn(EagCORE(P)),C(P),D).main + (={glob D, glob P} ==> ={res, C.c}) + (={glob D, glob P} ==> ={res, C.c});progress;1:rewrite/#. + + proc. + call (_: ={glob P, C.c}); first 2 by sim. + + proc=> /=; sp;if=>//=;inline{1}2;inline{2}2;sp;if;progress;2:auto. + swap{2}2;swap{1}3-2;sp;sim. + conseq(:_==> ={r0,glob P});progress. + replace{1} { while ; rest } by { + EagerCORE(P).ewhile(); + rest; + } + (={glob P, EagerCORE.order, r0, n0} /\ i{1} = 0 + /\ (EagerCORE.blo,EagerCORE.capa,EagerCORE.order){1} = (b0,c0,p{1}) + ==> ={r0, glob P}) + (={glob P,glob EagerCORE, n0,r0} ==> ={r0, glob P}); + progress;1:rewrite/#;first inline*;sim;auto;progress. + + (* eager part *) + admit. + + by inline*;auto;call(:true);auto. + + + + proc;call (_: ={glob P, C.c});..2:sim;last first. + + by inline*;auto;call(:true);auto. + proc=> /=; sp;if=>//=;sp;inline*;sp. + rcondt{1}1;1:auto=>/#;sp. + rcondt{2}1;1:(auto;smt(parseK formatK));sp. + rcondt{2}1;1:(auto;smt(parseK formatK));sp. + rcondt{2}1;1:(auto;smt(parseK formatK));sp;wp. + while( ={glob P,n} /\ (format p i){2} = rcons EagerCORE.order{1} b0 + /\ i{2} = i{1} + 1 /\ (sa,sc){2} = (EagerCORE.blo,EagerCORE.capa){1} + /\ valid p{2} /\ 0 < n{2} /\ 0 < i{1} /\ r0{1} = r{2} /\ n0{1} = n{2} + /\ C.c{1} = C.c{2} + sumid (size EagerCORE.order{1} + 1)(size p{2} + n{1}) + /\ 1 <= i{1} <= n0{1} + ). + + sp;rcondt{2}1;auto;1:smt(formatK parseK). + sp;rcondt{2}1;auto;1:smt(formatK parseK). + conseq(:_==> ={glob P,C.c} + /\ (sa,sc){2} = (EagerCORE.blo,EagerCORE.capa){1});progress. + + smt(rcons_cat nseqSr). + + smt(rcons_cat nseqSr). + + rewrite H0 size_rcons BIA.big_ltn_cond;2:rewrite/#. + by rewrite-(size_rcons _ b0)-H0 size_cat-addzA/=size_nseq/max H3/=/#. + + smt(rcons_cat nseqSr). + + smt(rcons_cat nseqSr). + + smt(rcons_cat nseqSr). + while(={glob P,C.c} /\ 0 <= i0{2} <= size p0{2} /\ (sa,sc,i0,p0){2} = + (EagerCORE.blo,EagerCORE.capa,i1,EagerCORE.order){1} + /\ i{2} = i{1} + 1 /\ n0{2} = i{2}); + auto;1:call(:true);auto;progress;..2,4..:smt(size_rcons size_ge0 formatK parseK). + admit. + + wp=>/=. + by while(={glob P,i0} /\ (sa,sc,p0){1} = + (EagerCORE.blo,EagerCORE.capa,EagerCORE.order){2}); + auto;1:call(:true);auto; + smt(nseq0 cats0 valid_spec size_ge0 size_eq0 nseq1 cats1). + + by inline*;auto;call(:true);auto. + + byequiv(: ={glob D, glob P} ==>_)=>//=; qed. @@ -440,209 +586,211 @@ section PROOF. - lemma LiftInd &m: - `| Pr[Low.Indif(CORE(P),P,D).main() @ &m: res] - - Pr[Low.Indif(ICORE,S(ICORE),D).main() @ &m: res] | - = `| Pr[Indif(BlockSponge(P),P,HiDist(D)).main() @ &m: res] - - Pr[Indif(IBlockSponge,HiSim(S,IBlockSponge),HiDist(D)).main() @ &m: res] |. - proof. - do !congr. - + byequiv (_: ={glob D, glob P} ==> _ )=> //=; proc. - call (_: ={glob P}); first 2 by sim. - + proc=> /=; sp;if=>//=;1:progress=>/#. - inline*;sp;wp. - rcondt{1}1;progress. - splitwhile{2}1: i < size x. - seq 3 1:( ={glob P,sa,sc,p} - /\ (x,n,p0,n0){1} = (x,n,x,n){2} - /\ valid x{1} - /\ i{2} = size x{2} - /\ i{1} = 1 - /\ r0{1} = [sa{1}] - /\ (x{2}, n{2}) = parse p{2} - /\ 0 < n{1}). - + wp;conseq(:_==> ={glob P,sa,sc,i,p,x,n} - /\ i{2} = size x{2} - /\ (x,n,p0,n0){1} = (x,n,x,n){2});progress. - while( ={glob P,sa,sc,i,p,x,n} - /\ (x{2}, n{2}) = parse p{2} - /\ (p0,n0){1} = (x,n){2} - /\ 0 <= i{2} <= size x{2} <= size p{2});auto;1:call(:true);auto;progress;2..9,-3..-1:smt(size_ge0). - + by rewrite-(formatK p{2})-H/=/format nth_cat H3. - + by rewrite-(formatK p{2})-H/=/format size_cat;smt(size_ge0). - by rewrite-(formatK p{2})-H/=/format size_cat;smt(size_ge0). - - while( ={glob P,sa,sc,p} - /\ i{1} - 1 = i{2} - size x{2} - /\ size x{2} <= i{2} <= size p{2} - /\ sa{1} = last b0 r0{1} - /\ (x{2}, n{2}) = parse p{2} - /\ (x{1}, n{1}) = parse p{1} - /\ valid x{1} - /\ 0 < n{1} - /\ size p{2} = size x{2} + n{2} - 1 - /\ n0{1} = n{2} - );auto;last first. - + progress. - + by rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. - + by rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. - + by rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. - by move:H2;rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. - - call(:true);auto;progress;2..5,-2..:smt(last_rcons). - rewrite -(formatK p{2})-H2/=/format nth_cat nth_nseq_if. - cut->//=:!i{2} < size x{2} by rewrite/#. - cut->//=: 0 <= i{2} - size x{2} by rewrite/#. - rewrite-H. - cut->/=:i{1} - 1 < n{2} - 1 by rewrite/#. - by rewrite BlockMonoid.addr0. +(* lemma LiftInd &m: *) +(* `| Pr[Low.Indif(CORE(P),P,D).main() @ &m: res] *) +(* - Pr[Low.Indif(ICORE,S(ICORE),D).main() @ &m: res] | *) +(* = `| Pr[Indif(BlockSponge(P),P,HiDist(D)).main() @ &m: res] *) +(* - Pr[Indif(IBlockSponge,HiSim(S,IBlockSponge),HiDist(D)).main() @ &m: res] |. *) +(* proof. *) +(* do !congr. *) +(* + byequiv (_: ={glob D, glob P} ==> _ )=> //=; proc. *) +(* call (_: ={glob P}); first 2 by sim. *) +(* + proc=> /=; sp;if=>//=;1:progress=>/#. *) +(* inline*;sp;wp. *) +(* rcondt{1}1;progress. *) +(* splitwhile{2}1: i < size x. *) +(* seq 3 1:( ={glob P,sa,sc,p} *) +(* /\ (x,n,p0,n0){1} = (x,n,x,n){2} *) +(* /\ valid x{1} *) +(* /\ i{2} = size x{2} *) +(* /\ i{1} = 1 *) +(* /\ r0{1} = [sa{1}] *) +(* /\ (x{2}, n{2}) = parse p{2} *) +(* /\ 0 < n{1}). *) +(* + wp;conseq(:_==> ={glob P,sa,sc,i,p,x,n} *) +(* /\ i{2} = size x{2} *) +(* /\ (x,n,p0,n0){1} = (x,n,x,n){2});progress. *) +(* while( ={glob P,sa,sc,i,p,x,n} *) +(* /\ (x{2}, n{2}) = parse p{2} *) +(* /\ (p0,n0){1} = (x,n){2} *) +(* /\ 0 <= i{2} <= size x{2} <= size p{2});auto;1:call(:true);auto;progress;2..9,-3..-1:smt(size_ge0). *) +(* + by rewrite-(formatK p{2})-H/=/format nth_cat H3. *) +(* + by rewrite-(formatK p{2})-H/=/format size_cat;smt(size_ge0). *) +(* by rewrite-(formatK p{2})-H/=/format size_cat;smt(size_ge0). *) + +(* while( ={glob P,sa,sc,p} *) +(* /\ i{1} - 1 = i{2} - size x{2} *) +(* /\ size x{2} <= i{2} <= size p{2} *) +(* /\ sa{1} = last b0 r0{1} *) +(* /\ (x{2}, n{2}) = parse p{2} *) +(* /\ (x{1}, n{1}) = parse p{1} *) +(* /\ valid x{1} *) +(* /\ 0 < n{1} *) +(* /\ size p{2} = size x{2} + n{2} - 1 *) +(* /\ n0{1} = n{2} *) +(* );auto;last first. *) +(* + progress. *) +(* + by rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. *) +(* + by rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. *) +(* + by rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. *) +(* by move:H2;rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. *) + +(* call(:true);auto;progress;2..5,-2..:smt(last_rcons). *) +(* rewrite -(formatK p{2})-H2/=/format nth_cat nth_nseq_if. *) +(* cut->//=:!i{2} < size x{2} by rewrite/#. *) +(* cut->//=: 0 <= i{2} - size x{2} by rewrite/#. *) +(* rewrite-H. *) +(* cut->/=:i{1} - 1 < n{2} - 1 by rewrite/#. *) +(* by rewrite BlockMonoid.addr0. *) - by inline*;auto;call(:true);auto. - - byequiv (_: ={glob D, glob S} ==> _)=> //=; proc. - call (_: ={glob S} /\ INV IBlockSponge.m{2} ICORE.m{1}). - + proc (INV IBlockSponge.m{2} ICORE.m{1})=> //. - proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. - inline{2} 1.1. - inline*. - while( INV IBlockSponge.m{2} ICORE.m{1} - /\ 0 < i{1} <= n{1} + 1 - /\ ={n,p,r,i} - /\ valid p{1} - /\ 0 < n{1} - /\ (forall j, 0 < j < i{1} => - format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. - rcondt{2}5;auto;1:smt(parseK). - swap{2}6-1;sp. - conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ - (forall j, 0 < j <= n0{1} => - format p0{1} j \in dom IBlockSponge.m{2}));1:smt(parseK formatK). - conseq(: INV IBlockSponge.m{2} ICORE.m{1} /\ (forall (j : int), - 0 < j < n0{1} => format p0{1} j \in dom IBlockSponge.m{2}) /\ - (p0,n0){1} = parse x1{2} /\ (x=x1){2} /\ ={p0,n0} /\ - n0{1} = i{2} /\ 0 <= i0{2} < i{2} - ==> _);1:smt(parseK formatK). - seq 1 1 : (INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < n0{2} /\ - (forall (j : int), 0 < j <= n0{1} => - format p0{1} j \in dom IBlockSponge.m{2}) /\ - (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. - + rcondf{2}1;auto;smt(parseK formatK). - splitwhile{2}1:(i0+1 - format p0{1} j \in dom IBlockSponge.m{2}) /\ - (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. - + rcondt{2}1;1:auto=>/#;rcondf{2}4;1: by progress;sp;if;auto=>/#. - sp;if;auto;progress. - + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. - smt(in_dom formatK). - + move:H3;rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. - smt(in_dom formatK). - + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - smt(getP parseK formatK). - + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - smt(in_dom getP parseK formatK). - + case(j=i0{2} + 1)=>//=;2:rewrite/#. - smt(in_dom getP parseK formatK). - while{2}((p0{2}, n0{2}) = parse x1{2} /\ (x=x1){2} /\ 0 <= i0{2} < n0{2} /\ - INV IBlockSponge.m{2} ICORE.m{1} /\ (p0,n0){1} = parse x1{2} /\ - ={p0,n0} /\ (forall (j : int), 0 < j < n0{2} => - format p0{2} j \in dom IBlockSponge.m{2}))(n0{2}-i0{2});progress. - + sp;rcondf 1;auto;progress. - + rewrite-(formatK x1{hr})-H3/=take_cat addzAC/=/=take_nseq/min/=. - cut->/=:!size p0{hr} + i0{hr} < size p0{hr} by rewrite/#. - by cut/#:=H4 (i0{hr}+1). - + by rewrite/#. - by rewrite/#. - by auto=>/#. +(* by inline*;auto;call(:true);auto. *) + +(* byequiv (_: ={glob D, glob S} ==> _)=> //=; proc. *) +(* call (_: ={glob S} /\ INV IBlockSponge.m{2} ICORE.m{1}). *) +(* + proc (INV IBlockSponge.m{2} ICORE.m{1})=> //. *) +(* proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. *) +(* inline{2} 1.1. *) +(* inline*. *) +(* while( INV IBlockSponge.m{2} ICORE.m{1} *) +(* /\ 0 < i{1} <= n{1} + 1 *) +(* /\ ={n,p,r,i} *) +(* /\ valid p{1} *) +(* /\ 0 < n{1} *) +(* /\ (forall j, 0 < j < i{1} => *) +(* format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. *) +(* rcondt{2}5;auto;1:smt(parseK). *) +(* swap{2}6-1;sp. *) +(* conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ *) +(* (forall j, 0 < j <= n0{1} => *) +(* format p0{1} j \in dom IBlockSponge.m{2}));1:smt(parseK formatK). *) +(* conseq(: INV IBlockSponge.m{2} ICORE.m{1} /\ (forall (j : int), *) +(* 0 < j < n0{1} => format p0{1} j \in dom IBlockSponge.m{2}) /\ *) +(* (p0,n0){1} = parse x1{2} /\ (x=x1){2} /\ ={p0,n0} /\ *) +(* n0{1} = i{2} /\ 0 <= i0{2} < i{2} *) +(* ==> _);1:smt(parseK formatK). *) +(* seq 1 1 : (INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < n0{2} /\ *) +(* (forall (j : int), 0 < j <= n0{1} => *) +(* format p0{1} j \in dom IBlockSponge.m{2}) /\ *) +(* (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. *) +(* + rcondf{2}1;auto;smt(parseK formatK). *) +(* splitwhile{2}1:(i0+1 *) +(* format p0{1} j \in dom IBlockSponge.m{2}) /\ *) +(* (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. *) +(* + rcondt{2}1;1:auto=>/#;rcondf{2}4;1: by progress;sp;if;auto=>/#. *) +(* sp;if;auto;progress. *) +(* + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) +(* cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. *) +(* smt(in_dom formatK). *) +(* + move:H3;rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) +(* cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. *) +(* smt(in_dom formatK). *) +(* + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) +(* smt(getP parseK formatK). *) +(* + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) +(* smt(in_dom getP parseK formatK). *) +(* + case(j=i0{2} + 1)=>//=;2:rewrite/#. *) +(* smt(in_dom getP parseK formatK). *) +(* while{2}((p0{2}, n0{2}) = parse x1{2} /\ (x=x1){2} /\ 0 <= i0{2} < n0{2} /\ *) +(* INV IBlockSponge.m{2} ICORE.m{1} /\ (p0,n0){1} = parse x1{2} /\ *) +(* ={p0,n0} /\ (forall (j : int), 0 < j < n0{2} => *) +(* format p0{2} j \in dom IBlockSponge.m{2}))(n0{2}-i0{2});progress. *) +(* + sp;rcondf 1;auto;progress. *) +(* + rewrite-(formatK x1{hr})-H3/=take_cat addzAC/=/=take_nseq/min/=. *) +(* cut->/=:!size p0{hr} + i0{hr} < size p0{hr} by rewrite/#. *) +(* by cut/#:=H4 (i0{hr}+1). *) +(* + by rewrite/#. *) +(* by rewrite/#. *) +(* by auto=>/#. *) + +(* + proc (INV IBlockSponge.m{2} ICORE.m{1})=> //. *) +(* proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. *) +(* inline{2} 1.1. *) +(* inline*. *) +(* while( INV IBlockSponge.m{2} ICORE.m{1} *) +(* /\ 0 < i{1} <= n{1} + 1 *) +(* /\ ={n,p,r,i} *) +(* /\ valid p{1} *) +(* /\ 0 < n{1} *) +(* /\ (forall j, 0 < j < i{1} => *) +(* format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. *) +(* rcondt{2}5;auto;1:smt(parseK). *) +(* swap{2}6-1;sp. *) +(* conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ *) +(* (forall j, 0 < j <= n0{1} => *) +(* format p0{1} j \in dom IBlockSponge.m{2}));1:smt(parseK formatK). *) +(* conseq(: INV IBlockSponge.m{2} ICORE.m{1} /\ (forall (j : int), *) +(* 0 < j < n0{1} => format p0{1} j \in dom IBlockSponge.m{2}) /\ *) +(* (p0,n0){1} = parse x1{2} /\ (x=x1){2} /\ ={p0,n0} /\ *) +(* n0{1} = i{2} /\ 0 <= i0{2} < i{2} *) +(* ==> _);1:smt(parseK formatK). *) +(* seq 1 1 : (INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < n0{2} /\ *) +(* (forall (j : int), 0 < j <= n0{1} => *) +(* format p0{1} j \in dom IBlockSponge.m{2}) /\ *) +(* (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. *) +(* + rcondf{2}1;auto;smt(parseK formatK). *) +(* splitwhile{2}1:(i0+1 *) +(* format p0{1} j \in dom IBlockSponge.m{2}) /\ *) +(* (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. *) +(* + rcondt{2}1;1:auto=>/#;rcondf{2}4;1: by progress;sp;if;auto=>/#. *) +(* sp;if;auto;progress. *) +(* + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) +(* cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. *) +(* smt(in_dom formatK). *) +(* + move:H3;rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) +(* cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. *) +(* smt(in_dom formatK). *) +(* + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) +(* smt(getP parseK formatK). *) +(* + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) +(* smt(in_dom getP parseK formatK). *) +(* + case(j=i0{2} + 1)=>//=;2:rewrite/#. *) +(* smt(in_dom getP parseK formatK). *) +(* while{2}((p0{2}, n0{2}) = parse x1{2} /\ (x=x1){2} /\ 0 <= i0{2} < n0{2} /\ *) +(* INV IBlockSponge.m{2} ICORE.m{1} /\ (p0,n0){1} = parse x1{2} /\ *) +(* ={p0,n0} /\ (forall (j : int), 0 < j < n0{2} => *) +(* format p0{2} j \in dom IBlockSponge.m{2}))(n0{2}-i0{2});progress. *) +(* + sp;rcondf 1;auto;progress. *) +(* + rewrite-(formatK x1{hr})-H3/=take_cat addzAC/=/=take_nseq/min/=. *) +(* cut->/=:!size p0{hr} + i0{hr} < size p0{hr} by rewrite/#. *) +(* by cut/#:=H4 (i0{hr}+1). *) +(* + by rewrite/#. *) +(* by rewrite/#. *) +(* by auto=>/#. *) + +(* + proc. *) +(* sp;if=> [&1 &2 [#] <*>/#| |] //=. *) +(* inline*;sp;rcondt{1}1;auto. *) +(* swap{2}1;sp. *) +(* conseq(:_==> last Block.b0 r0{1} = oget IBlockSponge.m{2}.[x{2}] /\ *) +(* INV IBlockSponge.m{2} ICORE.m{1});progress. *) +(* seq 1 1 :(last Block.b0 r0{1} = oget IBlockSponge.m{2}.[x{2}] /\ *) +(* INV IBlockSponge.m{2} ICORE.m{1} /\ *) +(* x1{2} \in dom IBlockSponge.m{2});last by rcondf{2}1;auto=>/#. *) +(* conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ i{2} = n{2} /\ *) +(* Some (last Block.b0 r0{1}) = *) +(* IBlockSponge.m{2}.[take (size p + i){2} x{2}]);progress. *) +(* + move:H5;rewrite take_oversize;2:smt(oget_some). *) +(* by rewrite-formatK/=-H/=size_cat size_nseq/#. *) +(* + move:H5;rewrite take_oversize. *) +(* + by rewrite-formatK/=-H/=size_cat size_nseq/#. *) +(* by rewrite in_dom/#. *) +(* while( i{1} = i{2}+1 /\ n0{1} = n{2} /\ p{2} = p0{1} *) +(* /\ valid p0{1} /\ 0 < i{1} /\ i{2} <= n{2} *) +(* /\ (i{2} = n{2} => Some (last Block.b0 r0{1}) = *) +(* IBlockSponge.m{2}.[take (size p{2} + i{2}) x{2}]) *) +(* /\ INV IBlockSponge.m{2} ICORE.m{1} *) +(* /\ parse x{2} = (p0{1},n0{1}));auto;last first. *) +(* + progress=>/#. *) +(* sp;if;auto;smt(take_nseq parseK in_dom formatK take_cat getP last_rcons). *) + +(* by inline*;auto;call(:true);auto;smt(in_dom dom0 in_fset0). *) +(* qed. *) - + proc (INV IBlockSponge.m{2} ICORE.m{1})=> //. - proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. - inline{2} 1.1. - inline*. - while( INV IBlockSponge.m{2} ICORE.m{1} - /\ 0 < i{1} <= n{1} + 1 - /\ ={n,p,r,i} - /\ valid p{1} - /\ 0 < n{1} - /\ (forall j, 0 < j < i{1} => - format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. - rcondt{2}5;auto;1:smt(parseK). - swap{2}6-1;sp. - conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ - (forall j, 0 < j <= n0{1} => - format p0{1} j \in dom IBlockSponge.m{2}));1:smt(parseK formatK). - conseq(: INV IBlockSponge.m{2} ICORE.m{1} /\ (forall (j : int), - 0 < j < n0{1} => format p0{1} j \in dom IBlockSponge.m{2}) /\ - (p0,n0){1} = parse x1{2} /\ (x=x1){2} /\ ={p0,n0} /\ - n0{1} = i{2} /\ 0 <= i0{2} < i{2} - ==> _);1:smt(parseK formatK). - seq 1 1 : (INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < n0{2} /\ - (forall (j : int), 0 < j <= n0{1} => - format p0{1} j \in dom IBlockSponge.m{2}) /\ - (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. - + rcondf{2}1;auto;smt(parseK formatK). - splitwhile{2}1:(i0+1 - format p0{1} j \in dom IBlockSponge.m{2}) /\ - (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. - + rcondt{2}1;1:auto=>/#;rcondf{2}4;1: by progress;sp;if;auto=>/#. - sp;if;auto;progress. - + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. - smt(in_dom formatK). - + move:H3;rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. - smt(in_dom formatK). - + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - smt(getP parseK formatK). - + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - smt(in_dom getP parseK formatK). - + case(j=i0{2} + 1)=>//=;2:rewrite/#. - smt(in_dom getP parseK formatK). - while{2}((p0{2}, n0{2}) = parse x1{2} /\ (x=x1){2} /\ 0 <= i0{2} < n0{2} /\ - INV IBlockSponge.m{2} ICORE.m{1} /\ (p0,n0){1} = parse x1{2} /\ - ={p0,n0} /\ (forall (j : int), 0 < j < n0{2} => - format p0{2} j \in dom IBlockSponge.m{2}))(n0{2}-i0{2});progress. - + sp;rcondf 1;auto;progress. - + rewrite-(formatK x1{hr})-H3/=take_cat addzAC/=/=take_nseq/min/=. - cut->/=:!size p0{hr} + i0{hr} < size p0{hr} by rewrite/#. - by cut/#:=H4 (i0{hr}+1). - + by rewrite/#. - by rewrite/#. - by auto=>/#. - - + proc. - sp;if=> [&1 &2 [#] <*>/#| |] //=. - inline*;sp;rcondt{1}1;auto. - swap{2}1;sp. - conseq(:_==> last Block.b0 r0{1} = oget IBlockSponge.m{2}.[x{2}] /\ - INV IBlockSponge.m{2} ICORE.m{1});progress. - seq 1 1 :(last Block.b0 r0{1} = oget IBlockSponge.m{2}.[x{2}] /\ - INV IBlockSponge.m{2} ICORE.m{1} /\ - x1{2} \in dom IBlockSponge.m{2});last by rcondf{2}1;auto=>/#. - conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ i{2} = n{2} /\ - Some (last Block.b0 r0{1}) = - IBlockSponge.m{2}.[take (size p + i){2} x{2}]);progress. - + move:H5;rewrite take_oversize;2:smt(oget_some). - by rewrite-formatK/=-H/=size_cat size_nseq/#. - + move:H5;rewrite take_oversize. - + by rewrite-formatK/=-H/=size_cat size_nseq/#. - by rewrite in_dom/#. - while( i{1} = i{2}+1 /\ n0{1} = n{2} /\ p{2} = p0{1} - /\ valid p0{1} /\ 0 < i{1} /\ i{2} <= n{2} - /\ (i{2} = n{2} => Some (last Block.b0 r0{1}) = - IBlockSponge.m{2}.[take (size p{2} + i{2}) x{2}]) - /\ INV IBlockSponge.m{2} ICORE.m{1} - /\ parse x{2} = (p0{1},n0{1}));auto;last first. - + progress=>/#. - sp;if;auto;smt(take_nseq parseK in_dom formatK take_cat getP last_rcons). - by inline*;auto;call(:true);auto;smt(in_dom dom0 in_fset0). -qed. end section PROOF. From b9e8cdbbe7262b0f9f5fbdf73b0fe411719ed116 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Fri, 12 Jan 2018 17:41:10 +0100 Subject: [PATCH 251/394] . --- sha3/proof/clean/BlockSponge.eca | 806 +++++++++++-------------------- 1 file changed, 283 insertions(+), 523 deletions(-) diff --git a/sha3/proof/clean/BlockSponge.eca b/sha3/proof/clean/BlockSponge.eca index bf27b16..b2629c8 100644 --- a/sha3/proof/clean/BlockSponge.eca +++ b/sha3/proof/clean/BlockSponge.eca @@ -5,9 +5,8 @@ require (*--*) StdBigop. require import StdOrder. (*---*) import IntOrder. -print StdBigop. -require import NewCommon. -(*---*) import Block DBlock Capacity DCapacity. +require import NewCommon Gconcl. +(*---*) import Block DBlock Capacity DCapacity SLCommon. (*** THEORY PARAMETERS ***) (** Validity of Functionality Queries **) @@ -42,6 +41,16 @@ case(i + 1 <= j)=>hi1j. rewrite take_oversize;smt(size_nseq). qed. +lemma sumid_leq (n m p : int) : 0 <= n => m <= p => sumid n m <= sumid n p. +proof. +move=>Hn0 Hmp. +case(m<=n)=>Hmn. search BIA.big 0 (<=). ++ rewrite BIA.big_geq//. + by apply sumr_ge0_seq=>//=;smt(mem_iota size_ge0). +rewrite(BIA.big_cat_int m n p) 1:/# //. +cut/#:0<=sumid m p. +by apply sumr_ge0_seq=>//=;smt(mem_iota size_ge0). +qed. (*** DEFINITIONS ***) (** Low-Level Definitions **) @@ -95,12 +104,12 @@ module IBlockSponge : FUNCTIONALITY = { proc f(x : block list) = { var bs <- b0; - var i <- 0; + var i <- 1; var (p,n) <- parse x; if (valid p /\ 0 < n) { while (i < n) { - fill_in(take (size p + i) x); + fill_in(format p i); i <- i + 1; } bs <@ fill_in(x); @@ -112,23 +121,19 @@ module IBlockSponge : FUNCTIONALITY = { (* Parametric Simulator *) -module (HiSim (S : Low.SIMULATOR) : SIMULATOR) (F : DFUNCTIONALITY) = { +module (LowSim (S : SIMULATOR) : Low.SIMULATOR) (F : Low.DFUNCTIONALITY) = { module LoF = { - proc f(p : block list, n : int): block list = { + proc f(x : block list) = { var r <- []; - var b; + var b <- b0; var i <- 1; - if (valid p /\ 0 < n) + if (let (p,n) = parse x in valid p /\ 0 < n) { - while (i <= n) { - b <@ F.f(format p i); - r <- rcons r b; - i <- i + 1; - } - + r <@ F.f(parse x); + b <- last b0 r; } - return r; + return b; } } @@ -143,15 +148,17 @@ pred INV (mc : (block list,block) fmap) (mb : (block list * int,block) fmap) = (* Constructed Distinguisher *) module (HiDist (D : Low.DISTINGUISHER) : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + var c : int module HiF = { proc f(p : block list, n : int) = { var r <- []; var b <- b0; var i <- 1; - if (valid p /\ 0 < n) { + if (valid p /\ 0 < n /\ c + sumid (size p) (size p + n) <= max_size) { while(i <= n) { b <@ F.f(format p i); + c <- c + size p + i - 1; r <- rcons r b; i <- i + 1; } @@ -159,55 +166,73 @@ module (HiDist (D : Low.DISTINGUISHER) : DISTINGUISHER) return r; } } + module C = { + proc f (x) = { + var y <- (b0,c0); + if (c + 1 <= max_size) { + c <- c + 1; + y <@ P.f(x); + } + return y; + } + proc fi (x) = { + var y <- (b0,c0); + if (c + 1 <= max_size) { + c <- c + 1; + y <@ P.fi(x); + } + return y; + } + } - proc distinguish = D(HiF,P).distinguish + proc distinguish() = { + var a; + c <- 0; + a <@ D(HiF,C).distinguish(); + return a; + } }. -print Low. +module DFCn (F : Low.FUNCTIONALITY) : Low.FUNCTIONALITY = { + proc init = F.init + proc f(p : block list, n : int) = { + var r : block list <- []; + if(C.c + sumid (size p) (size p + n) <= max_size /\ valid p /\ 0 < n) { + r <@ F.f(p,n); + C.c <- C.c + sumid (size p) (size p + n); + } + return r; + } +}. -module (C (P : PRIMITIVE) : PRIMITIVE) = { - var c : int - proc init() = { - c <- 0; +module DPC (P : PRIMITIVE) : PRIMITIVE = { + proc init () = { + C.init(); P.init(); } proc f(x) = { - var y; - c <- c + 1; - y <@ P.f(x); + var y <- (b0,c0); + if (C.c + 1 <= max_size) { + y <@ P.f(x); + C.c <- C.c + 1; + } return y; } proc fi(x) = { - var y; - c <- c + 1; - y <@ P.fi(x); - return y; - } -}. - -module DFCn (F : Low.FUNCTIONALITY) : Low.FUNCTIONALITY = { - proc init() = { - C.c <- 0; - F.init(); - } - proc f(bs,n) = { - var r : block list <- []; - if (valid bs /\ 0 < n) { - C.c <- C.c + sumid (size bs) (size bs + n); - r <@ F.f(bs,n); + var y <- (b0,c0); + if (C.c + 1 <= max_size) { + y <@ P.fi(x); + C.c <- C.c + 1; } - return r; + return y; } }. module DFC1 (F : FUNCTIONALITY) : FUNCTIONALITY = { - proc init() = { - C.c <- 0; - F.init(); - } - proc f(x) = { + proc init = F.init + proc f(x : block list) = { var b : block <- b0; - if (let (bs,n) = parse x in valid bs /\ 0 < n) { + if (C.c + size x <= max_size) { C.c <- C.c + size x; b <@ F.f(x); } @@ -217,12 +242,12 @@ module DFC1 (F : FUNCTIONALITY) : FUNCTIONALITY = { (*** PROOF forall P D S, - HiDist(D)^{BlockSponge(P),P} ~ HiDist(D)^{IBlockSponge,HiSim(S)(IBlockSponge)} - => D^{Core(P),P} ~ D^{ICore,S(ICore)} ***) + HiDist(D)^{BlockSponge(P),P} ~ HiDist(D)^{IBlockSponge,S(IBlockSponge)} + => D^{Core(P),P} ~ D^{ICore,LowSim(S,ICore)} ***) section PROOF. - declare module P : PRIMITIVE { Low.ICORE, IBlockSponge, HiSim, C }. - declare module S : Low.SIMULATOR { Low.ICORE, IBlockSponge, HiSim, C, P }. - declare module D : Low.DISTINGUISHER { Low.ICORE, IBlockSponge, HiSim, C, P, S }. + declare module P : PRIMITIVE { Low.ICORE, IBlockSponge, HiDist, C }. + declare module S : SIMULATOR { Low.ICORE, IBlockSponge, HiDist, C, P }. + declare module D : Low.DISTINGUISHER { Low.ICORE, IBlockSponge, HiDist, C, P, S }. @@ -299,35 +324,38 @@ section PROOF. } }. + equiv core_blocksponge : - Low.Indif(DFCn(CORE(P)),C(P),D).main ~ - Indif(DFC1(BlockSponge(P)),C(P),HiDist(D)).main : - ={glob D, glob P} ==> ={res, C.c}. + Low.Indif(DFCn(CORE(P)),DPC(P),D).main ~ + Indif(DFC1(BlockSponge(P)),DPC(P),HiDist(D)).main : + ={glob D, glob P} ==> ={res, C.c} /\ ={c}(C,HiDist). proof. - transitivity Low.Indif(DFCn(EagerCORE(P)),C(P),D).main + transitivity Low.Indif(DFCn(EagerCORE(P)),DPC(P),D).main (={glob D, glob P} ==> ={res, C.c}) - (={glob D, glob P} ==> ={res, C.c});progress;1:rewrite/#. + (={glob D, glob P} ==> ={res, C.c} /\ ={c}(C,HiDist));progress;1:rewrite/#. + proc=>/=;call (_: ={glob P, C.c}); first 2 by sim. - + proc=> /=;inline*;sp;if=>//=;sim;sp;if;progress;sim. - by while( ={i,p,glob P} /\ sc{1} = EagerCORE.capa{2} + + proc=> /=;inline*;sp;if;auto;sp;if;auto;sim. + conseq(:_==> sc{1} = EagerCORE.capa{2} /\ sa{1} = EagerCORE.blo{2} + /\ ={glob P});progress. + by while( ={i,p0,glob P} /\ sc{1} = EagerCORE.capa{2} /\ sa{1} = EagerCORE.blo{2});auto;call(:true);auto. by inline*;auto;call(:true);auto. - transitivity Low.Indif(DFCn(EagCORE(P)),C(P),D).main + transitivity Low.Indif(DFCn(EagCORE(P)),DPC(P),D).main (={glob D, glob P} ==> ={res, C.c}) - (={glob D, glob P} ==> ={res, C.c});progress;1:rewrite/#. + (={glob D, glob P} ==> ={res, C.c} /\ ={c}(C,HiDist));progress;1:rewrite/#. + proc. call (_: ={glob P, C.c}); first 2 by sim. - + proc=> /=; sp;if=>//=;inline{1}2;inline{2}2;sp;if;progress;2:auto. - swap{2}2;swap{1}3-2;sp;sim. - conseq(:_==> ={r0,glob P});progress. + + proc=> /=; sp. + if=>//=;auto;inline{1}1;inline{2}1;sp;if;auto;swap{1}3-2;swap{2}2. + conseq(:_==> ={r0,glob P});progress;sp. replace{1} { while ; rest } by { EagerCORE(P).ewhile(); rest; } (={glob P, EagerCORE.order, r0, n0} /\ i{1} = 0 - /\ (EagerCORE.blo,EagerCORE.capa,EagerCORE.order){1} = (b0,c0,p{1}) + /\ (EagerCORE.blo,EagerCORE.capa,EagerCORE.order){1} = (b0,c0,p0{1}) ==> ={r0, glob P}) (={glob P,glob EagerCORE, n0,r0} ==> ={r0, glob P}); progress;1:rewrite/#;first inline*;sim;auto;progress. @@ -338,472 +366,204 @@ section PROOF. by inline*;auto;call(:true);auto. - + proc;call (_: ={glob P, C.c});..2:sim;last first. - + by inline*;auto;call(:true);auto. - proc=> /=; sp;if=>//=;sp;inline*;sp. + + proc;inline{2}3;wp;call (_: ={glob P, C.c} /\ ={c}(C,HiDist)). + + by proc;inline*;sp;auto;if;auto;sp;rcondt{2}1;auto;call(:true);auto. + + by proc;inline*;sp;auto;if;auto;sp;rcondt{2}1;auto;call(:true);auto. + proc;inline*;sp;auto. + if;1:progress=>/#;sp;wp. rcondt{1}1;1:auto=>/#;sp. - rcondt{2}1;1:(auto;smt(parseK formatK));sp. - rcondt{2}1;1:(auto;smt(parseK formatK));sp. - rcondt{2}1;1:(auto;smt(parseK formatK));sp;wp. - while( ={glob P,n} /\ (format p i){2} = rcons EagerCORE.order{1} b0 - /\ i{2} = i{1} + 1 /\ (sa,sc){2} = (EagerCORE.blo,EagerCORE.capa){1} - /\ valid p{2} /\ 0 < n{2} /\ 0 < i{1} /\ r0{1} = r{2} /\ n0{1} = n{2} - /\ C.c{1} = C.c{2} + sumid (size EagerCORE.order{1} + 1)(size p{2} + n{1}) - /\ 1 <= i{1} <= n0{1} - ). - + sp;rcondt{2}1;auto;1:smt(formatK parseK). - sp;rcondt{2}1;auto;1:smt(formatK parseK). - conseq(:_==> ={glob P,C.c} - /\ (sa,sc){2} = (EagerCORE.blo,EagerCORE.capa){1});progress. - + smt(rcons_cat nseqSr). - + smt(rcons_cat nseqSr). - + rewrite H0 size_rcons BIA.big_ltn_cond;2:rewrite/#. - by rewrite-(size_rcons _ b0)-H0 size_cat-addzA/=size_nseq/max H3/=/#. - + smt(rcons_cat nseqSr). - + smt(rcons_cat nseqSr). - + smt(rcons_cat nseqSr). - while(={glob P,C.c} /\ 0 <= i0{2} <= size p0{2} /\ (sa,sc,i0,p0){2} = - (EagerCORE.blo,EagerCORE.capa,i1,EagerCORE.order){1} - /\ i{2} = i{1} + 1 /\ n0{2} = i{2}); - auto;1:call(:true);auto;progress;..2,4..:smt(size_rcons size_ge0 formatK parseK). - admit. - - wp=>/=. - by while(={glob P,i0} /\ (sa,sc,p0){1} = - (EagerCORE.blo,EagerCORE.capa,EagerCORE.order){2}); - auto;1:call(:true);auto; - smt(nseq0 cats0 valid_spec size_ge0 size_eq0 nseq1 cats1). - - by inline*;auto;call(:true);auto. - - byequiv(: ={glob D, glob P} ==>_)=>//=; + rcondt{2}1;1:auto=>/#;sp. + rcondt{2}1;1:auto;progress. + + rewrite size_cat nseq0/=. + cut/#:size p{hr} <= sumid (size p{hr}) (size p{hr} + n{hr}). + rewrite BIA.big_ltn 1:/# /=. + cut/#:=sumr_ge0_seq predT(fun n=>n)(range (size p{hr} + 1) (size p{hr} + n{hr})) _. + smt(mem_iota size_ge0). + sp;rcondt{2}1;1:(auto;smt(parseK formatK));sp. + conseq(:_==> r0{1} = r{2} /\ ={glob P} /\ C.c{2} = HiDist.c{2} + /\ i{1} = n{1} + /\ C.c{1} + sumid (size p{1}) (size p{1} + i{1}) = C.c{2});progress. + while( r0{1} = r{2} /\ ={glob P,p} /\ C.c{2} = HiDist.c{2} + /\ C.c{1} + sumid (size p{1}) (size p{1} + n{2}) <= max_size + /\ C.c{1} + sumid (size p{1}) (size p{1} + i{1}) = C.c{2} + /\ (n0, EagerCORE.blo, EagerCORE.capa){1} = (n, sa, sc){2} + /\ EagerCORE.order{1} = format p{2} i{1} + /\ i{2} = i{1} + 1 + /\ 0 < i{1} <= n0{1} + /\ valid p{2}). + + sp;rcondt{2}1;auto;progress. + + cut/#:sumid (size p{hr}) (size p{hr} + i{m}) + + size (format p{hr} (i{m} + 1)) <= + sumid (size p{hr}) (size p{hr} + n{hr}). + rewrite size_cat size_nseq-addzA/=/max H0/=. + cut/=<-:=BIA.big_int_recr (size p{hr} + i{m})(size p{hr})(fun n=>n)_;1:rewrite/#. + smt(sumid_leq size_ge0). + swap{2}5;sp;auto. + rcondt{2}1;1:(auto;smt(formatK parseK)). + conseq(:_==> ={glob P} /\ + (EagerCORE.blo, EagerCORE.capa){1} = (sa, sc){2});progress. + + rewrite size_cat-(addzA _ 1)/=size_nseq/max H1/=/#. + + rewrite size_cat-(addzA _ 1)/=size_nseq/max H1/=. search BIA.big (+) 1. + by cut/#:=BIA.big_int_recr_cond(size p{2} + i{1})(size p{2})predT(fun n=>n)_;rewrite/#. + + by rewrite rcons_cat-nseqSr 1:/# -addzA/=/format-addzA/=. + + rewrite/#. + + rewrite/#. + + rewrite/#. + while(={glob P} /\ + (i1,EagerCORE.order,EagerCORE.blo,EagerCORE.capa){1} = (i0,p0,sa,sc){2});auto. + + by call(:true);auto. + progress. + + by rewrite rcons_cat-nseqSr 1:/# -addzA/=/format-addzA/=. + + by move:H6;rewrite rcons_cat-nseqSr 1:/# -addzA/=/format-addzA/=. + by move:H6;rewrite rcons_cat-nseqSr 1:/# -addzA/=/format-addzA/=. + wp;conseq(:_==> ={glob P} /\ + (EagerCORE.blo, EagerCORE.capa){1} = (sa, sc){2});progress. + + by rewrite size_cat nseq0/#. + + by rewrite size_cat nseq0/= BIA.big_int1. + + by rewrite/format nseq0 cats0/#. + + rewrite/#. + + rewrite/#. + + rewrite/#. + + rewrite/#. + while(={glob P} /\ + (i0,EagerCORE.order,EagerCORE.blo,EagerCORE.capa){1} = (i0,p0,sa,sc){2});auto. + + by call(:true);auto. + progress. + + by rewrite/format nseq0 cats0/#. + + by rewrite size_cat nseq0/#. + + by move:H3;rewrite size_cat nseq0/#. + by auto;progress. + by inline*;auto;call(:true);auto. qed. - - - - lemma icore_iblocksponge &m : - Pr[Low.Indif(ICORE,S(ICORE),D).main() @ &m: res] = - Pr[Indif(IBlockSponge,HiSim(S,IBlockSponge),HiDist(D)).main() @ &m: res]. + + equiv icore_iblocksponge : + Low.Indif(DFCn(ICORE),DPC(LowSim(S,ICORE)),D).main ~ + Indif(DFC1(IBlockSponge),DPC(S(IBlockSponge)),HiDist(D)).main : + ={glob S, glob D} ==> ={res, C.c} /\ ={c}(C,HiDist). proof. - byequiv(: ={glob D, glob S} ==>_)=>//=;proc. - call (_: ={glob S} /\ INV IBlockSponge.m{2} ICORE.m{1}). - + proc (INV IBlockSponge.m{2} ICORE.m{1})=> //. - proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. - inline{2} 1.1. - inline*. - while( INV IBlockSponge.m{2} ICORE.m{1} - /\ 0 < i{1} <= n{1} + 1 - /\ ={n,p,r,i} - /\ valid p{1} - /\ 0 < n{1} - /\ (forall j, 0 < j < i{1} => - format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. - rcondt{2}5;auto;1:smt(parseK). - swap{2}6-1;sp. + proc;inline{2}3;wp;call (_: + ={glob S,C.c} /\ ={c}(C,HiDist) + /\ INV IBlockSponge.m{2} ICORE.m{1}). + + proc;inline*;sp;if;auto. + swap{2}3;sp;rcondt{2}1;auto. + call(: ={C.c} /\ ={c}(C,HiDist) /\ INV IBlockSponge.m{2} ICORE.m{1})=>/=;auto. + proc=> /=; sp;if;1:progress=>/#;inline*;sp;auto. + rcondt{1}1;1:auto=>/#. + wp. + splitwhile{1}1:i0/#;sp;if;auto=>/#. + rcondf{1}8;progress. + + wp;seq 1:(i0=n);2:(sp;if;auto=>/#). + by while(i0<=n);2:auto=>/#;sp;if;auto=>/#. + wp. conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ - (forall j, 0 < j <= n0{1} => - format p0{1} j \in dom IBlockSponge.m{2}));1:smt(parseK formatK). - conseq(: INV IBlockSponge.m{2} ICORE.m{1} /\ (forall (j : int), - 0 < j < n0{1} => format p0{1} j \in dom IBlockSponge.m{2}) /\ - (p0,n0){1} = parse x1{2} /\ (x=x1){2} /\ ={p0,n0} /\ - n0{1} = i{2} /\ 0 <= i0{2} < i{2} - ==> _);1:smt(parseK formatK). - seq 1 1 : (INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < n0{2} /\ - (forall (j : int), 0 < j <= n0{1} => - format p0{1} j \in dom IBlockSponge.m{2}) /\ - (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. - + rcondf{2}1;auto;smt(parseK formatK). - splitwhile{2}1:(i0+1 - format p0{1} j \in dom IBlockSponge.m{2}) /\ - (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. - + rcondt{2}1;1:auto=>/#;rcondf{2}4;1: by progress;sp;if;auto=>/#. - sp;if;auto;progress. - + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. - smt(in_dom formatK). - + move:H3;rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. - smt(in_dom formatK). - + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - smt(getP parseK formatK). - + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - smt(in_dom getP parseK formatK). - + case(j=i0{2} + 1)=>//=;2:rewrite/#. - smt(in_dom getP parseK formatK). - while{2}((p0{2}, n0{2}) = parse x1{2} /\ (x=x1){2} /\ 0 <= i0{2} < n0{2} /\ - INV IBlockSponge.m{2} ICORE.m{1} /\ (p0,n0){1} = parse x1{2} /\ - ={p0,n0} /\ (forall (j : int), 0 < j < n0{2} => - format p0{2} j \in dom IBlockSponge.m{2}))(n0{2}-i0{2});progress. - + sp;rcondf 1;auto;progress. - + rewrite-(formatK x1{hr})-H3/=take_cat addzAC/=/=take_nseq/min/=. - cut->/=:!size p0{hr} + i0{hr} < size p0{hr} by rewrite/#. - by cut/#:=H4 (i0{hr}+1). - + by rewrite/#. - by rewrite/#. - by auto=>/#. - - + proc (INV IBlockSponge.m{2} ICORE.m{1})=> //. - proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. - inline{2} 1.1. - inline*. - while( INV IBlockSponge.m{2} ICORE.m{1} - /\ 0 < i{1} <= n{1} + 1 - /\ ={n,p,r,i} - /\ valid p{1} - /\ 0 < n{1} - /\ (forall j, 0 < j < i{1} => - format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. - rcondt{2}5;auto;1:smt(parseK). - swap{2}6-1;sp. + ICORE.m{1}.[(p0{1}, n0{1})] = IBlockSponge.m{2}.[x1{2}]);progress. + + smt(last_rcons). + seq 3 2 : (INV IBlockSponge.m{2} ICORE.m{1} /\ + parse x1{2} = (p0{1}, n0{1}) /\ valid p0{1} /\ 0 < n0{1}); + last if;1:smt(in_dom);auto;smt(getP formatK parseK). + wp;conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ i0{1} = n{1});1:progress=>/#. + while( ={n,p} /\ INV IBlockSponge.m{2} ICORE.m{1} + /\ i0{1} = i{2} /\ valid p{1} /\ 0 < n{2} /\ 0 < i0{1} <= n{1}). + + sp;if;auto;smt(in_dom formatK parseK getP). + by auto;smt(in_dom formatK parseK getP). + + + proc;sp;if;auto;swap{2}1;inline{2}1;sp;rcondt{2}1;auto. + call(: ={C.c} /\ C.c{1} = HiDist.c{2}/\ INV IBlockSponge.m{2} ICORE.m{1})=> //. + proc=> /=; sp;if;1:progress=>/#;inline*;sp;auto. + rcondt{1}1;1:auto=>/#. + wp. + splitwhile{1}1:i0/#;sp;if;auto=>/#. + rcondf{1}8;progress. + + wp;seq 1:(i0=n);2:(sp;if;auto=>/#). + by while(i0<=n);2:auto=>/#;sp;if;auto=>/#. + wp. conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ - (forall j, 0 < j <= n0{1} => - format p0{1} j \in dom IBlockSponge.m{2}));1:smt(parseK formatK). - conseq(: INV IBlockSponge.m{2} ICORE.m{1} /\ (forall (j : int), - 0 < j < n0{1} => format p0{1} j \in dom IBlockSponge.m{2}) /\ - (p0,n0){1} = parse x1{2} /\ (x=x1){2} /\ ={p0,n0} /\ - n0{1} = i{2} /\ 0 <= i0{2} < i{2} - ==> _);1:smt(parseK formatK). - seq 1 1 : (INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < n0{2} /\ - (forall (j : int), 0 < j <= n0{1} => - format p0{1} j \in dom IBlockSponge.m{2}) /\ - (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. - + rcondf{2}1;auto;smt(parseK formatK). - splitwhile{2}1:(i0+1 - format p0{1} j \in dom IBlockSponge.m{2}) /\ - (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. - + rcondt{2}1;1:auto=>/#;rcondf{2}4;1: by progress;sp;if;auto=>/#. - sp;if;auto;progress. - + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. - smt(in_dom formatK). - + move:H3;rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. - smt(in_dom formatK). - + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - smt(getP parseK formatK). - + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - smt(in_dom getP parseK formatK). - + case(j=i0{2} + 1)=>//=;2:rewrite/#. - smt(in_dom getP parseK formatK). - while{2}((p0{2}, n0{2}) = parse x1{2} /\ (x=x1){2} /\ 0 <= i0{2} < n0{2} /\ - INV IBlockSponge.m{2} ICORE.m{1} /\ (p0,n0){1} = parse x1{2} /\ - ={p0,n0} /\ (forall (j : int), 0 < j < n0{2} => - format p0{2} j \in dom IBlockSponge.m{2}))(n0{2}-i0{2});progress. - + sp;rcondf 1;auto;progress. - + rewrite-(formatK x1{hr})-H3/=take_cat addzAC/=/=take_nseq/min/=. - cut->/=:!size p0{hr} + i0{hr} < size p0{hr} by rewrite/#. - by cut/#:=H4 (i0{hr}+1). - + by rewrite/#. - by rewrite/#. - by auto=>/#. - - - + proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. - inline{2} 1.1. - inline*. + ICORE.m{1}.[(p0{1}, n0{1})] = IBlockSponge.m{2}.[x1{2}]);progress. + + smt(last_rcons). + seq 3 2 : (INV IBlockSponge.m{2} ICORE.m{1} /\ + parse x1{2} = (p0{1}, n0{1}) /\ valid p0{1} /\ 0 < n0{1}); + last if;1:smt(in_dom);auto;smt(getP formatK parseK). + wp;conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ i0{1} = n{1});1:progress=>/#. + while( ={n,p} /\ INV IBlockSponge.m{2} ICORE.m{1} + /\ i0{1} = i{2} /\ valid p{1} /\ 0 < n{2} /\ 0 < i0{1} <= n{1}). + + sp;if;auto;smt(in_dom formatK parseK getP). + by auto;smt(in_dom formatK parseK getP). + + + proc=> /=; sp;if;1:progress=>/#;inline*;sp;auto. + rcondt{1}1;1:auto=>/#;wp. + conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} + /\ C.c{1} + sumid (size p{1}) (size p{1} + n{1}) = C.c{2} + /\ HiDist.c{2} = C.c{2} /\ r0{1} = r{2});progress. while( INV IBlockSponge.m{2} ICORE.m{1} - /\ 0 < i{1} <= n{1} + 1 - /\ ={n,p,r,i} - /\ valid p{1} - /\ 0 < n{1} + /\ ={i,p,n} /\ n0{1} = n{2} /\ p0{1} = p{1} + /\ valid p{1} /\ 0 < n{1} /\ 0 < i{1} <= n0{1} + 1 + /\ C.c{1} + sumid (size p{1}) (size (format p{1} i{1})) = C.c{2} + /\ C.c{1} + sumid (size p{1}) (size p{1} + n{1}) <= max_size /\ (forall j, 0 < j < i{1} => - format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. - rcondt{2}5;auto;1:smt(parseK). - swap{2}6-1;sp. - conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ - (forall (j : int), 0 < j <= i{2} => - format p{2} j \in dom IBlockSponge.m{2}));1:smt(formatK parseK). - seq 1 1 :(INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < i{2} /\ - (forall (j : int), 0 < j <= i{2} => - format p{2} j \in dom IBlockSponge.m{2}) /\ - x1{2} = format p{2} i{2});last first. - + rcondf{2}1;auto=>/#. - conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ - (forall (j : int), 0 < j <= i{2} => - format p{2} j \in dom IBlockSponge.m{2}));1:smt(formatK parseK). - if{1}. - + splitwhile{2}1:i0+1/#. - by while(i0 i0=n0-1 /\ IBlockSponge.m = m /\ p = p0 /\ i = n0);progress. - + by rewrite take_cat addzAC/=take_nseq/min/=;smt(in_dom formatK parseK). - conseq(:_==> i0=n0-1 /\ IBlockSponge.m = m);1:smt(formatK parseK). - while(0 <= i0 < n0 /\ (forall (j : int), 0 <= j < n0 - 1 => - take (size p0 + j) x \in dom m) /\ IBlockSponge.m = m);progress. - + rcondf 2;auto=>/#. - auto;progress;1,3:smt(formatK parseK). - rewrite take_cat addzAC/=take_nseq. - cut->/=:p0{hr}=p{hr} by smt(parseK formatK). - cut h:i{hr}=n0{hr} by smt(formatK parseK). - by rewrite h;cut/#:=H5 (j+1). - wp;rnd=>/=. - alias{2} 1 m = IBlockSponge.m;sp. - conseq(:_==> i0{2} = n0{2} - 1 /\ IBlockSponge.m{2} = m{2} /\ - x0{2} = format p{2} n0{2});1:smt(formatK parseK getP dom_set in_dom). - wp;conseq(:_==> i0{2} = n0{2} - 1 /\ m{2} = IBlockSponge.m{2});progress. - + rewrite take_cat addzAC/=take_nseq. - cut->/=:p0{2}=p{2} by smt(parseK formatK). - cut h:i{2}=n0{2} by smt(formatK parseK). - by rewrite h min_lel///format;smt(nseq0 cats0). - while{2}(0 <= i0{2} < n0{2} /\ (forall (j : int), 0 <= j < n0{2} - 1 => - take (size p0{2} + j) x{2} \in dom m{2}) /\ - IBlockSponge.m{2} = m{2})(n0{2}-i0{2}-1);progress. - + rcondf 2;auto=>/#. - auto;progress;1,3..:smt(formatK parseK). - rewrite take_cat addzAC/=take_nseq. - cut->/=:p0{2}=p{2} by smt(parseK formatK). - cut h:i{2}=n0{2} by smt(formatK parseK). - by rewrite h;cut/#:=H5 (j+1). - rewrite/=. - alias{2}1 m = IBlockSponge.m;sp. - conseq(:_==> m{2} = IBlockSponge.m{2});1:smt(in_dom formatK parseK). - while{2}(0 <= i0{2} <= n0{2} /\ (forall (j : int), 0 <= j < n0{2} => - take (size p0{2} + j) x{2} \in dom m{2}) /\ - IBlockSponge.m{2} = m{2})(n0{2}-i0{2});progress. - + rcondf 2;auto=>/#. - auto;progress;1,3..:smt(formatK parseK). - rewrite take_cat addzAC/=take_nseq. - cut->/=:p0{2}=p{2} by smt(parseK formatK). - cut h:i{2}=n0{2} by smt(formatK parseK). - rewrite h;case(j=0)=>[->/=|]. - + rewrite-take_nseq take0 cats0. - by cut/=:=H5 1;smt(in_dom parseK formatK nseq0 cats0). - cut->/=:!size p{2} + j < size p{2} by rewrite/#. - by cut:=H5 (j+1);smt(in_dom parseK formatK nseq0 cats0). + format p{2} j \in dom IBlockSponge.m{2}) + /\ HiDist.c{2} = C.c{2} /\ r0{1} = r{2});last first. + + auto;progress. + + rewrite/#. + + by rewrite size_cat nseq0/= BIA.big_geq/=. + + smt(in_dom). + by rewrite size_cat size_nseq max_ler /#. + sp. + rcondt{2}1;1:auto;progress. + + rewrite-addzA. + cut/=<-:=BIA.big_int_recr_cond(size (format p{hr} i{hr}))(size p{hr})predT(fun n=>n)_. + + by rewrite size_cat size_nseq max_ler/#. + cut/#:=sumid_leq(size p{hr})(size (format p{hr} i{hr}) + 1)(size p{hr} + n{hr})_ _;1:smt(size_ge0). + by rewrite size_cat size_nseq max_ler/#. + swap{2}1 7;sp. + wp=>/=. + conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} + /\ (forall (j : int), + 0 < j < i{1} + 1 => format p{2} j \in dom IBlockSponge.m{2}) + /\ oget ICORE.m{1}.[(p1{1}, n1{1})] = bs{2});progress. + + rewrite/#. + + rewrite/#. + + rewrite -addzA;congr=>//. + rewrite 2!size_cat-addzA/=2!size_nseq{1}/max H3/=max_ler 1:/#. + cut/#:=BIA.big_int_recr_cond(size p{2} + (i{2} -1))(size p{2})predT(fun n=>n)_;rewrite/#. + + rewrite -4!addzA;congr=>//;congr. + by rewrite size_cat/=size_nseq max_ler 1:/#. + rcondt{2}1;1:(auto;smt(parseK formatK)). + alias{2}1 m = IBlockSponge.m;sp;wp=>/=;swap{2}2-1;sp. + if{1};2:rcondf{2}2;1:rcondt{2}2;progress. + + while(!(format p0 n0) \in dom IBlockSponge.m /\ 0 < i0 );auto. + + sp;if;auto;progress. + + by rewrite dom_set in_fsetU1 H/=/format;smt(catsI size_nseq). + + by rewrite/#. + + by rewrite/#. + smt(in_dom formatK parseK). + rnd=>//=. + conseq(:_==> INV m{2} ICORE.m{1} /\ IBlockSponge.m{2} = m{2});progress. + + smt(getP formatK parseK in_dom). + + smt(getP formatK parseK in_dom). + + smt(getP formatK parseK in_dom). + conseq(:_==> IBlockSponge.m{2} = m{2});progress. + while{2}(IBlockSponge.m{2} = m{2} /\ 0 < i0{2} /\ (forall (j : int), + 0 < j < n0{2} => format p0{2} j \in dom m{2}))(n0{2}-i0{2});auto. + + sp;rcondf 1;auto=>/#. + smt(parseK formatK). + + conseq(:_==> IBlockSponge.m = m);1:smt(in_dom parseK formatK). + while(IBlockSponge.m = m /\ 0 < i0 /\ (forall (j : int), + 0 < j < n0 => format p0 j \in dom m));auto. + + sp;rcondf 1;auto=>/#. + smt(parseK formatK). + + conseq(:_==> IBlockSponge.m{2} = m{2});1:smt(in_dom parseK formatK). + while{2}(IBlockSponge.m{2} = m{2} /\ 0 < i0{2} /\ (forall (j : int), + 0 < j < n0{2} => format p0{2} j \in dom m{2}))(n0{2}-i0{2});auto. + + sp;rcondf 1;auto=>/#. + smt(parseK formatK). by inline*;auto;call(:true);auto;smt(in_dom dom0 in_fset0). qed. - -(* lemma LiftInd &m: *) -(* `| Pr[Low.Indif(CORE(P),P,D).main() @ &m: res] *) -(* - Pr[Low.Indif(ICORE,S(ICORE),D).main() @ &m: res] | *) -(* = `| Pr[Indif(BlockSponge(P),P,HiDist(D)).main() @ &m: res] *) -(* - Pr[Indif(IBlockSponge,HiSim(S,IBlockSponge),HiDist(D)).main() @ &m: res] |. *) -(* proof. *) -(* do !congr. *) -(* + byequiv (_: ={glob D, glob P} ==> _ )=> //=; proc. *) -(* call (_: ={glob P}); first 2 by sim. *) -(* + proc=> /=; sp;if=>//=;1:progress=>/#. *) -(* inline*;sp;wp. *) -(* rcondt{1}1;progress. *) -(* splitwhile{2}1: i < size x. *) -(* seq 3 1:( ={glob P,sa,sc,p} *) -(* /\ (x,n,p0,n0){1} = (x,n,x,n){2} *) -(* /\ valid x{1} *) -(* /\ i{2} = size x{2} *) -(* /\ i{1} = 1 *) -(* /\ r0{1} = [sa{1}] *) -(* /\ (x{2}, n{2}) = parse p{2} *) -(* /\ 0 < n{1}). *) -(* + wp;conseq(:_==> ={glob P,sa,sc,i,p,x,n} *) -(* /\ i{2} = size x{2} *) -(* /\ (x,n,p0,n0){1} = (x,n,x,n){2});progress. *) -(* while( ={glob P,sa,sc,i,p,x,n} *) -(* /\ (x{2}, n{2}) = parse p{2} *) -(* /\ (p0,n0){1} = (x,n){2} *) -(* /\ 0 <= i{2} <= size x{2} <= size p{2});auto;1:call(:true);auto;progress;2..9,-3..-1:smt(size_ge0). *) -(* + by rewrite-(formatK p{2})-H/=/format nth_cat H3. *) -(* + by rewrite-(formatK p{2})-H/=/format size_cat;smt(size_ge0). *) -(* by rewrite-(formatK p{2})-H/=/format size_cat;smt(size_ge0). *) - -(* while( ={glob P,sa,sc,p} *) -(* /\ i{1} - 1 = i{2} - size x{2} *) -(* /\ size x{2} <= i{2} <= size p{2} *) -(* /\ sa{1} = last b0 r0{1} *) -(* /\ (x{2}, n{2}) = parse p{2} *) -(* /\ (x{1}, n{1}) = parse p{1} *) -(* /\ valid x{1} *) -(* /\ 0 < n{1} *) -(* /\ size p{2} = size x{2} + n{2} - 1 *) -(* /\ n0{1} = n{2} *) -(* );auto;last first. *) -(* + progress. *) -(* + by rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. *) -(* + by rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. *) -(* + by rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. *) -(* by move:H2;rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. *) - -(* call(:true);auto;progress;2..5,-2..:smt(last_rcons). *) -(* rewrite -(formatK p{2})-H2/=/format nth_cat nth_nseq_if. *) -(* cut->//=:!i{2} < size x{2} by rewrite/#. *) -(* cut->//=: 0 <= i{2} - size x{2} by rewrite/#. *) -(* rewrite-H. *) -(* cut->/=:i{1} - 1 < n{2} - 1 by rewrite/#. *) -(* by rewrite BlockMonoid.addr0. *) - -(* by inline*;auto;call(:true);auto. *) - -(* byequiv (_: ={glob D, glob S} ==> _)=> //=; proc. *) -(* call (_: ={glob S} /\ INV IBlockSponge.m{2} ICORE.m{1}). *) -(* + proc (INV IBlockSponge.m{2} ICORE.m{1})=> //. *) -(* proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. *) -(* inline{2} 1.1. *) -(* inline*. *) -(* while( INV IBlockSponge.m{2} ICORE.m{1} *) -(* /\ 0 < i{1} <= n{1} + 1 *) -(* /\ ={n,p,r,i} *) -(* /\ valid p{1} *) -(* /\ 0 < n{1} *) -(* /\ (forall j, 0 < j < i{1} => *) -(* format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. *) -(* rcondt{2}5;auto;1:smt(parseK). *) -(* swap{2}6-1;sp. *) -(* conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ *) -(* (forall j, 0 < j <= n0{1} => *) -(* format p0{1} j \in dom IBlockSponge.m{2}));1:smt(parseK formatK). *) -(* conseq(: INV IBlockSponge.m{2} ICORE.m{1} /\ (forall (j : int), *) -(* 0 < j < n0{1} => format p0{1} j \in dom IBlockSponge.m{2}) /\ *) -(* (p0,n0){1} = parse x1{2} /\ (x=x1){2} /\ ={p0,n0} /\ *) -(* n0{1} = i{2} /\ 0 <= i0{2} < i{2} *) -(* ==> _);1:smt(parseK formatK). *) -(* seq 1 1 : (INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < n0{2} /\ *) -(* (forall (j : int), 0 < j <= n0{1} => *) -(* format p0{1} j \in dom IBlockSponge.m{2}) /\ *) -(* (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. *) -(* + rcondf{2}1;auto;smt(parseK formatK). *) -(* splitwhile{2}1:(i0+1 *) -(* format p0{1} j \in dom IBlockSponge.m{2}) /\ *) -(* (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. *) -(* + rcondt{2}1;1:auto=>/#;rcondf{2}4;1: by progress;sp;if;auto=>/#. *) -(* sp;if;auto;progress. *) -(* + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) -(* cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. *) -(* smt(in_dom formatK). *) -(* + move:H3;rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) -(* cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. *) -(* smt(in_dom formatK). *) -(* + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) -(* smt(getP parseK formatK). *) -(* + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) -(* smt(in_dom getP parseK formatK). *) -(* + case(j=i0{2} + 1)=>//=;2:rewrite/#. *) -(* smt(in_dom getP parseK formatK). *) -(* while{2}((p0{2}, n0{2}) = parse x1{2} /\ (x=x1){2} /\ 0 <= i0{2} < n0{2} /\ *) -(* INV IBlockSponge.m{2} ICORE.m{1} /\ (p0,n0){1} = parse x1{2} /\ *) -(* ={p0,n0} /\ (forall (j : int), 0 < j < n0{2} => *) -(* format p0{2} j \in dom IBlockSponge.m{2}))(n0{2}-i0{2});progress. *) -(* + sp;rcondf 1;auto;progress. *) -(* + rewrite-(formatK x1{hr})-H3/=take_cat addzAC/=/=take_nseq/min/=. *) -(* cut->/=:!size p0{hr} + i0{hr} < size p0{hr} by rewrite/#. *) -(* by cut/#:=H4 (i0{hr}+1). *) -(* + by rewrite/#. *) -(* by rewrite/#. *) -(* by auto=>/#. *) - -(* + proc (INV IBlockSponge.m{2} ICORE.m{1})=> //. *) -(* proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. *) -(* inline{2} 1.1. *) -(* inline*. *) -(* while( INV IBlockSponge.m{2} ICORE.m{1} *) -(* /\ 0 < i{1} <= n{1} + 1 *) -(* /\ ={n,p,r,i} *) -(* /\ valid p{1} *) -(* /\ 0 < n{1} *) -(* /\ (forall j, 0 < j < i{1} => *) -(* format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. *) -(* rcondt{2}5;auto;1:smt(parseK). *) -(* swap{2}6-1;sp. *) -(* conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ *) -(* (forall j, 0 < j <= n0{1} => *) -(* format p0{1} j \in dom IBlockSponge.m{2}));1:smt(parseK formatK). *) -(* conseq(: INV IBlockSponge.m{2} ICORE.m{1} /\ (forall (j : int), *) -(* 0 < j < n0{1} => format p0{1} j \in dom IBlockSponge.m{2}) /\ *) -(* (p0,n0){1} = parse x1{2} /\ (x=x1){2} /\ ={p0,n0} /\ *) -(* n0{1} = i{2} /\ 0 <= i0{2} < i{2} *) -(* ==> _);1:smt(parseK formatK). *) -(* seq 1 1 : (INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < n0{2} /\ *) -(* (forall (j : int), 0 < j <= n0{1} => *) -(* format p0{1} j \in dom IBlockSponge.m{2}) /\ *) -(* (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. *) -(* + rcondf{2}1;auto;smt(parseK formatK). *) -(* splitwhile{2}1:(i0+1 *) -(* format p0{1} j \in dom IBlockSponge.m{2}) /\ *) -(* (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. *) -(* + rcondt{2}1;1:auto=>/#;rcondf{2}4;1: by progress;sp;if;auto=>/#. *) -(* sp;if;auto;progress. *) -(* + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) -(* cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. *) -(* smt(in_dom formatK). *) -(* + move:H3;rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) -(* cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. *) -(* smt(in_dom formatK). *) -(* + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) -(* smt(getP parseK formatK). *) -(* + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) -(* smt(in_dom getP parseK formatK). *) -(* + case(j=i0{2} + 1)=>//=;2:rewrite/#. *) -(* smt(in_dom getP parseK formatK). *) -(* while{2}((p0{2}, n0{2}) = parse x1{2} /\ (x=x1){2} /\ 0 <= i0{2} < n0{2} /\ *) -(* INV IBlockSponge.m{2} ICORE.m{1} /\ (p0,n0){1} = parse x1{2} /\ *) -(* ={p0,n0} /\ (forall (j : int), 0 < j < n0{2} => *) -(* format p0{2} j \in dom IBlockSponge.m{2}))(n0{2}-i0{2});progress. *) -(* + sp;rcondf 1;auto;progress. *) -(* + rewrite-(formatK x1{hr})-H3/=take_cat addzAC/=/=take_nseq/min/=. *) -(* cut->/=:!size p0{hr} + i0{hr} < size p0{hr} by rewrite/#. *) -(* by cut/#:=H4 (i0{hr}+1). *) -(* + by rewrite/#. *) -(* by rewrite/#. *) -(* by auto=>/#. *) - -(* + proc. *) -(* sp;if=> [&1 &2 [#] <*>/#| |] //=. *) -(* inline*;sp;rcondt{1}1;auto. *) -(* swap{2}1;sp. *) -(* conseq(:_==> last Block.b0 r0{1} = oget IBlockSponge.m{2}.[x{2}] /\ *) -(* INV IBlockSponge.m{2} ICORE.m{1});progress. *) -(* seq 1 1 :(last Block.b0 r0{1} = oget IBlockSponge.m{2}.[x{2}] /\ *) -(* INV IBlockSponge.m{2} ICORE.m{1} /\ *) -(* x1{2} \in dom IBlockSponge.m{2});last by rcondf{2}1;auto=>/#. *) -(* conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ i{2} = n{2} /\ *) -(* Some (last Block.b0 r0{1}) = *) -(* IBlockSponge.m{2}.[take (size p + i){2} x{2}]);progress. *) -(* + move:H5;rewrite take_oversize;2:smt(oget_some). *) -(* by rewrite-formatK/=-H/=size_cat size_nseq/#. *) -(* + move:H5;rewrite take_oversize. *) -(* + by rewrite-formatK/=-H/=size_cat size_nseq/#. *) -(* by rewrite in_dom/#. *) -(* while( i{1} = i{2}+1 /\ n0{1} = n{2} /\ p{2} = p0{1} *) -(* /\ valid p0{1} /\ 0 < i{1} /\ i{2} <= n{2} *) -(* /\ (i{2} = n{2} => Some (last Block.b0 r0{1}) = *) -(* IBlockSponge.m{2}.[take (size p{2} + i{2}) x{2}]) *) -(* /\ INV IBlockSponge.m{2} ICORE.m{1} *) -(* /\ parse x{2} = (p0{1},n0{1}));auto;last first. *) -(* + progress=>/#. *) -(* sp;if;auto;smt(take_nseq parseK in_dom formatK take_cat getP last_rcons). *) - -(* by inline*;auto;call(:true);auto;smt(in_dom dom0 in_fset0). *) -(* qed. *) - - end section PROOF. - - -require import Gconcl. -print Gconcl. -print SLCommon.GReal. -print SLCommon.SqueezelessSponge. -print SLCommon.IdealIndif. -print SLCommon.RealIndif. -print SLCommon.DPRestr. -print SLCommon.DISTINGUISHER. -print DISTINGUISHER. -print SLCommon.DFUNCTIONALITY. -print SLCommon.DPRIMITIVE. -print DFUNCTIONALITY. -print DPRIMITIVE. \ No newline at end of file From 09fcb372932f634af72a1ff71dc2756b763e0a0f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Mon, 15 Jan 2018 18:32:49 +0100 Subject: [PATCH 252/394] . --- sha3/proof/Common.ec | 23 +-- sha3/proof/clean/BlockSponge.eca | 256 ++++++++++++++++++++++++++++--- sha3/proof/clean/NewCore.eca | 2 +- sha3/proof/core/Gconcl.ec | 2 +- 4 files changed, 252 insertions(+), 31 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 08fbb22..b509940 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -16,6 +16,7 @@ require (*--*) FinType BitWord RP Monoid. pragma +implicits. + (* -------------------------------------------------------------------- *) op r : { int | 2 <= r } as ge2_r. op c : { int | 0 < c } as gt0_c. @@ -24,6 +25,7 @@ type block. (* ~ bitstrings of size r *) type capacity. (* ~ bitstrings of size c *) (* -------------------------------------------------------------------- *) + lemma gt0_r: 0 < r. proof. by apply/(ltr_le_trans 2)/ge2_r. qed. @@ -36,22 +38,23 @@ clone BitWord as Capacity with op n <- c proof gt0_n by apply/gt0_c - rename "dword" as "cdistr" - "word" as "cap" - "zerow" as "c0". - -op cdistr = Capacity.DWord.dunifin. + rename "word" as "capacity" + "dunifin" as "cdistr" + "Word" as "Capacity" + "zerow" as "c0". +export Capacity DCapacity. clone export BitWord as Block with type word <- block, op n <- r proof gt0_n by apply/gt0_r - rename "word" as "block" - "Word" as "Block" - "zerow" as "b0". + rename "word" as "block" + "Word" as "Block" + "zerow" as "b0" + "dunifin" as "bdistr". +export DBlock. -op bdistr = DBlock.dunifin. (* ------------------------- Auxiliary Lemmas ------------------------- *) @@ -105,7 +108,7 @@ by rewrite (@last_nonempty y z). qed. (*------------------------------ Primitive -----------------------------*) - +print Block. clone export RP as Perm with type t <- block * capacity, op dt <- bdistr `*` cdistr diff --git a/sha3/proof/clean/BlockSponge.eca b/sha3/proof/clean/BlockSponge.eca index b2629c8..0fe48ea 100644 --- a/sha3/proof/clean/BlockSponge.eca +++ b/sha3/proof/clean/BlockSponge.eca @@ -5,8 +5,9 @@ require (*--*) StdBigop. require import StdOrder. (*---*) import IntOrder. -require import NewCommon Gconcl. -(*---*) import Block DBlock Capacity DCapacity SLCommon. +require import Gconcl. +(*---*) import Common SLCommon. +(*---*) import Block DBlock Capacity DCapacity. (*** THEORY PARAMETERS ***) (** Validity of Functionality Queries **) @@ -240,28 +241,35 @@ module DFC1 (F : FUNCTIONALITY) : FUNCTIONALITY = { } }. +module P = Common.Perm.Perm. +print Real_Ideal. (*** PROOF forall P D S, HiDist(D)^{BlockSponge(P),P} ~ HiDist(D)^{IBlockSponge,S(IBlockSponge)} => D^{Core(P),P} ~ D^{ICore,LowSim(S,ICore)} ***) section PROOF. - declare module P : PRIMITIVE { Low.ICORE, IBlockSponge, HiDist, C }. declare module S : SIMULATOR { Low.ICORE, IBlockSponge, HiDist, C, P }. declare module D : Low.DISTINGUISHER { Low.ICORE, IBlockSponge, HiDist, C, P, S }. - - (* FIXME : is this the eager we want ? *) local module EagerCORE (P : Low.PRIMITIVE) = { var order : block list var capa : capacity var blo : block + var map : (block * capacity) list proc init() = { order <- []; capa <- c0; blo <- b0; + map <- []; CORE(P).init(); } + proc g(bi,ci) = { + var bj, cj; + (bj,cj) <@ P.f(bi,ci); + map <- rcons map (bi,ci); + return (bj,cj); + } proc f (p : block list, n : int) = { var r : block list; var i : int; @@ -290,11 +298,42 @@ section PROOF. var i : int <- 0; blo <- b0; capa <- c0; + map <- []; while(i < size order) { - (blo,capa) <@ P.f(blo +^ nth witness order i,capa); + (blo,capa) <@ g(blo +^ nth witness order i,capa); + i <- i + 1; + } + } + proc nwhile(k : int) : block list = { + var i : int <- 1; + var result : block list <- []; + ewhile(); + result <- rcons result EagerCORE.blo; + while(i < k) { + EagerCORE.order <- rcons EagerCORE.order b0; + (blo,capa) <@ g(blo,capa); + result <- rcons result EagerCORE.blo; i <- i + 1; - } + } + return result; } + proc enwhile(k : int) : block list = { + var i : int <- 1; + var m : (block * capacity) list <- []; + var result : block list <- []; + ewhile(); + result <- rcons result EagerCORE.blo; + while(i < k) { + EagerCORE.order <- rcons EagerCORE.order b0; + m <- rcons EagerCORE.map (EagerCORE.blo, EagerCORE.capa); + ewhile(); + EagerCORE.map <- m; + result <- rcons result EagerCORE.blo; + i <- i + 1; + } + return result; + } + }. local module EagCORE (P : Low.PRIMITIVE) : Low.FUNCTIONALITY = { @@ -325,6 +364,138 @@ section PROOF. }. + local equiv nwhile_enwhile (n : int) : + EagerCORE(P).nwhile ~ EagerCORE(P).enwhile : + ={arg, glob P, glob EagerCORE} /\ arg{1} = n ==> ={res, glob P, glob EagerCORE}. + proof. + move:n;elim/natind=>n Hn0. + + by proc;sp;rcondf{1}3;progress;2:rcondf{2}3;progress;-1:sim; + (inline*;wp;while(!i/#). + move=>Hind;case(1 <= n)=>Hn1;last first. + + by proc;sp;rcondf{1}3;2:rcondf{2}3;-1:sim;progress;inline*; + by wp;while(!i/#. + proc. + replace{1} { (!<-) as init ; rest} by { + init; + result <@ EagerCORE(P).nwhile(n); + EagerCORE.order <- rcons EagerCORE.order b0; + (EagerCORE.blo,EagerCORE.capa) <@ EagerCORE(P).g(EagerCORE.blo,EagerCORE.capa); + result <- rcons result EagerCORE.blo; + i <- i + 1; + } + (={glob P, glob EagerCORE} /\ k{1} = n + 1 + ==> ={result, glob P, glob EagerCORE}) + (={glob P, glob EagerCORE} /\ k{2} = n + 1 + ==> ={result, glob P, glob EagerCORE}); + progress;1:rewrite/#. + + sp;inline{2}1;sp;sim. + splitwhile{1}3: i < n. + rcondt{1}4;progress. + + inline*;while(i <= n /\ k = n + 1);1:(sp;if;auto=>/#). + by conseq(:_==> true);1:progress=>/#;auto. + rcondf{1}8;progress. + + inline*;sp;wp;conseq(:_==> i=n);progress. + seq 3 : (i = n);last by sp;if;auto. + while(i <= n);first by sp;if;auto=>/#. + by conseq(:_==> true);2:auto;progress=>/#. + wp;sim. + while(={glob P, glob EagerCORE} /\ (result,i,n){1} = (result0,i0,k0){2} + /\ k{1} = n + 1);1:(inline*;sp;if;auto=>/#). + by wp;conseq(:_==> ={glob P, glob EagerCORE});1:progress=>/#;sim. + + replace{2} { (!<-) as init ; rest} by { + init; + result <@ EagerCORE(P).enwhile(n); + EagerCORE.order <- rcons EagerCORE.order b0; + m <- rcons EagerCORE.map (EagerCORE.blo, EagerCORE.capa); + EagerCORE(P).ewhile(); + EagerCORE.map <- m; + result <- rcons result EagerCORE.blo; + i <- i + 1; + } + (={glob P, glob EagerCORE} + ==> ={result, glob P, glob EagerCORE}) + (={glob P, glob EagerCORE} /\ k{2} = n + 1 + ==> ={result, glob P, glob EagerCORE}); + progress;1:rewrite/#;last first. + + sp;inline{1}1;sp;sim. + splitwhile{2}3: i < n. + rcondt{2}4;2:rcondf{2}10;progress. + + by while(i <= n /\ k = n + 1);by inline*;sp;wp;conseq(:_==> true);auto=>/#. + + wp;conseq(:_==> i = n);progress. + seq 3 : (i = n);last by inline*;conseq(:_==> true);auto. + by while(i <= n /\ k = n + 1); by inline*;sp;wp;conseq(:_==> true);auto=>/#. + sim. + while(={glob P, glob EagerCORE} /\ (result,i,n){2} = (result0,i0,k0){1} + /\ k{2} = n + 1);1:inline*. + + by sp;wp;conseq(:_==> ={glob P, glob EagerCORE} /\ i1{1} = i0{2}); + 1:progress=>/#;sim. + by wp;conseq(:_==> ={glob P, glob EagerCORE});1:progress=>/#;sim. + + replace{2} { (! <- as before); <@ ; after} by { + before; + result <@ EagerCORE(P).nwhile(n); + after; + } + (={glob P, glob EagerCORE} ==> ={result, glob P, glob EagerCORE}) + (={glob P, glob EagerCORE} ==> ={result, glob P, glob EagerCORE}); + progress;1:rewrite/#;last by sim;call(Hind);auto. + + sp;sim. (* TODO : reprendre ici *) + + + seq 1 1 : (={glob P, glob EagerCORE, result} + /\ size EagerCORE.order{2} = size EagerCORE.map{1} + /\ (forall j, 0 <= j < size EagerCORE.map{1} => + nth (b0,c0) EagerCORE.map{1} j \in dom Perm.m{1}) + /\ Some (EagerCORE.blo,EagerCORE.capa){1} = + Perm.m{2}.[last (b0,c0) EagerCORE.map{1}] + /\ (forall j, 0 <= j < size EagerCORE.map{1} - 1 => + let v = nth (b0,c0) EagerCORE.map{1} j in + let (e,f) = nth (b0,c0) EagerCORE.map{1} (j+1) in + let ej = nth witness EagerCORE.order{1} (j+1) in + Perm.m{1}.[v] = Some (e +^ ej, f)));last first. + + inline*. + splitwhile{2}7:i0 < size EagerCORE.order - 1. + rcondt{2}8;2:rcondf{2}16;progress. + + by while(i0 < size EagerCORE.order);1:(sp;if);auto;smt(size_rcons size_ge0). + + wp;conseq(:_==> i0 = size EagerCORE.order-1);1:progress=>/#. + seq 7:(i0 = size EagerCORE.order-1);2:(sp;if;auto=>/#). + by while(i0 <= size EagerCORE.order - 1);1:(sp;if);auto;smt(size_rcons size_ge0). + sim. + swap{1}-3;sim;sp 1 2;wp. + conseq(:_==> ={Perm.m, Perm.mi, EagerCORE.blo, EagerCORE.capa} + /\ i0{2} = size EagerCORE.order{2} - 1);progress. + + by rewrite nth_rcons size_rcons-addzA/=Block.WRing.addr0/#. + while{2}( ={Perm.m, Perm.mi, EagerCORE.order} + /\ 0 <= i0{2} <= size EagerCORE.order{2} - 1 + /\ take i0{2} EagerCORE.map{1} = EagerCORE.map{2} + /\ m{2} = EagerCORE.map{1} + /\ (EagerCORE.blo{2} +^ nth witness EagerCORE.order{2} i0{2}, + EagerCORE.capa{2}) = nth (b0,c0) m{2} i0{2} + /\ size EagerCORE.order{2} = size EagerCORE.map{1} + /\ (forall j, 0 <= j < size EagerCORE.map{1} => + nth (b0,c0) EagerCORE.map{1} j \in dom Perm.m{2}) + /\ (forall j, 0 <= j < size EagerCORE.map{1} - 1 => + let v = nth (b0,c0) EagerCORE.map{1} j in + let e = nth (b0,c0) EagerCORE.map{1} (j+1) in + let ej = nth witness EagerCORE.order{1} (j+1) in + Perm.m{2}.[v] = Some (e.`1 +^ ej, e.`2)) + )(size EagerCORE.order{2} - 1 - i0{2});progress;auto. + + rcondf 4;auto;progress;..4,6:smt(take_nth). + + by rewrite H1;cut->/=:=H4 i0{hr} _;1:rewrite/#; + rewrite oget_some/= -Block.WRing.addrA Block.WRing.addrN Block.WRing.addr0/#. + progress. + + smt(size_rcons size_ge0). + + smt(size_rcons size_ge0). + + smt(size_rcons size_ge0). + + smt(size_rcons size_ge0). + + smt(size_rcons size_ge0). + + smt(size_rcons size_ge0). + + smt(size_rcons size_ge0). + + qed. + equiv core_blocksponge : Low.Indif(DFCn(CORE(P)),DPC(P),D).main ~ Indif(DFC1(BlockSponge(P)),DPC(P),HiDist(D)).main : @@ -334,11 +505,7 @@ section PROOF. (={glob D, glob P} ==> ={res, C.c}) (={glob D, glob P} ==> ={res, C.c} /\ ={c}(C,HiDist));progress;1:rewrite/#. + proc=>/=;call (_: ={glob P, C.c}); first 2 by sim. - + proc=> /=;inline*;sp;if;auto;sp;if;auto;sim. - conseq(:_==> sc{1} = EagerCORE.capa{2} /\ sa{1} = EagerCORE.blo{2} - /\ ={glob P});progress. - by while( ={i,p0,glob P} /\ sc{1} = EagerCORE.capa{2} - /\ sa{1} = EagerCORE.blo{2});auto;call(:true);auto. + + by proc=> /=;inline*;sp;if;auto;sp;if;auto;sim. by inline*;auto;call(:true);auto. @@ -354,21 +521,72 @@ section PROOF. EagerCORE(P).ewhile(); rest; } - (={glob P, EagerCORE.order, r0, n0} /\ i{1} = 0 + (={glob P, EagerCORE.order, r0, p0, n0} /\ i{1} = 0 /\ (EagerCORE.blo,EagerCORE.capa,EagerCORE.order){1} = (b0,c0,p0{1}) ==> ={r0, glob P}) - (={glob P,glob EagerCORE, n0,r0} ==> ={r0, glob P}); + (={glob P,glob EagerCORE, n0, p0, r0} ==> ={r0, glob P}); progress;1:rewrite/#;first inline*;sim;auto;progress. (* eager part *) - admit. + replace{2} {| (<@ as ewhile); rest } by { + rest; + EagerCORE.order <- take (size EagerCORE.order - 1) EagerCORE.order; + ewhile; + } + (={glob P, glob EagerCORE, n0, p0, r0} ==> ={r0, glob P}) + (={glob P, glob EagerCORE, n0, p0, r0} ==> ={r0, glob P}); + progress;1:rewrite/#;last first. + + + + + replace{2} { begin ; while } by { + begin; + while(i < n0) { + EagerCORE(Perm).ewhile(); + EagerCORE.order <- rcons EagerCORE.order b0; + i <- i + 1; + (EagerCORE.blo, EagerCORE.capa) <@ + Perm.f(EagerCORE.blo, EagerCORE.capa); + r0 <- rcons r0 EagerCORE.blo; + } + } + (={glob P, glob EagerCORE, n0, p0, r0} ==> ={r0, glob P}) + (={glob P, glob EagerCORE, n0, p0, r0} ==> ={r0, glob P}); + progress;1:rewrite/#;last first. + + while(={r0, p0, n0, i, glob P, glob EagerCORE}); + last by conseq(:_==> ={r0, p0, n0, i, glob P, glob EagerCORE});progress;sim. + inline*;sp. swap{1}3 2;wp=>//=. + splitwhile{2}1: i0 < size EagerCORE.order - 1. + rcondt{2}2;progress. + + by while(i0 < size EagerCORE.order);1:(sp;if);auto;smt(size_ge0). + rcondf{2}6;progress. + + seq 1 : (i0 = size EagerCORE.order - 1);last by sp;if;auto=>/#. + by while(0 <= i0 < size EagerCORE.order);1:(sp;if);auto;smt(size_ge0 size_rcons). + wp=>/=. + conseq(:_==> ={glob P, glob EagerCORE, r0, x});progress;sim. + wp. + conseq(:_==> ={glob P, EagerCORE.blo, EagerCORE.capa, r0} + /\ i0{2} = size EagerCORE.order{2} - 1 + /\ rcons EagerCORE.order{1} b0 = EagerCORE.order{2});progress. + + by rewrite nth_rcons size_rcons-addzA/=Block.WRing.addr0. + conseq(:_==> ={glob P, EagerCORE.blo, EagerCORE.capa, r0} + /\ i0{2} = size EagerCORE.order{1});progress. + + smt(size_rcons). + while( ={glob P, EagerCORE.blo, EagerCORE.capa, r0, i0} + /\ rcons EagerCORE.order{1} b0 = EagerCORE.order{2} + /\ 0 <= i0{2} <= size EagerCORE.order{1}); + last auto;smt(size_ge0 size_rcons). + wp;conseq(:_==> ={glob P, EagerCORE.blo, EagerCORE.capa, r0, i0} + /\ x0{1} = x{2});1:smt(size_rcons). + by sp;sim;smt(nth_rcons size_rcons). + + by inline*;auto;call(:true);auto. + proc;inline{2}3;wp;call (_: ={glob P, C.c} /\ ={c}(C,HiDist)). - + by proc;inline*;sp;auto;if;auto;sp;rcondt{2}1;auto;call(:true);auto. - + by proc;inline*;sp;auto;if;auto;sp;rcondt{2}1;auto;call(:true);auto. + + by proc;inline*;sp;auto;if;auto;sp;rcondt{2}1;auto;sp;if;auto. + + by proc;inline*;sp;auto;if;auto;sp;rcondt{2}1;auto;sp;if;auto. proc;inline*;sp;auto. if;1:progress=>/#;sp;wp. rcondt{1}1;1:auto=>/#;sp. @@ -411,7 +629,7 @@ section PROOF. + rewrite/#. while(={glob P} /\ (i1,EagerCORE.order,EagerCORE.blo,EagerCORE.capa){1} = (i0,p0,sa,sc){2});auto. - + by call(:true);auto. + + by sp;if;auto. progress. + by rewrite rcons_cat-nseqSr 1:/# -addzA/=/format-addzA/=. + by move:H6;rewrite rcons_cat-nseqSr 1:/# -addzA/=/format-addzA/=. @@ -427,7 +645,7 @@ section PROOF. + rewrite/#. while(={glob P} /\ (i0,EagerCORE.order,EagerCORE.blo,EagerCORE.capa){1} = (i0,p0,sa,sc){2});auto. - + by call(:true);auto. + + by sp;if;auto. progress. + by rewrite/format nseq0 cats0/#. + by rewrite size_cat nseq0/#. diff --git a/sha3/proof/clean/NewCore.eca b/sha3/proof/clean/NewCore.eca index 56a5c10..b42ce5c 100644 --- a/sha3/proof/clean/NewCore.eca +++ b/sha3/proof/clean/NewCore.eca @@ -4,7 +4,7 @@ require import StdOrder Ring DProd. require (*..*) RP Indifferentiability. -require import NewCommon. +require import Common. (*---*) import Block DBlock Capacity DCapacity. (** Validity of Functionality Queries **) diff --git a/sha3/proof/core/Gconcl.ec b/sha3/proof/core/Gconcl.ec index 1215e7e..38284c7 100644 --- a/sha3/proof/core/Gconcl.ec +++ b/sha3/proof/core/Gconcl.ec @@ -5,7 +5,6 @@ require import DProd Dexcepted. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. require (*..*) Gext. -print F.RO. module IF = { proc init = F.RO.init @@ -364,6 +363,7 @@ axiom D_ll : 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] + From e48f07f0b320e64c7236fd62fe052b5a31751538 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 16 Jan 2018 18:47:54 +0100 Subject: [PATCH 253/394] . --- sha3/proof/clean/BlockSponge.eca | 285 ++++++++++++++++++++++++++----- 1 file changed, 244 insertions(+), 41 deletions(-) diff --git a/sha3/proof/clean/BlockSponge.eca b/sha3/proof/clean/BlockSponge.eca index 0fe48ea..016009e 100644 --- a/sha3/proof/clean/BlockSponge.eca +++ b/sha3/proof/clean/BlockSponge.eca @@ -80,7 +80,7 @@ module (BlockSponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { if (valid x /\ 0 < n) { while (i < size p) { - (sa,sc) <@ P.f((sa +^ nth witness p i,sc)); + (sa,sc) <@ P.f((sa +^ nth b0 p i,sc)); i <- i + 1; } } @@ -279,7 +279,7 @@ section PROOF. i <- 0; if (valid p /\ 0 < n) { while(i < size p) { - (blo,capa) <@ P.f(blo +^ nth witness p i, capa); + (blo,capa) <@ P.f(blo +^ nth b0 p i, capa); i <- i + 1; } i <- 1; @@ -300,7 +300,7 @@ section PROOF. capa <- c0; map <- []; while(i < size order) { - (blo,capa) <@ g(blo +^ nth witness order i,capa); + (blo,capa) <@ g(blo +^ nth b0 order i,capa); i <- i + 1; } } @@ -441,20 +441,24 @@ section PROOF. (={glob P, glob EagerCORE} ==> ={result, glob P, glob EagerCORE}); progress;1:rewrite/#;last by sim;call(Hind);auto. - sp;sim. (* TODO : reprendre ici *) - - + sp;sim. + + inline{2}4. seq 1 1 : (={glob P, glob EagerCORE, result} /\ size EagerCORE.order{2} = size EagerCORE.map{1} - /\ (forall j, 0 <= j < size EagerCORE.map{1} => - nth (b0,c0) EagerCORE.map{1} j \in dom Perm.m{1}) - /\ Some (EagerCORE.blo,EagerCORE.capa){1} = - Perm.m{2}.[last (b0,c0) EagerCORE.map{1}] - /\ (forall j, 0 <= j < size EagerCORE.map{1} - 1 => - let v = nth (b0,c0) EagerCORE.map{1} j in - let (e,f) = nth (b0,c0) EagerCORE.map{1} (j+1) in - let ej = nth witness EagerCORE.order{1} (j+1) in - Perm.m{1}.[v] = Some (e +^ ej, f)));last first. + /\ nth (b0,c0) EagerCORE.map{1} 0 = (nth b0 EagerCORE.order{1} 0, c0) + /\ (forall y, y \in EagerCORE.map{1} => y \in dom Perm.m{1}) + /\ (0 = size EagerCORE.map{1} => + (EagerCORE.blo,EagerCORE.capa){1} = (b0,c0)) + /\ (0 < size EagerCORE.map{1} => + (EagerCORE.blo,EagerCORE.capa){1} = + oget Perm.m{1}.[last (b0,c0) EagerCORE.map{1}]) + /\ (forall j, 0 < j < size EagerCORE.map{1} => + let ej = nth (b0,c0) EagerCORE.map{1} j in + let ej1 = nth (b0,c0) EagerCORE.map{1} (j-1) in + let mj = nth b0 EagerCORE.order{1} j in + Perm.m{1}.[ej1] = Some (ej.`1 +^ mj, ej.`2)));last first. + + inline*. splitwhile{2}7:i0 < size EagerCORE.order - 1. rcondt{2}8;2:rcondf{2}16;progress. @@ -467,33 +471,232 @@ section PROOF. conseq(:_==> ={Perm.m, Perm.mi, EagerCORE.blo, EagerCORE.capa} /\ i0{2} = size EagerCORE.order{2} - 1);progress. + by rewrite nth_rcons size_rcons-addzA/=Block.WRing.addr0/#. - while{2}( ={Perm.m, Perm.mi, EagerCORE.order} + alias{2}1 permm = Perm.m. + alias{2}1 permmi = Perm.mi. + sp 0 2;conseq(:_==> m{2} = rcons EagerCORE.map{1} (EagerCORE.blo{1}, EagerCORE.capa{1}) + /\ (EagerCORE.blo{2}, EagerCORE.capa{2}) = last (b0, c0) m{2} + /\ i0{2} = size EagerCORE.order{2} - 1 + /\ (Perm.m = permm /\ Perm.mi = permmi){2});1:smt(last_rcons). + + while{2}(={glob P, EagerCORE.order} + /\ (i0 = 0 => (EagerCORE.blo,EagerCORE.capa)=(b0,c0)){2} /\ 0 <= i0{2} <= size EagerCORE.order{2} - 1 - /\ take i0{2} EagerCORE.map{1} = EagerCORE.map{2} - /\ m{2} = EagerCORE.map{1} - /\ (EagerCORE.blo{2} +^ nth witness EagerCORE.order{2} i0{2}, - EagerCORE.capa{2}) = nth (b0,c0) m{2} i0{2} - /\ size EagerCORE.order{2} = size EagerCORE.map{1} - /\ (forall j, 0 <= j < size EagerCORE.map{1} => - nth (b0,c0) EagerCORE.map{1} j \in dom Perm.m{2}) - /\ (forall j, 0 <= j < size EagerCORE.map{1} - 1 => - let v = nth (b0,c0) EagerCORE.map{1} j in - let e = nth (b0,c0) EagerCORE.map{1} (j+1) in - let ej = nth witness EagerCORE.order{1} (j+1) in - Perm.m{2}.[v] = Some (e.`1 +^ ej, e.`2)) - )(size EagerCORE.order{2} - 1 - i0{2});progress;auto. - + rcondf 4;auto;progress;..4,6:smt(take_nth). - + by rewrite H1;cut->/=:=H4 i0{hr} _;1:rewrite/#; - rewrite oget_some/= -Block.WRing.addrA Block.WRing.addrN Block.WRing.addr0/#. - progress. - + smt(size_rcons size_ge0). - + smt(size_rcons size_ge0). - + smt(size_rcons size_ge0). - + smt(size_rcons size_ge0). - + smt(size_rcons size_ge0). - + smt(size_rcons size_ge0). - + smt(size_rcons size_ge0). - + /\ i0{2} = size EagerCORE.map{2} + /\ size EagerCORE.order{2}-1 = size EagerCORE.map{1} + /\ rcons EagerCORE.map{1} (last (b0,c0) m{2}) = m{2} + /\ nth (b0,c0) EagerCORE.map{1} 0 = (nth b0 EagerCORE.order{1} 0, c0) + /\ (0 < i0{2} => (EagerCORE.blo,EagerCORE.capa){2} = + oget Perm.m{1}.[last (b0,c0) EagerCORE.map{2}]) + /\ EagerCORE.map{2} = take i0{2} m{2} + /\ (Perm.m = permm /\ Perm.mi = permmi){2} + /\ (forall y, y \in EagerCORE.map{1} => y \in dom Perm.m{1}) + /\ (forall j, 0 < j < size EagerCORE.map{1} => + let ej = nth (b0,c0) EagerCORE.map{1} j in + let ej1 = nth (b0,c0) EagerCORE.map{1} (j-1) in + let mj = nth b0 EagerCORE.order{1} j in + Perm.m{1}.[ej1] = Some (ej.`1 +^ mj, ej.`2)) + /\ (EagerCORE.blo{1}, EagerCORE.capa{1}) = last (b0, c0) m{2} + /\ 1 <= size EagerCORE.order{1} + ) + (size EagerCORE.order{2} - 1 - i0{2}); + progress;1:auto. + + sp;rcondf 1;auto;progress. + + case(0Hi0;last first. + + cut h:EagerCORE.map{hr} = [] by smt(size_eq0). + rewrite h/=;cut[->->]:=H _;1:rewrite/#. + by rewrite Block.WRing.add0r H7-H4 mem_nth/#. + cut:=H5 Hi0;rewrite-nth_last. + rewrite {1}H6 nth_take 1,2:/# -H3 nth_rcons-H2. + cut->/=:size EagerCORE.map{hr} - 1 < size EagerCORE.order{hr}-1 by rewrite/#. + rewrite H8 1:/# oget_some/==>[[->->]]. + rewrite -Block.WRing.addrA Block.xorwK Block.WRing.addr0//=. + rewrite H7 H6 size_take;1:smt(size_ge0). + rewrite-H3 size_rcons-H2-addzA/= H11/=. + by cut/#:=mem_nth (b0,c0)EagerCORE.map{m}(size EagerCORE.map{hr})_;smt(size_ge0). + + by rewrite/#. + + by rewrite/#. + + by rewrite/#. + + by rewrite/#. + + smt(size_rcons). + + by rewrite last_rcons/#. + + case(0Hi0;last first. + + cut h:EagerCORE.map{hr} = [] by smt(size_eq0). + rewrite h/=;cut[->->]:=H _;1:rewrite/#. + rewrite Block.WRing.add0r(take_nth(b0,c0)0)/= 2:/#. + smt(size_rcons size_ge0). + rewrite(take_nth(b0,c0));1:smt(size_rcons size_ge0). + congr;cut:=H5 Hi0. + rewrite-nth_last {1}H6 {2}H6. + rewrite nth_take 1,2:/#. + rewrite size_take 1:/#. + rewrite-H3 size_rcons-H2-addzA/=H11/=nth_rcons. + rewrite-H3-H2/=. + cut->/=:size EagerCORE.map{hr} - 1 < size EagerCORE.order{hr} - 1 by rewrite/#. + rewrite H8 1:/# oget_some/==>[[->->]]. + rewrite -Block.WRing.addrA Block.xorwK Block.WRing.addr0//=. + rewrite nth_rcons. + by rewrite-H3-H2/=H12/=/#. + by rewrite/#. + + sp;auto;progress. + + smt(size_ge0 size_rcons). + + smt(size_ge0 size_rcons). + + smt(last_rcons). + + smt(nth_rcons size_ge0). + + smt(take0). + + smt(nth_rcons). + + smt(last_rcons). + + smt(size_ge0 size_rcons). + + smt(size_ge0 size_rcons). + + case(size map_R = 0)=>HmapR. + + cut:=size_eq0 map_R;rewrite HmapR/==>{HmapR}HmapR. + cut Hmap1:(size EagerCORE.map{1} = 0) by rewrite/#. + cut:=size_eq0 EagerCORE.map{1};rewrite Hmap1/==>{Hmap1}Hmap1. + rewrite Hmap1=>/={Hind}. + move:H6;rewrite HmapR/==>[[->->]]. + by move:H2;rewrite Hmap1/==>[[->->]]. + cut h:size order_R = size map_R by rewrite/#. + rewrite last_rcons H12 1:/# -nth_last {1}H13 nth_take 1,2:/#. + rewrite nth_rcons-H9 size_rcons-addzA/=h. + cut->/=:size map_R - 1 < size map_R by rewrite/#. + cut->:size map_R = size EagerCORE.map{1} by rewrite/#. + by rewrite nth_last/#. + smt(size_ge0 size_rcons). + + inline*;wp. + case(size EagerCORE.order{1} = 0). + + sp;rcondf{1}1;2:rcondf{2}1;auto;progress;1,2:smt(size_eq0 size_ge0). + while(={Perm.mi, Perm.m, k0} /\ i0{1} = i1{2} /\ k0{1} = n /\ + ={EagerCORE.map, EagerCORE.blo, EagerCORE.capa, EagerCORE.order} /\ + ={result0} /\ + size EagerCORE.order{2} = size EagerCORE.map{1} /\ + nth (b0, c0) EagerCORE.map{1} 0 = (nth b0 EagerCORE.order{1} 0, c0) /\ + (forall (y1 : block * capacity), + y1 \in EagerCORE.map{1} => y1 \in dom Perm.m{1}) /\ + (0 = size EagerCORE.map{1} => + EagerCORE.blo{1} = b0 && EagerCORE.capa{1} = c0) /\ + (0 < size EagerCORE.map{1} => + (EagerCORE.blo{1}, EagerCORE.capa{1}) = + oget Perm.m{1}.[last (b0, c0) EagerCORE.map{1}]) /\ + forall (j : int), + 0 < j < size EagerCORE.map{1} => + Perm.m{1}.[nth (b0, c0) EagerCORE.map{1} (j - 1)] = + Some + ((nth (b0, c0) EagerCORE.map{1} j).`1 +^ + nth b0 EagerCORE.order{1} j, (nth (b0, c0) EagerCORE.map{1} j).`2));auto;progress. + + sp;if;auto;progress. + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + rewrite getP !nth_rcons. rewrite size_rcons in H11. + cut->/=:j - 1 < size EagerCORE.map{2} by rewrite/#. + rewrite H. + case(jHj/=. + + cut->/=:!nth (b0, c0) EagerCORE.map{2} (j - 1) = + (EagerCORE.blo{2}, EagerCORE.capa{2}) + by cut/#:nth (b0, c0) EagerCORE.map{2} (j - 1) \in dom Perm.m{2};smt(mem_nth). + by rewrite H4//. + cut->/=:j=size EagerCORE.map{2} by rewrite/#. + cut->/=:!nth (b0, c0) EagerCORE.map{2} (size EagerCORE.map{2} - 1) = + (EagerCORE.blo{2}, EagerCORE.capa{2}) by smt(mem_nth). + by rewrite Block.WRing.addr0 H3;smt(get_oget mem_nth nth_last). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + rewrite !nth_rcons. rewrite size_rcons in H9. + cut->/=:j - 1 < size EagerCORE.map{2} by rewrite/#. + rewrite H. + case(jHj/=. + by rewrite H4//. + cut->/=:j=size EagerCORE.map{2} by rewrite/#. + by rewrite Block.WRing.addr0 H3;smt(get_oget mem_nth nth_last). + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons size_eq0). + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + + while(={glob P, glob EagerCORE, result0, k0} + /\ size EagerCORE.order{2} = size EagerCORE.map{1} + /\ i1{2} <= size EagerCORE.order{2} + /\ 1 <= i1{2} <= k0{2} /\ k0{2} = n + /\ i1{2} = i0{1} + /\ nth (b0, c0) EagerCORE.map{1} 0 = (nth b0 EagerCORE.order{1} 0, c0) + /\ (forall (y1 : block * capacity), + y1 \in EagerCORE.map{1} => y1 \in dom Perm.m{1}) + /\ (0 = size EagerCORE.map{1} => + (EagerCORE.blo{1}, EagerCORE.capa{1}) = (b0, c0)) + /\ (0 < size EagerCORE.order{1} => + (EagerCORE.blo{1}, EagerCORE.capa{1}) = + oget Perm.m{1}.[last (b0, c0) EagerCORE.map{1}]) + /\ (forall (j : int), 0 < j < size EagerCORE.map{1} => + let ej = nth (b0, c0) EagerCORE.map{1} j in + let ej1 = nth (b0, c0) EagerCORE.map{1} (j - 1) in + let mj = nth b0 EagerCORE.order{1} j in + Perm.m{1}.[ej1] = Some (ej.`1 +^ mj, ej.`2))). + + sp;if;auto;progress. + + smt(size_rcons size_ge0). + + smt(size_rcons size_ge0). + + smt(size_rcons size_ge0). + + smt(size_rcons size_ge0). + + smt(size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0). + + rewrite getP !nth_rcons. rewrite size_rcons in H14. + cut->/=:j - 1 < size EagerCORE.map{2} by rewrite/#. + rewrite H. + case(jHj/=. + + cut->/=:!nth (b0, c0) EagerCORE.map{2} (j - 1) = + (EagerCORE.blo{2}, EagerCORE.capa{2}) + by cut/#:nth (b0, c0) EagerCORE.map{2} (j - 1) \in dom Perm.m{2};smt(mem_nth). + by rewrite H7//. + cut->/=:j=size EagerCORE.map{2} by rewrite/#. + cut->/=:!nth (b0, c0) EagerCORE.map{2} (size EagerCORE.map{2} - 1) = + (EagerCORE.blo{2}, EagerCORE.capa{2}) by smt(mem_nth). + by rewrite Block.WRing.addr0 H6;smt(get_oget mem_nth nth_last). + + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + rewrite !nth_rcons. rewrite size_rcons in H12. + cut->/=:j - 1 < size EagerCORE.map{2} by rewrite/#. + rewrite H. + case(jHj/=. + by rewrite H7//. + cut->/=:j=size EagerCORE.map{2} by rewrite/#. + by rewrite Block.WRing.addr0 H6;smt(get_oget mem_nth nth_last). + wp;sp. + + conseq(:_==> ={glob P, glob EagerCORE, result0, k0} + /\ size EagerCORE.order{2} = size EagerCORE.map{1} + /\ nth (b0, c0) EagerCORE.map{1} 0 = (nth b0 EagerCORE.order{1} 0, c0) + /\ (forall (y1 : block * capacity), + y1 \in EagerCORE.map{1} => y1 \in dom Perm.m{1}) + /\ (0 = size EagerCORE.map{1} => + (EagerCORE.blo{1}, EagerCORE.capa{1}) = (b0, c0)) + /\ (0 < size EagerCORE.order{1} => + (EagerCORE.blo{1}, EagerCORE.capa{1}) = + oget Perm.m{1}.[last (b0, c0) EagerCORE.map{1}]) + /\ (forall (j : int), 0 < j < size EagerCORE.map{1} => + let ej = nth (b0, c0) EagerCORE.map{1} j in + let ej1 = nth (b0, c0) EagerCORE.map{1} (j - 1) in + let mj = nth b0 EagerCORE.order{1} j in + Perm.m{1}.[ej1] = Some (ej.`1 +^ mj, ej.`2)));1:smt(size_ge0). + + (* TODO : reprendre ici *) + admit. qed. equiv core_blocksponge : From ecc07bc2c4255301dc75c40596256067631cc178 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 18 Jan 2018 16:03:17 +0100 Subject: [PATCH 254/394] minor fixes --- sha3/proof/Common.ec | 11 ++- sha3/proof/clean/BlockSponge.eca | 154 ++++++++++++++++++------------- sha3/proof/core/Gext.eca | 18 ++-- sha3/proof/core/Handle.eca | 26 +++--- 4 files changed, 118 insertions(+), 91 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index b509940..5ec5802 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -33,14 +33,14 @@ lemma ge0_r: 0 <= r. proof. by apply/ltrW/gt0_r. qed. (* -------------------------------------------------------------------- *) -clone BitWord as Capacity with +clone export BitWord as Capacity with type word <- capacity, op n <- c proof gt0_n by apply/gt0_c rename "word" as "capacity" - "dunifin" as "cdistr" "Word" as "Capacity" + (* "dunifin" as "cdistr" *) "zerow" as "c0". export Capacity DCapacity. @@ -51,11 +51,14 @@ clone export BitWord as Block with rename "word" as "block" "Word" as "Block" - "zerow" as "b0" - "dunifin" as "bdistr". + (* "dunifin" as "bdistr" *) + "zerow" as "b0". export DBlock. +op cdistr = DCapacity.dunifin. +op bdistr = DBlock.dunifin. + (* ------------------------- Auxiliary Lemmas ------------------------- *) lemma dvdz_close (n : int) : diff --git a/sha3/proof/clean/BlockSponge.eca b/sha3/proof/clean/BlockSponge.eca index 016009e..bcb4796 100644 --- a/sha3/proof/clean/BlockSponge.eca +++ b/sha3/proof/clean/BlockSponge.eca @@ -696,7 +696,60 @@ section PROOF. Perm.m{1}.[ej1] = Some (ej.`1 +^ mj, ej.`2)));1:smt(size_ge0). (* TODO : reprendre ici *) - admit. + while( ={glob P, glob EagerCORE, result0, k0} + /\ i1{1} = i2{2} + /\ 0 <= i1{1} <= size EagerCORE.order{1} + /\ i1{1} = size EagerCORE.map{1} + /\ (0 < i1{1} => nth (b0, c0) EagerCORE.map{1} 0 = (nth b0 EagerCORE.order{1} 0, c0)) + /\ (forall (y1 : block * capacity), + y1 \in EagerCORE.map{1} => y1 \in dom Perm.m{1}) + /\ (0 = size EagerCORE.map{1} => + (EagerCORE.blo{1}, EagerCORE.capa{1}) = (b0, c0)) + /\ (0 < size EagerCORE.map{1} => + (EagerCORE.blo{1}, EagerCORE.capa{1}) = + oget Perm.m{1}.[last (b0, c0) EagerCORE.map{1}]) + /\ (forall (j : int), 0 < j < size EagerCORE.map{1} => + let ej = nth (b0, c0) EagerCORE.map{1} j in + let ej1 = nth (b0, c0) EagerCORE.map{1} (j - 1) in + let mj = nth b0 EagerCORE.order{1} j in + Perm.m{1}.[ej1] = Some (ej.`1 +^ mj, ej.`2)));last first. + + auto;smt(size_ge0). + sp;if;auto;progress. + + smt(size_ge0). + + smt(size_ge0). + + smt(size_ge0 size_rcons). + + rewrite nth_rcons;case(0Hsize//=;1:rewrite/#. + move:H3;cut->/=[->->]/=:EagerCORE.map{2} = [] by smt(size_eq0 size_ge0). + by rewrite Block.WRing.add0r. + + smt(mem_rcons dom_set in_fsetU1). + + smt(size_rcons). + + smt(size_rcons). + + smt(last_rcons). + + rewrite size_rcons in H12;rewrite getP !nth_rcons. + cut->/=:j - 1 < size EagerCORE.map{2} by rewrite/#. + pose x:=nth _ _ _;pose y:=(_,_). + cut->/=:!x=y by smt(mem_nth). + case(j//=[/#|Hsize]. + rewrite/x/y=>{x y};cut Hj/=:j = size EagerCORE.map{2} by rewrite/#. + rewrite Hj/=. + by rewrite -Block.WRing.addrA Block.xorwK Block.WRing.addr0/=;smt(get_oget mem_nth nth_last). + + smt(size_rcons). + + smt(size_rcons). + + smt(size_rcons). + + rewrite nth_rcons;case(0Hsize//=;1:rewrite/#. + move:H3;cut->/=[->->]/=:EagerCORE.map{2} = [] by smt(size_eq0 size_ge0). + by rewrite Block.WRing.add0r. + + smt(size_rcons mem_rcons). + + smt(size_rcons). + + smt(size_rcons). + + smt(size_rcons last_rcons). + rewrite size_rcons in H10;rewrite !nth_rcons. + cut->/=:j - 1 < size EagerCORE.map{2} by rewrite/#. + case(j//=[/#|Hsize]. + cut Hj/=:j = size EagerCORE.map{2} by rewrite/#. + rewrite Hj/=. + by rewrite -Block.WRing.addrA Block.xorwK Block.WRing.addr0/=;smt(get_oget mem_nth nth_last). + qed. equiv core_blocksponge : @@ -708,7 +761,15 @@ section PROOF. (={glob D, glob P} ==> ={res, C.c}) (={glob D, glob P} ==> ={res, C.c} /\ ={c}(C,HiDist));progress;1:rewrite/#. + proc=>/=;call (_: ={glob P, C.c}); first 2 by sim. - + by proc=> /=;inline*;sp;if;auto;sp;if;auto;sim. + + proc=> /=;inline*;sp;if;auto;sp;if;auto;sim. + conseq(:_==> ={glob P} /\ sc{1} = EagerCORE.capa{2} + /\ sa{1} = EagerCORE.blo{2});progress. + by while(={glob P, p0, i} /\ 0 <= i{1} <= size p0{1} + /\ (i < size p0 => nth witness p0 i = nth b0 p0 i){1} + /\ sc{1} = EagerCORE.capa{2} + /\ sa{1} = EagerCORE.blo{2});1:(sp;if);auto; + smt(nth_onth onth_nth size_ge0). + by inline*;auto;call(:true);auto. @@ -718,72 +779,35 @@ section PROOF. + proc. call (_: ={glob P, C.c}); first 2 by sim. + proc=> /=; sp. - if=>//=;auto;inline{1}1;inline{2}1;sp;if;auto;swap{1}3-2;swap{2}2. - conseq(:_==> ={r0,glob P});progress;sp. - replace{1} { while ; rest } by { - EagerCORE(P).ewhile(); - rest; + if=>//=;auto. + conseq(:_==> ={r,glob P});progress. + transitivity{1} { + EagerCORE.capa <- c0; + EagerCORE.blo <- b0; + EagerCORE.map <- []; + EagerCORE.order <- p; + r <@ EagerCORE(P).nwhile(n); } - (={glob P, EagerCORE.order, r0, p0, n0} /\ i{1} = 0 - /\ (EagerCORE.blo,EagerCORE.capa,EagerCORE.order){1} = (b0,c0,p0{1}) - ==> ={r0, glob P}) - (={glob P,glob EagerCORE, n0, p0, r0} ==> ={r0, glob P}); - progress;1:rewrite/#;first inline*;sim;auto;progress. - - (* eager part *) - replace{2} {| (<@ as ewhile); rest } by { - rest; - EagerCORE.order <- take (size EagerCORE.order - 1) EagerCORE.order; - ewhile; + (={glob P, p, n} /\ valid p{1} /\ 0 < n{1} ==> ={glob P, r}) + (={glob P, p, n} /\ valid p{1} /\ 0 < n{1} ==> ={glob P, r}); + progress;1:rewrite/#. + + inline*;sim. rcondt{1}6;1:auto;sim;sp;sim. + wp;conseq(:_==> ={EagerCORE.blo, EagerCORE.capa, glob P});progress. + by while( ={EagerCORE.blo, EagerCORE.capa, glob P} + /\ (i,p0){1} = (i0,EagerCORE.order){2});1:(sp;if);auto;progress. + transitivity{1} { + EagerCORE.capa <- c0; + EagerCORE.blo <- b0; + EagerCORE.map <- []; + EagerCORE.order <- p; + r <@ EagerCORE(P).enwhile(n); } - (={glob P, glob EagerCORE, n0, p0, r0} ==> ={r0, glob P}) - (={glob P, glob EagerCORE, n0, p0, r0} ==> ={r0, glob P}); + (={glob P, p, n} ==> ={glob P, r}) + (={glob P, p, n} /\ valid p{1} /\ 0 < n{1} ==> ={glob P, r}); progress;1:rewrite/#;last first. - + - - - replace{2} { begin ; while } by { - begin; - while(i < n0) { - EagerCORE(Perm).ewhile(); - EagerCORE.order <- rcons EagerCORE.order b0; - i <- i + 1; - (EagerCORE.blo, EagerCORE.capa) <@ - Perm.f(EagerCORE.blo, EagerCORE.capa); - r0 <- rcons r0 EagerCORE.blo; - } - } - (={glob P, glob EagerCORE, n0, p0, r0} ==> ={r0, glob P}) - (={glob P, glob EagerCORE, n0, p0, r0} ==> ={r0, glob P}); - progress;1:rewrite/#;last first. - + while(={r0, p0, n0, i, glob P, glob EagerCORE}); - last by conseq(:_==> ={r0, p0, n0, i, glob P, glob EagerCORE});progress;sim. - inline*;sp. swap{1}3 2;wp=>//=. - splitwhile{2}1: i0 < size EagerCORE.order - 1. - rcondt{2}2;progress. - + by while(i0 < size EagerCORE.order);1:(sp;if);auto;smt(size_ge0). - rcondf{2}6;progress. - + seq 1 : (i0 = size EagerCORE.order - 1);last by sp;if;auto=>/#. - by while(0 <= i0 < size EagerCORE.order);1:(sp;if);auto;smt(size_ge0 size_rcons). - wp=>/=. - conseq(:_==> ={glob P, glob EagerCORE, r0, x});progress;sim. - wp. - conseq(:_==> ={glob P, EagerCORE.blo, EagerCORE.capa, r0} - /\ i0{2} = size EagerCORE.order{2} - 1 - /\ rcons EagerCORE.order{1} b0 = EagerCORE.order{2});progress. - + by rewrite nth_rcons size_rcons-addzA/=Block.WRing.addr0. - conseq(:_==> ={glob P, EagerCORE.blo, EagerCORE.capa, r0} - /\ i0{2} = size EagerCORE.order{1});progress. - + smt(size_rcons). - while( ={glob P, EagerCORE.blo, EagerCORE.capa, r0, i0} - /\ rcons EagerCORE.order{1} b0 = EagerCORE.order{2} - /\ 0 <= i0{2} <= size EagerCORE.order{1}); - last auto;smt(size_ge0 size_rcons). - wp;conseq(:_==> ={glob P, EagerCORE.blo, EagerCORE.capa, r0, i0} - /\ x0{1} = x{2});1:smt(size_rcons). - by sp;sim;smt(nth_rcons size_rcons). - + - + + by inline*;sim;rcondt{2}6;1:auto;sim;auto. + by sp;exists*n{1};elim*=>n;call(nwhile_enwhile n);auto. + by inline*;auto;call(:true);auto. diff --git a/sha3/proof/core/Gext.eca b/sha3/proof/core/Gext.eca index c7439d7..988a9a2 100644 --- a/sha3/proof/core/Gext.eca +++ b/sha3/proof/core/Gext.eca @@ -2,7 +2,7 @@ pragma -oldip. require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. require import DProd Dexcepted. -(*...*) import Capacity IntOrder Bigreal RealOrder BRA. +(*...*) import Capacity IntOrder Bigreal RealOrder BRA DCapacity. require (*..*) Gcol. @@ -201,7 +201,7 @@ section. + by move=> &m;auto;rewrite /in_dom_with. (* auto=> |>. (* Bug ???? *) *) auto;progress. - + by apply DWord.dunifin_ll. + + by apply sampleto_ll. + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. + case (h = (oget G1.mh{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + by left;rewrite Hh oget_some. @@ -238,7 +238,7 @@ section. + inline *;rcondt{2} 4. + by move=> &m;auto;rewrite /in_dom_with. auto;progress. - + by apply DWord.dunifin_ll. + + by apply sampleto_ll. + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. + case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + by left;rewrite Hh oget_some. @@ -556,8 +556,8 @@ section EXT. + inline *;rcondt{1} 4;1:by auto=>/#. rcondt{2} 5;1:by auto;smt w=(sizeE size_ge0). rcondt{2} 10. by auto;progress;rewrite dom_set !inE. - wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. - rewrite DWord.dunifin_ll /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. + wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. + rewrite/Distr.is_lossless (sampleto_ll 0)/= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. 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. @@ -579,7 +579,7 @@ section EXT. rcondt{2} 5;1:by auto;smt w=(sizeE size_ge0). rcondt{2} 10. by auto;progress;rewrite dom_set !inE. wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. - rewrite DWord.dunifin_ll /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. + rewrite/Distr.is_lossless (sampleto_ll 0) /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. 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. @@ -622,8 +622,8 @@ section EXT. wp; rnd (mem (image snd (dom G1.m `|` dom G1.mi ))); skip=> /> &hr ? ? -> /= ? ?. rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr} `|` dom G1.mi{hr})) - cdistr (1%r/(2^c)%r))//. - + by move=>x _;rewrite DWord.dunifin1E cap_card. + cdistr (1%r/(2^c)%r))//. print DCapacity. + + 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 (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). @@ -634,7 +634,7 @@ section EXT. + proc;rcondt 2;1:by auto. wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x));skip=> /> &hr ??-> /= ??. rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. - + by move=>x _;rewrite DWord.dunifin1E cap_card. + + 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 (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). diff --git a/sha3/proof/core/Handle.eca b/sha3/proof/core/Handle.eca index 9fb10b9..a0c147d 100644 --- a/sha3/proof/core/Handle.eca +++ b/sha3/proof/core/Handle.eca @@ -2,7 +2,7 @@ pragma -oldip. pragma +implicits. require import Core Int Real StdOrder Ring IntExtra. require import List FSet NewFMap Utils Common SLCommon RndO. require import DProd Dexcepted. -(*...*) import Capacity IntOrder. +(*...*) import Capacity IntOrder DCapacity. require ConcreteF. @@ -10,7 +10,7 @@ clone import GenEager as ROhandle with type from <- handle, type to <- capacity, op sampleto <- fun (_:int) => cdistr - proof sampleto_ll by apply DWord.dunifin_ll. + proof sampleto_ll by apply DCapacity.dunifin_ll. module G1(D:DISTINGUISHER) = { var m, mi : smap @@ -1289,7 +1289,7 @@ case @[ambient]: {-1}(Gmi.[(xa,xc)]) (eq_refl Gmi.[(xa,xc)])=> [|[ya' yc'] ^] Gm 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. print Block.DBlock. - smt (@Block.DBlock @Capacity.DWord). + smt (@Block.DBlock @Capacity.DCapacity). have /incli_of_INV <- := inv0; 1:by rewrite Gmi_xaxc. rewrite Pmi_xaxc=> /= [#] <<*>. rcondf{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. @@ -1364,7 +1364,7 @@ proof. by have := size_drop (i{m2} + 1) p{m2};case (drop (i{m2} + 1) p{m2}) => //= [/#| ];smt w=size_ge0. case ((G1.bcol{2} \/ G1.bext{2})). + wp;conseq (_: _ ==> (G1.bcol{2} \/ G1.bext{2}))=> //. - by if{1};if{2};auto;2:(swap{2} 4 -3;auto); smt w=(Block.DBlock.dunifin_ll DWord.dunifin_ll). + by if{1};if{2};auto;2:(swap{2} 4 -3;auto); smt w=(Block.DBlock.dunifin_ll DCapacity.dunifin_ll). conseq (_: (x{1} = (sa{1} +^ head witness p{1}, sc{1}) /\ (p{1} = drop i{2} p{2} /\ 0 <= i{2} <= size p{2} /\ @@ -1782,7 +1782,7 @@ section AUX. + by have /hs_of_INV []:= inv0. by rewrite /in_dom_with in_dom hs_hy2. rcondt{2} 14; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite in_dom pi_x2. - auto=> &1 &2 [#] !<<- -> -> ->> _ /=; rewrite Block.DBlock.dunifin_ll Capacity.DWord.dunifin_ll /=. + auto=> &1 &2 [#] !<<- -> -> ->> _ /=; rewrite Block.DBlock.dunifin_ll Capacity.DCapacity.dunifin_ll /=. move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 !oget_some //=. rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. + by have /hs_of_INV []:= inv0. @@ -1790,22 +1790,22 @@ section AUX. exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). (* lossless PF.f *) + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. - smt (@Block.DBlock @Capacity.DWord). + smt (@Block.DBlock @Capacity.DCapacity). (* lossless and do not reset bad G1.S.f *) + move=> _; proc; if; auto. conseq (_: _ ==> G1.bcol \/ G1.bext); 1:smt (). inline *; if=> //=; wp; rnd predT; wp; rnd predT; auto. - + smt (@Block.DBlock @Capacity.DWord). - smt (@Block.DBlock @Capacity.DWord). + + smt (@Block.DBlock @Capacity.DCapacity). + smt (@Block.DBlock @Capacity.DCapacity). (** proofs for G1.S.fi *) (* equiv PF.P.fi G1.S.fi *) + by conseq (eq_fi D)=> /#. (* lossless PF.P.fi *) + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. - smt (@Block.DBlock @Capacity.DWord). + smt (@Block.DBlock @Capacity.DCapacity). (* lossless and do not reset bad G1.S.fi *) + move=> _; proc; if; 2:by auto. - by wp; do 2!rnd predT; auto => &hr [#]; smt (@Block.DBlock @Capacity.DWord). + by wp; do 2!rnd predT; auto => &hr [#]; smt (@Block.DBlock @Capacity.DCapacity). (** proofs for G1.C.f *) (* equiv PF.C.f G1.C.f *) + proc. @@ -1813,15 +1813,15 @@ section AUX. (* lossless PF.C.f *) + move=> &2 _; proc; inline *; while (true) (size p); auto. + sp; if; 2:by auto; smt (size_behead). - by wp; do 2!rnd predT; auto; smt (size_behead @Block.DBlock @Capacity.DWord). + 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; rnd predT; auto. while (G1.bcol \/ G1.bext) (size p - i)=> [z|]. + if; 1:by auto=> /#. wp; rnd predT; wp; rnd predT; auto. - smt (@Block.DBlock @Capacity.DWord). - by auto; smt (@Block.DBlock @Capacity.DWord). + smt (@Block.DBlock @Capacity.DCapacity). + by auto; smt (@Block.DBlock @Capacity.DCapacity). (* Init ok *) inline *; auto=> />; split=> [|/#]. (do !split; last 3 smt (getP map0P build_hpath_map0)); last 5 by move=> ? ? ? ?; rewrite map0P. From 7068c65bf8d2d97402bb9b5179f5d7084896c3ca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Fri, 19 Jan 2018 18:01:39 +0100 Subject: [PATCH 255/394] . --- sha3/proof/core/Gconcl.ec | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/sha3/proof/core/Gconcl.ec b/sha3/proof/core/Gconcl.ec index 38284c7..bf80aed 100644 --- a/sha3/proof/core/Gconcl.ec +++ b/sha3/proof/core/Gconcl.ec @@ -220,14 +220,14 @@ proof. [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=>/>. - wp;rnd;auto;progress[-split];rewrite DWord.dunifin_ll /= => ?_?->. + wp;rnd;auto;progress[-split];rewrite DCapacity.dunifin_ll /= => ?_?->. by rewrite !getP /= oget_some. case ((mem (dom G1.mh) (x.`1, hx2) /\ 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=>/>. wp;rnd;auto;rnd{1};auto;progress[-split]. - rewrite Block.DBlock.supp_dunifin DWord.dunifin_ll /==> ?_?->. + rewrite Block.DBlock.supp_dunifin DCapacity.dunifin_ll /==> ?_?->. by rewrite !getP /= oget_some. + proc;sp;if=>//. @@ -241,7 +241,7 @@ proof. [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=>/>. - wp;rnd;auto;progress[-split];rewrite DWord.dunifin_ll /= => ?_?->. + wp;rnd;auto;progress[-split];rewrite DCapacity.dunifin_ll /= => ?_?->. by rewrite !getP /= oget_some. proc;sp;if=>//. @@ -342,7 +342,7 @@ proof. call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. sp;sim; while(={i,p,F.RO.m})=>//. inline F.RO.sample F.RO.get;if{1};1:by auto. - by sim;inline *;auto;progress;apply DWord.dunifin_ll. + by sim;inline *;auto;progress;apply DCapacity.dunifin_ll. qed. local equiv G4_Ideal : G4(F.LRO).distinguish ~ IdealIndif(IF,S,DRestr(D)).main : From f7329e3895f80e24e21d2b5fccc25d5be7e2e462 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Mon, 22 Jan 2018 18:17:13 +0100 Subject: [PATCH 256/394] . --- sha3/proof/smart_counter/ConcreteF.eca | 186 ++ .../proof/smart_counter/CoreToBlockSponge.eca | 165 ++ sha3/proof/smart_counter/Gcol.eca | 317 +++ sha3/proof/smart_counter/Gconcl.ec | 384 ++++ sha3/proof/smart_counter/Gext.eca | 675 ++++++ sha3/proof/smart_counter/Handle.eca | 1866 +++++++++++++++++ sha3/proof/smart_counter/IndifPadding.ec | 123 ++ sha3/proof/smart_counter/LazyRO.eca | 22 + sha3/proof/smart_counter/SLCommon.ec | 498 +++++ sha3/proof/smart_counter/Utils.ec | 63 + 10 files changed, 4299 insertions(+) create mode 100644 sha3/proof/smart_counter/ConcreteF.eca create mode 100644 sha3/proof/smart_counter/CoreToBlockSponge.eca create mode 100644 sha3/proof/smart_counter/Gcol.eca create mode 100644 sha3/proof/smart_counter/Gconcl.ec create mode 100644 sha3/proof/smart_counter/Gext.eca create mode 100644 sha3/proof/smart_counter/Handle.eca create mode 100644 sha3/proof/smart_counter/IndifPadding.ec create mode 100644 sha3/proof/smart_counter/LazyRO.eca create mode 100644 sha3/proof/smart_counter/SLCommon.ec create mode 100644 sha3/proof/smart_counter/Utils.ec diff --git a/sha3/proof/smart_counter/ConcreteF.eca b/sha3/proof/smart_counter/ConcreteF.eca new file mode 100644 index 0000000..89fb7ce --- /dev/null +++ b/sha3/proof/smart_counter/ConcreteF.eca @@ -0,0 +1,186 @@ +require import Core Int Real StdOrder Ring Distr IntExtra. +require import List FSet NewFMap Utils Common SLCommon DProd Dexcepted. + +(*...*) import Capacity IntOrder RealOrder. + +require (*..*) Strong_RP_RF_C. + +module PF = { + var m, mi: (state,state) fmap + + proc init(): unit = { + m <- map0; + mi <- map0; + } + + proc f(x : state): state = { + var y1, y2; + + if (!mem (dom m) x) { + 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 (!mem (dom mi) x) { + 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}. + + 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_C 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': PRPt.Distinguisher) (P' : PRPt.Oracles) = { + proc distinguish = DRestr(D,SqueezelessSponge(P'),P').distinguish + }. + + local lemma DoubleBounding (P <: PRPt.StrongPRP {D, C, DBounder}) &m: + Pr[PRPt.IND(P,D').main() @ &m: res] + = Pr[PRPt.IND(P,DBounder(D')).main() @ &m: res]. + proof. + byequiv=> //=; proc; inline *. + wp. + call (_: ={glob C, glob P} /\ DBounder.FBounder.c{2} = C.c{2}). + + proc; sp; if=> //=; inline *. + rcondt{2} 4; 1: by auto=> /#. + by wp; call (_: true); auto. + + proc; sp; if=> //=; inline *. + rcondt{2} 4; 1: by auto=> /#. + by wp; call (_: true); auto. + + proc; sp; if=> //=; inline *. + wp; while ( ={glob C, glob P, p, sa, sc} + /\ C.c{2} <= max_size + /\ DBounder.FBounder.c{2} = C.c{2} - size p{2}). + rcondt{2} 3; 1: by auto; smt w=size_ge0. + by wp; call (_: true); auto=> /#. + by auto; progress; ring. + by wp; call (_: true). + qed. + + local clone import ProdSampling with + type t1 <- block, + op d1 <- bdistr, + type t2 <- capacity, + op d2 <- cdistr. + + lemma Real_Concrete &m : + Pr[GReal(D).main()@ &m: res /\ C.c <= max_size] <= + Pr[CF(DRestr(D)).main()@ &m: res] + (max_size ^ 2)%r * mu dstate (pred1 witness). + proof. + cut->: + 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});last by auto. + + by sim. + by sim. + proc; inline *; wp. + while (={glob Perm,sc,sa,p} /\ (C.c + size p){1} = C.c{2});2:by auto. + by sp; if=> //=; auto=> /> &2 cL /size_behead=> ->; progress; ring. + have p_ll := P_f_ll _ _. + + apply/dprod_ll; split. + + exact/Block.DBlock.dunifin_ll. + exact/Capacity.DCapacity.dunifin_ll. + + apply/fun_ext=>- [] a b; rewrite supp_dprod. + by rewrite/=/predT/=Block.DBlock.dunifin_fu Capacity.DCapacity.dunifin_fu. + have pi_ll := P_fi_ll _ _. + + apply/dprod_ll; split. + + exact/Block.DBlock.dunifin_ll. + exact/Capacity.DCapacity.dunifin_ll. + + apply/fun_ext=>- [] a b; rewrite supp_dprod. + by rewrite/=/predT/=Block.DBlock.dunifin_fu Capacity.DCapacity.dunifin_fu. + have f_ll : islossless SqueezelessSponge(Perm).f. + + proc; while true (size p)=> //=. + * by move=> z; wp; call p_ll; skip=> /> &hr /size_behead /#. + 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[PRPt.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. + by proc; if=> //=; auto. + have ->: Pr[CF(DRestr(D)).main() @ &m: res] + = Pr[PRPt.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(); } + (true ==> ={y1,y2}) + (true ==> (y1,y2){1} = x{2})=> //=. + - by inline *; auto. + transitivity{2} { x <@ S.sample(); } + (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(); } + (true ==> ={y1,y2}) + (true ==> (y1,y2){1} = y{2})=> //=. + - by inline *; auto. + transitivity{2} { y <@ S.sample(); } + (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; call (_: true)=> //=. + + apply D_ll. + + by proc; sp; if=> //=; call O_f_ll; auto. + + by proc; sp; if=> //=; call O_fi_ll; auto. + + proc; inline *; sp; if=> //=; auto. + while true (size p). + * by auto; call O_f_ll; auto=> /#. + by auto; smt w=size_ge0. + by inline *; auto. + qed. + +end section. diff --git a/sha3/proof/smart_counter/CoreToBlockSponge.eca b/sha3/proof/smart_counter/CoreToBlockSponge.eca new file mode 100644 index 0000000..6cf2b01 --- /dev/null +++ b/sha3/proof/smart_counter/CoreToBlockSponge.eca @@ -0,0 +1,165 @@ +(* -------------------------------------------------------------------- *) +require import Option Pair Int Real Distr List FSet NewFMap DProd. +require import BlockSponge. + +require (*--*) Core. + +op max_query : int. +axiom max_query_ge0: 0 <= max_query. + +clone Core as CoreConstruction with + op Block.r <- Common.r, + type Block.block <- Common.block, + op Block.b0 <- Common.Block.b0, + op Block.(+^) <- Common.Block.(+^), + op Block.enum <- Common.Block.blocks, + op Capacity.c <- Common.c, + type Capacity.capacity <- Common.capacity, + op Capacity.c0 <- Common.Capacity.c0, + op Capacity.enum <- Common.Capacity.caps, + op max_query <- max_query +proof *. +realize Block.r_ge0 by exact/Common.ge0_r. +search Common.Block.(+^). +realize Block.addbA by exact/Common.Block.addwA. + +(*---*) import Common Perm. + +(* -------------------------------------------------------------------- *) +section PROOF. + declare module D:DISTINGUISHER { Perm, Gconcl.IF, SLCommon.C, Gconcl.S, BIRO.IRO }. + + module Wrap (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + module WF = { + proc f(x : block list * int) = { + var r <- []; + var p, n; + + (p,n) <- x; + if (valid_block p /\ 0 < n) { + r <@ F.f(x); + } + return r; + } + } + + proc distinguish = D(WF,P).distinguish + }. + + module LowerF (F:DFUNCTIONALITY) = { + proc f(m:block list) : block = { + var r <- []; + var p, n; + + (p,n) <- strip m; + if (p <> []) { + r <- F.f(p,n); + } + return last b0 r; + } + }. + + module RaiseF (F:SLCommon.DFUNCTIONALITY) = { + proc f(m:block list, n:int) : block list = { + var i, r, b; + r <- []; + + if (m <> []) { + i <- 0; + b <- b0; + while (i < n) { + b <- F.f(extend m i); + r <- rcons r b; + i <- i + 1; + + } + } + return r; + } + }. + + module LowerDist(D : DISTINGUISHER, F : SLCommon.DFUNCTIONALITY) = + D(RaiseF(F)). + + module RaiseSim(S:SLCommon.SIMULATOR, F:DFUNCTIONALITY) = + S(LowerF(F)). + + local equiv f_f: BIRO.IRO.f ~ RaiseF(Gconcl.IF).f: + ={n} /\ x{1} = m{2} + /\ 0 <= n{2} + /\ valid_block x{1} + /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) + /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p]) + ==> ={res} + /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) + /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p]). + proof. + proc. rcondt{2} 2; 1:by auto=> /#. rcondt{1} 3; 1:by auto=> /#. + inline *. wp. + while ( ={i,n} /\ x{1} = m{2} /\ bs{1} = r{2} + /\ 0 <= i{2} <= n{2} + /\ last b0 x{1} <> b0 + /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) + /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p])). + + sp; if{1}. + + rcondt{2} 2. + + auto=> &hr [#] !->> i_ge0 i_lt_n wf hinv1 hinv2 _ _ + _ _. + by rewrite !in_dom /= hinv2 extendK. + auto=> &1 &2 /= [#] !->> i_ge0 _ wf inv1 inv2 i_lt_n _. + rewrite in_dom wf=> mp_xi r -> /=; split; first by rewrite !getP. + split=> [/#|]; split=> [p n|p]. + + by rewrite getP; case: ((p,n) = (m,i){2})=> [[#] <*>|_ /inv1]. + rewrite !getP; case: (strip p = (m,i){2})=> [strip_p|]. + + by have := stripK p; rewrite strip_p=> /= ->. + case: (p = extend m{2} i{2})=> [<*>|_ _]; first by rewrite extendK. + exact/inv2. + rcondf{2} 2. + + auto=> &hr [#] !->> i_ge0 i_lt_n wf hinv1 hinv2 _ _ + _ _. + by rewrite !in_dom /= hinv2 extendK. + by auto=> &1 &2; smt (DWord.bdistr_ll extendK). + by auto; smt (valid_block_ends_not_b0). + qed. + + lemma conclusion &m: + `| Pr[RealIndif(Sponge,Perm,Wrap(D)).main() @ &m : res] + - Pr[IdealIndif(BIRO.IRO,RaiseSim(Gconcl.S),Wrap(D)).main() @ &m : res] | + = `| Pr[SLCommon.RealIndif(SLCommon.SqueezelessSponge,SLCommon.PC(Perm),LowerDist(Wrap(D))).main() @ &m : res] + - Pr[SLCommon.IdealIndif(Gconcl.IF,Gconcl.S,LowerDist(Wrap(D))).main() @ &m : res] |. + proof. + do 3?congr. + + byequiv (_: ={glob D} ==> _)=> //; proc; inline *. + call (_: ={glob Perm}). + + by proc; inline *; wp; sim. + + by proc; inline *; wp; sim. + + proc; sp; if=> //. + call (_: ={glob Perm, arg} + /\ valid_block xs{1} /\ 0 < n{1} + ==> ={glob Perm, res}). + + proc. rcondt{1} 4; 1:by auto. rcondt{2} 2; 1:by auto; smt (valid_block_ends_not_b0). + rcondt{2} 4; 1:by auto. + inline{2} SLCommon.SqueezelessSponge(SLCommon.PC(Perm)).f. + seq 4 6: ( ={glob Perm, n, i, sa, sc} + /\ (* some notion of path through Perm.m *) true). + + while ( ={glob Perm, sa, sc} + /\ xs{1} = p{2} + /\ (* some notion of path through Perm.m *) true). + + wp; call (_: ={glob Perm}). + + by inline *; wp; sim. + by auto=> /> /#. + by auto=> &1 &2 [#] !<<- vblock n_gt0 /=; rewrite /extend nseq0 cats0. + (* make sure that the notion of path guarantees that only the last call of each iteration adds something to the map, and that it is exactly the right call *) + admit. + by auto=> /#. + by auto. + byequiv (_: ={glob D} ==> _)=> //; proc; inline *. + call (_: ={glob S} + /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) + /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p]) + /\ (* relation between S.paths and presence in the RO map *) true). + + proc. if=> //=; last by auto. if=> //=; last by auto. + inline *. admit. (* something about valid queries *) + + admit. (* prove: S(LowerF(BIRO.IRO)).fi ~ S(IF).fi *) + + by proc; sp; if=> //; call (f_f); auto=> /#. + by auto=> />; split=> [?|] ?; rewrite !map0P. + qed. +end section PROOF. diff --git a/sha3/proof/smart_counter/Gcol.eca b/sha3/proof/smart_counter/Gcol.eca new file mode 100644 index 0000000..fcc397c --- /dev/null +++ b/sha3/proof/smart_counter/Gcol.eca @@ -0,0 +1,317 @@ +pragma -oldip. +require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. +require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. +require import DProd Dexcepted. +(*...*) import Capacity IntOrder Bigreal RealOrder BRA. + +require (*..*) Handle. + +clone export Handle as Handle0. + export ROhandle. + +(* -------------------------------------------------------------------------- *) + + (* TODO: move this *) + lemma c_gt0r : 0%r < (2^c)%r. + proof. by rewrite lt_fromint;apply /powPos. 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}. + + 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 (rng FRO.m)) <= 2*max_size /\ + count < max_size) { + c <$ cdistr; + G1.bcol <- G1.bcol \/ mem (image fst (rng FRO.m)) c; + count <- count + 1; + } + + return c; + } + + module C = { + + proc f(p : block list): block = { + var sa, sa', sc; + var h, i <- 0; + sa <- b0; + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + 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; + } + 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 (!mem (dom G1.m) x) { + if (!(mem (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 (mem (dom G1.paths) x.`2) { + (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 (mem (dom G1.mh) (x.`1, hx2) /\ + 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 (mem (dom G1.paths) x.`2) { + (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 (!mem (dom G1.mi) x) { + if (!(mem (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 (mem (dom G1.mhi) (x.`1, hx2) /\ + 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 <- map0; + G1.m <- map0; + G1.mi <- map0; + G1.mh <- map0; + G1.mhi <- map0; + G1.bcol <- false; + + FRO.m <- map0.[0 <- (c0, Known)]; + G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.chandle <- 1; + count <- 0; + b <@ DRestr(D,C,S).distinguish(); + return b; + } + }. + + lemma card_rng_set (m:('a,'b)fmap) x y: card(rng m.[x<-y]) <= card(rng m) + 1. + proof. + rewrite rng_set fcardU fcard1. + cut := subset_leq_fcard (rng (rem x m)) (rng m) _;2:smt ml=0 w=fcard_ge0. + rewrite subsetP=> z;apply rng_rem_le. + qed. + + lemma hinv_image handles c: + hinv handles c <> None => + mem (image fst (rng handles)) c. + proof. + case: (hinv handles c) (hinvP handles c)=>//= h[f] Heq. + rewrite imageP;exists (c,f)=>@/fst/=. + by rewrite in_rng;exists (oget (Some h)). + qed. + + local equiv G1col : 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}/\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (rng 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. + seq 2 2 : (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + C.c,x0} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card(rng FRO.m) + 2 <= 2*C.c + 1/\ + Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. + if=>//;last by auto=>/#. + swap{1}[3..5]-2. + seq 3 2:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + C.c,x0,hx2} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (rng FRO.m) + 1 <= 2 * C.c + 1/\ + Gcol.count + 1 <= C.c <= max_size){2}). + + auto;smt ml=0 w=card_rng_set. + seq 2 2: + (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + C.c,x0,hx2,y0} /\ + ((G1.bcol\/hinv FRO.m y0.`2 <> None){1} => G1.bcol{2}) /\ + (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ + Gcol.count <= C.c <= max_size){2});last by auto;smt ml=0 w=card_rng_set. + wp;if=>//;inline Gcol.sample_c. + + rcondt{2}4. + + auto;conseq (_:true)=>//;progress;2: smt ml=0. + by cut /#:= fcard_image_leq fst (rng FRO.m{hr}). + wp;conseq (_: ={p,v,F.RO.m,y1} /\ y2{1}=c{2})=>//;1:smt ml=0 w=hinv_image. + by sim. + rcondt{2}3. + + by auto;progress;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). + auto;progress;smt w=hinv_image. + + + proc;sp 1 1;if=>//. + inline G1(DRestr(D)).S.fi Gcol.S.fi. + seq 2 2 : (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + C.c,x0} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card(rng FRO.m) + 2 <= 2*C.c + 1 /\ + Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. + if=>//;last by auto=>/#. + seq 3 2:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + C.c,x0,hx2} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ + Gcol.count + 1 <= C.c <= max_size){2}). + + by 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,x0,hx2,y0,y1,y2} /\ y0{1} = (y1,y2){1} /\ + ((G1.bcol\/hinv FRO.m y0.`2 <> None){1} => G1.bcol{2}) /\ + (card (rng 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;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). +(* BUG: auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | H]. marche pas ???? *) + auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | X];right;apply hinv_image=> //. + + + proc;sp 1 1;if=>//. + inline G1(DRestr(D)).C.f Gcol.C.f. + seq 5 5: + (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c,b, + p,h,i,sa} /\ i{1}=0 /\ + (G1.bcol{1} => G1.bcol{2}) /\ + card (rng FRO.m{2}) + 2*(size p{2}) <= 2 * C.c{2} + 1 /\ + Gcol.count{2} + size p{2} <= C.c{2} <= max_size);1:by auto=>/#. + wp;call (_: ={F.RO.m});1:by sim. + 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} /\ (i <= size p){1} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (rng FRO.m) + 2*(size p - i) <= 2 * C.c + 1 /\ + Gcol.count + size p - i <= C.c <= max_size){2}); + last by auto; smt ml=0 w=size_ge0. + if=>//;auto;1:smt ml=0 w=size_ge0. + call (_: ={F.RO.m});1:by sim. + inline *;rcondt{2} 2. + + auto;progress;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). + auto;smt ml=0 w=(hinv_image card_rng_set). + + auto;progress;3:by smt ml=0. + + by rewrite rng_set rem0 rng0 fset0U fcard1. + by apply max_ge0. + 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 (rng 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 (rng FRO.m)));skip;progress;2:smt ml=0. + cut->:=(Mu_mem.mu_mem (image fst (rng FRO.m{hr})) cdistr (1%r/(2^c)%r) _). + + move=>x _; rewrite DWord.dunifin1E;do !congr;exact cap_card. + 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. + + 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 G1col=> //#. + 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..bf80aed --- /dev/null +++ b/sha3/proof/smart_counter/Gconcl.ec @@ -0,0 +1,384 @@ +pragma -oldip. +require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. +require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. +require import DProd Dexcepted. +(*...*) import Capacity 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 <- map0; + mi <- map0; + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + paths <- map0.[c0 <- ([<:block>],b0)]; + } + + proc f(x : state): state = { + var p, v, y, y1, y2; + + if (!mem (dom m) x) { + if (mem (dom paths) x.`2) { + (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 (mem (dom paths) x.`2) { + (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 (!mem (dom mi) x) { + 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 }. +local clone import Gext as Gext0. + +local module G3(RO:F.RO) = { + + module C = { + + proc f(p : block list): block = { + var sa, sa'; + var h, i <- 0; + sa <- b0; + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + RO.sample(take (i+1) p); + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + 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; + } + 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 (!mem (dom G1.m) x) { + if (mem (dom G1.paths) x.`2) { + (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.restrK(); + if (!mem (rng handles_) x.`2) { + RRO.set(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <- RRO.restrK(); + hx2 <- oget (hinvc handles_ x.`2); + t <@ RRO.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); + if (mem (dom G1.mh) (x.`1, hx2) /\ 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 (mem (dom G1.paths) x.`2) { + (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 (!mem (dom G1.mi) x) { + handles_ <@ RRO.restrK(); + if (!mem (rng handles_) x.`2) { + RRO.set(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <@ RRO.restrK(); + hx2 <- oget (hinvc handles_ x.`2); + t <@ RRO.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + if (mem (dom G1.mhi) (x.`1, hx2) /\ 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 <- map0; + G1.mi <- map0; + G1.mh <- map0; + G1.mhi <- map0; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + RRO.init(); + RRO.set(0,c0); + G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.chandle <- 1; + b <@ DRestr(D,C,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}); last by auto. + + + proc;sp;if=> //. + call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c});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} /\ + (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}); + 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} + /\ (t = in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1}). + + by inline *;auto=> /> ? _;rewrite Block.DWord.bdistr_ll. + case ((mem (dom G1.mh) (x.`1, hx2) /\ 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=>/>. + wp;rnd;auto;progress[-split];rewrite DCapacity.dunifin_ll /= => ?_?->. + by rewrite !getP /= oget_some. + case ((mem (dom G1.mh) (x.`1, hx2) /\ 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=>/>. + wp;rnd;auto;rnd{1};auto;progress[-split]. + rewrite Block.DBlock.supp_dunifin DCapacity.dunifin_ll /==> ?_?->. + by rewrite !getP /= oget_some. + + + proc;sp;if=>//. + call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c});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} + /\ (t = in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1}). + + by inline *;auto. + case ((mem (dom G1.mhi) (x.`1, hx2) /\ 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=>/>. + wp;rnd;auto;progress[-split];rewrite DCapacity.dunifin_ll /= => ?_?->. + by rewrite !getP /= oget_some. + + proc;sp;if=>//. + call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c});2:by auto. + by inline F.LRO.sample;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 (!mem (dom G1.m) x) { + if (mem (dom G1.paths) x.`2) { + (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 (mem (dom G1.paths) x.`2) { + (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 (!mem (dom G1.mi) x) { + 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 <- map0; + G1.mi <- map0; + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + G1.paths <- map0.[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});last by auto. + + proc;sp;if=>//. + call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. + if => //;2:sim. + seq 3 3: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by sim. + sim;seq 5 0: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by inline *;auto. + by if{1};sim;inline *;auto. + + proc;sp;if=>//. + call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. + if => //;2:sim. + seq 5 0: (={x,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by inline *;auto. + seq 3 3: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by sim. + by if{1};sim;inline *;auto. + proc;sp;if=>//. + call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. + sp;sim; while(={i,p,F.RO.m})=>//. + inline F.RO.sample F.RO.get;if{1};1:by auto. + by sim;inline *;auto;progress;apply 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,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=>//. + 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. + +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)%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]). + + by byequiv (_: ={glob G3, F.RO.m} ==> _)=>//;symmetry;conseq (F.RO_LRO_D G3). + 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]);1:by byequiv (F.RO_LRO_D G4). + by byequiv G4_Ideal. +qed. + +end section. diff --git a/sha3/proof/smart_counter/Gext.eca b/sha3/proof/smart_counter/Gext.eca new file mode 100644 index 0000000..2182665 --- /dev/null +++ b/sha3/proof/smart_counter/Gext.eca @@ -0,0 +1,675 @@ +pragma -oldip. +require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. +require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. +require import DProd Dexcepted. +(*...*) import Capacity IntOrder Bigreal RealOrder BRA DCapacity. + +require (*..*) Gcol. + +clone export Gcol as Gcol0. +print Eager. +op bad_ext (m mi:smap) y = + mem (image snd (dom m)) y \/ + mem (image snd (dom mi)) y. + +op hinvc (m:(handle,capacity)fmap) (c:capacity) = + find (+ pred1 c) m. + +module G2(D:DISTINGUISHER,HS:FRO) = { + + module C = { + + proc f(p : block list): block = { + var sa, sa'; + var h, i <- 0; + sa <- b0; + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + 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; + } + 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 (!mem (dom G1.m) x) { + if (mem (dom G1.paths) x.`2) { + (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.restrK(); + if (!mem (rng handles_) x.`2) { + HS.set(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <- HS.restrK(); + hx2 <- oget (hinvc handles_ x.`2); + t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); + if (mem (dom G1.mh) (x.`1, hx2) /\ 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 (mem (dom G1.paths) x.`2) { + (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 (!mem (dom G1.mi) x) { + handles_ <@ HS.restrK(); + if (!mem (rng handles_) x.`2) { + HS.set(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <@ HS.restrK(); + hx2 <- oget (hinvc handles_ x.`2); + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + t <@ HS.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); + if (mem (dom G1.mhi) (x.`1, hx2) /\ 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 <- map0; + G1.m <- map0; + G1.mi <- map0; + G1.mh <- map0; + G1.mhi <- map0; + G1.bext <- false; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + HS.set(0,c0); + G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.chandle <- 1; + b <@ D(C,S).distinguish(); + return b; + } +}. + +section. + + declare module D: DISTINGUISHER{G1, G2, FRO}. + + op inv_ext (m mi:smap) (FROm:handles) = + exists x h, mem (dom m `|` dom 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: + mem (rng (restr f m)) x <=> mem (rng m) (x,f). + proof. + rewrite !in_rng;split=>-[z]H;exists z;move:H;rewrite restrP; case m.[z]=>//=. + by move=> [t f'] /=;case (f'=f). + qed. + + equiv G1_G2 : G1(D).main ~ Eager(G2(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. + call (_: ={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ + (forall h, mem (dom FRO.m) h => h < G1.chandle){1}). + + proc;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,y} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ + (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ + ! mem (dom G1.m{1}) x{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,y,hx2} /\ + t{2} = (in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1} /\ + (G1.bext{1} => (G1.bext{2} \/ (mem (rng FRO.m) (x.`2, Unknown)){2} \/ + inv_ext G1.m{2} G1.mi{2} FRO.m{2})) /\ + (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ + ! mem (dom G1.m{1}) x{1}). + + inline *;auto=> &ml&mr[#]10!-> Hi Hhand -> /=. + rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. + + rewrite rng_set !inE rem_id 1:/#;move:H0=>[/Hi[->|[x' h][]H1 H2]|->]//. + right;right;exists x' h;rewrite getP. + by cut ->//:(h<> G1.chandle{mr});move:(Hhand h);rewrite in_dom H2 /#. + by move:H0;rewrite dom_set !inE /#. + seq 1 1: (={x,y,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ + forall (h : handle), mem (dom FRO.m{1}) h => h < G1.chandle{1});2:by auto. + if=>//. + + inline *;rcondt{2} 4. + + by move=> &m;auto;rewrite /in_dom_with. +(* auto=> |>. (* Bug ???? *) *) + auto;progress. + + by apply sampleto_ll. + + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. + + case (h = (oget G1.mh{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + + by left;rewrite Hh oget_some. + by right;exists x{2} h;rewrite dom_set getP Hneq !inE. + case (h = (oget G1.mh{2}.[(x{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 !dom_set getP Hneq //=. + by move:Hx;rewrite !inE Hh=>-[]->. + by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. + inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. + rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. + + right;exists x{2} h;rewrite getP dom_set !inE /=. + by move:(H0 h);rewrite in_dom Hh /#. + right;exists x' h;rewrite getP !dom_set !inE;split. + + by move:Hx;rewrite !inE=>-[]->. + by move:(H0 h);rewrite !in_dom Hh /#. + + + proc;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,y,hx2} /\ + t{2} = (in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1} /\ + (G1.bext{1} => (G1.bext{2} \/ (mem (rng FRO.m) (x.`2, Unknown)){2} \/ + inv_ext G1.m{2} G1.mi{2} FRO.m{2})) /\ + (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ + ! mem (dom G1.mi{1}) x{1}). + + inline *;auto=> &ml&mr[#]9!-> Hi Hhand -> /=. + rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. + + rewrite rng_set !inE rem_id 1:/#;move:H4=>[/Hi[->|[x' h][]HH1 HH2]|->]//. + right;right;exists x' h;rewrite getP. + by cut ->//:(h<> G1.chandle{mr});move:(Hhand h);rewrite in_dom HH2 /#. + by move:H4;rewrite dom_set !inE /#. + if=>//. + + inline *;rcondt{2} 4. + + by move=> &m;auto;rewrite /in_dom_with. + auto;progress. + + by apply sampleto_ll. + + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. + + case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + + by left;rewrite Hh oget_some. + by right;exists x{2} h;rewrite !dom_set getP Hneq !inE. + case (h = (oget G1.mhi{2}.[(x{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 !dom_set getP Hneq //=. + by move:Hx;rewrite !inE Hh=>-[]->. + by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. + inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. + rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. + + right;exists x{2} h;rewrite getP !dom_set !inE /=. + by move:(H0 h);rewrite in_dom Hh /#. + right;exists x' h;rewrite getP !dom_set !inE;split. + + by move:Hx;rewrite !inE=>-[]->. + by move:(H0 h);rewrite !in_dom Hh /#. + + + proc; + conseq (_: ={sa,G1.mh,G1.mhi,F.RO.m, G1.chandle, FRO.m} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ + forall (h0 : handle), mem (dom FRO.m{1}) h0 => h0 < G1.chandle{1})=>//. + sp 3 3;call (_: ={F.RO.m});1:by sim. + while (={sa,G1.mh,G1.mhi,F.RO.m,G1.chandle,FRO.m,i,h,sa,p} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ + forall (h0 : handle), mem (dom FRO.m{1}) h0 => h0 < G1.chandle{1})=>//. + if=>//;inline *;1:by auto. + rcondt{2} 3;1:by auto=>/#. + auto=> &m1&m2 [#] 10!-> Hinv Hhand Hi _ _ /= ?->?->/=;split=>/= _;split. + + move:Hinv;rewrite /inv_ext1=> H/H{H}[->//|[x h]];rewrite inE=>-[Hmem Hh]. + by right;exists x h;rewrite !inE Hmem getP;smt w=in_dom. + + by move=>h;rewrite dom_set !inE /#. + + move:Hinv;rewrite /inv_ext1=> H/H{H}[->//|[x h]];rewrite inE=>-[Hmem Hh]. + by right;exists x h;rewrite !inE Hmem getP;smt w=in_dom. + by move=>h;rewrite dom_set !inE /#. + + (* **************** *) + inline *;auto;progress. + by move:H;rewrite dom_set dom0 !inE=>->. + qed. + +end section. + +section EXT. + + declare module D: DISTINGUISHER{C, PF, G1, G2, Perm, RO }. + + local module ReSample = { + var count:int + proc f (h:handle) = { + var c; + c <$ cdistr; + if (size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size) { + G1.bext <- G1.bext \/ mem (image snd (dom G1.m `|` dom G1.mi)) c; + FRO.m.[h] <- (c,Unknown); + count = count + 1 ; + } + } + + proc f1 (x:capacity,h:handle) = { + var c; + c <$ cdistr; + if (size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size) { + G1.bext <- G1.bext \/ mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x) c; + FRO.m.[h] <- (c,Unknown); + count = count + 1; + } + } + + }. + + local module Gext = { + + proc resample () = { + Iter(ReSample).iter (elems (dom (restr Unknown FRO.m))); + } + + module C = { + + proc f(p : block list): block = { + var sa, sa'; + var h, i <- 0; + sa <- b0; + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + 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; + } + 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 (!mem (dom G1.m) x) { + if (mem (dom G1.paths) x.`2) { + (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.restrK(); + if (!mem (rng handles_) x.`2) { + RRO.set(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <- RRO.restrK(); + hx2 <- oget (hinvc handles_ x.`2); + t <@ RRO.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); + if (mem (dom G1.mh) (x.`1, hx2) /\ 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 (mem (dom G1.paths) x.`2) { + (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 (!mem (dom G1.mi) x) { + handles_ <@ RRO.restrK(); + if (!mem (rng handles_) x.`2) { + RRO.set(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <@ RRO.restrK(); + hx2 <- oget (hinvc handles_ x.`2); + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + t <@ RRO.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); + if (mem (dom G1.mhi) (x.`1, hx2) /\ 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 <- map0; + G1.m <- map0; + G1.mi <- map0; + G1.mh <- map0; + G1.mhi <- map0; + G1.bext <- false; + ReSample.count <- 0; + FRO.m <- map0; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + RRO.set(0,c0); + G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.chandle <- 1; + b <@ DRestr(D,C,S).distinguish(); + resample(); + return b; + } + }. + + op inv_lt (m2 mi2:smap) c1 (Fm2:handles) count2 = + size m2 < c1 /\ size mi2 < c1 /\ + count2 + size (restr Unknown Fm2) < c1 /\ + c1 <= max_size. + + op inv_le (m2 mi2:smap) c1 (Fm2:handles) count2 = + size m2 <= c1 /\ size mi2 <= c1 /\ + count2 + size (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): + size (m.[x<-y]) = if mem (dom m) x then size m else size m + 1. + proof. + rewrite sizeE dom_set;case (mem (dom m) x)=> Hx. + + by rewrite fsetUC subset_fsetU_id 2:sizeE 2:// => z; rewrite ?inE. + rewrite fcardUI_indep 1:fset0_eqP=>[z|]. + + by rewrite !inE;case (z=x)=>//. + by rewrite fcard1 sizeE. + qed. + + lemma size_set_le (m:('a,'b)fmap) (x:'a) (y:'b): size (m.[x<-y]) <= size m + 1. + proof. rewrite size_set /#. qed. + + lemma size_rem (m:('a,'b)fmap) (x:'a): + size (rem x m) = if mem (dom m) x then size m - 1 else size m. + proof. + rewrite !sizeE dom_rem fcardD;case (mem (dom m) x)=> Hx. + + by rewrite subset_fsetI_id 2:fcard1// => z;rewrite !inE. + by rewrite (eq_fcards0 (_ `&` _)) 2:// fset0_eqP=>z;rewrite !inE /#. + qed. + + lemma size_rem_le (m:('a,'b)fmap) x : size (rem x m) <= size m. + proof. by rewrite size_rem /#. qed. + + lemma size_ge0 (m:('a,'b)fmap) : 0 <= size m. + proof. rewrite sizeE fcard_ge0. qed. + + lemma size0 : size map0<:'a,'b> = 0. + proof. by rewrite sizeE dom0 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 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} /\ size G1.m{2} <= max_size /\ + size G1.mi{2} <= max_size /\ + ReSample.count{2} + size l{2} <= max_size /\ + ((G1.bext{1} \/ + exists (x : state) (h : handle), + mem (dom G1.m{1} `|` dom 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 getP;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} /\ + inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}). + + proc;sp;if=> //. + 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 9 : (={x, y, 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});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} /\ + 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} /\ + 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.in_dom; wp;call (_: ={FRO.m});1:by sim. + inline RRO.restrK;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=(sizeE size_ge0). + rcondt{2} 10. by auto;progress;rewrite dom_set !inE. + wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. + rewrite/Distr.is_lossless (sampleto_ll 0)/= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. + 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=> //. + 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.in_dom; auto;call (_: ={FRO.m});1:by sim. + inline RRO.restrK;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=(sizeE size_ge0). + rcondt{2} 10. by auto;progress;rewrite dom_set !inE. + wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. + rewrite/Distr.is_lossless (sampleto_ll 0) /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. + 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=>//. + inline G2(DRestr(D), RRO).C.f Gext.C.f. + sp 5 5;elim *=> c0L c0R. + wp;call (_: ={F.RO.m});1:by sim. + while (={i,p,G1.mh,sa,h,FRO.m,F.RO.m,G1.mh,G1.mhi,G1.chandle} /\ 0 <= i{1} <= size p{1}/\ + c0R + size p{1} <= max_size /\ + inv_le G1.m{2} G1.mi{2} (c0R + i){2} FRO.m{2} ReSample.count{2}); + last by auto;smt w=List.size_ge0. + if=> //;1:by auto=>/#. + auto;call (_: ={F.RO.m});1:by sim. + inline *;auto=> ?&mr [#]!->@/inv_le Hi [#]. + case (p{mr})=> [/#|/=p1 p2] 4?_ /= 2?-> /=;split=>/= Hmem 4? [#]2->/= => [|/#]. + by rewrite restr_set /= size_set dom_restr /in_dom_with Hmem/= /#. + + auto;progress[delta];rewrite ?(size0,restr0,restr_set,rem0,max_ge0,-sizeE,-cardE) //=. + + smt ml=0. + smt ml=0. + smt ml=0. + + elim H7=>// [[x h] [#]];rewrite -memE dom_restr /in_dom_with in_dom=> _ ->/=. + by rewrite oget_some. + apply H10=>//. + 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 : + (size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size); + ReSample.f1 : + (size G1.m < max_size /\ size 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 (dom G1.m `|` dom G1.mi ))); skip=> /> &hr ? ? -> /= ? ?. + rewrite (Mu_mem.mu_mem + (image snd (dom G1.m{hr} `|` dom G1.mi{hr})) + cdistr (1%r/(2^c)%r))//. print DCapacity. + + 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 (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). + by rewrite -!sizeE;smt w=fcard_ge0. + + rewrite/#. + + 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 (dom G1.m `|` dom G1.mi) `|` fset1 x));skip=> /> &hr ??-> /= ??. + rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom 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 (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). + by rewrite -!sizeE;smt w=fcard_ge0. + + rewrite/#. + + by move=>c1;proc;auto=> &hr [^H 2->]/#. + move=> b1 c1;proc;auto=> /#. + qed. + + 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)%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 => //. + + cut ->: Pr[G1(DRestr(D)).main() @ &m : res] = Pr[Eager(G2(DRestr(D))).main1() @ &m : res]. + + by byequiv (G1_G2 (DRestr(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 (DRestr(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..1694dc7 --- /dev/null +++ b/sha3/proof/smart_counter/Handle.eca @@ -0,0 +1,1866 @@ +pragma -oldip. pragma +implicits. +require import Core Int Real StdOrder Ring IntExtra. +require import List FSet NewFMap Utils Common SLCommon RndO. +require import DProd Dexcepted. +(*...*) import Capacity IntOrder DCapacity. + +require ConcreteF. + +clone import GenEager as ROhandle with + type from <- handle, + type to <- capacity, + op sampleto <- fun (_:int) => cdistr + proof sampleto_ll by apply DCapacity.dunifin_ll. + +print FRO. +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 C = { + + proc f(p : block list): block = { + var sa, sa', sc; + var h, i <- 0; + sa <- b0; + while (i < size p ) { + if (mem (dom mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; + } else { + 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; + } + 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 (!mem (dom m) x) { + if (mem (dom paths) x.`2) { + (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 \/ mem (rng FRO.m) (x.`2, Unknown); + if (!(mem (rng FRO.m) (x.`2, Known))) { + FRO.m.[chandle] <- (x.`2, Known); + chandle <- chandle + 1; + } + hx2 <- oget (hinvK FRO.m x.`2); + if (mem (dom mh) (x.`1, hx2) /\ 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 (mem (dom paths) x.`2) { + (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 (!mem (dom mi) x) { + bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); + if (!(mem (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 (mem (dom mhi) (x.`1,hx2) /\ + 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 <- map0; + m <- map0; + mi <- map0; + mh <- map0; + mhi <- map0; + bext <- false; + bcol <- false; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + FRO.m <- map0.[0 <- (c0, Known)]; + paths <- map0.[c0 <- ([<:block>],b0)]; + chandle <- 1; + b <@ D(C,S).distinguish(); + return b; + } +}. + +(* -------------------------------------------------------------------------- *) +(** The state of CF contains only the map PF.m. + 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<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 = + | 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). + +(** 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: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + 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: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + 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: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + 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: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + 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: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + 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: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + 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: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + hs_spec hs ch. +proof. by case. qed. + +lemma inv_of_INV hs ch m1 mi1 m2 mi2 ro pi + mh2 mhi2: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + inv_spec mh2 mhi2. +proof. by case. qed. + +lemma invG_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + inv_spec m2 mi2. +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_notin_dom_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_notin_dom_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_notin_dom2_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_notin_dom2_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_notin_dom2_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 !getP 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 !getP 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 !getP /= /#. + + by exists hy fy hy' fy'; rewrite !getP Hhy' /#. + + by exists hx' fx' hy fy; rewrite !getP Hhx' /#. + by exists hx' fx' hy' fy'; rewrite !getP 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 !getP /= /#. ++ by exists yc fy yc' fy'; rewrite !getP Hhy' /#. ++ by exists xc' fx' yc fy; rewrite !getP Hhx' /#. +by exists xc' fx' yc' fy'; rewrite !getP 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 getP. ++ case: ((xa0,xc0) = (xa,xc))=> [[#] <<*> [#] <<*>|] /=. + + by exists hx f hy f'; rewrite !getP /= /#. + move=> xaxc0_neq_xaxc /Hm_mh [hx0 fx0 hy0 fy0] [#] hs_hx0 hs_hy0 mh_xahx0. + by exists hx0 fx0 hy0 fy0; rewrite !getP /#. +case: ((xa0,hx0) = (xa,hx))=> [[#] <*>> [#] <<*>|] /=. ++ by exists xc f yc f'; rewrite !getP /= /#. +rewrite andaE=> /negb_and xahx0_neq_xahx /Hmh_m [xc0 fx0 yc0 fy0] [#] hs_hx0 hs_hy0 Pm_xaxc0. +exists xc0 fx0 yc0 fy0; rewrite !getP; 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 getP; case: ((ya0,yc0) = (ya,yc))=> [[#] <*>> [#] <*>>|]. + + by exists hy fy hx fx; rewrite !getP /= /#. + move=> yayc0_neq_yayc /Hm_mh [hy0 fy0 hx0 fx0] [#] hs_hy0 hs_hx0 mhi_yayc0. + by exists hy0 fy0 hx0 fx0; rewrite !getP /#. +move=> ya0 hy0 xa0 hx0; rewrite getP; case: ((ya0,hy0) = (ya,hy))=> [[#] <*>> [#] <<*>|]. ++ by exists yc fy xc fx; rewrite !getP //= /#. +rewrite /= andaE=> /negb_and yahy0_neq_yahy /Hmh_m [yc0 fy0 xc0 fx0] [#] hs_hy0 hs_hx0 mi_yayc0. +exists yc0 fy0 xc0 fx0; rewrite !getP; 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 !getP. +case: (h1 = h); case: (h2 = h)=> //= [Hh2 + [#]|+ Hh1 + [#]|_ _] - <*>. ++ by rewrite c_notin_rng1_hs. ++ by rewrite c_notin_rng1_hs. +exact/Hhuniq. +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 !getP /=. + case: (h1 = ch); case: (h2 = ch)=> //= [+ + [#]|+ + + [#]|]=> <*>; + first 2 by rewrite xc_notin_rng1_hs. + by move=> _ _ hs_h1 /(Hhuniq _ _ _ _ hs_h1). ++ by rewrite getP (ch_neq0 _ Hhs). ++ move=> [c f] h; rewrite !getP; 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. ++ by move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /= /#. ++ by rewrite getP hx_neq0. +move=> cf h; rewrite getP; 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 !getP 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 !getP; 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 !getP; 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 <=> mem (rng hs) (xc,f)). +proof. +move=> huniq_hs; split. ++ rewrite /getflag; case: (hinvP hs xc)=> [-> //|]. + rewrite in_rng; case: (hinv hs xc)=> //= h [f']. + rewrite oget_some=> ^ hs_h -> @/snd /= ->>. + by exists h. +rewrite in_rng=> -[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]. ++ by move=> ^/rconsIs <<- {b'} /rconssI <<- {p'}; 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 getP /#. +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]. +move=> v h /build_hpathP [/#|p' b' + + ^/rconsIs <<- /rconssI <<-]. +move=> v' h' /ih; rewrite getP. +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. +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: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi + => 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. +proof. +move=> HINV x2_neq_y2 Pm_x Gm_x x2_notin_rng1_hs y2_notin_rng1_hs; split. ++ rewrite (@addzA ch 1 1); apply/hs_addh. + + by move: HINV=> /hs_of_INV/hs_addh=> ->. + by move=> f h; rewrite getP; case: (h = ch)=> [/#|_]; exact/y2_notin_rng1_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_notin_rng1_hs. ++ apply/inv_addm; 1:by case: HINV. + + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. + by apply/(ch_notin_dom2_mh _ _ Hm_mh Hhs). + have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. + by apply/(Sch_notin_dom2_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 getP. + by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_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 getP; case: (h = ch)=> [_ //=|_ //=]; first by rewrite x2_neq_y2. + by rewrite y2_notin_rng1_hs. + + by rewrite getP. + by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. ++ by apply/incl_addm; case: HINV. ++ by apply/incl_addm; case: HINV. ++ split. + + move=> xa hx ya hy; rewrite getP; case: ((xa,hx) = (x1,ch))=> [|]. + + by move=> [#] <*> [#] <*>; exists x2 Known y2 Known; rewrite !getP /#. + 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 getP). + case: fy Hite hs_hy=> /= [[p v] [Hro Hpath] hs_hy|[#] Gm_xaxc <*> hs_hy] /=; last first. + + by rewrite getP; case: ((xa,xc) = (x1,x2))=> [/#|]. + exists p v; rewrite Hro /=; apply/build_hpath_up=> //. + have /m_mh_of_INV /notin_hs_notin_dom2_mh H:= HINV. + exact/H/ch_notin_dom_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_notin_dom2_mh hs Pm)/ch_notin_dom_hs; case: HINV. + have ch_notin_rng2_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_notin_dom_hs; case: HINV. + split=> -[#]. + + move=> Hpath mh_vxahx; rewrite getP; 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_notin_rng2_mh. + move=> ^ /build_hpathP + -> /=; rewrite getP. + 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_notin_dom2_mh hs Pm)/ch_notin_dom_hs; case: HINV. + by move=> -> /= ^ /dom_hs; rewrite !getP /#. +have ch_notin_rng2_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_notin_dom_hs; case: HINV. +have Sch_notin_rng2_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_notin_dom_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_notin_rng2_mh. +move=> ^ /build_hpathP + -> /=; rewrite !getP. +by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. +qed. + +lemma lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi + => 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. +proof. +move=> HINV x2_neq_y2 Pm_x Gm_x xc_notin_rng1_hs yc_notin_rng1_hs; split. ++ rewrite (@addzA ch 1 1); apply/hs_addh. + + by move: HINV=> /hs_of_INV/hs_addh=> ->. + by move=> f h; rewrite getP; case: (h = ch)=> [/#|_]; exact/yc_notin_rng1_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_notin_rng1_hs. ++ apply/inv_addm; 1:by case: HINV. + + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. + by apply/(Sch_notin_dom2_mh _ _ Hm_mh Hhs). + have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. + by apply/(ch_notin_dom2_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 getP; case: (h = ch)=> [<*> /#|]; rewrite yc_notin_rng1_hs. + + by rewrite getP. + by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_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 getP. + by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. ++ by apply/incl_addm; case: HINV. ++ by apply/incl_addm; case: HINV. ++ split. + + move=> ya hy xa hx; rewrite getP; case: ((ya,hy) = (y1,ch + 1))=> [|]. + + by move=> [#] <*> [#] <*>; exists y2 Known x2 Known; rewrite !getP /#. + 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 getP). + case: fx Hite hs_hx=> /= [[p v] [Hro Hpath] hs_hx|[#] Gm_yayc <*> hs_hx] /=; last first. + + by rewrite getP; case: ((ya,yc) = (y1,y2))=> [/#|]. + exists p v; rewrite Hro /=; apply/build_hpath_up=> //. + have /m_mh_of_INV /notin_hs_notin_dom2_mh H:= HINV. + exact/H/Sch_notin_dom_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_notin_dom2_mh hs Pm)/Sch_notin_dom_hs; case: HINV. + have Sch_notin_rng2_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_notin_dom_hs; case: HINV. + split=> -[#]. + + move=> Hpath mh_vxahx; rewrite getP; 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_notin_rng2_mh. + move=> ^ /build_hpathP + -> /=; rewrite getP. + 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_notin_dom2_mh hs Pm)/Sch_notin_dom_hs; case: HINV. + by move=> -> /= ^ /dom_hs; rewrite !getP /#. +have ch_notin_rng2_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_notin_dom_hs; case: HINV. +have Sch_notin_rng2_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_notin_dom_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_notin_rng2_mh. +move=> ^ /build_hpathP + -> /=; rewrite !getP. +by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. +qed. + +lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x1 x2 y1 y2 hx: + INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi + => 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. +proof. +move=> HINV PFm_x1x2 G1m_x1x2 pi_x2 hs_hx y2_notin_rng1_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_notin_rng1_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_notin_dom2_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_notin_dom_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_notin_dom_hs. ++ by have /incl_of_INV/incl_addm ->:= HINV. ++ by have /incli_of_INV/incl_addm ->:= HINV. ++ split. + + move=> xa' hx' ya' hy'; rewrite getP; case: ((xa',hx') = (x1,hx))=> [[#] <*>> [#] <<*> /=|]. + + exists x2 Known y2 Known=> //=; rewrite !getP /=. + 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 !getP 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 !getP; 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 getP; 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 getP. 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 getP. + 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 getP; 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. +qed. + +lemma lemma2' hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x1 x2 y1 y2 hx: + INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi + => 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. +proof. +move=> HINV PFmi_x1x2 G1mi_x1x2 hs_hx y2_notin_rng1_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_notin_rng1_hs. ++ apply/inv_addm; 1:by case: HINV. + + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. + by apply/(ch_notin_dom2_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_notin_dom_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_notin_dom_hs. ++ by have /incl_of_INV/incl_addm ->:= HINV. ++ by have /incli_of_INV/incl_addm ->:= HINV. ++ split. + + move=> ya' hy' xa' hx'; rewrite getP; case: ((ya',hy') = (y1,ch))=> [[#] <*>> [#] <<*> /=|]. + + exists y2 Known x2 Known=> //=; rewrite !getP /=. + 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 !getP 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 !getP; 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_notin_dom2_mh hs PFm)/(ch_notin_dom_hs); by case: HINV. + move=> -> /=; rewrite getP /=; 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 getP. 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 getP. + 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 getP; 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. +qed. + +lemma lemma3 hs ch Pm Pmi Gm Gmi mh mhi ro pi xa xc hx ya yc hy p b: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi + => 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)]. +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 andaE -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 getP; 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!<<- {xct fxt} [#] 2!<<- {yct fyt} Pmi_yayc. + move=> [za zc]; rewrite getP; 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 !getP /=. + case: (hx = hy)=> [<*>|_]; first by move: hs_hx; rewrite hs_hy. + by exists xc Known yc Known; rewrite getP. + 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 (@getP _ _ _ hy') Hhy'=> /= hs_hx' ^ hs_hy' -> Hite. + exists xc' (if hx' = hy then Known else fx') yc' fy'. + rewrite (@getP Gm) (_: (xa',xc') <> (xa,xc)) /=. + + move: Hxahx'=> /=; case: (xa' = xa)=> [<*> /=|//]. + by apply/contra=> <*>; have /hs_of_INV [] + _ _ - /(_ _ _ _ _ hs_hx' hs_hx _) := HINV. + rewrite getP; case: (hx' = hy)=> /= [<*>|//]. + move: hs_hx'; rewrite hs_hy=> /= [#] <<*> /=. + by move: Hite=> /= [#]; case: fy' hs_hy'=> //= _ ->. +split=> c p' b'; rewrite !getP; 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 getP; case: (h = hy)=> [<*> /=|//=]. + by rewrite yc_neq_c hs_hy /=. +split=> [[#] <<*>|]. ++ exists hy; rewrite getP /=; 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 getP; 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. +qed. + +clone export ConcreteF as ConcreteF1. + +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 getP /=;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)=> [->> _ _ _ /Hch //|??? Hbu Hg]. + by rewrite build_hpath_prefix;exists v' h'. +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 oget_some. + rewrite getP. 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 getP;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 /= getP_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 getP_eq /=;apply build_hpath_up_None. +qed. + + + + +(* we should do a lemma to have the equivalence *) + +equiv eq_fi (D <: DISTINGUISHER {PF, RO, G1}): PF.fi ~ G1(D).S.fi: + !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} + ==> !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}. +proof. +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}. +elim* => hs ch Pm Pmi Gm Gmi mh mhi ro pi [xa xc]. +case @[ambient]: + {-1}(INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi) + (eq_refl (INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi)); 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 in_dom Pmi_xaxc. + rcondt{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. + case @[ambient]: {-1}(getflag hs xc) (eq_refl (getflag hs xc)). + + move=> /getflagP_none xc_notin_rng1_hs. + rcondt{2} 2. + + auto=> &hr [#] <<*> _ _ _; rewrite in_rng negb_exists=> h /=. + by rewrite xc_notin_rng1_hs. + rcondf{2} 8. + + auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _. + rewrite negb_and in_dom; left. + rewrite (@huniq_hinvK_h ch) 3:oget_some /=. + + by apply/huniq_addh=> //; have /hs_of_INV [] := inv0. + + by rewrite getP. + apply/(@notin_m_notin_mh hs.[ch <- (xc,Known)] Pmi _ _ xc ch Known)=> //. + + by apply/m_mh_addh=> //; case: inv0. + by rewrite getP. + auto=> ? ? [#] !<<- -> -> ->> _ /= ya -> /= yc -> /=. + case: (hinvP (hs.[ch <- (xc,Known)]) yc)=> [_|-> //] yc_notin_rng1_hs_addh _ _. + rewrite getP /= oget_some /= -addzA /=. + rewrite(@huniq_hinvK_h ch) 3:oget_some /=. + + by apply/huniq_addh=> //; have /hs_of_INV [] := inv0. + + by rewrite getP. + apply/(@lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi xa xc ya yc inv0 _ Pmi_xaxc Gmi_xaxc)=> //. + + rewrite -negP=> <*>; move: yc_notin_rng1_hs_addh => /=. + apply/negb_forall=> /=; exists ch; apply/negb_forall=> /=; exists Known. + by rewrite getP. + + move=> f h; move: (yc_notin_rng1_hs_addh h f); rewrite getP. + case: (h = ch)=> <*> //= _; rewrite -negP. + by have /hs_of_INV [] _ _ H /H {H} := inv0. + 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; rewrite in_rng=> -[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 in_dom /=; 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_notin_rng1_hs _ _|/#]. + rewrite getP /= oget_some /=. + by apply/lemma2'=> // f h; exact/y2_notin_rng1_hs. +rcondf{1} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom 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 in_dom Gmi_xaxc. + conseq (_: _ ==> G1.bext{2})=> //. + auto=> &1 &2 [#] !<<- _ -> ->> _ />. + rewrite !in_rng; 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. print Block.DBlock. + smt (@Block.DBlock @Capacity.DCapacity). +have /incli_of_INV <- := inv0; 1:by rewrite Gmi_xaxc. +rewrite Pmi_xaxc=> /= [#] <<*>. +rcondf{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. +by auto=> &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 => !mem (dom m2) x => incl m1 m2.[x <- y]. +proof. + move=> Hincl Hdom w ^/Hincl <- => Hw. + rewrite getP_neq // -negP => ->>. + by move: Hdom;rewrite in_dom. +qed. + + + +equiv PFf_Cf (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1(D).C.f : + ! (G1.bcol{2} \/ G1.bext{2}) /\ + ={p} /\ p{1} <> [] /\ + 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} ==> + ! (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}. +proof. + proc; seq 2 4: + ((!(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} /\ + F.RO.m.[p]{2} = Some sa{1})));last first. + + case : (! (G1.bcol{2} \/ G1.bext{2})); + 2: by conseq (_:_ ==> true)=> //; inline *;auto;rewrite Block.DBlock.dunifin_ll. + inline *; rcondf{2} 3. + + by move=> &m;auto=> &hr [#] H /H[_ H1] ??;rewrite in_dom H1. + by auto=> /> &m1 &m2;rewrite Block.DBlock.dunifin_ll /= => H /H [-> ->];rewrite oget_some. + while ( + p{1} = (drop i p){2} /\ (0 <= i <= size p){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} /\ + ={sa} /\ + (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})));last first. + + auto=> &m1 &m2 [#] -> -> Hp ^ Hinv -> /=;rewrite drop0 size_ge0 /=;split. + + split;[split|];1: by exists Known;case Hinv => -[] _ ->. + + by rewrite take0. + by case (p{m2}) => //=;smt w=size_ge0. + move=> ????? ????? ?? iR ? ->> ?[#] _ ?? H /H{H} [#] -> ->> _ ?. + have -> : iR = size p{m2} by smt (). + have -> /= : size p{m2} <> 0 by smt (size_ge0). + by rewrite take_size. + inline *;sp 1 0;wp=> /=. + conseq (_: _ ==> (! (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} /\ + (oget PF.m{1}.[x{1}]).`1 = sa{2} /\ + (exists (f : flag), FRO.m{2}.[h{2}] = Some ((oget PF.m{1}.[x{1}]).`2, f)) /\ + (build_hpath G1.mh (take (i + 1) p) = Some (sa,h)){2} /\ + if i{2} + 1 = 0 then sa{2} = b0 && h{2} = 0 + else F.RO.m{2}.[take (i{2} + 1) p{2}] = Some (oget PF.m{1}.[x{1}]).`1)). + + move=> &m1 &m2 [#] 2!->> ?? H ?? ?????????? H'. + rewrite behead_drop -drop_add //=;split=>[/#|]. + by have := size_drop (i{m2} + 1) p{m2};case (drop (i{m2} + 1) p{m2}) => //= [/#| ];smt w=size_ge0. + case ((G1.bcol{2} \/ G1.bext{2})). + + wp;conseq (_: _ ==> (G1.bcol{2} \/ G1.bext{2}))=> //. + by if{1};if{2};auto;2:(swap{2} 4 -3;auto); smt w=(Block.DBlock.dunifin_ll DCapacity.dunifin_ll). + conseq (_: (x{1} = (sa{1} +^ head witness p{1}, sc{1}) /\ + (p{1} = drop i{2} p{2} /\ + 0 <= i{2} <= size p{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} /\ + ={sa} /\ + (exists (f : flag), FRO.m{2}.[h{2}] = Some (sc{1}, f)) /\ + (build_hpath G1.mh (take i p) = Some (sa,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})) /\ + p{1} <> [] /\ i{2} < size p{2}) /\ + ! (G1.bcol{2} \/ G1.bext{2}) /\ + (mem (dom PF.m) x){1} = (mem (dom G1.mh) (sa +^ nth witness p i, h)){2} ==> _). + + move=> &m1 &m2 [#] 2!->> ?? H ?? ^ /H [#] /= Hinv ->> Hf -> -> ? /= />. + case: Hf=> f Hm; rewrite head_nth nth_drop // addz0 !in_dom. + pose X := sa{m2} +^ nth witness p{m2} i{m2}. + case (Hinv)=> -[Hu _ _] _ _ [] /(_ X sc{m1}) Hpf ^ HG1 /(_ X h{m2}) Hmh _ _ _ _ _. + case: {-1}(PF.m{m1}.[(X,sc{m1})]) (eq_refl (PF.m{m1}.[(X,sc{m1})])) Hpf Hmh. + + case (G1.mh{m2}.[(X, h{m2})]) => //= -[ya hy] Hpf. + by rewrite -negP => /(_ ya hy) [] ????[#];rewrite Hm /= => -[<-];rewrite Hpf. + move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. + rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _. + by have /= <<- -> := Hu _ _ _ _ Hm Hhx. + if{1};[rcondf{2} 1| rcondt{2} 1];1,3:(by auto;smt ());last first. + + auto => /> /= &m1 &m2 ?? [] Hhs Hinv Hinvi Hmmh Hmmhi Hincl Hincli Hmh Hpi f. + rewrite head_nth nth_drop // addz0 => Heq Hbu ????. + rewrite !in_dom. + have -> /= : i{m2} + 1 <> 0 by smt (). + pose sa' := sa{m2} +^ nth witness p{m2} i{m2}. + case (Hmmh) => /(_ sa' sc{m1});case (PF.m{m1}.[(sa', sc{m1})])=> //= -[ya yc] /(_ ya yc) /=. + move=> [hx fx hy fy]; case (Hhs) => Hu _ _ [#] Heq'. + have /= <<- /= Hhy ^? ->:= Hu _ _ _ _ Heq Heq'. + rewrite !oget_some /= => _;split;1: by exists fy. + rewrite (@take_nth witness) 1://. + case (Hmh) => _ -> _;rewrite build_hpath_prefix Hbu /#. + rcondt{2} 5. + + move=> &m;auto=> &hr /> ?? Hinv f. + rewrite head_nth nth_drop // addz0; pose sa' := sa{hr} +^ nth witness p{hr} i{hr}. + move=> ?Hbu????->Hmem ????. + case (Hinv) => ??????? [] H1 H2 H3 ?. + rewrite (@take_nth witness) 1:// -negP in_dom. + pose p' := (take i{hr} p{hr}); pose w:= (nth witness p{hr} i{hr}). + case {-1}(F.RO.m{hr}.[rcons p' w]) (eq_refl (F.RO.m{hr}.[rcons p' w]))=> //. + move=> ? /H2 [???];rewrite Hbu => -[] [!<<-] HG1. + by move: Hmem;rewrite in_dom HG1. + swap{2} 4 -3;auto => &m1 &m2 [#] 2!->?? [] Hhs Hinv Hinvi Hmmh Hmmhi Hincl Hincli Hmh Hpi -> /=. + move=> Hsc Hpa Hif Hdrop Hlt Hbad. + rewrite head_nth nth_drop // addz0; pose sa' := sa{m2} +^ nth witness p{m2} i{m2}. + move=> Heq Hdom y1L-> /= y2L-> /=. + have -> /= : i{m2} + 1 <> 0 by smt (). + rewrite !getP_eq !oget_some /=. + pose p' := (take (i{m2} + 1) p{m2});rewrite/==> [#] ? /=. + split;last first. + + split;1: by exists Unknown. + rewrite /p' (@take_nth witness) 1:// build_hpath_prefix. + exists sa{m2} h{m2}. + rewrite /sa' getP_eq /=;apply build_hpath_up => //. + by move: Hdom;rewrite Heq /sa' in_dom. + have Hy1L := ch_notin_dom2_mh _ _ _ y1L G1.chandle{m2} Hmmhi Hhs. + have := hinvP FRO.m{m2} y2L;rewrite /= => Hy2L. + have g1_sa' : G1.mh{m2}.[(sa', h{m2})] = None by move: Hdom;rewrite Heq in_dom. + case :Hsc => f Hsc; have Hh := dom_hs_neq_ch _ _ _ _ _ Hhs Hsc. + have Hch : FRO.m{m2}.[G1.chandle{m2}] = None. + + case Hhs => _ _ H. + by case {-1}(FRO.m{m2}.[G1.chandle{m2}]) (eq_refl (FRO.m{m2}.[G1.chandle{m2}])) => // ? /H. + have Hy2_mi: ! mem (dom PF.mi{m1}) (y1L, y2L). + + rewrite in_dom;case {-1}( PF.mi{m1}.[(y1L, y2L)]) (eq_refl (PF.mi{m1}.[(y1L, y2L)])) => //. + by move=> [] ??;case Hmmhi=> H _ /H [] ????/#. + have ch_0 := ch_neq0 _ _ Hhs. + have ch_None : + forall xa xb ha hb, G1.mh{m2}.[(xa,ha)] = Some(xb, hb) => + ha <> G1.chandle{m2} /\ hb <> G1.chandle{m2}. + + 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 => // ??/#. + + by apply inv_addm. + + by apply (m_mh_addh_addm f) => //;case Hhs. + + by apply (mi_mhi_addh_addmi f)=> // ??/#. + + by apply incl_upd_nin. + + by apply incl_upd_nin. + + case (Hmh)=> H1 H2 H3;split. + + move=> xa hx ya hy;rewrite getP;case((xa, hx) = (sa', h{m2}))=> [[2!->>] [2!<<-] | Hdiff]. + + exists sc{m1} f y2L Unknown. + rewrite getP_eq getP_neq 1:eq_sym //= Hsc /=. + exists (take i{m2} p{m2}) sa{m2}. + rewrite /p' (@take_nth witness) 1:// /sa' xorwA xorwK xorwC xorw0 getP_eq /=. + by apply build_hpath_up_None. + move=> /H1 [xc fx yc fy] [#] Hhx Hhy Hfy; exists xc fx yc fy. + rewrite !getP_neq. + + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhx). + + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhy). + rewrite Hhx Hhy /=;case: fy Hhy Hfy => //= Hhy [p v [Hro Hpath]]. + exists p v;rewrite getP_neq 1:-negP 1:/p' 1:(@take_nth witness) 1://. + + move => ^ /rconssI <<-;move: Hpath;rewrite Hpa=> -[!<<-] /rconsIs Heq'. + by move:Hdiff=> /=;rewrite /sa' Heq' xorwA xorwK xorwC xorw0. + by rewrite Hro /=;apply build_hpath_up_None. + + move=> p1 bn b; rewrite getP /p' (@take_nth witness) //. + case (rcons p1 bn = rcons (take i{m2} p{m2}) (nth witness p{m2} i{m2})). + + move=> ^ /rconssI ->> /rconsIs ->> /=; split => [<<- | ]. + + exists sa{m2} h{m2} G1.chandle{m2}. + by rewrite /sa' getP_eq /= (build_hpath_up Hpa) //. + move=> [v hx hy []] Heq1;rewrite getP /sa'. + case ((v +^ nth witness p{m2} i{m2}, hx) = (sa{m2} +^ nth witness p{m2} i{m2}, h{m2})) => //. + have := build_hpath_up_None G1.mh{m2} (sa', h{m2}) (y1L, G1.chandle{m2}) _ _ g1_sa' Hpa. + by rewrite Heq1 => -[!->>]. + move=> Hdiff;rewrite H2. + apply exists_iff=> v /= ;apply exists_iff => hx /=;apply exists_iff => hy /=. + have Hhx2 := dom_hs_neq_ch _ _ _ _ _ Hhs Hsc. + rewrite build_hpath_upd_ch_iff //. + case (hx = G1.chandle{m2}) => [->>|?]. + + split;1: by move=> [] _ /ch_None. + move=> [[p0' x [Hhx2']]]. + have [!<<-] [!->>]:= H3 _ _ _ _ _ Hpa Hhx2'. + by rewrite getP_neq /= ?Hhx2 // => /ch_None. + rewrite getP; case ((v +^ bn, hx) = (sa', h{m2})) => //= -[Hsa' ->>]. + rewrite Hsa' g1_sa' /= -negP => [#] Hbu !<<-. + have [!<<-]:= H3 _ _ _ _ _ Hpa Hbu. + move: Hsa'=> /Block.WRing.addrI /#. + move=> p1 v p2 v' hx. + rewrite !build_hpath_upd_ch_iff //. + case (hx = G1.chandle{m2})=> [->> | Hdiff ];2:by apply H3. + by move=> /> ?? Hp1 ?? Hp2;have [!->>] := H3 _ _ _ _ _ Hp1 Hp2. + case (Hpi) => H1;split=> c p1 v1;rewrite H1 => {H1}. + apply exists_iff => h1 /=. rewrite getP build_hpath_upd_ch_iff //. + by case (h1 = G1.chandle{m2}) => [->> /#|]. +qed. + +section AUX. + + declare module D : DISTINGUISHER {PF, RO, G1}. + + 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(D).main ~ G1(D).main: + ={glob D} ==> !(G1.bcol \/ G1.bext){2} => ={res}. + proof. + proc. + call (_: G1.bcol \/ G1.bext, + 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}). + (* 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} + /\ 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} + ==> !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}). + + by move=> &1 &2; rewrite negb_or. + + by move=> &1 &2 _ ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? [#]; rewrite negb_or. + (* 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. *) + (* We want to name everything for now, to make it easier to manage complexity *) + 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}. + elim * => hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 [] 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) + (eq_refl (INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0)); 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 in_dom PFm_x1x2. + rcondt{2} 1; 1:by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom Gm_x1x2. + case @[ambient]: {-1}(pi0.[x2]) (eq_refl (pi0.[x2])). + + move=> x2_in_pi; rcondf{2} 1. + + by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom x2_in_pi. + rcondf{2} 8. + + by move=> //= &1; auto=> &2 [#] !<<-; rewrite !in_dom 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} + /\ (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). + + by auto. + case @[ambient]: {-1}(getflag hs0 x2) (eq_refl (getflag hs0 x2)). + + rewrite getflagP_none => x2f_notin_rng_hs0; rcondt{2} 3. + + move=> &1; auto=> &2 /> _ _ _; rewrite in_rng negb_exists /=. + exact/(@x2f_notin_rng_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 !getP; case: (hx = G1.chandle{2}); case: (hy = G1.chandle{2})=> //=. + + by move=> _ + [#] - <*>; have:= (x2f_notin_rng_hs0 yf hy). + + by move=> + _ + [#] - <*>; have:= (x2f_notin_rng_hs0 xf hx). + by move=> _ _; have /hs_of_INV [] + _ _ - /(_ hx hy (xc,xf) (yc,yf)) := inv0. + by rewrite !getP. + rewrite oget_some=> _ _ _. + have -> //: !mem (dom G1.mh{2}) (x1,G1.chandle{2}). + rewrite in_dom /=; 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 [#] !<<- -> -> !->> {&1} /= _ x2_neq_y2 y2_notin_hs _ _. + rewrite getP /= oget_some /= -addzA /=. + rewrite (@huniq_hinvK_h ch0 hs0.[ch0 <- (x2,Known)] x2); 2:by rewrite getP. + + move=> @/huniq h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. + case: (h1 = ch0); case: (h2 = ch0)=> //=. + + by move=> _ + [#] - <*>; move: (x2f_notin_rng_hs0 f2 h2). + + by move=> + _ + [#] <*> - <*>; move: (x2f_notin_rng_hs0 f1 h1). + have /hs_of_INV [] + _ _ _ _ - h := inv0. + by apply/h; rewrite getP. + by rewrite oget_some; exact/lemma1. + conseq (_: _ ==> G1.bcol{2})=> //=. + auto=> &1 &2 [#] !<<- -> _ ->> !<<- _ /=. + case: (hinvP hs0.[ch0 <- (x2,Known)] y2{1})=> //= -> /=. + move=> hs0_spec; split=> [|f]. + + by have:= hs0_spec ch0 Known; rewrite getP. + move=> h; have:= hs0_spec h f; rewrite getP; 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. + + by move=> x2_is_U; conseq (_: G1.bext{2})=> //=; auto=> &1 &2 />; rewrite x2_is_U. + move=> x2_is_K; rcondf{2} 3; 1:by move=> &1; auto. + have:= x2_is_K; rewrite in_rng=> - [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} + /\ (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). + + auto=> &1 &2 /> _ -> /= _; split. + + move: x2_is_K; rewrite in_rng /= => -[hx2] hs_hx2. + rewrite in_rng 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 FRO.m{2} x2) //. + by have /hs_of_INV [] := inv0. + have x1hx_notin_G1m: !mem (dom G1mh) (x1,hx). + + rewrite in_dom; 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 [#] !<<- -> -> !->> _ /= hinv_y2_none. + rewrite getP /= oget_some /=; apply/lemma2=> //. + + by case: (hinvP hs0 y2{2})=> [_ + f h|//=] - ->. + move=> [p0 v0] ^ pi_x2. have /pi_of_INV [] -> [hx2] [#] Hpath hs_hx2:= inv0. + rcondt{2} 1. by move=> &m; auto=> &hr [#] !<<- _ _ ->> /= _; rewrite in_dom pi_x2. + rcondf{2} 6. + + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. + by rewrite in_rng; 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 in_dom; 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=> [#] !<<- {xc0 xf0}; rewrite PFm_x1x2. + rcondt{2} 15. + + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. + by rewrite in_dom pi_x2. + inline F.RO.get. rcondt{2} 4. + + auto=> &hr [#] !<<- _ _ !->> _ /= _ _; rewrite pi_x2 oget_some /=. + rewrite in_dom; 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 !getP_eq pi_x2 !oget_some /=. + have /hs_of_INV [] Hu _ _:= inv0; have -> := huniq_hinvK_h _ _ _ Hu hs_hx2. + rewrite oget_some => /= ? Hy2L . + case:inv0=> Hhs Hinv HinvG Hmmh Hmmhi Hincl Hincli Hmh Hpi. + 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 Hy2L => H _ + /H {H} [hx fx hy fy] [#]. + by case: (hinvP hs0 y2L)=> [_ ->|//]/#. + + by apply inv_addm=>//; apply (ch_notin_dom2_mh _ _ Hmmhi Hhs). + + by apply (m_mh_addh_addm _ Hmmh _ hs_hx2)=>//;apply ch_notin_dom_hs. + + apply (mi_mhi_addh_addmi _ Hmmhi _ hs_hx2);last by apply ch_notin_dom_hs. + by have := hinvP hs0 y2L;rewrite /#. + + by apply incl_addm. + by apply incl_addm. + + split. + + move=> xa hx ya hy;rewrite getP;case ((xa, hx) = (x1, hx2))=> /=. + + move=> [] !-> [] !<-; exists x2 Known y2L Known. + by rewrite !getP_eq /= getP_neq // eq_sym; apply (dom_hs_neq_ch _ _ _ Hhs hs_hx2). + move=> Hdiff Hxa; case Hmh=> /(_ _ _ _ _ Hxa) [] xc fx yc fy [#] Hhx Hhy HG1 _ _. + exists xc fx yc fy;rewrite !getP_neq //. + + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhx). + + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhy). + + rewrite /= -negP=> -[] <<- <<-;apply Hdiff=> /=. + by apply (Hu hx (x2, fx) (x2, Known)). + rewrite Hhx Hhy=> /=;move: HG1. + case: fy Hhy=> Hhy //= [p v [Hro Hbu]]. + exists p v;split. + + rewrite getP_neq // -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 getP. + case (rcons p bn = rcons p0 (v0 +^ x1)). + + move=> ^ /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 getP_eq. + move=> [v hx hy] [];rewrite getP ;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. + move=> 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'. + by rewrite getP_neq /= ?Hhx2 // => /ch_None. + rewrite getP;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 getP. case (c = y2L) => [->> /= | Hc]. + + split. + + move=> [!<<-];exists ch0;rewrite getP_eq /= build_hpath_prefix. + exists v0 hx2;rewrite xorwA xorwK Block.WRing.add0r getP_eq /=. + have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. + by apply build_hpath_up_None. + move=> [h []];rewrite getP 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 // getP;case (h = ch0) => [->> | //]. + split;1: by move=> [_ /(dom_hs_neq_ch _ _ _ _ _ Hhs)]. + by move=> /= [_ <<-];move:Hc. + + move=> [xa xc] PFm_x1x2. rcondf{1} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom 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 in_dom G1m_x1x2. + auto=> &1 &2 [#] <*> -> -> -> /=; have /incl_of_INV /(_ (x1,x2)) := inv0. + by rewrite PFm_x1x2 G1m_x1x2 /= => [#] !<<- {ya yc}. + move=> x1x2_notin_G1m; rcondt{2} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom x1x2_notin_G1m. + have <*>: fy2 = Unknown. + + have /mh_of_INV [] /(_ _ _ _ _ G1mh_x1hx2) + _ := inv0. + move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0}. + 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: (G1.bext{2}); last by inline*; if{2}; auto; smt (@Block @Capacity). + by auto=> ? ? [#] !<<- _ -> ->> _ /=; rewrite in_rng; exists hx2. + have /mh_of_INV []/(_ _ _ _ _ G1mh_x1hx2) + _ _:= inv0. + move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0} /= [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 in_dom pi_x2. + inline F.RO.get. + rcondf{2} 4; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite pi_x2 oget_some /= in_dom Hro. + rcondf{2} 8; first by auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _; rewrite in_rng; exists hx2. + rcondt{2} 9. + + auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _. + rewrite (@huniq_hinvK_h hx2 hs0 x2) // 2:in_dom 2:G1mh_x1hx2 2:!oget_some /=. + + by have /hs_of_INV []:= inv0. + by rewrite /in_dom_with in_dom hs_hy2. + rcondt{2} 14; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite in_dom pi_x2. + auto=> &1 &2 [#] !<<- -> -> ->> _ /=; rewrite Block.DBlock.dunifin_ll Capacity.DCapacity.dunifin_ll /=. + move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 !oget_some //=. + rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. + + by have /hs_of_INV []:= inv0. + rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //= => _. + exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). + (* lossless PF.f *) + + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. + smt (@Block.DBlock @Capacity.DCapacity). + (* lossless and do not reset bad G1.S.f *) + + move=> _; proc; 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 *) + + by conseq (eq_fi D)=> /#. + (* lossless PF.P.fi *) + + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. + smt (@Block.DBlock @Capacity.DCapacity). + (* lossless and do not reset bad G1.S.fi *) + + move=> _; proc; if; 2:by auto. + by wp; do 2!rnd predT; auto => &hr [#]; smt (@Block.DBlock @Capacity.DCapacity). + (** proofs for G1.C.f *) + (* equiv PF.C.f G1.C.f *) + + proc. + inline*;sp. admit. (* this is false *) + (* lossless PF.C.f *) + + move=> &2 _; proc; inline *; while (true) (size p); auto. + + sp; if; 2:by auto; smt (size_behead). + 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; rnd predT; auto. + while (G1.bcol \/ G1.bext) (size p - i)=> [z|]. + + if; 1:by auto=> /#. + wp; rnd predT; wp; rnd predT; auto. + smt (@Block.DBlock @Capacity.DCapacity). + by auto; smt (@Block.DBlock @Capacity.DCapacity). + (* Init ok *) + inline *; auto=> />; split=> [|/#]. + (do !split; last 3 smt (getP map0P build_hpath_map0)); last 5 by move=> ? ? ? ?; rewrite map0P. + + move=> h1 h2 ? ?; rewrite !getP !map0P. + by case: (h1 = 0); case: (h2 = 0)=> //=. + + by rewrite getP. + + by move=> ? h; rewrite getP map0P; case: (h = 0). + + by move=> ? ?; rewrite !map0P. + by move=> ? ?; rewrite !map0P. +qed. + +end section AUX. + +section. + + declare module D: DISTINGUISHER{Perm, C, PF, G1, RO}. + + 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)%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 D_ll &m)). + cut : Pr[CF(DRestr(D)).main() @ &m : res] <= + Pr[G1(DRestr(D)).main() @ &m : res] + + Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext]. + + byequiv (CF_G1 (DRestr(D)) _)=>//;1:by apply (DRestr_ll D D_ll). + smt ml=0. + cut /# : 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]. + rewrite Pr [mu_or]; smt. + qed. + +end section. + + diff --git a/sha3/proof/smart_counter/IndifPadding.ec b/sha3/proof/smart_counter/IndifPadding.ec new file mode 100644 index 0000000..192ca69 --- /dev/null +++ b/sha3/proof/smart_counter/IndifPadding.ec @@ -0,0 +1,123 @@ +require import Fun Pair Real NewFMap. +require (*..*) Indifferentiability LazyRO. + +clone import Indifferentiability as Ind1. + +clone import Indifferentiability as Ind2 + with type p <- Ind1.p, + type f_out <- Ind1.f_out. + +op pad : Ind2.f_in -> Ind1.f_in. +op padinv : Ind1.f_in -> Ind2.f_in. +axiom cancel_pad : cancel pad padinv. +axiom cancel_padinv : cancel padinv pad. + +clone import LazyRO as RO1 + with type from <- Ind1.f_in, + type to <- Ind1.f_out. + +clone import LazyRO as RO2 + with type from <- Ind2.f_in, + type to <- Ind1.f_out, + op d <- RO1.d. + +module ConstrPad (FC:Ind1.CONSTRUCTION, P:Ind1.DPRIMITIVE) = { + module C = FC(P) + + proc init = C.init + + proc f (x:Ind2.f_in) : f_out = { + var r; + r = C.f(pad x); + return r; + } +}. + +module DistPad(FD: Ind2.DISTINGUISHER, F:Ind1.DFUNCTIONALITY, P:Ind1.DPRIMITIVE) = { + module Fpad = { + proc f(x:Ind2.f_in) : f_out = { + var r; + r = F.f(pad x); + return r; + } + } + + proc distinguish = FD(Fpad,P).distinguish +}. + +module SimPadinv(S:Ind1.SIMULATOR, F2:Ind2.DFUNCTIONALITY) = { + module F1 = { + proc f(x:Ind1.f_in):Ind1.f_out = { + var r; + r = F2.f(padinv x); + return r; + } + } + + module S2 = S(F1) + + proc init = S2.init + + proc f = S2.f + proc fi = S2.fi +}. + +section Reduction. + declare module P : Ind1.PRIMITIVE. (* It is compatible with Ind2.Primitive *) + declare module C : Ind1.CONSTRUCTION {P}. + declare module S : Ind1.SIMULATOR{ RO1.H, RO2.H}. + + declare module D' : Ind2.DISTINGUISHER{P,C, RO1.H, RO2.H, S}. + + local equiv ConstrDistPad: + Ind2.GReal(ConstrPad(C), P, D').main ~ + Ind1.GReal(C, P, DistPad(D')).main : ={glob P, glob C, glob D'} ==> + ={glob P, glob C, glob D', res}. + proof. by sim. qed. + + local lemma PrConstrDistPad &m: + Pr[ Ind2.GReal(ConstrPad(C), P, D').main() @ &m : res] = + Pr[ Ind1.GReal(C, P, DistPad(D')).main() @ &m : res]. + proof. by byequiv ConstrDistPad. qed. + + local equiv DistH2H1: + Ind2.GIdeal(RO2.H, SimPadinv(S), D').main ~ + Ind1.GIdeal(RO1.H, S, DistPad(D')).main : + ={glob D', glob S} ==> + ={glob D',glob S, res} /\ forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]. + proof. + proc. + call (_: ={glob S} /\ forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]). + + proc *;inline *. + call (_: forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]);auto. + proc;inline *;wp;sp;if;first by progress [-split];rewrite !in_dom H. + + auto;progress;first by rewrite !getP_eq. + by rewrite !getP (can_eq _ _ cancel_padinv) H. + by auto;progress;rewrite H. + + proc *;inline *. + call (_: forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]);auto. + proc;inline *;wp;sp;if;first by progress [-split];rewrite !in_dom H. + + auto;progress;first by rewrite !getP_eq. + by rewrite !getP (can_eq _ _ cancel_padinv) H. + by auto;progress;rewrite H. + + proc;inline *;wp;sp;if;first by progress[-split];rewrite -{1}(cancel_pad x{2}) !in_dom H. + + auto;progress;first by rewrite !getP_eq. + by rewrite !getP (eq_sym x1) (can2_eq _ _ cancel_pad cancel_padinv) (eq_sym x{2}) H. + by auto;progress;rewrite -H cancel_pad. + inline *;wp. call (_: ={glob D'}). + auto;progress;by rewrite !map0P. + qed. + + local lemma PrDistH2H1 &m: + Pr[Ind2.GIdeal(RO2.H,SimPadinv(S),D').main() @ &m : res] = + Pr[Ind1.GIdeal(RO1.H,S, DistPad(D')).main() @ &m : res]. + proof. by byequiv DistH2H1. qed. + + lemma Conclusion &m: + `| Pr[Ind2.GReal (ConstrPad(C), P , D' ).main() @ &m : res] - + Pr[Ind2.GIdeal(RO2.H , SimPadinv(S), D' ).main() @ &m : res] | = + `| Pr[Ind1.GReal (C , P , DistPad(D')).main() @ &m : res] - + Pr[Ind1.GIdeal(RO1.H , S , DistPad(D')).main() @ &m : res] |. + proof. by rewrite (PrConstrDistPad &m) (PrDistH2H1 &m). qed. + +end section Reduction. diff --git a/sha3/proof/smart_counter/LazyRO.eca b/sha3/proof/smart_counter/LazyRO.eca new file mode 100644 index 0000000..96136e7 --- /dev/null +++ b/sha3/proof/smart_counter/LazyRO.eca @@ -0,0 +1,22 @@ +require import Option FSet NewFMap. +require (*..*) NewROM. + +type from, to. +op d: to distr. + +clone include NewROM with + type from <- from, + type to <- to, + op dsample <- fun (x:from) => d. + + +module H = { + var m : (from, to) fmap + + proc init() = { m = map0; } + + proc f(x) = { + if (!mem (dom m) x) m.[x] = $d; + return oget m.[x]; + } +}. diff --git a/sha3/proof/smart_counter/SLCommon.ec b/sha3/proof/smart_counter/SLCommon.ec new file mode 100644 index 0000000..8453ae9 --- /dev/null +++ b/sha3/proof/smart_counter/SLCommon.ec @@ -0,0 +1,498 @@ +(** 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 IntExtra. +require import List FSet NewFMap Utils Common RndO DProd Dexcepted. + +require (*..*) Indifferentiability. +(*...*) import Capacity IntOrder. + +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 RndO.GenEager as F with + type from <- block list, + type to <- block, + op sampleto <- fun (_:block list)=> bdistr + proof * by exact Block.DBlock.dunifin_ll. + +(** We can now define the squeezeless sponge construction **) +module SqueezelessSponge (P:DPRIMITIVE): FUNCTIONALITY = { + proc init () = {} + + proc f(p : block list): block = { + var (sa,sc) <- (b0,c0); + + while (p <> []) { (* Absorption *) + (sa,sc) <@ P.f((sa +^ head witness p,sc)); + p <- behead p; + } + + return sa; (* Squeezing phase (non-iterated) *) + } +}. + +clone export DProd.ProdSampling as Sample2 with + type t1 <- block, + type t2 <- capacity, + op d1 <- bdistr, + op d2 <- cdistr. + +(* -------------------------------------------------------------------------- *) +(** 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, mem (rng m) x => mem (dom mi) x) + /\ (forall x, mem (rng mi) x => mem (dom m) x). + +lemma half_permutation_set (m' mi' : ('a,'a) fmap) x' y': + (forall x, mem (rng m') x => mem (dom mi') x) + => (forall x, mem (rng m'.[x' <- y']) x => mem (dom mi'.[y' <- x']) x). +proof. + move=> h x0. + rewrite rng_set domP !in_fsetU in_fset1 => -[/rng_rem_le in_rng|//=]. + by rewrite h. +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 rewrite andaE; split=> [!~#] <*>; [exact/Empty|move=> [] /#]. +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']. + move=> ^/rconssI <<- {p'} /rconsIs ->> {b}. + by rewrite /build_hpath=> ->. +move=> [v' h']; rewrite oget_some /= -/(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'' ^/rconssI <<- {p'} /rconsIs <<- {b'}. +by rewrite build /= => [#] <*>. +qed. + +lemma build_hpath_map0 p: + build_hpath map0 p + = if p = [] then Some (b0,0) else None. +proof. +elim/last_ind: p=> //= p b _. +by rewrite -{1}cats1 foldl_cat {1}/step_hpath /= map0P /= /#. +qed. + +(* -------------------------------------------------------------------------- *) +theory Prefixe. + +op prefixe ['a] (s t : 'a list) = + with s = x :: s', t = y :: t' => if x = y then 1 + prefixe s' t' else 0 + with s = _ :: _ , t = [] => 0 + with s = [] , t = _ :: _ => 0 + with s = [] , t = [] => 0. + +lemma prefixe_eq (l : 'a list) : prefixe l l = size l. +proof. elim:l=>//=/#. qed. + + +lemma prefixeC (l1 l2 : 'a list) : + prefixe l1 l2 = prefixe 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 prefixe_ge0 (l1 l2 : 'a list) : + 0 <= prefixe 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 prefixe_sizel (l1 l2 : 'a list) : + prefixe 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). +move=>e2 l2 Hind2 e1 l1 Hind1/#. +qed. + +lemma prefixe_sizer (l1 l2 : 'a list) : + prefixe l1 l2 <= size l2. +proof. +by rewrite prefixeC prefixe_sizel. +qed. + + +lemma prefixe_take (l1 l2 : 'a list) : + take (prefixe l1 l2) l1 = take (prefixe 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 prefixe_nth (l1 l2 : 'a list) : + let i = prefixe l1 l2 in + forall j, 0 <= j < i => + nth witness l1 j = nth witness l2 j. +proof. +rewrite/=. +cut Htake:=prefixe_take l1 l2. search nth take. +move=>j[Hj0 Hjp];rewrite-(nth_take witness (prefixe l1 l2))1:prefixe_ge0//. +by rewrite-(nth_take witness (prefixe l1 l2) l2)1:prefixe_ge0//Htake. +qed. + + +op max_prefixe (l1 l2 : 'a list) (ll : 'a list list) = + with ll = "[]" => l2 + with ll = (::) l' ll' => + if prefixe l1 l2 < prefixe l1 l' then max_prefixe l1 l' ll' + else max_prefixe l1 l2 ll'. + + +op get_max_prefixe (l : 'a list) (ll : 'a list list) = + with ll = "[]" => [] + with ll = (::) l' ll' => max_prefixe l l' ll'. + + + +end Prefixe. + +(* -------------------------------------------------------------------------- *) + +module C = { + var c : int + var m : (state, state) fmap + var mi : (state, state) fmap + proc init () = { + c <- 0; + m <- map0; + mi <- map0; + } +}. + +module PC (P:PRIMITIVE) = { + + proc init () = { + C.init(); + P.init(); + } + + proc f (x:state) = { + var y; + y <@ P.f(x); + if (!x \in dom C.m) { + C.c <- C.c + 1; + C.m.[x] <- y; + C.mi.[y] <- x; + } + return y; + } + + proc fi(x:state) = { + var y; + y <@ P.fi(x); + if (!x \in dom C.mi) { + C.c <- C.c + 1; + C.mi.[x] <- y; + C.m.[y] <- x; + } + return y; + } + +}. + +module DPRestr (P:DPRIMITIVE) = { + + proc f (x:state) = { + var y=(b0,c0); + if (C.c + 1 <= max_size) { + y <@ P.f(x); + if (!x \in dom C.m) { + C.c <- C.c + 1; + C.m.[x] <- y; + C.mi.[y] <- x; + } + } + return y; + } + + proc fi(x:state) = { + var y=(b0,c0); + if (C.c + 1 <= max_size) { + y <@ P.fi(x); + if (!x \in dom C.mi) { + C.c <- C.c + 1; + C.mi.[x] <- y; + C.m.[y] <- x; + } + } + 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; + C.c <- C.c + size bs; + b <@ F.f(bs); + return b; + } +}. + +module DFRestr(F:DFUNCTIONALITY) = { + + proc f (bs:block list) = { + var b= b0; + if (C.c + size bs <= max_size) { + C.c <- C.c + size bs; + b <@ F.f(bs); + } + return b; + } +}. + +module FRestr(F:FUNCTIONALITY) = { + + proc 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): islossless P.f => islossless DPRestr(P).f. +proof. move=>Hll;proc;sp;if=>//;call Hll;auto. qed. + +lemma rpi_ll (P<:DPRIMITIVE): islossless P.fi => islossless DPRestr(P).fi. +proof. move=>Hll;proc;sp;if=>//;call Hll;auto. qed. + +lemma rf_ll (F<:DFUNCTIONALITY): islossless F.f => islossless DFRestr(F).f. +proof. move=>Hll;proc;sp;if=>//;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=>//. + proc;inline *;wp;swap{1}1 2;sim. + qed. + +end section RESTR. + +section COUNT. + + declare module P:PRIMITIVE{C}. + declare module CO:CONSTRUCTION{C,P}. + declare module D:DISTINGUISHER{C,P,CO}. + + axiom f_ll : islossless P.f. + axiom fi_ll : islossless P.fi. + + axiom CO_ll : islossless CO(P).f. + + 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;swap{2}1 2. + call (_: max_size < C.c, ={glob P, glob CO, glob C}). + + apply D_ll. + + proc; sp 1 0;if{1};1:by call(_:true);auto. + by call{2} f_ll;auto=>/#. + + by move=> ?_;proc;sp;if;auto;call f_ll;auto. + + by move=> _;proc;call f_ll;auto=>/#. + + proc;sp 1 0;if{1};1:by call(_:true);auto. + by call{2} fi_ll;auto=>/#. + + by move=> ?_;proc;sp;if;auto;call fi_ll;auto. + + by move=> _;proc;call fi_ll;auto=>/#. + + proc;sp 1 0;if{1};1:by call(_: ={glob P});auto;sim. + by call{2} CO_ll;auto=>/#. + + by move=> ?_;proc;sp;if;auto;call CO_ll;auto. + + move=> _;proc;call CO_ll;auto;smt ml=0 w=size_ge0. + wp;call (_:true);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. + cut @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := + findP (fun (_ : handle) => pred1 c \o fst) handles. + + by exists (oget handles.[h]).`2;rewrite oget_some get_oget;2:case (oget handles.[h]). + cut := H h;rewrite in_dom/#. +qed. + +lemma huniq_hinv (handles:handles) (h:handle): + huniq handles => mem (dom handles) h => hinv handles (oget handles.[h]).`1 = Some h. +proof. + move=> Huniq;pose c := (oget handles.[h]).`1. + cut:=Huniq h;cut:=hinvP handles c. + case (hinv _ _)=> /=[Hdiff _| h' +/(_ h')];1:by rewrite in_dom /#. + by move=> [f ->] /(_ (oget handles.[h]) (c,f)) H1 H2;rewrite H1 // get_oget. +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. + cut @/pred1/= [[h]|][->/=]:= findP (+ pred1 c) (restr Known handles). + + by rewrite oget_some in_dom restrP;case (handles.[h])=>//= /#. + by move=>+h-/(_ h);rewrite in_dom restrP => H1/#. +qed. + +lemma huniq_hinvK (handles:handles) c: + huniq handles => mem (rng handles) (c,Known) => handles.[oget (hinvK handles c)] = Some(c,Known). +proof. + move=> Huniq;rewrite in_rng=> -[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. + move=> Huniq;case: (hinvK _ _) (hinvKP handles c)=>/= [H|h'];1: by apply H. + by rewrite oget_some=> /Huniq H/H. +qed. + +(* -------------------------------------------------------------------------- *) +(** The initial Game *) +module GReal(D:DISTINGUISHER) = RealIndif(SqueezelessSponge, PC(Perm), D). diff --git a/sha3/proof/smart_counter/Utils.ec b/sha3/proof/smart_counter/Utils.ec new file mode 100644 index 0000000..3f2b506 --- /dev/null +++ b/sha3/proof/smart_counter/Utils.ec @@ -0,0 +1,63 @@ +(** These should make it into the standard libs **) +require import Core List FSet NewFMap. + +(* -------------------------------------------------------------------- *) + (* In NewFMap *) + +op reindex (f : 'a -> 'c) (m : ('a, 'b) fmap) = + NewFMap.oflist (map (fun (x : 'a * 'b) => (f x.`1,x.`2)) (elems m)) + axiomatized by reindexE. + + + +lemma dom_reindex (f : 'a -> 'c) (m : ('a, 'b) fmap) x: + mem (dom (reindex f m)) x <=> mem (image f (dom m)) x. +proof. + rewrite reindexE dom_oflist imageP mapP /fst; split. + move=> [[x' y] [+ ->>]]. + rewrite mapP=> -[[x0 y0]] /= [h [->> ->>]] {x' y}. + by exists x0; rewrite domE mem_oflist mapP /fst; exists (x0,y0). + move=> [a] [a_in_m <<-]. + exists (f a,oget m.[a])=> /=; rewrite mapP /=. + exists (a,oget m.[a])=> //=. + have:= a_in_m; rewrite in_dom; case {-1}(m.[a]) (eq_refl m.[a])=> //=. + by move=> y; rewrite getE mem_assoc_uniq 1:uniq_keys. +qed. + + +lemma reindex_injective_on (f : 'a -> 'c) (m : ('a, 'b) fmap): + (forall x y, mem (dom m) x => f x = f y => x = y) => + (forall x, m.[x] = (reindex f m).[f x]). +proof. + move=> f_pinj x. + pose s:= elems (reindex f m). + case (assocP s (f x)). + rewrite -dom_oflist {1}/s elemsK dom_reindex imageP. + move=> [[a]] [] /f_pinj h /(h x) ->> {a}. + rewrite !getE. + move=> [y] [+ ->]. + rewrite /s reindexE. + pose s':= map (fun (x : 'a * 'b) => (f x.`1,x.`2)) (elems m). + have <- := (perm_eq_mem _ _ (oflistK s')). + (** FIXME: make this a lemma **) + have h' /h': forall (s : ('c * 'b) list) x, mem (reduce s) x => mem s x. + rewrite /reduce=> s0 x0; rewrite -{2}(cat0s s0); pose acc:= []. + elim s0 acc x0=> {s'} [acc x0 /=|x' s' ih acc x0 /=]. + by rewrite cats0. + move=> /ih; rewrite -cat1s catA cats1 !mem_cat=> -[|-> //=]. + rewrite /augment; case (mem (map fst acc) x'.`1)=> _ h'; left=> //. + by rewrite mem_rcons /=; right. + rewrite /s' mapP=> -[[a' b']] /= [xy_in_m []]. + rewrite eq_sym. have h0 /h0 ->> <<- {a' b'}:= f_pinj a' x _; 1:by smt. + by apply/mem_assoc_uniq; 1:exact uniq_keys. + rewrite -mem_oflist {1}/s -domE=> -[] h; have := h; rewrite dom_reindex. + rewrite imageP=> h'. have {h'} h': forall (a : 'a), !mem (dom m) a \/ f a <> f x by smt. + have /= := h' x. + rewrite in_dom !getE /=. + by move=> -> ->. +qed. + +lemma reindex_injective (f : 'a -> 'c) (m : ('a, 'b) fmap): + injective f => + (forall x, m.[x] = (reindex f m).[f x]). +proof. by move=> f_inj; apply/reindex_injective_on=> + + _. qed. From 089eac0d54c3b6bd62f0240d5a268bccff8f01aa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 23 Jan 2018 20:23:13 +0100 Subject: [PATCH 257/394] . --- sha3/proof/smart_counter/ConcreteF.eca | 58 +++++-- sha3/proof/smart_counter/Handle.eca | 2 +- sha3/proof/smart_counter/SLCommon.ec | 229 +++++++++++++++++++++---- 3 files changed, 238 insertions(+), 51 deletions(-) diff --git a/sha3/proof/smart_counter/ConcreteF.eca b/sha3/proof/smart_counter/ConcreteF.eca index 89fb7ce..8cf3f69 100644 --- a/sha3/proof/smart_counter/ConcreteF.eca +++ b/sha3/proof/smart_counter/ConcreteF.eca @@ -56,8 +56,8 @@ section. type K <- unit, op dK <- (MUnit.dunit<:unit> tt), op q <- max_size - proof *. - realize ge0_q by smt w=max_ge0. + proof *. + realize ge0_q by rewrite max_ge0. realize uD_uf_fu. split. case=> [x y]; rewrite supp_dprod /=. @@ -77,24 +77,56 @@ section. lemma size_behead (l : 'a list) : l <> [] => size (behead l) = size l - 1. proof. by case l=> // ?? /=; ring. qed. + local module CP' (P' : PRPt.Oracles) = { + proc f (x : state) = { + var y <- (b0,c0); + if (!x \in dom C.m) { + y <@ P'.f(x); + C.m.[x] <- y; + C.mi.[y] <- x; + } else { + y <- oget C.m.[x]; + } + return y; + } + proc fi (x : state) = { + var y <- (b0,c0); + if (!x \in dom C.mi) { + y <@ P'.f(x); + C.mi.[x] <- y; + C.m.[y] <- x; + } else { + y <- oget C.mi.[x]; + } + return y; + } + }. + local module (D': PRPt.Distinguisher) (P' : PRPt.Oracles) = { - proc distinguish = DRestr(D,SqueezelessSponge(P'),P').distinguish + proc distinguish = DRestr(D,SqueezelessSponge(CP'(P')),P').distinguish }. + + local lemma DoubleBounding (P <: PRPt.StrongPRP {D, C, DBounder}) &m: Pr[PRPt.IND(P,D').main() @ &m: res] = Pr[PRPt.IND(P,DBounder(D')).main() @ &m: res]. proof. byequiv=> //=; proc; inline *. - wp. - call (_: ={glob C, glob P} /\ DBounder.FBounder.c{2} = C.c{2}). - + proc; sp; if=> //=; inline *. - rcondt{2} 4; 1: by auto=> /#. - by wp; call (_: true); auto. - + proc; sp; if=> //=; inline *. - rcondt{2} 4; 1: by auto=> /#. - by wp; call (_: true); auto. - + proc; sp; if=> //=; inline *. + wp. print prefixe_inv. + call (_: ={glob C, glob P} + /\ prefixe_inv C.queries{1} C.m{1} + /\ ={m,mi}(C,DBounder.FBounder) + /\ DBounder.FBounder.c{2} <= C.c{2}). + + proc; sp; if;auto;if=> //=; inline *. + rcondt{2} 3; 1: by auto=> /#. + rcondt{2} 4;first by auto;call(:true);auto. + by wp; call (_: true); auto;smt(prefixe_inv_set). + + proc; sp; if; auto; if=> //=; inline *. + rcondt{2} 3; 1: by auto=> /#. + rcondt{2} 4;first by auto;call(:true);auto. + wp; call (_: true); auto;progress. smt. admit. admit. + + proc; sp; if; auto; if=> //=; inline *. wp; while ( ={glob C, glob P, p, sa, sc} /\ C.c{2} <= max_size /\ DBounder.FBounder.c{2} = C.c{2} - size p{2}). @@ -112,7 +144,7 @@ section. lemma Real_Concrete &m : Pr[GReal(D).main()@ &m: res /\ C.c <= max_size] <= - Pr[CF(DRestr(D)).main()@ &m: res] + (max_size ^ 2)%r * mu dstate (pred1 witness). + Pr[CF(DRestr(D)).main()@ &m: res] + (max_size ^ 2)%r * inv 2%r * mu dstate (pred1 witness). proof. cut->: Pr[RealIndif(SqueezelessSponge,PC(Perm),D).main()@ &m: diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index 1694dc7..6dbc866 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -1846,7 +1846,7 @@ section. lemma Real_G1 &m: Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= - Pr[G1(DRestr(D)).main() @ &m: res] + (max_size ^ 2)%r * mu dstate (pred1 witness) + + Pr[G1(DRestr(D)).main() @ &m: res] + (max_size ^ 2)%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 D_ll &m)). diff --git a/sha3/proof/smart_counter/SLCommon.ec b/sha3/proof/smart_counter/SLCommon.ec index 8453ae9..9f4b155 100644 --- a/sha3/proof/smart_counter/SLCommon.ec +++ b/sha3/proof/smart_counter/SLCommon.ec @@ -223,8 +223,143 @@ op get_max_prefixe (l : 'a list) (ll : 'a list list) = with ll = (::) l' ll' => max_prefixe l l' ll'. +pred invm (m mi : ('a * 'b, 'a * 'b) fmap) = + forall x y, m.[x] = Some y <=> mi.[y] = Some x. +print foldl. + + +op blocksponge (l : block list) (m : (state, state) fmap) (bc : state) = + with l = "[]" => (l,bc) + with l = (::) b' l' => + let (b,c) = (bc.`1,bc.`2) in + if ((b +^ b', c) \in dom m) then blocksponge l' m (oget m.[(b +^ b', c)]) + else (l,(b,c)). + +op s0 : state = (b0,c0). + +lemma blocksponge_size_leq l m bc : + size (blocksponge l m bc).`1 <= size l. +proof. +move:m bc;elim l=>//=. +move=>e l Hind m bc/#. +qed. + + +lemma blocksponge_set l m bc x y : + (x \in dom m => y = oget m.[x]) => + let bs1 = blocksponge l m bc in + let bs2 = blocksponge l m.[x <- y] bc in + let l1 = bs1.`1 in let l2 = bs2.`1 in let bc1 = bs1.`2 in let bc2 = bs2.`2 in + size l2 <= size l1 /\ (size l1 = size l2 => (l1 = l2 /\ bc1 = bc2)). +proof. +move=>Hxy/=;split. ++ move:m bc x y Hxy;elim l=>//=. + move=>/=e l Hind m bc x y Hxy/=;rewrite dom_set in_fsetU1. + case((bc.`1 +^ e, bc.`2) = x)=>//=[->//=|hx]. + + rewrite getP/=oget_some;case(x\in dom m)=>//=[/#|]. + smt(blocksponge_size_leq getP). + rewrite getP hx/=. + case((bc.`1 +^ e, bc.`2) \in dom m)=>//=Hdom. + by cut//:=Hind m (oget m.[(bc.`1 +^ e, bc.`2)]) x y Hxy. +move:m bc x y Hxy;elim l=>//=. +move=>e l Hind m bx x y Hxy. +rewrite!dom_set !in_fsetU1 !getP. +case((bx.`1 +^ e, bx.`2) \in dom m)=>//=Hdom. ++ case(((bx.`1 +^ e, bx.`2) = x))=>//=Hx. + + move:Hdom;rewrite Hx=>Hdom. + cut:=Hxy;rewrite Hdom/==>Hxy2. + rewrite oget_some -Hxy2/=. + by cut:=Hind m y x y Hxy. + by cut:=Hind m (oget m.[(bx.`1 +^ e, bx.`2)]) x y Hxy. +case(((bx.`1 +^ e, bx.`2) = x))=>//=;smt(blocksponge_size_leq). +qed. + + +lemma blocksponge_cat m l1 l2 bc : + blocksponge (l1 ++ l2) m bc = + let lbc = blocksponge l1 m bc in + blocksponge (lbc.`1 ++ l2) m (lbc.`2). +proof. +rewrite/=. +move:m bc l2;elim l1=>//= e1 l1 Hind m bc b. +case((bc.`1 +^ e1, bc.`2) \in dom m)=>//=[|->//=]Hdom. +by cut//:=Hind m (oget m.[(bc.`1 +^ e1, bc.`2)]) b. +qed. + + +lemma blocksponge_rcons m l bc b : + blocksponge (rcons l b) m bc = + let lbc = blocksponge l m bc in + blocksponge (rcons lbc.`1 b) m (lbc.`2). +proof. +by rewrite/=-2!cats1 blocksponge_cat/=. +qed. + + +pred prefixe_inv (queries : (block list, block) fmap) + (m : (state, state) fmap) = + forall (bs : block list), + bs \in dom queries => + forall i, 0 <= i < size bs => + let bc = (blocksponge (take i bs) m s0).`2 in + (bc.`1 +^ nth b0 bs i, bc.`2) \in dom m. + + + +lemma prefixe_inv_bs_fst_nil queries m : + prefixe_inv queries m => + forall l, l \in dom queries => + forall i, 0 <= i <= size l => + (blocksponge (take i l) m s0).`1 = []. +proof. +move=>Hinv l Hdom i [Hi0 Hisize];move:i Hi0 l Hisize Hdom;apply intind=>//=. ++ by move=>l;rewrite take0/=. +move=>i Hi0 Hind l Hil Hldom. +rewrite(take_nth b0)1:/#. +rewrite blocksponge_rcons/=. +cut->/=:=Hind l _ Hldom;1:rewrite/#. +by cut/=->/=:=Hinv _ Hldom i _;1:rewrite/#. +qed. + + +lemma prefixe_inv_set queries m x y : + !x \in dom m => + prefixe_inv queries m => + prefixe_inv queries m.[x <- y]. +proof. +move=>Hxdom Hpref bs/=Hbsdom i [Hi0 Hisize]. +cut->:blocksponge (take i bs) m.[x <- y] s0 = blocksponge (take i bs) m s0. ++ move:i Hi0 bs Hisize Hbsdom;apply intind=>//=i;first by rewrite take0//=. + move=>Hi0 Hind bs Hsize Hbsdom. + rewrite (take_nth b0)1:/#. + rewrite 2!blocksponge_rcons/=. + cut->/=:=prefixe_inv_bs_fst_nil _ _ Hpref _ Hbsdom i _;1:rewrite/#. + cut/=->/=:=Hpref _ Hbsdom i _;1:rewrite/#. + cut->/=:=Hind bs _ Hbsdom;1:rewrite/#. + cut->/=:=prefixe_inv_bs_fst_nil _ _ Hpref _ Hbsdom i _;1:rewrite/#. + rewrite dom_set in_fsetU1. + cut/=->/=:=Hpref _ Hbsdom i _;1:rewrite/#. + rewrite getP. + cut/#:=Hpref _ Hbsdom i _;1:rewrite/#. +rewrite dom_set in_fsetU1. +cut/#:=Hpref _ Hbsdom i _;1:rewrite/#. +qed. + + +lemma size_blocksponge queries m l : + prefixe_inv queries m => + size (blocksponge l m s0).`1 <= size l - prefixe l (get_max_prefixe l (elems (dom queries))). +proof. +move=>Hinv. +pose l2:=get_max_prefixe _ _;pose p:=prefixe _ _. search take drop. +rewrite-{1}(cat_take_drop p l)blocksponge_cat/=. +rewrite(prefixe_take). + +qed. + end Prefixe. +export Prefixe. (* -------------------------------------------------------------------------- *) @@ -232,10 +367,12 @@ module C = { var c : int var m : (state, state) fmap var mi : (state, state) fmap + var queries : (block list, block) fmap proc init () = { - c <- 0; - m <- map0; - mi <- map0; + c <- 0; + m <- map0; + mi <- map0; + queries <- map0; } }. @@ -247,23 +384,27 @@ module PC (P:PRIMITIVE) = { } proc f (x:state) = { - var y; - y <@ P.f(x); + var y <- (b0,c0); if (!x \in dom C.m) { + y <@ P.f(x); C.c <- C.c + 1; C.m.[x] <- y; C.mi.[y] <- x; + } else { + y <- oget C.m.[x]; } return y; } proc fi(x:state) = { - var y; - y <@ P.fi(x); + var y <- (b0,c0); if (!x \in dom C.mi) { + y <@ P.fi(x); C.c <- C.c + 1; C.mi.[x] <- y; C.m.[y] <- x; + } else { + y <- oget C.mi.[x]; } return y; } @@ -273,27 +414,31 @@ module PC (P:PRIMITIVE) = { module DPRestr (P:DPRIMITIVE) = { proc f (x:state) = { - var y=(b0,c0); - if (C.c + 1 <= max_size) { - y <@ P.f(x); - if (!x \in dom C.m) { + var y <- (b0,c0); + if (!x \in dom C.m) { + if (C.c + 1 <= max_size) { + y <@ P.f(x); C.c <- C.c + 1; C.m.[x] <- y; C.mi.[y] <- x; } + } else { + y <- oget C.m.[x]; } return y; } proc fi(x:state) = { - var y=(b0,c0); - if (C.c + 1 <= max_size) { - y <@ P.fi(x); - if (!x \in dom C.mi) { + var y <- (b0,c0); + if (!x \in dom C.mi) { + if (C.c + 1 <= max_size) { + y <@ P.fi(x); C.c <- C.c + 1; C.mi.[x] <- y; C.m.[y] <- x; } + } else { + y <- oget C.mi.[x]; } return y; } @@ -318,9 +463,14 @@ module FC(F:FUNCTIONALITY) = { proc init = F.init proc f (bs:block list) = { - var b= b0; - C.c <- C.c + size bs; - b <@ F.f(bs); + var b <- b0; + if (!bs \in dom C.queries) { + C.c <- C.c + size bs - prefixe bs (get_max_prefixe bs (elems (dom C.queries))); + b <@ F.f(bs); + C.queries.[bs] <- b; + } else { + b <- oget C.queries.[bs]; + } return b; } }. @@ -329,9 +479,14 @@ module DFRestr(F:DFUNCTIONALITY) = { proc f (bs:block list) = { var b= b0; - if (C.c + size bs <= max_size) { - C.c <- C.c + size bs; - b <@ F.f(bs); + if (!bs \in dom C.queries) { + if (C.c + size bs - prefixe bs (get_max_prefixe bs (elems (dom C.queries))) <= max_size) { + C.c <- C.c + size bs - prefixe bs (get_max_prefixe bs (elems (dom C.queries))); + b <@ F.f(bs); + C.queries.[bs] <- b; + } + } else { + b <- oget C.queries.[bs]; } return b; } @@ -356,14 +511,14 @@ module DRestr(D:DISTINGUISHER, F:DFUNCTIONALITY, P:DPRIMITIVE) = { } }. -lemma rp_ll (P<:DPRIMITIVE): islossless P.f => islossless DPRestr(P).f. -proof. move=>Hll;proc;sp;if=>//;call Hll;auto. qed. +lemma rp_ll (P<:DPRIMITIVE{C}): islossless P.f => islossless DPRestr(P).f. +proof. move=>Hll;proc;sp;if;auto;if;auto;call Hll;auto. qed. -lemma rpi_ll (P<:DPRIMITIVE): islossless P.fi => islossless DPRestr(P).fi. -proof. move=>Hll;proc;sp;if=>//;call Hll;auto. qed. +lemma rpi_ll (P<:DPRIMITIVE{C}): islossless P.fi => islossless DPRestr(P).fi. +proof. move=>Hll;proc;sp;if;auto;if;auto;call Hll;auto. qed. -lemma rf_ll (F<:DFUNCTIONALITY): islossless F.f => islossless DFRestr(F).f. -proof. move=>Hll;proc;sp;if=>//;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}), @@ -390,7 +545,7 @@ section RESTR. Pr[Indif(F,P,DRestr(D)).main()@ &m: res]. proof. byequiv=>//. - proc;inline *;wp;swap{1}1 2;sim. + proc;inline *;wp;swap{1}1 2;sim;auto;call(:true);auto;call(:true);auto. qed. end section RESTR. @@ -419,18 +574,18 @@ section COUNT. symmetry;proc;inline *;wp;swap{2}1 2. call (_: max_size < C.c, ={glob P, glob CO, glob C}). + apply D_ll. - + proc; sp 1 0;if{1};1:by call(_:true);auto. + + proc; sp;if;auto;if{1};1:by auto;call(_:true);auto. by call{2} f_ll;auto=>/#. - + by move=> ?_;proc;sp;if;auto;call f_ll;auto. - + by move=> _;proc;call f_ll;auto=>/#. - + proc;sp 1 0;if{1};1:by call(_:true);auto. + + by move=> ?_;proc;sp;if;auto;if;auto;call f_ll;auto. + + by move=> _;proc;sp;if;auto;call f_ll;auto=>/#. + + proc;sp;if;auto;if{1};1:by auto;call(_:true);auto. by call{2} fi_ll;auto=>/#. - + by move=> ?_;proc;sp;if;auto;call fi_ll;auto. - + by move=> _;proc;call fi_ll;auto=>/#. - + proc;sp 1 0;if{1};1:by call(_: ={glob P});auto;sim. + + by move=> ?_;proc;sp;if;auto;if;auto;call fi_ll;auto. + + by move=> _;proc;sp;if;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;call CO_ll;auto. - + move=> _;proc;call CO_ll;auto;smt ml=0 w=size_ge0. + + by move=> ?_;proc;sp;if;auto;if;auto;call CO_ll;auto. + + by move=> _;proc;sp;if;auto;call CO_ll;auto;smt(prefixe_sizel). wp;call (_:true);call(_:true);auto=>/#. qed. From 8120a0f7b9b9db954f9f696a783ba2528018cfd0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Wed, 7 Feb 2018 17:40:24 +0100 Subject: [PATCH 258/394] . --- sha3/proof/smart_counter/ConcreteF.eca | 270 +++++++++++++++++++++++-- sha3/proof/smart_counter/Handle.eca | 8 +- sha3/proof/smart_counter/SLCommon.ec | 57 ++++-- 3 files changed, 303 insertions(+), 32 deletions(-) diff --git a/sha3/proof/smart_counter/ConcreteF.eca b/sha3/proof/smart_counter/ConcreteF.eca index 8cf3f69..8565349 100644 --- a/sha3/proof/smart_counter/ConcreteF.eca +++ b/sha3/proof/smart_counter/ConcreteF.eca @@ -19,8 +19,10 @@ module PF = { if (!mem (dom m) x) { y1 <$ bdistr; y2 <$ cdistr; + if (!(y1,y2) \in dom mi) { + mi.[(y1,y2)] <- x; + } m.[x] <- (y1,y2); - mi.[(y1,y2)] <- x; } return oget m.[x]; } @@ -31,8 +33,10 @@ module PF = { if (!mem (dom mi) x) { y1 <$ bdistr; y2 <$ cdistr; + if (!(y1,y2) \in dom m) { + m.[(y1,y2)] <- x; + } mi.[x] <- (y1,y2); - m.[(y1,y2)] <- x; } return oget mi.[x]; } @@ -82,8 +86,10 @@ section. var y <- (b0,c0); if (!x \in dom C.m) { y <@ P'.f(x); + if (!y \in dom C.mi) { + C.mi.[y] <- x; + } C.m.[x] <- y; - C.mi.[y] <- x; } else { y <- oget C.m.[x]; } @@ -93,8 +99,10 @@ section. var y <- (b0,c0); if (!x \in dom C.mi) { y <@ P'.f(x); + if (!y \in dom C.m) { + C.m.[y] <- x; + } C.mi.[x] <- y; - C.m.[y] <- x; } else { y <- oget C.mi.[x]; } @@ -106,14 +114,14 @@ section. proc distinguish = DRestr(D,SqueezelessSponge(CP'(P')),P').distinguish }. - +print DRestr. local lemma DoubleBounding (P <: PRPt.StrongPRP {D, C, DBounder}) &m: Pr[PRPt.IND(P,D').main() @ &m: res] = Pr[PRPt.IND(P,DBounder(D')).main() @ &m: res]. proof. byequiv=> //=; proc; inline *. - wp. print prefixe_inv. + wp. call (_: ={glob C, glob P} /\ prefixe_inv C.queries{1} C.m{1} /\ ={m,mi}(C,DBounder.FBounder) @@ -125,15 +133,231 @@ section. + proc; sp; if; auto; if=> //=; inline *. rcondt{2} 3; 1: by auto=> /#. rcondt{2} 4;first by auto;call(:true);auto. - wp; call (_: true); auto;progress. smt. admit. admit. + wp; call (_: true); auto;progress. + + smt(prefixe_inv_set). + + rewrite/#. + + rewrite/#. + proc; sp; if; auto; if=> //=; inline *. - wp; while ( ={glob C, glob P, p, sa, sc} - /\ C.c{2} <= max_size - /\ DBounder.FBounder.c{2} = C.c{2} - size p{2}). - rcondt{2} 3; 1: by auto; smt w=size_ge0. - by wp; call (_: true); auto=> /#. - by auto; progress; ring. - by wp; call (_: true). + splitwhile{1} 4 : (sa +^ head witness p, sc) \in dom C.m. + splitwhile{2} 4 : (sa +^ head witness p, sc) \in dom C.m. + wp=>//=;swap 1 4;wp=>//=. + conseq(:_==> ={sa, C.mi, C.m, glob P} /\ C.m{1} = DBounder.FBounder.m{2} + /\ C.mi{1} = DBounder.FBounder.mi{2} + /\ prefixe_inv C.queries{1} C.m{1} + /\ DBounder.FBounder.c{2} <= C.c{2} + size bs{2} - + prefixe bs{2} (get_max_prefixe bs{2} (elems (dom C.queries{2}))) + /\ (forall (i : int), + 0 <= i < size bs{2} => + let bc = (blocksponge (take i bs{2}) C.m{1} s0).`2 in + (bc.`1 +^ nth b0 bs{2} i, bc.`2) \in dom C.m{1})); + 1:smt(dom_set in_fsetU1). + + while(={sa, sc, C.mi, C.m, glob P, p, bs, C.c, C.queries} + /\ C.m{1} = DBounder.FBounder.m{2} + /\ C.mi{1} = DBounder.FBounder.mi{2} + /\ (exists i, p{2} = drop i bs{2} /\ 0 <= i <= size bs{2} + /\ blocksponge (take i bs{2}) C.m{1} s0 = ([], (sa{1},sc{1}))) + /\ prefixe_inv C.queries{1} C.m{1} + /\ C.c{1} + size bs{1} - prefixe bs{1} + (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= max_size + /\ DBounder.FBounder.c{2} <= C.c{2} + size bs{2} - size p{2} - + prefixe bs{2} (get_max_prefixe bs{2} (elems (dom C.queries{2}))) + /\ (forall (i : int), + 0 <= i < size bs{2} - size p{2} => + let bc = (blocksponge (take i bs{2}) C.m{1} s0).`2 in + (bc.`1 +^ nth b0 bs{2} i, bc.`2) \in dom C.m{1}) + /\ (forall (i : int), + 0 <= i < size bs{2} - size p{2} => + (blocksponge (take i bs{2}) C.m{1} s0).`1 = [])). + + sp;if;1,3:auto;last first;progress. + - exists (i+1);rewrite(drop_nth witness)//=;2:split;1,2:smt(drop_oversize). + rewrite (take_nth witness);1:smt(drop_oversize). + move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). + move=>?. + rewrite blocksponge_rcons H1/=H9/=/#. + - rewrite size_behead//=/#. + - move:H11;rewrite size_behead//=. + case(i0 < size bs{2} - size (drop i bs{2}))=>[/#|]h h1. + cut->:i0 = size bs{2} - size (drop i bs{2}) by rewrite/#. + rewrite size_drop//=max_ler 1:/#/=. + cut->:(size bs{2} - (size bs{2} - i)) = i by ring. + rewrite H1/=. + by move:H9;rewrite (drop_nth b0)/=;1:smt(drop_oversize). + - move:H11;rewrite size_behead//=. + case(i0 < size bs{2} - size (drop i bs{2}))=>[/#|]h h1. + cut->:i0 = size bs{2} - size (drop i bs{2}) by rewrite/#. + rewrite size_drop//=max_ler 1:/#/=. + cut->:(size bs{2} - (size bs{2} - i)) = i by ring. + by rewrite H1/=. + + rcondt{2}3;1:(auto;smt(size_ge0 size_eq0)). + rcondt{2}4;1:by auto;call(:true);auto. + wp;call(:true);auto;progress. + - exists (i+1);rewrite(drop_nth witness)//=;2:split;1,2:smt(drop_oversize). + rewrite (take_nth witness);1:smt(drop_oversize). + move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). + move=>h. + rewrite blocksponge_rcons/=. + cut/=:=blocksponge_set_nil (take i bs{2}) DBounder.FBounder.m{2} s0 + (sa{2} +^ nth witness bs{2} i, sc{2}) result_R h. + rewrite H1/=/==>->/=;rewrite dom_set in_fsetU1/=getP/=oget_some/#. + - smt(prefixe_inv_set). + - smt(size_ge0 size_eq0). + - move:H12;rewrite size_behead//==>?. + move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). + move=>h. + case(i0 < size bs{2} - size (drop i bs{2}))=>[|]?. + + cut//=->/=:=blocksponge_set_nil (take i0 bs{2}) DBounder.FBounder.m{2} s0 + (sa{2} +^ nth witness bs{2} i, sc{2}) result_R h (H6 i0 _);1:rewrite/#. + by rewrite dom_set in_fsetU1/#. + cut hii0:i0=i by move:H9 H12;rewrite!size_drop//=max_ler /#. + rewrite hii0. + cut//=:=blocksponge_set_nil (take i bs{2}) DBounder.FBounder.m{2} s0 + (sa{2} +^ nth witness bs{2} i, sc{2}) result_R h. + rewrite H1/==>->/=;rewrite dom_set in_fsetU1//=;right;congr. + by rewrite nth_onth (onth_nth witness)//=;smt(size_ge0 size_eq0). + + move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). + move=>h. + case(i0 < size bs{2} - size (drop i bs{2}))=>[|]?. + + smt(blocksponge_set_nil). + cut hii0:i0=i by move:H12;rewrite size_behead//==>?; + move:H9 H12;rewrite!size_drop//=max_ler /#. + rewrite hii0;smt(blocksponge_set_nil). + + exists (i+1);rewrite(drop_nth witness)//=;2:split;1,2:smt(drop_oversize). + rewrite (take_nth witness);1:smt(drop_oversize). + move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). + move=>h. + rewrite blocksponge_rcons/=. + cut/=:=blocksponge_set_nil (take i bs{2}) DBounder.FBounder.m{2} s0 + (sa{2} +^ nth witness bs{2} i, sc{2}) result_R h. + rewrite H1/=/==>->/=;rewrite dom_set in_fsetU1/=getP/=oget_some/#. + - smt(prefixe_inv_set). + - smt(size_ge0 size_eq0). + - move:H12;rewrite size_behead//==>?. + move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). + move=>h. + case(i0 < size bs{2} - size (drop i bs{2}))=>[|]?. + + cut//=->/=:=blocksponge_set_nil (take i0 bs{2}) DBounder.FBounder.m{2} s0 + (sa{2} +^ nth witness bs{2} i, sc{2}) result_R h (H6 i0 _);1:rewrite/#. + by rewrite dom_set in_fsetU1/#. + cut hii0:i0=i by move:H9 H12;rewrite!size_drop//=max_ler /#. + rewrite hii0. + cut//=:=blocksponge_set_nil (take i bs{2}) DBounder.FBounder.m{2} s0 + (sa{2} +^ nth witness bs{2} i, sc{2}) result_R h. + rewrite H1/==>->/=;rewrite dom_set in_fsetU1//=;right;congr. + by rewrite nth_onth (onth_nth witness)//=;smt(size_ge0 size_eq0). + + move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). + move=>h. + case(i0 < size bs{2} - size (drop i bs{2}))=>[|]?. + + smt(blocksponge_set_nil). + cut hii0:i0=i by move:H12;rewrite size_behead//==>?; + move:H9 H12;rewrite!size_drop//=max_ler /#. + rewrite hii0;smt(blocksponge_set_nil). + + conseq(:_==> ={sa, sc, C.mi, C.m, glob P, p, bs, C.c, C.queries} + /\ C.m{1} = DBounder.FBounder.m{2} + /\ C.mi{1} = DBounder.FBounder.mi{2} + /\ (exists i, p{2} = drop i bs{2} /\ 0 <= i <= size bs{2} + /\ blocksponge (take i bs{2}) C.m{1} s0 = ([], (sa{1},sc{1}))) + /\ prefixe_inv C.queries{1} C.m{1} + /\ C.c{1} + size bs{1} - prefixe bs{1} + (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= max_size + /\ DBounder.FBounder.c{2} <= C.c{2} + size bs{2} - size p{2} - + prefixe bs{2} (get_max_prefixe bs{2} (elems (dom C.queries{2}))) + /\ (forall (i : int), + 0 <= i < size bs{2} - size p{2} => + let bc = (blocksponge (take i bs{2}) C.m{1} s0).`2 in + (bc.`1 +^ nth b0 bs{2} i, bc.`2) \in dom C.m{1}) + /\ (forall (i : int), + 0 <= i < size bs{2} - size p{2} => + (blocksponge (take i bs{2}) C.m{1} s0).`1 = []));1:rewrite/#. + + alias{2} 1 k = DBounder.FBounder.c;sp 0 1. + alias{2} 1 dm = DBounder.FBounder.m;sp 0 1. + alias{2} 1 dmi = DBounder.FBounder.mi;sp 0 1. + alias{2} 1 cm = C.m;sp 0 1. + alias{2} 1 cmi = C.mi;sp 0 1. + conseq(:_==> ={sa, sc, C.mi, C.m, glob P, p, bs, C.c} + /\ C.m{1} = cm{2} + /\ DBounder.FBounder.m{2} = dm{2} + /\ C.mi{1} = cmi{2} + /\ DBounder.FBounder.mi{2} = dmi{2} + /\ (exists i, p{2} = drop i bs{2} /\ 0 <= i <= size bs{2} + /\ blocksponge (take i bs{2}) C.m{1} s0 = ([], (sa{1},sc{1}))) + /\ prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= size bs{1} - size p{1} + /\ DBounder.FBounder.c{2} = k{2} + /\ (forall (i : int), + 0 <= i < size bs{2} - size p{2} => + let bc = (blocksponge (take i bs{2}) C.m{1} s0).`2 in + (bc.`1 +^ nth b0 bs{2} i, bc.`2) \in dom C.m{1}) + /\ (forall (i : int), + 0 <= i < size bs{2} - size p{2} => + (blocksponge (take i bs{2}) C.m{1} s0).`1 = []));progress. + + rewrite/#. + + smt(size_ge0 size_drop). + + while(={sa, sc, C.mi, C.m, glob P, p, bs, C.c} + /\ prefixe_inv C.queries{1} C.m{1} + /\ C.m{1} = cm{2} + /\ DBounder.FBounder.m{2} = dm{2} + /\ C.mi{1} = cmi{2} + /\ DBounder.FBounder.mi{2} = dmi{2} + /\ (exists i, p{2} = drop i bs{2} /\ 0 <= i <= size bs{2} + /\ blocksponge (take i bs{2}) C.m{1} s0 = ([], (sa{1},sc{1}))) + /\ DBounder.FBounder.c{2} = k{2} + /\ (forall (i : int), + 0 <= i < size bs{2} - size p{2} => + let bc = (blocksponge (take i bs{2}) C.m{1} s0).`2 in + (bc.`1 +^ nth b0 bs{2} i, bc.`2) \in dom C.m{1}) + /\ (forall (i : int), + 0 <= i < size bs{2} - size p{2} => + (blocksponge (take i bs{2}) C.m{1} s0).`1 = []));last first. + + auto;progress. + smt(drop0 size_ge0). + smt(drop0 size_ge0). + smt(drop0 size_ge0). + smt(drop0 size_ge0). + move:H4;rewrite negb_and/==>[]. + case(drop i bs{2} = [])=>[hdropi|hdropi]//=. + + rewrite hdropi/=;smt(prefixe_sizel). + rewrite size_drop//=max_ler 1:/#. + cut->:size bs{2} - (size bs{2} - i) = i by rewrite/#. + rewrite(drop_nth b0)//=;1:smt(size_ge0 size_eq0 size_drop). print prefixe_inv. + apply absurd=>//=hi. + cut->:nth b0 bs{2} i = nth b0 (get_max_prefixe bs{2} (elems (dom C.queries{2}))) i. + + rewrite 2!nth_onth (onth_nth witness);1:smt(size_drop size_eq0). + cut/=h:=prefixe_nth bs{2} (get_max_prefixe bs{2} (elems (dom C.queries{2}))). + cut->:=h i _;1:smt(size_drop size_eq0). + by rewrite (onth_nth witness)/=;1:smt(size_drop size_eq0 prefixe_sizer). + cut:=H (get_max_prefixe bs{2} (elems (dom C.queries{2}))) _;last first. + + move=>h;cut:=h i _;1:smt(prefixe_sizer). + cut:=H8;cut->/#:(take i bs{2}) = (take i (get_max_prefixe bs{2} (elems (dom C.queries{2})))). + by apply (eq_from_nth b0 _ _ _ _); + smt(size_take prefixe_sizer prefixe_sizel nth_take prefixe_nth nth_onth onth_nth). + cut h:forall (l1 l2:block list) ll, max_prefixe l1 l2 ll = l2 \/ max_prefixe l1 l2 ll \in ll. + + clear P &m &1 &2 H H0 H H1 H2 P_R sa_R sc_R H5 i H3 H6 H7 H8 H9 H10 hdropi hi. + by move=>l1 l2 ll;move:ll l1 l2;move=>ll;elim:ll=>//=/#. + cut h1:forall (l : block list) ll, get_max_prefixe l ll <> [] => ll <> []. + + clear P &m &1 &2 H H0 H H1 H2 P_R sa_R sc_R H5 i H3 H6 H7 H8 H9 H10 hdropi hi. + by move=>l ll;move:ll l=>ll;elim:ll=>//=. + rewrite memE;smt(prefixe_sizer). + sp;rcondf{1}1;2:rcondf{2}1;auto;progress. + - exists (i+1);rewrite(drop_nth witness)//=;2:split;1,2:smt(drop_oversize). + rewrite (take_nth witness);1:smt(drop_oversize). + move:H8;rewrite (drop_nth witness)/=;1:smt(drop_oversize). + move=>h. + rewrite blocksponge_rcons/=H2/=h/=/#. + - move:H10;rewrite size_behead//=. + case(i0 < size bs{2} - size (drop i bs{2}))=>??;1:rewrite/#. + cut hii0:i0=i by smt(size_drop). + rewrite hii0 H2/=. + move:H8;rewrite (drop_nth witness)/=;1:smt(drop_oversize). + by rewrite nth_onth (onth_nth b0)/=;1:smt(size_eq0). + - move:H10;rewrite size_behead//=. + case(i0 < size bs{2} - size (drop i bs{2}))=>??;1:rewrite/#. + cut hii0:i0=i by smt(size_drop). + by rewrite hii0 H2/=. + auto;progress;call(:true);auto;smt(dom0 in_fset0). qed. local clone import ProdSampling with @@ -149,9 +373,23 @@ section. cut->: 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});last by auto. - + by sim. + by sim. + + byequiv=>//;proc;inline *;call (_: ={glob C,glob Perm} + /\ prefixe_inv C.queries{1} Perm.m{1} /\ inv Perm.m{1} Perm.mi{1}); + last by auto;smt(dom0 in_fset0 map0P). + + proc;inline*;sp;if;auto;sp;if;auto;progress. + - smt(getP oget_some prefixe_inv_set). + - smt(in_dom inv_dom_rng invC getP oget_some supp_dexcepted). + - smt(getP oget_some prefixe_inv_set). + - smt(in_dom inv_dom_rng invC getP oget_some supp_dexcepted). + + proc;inline*;sp;if;auto;sp;if;auto;progress. + - smt(getP oget_some prefixe_inv_set invC inv_dom_rng supp_dexcepted). + - smt(in_dom inv_dom_rng invC getP oget_some supp_dexcepted). + - smt(getP oget_some prefixe_inv_set invC inv_dom_rng supp_dexcepted). + - smt(in_dom inv_dom_rng invC getP oget_some supp_dexcepted). proc; inline *; wp. + sp;if{2}. + (* TODO : reprendre ici *) + + while (={glob Perm,sc,sa,p} /\ (C.c + size p){1} = C.c{2});2:by auto. by sp; if=> //=; auto=> /> &2 cL /size_behead=> ->; progress; ring. have p_ll := P_f_ll _ _. diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index 6dbc866..01ff87e 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -4,7 +4,7 @@ require import List FSet NewFMap Utils Common SLCommon RndO. require import DProd Dexcepted. (*...*) import Capacity IntOrder DCapacity. -require ConcreteF. +(* require ConcreteF. *) clone import GenEager as ROhandle with type from <- handle, @@ -12,7 +12,7 @@ clone import GenEager as ROhandle with op sampleto <- fun (_:int) => cdistr proof sampleto_ll by apply DCapacity.dunifin_ll. -print FRO. + module G1(D:DISTINGUISHER) = { var m, mi : smap var mh, mhi : hsmap @@ -1119,7 +1119,7 @@ move: pi_xc; have /pi_of_INV [] -> [h] [#] + hs_h:= HINV. by have /hs_of_INV [] + _ _ - /(_ _ _ _ _ hs_hx hs_h _) := HINV. qed. -clone export ConcreteF as ConcreteF1. +(* clone export ConcreteF as ConcreteF1. *) lemma m_mh_None hs0 PFm G1mh hx2 x2 k x1: m_mh hs0 PFm G1mh => @@ -1204,6 +1204,8 @@ qed. (* we should do a lemma to have the equivalence *) + + equiv eq_fi (D <: DISTINGUISHER {PF, RO, G1}): PF.fi ~ G1(D).S.fi: !G1.bcol{2} /\ !G1.bext{2} diff --git a/sha3/proof/smart_counter/SLCommon.ec b/sha3/proof/smart_counter/SLCommon.ec index 9f4b155..239f700 100644 --- a/sha3/proof/smart_counter/SLCommon.ec +++ b/sha3/proof/smart_counter/SLCommon.ec @@ -225,8 +225,18 @@ op get_max_prefixe (l : 'a list) (ll : 'a list list) = pred invm (m mi : ('a * 'b, 'a * 'b) fmap) = forall x y, m.[x] = Some y <=> mi.[y] = Some x. -print foldl. +lemma invm_set (m mi : ('a * 'b, 'a * 'b) fmap) x y : + ! x \in dom m => ! y \in rng m => invm m mi => invm m.[x <- y] mi.[y <- x]. +proof. +move=>Hxdom Hyrng Hinv a b;rewrite!getP;split. ++ case(a=x)=>//=hax hab;cut->/#:b<>y. + by cut/#:b\in rng m;rewrite in_rng/#. +case(a=x)=>//=hax. ++ case(b=y)=>//=hby. + by rewrite (eq_sym y b)hby/=-Hinv hax;rewrite in_dom/=/# in Hxdom. +by rewrite Hinv/#. +qed. op blocksponge (l : block list) (m : (state, state) fmap) (bc : state) = with l = "[]" => (l,bc) @@ -346,17 +356,30 @@ cut/#:=Hpref _ Hbsdom i _;1:rewrite/#. qed. -lemma size_blocksponge queries m l : - prefixe_inv queries m => - size (blocksponge l m s0).`1 <= size l - prefixe l (get_max_prefixe l (elems (dom queries))). +lemma blocksponge_set_nil l m bc x y : + !x \in dom m => + let bs1 = blocksponge l m bc in + let bs2 = blocksponge l m.[x <- y] bc in + bs1.`1 = [] => + bs2 = ([], bs1.`2). proof. -move=>Hinv. -pose l2:=get_max_prefixe _ _;pose p:=prefixe _ _. search take drop. -rewrite-{1}(cat_take_drop p l)blocksponge_cat/=. -rewrite(prefixe_take). - +rewrite/==>hdom bs1. +cut/=:=blocksponge_set l m bc x y. +smt(size_ge0 size_eq0). qed. +(* lemma size_blocksponge queries m l : *) +(* prefixe_inv queries m => *) +(* size (blocksponge l m s0).`1 <= size l - prefixe l (get_max_prefixe l (elems (dom queries))). *) +(* proof. *) +(* move=>Hinv. *) +(* pose l2:=get_max_prefixe _ _;pose p:=prefixe _ _. search take drop. *) +(* rewrite-{1}(cat_take_drop p l)blocksponge_cat/=. *) +(* rewrite(prefixe_take). *) +(* qed. *) + + + end Prefixe. export Prefixe. @@ -389,7 +412,9 @@ module PC (P:PRIMITIVE) = { y <@ P.f(x); C.c <- C.c + 1; C.m.[x] <- y; - C.mi.[y] <- x; + if (! y \in dom C.mi) { + C.mi.[y] <- x; + } } else { y <- oget C.m.[x]; } @@ -402,7 +427,9 @@ module PC (P:PRIMITIVE) = { y <@ P.fi(x); C.c <- C.c + 1; C.mi.[x] <- y; - C.m.[y] <- x; + if (! y \in dom C.m) { + C.m.[y] <- x; + } } else { y <- oget C.mi.[x]; } @@ -420,7 +447,9 @@ module DPRestr (P:DPRIMITIVE) = { y <@ P.f(x); C.c <- C.c + 1; C.m.[x] <- y; - C.mi.[y] <- x; + if (! y \in dom C.mi) { + C.mi.[y] <- x; + } } } else { y <- oget C.m.[x]; @@ -435,7 +464,9 @@ module DPRestr (P:DPRIMITIVE) = { y <@ P.fi(x); C.c <- C.c + 1; C.mi.[x] <- y; - C.m.[y] <- x; + if (! y \in dom C.m) { + C.m.[y] <- x; + } } } else { y <- oget C.mi.[x]; From cdfd3cf05433dde95ea3de454e8f4f9338c3cb57 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Fri, 16 Feb 2018 18:10:26 +0100 Subject: [PATCH 259/394] ConcreteF.eca : completed Handle.eca : TODO --- sha3/proof/smart_counter/ConcreteF.eca | 558 +++++++++----------- sha3/proof/smart_counter/Handle.eca | 2 +- sha3/proof/smart_counter/SLCommon.ec | 684 ++++++++++++++++++++----- 3 files changed, 810 insertions(+), 434 deletions(-) diff --git a/sha3/proof/smart_counter/ConcreteF.eca b/sha3/proof/smart_counter/ConcreteF.eca index 8565349..91a57bd 100644 --- a/sha3/proof/smart_counter/ConcreteF.eca +++ b/sha3/proof/smart_counter/ConcreteF.eca @@ -3,7 +3,7 @@ require import List FSet NewFMap Utils Common SLCommon DProd Dexcepted. (*...*) import Capacity IntOrder RealOrder. -require (*..*) Strong_RP_RF_C. +require (*..*) Strong_RP_RF. module PF = { var m, mi: (state,state) fmap @@ -19,10 +19,8 @@ module PF = { if (!mem (dom m) x) { y1 <$ bdistr; y2 <$ cdistr; - if (!(y1,y2) \in dom mi) { - mi.[(y1,y2)] <- x; - } m.[x] <- (y1,y2); + mi.[(y1,y2)] <- x; } return oget m.[x]; } @@ -33,10 +31,8 @@ module PF = { if (!mem (dom mi) x) { y1 <$ bdistr; y2 <$ cdistr; - if (!(y1,y2) \in dom m) { - m.[(y1,y2)] <- x; - } mi.[x] <- (y1,y2); + m.[(y1,y2)] <- x; } return oget mi.[x]; } @@ -46,7 +42,7 @@ module PF = { module CF(D:DISTINGUISHER) = Indif(SqueezelessSponge(PF), PF, D). section. - declare module D : DISTINGUISHER {Perm, C, PF}. + declare module D : DISTINGUISHER {Perm, C, PF, Redo}. axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): islossless P.f => islossless P.fi => islossless F.f => @@ -54,14 +50,14 @@ section. local module GReal' = Indif(FC(SqueezelessSponge(Perm)), PC(Perm), D). - local clone import Strong_RP_RF_C as Switching with + 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 rewrite max_ge0. + proof *. + realize ge0_q by smt w=max_ge0. realize uD_uf_fu. split. case=> [x y]; rewrite supp_dprod /=. @@ -81,283 +77,124 @@ section. lemma size_behead (l : 'a list) : l <> [] => size (behead l) = size l - 1. proof. by case l=> // ?? /=; ring. qed. - local module CP' (P' : PRPt.Oracles) = { - proc f (x : state) = { - var y <- (b0,c0); - if (!x \in dom C.m) { - y <@ P'.f(x); - if (!y \in dom C.mi) { - C.mi.[y] <- x; - } - C.m.[x] <- y; - } else { - y <- oget C.m.[x]; - } - return y; - } - proc fi (x : state) = { - var y <- (b0,c0); - if (!x \in dom C.mi) { - y <@ P'.f(x); - if (!y \in dom C.m) { - C.m.[y] <- x; - } - C.mi.[x] <- y; - } else { - y <- oget C.mi.[x]; - } - return y; - } - }. - local module (D': PRPt.Distinguisher) (P' : PRPt.Oracles) = { - proc distinguish = DRestr(D,SqueezelessSponge(CP'(P')),P').distinguish + proc distinguish () : bool = { + var b : bool; + Redo.init(); + b <@ DRestr(D,SqueezelessSponge(P'),P').distinguish(); + return b; + } }. -print DRestr. - - local lemma DoubleBounding (P <: PRPt.StrongPRP {D, C, DBounder}) &m: + local lemma DoubleBounding (P <: PRPt.StrongPRP {D, C, DBounder, Redo}) &m: Pr[PRPt.IND(P,D').main() @ &m: res] = Pr[PRPt.IND(P,DBounder(D')).main() @ &m: res]. proof. byequiv=> //=; proc; inline *. wp. - call (_: ={glob C, glob P} - /\ prefixe_inv C.queries{1} C.m{1} - /\ ={m,mi}(C,DBounder.FBounder) - /\ DBounder.FBounder.c{2} <= C.c{2}). - + proc; sp; if;auto;if=> //=; inline *. + call (_: ={glob C, glob P, glob Redo} + /\ all_prefixes Redo.prefixes{2} + /\ Redo.prefixes{2}.[[]] = Some (b0,c0) + /\ dom C.queries{2} <= dom Redo.prefixes{2} + /\ prefixe_inv C.queries{2} Redo.prefixes{2} + /\ DBounder.FBounder.c{2} = C.c{2}). + + proc; sp; if=> //=; inline *. rcondt{2} 3; 1: by auto=> /#. - rcondt{2} 4;first by auto;call(:true);auto. - by wp; call (_: true); auto;smt(prefixe_inv_set). - + proc; sp; if; auto; if=> //=; inline *. + by wp; call (_: true); auto. + + proc; sp; if=> //=; inline *. rcondt{2} 3; 1: by auto=> /#. - rcondt{2} 4;first by auto;call(:true);auto. - wp; call (_: true); auto;progress. - + smt(prefixe_inv_set). - + rewrite/#. - + rewrite/#. - + proc; sp; if; auto; if=> //=; inline *. - splitwhile{1} 4 : (sa +^ head witness p, sc) \in dom C.m. - splitwhile{2} 4 : (sa +^ head witness p, sc) \in dom C.m. - wp=>//=;swap 1 4;wp=>//=. - conseq(:_==> ={sa, C.mi, C.m, glob P} /\ C.m{1} = DBounder.FBounder.m{2} - /\ C.mi{1} = DBounder.FBounder.mi{2} - /\ prefixe_inv C.queries{1} C.m{1} - /\ DBounder.FBounder.c{2} <= C.c{2} + size bs{2} - - prefixe bs{2} (get_max_prefixe bs{2} (elems (dom C.queries{2}))) - /\ (forall (i : int), - 0 <= i < size bs{2} => - let bc = (blocksponge (take i bs{2}) C.m{1} s0).`2 in - (bc.`1 +^ nth b0 bs{2} i, bc.`2) \in dom C.m{1})); - 1:smt(dom_set in_fsetU1). - - while(={sa, sc, C.mi, C.m, glob P, p, bs, C.c, C.queries} - /\ C.m{1} = DBounder.FBounder.m{2} - /\ C.mi{1} = DBounder.FBounder.mi{2} - /\ (exists i, p{2} = drop i bs{2} /\ 0 <= i <= size bs{2} - /\ blocksponge (take i bs{2}) C.m{1} s0 = ([], (sa{1},sc{1}))) - /\ prefixe_inv C.queries{1} C.m{1} - /\ C.c{1} + size bs{1} - prefixe bs{1} - (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= max_size - /\ DBounder.FBounder.c{2} <= C.c{2} + size bs{2} - size p{2} - - prefixe bs{2} (get_max_prefixe bs{2} (elems (dom C.queries{2}))) - /\ (forall (i : int), - 0 <= i < size bs{2} - size p{2} => - let bc = (blocksponge (take i bs{2}) C.m{1} s0).`2 in - (bc.`1 +^ nth b0 bs{2} i, bc.`2) \in dom C.m{1}) - /\ (forall (i : int), - 0 <= i < size bs{2} - size p{2} => - (blocksponge (take i bs{2}) C.m{1} s0).`1 = [])). - + sp;if;1,3:auto;last first;progress. - - exists (i+1);rewrite(drop_nth witness)//=;2:split;1,2:smt(drop_oversize). - rewrite (take_nth witness);1:smt(drop_oversize). - move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). - move=>?. - rewrite blocksponge_rcons H1/=H9/=/#. - - rewrite size_behead//=/#. - - move:H11;rewrite size_behead//=. - case(i0 < size bs{2} - size (drop i bs{2}))=>[/#|]h h1. - cut->:i0 = size bs{2} - size (drop i bs{2}) by rewrite/#. - rewrite size_drop//=max_ler 1:/#/=. - cut->:(size bs{2} - (size bs{2} - i)) = i by ring. - rewrite H1/=. - by move:H9;rewrite (drop_nth b0)/=;1:smt(drop_oversize). - - move:H11;rewrite size_behead//=. - case(i0 < size bs{2} - size (drop i bs{2}))=>[/#|]h h1. - cut->:i0 = size bs{2} - size (drop i bs{2}) by rewrite/#. - rewrite size_drop//=max_ler 1:/#/=. - cut->:(size bs{2} - (size bs{2} - i)) = i by ring. - by rewrite H1/=. - - rcondt{2}3;1:(auto;smt(size_ge0 size_eq0)). - rcondt{2}4;1:by auto;call(:true);auto. - wp;call(:true);auto;progress. - - exists (i+1);rewrite(drop_nth witness)//=;2:split;1,2:smt(drop_oversize). - rewrite (take_nth witness);1:smt(drop_oversize). - move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). - move=>h. - rewrite blocksponge_rcons/=. - cut/=:=blocksponge_set_nil (take i bs{2}) DBounder.FBounder.m{2} s0 - (sa{2} +^ nth witness bs{2} i, sc{2}) result_R h. - rewrite H1/=/==>->/=;rewrite dom_set in_fsetU1/=getP/=oget_some/#. - - smt(prefixe_inv_set). - - smt(size_ge0 size_eq0). - - move:H12;rewrite size_behead//==>?. - move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). - move=>h. - case(i0 < size bs{2} - size (drop i bs{2}))=>[|]?. - + cut//=->/=:=blocksponge_set_nil (take i0 bs{2}) DBounder.FBounder.m{2} s0 - (sa{2} +^ nth witness bs{2} i, sc{2}) result_R h (H6 i0 _);1:rewrite/#. - by rewrite dom_set in_fsetU1/#. - cut hii0:i0=i by move:H9 H12;rewrite!size_drop//=max_ler /#. - rewrite hii0. - cut//=:=blocksponge_set_nil (take i bs{2}) DBounder.FBounder.m{2} s0 - (sa{2} +^ nth witness bs{2} i, sc{2}) result_R h. - rewrite H1/==>->/=;rewrite dom_set in_fsetU1//=;right;congr. - by rewrite nth_onth (onth_nth witness)//=;smt(size_ge0 size_eq0). - + move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). - move=>h. - case(i0 < size bs{2} - size (drop i bs{2}))=>[|]?. - + smt(blocksponge_set_nil). - cut hii0:i0=i by move:H12;rewrite size_behead//==>?; - move:H9 H12;rewrite!size_drop//=max_ler /#. - rewrite hii0;smt(blocksponge_set_nil). - + exists (i+1);rewrite(drop_nth witness)//=;2:split;1,2:smt(drop_oversize). - rewrite (take_nth witness);1:smt(drop_oversize). - move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). - move=>h. - rewrite blocksponge_rcons/=. - cut/=:=blocksponge_set_nil (take i bs{2}) DBounder.FBounder.m{2} s0 - (sa{2} +^ nth witness bs{2} i, sc{2}) result_R h. - rewrite H1/=/==>->/=;rewrite dom_set in_fsetU1/=getP/=oget_some/#. - - smt(prefixe_inv_set). - - smt(size_ge0 size_eq0). - - move:H12;rewrite size_behead//==>?. - move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). - move=>h. - case(i0 < size bs{2} - size (drop i bs{2}))=>[|]?. - + cut//=->/=:=blocksponge_set_nil (take i0 bs{2}) DBounder.FBounder.m{2} s0 - (sa{2} +^ nth witness bs{2} i, sc{2}) result_R h (H6 i0 _);1:rewrite/#. - by rewrite dom_set in_fsetU1/#. - cut hii0:i0=i by move:H9 H12;rewrite!size_drop//=max_ler /#. - rewrite hii0. - cut//=:=blocksponge_set_nil (take i bs{2}) DBounder.FBounder.m{2} s0 - (sa{2} +^ nth witness bs{2} i, sc{2}) result_R h. - rewrite H1/==>->/=;rewrite dom_set in_fsetU1//=;right;congr. - by rewrite nth_onth (onth_nth witness)//=;smt(size_ge0 size_eq0). - + move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). - move=>h. - case(i0 < size bs{2} - size (drop i bs{2}))=>[|]?. - + smt(blocksponge_set_nil). - cut hii0:i0=i by move:H12;rewrite size_behead//==>?; - move:H9 H12;rewrite!size_drop//=max_ler /#. - rewrite hii0;smt(blocksponge_set_nil). + by wp; call (_: true); auto. + + proc; sp; if=> //=; inline *;1:if;auto. - conseq(:_==> ={sa, sc, C.mi, C.m, glob P, p, bs, C.c, C.queries} - /\ C.m{1} = DBounder.FBounder.m{2} - /\ C.mi{1} = DBounder.FBounder.mi{2} - /\ (exists i, p{2} = drop i bs{2} /\ 0 <= i <= size bs{2} - /\ blocksponge (take i bs{2}) C.m{1} s0 = ([], (sa{1},sc{1}))) - /\ prefixe_inv C.queries{1} C.m{1} - /\ C.c{1} + size bs{1} - prefixe bs{1} - (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= max_size - /\ DBounder.FBounder.c{2} <= C.c{2} + size bs{2} - size p{2} - - prefixe bs{2} (get_max_prefixe bs{2} (elems (dom C.queries{2}))) - /\ (forall (i : int), - 0 <= i < size bs{2} - size p{2} => - let bc = (blocksponge (take i bs{2}) C.m{1} s0).`2 in - (bc.`1 +^ nth b0 bs{2} i, bc.`2) \in dom C.m{1}) - /\ (forall (i : int), - 0 <= i < size bs{2} - size p{2} => - (blocksponge (take i bs{2}) C.m{1} s0).`1 = []));1:rewrite/#. + splitwhile{1}5:take (i+1) p \in dom Redo.prefixes. + splitwhile{2}5:take (i+1) p \in dom Redo.prefixes. - alias{2} 1 k = DBounder.FBounder.c;sp 0 1. - alias{2} 1 dm = DBounder.FBounder.m;sp 0 1. - alias{2} 1 dmi = DBounder.FBounder.mi;sp 0 1. - alias{2} 1 cm = C.m;sp 0 1. - alias{2} 1 cmi = C.mi;sp 0 1. - conseq(:_==> ={sa, sc, C.mi, C.m, glob P, p, bs, C.c} - /\ C.m{1} = cm{2} - /\ DBounder.FBounder.m{2} = dm{2} - /\ C.mi{1} = cmi{2} - /\ DBounder.FBounder.mi{2} = dmi{2} - /\ (exists i, p{2} = drop i bs{2} /\ 0 <= i <= size bs{2} - /\ blocksponge (take i bs{2}) C.m{1} s0 = ([], (sa{1},sc{1}))) - /\ prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= size bs{1} - size p{1} - /\ DBounder.FBounder.c{2} = k{2} - /\ (forall (i : int), - 0 <= i < size bs{2} - size p{2} => - let bc = (blocksponge (take i bs{2}) C.m{1} s0).`2 in - (bc.`1 +^ nth b0 bs{2} i, bc.`2) \in dom C.m{1}) - /\ (forall (i : int), - 0 <= i < size bs{2} - size p{2} => - (blocksponge (take i bs{2}) C.m{1} s0).`1 = []));progress. - + rewrite/#. - + smt(size_ge0 size_drop). - - while(={sa, sc, C.mi, C.m, glob P, p, bs, C.c} - /\ prefixe_inv C.queries{1} C.m{1} - /\ C.m{1} = cm{2} - /\ DBounder.FBounder.m{2} = dm{2} - /\ C.mi{1} = cmi{2} - /\ DBounder.FBounder.mi{2} = dmi{2} - /\ (exists i, p{2} = drop i bs{2} /\ 0 <= i <= size bs{2} - /\ blocksponge (take i bs{2}) C.m{1} s0 = ([], (sa{1},sc{1}))) - /\ DBounder.FBounder.c{2} = k{2} - /\ (forall (i : int), - 0 <= i < size bs{2} - size p{2} => - let bc = (blocksponge (take i bs{2}) C.m{1} s0).`2 in - (bc.`1 +^ nth b0 bs{2} i, bc.`2) \in dom C.m{1}) - /\ (forall (i : int), - 0 <= i < size bs{2} - size p{2} => - (blocksponge (take i bs{2}) C.m{1} s0).`1 = []));last first. - + auto;progress. - smt(drop0 size_ge0). - smt(drop0 size_ge0). - smt(drop0 size_ge0). - smt(drop0 size_ge0). - move:H4;rewrite negb_and/==>[]. - case(drop i bs{2} = [])=>[hdropi|hdropi]//=. - + rewrite hdropi/=;smt(prefixe_sizel). - rewrite size_drop//=max_ler 1:/#. - cut->:size bs{2} - (size bs{2} - i) = i by rewrite/#. - rewrite(drop_nth b0)//=;1:smt(size_ge0 size_eq0 size_drop). print prefixe_inv. - apply absurd=>//=hi. - cut->:nth b0 bs{2} i = nth b0 (get_max_prefixe bs{2} (elems (dom C.queries{2}))) i. - + rewrite 2!nth_onth (onth_nth witness);1:smt(size_drop size_eq0). - cut/=h:=prefixe_nth bs{2} (get_max_prefixe bs{2} (elems (dom C.queries{2}))). - cut->:=h i _;1:smt(size_drop size_eq0). - by rewrite (onth_nth witness)/=;1:smt(size_drop size_eq0 prefixe_sizer). - cut:=H (get_max_prefixe bs{2} (elems (dom C.queries{2}))) _;last first. - + move=>h;cut:=h i _;1:smt(prefixe_sizer). - cut:=H8;cut->/#:(take i bs{2}) = (take i (get_max_prefixe bs{2} (elems (dom C.queries{2})))). - by apply (eq_from_nth b0 _ _ _ _); - smt(size_take prefixe_sizer prefixe_sizel nth_take prefixe_nth nth_onth onth_nth). - cut h:forall (l1 l2:block list) ll, max_prefixe l1 l2 ll = l2 \/ max_prefixe l1 l2 ll \in ll. - + clear P &m &1 &2 H H0 H H1 H2 P_R sa_R sc_R H5 i H3 H6 H7 H8 H9 H10 hdropi hi. - by move=>l1 l2 ll;move:ll l1 l2;move=>ll;elim:ll=>//=/#. - cut h1:forall (l : block list) ll, get_max_prefixe l ll <> [] => ll <> []. - + clear P &m &1 &2 H H0 H H1 H2 P_R sa_R sc_R H5 i H3 H6 H7 H8 H9 H10 hdropi hi. - by move=>l ll;move:ll l=>ll;elim:ll=>//=. - rewrite memE;smt(prefixe_sizer). - sp;rcondf{1}1;2:rcondf{2}1;auto;progress. - - exists (i+1);rewrite(drop_nth witness)//=;2:split;1,2:smt(drop_oversize). - rewrite (take_nth witness);1:smt(drop_oversize). - move:H8;rewrite (drop_nth witness)/=;1:smt(drop_oversize). - move=>h. - rewrite blocksponge_rcons/=H2/=h/=/#. - - move:H10;rewrite size_behead//=. - case(i0 < size bs{2} - size (drop i bs{2}))=>??;1:rewrite/#. - cut hii0:i0=i by smt(size_drop). - rewrite hii0 H2/=. - move:H8;rewrite (drop_nth witness)/=;1:smt(drop_oversize). - by rewrite nth_onth (onth_nth b0)/=;1:smt(size_eq0). - - move:H10;rewrite size_behead//=. - case(i0 < size bs{2} - size (drop i bs{2}))=>??;1:rewrite/#. - cut hii0:i0=i by smt(size_drop). - by rewrite hii0 H2/=. - auto;progress;call(:true);auto;smt(dom0 in_fset0). + 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} + /\ dom query{2} <= dom 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 dom pref{1} => pref{1}.[y] = Redo.prefixes{1}.[y]) + /\ (forall y, y \in dom Redo.prefixes{1} <=> (y \in dom 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}); + progress;..-2:smt(in_dom dom_set in_fsetU1 getP oget_some 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) + /\ dom query{2} <= dom Redo.prefixes{2} + /\ (i{1} < size p{1} => ! take (i{1} + 1) p{1} \in dom Redo.prefixes{1}) + /\ 0 <= prefixe bs{1} (get_max_prefixe bs{1} (elems (dom 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 dom pref{1} => pref{1}.[y] = Redo.prefixes{1}.[y]) + /\ (forall y, y \in dom Redo.prefixes{1} <=> (y \in dom 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(get_oget in_dom). + sp;rcondt{2}1;1:auto=>/#;auto;1:call(:true);auto;progress. + * move=>x;rewrite dom_set in_fsetU1=>[][|-> j];1:smt(in_fsetU1). + case(0 <= j)=>hj0;last first. + + by rewrite (take_le0 j)1:/# in_fsetU1 in_dom H0//=. + rewrite take_take in_fsetU1/min/#. + * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). + * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). + * rewrite dom_set in_fsetU1 negb_or H9 negb_or/=negb_exists/=. + cut 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(dom_set in_fsetU1 take_take in_dom getP oget_some). + * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). + * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). + * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). + * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). + sp; + conseq(:_==> ={sa, Redo.prefixes, glob P, i, C.c, p, sc, bs} /\ p{1} = bs{1} + /\ Redo.prefixes{2} = pref{2} + /\ dom query{2} <= dom Redo.prefixes{2} + /\ C.c{1} <= max_size + /\ i{1} = prefixe bs{1} (get_max_prefixe bs{1} (elems (dom 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} + + prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1})))); + progress;..4,6..-2: + smt(prefixe_ge0 prefixe_lt_size prefixe_sizel prefixe_exchange prefixe_lt_size memE). + + move:H8=>[]//=[]j [[hj0 hjsize] htake]. + rewrite htake. + apply take_get_max_prefixe2=>//=;1:smt(in_dom memE). + by rewrite-(prefixe_exchange _ _ _ H2 H). + 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} + /\ dom query{2} <= dom Redo.prefixes{2} + /\ C.c{2} <= max_size + /\ i{1} = prefixe bs{1} (get_max_prefixe bs{1} (elems (dom 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} + /\ dom query{2} <= dom Redo.prefixes{2} + /\ prefixe_inv C.queries{2} Redo.prefixes{2} + /\ all_prefixes Redo.prefixes{2} + /\ C.c{2} <= max_size + /\ 0 <= i{1} <= prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) + /\ (forall j, 0 <= j <= prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) + => take j bs{2} \in dom 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 rewrite/#. + * by rewrite(prefixe_exchange _ _ bs{2} H0 H1)all_take_in//=/#. + * smt(get_oget in_dom). + auto;progress. smt(prefixe_ge0). + * apply take_get_max_prefixe2=>//=;1:smt(in_dom memE). + by rewrite-(prefixe_exchange _ _ _ H2 H). + * smt(get_oget in_dom). + * smt(@Prefixe). + auto;call(:true);auto;smt(dom0 in_fset0 dom_set in_fsetU1 getP oget_some). qed. local clone import ProdSampling with @@ -368,30 +205,142 @@ print DRestr. lemma Real_Concrete &m : Pr[GReal(D).main()@ &m: res /\ C.c <= max_size] <= - Pr[CF(DRestr(D)).main()@ &m: res] + (max_size ^ 2)%r * inv 2%r * mu dstate (pred1 witness). + Pr[CF(DRestr(D)).main()@ &m: res] + (max_size ^ 2)%r * mu dstate (pred1 witness). proof. cut->: 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 (_: ={glob C,glob Perm} - /\ prefixe_inv C.queries{1} Perm.m{1} /\ inv Perm.m{1} Perm.mi{1}); - last by auto;smt(dom0 in_fset0 map0P). - + proc;inline*;sp;if;auto;sp;if;auto;progress. - - smt(getP oget_some prefixe_inv_set). - - smt(in_dom inv_dom_rng invC getP oget_some supp_dexcepted). - - smt(getP oget_some prefixe_inv_set). - - smt(in_dom inv_dom_rng invC getP oget_some supp_dexcepted). - + proc;inline*;sp;if;auto;sp;if;auto;progress. - - smt(getP oget_some prefixe_inv_set invC inv_dom_rng supp_dexcepted). - - smt(in_dom inv_dom_rng invC getP oget_some supp_dexcepted). - - smt(getP oget_some prefixe_inv_set invC inv_dom_rng supp_dexcepted). - - smt(in_dom inv_dom_rng invC getP oget_some supp_dexcepted). - proc; inline *; wp. - sp;if{2}. - (* TODO : reprendre ici *) - + - while (={glob Perm,sc,sa,p} /\ (C.c + size p){1} = C.c{2});2:by auto. - by sp; if=> //=; auto=> /> &2 cL /size_behead=> ->; progress; ring. + + byequiv=>//;proc;inline *; + call (_: ={C.c, glob Perm, Redo.prefixes} + /\ prefixe_inv C.queries{2} Redo.prefixes{1} + /\ Redo.prefixes{1}.[[]] = Some (b0, c0) + /\ all_prefixes Redo.prefixes{1}); + last first. + + auto;smt(dom0 in_fset0 dom_set in_fsetU1 getP 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 dom C.queries{2} + /\ prefixe_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 dom Redo.prefixes; + splitwhile{2} 1 : take (i+1) p \in dom 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 dom pref{2} => pref{2}.[l] = Redo.prefixes{2}.[l]) + /\ (forall j, 0 <= j <= i{2} => take j p{2} \in dom Redo.prefixes{2}) + /\ (forall l, l \in dom Redo.prefixes{2} => + l \in dom pref{2} \/ (exists j, 0 <= j <= i{2} /\ l = take j p{2}))); + progress. + * by rewrite/#. + * move:H3 H7;rewrite take_size dom_set in_fsetU1 getP;case(bs0 = bs{2})=>//=[->|]h. + * by rewrite h oget_some/=. + * move:H=>[?[??]];move=>? ?. + by rewrite -H4;1:smt(take_size);rewrite H//=. + * smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0). + * smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop). + * smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop). + * smt(dom_set in_fsetU1 take_size oget_some getP in_dom 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} + /\ prefixe_inv C.queries{2} pref{2} + /\ prefixe p{2} (get_max_prefixe p{2} (elems (dom 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 dom pref{2} => pref{2}.[l] = Redo.prefixes{2}.[l]) + /\ (forall j, 0 <= j <= i{2} => take j p{2} \in dom Redo.prefixes{2}) + /\ (forall l, l \in dom Redo.prefixes{2} => + l \in dom pref{2} \/ (exists j, 0 <= j <= i{2} /\ l = take j p{2}))). + + rcondf{1}1;2:rcondf{2}1;..2:auto;progress. + * cut:=H7 (take (i{m0}+1) p{m0}). + case((take (i{m0} + 1) p{m0} \in dom Redo.prefixes{m0}))=>//=_. + rewrite negb_or negb_exists/=;progress. + + by rewrite memE prefixe_lt_size//=-(prefixe_exchange _ _ p{m0} H1 H0)//=/#. + case(0<=a<=i{m0})=>//=ha;smt(size_take). + * cut:=H7 (take (i{hr}+1) p{hr}). + case((take (i{hr} + 1) p{hr} \in dom Redo.prefixes{hr}))=>//=_. + rewrite negb_or negb_exists/=;progress. + + by rewrite memE prefixe_lt_size//=-(prefixe_exchange _ _ p{hr} H1 H0)//=/#. + case(0<=a<=i{hr})=>//=ha;smt(size_take). + + sp;auto;if;auto;progress. + * rewrite/#. + * move=>x;rewrite dom_set in_fsetU1=>[][|h];1: + smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop). + rewrite h=>j;rewrite take_take in_fsetU1/min. + case(j//=hij. + cut->:take j p{2} = take j (take i{2} p{2});smt(take_take take_le0). + * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * rewrite!getP/=. + cut/#: !take (i{2} + 1) p{2} \in dom pref{2}. + by rewrite memE prefixe_lt_size//=-(prefixe_exchange _ _ _ H1 H0)//=/#. + * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * move=>x;rewrite dom_set in_fsetU1=>[][|h];1: + smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop). + rewrite h=>j;rewrite take_take in_fsetU1/min. + case(j//=hij. + cut->:take j p{2} = take j (take i{2} p{2});smt(take_take take_le0). + * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * rewrite!getP/=. + cut/#: !take (i{2} + 1) p{2} \in dom pref{2}. + by rewrite memE prefixe_lt_size//=-(prefixe_exchange _ _ _ H1 H0)//=/#. + * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + 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} + /\ prefixe_inv C.queries{2} pref{2} + /\ prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) = i{2} + /\ Redo.prefixes{2}.[take i{2} p{2}] = Some (sa{2}, sc{2}));1: + smt(prefixe_sizel take_get_max_prefixe2 in_dom prefixe_exchange). + + while( ={sa,sc,Perm.m,Perm.mi,Redo.prefixes,i,p} + /\ C.c{1} = C.c{2} - size p{2} + prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) + /\ pref{2} = Redo.prefixes{2} + /\ all_prefixes pref{2} + /\ prefixe_inv C.queries{2} pref{2} + /\ 0 <= i{2} <= prefixe p{2} (get_max_prefixe p{2} (elems (dom 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_prefixe (<=) take mem. + * rewrite(prefixe_inv_leq _ _ _ _ _ _ H H7 H0)//= 1:/#. + cut:=H0=>[][h1 [h2 h3]]. + cut:=h3 _ _ _ H7;last smt(memE). + smt(size_eq0 size_take). + * smt(get_oget in_dom). + auto;progress. + * rewrite/#. + * smt(prefixe_ge0). + * smt(take0). + * smt(prefixe_sizel @Prefixe memE). + * smt(prefixe_sizel @Prefixe memE). + have p_ll := P_f_ll _ _. + apply/dprod_ll; split. + exact/Block.DBlock.dunifin_ll. @@ -405,8 +354,8 @@ print DRestr. + apply/fun_ext=>- [] a b; rewrite supp_dprod. by rewrite/=/predT/=Block.DBlock.dunifin_fu Capacity.DCapacity.dunifin_fu. have f_ll : islossless SqueezelessSponge(Perm).f. - + proc; while true (size p)=> //=. - * by move=> z; wp; call p_ll; skip=> /> &hr /size_behead /#. + + proc; while true (size p - i)=> //=. + * 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)). @@ -442,15 +391,14 @@ print DRestr. by inline *; auto. have /#:= Conclusion D' &m _. move=> O O_f_ll O_fi_ll. - proc; call (_: true)=> //=. + proc;inline*;sp;wp; call (_: true)=> //=. + apply D_ll. - + by proc; sp; if=> //=; call O_f_ll; auto. - + by proc; sp; if=> //=; call O_fi_ll; auto. - + proc; inline *; sp; if=> //=; auto. - while true (size p). - * by auto; call O_f_ll; auto=> /#. + + 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. - by inline *; auto. qed. end section. diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index 01ff87e..8b52526 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -1327,7 +1327,7 @@ equiv PFf_Cf (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1(D).C.f : ! (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}. proof. - proc; seq 2 4: + proc. ; seq 2 4: ((!(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} /\ F.RO.m.[p]{2} = Some sa{1})));last first. diff --git a/sha3/proof/smart_counter/SLCommon.ec b/sha3/proof/smart_counter/SLCommon.ec index 239f700..d0629e5 100644 --- a/sha3/proof/smart_counter/SLCommon.ec +++ b/sha3/proof/smart_counter/SLCommon.ec @@ -39,16 +39,34 @@ clone import RndO.GenEager as F with op sampleto <- fun (_:block list)=> bdistr proof * by exact Block.DBlock.dunifin_ll. + +module Redo = { + var prefixes : (block list, state) fmap + + proc init() : unit = { + prefixes <- map0.[[] <- (b0,c0)]; + } +}. + (** We can now define the squeezeless sponge construction **) module SqueezelessSponge (P:DPRIMITIVE): FUNCTIONALITY = { - proc init () = {} + proc init () = { + Redo.init(); + } proc f(p : block list): block = { var (sa,sc) <- (b0,c0); - - while (p <> []) { (* Absorption *) - (sa,sc) <@ P.f((sa +^ head witness p,sc)); - p <- behead p; + var i : int <- 0; + + while (i < size p) { (* Absorption *) + if (take (i+1) p \in dom 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) *) @@ -199,6 +217,32 @@ 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/=. + cut->: (if i < j then i else j) = i by rewrite/#. + move=>[Hk0 Hki]. + by rewrite !nth_take//=/#. +case(0//=Hj0;last smt(take_le0). +rewrite min_ler 1:/#. +pose l':=take j l. +rewrite take_oversize//=. +rewrite/l' size_take /#. +qed. + +lemma prefixe_take_leq (l1 l2 : 'a list) (i : int) : + i <= prefixe l1 l2 => take i l1 = take i l2. +proof. +move=>Hi. +cut->:i = min i (prefixe l1 l2) by smt(min_lel). +by rewrite-(take_take l1 i _)-(take_take l2 i _) prefixe_take. +qed. + lemma prefixe_nth (l1 l2 : 'a list) : let i = prefixe l1 l2 in forall j, 0 <= j < i => @@ -223,6 +267,414 @@ op get_max_prefixe (l : 'a list) (ll : 'a list list) = with ll = (::) l' ll' => max_prefixe l l' ll'. +pred prefixe_inv (queries : (block list, block) fmap) + (prefixes : (block list, state) fmap) = + (forall (bs : block list), + bs \in dom queries => oget queries.[bs] = (oget prefixes.[bs]).`1) && + (forall (bs : block list), + bs \in dom queries => forall i, take i bs \in dom prefixes) && + (forall (bs : block list), + forall i, take i bs <> [] => + take i bs \in dom prefixes => + exists l2, (take i bs) ++ l2 \in dom queries). + +pred all_prefixes (prefixes : (block list, state) fmap) = + forall (bs : block list), bs \in dom prefixes => forall i, take i bs \in dom prefixes. + +lemma aux_mem_get_max_prefixe (l1 l2 : 'a list) ll : + max_prefixe l1 l2 ll = l2 \/ max_prefixe l1 l2 ll \in ll. +proof. +move:l1 l2;elim:ll=>//=l3 ll Hind l1 l2. +case(prefixe l1 l2 < prefixe l1 l3)=>//=hmax. ++ cut/#:=Hind l1 l3. +cut/#:=Hind l1 l2. +qed. + + +lemma mem_get_max_prefixe (l : 'a list) ll : + ll <> [] => get_max_prefixe l ll \in ll. +proof. +move:l;elim:ll=>//=l2 ll Hind l1. +exact aux_mem_get_max_prefixe. +qed. + + +lemma take_get_max_prefixe l prefixes : + (exists b, b \in dom prefixes) => + all_prefixes prefixes => + take (prefixe l (get_max_prefixe l (elems (dom prefixes)))) l \in dom prefixes. +proof. +move=>nil_in_dom all_pref. +rewrite prefixe_take all_pref memE mem_get_max_prefixe;smt(memE). +qed. + +lemma take_get_max_prefixe2 l prefixes i : + (exists b, b \in dom prefixes) => + all_prefixes prefixes => + i <= prefixe l (get_max_prefixe l (elems (dom prefixes))) => + take i l \in dom prefixes. +proof. +move=>nil_in_dom all_pref hi. +rewrite (prefixe_take_leq _ _ i hi) all_pref memE mem_get_max_prefixe;smt(memE). +qed. + + +lemma prefixe_cat (l l1 l2 : 'a list) : + prefixe (l ++ l1) (l ++ l2) = size l + prefixe l1 l2. +proof. +move:l1 l2;elim l=>//=/#. +qed. + + +lemma prefixe_leq_take (l1 l2 : 'a list) i : + 0 <= i <= min (size l1) (size l2) => + take i l1 = take i l2 => + i <= prefixe l1 l2. +proof. +move=> [hi0 himax] htake. +rewrite-(cat_take_drop i l1)-(cat_take_drop i l2)htake. +rewrite prefixe_cat size_take//=;smt(prefixe_ge0). +qed. + +lemma prefixe0 (l1 l2 : 'a list) : + prefixe l1 l2 = 0 <=> l1 = [] \/ l2 = [] \/ head witness l1 <> head witness l2 . +proof. +move:l2;elim:l1=>//=;1:rewrite/#;move=>e1 l1 Hind l2;move:e1 l1 Hind;elim:l2=>//=e2 l2 Hind2 e1 l1 Hind1. +smt(prefixe_ge0). +qed. + +lemma head_nth0 (l : 'a list) : head witness l = nth witness l 0. +proof. by elim:l. qed. + + +lemma get_prefixe (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 = prefixe l1 l2. +proof. +move=>[hi0 hisize] [|[]]. ++ move=>hi. + cut:=size_eq0 (drop i l1);rewrite {2}hi/=size_drop// =>h. + cut hsize: size l1 = i by rewrite/#. + rewrite -hsize take_size. + rewrite-{2}(cat_take_drop (size l1) l2)=><-. + by rewrite-{2}(cats0 l1)prefixe_cat/#. ++ move=>hi. + cut:=size_eq0 (drop i l2);rewrite {2}hi/=size_drop// =>h. + cut hsize: size l2 = i by rewrite/#. + rewrite -hsize take_size. + rewrite-{2}(cat_take_drop (size l2) l1)=>->. + by rewrite-{4}(cats0 l2)prefixe_cat/#. +move=>[himax hnth] htake. +rewrite-(cat_take_drop i l1)-(cat_take_drop i l2)htake. +rewrite prefixe_cat size_take//=. ++ cut[_ ->]:=prefixe0 (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. +rewrite/#. +qed. + +lemma get_max_prefixe_leq (l1 l2 : 'a list) (ll : 'a list list) : + prefixe l1 l2 <= prefixe l1 (max_prefixe l1 l2 ll). +proof. +move:l1 l2;elim:ll=>//=/#. +qed. + +lemma get_max_prefixe_is_max (l1 l2 : 'a list) (ll : 'a list list) : + forall l3, l3 \in ll => prefixe l1 l3 <= prefixe l1 (max_prefixe l1 l2 ll). +proof. +move:l1 l2;elim:ll=>//=. +move=>l4 ll Hind l1 l2 l3. +case(prefixe l1 l2 < prefixe l1 l4)=>//=h [];smt( get_max_prefixe_leq ). +qed. + +lemma get_max_prefixe_max (l : 'a list) (ll : 'a list list) : + forall l2, l2 \in ll => prefixe l l2 <= prefixe l (get_max_prefixe l ll). +proof. smt(get_max_prefixe_is_max get_max_prefixe_leq). qed. + +lemma all_take_in (l : block list) i prefixes : + 0 <= i <= size l => + all_prefixes prefixes => + take i l \in dom prefixes => + i <= prefixe l (get_max_prefixe l (elems (dom prefixes))). +proof. +move=>[hi0 hisize] all_prefixe take_in_dom. +cut->:i = prefixe l (take i l);2:smt(get_max_prefixe_max memE). +apply get_prefixe. ++ smt(size_take). ++ by right;left;apply size_eq0;rewrite size_drop//size_take//=/#. +smt(take_take). +qed. + +lemma prefixe_inv_leq (l : block list) i prefixes queries : + 0 <= i <= size l => + elems (dom queries) <> [] => + all_prefixes prefixes => + take i l \in dom prefixes => + prefixe_inv queries prefixes => + i <= prefixe l (get_max_prefixe l (elems (dom queries))). +proof. +move=>h_i h_nil h_all_prefixes take_in_dom [?[h_prefixe_inv h_exist]]. +case(take i l = [])=>//=h_take_neq_nil. ++ smt(prefixe_ge0 size_eq0). +cut[l2 h_l2_mem]:=h_exist l i h_take_neq_nil take_in_dom. +rewrite memE in h_l2_mem. +rewrite(StdOrder.IntOrder.ler_trans _ _ _ _ (get_max_prefixe_max _ _ _ h_l2_mem)). +rewrite-{1}(cat_take_drop i l)prefixe_cat size_take 1:/#;smt(prefixe_ge0). +qed. + + +lemma max_prefixe_eq (l : 'a list) (ll : 'a list list) : + max_prefixe l l ll = l. +proof. +move:l;elim:ll=>//=l2 ll Hind l1;smt( prefixe_eq prefixe_sizel). +qed. + +lemma prefixe_max_prefixe_eq_size (l1 l2 : 'a list) (ll : 'a list list) : + l1 = l2 \/ l1 \in ll => + prefixe l1 (max_prefixe l1 l2 ll) = size l1. +proof. +move:l1 l2;elim:ll=>//=;1:smt(prefixe_eq). +move=>l3 ll Hind l1 l2[->|[->|h1]]. ++ rewrite prefixe_eq max_prefixe_eq;smt(max_prefixe_eq prefixe_eq prefixe_sizer). ++ rewrite prefixe_eq max_prefixe_eq. + case(prefixe l3 l2 < size l3)=>//=h;1:by rewrite prefixe_eq. + cut h1:prefixe l3 l2 = size l3 by smt(prefixe_sizel). + cut: size l3 <= prefixe l3 (max_prefixe l3 l2 ll);2:smt(prefixe_sizel). + rewrite-h1. + by clear Hind l1 h h1;move:l2 l3;elim:ll=>//=l3 ll Hind l1 l2/#. +by case(prefixe l1 l2 < prefixe l1 l3)=>//=/#. +qed. + +lemma prefixe_get_max_prefixe_eq_size (l : 'a list) (ll : 'a list list) : + l \in ll => + prefixe l (get_max_prefixe l ll) = size l. +proof. +move:l;elim:ll=>//;smt(prefixe_max_prefixe_eq_size). +qed. + +lemma get_max_prefixe_exists (l : 'a list) (ll : 'a list list) : + ll <> [] => + exists l2, take (prefixe l (get_max_prefixe 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 prefixe_take). +move=>l3 ll Hind l1 l2. +case( prefixe l1 l2 < prefixe l1 l3 )=>//=h/#. +qed. + +lemma prefixe_geq (l1 l2 : 'a list) : + prefixe l1 l2 = prefixe (take (prefixe l1 l2) l1) (take (prefixe l1 l2) l2). +proof. +move:l2;elim:l1=>//=[/#|]e1 l1 Hind l2;elim:l2=>//=e2 l2 Hind2. +case(e1=e2)=>//=h12. +cut->/=:! 1 + prefixe l1 l2 <= 0 by smt(prefixe_ge0). +rewrite h12/=/#. +qed. + +lemma prefixe_take_prefixe (l1 l2 : 'a list) : + prefixe (take (prefixe l1 l2) l1) l2 = prefixe l1 l2. +proof. +move:l2;elim:l1=>//=e1 l1 Hind l2;elim:l2=>//=e2 l2 Hind2. +case(e1=e2)=>//=h12. +cut->/=:! 1 + prefixe l1 l2 <= 0 by smt(prefixe_ge0). +rewrite h12/=/#. +qed. + +lemma prefixe_leq_prefixe_cat (l1 l2 l3 : 'a list) : + prefixe l1 l2 <= prefixe (l1 ++ l3) l2. +proof. +move:l2 l3;elim l1=>//=;1:smt(take_le0 prefixe_ge0). +move=>e1 l1 hind1 l2;elim:l2=>//=e2 l2 hind2 l3/#. +qed. + +lemma prefixe_take_leq_prefixe (l1 l2 : 'a list) i : + prefixe (take i l1) l2 <= prefixe l1 l2. +proof. +rewrite-{2}(cat_take_drop i l1). +move:(take i l1)(drop i l1);clear i l1=>l1 l3. +exact prefixe_leq_prefixe_cat. +qed. + +lemma prefixe_take_geq_prefixe (l1 l2 : 'a list) i : + prefixe l1 l2 <= i => + prefixe l1 l2 = prefixe (take i l1) l2. +proof. +move=>hi. +cut:prefixe (take i l1) l2 <= prefixe l1 l2. ++ rewrite-{2}(cat_take_drop i l1) prefixe_leq_prefixe_cat. +cut/#:prefixe l1 l2 <= prefixe (take i l1) l2. +rewrite -prefixe_take_prefixe. +rewrite-(cat_take_drop (prefixe l1 l2) (take i l1))take_take min_lel// prefixe_leq_prefixe_cat. +qed. + +lemma get_max_prefixe_take (l : 'a list) (ll : 'a list list) i : + prefixe l (get_max_prefixe l ll) <= i => + get_max_prefixe l ll = get_max_prefixe (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( prefixe l1 l2 < prefixe l1 l3 )=>//=h hi. ++ rewrite -prefixe_take_geq_prefixe//=;1:smt(get_max_prefixe_leq). + rewrite -prefixe_take_geq_prefixe//=;1:smt(get_max_prefixe_leq). + rewrite h/=/#. +rewrite -prefixe_take_geq_prefixe//=;1:smt(get_max_prefixe_leq). +rewrite -prefixe_take_geq_prefixe//=;1:smt(get_max_prefixe_leq). +rewrite h/=/#. +qed. + + +lemma drop_prefixe_neq (l1 l2 : 'a list) : + drop (prefixe l1 l2) l1 = [] \/ drop (prefixe l1 l2) l1 <> drop (prefixe l1 l2) l2. +proof. +move:l2;elim:l1=>//=e1 l1 hind1 l2;elim:l2=>//=e2 l2 hind2/#. +qed. + + +lemma prefixe_prefixe_prefixe (l1 l2 l3 : 'a list) (ll : 'a list list) : + prefixe l1 l2 <= prefixe l1 l3 => + prefixe l1 (max_prefixe l1 l2 ll) <= prefixe l1 (max_prefixe l1 l3 ll). +proof. +move:l1 l2 l3;elim:ll=>//=l4 ll hind l1 l2 l3 h123/#. +qed. + +lemma prefixe_lt_size (l : 'a list) (ll : 'a list list) : + prefixe l (get_max_prefixe l ll) < size l => + forall i, prefixe l (get_max_prefixe 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 (prefixe l1 l2) (take i l1)) + -{3}(cat_take_drop (prefixe l1 l2) l2)take_take/min H0/=. + rewrite prefixe_take. + cut:drop (prefixe l1 l2) (take i l1) <> drop (prefixe l1 l2) l2;2:smt(catsI). + rewrite (prefixe_take_geq_prefixe l1 l2 i) 1:/#. + cut:=drop_prefixe_neq (take i l1) l2. + cut/#:drop (prefixe (take i l1) l2) (take i l1) <> []. + cut:0 < size (drop (prefixe (take i l1) l2) (take i l1));2:smt(size_eq0). + rewrite size_drop 1:prefixe_ge0 size_take;1:smt(prefixe_ge0). + by rewrite-prefixe_take_geq_prefixe /#. + +move=>l3 ll hind l1 l2. +case(prefixe l1 l2 < prefixe l1 l3)=>//=h;progress. ++ rewrite!negb_or/=. + cut:=hind l1 l3 H i H0;rewrite negb_or=>[][->->]/=. + cut:=hind l1 l2 _ i _;smt(prefixe_prefixe_prefixe). +smt(prefixe_prefixe_prefixe). +qed. + +lemma asfadst queries prefixes (bs : block list) : + prefixe_inv queries prefixes => + elems (dom queries ) <> [] => + all_prefixes prefixes => + (forall j, 0 <= j <= size bs => take j bs \in dom prefixes) => + take (prefixe bs (get_max_prefixe bs (elems (dom queries))) + 1) bs = bs. +proof. +progress. +cut h:=prefixe_inv_leq bs (size bs) prefixes queries _ _ _ _ _;rewrite//=. ++ exact size_ge0. ++ rewrite H2//=;exact size_ge0. +cut->/=:prefixe bs (get_max_prefixe bs (elems (dom queries))) = size bs by smt(prefixe_sizel). +rewrite take_oversize/#. +qed. + + +lemma prefixe_exchange_prefixe_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) => + prefixe l (get_max_prefixe l ll1) = prefixe l (get_max_prefixe l ll2). +proof. +case(ll1 = [])=>//=[->/#|]//=ll1_nil. +move=>incl all_prefix incl2 ;cut ll2_nil:ll2 <> [] by rewrite/#. +cut:=get_max_prefixe_max l ll2 (get_max_prefixe l ll1) _. ++ by rewrite incl mem_get_max_prefixe ll1_nil. +cut mem_ll2:=mem_get_max_prefixe l ll2 ll2_nil. +cut[]l3 mem_ll1:=incl2 _ mem_ll2. +cut:=get_max_prefixe_max l ll1 _ mem_ll1. +smt(prefixeC prefixe_leq_prefixe_cat). +qed. + +lemma prefixe_inv_nil queries prefixes : + prefixe_inv queries prefixes => + elems (dom queries) = [] => dom prefixes <= fset1 []. +proof. +move=>[h1 [h2 h3]] h4 x h5;rewrite in_fset1. +cut:=h3 x (size x). +rewrite take_size h5/=;apply absurd=>//=h6. +rewrite h6/=negb_exists/=;smt(memE). +qed. + + +lemma aux_prefixe_exchange queries prefixes (l : block list) : + prefixe_inv queries prefixes => all_prefixes prefixes => + elems (dom queries) <> [] => + prefixe l (get_max_prefixe l (elems (dom queries))) = + prefixe l (get_max_prefixe l (elems (dom prefixes))). +proof. +move=>[h1[h2 h3]] h5 h4;apply prefixe_exchange_prefixe_inv. ++ smt(memE take_size). ++ smt(memE). +move=>l2;rewrite-memE=> mem_l2. +case(l2=[])=>//=hl2;1:rewrite hl2/=. ++ move:h4;apply absurd=>//=;rewrite negb_exists/=/#. +smt(memE take_size). +qed. + +lemma prefixe_exchange queries prefixes (l : block list) : + prefixe_inv queries prefixes => all_prefixes prefixes => + prefixe l (get_max_prefixe l (elems (dom queries))) = + prefixe l (get_max_prefixe l (elems (dom prefixes))). +proof. +move=>[h1[h2 h3]] h5. +case(elems (dom queries) = [])=>//=h4;2:smt(aux_prefixe_exchange). +cut h6:=prefixe_inv_nil queries prefixes _ h4;1:rewrite/#. +rewrite h4/=. search FSet.(<=). +case(elems (dom prefixes) = [])=>//=[->//=|]h7. +cut h8:elems (dom prefixes) = [[]]. ++ cut [hh1 hh2]:[] \in dom prefixes /\ forall x, x \in elems (dom prefixes) => x = [] by smt(memE). + cut h9:=subset_leq_fcard _ _ h6. + apply (eq_from_nth witness)=>//=. + + rewrite-cardE-(fcard1 [<:block>]);move:h9;rewrite!fcard1!cardE=>h9. + cut/#:0 < size (elems (dom prefixes));smt(size_eq0 size_ge0 fcard1). + move:h9;rewrite!fcard1!cardE=>h9 i [hi0 hi1]. + cut->/=:i = 0 by rewrite/#. + by apply hh2;rewrite mem_nth/#. +by rewrite h8=>//=. +qed. + + +(* lemma prefixe_inv_prefixe queries prefixes l : *) +(* prefixe_inv queries prefixes => *) +(* all_prefixes prefixes => *) +(* (elems (dom queries) = [] => elems (dom prefixes) = [[]]) => *) +(* prefixe l (get_max_prefixe l (elems (dom queries))) = *) +(* prefixe l (get_max_prefixe l (elems (dom prefixes))). *) +(* proof. *) +(* move=>[? h_prefixe_inv] h_all_prefixes. *) +(* case(elems (dom queries) = [])=>//=h_nil. *) +(* + by rewrite h_nil//==>->/=. *) +(* cut h_mem_queries:=mem_get_max_prefixe l (elems (dom queries)) h_nil. *) +(* cut h_leq :=all_take_in l (prefixe l (get_max_prefixe l (elems (dom queries)))) _ _ h_all_prefixes _. *) +(* + smt(prefixe_ge0 prefixe_sizel). *) +(* + by rewrite prefixe_take h_prefixe_inv memE h_mem_queries. *) +(* cut:=all_take_in l (prefixe l (get_max_prefixe l (elems (dom prefixes)))) _ _ h_all_prefixes _. *) +(* + smt(prefixe_ge0 prefixe_sizel). *) +(* + *) +(* rewrite prefixe_take. *) + +(* rewrite -take_size. *) + +(* print mem_get_max_prefixe. *) + +(* qed. *) + pred invm (m mi : ('a * 'b, 'a * 'b) fmap) = forall x y, m.[x] = Some y <=> mi.[y] = Some x. @@ -306,67 +758,73 @@ by rewrite/=-2!cats1 blocksponge_cat/=. qed. -pred prefixe_inv (queries : (block list, block) fmap) - (m : (state, state) fmap) = - forall (bs : block list), - bs \in dom queries => - forall i, 0 <= i < size bs => - let bc = (blocksponge (take i bs) m s0).`2 in - (bc.`1 +^ nth b0 bs i, bc.`2) \in dom m. - - - -lemma prefixe_inv_bs_fst_nil queries m : - prefixe_inv queries m => - forall l, l \in dom queries => - forall i, 0 <= i <= size l => - (blocksponge (take i l) m s0).`1 = []. -proof. -move=>Hinv l Hdom i [Hi0 Hisize];move:i Hi0 l Hisize Hdom;apply intind=>//=. -+ by move=>l;rewrite take0/=. -move=>i Hi0 Hind l Hil Hldom. -rewrite(take_nth b0)1:/#. -rewrite blocksponge_rcons/=. -cut->/=:=Hind l _ Hldom;1:rewrite/#. -by cut/=->/=:=Hinv _ Hldom i _;1:rewrite/#. -qed. - - -lemma prefixe_inv_set queries m x y : - !x \in dom m => - prefixe_inv queries m => - prefixe_inv queries m.[x <- y]. -proof. -move=>Hxdom Hpref bs/=Hbsdom i [Hi0 Hisize]. -cut->:blocksponge (take i bs) m.[x <- y] s0 = blocksponge (take i bs) m s0. -+ move:i Hi0 bs Hisize Hbsdom;apply intind=>//=i;first by rewrite take0//=. - move=>Hi0 Hind bs Hsize Hbsdom. - rewrite (take_nth b0)1:/#. - rewrite 2!blocksponge_rcons/=. - cut->/=:=prefixe_inv_bs_fst_nil _ _ Hpref _ Hbsdom i _;1:rewrite/#. - cut/=->/=:=Hpref _ Hbsdom i _;1:rewrite/#. - cut->/=:=Hind bs _ Hbsdom;1:rewrite/#. - cut->/=:=prefixe_inv_bs_fst_nil _ _ Hpref _ Hbsdom i _;1:rewrite/#. - rewrite dom_set in_fsetU1. - cut/=->/=:=Hpref _ Hbsdom i _;1:rewrite/#. - rewrite getP. - cut/#:=Hpref _ Hbsdom i _;1:rewrite/#. -rewrite dom_set in_fsetU1. -cut/#:=Hpref _ Hbsdom i _;1:rewrite/#. -qed. - - -lemma blocksponge_set_nil l m bc x y : - !x \in dom m => - let bs1 = blocksponge l m bc in - let bs2 = blocksponge l m.[x <- y] bc in - bs1.`1 = [] => - bs2 = ([], bs1.`2). -proof. -rewrite/==>hdom bs1. -cut/=:=blocksponge_set l m bc x y. -smt(size_ge0 size_eq0). -qed. +(* lemma prefixe_inv_bs_fst_nil queries prefixes m : *) +(* prefixe_inv queries prefixes m => *) +(* forall l, l \in dom queries => *) +(* forall i, 0 <= i <= size l => *) +(* (blocksponge (take i l) m s0).`1 = []. *) +(* proof. *) +(* move=>[h2 [h3 Hinv]] l Hdom i [Hi0 Hisize];move:i Hi0 l Hisize Hdom;apply intind=>//=. *) +(* + by move=>l;rewrite take0/=. *) +(* move=>i Hi0 Hind l Hil Hldom. *) +(* rewrite(take_nth b0)1:/#. *) +(* rewrite blocksponge_rcons/=. *) +(* cut->/=:=Hind l _ Hldom;1:rewrite/#. *) +(* by cut/=->/=/#:=Hinv _ Hldom i. *) +(* qed. *) + + +(* lemma blocksponge_drop l m bc : *) +(* exists i, 0 <= i <= List.size l /\ (blocksponge l m bc).`1 = drop i l. *) +(* proof. *) +(* move:l bc=>l;elim:l=>//=;1:exists 0=>//=;progress. *) +(* case((bc.`1 +^ x, bc.`2) \in dom m)=>//=h. *) +(* + cut[i [[hi0 His] Hi]]:=H (oget m.[(bc.`1 +^ x, bc.`2)]). *) +(* exists(i+1)=>/#. *) +(* cut[i [[hi0 His] Hi]]:=H (oget m.[(bc.`1 +^ x, bc.`2)]). *) +(* exists 0=>/#. *) +(* qed. *) + + +(* lemma prefixe_inv_set queries prefixes m x y : *) +(* !x \in dom m => *) +(* prefixe_inv queries prefixes m => *) +(* prefixe_inv queries prefixes m.[x <- y]. *) +(* proof. *) +(* move=>Hxdom Hpref;progress=>//=. *) +(* + rewrite/#. *) +(* + rewrite/#. *) +(* cut->:blocksponge (take i bs) m.[x <- y] s0 = blocksponge (take i bs) m s0. *) +(* + move:i H2 bs H3 H1;apply intind=>//=i;first smt(take0). *) +(* move=>Hi0 Hind bs Hisize Hbsdom. *) +(* rewrite (take_nth b0)1:/#. *) +(* rewrite 2!blocksponge_rcons/=. *) +(* cut[?[? Hpre]]:=Hpref. *) +(* cut->/=:=prefixe_inv_bs_fst_nil _ _ _ Hpref _ Hbsdom i _;1:rewrite/#. *) +(* cut/=->/=:=Hpre _ Hbsdom i _;1:rewrite/#. *) +(* cut->/=:=Hind bs _ Hbsdom;1:rewrite/#. *) +(* cut->/=:=prefixe_inv_bs_fst_nil _ _ _ Hpref _ Hbsdom i _;1:rewrite/#. *) +(* rewrite dom_set in_fsetU1. *) +(* cut/=->/=:=Hpre _ Hbsdom i _;1:rewrite/#. *) +(* rewrite getP. *) +(* cut/#:=Hpre _ Hbsdom i _;1:rewrite/#. *) +(* rewrite dom_set in_fsetU1. *) +(* cut[?[? Hpre]]:=Hpref. *) +(* cut/#:=Hpre _ H1 i _;1:rewrite/#. *) +(* qed. *) + + +(* lemma blocksponge_set_nil l m bc x y : *) +(* !x \in dom m => *) +(* let bs1 = blocksponge l m bc in *) +(* let bs2 = blocksponge l m.[x <- y] bc in *) +(* bs1.`1 = [] => *) +(* bs2 = ([], bs1.`2). *) +(* proof. *) +(* rewrite/==>hdom bs1. *) +(* cut/=:=blocksponge_set l m bc x y. *) +(* smt(size_ge0 size_eq0). *) +(* qed. *) (* lemma size_blocksponge queries m l : *) (* prefixe_inv queries m => *) @@ -388,13 +846,9 @@ export Prefixe. module C = { var c : int - var m : (state, state) fmap - var mi : (state, state) fmap var queries : (block list, block) fmap - proc init () = { + proc init () = { c <- 0; - m <- map0; - mi <- map0; queries <- map0; } }. @@ -408,31 +862,15 @@ module PC (P:PRIMITIVE) = { proc f (x:state) = { var y <- (b0,c0); - if (!x \in dom C.m) { - y <@ P.f(x); - C.c <- C.c + 1; - C.m.[x] <- y; - if (! y \in dom C.mi) { - C.mi.[y] <- x; - } - } else { - y <- oget C.m.[x]; - } + y <@ P.f(x); + C.c <- C.c + 1; return y; } proc fi(x:state) = { var y <- (b0,c0); - if (!x \in dom C.mi) { - y <@ P.fi(x); - C.c <- C.c + 1; - C.mi.[x] <- y; - if (! y \in dom C.m) { - C.m.[y] <- x; - } - } else { - y <- oget C.mi.[x]; - } + y <@ P.fi(x); + C.c <- C.c + 1; return y; } @@ -442,34 +880,18 @@ module DPRestr (P:DPRIMITIVE) = { proc f (x:state) = { var y <- (b0,c0); - if (!x \in dom C.m) { - if (C.c + 1 <= max_size) { - y <@ P.f(x); - C.c <- C.c + 1; - C.m.[x] <- y; - if (! y \in dom C.mi) { - C.mi.[y] <- x; - } - } - } else { - y <- oget C.m.[x]; + 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 (!x \in dom C.mi) { - if (C.c + 1 <= max_size) { - y <@ P.fi(x); - C.c <- C.c + 1; - C.mi.[x] <- y; - if (! y \in dom C.m) { - C.m.[y] <- x; - } - } - } else { - y <- oget C.mi.[x]; + if (C.c + 1 <= max_size) { + y <@ P.fi(x); + C.c <- C.c + 1; } return y; } @@ -491,7 +913,9 @@ module PRestr (P:PRIMITIVE) = { module FC(F:FUNCTIONALITY) = { - proc init = F.init + proc init() = { + F.init(); + } proc f (bs:block list) = { var b <- b0; @@ -525,7 +949,10 @@ module DFRestr(F:DFUNCTIONALITY) = { module FRestr(F:FUNCTIONALITY) = { - proc init = F.init + proc init() = { + Redo.init(); + F.init(); + } proc f = DFRestr(F).f @@ -543,10 +970,10 @@ module DRestr(D:DISTINGUISHER, F:DFUNCTIONALITY, P:DPRIMITIVE) = { }. lemma rp_ll (P<:DPRIMITIVE{C}): islossless P.f => islossless DPRestr(P).f. -proof. move=>Hll;proc;sp;if;auto;if;auto;call Hll;auto. qed. +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;if;auto;call Hll;auto. qed. +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. @@ -575,8 +1002,9 @@ section RESTR. Pr[Indif(FRestr(F), PRestr(P), D).main()@ &m: res] = Pr[Indif(F,P,DRestr(D)).main()@ &m: res]. proof. - byequiv=>//. - proc;inline *;wp;swap{1}1 2;sim;auto;call(:true);auto;call(:true);auto. + byequiv=>//;auto. + proc;inline *;wp. + swap{1}[1..2] 3;sim;auto;call(:true);auto. qed. end section RESTR. @@ -602,22 +1030,22 @@ section COUNT. proof. byequiv (_: ={glob D, glob P, glob CO} ==> C.c{1} <= max_size => ={res})=>//; 2:by move=> ??H[]?/H<-. - symmetry;proc;inline *;wp;swap{2}1 2. + symmetry;proc;inline *;wp. call (_: max_size < C.c, ={glob P, glob CO, glob C}). + apply D_ll. - + proc; sp;if;auto;if{1};1:by auto;call(_:true);auto. - by call{2} f_ll;auto=>/#. - + by move=> ?_;proc;sp;if;auto;if;auto;call f_ll;auto. - + by move=> _;proc;sp;if;auto;call f_ll;auto=>/#. - + proc;sp;if;auto;if{1};1:by auto;call(_:true);auto. + + 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;if;auto;if;auto;call fi_ll;auto. - + by move=> _;proc;sp;if;auto;call 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(prefixe_sizel). - wp;call (_:true);call(_:true);auto=>/#. + auto;call (_:true);auto;call(:true);auto=>/#. qed. end section COUNT. From 1a13dbd35df7a0e4ca7241ed32174acdd34adcae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 20 Feb 2018 18:54:27 +0100 Subject: [PATCH 260/394] ConcreteF.eca : reduce the probability of Strong_RP_RF by a factor of 1/2. Handle.eca : pass the invariant INV_CF_G1 with the prefixes map: - Primitve.f : DONE. - Functionality.f : to finish. - CF ~ G1 : to do. --- sha3/proof/smart_counter/ConcreteF.eca | 2 +- sha3/proof/smart_counter/Handle.eca | 461 ++++++++++++++++++++----- 2 files changed, 368 insertions(+), 95 deletions(-) diff --git a/sha3/proof/smart_counter/ConcreteF.eca b/sha3/proof/smart_counter/ConcreteF.eca index 91a57bd..beff777 100644 --- a/sha3/proof/smart_counter/ConcreteF.eca +++ b/sha3/proof/smart_counter/ConcreteF.eca @@ -205,7 +205,7 @@ section. lemma Real_Concrete &m : Pr[GReal(D).main()@ &m: res /\ C.c <= max_size] <= - Pr[CF(DRestr(D)).main()@ &m: res] + (max_size ^ 2)%r * mu dstate (pred1 witness). + Pr[CF(DRestr(D)).main()@ &m: res] + (max_size ^ 2)%r / 2%r * mu dstate (pred1 witness). proof. cut->: Pr[RealIndif(SqueezelessSponge,PC(Perm),D).main()@ &m: diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index 8b52526..713edf2 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -4,7 +4,7 @@ require import List FSet NewFMap Utils Common SLCommon RndO. require import DProd Dexcepted. (*...*) import Capacity IntOrder DCapacity. -(* require ConcreteF. *) +require (*--*) ConcreteF. clone import GenEager as ROhandle with type from <- handle, @@ -13,6 +13,7 @@ clone import GenEager as ROhandle with proof sampleto_ll by apply DCapacity.dunifin_ll. + module G1(D:DISTINGUISHER) = { var m, mi : smap var mh, mhi : hsmap @@ -26,6 +27,7 @@ module G1(D:DISTINGUISHER) = { var sa, sa', sc; var h, i <- 0; sa <- b0; + sc <- c0; while (i < size p ) { if (mem (dom mh) (sa +^ nth witness p i, h)) { (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; @@ -153,7 +155,10 @@ module G1(D:DISTINGUISHER) = { }. (* -------------------------------------------------------------------------- *) -(** The state of CF contains only the map PF.m. +(** 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; @@ -178,6 +183,20 @@ inductive m_mh (hs : handles) (m : smap) (mh : hsmap) = /\ 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) = + | INV_m_p of (p.[[]] = Some (b0,c0)) + & (forall (l : block list), + l \in dom 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])). + +(** 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, @@ -221,7 +240,8 @@ inductive inv_spec (m:('a,'b) fmap) mi = (* 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 = + (mh mhi : hsmap) (ro : (block list,block) fmap) pi + (p : (block list, state) fmap) = | HCF_G1 of (hs_spec hs ch) & (inv_spec Gm Gmi) & (inv_spec mh mhi) @@ -230,15 +250,17 @@ inductive INV_CF_G1 (hs : handles) ch (Pm Pmi Gm Gmi : smap) & (incl Gm Pm) & (incl Gmi Pmi) & (mh_spec hs Gm mh ro) - & (pi_spec hs mh pi). + & (pi_spec hs mh pi) + (* & (ro_p ro p) *) + & (m_p Pm p). (** 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: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + hs m1 mh2 p: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => m_mh hs m1 mh2. proof. by case. qed. @@ -246,8 +268,8 @@ 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: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + hs mi1 mhi2 p: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => m_mh hs mi1 mhi2. proof. by case. qed. @@ -255,8 +277,8 @@ 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: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + m1 m2 p: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => incl m2 m1. proof. by case. qed. @@ -264,46 +286,72 @@ 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: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + mi1 mi2 p: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => 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: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + hs m2 mh2 ro p: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => 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: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + hs mh2 pi p: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => 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: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + hs ch p: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => hs_spec hs ch. proof. by case. qed. lemma inv_of_INV hs ch m1 mi1 m2 mi2 ro pi - mh2 mhi2: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + mh2 mhi2 p: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p=> inv_spec mh2 mhi2. proof. by case. qed. -lemma invG_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => +lemma invG_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 => inv_spec m2 mi2. proof. by case. qed. +lemma m_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 => + m_p m1 p. +proof. by case. qed. + +lemma all_prefixes_of_m_p m1 p: + m_p m1 p => all_prefixes p. +proof. +case=>_ h l hl i. +case(l = [])=>//=l_notnil. +case(0 <= i)=>hi0;last first. ++ rewrite take_le0 1:/#;cut<-:=take0 l;smt(in_dom size_ge0). +case(i < size l)=>hisize;last smt(take_oversize). +smt(in_dom). +qed. + +lemma all_prefixes_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 => + 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. @@ -664,8 +712,8 @@ 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: - INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi +lemma lemma1 hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2 prefixes: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes => x2 <> y2 => Pm.[(x1,x2)] = None => Gm.[(x1,x2)] = None @@ -676,7 +724,7 @@ lemma lemma1 hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2: 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. + ro pi prefixes. proof. move=> HINV x2_neq_y2 Pm_x Gm_x x2_notin_rng1_hs y2_notin_rng1_hs; split. + rewrite (@addzA ch 1 1); apply/hs_addh. @@ -755,12 +803,22 @@ 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_notin_rng2_mh. -move=> ^ /build_hpathP + -> /=; rewrite !getP. -by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. ++ move=> ^ /build_hpathP + -> /=; rewrite !getP. + by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. ++ by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). +split=>[]. ++ by case:HINV=>_ _ _ _ _ _ _ _ _ [] _ [] ->//. +move=>l hmem i hi. +cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. +cut[]sa sc[]:=h2 l hmem i hi. +cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. +smt(in_dom getP). qed. -lemma lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2: - INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi + +lemma lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes x1 x2 y1 y2: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes + => ! (y1,y2) \in dom Pm => x2 <> y2 => Pmi.[(x1,x2)] = None => Gmi.[(x1,x2)] = None @@ -771,9 +829,9 @@ lemma lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2: 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. + ro pi prefixes. proof. -move=> HINV x2_neq_y2 Pm_x Gm_x xc_notin_rng1_hs yc_notin_rng1_hs; split. +move=> HINV hh x2_neq_y2 Pm_x Gm_x xc_notin_rng1_hs yc_notin_rng1_hs; split. + rewrite (@addzA ch 1 1); apply/hs_addh. + by move: HINV=> /hs_of_INV/hs_addh=> ->. by move=> f h; rewrite getP; case: (h = ch)=> [/#|_]; exact/yc_notin_rng1_hs. @@ -849,12 +907,20 @@ 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_notin_rng2_mh. -move=> ^ /build_hpathP + -> /=; rewrite !getP. -by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. ++ move=> ^ /build_hpathP + -> /=; rewrite !getP. + by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. ++ by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). +split=>[]. ++ by case:HINV=>_ _ _ _ _ _ _ _ _ [] _ [] ->//. +move=>l hmem i hi. +cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. +cut[]sa sc[]:=h2 l hmem i hi. +cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. +smt(in_dom getP). qed. -lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x1 x2 y1 y2 hx: - INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi +lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes x1 x2 y1 y2 hx: + INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes => PFm.[(x1,x2)] = None => G1m.[(x1,x2)] = None => pi.[x2] = None @@ -864,7 +930,7 @@ lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x1 x2 y1 y2 hx: 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. + ro pi prefixes. proof. move=> HINV PFm_x1x2 G1m_x1x2 pi_x2 hs_hx y2_notin_rng1_hs. split. @@ -936,12 +1002,21 @@ have H /H {H} := build_hpath_down G1mh x1 hx y1 ch p v h no_path_to_hx. move=> ^ Hpath -> /=; rewrite getP; 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. ++ 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=>_ _ _ _ _ _ _ _ _ [] _ [] ->//. +move=>l hmem i hi. +cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. +cut[]sa sc[]:=h2 l hmem i hi. +cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. +smt(in_dom getP). qed. -lemma lemma2' hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x1 x2 y1 y2 hx: - INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi +lemma lemma2' hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes x1 x2 y1 y2 hx: + INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes + => ! (y1,y2) \in dom PFm => PFmi.[(x1,x2)] = None => G1mi.[(x1,x2)] = None => hs.[hx] = Some (x2,Known) @@ -950,9 +1025,9 @@ lemma lemma2' hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x1 x2 y1 y2 hx: 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. + ro pi prefixes. proof. -move=> HINV PFmi_x1x2 G1mi_x1x2 hs_hx y2_notin_rng1_hs. +move=> HINV hh PFmi_x1x2 G1mi_x1x2 hs_hx y2_notin_rng1_hs. split. + by apply/hs_addh=> //=; case: HINV. + apply/inv_addm=> //; 1:by case: HINV. @@ -1032,16 +1107,24 @@ have no_path_to_ch: forall p0 v0, build_hpath G1mh p0 <> Some (v0,ch). 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 getP; 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. ++ have H /H {H} := build_hpath_down G1mh y1 ch x1 hx p v h no_path_to_ch. + move=> ^ Hpath -> /=; rewrite getP; 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=>_ _ _ _ _ _ _ _ _ [] _ [] ->//. +move=>l hmem i hi. +cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. +cut[]sa sc[]:=h2 l hmem i hi. +cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. +smt(in_dom getP). qed. -lemma lemma3 hs ch Pm Pmi Gm Gmi mh mhi ro pi xa xc hx ya yc hy p b: - INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi +lemma lemma3 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes xa xc hx ya yc hy p b: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes => Pm.[(xa,xc)] = Some (ya,yc) => Gm.[(xa,xc)] = None => mh.[(xa,hx)] = Some (ya,hy) @@ -1052,7 +1135,7 @@ lemma lemma3 hs ch Pm Pmi Gm Gmi mh mhi ro pi xa xc hx ya yc hy p b: Pm Pmi Gm.[(xa,xc) <- (ya,yc)] Gmi.[(ya,yc) <- (xa,xc)] mh mhi - ro pi.[yc <- (rcons p (b +^ xa),ya)]. + ro pi.[yc <- (rcons p (b +^ xa),ya)] prefixes. proof. move=> HINV Pm_xaxc Gm_xaxc mh_xahx hs_hx hs_hy pi_xc. split. @@ -1102,24 +1185,32 @@ split. rewrite getP; case: (hx' = hy)=> /= [<*>|//]. move: hs_hx'; rewrite hs_hy=> /= [#] <<*> /=. by move: Hite=> /= [#]; case: fy' hs_hy'=> //= _ ->. -split=> c p' b'; rewrite !getP; 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 getP; case: (h = hy)=> [<*> /=|//=]. - by rewrite yc_neq_c hs_hy /=. -split=> [[#] <<*>|]. -+ exists hy; rewrite getP /=; apply/build_hpath_prefix. - exists b hx; rewrite xorwA xorwK xorwC xorw0 mh_xahx /=. ++ split=> c p' b'; rewrite !getP; 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 getP; case: (h = hy)=> [<*> /=|//=]. + by rewrite yc_neq_c hs_hy /=. + split=> [[#] <<*>|]. + + exists hy; rewrite getP /=; 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 getP; 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. -move=> [h]; rewrite getP; 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). +split=>[]. ++ by case:HINV=>_ _ _ _ _ _ _ _ _ [] _ [] ->//. +move=>l hmem i hi. +cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. +cut[]sa sc[]:=h2 l hmem i hi. +cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. +smt(in_dom getP). qed. -(* clone export ConcreteF as ConcreteF1. *) +clone export ConcreteF as ConcreteF1. lemma m_mh_None hs0 PFm G1mh hx2 x2 k x1: m_mh hs0 PFm G1mh => @@ -1200,10 +1291,29 @@ proof. qed. - - -(* we should do a lemma to have the equivalence *) +lemma lemma4 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes i p sa sc h f: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes +=> 0 <= i < List.size p +=> take (i + 1) p \in dom prefixes +=> prefixes.[take i p] = Some (sa,sc) +=> build_hpath mh (take i p) = Some (sa,h) +=> hs.[h] = Some (sc, f) +=> (sa +^ nth witness p i, h) \in dom mh. +proof. +move=>inv0 hi take_i1_p_in_prefixes prefixes_sa_sc build_hpath_i_p hs_h_sc_f. +cut[]_ m_prefixe:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. +cut[]b1 c1[]:=m_prefixe _ take_i1_p_in_prefixes i _;1:smt(size_take). +rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/# prefixes_sa_sc/==>[][<-<-]{b1 c1}Pm_prefixe. +cut[]hh1 hh2 hh3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. +cut:ro.[take (i+1) p] = Some (oget prefixes.[take (i+1) p]).`1 + by cut[]->:=(ro_p_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0);smt(mapP get_oget). +cut{1}->:=(take_nth witness i p);1:smt(size_take);move=>h1. +cut:=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(in_dom). +qed. + +(* we should do a lemma to have the equivalence *) equiv eq_fi (D <: DISTINGUISHER {PF, RO, G1}): PF.fi ~ G1(D).S.fi: @@ -1215,6 +1325,7 @@ equiv eq_fi (D <: DISTINGUISHER {PF, RO, G1}): PF.fi ~ G1(D).S.fi: G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} + Redo.prefixes{1} ==> !G1.bcol{2} => !G1.bext{2} => ={res} @@ -1222,15 +1333,16 @@ equiv eq_fi (D <: DISTINGUISHER {PF, RO, G1}): PF.fi ~ G1(D).S.fi: 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}. + F.RO.m{2} G1.paths{2} + Redo.prefixes{1}. proof. 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}. -elim* => hs ch Pm Pmi Gm Gmi mh mhi ro pi [xa xc]. + F.RO.m{2}, G1.paths{2}, x{2}, Redo.prefixes{1}. +elim* => hs ch Pm Pmi Gm Gmi mh mhi ro pi [xa xc] prefixes. case @[ambient]: - {-1}(INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi) - (eq_refl (INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi)); last first. + {-1}(INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes) + (eq_refl (INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes)); 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]. @@ -1258,13 +1370,22 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] rewrite(@huniq_hinvK_h ch) 3:oget_some /=. + by apply/huniq_addh=> //; have /hs_of_INV [] := inv0. + by rewrite getP. - apply/(@lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi xa xc ya yc inv0 _ Pmi_xaxc Gmi_xaxc)=> //. + apply/(@lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes xa xc ya yc inv0 _ _ Pmi_xaxc Gmi_xaxc)=> //;first last. + rewrite -negP=> <*>; move: yc_notin_rng1_hs_addh => /=. apply/negb_forall=> /=; exists ch; apply/negb_forall=> /=; exists Known. by rewrite getP. + move=> f h; move: (yc_notin_rng1_hs_addh h f); rewrite getP. case: (h = ch)=> <*> //= _; rewrite -negP. by have /hs_of_INV [] _ _ H /H {H} := inv0. + + rewrite in_dom/=;cut[]h1 h2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. + cut h1':=h1 ya yc. + cut :Pm.[(ya, yc)] <> None => exists (hx : handle) (fx : flag), hs.[hx] = Some (yc, fx) by rewrite/#. + case(Pm.[(ya, yc)] = None)=>//=h; + rewrite negb_exists/==>a;rewrite negb_exists/==>b. + cut:=yc_notin_rng1_hs_addh a b;rewrite getP;case(a=ch)=>//=hach. search (&&). + case(xc=yc)=>[/#|]hxyc. + cut[]_ _ help:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. + by cut/#:=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. @@ -1279,7 +1400,14 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] rewrite (@huniq_hinvK_h hx2) // oget_some /= => y1 -> /= y2 -> /=. case: (hinvP hs y2)=> [_ y2_notin_rng1_hs _ _|/#]. rewrite getP /= oget_some /=. - by apply/lemma2'=> // f h; exact/y2_notin_rng1_hs. + apply/lemma2'=> //. + + rewrite in_dom/=;cut[]h1 _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. + cut h1':=h1 y1 y2. + cut :Pm.[(y1, y2)] <> None => exists (hx : handle) (fx : flag), hs.[hx] = Some (y2, fx) by rewrite/#. + case(Pm.[(y1, y2)] = None)=>//=h; + rewrite negb_exists/==>a;rewrite negb_exists/==>b. + exact(y2_notin_rng1_hs). + move=> f h; exact/y2_notin_rng1_hs. rcondf{1} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom 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 in_dom Gmi_xaxc. @@ -1291,7 +1419,7 @@ case @[ambient]: {-1}(Gmi.[(xa,xc)]) (eq_refl Gmi.[(xa,xc)])=> [|[ya' yc'] ^] Gm 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. print Block.DBlock. + by have /invG_of_INV [] -> := inv0; rewrite Gmi_xaxc. smt (@Block.DBlock @Capacity.DCapacity). have /incli_of_INV <- := inv0; 1:by rewrite Gmi_xaxc. rewrite Pmi_xaxc=> /= [#] <<*>. @@ -1323,37 +1451,182 @@ qed. equiv PFf_Cf (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1(D).C.f : ! (G1.bcol{2} \/ G1.bext{2}) /\ ={p} /\ p{1} <> [] /\ - 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} ==> + 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} ==> ! (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}. + ={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}. proof. - proc. ; seq 2 4: + proc;sp. + seq 1 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} /\ + (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} /\ F.RO.m.[p]{2} = Some sa{1})));last first. + case : (! (G1.bcol{2} \/ G1.bext{2})); 2: by conseq (_:_ ==> true)=> //; inline *;auto;rewrite Block.DBlock.dunifin_ll. inline *; rcondf{2} 3. + by move=> &m;auto=> &hr [#] H /H[_ H1] ??;rewrite in_dom H1. by auto=> /> &m1 &m2;rewrite Block.DBlock.dunifin_ll /= => H /H [-> ->];rewrite oget_some. - while ( - p{1} = (drop i p){2} /\ (0 <= i <= size p){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} /\ - ={sa} /\ + while ( ={p, i} /\ (0 <= i <= size p){2} /\ + (Redo.prefixes.[take i p]{1} = Some (sa,sc){1}) /\ + (take i p \in dom 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} /\ + ={sa} /\ (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})));last first. - + auto=> &m1 &m2 [#] -> -> Hp ^ Hinv -> /=;rewrite drop0 size_ge0 /=;split. - + split;[split|];1: by exists Known;case Hinv => -[] _ ->. - + by rewrite take0. - by case (p{m2}) => //=;smt w=size_ge0. - move=> ????? ????? ?? iR ? ->> ?[#] _ ?? H /H{H} [#] -> ->> _ ?. - have -> : iR = size p{m2} by smt (). - have -> /= : size p{m2} <> 0 by smt (size_ge0). - by rewrite take_size. - inline *;sp 1 0;wp=> /=. + + auto=> &m1 &m2 [#]->->-> _->->->->-> Hp ^ Hinv -> /=;rewrite size_ge0/=;split. + + split;-1: split;-1: split;-2: by exists Known;case Hinv => -[] _ ->. + + by rewrite take0;case:Hinv=>_ _ _ _ _ _ _ _ _ _ []->//. + + by rewrite take0 in_dom;case:Hinv=>_ _ _ _ _ _ _ _ _ _ []->//. + by rewrite take0. + progress. + + rewrite/#. + + smt(size_eq0 size_ge0 take_size). + if{1}. + + case : (! (G1.bcol{2} \/ G1.bext{2}));last first. + + wp;conseq(:_==> (G1.bcol{2} \/ G1.bext{2}));1:smt(get_oget). + by inline*;if{2};auto;smt(DCapacity.dunifin_ll DBlock.dunifin_ll). + rcondt{2}1;1:auto;progress. + * smt(lemma4). + auto;progress. + * rewrite/#. + * rewrite/#. + * smt(get_oget). + * rewrite/#. + * move:H3;rewrite H7/==>[];progress. + cut:=lemma4 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H3 _ H6 H1 H10 H9;1:rewrite/#. + rewrite in_dom=>hG1. + cut[]b1 h1 hb1h1:exists b1 h1, G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2})] = Some (b1, h1) by rewrite/#. + cut[]_ h:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. + cut[]b' c':=h _ H6 i{2} _;1:smt(size_take). + rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#H1/==>[][][<<-<<-]{b' c'} h'{h}. + rewrite-h' hb1h1/=oget_some/=. + cut[]hh1 hh2:= m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. + cut[]a b c d:=hh2 _ _ _ _ hb1h1. + by rewrite H9/==>[][][]->>->>[]_->;rewrite !oget_some/=/#. + + * move:H3;rewrite H7=>//=[];progress. + cut:=lemma4 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H3 _ H6 H1 H10 H9;1:rewrite/#. + rewrite in_dom=>hG1. + cut[]b1 h1 hb1h1:exists b1 h1, G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2})] = Some (b1, h1) by rewrite/#. + cut[]_ h:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. + cut[]b' c':=h _ H6 i{2} _;1:smt(size_take). + rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#H1/==>[][][<<-<<-]{b' c'} h'{h}. + rewrite-h' hb1h1/=oget_some/=. + cut[]hh1 hh2:= m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. + cut[]a b c d:=hh2 _ _ _ _ hb1h1. + by rewrite H9/==>[][][]->>->>[]->->;rewrite !oget_some/=/#. + + * move:H3;rewrite H7=>//=[];progress. + cut:=lemma4 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H3 _ H6 H1 H10 H9;1:rewrite/#. + rewrite in_dom=>hG1. + cut[]b1 h1 hb1h1:exists b1 h1, G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2})] = Some (b1, h1) by rewrite/#. + cut->:=(take_nth witness i{2} p{2} _);rewrite//=. + by rewrite build_hpath_prefix H10/=hb1h1/=;smt(oget_some). + * rewrite/#. + * rewrite/#. + * move:H3;rewrite H7/==>[];progress. + by cut[]->:=ro_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H3;smt(mapP get_oget). + inline *;sp 2 0;wp=> /=. + conseq(:_==> (! (G1.bcol{2} \/ G1.bext{2}) => (oget PF.m{1}.[x{1}]).`1 = sa{2} + /\ build_hpath G1.mh{2} (take (i{2} + 1) p{2}) = Some (sa{2}, h{2}) + /\ (exists (f : flag), FRO.m{2}.[h{2}] = Some ((oget PF.m{1}.[x{1}]).`2, f)) + /\ 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}.[take (i{1} + 1) p{1} <- + ((oget PF.m{1}.[x{1}]).`1, (oget PF.m{1}.[x{1}]).`2)])); + progress;..-3:smt(getP dom_set in_fsetU1 mapP getP). + * by move:H7;rewrite H8/==>[][] _ []_ [] _ [] _ _ _ _ _ _ _ _ _ [] -> _/=;rewrite mapP/=getP/=/#. + case ((G1.bcol{2} \/ G1.bext{2})). + + wp;conseq (_: _ ==> (G1.bcol{2} \/ G1.bext{2}))=> //;progress. + by if{1};if{2};auto;2:(swap{2} 4 -3;auto); smt w=(Block.DBlock.dunifin_ll DCapacity.dunifin_ll). + conseq(: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} + /\ (exists (f : flag), FRO.m{2}.[h{2}] = Some (sc{1}, f)) + /\ x{1} = (sa{1}, sc{1}) + /\ sa{1} = sa{2} +^ nth witness p{1} i{1} + /\ ={p, i} /\ 0 <= i{1} < size p{1} + /\ Redo.prefixes{1}.[take i{1} p{1}] = Some (sa{2}, sc{1}) + /\ build_hpath G1.mh{2} (take i{2} p{2}) = Some (sa{2}, h{2}) + /\ (if i{2} = 0 then sa{2} = b0 && h{2} = 0 + else F.RO.m{2}.[take i{2} p{2}] = Some sa{2}) + /\ (take i{1} p{1} \in dom Redo.prefixes{1}) + /\ ! (take (i{1} + 1) p{1} \in dom Redo.prefixes{1}) + /\ ! (G1.bcol{2} \/ G1.bext{2}) + /\ (x \in dom PF.m){1} = ((sa +^ nth witness p i, h) \in dom G1.mh){2} + ==>_);progress;..-3:rewrite/#. + * move:H3;rewrite H7/=;progress. + rewrite !in_dom. + pose X := sa{2} +^ nth witness p{2} i{2}. + case (H3)=> -[Hu _ _] _ _ [] /(_ X sc{1}) Hpf ^ HG1 /(_ X h{2}) Hmh _ _ _ _ _. + case: {-1}(PF.m{1}.[(X,sc{1})]) (eq_refl (PF.m{1}.[(X,sc{1})])) Hpf Hmh. + + case (G1.mh{2}.[(X, h{2})]) => //= -[ya hy] Hpf. + by rewrite -negP => /(_ ya hy) [] ????[#];rewrite H8 /= => -[<-];rewrite Hpf. + move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. + rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. print huniq. + by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx)H8 Hhx;rewrite H11. + + if{1};2:(rcondt{2}1; first by auto=>/#);1:(rcondf{2}1;first by auto=>/#);last first. + + auto;progress. + * move:H9 H10;pose sa' := sa{2} +^ nth witness p{2} i{2};move=>H9 H10. + case (H)=> -[Hu _ _] _ _ [] /(_ sa' sc{1}) Hpf ^ HG1 /(_ sa' h{2}) Hmh _ _ _ _ _. + cut:(sa', h{2}) \in dom G1.mh{2} by rewrite -H9 H10. + move:H10;rewrite!in_dom;progress. + case: {-1}(PF.m{1}.[(sa',sc{1})]) (eq_refl (PF.m{1}.[(sa',sc{1})])) Hpf Hmh=>//=. + move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. + rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. + by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx) H0 Hhx;rewrite H15 !oget_some/=. + * cut->:=take_nth witness i{2} p{2};1:smt(size_take). + rewrite build_hpath_prefix H4/=;smt(get_oget). + * move:H9 H10;pose sa' := sa{2} +^ nth witness p{2} i{2};move=>H9 H10. + case (H)=> -[Hu _ _] _ _ [] /(_ sa' sc{1}) Hpf ^ HG1 /(_ sa' h{2}) Hmh _ _ _ _ _. + cut:(sa', h{2}) \in dom G1.mh{2} by rewrite -H9 H10. + move:H10;rewrite!in_dom;progress. + case: {-1}(PF.m{1}.[(sa',sc{1})]) (eq_refl (PF.m{1}.[(sa',sc{1})])) Hpf Hmh=>//=. + move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. + rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. + by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx) H0 Hhx;rewrite H15 !oget_some/=Hhy/#. + * do !split=>//=. + * by cut[]:=. + * by cut[]:=Hhs. + * by cut[]:=Hhs. + * by cut[]:=Hinv. + * by cut[]:=Hinvi. + * by cut[]:=Hmmh. + * by cut[]:=Hmmh. + * by cut[]:=Hmmhi. + * by cut[]:=Hmmhi. + * by cut[]:=Hmh. + * by cut[]:=Hmh. + * by cut[]:=Hmh. + * by cut[]:=Hpi. + * by cut[]:=H. + + rewrite head_nth nth_drop // addz0 => Heq Hbu ????. + rewrite !in_dom. + have -> /= : i{m2} + 1 <> 0 by smt (). + pose sa' := sa{m2} +^ nth witness p{m2} i{m2}. + case (Hmmh) => /(_ sa' sc{m1});case (PF.m{m1}.[(sa', sc{m1})])=> //= -[ya yc] /(_ ya yc) /=. + move=> [hx fx hy fy]; case (Hhs) => Hu _ _ [#] Heq'. + have /= <<- /= Hhy ^? ->:= Hu _ _ _ _ Heq Heq'. + rewrite !oget_some /= => _;split;1: by exists fy. + rewrite (@take_nth witness) 1://. + case (Hmh) => _ -> _;rewrite build_hpath_prefix Hbu /#. + * auto;progress. +move:H3;rewrite H7/=;progress. + rewrite in_dom/=;rewrite in_dom/= in H8. +search None. + cut H_m_mh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. + apply(notin_hs_notin_dom2_mh _ _ H_m_mh). + * smt(DBlock.dunifin_ll DCapacity.dunifin_ll). + * smt(DBlock.dunifin_ll DCapacity.dunifin_ll). + * rewrite getP/=oget_some. + conseq (_: _ ==> (! (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} /\ From 217d5d50c0490d53bcabebb2596be710475e6e16 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 20 Feb 2018 18:58:13 +0100 Subject: [PATCH 261/394] miss save --- sha3/proof/smart_counter/Handle.eca | 114 ++++++++++++++++++---------- 1 file changed, 73 insertions(+), 41 deletions(-) diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index 713edf2..09e8848 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -345,12 +345,12 @@ qed. lemma all_prefixes_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 => all_prefixes p. -proof. case=>? ? ? ? ? ? ? ? ? ? h ?;exact(all_prefixes_of_m_p _ h). qed. +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. +(* 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. @@ -805,9 +805,9 @@ have H /H {H}:= build_hpath_down mh x1 ch y1 (ch + 1) p v h _. by move=> p' b' v' h' <*>; rewrite ch_notin_rng2_mh. + move=> ^ /build_hpathP + -> /=; rewrite !getP. by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. -+ by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). +(* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ _ [] _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. move=>l hmem i hi. cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]sa sc[]:=h2 l hmem i hi. @@ -909,9 +909,9 @@ have H /H {H}:= build_hpath_down mh y1 (ch + 1) x1 ch p v h _. by move=> p' b' v' h' <*>; rewrite Sch_notin_rng2_mh. + move=> ^ /build_hpathP + -> /=; rewrite !getP. by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. -+ by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). +(* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ _ [] _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. move=>l hmem i hi. cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]sa sc[]:=h2 l hmem i hi. @@ -1004,9 +1004,9 @@ 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). +(* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ _ [] _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. move=>l hmem i hi. cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]sa sc[]:=h2 l hmem i hi. @@ -1113,9 +1113,9 @@ have no_path_to_ch: forall p0 v0, build_hpath G1mh p0 <> Some (v0,ch). + 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). +(* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ _ [] _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. move=>l hmem i hi. cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]sa sc[]:=h2 l hmem i hi. @@ -1200,9 +1200,9 @@ split. 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 apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ _ [] _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. move=>l hmem i hi. cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]sa sc[]:=h2 l hmem i hi. @@ -1297,17 +1297,16 @@ lemma lemma4 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes i p sa sc h f: => take (i + 1) p \in dom 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 dom mh. proof. -move=>inv0 hi take_i1_p_in_prefixes prefixes_sa_sc build_hpath_i_p hs_h_sc_f. +move=>inv0 hi take_i1_p_in_prefixes prefixes_sa_sc build_hpath_i_p ro_prefixe hs_h_sc_f. cut[]_ m_prefixe:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. cut[]b1 c1[]:=m_prefixe _ take_i1_p_in_prefixes i _;1:smt(size_take). rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/# prefixes_sa_sc/==>[][<-<-]{b1 c1}Pm_prefixe. cut[]hh1 hh2 hh3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. -cut:ro.[take (i+1) p] = Some (oget prefixes.[take (i+1) p]).`1 - by cut[]->:=(ro_p_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0);smt(mapP get_oget). -cut{1}->:=(take_nth witness i p);1:smt(size_take);move=>h1. +move:ro_prefixe;cut{1}->:=(take_nth witness i p);1:smt(size_take);move=>h1. cut:=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(in_dom). qed. @@ -1481,8 +1480,8 @@ proof. else F.RO.m.[take i p]{2} = Some sa{1})));last first. + auto=> &m1 &m2 [#]->->-> _->->->->-> Hp ^ Hinv -> /=;rewrite size_ge0/=;split. + split;-1: split;-1: split;-2: by exists Known;case Hinv => -[] _ ->. - + by rewrite take0;case:Hinv=>_ _ _ _ _ _ _ _ _ _ []->//. - + by rewrite take0 in_dom;case:Hinv=>_ _ _ _ _ _ _ _ _ _ []->//. + + by rewrite take0;case:Hinv=>_ _ _ _ _ _ _ _ _ []->//. + + by rewrite take0 in_dom;case:Hinv=>_ _ _ _ _ _ _ _ _ []->//. by rewrite take0. progress. + rewrite/#. @@ -1491,57 +1490,90 @@ proof. + case : (! (G1.bcol{2} \/ G1.bext{2}));last first. + wp;conseq(:_==> (G1.bcol{2} \/ G1.bext{2}));1:smt(get_oget). by inline*;if{2};auto;smt(DCapacity.dunifin_ll DBlock.dunifin_ll). - rcondt{2}1;1:auto;progress. - * smt(lemma4). + + conseq(: ={p, i, sa} + /\ 0 <= i{2} < size p{2} + /\ Redo.prefixes{1}.[take i{1} p{1}] = Some (sa{1}, sc{1}) + /\ (take i{1} p{1} \in dom Redo.prefixes{1}) + /\ 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} + /\ (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}) + /\ (take (i{1} + 1) p{1} \in dom Redo.prefixes{1}) + /\ ! (G1.bcol{2} \/ G1.bext{2}) + /\ F.RO.m{2}.[take (i{2} + 1) p{2}] = + Some (oget Redo.prefixes{1}.[take (i{2} + 1) p{2}]).`1 + && ((sa +^ nth witness p i, h) \in dom G1.mh){2} ==> _);progress. + * rewrite/#. + * rewrite/#. + * rewrite/#. + * rewrite/#. + * rewrite/#. + * rewrite/#. + * rewrite/#. + * move:H3;rewrite H7/=;progress. + cut[]prefixe_nil prefixes:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. + cut[]b1 c1:=prefixes _ H6 i{2} _;1:smt(size_take). + rewrite!take_take!min_lel//=1:/# nth_take 1,2:/# H1/==>[][][->>->>]h. + rewrite -h. + cut[]h1 h2 h3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. + cut->:=take_nth witness i{2} p{2} _;1:smt(size_take). + rewrite h2 H9/=. exists b1 h{2}=>//=. + clear h1 h2 h3 prefixes prefixe_nil. + cut[]h1 h2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. + cut[]a b c d[]e[]g j:=h1 (b1 +^ nth witness p{2} i{2}) c1 + (oget Redo.prefixes{1}.[take (i{2} + 1) p{2}]).`1 + (oget Redo.prefixes{1}.[take (i{2} + 1) p{2}]).`2 _;1:smt(get_oget). + cut[]hu _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. + by cut/=<<-/#:=hu _ _ _ _ H8 e. + * move:H3;rewrite H7/=;progress. + cut/#:=lemma4 _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} _ _ _ _ H3 _ H6 H1 H10 H8 H9. + by rewrite/#. + rcondt{2}1;1:auto. auto;progress. * rewrite/#. * rewrite/#. * smt(get_oget). - * rewrite/#. - * move:H3;rewrite H7/==>[];progress. - cut:=lemma4 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H3 _ H6 H1 H10 H9;1:rewrite/#. + * cut:=lemma4 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H3 _ H7 H1 H5 H9 H4;1:rewrite/#. rewrite in_dom=>hG1. cut[]b1 h1 hb1h1:exists b1 h1, G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2})] = Some (b1, h1) by rewrite/#. cut[]_ h:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. - cut[]b' c':=h _ H6 i{2} _;1:smt(size_take). + cut[]b' c':=h _ H7 i{2} _;1:smt(size_take). rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#H1/==>[][][<<-<<-]{b' c'} h'{h}. rewrite-h' hb1h1/=oget_some/=. cut[]hh1 hh2:= m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. cut[]a b c d:=hh2 _ _ _ _ hb1h1. - by rewrite H9/==>[][][]->>->>[]_->;rewrite !oget_some/=/#. - - * move:H3;rewrite H7=>//=[];progress. - cut:=lemma4 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H3 _ H6 H1 H10 H9;1:rewrite/#. + by rewrite H4/==>[][][]->>->>[]_->;rewrite !oget_some/=/#. + * cut:=lemma4 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H3 _ H7 H1 H5 H9 H4;1:rewrite/#. rewrite in_dom=>hG1. cut[]b1 h1 hb1h1:exists b1 h1, G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2})] = Some (b1, h1) by rewrite/#. cut[]_ h:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. - cut[]b' c':=h _ H6 i{2} _;1:smt(size_take). + cut[]b' c':=h _ H7 i{2} _;1:smt(size_take). rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#H1/==>[][][<<-<<-]{b' c'} h'{h}. rewrite-h' hb1h1/=oget_some/=. cut[]hh1 hh2:= m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. cut[]a b c d:=hh2 _ _ _ _ hb1h1. - by rewrite H9/==>[][][]->>->>[]->->;rewrite !oget_some/=/#. - - * move:H3;rewrite H7=>//=[];progress. - cut:=lemma4 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H3 _ H6 H1 H10 H9;1:rewrite/#. + by rewrite H4/==>[][][]->>->>[]->->;rewrite !oget_some/=/#. + * cut:=lemma4 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H3 _ H7 H1 H5 H9 H4;1:rewrite/#. rewrite in_dom=>hG1. cut[]b1 h1 hb1h1:exists b1 h1, G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2})] = Some (b1, h1) by rewrite/#. cut->:=(take_nth witness i{2} p{2} _);rewrite//=. - by rewrite build_hpath_prefix H10/=hb1h1/=;smt(oget_some). + by rewrite build_hpath_prefix H5/=hb1h1/=;smt(oget_some). * rewrite/#. * rewrite/#. - * move:H3;rewrite H7/==>[];progress. - by cut[]->:=ro_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H3;smt(mapP get_oget). inline *;sp 2 0;wp=> /=. conseq(:_==> (! (G1.bcol{2} \/ G1.bext{2}) => (oget PF.m{1}.[x{1}]).`1 = sa{2} /\ build_hpath G1.mh{2} (take (i{2} + 1) p{2}) = Some (sa{2}, h{2}) /\ (exists (f : flag), FRO.m{2}.[h{2}] = Some ((oget PF.m{1}.[x{1}]).`2, f)) + /\ F.RO.m{2}.[take (i{2} + 1) p{2}] = Some (oget PF.m{1}.[x{1}]).`1 /\ 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}.[take (i{1} + 1) p{1} <- ((oget PF.m{1}.[x{1}]).`1, (oget PF.m{1}.[x{1}]).`2)])); - progress;..-3:smt(getP dom_set in_fsetU1 mapP getP). - * by move:H7;rewrite H8/==>[][] _ []_ [] _ [] _ _ _ _ _ _ _ _ _ [] -> _/=;rewrite mapP/=getP/=/#. + progress;..-2:smt(getP dom_set in_fsetU1). + case ((G1.bcol{2} \/ G1.bext{2})). + wp;conseq (_: _ ==> (G1.bcol{2} \/ G1.bext{2}))=> //;progress. by if{1};if{2};auto;2:(swap{2} 4 -3;auto); smt w=(Block.DBlock.dunifin_ll DCapacity.dunifin_ll). From 31918a71a2b846148b5e147e48146cd8c76bb1c6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Wed, 28 Feb 2018 17:38:03 +0100 Subject: [PATCH 262/394] G1(D) ~ CF(D) : completed when greatest common prefix is not counted. --- sha3/proof/smart_counter/Handle.eca | 537 ++++++++++++++++++---------- 1 file changed, 341 insertions(+), 196 deletions(-) diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index 09e8848..72620ae 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -1311,7 +1311,6 @@ cut:=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(in_dom). qed. - (* we should do a lemma to have the equivalence *) @@ -1612,7 +1611,7 @@ proof. case: {-1}(PF.m{1}.[(sa',sc{1})]) (eq_refl (PF.m{1}.[(sa',sc{1})])) Hpf Hmh=>//=. move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. - by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx) H0 Hhx;rewrite H15 !oget_some/=. + by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx) H0 Hhx;rewrite H14 !oget_some/=. * cut->:=take_nth witness i{2} p{2};1:smt(size_take). rewrite build_hpath_prefix H4/=;smt(get_oget). * move:H9 H10;pose sa' := sa{2} +^ nth witness p{2} i{2};move=>H9 H10. @@ -1622,188 +1621,324 @@ proof. case: {-1}(PF.m{1}.[(sa',sc{1})]) (eq_refl (PF.m{1}.[(sa',sc{1})])) Hpf Hmh=>//=. move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. - by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx) H0 Hhx;rewrite H15 !oget_some/=Hhy/#. - * do !split=>//=. - * by cut[]:=. - * by cut[]:=Hhs. - * by cut[]:=Hhs. - * by cut[]:=Hinv. - * by cut[]:=Hinvi. - * by cut[]:=Hmmh. - * by cut[]:=Hmmh. - * by cut[]:=Hmmhi. - * by cut[]:=Hmmhi. - * by cut[]:=Hmh. - * by cut[]:=Hmh. - * by cut[]:=Hmh. - * by cut[]:=Hpi. - * by cut[]:=H. - - rewrite head_nth nth_drop // addz0 => Heq Hbu ????. - rewrite !in_dom. - have -> /= : i{m2} + 1 <> 0 by smt (). - pose sa' := sa{m2} +^ nth witness p{m2} i{m2}. - case (Hmmh) => /(_ sa' sc{m1});case (PF.m{m1}.[(sa', sc{m1})])=> //= -[ya yc] /(_ ya yc) /=. - move=> [hx fx hy fy]; case (Hhs) => Hu _ _ [#] Heq'. - have /= <<- /= Hhy ^? ->:= Hu _ _ _ _ Heq Heq'. - rewrite !oget_some /= => _;split;1: by exists fy. - rewrite (@take_nth witness) 1://. - case (Hmh) => _ -> _;rewrite build_hpath_prefix Hbu /#. - * auto;progress. -move:H3;rewrite H7/=;progress. - rewrite in_dom/=;rewrite in_dom/= in H8. -search None. - cut H_m_mh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. - apply(notin_hs_notin_dom2_mh _ _ H_m_mh). - * smt(DBlock.dunifin_ll DCapacity.dunifin_ll). - * smt(DBlock.dunifin_ll DCapacity.dunifin_ll). - * rewrite getP/=oget_some. - - conseq (_: _ ==> (! (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} /\ - (oget PF.m{1}.[x{1}]).`1 = sa{2} /\ - (exists (f : flag), FRO.m{2}.[h{2}] = Some ((oget PF.m{1}.[x{1}]).`2, f)) /\ - (build_hpath G1.mh (take (i + 1) p) = Some (sa,h)){2} /\ - if i{2} + 1 = 0 then sa{2} = b0 && h{2} = 0 - else F.RO.m{2}.[take (i{2} + 1) p{2}] = Some (oget PF.m{1}.[x{1}]).`1)). - + move=> &m1 &m2 [#] 2!->> ?? H ?? ?????????? H'. - rewrite behead_drop -drop_add //=;split=>[/#|]. - by have := size_drop (i{m2} + 1) p{m2};case (drop (i{m2} + 1) p{m2}) => //= [/#| ];smt w=size_ge0. - case ((G1.bcol{2} \/ G1.bext{2})). - + wp;conseq (_: _ ==> (G1.bcol{2} \/ G1.bext{2}))=> //. - by if{1};if{2};auto;2:(swap{2} 4 -3;auto); smt w=(Block.DBlock.dunifin_ll DCapacity.dunifin_ll). - conseq (_: (x{1} = (sa{1} +^ head witness p{1}, sc{1}) /\ - (p{1} = drop i{2} p{2} /\ - 0 <= i{2} <= size p{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} /\ - ={sa} /\ - (exists (f : flag), FRO.m{2}.[h{2}] = Some (sc{1}, f)) /\ - (build_hpath G1.mh (take i p) = Some (sa,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})) /\ - p{1} <> [] /\ i{2} < size p{2}) /\ - ! (G1.bcol{2} \/ G1.bext{2}) /\ - (mem (dom PF.m) x){1} = (mem (dom G1.mh) (sa +^ nth witness p i, h)){2} ==> _). - + move=> &m1 &m2 [#] 2!->> ?? H ?? ^ /H [#] /= Hinv ->> Hf -> -> ? /= />. - case: Hf=> f Hm; rewrite head_nth nth_drop // addz0 !in_dom. - pose X := sa{m2} +^ nth witness p{m2} i{m2}. - case (Hinv)=> -[Hu _ _] _ _ [] /(_ X sc{m1}) Hpf ^ HG1 /(_ X h{m2}) Hmh _ _ _ _ _. - case: {-1}(PF.m{m1}.[(X,sc{m1})]) (eq_refl (PF.m{m1}.[(X,sc{m1})])) Hpf Hmh. - + case (G1.mh{m2}.[(X, h{m2})]) => //= -[ya hy] Hpf. - by rewrite -negP => /(_ ya hy) [] ????[#];rewrite Hm /= => -[<-];rewrite Hpf. - move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. - rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _. - by have /= <<- -> := Hu _ _ _ _ Hm Hhx. - if{1};[rcondf{2} 1| rcondt{2} 1];1,3:(by auto;smt ());last first. - + auto => /> /= &m1 &m2 ?? [] Hhs Hinv Hinvi Hmmh Hmmhi Hincl Hincli Hmh Hpi f. - rewrite head_nth nth_drop // addz0 => Heq Hbu ????. - rewrite !in_dom. - have -> /= : i{m2} + 1 <> 0 by smt (). - pose sa' := sa{m2} +^ nth witness p{m2} i{m2}. - case (Hmmh) => /(_ sa' sc{m1});case (PF.m{m1}.[(sa', sc{m1})])=> //= -[ya yc] /(_ ya yc) /=. - move=> [hx fx hy fy]; case (Hhs) => Hu _ _ [#] Heq'. - have /= <<- /= Hhy ^? ->:= Hu _ _ _ _ Heq Heq'. - rewrite !oget_some /= => _;split;1: by exists fy. - rewrite (@take_nth witness) 1://. - case (Hmh) => _ -> _;rewrite build_hpath_prefix Hbu /#. - rcondt{2} 5. - + move=> &m;auto=> &hr /> ?? Hinv f. - rewrite head_nth nth_drop // addz0; pose sa' := sa{hr} +^ nth witness p{hr} i{hr}. - move=> ?Hbu????->Hmem ????. - case (Hinv) => ??????? [] H1 H2 H3 ?. - rewrite (@take_nth witness) 1:// -negP in_dom. - pose p' := (take i{hr} p{hr}); pose w:= (nth witness p{hr} i{hr}). - case {-1}(F.RO.m{hr}.[rcons p' w]) (eq_refl (F.RO.m{hr}.[rcons p' w]))=> //. - move=> ? /H2 [???];rewrite Hbu => -[] [!<<-] HG1. - by move: Hmem;rewrite in_dom HG1. - swap{2} 4 -3;auto => &m1 &m2 [#] 2!->?? [] Hhs Hinv Hinvi Hmmh Hmmhi Hincl Hincli Hmh Hpi -> /=. - move=> Hsc Hpa Hif Hdrop Hlt Hbad. - rewrite head_nth nth_drop // addz0; pose sa' := sa{m2} +^ nth witness p{m2} i{m2}. - move=> Heq Hdom y1L-> /= y2L-> /=. - have -> /= : i{m2} + 1 <> 0 by smt (). - rewrite !getP_eq !oget_some /=. - pose p' := (take (i{m2} + 1) p{m2});rewrite/==> [#] ? /=. - split;last first. - + split;1: by exists Unknown. - rewrite /p' (@take_nth witness) 1:// build_hpath_prefix. - exists sa{m2} h{m2}. - rewrite /sa' getP_eq /=;apply build_hpath_up => //. - by move: Hdom;rewrite Heq /sa' in_dom. - have Hy1L := ch_notin_dom2_mh _ _ _ y1L G1.chandle{m2} Hmmhi Hhs. - have := hinvP FRO.m{m2} y2L;rewrite /= => Hy2L. - have g1_sa' : G1.mh{m2}.[(sa', h{m2})] = None by move: Hdom;rewrite Heq in_dom. - case :Hsc => f Hsc; have Hh := dom_hs_neq_ch _ _ _ _ _ Hhs Hsc. - have Hch : FRO.m{m2}.[G1.chandle{m2}] = None. - + case Hhs => _ _ H. - by case {-1}(FRO.m{m2}.[G1.chandle{m2}]) (eq_refl (FRO.m{m2}.[G1.chandle{m2}])) => // ? /H. - have Hy2_mi: ! mem (dom PF.mi{m1}) (y1L, y2L). - + rewrite in_dom;case {-1}( PF.mi{m1}.[(y1L, y2L)]) (eq_refl (PF.mi{m1}.[(y1L, y2L)])) => //. - by move=> [] ??;case Hmmhi=> H _ /H [] ????/#. - have ch_0 := ch_neq0 _ _ Hhs. - have ch_None : - forall xa xb ha hb, G1.mh{m2}.[(xa,ha)] = Some(xb, hb) => - ha <> G1.chandle{m2} /\ hb <> G1.chandle{m2}. - + 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 => // ??/#. - + by apply inv_addm. - + by apply (m_mh_addh_addm f) => //;case Hhs. - + by apply (mi_mhi_addh_addmi f)=> // ??/#. - + by apply incl_upd_nin. - + by apply incl_upd_nin. - + case (Hmh)=> H1 H2 H3;split. - + move=> xa hx ya hy;rewrite getP;case((xa, hx) = (sa', h{m2}))=> [[2!->>] [2!<<-] | Hdiff]. - + exists sc{m1} f y2L Unknown. - rewrite getP_eq getP_neq 1:eq_sym //= Hsc /=. - exists (take i{m2} p{m2}) sa{m2}. - rewrite /p' (@take_nth witness) 1:// /sa' xorwA xorwK xorwC xorw0 getP_eq /=. - by apply build_hpath_up_None. - move=> /H1 [xc fx yc fy] [#] Hhx Hhy Hfy; exists xc fx yc fy. - rewrite !getP_neq. - + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhx). - + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhy). - rewrite Hhx Hhy /=;case: fy Hhy Hfy => //= Hhy [p v [Hro Hpath]]. - exists p v;rewrite getP_neq 1:-negP 1:/p' 1:(@take_nth witness) 1://. - + move => ^ /rconssI <<-;move: Hpath;rewrite Hpa=> -[!<<-] /rconsIs Heq'. - by move:Hdiff=> /=;rewrite /sa' Heq' xorwA xorwK xorwC xorw0. - by rewrite Hro /=;apply build_hpath_up_None. - + move=> p1 bn b; rewrite getP /p' (@take_nth witness) //. - case (rcons p1 bn = rcons (take i{m2} p{m2}) (nth witness p{m2} i{m2})). - + move=> ^ /rconssI ->> /rconsIs ->> /=; split => [<<- | ]. - + exists sa{m2} h{m2} G1.chandle{m2}. - by rewrite /sa' getP_eq /= (build_hpath_up Hpa) //. - move=> [v hx hy []] Heq1;rewrite getP /sa'. - case ((v +^ nth witness p{m2} i{m2}, hx) = (sa{m2} +^ nth witness p{m2} i{m2}, h{m2})) => //. - have := build_hpath_up_None G1.mh{m2} (sa', h{m2}) (y1L, G1.chandle{m2}) _ _ g1_sa' Hpa. - by rewrite Heq1 => -[!->>]. - move=> Hdiff;rewrite H2. - apply exists_iff=> v /= ;apply exists_iff => hx /=;apply exists_iff => hy /=. - have Hhx2 := dom_hs_neq_ch _ _ _ _ _ Hhs Hsc. - rewrite build_hpath_upd_ch_iff //. - case (hx = G1.chandle{m2}) => [->>|?]. - + split;1: by move=> [] _ /ch_None. - move=> [[p0' x [Hhx2']]]. - have [!<<-] [!->>]:= H3 _ _ _ _ _ Hpa Hhx2'. - by rewrite getP_neq /= ?Hhx2 // => /ch_None. - rewrite getP; case ((v +^ bn, hx) = (sa', h{m2})) => //= -[Hsa' ->>]. - rewrite Hsa' g1_sa' /= -negP => [#] Hbu !<<-. - have [!<<-]:= H3 _ _ _ _ _ Hpa Hbu. - move: Hsa'=> /Block.WRing.addrI /#. - move=> p1 v p2 v' hx. - rewrite !build_hpath_upd_ch_iff //. - case (hx = G1.chandle{m2})=> [->> | Hdiff ];2:by apply H3. - by move=> /> ?? Hp1 ?? Hp2;have [!->>] := H3 _ _ _ _ _ Hp1 Hp2. - case (Hpi) => H1;split=> c p1 v1;rewrite H1 => {H1}. - apply exists_iff => h1 /=. rewrite getP build_hpath_upd_ch_iff //. - by case (h1 = G1.chandle{m2}) => [->> /#|]. + by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx) H0 Hhx;rewrite H14 !oget_some/=Hhy/#. + * cut[] a b hab:exists a b, PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1})] = Some (a,b) by + move:H10;rewrite in_dom/#. + cut[]h1 h2 h3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H. + cut->:=take_nth witness i{2} p{2};1:smt(size_take). + rewrite h2 H4/=;exists sa{2} h{2}=>/=;rewrite hab oget_some/=. + cut[]hh1 hh2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H. + cut[]c d e i[]hcd[]hei hG1:=hh1 _ _ _ _ hab. + cut[]hu _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ H. + by cut/=<<-/#:=hu _ _ _ _ H0 hcd. + * split;..-2:case:H=>//=;progress. + split;first cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H;smt(size_take getP size_eq0). + progress;cut[]_ h:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H. + rewrite !getP. + move:H12;rewrite dom_set in_fsetU1. + case(l=take (i{2}+1) p{2})=>//=;last first. + + cut all_pref l_diff l_in_dom:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ H. + cut->/=:take i0 l <> take (i{2} + 1) p{2} by rewrite/#. + cut->/=/#:take (i0+1) l <> take (i{2} + 1) p{2} by rewrite/#. + move=>->>;rewrite!take_take. + cut hii0:i0 <= i{2} by move:H14;rewrite size_take /#. + rewrite!min_lel //1,2:/# nth_take 1,2:/#. + cut->/=:take i0 p{2} <> take (i{2} + 1) p{2} by smt(size_take). + case(i0=i{2})=>//=[->>|i_neq_i0]/=;1: by rewrite H3/=;smt(get_oget). + cut->/=:!take (i0 + 1) p{2} = take (i{2} + 1) p{2} by smt(size_take). + cut:=h _ H6 i0 _;1:smt(size_take). + by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#. + + rcondt{2}5;progress;1:auto;progress. + + cut[]hh1 hh2 hh3 :=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H. + rewrite(@take_nth witness)1:/#in_dom/=. + cut:=hh2 (take i{hr} p{hr}) (nth witness p{hr} i{hr});rewrite H4/=. + cut:=H10;rewrite H9 in_dom/=. + case(F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})] = None)=>//=h. + cut[]b hb:exists b, F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})] = Some b + by move:h;case:(F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})])=>//=/#. + rewrite negb_forall/==>h2;rewrite hb/=;exists b=>//=. + rewrite negb_exists=>v/=. + rewrite negb_exists=>hx/=. + rewrite negb_exists=>hy/=. + case(sa{hr} = v)=>//=->>. + by case(h{hr} = hx)=>//=->>;rewrite h2. + + swap{2}4-3;wp;progress=>/=. + conseq(:_==> hinv FRO.m{2} sc{2} = None + => y1{1} = r{2} + && build_hpath G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- + (r{2}, G1.chandle{2})] (take (i{2} + 1) p{2}) = Some (r{2}, G1.chandle{2}) + && sc{2} = y2{1} + && INV_CF_G1 FRO.m{2}.[G1.chandle{2} <- (sc{2}, Unknown)] (G1.chandle{2} + 1) + PF.m{1}.[x{1} <- (y1{1}, y2{1})] PF.mi{1}.[(y1{1}, y2{1}) <- x{1}] + G1.m{2} G1.mi{2} + G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (r{2}, G1.chandle{2})] + G1.mhi{2}.[(r{2}, G1.chandle{2}) <- (sa{2} +^ nth witness p{2} i{2}, h{2})] + F.RO.m{2}.[take (i{2} + 1) p{2} <- r{2}] G1.paths{2} + Redo.prefixes{1}.[take (i{1} + 1) p{1} <- (y1{1}, y2{1})]);1:smt(getP oget_some). + conseq(:_==> (y1,y2){1} = (r,sc){2});-1:by sim. + move=> &1 &2[][]inv0[][]flag h_flag[]->>[]->>[][]->>->>[]Hi[]. + move=>prefixe_p_i[] hpath[]ro_p_i[];rewrite in_dom prefixe_p_i/==>[][]preifxe_p_i1. + rewrite!negb_or !in_dom/==>[][][]bcol bext h_pf_g1 h_pf b1 c1 b2 c2 []->>->> hinv_none/=. + move:preifxe_p_i1;cut->:=take_nth witness i{2} p{2};1:smt(size_take). + move=>prefixe_p_i1. + split;1:rewrite build_hpath_prefix/=. + * by exists sa{2} h{2};rewrite getP/=;apply build_hpath_up=>//=;smt(in_dom). + cut:=inv0;case. + move=>H_hs_spec H_inv_spec H_inv_spech H_m_mh H_mi_mhi H_incl_m H_incl_mi H_mh_spec H_pi_spec H_m_p h_build_hpath_rcons. + cut:hs_spec FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] (G1.chandle{2}+1) + && inv_spec G1.m{2} G1.mi{2} + && inv_spec G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] + G1.mhi{2}.[(b2, G1.chandle{2}) <- (sa{2} +^ nth witness p{2} i{2}, h{2})] + && m_mh FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] + PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1}) <- (b2, c2)] + G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] + && m_mh FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] + PF.mi{1}.[(b2, c2) <- (sa{2} +^ nth witness p{2} i{2}, sc{1})] + G1.mhi{2}.[(b2, G1.chandle{2}) <- (sa{2} +^ nth witness p{2} i{2}, h{2})] + && incl G1.m{2} PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1}) <- (b2, c2)] + && incl G1.mi{2} PF.mi{1}.[(b2, c2) <- (sa{2} +^ nth witness p{2} i{2}, sc{1})] + && pi_spec FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] + G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] G1.paths{2} + && mh_spec FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] G1.m{2} + G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] + F.RO.m{2}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- b2] + && m_p PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1}) <- (b2, c2)] + Redo.prefixes{1}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- (b2, c2)];last by progress;split=>//. + split. + + apply hs_addh;1:cut//:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. + by cut:=hinvP FRO.m{2} c2;rewrite hinv_none/=/#. + move=>H2_hs_spec;split. + + by cut:=invG_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. + move=>H2_inv_spec;split. + + apply inv_addm=>//;1:cut//:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. + - rewrite/#. + cut hj:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. + cut hs_sp:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. + apply (notin_hs_notin_dom2_mh FRO.m{2} PF.mi{1})=>//=. + by apply ch_notin_dom_hs=>//=. + move=>H2_inv_spech;split. + + cut//=:=(m_mh_addh_addm FRO.m{2} PF.m{1} G1.mh{2} h{2} (sa{2} +^ nth witness p{2} i{2}) sc{1} G1.chandle{2} b2 c2 flag Unknown _ _ _ _);rewrite//. + - by cut[]:=H_hs_spec. + by rewrite ch_notin_dom_hs. + move=>H2_m_mh;split. + + cut->//=:=(mi_mhi_addh_addmi FRO.m{2} PF.mi{1} G1.mhi{2} h{2} (sa{2} +^ nth witness p{2} i{2}) sc{1} G1.chandle{2} b2 c2 flag Unknown _ _ _ _);rewrite//. + - by cut/#:=hinvP FRO.m{2} c2. + by rewrite ch_notin_dom_hs. + move=>H2_mi_mhi;split. + + move=>x;rewrite getP/=. + by cut:=H_incl_m (sa{2} +^ nth witness p{2} i{2}, sc{1});smt(in_dom). + move=>H2_incl_m;split. + + move=>x;rewrite getP/=. + cut/#:G1.mi{2}.[(b2, c2)] = None;move=>{x}. + cut help//=:=hinvP FRO.m{2} c2. + rewrite hinv_none/= in help. + cut->//=:=notin_m_notin_Gm _ _ (b2,c2) H_incl_mi. + cut/#:forall a b, PF.mi{1}.[(b2,c2)] <> Some (a,b). + move=>a b;move:help;apply absurd=>//=;rewrite negb_forall//=. + cut[] inv1 inv2 hab:=H_mi_mhi. + by cut/#:=inv1 _ _ _ _ hab. + cut :=h_pf_g1;rewrite h_pf/=eq_sym neqF/==>h_g1. + move=>H2_incl_mi;split. print mh_spec. search pi_spec. + + (* pi_spec *) + split;progress. + - cut[]h:=H_pi_spec;cut:=h c p0 v;rewrite H/==>[][]h1[] h'1 h'2. + exists h1;rewrite -h'2 getP/=. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h'2. + by apply build_hpath_up=>//=. + move:H0;rewrite getP/==>hh0. + cut h0_neq_ch:h0 <> G1.chandle{2} by rewrite/#. + cut[]->:=H_pi_spec;rewrite-hh0 h0_neq_ch/=;exists h0=>/=. search build_hpath None. + cut:=H;cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v h0. + rewrite h_g1/=H/=h0_neq_ch/=. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. + by cut->/=->//=:=ch_neq0 _ _ H_hs_spec;progress;cut[]hh1 hh2 hh3:=H_mh_spec;smt(dom_hs_neq_ch). + move=>H2_pi_spec;split. + + (* mh_spec *) + (* cut: *) + (* (forall (xa : block) (hx : handle) (ya : block) (hy : handle), *) + (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})].[( *) + (* xa, hx)] = Some (ya, hy) => *) + (* exists (xc : capacity) (fx : flag) (yc : capacity) (fy : flag), *) + (* FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)].[hx] = Some (xc, fx) /\ *) + (* FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)].[hy] = Some (yc, fy) /\ *) + (* if fy = Known then G1.m{2}.[(xa, xc)] = Some (ya, yc) /\ fx = Known *) + (* else *) + (* exists (p1 : block list) (v : block), *) + (* F.RO.m{2}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- b2].[ *) + (* rcons p1 (v +^ xa)] = Some ya /\ build_hpath *) + (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- *) + (* (b2, G1.chandle{2})] p1 = Some (v, hx)) *) + (* && *) + (* (forall (p1 : block list) (v : block) (p2 : block list) (v' : block) (hx : handle), *) + (* build_hpath *) + (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) + (* p1 = Some (v, hx) => *) + (* build_hpath *) + (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) + (* p2 = Some (v', hx) => p1 = p2 /\ v = v') *) + (* && *) + (* (forall (p1 : block list) (bn b : block), *) + (* F.RO.m{2}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- b2].[rcons p1 bn] = *) + (* Some b <=> *) + (* exists (v : block) (hx hy : handle), build_hpath *) + (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] p1 = *) + (* Some (v, hx) /\ *) + (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})].[(v +^ bn, hx)] = Some (b, hy)); *) + (* last by progress;split=>/#. *) + split=>//=. + - move=>x hx y hy;rewrite !getP. + case((x, hx) = (sa{2} +^ nth witness p{2} i{2}, h{2}))=>//=. + * move=>[->> ->>][<<- <<-]/=. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. + rewrite h_flag/=. + exists sc{1} flag c2 Unknown=>//=. + by exists (take i{2} p{2}) (sa{2})=>//=;rewrite getP Block.WRing.addKr/=;apply build_hpath_up=>//=/#. + move=> neq h1. + cut[]hh1 hh2 hh3:=H_mh_spec. + cut[]xc hxx yc hyc []h2[]h3 h4:=hh1 _ _ _ _ h1. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h2. + cut->/=:=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 getP. + cut->/=:=build_hpath_up _ _ _ b2 G1.chandle{2} _ _ _ hb h_g1. + cut/#:!rcons p0 (b +^ x) = rcons (take i{2} p{2}) (nth witness p{2} i{2});move:neq;apply absurd=>//=h'. + cut<<-:take i{2} p{2}=p0 by rewrite/#. + cut hbex:b +^ x = nth witness p{2} i{2} by rewrite/#. + by cut:=hb;rewrite hpath/==>[][->>->>]/=;rewrite-hbex Block.WRing.addKr/=. + (* move=>hh1;split. *) + (* - progress. search build_hpath Some. *) + + + - progress. search build_hpath. + * move:H;rewrite getP/=. + case(p0 = (take i{2} p{2}))=>[->>|hpp0]. search build_hpath None. + + cut->/=:=build_hpath_up _ _ _ b2 G1.chandle{2} _ _ _ hpath h_g1. + case(bn = (nth witness p{2} i{2}))=>[->>/=->>|hbni]/=. + - by exists sa{2} h{2} G1.chandle{2}=>//=;rewrite getP/=. + cut->/=:!rcons (take i{2} p{2}) bn = rcons (take i{2} p{2}) (nth witness p{2} i{2}). + - move:hbni;apply absurd=>//=h. + cut->:bn = nth witness (rcons (take i{2} p{2}) bn) i{2}. + * by rewrite nth_rcons size_take /#. + by rewrite h nth_rcons size_take /#. + move=>h_ro_p_bn. + cut[]_ hh4 _:=H_mh_spec. + by cut:=hh4 (take i{2} p{2}) bn b;rewrite h_ro_p_bn/=hpath/=;smt(getP @Block.WRing). + cut->/=:!rcons p0 bn = rcons (take i{2} p{2}) (nth witness p{2} i{2}). + + move:hpp0;apply absurd=>/=h. + cut:size p0 = size (take i{2} p{2}) by smt(size_rcons). + move:h;pose p' := take i{2} p{2};pose e := nth witness p{2} i{2}. + by move=>h h';move:p0 p' h' bn e h;apply seq2_ind=>//=/#. + move=>h_ro_p_bn. + cut[]_ hh4 _:=H_mh_spec. + cut:=hh4 p0 bn b;rewrite h_ro_p_bn/==>[][];progress. + cut help:(sa{2} +^ nth witness p{2} i{2}, h{2}) <> (v +^ bn, hx) by rewrite/#. + exists v hx hy=>//=;rewrite getP;rewrite eq_sym in help;rewrite help/=H0/=. + by apply build_hpath_up=>//=. + move:H H0;rewrite!getP=>h_build_hpath_set. + case(hy = G1.chandle{2})=>//=[->>|hy_neq_ch]/=. + + move=>h;cut h_eq:v +^ bn = sa{2} +^ nth witness p{2} i{2} && hx = h{2}. + + cut/#:G1.mh{2}.[(v +^ bn, hx)] <> Some (b, G1.chandle{2}). search hs_spec. + cut[]_ hh2:=H_m_mh. + cut:=hh2 (v +^ bn) hx b G1.chandle{2}. + case(G1.mh{2}.[(v +^ bn, hx)] = Some (b, G1.chandle{2}))=>//=. + rewrite negb_exists/=;progress; + rewrite negb_exists/=;progress; + rewrite negb_exists/=;progress; + rewrite negb_exists/=;progress;rewrite !negb_and. + by cut[]/#:=H_hs_spec. + cut[]eq_xor ->>:=h_eq. + move:h;rewrite h_eq/==>->>. + cut/#:!(p0 = (take i{2} p{2}) /\ bn = (nth witness p{2} i{2})) => + F.RO.m{2}.[rcons p0 bn] = Some b. + move:h_flag;case:flag=>h_flag;last first. + - cut:=known_path_uniq _ _ _ sc{1} h{2} p0 v (take i{2} p{2}) sa{2} H2_pi_spec _ h_build_hpath_set _. + * rewrite getP/=h_flag. + by cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. search build_hpath. + * by apply build_hpath_up=>//=. + move=>[]->>->>/=;smt(@Block.WRing). + + cut[]hh1 hh2 hh3:=H_mh_spec. + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b p0 v h{2}. + rewrite h_build_hpath_set/=h_g1/=. + cut->/=:=ch_neq0 _ _ H_hs_spec. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. + move=>help;cut:= 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=>//=. + by cut:=hh3 _ _ _ _ _ hpath h_build_hpath_p0;smt(@Block.WRing). + + move=>help;cut h_neq:! (v +^ bn = sa{2} +^ nth witness p{2} i{2} && hx = h{2}) by rewrite/#. + move:help;rewrite h_neq/==>h_g1_v_bn_hx. + cut[]hh1 hh2 hh3:=H_mh_spec. + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. + rewrite h_build_hpath_set/=h_g1/=. + cut->/=:=ch_neq0 _ _ H_hs_spec. + by cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag;smt(dom_hs_neq_ch). + + progress. + + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p' v' hx. + rewrite H H0/=. + cut->/=:=ch_neq0 _ _ H_hs_spec. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. + rewrite h_g1/=. + by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). + + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p' v' hx. + rewrite H H0/=. + cut->/=:=ch_neq0 _ _ H_hs_spec. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. + rewrite h_g1/=. + by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). + + move=>H2_mh_spec;split;progress. + + by cut[]:=H_m_p;smt(getP size_rcons size_eq0 size_ge0). + move:H;rewrite dom_set in_fsetU1. + case(l \in dom Redo.prefixes{1})=>//=hdom. + + cut[]_ h:=H_m_p. + cut[]sa' sc'[]h_pref h_pref2:=h _ hdom i0 _;1:rewrite/#. + exists sa' sc';rewrite!getP/=. + cut->/=:!take i0 l = rcons (take i{2} p{2}) (nth witness p{2} i{2}) by smt(in_dom). + rewrite h_pref/=. + cut->/=:!take (i0 + 1) l = rcons (take i{2} p{2}) (nth witness p{2} i{2}) by smt(in_dom take_size). + rewrite-h_pref2/=. + by cut->/=:! (sa' +^ nth witness l i0 = sa{2} +^ nth witness p{2} i{2} && sc' = sc{1}) by smt(in_dom take_size). + move=>->>;case(i0=i{2})=>[->>|i0_neq_i]//=. + + exists sa{2} sc{1}=>//=;rewrite!getP/=. + move:H1;rewrite !size_rcons !size_take//. + rewrite!nth_rcons-take_nth// !take_take!size_take 1:/#. + cut->/=hii:i{2}< size p{2} by rewrite/#. + rewrite !min_lel 1,2:/#. + by cut->/=:! take i{2} p{2} = take (i{2} + 1) p{2} by smt(size_take). + move:H1;rewrite !size_rcons !size_take//1:/#. + rewrite!nth_rcons-take_nth// !take_take!size_take 1:/#. + cut->/=hii:i{2}< size p{2} by rewrite/#. + rewrite i0_neq_i/=!min_lel 1,2:/#. + cut->/=:i0 < i{2} by rewrite/#. + rewrite!getP. + cut->/=:! take i0 p{2} = take (i{2} + 1) p{2} by smt(size_take). + cut[]_ h_pref:=H_m_p. + cut[]:= h_pref (take i{2} p{2}) _ i0 _;1:smt(in_dom);1:smt(size_take). + move=>b3 c3;rewrite!take_take!min_lel 1,2:/#=>[][]-> h. + cut->/=:!take (i0 + 1) p{2} = take (i{2} + 1) p{2} by smt(size_take). + exists b3 c3=>//=;rewrite getP/=. + cut/#:!(b3 +^ nth witness (take i{2} p{2}) i0 = sa{2} +^ nth witness p{2} i{2} && + c3 = sc{1}). + cut:(b3 +^ nth witness (take i{2} p{2}) i0, c3) \in dom PF.m{1};2:smt(in_dom). + cut:take (i0 + 1) p{2} \in dom Redo.prefixes{1};2:smt(in_dom). + cut->:take (i0 + 1) p{2} = take (i0 + 1) (take i{2} p{2});1:smt(take_take). + smt(in_dom take_oversize). qed. section AUX. - declare module D : DISTINGUISHER {PF, RO, G1}. + declare module D : DISTINGUISHER {PF, RO, G1, Redo}. axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): islossless P.f => islossless P.fi => islossless F.f => @@ -1815,7 +1950,8 @@ section AUX. proc. call (_: G1.bcol \/ G1.bext, 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}). + G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} + G1.paths{2} Redo.prefixes{1}). (* lossless D *) + exact/D_ll. (** proofs for G1.S.f *) @@ -1826,14 +1962,14 @@ section AUX. /\ 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} + F.RO.m{2} G1.paths{2} Redo.prefixes{1} ==> !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}). + F.RO.m{2} G1.paths{2} Redo.prefixes{1}). + by move=> &1 &2; rewrite negb_or. + by move=> &1 &2 _ ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? [#]; rewrite negb_or. (* For now, everything is completely directed by the syntax of @@ -1844,12 +1980,12 @@ section AUX. 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}, + F.RO.m{2}, G1.paths{2}, Redo.prefixes{1}, x{2}. - elim * => hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 [] x1 x2. + elim * => hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref [] 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) - (eq_refl (INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0)); last first. + case @[ambient]: {-1}(INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref) + (eq_refl (INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref)); 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. @@ -1871,11 +2007,12 @@ section AUX. /\ G1mhi = G1.mhi{2} /\ ro0 = F.RO.m{2} /\ pi0 = G1.paths{2} + /\ pref = Redo.prefixes{1} /\ (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). + /\ INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref). + by auto. case @[ambient]: {-1}(getflag hs0 x2) (eq_refl (getflag hs0 x2)). + rewrite getflagP_none => x2f_notin_rng_hs0; rcondt{2} 3. @@ -1928,13 +2065,14 @@ section AUX. /\ G1mhi = G1.mhi{2} /\ ro0 = F.RO.m{2} /\ pi0 = G1.paths{2} + /\ pref = Redo.prefixes{1} /\ (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). + /\ INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref). + auto=> &1 &2 /> _ -> /= _; split. + move: x2_is_K; rewrite in_rng /= => -[hx2] hs_hx2. rewrite in_rng negb_exists /==> h; rewrite -negP=> hs_h. @@ -1983,7 +2121,7 @@ section AUX. rewrite !getP_eq pi_x2 !oget_some /=. have /hs_of_INV [] Hu _ _:= inv0; have -> := huniq_hinvK_h _ _ _ Hu hs_hx2. rewrite oget_some => /= ? Hy2L . - case:inv0=> Hhs Hinv HinvG Hmmh Hmmhi Hincl Hincli Hmh Hpi. + 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) /=. @@ -2060,6 +2198,11 @@ section AUX. rewrite build_hpath_upd_ch_iff // getP;case (h = ch0) => [->> | //]. split;1: by move=> [_ /(dom_hs_neq_ch _ _ _ _ _ Hhs)]. by move=> /= [_ <<-];move:Hc. + split. + by cut[]/#:=Hmp. + cut[]_ h l hdom i hi:=Hmp. + cut[]b c[]->h':=h l hdom i hi. + by exists b c=>//=;rewrite getP/=-h';smt(in_dom take_oversize). move=> [xa xc] PFm_x1x2. rcondf{1} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom PFm_x1x2. have /m_mh_of_INV [] + _ - /(_ _ _ _ _ PFm_x1x2) := inv0. @@ -2095,7 +2238,7 @@ section AUX. rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. + by have /hs_of_INV []:= inv0. rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //= => _. - exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). + exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). (* lossless PF.f *) + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. smt (@Block.DBlock @Capacity.DCapacity). @@ -2119,8 +2262,9 @@ section AUX. + proc. inline*;sp. admit. (* this is false *) (* lossless PF.C.f *) - + move=> &2 _; proc; inline *; while (true) (size p); auto. - + sp; if; 2:by auto; smt (size_behead). + + move=> &2 _; proc; inline *; 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 *) @@ -2132,20 +2276,21 @@ section AUX. by auto; smt (@Block.DBlock @Capacity.DCapacity). (* Init ok *) inline *; auto=> />; split=> [|/#]. - (do !split; last 3 smt (getP map0P build_hpath_map0)); last 5 by move=> ? ? ? ?; rewrite map0P. + (do !split; -5..-2: smt (getP map0P build_hpath_map0)); -6..-2: by move=> ? ? ? ?; rewrite map0P. + move=> h1 h2 ? ?; rewrite !getP !map0P. by case: (h1 = 0); case: (h2 = 0)=> //=. + by rewrite getP. + by move=> ? h; rewrite getP map0P; case: (h = 0). + by move=> ? ?; rewrite !map0P. - by move=> ? ?; rewrite !map0P. + + by move=> ? ?; rewrite !map0P. + by move=>l;rewrite dom_set in_fsetU1 dom0 in_fset0/==>->>/=/#. qed. end section AUX. section. - declare module D: DISTINGUISHER{Perm, C, PF, G1, RO}. + declare module D: DISTINGUISHER{Perm, C, PF, G1, RO, Redo}. axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): islossless P.f => islossless P.fi => From 7a7a6b89d92d552ac1bf1c7340ad53f8f2829bed Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Wed, 28 Feb 2018 18:23:42 +0100 Subject: [PATCH 263/394] killing last admit in Handle.eca --- sha3/proof/smart_counter/Handle.eca | 65 +++++++++++++++++------------ 1 file changed, 39 insertions(+), 26 deletions(-) diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index 72620ae..37bd14d 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -44,7 +44,9 @@ module G1(D:DISTINGUISHER) = { } i <- i + 1; } - sa <- F.RO.get(p); + if (p <> []) { + sa <- F.RO.get(p); + } return sa; } } @@ -1446,7 +1448,7 @@ qed. -equiv PFf_Cf (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1(D).C.f : +equiv PFf_Cf_not_nil (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1(D).C.f : ! (G1.bcol{2} \/ G1.bext{2}) /\ ={p} /\ p{1} <> [] /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} @@ -1459,13 +1461,18 @@ proof. seq 1 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} /\ + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} /\ ={sa} /\ F.RO.m.[p]{2} = Some sa{1})));last first. + case : (! (G1.bcol{2} \/ G1.bext{2})); - 2: by conseq (_:_ ==> true)=> //; inline *;auto;rewrite Block.DBlock.dunifin_ll. - inline *; rcondf{2} 3. - + by move=> &m;auto=> &hr [#] H /H[_ H1] ??;rewrite in_dom H1. - by auto=> /> &m1 &m2;rewrite Block.DBlock.dunifin_ll /= => H /H [-> ->];rewrite oget_some. + 2: conseq (_:_ ==> true)=> //; inline *;auto;progress. + + if{2};1:rcondf{2} 3;auto;progress. + + smt(in_dom). + + smt(Block.DBlock.dunifin_ll). + + rewrite/#. + + rewrite/#. + + rewrite/#. + + rewrite/#. + if{2};auto;progress;smt(Block.DBlock.dunifin_ll). while ( ={p, i} /\ (0 <= i <= size p){2} /\ (Redo.prefixes.[take i p]{1} = Some (sa,sc){1}) /\ (take i p \in dom Redo.prefixes){1} /\ @@ -1485,11 +1492,11 @@ proof. progress. + rewrite/#. + smt(size_eq0 size_ge0 take_size). + + smt(size_eq0 size_ge0 take_size). if{1}. + case : (! (G1.bcol{2} \/ G1.bext{2}));last first. + wp;conseq(:_==> (G1.bcol{2} \/ G1.bext{2}));1:smt(get_oget). by inline*;if{2};auto;smt(DCapacity.dunifin_ll DBlock.dunifin_ll). - conseq(: ={p, i, sa} /\ 0 <= i{2} < size p{2} /\ Redo.prefixes{1}.[take i{1} p{1}] = Some (sa{1}, sc{1}) @@ -1572,8 +1579,7 @@ proof. Redo.prefixes{1}.[take (i{1} + 1) p{1} <- ((oget PF.m{1}.[x{1}]).`1, (oget PF.m{1}.[x{1}]).`2)])); progress;..-2:smt(getP dom_set in_fsetU1). - - case ((G1.bcol{2} \/ G1.bext{2})). + case ((G1.bcol{2} \/ G1.bext{2})). + wp;conseq (_: _ ==> (G1.bcol{2} \/ G1.bext{2}))=> //;progress. by if{1};if{2};auto;2:(swap{2} 4 -3;auto); smt w=(Block.DBlock.dunifin_ll DCapacity.dunifin_ll). conseq(:INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} @@ -1601,7 +1607,6 @@ proof. move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. print huniq. by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx)H8 Hhx;rewrite H11. - if{1};2:(rcondt{2}1; first by auto=>/#);1:(rcondf{2}1;first by auto=>/#);last first. + auto;progress. * move:H9 H10;pose sa' := sa{2} +^ nth witness p{2} i{2};move=>H9 H10. @@ -1648,7 +1653,6 @@ proof. cut->/=:!take (i0 + 1) p{2} = take (i{2} + 1) p{2} by smt(size_take). cut:=h _ H6 i0 _;1:smt(size_take). by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#. - rcondt{2}5;progress;1:auto;progress. + cut[]hh1 hh2 hh3 :=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H. rewrite(@take_nth witness)1:/#in_dom/=. @@ -1663,7 +1667,6 @@ proof. rewrite negb_exists=>hy/=. case(sa{hr} = v)=>//=->>. by case(h{hr} = hx)=>//=->>;rewrite h2. - swap{2}4-3;wp;progress=>/=. conseq(:_==> hinv FRO.m{2} sc{2} = None => y1{1} = r{2} @@ -1808,10 +1811,6 @@ proof. cut<<-:take i{2} p{2}=p0 by rewrite/#. cut hbex:b +^ x = nth witness p{2} i{2} by rewrite/#. by cut:=hb;rewrite hpath/==>[][->>->>]/=;rewrite-hbex Block.WRing.addKr/=. - (* move=>hh1;split. *) - (* - progress. search build_hpath Some. *) - - - progress. search build_hpath. * move:H;rewrite getP/=. case(p0 = (take i{2} p{2}))=>[->>|hpp0]. search build_hpath None. @@ -1859,7 +1858,6 @@ proof. by cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. search build_hpath. * by apply build_hpath_up=>//=. move=>[]->>->>/=;smt(@Block.WRing). - cut[]hh1 hh2 hh3:=H_mh_spec. cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b p0 v h{2}. rewrite h_build_hpath_set/=h_g1/=. @@ -1871,7 +1869,6 @@ proof. exists v h{2}=>//=. rewrite eq_xor h_g1/=;move:h_neq;apply absurd=>//=. by cut:=hh3 _ _ _ _ _ hpath h_build_hpath_p0;smt(@Block.WRing). - move=>help;cut h_neq:! (v +^ bn = sa{2} +^ nth witness p{2} i{2} && hx = h{2}) by rewrite/#. move:help;rewrite h_neq/==>h_g1_v_bn_hx. cut[]hh1 hh2 hh3:=H_mh_spec. @@ -1879,7 +1876,6 @@ proof. rewrite h_build_hpath_set/=h_g1/=. cut->/=:=ch_neq0 _ _ H_hs_spec. by cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag;smt(dom_hs_neq_ch). - progress. + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p' v' hx. @@ -1888,7 +1884,6 @@ proof. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. rewrite h_g1/=. by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p' v' hx. rewrite H H0/=. @@ -1896,7 +1891,6 @@ proof. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. rewrite h_g1/=. by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). - move=>H2_mh_spec;split;progress. + by cut[]:=H_m_p;smt(getP size_rcons size_eq0 size_ge0). move:H;rewrite dom_set in_fsetU1. @@ -1936,6 +1930,22 @@ proof. smt(in_dom take_oversize). qed. + +equiv PFf_Cf (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1(D).C.f : + ! (G1.bcol{2} \/ G1.bext{2}) /\ + ={p} /\ + 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} ==> + ! (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}. +proof. +exists*p{1};elim* =>input;case(input = [])=>input_nil;1:rewrite input_nil;2:conseq(PFf_Cf_not_nil D);progress. +proc;inline*;auto;sp. +by rcondf{1}1;auto;rcondf{2}1;auto;rcondf{2}1;auto. +qed. + + section AUX. declare module D : DISTINGUISHER {PF, RO, G1, Redo}. @@ -2258,9 +2268,8 @@ section AUX. + move=> _; proc; if; 2:by auto. by wp; do 2!rnd predT; auto => &hr [#]; smt (@Block.DBlock @Capacity.DCapacity). (** proofs for G1.C.f *) - (* equiv PF.C.f G1.C.f *) - + proc. - inline*;sp. admit. (* this is false *) + (* equiv PF.C.f G1.C.f *) + + conseq(PFf_Cf D);auto;progress. (* lossless PF.C.f *) + move=> &2 _; proc; inline *; while (true) (size p - i); auto. + if; 1:auto=>/#. @@ -2268,7 +2277,11 @@ section AUX. 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; rnd predT; auto. + + move=> _; proc; inline *; wp. + case(p = [])=>//=. + - by sp;rcondf 1;auto;sp;rcondf 1;auto. + rcondt 6;first by auto;while(p <> []);auto;sp;if;auto. + wp;rnd predT; auto. while (G1.bcol \/ G1.bext) (size p - i)=> [z|]. + if; 1:by auto=> /#. wp; rnd predT; wp; rnd predT; auto. From aafea8aeb289ca20b8c36ea42e8b51d8abb98b59 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 1 Mar 2018 11:27:08 +0100 Subject: [PATCH 264/394] An empty list as input was a problem, now it's not. --- sha3/proof/smart_counter/Handle.eca | 186 +++++++++++++++++++++++++-- sha3/proof/smart_counter/SLCommon.ec | 2 +- 2 files changed, 177 insertions(+), 11 deletions(-) diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index 37bd14d..4045341 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -44,9 +44,7 @@ module G1(D:DISTINGUISHER) = { } i <- i + 1; } - if (p <> []) { - sa <- F.RO.get(p); - } + sa <- F.RO.get(p); return sa; } } @@ -1448,7 +1446,146 @@ qed. -equiv PFf_Cf_not_nil (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1(D).C.f : +module G1'(D:DISTINGUISHER) = { + + module C = { + + proc f(p : block list): block = { + var sa, sa', sc; + var h, i <- 0; + sa <- b0; + sc <- c0; + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + sc <$ cdistr; + G1.bcol <- G1.bcol \/ hinv FRO.m sc <> None; + 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; + } + i <- i + 1; + } + if (p <> []) { + sa <- F.RO.get(p); + } + return sa; + } + } + + module S = { + + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2; + + if (!mem (dom G1.m) x) { + if (mem (dom G1.paths) x.`2) { + (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); + G1.bext <- G1.bext \/ mem (rng FRO.m) (x.`2, Unknown); + if (!(mem (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 (mem (dom G1.mh) (x.`1, hx2) /\ 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 { + G1.bcol <- G1.bcol \/ hinv FRO.m y.`2 <> None; + 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 (mem (dom G1.paths) x.`2) { + (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 (!mem (dom G1.mi) x) { + G1.bext <- G1.bext \/ mem (rng FRO.m) (x.`2, Unknown); + if (!(mem (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 <$ cdistr; + y <- (y1,y2); + if (mem (dom G1.mhi) (x.`1,hx2) /\ + 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 { + G1.bcol <- G1.bcol \/ hinv FRO.m y.`2 <> None; + 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 <- map0; + G1.m <- map0; + G1.mi <- map0; + G1.mh <- map0; + G1.mhi <- map0; + G1.bext <- false; + G1.bcol <- false; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + FRO.m <- map0.[0 <- (c0, Known)]; + G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.chandle <- 1; + b <@ D(C,S).distinguish(); + return b; + } +}. + + + +equiv PFf_Cf_not_nil (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1'(D).C.f : ! (G1.bcol{2} \/ G1.bext{2}) /\ ={p} /\ p{1} <> [] /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} @@ -1931,7 +2068,7 @@ proof. qed. -equiv PFf_Cf (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1(D).C.f : +equiv PFf_Cf (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1'(D).C.f : ! (G1.bcol{2} \/ G1.bext{2}) /\ ={p} /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} @@ -1954,7 +2091,7 @@ section AUX. islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. - equiv CF_G1 : CF(D).main ~ G1(D).main: + equiv CF_G1' : CF(D).main ~ G1'(D).main: ={glob D} ==> !(G1.bcol \/ G1.bext){2} => ={res}. proof. proc. @@ -2260,7 +2397,16 @@ section AUX. smt (@Block.DBlock @Capacity.DCapacity). (** proofs for G1.S.fi *) (* equiv PF.P.fi G1.S.fi *) - + by conseq (eq_fi D)=> /#. + + transitivity G1(D).S.fi + (! (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} + ==> ! (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}) + (={glob G1(D).S, x} ==> ={glob G1(D).S, res});progress;1:rewrite/#. + - by conseq (eq_fi D)=> /#. + by proc;inline*;sim. (* lossless PF.P.fi *) + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. smt (@Block.DBlock @Capacity.DCapacity). @@ -2297,8 +2443,9 @@ section AUX. + by move=> ? ?; rewrite !map0P. + by move=> ? ?; rewrite !map0P. by move=>l;rewrite dom_set in_fsetU1 dom0 in_fset0/==>->>/=/#. -qed. + qed. + end section AUX. section. @@ -2309,6 +2456,25 @@ section. islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. + local equiv CF_G1 : + CF(DRestr(D)).main ~ G1(DRestr(D)).main: + ={glob D, glob C} ==> !(G1.bcol \/ G1.bext){2} => ={res}. + proof. + transitivity G1'(DRestr(D)).main + (={glob D, glob C} ==> !(G1.bcol \/ G1.bext){2} => ={res}) + (={glob D, glob C} ==> ={res, glob G1(D)});progress;1:rewrite/#. + + by conseq(CF_G1' (DRestr(D)) (DRestr_ll D D_ll));progress. + proc;inline*;auto;sp. + call(: ={glob G1, glob C} /\ [] \in dom C.queries{1});auto;last first. + + smt(dom_set in_fsetU1). + + by proc;inline*;sp;if;auto;conseq(:_==> ={y0, glob G1, glob C});progress;sim. + + by proc;inline*;sp;if;auto;conseq(:_==> ={y0, glob G1, glob C});progress;sim. + proc;inline*;sp;if;auto;if;1,3:auto. + rcondt{1}8;first by auto;while(p <> []);auto;1:(sp;if);auto=>/#. + by wp 12 12;conseq(:_==> ={b, glob G1, glob C});1:smt(dom_set in_fsetU1);sim. + qed. + + lemma Real_G1 &m: Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= Pr[G1(DRestr(D)).main() @ &m: res] + (max_size ^ 2)%r * inv 2%r * mu dstate (pred1 witness) + @@ -2318,12 +2484,12 @@ section. cut : Pr[CF(DRestr(D)).main() @ &m : res] <= Pr[G1(DRestr(D)).main() @ &m : res] + Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext]. - + byequiv (CF_G1 (DRestr(D)) _)=>//;1:by apply (DRestr_ll D D_ll). + + byequiv (CF_G1)=>//. smt ml=0. cut /# : 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]. - rewrite Pr [mu_or]; smt. + 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 index d0629e5..97ba58a 100644 --- a/sha3/proof/smart_counter/SLCommon.ec +++ b/sha3/proof/smart_counter/SLCommon.ec @@ -849,7 +849,7 @@ module C = { var queries : (block list, block) fmap proc init () = { c <- 0; - queries <- map0; + queries <- map0.[[] <- b0]; } }. From a2e942a6d08854a3835d1a885d705fce3f4e96b6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Mon, 12 Mar 2018 17:53:24 +0100 Subject: [PATCH 265/394] Strong_rp_rf added --- sha3/proof/smart_counter/ConcreteF.eca | 38 +- sha3/proof/smart_counter/Gcol.eca | 82 ++- sha3/proof/smart_counter/Gconcl.ec | 52 +- sha3/proof/smart_counter/Gext.eca | 246 +++++---- sha3/proof/smart_counter/Handle.eca | 10 +- sha3/proof/smart_counter/SLCommon.ec | 35 +- sha3/proof/smart_counter/Strong_rp_rf.eca | 604 ++++++++++++++++++++++ 7 files changed, 871 insertions(+), 196 deletions(-) create mode 100644 sha3/proof/smart_counter/Strong_rp_rf.eca diff --git a/sha3/proof/smart_counter/ConcreteF.eca b/sha3/proof/smart_counter/ConcreteF.eca index beff777..4d4a963 100644 --- a/sha3/proof/smart_counter/ConcreteF.eca +++ b/sha3/proof/smart_counter/ConcreteF.eca @@ -3,7 +3,7 @@ require import List FSet NewFMap Utils Common SLCommon DProd Dexcepted. (*...*) import Capacity IntOrder RealOrder. -require (*..*) Strong_RP_RF. +require (*..*) Strong_rp_rf. module PF = { var m, mi: (state,state) fmap @@ -50,7 +50,7 @@ section. local module GReal' = Indif(FC(SqueezelessSponge(Perm)), PC(Perm), D). - local clone import Strong_RP_RF as Switching with + local clone import Strong_rp_rf as Switching with type D <- state, op uD <- dstate, type K <- unit, @@ -95,7 +95,7 @@ section. call (_: ={glob C, glob P, glob Redo} /\ all_prefixes Redo.prefixes{2} /\ Redo.prefixes{2}.[[]] = Some (b0,c0) - /\ dom C.queries{2} <= dom Redo.prefixes{2} + /\ dom C.queries{2} \subset dom Redo.prefixes{2} /\ prefixe_inv C.queries{2} Redo.prefixes{2} /\ DBounder.FBounder.c{2} = C.c{2}). + proc; sp; if=> //=; inline *. @@ -113,7 +113,7 @@ section. 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} - /\ dom query{2} <= dom Redo.prefixes{2} + /\ dom query{2} \subset dom 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 dom pref{1} => pref{1}.[y] = Redo.prefixes{1}.[y]) @@ -124,7 +124,7 @@ section. 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) - /\ dom query{2} <= dom Redo.prefixes{2} + /\ dom query{2} \subset dom Redo.prefixes{2} /\ (i{1} < size p{1} => ! take (i{1} + 1) p{1} \in dom Redo.prefixes{1}) /\ 0 <= prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= i{1} <= size bs{1} /\ C.c{1} <= max_size @@ -137,7 +137,7 @@ section. sp;rcondt{2}1;1:auto=>/#;auto;1:call(:true);auto;progress. * move=>x;rewrite dom_set in_fsetU1=>[][|-> j];1:smt(in_fsetU1). case(0 <= j)=>hj0;last first. - + by rewrite (take_le0 j)1:/# in_fsetU1 in_dom H0//=. + + by rewrite (@take_le0 j)1:/# in_fsetU1 in_dom H0//=. rewrite take_take in_fsetU1/min/#. * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). @@ -154,7 +154,7 @@ section. sp; conseq(:_==> ={sa, Redo.prefixes, glob P, i, C.c, p, sc, bs} /\ p{1} = bs{1} /\ Redo.prefixes{2} = pref{2} - /\ dom query{2} <= dom Redo.prefixes{2} + /\ dom query{2} \subset dom Redo.prefixes{2} /\ C.c{1} <= max_size /\ i{1} = prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) /\ Redo.prefixes{1}.[take i{1} bs{1}] = Some (sa{1},sc{1}) @@ -165,18 +165,18 @@ section. + move:H8=>[]//=[]j [[hj0 hjsize] htake]. rewrite htake. apply take_get_max_prefixe2=>//=;1:smt(in_dom memE). - by rewrite-(prefixe_exchange _ _ _ H2 H). + by rewrite-(@prefixe_exchange _ _ _ H2 H). 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} - /\ dom query{2} <= dom Redo.prefixes{2} + /\ dom query{2} \subset dom Redo.prefixes{2} /\ C.c{2} <= max_size /\ i{1} = prefixe bs{1} (get_max_prefixe bs{1} (elems (dom 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} - /\ dom query{2} <= dom Redo.prefixes{2} + /\ dom query{2} \subset dom Redo.prefixes{2} /\ prefixe_inv C.queries{2} Redo.prefixes{2} /\ all_prefixes Redo.prefixes{2} /\ C.c{2} <= max_size @@ -187,11 +187,11 @@ section. /\ DBounder.FBounder.c{2} = k{2}). + rcondt{1}1;2:rcondt{2}1;auto;progress. * by rewrite/#. - * by rewrite(prefixe_exchange _ _ bs{2} H0 H1)all_take_in//=/#. + * by rewrite(@prefixe_exchange _ _ bs{2} H0 H1)all_take_in//=/#. * smt(get_oget in_dom). auto;progress. smt(prefixe_ge0). * apply take_get_max_prefixe2=>//=;1:smt(in_dom memE). - by rewrite-(prefixe_exchange _ _ _ H2 H). + by rewrite-(@prefixe_exchange _ _ _ H2 H). * smt(get_oget in_dom). * smt(@Prefixe). auto;call(:true);auto;smt(dom0 in_fset0 dom_set in_fsetU1 getP oget_some). @@ -253,7 +253,7 @@ section. * by rewrite/#. * move:H3 H7;rewrite take_size dom_set in_fsetU1 getP;case(bs0 = bs{2})=>//=[->|]h. * by rewrite h oget_some/=. - * move:H=>[?[??]];move=>? ?. + * move:H=>[H []];progress. by rewrite -H4;1:smt(take_size);rewrite H//=. * smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0). * smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop). @@ -274,12 +274,12 @@ section. * cut:=H7 (take (i{m0}+1) p{m0}). case((take (i{m0} + 1) p{m0} \in dom Redo.prefixes{m0}))=>//=_. rewrite negb_or negb_exists/=;progress. - + by rewrite memE prefixe_lt_size//=-(prefixe_exchange _ _ p{m0} H1 H0)//=/#. + + by rewrite memE prefixe_lt_size//=-(@prefixe_exchange _ _ p{m0} H1 H0)//=/#. case(0<=a<=i{m0})=>//=ha;smt(size_take). * cut:=H7 (take (i{hr}+1) p{hr}). case((take (i{hr} + 1) p{hr} \in dom Redo.prefixes{hr}))=>//=_. rewrite negb_or negb_exists/=;progress. - + by rewrite memE prefixe_lt_size//=-(prefixe_exchange _ _ p{hr} H1 H0)//=/#. + + by rewrite memE prefixe_lt_size//=-(@prefixe_exchange _ _ p{hr} H1 H0)//=/#. case(0<=a<=i{hr})=>//=ha;smt(size_take). sp;auto;if;auto;progress. @@ -294,7 +294,7 @@ section. * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). * rewrite!getP/=. cut/#: !take (i{2} + 1) p{2} \in dom pref{2}. - by rewrite memE prefixe_lt_size//=-(prefixe_exchange _ _ _ H1 H0)//=/#. + by rewrite memE prefixe_lt_size//=-(@prefixe_exchange _ _ _ H1 H0)//=/#. * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). @@ -308,7 +308,7 @@ section. * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). * rewrite!getP/=. cut/#: !take (i{2} + 1) p{2} \in dom pref{2}. - by rewrite memE prefixe_lt_size//=-(prefixe_exchange _ _ _ H1 H0)//=/#. + by rewrite memE prefixe_lt_size//=-(@prefixe_exchange _ _ _ H1 H0)//=/#. * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). conseq(:_==> ={sa,sc,Perm.m,Perm.mi,Redo.prefixes,i,p} @@ -329,7 +329,7 @@ section. /\ 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_prefixe (<=) take mem. - * rewrite(prefixe_inv_leq _ _ _ _ _ _ H H7 H0)//= 1:/#. + * rewrite(@prefixe_inv_leq _ _ _ _ _ _ H H7 H0)//= 1:/#. cut:=H0=>[][h1 [h2 h3]]. cut:=h3 _ _ _ H7;last smt(memE). smt(size_eq0 size_take). @@ -357,7 +357,7 @@ section. + proc; while true (size p - i)=> //=. * move=> z; wp;if;auto; 2:call p_ll; auto=>/#. by auto; smt w=size_ge0. - apply (ler_trans _ _ _ + 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[PRPt.IND(PRPi.PRPi,DBounder(D')).main() @ &m: res]. diff --git a/sha3/proof/smart_counter/Gcol.eca b/sha3/proof/smart_counter/Gcol.eca index fcc397c..1d7a678 100644 --- a/sha3/proof/smart_counter/Gcol.eca +++ b/sha3/proof/smart_counter/Gcol.eca @@ -38,7 +38,7 @@ section PROOF. proc sample_c () = { var c=c0; if (card (image fst (rng FRO.m)) <= 2*max_size /\ - count < max_size) { + count < max_size /\ ! G1.bcol /\ ! G1.bext) { c <$ cdistr; G1.bcol <- G1.bcol \/ mem (image fst (rng FRO.m)) c; count <- count + 1; @@ -191,38 +191,53 @@ section PROOF. by rewrite in_rng;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 (rng 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 (rng FRO.m)));skip;progress;2:smt ml=0. + cut->:=(Mu_mem.mu_mem (image fst (rng 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 G1col : 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}/\ + 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 (rng 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. - seq 2 2 : (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, - C.c,x0} /\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card(rng FRO.m) + 2 <= 2*C.c + 1/\ - Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. - if=>//;last by auto=>/#. + + proc;sp 1 1;if=>//;inline G1(DRestr(D)).S.f Gcol.S.f;swap -3. + sp;if;1,3:auto=>/#. swap{1}[3..5]-2. seq 3 2:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, - C.c,x0,hx2} /\ + C.c,C.queries,x0,hx2} /\ (G1.bcol{1} => G1.bcol{2}) /\ - (card (rng FRO.m) + 1 <= 2 * C.c + 1/\ + (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ Gcol.count + 1 <= C.c <= max_size){2}). + auto;smt ml=0 w=card_rng_set. seq 2 2: (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, - C.c,x0,hx2,y0} /\ + C.c,C.queries,x0,hx2,y0} /\ ((G1.bcol\/hinv FRO.m y0.`2 <> None){1} => G1.bcol{2}) /\ (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ - Gcol.count <= C.c <= max_size){2});last by auto;smt ml=0 w=card_rng_set. + Gcol.count <= C.c <= max_size){2});last by auto;smt ml=0 w=card_rng_set. wp;if=>//;inline Gcol.sample_c. + rcondt{2}4. - + auto;conseq (_:true)=>//;progress;2: smt ml=0. + + auto;conseq (_:true)=>//;progress;2: smt ml=0. by cut /#:= fcard_image_leq fst (rng FRO.m{hr}). wp;conseq (_: ={p,v,F.RO.m,y1} /\ y2{1}=c{2})=>//;1:smt ml=0 w=hinv_image. by sim. @@ -231,22 +246,22 @@ section PROOF. auto;progress;smt w=hinv_image. + proc;sp 1 1;if=>//. - inline G1(DRestr(D)).S.fi Gcol.S.fi. + 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,x0} /\ + C.c,C.queries,x0} /\ (G1.bcol{1} => G1.bcol{2}) /\ (card(rng FRO.m) + 2 <= 2*C.c + 1 /\ Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. if=>//;last by auto=>/#. seq 3 2:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, - C.c,x0,hx2} /\ + C.c,C.queries,x0,hx2} /\ (G1.bcol{1} => G1.bcol{2}) /\ (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ Gcol.count + 1 <= C.c <= max_size){2}). + by 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,x0,hx2,y0,y1,y2} /\ y0{1} = (y1,y2){1} /\ + 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 (rng FRO.m) + 1 <= 2 * C.c + 1 /\ Gcol.count <= C.c <= max_size){2});2:by auto;smt w=card_rng_set. @@ -256,11 +271,11 @@ section PROOF. (* BUG: auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | H]. marche pas ???? *) auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | X];right;apply hinv_image=> //. - + proc;sp 1 1;if=>//. - inline G1(DRestr(D)).C.f Gcol.C.f. + + proc;sp 1 1;if=>//;2:auto;sp;if=>//. + inline G1(DRestr(D)).C.f Gcol.C.f. sp. seq 5 5: - (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c,b, - p,h,i,sa} /\ i{1}=0 /\ + (={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} /\ i{1}=0 /\ (G1.bcol{1} => G1.bcol{2}) /\ card (rng FRO.m{2}) + 2*(size p{2}) <= 2 * C.c{2} + 1 /\ Gcol.count{2} + size p{2} <= C.c{2} <= max_size);1:by auto=>/#. @@ -283,27 +298,6 @@ section PROOF. by apply max_ge0. 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 (rng 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 (rng FRO.m)));skip;progress;2:smt ml=0. - cut->:=(Mu_mem.mu_mem (image fst (rng FRO.m{hr})) cdistr (1%r/(2^c)%r) _). - + move=>x _; rewrite DWord.dunifin1E;do !congr;exact cap_card. - 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. - lemma Pr_G1col &m: Pr[G1(DRestr(D)).main() @ &m : G1.bcol] <= max_size%r * ((2*max_size)%r / (2^c)%r). proof. diff --git a/sha3/proof/smart_counter/Gconcl.ec b/sha3/proof/smart_counter/Gconcl.ec index bf80aed..9356a7f 100644 --- a/sha3/proof/smart_counter/Gconcl.ec +++ b/sha3/proof/smart_counter/Gconcl.ec @@ -65,7 +65,7 @@ module S(F : DFUNCTIONALITY) = { section. -declare module D: DISTINGUISHER{C, Perm, F.RO, F.FRO,S }. +declare module D: DISTINGUISHER{C, Perm, F.RO, F.FRO, S, Redo}. local clone import Gext as Gext0. local module G3(RO:F.RO) = { @@ -201,19 +201,19 @@ local module G3(RO:F.RO) = { 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}); last by auto. + 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=> //. - call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c});2: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} /\ + 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}); + 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} + + 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 ((mem (dom G1.mh) (x.`1, hx2) /\ t){1}); @@ -230,11 +230,11 @@ proof. rewrite Block.DBlock.supp_dunifin DCapacity.dunifin_ll /==> ?_?->. by rewrite !getP /= oget_some. - + proc;sp;if=>//. - call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c});2: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: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} + 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 ((mem (dom G1.mhi) (x.`1, hx2) /\ t){1}); @@ -244,8 +244,8 @@ proof. wp;rnd;auto;progress[-split];rewrite DCapacity.dunifin_ll /= => ?_?->. by rewrite !getP /= oget_some. - proc;sp;if=>//. - call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c});2:by auto. + 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 F.LRO.sample;sim. qed. @@ -325,21 +325,21 @@ local module G4(RO:F.RO) = { 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});last by auto. - + proc;sp;if=>//. - call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. + 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});1:by sim. - sim;seq 5 0: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c});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. + 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=>//. - call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});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 5 0: (={x,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by inline *;auto. - seq 3 3: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by 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=>//. - call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by 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. by sim;inline *;auto;progress;apply DCapacity.dunifin_ll. @@ -349,9 +349,9 @@ local equiv G4_Ideal : G4(F.LRO).distinguish ~ IdealIndif(IF,S,DRestr(D)).main : ={glob D} ==> ={res}. proof. proc;inline *;wp. - call (_: ={C.c,F.RO.m} /\ G1.m{1}=S.m{2} /\ G1.mi{1}=S.mi{2} /\ G1.paths{1}=S.paths{2}). + 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=>//. + + 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=>/#. @@ -367,7 +367,7 @@ axiom D_ll : 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)%r * mu dstate (pred1 witness) + + (max_size ^ 2)%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. diff --git a/sha3/proof/smart_counter/Gext.eca b/sha3/proof/smart_counter/Gext.eca index 2182665..5e485f2 100644 --- a/sha3/proof/smart_counter/Gext.eca +++ b/sha3/proof/smart_counter/Gext.eca @@ -277,6 +277,7 @@ section. (* **************** *) inline *;auto;progress. + auto;inline*;auto;progress. by move:H;rewrite dom_set dom0 !inE=>->. qed. @@ -284,7 +285,7 @@ end section. section EXT. - declare module D: DISTINGUISHER{C, PF, G1, G2, Perm, RO }. + declare module D: DISTINGUISHER{C, PF, G1, G2, Perm, RO, Redo}. local module ReSample = { var count:int @@ -488,7 +489,7 @@ section EXT. proof. rewrite !sizeE dom_rem fcardD;case (mem (dom m) x)=> Hx. + by rewrite subset_fsetI_id 2:fcard1// => z;rewrite !inE. - by rewrite (eq_fcards0 (_ `&` _)) 2:// fset0_eqP=>z;rewrite !inE /#. + by rewrite (@eq_fcards0 (dom m `&` fset1 x)) 2:// fset0_eqP=>z;rewrite !inE /#. qed. lemma size_rem_le (m:('a,'b)fmap) x : size (rem x m) <= size m. @@ -508,102 +509,6 @@ section EXT. rewrite restr_set /=;smt w=(size_set_le size_rem_le). 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} /\ size G1.m{2} <= max_size /\ - size G1.mi{2} <= max_size /\ - ReSample.count{2} + size l{2} <= max_size /\ - ((G1.bext{1} \/ - exists (x : state) (h : handle), - mem (dom G1.m{1} `|` dom 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 getP;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} /\ - inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}). - + proc;sp;if=> //. - 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 9 : (={x, y, 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});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} /\ - 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} /\ - 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.in_dom; wp;call (_: ={FRO.m});1:by sim. - inline RRO.restrK;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=(sizeE size_ge0). - rcondt{2} 10. by auto;progress;rewrite dom_set !inE. - wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. - rewrite/Distr.is_lossless (sampleto_ll 0)/= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. - 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=> //. - 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.in_dom; auto;call (_: ={FRO.m});1:by sim. - inline RRO.restrK;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=(sizeE size_ge0). - rcondt{2} 10. by auto;progress;rewrite dom_set !inE. - wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. - rewrite/Distr.is_lossless (sampleto_ll 0) /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. - 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=>//. - inline G2(DRestr(D), RRO).C.f Gext.C.f. - sp 5 5;elim *=> c0L c0R. - wp;call (_: ={F.RO.m});1:by sim. - while (={i,p,G1.mh,sa,h,FRO.m,F.RO.m,G1.mh,G1.mhi,G1.chandle} /\ 0 <= i{1} <= size p{1}/\ - c0R + size p{1} <= max_size /\ - inv_le G1.m{2} G1.mi{2} (c0R + i){2} FRO.m{2} ReSample.count{2}); - last by auto;smt w=List.size_ge0. - if=> //;1:by auto=>/#. - auto;call (_: ={F.RO.m});1:by sim. - inline *;auto=> ?&mr [#]!->@/inv_le Hi [#]. - case (p{mr})=> [/#|/=p1 p2] 4?_ /= 2?-> /=;split=>/= Hmem 4? [#]2->/= => [|/#]. - by rewrite restr_set /= size_set dom_restr /in_dom_with Hmem/= /#. - - auto;progress[delta];rewrite ?(size0,restr0,restr_set,rem0,max_ge0,-sizeE,-cardE) //=. - + smt ml=0. + smt ml=0. + smt ml=0. - + elim H7=>// [[x h] [#]];rewrite -memE dom_restr /in_dom_with in_dom=> _ ->/=. - by rewrite oget_some. - apply H10=>//. - 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). @@ -644,6 +549,149 @@ section EXT. move=> b1 c1;proc;auto=> /#. qed. + local equiv EG2_Gext : Eager(G2(DRestr(D))).main2 ~ Gext.distinguish: + ={glob D} ==> + ((G1.bext{1} \/ inv_ext G1.m{1} G1.mi{1} FRO.m{1}) => + ReSample.count{2} <= max_size /\ G1.bext{2}). + proof. + proc;inline *;wp;sp. + swap{1}[2..3]2;swap{2}2 2;wp. print inv_ext. + while (={l,G1.m,G1.mi} + /\ ((!G1.bext{1} /\ forall (x : state) (h : handle), + !mem (dom G1.m{1} `|` dom G1.mi{1}) x \/ + FRO.m{1}.[h] <> Some (x.`2, Unknown) \/ mem l{1} h) => + ={FRO.m} + /\ size G1.m{2} <= max_size /\ size G1.mi{2} <= max_size + /\ ReSample.count{2} + size l{2} <= max_size) + /\ ((G1.bext{1} \/ exists (x : state) (h : handle), + mem (dom G1.m{1} `|` dom G1.mi{1}) x /\ + FRO.m{1}.[h] = Some (x.`2, Unknown) /\ !mem l{1} h) => + G1.bext{2})). + + case(G1.bext{1} \/ exists (x1 : state) (h0 : handle), + (x1 \in dom G1.m{1} `|` dom G1.mi{1}) /\ + FRO.m{1}.[h0] = Some (x1.`2, Unknown) /\ ! (h0 \in l{1}))=>//=. + auto;progress. + + move:H3;rewrite H9/==>[][]a b. + cut[->//=|[|]]:=H10 a b. + + rewrite getP;case(b = head witness l{2})=>[->>|hb->//=]/=. + by rewrite-(@mem_head_behead witness)//. + by move=>h;cut->//=:=mem_drop _ _ _ h. + + rewrite size_drop//=. + cut/#:=H _;rewrite H9/==>x h. + cut:=H10 x h;rewrite getP/==>[][->|[|]]//=. + + case(h=head witness l{2})=>[->>|hb->//=]/=. + by rewrite-(@mem_head_behead witness)//. + by move=>h2;cut->//=:=mem_drop _ _ _ h2. + + by cut->:=H0 H3. + + admit. + + admit. + + admit. + + admit. + + admit. + + admit. + + admit. +(* 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 getP;case (h=h1)=> [/=->Hin->_ | Hneq ???]. *) +(* + by right;apply (@mem_image snd _ x). *) +(* by rewrite Hext 2://;right;exists x h;rewrite Hneq. *) +(* conseq(:_==> (={l,FRO.m,G1.m,G1.mi} /\ *) +(* size G1.m{2} <= max_size /\ *) +(* size G1.mi{2} <= max_size /\ *) +(* ReSample.count{2} + size l{2} <= max_size /\ *) +(* ((G1.bext{1} \/ *) +(* exists (x : state) (h : handle), *) +(* mem (dom G1.m{1} `|` dom G1.mi{1}) x /\ *) +(* FRO.m{1}.[h] = Some (x.`2, Unknown) /\ !mem l{1} h) => *) +(* G1.bext{2})));1:progress=>/#;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.in_dom; wp;call (_: ={FRO.m});1:by sim. *) +(* inline RRO.restrK;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=(sizeE size_ge0). *) +(* rcondt{2} 10. by auto;progress;rewrite dom_set !inE. *) +(* wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. *) +(* rewrite/Distr.is_lossless (sampleto_ll 0)/= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. *) +(* 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,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 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,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.mhi.[(x.`1, hx2)]).`2 Unknown){1}). *) +(* + inline RRO.in_dom; auto;call (_: ={FRO.m});1:by sim. *) +(* inline RRO.restrK;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=(sizeE size_ge0). *) +(* rcondt{2} 10. by auto;progress;rewrite dom_set !inE. *) +(* wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. *) +(* rewrite/Distr.is_lossless (sampleto_ll 0) /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. *) +(* 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=>//. *) +(* inline G2(DRestr(D), RRO).C.f Gext.C.f. *) +(* sp 5 5;elim *=> c0L c0R. *) +(* wp;call (_: ={F.RO.m});1:by sim. *) +(* while (={i,p,G1.mh,sa,h,FRO.m,F.RO.m,G1.mh,G1.mhi,G1.chandle} /\ 0 <= i{1} <= size p{1}/\ *) +(* c0R + size p{1} - prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= max_size /\ *) +(* inv_le G1.m{2} G1.mi{2} (c0R + i){2} FRO.m{2} ReSample.count{2}); *) +(* last first. *) +(* + auto;progress. *) +(* admit. *) +(* admit. *) +(* admit. *) +(* admit. *) +(* admit. *) +(* (* - smt(size_ge0) *) *) +(* (* by auto;smt(List.size_ge0 @Prefixe). *) *) +(* (* if=> //;1:by auto=>/#. *) *) +(* (* auto;call (_: ={F.RO.m});1:by sim. *) *) +(* (* inline *;auto=> ?&mr [#]!->@/inv_le Hi [#]. *) *) +(* (* case (p{mr})=> [/#|/=p1 p2] 4?_ /= 2?-> /=;split=>/= Hmem 4? [#]2->/= => [|/#]. *) *) +(* (* by rewrite restr_set /= size_set dom_restr /in_dom_with Hmem/= /#. *) *) + +(* auto;progress[delta];rewrite ?(size0,restr0,restr_set,rem0,max_ge0,-sizeE,-cardE) //=. *) +(* + smt ml=0. + smt ml=0. + smt ml=0. *) +(* + elim H7=>// [[x h] [#]];rewrite -memE dom_restr /in_dom_with in_dom=> _ ->/=. *) +(* by rewrite oget_some. *) +(* apply H10=>//. *) + qed. + axiom D_ll: forall (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}), islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. @@ -651,7 +699,7 @@ section EXT. 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)%r * mu dstate (pred1 witness) + + (max_size ^ 2)%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. diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index 4045341..ebb10c2 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -2477,8 +2477,9 @@ section. lemma Real_G1 &m: Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= - Pr[G1(DRestr(D)).main() @ &m: res] + (max_size ^ 2)%r * inv 2%r * mu dstate (pred1 witness) + - Pr[G1(DRestr(D)).main() @&m: G1.bcol] + Pr[G1(DRestr(D)).main() @&m: G1.bext]. + Pr[G1(DRestr(D)).main() @ &m: res] + + (max_size ^ 2)%r * inv 2%r * mu dstate (pred1 witness) + + Pr[G1(DRestr(D)).main() @&m: G1.bcol \/ G1.bext]. proof. apply (@RealOrder.ler_trans _ _ _ (Real_Concrete D D_ll &m)). cut : Pr[CF(DRestr(D)).main() @ &m : res] <= @@ -2486,10 +2487,7 @@ section. Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext]. + byequiv (CF_G1)=>//. smt ml=0. - cut /# : 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]. - rewrite Pr [mu_or]; smt(Distr.mu_bounded). + smt ml=0. qed. end section. diff --git a/sha3/proof/smart_counter/SLCommon.ec b/sha3/proof/smart_counter/SLCommon.ec index 97ba58a..0de9947 100644 --- a/sha3/proof/smart_counter/SLCommon.ec +++ b/sha3/proof/smart_counter/SLCommon.ec @@ -603,7 +603,7 @@ qed. lemma prefixe_inv_nil queries prefixes : prefixe_inv queries prefixes => - elems (dom queries) = [] => dom prefixes <= fset1 []. + elems (dom queries) = [] => dom prefixes \subset fset1 []. proof. move=>[h1 [h2 h3]] h4 x h5;rewrite in_fset1. cut:=h3 x (size x). @@ -635,7 +635,7 @@ proof. move=>[h1[h2 h3]] h5. case(elems (dom queries) = [])=>//=h4;2:smt(aux_prefixe_exchange). cut h6:=prefixe_inv_nil queries prefixes _ h4;1:rewrite/#. -rewrite h4/=. search FSet.(<=). +rewrite h4/=. case(elems (dom prefixes) = [])=>//=[->//=|]h7. cut h8:elems (dom prefixes) = [[]]. + cut [hh1 hh2]:[] \in dom prefixes /\ forall x, x \in elems (dom prefixes) => x = [] by smt(memE). @@ -650,6 +650,37 @@ by rewrite h8=>//=. qed. +pred all_prefixes_fset (prefixes : block list fset) = + forall bs, bs \in prefixes => forall i, take i bs \in prefixes. + +pred inv_prefixe_block (queries : (block list, block) fmap) + (prefixes : (block list, block) fmap) = + (forall (bs : block list), + bs \in dom queries => queries.[bs] = prefixes.[bs]) && + (forall (bs : block list), + bs \in dom queries => forall i, take i bs \in dom prefixes). + +lemma prefixe_gt0_mem l (ll : 'a list list) : + 0 < prefixe l (get_max_prefixe l ll) => + get_max_prefixe 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(prefixe l1 l2 < prefixe l1 l3)=>//=/#. +qed. + +lemma inv_prefixe_block_mem_take queries prefixes l i : + inv_prefixe_block queries prefixes => + 0 <= i < prefixe l (get_max_prefixe l (elems (dom queries))) => + take i l \in dom prefixes. +proof. +move=>[]H_incl H_all_prefixes Hi. +rewrite (prefixe_take_leq _ (get_max_prefixe l (elems (dom queries))))1:/#. +rewrite H_all_prefixes. +cut:get_max_prefixe l (elems (dom queries)) \in dom queries;2:smt(in_dom). +by rewrite memE;apply prefixe_gt0_mem=>/#. +qed. + (* lemma prefixe_inv_prefixe queries prefixes l : *) (* prefixe_inv queries prefixes => *) (* all_prefixes prefixes => *) diff --git a/sha3/proof/smart_counter/Strong_rp_rf.eca b/sha3/proof/smart_counter/Strong_rp_rf.eca new file mode 100644 index 0000000..99d42fe --- /dev/null +++ b/sha3/proof/smart_counter/Strong_rp_rf.eca @@ -0,0 +1,604 @@ +(* -------------------------------------------------------------------- + * Copyright (c) - 2012--2016 - IMDEA Software Institute + * Copyright (c) - 2012--2018 - Inria + * Copyright (c) - 2012--2018 - Ecole Polytechnique + * + * Distributed under the terms of the CeCILL-B-V1 license + * -------------------------------------------------------------------- *) + +require import AllCore Distr List FSet NewFMap StdRing StdOrder. +require import Dexcepted. +require (*--*) NewPRP StrongPRP IdealPRP FelTactic. +(*---*) import RField RealOrder. + +(** We assume a finite domain D, equipped with its uniform + distribution. **) +type D. +op uD: { D distr | is_uniform uD /\ is_lossless uD /\ is_full uD } as uD_uf_fu. + +(** and a type K equipped with a lossless distribution **) +type K. +op dK: { K distr | is_lossless dK } as dK_ll. + +clone import StrongPRP as PRPt with + type K <- K, + op dK <- dK, + type D <- D +proof * by smt ml=0 w=dK_ll +rename "StrongPRP_" as "". + +clone import IdealPRP as PRPi with + type K <- K, + op dK <- dK, + type D <- D, + op dD <- uD +proof * by smt ml=0 w=(dK_ll uD_uf_fu) +rename "RandomPermutation" as "PRPi". + +(* This is an "Almost (Random Permutation)" (the Almost applies to Permutation) *) +(* We keep track of collisions explicitly because it's going to be useful anyway *) +module ARP = { + var coll : bool + var m, mi: (D,D) fmap + + proc init(): unit = { + m <- map0; + mi <- map0; + coll <- false; + } + + proc f(x : D) = { + var y; + + if (!mem (dom m) x) { + y <$ uD; + coll <- coll \/ mem (rng m) y; + m.[x] <- y; + mi.[y] <- x; + } + return oget m.[x]; + } + + proc fi(y : D) = { + var x; + + if (!mem (dom mi) y) { + x <$ uD; + coll <- coll \/ mem (rng mi) x; + m.[x] <- y; + mi.[y] <- x; + } + return oget mi.[y]; + } +}. + +op q : { int | 0 <= q } as ge0_q. + +(** To factor out the difficult step, we parameterize the PRP by a + procedure that samples its output, and provide two instantiations + of it. **) +module type Sample_t = { + proc sample(X:D fset): D +}. + +module Direct = { + proc sample(X:D fset): D = { + var r; + + r = $uD \ (mem X); + return r; + } +}. + +module Indirect = { + proc sample(X:D fset): D = { + var r; + + r = $uD; + if (mem X r) { + r = $uD \ (mem X); + } + return r; + } +}. + +module PRPi'(S:Sample_t) = { + proc init = PRPi.init + + proc f(x:D): D = { + if (!mem (dom PRPi.m) x) { + PRPi.m.[x] = S.sample(rng PRPi.m); + PRPi.mi.[oget PRPi.m.[x]] <- x; + } + return oget PRPi.m.[x]; + } + + proc fi(x:D): D = { + if (!mem (dom PRPi.mi) x) { + PRPi.mi.[x] = S.sample(rng PRPi.mi); + PRPi.m.[oget PRPi.mi.[x]] <- x; + } + return oget PRPi.mi.[x]; + } +}. + +(* Some losslessness lemmas *) +(* FIXME: cleanup *) + +(* FIXME: Duplicate lemmas with RP_RF *) +lemma nosmt notin_supportIP (P : 'a -> bool) (d : 'a distr): + (exists a, support d a /\ !P a) <=> mu d P < mu d predT. +proof. +rewrite (mu_split _ predT P) /predI /predT /predC /=. +rewrite (exists_eq (fun a => support d a /\ !P a) (fun a => !P a /\ a \in d)) /=. ++ by move=> a /=; rewrite andbC. +by rewrite -(witness_support (predC P)) -/(predC _) /#. +qed. + +lemma excepted_lossless (m:(D,D) fmap): + (exists x, !mem (dom m) x) => + mu (uD \ (mem (rng m))) predT = 1%r. +proof. +move=> /endo_dom_rng [x h]; rewrite dexcepted_ll //. ++ smt w=uD_uf_fu. +have [?[<- @/is_full Hsupp]]:= uD_uf_fu. +apply/notin_supportIP;exists x => />;apply Hsupp. +qed. + +phoare Indirect_ll: [Indirect.sample: exists x, support uD x /\ !mem X x ==> true] = 1%r. +proof. +proc; seq 1: (exists x, support uD x /\ !mem X x)=> //=. ++ by rnd (predT); skip; smt ml=0 w=uD_uf_fu. +if=> //=. ++ rnd (predT); skip. + by progress [-split]; split=> //=; smt. +by hoare; rnd=> //=; skip=> &hr ->. +qed. + +lemma PRPi'_Indirect_f_ll: islossless PRPi'(Indirect).f. +proof. +proc; if=> //=; auto; call Indirect_ll. +skip=> /> &hr x_notin_m. +have [x0] x0_notinr_m := endo_dom_rng PRPi.m{hr} _; first by exists x{hr}. +by exists x0; rewrite x0_notinr_m /=; smt w=uD_uf_fu. +qed. + +lemma PRPi'_Indirect_fi_ll: islossless PRPi'(Indirect).fi. +proof. +proc; if=> //=; auto; call Indirect_ll. +skip=> /> &hr x_notin_mi. +have [x0] x0_notinr_mi := endo_dom_rng PRPi.mi{hr} _; first by exists x{hr}. +by exists x0; rewrite x0_notinr_mi; smt w=uD_uf_fu. +qed. + +(** The proof is cut into 3 parts (sections): + - We first focus on proving + Pr[IND(PRPi'(Indirect),D).main() @ &m: res] + <= Pr[IND(PRFi,D).main() @ &m: res] + + Pr[IND(PRFi,D).main() @ &m: collision PRFi.m]. + - Second, we concretely bound (when the PRF oracle stops + answering queries after the q-th): + Pr[IND(PRFi,D).main() @ &m: collision PRFi.m] + <= q^2 * Pr[x = $uD: x = witness] + - We conclude by proving (difficult!) + Pr[IND(PRPi,D).main() @ &m: res] + = Pr[IND(PRPi'(Indirect),D).main() @ &m: res]. + + Purists are then invited to turn the security statement about + restricted oracles into a security statement about restricted + adversaries. **) +section Upto. + declare module D:Distinguisher {PRPi, ARP}. + axiom D_ll (O <: Oracles {D}): islossless O.f => islossless O.fi => islossless D(O).distinguish. + + local module PRP_indirect_bad = { + var bad : bool + + proc init(): unit = { + PRPi.init(); + bad <- false; + } + + proc sample(X:D fset): D = { + var r; + + r = $uD; + if (mem X r) { + bad <- true; + r = $uD \ (mem X); + } + return r; + } + + proc f(x:D): D = { + if (!mem (dom PRPi.m) x) { + PRPi.m.[x] = sample(rng PRPi.m); + PRPi.mi.[oget PRPi.m.[x]] <- x; + } + return oget PRPi.m.[x]; + } + + proc fi(y:D): D = { + if (!mem (dom PRPi.mi) y) { + PRPi.mi.[y] = sample(rng PRPi.mi); + PRPi.m.[oget PRPi.mi.[y]] <- y; + } + return oget PRPi.mi.[y]; + } + }. + + local lemma PRPi'_Indirect_eq &m: + Pr[IND(PRPi'(Indirect),D).main() @ &m: res] + = Pr[IND(PRP_indirect_bad,D).main() @ &m: res]. + proof. by byequiv=> //=; proc; inline *; sim. qed. + + (** Upto failure: if a collision does not occur in PRFi.m, then the + programs are equivalent **) + lemma pr_PRPi'_Indirect_ARP &m: + `|Pr[IND(PRPi'(Indirect),D).main() @ &m: res] + - Pr[IND(ARP,D).main() @ &m: res]| + <= Pr[IND(ARP,D).main() @ &m: ARP.coll]. + proof. + rewrite (PRPi'_Indirect_eq &m). + byequiv: PRP_indirect_bad.bad=> //=; 2:smt ml=0. + proc. + call (_: ARP.coll, + !PRP_indirect_bad.bad{1} /\ ={m,mi}(PRPi,ARP), + (PRP_indirect_bad.bad{1} <=> ARP.coll{2})). + + exact D_ll. + + proc. if=> //=; inline *. + swap{1} 1. + seq 1 4: (={x} /\ + !mem (dom PRPi.m{1}) x{1} /\ + ARP.m{2} = PRPi.m.[x <- r]{1} /\ + ARP.mi{2} = PRPi.mi.[r <- x]{1} /\ + ((PRP_indirect_bad.bad \/ mem (rng PRPi.m) r){1} <=> ARP.coll{2})). + by auto=> /#. + sp; if{1}. + conseq (_: PRP_indirect_bad.bad{1} /\ ARP.coll{2})=> //=. + auto; progress [-split]; split=> //= [|_]; 1:smt. + by progress; right. + by auto; progress [-split]; rewrite H0 /=; split=> //=; rewrite getP. + + move=> &2 bad; conseq (_: true ==> true: =1%r) + (_: PRP_indirect_bad.bad ==> PRP_indirect_bad.bad)=> //=. + by proc; if=> //=; inline *; seq 2: PRP_indirect_bad.bad; [auto|if=> //=; auto]. + proc; if=> //=; inline *. + seq 2: (X = rng PRPi.m /\ !mem (dom PRPi.m) x) 1%r 1%r 0%r _ => //=. + by auto; rewrite -/predT; smt ml=0 w=uD_uf_fu. (* predT should be an abbreviation *) + by if=> //=; auto; smt. + by hoare; auto. + + move=> &1. + proc; if; auto; progress [-split]; rewrite -/predT; split=> //= [|_]; 1:smt ml=0 w=uD_uf_fu. + by progress [-split]; rewrite H. + + proc. if=> //=; inline *. + swap{1} 1. + seq 1 4: (={y} /\ + !mem (dom PRPi.mi{1}) y{1} /\ + ARP.m{2} = PRPi.m.[r <- y]{1} /\ + ARP.mi{2} = PRPi.mi.[y <- r]{1} /\ + ((PRP_indirect_bad.bad \/ mem (rng PRPi.mi) r){1} <=> ARP.coll{2})). + by auto=> /#. + sp; if{1}. + conseq (_: PRP_indirect_bad.bad{1} /\ ARP.coll{2})=> //=. + auto; progress [-split]; split=> //= [|_]; 1:smt. + by progress; right. + by auto; progress [-split]; rewrite H0 /=; split=> //=; rewrite getP. + + move=> &2 bad; conseq (_: true ==> true: =1%r) + (_: PRP_indirect_bad.bad ==> PRP_indirect_bad.bad)=> //=. + by proc; if=> //=; inline *; seq 2: PRP_indirect_bad.bad; [auto|if=> //=; auto]. + proc; if=> //=; inline *. + seq 2: (X = rng PRPi.mi /\ !mem (dom PRPi.mi) y) 1%r 1%r 0%r _ => //=. + by auto; rewrite -/predT; smt ml=0 w=uD_uf_fu. (* predT should be an abbreviation *) + by if=> //=; auto; smt. + by hoare; auto. + + move=> &1. + proc; if; auto; progress [-split]; rewrite -/predT; split=> //= [|_]; 1:smt ml=0 w=uD_uf_fu. + by progress [-split]; rewrite H. + by inline *; auto; progress; smt. + qed. +end section Upto. + +(** We now bound the probability of collisions. We cannot do so + by instantiating the generic Birthday Bound result. It's still + the Birthday Bound, though, just not generic: + Pr[IND(ARP,DBounder(D)).main() @ &m: ARP.coll] + <= q^2 * Pr[x = $uD: x = witness], + + where DBounder prevents the distinguisher from calling the + f-oracle more than q times. **) +module DBounder (D:Distinguisher,F:Oracles) = { + module FBounder = { + var c:int + + proc f(x:D): D = { + var r = witness; + + if (c < q) { + r = F.f(x); + c = c + 1; + } + return r; + } + + proc fi(x:D): D = { + var r = witness; + + if (c < q) { + r = F.fi(x); + c = c + 1; + } + return r; + } + } + + proc distinguish(): bool = { + var b; + + FBounder.c <- 0; + b <@ D(FBounder).distinguish(); + return b; + } +}. + +section CollisionProbability. + require import Mu_mem. + (*---*) import StdBigop StdRing StdOrder IntExtra. + (*---*) import Bigreal.BRA RField RField.AddMonoid IntOrder. + + declare module D:Distinguisher {ARP, DBounder}. + axiom D_ll (O <: Oracles {D}): islossless O.f => islossless O.fi => islossless D(O).distinguish. + + local module FEL (D : Distinguisher) = { + var c : int + + module FBounder = { + proc f(x:D): D = { + var r = witness; + + if (c < q) { + if (card (rng ARP.m) < q) { + r = ARP.f(x); + } + c = c + 1; + } + return r; + } + + proc fi(x:D): D = { + var r = witness; + + if (c < q) { + if (card (rng ARP.mi) < q) { + r = ARP.fi(x); + } + c = c + 1; + } + return r; + } + } + + proc main(): bool = { + var b : bool; + + ARP.init(); + c <- 0; + b <@ D(FBounder).distinguish(); + return b; + } + }. + + lemma pr_PRFi_collision &m: + Pr[IND(ARP,DBounder(D)).main() @ &m: ARP.coll] + <= (q^2)%r / 2%r * mu uD (pred1 witness). + proof. + have ->: Pr[IND(ARP,DBounder(D)).main() @ &m: ARP.coll] + = Pr[IND(ARP,DBounder(D)).main() @ &m: ARP.coll /\ DBounder.FBounder.c <= q]. + + byequiv=> //=; conseq (_: ={glob D} ==> ={ARP.coll,DBounder.FBounder.c}) + (_: true ==> DBounder.FBounder.c <= q)=> //=. + * proc; inline *; wp; call (_: DBounder.FBounder.c <= q). + - by proc; sp; if=> //=; inline*; sp; if=> //=; auto=> /#. + - by proc; sp; if=> //=; inline*; sp; if=> //=; auto=> /#. + by auto=> /=; apply/ge0_q. + by sim. + have ->: Pr[IND(ARP,DBounder(D)).main() @ &m: ARP.coll /\ DBounder.FBounder.c <= q] + = Pr[FEL(D).main() @ &m: ARP.coll /\ FEL.c <= q]. + + byequiv=> //=; proc; inline *; wp. + call (_: ={glob ARP} /\ ={c}(DBounder.FBounder,FEL) /\ card (rng ARP.m){1} <= FEL.c{2} /\ card (rng ARP.mi){1} <= FEL.c{2}). + * proc; sp; if=> //=. rcondt{2} 1; first by auto=> /#. + inline *; sp; if=> //=; auto. + - progress. + + apply/(ler_trans (card (rng ARP.m{2} `|` fset1 yL))). + apply/subset_leq_fcard=> x; rewrite rng_set !inE rng_rem in_rng. + by move=> [[a] [] _ ma|-> //=]; left; exists a. + smt. + + apply/(ler_trans (card (rng ARP.mi{2} `|` fset1 x{2}))). + apply/subset_leq_fcard=> x; rewrite rng_set !inE rng_rem in_rng. + by move=> [[a] [] _ ma|-> //=]; left; exists a. + smt. + - smt ml=0. + * proc; sp; if=> //=. rcondt{2} 1; first by auto=> /#. + inline *; sp; if=> //=; auto. + - progress. + + apply/(ler_trans (card (rng ARP.m{2} `|` fset1 x{2}))). + apply/subset_leq_fcard=> x; rewrite rng_set !inE rng_rem in_rng. + by move=> [[a] [] _ ma|-> //=]; left; exists a. + smt. + + apply/(ler_trans (card (rng ARP.mi{2} `|` fset1 x0L))). + apply/subset_leq_fcard=> x; rewrite rng_set !inE rng_rem in_rng. + by move=> [[a] [] _ ma|-> //=]; left; exists a. + smt. + - smt ml=0. + by auto; progress; rewrite rng0 fcards0. + fel 2 FEL.c (fun x, x%r * mu uD (pred1 witness)) q (ARP.coll) [FEL(D).FBounder.f: (FEL.c < q); FEL(D).FBounder.fi: (FEL.c < q)] (size ARP.m <= FEL.c /\ size ARP.mi <= FEL.c)=> //. + + rewrite-mulr_suml Bigreal.sumidE 1:ge0_q. + by rewrite (powS 1) // pow1;smt(mu_bounded ge0_q). + + by inline*; auto; smt(dom0 fcards0 sizeE). + + exists*FEL.c;elim*=> c. + conseq(:_==>_ : (c%r * mu1 uD witness));progress. + proc; sp; rcondt 1=> //. + inline *; sp; if=> //=; last first. + * hoare; auto=> // /> &hr _ _ _ _ _ _. + by apply/RealOrder.mulr_ge0; smt w=(mu_bounded ge0_q). + sp; if=> //=. + * wp; rnd (mem (rng ARP.m)); skip. + progress. + - apply/(RealOrder.ler_trans ((card (rng ARP.m{hr}))%r * mu uD (pred1 witness))). + apply/mu_mem_le; move=> x _; have [] uD_suf [] ? uD_fu:= uD_uf_fu. + apply/RealOrder.lerr_eq/uD_suf; 1,2:rewrite uD_fu //. + by apply/RealOrder.ler_wpmul2r; smt w=(mu_bounded lt_fromint ltrW sizeE leq_card_rng_dom). + - by move: H9;rewrite H1. + * by hoare; auto=> //=; smt w=(RealOrder.mulr_ge0 mu_bounded ge0_q). + + move=> c; proc. rcondt 2; 1:by auto. + sp; if=> //=. + * inline*;sp;if;auto;smt(size_set). + * by auto=> /#. + + by move=> b c; proc; rcondf 2; auto. + + exists*FEL.c;elim*=> c. + conseq(:_==>_ : (c%r * mu1 uD witness));progress. + proc; sp; rcondt 1=> //=. + inline *; sp; if=> //=; last by hoare; auto; smt w=(RealOrder.mulr_ge0 mu_bounded ge0_q). + sp; if=> //=. + * wp; rnd (mem (rng ARP.mi)); skip. + progress. + - apply/(RealOrder.ler_trans ((card (rng ARP.mi{hr}))%r * mu uD (pred1 witness))). + apply/mu_mem_le; move=> x _; have [] uD_suf [] _ uD_fu:= uD_uf_fu. + apply/RealOrder.lerr_eq/uD_suf; 1,2:rewrite uD_fu //. + smt w=(RealOrder.ler_wpmul2r mu_bounded le_fromint ltrW sizeE leq_card_rng_dom). + - by move: H9; rewrite H1. + * by hoare; auto; smt w=(RealOrder.mulr_ge0 mu_bounded ge0_q). + + move=> c; proc; rcondt 2; 1:by auto. + sp; if=> //=. + * inline*;sp;if;auto;smt(size_set). + * by auto=> /#. + + by move=> b c; proc; rcondf 2; auto. + qed. +end section CollisionProbability. + +(* We pull together the results of the first two sections *) +lemma PartialConclusion (D <: Distinguisher {PRPi, ARP, DBounder}) &m: + (forall (O <: Oracles {D}), islossless O.f => islossless O.fi => islossless D(O).distinguish) => + `|Pr[IND(PRPi'(Indirect),DBounder(D)).main() @ &m: res] + - Pr[IND(ARP,DBounder(D)).main() @ &m: res]| + <= (q^2)%r / 2%r * mu uD (pred1 witness). +proof. +move=> D_ll. +have:= pr_PRFi_collision D D_ll &m. +have /#:= pr_PRPi'_Indirect_ARP (DBounder(D)) _ &m. +move=> O O_f_ll O_fi_ll; proc. +call (D_ll (<: DBounder(D,O).FBounder) _ _). + by proc; sp; if=> //=; wp; call O_f_ll. + by proc; sp; if=> //=; wp; call O_fi_ll. +by auto. +qed. + +(** This section proves the equivalence between the Ideal PRP and the + module PRPi'(Indirect) used in section Upto. **) +section PRPi_PRPi'_Indirect. + (* The key is in proving that Direct.sample and Indirect.sample + define the same distribution. We do this by extensional equality + of distributions: + forall a, Pr[Direct.sample: res = a] = Pr[Indirect.sample: res = a]. *) + equiv eq_Direct_Indirect: Direct.sample ~ Indirect.sample: ={X} ==> ={res}. + proof. + bypr (res{1}) (res{2})=> //. (* Pointwise equality of distributions *) + progress. + (* We first perform the computation on the easy side,... *) + cut ->: Pr[Direct.sample(X{1}) @ &1: res = a] = mu (uD \ (mem X){1}) (pred1 a). + byphoare (_: X = X{1} ==> _)=> //=. + by proc; rnd=> //=; auto. + subst X{1}. + (* ... and we are left with the difficult side *) + byphoare (_: X = X{2} ==> _)=> //=. + (* We deal separately with the case where a is in X and thus has + probability 0 of being sampled) *) + case (mem X{2} a)=> [a_in_X | a_notin_X]. + conseq (_: _ ==> _: 0%r); first smt. + proc. + seq 1: (mem X r) + _ 0%r + _ 0%r + (X = X{2}). + by auto. + by rcondt 1=> //=; rnd=> //=; skip; smt. + by rcondf 1=> //=; hoare; skip; smt. + done. + (* And we are now left with the case where a is not in X *) + proc. + alias 2 r0 = r. + (* There are two scenarios that lead to a = r: + - r0 = a /\ r = a (with probability mu uD (pred1 a)); + - r0 <> a /\ r = a (with probability mu uD (fun x, mem x X) * mu (uD \ X) (pred1 a)). *) + phoare split (mu uD (pred1 a)) (mu uD (mem X) * mu (uD \ (mem X)) (pred1 a)): (r0 = a). + (* Bound *) + progress. + rewrite dexcepted1E. + have [] uD_suf [] uD_ll uD_fu /=:= uD_uf_fu. + cut not_empty: mu uD predT - mu uD (mem X{2}) <> 0%r. + rewrite -mu_not. + cut: 0%r < mu uD (predC (mem X{2})); last smt. + by rewrite witness_support; exists a; rewrite uD_fu /= /predC a_notin_X. + by smt ml=0 w=uD_uf_fu. + (* case r0 = a *) + seq 2: (a = r0) (mu uD (pred1 a)) 1%r _ 0%r (r0 = r /\ X = X{2}). + by auto. + by wp; rnd; skip; progress; rewrite pred1E -(etaE ((=) a)) etaP. + by rcondf 1. + by hoare; conseq (_: _ ==> true)=> //=; smt. + done. + (* case r0 <> a *) + seq 2: (!mem X r) + _ 0%r + (mu uD (mem X)) (mu (uD \ (mem X)) (pred1 a)) + (r0 = r /\ X = X{2}). + by auto. + by hoare; rcondf 1=> //=; skip; smt. + by wp; rnd. + rcondt 1=> //=; rnd (pred1 a). + by skip; smt. + done. + qed. + + (* The rest is easy *) + local equiv eq_PRPi_PRPi'_f_Indirect: PRPi.f ~ PRPi'(Indirect).f: + ={x, PRPi.m, PRPi.mi} ==> ={res, PRPi.m, PRPi.mi}. + proof. + transitivity PRPi'(Direct).f (={PRPi.m,PRPi.mi,x} ==> ={PRPi.m,PRPi.mi,res}) (={PRPi.m,PRPi.mi,x} ==> ={PRPi.m,PRPi.mi,res}). + + by move=> &1 &2 [->> [->> ->>]]; exists PRPi.m{2} PRPi.mi{2} x{2}. + + done. + + by proc; inline *; if=> //=; auto; progress; rewrite getP. + + by proc; if=> //=; wp; call eq_Direct_Indirect. + qed. + + local equiv eq_PRPi_PRPi'_fi_Indirect: PRPi.fi ~ PRPi'(Indirect).fi: + y{1} = x{2} /\ ={PRPi.m, PRPi.mi} ==> ={res, PRPi.m, PRPi.mi}. + proof. + transitivity PRPi'(Direct).fi (={PRPi.m,PRPi.mi} /\ y{1} = x{2} ==> ={PRPi.m,PRPi.mi,res}) (={PRPi.m,PRPi.mi,x} ==> ={PRPi.m,PRPi.mi,res}). + + by move=> &1 &2 [->> [->> ->>]]; exists PRPi.m{2} PRPi.mi{2} x{2}. + + done. + + by proc; inline *; if=> //=; auto; progress; rewrite getP. + + by proc; if=> //=; wp; call eq_Direct_Indirect. + qed. + + declare module D:Distinguisher {PRPi}. + + lemma pr_PRPi_PRPi'_Indirect &m: + Pr[IND(PRPi,D).main() @ &m: res] = Pr[IND(PRPi'(Indirect),D).main() @ &m: res]. + proof. + byequiv=> //=. + proc. + call (_: ={PRPi.m,PRPi.mi}). + by apply eq_PRPi_PRPi'_f_Indirect. + by apply eq_PRPi_PRPi'_fi_Indirect. + by inline*; auto. + qed. +end section PRPi_PRPi'_Indirect. + +lemma Conclusion (D <: Distinguisher {PRPi, ARP, DBounder}) &m: + (forall (O <: Oracles {D}), islossless O.f => islossless O.fi => islossless D(O).distinguish) => + `|Pr[IND(PRPi,DBounder(D)).main() @ &m: res] + - Pr[IND(ARP,DBounder(D)).main() @ &m: res]| + <= (q^2)%r / 2%r * mu uD (pred1 witness). +proof. +move=> D_ll. +by rewrite (pr_PRPi_PRPi'_Indirect (DBounder(D)) &m) (PartialConclusion D &m D_ll). +qed. From 303fcfb5835cf43079fd4570cad3aa004898b6e2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Mon, 26 Mar 2018 18:59:49 +0200 Subject: [PATCH 266/394] . --- sha3/proof/smart_counter/Gcol.eca | 163 +-- sha3/proof/smart_counter/Handle.eca | 1535 ++++++++++++++++---------- sha3/proof/smart_counter/SLCommon.ec | 5 +- 3 files changed, 1055 insertions(+), 648 deletions(-) diff --git a/sha3/proof/smart_counter/Gcol.eca b/sha3/proof/smart_counter/Gcol.eca index 1d7a678..2047d12 100644 --- a/sha3/proof/smart_counter/Gcol.eca +++ b/sha3/proof/smart_counter/Gcol.eca @@ -4,10 +4,9 @@ require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. require import DProd Dexcepted. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. -require (*..*) Handle. +require (*..*) Gcol_ext. -clone export Handle as Handle0. - export ROhandle. +clone export Gcol_ext as Handle0. (* -------------------------------------------------------------------------- *) @@ -38,7 +37,7 @@ section PROOF. proc sample_c () = { var c=c0; if (card (image fst (rng FRO.m)) <= 2*max_size /\ - count < max_size /\ ! G1.bcol /\ ! G1.bext) { + count < max_size) { c <$ cdistr; G1.bcol <- G1.bcol \/ mem (image fst (rng FRO.m)) c; count <- count + 1; @@ -57,14 +56,16 @@ section PROOF. if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; } else { - 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; + if (! G1.bcol /\ ! G1.bext) { + 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; + } } i <- i + 1; } @@ -79,40 +80,43 @@ section PROOF. var p, v, y, y1, y2, hy2, hx2; if (!mem (dom G1.m) x) { - if (!(mem (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 (mem (dom G1.paths) x.`2) { - (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 <- (b0,c0); + if (! G1.bcol /\ ! G1.bext) { + if (!(mem (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 (mem (dom G1.paths) x.`2) { + (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 (mem (dom G1.mh) (x.`1, hx2) /\ - 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 (mem (dom G1.paths) x.`2) { - (p,v) <- oget G1.paths.[x.`2]; - G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } + y <- (y1,y2); + if (mem (dom G1.mh) (x.`1, hx2) /\ + 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 (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } } } else { y <- oget G1.m.[x]; @@ -124,29 +128,32 @@ section PROOF. var y, y1, y2, hx2, hy2; if (!mem (dom G1.mi) x) { - if (!(mem (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 (mem (dom G1.mhi) (x.`1, hx2) /\ - 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); + y <- (b0,c0); + if (! G1.bcol /\ !G1.bext) { + if (!(mem (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 (mem (dom G1.mhi) (x.`1, hx2) /\ + 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]; @@ -159,14 +166,14 @@ section PROOF. proc main(): bool = { var b; - F.RO.m <- map0; + F.RO.m <- map0; G1.m <- map0; G1.mi <- map0; G1.mh <- map0; G1.mhi <- map0; G1.bcol <- false; - FRO.m <- map0.[0 <- (c0, Known)]; + FRO.m <- map0.[0 <- (c0, Known)]; G1.paths <- map0.[c0 <- ([<:block>],b0)]; G1.chandle <- 1; count <- 0; @@ -212,16 +219,20 @@ section PROOF. move=> b c;proc;sp;if;auto;smt ml=0. qed. - local equiv G1col : G1(DRestr(D)).main ~ Gcol.main : + local equiv Gpr_col : Gpr(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}) /\ + ((!G1.bext /\ !G1.bcol) => mh_spec FRO.m G1.m G1.mh F.RO.m + /\ pi_spec FRO.m G1.mh G1.paths + /\ hs_spec FRO.m G1.chandle){1} /\ (card (rng 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=>/#. + + proc;sp 1 1;if=>//;inline Gpr(DRestr(D)).S.f Gcol.S.f;swap -3. + sp;if;1,3:auto=>/#;sp;wp;if;auto;progress. + - rewrite/ swap{1}[3..5]-2. seq 3 2:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, C.c,C.queries,x0,hx2} /\ @@ -246,7 +257,7 @@ section PROOF. auto;progress;smt w=hinv_image. + proc;sp 1 1;if=>//. - inline G1(DRestr(D)).S.fi Gcol.S.fi;swap-3. + inline Gpr(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}) /\ @@ -272,7 +283,7 @@ section PROOF. auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | X];right;apply hinv_image=> //. + proc;sp 1 1;if=>//;2:auto;sp;if=>//. - inline G1(DRestr(D)).C.f Gcol.C.f. sp. + inline Gpr(DRestr(D)).C.f Gcol.C.f. sp. seq 5 5: (={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} /\ i{1}=0 /\ @@ -299,7 +310,7 @@ section PROOF. qed. lemma Pr_G1col &m: - Pr[G1(DRestr(D)).main() @ &m : G1.bcol] <= max_size%r * ((2*max_size)%r / (2^c)%r). + Pr[Gpr(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 G1col=> //#. diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index ebb10c2..8bb05ef 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -12,7 +12,7 @@ clone import GenEager as ROhandle with op sampleto <- fun (_:int) => cdistr proof sampleto_ll by apply DCapacity.dunifin_ll. - +clone export ConcreteF as ConcreteF1. module G1(D:DISTINGUISHER) = { var m, mi : smap @@ -21,7 +21,7 @@ module G1(D:DISTINGUISHER) = { var paths : (capacity, block list * block) fmap var bext, bcol : bool - module C = { + module M = { proc f(p : block list): block = { var sa, sa', sc; @@ -149,7 +149,7 @@ module G1(D:DISTINGUISHER) = { FRO.m <- map0.[0 <- (c0, Known)]; paths <- map0.[c0 <- ([<:block>],b0)]; chandle <- 1; - b <@ D(C,S).distinguish(); + b <@ D(M,S).distinguish(); return b; } }. @@ -184,7 +184,7 @@ inductive m_mh (hs : handles) (m : smap) (mh : hsmap) = /\ m.[(xa,xc)] = Some (ya,yc)). -(* WELL-FORMEDNESS<1>: Map and Prefixes are compatible *) +(* WELL-FORMEDNESS<1 >: Map and Prefixes are compatible *) inductive m_p (m : smap) (p : (block list, state) fmap) = | INV_m_p of (p.[[]] = Some (b0,c0)) & (forall (l : block list), @@ -251,7 +251,7 @@ inductive INV_CF_G1 (hs : handles) ch (Pm Pmi Gm Gmi : smap) & (incl Gmi Pmi) & (mh_spec hs Gm mh ro) & (pi_spec hs mh pi) - (* & (ro_p ro p) *) + & (all_prefixes_fset (dom ro)) & (m_p Pm p). (** Structural Projections **) @@ -326,6 +326,11 @@ lemma invG_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p: 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: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => + 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: INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => m_p m1 p. @@ -343,9 +348,9 @@ smt(in_dom). qed. lemma all_prefixes_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 => + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p=> all_prefixes p. -proof. case=>? ? ? ? ? ? ? ? ? h ?;exact(all_prefixes_of_m_p _ h). qed. +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 => *) @@ -806,13 +811,14 @@ have H /H {H}:= build_hpath_down mh x1 ch y1 (ch + 1) p v h _. + move=> ^ /build_hpathP + -> /=; rewrite !getP. by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. (* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) ++ by case:HINV. split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. -move=>l hmem i hi. -cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. -cut[]sa sc[]:=h2 l hmem i hi. -cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. -smt(in_dom getP). ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ _ [] ->//. ++ move=>l hmem i hi. + cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]sa sc[]:=h2 l hmem i hi. + cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + smt(in_dom getP). qed. @@ -910,13 +916,14 @@ have H /H {H}:= build_hpath_down mh y1 (ch + 1) x1 ch p v h _. + move=> ^ /build_hpathP + -> /=; rewrite !getP. by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. (* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) ++ by case:HINV. split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. -move=>l hmem i hi. -cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. -cut[]sa sc[]:=h2 l hmem i hi. -cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. -smt(in_dom getP). ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ _ [] ->//. ++ move=>l hmem i hi. + cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]sa sc[]:=h2 l hmem i hi. + cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + smt(in_dom getP). qed. lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes x1 x2 y1 y2 hx: @@ -1005,13 +1012,14 @@ move: Hpath=> /build_hpathP [<*>|]. + 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). *) ++ by case:HINV. split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. -move=>l hmem i hi. -cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. -cut[]sa sc[]:=h2 l hmem i hi. -cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. -smt(in_dom getP). ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ _ [] ->//. ++ move=>l hmem i hi. + cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]sa sc[]:=h2 l hmem i hi. + cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + smt(in_dom getP). qed. lemma lemma2' hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes x1 x2 y1 y2 hx: @@ -1114,13 +1122,14 @@ have no_path_to_ch: forall p0 v0, build_hpath G1mh p0 <> Some (v0,ch). 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). *) ++ by case:HINV. split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. -move=>l hmem i hi. -cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. -cut[]sa sc[]:=h2 l hmem i hi. -cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. -smt(in_dom getP). ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ _ [] ->//. ++ move=>l hmem i hi. + cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]sa sc[]:=h2 l hmem i hi. + cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + smt(in_dom getP). qed. lemma lemma3 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes xa xc hx ya yc hy p b: @@ -1201,16 +1210,16 @@ split. 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. split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. -move=>l hmem i hi. -cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. -cut[]sa sc[]:=h2 l hmem i hi. -cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. -smt(in_dom getP). ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ _ [] ->//. ++ move=>l hmem i hi. + cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]sa sc[]:=h2 l hmem i hi. + cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + smt(in_dom getP). qed. -clone export ConcreteF as ConcreteF1. lemma m_mh_None hs0 PFm G1mh hx2 x2 k x1: m_mh hs0 PFm G1mh => @@ -1447,33 +1456,39 @@ qed. 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 C = { + module M = { proc f(p : block list): block = { var sa, sa', sc; - var h, i <- 0; + var h, i, counter <- 0; sa <- b0; sc <- c0; while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + if (mem (dom mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; } else { - sc <$ cdistr; - G1.bcol <- G1.bcol \/ hinv FRO.m sc <> None; - 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; + if (counter < size p - prefixe p (get_max_prefixe p (elems (dom 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; } - if (p <> []) { - sa <- F.RO.get(p); - } + sa <- F.RO.get(p); return sa; } } @@ -1483,9 +1498,9 @@ module G1'(D:DISTINGUISHER) = { proc f(x : state): state = { var p, v, y, y1, y2, hy2, hx2; - if (!mem (dom G1.m) x) { - if (mem (dom G1.paths) x.`2) { - (p,v) <- oget G1.paths.[x.`2]; + if (!mem (dom m) x) { + if (mem (dom paths) x.`2) { + (p,v) <- oget paths.[x.`2]; y1 <- F.RO.get (rcons p (v +^ x.`1)); y2 <$ cdistr; } else { @@ -1493,34 +1508,34 @@ module G1'(D:DISTINGUISHER) = { y2 <$ cdistr; } y <- (y1, y2); - G1.bext <- G1.bext \/ mem (rng FRO.m) (x.`2, Unknown); + bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); if (!(mem (rng FRO.m) (x.`2, Known))) { - FRO.m.[G1.chandle] <- (x.`2, Known); - G1.chandle <- G1.chandle + 1; + FRO.m.[chandle] <- (x.`2, Known); + chandle <- chandle + 1; } hx2 <- oget (hinvK FRO.m x.`2); - if (mem (dom G1.mh) (x.`1, hx2) /\ 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; + if (mem (dom mh) (x.`1, hx2) /\ 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 { - G1.bcol <- G1.bcol \/ hinv FRO.m y.`2 <> None; - 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); + 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 (mem (dom G1.paths) x.`2) { - (p,v) <- oget G1.paths.[x.`2]; - G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + if (mem (dom paths) x.`2) { + (p,v) <- oget paths.[x.`2]; + paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); } } else { - y <- oget G1.m.[x]; + y <- oget m.[x]; } return y; } @@ -1528,35 +1543,35 @@ module G1'(D:DISTINGUISHER) = { proc fi(x : state): state = { var y, y1, y2, hx2, hy2; - if (!mem (dom G1.mi) x) { - G1.bext <- G1.bext \/ mem (rng FRO.m) (x.`2, Unknown); + if (!mem (dom mi) x) { + bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); if (!(mem (rng FRO.m) (x.`2, Known))) { - FRO.m.[G1.chandle] <- (x.`2, Known); - G1.chandle <- G1.chandle + 1; + FRO.m.[chandle] <- (x.`2, Known); + chandle <- chandle + 1; } hx2 <- oget (hinvK FRO.m x.`2); y1 <$ bdistr; y2 <$ cdistr; y <- (y1,y2); - if (mem (dom G1.mhi) (x.`1,hx2) /\ - 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; + if (mem (dom mhi) (x.`1,hx2) /\ + 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 { - G1.bcol <- G1.bcol \/ hinv FRO.m y.`2 <> None; - 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); + 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 G1.mi.[x]; + y <- oget mi.[x]; } return y; } @@ -1566,506 +1581,886 @@ module G1'(D:DISTINGUISHER) = { proc main(): bool = { var b; - F.RO.m <- map0; - G1.m <- map0; - G1.mi <- map0; - G1.mh <- map0; - G1.mhi <- map0; - G1.bext <- false; - G1.bcol <- false; + F.RO.m <- map0; + m <- map0; + mi <- map0; + mh <- map0; + mhi <- map0; + bext <- false; + bcol <- false; (* the empty path is initially known by the adversary to lead to capacity 0^c *) - FRO.m <- map0.[0 <- (c0, Known)]; - G1.paths <- map0.[c0 <- ([<:block>],b0)]; - G1.chandle <- 1; - b <@ D(C,S).distinguish(); + FRO.m <- map0.[0 <- (c0, Known)]; + paths <- map0.[c0 <- ([<:block>],b0)]; + chandle <- 1; + b <@ D(M,S).distinguish(); return b; } }. +lemma lemma5 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes i (p : block list) b c h: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes + => 0 <= i < size p + => take (i + 1) p \in dom 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. +cut[]_ H:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ Hinv. +cut[]sa sc:=H _ H_take_iS i _;1:smt(size_take). +rewrite!take_take !min_lel//= 1:/# nth_take 1,2:/#H_take_i=>[][]/=[->>->>] H_pm. +cut[]b' c' H_Pm:exists b' c', Pm.[(sa +^ nth witness p i, sc)] = Some (b',c') by smt(in_dom). +exists b' c';rewrite -H_Pm/=. +cut[]h_Pm _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ Hinv. +cut[]h' f' hy fy[]H_h'[]H_hy H_mh:=h_Pm _ _ _ _ H_Pm. +cut[]h_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ Hinv. print huniq. +cut[]f H_h := H_hs_h. +cut/=<<-:=h_huniq _ _ _ _ H_h H_h'. +by rewrite H_mh/=/#. +qed. -equiv PFf_Cf_not_nil (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1'(D).C.f : - ! (G1.bcol{2} \/ G1.bext{2}) /\ - ={p} /\ p{1} <> [] /\ - 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} ==> - ! (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}. + +lemma lemma5' hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes i (p : block list) b c h: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes + => 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. + cut[]b1 h1 H_mh1:exists b1 h1, mh.[(b +^ nth witness p i, h)] = Some (b1,h1) by rewrite/#. + cut[]H_Pm H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ Hinv. + by cut/#:=H_Gmh _ _ _ _ H_mh1. +cut[]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(get_oget in_dom). +cut[]H_P_m H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ Hinv. +cut:=H_P_m _ _ _ _ H_Pm1. +by cut[]/#:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ Hinv. +qed. + + +equiv PFf_Cf_not_nil (D<:DISTINGUISHER): + + DFRestr(SqueezelessSponge(PF)).f ~ DFRestr(G1(D).M).f : + + ! (G1.bcol{2} \/ G1.bext{2}) /\ + ={arg} /\ ={glob C} /\ [] \in dom C.queries{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} + ==> + ! (G1.bcol{2} \/ G1.bext{2}) => ={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} /\ + [] \in dom C.queries{2}. proof. - proc;sp. - seq 1 1: - ((!(G1.bcol{2} \/ G1.bext{2}) => + 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} /\ + [] \in dom C.queries{2} /\ + F.RO.m.[p]{2} = Some sa{2});progress. + + rewrite/#. + + rewrite/#. + + rewrite/#. + + smt(dom_set in_fsetU1). + 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} /\ ={sa} /\ + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} /\ + [] \in dom C.queries{2} /\ ={sa} /\ F.RO.m.[p]{2} = Some sa{1})));last first. - + case : (! (G1.bcol{2} \/ G1.bext{2})); - 2: conseq (_:_ ==> true)=> //; inline *;auto;progress. - + if{2};1:rcondf{2} 3;auto;progress. - + smt(in_dom). - + smt(Block.DBlock.dunifin_ll). - + rewrite/#. - + rewrite/#. - + rewrite/#. - + rewrite/#. - if{2};auto;progress;smt(Block.DBlock.dunifin_ll). - while ( ={p, i} /\ (0 <= i <= size p){2} /\ + + 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(in_dom DBlock.dunifin_ll DCapacity.dunifin_ll take_size). + + while ( ={p, i, glob C} /\ (0 <= i <= size p){2} /\ (Redo.prefixes.[take i p]{1} = Some (sa,sc){1}) /\ (take i p \in dom 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.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} /\ + [] \in dom C.queries{2} /\ ={sa} /\ - (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})));last first. - + auto=> &m1 &m2 [#]->->-> _->->->->-> Hp ^ Hinv -> /=;rewrite size_ge0/=;split. - + split;-1: split;-1: split;-2: by exists Known;case Hinv => -[] _ ->. - + by rewrite take0;case:Hinv=>_ _ _ _ _ _ _ _ _ []->//. - + by rewrite take0 in_dom;case:Hinv=>_ _ _ _ _ _ _ _ _ []->//. - by rewrite take0. - progress. - + rewrite/#. - + smt(size_eq0 size_ge0 take_size). - + smt(size_eq0 size_ge0 take_size). + (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})));last first. + + auto;progress. + - smt(size_ge0). + - case:H1=>_ _ _ _ _ _ _ _ _ _ [];smt(take0). + - case:H1=>_ _ _ _ _ _ _ _ _ _ [];smt(take0 in_dom). + - cut[]/#:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ H1. + - cut[]/#:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H1. + - rewrite/#. + - rewrite/#. + - rewrite/#. + - smt(size_eq0 size_ge0 take_le0 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 dom Redo.prefixes{1}) + /\ (G1.bcol{2} \/ G1.bext{2}));1:rewrite/#. + if{1};sp;2:if{1};if{2};sp;auto;4:swap{2}4-3;auto; + smt(getP get_oget dom_set in_fsetU1 DBlock.dunifin_ll DCapacity.dunifin_ll). if{1}. - + case : (! (G1.bcol{2} \/ G1.bext{2}));last first. - + wp;conseq(:_==> (G1.bcol{2} \/ G1.bext{2}));1:smt(get_oget). - by inline*;if{2};auto;smt(DCapacity.dunifin_ll DBlock.dunifin_ll). - conseq(: ={p, i, sa} - /\ 0 <= i{2} < size p{2} - /\ Redo.prefixes{1}.[take i{1} p{1}] = Some (sa{1}, sc{1}) - /\ (take i{1} p{1} \in dom Redo.prefixes{1}) - /\ 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} - /\ (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}) - /\ (take (i{1} + 1) p{1} \in dom Redo.prefixes{1}) - /\ ! (G1.bcol{2} \/ G1.bext{2}) - /\ F.RO.m{2}.[take (i{2} + 1) p{2}] = - Some (oget Redo.prefixes{1}.[take (i{2} + 1) p{2}]).`1 - && ((sa +^ nth witness p i, h) \in dom G1.mh){2} ==> _);progress. - * rewrite/#. - * rewrite/#. - * rewrite/#. - * rewrite/#. - * rewrite/#. - * rewrite/#. - * rewrite/#. - * move:H3;rewrite H7/=;progress. - cut[]prefixe_nil prefixes:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. - cut[]b1 c1:=prefixes _ H6 i{2} _;1:smt(size_take). - rewrite!take_take!min_lel//=1:/# nth_take 1,2:/# H1/==>[][][->>->>]h. - rewrite -h. - cut[]h1 h2 h3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. - cut->:=take_nth witness i{2} p{2} _;1:smt(size_take). - rewrite h2 H9/=. exists b1 h{2}=>//=. - clear h1 h2 h3 prefixes prefixe_nil. - cut[]h1 h2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. - cut[]a b c d[]e[]g j:=h1 (b1 +^ nth witness p{2} i{2}) c1 - (oget Redo.prefixes{1}.[take (i{2} + 1) p{2}]).`1 - (oget Redo.prefixes{1}.[take (i{2} + 1) p{2}]).`2 _;1:smt(get_oget). - cut[]hu _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. - by cut/=<<-/#:=hu _ _ _ _ H8 e. - * move:H3;rewrite H7/=;progress. - cut/#:=lemma4 _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} _ _ _ _ H3 _ H6 H1 H10 H8 H9. - by rewrite/#. - rcondt{2}1;1:auto. - auto;progress. + + rcondt{2}1;auto;progress. + - cut[]HINV:=H3 H6. + by cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ i{hr} p{hr} sa{hr} sc{m} h{hr} HINV;smt(in_dom). + - rewrite/#. + - rewrite/#. + - smt(get_oget). + - rewrite/#. + - rewrite/#. + - cut[]HINV[]H_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. + cut//=[]:=lemma5 _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + * rewrite/#. + * rewrite/#. + * rewrite/#. + * rewrite/#. + move=>b' c' h'[]H_Pm ->/=;rewrite oget_some/=. + cut[]_ H_pref:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]b1 c1[]:=H_pref _ H7 i{2} _;1:smt(size_take). + by rewrite !take_take!min_lel 1,2:/# nth_take 1,2:/# H1/==>[][]->>->><-/#. + - cut[]HINV[]H_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. + cut//=[]:=lemma5 _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + * rewrite/#. + * rewrite/#. + * rewrite/#. + * rewrite/#. + move=>b' c' h'[]H_Pm H_mh/=. + rewrite H_mh/=oget_some/=. + cut[]_ H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]c1 h1 c2 h2:=H_Gmh _ _ _ _ H_mh;rewrite H_h/==>[][][<<-<<-][];rewrite H_Pm/=. + move=>help ->>;move:help. + cut[]_ H_pref:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]b3 c3[]:=H_pref _ H7 i{2} _;1:smt(size_take). + rewrite !take_take!min_lel 1,2:/# nth_take 1,2:/# H1/==>[][]->>->><-. + by rewrite H_Pm oget_some/=/#. + - cut[]HINV[]H_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. + cut//=[]b1 c1 h1[]H_Pm H_mh:=lemma5 _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + * rewrite/#. + * rewrite/#. + * rewrite/#. + * rewrite/#. + by rewrite H_mh/=oget_some/=(@take_nth witness)1:/#build_hpath_prefix H_path/=/#. + - rewrite/#. + - rewrite/#. + - cut[]HINV[]H_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. + cut[]_ H_pref:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]b3 c3[]:=H_pref _ H7 i{2} _;1:smt(size_take). + rewrite !take_take!min_lel 1,2:/# nth_take 1,2:/# H1/==>[][]->>->>. + cut//=[]b1 c1 h1[]H_Pm H_mh:=lemma5 _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} b3 c3 h{2} HINV _ _ _ _. + * rewrite/#. + * rewrite/#. + * rewrite/#. + * rewrite/#. + rewrite H_Pm=>H_pref_Pm;rewrite -H_pref_Pm oget_some/=. + rewrite(@take_nth witness)1:/#. + by cut[]_ -> _/#:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + + sp;wp=>/=. + if{1};2:rcondt{2}1;first last;3:rcondf{2}1;..3:auto. + + smt(lemma5' in_dom). + + progress. + - rewrite/#. + - rewrite/#. + - smt(getP get_oget in_dom). + - smt(getP get_oget in_dom). + - cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. + split;case:HINV=>//=_ _ _ _ _ _ _ _ _ _[] H0' H_m_p;split. + + by rewrite getP; smt(size_take take0 size_eq0 size_ge0). + move=>l;rewrite dom_set in_fsetU1. + case(l = take (i{2} + 1) p{2})=>//=[->>|H_l H_dom]. + * move=>j H_size;rewrite!getP/=. + cut h_size:0 <= j <= i{2} by smt(size_take). + cut->/=:!take j (take (i{2} + 1) p{2}) = take (i{2} + 1) p{2} by smt(size_take). + rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#. + case(j=i{2})=>[->>|H_ij]/=. + + smt(get_oget in_dom). + cut->/=:!(take (j + 1) p{2}) = take (i{2} + 1) p{2} by smt(size_take). + cut[]:=H_m_p _ H2 j _;1:smt(size_take). + by rewrite!take_take!min_lel 1,2:/# nth_take /#. + move=>i Hi;rewrite!getP. + cut:take i l \in dom Redo.prefixes{1} by smt(in_dom). + by cut/#:take (i+1) l \in dom Redo.prefixes{1} by smt(in_dom take_oversize). + - rewrite/#. + - smt(lemma5' in_dom). + - cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. + cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _. + * rewrite/#. + * rewrite/#. + * rewrite/#. + cut:=H8;rewrite in_dom=>->/=[]b1 c1 h1[]H_Pm1 H_Gmh1. + rewrite H_Pm1 H_Gmh1 !oget_some/=. + by cut[]/#:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + - cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. + cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _. + * rewrite/#. + * rewrite/#. + * rewrite/#. + cut:=H8;rewrite in_dom=>->/=[]b1 c1 h1[]H_Pm1 H_Gmh1. + by rewrite H_Gmh1 oget_some/=(@take_nth witness)1:/#build_hpath_prefix H_path/=/#. + - rewrite/#. + - rewrite/#. + - cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. + cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _. + * rewrite/#. + * rewrite/#. + * rewrite/#. + cut:=H8;rewrite in_dom=>->/=[]b1 c1 h1[]H_Pm1 H_Gmh1. + rewrite H_Pm1 !oget_some/=(@take_nth witness)1:/#. + by cut[]/#:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + + smt(lemma5' in_dom). + rcondt{2}5;auto;progress. + * rewrite(@take_nth witness)1:/# in_dom. + cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. + cut[]:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ i{hr} p{hr} sa{hr} sc{m} h{hr} HINV _ _ _. * rewrite/#. * rewrite/#. - * smt(get_oget). - * cut:=lemma4 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H3 _ H7 H1 H5 H9 H4;1:rewrite/#. - rewrite in_dom=>hG1. - cut[]b1 h1 hb1h1:exists b1 h1, G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2})] = Some (b1, h1) by rewrite/#. - cut[]_ h:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. - cut[]b' c':=h _ H7 i{2} _;1:smt(size_take). - rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#H1/==>[][][<<-<<-]{b' c'} h'{h}. - rewrite-h' hb1h1/=oget_some/=. - cut[]hh1 hh2:= m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. - cut[]a b c d:=hh2 _ _ _ _ hb1h1. - by rewrite H4/==>[][][]->>->>[]_->;rewrite !oget_some/=/#. - * cut:=lemma4 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H3 _ H7 H1 H5 H9 H4;1:rewrite/#. - rewrite in_dom=>hG1. - cut[]b1 h1 hb1h1:exists b1 h1, G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2})] = Some (b1, h1) by rewrite/#. - cut[]_ h:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. - cut[]b' c':=h _ H7 i{2} _;1:smt(size_take). - rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#H1/==>[][][<<-<<-]{b' c'} h'{h}. - rewrite-h' hb1h1/=oget_some/=. - cut[]hh1 hh2:= m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. - cut[]a b c d:=hh2 _ _ _ _ hb1h1. - by rewrite H4/==>[][][]->>->>[]->->;rewrite !oget_some/=/#. - * cut:=lemma4 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H3 _ H7 H1 H5 H9 H4;1:rewrite/#. - rewrite in_dom=>hG1. - cut[]b1 h1 hb1h1:exists b1 h1, G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2})] = Some (b1, h1) by rewrite/#. - cut->:=(take_nth witness i{2} p{2} _);rewrite//=. - by rewrite build_hpath_prefix H5/=hb1h1/=;smt(oget_some). * rewrite/#. + cut:=H8;rewrite in_dom =>/=->/=H_Gmh _ H_ H_path_uniq. + cut help:=H_ (take i{hr} p{hr}) (nth witness p{hr} i{hr});rewrite H_path/= in help. + cut:forall (b : block), + F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})] = Some b + <=> exists hy, G1.mh{hr}.[(sa{hr} +^ nth witness p{hr} i{hr}, h{hr})] = Some (b, hy) by rewrite/#. + move:help=>_ help;move:H_Gmh;apply absurd=>//=H_F_Ro. + by cut:=get_oget F.RO.m{hr} (rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr}));rewrite in_dom H_F_Ro/=help=>[]/#. + swap{2}-3;auto;progress. + * rewrite/#. + * rewrite/#. + * by rewrite!getP/=. + * smt(getP dom_set in_fsetU1). + * rewrite!getP/=!oget_some/=. + * cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. + cut:=H13;rewrite !negb_or/==>[][][]bad1 hinv_none bad2. + cut H_hs_spec:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut H_mh_spec:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut H_m_mh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut H_mi_mhi:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut H_pi_spec:=pi_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut :=lemma5' _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _. + * by rewrite H H4/=. + * exact H1. * rewrite/#. - inline *;sp 2 0;wp=> /=. - conseq(:_==> (! (G1.bcol{2} \/ G1.bext{2}) => (oget PF.m{1}.[x{1}]).`1 = sa{2} - /\ build_hpath G1.mh{2} (take (i{2} + 1) p{2}) = Some (sa{2}, h{2}) - /\ (exists (f : flag), FRO.m{2}.[h{2}] = Some ((oget PF.m{1}.[x{1}]).`2, f)) - /\ F.RO.m{2}.[take (i{2} + 1) p{2}] = Some (oget PF.m{1}.[x{1}]).`1 - /\ 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}.[take (i{1} + 1) p{1} <- - ((oget PF.m{1}.[x{1}]).`1, (oget PF.m{1}.[x{1}]).`2)])); - progress;..-2:smt(getP dom_set in_fsetU1). - case ((G1.bcol{2} \/ G1.bext{2})). - + wp;conseq (_: _ ==> (G1.bcol{2} \/ G1.bext{2}))=> //;progress. - by if{1};if{2};auto;2:(swap{2} 4 -3;auto); smt w=(Block.DBlock.dunifin_ll DCapacity.dunifin_ll). - conseq(: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} - /\ (exists (f : flag), FRO.m{2}.[h{2}] = Some (sc{1}, f)) - /\ x{1} = (sa{1}, sc{1}) - /\ sa{1} = sa{2} +^ nth witness p{1} i{1} - /\ ={p, i} /\ 0 <= i{1} < size p{1} - /\ Redo.prefixes{1}.[take i{1} p{1}] = Some (sa{2}, sc{1}) - /\ build_hpath G1.mh{2} (take i{2} p{2}) = Some (sa{2}, h{2}) - /\ (if i{2} = 0 then sa{2} = b0 && h{2} = 0 - else F.RO.m{2}.[take i{2} p{2}] = Some sa{2}) - /\ (take i{1} p{1} \in dom Redo.prefixes{1}) - /\ ! (take (i{1} + 1) p{1} \in dom Redo.prefixes{1}) - /\ ! (G1.bcol{2} \/ G1.bext{2}) - /\ (x \in dom PF.m){1} = ((sa +^ nth witness p i, h) \in dom G1.mh){2} - ==>_);progress;..-3:rewrite/#. - * move:H3;rewrite H7/=;progress. - rewrite !in_dom. - pose X := sa{2} +^ nth witness p{2} i{2}. - case (H3)=> -[Hu _ _] _ _ [] /(_ X sc{1}) Hpf ^ HG1 /(_ X h{2}) Hmh _ _ _ _ _. - case: {-1}(PF.m{1}.[(X,sc{1})]) (eq_refl (PF.m{1}.[(X,sc{1})])) Hpf Hmh. - + case (G1.mh{2}.[(X, h{2})]) => //= -[ya hy] Hpf. - by rewrite -negP => /(_ ya hy) [] ????[#];rewrite H8 /= => -[<-];rewrite Hpf. - move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. - rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. print huniq. - by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx)H8 Hhx;rewrite H11. - if{1};2:(rcondt{2}1; first by auto=>/#);1:(rcondf{2}1;first by auto=>/#);last first. - + auto;progress. - * move:H9 H10;pose sa' := sa{2} +^ nth witness p{2} i{2};move=>H9 H10. - case (H)=> -[Hu _ _] _ _ [] /(_ sa' sc{1}) Hpf ^ HG1 /(_ sa' h{2}) Hmh _ _ _ _ _. - cut:(sa', h{2}) \in dom G1.mh{2} by rewrite -H9 H10. - move:H10;rewrite!in_dom;progress. - case: {-1}(PF.m{1}.[(sa',sc{1})]) (eq_refl (PF.m{1}.[(sa',sc{1})])) Hpf Hmh=>//=. - move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. - rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. - by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx) H0 Hhx;rewrite H14 !oget_some/=. - * cut->:=take_nth witness i{2} p{2};1:smt(size_take). - rewrite build_hpath_prefix H4/=;smt(get_oget). - * move:H9 H10;pose sa' := sa{2} +^ nth witness p{2} i{2};move=>H9 H10. - case (H)=> -[Hu _ _] _ _ [] /(_ sa' sc{1}) Hpf ^ HG1 /(_ sa' h{2}) Hmh _ _ _ _ _. - cut:(sa', h{2}) \in dom G1.mh{2} by rewrite -H9 H10. - move:H10;rewrite!in_dom;progress. - case: {-1}(PF.m{1}.[(sa',sc{1})]) (eq_refl (PF.m{1}.[(sa',sc{1})])) Hpf Hmh=>//=. - move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. - rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. - by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx) H0 Hhx;rewrite H14 !oget_some/=Hhy/#. - * cut[] a b hab:exists a b, PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1})] = Some (a,b) by - move:H10;rewrite in_dom/#. - cut[]h1 h2 h3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H. - cut->:=take_nth witness i{2} p{2};1:smt(size_take). - rewrite h2 H4/=;exists sa{2} h{2}=>/=;rewrite hab oget_some/=. - cut[]hh1 hh2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H. - cut[]c d e i[]hcd[]hei hG1:=hh1 _ _ _ _ hab. - cut[]hu _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ H. - by cut/=<<-/#:=hu _ _ _ _ H0 hcd. - * split;..-2:case:H=>//=;progress. - split;first cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H;smt(size_take getP size_eq0). - progress;cut[]_ h:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H. - rewrite !getP. - move:H12;rewrite dom_set in_fsetU1. - case(l=take (i{2}+1) p{2})=>//=;last first. - + cut all_pref l_diff l_in_dom:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ H. - cut->/=:take i0 l <> take (i{2} + 1) p{2} by rewrite/#. - cut->/=/#:take (i0+1) l <> take (i{2} + 1) p{2} by rewrite/#. - move=>->>;rewrite!take_take. - cut hii0:i0 <= i{2} by move:H14;rewrite size_take /#. - rewrite!min_lel //1,2:/# nth_take 1,2:/#. - cut->/=:take i0 p{2} <> take (i{2} + 1) p{2} by smt(size_take). - case(i0=i{2})=>//=[->>|i_neq_i0]/=;1: by rewrite H3/=;smt(get_oget). - cut->/=:!take (i0 + 1) p{2} = take (i{2} + 1) p{2} by smt(size_take). - cut:=h _ H6 i0 _;1:smt(size_take). - by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#. - rcondt{2}5;progress;1:auto;progress. - + cut[]hh1 hh2 hh3 :=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H. - rewrite(@take_nth witness)1:/#in_dom/=. - cut:=hh2 (take i{hr} p{hr}) (nth witness p{hr} i{hr});rewrite H4/=. - cut:=H10;rewrite H9 in_dom/=. - case(F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})] = None)=>//=h. - cut[]b hb:exists b, F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})] = Some b - by move:h;case:(F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})])=>//=/#. - rewrite negb_forall/==>h2;rewrite hb/=;exists b=>//=. - rewrite negb_exists=>v/=. - rewrite negb_exists=>hx/=. - rewrite negb_exists=>hy/=. - case(sa{hr} = v)=>//=->>. - by case(h{hr} = hx)=>//=->>;rewrite h2. - swap{2}4-3;wp;progress=>/=. - conseq(:_==> hinv FRO.m{2} sc{2} = None - => y1{1} = r{2} - && build_hpath G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- - (r{2}, G1.chandle{2})] (take (i{2} + 1) p{2}) = Some (r{2}, G1.chandle{2}) - && sc{2} = y2{1} - && INV_CF_G1 FRO.m{2}.[G1.chandle{2} <- (sc{2}, Unknown)] (G1.chandle{2} + 1) - PF.m{1}.[x{1} <- (y1{1}, y2{1})] PF.mi{1}.[(y1{1}, y2{1}) <- x{1}] - G1.m{2} G1.mi{2} - G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (r{2}, G1.chandle{2})] - G1.mhi{2}.[(r{2}, G1.chandle{2}) <- (sa{2} +^ nth witness p{2} i{2}, h{2})] - F.RO.m{2}.[take (i{2} + 1) p{2} <- r{2}] G1.paths{2} - Redo.prefixes{1}.[take (i{1} + 1) p{1} <- (y1{1}, y2{1})]);1:smt(getP oget_some). - conseq(:_==> (y1,y2){1} = (r,sc){2});-1:by sim. - move=> &1 &2[][]inv0[][]flag h_flag[]->>[]->>[][]->>->>[]Hi[]. - move=>prefixe_p_i[] hpath[]ro_p_i[];rewrite in_dom prefixe_p_i/==>[][]preifxe_p_i1. - rewrite!negb_or !in_dom/==>[][][]bcol bext h_pf_g1 h_pf b1 c1 b2 c2 []->>->> hinv_none/=. - move:preifxe_p_i1;cut->:=take_nth witness i{2} p{2};1:smt(size_take). - move=>prefixe_p_i1. - split;1:rewrite build_hpath_prefix/=. - * by exists sa{2} h{2};rewrite getP/=;apply build_hpath_up=>//=;smt(in_dom). - cut:=inv0;case. - move=>H_hs_spec H_inv_spec H_inv_spech H_m_mh H_mi_mhi H_incl_m H_incl_mi H_mh_spec H_pi_spec H_m_p h_build_hpath_rcons. - cut:hs_spec FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] (G1.chandle{2}+1) - && inv_spec G1.m{2} G1.mi{2} - && inv_spec G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] - G1.mhi{2}.[(b2, G1.chandle{2}) <- (sa{2} +^ nth witness p{2} i{2}, h{2})] - && m_mh FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] - PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1}) <- (b2, c2)] - G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] - && m_mh FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] - PF.mi{1}.[(b2, c2) <- (sa{2} +^ nth witness p{2} i{2}, sc{1})] - G1.mhi{2}.[(b2, G1.chandle{2}) <- (sa{2} +^ nth witness p{2} i{2}, h{2})] - && incl G1.m{2} PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1}) <- (b2, c2)] - && incl G1.mi{2} PF.mi{1}.[(b2, c2) <- (sa{2} +^ nth witness p{2} i{2}, sc{1})] - && pi_spec FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] - G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] G1.paths{2} - && mh_spec FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] G1.m{2} - G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] - F.RO.m{2}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- b2] - && m_p PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1}) <- (b2, c2)] - Redo.prefixes{1}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- (b2, c2)];last by progress;split=>//. - split. - + apply hs_addh;1:cut//:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. - by cut:=hinvP FRO.m{2} c2;rewrite hinv_none/=/#. - move=>H2_hs_spec;split. - + by cut:=invG_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. - move=>H2_inv_spec;split. - + apply inv_addm=>//;1:cut//:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. - - rewrite/#. - cut hj:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. - cut hs_sp:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. - apply (notin_hs_notin_dom2_mh FRO.m{2} PF.mi{1})=>//=. - by apply ch_notin_dom_hs=>//=. - move=>H2_inv_spech;split. - + cut//=:=(m_mh_addh_addm FRO.m{2} PF.m{1} G1.mh{2} h{2} (sa{2} +^ nth witness p{2} i{2}) sc{1} G1.chandle{2} b2 c2 flag Unknown _ _ _ _);rewrite//. - - by cut[]:=H_hs_spec. - by rewrite ch_notin_dom_hs. - move=>H2_m_mh;split. - + cut->//=:=(mi_mhi_addh_addmi FRO.m{2} PF.mi{1} G1.mhi{2} h{2} (sa{2} +^ nth witness p{2} i{2}) sc{1} G1.chandle{2} b2 c2 flag Unknown _ _ _ _);rewrite//. - - by cut/#:=hinvP FRO.m{2} c2. - by rewrite ch_notin_dom_hs. - move=>H2_mi_mhi;split. - + move=>x;rewrite getP/=. - by cut:=H_incl_m (sa{2} +^ nth witness p{2} i{2}, sc{1});smt(in_dom). - move=>H2_incl_m;split. - + move=>x;rewrite getP/=. - cut/#:G1.mi{2}.[(b2, c2)] = None;move=>{x}. - cut help//=:=hinvP FRO.m{2} c2. - rewrite hinv_none/= in help. - cut->//=:=notin_m_notin_Gm _ _ (b2,c2) H_incl_mi. - cut/#:forall a b, PF.mi{1}.[(b2,c2)] <> Some (a,b). - move=>a b;move:help;apply absurd=>//=;rewrite negb_forall//=. - cut[] inv1 inv2 hab:=H_mi_mhi. - by cut/#:=inv1 _ _ _ _ hab. - cut :=h_pf_g1;rewrite h_pf/=eq_sym neqF/==>h_g1. - move=>H2_incl_mi;split. print mh_spec. search pi_spec. - + (* pi_spec *) - split;progress. - - cut[]h:=H_pi_spec;cut:=h c p0 v;rewrite H/==>[][]h1[] h'1 h'2. - exists h1;rewrite -h'2 getP/=. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h'2. - by apply build_hpath_up=>//=. - move:H0;rewrite getP/==>hh0. - cut h0_neq_ch:h0 <> G1.chandle{2} by rewrite/#. - cut[]->:=H_pi_spec;rewrite-hh0 h0_neq_ch/=;exists h0=>/=. search build_hpath None. - cut:=H;cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v h0. - rewrite h_g1/=H/=h0_neq_ch/=. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. - by cut->/=->//=:=ch_neq0 _ _ H_hs_spec;progress;cut[]hh1 hh2 hh3:=H_mh_spec;smt(dom_hs_neq_ch). - move=>H2_pi_spec;split. - + (* mh_spec *) - (* cut: *) - (* (forall (xa : block) (hx : handle) (ya : block) (hy : handle), *) - (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})].[( *) - (* xa, hx)] = Some (ya, hy) => *) - (* exists (xc : capacity) (fx : flag) (yc : capacity) (fy : flag), *) - (* FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)].[hx] = Some (xc, fx) /\ *) - (* FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)].[hy] = Some (yc, fy) /\ *) - (* if fy = Known then G1.m{2}.[(xa, xc)] = Some (ya, yc) /\ fx = Known *) - (* else *) - (* exists (p1 : block list) (v : block), *) - (* F.RO.m{2}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- b2].[ *) - (* rcons p1 (v +^ xa)] = Some ya /\ build_hpath *) - (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- *) - (* (b2, G1.chandle{2})] p1 = Some (v, hx)) *) - (* && *) - (* (forall (p1 : block list) (v : block) (p2 : block list) (v' : block) (hx : handle), *) - (* build_hpath *) - (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) - (* p1 = Some (v, hx) => *) - (* build_hpath *) - (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) - (* p2 = Some (v', hx) => p1 = p2 /\ v = v') *) - (* && *) - (* (forall (p1 : block list) (bn b : block), *) - (* F.RO.m{2}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- b2].[rcons p1 bn] = *) - (* Some b <=> *) - (* exists (v : block) (hx hy : handle), build_hpath *) - (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] p1 = *) - (* Some (v, hx) /\ *) - (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})].[(v +^ bn, hx)] = Some (b, hy)); *) - (* last by progress;split=>/#. *) - split=>//=. - - move=>x hx y hy;rewrite !getP. - case((x, hx) = (sa{2} +^ nth witness p{2} i{2}, h{2}))=>//=. - * move=>[->> ->>][<<- <<-]/=. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. - rewrite h_flag/=. - exists sc{1} flag c2 Unknown=>//=. - by exists (take i{2} p{2}) (sa{2})=>//=;rewrite getP Block.WRing.addKr/=;apply build_hpath_up=>//=/#. - move=> neq h1. - cut[]hh1 hh2 hh3:=H_mh_spec. - cut[]xc hxx yc hyc []h2[]h3 h4:=hh1 _ _ _ _ h1. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h2. - cut->/=:=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 getP. - cut->/=:=build_hpath_up _ _ _ b2 G1.chandle{2} _ _ _ hb h_g1. - cut/#:!rcons p0 (b +^ x) = rcons (take i{2} p{2}) (nth witness p{2} i{2});move:neq;apply absurd=>//=h'. - cut<<-:take i{2} p{2}=p0 by rewrite/#. - cut hbex:b +^ x = nth witness p{2} i{2} by rewrite/#. - by cut:=hb;rewrite hpath/==>[][->>->>]/=;rewrite-hbex Block.WRing.addKr/=. - - progress. search build_hpath. - * move:H;rewrite getP/=. - case(p0 = (take i{2} p{2}))=>[->>|hpp0]. search build_hpath None. - + cut->/=:=build_hpath_up _ _ _ b2 G1.chandle{2} _ _ _ hpath h_g1. - case(bn = (nth witness p{2} i{2}))=>[->>/=->>|hbni]/=. - - by exists sa{2} h{2} G1.chandle{2}=>//=;rewrite getP/=. - cut->/=:!rcons (take i{2} p{2}) bn = rcons (take i{2} p{2}) (nth witness p{2} i{2}). - - move:hbni;apply absurd=>//=h. - cut->:bn = nth witness (rcons (take i{2} p{2}) bn) i{2}. - * by rewrite nth_rcons size_take /#. - by rewrite h nth_rcons size_take /#. + cut:=H8;rewrite in_dom/==>->/=h_g1. + cut H2_pi_spec:pi_spec FRO.m{2}.[G1.chandle{2} <- (y2L, Unknown)] + G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (y1L, G1.chandle{2})] + G1.paths{2}. + + split;progress. + - cut[]h:=H_pi_spec;cut:=h c p0 v;rewrite H14/==>[][]h1[] h'1 h'2. + exists h1;rewrite -h'2 getP/=. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h'2. + by apply build_hpath_up=>//=. + move:H15;rewrite getP/==>hh0. + cut h0_neq_ch:h0 <> G1.chandle{2} by rewrite/#. + cut[]->:=H_pi_spec;rewrite-hh0 h0_neq_ch/=;exists h0=>/=. + cut:=H;cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) y1L p0 v h0. + rewrite h_g1/=H/=h0_neq_ch/=. + cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. + cut -> /= <-//=:=ch_neq0 _ _ H_hs_spec;progress;cut[]hh1 hh2 hh3:=H_mh_spec;smt(dom_hs_neq_ch). + split. + + apply hs_addh;1:cut//:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + by cut:=hinvP FRO.m{2} y2L;rewrite hinv_none/=/#. + + by cut:=invG_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + + apply inv_addm=>//;1:cut//:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + apply (notin_hs_notin_dom2_mh FRO.m{2} PF.mi{1})=>//=. + by apply ch_notin_dom_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + + cut[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + apply (m_mh_addh_addm _ H_m_mh H_huniq H_h)=>//=. + by apply ch_notin_dom_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + + cut[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + apply (mi_mhi_addh_addmi _ H_mi_mhi _ H_h _)=>//=. + - smt(hinvP). + by apply ch_notin_dom_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + + apply incl_upd_nin=>//=. + by cut:=incl_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + + apply incl_upd_nin=>//=. + - by cut:=incli_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut:=hinvP FRO.m{2} y2L;rewrite in_dom hinv_none/=;apply absurd=>H_P_mi. + rewrite negb_forall/=. + cut H_inv_Gmh:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]H_inv_Pm:=inv_mh_inv_Pm _ _ _ _ _ H_m_mh H_mi_mhi H_inv_Gmh. + cut[]H_Pmi H_Gmhi:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + by cut[]/#:=H_Pmi y1L y2L (oget PF.mi{1}.[(y1L, y2L)]).`1 + (oget PF.mi{1}.[(y1L, y2L)]).`2 _;1:smt(get_oget in_dom). + + cut H_take_Si:=take_nth witness i{2} p{2} _;1:rewrite/#. + split=>//=. + - move=>x hx y hy;rewrite !getP. + case((x, hx) = (sa{2} +^ nth witness p{2} i{2}, h{2}))=>//=. + * move=>[->> ->>][<<- <<-]/=. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. + rewrite H_h/=. + exists sc{1} f y2L Unknown=>//=. + exists (take i{2} p{2}) (sa{2})=>//=;rewrite getP Block.WRing.addKr/=. + by rewrite(@take_nth witness)1:/#/=;apply build_hpath_up=>//=;smt(in_dom). + move=> neq h1. + cut[]hh1 hh2 hh3:=H_mh_spec. + cut[]xc hxx yc hyc []h2[]h3 h4:=hh1 _ _ _ _ h1. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h2. + cut->/=:=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 getP. + cut->/=:=build_hpath_up _ _ _ y1L G1.chandle{2} _ _ _ hb h_g1. + cut/#:!rcons p0 (b +^ x) = rcons (take i{2} p{2}) (nth witness p{2} i{2});move:neq;apply absurd=>//=h'. + cut<<-:take i{2} p{2}=p0 by rewrite/#. + cut hbex:b +^ x = nth witness p{2} i{2} by rewrite/#. + by cut:=hb;rewrite H_path/==>[][->>->>]/=;rewrite-hbex Block.WRing.addKr/=. + - progress. + * move:H14;rewrite getP/=H_take_Si/=. + case(p0 = (take i{2} p{2}))=>[->>|hpp0]. + + cut->/=:=build_hpath_up _ _ _ y1L G1.chandle{2} _ _ _ H_path h_g1. + case(bn = (nth witness p{2} i{2}))=>[->> /= ->>|hbni]/=. + - by exists sa{2} h{2} G1.chandle{2}=>//=;rewrite getP/=. + cut->/=:!rcons (take i{2} p{2}) bn = rcons (take i{2} p{2}) (nth witness p{2} i{2}). + - move:hbni;apply absurd=>//=h. + cut->:bn = nth witness (rcons (take i{2} p{2}) bn) i{2}. + * by rewrite nth_rcons size_take /#. + by rewrite h nth_rcons size_take /#. + move=>h_ro_p_bn. + cut[]_ hh4 _:=H_mh_spec. + by cut:=hh4 (take i{2} p{2}) bn b0;rewrite h_ro_p_bn/=H_path/=;smt(getP @Block.WRing). + cut->/=:!rcons p0 bn = rcons (take i{2} p{2}) (nth witness p{2} i{2}). + + move:hpp0;apply absurd=>/=h. + cut:size p0 = size (take i{2} p{2}) by smt(size_rcons). + move:h;pose p' := take i{2} p{2};pose e := nth witness p{2} i{2}. + by move=>h h';move:p0 p' h' bn e h;apply seq2_ind=>//=/#. move=>h_ro_p_bn. cut[]_ hh4 _:=H_mh_spec. - by cut:=hh4 (take i{2} p{2}) bn b;rewrite h_ro_p_bn/=hpath/=;smt(getP @Block.WRing). - cut->/=:!rcons p0 bn = rcons (take i{2} p{2}) (nth witness p{2} i{2}). - + move:hpp0;apply absurd=>/=h. - cut:size p0 = size (take i{2} p{2}) by smt(size_rcons). - move:h;pose p' := take i{2} p{2};pose e := nth witness p{2} i{2}. - by move=>h h';move:p0 p' h' bn e h;apply seq2_ind=>//=/#. - move=>h_ro_p_bn. - cut[]_ hh4 _:=H_mh_spec. - cut:=hh4 p0 bn b;rewrite h_ro_p_bn/==>[][];progress. - cut help:(sa{2} +^ nth witness p{2} i{2}, h{2}) <> (v +^ bn, hx) by rewrite/#. - exists v hx hy=>//=;rewrite getP;rewrite eq_sym in help;rewrite help/=H0/=. - by apply build_hpath_up=>//=. - move:H H0;rewrite!getP=>h_build_hpath_set. - case(hy = G1.chandle{2})=>//=[->>|hy_neq_ch]/=. - + move=>h;cut h_eq:v +^ bn = sa{2} +^ nth witness p{2} i{2} && hx = h{2}. - + cut/#:G1.mh{2}.[(v +^ bn, hx)] <> Some (b, G1.chandle{2}). search hs_spec. - cut[]_ hh2:=H_m_mh. - cut:=hh2 (v +^ bn) hx b G1.chandle{2}. - case(G1.mh{2}.[(v +^ bn, hx)] = Some (b, G1.chandle{2}))=>//=. - rewrite negb_exists/=;progress; - rewrite negb_exists/=;progress; - rewrite negb_exists/=;progress; - rewrite negb_exists/=;progress;rewrite !negb_and. - by cut[]/#:=H_hs_spec. - cut[]eq_xor ->>:=h_eq. - move:h;rewrite h_eq/==>->>. - cut/#:!(p0 = (take i{2} p{2}) /\ bn = (nth witness p{2} i{2})) => - F.RO.m{2}.[rcons p0 bn] = Some b. - move:h_flag;case:flag=>h_flag;last first. - - cut:=known_path_uniq _ _ _ sc{1} h{2} p0 v (take i{2} p{2}) sa{2} H2_pi_spec _ h_build_hpath_set _. - * rewrite getP/=h_flag. - by cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. search build_hpath. - * by apply build_hpath_up=>//=. - move=>[]->>->>/=;smt(@Block.WRing). + cut:=hh4 p0 bn b0;rewrite h_ro_p_bn/==>[][];progress. + cut help:(sa{2} +^ nth witness p{2} i{2}, h{2}) <> (v +^ bn, hx) by rewrite/#. + exists v hx hy=>//=;rewrite getP;rewrite eq_sym in help;rewrite help/=H15/=. + by apply build_hpath_up=>//=. + move:H14 H15;rewrite!getP=>h_build_hpath_set. + case(hy = G1.chandle{2})=>//=[->>|hy_neq_ch]/=. + + move=>h;cut h_eq:v +^ bn = sa{2} +^ nth witness p{2} i{2} && hx = h{2}. + + cut/#:G1.mh{2}.[(v +^ bn, hx)] <> Some (b0, G1.chandle{2}). + cut[]_ hh2:=H_m_mh. + cut:=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 cut[]/#:=H_hs_spec. + cut[]eq_xor ->>:=h_eq. + move:h;rewrite h_eq/==>->>. + cut/#:!(p0 = (take i{2} p{2}) /\ bn = (nth witness p{2} i{2})) => + F.RO.m{2}.[rcons p0 bn] = Some b0. + move:H_h;case:f=>h_flag;last first. + - cut:=known_path_uniq _ _ _ sc{1} h{2} p0 v (take i{2} p{2}) sa{2} H2_pi_spec _ h_build_hpath_set _. + * rewrite getP/=h_flag. + by cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. + * by apply build_hpath_up=>//=. + move=>[]->>->>/=;apply absurd=>//=_. + cut->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). + cut[]hh1 hh2 hh3:=H_mh_spec. + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b0 p0 v h{2}. + rewrite h_build_hpath_set/=h_g1/=. + cut->/=:=ch_neq0 _ _ H_hs_spec. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. + move=>help;cut:= 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=>//=. + cut:=hh3 _ _ _ _ _ H_path h_build_hpath_p0. + cut->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). + move=>help;cut h_neq:! (v +^ bn = sa{2} +^ nth witness p{2} i{2} && hx = h{2}) by rewrite/#. + move:help;rewrite h_neq/==>h_g1_v_bn_hx. cut[]hh1 hh2 hh3:=H_mh_spec. - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b p0 v h{2}. + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) y1L p0 v hx. rewrite h_build_hpath_set/=h_g1/=. cut->/=:=ch_neq0 _ _ H_hs_spec. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. - move=>help;cut:= 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=>//=. - by cut:=hh3 _ _ _ _ _ hpath h_build_hpath_p0;smt(@Block.WRing). - move=>help;cut h_neq:! (v +^ bn = sa{2} +^ nth witness p{2} i{2} && hx = h{2}) by rewrite/#. - move:help;rewrite h_neq/==>h_g1_v_bn_hx. - cut[]hh1 hh2 hh3:=H_mh_spec. - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. - rewrite h_build_hpath_set/=h_g1/=. - cut->/=:=ch_neq0 _ _ H_hs_spec. - by cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag;smt(dom_hs_neq_ch). - progress. - + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p' v' hx. - rewrite H H0/=. + by cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h;smt(dom_hs_neq_ch). + progress. + + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) y1L p0 v hx. + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) y1L p' v' hx. + rewrite H14 H15/=. + cut->/=:=ch_neq0 _ _ H_hs_spec. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. + rewrite h_g1/=. + by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) y1L p0 v hx. + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) y1L p' v' hx. + rewrite H14 H15/=. cut->/=:=ch_neq0 _ _ H_hs_spec. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p' v' hx. - rewrite H H0/=. - cut->/=:=ch_neq0 _ _ H_hs_spec. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. - rewrite h_g1/=. - by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). - move=>H2_mh_spec;split;progress. - + by cut[]:=H_m_p;smt(getP size_rcons size_eq0 size_ge0). - move:H;rewrite dom_set in_fsetU1. - case(l \in dom Redo.prefixes{1})=>//=hdom. - + cut[]_ h:=H_m_p. - cut[]sa' sc'[]h_pref h_pref2:=h _ hdom i0 _;1:rewrite/#. - exists sa' sc';rewrite!getP/=. - cut->/=:!take i0 l = rcons (take i{2} p{2}) (nth witness p{2} i{2}) by smt(in_dom). - rewrite h_pref/=. - cut->/=:!take (i0 + 1) l = rcons (take i{2} p{2}) (nth witness p{2} i{2}) by smt(in_dom take_size). - rewrite-h_pref2/=. - by cut->/=:! (sa' +^ nth witness l i0 = sa{2} +^ nth witness p{2} i{2} && sc' = sc{1}) by smt(in_dom take_size). - move=>->>;case(i0=i{2})=>[->>|i0_neq_i]//=. - + exists sa{2} sc{1}=>//=;rewrite!getP/=. - move:H1;rewrite !size_rcons !size_take//. - rewrite!nth_rcons-take_nth// !take_take!size_take 1:/#. - cut->/=hii:i{2}< size p{2} by rewrite/#. - rewrite !min_lel 1,2:/#. - by cut->/=:! take i{2} p{2} = take (i{2} + 1) p{2} by smt(size_take). - move:H1;rewrite !size_rcons !size_take//1:/#. - rewrite!nth_rcons-take_nth// !take_take!size_take 1:/#. - cut->/=hii:i{2}< size p{2} by rewrite/#. - rewrite i0_neq_i/=!min_lel 1,2:/#. - cut->/=:i0 < i{2} by rewrite/#. - rewrite!getP. - cut->/=:! take i0 p{2} = take (i{2} + 1) p{2} by smt(size_take). - cut[]_ h_pref:=H_m_p. - cut[]:= h_pref (take i{2} p{2}) _ i0 _;1:smt(in_dom);1:smt(size_take). - move=>b3 c3;rewrite!take_take!min_lel 1,2:/#=>[][]-> h. - cut->/=:!take (i0 + 1) p{2} = take (i{2} + 1) p{2} by smt(size_take). - exists b3 c3=>//=;rewrite getP/=. - cut/#:!(b3 +^ nth witness (take i{2} p{2}) i0 = sa{2} +^ nth witness p{2} i{2} && - c3 = sc{1}). - cut:(b3 +^ nth witness (take i{2} p{2}) i0, c3) \in dom PF.m{1};2:smt(in_dom). - cut:take (i0 + 1) p{2} \in dom Redo.prefixes{1};2:smt(in_dom). - cut->:take (i0 + 1) p{2} = take (i0 + 1) (take i{2} p{2});1:smt(take_take). - smt(in_dom take_oversize). -qed. + + exact H2_pi_spec. + + move=>l;rewrite dom_set in_fsetU1. + case(l \in dom F.RO.m{2})=>/=[H_dom i|H_not_dom ->> j]. + + by rewrite in_fsetU1;left;case:HINV=>/#. + cut H_pref:=all_prefixes_fset_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + case(0 <= j)=>Hj0;last first. + + rewrite + case(l \in dom Redo.prefixes{1})=>//=hdom. + + cut[]_ h:=H_m_p. + cut[]sa' sc'[]h_pref h_pref2:=h _ hdom i0 _;1:rewrite/#. + exists sa' sc';rewrite!getP/=. + cut->/=:!take i0 l = rcons (take i{2} p{2}) (nth witness p{2} i{2}) by smt(in_dom). + rewrite h_pref/=. + cut->/=:!take (i0 + 1) l = rcons (take i{2} p{2}) (nth witness p{2} i{2}) by smt(in_dom take_size). + rewrite-h_pref2/=. + by cut->/=:! (sa' +^ nth witness l i0 = sa{2} +^ nth witness p{2} i{2} && sc' = sc{1}) by smt(in_dom take_size). + move=>->>;case(i0=i{2})=>[->>|i0_neq_i]//=. + + exists sa{2} sc{1}=>//=;rewrite!getP/=. + move:H1;rewrite !size_rcons !size_take//. + rewrite!nth_rcons-take_nth// !take_take!size_take 1:/#. + cut->/=hii:i{2}< size p{2} by rewrite/#. + rewrite !min_lel 1,2:/#. + by cut->/=:! take i{2} p{2} = take (i{2} + 1) p{2} by smt(size_take). + move:H1;rewrite !size_rcons !size_take//1:/#. + rewrite!nth_rcons-take_nth// !take_take!size_take 1:/#. + cut->/=hii:i{2}< size p{2} by rewrite/#. + rewrite i0_neq_i/=!min_lel 1,2:/#. + cut->/=:i0 < i{2} by rewrite/#. + rewrite!getP. + cut->/=:! take i0 p{2} = take (i{2} + 1) p{2} by smt(size_take). + cut[]_ h_pref:=H_m_p. + cut[]:= h_pref (take i{2} p{2}) _ i0 _;1:smt(in_dom);1:smt(size_take). + move=>b3 c3;rewrite!take_take!min_lel 1,2:/#=>[][]-> h. + cut->/=:!take (i0 + 1) p{2} = take (i{2} + 1) p{2} by smt(size_take). + exists b3 c3=>//=;rewrite getP/=. + cut/#:!(b3 +^ nth witness (take i{2} p{2}) i0 = sa{2} +^ nth witness p{2} i{2} && + c3 = sc{1}). + cut:(b3 +^ nth witness (take i{2} p{2}) i0, c3) \in dom PF.m{1};2:smt(in_dom). + cut:take (i0 + 1) p{2} \in dom Redo.prefixes{1};2:smt(in_dom). + cut->:take (i0 + 1) p{2} = take (i0 + 1) (take i{2} p{2});1:smt(take_take). + smt(in_dom take_oversize). + - split. + + search hs_spec 0. + smt(getP). + * rewrite/#. + * by rewrite!getP/=!oget_some. + * by rewrite !getP/=oget_some/#. + * rewrite!getP/=!oget_some/=(@take_nth witness)1:/# build_hpath_prefix/=. + cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. + cut:=H8;rewrite in_dom/==>H_none. + cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + * rewrite/#. + * rewrite/#. + * rewrite/#. + * rewrite/#. + rewrite H_none/==>H_Gmh_none. + by cut->/=:=build_hpath_up G1.mh{2} _ _ y1L G1.chandle{2} _ _ _ H_path H_Gmh_none;smt(getP). + * rewrite/#. + * rewrite/#. + * by rewrite!getP/=!oget_some/=. + qed. + +(* * rewrite/#. *) +(* * rewrite/#. *) +(* * by rewrite !getP/=. *) +(* * by rewrite dom_set in_fsetU1/=. *) +(* * rewrite!getP/=!oget_some/=. *) +(* * admit. *) +(* * rewrite/#. *) +(* * rewrite!getP/=. *) +(* * rewrite/#. *) +(* * rewrite/#. *) +(* * rewrite/#. *) +(* * rewrite/#. *) +(* * rewrite/#. *) +(* * rewrite/#. *) +(* * rewrite/#. *) +(* * rewrite/#. *) +(* * rewrite/#. *) + + +(* rcondf{1}1;1:auto;progress. *) +(* - cut[][]HINV[]->>[]H_inv_prefixe[][]f H_flag[]H_path H_prefixe[]H_val[]H_pref_exists H_F_RO:=H6 H9. *) +(* cut[]hh0 hh1 hh2 hh3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. search prefixe get_max_prefixe. *) +(* cut h_pref_exchange:=prefixe_exchange_prefixe_inv (elems (dom C.queries{m})) (elems (dom Redo.prefixes{hr})) p{m} _ _ _. *) +(* * move=>l2;rewrite-!memE=>H_dom;smt(in_dom). *) +(* * move=>l2;rewrite-!memE=>H_dom j;rewrite -memE. *) +(* case(0 <= j)=>hj0;last first. *) +(* + by rewrite take_le0 1:/#in_dom hh0. *) +(* case(j < size l2)=>hjsize;last first. *) +(* + by rewrite take_oversize 1:/#;smt(in_dom). *) +(* smt(in_dom). *) +(* * smt(memE). *) +(* by rewrite memE;apply prefixe_lt_size=>/#. *) +(* inline *;sp 2 0;wp=> /=. *) +(* conseq(: ={glob C, p, i} *) +(* /\ sa{1} = sa{2} +^ nth witness p{1} i{1} *) +(* /\ x{1} = (sa{1}, sc{1}) *) +(* /\ 0 <= i{2} < size p{2} *) +(* /\ Redo.prefixes{1}.[take i{1} p{1}] = Some (sa{2}, sc{1}) *) +(* /\ (take i{1} p{1} \in dom Redo.prefixes{1}) *) +(* /\ prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) <= i{2} *) +(* /\ 0 <= counter{2} <= i{2} - *) +(* prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{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{1} *) +(* /\ inv_prefixe_block C.queries{2} F.RO.m{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}) *) +(* /\ (forall (j : int), 0 < j <= i{2} => take j p{2} \in dom F.RO.m{2}) *) +(* /\ (forall (l : block list), l \in dom Redo.prefixes{1} => *) +(* exists (l2 : block list), *) +(* l ++ l2 = p{2} \/ (l ++ l2 \in dom C.queries{1})) *) +(* /\ (if i{2} = 0 then sa{2} = b0 && h{2} = 0 *) +(* else F.RO.m{2}.[take i{2} p{2}] = Some sa{2}) *) +(* /\ ! (G1.bcol{2} \/ G1.bext{2}) *) +(* /\ (x \in dom PF.m){1} = ((sa +^ nth witness p i, h) \in dom G1.mh){2} ==>_); *) +(* progress;..-3:rewrite/#. *) +(* - move:H6;rewrite H9/=;progress. *) +(* rewrite !in_dom. *) +(* pose X := sa{2} +^ nth witness p{2} i{2}. *) +(* case (H6)=> -[Hu _ _] _ _ [] /(_ X sc{1}) Hpf ^ HG1 /(_ X h{2}) Hmh _ _ _ _ _. *) +(* case: {-1}(PF.m{1}.[(X,sc{1})]) (eq_refl (PF.m{1}.[(X,sc{1})])) Hpf Hmh. *) +(* + case (G1.mh{2}.[(X, h{2})]) => //= -[ya hy] Hpf. *) +(* by rewrite -negP => /(_ ya hy) [] ????[#];rewrite H11 /= => -[<-];rewrite Hpf. *) +(* move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. *) +(* rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. *) +(* by cut/=->>/#:=Hu h{2} hx(sc{1}, f)(sc{1}, fx)H11 Hhx. *) +(* if{1};2:(rcondt{2}1; first by auto=>/#);1:(rcondf{2}1;first by auto=>/#);last first. *) +(* + auto;progress. *) +(* * rewrite/#. *) +(* * rewrite/#. *) +(* * by rewrite!getP/=. *) +(* * smt(dom_set in_fsetU1). *) +(* * smt(dom_set in_fsetU1). *) +(* * smt(dom_set in_fsetU1). *) +(* * move:H9 H10;pose sa' := sa{2} +^ nth witness p{2} i{2};move=>H9 H10. *) +(* case (H6)=> -[Hu _ _] _ _ [] /(_ sa' sc{1}) Hpf ^ HG1 /(_ sa' h{2}) Hmh _ _ _ _ _. *) +(* cut:(sa', h{2}) \in dom G1.mh{2} by rewrite -H14 H15. *) +(* move:H10;rewrite!in_dom;progress. *) +(* case: {-1}(PF.m{1}.[(sa',sc{1})]) (eq_refl (PF.m{1}.[(sa',sc{1})])) Hpf Hmh=>//=. *) +(* move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. *) +(* rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. *) +(* by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx) H0 Hhx;rewrite H14 !oget_some/=. *) +(* * cut->:=take_nth witness i{2} p{2};1:smt(size_take). *) +(* rewrite build_hpath_prefix H4/=;smt(get_oget). *) +(* * move:H9 H10;pose sa' := sa{2} +^ nth witness p{2} i{2};move=>H9 H10. *) +(* case (H)=> -[Hu _ _] _ _ [] /(_ sa' sc{1}) Hpf ^ HG1 /(_ sa' h{2}) Hmh _ _ _ _ _. *) +(* cut:(sa', h{2}) \in dom G1.mh{2} by rewrite -H9 H10. *) +(* move:H10;rewrite!in_dom;progress. *) +(* case: {-1}(PF.m{1}.[(sa',sc{1})]) (eq_refl (PF.m{1}.[(sa',sc{1})])) Hpf Hmh=>//=. *) +(* move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. *) +(* rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. *) +(* by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx) H0 Hhx;rewrite H14 !oget_some/=Hhy/#. *) +(* * cut[] a b hab:exists a b, PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1})] = Some (a,b) by *) +(* move:H10;rewrite in_dom/#. *) +(* cut[]h1 h2 h3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H. *) +(* cut->:=take_nth witness i{2} p{2};1:smt(size_take). *) +(* rewrite h2 H4/=;exists sa{2} h{2}=>/=;rewrite hab oget_some/=. *) +(* cut[]hh1 hh2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H. *) +(* cut[]c d e i[]hcd[]hei hG1:=hh1 _ _ _ _ hab. *) +(* cut[]hu _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ H. *) +(* by cut/=<<-/#:=hu _ _ _ _ H0 hcd. *) +(* * split;..-2:case:H=>//=;progress. *) +(* split;first cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H;smt(size_take getP size_eq0). *) +(* progress;cut[]_ h:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H. *) +(* rewrite !getP. *) +(* move:H12;rewrite dom_set in_fsetU1. *) +(* case(l=take (i{2}+1) p{2})=>//=;last first. *) +(* + cut all_pref l_diff l_in_dom:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ H. *) +(* cut->/=:take i0 l <> take (i{2} + 1) p{2} by rewrite/#. *) +(* cut->/=/#:take (i0+1) l <> take (i{2} + 1) p{2} by rewrite/#. *) +(* move=>->>;rewrite!take_take. *) +(* cut hii0:i0 <= i{2} by move:H14;rewrite size_take /#. *) +(* rewrite!min_lel //1,2:/# nth_take 1,2:/#. *) +(* cut->/=:take i0 p{2} <> take (i{2} + 1) p{2} by smt(size_take). *) +(* case(i0=i{2})=>//=[->>|i_neq_i0]/=;1: by rewrite H3/=;smt(get_oget). *) +(* cut->/=:!take (i0 + 1) p{2} = take (i{2} + 1) p{2} by smt(size_take). *) +(* cut:=h _ H6 i0 _;1:smt(size_take). *) +(* by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#. *) +(* rcondt{2}5;progress;1:auto;progress. *) +(* + cut[]hh1 hh2 hh3 :=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H. *) +(* rewrite(@take_nth witness)1:/#in_dom/=. *) +(* cut:=hh2 (take i{hr} p{hr}) (nth witness p{hr} i{hr});rewrite H4/=. *) +(* cut:=H10;rewrite H9 in_dom/=. *) +(* case(F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})] = None)=>//=h. *) +(* cut[]b hb:exists b, F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})] = Some b *) +(* by move:h;case:(F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})])=>//=/#. *) +(* rewrite negb_forall/==>h2;rewrite hb/=;exists b=>//=. *) +(* rewrite negb_exists=>v/=. *) +(* rewrite negb_exists=>hx/=. *) +(* rewrite negb_exists=>hy/=. *) +(* case(sa{hr} = v)=>//=->>. *) +(* by case(h{hr} = hx)=>//=->>;rewrite h2. *) +(* swap{2}4-3;wp;progress=>/=. *) +(* conseq(:_==> hinv FRO.m{2} sc{2} = None *) +(* => y1{1} = r{2} *) +(* && build_hpath G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- *) +(* (r{2}, G1.chandle{2})] (take (i{2} + 1) p{2}) = Some (r{2}, G1.chandle{2}) *) +(* && sc{2} = y2{1} *) +(* && INV_CF_G1 FRO.m{2}.[G1.chandle{2} <- (sc{2}, Unknown)] (G1.chandle{2} + 1) *) +(* PF.m{1}.[x{1} <- (y1{1}, y2{1})] PF.mi{1}.[(y1{1}, y2{1}) <- x{1}] *) +(* G1.m{2} G1.mi{2} *) +(* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (r{2}, G1.chandle{2})] *) +(* G1.mhi{2}.[(r{2}, G1.chandle{2}) <- (sa{2} +^ nth witness p{2} i{2}, h{2})] *) +(* F.RO.m{2}.[take (i{2} + 1) p{2} <- r{2}] G1.paths{2} *) +(* Redo.prefixes{1}.[take (i{1} + 1) p{1} <- (y1{1}, y2{1})]);1:smt(getP oget_some). *) +(* conseq(:_==> (y1,y2){1} = (r,sc){2});-1:by sim. *) +(* move=> &1 &2[][]inv0[][]flag h_flag[]->>[]->>[][]->>->>[]Hi[]. *) +(* move=>prefixe_p_i[] hpath[]ro_p_i[];rewrite in_dom prefixe_p_i/==>[][]preifxe_p_i1. *) +(* rewrite!negb_or !in_dom/==>[][][]bcol bext h_pf_g1 h_pf b1 c1 b2 c2 []->>->> hinv_none/=. *) +(* move:preifxe_p_i1;cut->:=take_nth witness i{2} p{2};1:smt(size_take). *) +(* move=>prefixe_p_i1. *) +(* split;1:rewrite build_hpath_prefix/=. *) +(* * by exists sa{2} h{2};rewrite getP/=;apply build_hpath_up=>//=;smt(in_dom). *) +(* cut:=inv0;case. *) +(* move=>H_hs_spec H_inv_spec H_inv_spech H_m_mh H_mi_mhi H_incl_m H_incl_mi H_mh_spec H_pi_spec H_m_p h_build_hpath_rcons. *) +(* cut:hs_spec FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] (G1.chandle{2}+1) *) +(* && inv_spec G1.m{2} G1.mi{2} *) +(* && inv_spec G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) +(* G1.mhi{2}.[(b2, G1.chandle{2}) <- (sa{2} +^ nth witness p{2} i{2}, h{2})] *) +(* && m_mh FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] *) +(* PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1}) <- (b2, c2)] *) +(* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) +(* && m_mh FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] *) +(* PF.mi{1}.[(b2, c2) <- (sa{2} +^ nth witness p{2} i{2}, sc{1})] *) +(* G1.mhi{2}.[(b2, G1.chandle{2}) <- (sa{2} +^ nth witness p{2} i{2}, h{2})] *) +(* && incl G1.m{2} PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1}) <- (b2, c2)] *) +(* && incl G1.mi{2} PF.mi{1}.[(b2, c2) <- (sa{2} +^ nth witness p{2} i{2}, sc{1})] *) +(* && pi_spec FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] *) +(* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] G1.paths{2} *) +(* && mh_spec FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] G1.m{2} *) +(* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) +(* F.RO.m{2}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- b2] *) +(* && m_p PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1}) <- (b2, c2)] *) +(* Redo.prefixes{1}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- (b2, c2)];last by progress;split=>//. *) +(* split. *) +(* + apply hs_addh;1:cut//:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. *) +(* by cut:=hinvP FRO.m{2} c2;rewrite hinv_none/=/#. *) +(* move=>H2_hs_spec;split. *) +(* + by cut:=invG_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. *) +(* move=>H2_inv_spec;split. *) +(* + apply inv_addm=>//;1:cut//:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. *) +(* - rewrite/#. *) +(* cut hj:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. *) +(* cut hs_sp:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. *) +(* apply (notin_hs_notin_dom2_mh FRO.m{2} PF.mi{1})=>//=. *) +(* by apply ch_notin_dom_hs=>//=. *) +(* move=>H2_inv_spech;split. *) +(* + cut//=:=(m_mh_addh_addm FRO.m{2} PF.m{1} G1.mh{2} h{2} (sa{2} +^ nth witness p{2} i{2}) sc{1} G1.chandle{2} b2 c2 flag Unknown _ _ _ _);rewrite//. *) +(* - by cut[]:=H_hs_spec. *) +(* by rewrite ch_notin_dom_hs. *) +(* move=>H2_m_mh;split. *) +(* + cut->//=:=(mi_mhi_addh_addmi FRO.m{2} PF.mi{1} G1.mhi{2} h{2} (sa{2} +^ nth witness p{2} i{2}) sc{1} G1.chandle{2} b2 c2 flag Unknown _ _ _ _);rewrite//. *) +(* - by cut/#:=hinvP FRO.m{2} c2. *) +(* by rewrite ch_notin_dom_hs. *) +(* move=>H2_mi_mhi;split. *) +(* + move=>x;rewrite getP/=. *) +(* by cut:=H_incl_m (sa{2} +^ nth witness p{2} i{2}, sc{1});smt(in_dom). *) +(* move=>H2_incl_m;split. *) +(* + move=>x;rewrite getP/=. *) +(* cut/#:G1.mi{2}.[(b2, c2)] = None;move=>{x}. *) +(* cut help//=:=hinvP FRO.m{2} c2. *) +(* rewrite hinv_none/= in help. *) +(* cut->//=:=notin_m_notin_Gm _ _ (b2,c2) H_incl_mi. *) +(* cut/#:forall a b, PF.mi{1}.[(b2,c2)] <> Some (a,b). *) +(* move=>a b;move:help;apply absurd=>//=;rewrite negb_forall//=. *) +(* cut[] inv1 inv2 hab:=H_mi_mhi. *) +(* by cut/#:=inv1 _ _ _ _ hab. *) +(* cut :=h_pf_g1;rewrite h_pf/=eq_sym neqF/==>h_g1. *) +(* move=>H2_incl_mi;split. print mh_spec. search pi_spec. *) +(* + (* pi_spec *) *) +(* split;progress. *) +(* - cut[]h:=H_pi_spec;cut:=h c p0 v;rewrite H/==>[][]h1[] h'1 h'2. *) +(* exists h1;rewrite -h'2 getP/=. *) +(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h'2. *) +(* by apply build_hpath_up=>//=. *) +(* move:H0;rewrite getP/==>hh0. *) +(* cut h0_neq_ch:h0 <> G1.chandle{2} by rewrite/#. *) +(* cut[]->:=H_pi_spec;rewrite-hh0 h0_neq_ch/=;exists h0=>/=. search build_hpath None. *) +(* cut:=H;cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v h0. *) +(* rewrite h_g1/=H/=h0_neq_ch/=. *) +(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. *) +(* by cut->/=->//=:=ch_neq0 _ _ H_hs_spec;progress;cut[]hh1 hh2 hh3:=H_mh_spec;smt(dom_hs_neq_ch). *) +(* move=>H2_pi_spec;split. *) +(* + (* mh_spec *) *) +(* (* cut: *) *) +(* (* (forall (xa : block) (hx : handle) (ya : block) (hy : handle), *) *) +(* (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})].[( *) *) +(* (* xa, hx)] = Some (ya, hy) => *) *) +(* (* exists (xc : capacity) (fx : flag) (yc : capacity) (fy : flag), *) *) +(* (* FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)].[hx] = Some (xc, fx) /\ *) *) +(* (* FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)].[hy] = Some (yc, fy) /\ *) *) +(* (* if fy = Known then G1.m{2}.[(xa, xc)] = Some (ya, yc) /\ fx = Known *) *) +(* (* else *) *) +(* (* exists (p1 : block list) (v : block), *) *) +(* (* F.RO.m{2}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- b2].[ *) *) +(* (* rcons p1 (v +^ xa)] = Some ya /\ build_hpath *) *) +(* (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- *) *) +(* (* (b2, G1.chandle{2})] p1 = Some (v, hx)) *) *) +(* (* && *) *) +(* (* (forall (p1 : block list) (v : block) (p2 : block list) (v' : block) (hx : handle), *) *) +(* (* build_hpath *) *) +(* (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) *) +(* (* p1 = Some (v, hx) => *) *) +(* (* build_hpath *) *) +(* (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) *) +(* (* p2 = Some (v', hx) => p1 = p2 /\ v = v') *) *) +(* (* && *) *) +(* (* (forall (p1 : block list) (bn b : block), *) *) +(* (* F.RO.m{2}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- b2].[rcons p1 bn] = *) *) +(* (* Some b <=> *) *) +(* (* exists (v : block) (hx hy : handle), build_hpath *) *) +(* (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] p1 = *) *) +(* (* Some (v, hx) /\ *) *) +(* (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})].[(v +^ bn, hx)] = Some (b, hy)); *) *) +(* (* last by progress;split=>/#. *) *) +(* split=>//=. *) +(* - move=>x hx y hy;rewrite !getP. *) +(* case((x, hx) = (sa{2} +^ nth witness p{2} i{2}, h{2}))=>//=. *) +(* * move=>[->> ->>][<<- <<-]/=. *) +(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. *) +(* rewrite h_flag/=. *) +(* exists sc{1} flag c2 Unknown=>//=. *) +(* by exists (take i{2} p{2}) (sa{2})=>//=;rewrite getP Block.WRing.addKr/=;apply build_hpath_up=>//=/#. *) +(* move=> neq h1. *) +(* cut[]hh1 hh2 hh3:=H_mh_spec. *) +(* cut[]xc hxx yc hyc []h2[]h3 h4:=hh1 _ _ _ _ h1. *) +(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h2. *) +(* cut->/=:=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 getP. *) +(* cut->/=:=build_hpath_up _ _ _ b2 G1.chandle{2} _ _ _ hb h_g1. *) +(* cut/#:!rcons p0 (b +^ x) = rcons (take i{2} p{2}) (nth witness p{2} i{2});move:neq;apply absurd=>//=h'. *) +(* cut<<-:take i{2} p{2}=p0 by rewrite/#. *) +(* cut hbex:b +^ x = nth witness p{2} i{2} by rewrite/#. *) +(* by cut:=hb;rewrite hpath/==>[][->>->>]/=;rewrite-hbex Block.WRing.addKr/=. *) +(* - progress. search build_hpath. *) +(* * move:H;rewrite getP/=. *) +(* case(p0 = (take i{2} p{2}))=>[->>|hpp0]. search build_hpath None. *) +(* + cut->/=:=build_hpath_up _ _ _ b2 G1.chandle{2} _ _ _ hpath h_g1. *) +(* case(bn = (nth witness p{2} i{2}))=>[->>/=->>|hbni]/=. *) +(* - by exists sa{2} h{2} G1.chandle{2}=>//=;rewrite getP/=. *) +(* cut->/=:!rcons (take i{2} p{2}) bn = rcons (take i{2} p{2}) (nth witness p{2} i{2}). *) +(* - move:hbni;apply absurd=>//=h. *) +(* cut->:bn = nth witness (rcons (take i{2} p{2}) bn) i{2}. *) +(* * by rewrite nth_rcons size_take /#. *) +(* by rewrite h nth_rcons size_take /#. *) +(* move=>h_ro_p_bn. *) +(* cut[]_ hh4 _:=H_mh_spec. *) +(* by cut:=hh4 (take i{2} p{2}) bn b;rewrite h_ro_p_bn/=hpath/=;smt(getP @Block.WRing). *) +(* cut->/=:!rcons p0 bn = rcons (take i{2} p{2}) (nth witness p{2} i{2}). *) +(* + move:hpp0;apply absurd=>/=h. *) +(* cut:size p0 = size (take i{2} p{2}) by smt(size_rcons). *) +(* move:h;pose p' := take i{2} p{2};pose e := nth witness p{2} i{2}. *) +(* by move=>h h';move:p0 p' h' bn e h;apply seq2_ind=>//=/#. *) +(* move=>h_ro_p_bn. *) +(* cut[]_ hh4 _:=H_mh_spec. *) +(* cut:=hh4 p0 bn b;rewrite h_ro_p_bn/==>[][];progress. *) +(* cut help:(sa{2} +^ nth witness p{2} i{2}, h{2}) <> (v +^ bn, hx) by rewrite/#. *) +(* exists v hx hy=>//=;rewrite getP;rewrite eq_sym in help;rewrite help/=H0/=. *) +(* by apply build_hpath_up=>//=. *) +(* move:H H0;rewrite!getP=>h_build_hpath_set. *) +(* case(hy = G1.chandle{2})=>//=[->>|hy_neq_ch]/=. *) +(* + move=>h;cut h_eq:v +^ bn = sa{2} +^ nth witness p{2} i{2} && hx = h{2}. *) +(* + cut/#:G1.mh{2}.[(v +^ bn, hx)] <> Some (b, G1.chandle{2}). search hs_spec. *) +(* cut[]_ hh2:=H_m_mh. *) +(* cut:=hh2 (v +^ bn) hx b G1.chandle{2}. *) +(* case(G1.mh{2}.[(v +^ bn, hx)] = Some (b, G1.chandle{2}))=>//=. *) +(* rewrite negb_exists/=;progress; *) +(* rewrite negb_exists/=;progress; *) +(* rewrite negb_exists/=;progress; *) +(* rewrite negb_exists/=;progress;rewrite !negb_and. *) +(* by cut[]/#:=H_hs_spec. *) +(* cut[]eq_xor ->>:=h_eq. *) +(* move:h;rewrite h_eq/==>->>. *) +(* cut/#:!(p0 = (take i{2} p{2}) /\ bn = (nth witness p{2} i{2})) => *) +(* F.RO.m{2}.[rcons p0 bn] = Some b. *) +(* move:h_flag;case:flag=>h_flag;last first. *) +(* - cut:=known_path_uniq _ _ _ sc{1} h{2} p0 v (take i{2} p{2}) sa{2} H2_pi_spec _ h_build_hpath_set _. *) +(* * rewrite getP/=h_flag. *) +(* by cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. search build_hpath. *) +(* * by apply build_hpath_up=>//=. *) +(* move=>[]->>->>/=;smt(@Block.WRing). *) +(* cut[]hh1 hh2 hh3:=H_mh_spec. *) +(* cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b p0 v h{2}. *) +(* rewrite h_build_hpath_set/=h_g1/=. *) +(* cut->/=:=ch_neq0 _ _ H_hs_spec. *) +(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. *) +(* move=>help;cut:= 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=>//=. *) +(* by cut:=hh3 _ _ _ _ _ hpath h_build_hpath_p0;smt(@Block.WRing). *) +(* move=>help;cut h_neq:! (v +^ bn = sa{2} +^ nth witness p{2} i{2} && hx = h{2}) by rewrite/#. *) +(* move:help;rewrite h_neq/==>h_g1_v_bn_hx. *) +(* cut[]hh1 hh2 hh3:=H_mh_spec. *) +(* cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. *) +(* rewrite h_build_hpath_set/=h_g1/=. *) +(* cut->/=:=ch_neq0 _ _ H_hs_spec. *) +(* by cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag;smt(dom_hs_neq_ch). *) +(* progress. *) +(* + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. *) +(* cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p' v' hx. *) +(* rewrite H H0/=. *) +(* cut->/=:=ch_neq0 _ _ H_hs_spec. *) +(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. *) +(* rewrite h_g1/=. *) +(* by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). *) +(* cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. *) +(* cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p' v' hx. *) +(* rewrite H H0/=. *) +(* cut->/=:=ch_neq0 _ _ H_hs_spec. *) +(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. *) +(* rewrite h_g1/=. *) +(* by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). *) +(* move=>H2_mh_spec;split;progress. *) +(* + by cut[]:=H_m_p;smt(getP size_rcons size_eq0 size_ge0). *) +(* move:H;rewrite dom_set in_fsetU1. *) +(* case(l \in dom Redo.prefixes{1})=>//=hdom. *) +(* + cut[]_ h:=H_m_p. *) +(* cut[]sa' sc'[]h_pref h_pref2:=h _ hdom i0 _;1:rewrite/#. *) +(* exists sa' sc';rewrite!getP/=. *) +(* cut->/=:!take i0 l = rcons (take i{2} p{2}) (nth witness p{2} i{2}) by smt(in_dom). *) +(* rewrite h_pref/=. *) +(* cut->/=:!take (i0 + 1) l = rcons (take i{2} p{2}) (nth witness p{2} i{2}) by smt(in_dom take_size). *) +(* rewrite-h_pref2/=. *) +(* by cut->/=:! (sa' +^ nth witness l i0 = sa{2} +^ nth witness p{2} i{2} && sc' = sc{1}) by smt(in_dom take_size). *) +(* move=>->>;case(i0=i{2})=>[->>|i0_neq_i]//=. *) +(* + exists sa{2} sc{1}=>//=;rewrite!getP/=. *) +(* move:H1;rewrite !size_rcons !size_take//. *) +(* rewrite!nth_rcons-take_nth// !take_take!size_take 1:/#. *) +(* cut->/=hii:i{2}< size p{2} by rewrite/#. *) +(* rewrite !min_lel 1,2:/#. *) +(* by cut->/=:! take i{2} p{2} = take (i{2} + 1) p{2} by smt(size_take). *) +(* move:H1;rewrite !size_rcons !size_take//1:/#. *) +(* rewrite!nth_rcons-take_nth// !take_take!size_take 1:/#. *) +(* cut->/=hii:i{2}< size p{2} by rewrite/#. *) +(* rewrite i0_neq_i/=!min_lel 1,2:/#. *) +(* cut->/=:i0 < i{2} by rewrite/#. *) +(* rewrite!getP. *) +(* cut->/=:! take i0 p{2} = take (i{2} + 1) p{2} by smt(size_take). *) +(* cut[]_ h_pref:=H_m_p. *) +(* cut[]:= h_pref (take i{2} p{2}) _ i0 _;1:smt(in_dom);1:smt(size_take). *) +(* move=>b3 c3;rewrite!take_take!min_lel 1,2:/#=>[][]-> h. *) +(* cut->/=:!take (i0 + 1) p{2} = take (i{2} + 1) p{2} by smt(size_take). *) +(* exists b3 c3=>//=;rewrite getP/=. *) +(* cut/#:!(b3 +^ nth witness (take i{2} p{2}) i0 = sa{2} +^ nth witness p{2} i{2} && *) +(* c3 = sc{1}). *) +(* cut:(b3 +^ nth witness (take i{2} p{2}) i0, c3) \in dom PF.m{1};2:smt(in_dom). *) +(* cut:take (i0 + 1) p{2} \in dom Redo.prefixes{1};2:smt(in_dom). *) +(* cut->:take (i0 + 1) p{2} = take (i0 + 1) (take i{2} p{2});1:smt(take_take). *) +(* smt(in_dom take_oversize). *) +(* qed. *) equiv PFf_Cf (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1'(D).C.f : diff --git a/sha3/proof/smart_counter/SLCommon.ec b/sha3/proof/smart_counter/SLCommon.ec index 0de9947..2757b7f 100644 --- a/sha3/proof/smart_counter/SLCommon.ec +++ b/sha3/proof/smart_counter/SLCommon.ec @@ -658,7 +658,7 @@ pred inv_prefixe_block (queries : (block list, block) fmap) (forall (bs : block list), bs \in dom queries => queries.[bs] = prefixes.[bs]) && (forall (bs : block list), - bs \in dom queries => forall i, take i bs \in dom prefixes). + bs \in dom queries => forall i, 0 < i <= size bs => take i bs \in dom prefixes). lemma prefixe_gt0_mem l (ll : 'a list list) : 0 < prefixe l (get_max_prefixe l ll) => @@ -671,7 +671,7 @@ qed. lemma inv_prefixe_block_mem_take queries prefixes l i : inv_prefixe_block queries prefixes => - 0 <= i < prefixe l (get_max_prefixe l (elems (dom queries))) => + 0 < i < prefixe l (get_max_prefixe l (elems (dom queries))) => take i l \in dom prefixes. proof. move=>[]H_incl H_all_prefixes Hi. @@ -679,6 +679,7 @@ rewrite (prefixe_take_leq _ (get_max_prefixe l (elems (dom queries))))1:/#. rewrite H_all_prefixes. cut:get_max_prefixe l (elems (dom queries)) \in dom queries;2:smt(in_dom). by rewrite memE;apply prefixe_gt0_mem=>/#. +smt(prefixe_sizer). qed. (* lemma prefixe_inv_prefixe queries prefixes l : *) From d14d0a64f1b636976c1794dced943ac44f45cfa5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 29 Mar 2018 17:42:25 +0200 Subject: [PATCH 267/394] Handle.eca --- sha3/proof/smart_counter/Handle.eca | 2447 +++++++++++++-------------- 1 file changed, 1168 insertions(+), 1279 deletions(-) diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index 8bb05ef..3a7b09c 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -25,22 +25,24 @@ module G1(D:DISTINGUISHER) = { proc f(p : block list): block = { var sa, sa', sc; - var h, i <- 0; + var h, i, counter <- 0; sa <- b0; sc <- c0; while (i < size p ) { if (mem (dom mh) (sa +^ nth witness p i, h)) { (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; } else { - 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; + if (counter < size p - prefixe p (get_max_prefixe p (elems (dom 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; + } } i <- i + 1; } @@ -185,13 +187,19 @@ inductive m_mh (hs : handles) (m : smap) (mh : hsmap) = (* WELL-FORMEDNESS<1 >: Map and Prefixes are compatible *) -inductive m_p (m : smap) (p : (block list, state) fmap) = +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 dom 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])). + m.[(sa +^ nth witness l i, sc)] = p.[take (i+1) l])) + & (forall (l : block list), + l \in dom q => exists c, p.[l] = Some (oget q.[l], c)) + & (forall (l : block list), + l \in dom p => exists (l2 : block list), l ++ l2 \in dom q). (** RELATIONAL : Prefixes and RO are compatible. **) inductive ro_p (ro : (block list, block) fmap) (p : (block list, state) fmap) = @@ -241,7 +249,8 @@ inductive inv_spec (m:('a,'b) fmap) mi = (* 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) = + (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) @@ -251,16 +260,16 @@ inductive INV_CF_G1 (hs : handles) ch (Pm Pmi Gm Gmi : smap) & (incl Gmi Pmi) & (mh_spec hs Gm mh ro) & (pi_spec hs mh pi) - & (all_prefixes_fset (dom ro)) - & (m_p Pm p). + (* & (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: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => + 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. @@ -268,8 +277,8 @@ 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: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => + 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. @@ -277,8 +286,8 @@ 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: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => + 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. @@ -286,60 +295,60 @@ 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: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => + 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: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => + 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: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => + 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: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => + 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: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p=> + 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: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => +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: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => - all_prefixes_fset (dom ro). -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: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => - m_p m1 p. +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: - m_p m1 p => all_prefixes p. +lemma all_prefixes_of_m_p m1 p q: + m_p m1 p q => all_prefixes p. proof. -case=>_ h l hl i. +case=>h0 h0' h1 h2 _ l hl i. case(l = [])=>//=l_notnil. case(0 <= i)=>hi0;last first. + rewrite take_le0 1:/#;cut<-:=take0 l;smt(in_dom size_ge0). @@ -347,10 +356,10 @@ case(i < size l)=>hisize;last smt(take_oversize). smt(in_dom). qed. -lemma all_prefixes_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=> +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. +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 => *) @@ -717,8 +726,8 @@ 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: - INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes +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 @@ -729,7 +738,7 @@ lemma lemma1 hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2 prefixes: 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. + ro pi prefixes queries. proof. move=> HINV x2_neq_y2 Pm_x Gm_x x2_notin_rng1_hs y2_notin_rng1_hs; split. + rewrite (@addzA ch 1 1); apply/hs_addh. @@ -811,19 +820,21 @@ have H /H {H}:= build_hpath_down mh x1 ch y1 (ch + 1) p v h _. + move=> ^ /build_hpathP + -> /=; rewrite !getP. by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. (* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) -+ by case:HINV. split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] //. + move=>l hmem i hi. - cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]_ _ h2 h3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]sa sc[]:=h2 l hmem i hi. - cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. smt(in_dom getP). +by case:HINV=>_ _ _ _ _ _ _ _ _ []. +by case:HINV=>_ _ _ _ _ _ _ _ _ []. qed. -lemma lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes x1 x2 y1 y2: - INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes +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 dom Pm => x2 <> y2 => Pmi.[(x1,x2)] = None @@ -835,7 +846,7 @@ lemma lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes x1 x2 y1 y2: 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. + ro pi prefixes queries. proof. move=> HINV hh x2_neq_y2 Pm_x Gm_x xc_notin_rng1_hs yc_notin_rng1_hs; split. + rewrite (@addzA ch 1 1); apply/hs_addh. @@ -916,18 +927,20 @@ have H /H {H}:= build_hpath_down mh y1 (ch + 1) x1 ch p v h _. + move=> ^ /build_hpathP + -> /=; rewrite !getP. by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. (* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) -+ by case:HINV. split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ []. + move=>l hmem i hi. - cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]_ _ h2 h3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]sa sc[]:=h2 l hmem i hi. - cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. smt(in_dom getP). +by case:HINV=>_ _ _ _ _ _ _ _ _ []. +by case:HINV=>_ _ _ _ _ _ _ _ _ []. qed. -lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes x1 x2 y1 y2 hx: - INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes +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 @@ -937,7 +950,7 @@ lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes x1 x2 y1 y2 hx: 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. + ro pi prefixes queries. proof. move=> HINV PFm_x1x2 G1m_x1x2 pi_x2 hs_hx y2_notin_rng1_hs. split. @@ -1012,18 +1025,20 @@ move: Hpath=> /build_hpathP [<*>|]. + 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). *) -+ by case:HINV. split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ []. + move=>l hmem i hi. - cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]_ _ h2 _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]sa sc[]:=h2 l hmem i hi. - cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. smt(in_dom getP). +by case:HINV=>_ _ _ _ _ _ _ _ _ []. +by case:HINV=>_ _ _ _ _ _ _ _ _ []. qed. -lemma lemma2' hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes x1 x2 y1 y2 hx: - INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes +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 dom PFm => PFmi.[(x1,x2)] = None => G1mi.[(x1,x2)] = None @@ -1033,7 +1048,7 @@ lemma lemma2' hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes x1 x2 y1 y2 hx: 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. + ro pi prefixes queries. proof. move=> HINV hh PFmi_x1x2 G1mi_x1x2 hs_hx y2_notin_rng1_hs. split. @@ -1122,18 +1137,20 @@ have no_path_to_ch: forall p0 v0, build_hpath G1mh p0 <> Some (v0,ch). 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). *) -+ by case:HINV. split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ []. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ []. + move=>l hmem i hi. - cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]_ _ h2 _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]sa sc[]:=h2 l hmem i hi. - cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. smt(in_dom getP). +by case:HINV=>_ _ _ _ _ _ _ _ _ []. +by case:HINV=>_ _ _ _ _ _ _ _ _ []. qed. -lemma lemma3 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes xa xc hx ya yc hy p b: - INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes +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) @@ -1144,7 +1161,7 @@ lemma lemma3 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes xa xc hx ya yc hy p b: Pm Pmi Gm.[(xa,xc) <- (ya,yc)] Gmi.[(ya,yc) <- (xa,xc)] mh mhi - ro pi.[yc <- (rcons p (b +^ xa),ya)] prefixes. + 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. @@ -1211,13 +1228,6 @@ split. by have /hs_of_INV [] + _ _ - /(_ _ _ _ _ hs_hx hs_h _) := HINV. (* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) + by case:HINV. -split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ _ [] ->//. -+ move=>l hmem i hi. - cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - cut[]sa sc[]:=h2 l hmem i hi. - cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - smt(in_dom getP). qed. @@ -1300,8 +1310,8 @@ proof. qed. -lemma lemma4 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes i p sa sc h f: - INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes +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 dom prefixes => prefixes.[take i p] = Some (sa,sc) @@ -1311,10 +1321,10 @@ lemma lemma4 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes i p sa sc h f: => (sa +^ nth witness p i, h) \in dom mh. proof. move=>inv0 hi take_i1_p_in_prefixes prefixes_sa_sc build_hpath_i_p ro_prefixe hs_h_sc_f. -cut[]_ m_prefixe:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. +cut[]_ _ m_prefixe _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. cut[]b1 c1[]:=m_prefixe _ take_i1_p_in_prefixes i _;1:smt(size_take). rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/# prefixes_sa_sc/==>[][<-<-]{b1 c1}Pm_prefixe. -cut[]hh1 hh2 hh3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. +cut[]hh1 hh2 hh3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. move:ro_prefixe;cut{1}->:=(take_nth witness i p);1:smt(size_take);move=>h1. cut:=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(in_dom). @@ -1323,16 +1333,36 @@ qed. (* we should do a lemma to have the equivalence *) -equiv eq_fi (D <: DISTINGUISHER {PF, RO, G1}): PF.fi ~ G1(D).S.fi: +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 dom C.queries{1}) /\ ([] \in dom 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} + Redo.prefixes{1} C.queries{2} ==> !G1.bcol{2} => !G1.bext{2} => ={res} @@ -1341,15 +1371,14 @@ equiv eq_fi (D <: DISTINGUISHER {PF, RO, G1}): PF.fi ~ G1(D).S.fi: G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} - Redo.prefixes{1}. -proof. + 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}. -elim* => hs ch Pm Pmi Gm Gmi mh mhi ro pi [xa xc] prefixes. + 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) - (eq_refl (INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes)); last first. + {-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]. @@ -1377,21 +1406,21 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] rewrite(@huniq_hinvK_h ch) 3:oget_some /=. + by apply/huniq_addh=> //; have /hs_of_INV [] := inv0. + by rewrite getP. - apply/(@lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes xa xc ya yc inv0 _ _ Pmi_xaxc Gmi_xaxc)=> //;first last. + 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_notin_rng1_hs_addh => /=. apply/negb_forall=> /=; exists ch; apply/negb_forall=> /=; exists Known. by rewrite getP. + move=> f h; move: (yc_notin_rng1_hs_addh h f); rewrite getP. case: (h = ch)=> <*> //= _; rewrite -negP. by have /hs_of_INV [] _ _ H /H {H} := inv0. - + rewrite in_dom/=;cut[]h1 h2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. + + rewrite in_dom/=;cut[]h1 h2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. cut h1':=h1 ya yc. cut :Pm.[(ya, yc)] <> None => exists (hx : handle) (fx : flag), hs.[hx] = Some (yc, fx) by rewrite/#. case(Pm.[(ya, yc)] = None)=>//=h; rewrite negb_exists/==>a;rewrite negb_exists/==>b. cut:=yc_notin_rng1_hs_addh a b;rewrite getP;case(a=ch)=>//=hach. search (&&). case(xc=yc)=>[/#|]hxyc. - cut[]_ _ help:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. + cut[]_ _ help:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. by cut/#:=help (yc,b) a. have /hs_of_INV [] Hhuniq _ _ [] /(getflagP_some _ _ _ Hhuniq):= inv0. + move=> x2_is_U; conseq (_: _ ==> G1.bext{2})=> //. @@ -1408,7 +1437,7 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] case: (hinvP hs y2)=> [_ y2_notin_rng1_hs _ _|/#]. rewrite getP /= oget_some /=. apply/lemma2'=> //. - + rewrite in_dom/=;cut[]h1 _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. + + rewrite in_dom/=;cut[]h1 _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. cut h1':=h1 y1 y2. cut :Pm.[(y1, y2)] <> None => exists (hx : handle) (fx : flag), hs.[hx] = Some (y2, fx) by rewrite/#. case(Pm.[(y1, y2)] = None)=>//=h; @@ -1432,1102 +1461,59 @@ have /incli_of_INV <- := inv0; 1:by rewrite Gmi_xaxc. rewrite Pmi_xaxc=> /= [#] <<*>. rcondf{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. by auto=> &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 => !mem (dom m2) x => incl m1 m2.[x <- y]. -proof. - move=> Hincl Hdom w ^/Hincl <- => Hw. - rewrite getP_neq // -negP => ->>. - by move: Hdom;rewrite in_dom. -qed. - - - -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 (mem (dom mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; - } else { - if (counter < size p - prefixe p (get_max_prefixe p (elems (dom 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 (!mem (dom m) x) { - if (mem (dom paths) x.`2) { - (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 \/ mem (rng FRO.m) (x.`2, Unknown); - if (!(mem (rng FRO.m) (x.`2, Known))) { - FRO.m.[chandle] <- (x.`2, Known); - chandle <- chandle + 1; - } - hx2 <- oget (hinvK FRO.m x.`2); - if (mem (dom mh) (x.`1, hx2) /\ 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 (mem (dom paths) x.`2) { - (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 (!mem (dom mi) x) { - bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); - if (!(mem (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 (mem (dom mhi) (x.`1,hx2) /\ - 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 <- map0; - m <- map0; - mi <- map0; - mh <- map0; - mhi <- map0; - bext <- false; - bcol <- false; - - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - FRO.m <- map0.[0 <- (c0, Known)]; - paths <- map0.[c0 <- ([<:block>],b0)]; - chandle <- 1; - b <@ D(M,S).distinguish(); - return b; - } -}. - - -lemma lemma5 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes i (p : block list) b c h: - INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes - => 0 <= i < size p - => take (i + 1) p \in dom 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. -cut[]_ H:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ Hinv. -cut[]sa sc:=H _ H_take_iS i _;1:smt(size_take). -rewrite!take_take !min_lel//= 1:/# nth_take 1,2:/#H_take_i=>[][]/=[->>->>] H_pm. -cut[]b' c' H_Pm:exists b' c', Pm.[(sa +^ nth witness p i, sc)] = Some (b',c') by smt(in_dom). -exists b' c';rewrite -H_Pm/=. -cut[]h_Pm _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ Hinv. -cut[]h' f' hy fy[]H_h'[]H_hy H_mh:=h_Pm _ _ _ _ H_Pm. -cut[]h_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ Hinv. print huniq. -cut[]f H_h := H_hs_h. -cut/=<<-:=h_huniq _ _ _ _ H_h H_h'. -by rewrite H_mh/=/#. +progress;cut[]//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H1;smt(in_dom). +progress;cut[]//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H1;smt(in_dom). qed. -lemma lemma5' hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes i (p : block list) b c h: - INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes - => 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). +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 dom 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. -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. - cut[]b1 h1 H_mh1:exists b1 h1, mh.[(b +^ nth witness p i, h)] = Some (b1,h1) by rewrite/#. - cut[]H_Pm H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ Hinv. - by cut/#:=H_Gmh _ _ _ _ H_mh1. -cut[]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(get_oget in_dom). -cut[]H_P_m H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ Hinv. -cut:=H_P_m _ _ _ _ H_Pm1. -by cut[]/#:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ Hinv. -qed. - - -equiv PFf_Cf_not_nil (D<:DISTINGUISHER): - - DFRestr(SqueezelessSponge(PF)).f ~ DFRestr(G1(D).M).f : - - ! (G1.bcol{2} \/ G1.bext{2}) /\ - ={arg} /\ ={glob C} /\ [] \in dom C.queries{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} - ==> - ! (G1.bcol{2} \/ G1.bext{2}) => ={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} /\ - [] \in dom 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} /\ - [] \in dom C.queries{2} /\ - F.RO.m.[p]{2} = Some sa{2});progress. - + rewrite/#. - + rewrite/#. - + rewrite/#. - + smt(dom_set in_fsetU1). - 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} /\ - [] \in dom C.queries{2} /\ ={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(in_dom DBlock.dunifin_ll DCapacity.dunifin_ll take_size). - - while ( ={p, i, glob C} /\ (0 <= i <= size p){2} /\ - (Redo.prefixes.[take i p]{1} = Some (sa,sc){1}) /\ - (take i p \in dom 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} /\ - [] \in dom C.queries{2} /\ - ={sa} /\ - (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})));last first. - + auto;progress. - - smt(size_ge0). - - case:H1=>_ _ _ _ _ _ _ _ _ _ [];smt(take0). - - case:H1=>_ _ _ _ _ _ _ _ _ _ [];smt(take0 in_dom). - - cut[]/#:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ H1. - - cut[]/#:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H1. - - rewrite/#. - - rewrite/#. - - rewrite/#. - - smt(size_eq0 size_ge0 take_le0 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 dom Redo.prefixes{1}) - /\ (G1.bcol{2} \/ G1.bext{2}));1:rewrite/#. - if{1};sp;2:if{1};if{2};sp;auto;4:swap{2}4-3;auto; - smt(getP get_oget dom_set in_fsetU1 DBlock.dunifin_ll DCapacity.dunifin_ll). - if{1}. - + rcondt{2}1;auto;progress. - - cut[]HINV:=H3 H6. - by cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ i{hr} p{hr} sa{hr} sc{m} h{hr} HINV;smt(in_dom). - - rewrite/#. - - rewrite/#. - - smt(get_oget). - - rewrite/#. - - rewrite/#. - - cut[]HINV[]H_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. - cut//=[]:=lemma5 _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. - * rewrite/#. - * rewrite/#. - * rewrite/#. - * rewrite/#. - move=>b' c' h'[]H_Pm ->/=;rewrite oget_some/=. - cut[]_ H_pref:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - cut[]b1 c1[]:=H_pref _ H7 i{2} _;1:smt(size_take). - by rewrite !take_take!min_lel 1,2:/# nth_take 1,2:/# H1/==>[][]->>->><-/#. - - cut[]HINV[]H_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. - cut//=[]:=lemma5 _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. - * rewrite/#. - * rewrite/#. - * rewrite/#. - * rewrite/#. - move=>b' c' h'[]H_Pm H_mh/=. - rewrite H_mh/=oget_some/=. - cut[]_ H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - cut[]c1 h1 c2 h2:=H_Gmh _ _ _ _ H_mh;rewrite H_h/==>[][][<<-<<-][];rewrite H_Pm/=. - move=>help ->>;move:help. - cut[]_ H_pref:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - cut[]b3 c3[]:=H_pref _ H7 i{2} _;1:smt(size_take). - rewrite !take_take!min_lel 1,2:/# nth_take 1,2:/# H1/==>[][]->>->><-. - by rewrite H_Pm oget_some/=/#. - - cut[]HINV[]H_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. - cut//=[]b1 c1 h1[]H_Pm H_mh:=lemma5 _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. - * rewrite/#. - * rewrite/#. - * rewrite/#. - * rewrite/#. - by rewrite H_mh/=oget_some/=(@take_nth witness)1:/#build_hpath_prefix H_path/=/#. - - rewrite/#. - - rewrite/#. - - cut[]HINV[]H_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. - cut[]_ H_pref:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - cut[]b3 c3[]:=H_pref _ H7 i{2} _;1:smt(size_take). - rewrite !take_take!min_lel 1,2:/# nth_take 1,2:/# H1/==>[][]->>->>. - cut//=[]b1 c1 h1[]H_Pm H_mh:=lemma5 _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} b3 c3 h{2} HINV _ _ _ _. - * rewrite/#. - * rewrite/#. - * rewrite/#. - * rewrite/#. - rewrite H_Pm=>H_pref_Pm;rewrite -H_pref_Pm oget_some/=. - rewrite(@take_nth witness)1:/#. - by cut[]_ -> _/#:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - - sp;wp=>/=. - if{1};2:rcondt{2}1;first last;3:rcondf{2}1;..3:auto. - + smt(lemma5' in_dom). - + progress. - - rewrite/#. - - rewrite/#. - - smt(getP get_oget in_dom). - - smt(getP get_oget in_dom). - - cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. - split;case:HINV=>//=_ _ _ _ _ _ _ _ _ _[] H0' H_m_p;split. - + by rewrite getP; smt(size_take take0 size_eq0 size_ge0). - move=>l;rewrite dom_set in_fsetU1. - case(l = take (i{2} + 1) p{2})=>//=[->>|H_l H_dom]. - * move=>j H_size;rewrite!getP/=. - cut h_size:0 <= j <= i{2} by smt(size_take). - cut->/=:!take j (take (i{2} + 1) p{2}) = take (i{2} + 1) p{2} by smt(size_take). - rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#. - case(j=i{2})=>[->>|H_ij]/=. - + smt(get_oget in_dom). - cut->/=:!(take (j + 1) p{2}) = take (i{2} + 1) p{2} by smt(size_take). - cut[]:=H_m_p _ H2 j _;1:smt(size_take). - by rewrite!take_take!min_lel 1,2:/# nth_take /#. - move=>i Hi;rewrite!getP. - cut:take i l \in dom Redo.prefixes{1} by smt(in_dom). - by cut/#:take (i+1) l \in dom Redo.prefixes{1} by smt(in_dom take_oversize). - - rewrite/#. - - smt(lemma5' in_dom). - - cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. - cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _. - * rewrite/#. - * rewrite/#. - * rewrite/#. - cut:=H8;rewrite in_dom=>->/=[]b1 c1 h1[]H_Pm1 H_Gmh1. - rewrite H_Pm1 H_Gmh1 !oget_some/=. - by cut[]/#:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - - cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. - cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _. - * rewrite/#. - * rewrite/#. - * rewrite/#. - cut:=H8;rewrite in_dom=>->/=[]b1 c1 h1[]H_Pm1 H_Gmh1. - by rewrite H_Gmh1 oget_some/=(@take_nth witness)1:/#build_hpath_prefix H_path/=/#. - - rewrite/#. - - rewrite/#. - - cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. - cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _. - * rewrite/#. - * rewrite/#. - * rewrite/#. - cut:=H8;rewrite in_dom=>->/=[]b1 c1 h1[]H_Pm1 H_Gmh1. - rewrite H_Pm1 !oget_some/=(@take_nth witness)1:/#. - by cut[]/#:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - + smt(lemma5' in_dom). - rcondt{2}5;auto;progress. - * rewrite(@take_nth witness)1:/# in_dom. - cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. - cut[]:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ i{hr} p{hr} sa{hr} sc{m} h{hr} HINV _ _ _. - * rewrite/#. - * rewrite/#. - * rewrite/#. - cut:=H8;rewrite in_dom =>/=->/=H_Gmh _ H_ H_path_uniq. - cut help:=H_ (take i{hr} p{hr}) (nth witness p{hr} i{hr});rewrite H_path/= in help. - cut:forall (b : block), - F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})] = Some b - <=> exists hy, G1.mh{hr}.[(sa{hr} +^ nth witness p{hr} i{hr}, h{hr})] = Some (b, hy) by rewrite/#. - move:help=>_ help;move:H_Gmh;apply absurd=>//=H_F_Ro. - by cut:=get_oget F.RO.m{hr} (rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr}));rewrite in_dom H_F_Ro/=help=>[]/#. - swap{2}-3;auto;progress. - * rewrite/#. - * rewrite/#. - * by rewrite!getP/=. - * smt(getP dom_set in_fsetU1). - * rewrite!getP/=!oget_some/=. - * cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. - cut:=H13;rewrite !negb_or/==>[][][]bad1 hinv_none bad2. - cut H_hs_spec:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - cut H_mh_spec:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - cut H_m_mh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - cut H_mi_mhi:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - cut H_pi_spec:=pi_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - cut :=lemma5' _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _. - * by rewrite H H4/=. - * exact H1. - * rewrite/#. - cut:=H8;rewrite in_dom/==>->/=h_g1. - cut H2_pi_spec:pi_spec FRO.m{2}.[G1.chandle{2} <- (y2L, Unknown)] - G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (y1L, G1.chandle{2})] - G1.paths{2}. - + split;progress. - - cut[]h:=H_pi_spec;cut:=h c p0 v;rewrite H14/==>[][]h1[] h'1 h'2. - exists h1;rewrite -h'2 getP/=. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h'2. - by apply build_hpath_up=>//=. - move:H15;rewrite getP/==>hh0. - cut h0_neq_ch:h0 <> G1.chandle{2} by rewrite/#. - cut[]->:=H_pi_spec;rewrite-hh0 h0_neq_ch/=;exists h0=>/=. - cut:=H;cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) y1L p0 v h0. - rewrite h_g1/=H/=h0_neq_ch/=. - cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. - cut -> /= <-//=:=ch_neq0 _ _ H_hs_spec;progress;cut[]hh1 hh2 hh3:=H_mh_spec;smt(dom_hs_neq_ch). - split. - + apply hs_addh;1:cut//:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - by cut:=hinvP FRO.m{2} y2L;rewrite hinv_none/=/#. - + by cut:=invG_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - + apply inv_addm=>//;1:cut//:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - apply (notin_hs_notin_dom2_mh FRO.m{2} PF.mi{1})=>//=. - by apply ch_notin_dom_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - + cut[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - apply (m_mh_addh_addm _ H_m_mh H_huniq H_h)=>//=. - by apply ch_notin_dom_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - + cut[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - apply (mi_mhi_addh_addmi _ H_mi_mhi _ H_h _)=>//=. - - smt(hinvP). - by apply ch_notin_dom_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - + apply incl_upd_nin=>//=. - by cut:=incl_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - + apply incl_upd_nin=>//=. - - by cut:=incli_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - cut:=hinvP FRO.m{2} y2L;rewrite in_dom hinv_none/=;apply absurd=>H_P_mi. - rewrite negb_forall/=. - cut H_inv_Gmh:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - cut[]H_inv_Pm:=inv_mh_inv_Pm _ _ _ _ _ H_m_mh H_mi_mhi H_inv_Gmh. - cut[]H_Pmi H_Gmhi:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - by cut[]/#:=H_Pmi y1L y2L (oget PF.mi{1}.[(y1L, y2L)]).`1 - (oget PF.mi{1}.[(y1L, y2L)]).`2 _;1:smt(get_oget in_dom). - + cut H_take_Si:=take_nth witness i{2} p{2} _;1:rewrite/#. - split=>//=. - - move=>x hx y hy;rewrite !getP. - case((x, hx) = (sa{2} +^ nth witness p{2} i{2}, h{2}))=>//=. - * move=>[->> ->>][<<- <<-]/=. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. - rewrite H_h/=. - exists sc{1} f y2L Unknown=>//=. - exists (take i{2} p{2}) (sa{2})=>//=;rewrite getP Block.WRing.addKr/=. - by rewrite(@take_nth witness)1:/#/=;apply build_hpath_up=>//=;smt(in_dom). - move=> neq h1. - cut[]hh1 hh2 hh3:=H_mh_spec. - cut[]xc hxx yc hyc []h2[]h3 h4:=hh1 _ _ _ _ h1. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h2. - cut->/=:=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 getP. - cut->/=:=build_hpath_up _ _ _ y1L G1.chandle{2} _ _ _ hb h_g1. - cut/#:!rcons p0 (b +^ x) = rcons (take i{2} p{2}) (nth witness p{2} i{2});move:neq;apply absurd=>//=h'. - cut<<-:take i{2} p{2}=p0 by rewrite/#. - cut hbex:b +^ x = nth witness p{2} i{2} by rewrite/#. - by cut:=hb;rewrite H_path/==>[][->>->>]/=;rewrite-hbex Block.WRing.addKr/=. - - progress. - * move:H14;rewrite getP/=H_take_Si/=. - case(p0 = (take i{2} p{2}))=>[->>|hpp0]. - + cut->/=:=build_hpath_up _ _ _ y1L G1.chandle{2} _ _ _ H_path h_g1. - case(bn = (nth witness p{2} i{2}))=>[->> /= ->>|hbni]/=. - - by exists sa{2} h{2} G1.chandle{2}=>//=;rewrite getP/=. - cut->/=:!rcons (take i{2} p{2}) bn = rcons (take i{2} p{2}) (nth witness p{2} i{2}). - - move:hbni;apply absurd=>//=h. - cut->:bn = nth witness (rcons (take i{2} p{2}) bn) i{2}. - * by rewrite nth_rcons size_take /#. - by rewrite h nth_rcons size_take /#. - move=>h_ro_p_bn. - cut[]_ hh4 _:=H_mh_spec. - by cut:=hh4 (take i{2} p{2}) bn b0;rewrite h_ro_p_bn/=H_path/=;smt(getP @Block.WRing). - cut->/=:!rcons p0 bn = rcons (take i{2} p{2}) (nth witness p{2} i{2}). - + move:hpp0;apply absurd=>/=h. - cut:size p0 = size (take i{2} p{2}) by smt(size_rcons). - move:h;pose p' := take i{2} p{2};pose e := nth witness p{2} i{2}. - by move=>h h';move:p0 p' h' bn e h;apply seq2_ind=>//=/#. - move=>h_ro_p_bn. - cut[]_ hh4 _:=H_mh_spec. - cut:=hh4 p0 bn b0;rewrite h_ro_p_bn/==>[][];progress. - cut help:(sa{2} +^ nth witness p{2} i{2}, h{2}) <> (v +^ bn, hx) by rewrite/#. - exists v hx hy=>//=;rewrite getP;rewrite eq_sym in help;rewrite help/=H15/=. - by apply build_hpath_up=>//=. - move:H14 H15;rewrite!getP=>h_build_hpath_set. - case(hy = G1.chandle{2})=>//=[->>|hy_neq_ch]/=. - + move=>h;cut h_eq:v +^ bn = sa{2} +^ nth witness p{2} i{2} && hx = h{2}. - + cut/#:G1.mh{2}.[(v +^ bn, hx)] <> Some (b0, G1.chandle{2}). - cut[]_ hh2:=H_m_mh. - cut:=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 cut[]/#:=H_hs_spec. - cut[]eq_xor ->>:=h_eq. - move:h;rewrite h_eq/==>->>. - cut/#:!(p0 = (take i{2} p{2}) /\ bn = (nth witness p{2} i{2})) => - F.RO.m{2}.[rcons p0 bn] = Some b0. - move:H_h;case:f=>h_flag;last first. - - cut:=known_path_uniq _ _ _ sc{1} h{2} p0 v (take i{2} p{2}) sa{2} H2_pi_spec _ h_build_hpath_set _. - * rewrite getP/=h_flag. - by cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. - * by apply build_hpath_up=>//=. - move=>[]->>->>/=;apply absurd=>//=_. - cut->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). - cut[]hh1 hh2 hh3:=H_mh_spec. - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b0 p0 v h{2}. - rewrite h_build_hpath_set/=h_g1/=. - cut->/=:=ch_neq0 _ _ H_hs_spec. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. - move=>help;cut:= 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=>//=. - cut:=hh3 _ _ _ _ _ H_path h_build_hpath_p0. - cut->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). - move=>help;cut h_neq:! (v +^ bn = sa{2} +^ nth witness p{2} i{2} && hx = h{2}) by rewrite/#. - move:help;rewrite h_neq/==>h_g1_v_bn_hx. - cut[]hh1 hh2 hh3:=H_mh_spec. - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) y1L p0 v hx. - rewrite h_build_hpath_set/=h_g1/=. - cut->/=:=ch_neq0 _ _ H_hs_spec. - by cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h;smt(dom_hs_neq_ch). - progress. - + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) y1L p0 v hx. - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) y1L p' v' hx. - rewrite H14 H15/=. - cut->/=:=ch_neq0 _ _ H_hs_spec. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. - rewrite h_g1/=. - by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) y1L p0 v hx. - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) y1L p' v' hx. - rewrite H14 H15/=. - cut->/=:=ch_neq0 _ _ H_hs_spec. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. - rewrite h_g1/=. - by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). - + exact H2_pi_spec. - + move=>l;rewrite dom_set in_fsetU1. - case(l \in dom F.RO.m{2})=>/=[H_dom i|H_not_dom ->> j]. - + by rewrite in_fsetU1;left;case:HINV=>/#. - cut H_pref:=all_prefixes_fset_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - case(0 <= j)=>Hj0;last first. - + rewrite - case(l \in dom Redo.prefixes{1})=>//=hdom. - + cut[]_ h:=H_m_p. - cut[]sa' sc'[]h_pref h_pref2:=h _ hdom i0 _;1:rewrite/#. - exists sa' sc';rewrite!getP/=. - cut->/=:!take i0 l = rcons (take i{2} p{2}) (nth witness p{2} i{2}) by smt(in_dom). - rewrite h_pref/=. - cut->/=:!take (i0 + 1) l = rcons (take i{2} p{2}) (nth witness p{2} i{2}) by smt(in_dom take_size). - rewrite-h_pref2/=. - by cut->/=:! (sa' +^ nth witness l i0 = sa{2} +^ nth witness p{2} i{2} && sc' = sc{1}) by smt(in_dom take_size). - move=>->>;case(i0=i{2})=>[->>|i0_neq_i]//=. - + exists sa{2} sc{1}=>//=;rewrite!getP/=. - move:H1;rewrite !size_rcons !size_take//. - rewrite!nth_rcons-take_nth// !take_take!size_take 1:/#. - cut->/=hii:i{2}< size p{2} by rewrite/#. - rewrite !min_lel 1,2:/#. - by cut->/=:! take i{2} p{2} = take (i{2} + 1) p{2} by smt(size_take). - move:H1;rewrite !size_rcons !size_take//1:/#. - rewrite!nth_rcons-take_nth// !take_take!size_take 1:/#. - cut->/=hii:i{2}< size p{2} by rewrite/#. - rewrite i0_neq_i/=!min_lel 1,2:/#. - cut->/=:i0 < i{2} by rewrite/#. - rewrite!getP. - cut->/=:! take i0 p{2} = take (i{2} + 1) p{2} by smt(size_take). - cut[]_ h_pref:=H_m_p. - cut[]:= h_pref (take i{2} p{2}) _ i0 _;1:smt(in_dom);1:smt(size_take). - move=>b3 c3;rewrite!take_take!min_lel 1,2:/#=>[][]-> h. - cut->/=:!take (i0 + 1) p{2} = take (i{2} + 1) p{2} by smt(size_take). - exists b3 c3=>//=;rewrite getP/=. - cut/#:!(b3 +^ nth witness (take i{2} p{2}) i0 = sa{2} +^ nth witness p{2} i{2} && - c3 = sc{1}). - cut:(b3 +^ nth witness (take i{2} p{2}) i0, c3) \in dom PF.m{1};2:smt(in_dom). - cut:take (i0 + 1) p{2} \in dom Redo.prefixes{1};2:smt(in_dom). - cut->:take (i0 + 1) p{2} = take (i0 + 1) (take i{2} p{2});1:smt(take_take). - smt(in_dom take_oversize). - - split. - - search hs_spec 0. - smt(getP). - * rewrite/#. - * by rewrite!getP/=!oget_some. - * by rewrite !getP/=oget_some/#. - * rewrite!getP/=!oget_some/=(@take_nth witness)1:/# build_hpath_prefix/=. - cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. - cut:=H8;rewrite in_dom/==>H_none. - cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. - * rewrite/#. - * rewrite/#. - * rewrite/#. - * rewrite/#. - rewrite H_none/==>H_Gmh_none. - by cut->/=:=build_hpath_up G1.mh{2} _ _ y1L G1.chandle{2} _ _ _ H_path H_Gmh_none;smt(getP). - * rewrite/#. - * rewrite/#. - * by rewrite!getP/=!oget_some/=. - qed. - -(* * rewrite/#. *) -(* * rewrite/#. *) -(* * by rewrite !getP/=. *) -(* * by rewrite dom_set in_fsetU1/=. *) -(* * rewrite!getP/=!oget_some/=. *) -(* * admit. *) -(* * rewrite/#. *) -(* * rewrite!getP/=. *) -(* * rewrite/#. *) -(* * rewrite/#. *) -(* * rewrite/#. *) -(* * rewrite/#. *) -(* * rewrite/#. *) -(* * rewrite/#. *) -(* * rewrite/#. *) -(* * rewrite/#. *) -(* * rewrite/#. *) - - -(* rcondf{1}1;1:auto;progress. *) -(* - cut[][]HINV[]->>[]H_inv_prefixe[][]f H_flag[]H_path H_prefixe[]H_val[]H_pref_exists H_F_RO:=H6 H9. *) -(* cut[]hh0 hh1 hh2 hh3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. search prefixe get_max_prefixe. *) -(* cut h_pref_exchange:=prefixe_exchange_prefixe_inv (elems (dom C.queries{m})) (elems (dom Redo.prefixes{hr})) p{m} _ _ _. *) -(* * move=>l2;rewrite-!memE=>H_dom;smt(in_dom). *) -(* * move=>l2;rewrite-!memE=>H_dom j;rewrite -memE. *) -(* case(0 <= j)=>hj0;last first. *) -(* + by rewrite take_le0 1:/#in_dom hh0. *) -(* case(j < size l2)=>hjsize;last first. *) -(* + by rewrite take_oversize 1:/#;smt(in_dom). *) -(* smt(in_dom). *) -(* * smt(memE). *) -(* by rewrite memE;apply prefixe_lt_size=>/#. *) -(* inline *;sp 2 0;wp=> /=. *) -(* conseq(: ={glob C, p, i} *) -(* /\ sa{1} = sa{2} +^ nth witness p{1} i{1} *) -(* /\ x{1} = (sa{1}, sc{1}) *) -(* /\ 0 <= i{2} < size p{2} *) -(* /\ Redo.prefixes{1}.[take i{1} p{1}] = Some (sa{2}, sc{1}) *) -(* /\ (take i{1} p{1} \in dom Redo.prefixes{1}) *) -(* /\ prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) <= i{2} *) -(* /\ 0 <= counter{2} <= i{2} - *) -(* prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{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{1} *) -(* /\ inv_prefixe_block C.queries{2} F.RO.m{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}) *) -(* /\ (forall (j : int), 0 < j <= i{2} => take j p{2} \in dom F.RO.m{2}) *) -(* /\ (forall (l : block list), l \in dom Redo.prefixes{1} => *) -(* exists (l2 : block list), *) -(* l ++ l2 = p{2} \/ (l ++ l2 \in dom C.queries{1})) *) -(* /\ (if i{2} = 0 then sa{2} = b0 && h{2} = 0 *) -(* else F.RO.m{2}.[take i{2} p{2}] = Some sa{2}) *) -(* /\ ! (G1.bcol{2} \/ G1.bext{2}) *) -(* /\ (x \in dom PF.m){1} = ((sa +^ nth witness p i, h) \in dom G1.mh){2} ==>_); *) -(* progress;..-3:rewrite/#. *) -(* - move:H6;rewrite H9/=;progress. *) -(* rewrite !in_dom. *) -(* pose X := sa{2} +^ nth witness p{2} i{2}. *) -(* case (H6)=> -[Hu _ _] _ _ [] /(_ X sc{1}) Hpf ^ HG1 /(_ X h{2}) Hmh _ _ _ _ _. *) -(* case: {-1}(PF.m{1}.[(X,sc{1})]) (eq_refl (PF.m{1}.[(X,sc{1})])) Hpf Hmh. *) -(* + case (G1.mh{2}.[(X, h{2})]) => //= -[ya hy] Hpf. *) -(* by rewrite -negP => /(_ ya hy) [] ????[#];rewrite H11 /= => -[<-];rewrite Hpf. *) -(* move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. *) -(* rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. *) -(* by cut/=->>/#:=Hu h{2} hx(sc{1}, f)(sc{1}, fx)H11 Hhx. *) -(* if{1};2:(rcondt{2}1; first by auto=>/#);1:(rcondf{2}1;first by auto=>/#);last first. *) -(* + auto;progress. *) -(* * rewrite/#. *) -(* * rewrite/#. *) -(* * by rewrite!getP/=. *) -(* * smt(dom_set in_fsetU1). *) -(* * smt(dom_set in_fsetU1). *) -(* * smt(dom_set in_fsetU1). *) -(* * move:H9 H10;pose sa' := sa{2} +^ nth witness p{2} i{2};move=>H9 H10. *) -(* case (H6)=> -[Hu _ _] _ _ [] /(_ sa' sc{1}) Hpf ^ HG1 /(_ sa' h{2}) Hmh _ _ _ _ _. *) -(* cut:(sa', h{2}) \in dom G1.mh{2} by rewrite -H14 H15. *) -(* move:H10;rewrite!in_dom;progress. *) -(* case: {-1}(PF.m{1}.[(sa',sc{1})]) (eq_refl (PF.m{1}.[(sa',sc{1})])) Hpf Hmh=>//=. *) -(* move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. *) -(* rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. *) -(* by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx) H0 Hhx;rewrite H14 !oget_some/=. *) -(* * cut->:=take_nth witness i{2} p{2};1:smt(size_take). *) -(* rewrite build_hpath_prefix H4/=;smt(get_oget). *) -(* * move:H9 H10;pose sa' := sa{2} +^ nth witness p{2} i{2};move=>H9 H10. *) -(* case (H)=> -[Hu _ _] _ _ [] /(_ sa' sc{1}) Hpf ^ HG1 /(_ sa' h{2}) Hmh _ _ _ _ _. *) -(* cut:(sa', h{2}) \in dom G1.mh{2} by rewrite -H9 H10. *) -(* move:H10;rewrite!in_dom;progress. *) -(* case: {-1}(PF.m{1}.[(sa',sc{1})]) (eq_refl (PF.m{1}.[(sa',sc{1})])) Hpf Hmh=>//=. *) -(* move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. *) -(* rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. *) -(* by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx) H0 Hhx;rewrite H14 !oget_some/=Hhy/#. *) -(* * cut[] a b hab:exists a b, PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1})] = Some (a,b) by *) -(* move:H10;rewrite in_dom/#. *) -(* cut[]h1 h2 h3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H. *) -(* cut->:=take_nth witness i{2} p{2};1:smt(size_take). *) -(* rewrite h2 H4/=;exists sa{2} h{2}=>/=;rewrite hab oget_some/=. *) -(* cut[]hh1 hh2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H. *) -(* cut[]c d e i[]hcd[]hei hG1:=hh1 _ _ _ _ hab. *) -(* cut[]hu _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ H. *) -(* by cut/=<<-/#:=hu _ _ _ _ H0 hcd. *) -(* * split;..-2:case:H=>//=;progress. *) -(* split;first cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H;smt(size_take getP size_eq0). *) -(* progress;cut[]_ h:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H. *) -(* rewrite !getP. *) -(* move:H12;rewrite dom_set in_fsetU1. *) -(* case(l=take (i{2}+1) p{2})=>//=;last first. *) -(* + cut all_pref l_diff l_in_dom:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ H. *) -(* cut->/=:take i0 l <> take (i{2} + 1) p{2} by rewrite/#. *) -(* cut->/=/#:take (i0+1) l <> take (i{2} + 1) p{2} by rewrite/#. *) -(* move=>->>;rewrite!take_take. *) -(* cut hii0:i0 <= i{2} by move:H14;rewrite size_take /#. *) -(* rewrite!min_lel //1,2:/# nth_take 1,2:/#. *) -(* cut->/=:take i0 p{2} <> take (i{2} + 1) p{2} by smt(size_take). *) -(* case(i0=i{2})=>//=[->>|i_neq_i0]/=;1: by rewrite H3/=;smt(get_oget). *) -(* cut->/=:!take (i0 + 1) p{2} = take (i{2} + 1) p{2} by smt(size_take). *) -(* cut:=h _ H6 i0 _;1:smt(size_take). *) -(* by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#. *) -(* rcondt{2}5;progress;1:auto;progress. *) -(* + cut[]hh1 hh2 hh3 :=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H. *) -(* rewrite(@take_nth witness)1:/#in_dom/=. *) -(* cut:=hh2 (take i{hr} p{hr}) (nth witness p{hr} i{hr});rewrite H4/=. *) -(* cut:=H10;rewrite H9 in_dom/=. *) -(* case(F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})] = None)=>//=h. *) -(* cut[]b hb:exists b, F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})] = Some b *) -(* by move:h;case:(F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})])=>//=/#. *) -(* rewrite negb_forall/==>h2;rewrite hb/=;exists b=>//=. *) -(* rewrite negb_exists=>v/=. *) -(* rewrite negb_exists=>hx/=. *) -(* rewrite negb_exists=>hy/=. *) -(* case(sa{hr} = v)=>//=->>. *) -(* by case(h{hr} = hx)=>//=->>;rewrite h2. *) -(* swap{2}4-3;wp;progress=>/=. *) -(* conseq(:_==> hinv FRO.m{2} sc{2} = None *) -(* => y1{1} = r{2} *) -(* && build_hpath G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- *) -(* (r{2}, G1.chandle{2})] (take (i{2} + 1) p{2}) = Some (r{2}, G1.chandle{2}) *) -(* && sc{2} = y2{1} *) -(* && INV_CF_G1 FRO.m{2}.[G1.chandle{2} <- (sc{2}, Unknown)] (G1.chandle{2} + 1) *) -(* PF.m{1}.[x{1} <- (y1{1}, y2{1})] PF.mi{1}.[(y1{1}, y2{1}) <- x{1}] *) -(* G1.m{2} G1.mi{2} *) -(* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (r{2}, G1.chandle{2})] *) -(* G1.mhi{2}.[(r{2}, G1.chandle{2}) <- (sa{2} +^ nth witness p{2} i{2}, h{2})] *) -(* F.RO.m{2}.[take (i{2} + 1) p{2} <- r{2}] G1.paths{2} *) -(* Redo.prefixes{1}.[take (i{1} + 1) p{1} <- (y1{1}, y2{1})]);1:smt(getP oget_some). *) -(* conseq(:_==> (y1,y2){1} = (r,sc){2});-1:by sim. *) -(* move=> &1 &2[][]inv0[][]flag h_flag[]->>[]->>[][]->>->>[]Hi[]. *) -(* move=>prefixe_p_i[] hpath[]ro_p_i[];rewrite in_dom prefixe_p_i/==>[][]preifxe_p_i1. *) -(* rewrite!negb_or !in_dom/==>[][][]bcol bext h_pf_g1 h_pf b1 c1 b2 c2 []->>->> hinv_none/=. *) -(* move:preifxe_p_i1;cut->:=take_nth witness i{2} p{2};1:smt(size_take). *) -(* move=>prefixe_p_i1. *) -(* split;1:rewrite build_hpath_prefix/=. *) -(* * by exists sa{2} h{2};rewrite getP/=;apply build_hpath_up=>//=;smt(in_dom). *) -(* cut:=inv0;case. *) -(* move=>H_hs_spec H_inv_spec H_inv_spech H_m_mh H_mi_mhi H_incl_m H_incl_mi H_mh_spec H_pi_spec H_m_p h_build_hpath_rcons. *) -(* cut:hs_spec FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] (G1.chandle{2}+1) *) -(* && inv_spec G1.m{2} G1.mi{2} *) -(* && inv_spec G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) -(* G1.mhi{2}.[(b2, G1.chandle{2}) <- (sa{2} +^ nth witness p{2} i{2}, h{2})] *) -(* && m_mh FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] *) -(* PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1}) <- (b2, c2)] *) -(* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) -(* && m_mh FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] *) -(* PF.mi{1}.[(b2, c2) <- (sa{2} +^ nth witness p{2} i{2}, sc{1})] *) -(* G1.mhi{2}.[(b2, G1.chandle{2}) <- (sa{2} +^ nth witness p{2} i{2}, h{2})] *) -(* && incl G1.m{2} PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1}) <- (b2, c2)] *) -(* && incl G1.mi{2} PF.mi{1}.[(b2, c2) <- (sa{2} +^ nth witness p{2} i{2}, sc{1})] *) -(* && pi_spec FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] *) -(* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] G1.paths{2} *) -(* && mh_spec FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] G1.m{2} *) -(* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) -(* F.RO.m{2}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- b2] *) -(* && m_p PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1}) <- (b2, c2)] *) -(* Redo.prefixes{1}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- (b2, c2)];last by progress;split=>//. *) -(* split. *) -(* + apply hs_addh;1:cut//:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. *) -(* by cut:=hinvP FRO.m{2} c2;rewrite hinv_none/=/#. *) -(* move=>H2_hs_spec;split. *) -(* + by cut:=invG_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. *) -(* move=>H2_inv_spec;split. *) -(* + apply inv_addm=>//;1:cut//:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. *) -(* - rewrite/#. *) -(* cut hj:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. *) -(* cut hs_sp:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. *) -(* apply (notin_hs_notin_dom2_mh FRO.m{2} PF.mi{1})=>//=. *) -(* by apply ch_notin_dom_hs=>//=. *) -(* move=>H2_inv_spech;split. *) -(* + cut//=:=(m_mh_addh_addm FRO.m{2} PF.m{1} G1.mh{2} h{2} (sa{2} +^ nth witness p{2} i{2}) sc{1} G1.chandle{2} b2 c2 flag Unknown _ _ _ _);rewrite//. *) -(* - by cut[]:=H_hs_spec. *) -(* by rewrite ch_notin_dom_hs. *) -(* move=>H2_m_mh;split. *) -(* + cut->//=:=(mi_mhi_addh_addmi FRO.m{2} PF.mi{1} G1.mhi{2} h{2} (sa{2} +^ nth witness p{2} i{2}) sc{1} G1.chandle{2} b2 c2 flag Unknown _ _ _ _);rewrite//. *) -(* - by cut/#:=hinvP FRO.m{2} c2. *) -(* by rewrite ch_notin_dom_hs. *) -(* move=>H2_mi_mhi;split. *) -(* + move=>x;rewrite getP/=. *) -(* by cut:=H_incl_m (sa{2} +^ nth witness p{2} i{2}, sc{1});smt(in_dom). *) -(* move=>H2_incl_m;split. *) -(* + move=>x;rewrite getP/=. *) -(* cut/#:G1.mi{2}.[(b2, c2)] = None;move=>{x}. *) -(* cut help//=:=hinvP FRO.m{2} c2. *) -(* rewrite hinv_none/= in help. *) -(* cut->//=:=notin_m_notin_Gm _ _ (b2,c2) H_incl_mi. *) -(* cut/#:forall a b, PF.mi{1}.[(b2,c2)] <> Some (a,b). *) -(* move=>a b;move:help;apply absurd=>//=;rewrite negb_forall//=. *) -(* cut[] inv1 inv2 hab:=H_mi_mhi. *) -(* by cut/#:=inv1 _ _ _ _ hab. *) -(* cut :=h_pf_g1;rewrite h_pf/=eq_sym neqF/==>h_g1. *) -(* move=>H2_incl_mi;split. print mh_spec. search pi_spec. *) -(* + (* pi_spec *) *) -(* split;progress. *) -(* - cut[]h:=H_pi_spec;cut:=h c p0 v;rewrite H/==>[][]h1[] h'1 h'2. *) -(* exists h1;rewrite -h'2 getP/=. *) -(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h'2. *) -(* by apply build_hpath_up=>//=. *) -(* move:H0;rewrite getP/==>hh0. *) -(* cut h0_neq_ch:h0 <> G1.chandle{2} by rewrite/#. *) -(* cut[]->:=H_pi_spec;rewrite-hh0 h0_neq_ch/=;exists h0=>/=. search build_hpath None. *) -(* cut:=H;cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v h0. *) -(* rewrite h_g1/=H/=h0_neq_ch/=. *) -(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. *) -(* by cut->/=->//=:=ch_neq0 _ _ H_hs_spec;progress;cut[]hh1 hh2 hh3:=H_mh_spec;smt(dom_hs_neq_ch). *) -(* move=>H2_pi_spec;split. *) -(* + (* mh_spec *) *) -(* (* cut: *) *) -(* (* (forall (xa : block) (hx : handle) (ya : block) (hy : handle), *) *) -(* (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})].[( *) *) -(* (* xa, hx)] = Some (ya, hy) => *) *) -(* (* exists (xc : capacity) (fx : flag) (yc : capacity) (fy : flag), *) *) -(* (* FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)].[hx] = Some (xc, fx) /\ *) *) -(* (* FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)].[hy] = Some (yc, fy) /\ *) *) -(* (* if fy = Known then G1.m{2}.[(xa, xc)] = Some (ya, yc) /\ fx = Known *) *) -(* (* else *) *) -(* (* exists (p1 : block list) (v : block), *) *) -(* (* F.RO.m{2}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- b2].[ *) *) -(* (* rcons p1 (v +^ xa)] = Some ya /\ build_hpath *) *) -(* (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- *) *) -(* (* (b2, G1.chandle{2})] p1 = Some (v, hx)) *) *) -(* (* && *) *) -(* (* (forall (p1 : block list) (v : block) (p2 : block list) (v' : block) (hx : handle), *) *) -(* (* build_hpath *) *) -(* (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) *) -(* (* p1 = Some (v, hx) => *) *) -(* (* build_hpath *) *) -(* (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) *) -(* (* p2 = Some (v', hx) => p1 = p2 /\ v = v') *) *) -(* (* && *) *) -(* (* (forall (p1 : block list) (bn b : block), *) *) -(* (* F.RO.m{2}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- b2].[rcons p1 bn] = *) *) -(* (* Some b <=> *) *) -(* (* exists (v : block) (hx hy : handle), build_hpath *) *) -(* (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] p1 = *) *) -(* (* Some (v, hx) /\ *) *) -(* (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})].[(v +^ bn, hx)] = Some (b, hy)); *) *) -(* (* last by progress;split=>/#. *) *) -(* split=>//=. *) -(* - move=>x hx y hy;rewrite !getP. *) -(* case((x, hx) = (sa{2} +^ nth witness p{2} i{2}, h{2}))=>//=. *) -(* * move=>[->> ->>][<<- <<-]/=. *) -(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. *) -(* rewrite h_flag/=. *) -(* exists sc{1} flag c2 Unknown=>//=. *) -(* by exists (take i{2} p{2}) (sa{2})=>//=;rewrite getP Block.WRing.addKr/=;apply build_hpath_up=>//=/#. *) -(* move=> neq h1. *) -(* cut[]hh1 hh2 hh3:=H_mh_spec. *) -(* cut[]xc hxx yc hyc []h2[]h3 h4:=hh1 _ _ _ _ h1. *) -(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h2. *) -(* cut->/=:=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 getP. *) -(* cut->/=:=build_hpath_up _ _ _ b2 G1.chandle{2} _ _ _ hb h_g1. *) -(* cut/#:!rcons p0 (b +^ x) = rcons (take i{2} p{2}) (nth witness p{2} i{2});move:neq;apply absurd=>//=h'. *) -(* cut<<-:take i{2} p{2}=p0 by rewrite/#. *) -(* cut hbex:b +^ x = nth witness p{2} i{2} by rewrite/#. *) -(* by cut:=hb;rewrite hpath/==>[][->>->>]/=;rewrite-hbex Block.WRing.addKr/=. *) -(* - progress. search build_hpath. *) -(* * move:H;rewrite getP/=. *) -(* case(p0 = (take i{2} p{2}))=>[->>|hpp0]. search build_hpath None. *) -(* + cut->/=:=build_hpath_up _ _ _ b2 G1.chandle{2} _ _ _ hpath h_g1. *) -(* case(bn = (nth witness p{2} i{2}))=>[->>/=->>|hbni]/=. *) -(* - by exists sa{2} h{2} G1.chandle{2}=>//=;rewrite getP/=. *) -(* cut->/=:!rcons (take i{2} p{2}) bn = rcons (take i{2} p{2}) (nth witness p{2} i{2}). *) -(* - move:hbni;apply absurd=>//=h. *) -(* cut->:bn = nth witness (rcons (take i{2} p{2}) bn) i{2}. *) -(* * by rewrite nth_rcons size_take /#. *) -(* by rewrite h nth_rcons size_take /#. *) -(* move=>h_ro_p_bn. *) -(* cut[]_ hh4 _:=H_mh_spec. *) -(* by cut:=hh4 (take i{2} p{2}) bn b;rewrite h_ro_p_bn/=hpath/=;smt(getP @Block.WRing). *) -(* cut->/=:!rcons p0 bn = rcons (take i{2} p{2}) (nth witness p{2} i{2}). *) -(* + move:hpp0;apply absurd=>/=h. *) -(* cut:size p0 = size (take i{2} p{2}) by smt(size_rcons). *) -(* move:h;pose p' := take i{2} p{2};pose e := nth witness p{2} i{2}. *) -(* by move=>h h';move:p0 p' h' bn e h;apply seq2_ind=>//=/#. *) -(* move=>h_ro_p_bn. *) -(* cut[]_ hh4 _:=H_mh_spec. *) -(* cut:=hh4 p0 bn b;rewrite h_ro_p_bn/==>[][];progress. *) -(* cut help:(sa{2} +^ nth witness p{2} i{2}, h{2}) <> (v +^ bn, hx) by rewrite/#. *) -(* exists v hx hy=>//=;rewrite getP;rewrite eq_sym in help;rewrite help/=H0/=. *) -(* by apply build_hpath_up=>//=. *) -(* move:H H0;rewrite!getP=>h_build_hpath_set. *) -(* case(hy = G1.chandle{2})=>//=[->>|hy_neq_ch]/=. *) -(* + move=>h;cut h_eq:v +^ bn = sa{2} +^ nth witness p{2} i{2} && hx = h{2}. *) -(* + cut/#:G1.mh{2}.[(v +^ bn, hx)] <> Some (b, G1.chandle{2}). search hs_spec. *) -(* cut[]_ hh2:=H_m_mh. *) -(* cut:=hh2 (v +^ bn) hx b G1.chandle{2}. *) -(* case(G1.mh{2}.[(v +^ bn, hx)] = Some (b, G1.chandle{2}))=>//=. *) -(* rewrite negb_exists/=;progress; *) -(* rewrite negb_exists/=;progress; *) -(* rewrite negb_exists/=;progress; *) -(* rewrite negb_exists/=;progress;rewrite !negb_and. *) -(* by cut[]/#:=H_hs_spec. *) -(* cut[]eq_xor ->>:=h_eq. *) -(* move:h;rewrite h_eq/==>->>. *) -(* cut/#:!(p0 = (take i{2} p{2}) /\ bn = (nth witness p{2} i{2})) => *) -(* F.RO.m{2}.[rcons p0 bn] = Some b. *) -(* move:h_flag;case:flag=>h_flag;last first. *) -(* - cut:=known_path_uniq _ _ _ sc{1} h{2} p0 v (take i{2} p{2}) sa{2} H2_pi_spec _ h_build_hpath_set _. *) -(* * rewrite getP/=h_flag. *) -(* by cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. search build_hpath. *) -(* * by apply build_hpath_up=>//=. *) -(* move=>[]->>->>/=;smt(@Block.WRing). *) -(* cut[]hh1 hh2 hh3:=H_mh_spec. *) -(* cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b p0 v h{2}. *) -(* rewrite h_build_hpath_set/=h_g1/=. *) -(* cut->/=:=ch_neq0 _ _ H_hs_spec. *) -(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. *) -(* move=>help;cut:= 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=>//=. *) -(* by cut:=hh3 _ _ _ _ _ hpath h_build_hpath_p0;smt(@Block.WRing). *) -(* move=>help;cut h_neq:! (v +^ bn = sa{2} +^ nth witness p{2} i{2} && hx = h{2}) by rewrite/#. *) -(* move:help;rewrite h_neq/==>h_g1_v_bn_hx. *) -(* cut[]hh1 hh2 hh3:=H_mh_spec. *) -(* cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. *) -(* rewrite h_build_hpath_set/=h_g1/=. *) -(* cut->/=:=ch_neq0 _ _ H_hs_spec. *) -(* by cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag;smt(dom_hs_neq_ch). *) -(* progress. *) -(* + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. *) -(* cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p' v' hx. *) -(* rewrite H H0/=. *) -(* cut->/=:=ch_neq0 _ _ H_hs_spec. *) -(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. *) -(* rewrite h_g1/=. *) -(* by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). *) -(* cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. *) -(* cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p' v' hx. *) -(* rewrite H H0/=. *) -(* cut->/=:=ch_neq0 _ _ H_hs_spec. *) -(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. *) -(* rewrite h_g1/=. *) -(* by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). *) -(* move=>H2_mh_spec;split;progress. *) -(* + by cut[]:=H_m_p;smt(getP size_rcons size_eq0 size_ge0). *) -(* move:H;rewrite dom_set in_fsetU1. *) -(* case(l \in dom Redo.prefixes{1})=>//=hdom. *) -(* + cut[]_ h:=H_m_p. *) -(* cut[]sa' sc'[]h_pref h_pref2:=h _ hdom i0 _;1:rewrite/#. *) -(* exists sa' sc';rewrite!getP/=. *) -(* cut->/=:!take i0 l = rcons (take i{2} p{2}) (nth witness p{2} i{2}) by smt(in_dom). *) -(* rewrite h_pref/=. *) -(* cut->/=:!take (i0 + 1) l = rcons (take i{2} p{2}) (nth witness p{2} i{2}) by smt(in_dom take_size). *) -(* rewrite-h_pref2/=. *) -(* by cut->/=:! (sa' +^ nth witness l i0 = sa{2} +^ nth witness p{2} i{2} && sc' = sc{1}) by smt(in_dom take_size). *) -(* move=>->>;case(i0=i{2})=>[->>|i0_neq_i]//=. *) -(* + exists sa{2} sc{1}=>//=;rewrite!getP/=. *) -(* move:H1;rewrite !size_rcons !size_take//. *) -(* rewrite!nth_rcons-take_nth// !take_take!size_take 1:/#. *) -(* cut->/=hii:i{2}< size p{2} by rewrite/#. *) -(* rewrite !min_lel 1,2:/#. *) -(* by cut->/=:! take i{2} p{2} = take (i{2} + 1) p{2} by smt(size_take). *) -(* move:H1;rewrite !size_rcons !size_take//1:/#. *) -(* rewrite!nth_rcons-take_nth// !take_take!size_take 1:/#. *) -(* cut->/=hii:i{2}< size p{2} by rewrite/#. *) -(* rewrite i0_neq_i/=!min_lel 1,2:/#. *) -(* cut->/=:i0 < i{2} by rewrite/#. *) -(* rewrite!getP. *) -(* cut->/=:! take i0 p{2} = take (i{2} + 1) p{2} by smt(size_take). *) -(* cut[]_ h_pref:=H_m_p. *) -(* cut[]:= h_pref (take i{2} p{2}) _ i0 _;1:smt(in_dom);1:smt(size_take). *) -(* move=>b3 c3;rewrite!take_take!min_lel 1,2:/#=>[][]-> h. *) -(* cut->/=:!take (i0 + 1) p{2} = take (i{2} + 1) p{2} by smt(size_take). *) -(* exists b3 c3=>//=;rewrite getP/=. *) -(* cut/#:!(b3 +^ nth witness (take i{2} p{2}) i0 = sa{2} +^ nth witness p{2} i{2} && *) -(* c3 = sc{1}). *) -(* cut:(b3 +^ nth witness (take i{2} p{2}) i0, c3) \in dom PF.m{1};2:smt(in_dom). *) -(* cut:take (i0 + 1) p{2} \in dom Redo.prefixes{1};2:smt(in_dom). *) -(* cut->:take (i0 + 1) p{2} = take (i0 + 1) (take i{2} p{2});1:smt(take_take). *) -(* smt(in_dom take_oversize). *) -(* qed. *) - - -equiv PFf_Cf (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1'(D).C.f : - ! (G1.bcol{2} \/ G1.bext{2}) /\ - ={p} /\ - 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} ==> - ! (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}. -proof. -exists*p{1};elim* =>input;case(input = [])=>input_nil;1:rewrite input_nil;2:conseq(PFf_Cf_not_nil D);progress. -proc;inline*;auto;sp. -by rcondf{1}1;auto;rcondf{2}1;auto;rcondf{2}1;auto. -qed. - - -section AUX. - - declare module D : DISTINGUISHER {PF, RO, G1, Redo}. - - 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(D).main ~ G1'(D).main: - ={glob D} ==> !(G1.bcol \/ G1.bext){2} => ={res}. - proof. - proc. - call (_: G1.bcol \/ G1.bext, - 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}). - (* 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} - /\ 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} - ==> !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}). - + by move=> &1 &2; rewrite negb_or. - + by move=> &1 &2 _ ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? [#]; rewrite negb_or. - (* 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. *) - (* We want to name everything for now, to make it easier to manage complexity *) +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 dom 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}, + 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 [] x1 x2. + 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) - (eq_refl (INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref)); last first. + 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. @@ -2550,11 +1536,12 @@ section AUX. /\ 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). + /\ 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_notin_rng_hs0; rcondt{2} 3. @@ -2576,7 +1563,7 @@ section AUX. 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 [#] !<<- -> -> !->> {&1} /= _ x2_neq_y2 y2_notin_hs _ _. + + auto=> &1 &2 [#] !<<- -> -> !->> /= _ x2_neq_y2 y2_notin_hs. rewrite getP /= oget_some /= -addzA /=. rewrite (@huniq_hinvK_h ch0 hs0.[ch0 <- (x2,Known)] x2); 2:by rewrite getP. + move=> @/huniq h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. @@ -2585,16 +1572,21 @@ section AUX. + by move=> + _ + [#] <*> - <*>; move: (x2f_notin_rng_hs0 f1 h1). have /hs_of_INV [] + _ _ _ _ - h := inv0. by apply/h; rewrite getP. - by rewrite oget_some; exact/lemma1. + rewrite !oget_some;rewrite in_dom;cut[]_ -> _ _ _ /=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + smt(lemma1). conseq (_: _ ==> G1.bcol{2})=> //=. - auto=> &1 &2 [#] !<<- -> _ ->> !<<- _ /=. + + by auto=> &1 &2 [#] !<<- bad1 bad2 -> _ ->> !<<- _ /=/>; + rewrite in_dom;cut[]_ ->_ _ _/=:=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 getP. move=> h; have:= hs0_spec h f; rewrite getP; 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. - + by move=> x2_is_U; conseq (_: G1.bext{2})=> //=; auto=> &1 &2 />; rewrite x2_is_U. + + move=> x2_is_U; conseq (_: G1.bext{2})=> //=; auto=> &1 &2 /> _ _ hinv0 . + + by rewrite in_dom;cut[]_ -> _ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + rewrite/#. move=> x2_is_K; rcondf{2} 3; 1:by move=> &1; auto. have:= x2_is_K; rewrite in_rng=> - [hx] hs0_hx. seq 0 3: ( hs0 = FRO.m{2} @@ -2608,13 +1600,14 @@ section AUX. /\ 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). + /\ INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref queries). + auto=> &1 &2 /> _ -> /= _; split. + move: x2_is_K; rewrite in_rng /= => -[hx2] hs_hx2. rewrite in_rng negb_exists /==> h; rewrite -negP=> hs_h. @@ -2630,9 +1623,10 @@ section AUX. by rewrite hs0_hx=> [#] <*>; rewrite PFm_x1x2. rcondf{2} 1. + by move=> &m; auto=> //= &hr [#] <*>; rewrite x1hx_notin_G1m. - auto=> &1 &2 [#] !<<- -> -> !->> _ /= hinv_y2_none. - rewrite getP /= oget_some /=; apply/lemma2=> //. - + by case: (hinvP hs0 y2{2})=> [_ + f h|//=] - ->. + auto=> &1 &2 [#] !<<- -> -> !->> _ /=. + rewrite in_dom;cut[]_ -> _ _ _ /=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + case(hinv hs0 y2{2} = None)=>//=h; + rewrite getP /= oget_some /=;smt(lemma2 hinvP). move=> [p0 v0] ^ pi_x2. have /pi_of_INV [] -> [hx2] [#] Hpath hs_hx2:= inv0. rcondt{2} 1. by move=> &m; auto=> &hr [#] !<<- _ _ ->> /= _; rewrite in_dom pi_x2. rcondf{2} 6. @@ -2662,7 +1656,8 @@ section AUX. auto => &m1 &m2 [#] !<- _ _ -> /= _ y1L -> y2L -> /=. rewrite !getP_eq pi_x2 !oget_some /=. have /hs_of_INV [] Hu _ _:= inv0; have -> := huniq_hinvK_h _ _ _ Hu hs_hx2. - rewrite oget_some => /= ? Hy2L . + rewrite oget_some in_dom => /= ;cut[]_->_ _ _/=:=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. @@ -2676,7 +1671,7 @@ section AUX. + 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 Hy2L => H _ + /H {H} [hx fx hy fy] [#]. + case: Hmmhi hinv0 => H _ + /H {H} [hx fx hy fy] [#]. by case: (hinvP hs0 y2L)=> [_ ->|//]/#. + by apply inv_addm=>//; apply (ch_notin_dom2_mh _ _ Hmmhi Hhs). + by apply (m_mh_addh_addm _ Hmmh _ hs_hx2)=>//;apply ch_notin_dom_hs. @@ -2741,11 +1736,13 @@ section AUX. split;1: by move=> [_ /(dom_hs_neq_ch _ _ _ _ _ Hhs)]. by move=> /= [_ <<-];move:Hc. split. - by cut[]/#:=Hmp. - cut[]_ h l hdom i hi:=Hmp. - cut[]b c[]->h':=h l hdom i hi. - by exists b c=>//=;rewrite getP/=-h';smt(in_dom take_oversize). - + + by cut[]/#:=Hmp. + + by cut[]/#:=Hmp. + + cut[]_ _ h _ _ l hdom i hi:=Hmp. + cut[]b c[]->h':=h l hdom i hi. + by exists b c=>//=;rewrite getP/=-h';smt(in_dom take_oversize). + + by cut[]/#:=Hmp. + + by cut[]/#:=Hmp. move=> [xa xc] PFm_x1x2. rcondf{1} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom PFm_x1x2. have /m_mh_of_INV [] + _ - /(_ _ _ _ _ PFm_x1x2) := inv0. move=> [hx2 fx2 hy2 fy2] [#] hs_hx2 hs_hy2 G1mh_x1hx2. @@ -2759,12 +1756,18 @@ section AUX. move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0}. 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: (G1.bext{2}); last by inline*; if{2}; auto; smt (@Block @Capacity). - by auto=> ? ? [#] !<<- _ -> ->> _ /=; rewrite in_rng; exists hx2. + + swap{2} 3 -2; seq 0 1: (queries = C.queries{2} /\ G1.bext{2}). + - by auto=> ? ? [#] !<<- _ -> ->> _ /=; rewrite in_rng; 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 in_dom;cut[]_->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + inline*; if{2}; auto; smt (@Block @Capacity). have /mh_of_INV []/(_ _ _ _ _ G1mh_x1hx2) + _ _:= inv0. move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0} /= [p0 v0] [#] Hro Hpath. have /pi_of_INV [] /(_ x2 p0 v0) /iffRL /(_ _) := inv0. - + by exists hx2. + + by exists hx2=>/#. move=> pi_x2; rcondt{2} 1; 1:by auto=> &hr [#] <*>; rewrite in_dom pi_x2. inline F.RO.get. rcondf{2} 4; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite pi_x2 oget_some /= in_dom Hro. @@ -2779,65 +1782,970 @@ section AUX. move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 !oget_some //=. rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. + by have /hs_of_INV []:= inv0. - rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //= => _. - exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). - (* lossless PF.f *) - + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. - smt (@Block.DBlock @Capacity.DCapacity). - (* lossless and do not reset bad G1.S.f *) - + move=> _; proc; 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 *) - + transitivity G1(D).S.fi - (! (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} - ==> ! (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}) - (={glob G1(D).S, x} ==> ={glob G1(D).S, res});progress;1:rewrite/#. - - by conseq (eq_fi D)=> /#. - by proc;inline*;sim. - (* lossless PF.P.fi *) - + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. - smt (@Block.DBlock @Capacity.DCapacity). - (* lossless and do not reset bad G1.S.fi *) - + move=> _; proc; if; 2:by auto. - by wp; do 2!rnd predT; auto => &hr [#]; smt (@Block.DBlock @Capacity.DCapacity). - (** proofs for G1.C.f *) - (* equiv PF.C.f G1.C.f *) - + conseq(PFf_Cf D);auto;progress. - (* lossless PF.C.f *) - + move=> &2 _; proc; inline *; 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. - case(p = [])=>//=. - - by sp;rcondf 1;auto;sp;rcondf 1;auto. - rcondt 6;first by auto;while(p <> []);auto;sp;if;auto. - wp;rnd predT; auto. + rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //=in_dom. + cut[]_->_ _ _//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + case((x2, Unknown) \in rng hs0)=>//=_. + exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). + progress;cut[]//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H1;smt(in_dom). +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 => !mem (dom m2) x => incl m1 m2.[x <- y]. +proof. + move=> Hincl Hdom w ^/Hincl <- => Hw. + rewrite getP_neq // -negP => ->>. + by move: Hdom;rewrite in_dom. +qed. + + + +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 (mem (dom mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; + } else { + if (counter < size p - prefixe p (get_max_prefixe p (elems (dom 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 (!mem (dom m) x) { + if (mem (dom paths) x.`2) { + (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 \/ mem (rng FRO.m) (x.`2, Unknown); + if (!(mem (rng FRO.m) (x.`2, Known))) { + FRO.m.[chandle] <- (x.`2, Known); + chandle <- chandle + 1; + } + hx2 <- oget (hinvK FRO.m x.`2); + if (mem (dom mh) (x.`1, hx2) /\ 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 (mem (dom paths) x.`2) { + (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 (!mem (dom mi) x) { + bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); + if (!(mem (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 (mem (dom mhi) (x.`1,hx2) /\ + 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 <- map0; + m <- map0; + mi <- map0; + mh <- map0; + mhi <- map0; + bext <- false; + bcol <- false; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + FRO.m <- map0.[0 <- (c0, Known)]; + paths <- map0.[c0 <- ([<:block>],b0)]; + chandle <- 1; + b <@ D(M,S).distinguish(); + return b; + } +}. + + +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 dom 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. +cut[]_ _ H _ _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. +cut[]sa sc:=H _ H_take_iS i _;1:smt(size_take). +rewrite!take_take !min_lel//= 1:/# nth_take 1,2:/#H_take_i=>[][]/=[->>->>] H_pm. +cut[]b' c' H_Pm:exists b' c', Pm.[(sa +^ nth witness p i, sc)] = Some (b',c') by smt(in_dom). +exists b' c';rewrite -H_Pm/=. +cut[]h_Pm _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. +cut[]h' f' hy fy[]H_h'[]H_hy H_mh:=h_Pm _ _ _ _ H_Pm. +cut[]h_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. +cut[]f H_h := H_hs_h. +cut/=<<-:=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. + cut[]b1 h1 H_mh1:exists b1 h1, mh.[(b +^ nth witness p i, h)] = Some (b1,h1) by rewrite/#. + cut[]H_Pm H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. + by cut/#:=H_Gmh _ _ _ _ H_mh1. +cut[]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(get_oget in_dom). +cut[]H_P_m H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. +cut:=H_P_m _ _ _ _ H_Pm1. +by cut[]/#:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. +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 dom 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 dom_set in_fsetU1 in_dom;left;cut[]_->_ _ _//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0. + + smt(dom_set in_fsetU1). + + smt(dom_set in_fsetU1). + + smt(dom_set in_fsetU1). + 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(in_dom 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 < prefixe p (get_max_prefixe p (elems (dom C.queries))). + splitwhile{2} 1 : i < prefixe p (get_max_prefixe p (elems (dom C.queries))). + + seq 1 1 : (={p, i, glob C, bs} /\ bs{2} = p{2} /\ + (prefixe p (get_max_prefixe p (elems (dom C.queries))) = i){2} /\ + (Redo.prefixes.[take i p]{1} = Some (sa,sc){1}) /\ + (take i p \in dom Redo.prefixes){1} /\ + (C.queries.[[]] = Some b0){1} /\ + (! p{2} \in dom 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 <= prefixe p (get_max_prefixe p (elems (dom C.queries)))){2} /\ + (Redo.prefixes.[take i p]{1} = Some (sa,sc){1}) /\ + (take i p \in dom Redo.prefixes){1} /\ + (C.queries.[[]] = Some b0){1} /\ + (! p{2} \in dom 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(@Prefixe). + * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom). + * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom). + * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom set_eq). + * by cut[]:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom). + * smt. + * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom size_take size_eq0). + * smt(prefixe_sizel). + + case(G1.bcol{2} \/ G1.bext{2}). + - by if{1};auto;conseq(:_==> (G1.bcol{2} \/ G1.bext{2}));1,3:smt(get_oget in_dom getP); + (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} <= prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) /\ + Redo.prefixes{1}.[take i{1} p{1}] = Some (sa{1}, sc{1}) /\ + (C.queries.[[]] = Some b0){1} /\ (! p{2} \in dom C.queries{2}) /\ + (take i{1} p{1} \in dom 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} < prefixe p{1} (get_max_prefixe p{1} (elems (dom C.queries{1})))) /\ + i{2} < size p{2} /\ + i{2} < prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) /\ + ! (G1.bcol{2} \/ G1.bext{2}) /\ (take (i+1) p \in dom Redo.prefixes){1} /\ + 0 < size p{2} + ==>_);progress. + - cut:=prefixe_gt0_mem p{2} (elems (dom C.queries{2})) _;1:rewrite/#. + rewrite-memE=>H_dom_q. + cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H12. + cut[]_ _ h1 h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut:=h2 (get_max_prefixe p{2} (elems (dom C.queries{2}))) _;1:rewrite /#. + move=>[]c; + cut H_dom_p:get_max_prefixe p{2} (elems (dom C.queries{2})) \in dom Redo.prefixes{1} by smt(in_dom). + cut->/=:=prefixe_take_leq p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) (i{2}+1) _;1:rewrite/#. + smt(in_dom take_oversize prefixe_sizer). + rcondt{1}1;1:auto;progress. + rcondt{2}1;1:auto;progress. + - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. + cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{hr} p{hr} sa{hr} sc{m} h{hr} HINV _ _ _ _. + * by rewrite H0/=H7/=. + * smt(in_dom). + * rewrite/#. + * rewrite/#. + by move=>[]b2 c2 h2[]H_PFm H_Gmh;rewrite in_dom H_Gmh/=. + auto;progress. + - rewrite /#. + - rewrite /#. + - rewrite /#. + - smt(get_oget in_dom). + - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO/#:=H6 H11. + - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. + cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + * by rewrite H0/=H7/=. + * smt(in_dom). + * rewrite/#. + * rewrite/#. + move=>[]b2 c2 h2[]H_PFm H_Gmh. + rewrite H_Gmh/=oget_some/=. + cut[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). + by rewrite!take_take !min_lel 1,2:/# nth_take 1,2:/# H2/==>[][]->>->><-;rewrite H_PFm oget_some. + - rewrite/#. + - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. + cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + * by rewrite H0/=H7/=. + * smt(in_dom). + * rewrite/#. + * rewrite/#. + move=>[]b2 c2 h2[]H_PFm H_Gmh. + cut[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). + rewrite!take_take !min_lel 1,2:/# nth_take 1,2:/# H2/=H_Gmh oget_some=>[][]<<-<<-<-. + rewrite H_PFm oget_some/=. + by cut[]help1 help2/# :=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. + cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + * by rewrite H0/=H7/=. + * smt(in_dom). + * rewrite/#. + * rewrite/#. + move=>[]b2 c2 h2[]H_PFm H_Gmh. + by rewrite H_Gmh/=oget_some/=(@take_nth witness) 1:/# build_hpath_prefix/#. + - rewrite/#. + - rewrite/#. + - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. + cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + * by rewrite H0/=H7/=. + * smt(in_dom). + * rewrite/#. + * rewrite/#. + move=>[]b2 c2 h2[]H_PFm H_Gmh. + cut[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). + rewrite!take_take !min_lel 1,2:/# nth_take 1,2:/# H2/==>[][]<<-<<-<-. + rewrite H_PFm/=oget_some/=(@take_nth witness)1:/#. + by cut[]help1 help2/# :=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + + alias{1} 1 prefixes = Redo.prefixes;sp. + alias{2} 1 bad1 = G1.bcol;sp. + (* 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} prefixes{1} *) + (* C.queries{2} /\ (! (bad1{2} \/ G1.bext{2})) /\ *) + (* Redo.prefixes{1}.[take i{2} p{2}] = Some (sa{1}, sc{1}) /\ *) + (* (forall l, l \in dom prefixes{1} => *) + (* prefixes{1}.[l] = Redo.prefixes{1}.[l]) /\ *) + (* (forall l, l \in dom Redo.prefixes{1} => *) + (* exists l2, l ++ l2 = take i{2} p{2} \/ l ++ l2 \in dom C.queries{2}) /\ *) + (* (forall l, l \in dom Redo.prefixes{1} => *) + (* l \in dom prefixes{1} \/ exists j, 0 <= j < i{2} /\ take j p{2} = l) /\ *) + (* (forall j, 0 <= j < i{1} => exists (sa : block) (sc : capacity), *) + (* Redo.prefixes{1}.[take j p{2}] = Some (sa, sc) /\ *) + (* PF.m{1}.[(sa +^ nth witness p{2} j, sc)] = *) + (* Redo.prefixes{1}.[take (j + 1) p{2}]) /\ *) + (* ={sa} /\ F.RO.m{2}.[p{2}] = Some sa{1}));progress. *) + (* + cut[]HINV[]H_bad1[]H_prefixe[]H_pref[]H_pref2[]H_pref3[]H_pref4[]->> H_m_R0:=H6 H7. *) + (* cut[]HINV'[]->>[]->>[]H_h[]H_path H_F_RO:=H3 H_bad1. *) + (* rewrite take_size;split;..-2:by case:HINV=>//=. *) + (* cut[]H01 H02 H_m_p1 H_m_p2 H_m_p3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ *) + (* HINV;split=>//=. *) + (* - cut[]H01' H02' H_m_p1' H_m_p2' H_m_p3':=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ *) + (* HINV'. *) + (* smt(in_dom). *) + (* - smt(in_dom getP). *) + (* - move=>l H_l_dom j Hj. *) + (* cut[]:=H_pref3 _ H_l_dom. *) + (* * move=>H_dom;cut:=H_m_p1 l H_dom j Hj;smt(in_dom take_oversize). *) + (* move=>[]k [][Hk0 Hk] <<-. *) + (* move:Hj;rewrite size_take 1:/# Hk/==>[][]Hj0 Hjk. *) + (* rewrite!take_take!min_lel// 1,2:/# nth_take 1,2:/#;smt(in_dom take_oversize). *) + (* - smt(dom_set in_fsetU1 getP dom_set in_dom take_size). *) + (* move=>l H_dom;cut:=H_pref3 l H_dom. *) + (* case(l \in dom Redo.prefixes{1})=>H_dom1/=;1:smt(dom_set in_fsetU1). *) + (* move=>[]j[][]Hj0 Hj_size <<-. *) + (* by exists (drop j p{2});rewrite cat_take_drop dom_set in_fsetU1. *) + (* + by rewrite/#. *) + (* + by rewrite/#. *) + + while ( ={i, p, C.queries, C.c} + /\ prefixe p{2} (get_max_prefixe p{2} (elems (dom 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 dom 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 dom prefixes{1} => prefixes{1}.[l] = Redo.prefixes{1}.[l]) + /\ (forall (l : block list), l \in dom Redo.prefixes{1} => + (l \in dom prefixes{1}) \/ + exists (j : int), 0 <= j <= i{2} /\ take j p{2} = l) + /\ ={sa} + /\ counter{2} <= i{2} - prefixe p{2} + (get_max_prefixe p{2} (elems (dom 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 dom Redo.prefixes{1})));last first. + + auto;progress. + - smt(prefixe_sizel). + - cut[]HINV _:=H3 H6;split;..-2:case:HINV=>//=. + by cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV; + split=>//=;smt(take0 getP dom_set in_fsetU1 take_oversize take_le0). + - by cut[]HINV _:=H3 H6;cut:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + - rewrite/#. + - rewrite/#. + - rewrite/#. + - rewrite/#. + - rewrite/#. + - rewrite/#. + - rewrite/#. + - rewrite/#. + - cut[]HINV[]->>[]->>[]H_h[]H_path H_F_RO:=H3 H6. + cut[]H01 H02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut H_pref_eq:=prefixe_exchange_prefixe_inv (elems (dom C.queries{2})) + (elems (dom Redo.prefixes{1})) p{2} _ _ _. + * smt(memE in_dom). + * smt(memE in_dom take_oversize size_take take_take nth_take take_le0). + * smt(memE in_dom take_oversize size_take take_take nth_take take_le0). + by rewrite memE prefixe_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 dom Redo.prefixes{1}) + /\ (G1.bcol{2} \/ G1.bext{2}));1:smt(prefixe_ge0). + if{1};sp;2:if{1};(if{2};2:if{2});sp;auto;5:swap{2}4-3;auto; + smt(getP get_oget dom_set in_fsetU1 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. + cut[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{hr} bs{m} sa{hr} sc{m} h{hr} HINV _ _ _. + - smt(prefixe_ge0). + - exact H1. + - exact H_h. + by cut:=H7;rewrite !in_dom=>->/=/#. + + progress. + - rewrite/#. + - rewrite/#. + - by rewrite getP. + - cut[]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=>//=. + cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV;split=>//=. + * smt(getP size_take size_eq0 size_ge0 prefixe_ge0). + * by cut[]_ Hmp02' _ _ _:=H_m_p0; + smt(getP size_take size_eq0 size_ge0 prefixe_ge0 take0). + * move=>l;rewrite!dom_set !in_fsetU1. + case(l = take (i{2} + 1) bs{1})=>//=[->>|]. + + move=>j;rewrite size_take;1:smt(prefixe_ge0). + cut->/=:(if i{2} + 1 < size bs{1} then i{2} + 1 else size bs{1}) = i{2} + 1 by rewrite/#. + move=>[]H0j HjiS;rewrite!getP. + cut->/=:! take j (take (i{2} + 1) bs{1}) = take (i{2} + 1) bs{1} by smt(size_take). + rewrite!take_take!min_lel 1,2:/# nth_take 2:/#;1:smt(prefixe_ge0). + case(j < i{2})=>Hij. + - cut->/=:!take (j + 1) bs{1} = take (i{2} + 1) bs{1} by smt(size_take). + by cut:=Hmp1(take i{2} bs{1}) _ j _; + smt(in_dom take_take nth_take prefixe_ge0 size_take). + cut->>:j = i{2} by rewrite/#. + by exists sa{2} sc{1};rewrite H1/=;smt(get_oget). + move=>h H_dom j []Hi0 Hisize;rewrite!getP. + cut->/=:!take j l = take (i{2} + 1) bs{1} by smt(in_dom take_oversize size_take take_take). + by cut->/=/#:!take (j+1) l = take (i{2} + 1) bs{1} + by smt(in_dom take_oversize size_take take_take). + * move=>l;rewrite dom_set in_fsetU1. + case(l = take (i{2} + 1) bs{1})=>//=[->>|]. + + by rewrite!getP/=oget_some/=/#. + move=>h H_dom;rewrite!getP h/=. + cut[]H2mp01 H2mp02 H2mp1 H2mp2 H2mp3:=H_m_p0. + rewrite-Hp1;1:smt(in_dom). + by apply H2mp2. + move=>l;rewrite !dom_set !in_fsetU1. + case(l = take (i{2} + 1) bs{1})=>//=[->>|]. + + by exists []; smt(cats0 dom_set in_fsetU1). + move=>H_neq H_dom;cut[]l1:=Hmp3 _ H_dom;rewrite!dom_set!in_fsetU1;case=>H_case. + + exists l1;by rewrite in_fsetU1 H_case. + exists (rcons l1 (nth witness bs{1} i{2}));rewrite in_fsetU1;right. search rcons (++). + by rewrite-rcons_cat (@take_nth witness);smt(prefixe_ge0). + - rewrite/#. + - rewrite/#. + - smt(in_dom getP). + - move:H9;rewrite dom_set in_fsetU1;case;smt(prefixe_ge0). + - cut[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + - smt(prefixe_ge0). + - exact H1. + - exact H_h. + by cut:=H7;rewrite !in_dom=>->/=/#. + - rewrite/#. + - cut[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + - smt(prefixe_ge0). + - exact H1. + - exact H_h. + cut:=H7;rewrite !in_dom=>->/=[]b4 c4 h4[]H_PFm H_Gmh;rewrite H_PFm H_Gmh !oget_some/=. + cut[]_ help:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut:=help _ _ _ _ H_Gmh. + by cut[]f H_h':=H_h;rewrite H_h'/==>[][]a b c d[][]->>->>[];rewrite H_PFm/==>[]h'->>/#. + - cut[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + - smt(prefixe_ge0). + - exact H1. + - exact H_h. + cut:=H7;rewrite !in_dom=>->/=[]b4 c4 h4[]H_PFm H_Gmh. + rewrite (@take_nth witness);1:smt(prefixe_ge0). + by rewrite build_hpath_prefix H_path/=;smt(get_oget in_dom). + - smt(prefixe_ge0). + - smt(prefixe_ge0). + - cut[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + - smt(prefixe_ge0). + - exact H1. + - exact H_h. + cut:=H7;rewrite !in_dom=>->/=[]b4 c4 h4[]H_PFm H_Gmh. + rewrite(@take_nth witness);1:smt(prefixe_ge0). + cut[]_ help H_uniq_path:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by rewrite help H_path;smt(get_oget in_dom). + - cut[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + rewrite dom_set in_fsetU1 negb_or/=;split;2:smt(size_take prefixe_ge0 take_oversize). + cut:=Hp2 (take (i{2} + 1 + 1) bs{1}). + pose P:= _ \/ _;cut/#:!P;rewrite/P;clear P;rewrite negb_or/=negb_exists/=;split. + * cut:=prefixe_exchange_prefixe_inv(elems (dom C.queries{2}))(elems (dom prefixes{1}))bs{1} _ _ _. + + by cut[]:=H_m_p0;smt(in_dom memE). + + cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=H_m_p0. + by cut:=all_prefixes_of_m_p _ _ _ H_m_p0;smt(memE in_dom). + + by cut[]:=H_m_p0;smt(memE in_dom). + by move=>H_pref_eq;rewrite memE prefixe_lt_size//= -H_pref_eq/#. + by move=>j;case(0<=j<=i{2})=>//=[][]Hj0 Hji;smt(size_take prefixe_ge0 take_le0). + + progress. + cut[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{hr} bs{m} sa{hr} sc{m} h{hr} HINV _ _ _. + - smt(prefixe_ge0). + - exact H1. + - exact H_h. + by cut:=H7;rewrite !in_dom=>/=->/=. + rcondt{2}1;1:auto=>/#. + rcondt{2}5;auto;progress. + * rewrite(@take_nth witness);1:smt(prefixe_ge0);rewrite in_dom. + cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_i:=H3 H6. + cut[]:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{hr} bs{m} sa{hr} sc{m} h{hr} HINV _ _ _. + * smt(prefixe_ge0). + * rewrite/#. + * rewrite/#. + cut:=H7;rewrite in_dom =>/=->/=H_Gmh _ H_ H_path_uniq. + cut help:=H_ (take i{hr} bs{m}) (nth witness bs{m} i{hr});rewrite H_path/= in help. + cut: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. + by cut:=get_oget F.RO.m{hr} (rcons (take i{hr} bs{m}) (nth witness bs{m} i{hr}));rewrite in_dom H_F_Ro/=help=>[]/#. + swap{2}-3;auto;progress. + * rewrite/#. + * rewrite/#. + * by rewrite!getP/=. + * cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. + cut:=H12;rewrite !negb_or/==>[][][]bad1 hinv_none bad2. + cut H_hs_spec:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut H_mh_spec:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut H_m_mh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut H_mi_mhi:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut H_pi_spec:=pi_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut :=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + * smt(prefixe_ge0). + * exact H1. + * rewrite/#. + cut:=H7;rewrite in_dom/==>->/=h_g1. + cut 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. + - cut[]h:=H_pi_spec;cut:=h c p0 v;rewrite H13/==>[][]h1[] h'1 h'2. + exists h1;rewrite -h'2 getP/=. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h'2. + by apply build_hpath_up=>//=. + move:H14;rewrite getP/==>hh0. + cut h0_neq_ch:h0 <> G1.chandle{2} by rewrite/#. + cut[]->:=H_pi_spec;rewrite-hh0 h0_neq_ch/=;exists h0=>/=. + cut:=H;cut:=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/=. + cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. + cut -> /= <-//=:=ch_neq0 _ _ H_hs_spec;progress;cut[]hh1 hh2 hh3:=H_mh_spec;smt(dom_hs_neq_ch). + split. + + apply hs_addh;1:cut//:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by cut:=hinvP FRO.m{2} y2L;rewrite hinv_none/=/#. + + by cut:=invG_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + + apply inv_addm=>//;1:cut//:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + apply (notin_hs_notin_dom2_mh FRO.m{2} PF.mi{1})=>//=. + by apply ch_notin_dom_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + + cut[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + rewrite!getP/=oget_some. + apply (m_mh_addh_addm _ H_m_mh H_huniq H_h _)=>//=. + by apply ch_notin_dom_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + + cut[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + rewrite!getP/=oget_some;apply (mi_mhi_addh_addmi _ H_mi_mhi _ H_h _)=>//=. + - smt(hinvP). + by apply ch_notin_dom_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + + apply incl_upd_nin=>//=. + by cut:=incl_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + + apply incl_upd_nin=>//=. + - by cut:=incli_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut:=hinvP FRO.m{2} y2L;rewrite in_dom hinv_none/=;apply absurd=>H_P_mi. + rewrite negb_forall/=. + cut H_inv_Gmh:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]H_inv_Pm:=inv_mh_inv_Pm _ _ _ _ _ H_m_mh H_mi_mhi H_inv_Gmh. + cut[]H_Pmi H_Gmhi:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by cut[]/#:=H_Pmi y1L y2L (oget PF.mi{1}.[(y1L, y2L)]).`1 + (oget PF.mi{1}.[(y1L, y2L)]).`2 _;1:smt(get_oget in_dom). + + cut H_take_Si:=take_nth witness i{2} bs{1} _;1:smt(prefixe_ge0). + split=>//=. + - move=>x hx y hy;rewrite !getP. + case((x, hx) = (sa{2} +^ nth witness bs{1} i{2}, h{2}))=>//=. + * move=>[->> ->>][<<- <<-]/=. + cut->/=:=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 getP Block.WRing.addKr/=. + rewrite oget_some/=(@take_nth witness)/=;1:smt(prefixe_ge0). + by apply build_hpath_up=>//=;smt(in_dom). + move=> neq h1. + cut[]hh1 hh2 hh3:=H_mh_spec. + cut[]xc hxx yc hyc []h2[]h3 h4:=hh1 _ _ _ _ h1. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h2. + cut->/=:=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 getP. + cut->/=:=build_hpath_up _ _ _ y1L G1.chandle{2} _ _ _ hb h_g1. + cut/#:!rcons p0 (b +^ x) = rcons (take i{2} bs{1}) (nth witness bs{1} i{2});move:neq;apply absurd=>//=h'. + cut<<-:take i{2} bs{1}=p0 by rewrite/#. + cut hbex:b +^ x = nth witness bs{1} i{2} by rewrite/#. + by cut:=hb;rewrite H_path/==>[][->>->>]/=;rewrite-hbex Block.WRing.addKr/=. + - progress. + * move:H13;rewrite getP/=H_take_Si/=. + case(p0 = (take i{2} bs{1}))=>[->>|hpp0];rewrite!getP/=!oget_some/=. + + cut->/=:=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 getP/=. + cut->/=:!rcons (take i{2} bs{1}) bn = rcons (take i{2} bs{1}) (nth witness bs{1} i{2}). + - move:hbni;apply absurd=>//=h. + cut->:bn = nth witness (rcons (take i{2} bs{1}) bn) i{2}. + * by rewrite nth_rcons size_take;smt(prefixe_ge0). + by rewrite h nth_rcons size_take;smt(prefixe_ge0). + move=>h_ro_p_bn. + cut[]_ hh4 _:=H_mh_spec. + by cut:=hh4 (take i{2} bs{1}) bn b0;rewrite h_ro_p_bn/=H_path/=;smt(getP @Block.WRing). + cut->/=:!rcons p0 bn = rcons (take i{2} bs{1}) (nth witness bs{1} i{2}). + + move:hpp0;apply absurd=>/=h. + cut: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. + cut[]_ hh4 _:=H_mh_spec. + cut:=hh4 p0 bn b0;rewrite h_ro_p_bn/==>[][];progress. + cut help:(sa{2} +^ nth witness bs{1} i{2}, h{2}) <> (v +^ bn, hx) by rewrite/#. + exists v hx hy=>//=;rewrite getP;rewrite eq_sym in help;rewrite help/=H14/=. + by apply build_hpath_up=>//=. + move:H13 H14;rewrite!getP/=!oget_some/==>h_build_hpath_set. + case(hy = G1.chandle{2})=>//=[->>|hy_neq_ch]/=. + + move=>h;cut h_eq:v +^ bn = sa{2} +^ nth witness bs{1} i{2} && hx = h{2}. + + cut/#:G1.mh{2}.[(v +^ bn, hx)] <> Some (b0, G1.chandle{2}). + cut[]_ hh2:=H_m_mh. + cut:=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 cut[]/#:=H_hs_spec. + cut[]eq_xor ->>:=h_eq. + move:h;rewrite h_eq/==>->>. + cut/#:!(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. + - cut:=known_path_uniq _ _ _ sc{1} h{2} p0 v (take i{2} bs{1}) sa{2} H2_pi_spec _ h_build_hpath_set _. + * rewrite getP/=h_flag. + by cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. + * by apply build_hpath_up=>//=. + move=>[]->>->>/=;apply absurd=>//=_. + cut->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). + cut[]hh1 hh2 hh3:=H_mh_spec. + cut:=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/=. + cut->/=:=ch_neq0 _ _ H_hs_spec. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. + move=>help;cut:= 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=>//=. + cut:=hh3 _ _ _ _ _ H_path h_build_hpath_p0. + cut->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). + move=>help;cut 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. + cut[]hh1 hh2 hh3:=H_mh_spec. + cut:=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/=. + cut->/=:=ch_neq0 _ _ H_hs_spec. + by cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h;smt(dom_hs_neq_ch). + progress. + + cut:=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. + cut:=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:H13 H14;rewrite!getP/=!oget_some/==>H13 H14;rewrite H13 H14. + cut->/=:=ch_neq0 _ _ H_hs_spec. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. + rewrite h_g1/=. + by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). + cut:=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. + cut:=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:H13 H14;rewrite!getP/=!oget_some/==>H13 H14;rewrite H13 H14/=. + cut->/=:=ch_neq0 _ _ H_hs_spec. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. + rewrite h_g1/=. + by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). + + rewrite!getP/=oget_some;exact H2_pi_spec. + + rewrite!getP/=!oget_some/=. + cut H_m_p:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut H_all_prefixes:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + split;case:H_m_p=>//=Hmp01 Hmp02 Hmp1 Hmp2 Hmp3. + - smt(getP size_take prefixe_ge0). + - by cut[]:=H_m_p0;smt(getP size_take prefixe_ge0). + - move=>l;rewrite dom_set in_fsetU1;case=>H_case j []Hj0. + * move=>Hjsize;rewrite!getP/=. + cut->/=:!take j l = take (i{2} + 1) bs{1} by rewrite/#. + cut->/=:!take (j+1) l = take (i{2} + 1) bs{1} by rewrite/#. + smt(in_dom getP). + cut->>:=H_case;rewrite size_take;1:smt(prefixe_ge0). + cut->/=:(if i{2} + 1 < size bs{1} then i{2} + 1 else size bs{1}) = i{2} + 1 by rewrite/#. + move=>HjiS;rewrite!getP. + cut->/=:! take j (take (i{2} + 1) bs{1}) = take (i{2} + 1) bs{1} by smt(size_take). + rewrite!take_take!min_lel 1,2:/# nth_take 2:/#;1:smt(prefixe_ge0). + case(j < i{2})=>Hij. + - cut->/=:!take (j + 1) bs{1} = take (i{2} + 1) bs{1} by smt(size_take). + by cut:=Hmp1(take i{2} bs{1}) _ j _;smt(in_dom take_take nth_take prefixe_ge0 size_take getP). + cut->>:j = i{2} by rewrite/#. + by exists sa{2} sc{1};rewrite H1/=;smt(get_oget getP in_dom). + - move=>l;rewrite dom_set in_fsetU1. + case(l = take (i{2} + 1) bs{1})=>//=[->>|]. + + by rewrite!getP/=oget_some/=/#. + move=>h H_dom;rewrite!getP h/=. + cut[]H2mp01 H2mp02 H2mp1 H2mp2 H2mp3:=H_m_p0. + rewrite-Hp1;1:smt(in_dom). + by apply H2mp2. + move=>l;rewrite !dom_set !in_fsetU1. + case(l = take (i{2} + 1) bs{1})=>//=[->>|]. + + by exists []; smt(cats0 dom_set in_fsetU1). + move=>H_neq H_dom;cut[]l1:=Hmp3 _ H_dom;rewrite!dom_set!in_fsetU1;case=>H_case. + + exists l1;by rewrite in_fsetU1 H_case. + exists (rcons l1 (nth witness bs{1} i{2}));rewrite in_fsetU1;right. + by rewrite-rcons_cat (@take_nth witness);smt(prefixe_ge0). + * rewrite/#. + * cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. + by split;cut[]//=:=H_m_p0;smt(getP in_dom take_take take_nth size_take + prefixe_ge0 nth_take take_oversize take_le0). + + rewrite!getP/=oget_some;smt(in_dom). + + smt(getP in_dom take_take size_take prefixe_ge0 nth_take take_oversize take_le0). + + rewrite!getP/=oget_some;smt(in_dom). + + rewrite/#. + + by rewrite!getP/=oget_some/#. + + rewrite!getP/=oget_some(@take_nth witness);1:smt(prefixe_ge0);rewrite build_hpath_prefix. + cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. + cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + - smt(prefixe_ge0). + - exact H1. + - rewrite/#. + cut:=H7;rewrite in_dom=>/=->/=H_Gmh. + cut->/=:=build_hpath_up_None _ _ (y1L, G1.chandle{2})_ _ H_Gmh H_path;smt(getP). + + smt(prefixe_ge0). + + smt(prefixe_ge0). + + by rewrite!getP/=oget_some. + rewrite!dom_set!in_fsetU1 negb_or/=;split;2:smt(prefixe_ge0 size_take prefixe_ge0 take_oversize). + cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. + cut:=Hp2 (take (i{2} + 1 + 1) bs{1}). + pose P:= _ \/ _;cut/#:!P;rewrite/P;clear P;rewrite negb_or/=negb_exists/=;split. + * cut:=prefixe_exchange_prefixe_inv(elems (dom C.queries{2}))(elems (dom prefixes{1}))bs{1} _ _ _. + + by cut[]:=H_m_p0;smt(in_dom memE). + + cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=H_m_p0. + by cut:=all_prefixes_of_m_p _ _ _ H_m_p0;smt(memE in_dom). + + by cut[]:=H_m_p0;smt(memE in_dom). + by move=>H_pref_eq;rewrite memE prefixe_lt_size//= -H_pref_eq/#. + by move=>j;case(0<=j<=i{2})=>//=[][]Hj0 Hji;smt(size_take prefixe_ge0 take_le0). +qed. + + +section AUX. + + declare module D : DISTINGUISHER {PF, RO, G1, Redo, C}. + + 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 dom 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;cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(in_dom). + (* 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(:_==> (G1.bcol \/ G1.bext));1:smt(@DBlock @DCapacity dom_set in_fsetU1). while (G1.bcol \/ G1.bext) (size p - i)=> [z|]. + if; 1:by auto=> /#. - wp; rnd predT; wp; rnd predT; auto. + if;2:auto=>/#;wp; rnd predT; wp; rnd predT; auto. smt (@Block.DBlock @Capacity.DCapacity). by auto; smt (@Block.DBlock @Capacity.DCapacity). (* Init ok *) inline *; auto=> />; split=> [|/#]. - (do !split; -5..-2: smt (getP map0P build_hpath_map0)); -6..-2: by move=> ? ? ? ?; rewrite map0P. - + move=> h1 h2 ? ?; rewrite !getP !map0P. - by case: (h1 = 0); case: (h2 = 0)=> //=. - + by rewrite getP. - + by move=> ? h; rewrite getP map0P; case: (h = 0). - + by move=> ? ?; rewrite !map0P. - + by move=> ? ?; rewrite !map0P. - by move=>l;rewrite dom_set in_fsetU1 dom0 in_fset0/==>->>/=/#. + do !split. + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + by move=>l;rewrite dom_set in_fsetU1 dom0 in_fset0/==>->>/=/#. + + by move=>l;rewrite dom_set in_fsetU1 dom0 in_fset0/=!getP/==>->>/=/#. + + by move=>l;rewrite dom_set in_fsetU1 dom0 in_fset0/=/==>->>/=;exists[];rewrite dom_set in_fsetU1//=. qed. @@ -2851,25 +2759,6 @@ section. islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. - local equiv CF_G1 : - CF(DRestr(D)).main ~ G1(DRestr(D)).main: - ={glob D, glob C} ==> !(G1.bcol \/ G1.bext){2} => ={res}. - proof. - transitivity G1'(DRestr(D)).main - (={glob D, glob C} ==> !(G1.bcol \/ G1.bext){2} => ={res}) - (={glob D, glob C} ==> ={res, glob G1(D)});progress;1:rewrite/#. - + by conseq(CF_G1' (DRestr(D)) (DRestr_ll D D_ll));progress. - proc;inline*;auto;sp. - call(: ={glob G1, glob C} /\ [] \in dom C.queries{1});auto;last first. - + smt(dom_set in_fsetU1). - + by proc;inline*;sp;if;auto;conseq(:_==> ={y0, glob G1, glob C});progress;sim. - + by proc;inline*;sp;if;auto;conseq(:_==> ={y0, glob G1, glob C});progress;sim. - proc;inline*;sp;if;auto;if;1,3:auto. - rcondt{1}8;first by auto;while(p <> []);auto;1:(sp;if);auto=>/#. - by wp 12 12;conseq(:_==> ={b, glob G1, glob C});1:smt(dom_set in_fsetU1);sim. - qed. - - lemma Real_G1 &m: Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= Pr[G1(DRestr(D)).main() @ &m: res] @@ -2880,7 +2769,7 @@ section. cut : Pr[CF(DRestr(D)).main() @ &m : res] <= Pr[G1(DRestr(D)).main() @ &m : res] + Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext]. - + byequiv (CF_G1)=>//. + + byequiv (CF_G1 D D_ll)=>//. smt ml=0. smt ml=0. qed. From 7c9b50e6ab789b016a2b73a6273e701c01896417 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 5 Apr 2018 13:39:58 +0200 Subject: [PATCH 268/394] Gconcl.ec : done, cleaning todo Translating from a output block to a output list of blocks : TODO --- sha3/proof/smart_counter/Gcol.eca | 262 ++++++++++-------- sha3/proof/smart_counter/Gconcl.ec | 31 ++- sha3/proof/smart_counter/Gext.eca | 382 +++++++++++++-------------- sha3/proof/smart_counter/Handle.eca | 161 +---------- sha3/proof/smart_counter/SLCommon.ec | 75 ++++++ 5 files changed, 430 insertions(+), 481 deletions(-) diff --git a/sha3/proof/smart_counter/Gcol.eca b/sha3/proof/smart_counter/Gcol.eca index 2047d12..1af352a 100644 --- a/sha3/proof/smart_counter/Gcol.eca +++ b/sha3/proof/smart_counter/Gcol.eca @@ -4,10 +4,10 @@ require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. require import DProd Dexcepted. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. -require (*..*) Gcol_ext. - -clone export Gcol_ext as Handle0. +require (*..*) Handle. +clone export Handle as Handle0. +import ROhandle. (* -------------------------------------------------------------------------- *) (* TODO: move this *) @@ -46,17 +46,17 @@ section PROOF. return c; } - module C = { + module M = { proc f(p : block list): block = { var sa, sa', sc; - var h, i <- 0; + var h, i, counter <- 0; sa <- b0; while (i < size p ) { if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; } else { - if (! G1.bcol /\ ! G1.bext) { + if (counter < size p - prefixe p (get_max_prefixe p (elems (dom C.queries)))) { sc <@ sample_c(); sa' <- F.RO.get(take (i+1) p); sa <- sa +^ nth witness p i; @@ -65,6 +65,7 @@ section PROOF. (sa,h) <- (sa',G1.chandle); FRO.m.[G1.chandle] <- (sc,Unknown); G1.chandle <- G1.chandle + 1; + counter <- counter + 1; } } i <- i + 1; @@ -81,42 +82,39 @@ section PROOF. if (!mem (dom G1.m) x) { y <- (b0,c0); - if (! G1.bcol /\ ! G1.bext) { - if (!(mem (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 (mem (dom G1.paths) x.`2) { - (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 (mem (dom G1.mh) (x.`1, hx2) /\ - 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 (mem (dom G1.paths) x.`2) { - (p,v) <- oget G1.paths.[x.`2]; - G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); - } + if (!(mem (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 (mem (dom G1.paths) x.`2) { + (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 (mem (dom G1.mh) (x.`1, hx2) /\ + 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 (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); } } else { y <- oget G1.m.[x]; @@ -129,31 +127,29 @@ section PROOF. if (!mem (dom G1.mi) x) { y <- (b0,c0); - if (! G1.bcol /\ !G1.bext) { - if (!(mem (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 (mem (dom G1.mhi) (x.`1, hx2) /\ - 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); - } + if (!(mem (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 (mem (dom G1.mhi) (x.`1, hx2) /\ + 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]; @@ -177,7 +173,7 @@ section PROOF. G1.paths <- map0.[c0 <- ([<:block>],b0)]; G1.chandle <- 1; count <- 0; - b <@ DRestr(D,C,S).distinguish(); + b <@ DRestr(D,M,S).distinguish(); return b; } }. @@ -219,57 +215,76 @@ section PROOF. move=> b c;proc;sp;if;auto;smt ml=0. qed. - local equiv Gpr_col : Gpr(DRestr(D)).main ~ Gcol.main : + 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}) /\ - ((!G1.bext /\ !G1.bcol) => mh_spec FRO.m G1.m G1.mh F.RO.m - /\ pi_spec FRO.m G1.mh G1.paths - /\ hs_spec FRO.m G1.chandle){1} /\ (card (rng FRO.m) <= 2*C.c + 1 /\ Gcol.count <= C.c <= max_size){2}). - + proc;sp 1 1;if=>//;inline Gpr(DRestr(D)).S.f Gcol.S.f;swap -3. - sp;if;1,3:auto=>/#;sp;wp;if;auto;progress. - - rewrite/ - swap{1}[3..5]-2. - seq 3 2:(={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 (rng FRO.m) + 1 <= 2 * C.c + 1 /\ - Gcol.count + 1 <= C.c <= max_size){2}). - + auto;smt ml=0 w=card_rng_set. - 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,hx2,y0} /\ - ((G1.bcol\/hinv FRO.m y0.`2 <> None){1} => G1.bcol{2}) /\ - (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ - Gcol.count <= C.c <= max_size){2});last by auto;smt ml=0 w=card_rng_set. - wp;if=>//;inline Gcol.sample_c. - + rcondt{2}4. - + auto;conseq (_:true)=>//;progress;2: smt ml=0. - by cut /#:= fcard_image_leq fst (rng FRO.m{hr}). - wp;conseq (_: ={p,v,F.RO.m,y1} /\ y2{1}=c{2})=>//;1:smt ml=0 w=hinv_image. - by sim. - rcondt{2}3. - + by auto;progress;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). - auto;progress;smt w=hinv_image. + + 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 (rng 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 (rng FRO.m{2}) <= 2 * C.c{2} + /\ Gcol.count{2} + 1 <= C.c{2} <= max_size);1: by if;auto;smt(card_rng_set). + if;1:auto. + - inline Gcol.sample_c;rcondt{2}4. + * auto;inline*;auto;progress. + + by cut/#:=fcard_image_leq (fun (p : capacity * flag) => p.`1) (rng 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 (rng FRO.m{2}) <= 2 * C.c{2} + /\ Gcol.count{2} + 1 <= C.c{2} <= max_size + /\ (x0{1}.`2 \in dom G1.paths{1}) + /\ y2{1} = c{2});1: by inline*;auto. + sp 1 4;if;auto;progress. + + by cut->:=(H H6). + + smt(card_rng_set). + + case:H5=>/=[h|H_hinv];1: by cut->:=H h. + by cut:=hinvP FRO.m{2} c{2};rewrite H_hinv/=imageP/==>[][]f H_f;smt(in_rng). + smt(card_rng_set). + inline Gcol.sample_c;rcondt{2}3. + * auto;progress. + + by cut/#:=fcard_image_leq (fun (p : capacity * flag) => p.`1) (rng 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 (rng FRO.m{2}) <= 2 * C.c{2} + /\ Gcol.count{2} + 1 <= C.c{2} <= max_size + /\ ! (x0{1}.`2 \in dom G1.paths{1}) + /\ y2{1} = c{2});1: by auto. + sp 1 4;if;auto;progress. + + by cut->:=(H H6). + + smt(card_rng_set). + + case:H5=>/=[h|H_hinv];1: by cut->:=H h. + by cut:=hinvP FRO.m{2} c{2};rewrite H_hinv/=imageP/==>[][]f H_f;smt(in_rng). + smt(card_rng_set). + proc;sp 1 1;if=>//. - inline Gpr(DRestr(D)).S.fi Gcol.S.fi;swap-3. + 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(rng FRO.m) + 2 <= 2*C.c + 1 /\ Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. if=>//;last by auto=>/#. - seq 3 2:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + 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 (rng FRO.m) + 1 <= 2 * C.c + 1 /\ Gcol.count + 1 <= C.c <= max_size){2}). - + by auto;smt ml=0 w=card_rng_set. + + 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} /\ @@ -282,38 +297,51 @@ section PROOF. (* BUG: auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | H]. marche pas ???? *) auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | X];right;apply hinv_image=> //. - + proc;sp 1 1;if=>//;2:auto;sp;if=>//. - inline Gpr(DRestr(D)).C.f Gcol.C.f. sp. - seq 5 5: + + 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} /\ i{1}=0 /\ - (G1.bcol{1} => G1.bcol{2}) /\ - card (rng FRO.m{2}) + 2*(size p{2}) <= 2 * C.c{2} + 1 /\ - Gcol.count{2} + size p{2} <= C.c{2} <= max_size);1:by auto=>/#. - wp;call (_: ={F.RO.m});1:by sim. + 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} - + prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{1})))) /\ + card (rng FRO.m{2}) <= 2 * (C.c{2} + counter{2}) + 1 /\ + Gcol.count{2} + size p{2} - + prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{1}))) + - counter{2} <= C.c{2} + size p{2} - + prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{1}))) + <= max_size); + last by inline*;auto;smt(size_ge0 prefixe_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} /\ (i <= size p){1} /\ + p,h,i,sa,counter,C.queries} /\ (0 <= i <= size p){1} /\ (G1.bcol{1} => G1.bcol{2}) /\ - (card (rng FRO.m) + 2*(size p - i) <= 2 * C.c + 1 /\ - Gcol.count + size p - i <= C.c <= max_size){2}); - last by auto; smt ml=0 w=size_ge0. + (0 <= counter{2} <= size p{2} - + prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{1})))) /\ + card (rng FRO.m{2}) <= 2 * (C.c{2} + counter{2}) + 1 /\ + Gcol.count{2} + size p{2} - + prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{1}))) + - counter{2} <= C.c{2} + size p{2} - + prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{1}))) + <= max_size);last by auto;smt(size_ge0 prefixe_sizel prefixe_ge0). if=>//;auto;1:smt ml=0 w=size_ge0. - call (_: ={F.RO.m});1:by sim. + if=>//;2:auto;2:smt(size_ge0 prefixe_sizel). + auto;call (_: ={F.RO.m})=>/=;1:by sim. inline *;rcondt{2} 2. - + auto;progress;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). + + auto;progress. + - apply(StdOrder.IntOrder.ler_trans _ _ _ (fcard_image_leq fst (rng FRO.m{hr})))=>/#. + smt(size_ge0 prefixe_sizel). auto;smt ml=0 w=(hinv_image card_rng_set). - auto;progress;3:by smt ml=0. + by rewrite rng_set rem0 rng0 fset0U fcard1. by apply max_ge0. qed. lemma Pr_G1col &m: - Pr[Gpr(DRestr(D)).main() @ &m : G1.bcol] <= max_size%r * ((2*max_size)%r / (2^c)%r). + 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 G1col=> //#. + + byequiv G1_col=> //#. apply (Pr_col &m). qed. diff --git a/sha3/proof/smart_counter/Gconcl.ec b/sha3/proof/smart_counter/Gconcl.ec index 9356a7f..0803dcb 100644 --- a/sha3/proof/smart_counter/Gconcl.ec +++ b/sha3/proof/smart_counter/Gconcl.ec @@ -68,26 +68,32 @@ 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 C = { + module M = { proc f(p : block list): block = { var sa, sa'; - var h, i <- 0; + var h, i, counter <- 0; sa <- b0; while (i < size p ) { if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { RO.sample(take (i+1) p); (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; } else { - 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; + if (counter < size p - prefixe p (get_max_prefixe p (elems (dom 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; } @@ -193,7 +199,7 @@ local module G3(RO:F.RO) = { RRO.set(0,c0); G1.paths <- map0.[c0 <- ([<:block>],b0)]; G1.chandle <- 1; - b <@ DRestr(D,C,S).distinguish(); + b <@ DRestr(D,M,S).distinguish(); return b; } }. @@ -246,7 +252,7 @@ proof. 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 F.LRO.sample;sim. + by inline*;sim. qed. local module G4(RO:F.RO) = { @@ -342,7 +348,8 @@ proof. 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. - by sim;inline *;auto;progress;apply DCapacity.dunifin_ll. + 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 : diff --git a/sha3/proof/smart_counter/Gext.eca b/sha3/proof/smart_counter/Gext.eca index 5e485f2..34225b6 100644 --- a/sha3/proof/smart_counter/Gext.eca +++ b/sha3/proof/smart_counter/Gext.eca @@ -7,7 +7,7 @@ require import DProd Dexcepted. require (*..*) Gcol. clone export Gcol as Gcol0. -print Eager. + op bad_ext (m mi:smap) y = mem (image snd (dom m)) y \/ mem (image snd (dom mi)) y. @@ -17,23 +17,26 @@ op hinvc (m:(handle,capacity)fmap) (c:capacity) = module G2(D:DISTINGUISHER,HS:FRO) = { - module C = { + module M = { proc f(p : block list): block = { var sa, sa'; - var h, i <- 0; + var h, i, counter <- 0; sa <- b0; while (i < size p ) { if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; } else { - 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; + if (counter < size p - prefixe p (get_max_prefixe p (elems (dom 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; } @@ -134,25 +137,25 @@ module G2(D:DISTINGUISHER,HS:FRO) = { proc distinguish(): bool = { var b; - F.RO.m <- map0; + F.RO.m <- map0; G1.m <- map0; G1.mi <- map0; G1.mh <- map0; G1.mhi <- map0; G1.bext <- false; - + C.queries<- map0.[[] <- b0]; (* the empty path is initially known by the adversary to lead to capacity 0^c *) HS.set(0,c0); G1.paths <- map0.[c0 <- ([<:block>],b0)]; G1.chandle <- 1; - b <@ D(C,S).distinguish(); + b <@ D(M,S).distinguish(); return b; } }. section. - declare module D: DISTINGUISHER{G1, G2, FRO}. + declare module D: DISTINGUISHER{G1, G2, FRO, C}. op inv_ext (m mi:smap) (FROm:handles) = exists x h, mem (dom m `|` dom mi) x /\ FROm.[h] = Some (x.`2, Unknown). @@ -167,34 +170,37 @@ section. by move=> [t f'] /=;case (f'=f). qed. - equiv G1_G2 : G1(D).main ~ Eager(G2(D)).main1 : + 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. - call (_: ={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m} /\ + 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, mem (dom FRO.m) h => h < G1.chandle){1}). - + proc;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,y} /\ - inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ + + 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, mem (dom FRO.m) h => h < G1.chandle){1} /\ - ! mem (dom G1.m{1}) x{1}). + ! mem (dom G1.m{1}) x0{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,y,hx2} /\ - t{2} = (in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1} /\ + (={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} \/ (mem (rng FRO.m) (x.`2, Unknown)){2} \/ inv_ext G1.m{2} G1.mi{2} FRO.m{2})) /\ (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ - ! mem (dom G1.m{1}) x{1}). - + inline *;auto=> &ml&mr[#]10!-> Hi Hhand -> /=. - rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. + ! mem (dom G1.m{1}) x0{1}). + + inline *;auto=> &ml&mr[#]10!-> -> ->->Hi-> Hhand -> /=. + rewrite -dom_restr rng_restr /=;progress;3:by smt ml=0. + rewrite rng_set !inE rem_id 1:/#;move:H0=>[/Hi[->|[x' h][]H1 H2]|->]//. right;right;exists x' h;rewrite getP. by cut ->//:(h<> G1.chandle{mr});move:(Hhand h);rewrite in_dom H2 /#. by move:H0;rewrite dom_set !inE /#. - seq 1 1: (={x,y,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m} /\ - inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ + 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), mem (dom FRO.m{1}) h => h < G1.chandle{1});2:by auto. if=>//. + inline *;rcondt{2} 4. @@ -203,10 +209,10 @@ section. auto;progress. + by apply sampleto_ll. + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. - + case (h = (oget G1.mh{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. - + by left;rewrite Hh oget_some. - by right;exists x{2} h;rewrite dom_set getP Hneq !inE. - case (h = (oget G1.mh{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + + 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 dom_set getP Hneq !inE. + 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;rewrite !dom_set getP Hneq //=. @@ -214,21 +220,22 @@ section. by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. - + right;exists x{2} h;rewrite getP dom_set !inE /=. + + right;exists x0{2} h;rewrite getP dom_set !inE /=. by move:(H0 h);rewrite in_dom Hh /#. right;exists x' h;rewrite getP !dom_set !inE;split. + by move:Hx;rewrite !inE=>-[]->. by move:(H0 h);rewrite !in_dom Hh /#. - + proc;if=>//;last by auto. + + 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,y,hx2} /\ - t{2} = (in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1} /\ + (={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} \/ (mem (rng FRO.m) (x.`2, Unknown)){2} \/ inv_ext G1.m{2} G1.mi{2} FRO.m{2})) /\ (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ ! mem (dom G1.mi{1}) x{1}). - + inline *;auto=> &ml&mr[#]9!-> Hi Hhand -> /=. + + inline *;auto=> &ml&mr[#]-><-_ _9!-> Hi Hhand _ -> /=. rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. + rewrite rng_set !inE rem_id 1:/#;move:H4=>[/Hi[->|[x' h][]HH1 HH2]|->]//. right;right;exists x' h;rewrite getP. @@ -240,10 +247,10 @@ section. auto;progress. + by apply sampleto_ll. + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. - + case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + + case (h = (oget G1.mhi{2}.[(x0{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + by left;rewrite Hh oget_some. - by right;exists x{2} h;rewrite !dom_set getP Hneq !inE. - case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + by right;exists x0{2} h;rewrite !dom_set getP Hneq !inE. + 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 !dom_set getP Hneq //=. @@ -251,34 +258,35 @@ section. by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. - + right;exists x{2} h;rewrite getP !dom_set !inE /=. + + right;exists x0{2} h;rewrite getP !dom_set !inE /=. by move:(H0 h);rewrite in_dom Hh /#. right;exists x' h;rewrite getP !dom_set !inE;split. + by move:Hx;rewrite !inE=>-[]->. by move:(H0 h);rewrite !in_dom Hh /#. - + proc; - conseq (_: ={sa,G1.mh,G1.mhi,F.RO.m, G1.chandle, FRO.m} /\ + + 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), mem (dom FRO.m{1}) h0 => h0 < G1.chandle{1})=>//. - sp 3 3;call (_: ={F.RO.m});1:by sim. - while (={sa,G1.mh,G1.mhi,F.RO.m,G1.chandle,FRO.m,i,h,sa,p} /\ - inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ + 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), mem (dom FRO.m{1}) h0 => h0 < G1.chandle{1})=>//. if=>//;inline *;1:by auto. + if;1,3:auto;progress. rcondt{2} 3;1:by auto=>/#. - auto=> &m1&m2 [#] 10!-> Hinv Hhand Hi _ _ /= ?->?->/=;split=>/= _;split. - + move:Hinv;rewrite /inv_ext1=> H/H{H}[->//|[x h]];rewrite inE=>-[Hmem Hh]. - by right;exists x h;rewrite !inE Hmem getP;smt w=in_dom. - + by move=>h;rewrite dom_set !inE /#. - + move:Hinv;rewrite /inv_ext1=> H/H{H}[->//|[x h]];rewrite inE=>-[Hmem Hh]. - by right;exists x h;rewrite !inE Hmem getP;smt w=in_dom. - by move=>h;rewrite dom_set !inE /#. + auto;progress. + + move=>bad1;cut[/=->//|]:=H bad1;rewrite/inv_ext=>[][]x h[]H_dom Hh;right. + by exists x h;rewrite H_dom/=getP/= Hh;smt(in_dom getP). + + smt(dom_set in_fsetU1). + + move=>bad1;cut[/=->//|]:=H bad1;rewrite/inv_ext=>[][]x h[]H_dom Hh;right. + by exists x h;rewrite H_dom/=getP/= Hh;smt(in_dom getP). + + smt(dom_set in_fsetU1). (* **************** *) inline *;auto;progress. - auto;inline*;auto;progress. - by move:H;rewrite dom_set dom0 !inE=>->. + smt(dom_set in_fsetU1 dom0 in_fset0). qed. end section. @@ -317,23 +325,26 @@ section EXT. Iter(ReSample).iter (elems (dom (restr Unknown FRO.m))); } - module C = { + module M = { proc f(p : block list): block = { var sa, sa'; - var h, i <- 0; + var h, i, counter <- 0; sa <- b0; while (i < size p ) { if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; } else { - 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; + if (counter < size p - prefixe p (get_max_prefixe p (elems (dom 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; } @@ -449,7 +460,7 @@ section EXT. RRO.set(0,c0); G1.paths <- map0.[c0 <- ([<:block>],b0)]; G1.chandle <- 1; - b <@ DRestr(D,C,S).distinguish(); + b <@ DRestr(D,M,S).distinguish(); resample(); return b; } @@ -549,147 +560,114 @@ section EXT. move=> b1 c1;proc;auto=> /#. qed. + local equiv EG2_Gext : Eager(G2(DRestr(D))).main2 ~ Gext.distinguish: - ={glob D} ==> - ((G1.bext{1} \/ inv_ext G1.m{1} G1.mi{1} FRO.m{1}) => - ReSample.count{2} <= max_size /\ G1.bext{2}). + ={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;sp. - swap{1}[2..3]2;swap{2}2 2;wp. print inv_ext. - while (={l,G1.m,G1.mi} - /\ ((!G1.bext{1} /\ forall (x : state) (h : handle), - !mem (dom G1.m{1} `|` dom G1.mi{1}) x \/ - FRO.m{1}.[h] <> Some (x.`2, Unknown) \/ mem l{1} h) => - ={FRO.m} - /\ size G1.m{2} <= max_size /\ size G1.mi{2} <= max_size - /\ ReSample.count{2} + size l{2} <= max_size) - /\ ((G1.bext{1} \/ exists (x : state) (h : handle), + proc;inline *;wp. + while (={l,FRO.m,G1.m,G1.mi} /\ size G1.m{2} <= max_size /\ + size G1.mi{2} <= max_size /\ + ReSample.count{2} + size l{2} <= max_size /\ + ((G1.bext{1} \/ + exists (x : state) (h : handle), mem (dom G1.m{1} `|` dom G1.mi{1}) x /\ FRO.m{1}.[h] = Some (x.`2, Unknown) /\ !mem l{1} h) => G1.bext{2})). - + case(G1.bext{1} \/ exists (x1 : state) (h0 : handle), - (x1 \in dom G1.m{1} `|` dom G1.mi{1}) /\ - FRO.m{1}.[h0] = Some (x1.`2, Unknown) /\ ! (h0 \in l{1}))=>//=. - auto;progress. - + move:H3;rewrite H9/==>[][]a b. - cut[->//=|[|]]:=H10 a b. - + rewrite getP;case(b = head witness l{2})=>[->>|hb->//=]/=. - by rewrite-(@mem_head_behead witness)//. - by move=>h;cut->//=:=mem_drop _ _ _ h. - + rewrite size_drop//=. - cut/#:=H _;rewrite H9/==>x h. - cut:=H10 x h;rewrite getP/==>[][->|[|]]//=. - + case(h=head witness l{2})=>[->>|hb->//=]/=. - by rewrite-(@mem_head_behead witness)//. - by move=>h2;cut->//=:=mem_drop _ _ _ h2. - + by cut->:=H0 H3. - + admit. - + admit. - + admit. - + admit. - + admit. - + admit. - + admit. -(* 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 getP;case (h=h1)=> [/=->Hin->_ | Hneq ???]. *) -(* + by right;apply (@mem_image snd _ x). *) -(* by rewrite Hext 2://;right;exists x h;rewrite Hneq. *) -(* conseq(:_==> (={l,FRO.m,G1.m,G1.mi} /\ *) -(* size G1.m{2} <= max_size /\ *) -(* size G1.mi{2} <= max_size /\ *) -(* ReSample.count{2} + size l{2} <= max_size /\ *) -(* ((G1.bext{1} \/ *) -(* exists (x : state) (h : handle), *) -(* mem (dom G1.m{1} `|` dom G1.mi{1}) x /\ *) -(* FRO.m{1}.[h] = Some (x.`2, Unknown) /\ !mem l{1} h) => *) -(* G1.bext{2})));1:progress=>/#;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.in_dom; wp;call (_: ={FRO.m});1:by sim. *) -(* inline RRO.restrK;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=(sizeE size_ge0). *) -(* rcondt{2} 10. by auto;progress;rewrite dom_set !inE. *) -(* wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. *) -(* rewrite/Distr.is_lossless (sampleto_ll 0)/= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. *) -(* 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,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 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,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.mhi.[(x.`1, hx2)]).`2 Unknown){1}). *) -(* + inline RRO.in_dom; auto;call (_: ={FRO.m});1:by sim. *) -(* inline RRO.restrK;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=(sizeE size_ge0). *) -(* rcondt{2} 10. by auto;progress;rewrite dom_set !inE. *) -(* wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. *) -(* rewrite/Distr.is_lossless (sampleto_ll 0) /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. *) -(* 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=>//. *) -(* inline G2(DRestr(D), RRO).C.f Gext.C.f. *) -(* sp 5 5;elim *=> c0L c0R. *) -(* wp;call (_: ={F.RO.m});1:by sim. *) -(* while (={i,p,G1.mh,sa,h,FRO.m,F.RO.m,G1.mh,G1.mhi,G1.chandle} /\ 0 <= i{1} <= size p{1}/\ *) -(* c0R + size p{1} - prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= max_size /\ *) -(* inv_le G1.m{2} G1.mi{2} (c0R + i){2} FRO.m{2} ReSample.count{2}); *) -(* last first. *) -(* + auto;progress. *) -(* admit. *) -(* admit. *) -(* admit. *) -(* admit. *) -(* admit. *) -(* (* - smt(size_ge0) *) *) -(* (* by auto;smt(List.size_ge0 @Prefixe). *) *) -(* (* if=> //;1:by auto=>/#. *) *) -(* (* auto;call (_: ={F.RO.m});1:by sim. *) *) -(* (* inline *;auto=> ?&mr [#]!->@/inv_le Hi [#]. *) *) -(* (* case (p{mr})=> [/#|/=p1 p2] 4?_ /= 2?-> /=;split=>/= Hmem 4? [#]2->/= => [|/#]. *) *) -(* (* by rewrite restr_set /= size_set dom_restr /in_dom_with Hmem/= /#. *) *) - -(* auto;progress[delta];rewrite ?(size0,restr0,restr_set,rem0,max_ge0,-sizeE,-cardE) //=. *) -(* + smt ml=0. + smt ml=0. + smt ml=0. *) -(* + elim H7=>// [[x h] [#]];rewrite -memE dom_restr /in_dom_with in_dom=> _ ->/=. *) -(* by rewrite oget_some. *) -(* apply H10=>//. *) + + 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 getP;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.in_dom; wp;call (_: ={FRO.m});1:by sim. + inline RRO.restrK;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=(sizeE size_ge0). + rcondt{2} 10. by auto;progress;rewrite dom_set !inE. + wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. + rewrite/Distr.is_lossless (sampleto_ll 0)/= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. + 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.in_dom; auto;call (_: ={FRO.m});1:by sim. + inline RRO.restrK;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=(sizeE size_ge0). + rcondt{2} 10. by auto;progress;rewrite dom_set !inE. + wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. + rewrite/Distr.is_lossless (sampleto_ll 0) /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. + 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} - + prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) /\ + c0R + size p{1} - + prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= max_size /\ + inv_le G1.m{2} G1.mi{2} (c0R + counter){2} FRO.m{2} ReSample.count{2});1: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} - + prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) /\ + c0R + size p{1} - + prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= max_size /\ + inv_le G1.m{2} G1.mi{2} (c0R + counter){2} FRO.m{2} ReSample.count{2}); + last by auto;smt(List.size_ge0 prefixe_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_prefixe c;rewrite DCapacity.dunifin_fu/=. + case(G1.chandle{mr} \in dom 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 ml=0. + smt ml=0. + smt ml=0. + + elim H7=>// [[x h] [#]];rewrite -memE dom_restr /in_dom_with in_dom=> _ ->/=. + by rewrite oget_some. + apply H10=>//. qed. axiom D_ll: @@ -706,11 +684,11 @@ section EXT. apply (ler_trans _ _ _ (Real_G1 D D_ll &m)). do !apply ler_add => //. + cut ->: Pr[G1(DRestr(D)).main() @ &m : res] = Pr[Eager(G2(DRestr(D))).main1() @ &m : res]. - + by byequiv (G1_G2 (DRestr(D))). + + 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 (DRestr(D)))=>//#. + + 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)). diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index 3a7b09c..aca0768 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -6,7 +6,7 @@ require import DProd Dexcepted. require (*--*) ConcreteF. -clone import GenEager as ROhandle with +clone export GenEager as ROhandle with type from <- handle, type to <- capacity, op sampleto <- fun (_:int) => cdistr @@ -42,6 +42,7 @@ module G1(D:DISTINGUISHER) = { (sa,h) <- (sa',chandle); FRO.m.[chandle] <- (sc,Unknown); chandle <- chandle + 1; + counter <- counter + 1; } } i <- i + 1; @@ -146,6 +147,7 @@ module G1(D:DISTINGUISHER) = { mhi <- map0; bext <- false; bcol <- false; + C.queries<- map0.[[] <- b0]; (* the empty path is initially known by the adversary to lead to capacity 0^c *) FRO.m <- map0.[0 <- (c0, Known)]; @@ -1810,150 +1812,6 @@ qed. -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 (mem (dom mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; - } else { - if (counter < size p - prefixe p (get_max_prefixe p (elems (dom 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 (!mem (dom m) x) { - if (mem (dom paths) x.`2) { - (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 \/ mem (rng FRO.m) (x.`2, Unknown); - if (!(mem (rng FRO.m) (x.`2, Known))) { - FRO.m.[chandle] <- (x.`2, Known); - chandle <- chandle + 1; - } - hx2 <- oget (hinvK FRO.m x.`2); - if (mem (dom mh) (x.`1, hx2) /\ 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 (mem (dom paths) x.`2) { - (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 (!mem (dom mi) x) { - bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); - if (!(mem (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 (mem (dom mhi) (x.`1,hx2) /\ - 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 <- map0; - m <- map0; - mi <- map0; - mh <- map0; - mhi <- map0; - bext <- false; - bcol <- false; - - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - FRO.m <- map0.[0 <- (c0, Known)]; - paths <- map0.[c0 <- ([<:block>],b0)]; - chandle <- 1; - b <@ D(M,S).distinguish(); - return b; - } -}. - - 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 @@ -2763,15 +2621,18 @@ section. Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= Pr[G1(DRestr(D)).main() @ &m: res] + (max_size ^ 2)%r * inv 2%r * mu dstate (pred1 witness) - + 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]. proof. - apply (@RealOrder.ler_trans _ _ _ (Real_Concrete D D_ll &m)). + apply (@RealOrder.ler_trans _ _ _ (Real_Concrete D D_ll &m))=>//=. cut : Pr[CF(DRestr(D)).main() @ &m : res] <= Pr[G1(DRestr(D)).main() @ &m : res] + Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext]. - + byequiv (CF_G1 D D_ll)=>//. - smt ml=0. - smt ml=0. + + byequiv (CF_G1 D D_ll)=>//=/#. + cut/#: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]. + 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 index 2757b7f..8476601 100644 --- a/sha3/proof/smart_counter/SLCommon.ec +++ b/sha3/proof/smart_counter/SLCommon.ec @@ -682,6 +682,81 @@ by rewrite memE;apply prefixe_gt0_mem=>/#. smt(prefixe_sizer). qed. +lemma prefixe_cat_leq_prefixe_size (l1 l2 l3 : 'a list): + prefixe (l1 ++ l2) l3 <= prefixe l1 l3 + size l2. +proof. +move:l2 l3;elim:l1=>//=;1:smt(prefixe_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];exact size_ge0. +qed. + + +lemma prefixe_cat1 (l1 l2 l3 : 'a list) : + prefixe (l1 ++ l2) l3 = prefixe l1 l3 + + if prefixe l1 l3 = size l1 + then prefixe l2 (drop (size l1) l3) + else 0. +proof. +move:l2 l3;elim:l1=>//=;1:smt(prefixe_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 prefixe_leq_prefixe_cat_size (l1 l2 : 'a list) (ll : 'a list list) : + prefixe (l1++l2) (get_max_prefixe (l1++l2) ll) <= + prefixe l1 (get_max_prefixe l1 ll) + + if (prefixe l1 (get_max_prefixe l1 ll) = size l1) + then prefixe l2 (get_max_prefixe l2 (map (drop (size l1)) ll)) + else 0. +proof. +move:l1 l2;elim:ll=>//=;1:smt(size_cat size_ge0). +move=>l3 ll hind{hind};move:l3;elim:ll=>//=;1:smt(prefixe_cat1). +move=>l4 ll hind l3 l1 l2. +case(prefixe (l1 ++ l2) l3 < prefixe (l1 ++ l2) l4)=>//=. ++ rewrite 2!prefixe_cat1. + case(prefixe l1 l3 = size l1)=>//=H_l1l3;case(prefixe l1 l4 = size l1)=>//=H_l1l4. + - rewrite H_l1l4 H_l1l3/=ltz_add2l=>h;rewrite h/=. + rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _)). + cut->/=:prefixe l1 (max_prefixe l1 l4 ll) = size l1 + by move:{hind};elim:ll=>//=;smt(prefixe_sizel). + by cut->/=:prefixe l1 (max_prefixe l1 l3 ll) = size l1 + by move:{hind};elim:ll=>//=;smt(prefixe_sizel). + - smt(prefixe_sizel prefixe_ge0). + - cut->/=h:prefixe l1 l3 < prefixe l1 l4 by smt(prefixe_sizel). + rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _)). + cut->/=:prefixe l1 (max_prefixe l1 l4 ll) = size l1 + by move:{hind};elim:ll=>//=;smt(prefixe_sizel). + smt(prefixe_prefixe_prefixe). + move=>H_l3l4;rewrite H_l3l4/=. + rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _)). + by case(prefixe l1 (max_prefixe l1 l4 ll) = size l1)=>//=->; + smt(prefixe_prefixe_prefixe). +rewrite 2!prefixe_cat1. +case(prefixe l1 l3 = size l1)=>//=H_l1l3;case(prefixe l1 l4 = size l1)=>//=H_l1l4. ++ by rewrite H_l1l4 H_l1l3/=ltz_add2l=>h;rewrite h/=hind. ++ rewrite H_l1l3. + cut->/=:!size l1 < prefixe l1 l4 by smt(prefixe_sizel). + rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _))//=. + cut->//=:prefixe l1 (max_prefixe l1 l3 ll) = size l1 + by move:{hind};elim:ll=>//=;smt(prefixe_sizel). + smt(prefixe_prefixe_prefixe). ++ smt(prefixe_sizel prefixe_ge0). +move=>H_l3l4;rewrite H_l3l4/=. +rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _))//=. +smt(prefixe_prefixe_prefixe). +qed. + + +lemma diff_size_prefixe_leq_cat (l1 l2 : 'a list) (ll : 'a list list) : + size l1 - prefixe l1 (get_max_prefixe l1 ll) <= + size (l1++l2) - prefixe (l1++l2) (get_max_prefixe (l1++l2) ll). +proof. +smt(prefixe_leq_prefixe_cat_size prefixe_sizel prefixe_ge0 size_ge0 prefixe_sizer size_cat). +qed. + + + (* lemma prefixe_inv_prefixe queries prefixes l : *) (* prefixe_inv queries prefixes => *) (* all_prefixes prefixes => *) From e62a11ebb3d2aa941fda660c51138c8dabb328b1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 10 Apr 2018 16:56:17 +0200 Subject: [PATCH 269/394] Gconcl_list.ec : file that contains the transformations from a functionality to a n-functionality --- sha3/proof/smart_counter/Gconcl_list.ec | 644 ++++++++++++++++++++++++ 1 file changed, 644 insertions(+) create mode 100644 sha3/proof/smart_counter/Gconcl_list.ec diff --git a/sha3/proof/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec new file mode 100644 index 0000000..b1b8c8e --- /dev/null +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -0,0 +1,644 @@ +pragma -oldip. +require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. +require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. +require import DProd Dexcepted. +(*...*) import Capacity IntOrder Bigreal RealOrder BRA. + +require (*--*) Handle. + + +clone export Handle as Handle0. + +(*** THEORY PARAMETERS ***) +(** Validity of Functionality Queries **) +op valid: block list -> bool. +axiom valid_spec p: valid p => p <> []. + +(** 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 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 p => parse p = (p,1). +proof. +move=>h;cut{1}->:p=format p 1;2:smt(parseK). +by rewrite/format/=nseq0 cats0. +qed. + + +module type NFUNCTIONALITY = { + proc init () : unit + proc f (p : block list, n : int) : block list +}. + +module type NDFUNCTIONALITY = { + proc f (p : block list, n : int) : block list +}. + +module type NDISTINGUISHER (F : NDFUNCTIONALITY, P : DPRIMITIVE) = { + proc distinguish () : bool +}. + + +module NC = { + var c : int + var queries : (block list * int, block list) fmap +}. + +module NFC (F : NDFUNCTIONALITY) : NDFUNCTIONALITY = { + proc f (bl : block list, nb : int) = { + var r : block list <- []; + if (valid bl /\ 0 < nb) { + if (! (bl,nb) \in dom NC.queries) { + NC.c <- NC.c + size bl + nb - 1; + r <@ F.f(bl,nb); + NC.queries.[(bl,nb)] <- r; + } else { + r <- oget NC.queries.[(bl,nb)]; + } + } + return r; + } +}. + + + +module NPC (P : DPRIMITIVE) : DPRIMITIVE = { + proc f (a : state) = { + var z : state; + z <@ P.f(a); + NC.c <- NC.c + 1; + return z; + } + proc fi (a : state) = { + var z : state; + z <@ P.fi(a); + NC.c <- NC.c + 1; + return z; + } +}. + +module (DSqueeze (F : DFUNCTIONALITY) : NDFUNCTIONALITY) = { + proc f (p : block list, n : int) : block list = { + var lres : block list <- []; + var b : block <- b0; + var i : int <- 0; + while (i < n) { + i <- i + 1; + if (! (p,i) \in dom NC.queries) { + b <@ F.f(format p i); + lres <- rcons lres b; + NC.queries.[(p,i)] <- lres; + } else { + lres <- oget NC.queries.[(p,i)]; + } + } + return lres; + } +}. + + +module (Squeeze (F : FUNCTIONALITY) : NFUNCTIONALITY) = { + proc init () : unit = { + NC.queries <- map0; + NC.c <- 0; + F.init(); + } + proc f = DSqueeze(F).f +}. + + +module NDFRestr (F : NDFUNCTIONALITY) = { + proc f (bl : block list, nb : int) = { + var b : block <- b0; + var lres : block list <- []; + var i : int <- 0; + + if (valid bl /\ 0 < nb) { + if (! (bl,nb) \in dom NC.queries) { + if (NC.c + size bl + nb - 1 <= max_size) { + NC.c <- NC.c + size bl + nb - 1; + lres <@ F.f(bl,nb); + } + } else { + lres <- oget NC.queries.[(bl,nb)]; + } + } + return lres; + } +}. + + +module NDPRestr (P : DPRIMITIVE) : DPRIMITIVE = { + proc f (a : state) = { + var z : state; + if (NC.c + 1 <= max_size) { + z <@ P.f(a); + NC.c <- NC.c + 1; + } + return z; + } + proc fi (a : state) = { + var z : state; + if (NC.c + 1 <= max_size) { + z <@ P.fi(a); + NC.c <- NC.c + 1; + } + return z; + } +}. + + + +module (NDRestr (D : NDISTINGUISHER) : NDISTINGUISHER) + (F : NDFUNCTIONALITY) (P : DPRIMITIVE) = D(NDFRestr(F),NDPRestr(P)). + + + +module (A (D : NDISTINGUISHER) : DISTINGUISHER) + (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + proc distinguish() : bool = { + var b : bool; + NC.queries <- map0; + NC.c <- 0; + b <@ D(NFC(DSqueeze(F)),NPC(P)).distinguish(); + return b; + } +}. + + + +module NIndif (F : NFUNCTIONALITY, P : PRIMITIVE, D : NDISTINGUISHER) = { + proc main () : bool = { + var b : bool; + C.init(); + P.init(); + F.init(); + b <@ D(F,P).distinguish(); + return b; + } +}. + + +module DC (D : NDISTINGUISHER) (F : NDFUNCTIONALITY) (P : DPRIMITIVE) = D(NFC(F),NPC(P)). + + +module P = Perm. + + +section. + + pred inv_ideal (squeeze : (block list * int, block list) fmap) + (c : (block list, block) fmap) = + (forall p n, (p,n) \in dom squeeze => + forall i, 1 <= i <= n => (p,i) = parse (format p i)) /\ + (forall p n, (p,n) \in dom squeeze => + forall i, 1 <= i <= n => format p i \in dom c) /\ + (forall l, l \in dom c => + forall i, 1 <= i <= (parse l).`2 => ((parse l).`1,i) \in dom squeeze). + + + inductive m_p (m : (state, state) fmap) (p : (block list, state) fmap) + (q : (block list * int, block list) fmap) = + | IND_M_P of (p.[[]] = Some (b0, c0)) + & (forall l, l \in dom 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]) + & (forall l n, (l,n) \in dom q => + valid l /\ 0 < n /\ + (forall i, 0 < i <= n => q.[(l,i)] = Some (take i (oget q.[(l,n)])))) + & (forall l n, (l,n) \in dom q => format l n \in dom p) + & (forall l, l \in dom p => l <> [] => exists l2, parse (l ++ l2) \in dom q). + + + inductive INV_Real + (c1 c2 : int) + (m mi : (state, state) fmap) + (p : (block list, state) fmap) + (q : (block list * int, block list) fmap) = + | INV_real of (c1 <= c2) + & (m_p m p q) + & (invm m mi). + + local lemma INV_Real_incr c1 c2 m mi p q : + INV_Real c1 c2 m mi p q => + INV_Real (c1 + 1) (c2 + 1) m mi p q. + proof. by case;progress;split=>//=/#. qed. + + local lemma INV_Real_addm_mi c1 c2 m mi p q x y : + INV_Real c1 c2 m mi p q => + ! x \in dom m => + ! y \in rng m => + INV_Real c1 c2 m.[x <- y] mi.[y <- x] p q. + proof. + case=> H_c1c2 H_m_p H_invm H_x_dom H_y_rng;split=>//=. + + split;case:H_m_p=>//=; + smt(getP in_dom 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. by move=>h;rewrite fsetP=>x;split;rewrite in_dom in_rng/#. qed. + + local lemma lemma1 c1 c2 m mi p q bs n i (l : block list): + INV_Real c1 c2 m mi p q => + ! (bs,i) \in dom q => + valid bs => + 0 < i <= n => + size l = i => + format bs i \in dom p => + (forall j, 0 < j < i => q.[(bs,j)] = Some (take j l)) => + INV_Real c1 c2 m mi p q.[(bs,i) <- l]. + proof. + move=>INV0 H_bs_n_dom H_bs_valid H0in H_size H_format_dom H_pref_quer. + split;cut[]//=H_c1c2 H_m_p H_invm:=INV0. + split;cut[]//H_mp0 H_mp1 H_mp2 H_mp3 H_mp4:=H_m_p. + + move=>l1 n1;rewrite dom_set in_fsetU1. + case((l1, n1) = (bs, i))=>[[]->>->>|H_neq]//=. + - rewrite H_bs_valid/=;split;1:rewrite/#;move=>j []Hj0 Hj1. + rewrite!getP/=oget_some. + by case(j=i)=>[->>|/#]//=;1:rewrite -H_size take_size//=. + move=>H_dom;cut[]->[]->/=help j[]hj0 hji:=H_mp2 _ _ H_dom. + rewrite !getP/=. + cut:=H_neq;case(l1=bs)=>[->>H_n1i|]//=;smt(in_dom). + + smt(dom_set in_fsetU1). + + smt(dom_set in_fsetU1). + qed. + + local lemma all_prefixes_of_INV_real c1 c2 m mi p q: + INV_Real c1 c2 m mi p q => + all_prefixes p. + proof. + move=>[]_[]Hp0 Hmp1 _ _ _ _ l H_dom i. + smt(take_le0 take_oversize size_take take_take take_size nth_take in_dom). + qed. + + local lemma equiv_sponge (D <: NDISTINGUISHER {P, NC, Redo, C}) : + equiv [ GReal(A(D)).main + ~ NIndif(Squeeze(SqueezelessSponge(P)),P,DC(D)).main + : ={glob D} ==> ={res, glob D, glob P, glob NC} /\ C.c{1} <= NC.c{2}]. + proof. + proc;inline*;sp;wp. + call(: ={Redo.prefixes, glob P, glob NC} /\ + INV_Real C.c{1} NC.c{2} Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1});auto;last first. + + by progress;1:(split=>//=;1:split;smt(dom0 in_fset0 dom_set in_fsetU1 getP map0P));case:H0=>//=. + + by proc;inline*;auto;sp;if;auto;smt(INV_Real_addm_mi INV_Real_incr supp_dexcepted). + + proc;inline*;auto;sp;if;auto;progress. + + apply INV_Real_incr=>//=. + apply INV_Real_addm_mi=>//=. + + case:H=>H_c H_m_p H_invm;rewrite (invm_dom_rng _ _ H_invm)//=. + by move:H1;rewrite supp_dexcepted. + case:H=>H_c H_m_p H_invm;cut<-//:=(invm_dom_rng Perm.mi{2} Perm.m{2}). + by rewrite invmC. + + exact INV_Real_incr. + + proc;inline*;sp;if;auto;sp;if;auto. + swap 6;wp;sp=>/=;rcondt{1}1;1:auto;rcondt{2}1;1:auto. + conseq(:_==> ={i,nb,bl,n,p,glob NC,glob Redo,glob P,lres} /\ (n,p){1} = (nb,bl){1} /\ + i{1} = nb{1} /\ + format p{1} i{1} \in dom Redo.prefixes{1} /\ + INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{1} + Redo.prefixes{1} NC.queries{1}.[(bl{1}, i{1}) <- lres{1}]);progress. + while(={i,nb,bl,n,p,glob NC,glob Redo,glob P,lres} /\ (n,p){1} = (nb,bl){1} /\ + 0 < i{1} <= nb{1} /\ (0 < i{1} => Some lres{1} = NC.queries{1}.[(bl{1}, i{1})]) /\ + format p{1} i{1} \in dom Redo.prefixes{1} /\ + INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{1} + Redo.prefixes{1} NC.queries{1}.[(bl{1}, i{1}) <- lres{1}]);last first. + + sp;conseq(:_ ==> ={i,nb,bl,n,p,glob NC,glob Redo,glob P,lres} /\ (n,p){1} = (nb,bl){1} /\ + 0 < i{1} <= nb{1} /\ (0 < i{1} => Some lres{1} = NC.queries{1}.[(bl{1}, i{1})]) /\ + format p{1} i{1} \in dom Redo.prefixes{1} /\ + INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{1} + Redo.prefixes{1} NC.queries{1}.[(bl{1}, i{1}) <- lres{1}]);1:progress=>/#. + sp;if;auto;last first. + * progress. + - by rewrite/#. + - by cut INV0:=H;cut[]//=H_c1c2 H_m_p H_invm:=INV0;cut[]/#:=H_m_p. + - by cut[]_[]_ _ _ help _ _:=H;cut:=help _ _ H3. + by rewrite set_eq 1:get_oget//=;split;case:H=>//=;smt(size_ge0). + sp=>/=. + exists* Redo.prefixes{1}, C.c{1};elim*=>pref count;progress. + conseq(:_==> ={i0,p0,i,p,n,nb,bl,sa,lres,glob NC,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 NC.c{1} Perm.m{1} Perm.mi{1} pref NC.queries{1} + /\ (forall l, l \in dom Redo.prefixes{1} => + l \in dom pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) + /\ (forall l, l \in dom pref => pref.[l] = Redo.prefixes{1}.[l]) + /\ C.c{1} <= count + i0{1} <= NC.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. + + by rewrite/#. + + by rewrite getP/=. + + by rewrite/format/=nseq0 cats0//-take_size in_dom H5. + + rewrite set_set/=. + cut inv0:=H6;cut[]h_c1c2[]Hmp0 Hmp1 Hmp2 Hmp3 Hmp4 Hinvm:=inv0;split=>//=. + - rewrite/#. + split=>//=. + - smt(in_dom). + - move=>l H_dom_R i []Hi0 Hisize;cut:=H7 l H_dom_R. + case(l \in dom Redo.prefixes{2})=>H_in_pref//=. + * cut:=Hmp1 l H_in_pref i _;rewrite//=. + rewrite ?H8//=;1:smt(in_dom). + case(i+1 < size l)=>h;1:smt(in_dom). + by rewrite take_oversize 1:/#. + move=>[]j[][]hj0 hjsize ->>. + cut:=Hisize;rewrite size_take 1:/#. + pose k:=if _ then _ else _;cut->>Hij{k}:k=j by rewrite/#. + by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#;smt(in_dom). + - by move=>l n;rewrite!dom_set in_fsetU1=>[][];smt(getP oget_some in_dom take_oversize). + - move=>l n;rewrite dom_set in_fsetU1;case=>//=;1:smt(in_dom). + by move=>[]<<-->>;rewrite/format/=nseq0 cats0/=-take_size in_dom H5. + - move=>l H_dom_R H_not_nil;rewrite dom_set. + cut:=H7 l H_dom_R;case;1:smt(in_fsetU1). + move=>[]j[][]hj0 hjsize ->>;exists(drop j bl{2}). + by rewrite cat_take_drop parse_valid//=in_fsetU1. + while( ={i0,p0,i,p,n,nb,bl,sa,sc,lres,glob NC,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 NC.c{1} Perm.m{1} Perm.mi{1} pref NC.queries{1} + /\ (forall l, l \in dom Redo.prefixes{1} => + l \in dom pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) + /\ (forall l, l \in dom pref => pref.[l] = Redo.prefixes{1}.[l]) + /\ C.c{1} <= count + i0{1} <= NC.c{1} + i0{1} + /\ (i0{1} < size p0{1} => + take (i0{1}+1) p{1} \in dom 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. + - by rewrite /format/=nseq0 cats0. + - exact size_ge0. + - by rewrite take0;cut[]_[]->//=:=H. + - by rewrite/#. + - by cut[]->//=:=H. + - smt(all_prefixes_of_INV_real). + - by rewrite/#. + by rewrite/#. + if;auto;progress. + + by rewrite/#. + + by rewrite/#. + + smt(get_oget in_dom). + + smt(in_dom take_take take_oversize size_take). + + by rewrite/#. + + by rewrite/#. + + by rewrite/#. + + case(jh;1:rewrite/#;cut<<-:j=i0{2} by rewrite/#. + cut->>:=H7 H10 H12. + by cut[]_[]_ help _ _ _ _:=H2;cut:=help _ H12 j _;smt(take_take nth_take size_take). + sp;if;auto;progress. + + by rewrite/#. + + by rewrite/#. + + by rewrite!getP/=. + + by apply INV_Real_addm_mi=>//=;smt(supp_dexcepted). + + by move:H16;rewrite dom_set in_fsetU1/#. + + by rewrite!getP/=;smt(in_dom). + + by rewrite/#. + + by rewrite/#. + + move:H12;apply absurd=>//=_. + move:H17;rewrite dom_set in_fsetU1. + cut->/=:!take (i0{2} + 1 + 1) bl{2} = take (i0{2} + 1) bl{2} by smt(size_take). + smt(take_take size_take). + + move=>l;rewrite!dom_set in_fsetU1;case. + - move=>H_dom;cut[]:=H3 l H_dom. + * by move=>Hdom i;rewrite in_fsetU1/=; + smt(in_dom all_prefixes_of_INV_real). + move=>[]j[][]hj0 hji0->>k. + rewrite in_fsetU1 take_take;left. + cut[]:=H3 _ H_dom;smt(in_dom take_take take_le0 take0 take_oversize). + move=>->>k. + rewrite in_fsetU1 take_take;case(0 <= k)=>hk0; + last smt(in_fsetU1 in_dom take_take take_le0 take0 take_oversize). + case(k < i0{2})=>hki01; + first smt(in_fsetU1 in_dom take_take take_le0 take0 take_oversize). + by case(k <= i0{2} + 1)=>hki02;smt(in_dom). + + rewrite!getP/=oget_some. + cut->/=:!take j bl{2} = take (i0{2} + 1) bl{2} by smt(size_take). + case(j < i0{2})=>hj0;2:smt(getP oget_some size_take). + cut->/=:!take (j + 1) bl{2} = take (i0{2} + 1) bl{2} by smt(size_take). + by cut:=H9 j _;1:rewrite hj0 H16//=;smt(in_rng getP in_dom). + + by rewrite/#. + + by rewrite/#. + + by rewrite!getP/=. + + by move:H14;rewrite dom_set in_fsetU1/#. + + by rewrite!getP/=;smt(in_dom). + + by rewrite/#. + + by rewrite/#. + + move:H12;apply absurd=>//=_. + move:H15;rewrite dom_set in_fsetU1. + cut->/=:!take (i0{2} + 1 + 1) bl{2} = take (i0{2} + 1) bl{2} by smt(size_take). + by move=>h;cut:=H8 _ h (i0{2}+1);rewrite take_take/#. + + move=>l;rewrite!dom_set in_fsetU1;case. + - move=>H_dom;cut[]:=H3 l H_dom. + * by move=>Hdom i;rewrite in_fsetU1/=; + smt(in_dom all_prefixes_of_INV_real). + move=>[]j[][]hj0 hji0->>k. + rewrite in_fsetU1 take_take;left. + cut[]:=H3 _ H_dom;smt(in_dom take_take take_le0 take0 take_oversize). + move=>->>k. + rewrite in_fsetU1 take_take;case(0 <= k)=>hk0; + last smt(in_fsetU1 in_dom take_take take_le0 take0 take_oversize). + case(k < i0{2})=>hki01; + first smt(in_fsetU1 in_dom take_take take_le0 take0 take_oversize). + by case(k <= i0{2} + 1)=>hki02;smt(in_dom). + rewrite!getP/=. + cut->/=:!take j bl{2} = take (i0{2} + 1) bl{2} by smt(size_take). + by case(j < i0{2})=>hj0;smt(get_oget in_dom oget_some size_take). + + sp;if;auto;last first;progress. + + rewrite/#. + + rewrite/#. + + by rewrite get_oget//=. + + by cut[]_[]_ _ _ help _ _:=H3;cut->//=:=help bl{2} (i_R+1);rewrite dom_set in_fsetU1 H6. + + by rewrite set_eq//=1:get_oget//=;split;cut:=H3;rewrite set_eq 1:H1//==>[][]//=/#. + + sp. + splitwhile{1} 1 : i0 < size p0 - 1;splitwhile{2} 1 : i0 < size p0 - 1. + rcondt{1}2;2:rcondt{2}2;1,2:by auto; + while(i0 < size p0);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 : (i0 = size p0 - 1);1:(auto; + while(i0 < size p0);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). + (* TODO *) + + qed. + + + + local lemma equiv_ideal + (IF <: FUNCTIONALITY{DSqueeze,C}) + (S <: SIMULATOR{DSqueeze,C,IF}) + (D <: NDISTINGUISHER{C,DSqueeze,IF,S}) : + equiv [ S(IF).init ~ S(IF).init : true ==> ={glob S} ] => + equiv [ IF.init ~ IF.init : true ==> ={glob IF} ] => + equiv [ Indif(IF,S(IF),DRestr(A(D))).main + ~ NIndif(Squeeze(IF),S(IF),NDRestr(D)).main + : ={glob D} + ==> + ={res, glob D, glob IF, glob S, glob NC, C.c} ]. + proof. + move=>S_init IF_init. + proc;inline*;sp;wp;swap{2}2-1;swap{1}[3..5]-2;sp. + call(: ={glob IF, glob S, C.c, glob DSqueeze} + /\ C.c{1} <= NC.c{1} <= max_size + /\ inv_ideal NC.queries{1} C.queries{1});auto;last first. + + call IF_init;auto;call S_init;auto;smt(dom_set in_fsetU1 dom0 in_fset0 parse_nil max_ge0). + + proc;inline*;sp;if;auto;1:call(: ={glob IF});auto;1:proc(true);progress=>//=. + + by proc;inline*;sp;if;auto;1:call(: ={glob IF});auto;proc(true)=>//=. + proc;inline*;sp=>/=;if;auto;if{2};last first. + + wp;conseq(:_==> lres{1} = oget NC.queries.[(p,i)]{1} + /\ i{1} = n{1} + /\ inv_ideal NC.queries{1} C.queries{1} + /\ ={glob IF, glob S, C.c, NC.queries});progress. + while{1}((0 < i{1} => lres{1} = oget NC.queries.[(p,i)]{1}) + /\ 0 <= i{1} <= n{1} + /\ ((p{1}, n{1}) \in dom NC.queries{1}) + /\ valid p{1} /\ 0 < n{1} + /\ inv_ideal NC.queries{1} C.queries{1} + /\ ={glob IF, glob S, C.c, NC.queries})(n{1}-i{1});progress. + - sp;rcondf 1;auto;progress;2..:rewrite/#. + cut[]h1[]h2 h3 :=H5. + cut h5:=h2 _ _ H2 n{hr} _;1:rewrite/#. + cut :=h3 _ h5 (i2+1) _;1:rewrite/#. + by cut<-/= :=h1 _ _ H2 n{hr} _;1:rewrite/#. + by auto=>/#. + + sp;if{2}. + + rcondt{2}7;1:auto;wp;sp. print inv_ideal. + while(={glob IF, glob S, C.c, NC.queries} /\ + (i,n,p,lres){1} = (i0,n0,p0,lres0){2} /\ + inv_ideal NC.queries{1} C.queries{1} /\ + + alias + + + + sp;auto=>/=. + rcondf{2}1;1:auto;progress. + + move:H4;pose s:= List.map _ _;pose c:=C.c{hr};pose p:=p{hr};pose n:=n{hr}. + apply absurd=>//=. + print diff_size_prefixe_leq_cat. prefixe_leq_prefixe_cat_size. + search prefixe (++). + + cut h:size (format p n) = size p + n - 1 by rewrite size_cat size_nseq max_ler /#. +sear + cut h':max_size < c + size (format p n) + smt(prefixe_sizel). + while{1}(={n, p, glob IF, glob S, NC.queries} + /\ i{1} = nb_iter{2} /\ lres{1} = r{2} + /\ inv_ideal NC.queries{1} C.queries{1} + /\ max_size <= C.c{1} + + + conseq(:_ ==> lres{1} = mkseq (+Block.b0) i{1} /\ i{1} = n{1} + /\ ={glob IF, glob S} /\ C.c{1} = max_size + /\ inv_ideal NC.queries{1} C.queries{1} + /\ NC.queries{1} = NC.queries{2}.[(p{1}, n{1}) <- lres{1}]); + 1:smt(min_ler min_lel max_ler max_ler). + while{1}(lres{1} = mkseq (+Block.b0) i{1} /\ i{1} = n{1} + /\ ={glob IF, glob S} /\ C.c{1} = max_size + /\ inv_ideal NC.queries{1} C.queries{1} + /\ NC.queries{1} = NC.queries{2}.[(p{1}, n{1}) <- lres{1}]) + (n{1}-i{1}); + + rcondt{2}1;1:auto;progress. search min. + + pose m:=C.c{hr}+_. + cut/#:1 <=min n{hr} (max 0 (n{hr} + max_size - m)). + apply min_is_glb=>[/#|]. + + rewrite /min/max. + qed. + +print RealIndif. + + +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 <- map0; + mi <- map0; + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + paths <- map0.[c0 <- ([<:block>],b0)]; + } + + proc f(x : state): state = { + var p, v, y, y1, y2; + if (!mem (dom m) x) { + if (mem (dom paths) x.`2) { + (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 (mem (dom paths) x.`2) { + (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 (!mem (dom mi) x) { + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + mi.[x] <- y; + m.[y] <- x; + } else { + y <- oget mi.[x]; + } + return y; + } +}. + +lemma Real_Ideal &m (D <: DISTINGUISHER): + Pr[Indif(SqueezelessSponge(PC(Perm)), PC(Perm), D).main() @ &m: res /\ C.c <= max_size] <= + Pr[Indif(IF,S(IF),DRestr(D)).main() @ &m :res] + + (max_size ^ 2)%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. +search max_size. + apply (ler_trans _ _ _ (Pr_restr _ _ _ _ _ _ &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]). + + by byequiv (_: ={glob G3, F.RO.m} ==> _)=>//;symmetry;conseq (F.RO_LRO_D G3). + 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]);1:by byequiv (F.RO_LRO_D G4). + by byequiv G4_Ideal. +qed. + From 1d0c7fc0724ccd38bf0f71c3a0146c11f14d74c8 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 18 Apr 2018 13:01:33 +0200 Subject: [PATCH 270/394] Removed print leftover from debugging. --- sha3/proof/Common.ec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 5ec5802..fcb9dbf 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -111,7 +111,7 @@ by rewrite (@last_nonempty y z). qed. (*------------------------------ Primitive -----------------------------*) -print Block. + clone export RP as Perm with type t <- block * capacity, op dt <- bdistr `*` cdistr From ca689e39716df2baca7dcd556f2d90c106561dd5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Wed, 18 Apr 2018 13:30:42 +0200 Subject: [PATCH 271/394] . --- sha3/proof/smart_counter/Gconcl_list.ec | 520 ++++++++++++++++++++++-- 1 file changed, 489 insertions(+), 31 deletions(-) diff --git a/sha3/proof/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec index b1b8c8e..aab08f0 100644 --- a/sha3/proof/smart_counter/Gconcl_list.ec +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -41,14 +41,44 @@ module type NDFUNCTIONALITY = { proc f (p : block list, n : int) : block list }. -module type NDISTINGUISHER (F : NDFUNCTIONALITY, P : DPRIMITIVE) = { - proc distinguish () : bool -}. - module NC = { var c : int var queries : (block list * int, block list) fmap + proc init() = { + c <- 0; + queries <- map0; + } +}. + + +module BlockSponge (P : PRIMITIVE) : NFUNCTIONALITY = { + proc init() = { + P.init(); + } + proc f (p : block list, n : int) : block list = { + var r : block list <- []; + var i : int <- 0; + var (b,c) <- (b0,c0); + while (i < size p) { + (b,c) <@ P.f(b +^ nth witness p i, c); + i <- i + 1; + } + i <- 1; + r <- rcons r b; + NC.queries.[(p,1)] <- r; + while (i < n) { + (b,c) <@ P.f(b, c); + r <- rcons r b; + i <- i + 1; + NC.queries.[(p,i)] <- r; + } + return r; + } +}. + +module type NDISTINGUISHER (F : NDFUNCTIONALITY, P : DPRIMITIVE) = { + proc distinguish () : bool }. module NFC (F : NDFUNCTIONALITY) : NDFUNCTIONALITY = { @@ -165,8 +195,7 @@ module (A (D : NDISTINGUISHER) : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { proc distinguish() : bool = { var b : bool; - NC.queries <- map0; - NC.c <- 0; + NC.init(); b <@ D(NFC(DSqueeze(F)),NPC(P)).distinguish(); return b; } @@ -186,7 +215,14 @@ module NIndif (F : NFUNCTIONALITY, P : PRIMITIVE, D : NDISTINGUISHER) = { }. -module DC (D : NDISTINGUISHER) (F : NDFUNCTIONALITY) (P : DPRIMITIVE) = D(NFC(F),NPC(P)). +module DC (D : NDISTINGUISHER) (F : NDFUNCTIONALITY) (P : DPRIMITIVE) = { + proc distinguish () : bool = { + var b : bool; + NC.init(); + b <@ D(NFC(F),NPC(P)).distinguish(); + return b; + } +}. module P = Perm. @@ -211,9 +247,9 @@ section. exists b c, p.[take i l] = Some (b,c) /\ m.[(b +^ nth witness l i, c)] = p.[take (i+1) l]) & (forall l n, (l,n) \in dom q => - valid l /\ 0 < n /\ + valid l /\ 0 < n /\ size (oget q.[(l,n)]) = n /\ (forall i, 0 < i <= n => q.[(l,i)] = Some (take i (oget q.[(l,n)])))) - & (forall l n, (l,n) \in dom q => format l n \in dom p) + & (forall l n, (l,n) \in dom q => exists c, p.[format l n] = Some (last b0 (oget q.[(l,n)]),c)) & (forall l, l \in dom p => l <> [] => exists l2, parse (l ++ l2) \in dom q). @@ -255,13 +291,13 @@ section. invm m mi => dom m = rng mi. proof. by move=>h;rewrite fsetP=>x;split;rewrite in_dom in_rng/#. qed. - local lemma lemma1 c1 c2 m mi p q bs n i (l : block list): + local lemma lemma1 c1 c2 m mi p q bs i (l : block list): INV_Real c1 c2 m mi p q => ! (bs,i) \in dom q => valid bs => - 0 < i <= n => + 0 < i => size l = i => - format bs i \in dom p => + (exists c, p.[format bs i] = Some (last b0 l, c)) => (forall j, 0 < j < i => q.[(bs,j)] = Some (take j l)) => INV_Real c1 c2 m mi p q.[(bs,i) <- l]. proof. @@ -270,13 +306,16 @@ section. split;cut[]//H_mp0 H_mp1 H_mp2 H_mp3 H_mp4:=H_m_p. + move=>l1 n1;rewrite dom_set in_fsetU1. case((l1, n1) = (bs, i))=>[[]->>->>|H_neq]//=. - - rewrite H_bs_valid/=;split;1:rewrite/#;move=>j []Hj0 Hj1. - rewrite!getP/=oget_some. - by case(j=i)=>[->>|/#]//=;1:rewrite -H_size take_size//=. - move=>H_dom;cut[]->[]->/=help j[]hj0 hji:=H_mp2 _ _ H_dom. + - rewrite H_bs_valid getP/= oget_some/=H_size//=;split;1:rewrite/#;move=>j []Hj0 Hj1. + rewrite getP/=;case(j=i)=>[->>|/#]//=;1:rewrite -H_size take_size//=. + rewrite getP/=;move=>H_dom;cut[]->[]->[]H_size_get/=help:=H_mp2 _ _ H_dom;split. + - by rewrite H_neq/=H_size_get. + move=> j[]hj0 hji. rewrite !getP/=. cut:=H_neq;case(l1=bs)=>[->>H_n1i|]//=;smt(in_dom). - + smt(dom_set in_fsetU1). + + move=>m1 j;rewrite dom_set in_fsetU1 getP. + case((m1, j) = (bs, i))=>//=h H_dom. + by cut[]c ->/#:=H_mp3 _ _ H_dom. + smt(dom_set in_fsetU1). qed. @@ -288,6 +327,97 @@ section. smt(take_le0 take_oversize size_take take_take take_size nth_take in_dom). qed. + local lemma lemma2 c1 c2 m mi p q bl i sa sc lres: + INV_Real c1 c2 m mi p q => + 1 < i => + valid bl => + (sa,sc) \in dom m => + ! (format bl i) \in dom p => + ! (bl, i) \in dom q => + p.[format bl (i-1)] = Some (sa,sc) => + q.[(bl,i-1)] = Some lres => + INV_Real c1 c2 m mi p.[format bl i <- oget m.[(sa,sc)]] + q.[(bl,i) <- rcons lres (oget m.[(sa,sc)]).`1]. + proof. + move=>inv0 h1i h_valid H_dom_m H_dom_p H_dom_q H_p_val H_q_val. + split;cut[]//=_[] hmp0 hmp1 hmp2 hmp3 hmp4 hinvm:=inv0;split=>//=. + + by rewrite getP;smt(size_cat size_nseq size_ge0). + + move=>l;rewrite dom_set in_fsetU1;case;1:smt(all_prefixes_of_INV_real getP). + move=>->>j[]hj0 hjsize;rewrite getP/=. + cut:=hmp1 (format bl (i - 1));rewrite in_dom H_p_val/==>help. + cut:=hjsize;rewrite !size_cat !size_nseq/=!max_ler 1:/#=>hjsizei. + cut->/=:!take j (format bl i) = format bl i by smt(size_take). + cut 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!max_ler/#. + rewrite!size_take//=1:/#!size_nseq!max_ler 1:/#. + pose o:=if _ then _ else _;cut->/={o}:o = k - size bl by smt(). + by progress;rewrite!nth_take//= 1,2:/# !nth_nseq//=/#. + case(j < size bl + i - 2)=>hj. + - cut:=help j _;1:smt(size_cat size_nseq). + move=>[]b c[]. + cut->: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'/=getP/=. + smt(size_take size_cat size_nseq). + cut->>/=:j = size (format bl (i-1)) by smt(size_cat size_nseq). + rewrite getP/=. + cut h':size (format bl (i-1)) = size bl + i - 2 by smt(size_cat size_nseq). + rewrite h'/=-(addzA _ _ 1)/=. + cut 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';cut->/=:! size bl + i - 2 < size bl by smt(). + by rewrite nth_nseq 1:/#;smt(Block.WRing.AddMonoid.addm0 in_dom get_oget). + + move=>bs n;rewrite dom_set in_fsetU1;case=>//=[Hdom|[]->>->>]//=;do!split=>//=. + - by cut//:=hmp2 _ _ Hdom. + - by cut//:=hmp2 _ _ Hdom. + - by cut[]H_valid[]Hn0[]H_size H_prefixe:=hmp2 _ _ Hdom;rewrite getP/=;smt(). + - cut[]H_valid[]Hn0[]H_size H_prefixe k[]hk0 hksize:=hmp2 _ _ Hdom. + rewrite!getP/=;cut->/=:!(bs = bl && n = i) by smt(). + by rewrite-H_prefixe//=;smt(in_dom). + - smt(). + - by rewrite getP/=oget_some/=size_rcons;smt(in_dom get_oget). + move=>j[]hj0 hji;rewrite!getP/=oget_some-{2}cats1 take_cat. + case(i=j)=>[->>|]//=. + - by cut<-/=:j - 1 = size lres;smt(in_dom get_oget cats1). + move=>hij;cut->/=:j<>i by smt(). + cut->:size lres = i - 1 by smt(in_dom get_oget cats1). + case(j < i - 1)=>//=hh;1:smt(in_dom get_oget cats1). + by cut->>/=: j = i - 1;smt(cats0). + + move=>bs n;rewrite dom_set in_fsetU1;case=>[Hdom|[]->>->>]. + - rewrite !getP/=;smt(in_dom). + by rewrite!getP/=oget_some last_rcons/=;smt(get_oget in_dom). + move=>l;rewrite dom_set in_fsetU1;case=>[H_dom|->>]l_n_nil. + + smt(dom_set in_fsetU1). + by exists [];rewrite cats0 parseK//= 1:/# dom_set in_fsetU1. + 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']. + cut->/=: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 <: NDISTINGUISHER {P, NC, Redo, C}) : equiv [ GReal(A(D)).main ~ NIndif(Squeeze(SqueezelessSponge(P)),P,DC(D)).main @@ -315,19 +445,21 @@ section. Redo.prefixes{1} NC.queries{1}.[(bl{1}, i{1}) <- lres{1}]);progress. while(={i,nb,bl,n,p,glob NC,glob Redo,glob P,lres} /\ (n,p){1} = (nb,bl){1} /\ 0 < i{1} <= nb{1} /\ (0 < i{1} => Some lres{1} = NC.queries{1}.[(bl{1}, i{1})]) /\ - format p{1} i{1} \in dom Redo.prefixes{1} /\ + format p{1} i{1} \in dom Redo.prefixes{1} /\ valid p{1} /\ size lres{1} = i{1} /\ INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1}.[(bl{1}, i{1}) <- lres{1}]);last first. + sp;conseq(:_ ==> ={i,nb,bl,n,p,glob NC,glob Redo,glob P,lres} /\ (n,p){1} = (nb,bl){1} /\ 0 < i{1} <= nb{1} /\ (0 < i{1} => Some lres{1} = NC.queries{1}.[(bl{1}, i{1})]) /\ - format p{1} i{1} \in dom Redo.prefixes{1} /\ + format p{1} i{1} \in dom Redo.prefixes{1} /\ size lres{1} = i{1} /\ INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{1} - Redo.prefixes{1} NC.queries{1}.[(bl{1}, i{1}) <- lres{1}]);1:progress=>/#. + Redo.prefixes{1} NC.queries{1}.[(bl{1}, i{1}) <- lres{1}]);1:progress=>/#. sp;if;auto;last first. * progress. - by rewrite/#. - by cut INV0:=H;cut[]//=H_c1c2 H_m_p H_invm:=INV0;cut[]/#:=H_m_p. - - by cut[]_[]_ _ _ help _ _:=H;cut:=help _ _ H3. + - by cut[]_[]_ _ _ help _ _:=H;cut:=help _ _ H3;smt(in_dom). + - cut[]_[]Hmp0 Hmp1 Hmp2 Hmp3 Hmp4 Hinvm:=H. + cut//=:=Hmp2 bl{2} 1 H3;rewrite H0/==>help;cut/=->/=:=help 1;rewrite oget_some size_take//=. by rewrite set_eq 1:get_oget//=;split;case:H=>//=;smt(size_ge0). sp=>/=. exists* Redo.prefixes{1}, C.c{1};elim*=>pref count;progress. @@ -362,8 +494,9 @@ section. pose k:=if _ then _ else _;cut->>Hij{k}:k=j by rewrite/#. by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#;smt(in_dom). - by move=>l n;rewrite!dom_set in_fsetU1=>[][];smt(getP oget_some in_dom take_oversize). - - move=>l n;rewrite dom_set in_fsetU1;case=>//=;1:smt(in_dom). - by move=>[]<<-->>;rewrite/format/=nseq0 cats0/=-take_size in_dom H5. + - move=>l n;rewrite dom_set in_fsetU1 getP;case((l, n) = (bl{2}, 1))=>//=[[->>->>]|]. + * by rewrite oget_some/=/format/=nseq0 cats0-take_size H5/#. + move=>h H_dom;cut[]c:=Hmp3 _ _ H_dom;smt(in_dom). - move=>l H_dom_R H_not_nil;rewrite dom_set. cut:=H7 l H_dom_R;case;1:smt(in_fsetU1). move=>[]j[][]hj0 hjsize ->>;exists(drop j bl{2}). @@ -462,14 +595,16 @@ section. rewrite!getP/=. cut->/=:!take j bl{2} = take (i0{2} + 1) bl{2} by smt(size_take). by case(j < i0{2})=>hj0;smt(get_oget in_dom oget_some size_take). - sp;if;auto;last first;progress. + rewrite/#. + rewrite/#. + by rewrite get_oget//=. - + by cut[]_[]_ _ _ help _ _:=H3;cut->//=:=help bl{2} (i_R+1);rewrite dom_set in_fsetU1 H6. - + by rewrite set_eq//=1:get_oget//=;split;cut:=H3;rewrite set_eq 1:H1//==>[][]//=/#. - + + rewrite in_dom;cut[]_[]_ _ _ help _ _:=H4. + by cut//=:=help bl{2} (size lres{2}+1);rewrite dom_set in_fsetU1 H7/==>[][]c->. + + cut[]_[]_ _ help _ _ _:=H4. + cut:=help bl{2} (size lres{2}+1);rewrite dom_set in_fsetU1//=H7/=H3/=!getP/=. + by cut->/=[]_[]->//:!size lres{2} + 1 = size lres{2} by smt(). + + by rewrite set_eq//=1:get_oget//=;split;cut:=H4;rewrite set_eq 1:H1//==>[][]//=/#. sp. splitwhile{1} 1 : i0 < size p0 - 1;splitwhile{2} 1 : i0 < size p0 - 1. rcondt{1}2;2:rcondt{2}2;1,2:by auto; @@ -478,11 +613,334 @@ section. seq 1 : (i0 = size p0 - 1);1:(auto; while(i0 < size p0);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). - (* TODO *) + wp;conseq(:_==> ={sa,sc,glob Redo,glob Perm} + /\ INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{1} + Redo.prefixes{1} NC.queries{1}.[(p{1}, i{1}) <- rcons lres{1} sa{1}] + /\ (format p{1} i{1} \in dom Redo.prefixes{1}));progress. + + smt(size_ge0). + + smt(size_ge0). + + by rewrite getP/=. + + exact size_rcons. + + by rewrite set_set//=. + seq 1 1 : (={nb,bl,n,p,p0,i,i0,lres,sa,sc,glob NC,glob Redo,glob Perm} + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = format p{1} i{1} + /\ 1 < i{1} <= n{1} /\ valid p{1} /\ i0{1} = size p0{1} - 1 + /\ Some lres{1} = NC.queries{1}.[(bl{1}, i{1}-1)] + /\ ! ((p{1}, i{1}) \in dom NC.queries{1}) + /\ Redo.prefixes{1}.[format p{1} (i{1}-1)] = Some (sa{1},sc{1}) + /\ INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} + Redo.prefixes{1} NC.queries{1}.[(bl{1}, i{1} - 1) <- lres{1}]);last first. + + if;auto;progress. + - move:H6;rewrite -addzA/=take_size=>H_dom. + move:H5;rewrite set_eq 1:H2//= =>inv0. + apply lemma1=>//=. + * split;case:inv0=>//=/#. + * smt(). + * rewrite size_rcons;cut[]//=Hc[]Hmp0 Hmp1 Hmp2 Hmp3 Hmp4 Hinvm:=inv0. + by cut:=Hmp2 bl{2} (i{2}-1);rewrite in_dom -H2/=H1/=oget_some/#. + * rewrite last_rcons;smt(get_oget in_dom). + move=>j[]hj0 hji. + cut[]//=Hc[]Hmp0 Hmp1 Hmp2 Hmp3 Hmp4 Hinvm:=inv0;cut:=Hmp2 bl{2} (i{2}-1). + rewrite in_dom -H2/=H1/=oget_some=>[][]hi10[]hsize->;1:smt(). + congr;rewrite-cats1 take_cat;case(j < size lres{2})=>//=hsize2. + cut->//=:j = size lres{2} by smt(). + by rewrite cats0 take_size. + - by move:H6;rewrite -(addzA _ _ 1)/=take_size. + sp;if;auto;progress. + - move:H6 H7;rewrite!getP/=!oget_some nth_last -(addzA _ _ 1)/=take_size. + rewrite last_cat last_nseq 1:/# Block.WRing.addr0;progress. + cut//=:=lemma2(C.c{1} + 1)(NC.c{2} + size bl{2} + i{2} - 1) + Perm.m{2}.[(sa_R, sc{2}) <- y0L] Perm.mi{2}.[y0L <- (sa_R, sc{2})] + Redo.prefixes{2} NC.queries{2} bl{2} i{2} sa_R sc{2} lres{2}. + rewrite H/=H1/=H2/=H4/=H6/=H3/=dom_set in_fsetU1/=getP/=oget_some. + cut->->//=:y0L = (y0L.`1, y0L.`2) by smt(). + rewrite INV_Real_addm_mi//=;2:smt(supp_dexcepted). + by cut:=H5;rewrite set_eq 1:H2//==>hinv0;split;case:hinv0=>//=/#. + - by rewrite dom_set in_fsetU1//=-(addzA _ _ 1)/=take_size. + - move:H6 H7;rewrite nth_last -(addzA _ _ 1)/=take_size. + rewrite last_cat last_nseq 1:/# Block.WRing.addr0;progress. + pose a:=(_, _);cut->/={a}:a = oget Perm.m{2}.[(sa_R, sc{2})] by smt(). + apply lemma2=>//=;first cut:=H5;rewrite set_eq 1:H2//==>hinv0;split;case:hinv0=>//=/#. + rewrite H2//=. + - by rewrite dom_set in_fsetU1//=-(addzA _ _ 1)/=take_size. + alias{1} 1 pref = Redo.prefixes;sp;alias{1} 1 count = C.c. + alias{1} 1 pm = Perm.m;sp;alias{1} 1 pmi = Perm.mi;sp. + conseq(:_==> ={nb,bl,n,p,p0,i,i0,lres,sa,sc,glob NC,glob Redo,glob Perm} + /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} + /\ pref{1} = Redo.prefixes{1} /\ C.c{1} = count{1} + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = format p{1} i{1} + /\ i0{1} = size p0{1} - 1 + /\ Redo.prefixes{1}.[format p{1} (i0{1} - size p{1} + 1)] = Some (sa{1}, sc{1})); + 1:smt(size_cat size_nseq). + splitwhile{1}1:i0 < size p;splitwhile{2}1:i0 < size p. + while(={nb,bl,n,p,p0,i,i0,lres,sa,sc,glob NC,glob Redo,glob Perm} + /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} /\ 0 < i{1} + /\ pref{1} = Redo.prefixes{1} /\ C.c{1} = count{1} + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = format p{1} i{1} + /\ size p{1} <= i0{1} <= size p0{1} - 1 /\ valid p{1} + /\ (format p{1} (i{1}-1) \in dom Redo.prefixes{1}) + /\ INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} + Redo.prefixes{1} NC.queries{1} + /\ Redo.prefixes{1}.[format p{1} (i0{1} - size p{1} + 1)] = Some (sa{1}, sc{1}) ). + + rcondt{1}1;2:rcondt{2}1;auto;progress. + - rewrite take_format;1,2:smt(size_cat size_ge0 size_nseq). + cut->/=:! i0{m} + 1 <= size bl{m} by smt(). + cut:=take_format bl{m} (i{m}-1) (i0{m} + 1) _ _;1,2:smt(size_cat size_ge0 size_nseq). + cut->/=<-:! i0{m} + 1 <= size bl{m} by smt(). + by cut/#:=all_prefixes_of_INV_real. + - rewrite take_format;1,2:smt(size_cat size_ge0 size_nseq). + cut->/=:! i0{hr} + 1 <= size bl{hr} by smt(). + cut:=take_format bl{hr} (i{hr}-1) (i0{hr} + 1) _ _;1,2:smt(size_cat size_ge0 size_nseq). + cut->/=<-:! i0{hr} + 1 <= size bl{hr} by smt(). + by cut/#:=all_prefixes_of_INV_real. + - smt(). + - smt(). + - rewrite take_format//=;1:smt(size_cat size_ge0 size_nseq). + cut->/=:!i0{2} + 1 <= size bl{2} by smt(). + rewrite get_oget 2:/#. + cut:=take_format bl{2} (i{2}-1) (i0{2} + 1) _ _;1,2:smt(size_cat size_ge0 size_nseq). + cut->/=:!i0{2} + 1 <= size bl{2} by smt(). + by cut/#:=all_prefixes_of_INV_real. + conseq(:_==> ={nb,bl,n,p,p0,i,i0,lres,sa,sc,glob NC,glob Redo,glob Perm} + /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} /\ 0 < i{1} + /\ pref{1} = Redo.prefixes{1} /\ C.c{1} = count{1} + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = format p{1} i{1} + /\ size p{1} = i0{1} /\ valid p{1} + /\ (format p{1} (i{1}-1) \in dom Redo.prefixes{1}) + /\ INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} + Redo.prefixes{1} NC.queries{1} + /\ Redo.prefixes{1}.[take i0{1} p{1}] = Some (sa{1}, sc{1})); + progress. + + smt(size_cat size_ge0 size_nseq). + + by rewrite /format/=nseq0 cats0 -take_size;exact H12. + + smt(). + while( ={nb,bl,n,p,p0,i,i0,lres,sa,sc,glob NC,glob Redo,glob Perm} + /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} /\ 1 < i{1} + /\ pref{1} = Redo.prefixes{1} /\ C.c{1} = count{1} + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = format p{1} i{1} + /\ 0 <= i0{1} <= size p{1} /\ valid p{1} + /\ (format p{1} (i{1}-1) \in dom Redo.prefixes{1}) + /\ INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} + Redo.prefixes{1} NC.queries{1} + /\ Redo.prefixes{1}.[take i0{1} p{1}] = Some (sa{1}, sc{1}) );last first. + + auto;progress. + - smt(size_ge0). + - smt(size_ge0). + - smt(). + - smt(set_eq in_dom). + - by rewrite take0;case:H4=>[]_[]//=. + - smt(size_cat size_nseq size_ge0). + - smt(size_cat size_nseq size_ge0). + rcondt{1}1;2:rcondt{2}1;auto;progress. + + cut->:take (i0{m} + 1) (format bl{m} i{m}) = + take (i0{m} + 1) (format bl{m} (i{m} - 1)) + by rewrite!take_format//=;smt(size_cat size_ge0 size_nseq). + by cut/#:=all_prefixes_of_INV_real. + + cut->:take (i0{hr} + 1) (format bl{hr} i{hr}) = + take (i0{hr} + 1) (format bl{hr} (i{hr} - 1)) + by rewrite!take_format//=;smt(size_cat size_ge0 size_nseq). + by cut/#:=all_prefixes_of_INV_real. + + smt(). + + smt(). + cut->:take (i0{2} + 1) (format bl{2} i{2}) = + take (i0{2} + 1) (format bl{2} (i{2} - 1)) + by rewrite!take_format//=;smt(size_cat size_ge0 size_nseq). + cut->:take (i0{2} + 1) bl{2} = take (i0{2} + 1) (format bl{2} (i{2} - 1)) + by rewrite take_format;smt(size_cat size_ge0 size_nseq). + by cut:=all_prefixes_of_INV_real _ _ _ _ _ _ H4 _ H3;smt(in_dom). + qed. + + + local lemma lemma3 c c' m mi p q bl i sa sc lres: + INV_Real c c' m mi p q => + 0 < i => + q.[(bl,i)] = Some lres => + p.[format bl i] = Some (sa,sc) => + (bl,i+1) \in dom q => + q.[(bl,i+1)] = Some (rcons lres (oget m.[(sa,sc)]).`1). + proof. + move=>inv0 H_i0 H_q_i H_p_i H_dom_iS. + cut[]_[]_ hmp1 hmp2 hmp3 _ _:=inv0. + cut[]c2 h2:=hmp3 _ _ H_dom_iS. + cut:=hmp1 (format bl (i+1));rewrite in_dom h2/==>help. + cut:=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). + cut->/=:!size (format bl i) + 1 <= size bl by smt(size_cat size_nseq size_ge0). + rewrite nth_cat. + cut->/=:!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 _;cut->/={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;cut->/={x}:x=i+1 + by rewrite/x size_cat size_nseq;smt(). + rewrite H_p_i h2=>[]/=[][]->>->>. + rewrite Block.WRing.addr0=>H_pm;rewrite H_pm/=oget_some. + cut[]_[]_[]H_size H:=hmp2 _ _ H_dom_iS. + cut H_q_i':=H i _;1:smt(). + cut:=H (i+1) _;1:smt(). + rewrite (take_nth witness)1:/# =>H_q_iS. + rewrite H_q_iS/=oget_some last_rcons;congr. + by cut:=H_q_i';rewrite H_q_i/=. + qed. + + + local lemma lemma3' c c' m mi p q bl i sa sc lres: + INV_Real c c' m mi p q => + 0 < i => + q.[(bl,i)] = Some lres => + p.[format bl i] = Some (sa,sc) => + (bl,i+1) \in dom q => + q.[(bl,i+1)] = Some (rcons lres (oget p.[format bl (i+1)]).`1). + proof. + move=>inv0 H_i0 H_q_i H_p_i H_dom_iS. + cut[]_[]_ hmp1 hmp2 hmp3 _ _:=inv0. + cut->:=lemma3 _ _ _ _ _ _ _ _ _ _ _ inv0 H_i0 H_q_i H_p_i H_dom_iS;congr;congr. + cut[]b3 c3[]:=hmp1 (format bl (i+1)) _ (size (format bl i)) _. + + rewrite in_dom;smt(). + + rewrite!size_cat!size_nseq;smt(size_ge0). + rewrite nth_cat nth_nseq;1:smt(size_cat size_nseq size_ge0). + cut->/=:!size (format bl i) < size bl by smt(size_cat size_nseq size_ge0). + rewrite Block.WRing.addr0 !take_format 1,3:/#;1,2:smt(size_cat size_nseq size_ge0). + cut->/=:!size (format bl i) + 1 <= size bl by smt(size_cat size_nseq size_ge0). + cut->:size (format bl i) + 1 - size bl = i by smt(size_cat size_nseq). + case(size (format bl i) <= size bl)=>//=Hi;last first. + + cut->:size (format bl i) - size bl + 1 = i by smt(size_cat size_nseq). + by rewrite H_p_i/==>[][]->>->>->//. + cut->>/=:i = 1 by smt(size_cat size_nseq). + by cut:=H_p_i;rewrite /(format bl 1)/=nseq0 cats0 take_size=>->/=[]->>->>->//. + qed. + + + local lemma lemma4 c c' m mi p q bl i sa sc lres: + INV_Real c c' m mi p q => + 0 < i => + q.[(bl,i)] = Some lres => + p.[format bl i] = Some (sa,sc) => + (bl,i+1) \in dom q => + p.[format bl (i+1)] = m.[(sa,sc)]. + proof. + move=>inv0 H_i0 H_q_i H_p_i H_dom_iS. + cut[]_[]_ hmp1 hmp2 hmp3 _ _:=inv0. + cut[]c2 h2:=hmp3 _ _ H_dom_iS. + cut:=hmp1 (format bl (i+1));rewrite in_dom h2/==>help. + cut:=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). + cut->/=:!size (format bl i) + 1 <= size bl by smt(size_cat size_nseq size_ge0). + rewrite nth_cat. + cut->/=:!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 _;cut->/={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;cut->/={x}:x=i+1 + by rewrite/x size_cat size_nseq;smt(). + rewrite H_p_i h2=>[]/=[][]->>->>. + rewrite Block.WRing.addr0=>H_pm;rewrite H_pm/=. + cut[]_[]_[]H_size H:=hmp2 _ _ H_dom_iS. + cut H_q_i':=H i _;1:smt(). + cut:=H (i+1) _;1:smt(). + by rewrite (take_nth witness)1:/# =>H_q_iS. qed. + local lemma squeeze_squeezeless (D <: NDISTINGUISHER {P, NC, Redo, C}) : + equiv [ NIndif(Squeeze(SqueezelessSponge(P)),P,DC(D)).main + ~ NIndif(BlockSponge(P),P,DC(D)).main + : ={glob D} ==> ={res, glob P, glob D, NC.c}]. + proof. + proc;inline*;sp;wp. + call(: ={glob Perm,glob NC} + /\ INV_Real 0 NC.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} + NC.queries{1});auto;last first. + + progress. + split=>//=;1:split=>//=;smt(getP dom0 map0P in_fset0 dom_set in_fsetU1). + + proc;inline*;auto;sp;if;auto;progress. + - by rewrite INV_Real_addm_mi;2..:smt(supp_dexcepted);split;case:H=>//=;smt(). + - by split;case:H=>//=;smt(). + + proc;inline*;auto;sp;if;auto;progress. + - rewrite INV_Real_addm_mi;1: by split;case:H=>//=;smt(). + * case:H;smt(invm_dom_rng invmC supp_dexcepted). + case:H;smt(invm_dom_rng invmC supp_dexcepted). + - by split;case:H=>//=;smt(). + proc;inline*;sp;auto;if;auto;if;auto;sp. + rcondt{1}1;auto;sp. + seq 1 4 : (={glob Perm, glob NC, i, p, n, bl, nb} /\ nb{1} = n{1} + /\ (lres,sa,sc){1} = (r0,b,c){2} /\ bl{1} = p{2} + /\ NC.queries{1}.[(p{1},i{1})] = Some lres{1} + /\ valid p{1} /\ i{1} <= n{1} /\ i{1} = 1 + /\ ! ((p,n) \in dom NC.queries){1} + /\ INV_Real 0 NC.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} + NC.queries{1}.[(p{1}, i{1}) <- lres{1}] + /\ Redo.prefixes{1}.[p{1}] = Some (sa{1},sc{1}));last first. + + auto=>/=. + while(={glob Perm, glob NC, i, p, n, bl, nb} /\ nb{1} = n{1} + /\ (lres){1} = (r0){2} /\ bl{1} = p{2} /\ 0 < i{2} <= n{1} + /\ valid p{1} + /\ NC.queries{1}.[(p{1},i{1})] = Some lres{1} + /\ ! ((p,n) \in dom NC.queries){1} + /\ INV_Real 0 NC.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} + NC.queries{1}.[(p{1}, i{1}) <- lres{1}] + /\ Redo.prefixes{1}.[format p{1} i{1}] = Some (b{2},c{2}));last first. + - auto;progress. + * by rewrite/format/=nseq0 cats0 H4//=. + * smt(). + sp;if{1};last first. + - rcondf{2}1;auto;progress. + * cut:=H4;rewrite set_eq//=in_dom=>inv0. + cut[]_[]_ hmp1 hmp2 hmp3 _ _:=inv0. + cut:=hmp1 (format p{hr} (i{hr}+1));rewrite in_dom//=. + cut[]c3 h3:=hmp3 _ _ H8;rewrite h3/= => help. + cut[]b4 c4:=help (size p{hr} + i{hr} - 1) _;1:smt(size_cat size_nseq size_ge0). + rewrite !take_format 1,3:/#;1,2:smt(size_cat size_nseq size_ge0). + rewrite nth_cat/=nth_nseq/=1:/# -(addzA _ (-1) 1)/=. + cut->/=:!size p{hr} + i{hr} <= size p{hr} by smt(). + cut->/=:!size p{hr} + i{hr} - 1 < size p{hr} by smt(). + pose x:=if _ then _ else _;cut->/={x}:x = format p{hr} i{hr}. + + rewrite/x;case(i{hr}=1)=>[->>|/#]//=. + by rewrite -(addzA _ 1 (-1))/= take_size/format/=nseq0 cats0. + by rewrite Block.WRing.addr0 (addzAC _ i{hr})/=H5/==>[][][]->>->>->;rewrite h3. + * rewrite set_eq//=. + cut:=H4;rewrite set_eq//==>inv0. + by cut->:=lemma3 _ _ _ _ _ _ _ _ _ _ _ inv0 H H2 H5 H8. + * cut:=H4;rewrite set_eq//==>inv0. + by cut->:=lemma3 _ _ _ _ _ _ _ _ _ _ _ inv0 H H2 H5 H8. + * smt(). + * smt(). + * smt(get_oget in_dom). + * smt(set_eq get_oget in_dom). + * cut:=H4;rewrite set_eq//==>inv0. + cut->:=lemma4 _ _ _ _ _ _ _ _ _ _ _ inv0 H H2 H5 H8;rewrite get_oget 2:/#. + cut[]_[]_ hmp1 hmp2 hmp3 _ _:=inv0. + cut:=hmp1 (format p{2} (i{2}+1));rewrite in_dom//=. + cut[]c3 h3:=hmp3 _ _ H8;rewrite h3/= => help. + cut[]b4 c4:=help (size p{2} + i{2} - 1) _;1:smt(size_cat size_nseq size_ge0). + rewrite !take_format 1,3:/#;1,2:smt(size_cat size_nseq size_ge0). + rewrite nth_cat/=nth_nseq/=1:/# -(addzA _ (-1) 1)/=. + cut->/=:!size p{2} + i{2} <= size p{2} by smt(). + cut->/=:!size p{2} + i{2} - 1 < size p{2} by smt(). + pose x:=if _ then _ else _;cut->/={x}:x = format p{2} i{2}. + + rewrite/x;case(i{2}=1)=>[->>|/#]//=. + by rewrite -(addzA _ 1 (-1))/= take_size/format/=nseq0 cats0. + by rewrite in_dom Block.WRing.addr0 (addzAC _ i{2})/=H5/==>[][][]->>->>->;rewrite h3. + swap{2}4-3;wp;sp=>/=. + splitwhile{1}1:i0 < size p0 - 1. + rcondt{1}2;2:rcondf{1}4;auto. + + while(0 <= i0 <= size p0 -1);last by auto;smt(size_cat size_nseq size_ge0). + if;auto;1:smt(size_cat size_nseq size_ge0). + by sp;if;auto;smt(size_cat size_nseq size_ge0). + + seq 1 : (i0 = size p0 - 1). + - while(0 <= i0 <= size p0 -1);last by auto;smt(size_cat size_nseq size_ge0). + if;auto;1:smt(size_cat size_nseq size_ge0). + by sp;if;auto;smt(size_cat size_nseq size_ge0). + by if;auto;1:smt();sp;if;auto;smt(). + seq 1 1 : + + + qed. local lemma equiv_ideal (IF <: FUNCTIONALITY{DSqueeze,C}) @@ -624,9 +1082,9 @@ module S(F : DFUNCTIONALITY) = { } }. -lemma Real_Ideal &m (D <: DISTINGUISHER): - Pr[Indif(SqueezelessSponge(PC(Perm)), PC(Perm), D).main() @ &m: res /\ C.c <= max_size] <= - Pr[Indif(IF,S(IF),DRestr(D)).main() @ &m :res] + +lemma Real_Ideal &m (D <: NDISTINGUISHER): + Pr[NIndif(BlockSponge(PC(Perm)), PC(Perm), D).main() @ &m: res /\ C.c <= max_size] <= + Pr[NIndif(IF,S(IF),DRestr(D)).main() @ &m : res] + (max_size ^ 2)%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). From 84178087c1465bc876b772a2eceb834913944683 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 19 Apr 2018 16:43:27 +0200 Subject: [PATCH 272/394] BlockSponge: - DRestr defined and explained. - The lemma we want to prove at the end of my part. - Definition of the simulator (it uses the definition of the simulator in the very low level). --- sha3/proof/BlockSponge.ec | 112 +++++++++++++++++++++++++++++++++++--- 1 file changed, 103 insertions(+), 9 deletions(-) diff --git a/sha3/proof/BlockSponge.ec b/sha3/proof/BlockSponge.ec index 5c9956d..ba95d77 100644 --- a/sha3/proof/BlockSponge.ec +++ b/sha3/proof/BlockSponge.ec @@ -1,8 +1,8 @@ (*-------------------- Padded Block Sponge Construction ----------------*) -require import Core Int Real List. -require (*--*) IRO Indifferentiability. -require import Common. +require import AllCore Int Real List. +require (*--*) IRO Indifferentiability Gconcl. +require import Common SLCommon. (*------------------------- Indifferentiability ------------------------*) @@ -24,6 +24,101 @@ clone import IRO as BIRO with 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;cut{1}->:p=format p 1;2:smt(parseK). +by rewrite/format/=nseq0 cats0. +qed. + + +(*------------------------------ Counter -------------------------------*) + +module C = { + var c : int + proc init() = { + c <- 0; + } +}. + +(*---------------------------- 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 FC (F : DFUNCTIONALITY) = { + proc init () : unit = {} + proc f (bl : block list, nb : int) = { + var r : block list <- []; + if (0 < nb) { + if (C.c + size bl + nb - 1 <= max_size) { + C.c <- C.c + size bl + nb - 1; + r <@ F.f(bl,nb); + } + } + return r; + } +}. + + +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 r : block list <- []; + r <@ F.f(parse p); + return last b0 r; + } +}. + +module (S : SIMULATOR) (F : DFUNCTIONALITY) = Gconcl.S(Last(F)). + (*------------------------- Sponge Construction ------------------------*) module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { @@ -57,14 +152,13 @@ module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { (* this is just for typechecking, right now: *) -op eps : real. - lemma conclusion : - exists (S <: SIMULATOR), forall (D <: DISTINGUISHER) &m, - `| Pr[RealIndif(Sponge, Perm, D).main() @ &m : res] - - Pr[IdealIndif(IRO, S, D).main() @ &m : res]| - < eps. + `| Pr[RealIndif(Sponge, Perm, DRestr(D)).main() @ &m : res] + - Pr[IdealIndif(IRO, S, DRestr(D)).main() @ &m : res]| + <= (max_size ^ 2)%r / 2%r * Distr.mu1 dstate witness + + max_size%r * ((2 * max_size)%r / (2 ^ c)%r) + + max_size%r * ((2 * max_size)%r / (2 ^ c)%r). proof. admit. qed. From d7757a89c4c2bff2cc741f2e7ad345aaabec39ec Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 19 Apr 2018 17:50:39 +0200 Subject: [PATCH 273/394] Updating to include smart_counter in EasyCrypt load path. --- sha3/proof/.dir-locals.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/proof/.dir-locals.el b/sha3/proof/.dir-locals.el index a0bbb33..0337f77 100644 --- a/sha3/proof/.dir-locals.el +++ b/sha3/proof/.dir-locals.el @@ -1,4 +1,4 @@ ((easycrypt-mode . ((eval . (flet ((pre (s) (concat (locate-dominating-file buffer-file-name ".dir-locals.el") s))) - (setq easycrypt-load-path `(,(pre ".") ,(pre "core")))))))) + (setq easycrypt-load-path `(,(pre ".") ,(pre "core") ,(pre "smart_counter")))))))) From 11fb73a6c2ab4df1063ba484e7fd63a0c7c3412c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 19 Apr 2018 17:58:03 +0200 Subject: [PATCH 274/394] Real : 1 step finished, 1 step 90% finished, 1 step todo. Ideal : all steps todo (should not be hard). --- sha3/proof/smart_counter/Gconcl_list.ec | 704 +++++++++++++++--------- 1 file changed, 434 insertions(+), 270 deletions(-) diff --git a/sha3/proof/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec index aab08f0..ce418ba 100644 --- a/sha3/proof/smart_counter/Gconcl_list.ec +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -1,132 +1,45 @@ pragma -oldip. require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. -require import DProd Dexcepted. +require import DProd Dexcepted BlockSponge. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. require (*--*) Handle. -clone export Handle as Handle0. - (*** THEORY PARAMETERS ***) (** Validity of Functionality Queries **) -op valid: block list -> bool. +op valid: block list -> bool = valid_block. axiom valid_spec p: valid p => p <> []. -(** 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 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 p => parse p = (p,1). -proof. -move=>h;cut{1}->:p=format p 1;2:smt(parseK). -by rewrite/format/=nseq0 cats0. -qed. - -module type NFUNCTIONALITY = { - proc init () : unit - proc f (p : block list, n : int) : block list -}. - -module type NDFUNCTIONALITY = { - proc f (p : block list, n : int) : block list -}. +clone export Handle as Handle0. module NC = { - var c : int var queries : (block list * int, block list) fmap proc init() = { - c <- 0; queries <- map0; } }. -module BlockSponge (P : PRIMITIVE) : NFUNCTIONALITY = { - proc init() = { - P.init(); - } - proc f (p : block list, n : int) : block list = { - var r : block list <- []; - var i : int <- 0; - var (b,c) <- (b0,c0); - while (i < size p) { - (b,c) <@ P.f(b +^ nth witness p i, c); - i <- i + 1; - } - i <- 1; - r <- rcons r b; - NC.queries.[(p,1)] <- r; - while (i < n) { - (b,c) <@ P.f(b, c); - r <- rcons r b; - i <- i + 1; - NC.queries.[(p,i)] <- r; - } - return r; - } -}. - -module type NDISTINGUISHER (F : NDFUNCTIONALITY, P : DPRIMITIVE) = { - proc distinguish () : bool -}. - -module NFC (F : NDFUNCTIONALITY) : NDFUNCTIONALITY = { - proc f (bl : block list, nb : int) = { - var r : block list <- []; - if (valid bl /\ 0 < nb) { - if (! (bl,nb) \in dom NC.queries) { - NC.c <- NC.c + size bl + nb - 1; - r <@ F.f(bl,nb); - NC.queries.[(bl,nb)] <- r; - } else { - r <- oget NC.queries.[(bl,nb)]; - } - } - return r; - } -}. - - - -module NPC (P : DPRIMITIVE) : DPRIMITIVE = { - proc f (a : state) = { - var z : state; - z <@ P.f(a); - NC.c <- NC.c + 1; - return z; - } - proc fi (a : state) = { - var z : state; - z <@ P.fi(a); - NC.c <- NC.c + 1; - return z; - } -}. - -module (DSqueeze (F : DFUNCTIONALITY) : NDFUNCTIONALITY) = { +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; - while (i < n) { - i <- i + 1; - if (! (p,i) \in dom NC.queries) { - b <@ F.f(format p i); - lres <- rcons lres b; - NC.queries.[(p,i)] <- lres; - } else { - lres <- oget NC.queries.[(p,i)]; + if (valid p /\ 0 < n) { + while (i < n) { + i <- i + 1; + if (! (p,i) \in dom NC.queries) { + b <@ F.f(format p i); + lres <- rcons lres b; + NC.queries.[(p,i)] <- lres; + } else { + lres <- oget NC.queries.[(p,i)]; + } } } return lres; @@ -134,76 +47,30 @@ module (DSqueeze (F : DFUNCTIONALITY) : NDFUNCTIONALITY) = { }. -module (Squeeze (F : FUNCTIONALITY) : NFUNCTIONALITY) = { +module (Squeeze (F : SLCommon.FUNCTIONALITY) : FUNCTIONALITY) = { proc init () : unit = { - NC.queries <- map0; - NC.c <- 0; + NC.init(); + C.init(); F.init(); } proc f = DSqueeze(F).f }. -module NDFRestr (F : NDFUNCTIONALITY) = { - proc f (bl : block list, nb : int) = { - var b : block <- b0; - var lres : block list <- []; - var i : int <- 0; - - if (valid bl /\ 0 < nb) { - if (! (bl,nb) \in dom NC.queries) { - if (NC.c + size bl + nb - 1 <= max_size) { - NC.c <- NC.c + size bl + nb - 1; - lres <@ F.f(bl,nb); - } - } else { - lres <- oget NC.queries.[(bl,nb)]; - } - } - return lres; - } -}. - - -module NDPRestr (P : DPRIMITIVE) : DPRIMITIVE = { - proc f (a : state) = { - var z : state; - if (NC.c + 1 <= max_size) { - z <@ P.f(a); - NC.c <- NC.c + 1; - } - return z; - } - proc fi (a : state) = { - var z : state; - if (NC.c + 1 <= max_size) { - z <@ P.fi(a); - NC.c <- NC.c + 1; - } - return z; - } -}. - - - -module (NDRestr (D : NDISTINGUISHER) : NDISTINGUISHER) - (F : NDFUNCTIONALITY) (P : DPRIMITIVE) = D(NDFRestr(F),NDPRestr(P)). - - - -module (A (D : NDISTINGUISHER) : DISTINGUISHER) - (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { +module (A (D : DISTINGUISHER) : SLCommon.DISTINGUISHER) + (F : SLCommon.DFUNCTIONALITY) (P : DPRIMITIVE) = { proc distinguish() : bool = { var b : bool; NC.init(); - b <@ D(NFC(DSqueeze(F)),NPC(P)).distinguish(); + C.init(); + b <@ D(FC(DSqueeze(F)),PC(P)).distinguish(); return b; } }. -module NIndif (F : NFUNCTIONALITY, P : PRIMITIVE, D : NDISTINGUISHER) = { +module NIndif (F : FUNCTIONALITY, P : PRIMITIVE, D : DISTINGUISHER) = { proc main () : bool = { var b : bool; C.init(); @@ -215,11 +82,12 @@ module NIndif (F : NFUNCTIONALITY, P : PRIMITIVE, D : NDISTINGUISHER) = { }. -module DC (D : NDISTINGUISHER) (F : NDFUNCTIONALITY) (P : DPRIMITIVE) = { +module DC (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { proc distinguish () : bool = { var b : bool; NC.init(); - b <@ D(NFC(F),NPC(P)).distinguish(); + C.init(); + b <@ D(FC(F),PC(P)).distinguish(); return b; } }. @@ -228,8 +96,11 @@ module DC (D : NDISTINGUISHER) (F : NDFUNCTIONALITY) (P : DPRIMITIVE) = { module P = Perm. -section. +section Real_Ideal. + + + pred inv_ideal (squeeze : (block list * int, block list) fmap) (c : (block list, block) fmap) = (forall p n, (p,n) \in dom squeeze => @@ -418,75 +289,80 @@ section. qed. - local lemma equiv_sponge (D <: NDISTINGUISHER {P, NC, Redo, C}) : + local lemma equiv_sponge (D <: DISTINGUISHER {P, NC, Redo, C, SLCommon.C}) : equiv [ GReal(A(D)).main ~ NIndif(Squeeze(SqueezelessSponge(P)),P,DC(D)).main - : ={glob D} ==> ={res, glob D, glob P, glob NC} /\ C.c{1} <= NC.c{2}]. + : ={glob D} ==> ={res, glob D, glob P, NC.queries, C.c} /\ SLCommon.C.c{1} <= C.c{2}]. proof. proc;inline*;sp;wp. - call(: ={Redo.prefixes, glob P, glob NC} /\ - INV_Real C.c{1} NC.c{2} Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1});auto;last first. + call(: ={Redo.prefixes, glob P, NC.queries, C.c} /\ + INV_Real SLCommon.C.c{1} C.c{2} Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1});auto;last first. + by progress;1:(split=>//=;1:split;smt(dom0 in_fset0 dom_set in_fsetU1 getP map0P));case:H0=>//=. - + by proc;inline*;auto;sp;if;auto;smt(INV_Real_addm_mi INV_Real_incr supp_dexcepted). - + proc;inline*;auto;sp;if;auto;progress. + + 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:H=>H_c H_m_p H_invm;rewrite (invm_dom_rng _ _ H_invm)//=. - by move:H1;rewrite supp_dexcepted. + by move:H2;rewrite supp_dexcepted. case:H=>H_c H_m_p H_invm;cut<-//:=(invm_dom_rng Perm.mi{2} Perm.m{2}). by rewrite invmC. + exact INV_Real_incr. - + proc;inline*;sp;if;auto;sp;if;auto. - swap 6;wp;sp=>/=;rcondt{1}1;1:auto;rcondt{2}1;1:auto. - conseq(:_==> ={i,nb,bl,n,p,glob NC,glob Redo,glob P,lres} /\ (n,p){1} = (nb,bl){1} /\ - i{1} = nb{1} /\ - format p{1} i{1} \in dom Redo.prefixes{1} /\ - INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{1} - Redo.prefixes{1} NC.queries{1}.[(bl{1}, i{1}) <- lres{1}]);progress. - while(={i,nb,bl,n,p,glob NC,glob Redo,glob P,lres} /\ (n,p){1} = (nb,bl){1} /\ - 0 < i{1} <= nb{1} /\ (0 < i{1} => Some lres{1} = NC.queries{1}.[(bl{1}, i{1})]) /\ - format p{1} i{1} \in dom Redo.prefixes{1} /\ valid p{1} /\ size lres{1} = i{1} /\ - INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{1} - Redo.prefixes{1} NC.queries{1}.[(bl{1}, i{1}) <- lres{1}]);last first. - + sp;conseq(:_ ==> ={i,nb,bl,n,p,glob NC,glob Redo,glob P,lres} /\ (n,p){1} = (nb,bl){1} /\ - 0 < i{1} <= nb{1} /\ (0 < i{1} => Some lres{1} = NC.queries{1}.[(bl{1}, i{1})]) /\ - format p{1} i{1} \in dom Redo.prefixes{1} /\ size lres{1} = i{1} /\ - INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{1} - Redo.prefixes{1} NC.queries{1}.[(bl{1}, i{1}) <- lres{1}]);1:progress=>/#. + + proc;inline*;sp;if;auto;if;auto. + swap 6;wp;sp=>/=;if;auto;last by progress;split;case:H=>//=;smt(size_ge0). + rcondt{1}1;1:auto;rcondt{2}1;1:auto;sp. + conseq(:_==> ={i,nb,bl,n,p,NC.queries, C.c,glob Redo,glob P,lres} + /\ (n,p){1} = (nb,bl){1} /\ i{1} = nb{1} + /\ format p{1} i{1} \in dom Redo.prefixes{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} NC.queries{1});progress. + while(={i,nb,bl,n,p,NC.queries,C.c,glob Redo,glob P,lres} + /\ (n,p){1} = (nb,bl){1} /\ 0 < i{1} <= nb{1} + /\ (0 < i{1} => Some lres{1} = NC.queries{1}.[(bl{1}, i{1})]) + /\ format p{1} i{1} \in dom Redo.prefixes{1} /\ valid p{1} + /\ size lres{1} = i{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} NC.queries{1});last first. + + sp;conseq(:_ ==> ={i,nb,bl,n,p,NC.queries,C.c,glob Redo,glob P,lres} + /\ (n,p){1} = (nb,bl){1} /\ 0 < i{1} <= nb{1} + /\ (0 < i{1} => Some lres{1} = NC.queries{1}.[(bl{1}, i{1})]) + /\ format p{1} i{1} \in dom Redo.prefixes{1} /\ size lres{1} = i{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} NC.queries{1});1:progress=>/#. sp;if;auto;last first. * progress. - by rewrite/#. - - by cut INV0:=H;cut[]//=H_c1c2 H_m_p H_invm:=INV0;cut[]/#:=H_m_p. - - by cut[]_[]_ _ _ help _ _:=H;cut:=help _ _ H3;smt(in_dom). + - by rewrite get_oget//. + - by cut INV0:=H;cut[]//=H_c1c2 H_m_p H_invm:=INV0;cut[]:=H_m_p;smt(in_dom). - cut[]_[]Hmp0 Hmp1 Hmp2 Hmp3 Hmp4 Hinvm:=H. - cut//=:=Hmp2 bl{2} 1 H3;rewrite H0/==>help;cut/=->/=:=help 1;rewrite oget_some size_take//=. - by rewrite set_eq 1:get_oget//=;split;case:H=>//=;smt(size_ge0). + by cut//=:=Hmp2 bl{2} 1 H4;rewrite H0/==>help;cut/=->/=:=help 1; + rewrite oget_some size_take. + by split;case:H=>//=;smt(size_ge0). sp=>/=. - exists* Redo.prefixes{1}, C.c{1};elim*=>pref count;progress. - conseq(:_==> ={i0,p0,i,p,n,nb,bl,sa,lres,glob NC,glob Redo,glob Perm} + exists* Redo.prefixes{1}, SLCommon.C.c{1};elim*=>pref count;progress. + conseq(:_==> ={i0,p0,i,p,n,nb,bl,sa,lres,NC.queries,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 NC.c{1} Perm.m{1} Perm.mi{1} pref NC.queries{1} + /\ INV_Real count C.c{1} Perm.m{1} Perm.mi{1} pref NC.queries{1} /\ (forall l, l \in dom Redo.prefixes{1} => l \in dom pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) /\ (forall l, l \in dom pref => pref.[l] = Redo.prefixes{1}.[l]) - /\ C.c{1} <= count + i0{1} <= NC.c{1} + i0{1} + /\ 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. + by rewrite/#. + by rewrite getP/=. - + by rewrite/format/=nseq0 cats0//-take_size in_dom H5. - + rewrite set_set/=. - cut inv0:=H6;cut[]h_c1c2[]Hmp0 Hmp1 Hmp2 Hmp3 Hmp4 Hinvm:=inv0;split=>//=. - - rewrite/#. + + by rewrite/format/=nseq0 cats0//-take_size in_dom H6. + + cut inv0:=H7;cut[]h_c1c2[]Hmp0 Hmp1 Hmp2 Hmp3 Hmp4 Hinvm:=inv0;split=>//=. + - case:inv0;smt(size_ge0). split=>//=. - smt(in_dom). - - move=>l H_dom_R i []Hi0 Hisize;cut:=H7 l H_dom_R. + - move=>l H_dom_R i []Hi0 Hisize;cut:=H8 l H_dom_R. case(l \in dom Redo.prefixes{2})=>H_in_pref//=. * cut:=Hmp1 l H_in_pref i _;rewrite//=. - rewrite ?H8//=;1:smt(in_dom). + rewrite ?H9//=;1:smt(in_dom). case(i+1 < size l)=>h;1:smt(in_dom). by rewrite take_oversize 1:/#. move=>[]j[][]hj0 hjsize ->>. @@ -495,20 +371,20 @@ section. by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#;smt(in_dom). - by move=>l n;rewrite!dom_set in_fsetU1=>[][];smt(getP oget_some in_dom take_oversize). - move=>l n;rewrite dom_set in_fsetU1 getP;case((l, n) = (bl{2}, 1))=>//=[[->>->>]|]. - * by rewrite oget_some/=/format/=nseq0 cats0-take_size H5/#. + * by rewrite oget_some/=/format/=nseq0 cats0-take_size H6/#. move=>h H_dom;cut[]c:=Hmp3 _ _ H_dom;smt(in_dom). - move=>l H_dom_R H_not_nil;rewrite dom_set. - cut:=H7 l H_dom_R;case;1:smt(in_fsetU1). + cut:=H8 l H_dom_R;case;1:smt(in_fsetU1). move=>[]j[][]hj0 hjsize ->>;exists(drop j bl{2}). by rewrite cat_take_drop parse_valid//=in_fsetU1. - while( ={i0,p0,i,p,n,nb,bl,sa,sc,lres,glob NC,glob Redo,glob Perm} + while( ={i0,p0,i,p,n,nb,bl,sa,sc,lres,NC.queries,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 NC.c{1} Perm.m{1} Perm.mi{1} pref NC.queries{1} + /\ INV_Real count C.c{1} Perm.m{1} Perm.mi{1} pref NC.queries{1} /\ (forall l, l \in dom Redo.prefixes{1} => l \in dom pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) /\ (forall l, l \in dom pref => pref.[l] = Redo.prefixes{1}.[l]) - /\ C.c{1} <= count + i0{1} <= NC.c{1} + i0{1} + /\ SLCommon.C.c{1} <= count + i0{1} <= C.c{1} + i0{1} /\ (i0{1} < size p0{1} => take (i0{1}+1) p{1} \in dom Redo.prefixes{1} => Redo.prefixes{1} = pref) @@ -600,11 +476,10 @@ section. + rewrite/#. + by rewrite get_oget//=. + rewrite in_dom;cut[]_[]_ _ _ help _ _:=H4. - by cut//=:=help bl{2} (size lres{2}+1);rewrite dom_set in_fsetU1 H7/==>[][]c->. + by cut//=:=help bl{2} (size lres{2}+1);rewrite H7/==>[][]c->. + cut[]_[]_ _ help _ _ _:=H4. - cut:=help bl{2} (size lres{2}+1);rewrite dom_set in_fsetU1//=H7/=H3/=!getP/=. - by cut->/=[]_[]->//:!size lres{2} + 1 = size lres{2} by smt(). - + by rewrite set_eq//=1:get_oget//=;split;cut:=H4;rewrite set_eq 1:H1//==>[][]//=/#. + by cut:=help bl{2} (size lres{2}+1);rewrite H7/=H3/==>[][]_[]->//=. + + by split;cut[]//=/#:=H4. sp. splitwhile{1} 1 : i0 < size p0 - 1;splitwhile{2} 1 : i0 < size p0 - 1. rcondt{1}2;2:rcondt{2}2;1,2:by auto; @@ -614,21 +489,20 @@ section. while(i0 < size p0);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;conseq(:_==> ={sa,sc,glob Redo,glob Perm} - /\ INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{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} NC.queries{1}.[(p{1}, i{1}) <- rcons lres{1} sa{1}] /\ (format p{1} i{1} \in dom Redo.prefixes{1}));progress. + smt(size_ge0). + smt(size_ge0). + by rewrite getP/=. + exact size_rcons. - + by rewrite set_set//=. - seq 1 1 : (={nb,bl,n,p,p0,i,i0,lres,sa,sc,glob NC,glob Redo,glob Perm} + seq 1 1 : (={nb,bl,n,p,p0,i,i0,lres,sa,sc,NC.queries,C.c,glob Redo,glob Perm} /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = format p{1} i{1} /\ 1 < i{1} <= n{1} /\ valid p{1} /\ i0{1} = size p0{1} - 1 /\ Some lres{1} = NC.queries{1}.[(bl{1}, i{1}-1)] /\ ! ((p{1}, i{1}) \in dom NC.queries{1}) /\ Redo.prefixes{1}.[format p{1} (i{1}-1)] = Some (sa{1},sc{1}) - /\ INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} + /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1}.[(bl{1}, i{1} - 1) <- lres{1}]);last first. + if;auto;progress. - move:H6;rewrite -addzA/=take_size=>H_dom. @@ -649,7 +523,7 @@ section. sp;if;auto;progress. - move:H6 H7;rewrite!getP/=!oget_some nth_last -(addzA _ _ 1)/=take_size. rewrite last_cat last_nseq 1:/# Block.WRing.addr0;progress. - cut//=:=lemma2(C.c{1} + 1)(NC.c{2} + size bl{2} + i{2} - 1) + cut//=:=lemma2(SLCommon.C.c{1} + 1)(C.c{2} + size bl{2} + i{2} - 1) Perm.m{2}.[(sa_R, sc{2}) <- y0L] Perm.mi{2}.[y0L <- (sa_R, sc{2})] Redo.prefixes{2} NC.queries{2} bl{2} i{2} sa_R sc{2} lres{2}. rewrite H/=H1/=H2/=H4/=H6/=H3/=dom_set in_fsetU1/=getP/=oget_some. @@ -663,24 +537,24 @@ section. apply lemma2=>//=;first cut:=H5;rewrite set_eq 1:H2//==>hinv0;split;case:hinv0=>//=/#. rewrite H2//=. - by rewrite dom_set in_fsetU1//=-(addzA _ _ 1)/=take_size. - alias{1} 1 pref = Redo.prefixes;sp;alias{1} 1 count = C.c. + 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,p0,i,i0,lres,sa,sc,glob NC,glob Redo,glob Perm} + conseq(:_==> ={nb,bl,n,p,p0,i,i0,lres,sa,sc,NC.queries,C.c,glob Redo,glob Perm} /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} - /\ pref{1} = Redo.prefixes{1} /\ C.c{1} = count{1} + /\ pref{1} = Redo.prefixes{1} /\ SLCommon.C.c{1} = count{1} /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = format p{1} i{1} /\ i0{1} = size p0{1} - 1 - /\ Redo.prefixes{1}.[format p{1} (i0{1} - size p{1} + 1)] = Some (sa{1}, sc{1})); - 1:smt(size_cat size_nseq). + /\ Redo.prefixes{1}.[format p{1} (i0{1} - size p{1} + 1)] = + Some (sa{1}, sc{1}));1:smt(size_cat size_nseq set_eq in_dom). splitwhile{1}1:i0 < size p;splitwhile{2}1:i0 < size p. - while(={nb,bl,n,p,p0,i,i0,lres,sa,sc,glob NC,glob Redo,glob Perm} + while(={nb,bl,n,p,p0,i,i0,lres,sa,sc,NC.queries, C.c,glob Redo,glob Perm} /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} /\ 0 < i{1} - /\ pref{1} = Redo.prefixes{1} /\ C.c{1} = count{1} + /\ pref{1} = Redo.prefixes{1} /\ SLCommon.C.c{1} = count{1} /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = format p{1} i{1} /\ size p{1} <= i0{1} <= size p0{1} - 1 /\ valid p{1} /\ (format p{1} (i{1}-1) \in dom Redo.prefixes{1}) - /\ INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} - Redo.prefixes{1} NC.queries{1} + /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 2) + Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1} /\ Redo.prefixes{1}.[format p{1} (i0{1} - size p{1} + 1)] = Some (sa{1}, sc{1}) ). + rcondt{1}1;2:rcondt{2}1;auto;progress. - rewrite take_format;1,2:smt(size_cat size_ge0 size_nseq). @@ -701,26 +575,26 @@ section. cut:=take_format bl{2} (i{2}-1) (i0{2} + 1) _ _;1,2:smt(size_cat size_ge0 size_nseq). cut->/=:!i0{2} + 1 <= size bl{2} by smt(). by cut/#:=all_prefixes_of_INV_real. - conseq(:_==> ={nb,bl,n,p,p0,i,i0,lres,sa,sc,glob NC,glob Redo,glob Perm} + conseq(:_==> ={nb,bl,n,p,p0,i,i0,lres,sa,sc,NC.queries, C.c,glob Redo,glob Perm} /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} /\ 0 < i{1} - /\ pref{1} = Redo.prefixes{1} /\ C.c{1} = count{1} + /\ pref{1} = Redo.prefixes{1} /\ SLCommon.C.c{1} = count{1} /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = format p{1} i{1} /\ size p{1} = i0{1} /\ valid p{1} /\ (format p{1} (i{1}-1) \in dom Redo.prefixes{1}) - /\ INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} + /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1} /\ Redo.prefixes{1}.[take i0{1} p{1}] = Some (sa{1}, sc{1})); progress. + smt(size_cat size_ge0 size_nseq). + by rewrite /format/=nseq0 cats0 -take_size;exact H12. + smt(). - while( ={nb,bl,n,p,p0,i,i0,lres,sa,sc,glob NC,glob Redo,glob Perm} + while( ={nb,bl,n,p,p0,i,i0,lres,sa,sc,NC.queries, C.c,glob Redo,glob Perm} /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} /\ 1 < i{1} - /\ pref{1} = Redo.prefixes{1} /\ C.c{1} = count{1} + /\ pref{1} = Redo.prefixes{1} /\ SLCommon.C.c{1} = count{1} /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = format p{1} i{1} /\ 0 <= i0{1} <= size p{1} /\ valid p{1} /\ (format p{1} (i{1}-1) \in dom Redo.prefixes{1}) - /\ INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} + /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1} /\ Redo.prefixes{1}.[take i0{1} p{1}] = Some (sa{1}, sc{1}) );last first. + auto;progress. @@ -847,53 +721,115 @@ section. qed. - local lemma squeeze_squeezeless (D <: NDISTINGUISHER {P, NC, Redo, C}) : + + local lemma lemma4' c c' m mi p q bl i sa sc lres: + INV_Real c c' m mi p q => + 0 < i => + q.[(bl,i)] = Some lres => + p.[format bl i] = Some (sa,sc) => + format bl (i+1) \in dom p => + p.[format bl (i+1)] = m.[(sa,sc)]. + proof. + move=>inv0 H_i0 H_q_i H_p_i H_p_dom_iS. + cut[]_[]_ hmp1 hmp2 hmp3 hmp4 _:=inv0. + cut[]:=hmp4 _ H_p_dom_iS _. + + smt(size_ge0 size_eq0 size_cat valid_spec size_nseq). + move=>l;pose pn := parse (format bl (i + 1) ++ l). + cut->/=H_dom_iS:pn = (pn.`1,pn.`2) by smt(). + cut[]c2:=hmp3 _ _ H_dom_iS. + cut->/=:format pn.`1 pn.`2 = (format bl (i + 1) ++ l) by smt(parseK formatK). + move:H_dom_iS;cut->/={pn}H_dom_iS H_p_iS_l:(pn.`1, pn.`2) = parse (format bl (i + 1) ++ l) by smt(). + cut help:=hmp1 (format bl (i + 1) ++ l) _;1:by rewrite in_dom H_p_iS_l. + cut[]b3 c3:=help (size (format bl i)) _. + + smt(size_ge0 size_cat size_nseq). + rewrite take_cat take_format//=1:/#. + + smt(size_ge0 size_cat size_nseq). + cut->/=:size (format bl i) < size (format bl (i + 1)) by smt(size_cat size_nseq). + pose x:=if _ then _ else _;cut->/={x}:x = format bl i. + + rewrite/x;rewrite size_cat size_nseq max_ler 1:/#. + case(size bl + (i - 1) <= size bl)=>//=[h|/#]. + by cut->>/=:i=1;smt(take_size nseq0 cats0). + rewrite H_p_i/==>[][][]->>->>. + rewrite nth_cat/=. + cut->/=:size (format bl i) < size (format bl (i + 1)) by smt(size_cat size_nseq). + rewrite nth_cat. + cut->/=:!size (format bl i) < size bl by smt(size_cat size_nseq size_ge0). + rewrite nth_nseq 1:size_cat 1:size_nseq 1:/#. + rewrite take_cat. + cut->/=:size (format bl i) + 1 = size (format bl (i + 1)) by smt(size_cat size_nseq). + rewrite take0 cats0 Block.WRing.addr0 =>->//=. + qed. + + + module QBlockSponge (P : DPRIMITIVE) : FUNCTIONALITY = { + proc init() = {} + proc f (p : block list, n : int) : block list = { + var r : block list <- []; + var i : int <- 0; + var (b,c) <- (b0,c0); + if (valid p /\ 0 < n) { + while (i < size p) { + (b,c) <@ P.f(b +^ nth witness p i, c); + i <- i + 1; + } + i <- 1; + r <- rcons r b; + while (i < n) { + (b,c) <@ P.f(b, c); + r <- rcons r b; + i <- i + 1; + } + } + return r; + } + }. + + local lemma squeeze_squeezeless (D <: DISTINGUISHER {P, NC, Redo, C, SLCommon.C}) : equiv [ NIndif(Squeeze(SqueezelessSponge(P)),P,DC(D)).main - ~ NIndif(BlockSponge(P),P,DC(D)).main - : ={glob D} ==> ={res, glob P, glob D, NC.c}]. + ~ RealIndif(QBlockSponge,P,DRestr(D)).main + : ={glob D} ==> ={res, glob P, glob D, C.c}]. proof. proc;inline*;sp;wp. - call(: ={glob Perm,glob NC} - /\ INV_Real 0 NC.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} + call(: ={glob Perm,C.c} + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1});auto;last first. + progress. split=>//=;1:split=>//=;smt(getP dom0 map0P in_fset0 dom_set in_fsetU1). - + proc;inline*;auto;sp;if;auto;progress. + + proc;inline*;auto;sp;if;auto;sp;if;auto;progress. - by rewrite INV_Real_addm_mi;2..:smt(supp_dexcepted);split;case:H=>//=;smt(). - by split;case:H=>//=;smt(). - + proc;inline*;auto;sp;if;auto;progress. + + proc;inline*;auto;sp;if;auto;sp;if;auto;progress. - rewrite INV_Real_addm_mi;1: by split;case:H=>//=;smt(). * case:H;smt(invm_dom_rng invmC supp_dexcepted). case:H;smt(invm_dom_rng invmC supp_dexcepted). - by split;case:H=>//=;smt(). - proc;inline*;sp;auto;if;auto;if;auto;sp. + proc;inline*;sp;auto;if;auto;if;auto;sp;if;auto; + last by progress;split;case:H=>//=;smt(size_ge0). rcondt{1}1;auto;sp. - seq 1 4 : (={glob Perm, glob NC, i, p, n, bl, nb} /\ nb{1} = n{1} - /\ (lres,sa,sc){1} = (r0,b,c){2} /\ bl{1} = p{2} + seq 1 3 : (={glob Perm, C.c, i, p, n, bl, nb} /\ nb{1} = n{1} + /\ (lres){1} = (r0){2} /\ bl{1} = p{2} /\ NC.queries{1}.[(p{1},i{1})] = Some lres{1} /\ valid p{1} /\ i{1} <= n{1} /\ i{1} = 1 - /\ ! ((p,n) \in dom NC.queries){1} - /\ INV_Real 0 NC.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1}.[(p{1}, i{1}) <- lres{1}] - /\ Redo.prefixes{1}.[p{1}] = Some (sa{1},sc{1}));last first. + /\ Redo.prefixes{1}.[p{1}] = Some (b,c){2});last first. + auto=>/=. - while(={glob Perm, glob NC, i, p, n, bl, nb} /\ nb{1} = n{1} + while(={glob Perm, C.c, i, p, n, bl, nb} /\ nb{1} = n{1} /\ (lres){1} = (r0){2} /\ bl{1} = p{2} /\ 0 < i{2} <= n{1} /\ valid p{1} /\ NC.queries{1}.[(p{1},i{1})] = Some lres{1} - /\ ! ((p,n) \in dom NC.queries){1} - /\ INV_Real 0 NC.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} - NC.queries{1}.[(p{1}, i{1}) <- lres{1}] + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} + NC.queries{1} /\ Redo.prefixes{1}.[format p{1} i{1}] = Some (b{2},c{2}));last first. - auto;progress. - * by rewrite/format/=nseq0 cats0 H4//=. - * smt(). + * cut:=H2;rewrite set_eq//=. + * by rewrite/format/=nseq0 cats0 H3//=. sp;if{1};last first. - rcondf{2}1;auto;progress. - * cut:=H4;rewrite set_eq//=in_dom=>inv0. + * cut:=H3;rewrite in_dom=>inv0. cut[]_[]_ hmp1 hmp2 hmp3 _ _:=inv0. cut:=hmp1 (format p{hr} (i{hr}+1));rewrite in_dom//=. - cut[]c3 h3:=hmp3 _ _ H8;rewrite h3/= => help. + cut[]c3 h3:=hmp3 _ _ H7;rewrite h3/= => help. cut[]b4 c4:=help (size p{hr} + i{hr} - 1) _;1:smt(size_cat size_nseq size_ge0). rewrite !take_format 1,3:/#;1,2:smt(size_cat size_nseq size_ge0). rewrite nth_cat/=nth_nseq/=1:/# -(addzA _ (-1) 1)/=. @@ -902,21 +838,19 @@ section. pose x:=if _ then _ else _;cut->/={x}:x = format p{hr} i{hr}. + rewrite/x;case(i{hr}=1)=>[->>|/#]//=. by rewrite -(addzA _ 1 (-1))/= take_size/format/=nseq0 cats0. - by rewrite Block.WRing.addr0 (addzAC _ i{hr})/=H5/==>[][][]->>->>->;rewrite h3. - * rewrite set_eq//=. - cut:=H4;rewrite set_eq//==>inv0. - by cut->:=lemma3 _ _ _ _ _ _ _ _ _ _ _ inv0 H H2 H5 H8. - * cut:=H4;rewrite set_eq//==>inv0. - by cut->:=lemma3 _ _ _ _ _ _ _ _ _ _ _ inv0 H H2 H5 H8. + by rewrite Block.WRing.addr0 (addzAC _ i{hr})/=H4/==>[][][]->>->>->;rewrite h3. + * cut:=H3;move=>inv0. + by cut->:=lemma3 _ _ _ _ _ _ _ _ _ _ _ inv0 H H2 H4 H7. + (* * cut:=H3;rewrite //==>inv0. *) + (* by cut->:=lemma3 _ _ _ _ _ _ _ _ _ _ _ inv0 H H2 H4 H7. *) * smt(). * smt(). * smt(get_oget in_dom). - * smt(set_eq get_oget in_dom). - * cut:=H4;rewrite set_eq//==>inv0. - cut->:=lemma4 _ _ _ _ _ _ _ _ _ _ _ inv0 H H2 H5 H8;rewrite get_oget 2:/#. + * cut:=H3;rewrite //==>inv0. + cut->:=lemma4 _ _ _ _ _ _ _ _ _ _ _ inv0 H H2 H4 H7;rewrite get_oget 2:/#. cut[]_[]_ hmp1 hmp2 hmp3 _ _:=inv0. cut:=hmp1 (format p{2} (i{2}+1));rewrite in_dom//=. - cut[]c3 h3:=hmp3 _ _ H8;rewrite h3/= => help. + cut[]c3 h3:=hmp3 _ _ H7;rewrite h3/= => help. cut[]b4 c4:=help (size p{2} + i{2} - 1) _;1:smt(size_cat size_nseq size_ge0). rewrite !take_format 1,3:/#;1,2:smt(size_cat size_nseq size_ge0). rewrite nth_cat/=nth_nseq/=1:/# -(addzA _ (-1) 1)/=. @@ -925,7 +859,7 @@ section. pose x:=if _ then _ else _;cut->/={x}:x = format p{2} i{2}. + rewrite/x;case(i{2}=1)=>[->>|/#]//=. by rewrite -(addzA _ 1 (-1))/= take_size/format/=nseq0 cats0. - by rewrite in_dom Block.WRing.addr0 (addzAC _ i{2})/=H5/==>[][][]->>->>->;rewrite h3. + by rewrite in_dom Block.WRing.addr0 (addzAC _ i{2})/=H4/==>[][][]->>->>->;rewrite h3. swap{2}4-3;wp;sp=>/=. splitwhile{1}1:i0 < size p0 - 1. rcondt{1}2;2:rcondf{1}4;auto. @@ -937,10 +871,240 @@ section. if;auto;1:smt(size_cat size_nseq size_ge0). by sp;if;auto;smt(size_cat size_nseq size_ge0). by if;auto;1:smt();sp;if;auto;smt(). - seq 1 1 : - - - qed. + seq 1 0 : (={glob P, C.c, i, p, n, bl, nb} + /\ nb{1} = n{1} /\ lres{1} = r0{2} /\ bl{1} = p{1} + /\ x0{2} = (sa,sc){1} /\ p0{1} = format p{1} i{1} + /\ i0{1} = size p{1} + i{1} - 2 /\ 1 < i{1} <= n{1} + /\ valid p{1} /\ 0 < n{1} + /\ ! ((p{1}, i{1}) \in dom NC.queries{1}) + /\ NC.queries{1}.[(p{1},i{1}-1)] = Some lres{1} + /\ Redo.prefixes{1}.[format p{1} (i{1}-1)] = Some (sa,sc){1} + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} + NC.queries{1});last first. + + if{1}. + - wp;rcondf{2}1. + * auto;progress. + cut[]_[]_ hmp1 hmp2 hmp3 hmp4 _:=H6. + cut:=hmp4 _ H7 _. + + rewrite-size_eq0 size_take;1:smt(size_ge0). + by rewrite size_cat size_nseq;smt(valid_spec size_eq0 size_ge0). + move=>[]l;rewrite take_oversize;1:rewrite size_cat size_nseq/#. + move=>H_dom. + pose x:= (parse (format p{hr} i{hr} ++ l)).`1. + pose y:= (parse (format p{hr} i{hr} ++ l)).`2. + cut[]:=hmp3 x y _;1:smt();cut->/=:format x y = (format p{hr} i{hr} ++ l) by smt(formatK). + cut->/={x y}c H_dom_c:(x, y) = (parse (format p{hr} i{hr} ++ l)) by smt(). + cut help:=hmp1 (format p{hr} i{hr} ++ l) _;1:by rewrite in_dom H_dom_c. + cut:=help (size (format p{hr} i{hr})-1) _;1:split. + - smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). + - move=>_;rewrite !size_cat. + cut:size l <> 0;2:smt(size_ge0). + by rewrite size_eq0;smt(in_dom cats0 formatK parseK). + move=>[]b2 c2;rewrite take_cat nth_cat/=. + cut->/=:size (format p{hr} i{hr}) - 1 < size (format p{hr} i{hr}) by smt(). + rewrite nth_cat nth_nseq. + - smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). + cut->/=:!size (format p{hr} i{hr}) - 1 < size p{hr} + by smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). + rewrite take_format 1:/#. + - smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). + pose x:=if _ then _ else _;cut->/={x}:x = format p{hr} (i{hr}-1). + - rewrite /x;rewrite size_cat size_nseq/=/max/=. + cut->/=:0 < i{hr} - 1 by smt(). + case(size p{hr} + (i{hr} - 1) - 1 <= size p{hr})=>//=[h|/#]. + cut->>/=:i{hr}=2 by smt(). + smt(take_size nseq0 cats0). + rewrite H5=>//=[][][]->>->>;rewrite Block.WRing.addr0 take_cat. + rewrite-(addzA _ _ 1)//=take0 cats0=>h. + cut:=help (size (format p{hr} i{hr})) _. + - cut:size l <> 0;2:smt(size_ge0 size_cat). + by rewrite size_eq0;smt(in_dom cats0 formatK parseK). + by move=>[]b5 c5;rewrite take_cat take_size/=take0 cats0 in_dom h=>[][]->//=. + auto;progress. + * move:H7;rewrite take_oversize;1:rewrite size_cat size_nseq/#. + move=>H_dom. + cut:=lemma4' _ _ _ _ _ _ _ _ _ _ _ H6 _ H4 H5 _;1,2:smt(). + by rewrite-(addzA _ _ 1)/==>->//=. + (* * move:H7;rewrite take_oversize;1:rewrite size_cat size_nseq/#. *) + (* move=>H_dom. *) + (* cut:=lemma4' _ _ _ _ _ _ _ _ _ _ _ H6 _ H4 H5 _;1,2:smt(). *) + (* by rewrite-(addzA _ _ 1)/==>->//=. *) + * smt(). + * move:H7;rewrite take_oversize;1:rewrite size_cat size_nseq/#. + move=>H_dom. + cut:=lemma4' _ _ _ _ _ _ _ _ _ _ _ H6 _ H4 H5 _;1,2:smt(). + by rewrite-(addzA _ _ 1)/==>->//=;rewrite getP/=. + * move:H7;rewrite take_oversize;1:rewrite size_cat size_nseq/#. + cut H_i_size:i{2}-1 = size r0{2}. + + cut[]_[]_ hmp1 hmp2 hmp3 hmp4 _:=H6. + cut:=hmp2 p{2} (i{2}-1);rewrite in_dom H4/==>[][]_[]_[]. + by rewrite oget_some=>->/=/#. + move=>H_l;apply(lemma1 _ _ _ _ _ _ _ _ _ H6 H3 H1 _ _ _ _);1:smt(). + + by rewrite size_rcons-H_i_size;ring. + + by rewrite get_oget//last_rcons oget_some/#. + move=>j[]hj0 hji;rewrite -cats1 take_cat-H_i_size. + pose x:=if _ then _ else _;cut->/={x}:x = take j r0{2}. + - rewrite /x;case(j//=h;cut->>/=:j=i{2}-1 by smt(). + by rewrite H_i_size cats0 take_size. + cut[]_[]_ hmp1 hmp2 hmp3 hmp4 _:=H6. + by cut:=hmp2 p{2} (i{2}-1);rewrite in_dom H4//=oget_some/#. + move:H7;rewrite take_oversize;1:rewrite size_cat size_nseq/#. + move=>H_dom. + cut:=lemma4' _ _ _ _ _ _ _ _ _ _ _ H6 _ H4 H5 _;1,2:smt(). + by rewrite-(addzA _ _ 1)/==><-//=;smt(get_oget in_dom). + sp;wp;if;auto;progress. + - move:H8;rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). + rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). + by rewrite Block.WRing.addr0. + - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). + rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). + by rewrite Block.WRing.addr0. + - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). + rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). + by rewrite Block.WRing.addr0. + - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). + rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). + by rewrite Block.WRing.addr0. + - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). + rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). + by rewrite Block.WRing.addr0. + (* - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). *) + (* rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). *) + (* by rewrite Block.WRing.addr0. *) + - smt(). + - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). + rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). + by rewrite Block.WRing.addr0 getP/=. + - move:H7 H8;rewrite take_oversize;1:rewrite size_cat size_nseq/#. + rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). + rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). + rewrite Block.WRing.addr0/==>H_dom h;rewrite getP/=oget_some. + cut//=:=lemma2 0 C.c{2}Perm.m{2}.[(sa_L, sc{1}) <- yL] + Perm.mi{2}.[yL <- (sa_L, sc{1})]Redo.prefixes{1} + NC.queries{1}p{2}i{2}sa_L sc{1} r0{2} _ _ _ _ _ _ _ _;rewrite//=. + * by apply INV_Real_addm_mi=>//=;1:smt(supp_dexcepted). + * by rewrite dom_set in_fsetU1. + by rewrite!getP/=oget_some/#. + - move:H8;rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). + rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). + by rewrite Block.WRing.addr0 !getP/=oget_some/=take_oversize//=size_cat size_nseq/#. + - move:H8;rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). + rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). + by rewrite Block.WRing.addr0. + (* - move:H8;rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). *) + (* rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). *) + (* by rewrite Block.WRing.addr0. *) + - smt(). + - move:H8;rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). + rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). + by rewrite Block.WRing.addr0 getP/=. + - move:H7 H8;rewrite take_oversize;1:rewrite size_cat size_nseq/#. + rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). + rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). + rewrite Block.WRing.addr0/==>H_dom h. + by cut//=:=lemma2 0 C.c{2}Perm.m{2}Perm.mi{2}Redo.prefixes{1} + NC.queries{1}p{2}i{2}sa_L sc{1} r0{2} _ _ _ _ _ _ _ _;rewrite//=/#. + move:H8;rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). + rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). + by rewrite Block.WRing.addr0 getP/=take_oversize//=size_cat size_nseq/#. + alias{1} 1 pref = Redo.prefixes;sp. + conseq(:_==> ={glob P} /\ i0{1} = size p{1} + i{1} - 2 /\ Redo.prefixes{1} = pref{1} + /\ Redo.prefixes{1}.[take i0{1} (format p{1} (i{1} - 1))] = Some (sa{1}, sc{1}));progress. + + by cut:=H8;rewrite take_oversize 2:-(addzA _ 1)/=2:H4//=size_cat size_nseq;smt(). + + by cut:=H8;rewrite take_oversize 2:-(addzA _ 1)/=2:H4//=size_cat size_nseq;smt(). + + smt(). + + smt(). + + smt(). + + smt(dom_set in_fsetU1). + + by cut:=H8;rewrite take_oversize 2:-(addzA _ 1)//=size_cat size_nseq;smt(). + while{1}( ={glob P} /\ 0 <= i0{1} <= size p{1} + i{1} - 2 + /\ 1 < i{1} <= n{1} + /\ Redo.prefixes{1} = pref{1} /\ p0{1} = format p{1} i{1} + /\ format p{1} (i{1}-1) \in dom Redo.prefixes{1} + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1} + /\ Redo.prefixes{1}.[take i0{1} (format p{1} (i{1} - 1))] = + Some (sa{1}, sc{1}))(size p0{1} - 1 - i0{1});auto;last first. + + auto;progress. + + smt(size_ge0). + + smt(in_dom). + + smt(). + + smt(in_dom). + + cut[]_[]:=H3;smt(take0 in_dom). + + smt(). + + smt(size_cat size_nseq). + rcondt 1;auto;progress. + + cut->:take (i0{hr} + 1) (format p{hr} i{hr}) = + take (i0{hr} + 1) (format p{hr} (i{hr}-1)); + last by smt(in_dom all_prefixes_of_INV_real). + by rewrite!take_format//= 1,3:/#;1,2:smt(size_cat size_nseq). + + smt(). + + smt(size_cat size_nseq). + + cut->:take (i0{hr} + 1) (format p{hr} i{hr}) = + take (i0{hr} + 1) (format p{hr} (i{hr}-1)); + last by smt(in_dom all_prefixes_of_INV_real). + by rewrite!take_format//= 1,3:/#;1,2:smt(size_cat size_nseq). + smt(). + + if{1};last first. + + wp=>//=. + conseq(:_==> ={glob P} /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} + Redo.prefixes{1} NC.queries{1} + /\ i{2} = size p{2} + /\ Redo.prefixes{1}.[take i{2} p{2}] = Some (b,c){2} + /\ (0 < i{2} => Perm.m.[x]{2} = Some (b,c){2}));progress. + - cut[]_[]_ hmp1 hmp2 hmp3 hmp4 _:=H5. + cut/=[]_[]H_size H':=hmp2 _ _ H4. + cut/=[]c3:=hmp3 _ _ H4;rewrite/format/=nseq0 cats0-{1}take_size H6/==>[][]H_b ->>//=. + rewrite get_oget//=;apply (eq_from_nth b0)=>//=i. + rewrite H_size=>h;cut->>/=:i = 0 by smt(). + cut->:0 = size (oget NC.queries{1}.[(bl{2}, 1)]) - 1 by rewrite H_size. + by rewrite nth_last H_b. + (* - cut[]_[]_ hmp1 hmp2 hmp3 hmp4 _:=H5. *) + (* cut/=[]_[]H_size H':=hmp2 _ _ H4. *) + (* cut/=[]c3:=hmp3 _ _ H4;rewrite/format/=nseq0 cats0-{1}take_size H6/==>[][]H_b ->>//=. *) + (* rewrite get_oget//=;apply (eq_from_nth b0)=>//=i. *) + (* rewrite H_size=>h;cut->>/=:i = 0 by smt(). *) + (* cut->:0 = size (oget NC.queries{2}.[(bl{2}, 1)]) - 1 by rewrite H_size. *) + (* by rewrite nth_last H_b. *) + - smt(get_oget in_dom). + - smt(). + - smt(set_eq get_oget in_dom). + - smt(take_size). + while{2}(={glob P} /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} + Redo.prefixes{1} NC.queries{1} + /\ 0 <= i{2} <= size p{2} + /\ ((p{2}, 1) \in dom NC.queries{1}) + /\ Redo.prefixes{1}.[take i{2} p{2}] = Some (b,c){2} + /\ (0 < i{2} => Perm.m.[x]{2} = Some (b,c){2}))(size p{2}-i{2}); + progress;last first. + - auto;progress. + * split;case:H=>//=;smt(size_ge0 size_eq0 valid_spec). + * exact size_ge0. + * by rewrite take0;cut[]_[]->//:=H. + * smt(). + * smt(). + sp;rcondf 1;auto;progress. + - cut[]_[]_ hmp1 hmp2 hmp3 _ _:=H. + cut[]c3:=hmp3 p{hr} 1 H2;rewrite/(format _ 1)/=nseq0 cats0=> H_pref. + cut:=hmp1 p{hr};rewrite 2!in_dom H_pref/==>help. + by cut[]b4 c4 []:=help i{hr} _;1:smt();rewrite H3/==>[][]->>->>->; + smt(in_dom all_prefixes_of_INV_real). + - smt(). + - smt(). + - cut[]_[]_ hmp1 hmp2 hmp3 _ _:=H. + cut[]c3:=hmp3 p{hr} 1 H2;rewrite/(format _ 1)/=nseq0 cats0=> H_pref. + cut:=hmp1 p{hr};rewrite in_dom H_pref/==>help. + by cut[]b4 c4 []:=help i{hr} _;1:smt();rewrite H3/==>[][]->>->>->; + smt(in_dom all_prefixes_of_INV_real get_oget). + - cut[]_[]_ hmp1 hmp2 hmp3 _ _:=H. + cut[]c3:=hmp3 p{hr} 1 H2;rewrite/(format _ 1)/=nseq0 cats0=> H_pref. + cut:=hmp1 p{hr};rewrite in_dom H_pref/==>help. + by cut[]b4 c4 []:=help i{hr} _;1:smt();rewrite H3/==>[][]->>->>->; + smt(in_dom all_prefixes_of_INV_real get_oget). + - smt(). + sp;wp. + (* TODO *) + qed. local lemma equiv_ideal (IF <: FUNCTIONALITY{DSqueeze,C}) @@ -952,12 +1116,12 @@ section. ~ NIndif(Squeeze(IF),S(IF),NDRestr(D)).main : ={glob D} ==> - ={res, glob D, glob IF, glob S, glob NC, C.c} ]. + ={res, glob D, glob IF, glob S, NC.queries, C.c, C.c} ]. proof. move=>S_init IF_init. proc;inline*;sp;wp;swap{2}2-1;swap{1}[3..5]-2;sp. call(: ={glob IF, glob S, C.c, glob DSqueeze} - /\ C.c{1} <= NC.c{1} <= max_size + /\ SLCommon.C.c{1} <= NC.c{1} <= max_size /\ inv_ideal NC.queries{1} C.queries{1});auto;last first. + call IF_init;auto;call S_init;auto;smt(dom_set in_fsetU1 dom0 in_fset0 parse_nil max_ge0). + proc;inline*;sp;if;auto;1:call(: ={glob IF});auto;1:proc(true);progress=>//=. @@ -1003,16 +1167,16 @@ sear while{1}(={n, p, glob IF, glob S, NC.queries} /\ i{1} = nb_iter{2} /\ lres{1} = r{2} /\ inv_ideal NC.queries{1} C.queries{1} - /\ max_size <= C.c{1} + /\ max_size <= SLCommon.C.c{1} conseq(:_ ==> lres{1} = mkseq (+Block.b0) i{1} /\ i{1} = n{1} - /\ ={glob IF, glob S} /\ C.c{1} = max_size + /\ ={glob IF, glob S} /\ SLCommon.C.c{1} = max_size /\ inv_ideal NC.queries{1} C.queries{1} /\ NC.queries{1} = NC.queries{2}.[(p{1}, n{1}) <- lres{1}]); 1:smt(min_ler min_lel max_ler max_ler). while{1}(lres{1} = mkseq (+Block.b0) i{1} /\ i{1} = n{1} - /\ ={glob IF, glob S} /\ C.c{1} = max_size + /\ ={glob IF, glob S} /\ SLCommon.C.c{1} = max_size /\ inv_ideal NC.queries{1} C.queries{1} /\ NC.queries{1} = NC.queries{2}.[(p{1}, n{1}) <- lres{1}]) (n{1}-i{1}); @@ -1082,9 +1246,9 @@ module S(F : DFUNCTIONALITY) = { } }. -lemma Real_Ideal &m (D <: NDISTINGUISHER): - Pr[NIndif(BlockSponge(PC(Perm)), PC(Perm), D).main() @ &m: res /\ C.c <= max_size] <= - Pr[NIndif(IF,S(IF),DRestr(D)).main() @ &m : res] + +lemma Real_Ideal &m (D <: DISTINGUISHER): + Pr[Indif(SqueezelessSponge(PC(Perm)), PC(Perm), D).main() @ &m: res /\ C.c <= max_size] <= + Pr[Indif(IF,S(IF),DRestr(D)).main() @ &m :res] + (max_size ^ 2)%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). From f01b025b656becfd95cbe61eb954946a29c542e5 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 20 Apr 2018 19:03:19 +0200 Subject: [PATCH 275/394] Made upper bound of top-level result more succinct. --- sha3/proof/Common.ec | 9 ++++++-- sha3/proof/SHA3-Security.ec | 45 ++++++++++++++++++++++++++----------- 2 files changed, 39 insertions(+), 15 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index df98d4f..8555c2b 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -26,12 +26,15 @@ type capacity. (* ~ bitstrings of size c *) (* -------------------------------------------------------------------- *) -lemma gt0_r: 0 < r. +lemma gt0_r : 0 < r. proof. by apply/(ltr_le_trans 2)/ge2_r. qed. -lemma ge0_r: 0 <= r. +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 type word <- capacity, @@ -57,6 +60,8 @@ export DBlock. op cdistr = DCapacity.dunifin. op bdistr = DBlock.dunifin. +search c. + (* ------------------------- Auxiliary Lemmas ------------------------- *) diff --git a/sha3/proof/SHA3-Security.ec b/sha3/proof/SHA3-Security.ec index ed0780c..d295459 100644 --- a/sha3/proof/SHA3-Security.ec +++ b/sha3/proof/SHA3-Security.ec @@ -1,6 +1,9 @@ -(* Top Level *) +(* Top-level Proof of SHA-3 Security *) + +require import AllCore List IntDiv StdOrder Distr. + +require import Common Sponge. import BIRO. -require import AllCore List IntDiv StdOrder Common Sponge. import BIRO. require SLCommon BlockSponge. (* FIX: would be nicer to define limit at top-level and then clone @@ -12,10 +15,6 @@ op limit : {int | 0 < limit} as gt0_max_limit. op limit : int = SLCommon.max_size. -(* FIX: don't want this in bound *) - -op dstate : (block * capacity) distr = SLCommon.dstate. - (*---------------------------- Restrictions ----------------------------*) (** The counter for the functionality counts the number of times the @@ -158,15 +157,37 @@ auto; progress; by rewrite blocks2bits_nil. auto. qed. +op wit_pair : block * capacity = witness. + lemma security &m : `|Pr[RealIndif(Sponge, Perm, DRestr(Dist)).main() @ &m : res] - Pr[IdealIndif (IRO, RaiseSim(BlockSponge.Sim), DRestr(Dist)).main() @ &m : res]| <= - (limit ^ 2)%r / 2%r * Distr.mu1 dstate witness + - limit%r * ((2 * limit)%r / (2 ^ c)%r) + - limit%r * ((2 * limit)%r / (2 ^ c)%r). + (limit ^ 2)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. proof. +rewrite powS 1:addz_ge0 1:ge0_r 1:ge0_c -pow_add 1:ge0_r 1:ge0_c. +have -> : + (limit ^ 2)%r / (2 * (2 ^ r * 2 ^ c))%r = + ((limit ^ 2)%r / 2%r) * (1%r / (2 ^ r)%r) * (1%r / (2 ^ c)%r). + rewrite (fromintM 2) StdRing.RField.invfM StdRing.RField.mulrA + -!StdRing.RField.mulrA. + congr. + rewrite (fromintM (2 ^ r)) StdRing.RField.invfM StdRing.RField.mulrA + -!StdRing.RField.mulrA. + congr; by rewrite StdRing.RField.mul1r. +rewrite -{1}block_card -{1}capacity_card + -(DBlock.dunifin1E wit_pair.`1) -(DCapacity.dunifin1E wit_pair.`2) + -StdRing.RField.mulrA -DProd.dprod1E. +have -> : (wit_pair.`1, wit_pair.`2) = witness + by rewrite /wit_pair // {3}(pairS witness). +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 powS // pow1 /#. +rewrite -/SLCommon.dstate /limit. rewrite (RealOrder.ler_trans (`|Pr[BlockSponge.RealIndif @@ -176,7 +197,7 @@ rewrite LowerDist(DRestr(Dist))).main() @ &m : res]|)) 1:RealOrder.lerr_eq 1:(conclusion BlockSponge.Sim (DRestr(Dist)) &m) // - (drestr_commute1 &m) (drestr_commute2 &m) + (drestr_commute1 &m) (drestr_commute2 &m) StdRing.RField.addrA (BlockSponge.conclusion (LowerDist(Dist)) &m). qed. @@ -189,7 +210,5 @@ lemma SHA3Security `|Pr[RealIndif(Sponge, Perm, DRestr(Dist)).main() @ &m : res] - Pr[IdealIndif (IRO, RaiseSim(BlockSponge.Sim), DRestr(Dist)).main() @ &m : res]| <= - (limit ^ 2)%r / 2%r * (Distr.mu1 dstate witness)%Distr + - limit%r * ((2 * limit)%r / (2 ^ c)%r) + - limit%r * ((2 * limit)%r / (2 ^ c)%r). + (limit ^ 2)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. proof. apply (security Dist &m). qed. From 9dd9ed4f6a90bef1016964289cf92d465fb109cb Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 20 Apr 2018 11:46:51 +0200 Subject: [PATCH 276/394] Proof of top-level security. --- sha3/proof/BlockSponge.ec | 53 +++++----- sha3/proof/Common.ec | 10 +- sha3/proof/SHA3-Security.ec | 195 ++++++++++++++++++++++++++++++++++++ 3 files changed, 230 insertions(+), 28 deletions(-) create mode 100644 sha3/proof/SHA3-Security.ec diff --git a/sha3/proof/BlockSponge.ec b/sha3/proof/BlockSponge.ec index ba95d77..c2e3531 100644 --- a/sha3/proof/BlockSponge.ec +++ b/sha3/proof/BlockSponge.ec @@ -24,7 +24,6 @@ clone import IRO as BIRO with 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. @@ -35,7 +34,9 @@ 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. +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. @@ -43,8 +44,14 @@ move=>h;cut{1}->:p=format p 1;2:smt(parseK). by rewrite/format/=nseq0 cats0. qed. +(*---------------------------- Restrictions ----------------------------*) -(*------------------------------ Counter -------------------------------*) +(** 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 @@ -53,41 +60,33 @@ module C = { } }. -(*---------------------------- 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 FC (F : DFUNCTIONALITY) = { proc init () : unit = {} + proc f (bl : block list, nb : int) = { - var r : block list <- []; - if (0 < nb) { - if (C.c + size bl + nb - 1 <= max_size) { - C.c <- C.c + size bl + nb - 1; - r <@ F.f(bl,nb); - } + 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 r; + return z; } }. - module PC (P : DPRIMITIVE) = { proc init() = {} + proc f (a : state) = { - var z : state <- (b0,c0); + 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); + var z : state <- (b0, c0); if (C.c + 1 <= max_size) { z <@ P.fi(a); C.c <- C.c + 1; @@ -100,7 +99,7 @@ module DRestr (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { proc distinguish () : bool = { var b : bool; C.init(); - b <@ D(FC(F),PC(P)).distinguish(); + b <@ D(FC(F), PC(P)).distinguish(); return b; } }. @@ -111,13 +110,13 @@ module DRestr (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { module Last (F : DFUNCTIONALITY) : SLCommon.DFUNCTIONALITY = { proc init() = {} proc f (p : block list) : block = { - var r : block list <- []; - r <@ F.f(parse p); - return last b0 r; + var z : block list <- []; + z <@ F.f(parse p); + return last b0 z; } }. -module (S : SIMULATOR) (F : DFUNCTIONALITY) = Gconcl.S(Last(F)). +module (Sim : SIMULATOR) (F : DFUNCTIONALITY) = Gconcl.S(Last(F)). (*------------------------- Sponge Construction ------------------------*) @@ -155,7 +154,7 @@ module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { lemma conclusion : forall (D <: DISTINGUISHER) &m, `| Pr[RealIndif(Sponge, Perm, DRestr(D)).main() @ &m : res] - - Pr[IdealIndif(IRO, S, DRestr(D)).main() @ &m : res]| + - Pr[IdealIndif(IRO, Sim, DRestr(D)).main() @ &m : res]| <= (max_size ^ 2)%r / 2%r * Distr.mu1 dstate witness + max_size%r * ((2 * max_size)%r / (2 ^ c)%r) + max_size%r * ((2 * max_size)%r / (2 ^ c)%r). diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index fcb9dbf..df98d4f 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -55,7 +55,6 @@ clone export BitWord as Block with "zerow" as "b0". export DBlock. - op cdistr = DCapacity.dunifin. op bdistr = DBlock.dunifin. @@ -483,6 +482,15 @@ 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) = diff --git a/sha3/proof/SHA3-Security.ec b/sha3/proof/SHA3-Security.ec new file mode 100644 index 0000000..ed0780c --- /dev/null +++ b/sha3/proof/SHA3-Security.ec @@ -0,0 +1,195 @@ +(* Top Level *) + +require import AllCore List IntDiv StdOrder Common Sponge. import BIRO. +require SLCommon 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. + +(* FIX: don't want this in bound *) + +op dstate : (block * capacity) distr = SLCommon.dstate. + +(*---------------------------- 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, BlockSponge.Sim, IRO, Cntr, BlockSponge.BIRO.IRO, + BlockSponge.C}. + +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. +auto. +qed. + +lemma drestr_commute2 &m : + Pr[BlockSponge.IdealIndif + (BlockSponge.BIRO.IRO, BlockSponge.Sim, + LowerDist(DRestr(Dist))).main() @ &m : res] = + Pr[BlockSponge.IdealIndif + (BlockSponge.BIRO.IRO, BlockSponge.Sim, + BlockSponge.DRestr(LowerDist(Dist))).main() @ &m : res]. +proof. +byequiv=> //; proc. +seq 2 2 : + (={glob Dist, BlockSponge.BIRO.IRO.mp, + glob BlockSponge.Sim}); first sim. +inline*; wp; sp. +call + (_ : + ={c}(Cntr, BlockSponge.C) /\ ={BlockSponge.BIRO.IRO.mp} /\ + ={glob BlockSponge.Sim}). +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.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. +auto; progress; by rewrite blocks2bits_nil. +auto. +qed. + +lemma security &m : + `|Pr[RealIndif(Sponge, Perm, DRestr(Dist)).main() @ &m : res] - + Pr[IdealIndif + (IRO, RaiseSim(BlockSponge.Sim), + DRestr(Dist)).main() @ &m : res]| <= + (limit ^ 2)%r / 2%r * Distr.mu1 dstate witness + + limit%r * ((2 * limit)%r / (2 ^ c)%r) + + limit%r * ((2 * limit)%r / (2 ^ c)%r). +proof. +rewrite + (RealOrder.ler_trans + (`|Pr[BlockSponge.RealIndif + (BlockSponge.Sponge, Perm, LowerDist(DRestr(Dist))).main() @ &m : res] - + Pr[BlockSponge.IdealIndif + (BlockSponge.BIRO.IRO, BlockSponge.Sim, + LowerDist(DRestr(Dist))).main() @ &m : res]|)) + 1:RealOrder.lerr_eq + 1:(conclusion BlockSponge.Sim (DRestr(Dist)) &m) // + (drestr_commute1 &m) (drestr_commute2 &m) + (BlockSponge.conclusion (LowerDist(Dist)) &m). +qed. + +end section. + +lemma SHA3Security + (Dist <: + DISTINGUISHER{Perm, IRO, BlockSponge.BIRO.IRO, Cntr, + BlockSponge.Sim, BlockSponge.C}) &m : + `|Pr[RealIndif(Sponge, Perm, DRestr(Dist)).main() @ &m : res] - + Pr[IdealIndif + (IRO, RaiseSim(BlockSponge.Sim), DRestr(Dist)).main() @ &m : res]| <= + (limit ^ 2)%r / 2%r * (Distr.mu1 dstate witness)%Distr + + limit%r * ((2 * limit)%r / (2 ^ c)%r) + + limit%r * ((2 * limit)%r / (2 ^ c)%r). +proof. apply (security Dist &m). qed. From 01cafad657ccbe6207a03058fda57afe3a973d36 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Tue, 24 Apr 2018 08:29:18 +0200 Subject: [PATCH 277/394] Import NewFMap --- sha3/proof/NewFMap.ec | 818 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 818 insertions(+) create mode 100644 sha3/proof/NewFMap.ec diff --git a/sha3/proof/NewFMap.ec b/sha3/proof/NewFMap.ec new file mode 100644 index 0000000..6d5b089 --- /dev/null +++ b/sha3/proof/NewFMap.ec @@ -0,0 +1,818 @@ +(* -------------------------------------------------------------------- + * Copyright (c) - 2012--2016 - IMDEA Software Institute + * Copyright (c) - 2012--2018 - Inria + * Copyright (c) - 2012--2018 - Ecole Polytechnique + * + * Distributed under the terms of the CeCILL-B-V1 license + * -------------------------------------------------------------------- *) + +(* -------------------------------------------------------------------- *) +require import AllCore Int List FSet. + +pragma -oldip. +pragma +implicits. + +(* -------------------------------------------------------------------- *) +lemma perm_eq_uniq_map (f : 'a -> 'b) (s1 s2 : 'a list): + perm_eq s1 s2 => uniq (map f s1) <=> uniq (map f s2). +proof. by move=> /(perm_eq_map f) /perm_eq_uniq ->. qed. + +lemma uniq_perm_eq_map (s1 s2 : ('a * 'b) list) (f: 'a * 'b -> 'c): + uniq (map f s1) => uniq (map f s2) + => (forall (x : 'a * 'b), mem s1 x <=> mem s2 x) + => perm_eq s1 s2. +proof. by move=> /uniq_map h1 /uniq_map h2 /(uniq_perm_eq _ _ h1 h2). qed. + +(* -------------------------------------------------------------------- *) +op augment (s : ('a * 'b) list) (kv : 'a * 'b) = + if mem (map fst s) kv.`1 then s else rcons s kv. + +lemma nosmt augment_nil (kv : 'a * 'b): augment [] kv = [kv]. +proof. by []. qed. + +lemma augmentP (s : ('a * 'b) list) x y: + ( mem (map fst s) x /\ augment s (x, y) = s) + \/ (! mem (map fst s) x /\ augment s (x, y) = rcons s (x, y)). +proof. by case: (mem (map fst s) x)=> //=; rewrite /augment => ->. qed. + +op reduce (xs : ('a * 'b) list): ('a * 'b) list = + foldl augment [] xs. + +lemma reduce_nil: reduce [<:'a * 'b>] = []. +proof. by []. qed. + +lemma nosmt reduce_cat (r s : ('a * 'b) list): + foldl augment r s + = r ++ filter (predC (mem (map fst r)) \o fst) (foldl augment [] s). +proof. +rewrite -(@revK s) !foldl_rev; pose f := fun x z => augment z x. +elim/last_ind: s r => /=. + by move=> r; rewrite !rev_nil /= cats0. +move=> s [x y] ih r; rewrite !rev_rcons /= ih => {ih}. +rewrite {1}/f {1}/augment map_cat mem_cat /=. +pose t1 := map fst _; pose t2 := map fst _. +case: (mem t1 x \/ mem t2 x) => //; last first. + rewrite negb_or => -[t1_x t2_x]; rewrite rcons_cat; congr. + rewrite {2}/f /augment /=; pose t := map fst _. + case: (mem t x) => h; last first. + by rewrite filter_rcons /= /(\o) /predC t1_x. + have: mem t2 x; rewrite // /t2 /(\o). + have <- := filter_map<:'a, 'a * 'b> fst (predC (mem t1)). + by rewrite mem_filter /predC t1_x. +case=> h; congr; rewrite {2}/f /augment /=; last first. + move: h; rewrite /t2 => /mapP [z] [h ->>]. + by move: h; rewrite mem_filter => -[_ /(map_f fst) ->]. +case: (List.mem _ _) => //=; rewrite filter_rcons. +by rewrite /(\o) /predC h. +qed. + +lemma reduce_cons (x : 'a) (y : 'b) s: + reduce ((x, y) :: s) + = (x, y) :: filter (predC1 x \o fst) (reduce s). +proof. by rewrite {1}/reduce /= augment_nil reduce_cat cat1s. qed. + +lemma assoc_reduce (s : ('a * 'b) list): + forall x, assoc (reduce s) x = assoc s x. +proof. +move=> x; elim: s => //; case=> x' y' s ih. +rewrite reduce_cons !assoc_cons; case: (x = x')=> // ne_xx'. +by rewrite assoc_filter /predC1 ne_xx'. +qed. + +lemma dom_reduce (s : ('a * 'b) list): + forall x, mem (map fst (reduce s)) x <=> mem (map fst s) x. +proof. +move=> x; elim: s => [|[x' y] s ih] /=; 1: by rewrite reduce_nil. +rewrite reduce_cons /=; apply/orb_id2l. +rewrite /(\o) /= => ne_xx'. +by rewrite -(@filter_map _ (predC1 x')) mem_filter /predC1 ne_xx' /= ih. +qed. + +lemma reduced_reduce (s : ('a * 'b) list): uniq (map fst (reduce s)). +proof. +elim: s => [|[x y] s ih]; 1: by rewrite reduce_nil. +rewrite reduce_cons /= ; split. ++ by apply/negP=> /mapP [[x' y']]; rewrite mem_filter=> -[# h1 h2 ->>]. +rewrite /(\o); have <- := filter_map fst<:'a, 'b> (predC1 x). +by rewrite filter_uniq. +qed. + +lemma reduce_reduced (s : ('a * 'b) list): + uniq (map fst s) => reduce s = s. +proof. +elim: s => [|[x y] s ih]; 1: by rewrite reduce_nil. +rewrite reduce_cons /= => -[x_notin_s /ih ->]. +rewrite (@eq_in_filter _ predT) ?filter_predT /predT //=. +case=> x' y' /(map_f fst) x'_in_s; apply/negP => <<-. +by move: x_notin_s. +qed. + +lemma reduceK (xs : ('a * 'b) list): reduce (reduce xs) = reduce xs. +proof. by rewrite reduce_reduced 1:reduced_reduce. qed. + +lemma mem_reduce_head (xs : ('a * 'b) list) a b: + mem (reduce ((a, b) :: xs)) (a, b). +proof. by rewrite reduce_cons. qed. + +(* -------------------------------------------------------------------- *) +(* Finite maps are abstractely represented as the quotient by *) +(* [perm_eq] of lists of pairs without first projection duplicates. *) + +type ('a, 'b) fmap. + +op elems : ('a, 'b) fmap -> ('a * 'b) list. +op oflist : ('a * 'b) list -> ('a,'b) fmap. + +axiom elemsK (m : ('a, 'b) fmap) : Self.oflist (elems m) = m. +axiom oflistK (s : ('a * 'b) list): perm_eq (reduce s) (elems (Self.oflist s)). + +lemma uniq_keys (m : ('a, 'b) fmap): uniq (map fst (elems m)). +proof. +rewrite -elemsK; move: (elems m) => {m} m. +apply (@perm_eq_uniq (map fst (reduce m)) _). ++ by apply perm_eq_map; apply oflistK. +by apply reduced_reduce. +qed. + +axiom fmap_eq (s1 s2 : ('a,'b) fmap): + (perm_eq (elems s1) (elems s2)) <=> (s1 = s2). + +(* -------------------------------------------------------------------- *) +lemma fmapW (p : ('a, 'b) fmap -> bool): + (forall m, uniq (map fst m) => p (Self.oflist m)) + => forall m, p m. +proof. by move=> ih m; rewrite -elemsK; apply/ih/uniq_keys. qed. + +(* -------------------------------------------------------------------- *) +op "_.[_]" (m : ('a,'b) fmap) (x : 'a) = assoc (elems m) x + axiomatized by getE. + +lemma get_oflist (s : ('a * 'b) list): + forall x, (Self.oflist s).[x] = assoc s x. +proof. +move=> x; rewrite getE; rewrite -(@assoc_reduce s). +apply/eq_sym/perm_eq_assoc; 1: by apply/uniq_keys. +by apply/oflistK. +qed. + +lemma fmapP (m1 m2 : ('a,'b) fmap): + (m1 = m2) <=> (forall x, m1.[x] = m2.[x]). +proof. +split=> // h; apply/fmap_eq/uniq_perm_eq; ~3:by apply/(@uniq_map fst)/uniq_keys. +case=> x y; move: (h x); rewrite !getE => {h} h. +by rewrite !mem_assoc_uniq ?uniq_keys // h. +qed. + +(* -------------------------------------------------------------------- *) +op map0 ['a,'b] = Self.oflist [<:'a * 'b>] axiomatized by map0E. + +(* -------------------------------------------------------------------- *) +op "_.[_<-_]" (m : ('a, 'b) fmap) (a : 'a) (b : 'b) = + Self.oflist (reduce ((a, b) :: elems m)) + axiomatized by setE. + +lemma getP (m : ('a, 'b) fmap) (a : 'a) (b : 'b) (x : 'a): + m.[a <- b].[x] = if x = a then Some b else m.[x]. +proof. +by rewrite setE get_oflist assoc_reduce assoc_cons getE; case: (x = a). +qed. + +lemma getP_eq (m : ('a, 'b) fmap) (a : 'a) (b : 'b): + m.[a <- b].[a] = Some b. +proof. by rewrite getP. qed. + +lemma getP_neq (m : ('a, 'b) fmap) (a1 a2 : 'a) (b : 'b): + a1 <> a2 => + m.[a1 <- b].[a2] = m.[a2]. +proof. by rewrite getP eq_sym=> ->. qed. + +lemma set_set (m : ('a,'b) fmap) x x' y y': + m.[x <- y].[x' <- y'] = if x = x' then m.[x' <- y'] + else m.[x' <- y'].[x <- y]. +proof. +rewrite fmapP=> a; case (x = x')=> [<<- {x'} | ne_x_x']; rewrite !getP. ++ by case (a = x). +by case (a = x')=> //; case (a = x)=> // ->;rewrite ne_x_x'. +qed. + +lemma nosmt set_set_eq y (m : ('a, 'b) fmap) x y': + m.[x <- y].[x <- y'] = m.[x <- y']. +proof. by rewrite fmapP=> a; rewrite set_set. qed. + +(* -------------------------------------------------------------------- *) +op rem (a : 'a) (m : ('a, 'b) fmap) = + Self.oflist (filter (predC1 a \o fst) (elems m)) + axiomatized by remE. + +lemma remP (a : 'a) (m : ('a, 'b) fmap): + forall x, (rem a m).[x] = if x = a then None else m.[x]. +proof. +move=> x; rewrite remE get_oflist assoc_filter; case (x = a)=> //=. +by rewrite /predC1 getE=> ->. +qed. + +(* -------------------------------------------------------------------- *) +op dom ['a 'b] (m : ('a, 'b) fmap) = + FSet.oflist (map fst (elems m)) + axiomatized by domE. + +lemma dom_oflist (s : ('a * 'b) list): + forall x, mem (dom (Self.oflist s)) x <=> mem (map fst s) x. +proof. +move=> x; rewrite domE mem_oflist. +have/perm_eq_sym/(perm_eq_map fst) := oflistK s. +by move/perm_eq_mem=> ->; apply/dom_reduce. +qed. + +lemma mem_domE (m : ('a, 'b) fmap) x: + mem (dom m) x <=> mem (map fst (elems m)) x. +proof. by rewrite domE mem_oflist. qed. + +lemma in_dom (m : ('a, 'b) fmap) x: + mem (dom m) x <=> m.[x] <> None. +proof. +rewrite mem_domE getE. +by case: (assocP (elems m) x)=> [[-> [y [_ ->]]] | [-> ->]]. +qed. + +lemma fmap_domP (m1 m2 : ('a, 'b) fmap): + (m1 = m2) <=> (forall x, mem (dom m1) x = mem (dom m2) x) + /\ (forall x, mem (dom m1) x => m1.[x] = m2.[x]). +proof. +split=> // [[]] eq_dom eq_on_dom. +apply fmapP=> x; case: (mem (dom m1) x). ++ by apply eq_on_dom. +move=> ^; rewrite {2}eq_dom !in_dom /=. +by move=> -> ->. +qed. + +lemma get_oget (m:('a,'b)fmap) (x:'a) : + mem (dom m) x => m.[x] = Some (oget m.[x]). +proof. by rewrite in_dom; case: (m.[x]). qed. + +(* -------------------------------------------------------------------- *) +op rng ['a 'b] (m : ('a, 'b) fmap) = + FSet.oflist (map snd (elems m)) + axiomatized by rngE. + +lemma mem_rngE (m : ('a, 'b) fmap) y: + mem (rng m) y <=> mem (map snd (elems m)) y. +proof. by rewrite rngE mem_oflist. qed. + +lemma in_rng (m: ('a,'b) fmap) (b : 'b): + mem (rng m) b <=> (exists a, m.[a] = Some b). +proof. +rewrite mem_rngE; split. ++ move/List.mapP=> [] [x y] [h ->]; exists x. + by rewrite getE -mem_assoc_uniq 1:uniq_keys. +case=> x; rewrite getE -mem_assoc_uniq ?uniq_keys // => h. +by apply/List.mapP; exists (x, b). +qed. + +(* -------------------------------------------------------------------- *) +op has (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap) = + List.has (fun (x : 'a * 'b), p x.`1 x.`2) (elems m) + axiomatized by hasE. + +lemma hasP p (m : ('a, 'b) fmap): + has p m <=> (exists x, mem (dom m) x /\ p x (oget m.[x])). +proof. +rewrite hasE hasP /=; split=> [[[a b]] /= [^ab_in_m+ p_a_b] |[a] []]. ++ rewrite mem_assoc_uniq 1:uniq_keys // -getE => ma_b. + by exists a; rewrite ma_b mem_domE /oget /= p_a_b /= mem_map_fst; exists b. +rewrite mem_domE mem_map_fst=> -[b] ^ab_in_m+. +by rewrite mem_assoc_uniq 1:uniq_keys // getE /oget=> -> /= p_a_b; exists (a,b). +qed. + +(* FIXME: name *) +lemma has_le p' (m : ('a, 'b) fmap) (p : 'a -> 'b -> bool): + (forall x y, mem (dom m) x /\ p x y => mem (dom m) x /\ p' x y) => + has p m => + has p' m. +proof. +by move=> le_p_p'; rewrite !hasP=> -[x] /le_p_p' [p'_x x_in_m]; exists x. +qed. + +(* -------------------------------------------------------------------- *) +op all (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap) = + List.all (fun (x : 'a * 'b), p x.`1 x.`2) (elems m) + axiomatized by allE. + +lemma allP p (m : ('a, 'b) fmap): + all p m <=> (forall x, mem (dom m) x => p x (oget m.[x])). +proof. +rewrite allE allP; split=> [h a|h [a b] /= ^ab_in_m]. ++ rewrite mem_domE mem_map_fst=> -[b] ^ab_in_m+. + by rewrite mem_assoc_uniq 1:uniq_keys -getE /oget=> ->; apply (@h (a,b)). +rewrite mem_assoc_uniq 1:uniq_keys -getE=> /(@congr1 oget) <-. +by apply/h; rewrite mem_domE mem_map_fst; exists b. +qed. + +lemma all_le p' (m : ('a, 'b) fmap) (p : 'a -> 'b -> bool): + (forall x y, mem (dom m) x /\ p x y => mem (dom m) x /\ p' x y) => + all p m => + all p' m. +proof. +move=> le_p_p'. rewrite !allP=> h x ^x_in_m /h p_x. +exact/(andWr _ (:@le_p_p' x (oget m.[x]) _)). +qed. + +(* -------------------------------------------------------------------- *) +lemma has_all (m : ('a, 'b) fmap) (p : 'a -> 'b -> bool): + has p m <=> !all (fun x y, !p x y) m. +proof. +rewrite hasP allP negb_forall /=; split=> [[x] [x_in_m p_x]|[] x]. ++ by exists x; rewrite p_x. +by rewrite negb_imply /= => h; exists x. +qed. + +(* -------------------------------------------------------------------- *) +op (+) (m1 m2 : ('a, 'b) fmap) = Self.oflist (elems m2 ++ elems m1) + axiomatized by joinE. + +lemma joinP (m1 m2 : ('a, 'b) fmap) x: + (m1 + m2).[x] = if mem (dom m2) x then m2.[x] else m1.[x]. +proof. by rewrite joinE get_oflist mem_domE assoc_cat -!getE. qed. + +(* -------------------------------------------------------------------- *) +op find (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap) = + onth (map fst (elems m)) (find (fun (x : 'a * 'b), p x.`1 x.`2) (elems m)) + axiomatized by findE. + +(** The following are inspired from lemmas on List.find. findP is a + total characterization, but a more usable interface may be useful. **) +lemma find_none (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap): + has p m <=> find p m <> None. +proof. +rewrite hasE /= findE List.has_find; split=> [h|]. ++ by rewrite (@onth_nth witness) 1:find_ge0/= 1:size_map. +by apply/contraLR=> h; rewrite onth_nth_map -map_comp nth_default 1:size_map 1:lezNgt. +qed. + +lemma findP (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap): + (exists x, find p m = Some x /\ mem (dom m) x /\ p x (oget m.[x])) + \/ (find p m = None /\ forall x, mem (dom m) x => !p x (oget m.[x])). +proof. +case: (has p m)=> [^has_p | ^all_not_p]. ++ rewrite hasE has_find. + have:= find_ge0 (fun (x : 'a * 'b) => p x.`1 x.`2) (elems m). + pose i:= find _ (elems m); move => le0_i lt_i_sizem; left. + exists (nth witness (map ofst (elems m)) i); split. + + by rewrite findE -/i (@onth_nth witness) 1:size_map. + split. + + by rewrite mem_domE -index_mem index_uniq 1,3:size_map 2:uniq_keys. + have /= := nth_find witness (fun (x : 'a * 'b) => p (ofst x) (osnd x)) (elems m) _. + + by rewrite -hasE. + rewrite -/i -(@nth_map _ witness) // getE /assoc + (@index_uniq witness i (map fst (elems m))). + + by rewrite size_map. + + exact/uniq_keys. + by rewrite (@onth_nth witness) //. +rewrite has_all /= allP /= => h; right. +by split=> //; move: all_not_p; rewrite find_none. +qed. + +(* -------------------------------------------------------------------- *) +op filter (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap) = + oflist (filter (fun (x : 'a * 'b) => p x.`1 x.`2) (elems m)) + axiomatized by filterE. + +(* FIXME: Move me *) +lemma filter_mem_map (p : 'a -> bool) (f : 'a -> 'b) (s : 'a list) x': + mem (map f (filter p s)) x' => mem (map f s) x'. +proof. by elim s=> //= x xs ih; case (p x)=> [_ [//= |] | _] /ih ->. qed. + +(* FIXME: Move me *) +lemma uniq_map_filter (p : 'a -> bool) (f : 'a -> 'b) (s : 'a list): + uniq (map f s) => uniq (map f (filter p s)). +proof. + elim s=> //= x xs ih [fx_notin_fxs uniq_fxs]. + by case (p x); rewrite ih //= -negP => h {h} /filter_mem_map. +qed. + +lemma perm_eq_elems_filter (m : ('a, 'b) fmap) (p: 'a -> 'b -> bool): + perm_eq (filter (fun (x : 'a * 'b) => p x.`1 x.`2) (elems m)) + (elems (filter p m)). +proof. + (* FIXME: curry-uncurry should probably go into Pair for some chosen arities *) + rewrite filterE; pose P:= fun (x : 'a * 'b) => p x.`1 x.`2. + apply (perm_eq_trans _ _ (:@oflistK _)). + rewrite reduce_reduced 2:perm_eq_refl //. + by apply/uniq_map_filter/uniq_keys. +qed. + +lemma mem_elems_filter (m : ('a, 'b) fmap) (p: 'a -> 'b -> bool) x y: + mem (filter (fun (x : 'a * 'b) => p x.`1 x.`2) (elems m)) (x,y) + <=> mem (elems (filter p m)) (x,y). +proof. by apply/perm_eq_mem/perm_eq_elems_filter. qed. + +lemma mem_map_filter_elems (p : 'a -> 'b -> bool) (f : ('a * 'b) -> 'c) (m : ('a, 'b) fmap) a: + mem (map f (filter (fun (x : 'a * 'b) => p x.`1 x.`2) (elems m))) a + <=> mem (map f (elems (filter p m))) a. +proof. by apply/perm_eq_mem/perm_eq_map/perm_eq_elems_filter. qed. + +lemma assoc_elems_filter (m : ('a, 'b) fmap) (p: 'a -> 'b -> bool) x: + assoc (filter (fun (x : 'a * 'b) => p x.`1 x.`2) (elems m)) x + = assoc (elems (filter p m)) x. +proof. by apply/perm_eq_assoc/perm_eq_elems_filter/uniq_keys. qed. + +lemma dom_filter (p : 'a -> 'b -> bool) (m : ('a,'b) fmap) x: + mem (dom (filter p m)) x <=> mem (dom m) x /\ p x (oget m.[x]). +proof. + (* FIXME: curry-uncurry should probably go into Pair for some chosen arities *) + pose P := fun (x : 'a * 'b) => p x.`1 x.`2. + rewrite !mem_domE !mem_map_fst; split=> [[y] | [[y] xy_in_m]]. + rewrite -mem_elems_filter mem_filter getE /= => -[p_x_y xy_in_pm]. + split; 1:by exists y. + by move: xy_in_pm; rewrite mem_assoc_uniq 1:uniq_keys // => ->. + have:= xy_in_m; rewrite mem_assoc_uniq 1:uniq_keys // getE /oget=> -> /= p_x_y. + by exists y; rewrite -mem_elems_filter mem_filter. +qed. + +lemma filterP (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap) x: + (filter p m).[x] = if mem (dom m) x /\ p x (oget m.[x]) + then m.[x] + else None. +proof. + case (mem (dom m) x /\ p x (oget m.[x])); rewrite -dom_filter in_dom //=. + case {-1}((filter p m).[x]) (eq_refl (filter p m).[x])=> //= y. + rewrite getE -mem_assoc_uniq 1:uniq_keys //. + rewrite -mem_elems_filter mem_filter /= mem_assoc_uniq 1:uniq_keys //. + by rewrite getE=> -[_ ->]. +qed. + +lemma filter_eq_dom (m:('a,'b)fmap) (p1 p2:'a->'b->bool): + (forall a, mem (dom m) a=> p1 a (oget m.[a]) = p2 a (oget m.[a])) => + filter p1 m = filter p2 m. +proof. + by move=> Hp;apply fmapP=>z;rewrite !filterP;case (mem (dom m) z)=>// Hz;rewrite Hp. +qed. + +lemma filter_eq (m:('a,'b)fmap) (p1 p2:'a->'b->bool): + (forall a b, p1 a b = p2 a b) => + filter p1 m = filter p2 m. +proof. by move=>Hp;apply filter_eq_dom=>?_;apply Hp. qed. + +lemma filter_dom (m : ('a,'b) fmap) (p : 'a -> 'b -> bool): + filter (relI p (fun a (_ : 'b)=> mem (dom m) a)) m = filter p m. +proof. by apply/filter_eq_dom=> a @/relI ->. qed. + +(* -------------------------------------------------------------------- *) +op map (f : 'a -> 'b -> 'c) (m : ('a, 'b) fmap) = + oflist (map (fun (x : 'a * 'b) => (x.`1,f x.`1 x.`2)) (elems m)) + axiomatized by mapE. + +lemma dom_map (m : ('a,'b) fmap) (f : 'a -> 'b -> 'c) x: + mem (dom (map f m)) x <=> mem (dom m) x. +proof. + rewrite mapE dom_oflist domE mem_oflist. + by elim (elems m)=> //= [[a b] l] /= ->. +qed. + +lemma perm_eq_elems_map (m : ('a, 'b) fmap) (f : 'a -> 'b -> 'c): + perm_eq (map (fun (x : 'a * 'b) => (x.`1,f x.`1 x.`2)) (elems m)) + (elems (map f m)). +proof. + pose F := fun (x : 'a * 'b) => (x.`1,f x.`1 x.`2). + apply (@perm_eq_trans (reduce (map F (elems m)))). + rewrite -{1}(@reduce_reduced (map F (elems m))) 2:perm_eq_refl //. + have ->: forall s, map fst (map F s) = map fst s by elim. + exact/uniq_keys. + by rewrite mapE; apply/oflistK. +qed. + +lemma mem_elems_map (m : ('a, 'b) fmap) (f : 'a -> 'b -> 'c) x y: + mem (map (fun (x : 'a * 'b) => (x.`1,f x.`1 x.`2)) (elems m)) (x,y) + <=> mem (elems (map f m)) (x,y). +proof. by apply/perm_eq_mem/perm_eq_elems_map. qed. + +lemma mapP (f : 'a -> 'b -> 'c) (m : ('a, 'b) fmap) x: + (map f m).[x] = omap (f x) m.[x]. +proof. + pose F := fun (x : 'a * 'b) => (x.`1,f x.`1 x.`2). + case (mem (dom (map f m)) x)=> h //=. + case {-1}((map f m).[x]) (eq_refl (map f m).[x])=> [nh | y]. + by move: h; rewrite in_dom nh. + rewrite getE -mem_assoc_uniq 1:uniq_keys// -mem_elems_map mapP=> -[[a b]] /=. + by rewrite mem_assoc_uniq 1:uniq_keys// -getE andbC=> -[[<<- ->>]] ->. + have:= h; rewrite dom_map=> h'. + by move: h h'; rewrite !in_dom /= => -> ->. +qed. + +(* -------------------------------------------------------------------- *) +op eq_except (m1 m2 : ('a, 'b) fmap) (X : 'a -> bool) = + filter (fun x y => !X x) m1 + = filter (fun x y => !X x) m2 + axiomatized by eq_exceptE. + +lemma eq_except_refl (m : ('a, 'b) fmap) X: eq_except m m X. +proof. by rewrite eq_exceptE. qed. + +lemma eq_except_sym (m1 m2 : ('a, 'b) fmap) X: + eq_except m1 m2 X <=> eq_except m2 m1 X. +proof. by rewrite eq_exceptE eq_sym -eq_exceptE. qed. + +lemma eq_except_trans (m2 m1 m3 : ('a, 'b) fmap) X: + eq_except m1 m2 X => + eq_except m2 m3 X => + eq_except m1 m3 X. +proof. by rewrite !eq_exceptE; apply eq_trans. qed. + +lemma eq_exceptP (m1 m2 : ('a, 'b) fmap) X: + eq_except m1 m2 X <=> + (forall x, !X x => m1.[x] = m2.[x]). +proof. + rewrite eq_exceptE fmapP; split=> h x. + move=> x_notin_X; have:= h x; rewrite !filterP /= x_notin_X /=. + case (mem (dom m1) x); case (mem (dom m2) x); rewrite !in_dom=> //=. + (* FIXME: Should the following two be dealt with by `trivial'? *) + by rewrite eq_sym. + by move=> -> ->. + by rewrite !filterP /=; case (X x)=> //= /h; rewrite !in_dom=> ->. +qed. + +(* -------------------------------------------------------------------- *) +op size (m : ('a, 'b) fmap) = card (dom m) + axiomatized by sizeE. + +(* -------------------------------------------------------------------- *) +(* TODO: Do we need unary variants of has, all, find and map? *) + +(* -------------------------------------------------------------------- *) +lemma map0P x: (map0<:'a, 'b>).[x] = None. +proof. by rewrite map0E get_oflist. qed. + +lemma map0_eq0 (m : ('a,'b) fmap): + (forall x, m.[x] = None) => m = map0. +proof. by move=> h; apply fmapP=> x; rewrite h map0P. qed. + +lemma remP_eq (a : 'a) (m : ('a,'b) fmap): (rem a m).[a] = None. +proof. by rewrite remP. qed. + +lemma rem_rem (a : 'a) (m : ('a, 'b) fmap): + rem a (rem a m) = rem a m. +proof. by rewrite fmapP=> x; rewrite !remP; case (x = a). qed. + +lemma dom0: dom map0<:'a, 'b> = fset0. +proof. by apply/fsetP=> x; rewrite map0E dom_oflist in_fset0. qed. + +lemma dom_eq0 (m : ('a,'b) fmap): + dom m = fset0 => m = map0. +proof. + move=> eq_dom; apply fmap_domP; rewrite eq_dom dom0 //= => x; + by rewrite in_fset0. +qed. + +lemma domP (m : ('a, 'b) fmap) (a : 'a) (b : 'b): + forall x, mem (dom m.[a <- b]) x <=> mem (dom m `|` fset1 a) x. +proof. + move=> x; rewrite in_fsetU in_fset1 !in_dom getP; + by case (x = a). +qed. + +lemma domP_eq (m : ('a, 'b) fmap) (a : 'a) (b : 'b): + mem (dom m.[a <- b]) a. +proof. by rewrite domP in_fsetU in_fset1. qed. + +lemma dom_set (m:('a,'b) fmap) a b : + dom m.[a<-b] = dom m `|` fset1 a. +proof. by apply/fsetP/domP. qed. + +lemma dom_rem (a : 'a) (m : ('a, 'b) fmap): + dom (rem a m) = dom m `\` fset1 a. +proof. + by rewrite fsetP=> x; rewrite in_fsetD in_fset1 !in_dom remP; case (x = a). +qed. + +lemma dom_rem_eq (a : 'a) (m : ('a, 'b) fmap): !mem (dom (rem a m)) a. +proof. by rewrite dom_rem in_fsetD in_fset1. qed. + +lemma rng0: rng map0<:'a, 'b> = fset0. +proof. + apply/fsetP=> x; rewrite in_fset0 //= in_rng. + by rewrite negb_exists => a; rewrite /= map0P. +qed. + +lemma find_set (m:('a,'b) fmap) y x (p:'a -> 'b -> bool): + (forall x, mem (dom m) x => !p x (oget m.[x])) => + find p m.[x <- y] = if p x y then Some x else None. +proof. + cut [[a []->[]] | []-> Hp Hnp]:= findP p (m.[x<-y]);1: rewrite getP dom_set !inE /#. + by case (p x y)=> //; cut := Hp x;rewrite getP dom_set !inE /= oget_some. +qed. + +lemma rng_set (m : ('a, 'b) fmap) (a : 'a) (b : 'b): + rng m.[a<-b] = rng (rem a m) `|` fset1 b. +proof. + rewrite fsetP=> y; rewrite in_fsetU in_fset1 !in_rng; split=> [[] x |]. + rewrite getP; case (x = a)=> [->> /= <<- |ne_xa mx_y]; [right=> // |left]. + by exists x; rewrite remP ne_xa /=. + rewrite orbC -oraE=> -[->> | ]. + by exists a; rewrite getP_eq. + move=> ne_yb [] x; rewrite remP. + case (x = a)=> //= ne_xa <-. + by exists x; rewrite getP ne_xa. +qed. + +lemma rng_set_eq (m : ('a, 'b) fmap) (a : 'a) (b : 'b): + mem (rng m.[a<-b]) b. +proof. by rewrite rng_set in_fsetU in_fset1. qed. + +lemma rng_rem (a : 'a) (m : ('a, 'b) fmap) (b : 'b): + mem (rng (rem a m)) b <=> (exists x, x <> a /\ m.[x] = Some b). +proof. + rewrite in_rng; split=> [[x]|[x] [ne_x_a mx_b]]. + rewrite remP; case (x = a)=> //=. + by move=> ne_x_a mx_b; exists x. + by exists x; rewrite remP ne_x_a. +qed. + +lemma dom_join (m1 m2 : ('a, 'b) fmap): + forall x, mem (dom (m1 + m2)) x <=> mem (dom m1 `|` dom m2) x. +proof. + by move=> x; rewrite in_fsetU !in_dom joinP in_dom; case (m2.[x]). +qed. + +lemma has_join (p : 'a -> 'b -> bool) (m1 m2 : ('a, 'b) fmap): + has p (m1 + m2) <=> has (fun x y => p x y /\ !mem (dom m2) x) m1 \/ has p m2. +proof. +rewrite !hasP; split=> [[x]|]. + rewrite joinP dom_join in_fsetU. + by case: (mem (dom m2) x)=> //= + [x_in_m2 p_x_m2x|x_notin_m2 [x_in_m1 p_x_m1x]]; + [right|left]; exists x. +by move=> [[]|[]] x /> => [x_in_m1|h] p_x => [h|]; exists x; rewrite dom_join joinP in_fsetU h. +qed. + +lemma get_find (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap): + has p m => p (oget (find p m)) (oget m.[oget (find p m)]). +proof. by rewrite find_none; have:= findP p m; case (find p m). qed. + +lemma has_find (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap): + has p m <=> exists x, find p m = Some x /\ mem (dom m) x. +proof. + rewrite find_none; have:= findP p m. + by case (find p m)=> //= x [x'] [eq_xx' [x'_in_m _]]; exists x'. +qed. + +lemma find_some (p:'a -> 'b -> bool) m x: + find p m = Some x => + mem (dom m) x /\ p x (oget m.[x]). +proof. by have:= findP p m; case (find p m). qed. + +lemma rem_filter (m : ('a, 'b) fmap) x: + rem x m = filter (fun x' y => x' <> x) m. +proof. + apply fmapP=> x'; rewrite remP filterP; case (mem (dom m) x'). + by case (x' = x). + by rewrite in_dom /= => ->. +qed. + +lemma filter_predI (p1 p2: 'a -> 'b -> bool) (m : ('a, 'b) fmap): + filter (fun a b => p1 a b /\ p2 a b) m = filter p1 (filter p2 m). +proof. by rewrite fmapP=>x;rewrite !(filterP, dom_filter)/#. qed. + +lemma filter_filter (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap): + filter p (filter p m) = filter p m. +proof. by rewrite -filter_predI;apply filter_eq => /#. qed. + +lemma filter_rem (p:'a->'b->bool) (m:('a,'b)fmap) x: + filter p (rem x m) = rem x (filter p m). +proof. rewrite !rem_filter -!filter_predI;apply filter_eq=>/#. qed. + +lemma join_filter (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap): + (filter p m) + (filter (fun x y=> !p x y) m) = m. +proof. + rewrite fmapP=> x; rewrite joinP dom_filter /= !filterP. + case (mem (dom m) x)=> /=. + by case (p x (oget m.[x])). + by rewrite in_dom /= eq_sym. +qed. + +lemma eq_except_set a b (m1 m2 : ('a, 'b) fmap) X: + eq_except m1 m2 X => + eq_except m1.[a <- b] m2.[a <- b] X. +proof. + rewrite !eq_exceptP=> h x x_notin_X. + rewrite !getP; case (x = a)=> //=. + by rewrite h. +qed. + +lemma filter_eq_except (m : ('a, 'b) fmap) (X : 'a -> bool): + eq_except (filter (fun x y => !X x) m) m X. +proof. by rewrite eq_exceptE filter_filter. qed. + +lemma eq_except_rem (m1 m2:('a,'b)fmap) (s:'a -> bool) x: + s x => eq_except m1 m2 s => eq_except m1 (rem x m2) s. +proof. + rewrite !eq_exceptE rem_filter -filter_predI=> Hmem ->;apply filter_eq=>/#. +qed. + +lemma set_eq_except x b (m : ('a, 'b) fmap): + eq_except m.[x <- b] m (pred1 x). +proof. by rewrite eq_exceptP=> x'; rewrite !getP=> ->. qed. + +lemma set2_eq_except x b b' (m : ('a, 'b) fmap): + eq_except m.[x <- b] m.[x <- b'] (pred1 x). +proof. by rewrite eq_exceptP=> x'; rewrite !getP=> ->. qed. + +lemma eq_except_set_eq (m1 m2 : ('a, 'b) fmap) x: + mem (dom m1) x => + eq_except m1 m2 (pred1 x) => + m1 = m2.[x <- oget m1.[x]]. +proof. + rewrite eq_exceptP fmapP=> x_in_m1 eqe x'. + rewrite !getP /oget; case (x' = x)=> [->> |]. + by move: x_in_m1; rewrite in_dom; case (m1.[x]). + by exact/eqe. +qed. + +(* -------------------------------------------------------------------- *) +lemma rem_id (x : 'a) (m : ('a,'b) fmap): + !mem (dom m) x => rem x m = m. +proof. +rewrite in_dom /= => x_notin_m; apply/fmapP=> x'; rewrite remP. +by case: (x' = x)=> //= ->>; rewrite x_notin_m. +qed. + +lemma dom_rem_le (x : 'a) (m : ('a,'b) fmap) (x' : 'a): + mem (dom (rem x m)) x' => mem (dom m) x'. +proof. by rewrite dom_rem in_fsetD. qed. + +lemma rng_rem_le (x : 'a) (m : ('a,'b) fmap) (x' : 'b): + mem (rng (rem x m)) x' => mem (rng m) x'. +proof. by rewrite rng_rem in_rng=> -[x0] [_ h]; exists x0. qed. + +(* -------------------------------------------------------------------- *) +(** FIXME: these two were minimally imported from old and need cleaning *) +lemma leq_card_rng_dom (m:('a,'b) fmap): + card (rng m) <= card (dom m). +proof. +elim/fset_ind: (dom m) {-2}m (eq_refl (dom m))=> {m} [m /dom_eq0 ->|]. ++ by rewrite rng0 dom0 !fcards0. +move=> x s x_notin_s ih m dom_m. +cut ->: m = (rem x m).[x <- oget m.[x]]. ++ apply fmapP=> x'; rewrite getP remP; case: (x' = x)=> [->|//]. + have /fsetP /(_ x):= dom_m; rewrite in_fsetU in_fset1 /= in_dom. + by case: m.[x]. +have ->:= rng_set (rem x m) x (oget m.[x]). +rewrite fcardU rem_rem fsetI1 fun_if !fcard1 fcards0. +rewrite dom_set fcardUI_indep 2:fcard1. ++ by apply/fsetP=> x0; rewrite in_fsetI dom_rem !inE -andbA andNb. +rewrite StdOrder.IntOrder.ler_subl_addr; apply/StdOrder.IntOrder.ler_paddr. ++ by case: (mem (rng _) _). +apply/StdOrder.IntOrder.ler_add2r/ih/fsetP=> x0. +by rewrite dom_rem dom_m !inE; case: (x0 = x). +qed. + +lemma endo_dom_rng (m:('a,'a) fmap): + (exists x, !mem (dom m) x) => + exists x, !mem (rng m) x. +proof. +elim=> x x_notin_m. +have h: 0 < card (((dom m) `|` fset1 x) `\` (rng m)); last first. ++ by have: forall (X : 'a fset), 0 < card X => exists x, mem X x; smt. +rewrite fcardD fcardUI_indep. ++ by apply/fsetP=> x'; rewrite !inE /#. +rewrite fcard1 fsetIUl fcardUI_indep. ++ by apply/fsetP=> x'; rewrite !inE /#. +have ->: card (fset1 x `&` rng m) = if mem (rng m) x then 1 else 0. ++ smt (@FSet). +smt (leq_card_rng_dom @FSet). +qed. + +(** TODO: lots of lemmas *) +lemma rem0 (a : 'a) : rem a map0<:'a,'b> = map0. +proof. + by apply map0_eq0=>x;rewrite remP;case (x=a)=>//=;rewrite map0P. +qed. + +lemma set_eq (m:('a,'b)fmap) x y: m.[x] = Some y => m.[x<-y] = m. +proof. + by rewrite fmapP=> Hx x';rewrite getP;case (x'=x)=>//->;rewrite Hx. +qed. + +lemma map_map0 (f:'a -> 'b -> 'c): map f map0 = map0. +proof. by rewrite fmapP=> x;rewrite mapP !map0P. qed. + +lemma map_set (f:'a -> 'b -> 'c) m x y : + map f m.[x<-y] = (map f m).[x<- f x y]. +proof. + by rewrite fmapP=>z;rewrite mapP !getP;case (z=x)=>// _;rewrite mapP. +qed. + +lemma map_rem (f:'a -> 'b -> 'c) m x: map f (rem x m) = rem x (map f m). +proof. by rewrite fmapP=>z;rewrite !(mapP,remP)/#. qed. + +lemma rem_set (m:('a,'b)fmap) x y v: + rem x (m.[y<-v]) = if x = y then rem x m else (rem x m).[y<-v]. +proof. + rewrite fmapP=>z;case (x=y)=>[->|]; rewrite !(remP,getP) /#. +qed. + +lemma map_comp (f1:'a->'b->'c) (f2:'a->'c->'d) (m:('a,'b)fmap): + map f2 (map f1 m) = map (fun a b => f2 a (f1 a b)) m. +proof. by rewrite fmapP=>x;rewrite !mapP;case (m.[x]). qed. + +lemma map_id (m:('a,'b)fmap): map (fun _ b => b) m = m. +proof. by rewrite fmapP=>x;rewrite mapP;case (m.[x]). qed. From 5da1a6ec4590ed7e97143488ceac12e3ba700cbd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 24 Apr 2018 19:03:28 +0200 Subject: [PATCH 278/394] Real : all done. Ideal : TODO. --- sha3/proof/smart_counter/Gconcl_list.ec | 1327 +++++++++-------------- 1 file changed, 519 insertions(+), 808 deletions(-) diff --git a/sha3/proof/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec index ce418ba..a0de715 100644 --- a/sha3/proof/smart_counter/Gconcl_list.ec +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -7,6 +7,7 @@ require import DProd Dexcepted BlockSponge. require (*--*) Handle. + (*** THEORY PARAMETERS ***) (** Validity of Functionality Queries **) op valid: block list -> bool = valid_block. @@ -15,30 +16,19 @@ axiom valid_spec p: valid p => p <> []. clone export Handle as Handle0. - -module NC = { - var queries : (block list * int, block list) fmap - proc init() = { - queries <- map0; - } -}. - - 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 /\ 0 < n) { + if (valid p) { + b <@ F.f(p); while (i < n) { i <- i + 1; - if (! (p,i) \in dom NC.queries) { - b <@ F.f(format p i); - lres <- rcons lres b; - NC.queries.[(p,i)] <- lres; - } else { - lres <- oget NC.queries.[(p,i)]; + lres <- rcons lres b; + if (i < n) { + b <@ F.f(format p (i+1)); } } } @@ -49,7 +39,6 @@ module DSqueeze (F : SLCommon.DFUNCTIONALITY) = { module (Squeeze (F : SLCommon.FUNCTIONALITY) : FUNCTIONALITY) = { proc init () : unit = { - NC.init(); C.init(); F.init(); } @@ -61,9 +50,8 @@ module (A (D : DISTINGUISHER) : SLCommon.DISTINGUISHER) (F : SLCommon.DFUNCTIONALITY) (P : DPRIMITIVE) = { proc distinguish() : bool = { var b : bool; - NC.init(); C.init(); - b <@ D(FC(DSqueeze(F)),PC(P)).distinguish(); + b <@ DRestr(D,DSqueeze(F),P).distinguish(); return b; } }. @@ -82,16 +70,6 @@ module NIndif (F : FUNCTIONALITY, P : PRIMITIVE, D : DISTINGUISHER) = { }. -module DC (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { - proc distinguish () : bool = { - var b : bool; - NC.init(); - C.init(); - b <@ D(FC(F),PC(P)).distinguish(); - return b; - } -}. - module P = Perm. @@ -111,38 +89,31 @@ section Real_Ideal. forall i, 1 <= i <= (parse l).`2 => ((parse l).`1,i) \in dom squeeze). - inductive m_p (m : (state, state) fmap) (p : (block list, state) fmap) - (q : (block list * int, block list) fmap) = + inductive m_p (m : (state, state) fmap) (p : (block list, state) fmap) = | IND_M_P of (p.[[]] = Some (b0, c0)) & (forall l, l \in dom 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]) - & (forall l n, (l,n) \in dom q => - valid l /\ 0 < n /\ size (oget q.[(l,n)]) = n /\ - (forall i, 0 < i <= n => q.[(l,i)] = Some (take i (oget q.[(l,n)])))) - & (forall l n, (l,n) \in dom q => exists c, p.[format l n] = Some (last b0 (oget q.[(l,n)]),c)) - & (forall l, l \in dom p => l <> [] => exists l2, parse (l ++ l2) \in dom q). + 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) - (q : (block list * int, block list) fmap) = + (p : (block list, state) fmap) = | INV_real of (c1 <= c2) - & (m_p m p q) + & (m_p m p) & (invm m mi). - local lemma INV_Real_incr c1 c2 m mi p q : - INV_Real c1 c2 m mi p q => - INV_Real (c1 + 1) (c2 + 1) m mi p q. + 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 q x y : - INV_Real c1 c2 m mi p q => + local lemma INV_Real_addm_mi c1 c2 m mi p x y : + INV_Real c1 c2 m mi p => ! x \in dom m => ! y \in rng m => - INV_Real c1 c2 m.[x <- y] mi.[y <- x] p q. + 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=>//=; @@ -162,56 +133,25 @@ section Real_Ideal. invm m mi => dom m = rng mi. proof. by move=>h;rewrite fsetP=>x;split;rewrite in_dom in_rng/#. qed. - local lemma lemma1 c1 c2 m mi p q bs i (l : block list): - INV_Real c1 c2 m mi p q => - ! (bs,i) \in dom q => - valid bs => - 0 < i => - size l = i => - (exists c, p.[format bs i] = Some (last b0 l, c)) => - (forall j, 0 < j < i => q.[(bs,j)] = Some (take j l)) => - INV_Real c1 c2 m mi p q.[(bs,i) <- l]. - proof. - move=>INV0 H_bs_n_dom H_bs_valid H0in H_size H_format_dom H_pref_quer. - split;cut[]//=H_c1c2 H_m_p H_invm:=INV0. - split;cut[]//H_mp0 H_mp1 H_mp2 H_mp3 H_mp4:=H_m_p. - + move=>l1 n1;rewrite dom_set in_fsetU1. - case((l1, n1) = (bs, i))=>[[]->>->>|H_neq]//=. - - rewrite H_bs_valid getP/= oget_some/=H_size//=;split;1:rewrite/#;move=>j []Hj0 Hj1. - rewrite getP/=;case(j=i)=>[->>|/#]//=;1:rewrite -H_size take_size//=. - rewrite getP/=;move=>H_dom;cut[]->[]->[]H_size_get/=help:=H_mp2 _ _ H_dom;split. - - by rewrite H_neq/=H_size_get. - move=> j[]hj0 hji. - rewrite !getP/=. - cut:=H_neq;case(l1=bs)=>[->>H_n1i|]//=;smt(in_dom). - + move=>m1 j;rewrite dom_set in_fsetU1 getP. - case((m1, j) = (bs, i))=>//=h H_dom. - by cut[]c ->/#:=H_mp3 _ _ H_dom. - + smt(dom_set in_fsetU1). - qed. - - local lemma all_prefixes_of_INV_real c1 c2 m mi p q: - INV_Real c1 c2 m mi p q => + 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. + move=>[]_[]Hp0 Hmp1 _ l H_dom i. smt(take_le0 take_oversize size_take take_take take_size nth_take in_dom). qed. - local lemma lemma2 c1 c2 m mi p q bl i sa sc lres: - INV_Real c1 c2 m mi p q => + 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 dom m => ! (format bl i) \in dom p => - ! (bl, i) \in dom q => p.[format bl (i-1)] = Some (sa,sc) => - q.[(bl,i-1)] = Some lres => - INV_Real c1 c2 m mi p.[format bl i <- oget m.[(sa,sc)]] - q.[(bl,i) <- rcons lres (oget m.[(sa,sc)]).`1]. + 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_dom_q H_p_val H_q_val. - split;cut[]//=_[] hmp0 hmp1 hmp2 hmp3 hmp4 hinvm:=inv0;split=>//=. + move=>inv0 h1i h_valid H_dom_m H_dom_p H_p_val. + split;cut[]//=_[] hmp0 hmp1 hinvm:=inv0;split=>//=. + by rewrite getP;smt(size_cat size_nseq size_ge0). + move=>l;rewrite dom_set in_fsetU1;case;1:smt(all_prefixes_of_INV_real getP). move=>->>j[]hj0 hjsize;rewrite getP/=. @@ -240,28 +180,6 @@ section Real_Ideal. rewrite h'' take_size/=-h 1:/# -h' take_size. rewrite nth_cat h';cut->/=:! size bl + i - 2 < size bl by smt(). by rewrite nth_nseq 1:/#;smt(Block.WRing.AddMonoid.addm0 in_dom get_oget). - + move=>bs n;rewrite dom_set in_fsetU1;case=>//=[Hdom|[]->>->>]//=;do!split=>//=. - - by cut//:=hmp2 _ _ Hdom. - - by cut//:=hmp2 _ _ Hdom. - - by cut[]H_valid[]Hn0[]H_size H_prefixe:=hmp2 _ _ Hdom;rewrite getP/=;smt(). - - cut[]H_valid[]Hn0[]H_size H_prefixe k[]hk0 hksize:=hmp2 _ _ Hdom. - rewrite!getP/=;cut->/=:!(bs = bl && n = i) by smt(). - by rewrite-H_prefixe//=;smt(in_dom). - - smt(). - - by rewrite getP/=oget_some/=size_rcons;smt(in_dom get_oget). - move=>j[]hj0 hji;rewrite!getP/=oget_some-{2}cats1 take_cat. - case(i=j)=>[->>|]//=. - - by cut<-/=:j - 1 = size lres;smt(in_dom get_oget cats1). - move=>hij;cut->/=:j<>i by smt(). - cut->:size lres = i - 1 by smt(in_dom get_oget cats1). - case(j < i - 1)=>//=hh;1:smt(in_dom get_oget cats1). - by cut->>/=: j = i - 1;smt(cats0). - + move=>bs n;rewrite dom_set in_fsetU1;case=>[Hdom|[]->>->>]. - - rewrite !getP/=;smt(in_dom). - by rewrite!getP/=oget_some last_rcons/=;smt(get_oget in_dom). - move=>l;rewrite dom_set in_fsetU1;case=>[H_dom|->>]l_n_nil. - + smt(dom_set in_fsetU1). - by exists [];rewrite cats0 parseK//= 1:/# dom_set in_fsetU1. qed. local lemma take_nseq (a : 'a) i j : @@ -289,14 +207,14 @@ section Real_Ideal. qed. - local lemma equiv_sponge (D <: DISTINGUISHER {P, NC, Redo, C, SLCommon.C}) : + local lemma equiv_sponge (D <: DISTINGUISHER {P, Redo, C, SLCommon.C}) : equiv [ GReal(A(D)).main - ~ NIndif(Squeeze(SqueezelessSponge(P)),P,DC(D)).main - : ={glob D} ==> ={res, glob D, glob P, NC.queries, C.c} /\ SLCommon.C.c{1} <= C.c{2}]. + ~ NIndif(Squeeze(SqueezelessSponge(P)),P,DRestr(D)).main + : ={glob D} ==> ={res, glob D, glob P, C.c} /\ SLCommon.C.c{1} <= C.c{2}]. proof. proc;inline*;sp;wp. - call(: ={Redo.prefixes, glob P, NC.queries, C.c} /\ - INV_Real SLCommon.C.c{1} C.c{2} Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1});auto;last first. + call(: ={Redo.prefixes, glob P, C.c} /\ + INV_Real SLCommon.C.c{1} C.c{2} Perm.m{1} Perm.mi{1} Redo.prefixes{1});auto;last first. + by progress;1:(split=>//=;1:split;smt(dom0 in_fset0 dom_set in_fsetU1 getP map0P));case:H0=>//=. + by proc;inline*;auto;sp;if;auto;sp;if;auto; smt(INV_Real_addm_mi INV_Real_incr supp_dexcepted). @@ -308,79 +226,48 @@ section Real_Ideal. case:H=>H_c H_m_p H_invm;cut<-//:=(invm_dom_rng Perm.mi{2} Perm.m{2}). by rewrite invmC. + exact INV_Real_incr. - + proc;inline*;sp;if;auto;if;auto. + + proc;inline*;sp;if;auto. swap 6;wp;sp=>/=;if;auto;last by progress;split;case:H=>//=;smt(size_ge0). - rcondt{1}1;1:auto;rcondt{2}1;1:auto;sp. - conseq(:_==> ={i,nb,bl,n,p,NC.queries, C.c,glob Redo,glob P,lres} - /\ (n,p){1} = (nb,bl){1} /\ i{1} = nb{1} - /\ format p{1} i{1} \in dom Redo.prefixes{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} NC.queries{1});progress. - while(={i,nb,bl,n,p,NC.queries,C.c,glob Redo,glob P,lres} - /\ (n,p){1} = (nb,bl){1} /\ 0 < i{1} <= nb{1} - /\ (0 < i{1} => Some lres{1} = NC.queries{1}.[(bl{1}, i{1})]) - /\ format p{1} i{1} \in dom Redo.prefixes{1} /\ valid p{1} - /\ size lres{1} = i{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} NC.queries{1});last first. - + sp;conseq(:_ ==> ={i,nb,bl,n,p,NC.queries,C.c,glob Redo,glob P,lres} - /\ (n,p){1} = (nb,bl){1} /\ 0 < i{1} <= nb{1} - /\ (0 < i{1} => Some lres{1} = NC.queries{1}.[(bl{1}, i{1})]) - /\ format p{1} i{1} \in dom Redo.prefixes{1} /\ size lres{1} = i{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} NC.queries{1});1:progress=>/#. - sp;if;auto;last first. - * progress. - - by rewrite/#. - - by rewrite get_oget//. - - by cut INV0:=H;cut[]//=H_c1c2 H_m_p H_invm:=INV0;cut[]:=H_m_p;smt(in_dom). - - cut[]_[]Hmp0 Hmp1 Hmp2 Hmp3 Hmp4 Hinvm:=H. - by cut//=:=Hmp2 bl{2} 1 H4;rewrite H0/==>help;cut/=->/=:=help 1; - rewrite oget_some size_take. - by split;case:H=>//=;smt(size_ge0). - sp=>/=. - exists* Redo.prefixes{1}, SLCommon.C.c{1};elim*=>pref count;progress. - conseq(:_==> ={i0,p0,i,p,n,nb,bl,sa,lres,NC.queries,C.c,glob Redo,glob Perm} + 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 NC.queries{1} + /\ INV_Real count C.c{1} Perm.m{1} Perm.mi{1} pref /\ (forall l, l \in dom Redo.prefixes{1} => l \in dom pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) /\ (forall l, l \in dom 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. - + by rewrite/#. - + by rewrite getP/=. - + by rewrite/format/=nseq0 cats0//-take_size in_dom H6. - + cut inv0:=H7;cut[]h_c1c2[]Hmp0 Hmp1 Hmp2 Hmp3 Hmp4 Hinvm:=inv0;split=>//=. + Perm.m{1}.[(b +^ nth witness p{1} j, c)] = + Redo.prefixes{1}.[take (j+1) p{1}])); + progress. + - cut inv0:=H3;cut[]h_c1c2[]Hmp0 Hmp1 Hinvm:=inv0;split=>//=. - case:inv0;smt(size_ge0). split=>//=. - smt(in_dom). - - move=>l H_dom_R i []Hi0 Hisize;cut:=H8 l H_dom_R. + - move=>l H_dom_R i []Hi0 Hisize;cut:=H4 l H_dom_R. case(l \in dom Redo.prefixes{2})=>H_in_pref//=. * cut:=Hmp1 l H_in_pref i _;rewrite//=. - rewrite ?H9//=;1:smt(in_dom). + rewrite ?H5//=;1:smt(in_dom). case(i+1 < size l)=>h;1:smt(in_dom). by rewrite take_oversize 1:/#. move=>[]j[][]hj0 hjsize ->>. cut:=Hisize;rewrite size_take 1:/#. pose k:=if _ then _ else _;cut->>Hij{k}:k=j by rewrite/#. by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#;smt(in_dom). - - by move=>l n;rewrite!dom_set in_fsetU1=>[][];smt(getP oget_some in_dom take_oversize). - - move=>l n;rewrite dom_set in_fsetU1 getP;case((l, n) = (bl{2}, 1))=>//=[[->>->>]|]. - * by rewrite oget_some/=/format/=nseq0 cats0-take_size H6/#. - move=>h H_dom;cut[]c:=Hmp3 _ _ H_dom;smt(in_dom). - - move=>l H_dom_R H_not_nil;rewrite dom_set. - cut:=H8 l H_dom_R;case;1:smt(in_fsetU1). - move=>[]j[][]hj0 hjsize ->>;exists(drop j bl{2}). - by rewrite cat_take_drop parse_valid//=in_fsetU1. - while( ={i0,p0,i,p,n,nb,bl,sa,sc,lres,NC.queries,C.c,glob Redo,glob Perm} + - smt(getP oget_some in_dom 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 NC.queries{1} + /\ INV_Real count C.c{1} Perm.m{1} Perm.mi{1} pref /\ (forall l, l \in dom Redo.prefixes{1} => l \in dom pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) /\ (forall l, l \in dom pref => pref.[l] = Redo.prefixes{1}.[l]) @@ -393,313 +280,242 @@ section Real_Ideal. 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. - - by rewrite /format/=nseq0 cats0. - - exact size_ge0. - - by rewrite take0;cut[]_[]->//=:=H. - - by rewrite/#. - - by cut[]->//=:=H. - - smt(all_prefixes_of_INV_real). - - by rewrite/#. - by rewrite/#. - if;auto;progress. - + by rewrite/#. - + by rewrite/#. - + smt(get_oget in_dom). - + smt(in_dom take_take take_oversize size_take). - + by rewrite/#. - + by rewrite/#. - + by rewrite/#. - + case(jh;1:rewrite/#;cut<<-:j=i0{2} by rewrite/#. - cut->>:=H7 H10 H12. - by cut[]_[]_ help _ _ _ _:=H2;cut:=help _ H12 j _;smt(take_take nth_take size_take). - sp;if;auto;progress. - + by rewrite/#. - + by rewrite/#. - + by rewrite!getP/=. - + by apply INV_Real_addm_mi=>//=;smt(supp_dexcepted). - + by move:H16;rewrite dom_set in_fsetU1/#. - + by rewrite!getP/=;smt(in_dom). - + by rewrite/#. - + by rewrite/#. - + move:H12;apply absurd=>//=_. - move:H17;rewrite dom_set in_fsetU1. - cut->/=:!take (i0{2} + 1 + 1) bl{2} = take (i0{2} + 1) bl{2} by smt(size_take). - smt(take_take size_take). - + move=>l;rewrite!dom_set in_fsetU1;case. - - move=>H_dom;cut[]:=H3 l H_dom. - * by move=>Hdom i;rewrite in_fsetU1/=; - smt(in_dom all_prefixes_of_INV_real). - move=>[]j[][]hj0 hji0->>k. - rewrite in_fsetU1 take_take;left. - cut[]:=H3 _ H_dom;smt(in_dom take_take take_le0 take0 take_oversize). - move=>->>k. - rewrite in_fsetU1 take_take;case(0 <= k)=>hk0; - last smt(in_fsetU1 in_dom take_take take_le0 take0 take_oversize). - case(k < i0{2})=>hki01; - first smt(in_fsetU1 in_dom take_take take_le0 take0 take_oversize). - by case(k <= i0{2} + 1)=>hki02;smt(in_dom). - + rewrite!getP/=oget_some. - cut->/=:!take j bl{2} = take (i0{2} + 1) bl{2} by smt(size_take). - case(j < i0{2})=>hj0;2:smt(getP oget_some size_take). - cut->/=:!take (j + 1) bl{2} = take (i0{2} + 1) bl{2} by smt(size_take). - by cut:=H9 j _;1:rewrite hj0 H16//=;smt(in_rng getP in_dom). - + by rewrite/#. - + by rewrite/#. - + by rewrite!getP/=. - + by move:H14;rewrite dom_set in_fsetU1/#. - + by rewrite!getP/=;smt(in_dom). - + by rewrite/#. - + by rewrite/#. - + move:H12;apply absurd=>//=_. - move:H15;rewrite dom_set in_fsetU1. - cut->/=:!take (i0{2} + 1 + 1) bl{2} = take (i0{2} + 1) bl{2} by smt(size_take). - by move=>h;cut:=H8 _ h (i0{2}+1);rewrite take_take/#. - + move=>l;rewrite!dom_set in_fsetU1;case. - - move=>H_dom;cut[]:=H3 l H_dom. - * by move=>Hdom i;rewrite in_fsetU1/=; - smt(in_dom all_prefixes_of_INV_real). - move=>[]j[][]hj0 hji0->>k. - rewrite in_fsetU1 take_take;left. - cut[]:=H3 _ H_dom;smt(in_dom take_take take_le0 take0 take_oversize). - move=>->>k. - rewrite in_fsetU1 take_take;case(0 <= k)=>hk0; - last smt(in_fsetU1 in_dom take_take take_le0 take0 take_oversize). - case(k < i0{2})=>hki01; - first smt(in_fsetU1 in_dom take_take take_le0 take0 take_oversize). - by case(k <= i0{2} + 1)=>hki02;smt(in_dom). - rewrite!getP/=. - cut->/=:!take j bl{2} = take (i0{2} + 1) bl{2} by smt(size_take). - by case(j < i0{2})=>hj0;smt(get_oget in_dom oget_some size_take). - sp;if;auto;last first;progress. - + rewrite/#. - + rewrite/#. - + by rewrite get_oget//=. - + rewrite in_dom;cut[]_[]_ _ _ help _ _:=H4. - by cut//=:=help bl{2} (size lres{2}+1);rewrite H7/==>[][]c->. - + cut[]_[]_ _ help _ _ _:=H4. - by cut:=help bl{2} (size lres{2}+1);rewrite H7/=H3/==>[][]_[]->//=. - + by split;cut[]//=/#:=H4. + + auto;progress. + - exact size_ge0. + - by rewrite take0;cut[]_[]->//=:=H. + - smt(). + - by cut[]->//=:=H. + - smt(all_prefixes_of_INV_real). + - smt(). + - smt(). + if;auto;progress. + - smt(). + - smt(). + - smt(get_oget in_dom). + - smt(in_dom). + - smt(). + - smt(). + - smt(all_prefixes_of_INV_real in_dom take_take size_take). + - case(j < i0{2})=>hj;1:smt(). + cut<<-/=:j = i0{2} by smt(). + cut->>:=H7 H10 H12. + cut[]_[]hmp0 hmp1 _:=H2. + cut[]b3 c3:=hmp1 _ H12 j _;1:smt(size_take). + smt(take_take nth_take size_take). + sp;if;auto;progress. + - smt(). + - smt(). + - smt(getP get_oget in_dom). + - rewrite INV_Real_addm_mi//=;smt(supp_dexcepted). + - smt(dom_set in_fsetU1). + - smt(getP in_dom). + - smt(). + - smt(). + - move:H17;apply absurd=>//=_;rewrite dom_set in_fsetU1. + pose x:=_ = _;cut->/={x}:x=false by smt(size_take). + move:H12;apply absurd=>//=. + smt(all_prefixes_of_INV_real dom_set in_fsetU1 take_take size_take). + - move=>l;rewrite!dom_set!in_fsetU1;case=>[H_dom|->>]/=;1:smt(in_fsetU1). + move=>j;rewrite in_fsetU1. + case(0 <= j)=>hj0;2:smt(in_dom take_le0). + case(j < i0{2} + 1)=>hjiS;2:smt(in_dom take_take). + rewrite take_take/min hjiS//=;left. + cut:=(take_take bl{2} j i0{2});rewrite min_lel 1:/#=><-. + smt(all_prefixes_of_INV_real in_dom). + - smt(getP get_oget in_dom dom_set in_fsetU1). + - smt(getP get_oget in_dom). + - smt(). + - smt(getP get_oget in_dom). + - smt(dom_set in_fsetU1). + - smt(getP in_dom). + - smt(). + - smt(). + - move:H15;apply absurd=>//=_;rewrite dom_set in_fsetU1. + pose x:=_ = _;cut->/={x}:x=false by smt(size_take). + move:H12;apply absurd=>//=. + cut:=take_take bl{2}(i0{2} + 1)(i0{2} + 1 + 1);rewrite min_lel 1:/# =><-h. + by rewrite (H8 _ h). + - move=>l;rewrite!dom_set!in_fsetU1;case=>[H_dom|->>]/=;1:smt(in_fsetU1). + move=>j;rewrite in_fsetU1. + case(0 <= j)=>hj0;2:smt(in_dom take_le0). + case(j < i0{2} + 1)=>hjiS;2:smt(in_dom take_take). + rewrite take_take/min hjiS//=;left. + cut:=(take_take bl{2} j i0{2});rewrite min_lel 1:/#=><-. + smt(all_prefixes_of_INV_real in_dom). + - smt(getP get_oget in_dom dom_set in_fsetU1). + 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 : i0 < size p0 - 1;splitwhile{2} 1 : i0 < size p0 - 1. + 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(i0 < size p0);auto;1:if;2:(sp;if);auto;smt(size_cat size_nseq size_ge0). + 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 : (i0 = size p0 - 1);1:(auto; - while(i0 < size p0);auto;1:if;2:(sp;if);auto;smt(size_cat size_nseq size_ge0)); + 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;conseq(:_==> ={sa,sc,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} NC.queries{1}.[(p{1}, i{1}) <- rcons lres{1} sa{1}] - /\ (format p{1} i{1} \in dom Redo.prefixes{1}));progress. + 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 dom 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). - + by rewrite getP/=. - + exact size_rcons. - seq 1 1 : (={nb,bl,n,p,p0,i,i0,lres,sa,sc,NC.queries,C.c,glob Redo,glob Perm} - /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = format p{1} i{1} - /\ 1 < i{1} <= n{1} /\ valid p{1} /\ i0{1} = size p0{1} - 1 - /\ Some lres{1} = NC.queries{1}.[(bl{1}, i{1}-1)] - /\ ! ((p{1}, i{1}) \in dom NC.queries{1}) - /\ Redo.prefixes{1}.[format p{1} (i{1}-1)] = Some (sa{1},sc{1}) - /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} - Redo.prefixes{1} NC.queries{1}.[(bl{1}, i{1} - 1) <- lres{1}]);last first. + + 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. - - move:H6;rewrite -addzA/=take_size=>H_dom. - move:H5;rewrite set_eq 1:H2//= =>inv0. - apply lemma1=>//=. - * split;case:inv0=>//=/#. - * smt(). - * rewrite size_rcons;cut[]//=Hc[]Hmp0 Hmp1 Hmp2 Hmp3 Hmp4 Hinvm:=inv0. - by cut:=Hmp2 bl{2} (i{2}-1);rewrite in_dom -H2/=H1/=oget_some/#. - * rewrite last_rcons;smt(get_oget in_dom). - move=>j[]hj0 hji. - cut[]//=Hc[]Hmp0 Hmp1 Hmp2 Hmp3 Hmp4 Hinvm:=inv0;cut:=Hmp2 bl{2} (i{2}-1). - rewrite in_dom -H2/=H1/=oget_some=>[][]hi10[]hsize->;1:smt(). - congr;rewrite-cats1 take_cat;case(j < size lres{2})=>//=hsize2. - cut->//=:j = size lres{2} by smt(). - by rewrite cats0 take_size. - - by move:H6;rewrite -(addzA _ _ 1)/=take_size. + - by split;case:H3=>//=;smt(). + - by rewrite in_dom H2//=. + - by move:H4;rewrite -(addzA _ _ 1)/=take_size;smt(get_oget in_dom). sp;if;auto;progress. - - move:H6 H7;rewrite!getP/=!oget_some nth_last -(addzA _ _ 1)/=take_size. + - move:H4 H5;rewrite!getP/=!oget_some nth_last -(addzA _ _ 1)/=take_size. rewrite last_cat last_nseq 1:/# Block.WRing.addr0;progress. - cut//=:=lemma2(SLCommon.C.c{1} + 1)(C.c{2} + size bl{2} + i{2} - 1) - Perm.m{2}.[(sa_R, sc{2}) <- y0L] Perm.mi{2}.[y0L <- (sa_R, sc{2})] - Redo.prefixes{2} NC.queries{2} bl{2} i{2} sa_R sc{2} lres{2}. - rewrite H/=H1/=H2/=H4/=H6/=H3/=dom_set in_fsetU1/=getP/=oget_some. - cut->->//=:y0L = (y0L.`1, y0L.`2) by smt(). + cut//=:=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 -(addzA _ 1)/=H1/=!dom_set!in_fsetU1/=H4/=H2/=getP/=oget_some/=. + cut->->//=:y2L = (y2L.`1, y2L.`2);1,-1:smt(). rewrite INV_Real_addm_mi//=;2:smt(supp_dexcepted). - by cut:=H5;rewrite set_eq 1:H2//==>hinv0;split;case:hinv0=>//=/#. - - by rewrite dom_set in_fsetU1//=-(addzA _ _ 1)/=take_size. - - move:H6 H7;rewrite nth_last -(addzA _ _ 1)/=take_size. + by cut:=H3=>hinv0;split;case:hinv0=>//=/#. + - by rewrite dom_set in_fsetU1//=-(addzA _ _ 1)/=take_size in_dom H2. + - by rewrite!getP-(addzA _ _ 1)/=take_size/=;smt(). + - move:H4 H5;rewrite nth_last -(addzA _ _ 1)/=take_size. rewrite last_cat last_nseq 1:/# Block.WRing.addr0;progress. - pose a:=(_, _);cut->/={a}:a = oget Perm.m{2}.[(sa_R, sc{2})] by smt(). - apply lemma2=>//=;first cut:=H5;rewrite set_eq 1:H2//==>hinv0;split;case:hinv0=>//=/#. - rewrite H2//=. - - by rewrite dom_set in_fsetU1//=-(addzA _ _ 1)/=take_size. + pose a:=(_, _);cut->/={a}:a = oget Perm.m{2}.[(sa0_R, sc0{2})] by smt(). + apply lemma2=>//=;first cut:=H3=>hinv0;split;case:hinv0=>//=/#. + smt(). + smt(). + - by rewrite dom_set in_fsetU1//=-(addzA _ _ 1)/=take_size;smt(in_dom). + - by rewrite!getP-(addzA _ _ 1)/=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,p0,i,i0,lres,sa,sc,NC.queries,C.c,glob Redo,glob Perm} + 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} /\ p0{1} = format p{1} i{1} - /\ i0{1} = size p0{1} - 1 - /\ Redo.prefixes{1}.[format p{1} (i0{1} - size p{1} + 1)] = - Some (sa{1}, sc{1}));1:smt(size_cat size_nseq set_eq in_dom). - splitwhile{1}1:i0 < size p;splitwhile{2}1:i0 < size p. - while(={nb,bl,n,p,p0,i,i0,lres,sa,sc,NC.queries, C.c,glob Redo,glob Perm} - /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} /\ 0 < i{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(size_cat size_nseq set_eq in_dom). + + move:H8;rewrite size_cat size_nseq-(addzA _ 1 (-1))/=/max H0/=. + by pose x:= Int.(+) _ _;cut->/={x}: x = i_R + 1 by smt(). + + move:H8;rewrite size_cat size_nseq-(addzA _ 1 (-1))/=/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} /\ p0{1} = format p{1} i{1} - /\ size p{1} <= i0{1} <= size p0{1} - 1 /\ valid p{1} - /\ (format p{1} (i{1}-1) \in dom Redo.prefixes{1}) - /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 2) - Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1} - /\ Redo.prefixes{1}.[format p{1} (i0{1} - size p{1} + 1)] = Some (sa{1}, sc{1}) ). + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p1{1} = format p{1} (i{1}+1) + /\ (format p{1} i{1} \in dom 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. - - rewrite take_format;1,2:smt(size_cat size_ge0 size_nseq). - cut->/=:! i0{m} + 1 <= size bl{m} by smt(). - cut:=take_format bl{m} (i{m}-1) (i0{m} + 1) _ _;1,2:smt(size_cat size_ge0 size_nseq). - cut->/=<-:! i0{m} + 1 <= size bl{m} by smt(). - by cut/#:=all_prefixes_of_INV_real. - - rewrite take_format;1,2:smt(size_cat size_ge0 size_nseq). - cut->/=:! i0{hr} + 1 <= size bl{hr} by smt(). - cut:=take_format bl{hr} (i{hr}-1) (i0{hr} + 1) _ _;1,2:smt(size_cat size_ge0 size_nseq). - cut->/=<-:! i0{hr} + 1 <= size bl{hr} by smt(). - by cut/#:=all_prefixes_of_INV_real. - - smt(). - - smt(). - - rewrite take_format//=;1:smt(size_cat size_ge0 size_nseq). - cut->/=:!i0{2} + 1 <= size bl{2} by smt(). - rewrite get_oget 2:/#. - cut:=take_format bl{2} (i{2}-1) (i0{2} + 1) _ _;1,2:smt(size_cat size_ge0 size_nseq). - cut->/=:!i0{2} + 1 <= size bl{2} by smt(). - by cut/#:=all_prefixes_of_INV_real. - conseq(:_==> ={nb,bl,n,p,p0,i,i0,lres,sa,sc,NC.queries, C.c,glob Redo,glob Perm} - /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} /\ 0 < i{1} + + cut->: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). + + cut->: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). + + rewrite get_oget;2:smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). + cut->:format bl{2} (i1{2} + 1 - size bl{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). + smt(all_prefixes_of_INV_real). + 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} /\ p0{1} = format p{1} i{1} - /\ size p{1} = i0{1} /\ valid p{1} - /\ (format p{1} (i{1}-1) \in dom Redo.prefixes{1}) - /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} - Redo.prefixes{1} NC.queries{1} - /\ Redo.prefixes{1}.[take i0{1} p{1}] = Some (sa{1}, sc{1})); - progress. - + smt(size_cat size_ge0 size_nseq). - + by rewrite /format/=nseq0 cats0 -take_size;exact H12. - + smt(). - while( ={nb,bl,n,p,p0,i,i0,lres,sa,sc,NC.queries, C.c,glob Redo,glob Perm} - /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} /\ 1 < i{1} + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p1{1} = format p{1} (i{1}+1) + /\ (format p{1} i{1} \in dom 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} /\ p0{1} = format p{1} i{1} - /\ 0 <= i0{1} <= size p{1} /\ valid p{1} - /\ (format p{1} (i{1}-1) \in dom Redo.prefixes{1}) - /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} - Redo.prefixes{1} NC.queries{1} - /\ Redo.prefixes{1}.[take i0{1} p{1}] = Some (sa{1}, sc{1}) );last first. + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p1{1} = format p{1} (i{1}+1) + /\ (format p{1} i{1} \in dom 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(size_ge0). - - smt(size_ge0). - smt(). - - smt(set_eq in_dom). - - by rewrite take0;case:H4=>[]_[]//=. - - smt(size_cat size_nseq size_ge0). - - smt(size_cat size_nseq size_ge0). + - cut[]_[]:=H;smt(in_dom). + - exact size_ge0. + - cut[]_[]:=H;smt(in_dom take0). + - smt(size_cat size_nseq). rcondt{1}1;2:rcondt{2}1;auto;progress. - + cut->:take (i0{m} + 1) (format bl{m} i{m}) = - take (i0{m} + 1) (format bl{m} (i{m} - 1)) - by rewrite!take_format//=;smt(size_cat size_ge0 size_nseq). - by cut/#:=all_prefixes_of_INV_real. - + cut->:take (i0{hr} + 1) (format bl{hr} i{hr}) = - take (i0{hr} + 1) (format bl{hr} (i{hr} - 1)) - by rewrite!take_format//=;smt(size_cat size_ge0 size_nseq). - by cut/#:=all_prefixes_of_INV_real. - + smt(). - + smt(). - cut->:take (i0{2} + 1) (format bl{2} i{2}) = - take (i0{2} + 1) (format bl{2} (i{2} - 1)) - by rewrite!take_format//=;smt(size_cat size_ge0 size_nseq). - cut->:take (i0{2} + 1) bl{2} = take (i0{2} + 1) (format bl{2} (i{2} - 1)) - by rewrite take_format;smt(size_cat size_ge0 size_nseq). - by cut:=all_prefixes_of_INV_real _ _ _ _ _ _ H4 _ H3;smt(in_dom). - qed. - - - - local lemma lemma3 c c' m mi p q bl i sa sc lres: - INV_Real c c' m mi p q => - 0 < i => - q.[(bl,i)] = Some lres => - p.[format bl i] = Some (sa,sc) => - (bl,i+1) \in dom q => - q.[(bl,i+1)] = Some (rcons lres (oget m.[(sa,sc)]).`1). - proof. - move=>inv0 H_i0 H_q_i H_p_i H_dom_iS. - cut[]_[]_ hmp1 hmp2 hmp3 _ _:=inv0. - cut[]c2 h2:=hmp3 _ _ H_dom_iS. - cut:=hmp1 (format bl (i+1));rewrite in_dom h2/==>help. - cut:=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). - cut->/=:!size (format bl i) + 1 <= size bl by smt(size_cat size_nseq size_ge0). - rewrite nth_cat. - cut->/=:!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 _;cut->/={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;cut->/={x}:x=i+1 - by rewrite/x size_cat size_nseq;smt(). - rewrite H_p_i h2=>[]/=[][]->>->>. - rewrite Block.WRing.addr0=>H_pm;rewrite H_pm/=oget_some. - cut[]_[]_[]H_size H:=hmp2 _ _ H_dom_iS. - cut H_q_i':=H i _;1:smt(). - cut:=H (i+1) _;1:smt(). - rewrite (take_nth witness)1:/# =>H_q_iS. - rewrite H_q_iS/=oget_some last_rcons;congr. - by cut:=H_q_i';rewrite H_q_i/=. + - cut->: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). + - cut->: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(). + - cut->: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). + cut->:take (i1{2} + 1) bl{2} = + take (i1{2} + 1) (format bl{2} i{2}) + by smt(take_cat take_le0 cats0). + rewrite get_oget//=;smt(all_prefixes_of_INV_real). qed. - local lemma lemma3' c c' m mi p q bl i sa sc lres: - INV_Real c c' m mi p q => + local lemma lemma4 c c' m mi p bl i sa sc: + INV_Real c c' m mi p => 0 < i => - q.[(bl,i)] = Some lres => p.[format bl i] = Some (sa,sc) => - (bl,i+1) \in dom q => - q.[(bl,i+1)] = Some (rcons lres (oget p.[format bl (i+1)]).`1). - proof. - move=>inv0 H_i0 H_q_i H_p_i H_dom_iS. - cut[]_[]_ hmp1 hmp2 hmp3 _ _:=inv0. - cut->:=lemma3 _ _ _ _ _ _ _ _ _ _ _ inv0 H_i0 H_q_i H_p_i H_dom_iS;congr;congr. - cut[]b3 c3[]:=hmp1 (format bl (i+1)) _ (size (format bl i)) _. - + rewrite in_dom;smt(). - + rewrite!size_cat!size_nseq;smt(size_ge0). - rewrite nth_cat nth_nseq;1:smt(size_cat size_nseq size_ge0). - cut->/=:!size (format bl i) < size bl by smt(size_cat size_nseq size_ge0). - rewrite Block.WRing.addr0 !take_format 1,3:/#;1,2:smt(size_cat size_nseq size_ge0). - cut->/=:!size (format bl i) + 1 <= size bl by smt(size_cat size_nseq size_ge0). - cut->:size (format bl i) + 1 - size bl = i by smt(size_cat size_nseq). - case(size (format bl i) <= size bl)=>//=Hi;last first. - + cut->:size (format bl i) - size bl + 1 = i by smt(size_cat size_nseq). - by rewrite H_p_i/==>[][]->>->>->//. - cut->>/=:i = 1 by smt(size_cat size_nseq). - by cut:=H_p_i;rewrite /(format bl 1)/=nseq0 cats0 take_size=>->/=[]->>->>->//. - qed. - - - local lemma lemma4 c c' m mi p q bl i sa sc lres: - INV_Real c c' m mi p q => - 0 < i => - q.[(bl,i)] = Some lres => - p.[format bl i] = Some (sa,sc) => - (bl,i+1) \in dom q => + format bl (i+1) \in dom p => p.[format bl (i+1)] = m.[(sa,sc)]. proof. - move=>inv0 H_i0 H_q_i H_p_i H_dom_iS. - cut[]_[]_ hmp1 hmp2 hmp3 _ _:=inv0. - cut[]c2 h2:=hmp3 _ _ H_dom_iS. - cut:=hmp1 (format bl (i+1));rewrite in_dom h2/==>help. + move=>inv0 H_i0 H_p_i H_dom_iS. + cut[]_[]_ hmp1 _ :=inv0. + cut:=hmp1 (format bl (i+1)) H_dom_iS=>help. cut:=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). cut->/=:!size (format bl i) + 1 <= size bl by smt(size_cat size_nseq size_ge0). @@ -712,88 +528,49 @@ section Real_Ideal. by rewrite size_cat size_nseq/#. pose x:=List.size _ + 1 - List.size _ + 1;cut->/={x}:x=i+1 by rewrite/x size_cat size_nseq;smt(). - rewrite H_p_i h2=>[]/=[][]->>->>. - rewrite Block.WRing.addr0=>H_pm;rewrite H_pm/=. - cut[]_[]_[]H_size H:=hmp2 _ _ H_dom_iS. - cut H_q_i':=H i _;1:smt(). - cut:=H (i+1) _;1:smt(). - by rewrite (take_nth witness)1:/# =>H_q_iS. + rewrite H_p_i=>[]/=[][]->>->>. + by rewrite Block.WRing.addr0=>H_pm;rewrite H_pm/=. qed. - - - local lemma lemma4' c c' m mi p q bl i sa sc lres: - INV_Real c c' m mi p q => - 0 < i => - q.[(bl,i)] = Some lres => - p.[format bl i] = Some (sa,sc) => - format bl (i+1) \in dom p => - p.[format bl (i+1)] = m.[(sa,sc)]. + local lemma lemma3 c1 c2 m mi p bl b (sa:block) sc: + INV_Real c1 c2 m mi p => + (sa +^ b,sc) \in dom m => + ! rcons bl b \in dom 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_i0 H_q_i H_p_i H_p_dom_iS. - cut[]_[]_ hmp1 hmp2 hmp3 hmp4 _:=inv0. - cut[]:=hmp4 _ H_p_dom_iS _. - + smt(size_ge0 size_eq0 size_cat valid_spec size_nseq). - move=>l;pose pn := parse (format bl (i + 1) ++ l). - cut->/=H_dom_iS:pn = (pn.`1,pn.`2) by smt(). - cut[]c2:=hmp3 _ _ H_dom_iS. - cut->/=:format pn.`1 pn.`2 = (format bl (i + 1) ++ l) by smt(parseK formatK). - move:H_dom_iS;cut->/={pn}H_dom_iS H_p_iS_l:(pn.`1, pn.`2) = parse (format bl (i + 1) ++ l) by smt(). - cut help:=hmp1 (format bl (i + 1) ++ l) _;1:by rewrite in_dom H_p_iS_l. - cut[]b3 c3:=help (size (format bl i)) _. - + smt(size_ge0 size_cat size_nseq). - rewrite take_cat take_format//=1:/#. - + smt(size_ge0 size_cat size_nseq). - cut->/=:size (format bl i) < size (format bl (i + 1)) by smt(size_cat size_nseq). - pose x:=if _ then _ else _;cut->/={x}:x = format bl i. - + rewrite/x;rewrite size_cat size_nseq max_ler 1:/#. - case(size bl + (i - 1) <= size bl)=>//=[h|/#]. - by cut->>/=:i=1;smt(take_size nseq0 cats0). - rewrite H_p_i/==>[][][]->>->>. - rewrite nth_cat/=. - cut->/=:size (format bl i) < size (format bl (i + 1)) by smt(size_cat size_nseq). - rewrite nth_cat. - cut->/=:!size (format bl i) < size bl by smt(size_cat size_nseq size_ge0). - rewrite nth_nseq 1:size_cat 1:size_nseq 1:/#. - rewrite take_cat. - cut->/=:size (format bl i) + 1 = size (format bl (i + 1)) by smt(size_cat size_nseq). - rewrite take0 cats0 Block.WRing.addr0 =>->//=. + move=>inv0 H_dom_m H_dom_p H_p_val. + split;cut[]//=_[] hmp0 hmp1 hinvm:=inv0;split=>//=. + + by rewrite getP;smt(size_cat size_nseq size_ge0). + + move=>l;rewrite dom_set in_fsetU1;case;1:smt(all_prefixes_of_INV_real getP). + move=>->>j[]hj0 hjsize;rewrite getP/=. + cut:=hmp1 bl;rewrite in_dom H_p_val/==>help. + cut->/=:!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 _;cut->/={x}: x = take j bl by smt(take_le0 cats0 take_size). + rewrite nth_cat. + case(j < size bl)=>//=hj;last first. + + cut->>/=:j = size bl by smt(). + by rewrite take_size H_p_val/=;exists sa sc=>//=;smt(getP get_oget). + cut->/=:j + 1 - size bl <= 0 by smt(). + rewrite cats0. + pose x := if _ then _ else _;cut->/={x}: x = take (j+1) bl by smt(take_le0 cats0 take_size). + cut:=hmp1 bl;rewrite in_dom H_p_val/==>hep. + cut:=hep j _;rewrite//=;smt(getP size_cat size_take). qed. - module QBlockSponge (P : DPRIMITIVE) : FUNCTIONALITY = { - proc init() = {} - proc f (p : block list, n : int) : block list = { - var r : block list <- []; - var i : int <- 0; - var (b,c) <- (b0,c0); - if (valid p /\ 0 < n) { - while (i < size p) { - (b,c) <@ P.f(b +^ nth witness p i, c); - i <- i + 1; - } - i <- 1; - r <- rcons r b; - while (i < n) { - (b,c) <@ P.f(b, c); - r <- rcons r b; - i <- i + 1; - } - } - return r; - } - }. - local lemma squeeze_squeezeless (D <: DISTINGUISHER {P, NC, Redo, C, SLCommon.C}) : - equiv [ NIndif(Squeeze(SqueezelessSponge(P)),P,DC(D)).main - ~ RealIndif(QBlockSponge,P,DRestr(D)).main + 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}]. proof. proc;inline*;sp;wp. call(: ={glob Perm,C.c} - /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} - NC.queries{1});auto;last first. - + progress. + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1});auto;last first. + + progress. split=>//=;1:split=>//=;smt(getP dom0 map0P in_fset0 dom_set in_fsetU1). + proc;inline*;auto;sp;if;auto;sp;if;auto;progress. - by rewrite INV_Real_addm_mi;2..:smt(supp_dexcepted);split;case:H=>//=;smt(). @@ -803,308 +580,242 @@ section Real_Ideal. * case:H;smt(invm_dom_rng invmC supp_dexcepted). case:H;smt(invm_dom_rng invmC supp_dexcepted). - by split;case:H=>//=;smt(). - proc;inline*;sp;auto;if;auto;if;auto;sp;if;auto; + proc;inline*;sp;auto;if;auto;sp;if;auto; last by progress;split;case:H=>//=;smt(size_ge0). - rcondt{1}1;auto;sp. - seq 1 3 : (={glob Perm, C.c, i, p, n, bl, nb} /\ nb{1} = n{1} - /\ (lres){1} = (r0){2} /\ bl{1} = p{2} - /\ NC.queries{1}.[(p{1},i{1})] = Some lres{1} - /\ valid p{1} /\ i{1} <= n{1} /\ i{1} = 1 - /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} - NC.queries{1}.[(p{1}, i{1}) <- lres{1}] - /\ Redo.prefixes{1}.[p{1}] = Some (b,c){2});last first. - + auto=>/=. - while(={glob Perm, C.c, i, p, n, bl, nb} /\ nb{1} = n{1} - /\ (lres){1} = (r0){2} /\ bl{1} = p{2} /\ 0 < i{2} <= n{1} - /\ valid p{1} - /\ NC.queries{1}.[(p{1},i{1})] = Some lres{1} - /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} - NC.queries{1} - /\ Redo.prefixes{1}.[format p{1} i{1}] = Some (b{2},c{2}));last first. - - auto;progress. - * cut:=H2;rewrite set_eq//=. - * by rewrite/format/=nseq0 cats0 H3//=. - sp;if{1};last first. - - rcondf{2}1;auto;progress. - * cut:=H3;rewrite in_dom=>inv0. - cut[]_[]_ hmp1 hmp2 hmp3 _ _:=inv0. - cut:=hmp1 (format p{hr} (i{hr}+1));rewrite in_dom//=. - cut[]c3 h3:=hmp3 _ _ H7;rewrite h3/= => help. - cut[]b4 c4:=help (size p{hr} + i{hr} - 1) _;1:smt(size_cat size_nseq size_ge0). - rewrite !take_format 1,3:/#;1,2:smt(size_cat size_nseq size_ge0). - rewrite nth_cat/=nth_nseq/=1:/# -(addzA _ (-1) 1)/=. - cut->/=:!size p{hr} + i{hr} <= size p{hr} by smt(). - cut->/=:!size p{hr} + i{hr} - 1 < size p{hr} by smt(). - pose x:=if _ then _ else _;cut->/={x}:x = format p{hr} i{hr}. - + rewrite/x;case(i{hr}=1)=>[->>|/#]//=. - by rewrite -(addzA _ 1 (-1))/= take_size/format/=nseq0 cats0. - by rewrite Block.WRing.addr0 (addzAC _ i{hr})/=H4/==>[][][]->>->>->;rewrite h3. - * cut:=H3;move=>inv0. - by cut->:=lemma3 _ _ _ _ _ _ _ _ _ _ _ inv0 H H2 H4 H7. - (* * cut:=H3;rewrite //==>inv0. *) - (* by cut->:=lemma3 _ _ _ _ _ _ _ _ _ _ _ inv0 H H2 H4 H7. *) - * smt(). - * smt(). - * smt(get_oget in_dom). - * cut:=H3;rewrite //==>inv0. - cut->:=lemma4 _ _ _ _ _ _ _ _ _ _ _ inv0 H H2 H4 H7;rewrite get_oget 2:/#. - cut[]_[]_ hmp1 hmp2 hmp3 _ _:=inv0. - cut:=hmp1 (format p{2} (i{2}+1));rewrite in_dom//=. - cut[]c3 h3:=hmp3 _ _ H7;rewrite h3/= => help. - cut[]b4 c4:=help (size p{2} + i{2} - 1) _;1:smt(size_cat size_nseq size_ge0). - rewrite !take_format 1,3:/#;1,2:smt(size_cat size_nseq size_ge0). - rewrite nth_cat/=nth_nseq/=1:/# -(addzA _ (-1) 1)/=. - cut->/=:!size p{2} + i{2} <= size p{2} by smt(). - cut->/=:!size p{2} + i{2} - 1 < size p{2} by smt(). - pose x:=if _ then _ else _;cut->/={x}:x = format p{2} i{2}. - + rewrite/x;case(i{2}=1)=>[->>|/#]//=. - by rewrite -(addzA _ 1 (-1))/= take_size/format/=nseq0 cats0. - by rewrite in_dom Block.WRing.addr0 (addzAC _ i{2})/=H4/==>[][][]->>->>->;rewrite h3. - swap{2}4-3;wp;sp=>/=. - splitwhile{1}1:i0 < size p0 - 1. - rcondt{1}2;2:rcondf{1}4;auto. - + while(0 <= i0 <= size p0 -1);last by auto;smt(size_cat size_nseq size_ge0). - if;auto;1:smt(size_cat size_nseq size_ge0). - by sp;if;auto;smt(size_cat size_nseq size_ge0). - + seq 1 : (i0 = size p0 - 1). - - while(0 <= i0 <= size p0 -1);last by auto;smt(size_cat size_nseq size_ge0). - if;auto;1:smt(size_cat size_nseq size_ge0). - by sp;if;auto;smt(size_cat size_nseq size_ge0). - by if;auto;1:smt();sp;if;auto;smt(). - seq 1 0 : (={glob P, C.c, i, p, n, bl, nb} - /\ nb{1} = n{1} /\ lres{1} = r0{2} /\ bl{1} = p{1} - /\ x0{2} = (sa,sc){1} /\ p0{1} = format p{1} i{1} - /\ i0{1} = size p{1} + i{1} - 2 /\ 1 < i{1} <= n{1} - /\ valid p{1} /\ 0 < n{1} - /\ ! ((p{1}, i{1}) \in dom NC.queries{1}) - /\ NC.queries{1}.[(p{1},i{1}-1)] = Some lres{1} - /\ Redo.prefixes{1}.[format p{1} (i{1}-1)] = Some (sa,sc){1} + 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//=. + cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{m} _;1:smt(size_take). + move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. + rewrite H1=>//=[][][]->>->>. + by rewrite nth_onth (onth_nth b0)//=;smt(in_dom). + + rewrite head_nth nth_drop//=. + cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). + move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. + rewrite H1=>//=[][][]->>->>. + by rewrite nth_onth (onth_nth b0)//=;smt(in_dom). + + rewrite head_nth nth_drop//=. + cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). + move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. + rewrite H1=>//=[][][]->>->>. + by rewrite nth_onth (onth_nth b0)//=;smt(in_dom). + + rewrite head_nth nth_drop//=. + cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). + move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. + rewrite H1=>//=[][][]->>->>. + by rewrite nth_onth (onth_nth b0)//=;smt(in_dom). + + rewrite head_nth nth_drop//=. + cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). + move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. + rewrite H1=>//=[][][]->>->>. + by rewrite nth_onth (onth_nth b0)//=;smt(in_dom). + + smt(). + + smt(). + + smt(get_oget). + + 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 getP/=. + + by rewrite behead_drop drop_add. + + rewrite!getP/=oget_some. + cut:=lemma3 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!dom_set!in_fsetU1/=-take_nth//=H5/=H1/=getP/=oget_some. + cut->->//=:(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 getP. + + by rewrite behead_drop drop_add. + + rewrite(take_nth witness)//=. + cut:=lemma3 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;cut[]_[]->:=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(). + by if;auto;1:smt();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} - NC.queries{1});last first. - + if{1}. - - wp;rcondf{2}1. - * auto;progress. - cut[]_[]_ hmp1 hmp2 hmp3 hmp4 _:=H6. - cut:=hmp4 _ H7 _. - + rewrite-size_eq0 size_take;1:smt(size_ge0). - by rewrite size_cat size_nseq;smt(valid_spec size_eq0 size_ge0). - move=>[]l;rewrite take_oversize;1:rewrite size_cat size_nseq/#. - move=>H_dom. - pose x:= (parse (format p{hr} i{hr} ++ l)).`1. - pose y:= (parse (format p{hr} i{hr} ++ l)).`2. - cut[]:=hmp3 x y _;1:smt();cut->/=:format x y = (format p{hr} i{hr} ++ l) by smt(formatK). - cut->/={x y}c H_dom_c:(x, y) = (parse (format p{hr} i{hr} ++ l)) by smt(). - cut help:=hmp1 (format p{hr} i{hr} ++ l) _;1:by rewrite in_dom H_dom_c. - cut:=help (size (format p{hr} i{hr})-1) _;1:split. - - smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). - - move=>_;rewrite !size_cat. - cut:size l <> 0;2:smt(size_ge0). - by rewrite size_eq0;smt(in_dom cats0 formatK parseK). - move=>[]b2 c2;rewrite take_cat nth_cat/=. - cut->/=:size (format p{hr} i{hr}) - 1 < size (format p{hr} i{hr}) by smt(). - rewrite nth_cat nth_nseq. - - smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). - cut->/=:!size (format p{hr} i{hr}) - 1 < size p{hr} - by smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). - rewrite take_format 1:/#. - - smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). - pose x:=if _ then _ else _;cut->/={x}:x = format p{hr} (i{hr}-1). - - rewrite /x;rewrite size_cat size_nseq/=/max/=. - cut->/=:0 < i{hr} - 1 by smt(). - case(size p{hr} + (i{hr} - 1) - 1 <= size p{hr})=>//=[h|/#]. - cut->>/=:i{hr}=2 by smt(). - smt(take_size nseq0 cats0). - rewrite H5=>//=[][][]->>->>;rewrite Block.WRing.addr0 take_cat. - rewrite-(addzA _ _ 1)//=take0 cats0=>h. - cut:=help (size (format p{hr} i{hr})) _. - - cut:size l <> 0;2:smt(size_ge0 size_cat). - by rewrite size_eq0;smt(in_dom cats0 formatK parseK). - by move=>[]b5 c5;rewrite take_cat take_size/=take0 cats0 in_dom h=>[][]->//=. - auto;progress. - * move:H7;rewrite take_oversize;1:rewrite size_cat size_nseq/#. - move=>H_dom. - cut:=lemma4' _ _ _ _ _ _ _ _ _ _ _ H6 _ H4 H5 _;1,2:smt(). - by rewrite-(addzA _ _ 1)/==>->//=. - (* * move:H7;rewrite take_oversize;1:rewrite size_cat size_nseq/#. *) - (* move=>H_dom. *) - (* cut:=lemma4' _ _ _ _ _ _ _ _ _ _ _ H6 _ H4 H5 _;1,2:smt(). *) - (* by rewrite-(addzA _ _ 1)/==>->//=. *) - * smt(). - * move:H7;rewrite take_oversize;1:rewrite size_cat size_nseq/#. - move=>H_dom. - cut:=lemma4' _ _ _ _ _ _ _ _ _ _ _ H6 _ H4 H5 _;1,2:smt(). - by rewrite-(addzA _ _ 1)/==>->//=;rewrite getP/=. - * move:H7;rewrite take_oversize;1:rewrite size_cat size_nseq/#. - cut H_i_size:i{2}-1 = size r0{2}. - + cut[]_[]_ hmp1 hmp2 hmp3 hmp4 _:=H6. - cut:=hmp2 p{2} (i{2}-1);rewrite in_dom H4/==>[][]_[]_[]. - by rewrite oget_some=>->/=/#. - move=>H_l;apply(lemma1 _ _ _ _ _ _ _ _ _ H6 H3 H1 _ _ _ _);1:smt(). - + by rewrite size_rcons-H_i_size;ring. - + by rewrite get_oget//last_rcons oget_some/#. - move=>j[]hj0 hji;rewrite -cats1 take_cat-H_i_size. - pose x:=if _ then _ else _;cut->/={x}:x = take j r0{2}. - - rewrite /x;case(j//=h;cut->>/=:j=i{2}-1 by smt(). - by rewrite H_i_size cats0 take_size. - cut[]_[]_ hmp1 hmp2 hmp3 hmp4 _:=H6. - by cut:=hmp2 p{2} (i{2}-1);rewrite in_dom H4//=oget_some/#. - move:H7;rewrite take_oversize;1:rewrite size_cat size_nseq/#. - move=>H_dom. - cut:=lemma4' _ _ _ _ _ _ _ _ _ _ _ H6 _ H4 H5 _;1,2:smt(). - by rewrite-(addzA _ _ 1)/==><-//=;smt(get_oget in_dom). - sp;wp;if;auto;progress. - - move:H8;rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). - rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). - by rewrite Block.WRing.addr0. - - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). - rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). - by rewrite Block.WRing.addr0. - - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). - rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). - by rewrite Block.WRing.addr0. - - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). - rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). - by rewrite Block.WRing.addr0. - - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). - rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). - by rewrite Block.WRing.addr0. - (* - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). *) - (* rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). *) - (* by rewrite Block.WRing.addr0. *) - - smt(). - - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). - rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). - by rewrite Block.WRing.addr0 getP/=. - - move:H7 H8;rewrite take_oversize;1:rewrite size_cat size_nseq/#. - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). - rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). - rewrite Block.WRing.addr0/==>H_dom h;rewrite getP/=oget_some. - cut//=:=lemma2 0 C.c{2}Perm.m{2}.[(sa_L, sc{1}) <- yL] - Perm.mi{2}.[yL <- (sa_L, sc{1})]Redo.prefixes{1} - NC.queries{1}p{2}i{2}sa_L sc{1} r0{2} _ _ _ _ _ _ _ _;rewrite//=. - * by apply INV_Real_addm_mi=>//=;1:smt(supp_dexcepted). - * by rewrite dom_set in_fsetU1. - by rewrite!getP/=oget_some/#. - - move:H8;rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). - rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). - by rewrite Block.WRing.addr0 !getP/=oget_some/=take_oversize//=size_cat size_nseq/#. - - move:H8;rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). - rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). - by rewrite Block.WRing.addr0. - (* - move:H8;rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). *) - (* rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). *) - (* by rewrite Block.WRing.addr0. *) - - smt(). - - move:H8;rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). - rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). - by rewrite Block.WRing.addr0 getP/=. - - move:H7 H8;rewrite take_oversize;1:rewrite size_cat size_nseq/#. - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). - rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). - rewrite Block.WRing.addr0/==>H_dom h. - by cut//=:=lemma2 0 C.c{2}Perm.m{2}Perm.mi{2}Redo.prefixes{1} - NC.queries{1}p{2}i{2}sa_L sc{1} r0{2} _ _ _ _ _ _ _ _;rewrite//=/#. - move:H8;rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). - rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). - by rewrite Block.WRing.addr0 getP/=take_oversize//=size_cat size_nseq/#. - alias{1} 1 pref = Redo.prefixes;sp. - conseq(:_==> ={glob P} /\ i0{1} = size p{1} + i{1} - 2 /\ Redo.prefixes{1} = pref{1} - /\ Redo.prefixes{1}.[take i0{1} (format p{1} (i{1} - 1))] = Some (sa{1}, sc{1}));progress. - + by cut:=H8;rewrite take_oversize 2:-(addzA _ 1)/=2:H4//=size_cat size_nseq;smt(). - + by cut:=H8;rewrite take_oversize 2:-(addzA _ 1)/=2:H4//=size_cat size_nseq;smt(). + /\ valid p{1});last first. + + if{1};auto. + + rcondf{2}1;auto;progress. + + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq max_ler/#. + move=>H_dom;rewrite in_dom. + by cut<-:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;rewrite-in_dom. + + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq max_ler/#;move=>H_dom. + by cut:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;smt(in_dom). + + smt(). + + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq max_ler/#;move=>H_dom. + by cut:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;smt(in_dom). + sp;if;auto;progress. + + move:H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). + cut->/=:!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). + cut->/=:!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). + cut->/=:!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). + cut->/=:!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). + cut->/=:!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). + cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). + rewrite Block.WRing.addr0 !getP/=oget_some take_oversize;1:rewrite size_cat size_nseq/#. + move=>H_dom_iS H_dom_p. + cut:=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 dom_set in_fsetU1. + by rewrite!getP/=oget_some-(addzA)/=H2/=;smt(). + + by rewrite!getP/=take_oversize//=size_cat size_nseq/#. + + rewrite nth_cat;cut->/=:! 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;cut->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). + rewrite nth_nseq//=1:/# Block.WRing.addr0 =>h1 h2. + by cut:=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;cut->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). + by rewrite nth_nseq//=1:/# Block.WRing.addr0 !getP//=. + 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 _ ;cut->/={x}: x = format p{1} (i_R+1). + + rewrite/x size_cat size_nseq-(addzA _ 1 (-1))/=!max_ler 1:/#-(addzA _ _ (-1))-(addzA _ _ (-1))/=. + case(size p{1} + i_R <= size p{1})=>//=h;2:smt(size_ge0 size_cat size_nseq). + cut->>/=: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 _ ;cut->/={x}: x = format p{1} (i_R+1). + + rewrite/x size_cat size_nseq-(addzA _ 1 (-1))/=!max_ler 1:/#-(addzA _ _ (-1))-(addzA _ _ (-1))/=. + case(size p{1} + i_R <= size p{1})=>//=h;2:smt(size_ge0 size_cat size_nseq). + cut->>/=: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 dom 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(). - + smt(dom_set in_fsetU1). - + by cut:=H8;rewrite take_oversize 2:-(addzA _ 1)//=size_cat size_nseq;smt(). - while{1}( ={glob P} /\ 0 <= i0{1} <= size p{1} + i{1} - 2 - /\ 1 < i{1} <= n{1} - /\ Redo.prefixes{1} = pref{1} /\ p0{1} = format p{1} i{1} - /\ format p{1} (i{1}-1) \in dom Redo.prefixes{1} - /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1} - /\ Redo.prefixes{1}.[take i0{1} (format p{1} (i{1} - 1))] = - Some (sa{1}, sc{1}))(size p0{1} - 1 - i0{1});auto;last first. - + auto;progress. - + smt(size_ge0). - + smt(in_dom). - + smt(). - + smt(in_dom). - + cut[]_[]:=H3;smt(take0 in_dom). - + smt(). - + smt(size_cat size_nseq). - rcondt 1;auto;progress. - + cut->:take (i0{hr} + 1) (format p{hr} i{hr}) = - take (i0{hr} + 1) (format p{hr} (i{hr}-1)); - last by smt(in_dom all_prefixes_of_INV_real). - by rewrite!take_format//= 1,3:/#;1,2:smt(size_cat size_nseq). + + by rewrite in_dom H3. + + by rewrite take0;cut[]_[]:=H1. + smt(). - + smt(size_cat size_nseq). - + cut->:take (i0{hr} + 1) (format p{hr} i{hr}) = - take (i0{hr} + 1) (format p{hr} (i{hr}-1)); - last by smt(in_dom all_prefixes_of_INV_real). - by rewrite!take_format//= 1,3:/#;1,2:smt(size_cat size_nseq). - smt(). - - if{1};last first. - + wp=>//=. - conseq(:_==> ={glob P} /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} - Redo.prefixes{1} NC.queries{1} - /\ i{2} = size p{2} - /\ Redo.prefixes{1}.[take i{2} p{2}] = Some (b,c){2} - /\ (0 < i{2} => Perm.m.[x]{2} = Some (b,c){2}));progress. - - cut[]_[]_ hmp1 hmp2 hmp3 hmp4 _:=H5. - cut/=[]_[]H_size H':=hmp2 _ _ H4. - cut/=[]c3:=hmp3 _ _ H4;rewrite/format/=nseq0 cats0-{1}take_size H6/==>[][]H_b ->>//=. - rewrite get_oget//=;apply (eq_from_nth b0)=>//=i. - rewrite H_size=>h;cut->>/=:i = 0 by smt(). - cut->:0 = size (oget NC.queries{1}.[(bl{2}, 1)]) - 1 by rewrite H_size. - by rewrite nth_last H_b. - (* - cut[]_[]_ hmp1 hmp2 hmp3 hmp4 _:=H5. *) - (* cut/=[]_[]H_size H':=hmp2 _ _ H4. *) - (* cut/=[]c3:=hmp3 _ _ H4;rewrite/format/=nseq0 cats0-{1}take_size H6/==>[][]H_b ->>//=. *) - (* rewrite get_oget//=;apply (eq_from_nth b0)=>//=i. *) - (* rewrite H_size=>h;cut->>/=:i = 0 by smt(). *) - (* cut->:0 = size (oget NC.queries{2}.[(bl{2}, 1)]) - 1 by rewrite H_size. *) - (* by rewrite nth_last H_b. *) - - smt(get_oget in_dom). - - smt(). - - smt(set_eq get_oget in_dom). - - smt(take_size). - while{2}(={glob P} /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} - Redo.prefixes{1} NC.queries{1} - /\ 0 <= i{2} <= size p{2} - /\ ((p{2}, 1) \in dom NC.queries{1}) - /\ Redo.prefixes{1}.[take i{2} p{2}] = Some (b,c){2} - /\ (0 < i{2} => Perm.m.[x]{2} = Some (b,c){2}))(size p{2}-i{2}); - progress;last first. - - auto;progress. - * split;case:H=>//=;smt(size_ge0 size_eq0 valid_spec). - * exact size_ge0. - * by rewrite take0;cut[]_[]->//:=H. - * smt(). - * smt(). - sp;rcondf 1;auto;progress. - - cut[]_[]_ hmp1 hmp2 hmp3 _ _:=H. - cut[]c3:=hmp3 p{hr} 1 H2;rewrite/(format _ 1)/=nseq0 cats0=> H_pref. - cut:=hmp1 p{hr};rewrite 2!in_dom H_pref/==>help. - by cut[]b4 c4 []:=help i{hr} _;1:smt();rewrite H3/==>[][]->>->>->; - smt(in_dom all_prefixes_of_INV_real). - - smt(). - - smt(). - - cut[]_[]_ hmp1 hmp2 hmp3 _ _:=H. - cut[]c3:=hmp3 p{hr} 1 H2;rewrite/(format _ 1)/=nseq0 cats0=> H_pref. - cut:=hmp1 p{hr};rewrite in_dom H_pref/==>help. - by cut[]b4 c4 []:=help i{hr} _;1:smt();rewrite H3/==>[][]->>->>->; - smt(in_dom all_prefixes_of_INV_real get_oget). - - cut[]_[]_ hmp1 hmp2 hmp3 _ _:=H. - cut[]c3:=hmp3 p{hr} 1 H2;rewrite/(format _ 1)/=nseq0 cats0=> H_pref. - cut:=hmp1 p{hr};rewrite in_dom H_pref/==>help. - by cut[]b4 c4 []:=help i{hr} _;1:smt();rewrite H3/==>[][]->>->>->; - smt(in_dom all_prefixes_of_INV_real get_oget). - - smt(). - sp;wp. - (* TODO *) + + smt(). + rcondt 1;auto;progress. + + cut->: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 in_dom). + 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). + + cut->: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 in_dom). + rewrite!take_format;smt(valid_spec size_ge0 size_eq0 size_cat size_nseq). + smt(). qed. + + + local lemma pr_real (D <: DISTINGUISHER{SLCommon.C, C, Perm, Redo}) &m : + Pr [ GReal(A(D)).main() @ &m : res ] = + Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res ]. + proof. + cut->:Pr [ RealIndif(Sponge, P, DRestr(D)).main() @ &m : res ] = + Pr [ NIndif(Squeeze(SqueezelessSponge(P)),P,DRestr(D)).main() @ &m : res ]. + + by rewrite eq_sym;byequiv (squeeze_squeezeless D)=>//=. + by byequiv (equiv_sponge D)=>//=. + qed. + + (* TODO : Ideal *) local lemma equiv_ideal (IF <: FUNCTIONALITY{DSqueeze,C}) @@ -1263,4 +974,4 @@ search max_size. apply (eq_trans _ Pr[G4(F.LRO).distinguish() @ &m : res]);1:by byequiv (F.RO_LRO_D G4). by byequiv G4_Ideal. qed. - + From 849f0e81752fa0fdc33eba05be93f771cb3baaee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 26 Apr 2018 17:06:38 +0200 Subject: [PATCH 279/394] Ideal : Step 1 : todo, step 2 : 70%, step 3 : todo --- sha3/proof/smart_counter/Gconcl_list.ec | 364 ++++++++++++++++++++++-- 1 file changed, 338 insertions(+), 26 deletions(-) diff --git a/sha3/proof/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec index a0de715..aaae1e9 100644 --- a/sha3/proof/smart_counter/Gconcl_list.ec +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -1,19 +1,16 @@ pragma -oldip. require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. -require import DProd Dexcepted BlockSponge. +require import DProd Dexcepted BlockSponge Gconcl. (*...*) import Capacity 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 <> []. - clone export Handle as Handle0. module DSqueeze (F : SLCommon.DFUNCTIONALITY) = { @@ -74,7 +71,6 @@ module NIndif (F : FUNCTIONALITY, P : PRIMITIVE, D : DISTINGUISHER) = { module P = Perm. - section Real_Ideal. @@ -210,24 +206,38 @@ section Real_Ideal. 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}]. + : ={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} /\ + 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. - + by progress;1:(split=>//=;1:split;smt(dom0 in_fset0 dom_set in_fsetU1 getP map0P));case:H0=>//=. + + progress. + + exact max_ge0. + + by split=>//=;1:split;smt(dom0 in_fset0 dom_set in_fsetU1 getP map0P). + 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:H=>H_c H_m_p H_invm;rewrite (invm_dom_rng _ _ H_invm)//=. - by move:H2;rewrite supp_dexcepted. - case:H=>H_c H_m_p H_invm;cut<-//:=(invm_dom_rng Perm.mi{2} Perm.m{2}). + + 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;cut<-//:=(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:H=>//=;smt(size_ge0). + 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}) @@ -565,23 +575,34 @@ section Real_Ideal. 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}]. + : ={glob D} ==> ={res, glob P, glob D, C.c} /\ C.c{1} <= max_size]. proof. proc;inline*;sp;wp. - call(: ={glob Perm,C.c} + 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. + + progress. + + exact max_ge0. split=>//=;1:split=>//=;smt(getP dom0 map0P in_fset0 dom_set in_fsetU1). + proc;inline*;auto;sp;if;auto;sp;if;auto;progress. - - by rewrite INV_Real_addm_mi;2..:smt(supp_dexcepted);split;case:H=>//=;smt(). - - by split;case:H=>//=;smt(). + - 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:H=>//=;smt(). - * case:H;smt(invm_dom_rng invmC supp_dexcepted). - case:H;smt(invm_dom_rng invmC supp_dexcepted). - - by split;case:H=>//=;smt(). + - 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:H=>//=;smt(size_ge0). + 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} @@ -805,14 +826,305 @@ section Real_Ideal. qed. + local lemma pr_real (D <: DISTINGUISHER{SLCommon.C, C, Perm, Redo}) &m : - Pr [ GReal(A(D)).main() @ &m : res ] = - Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res ]. + Pr [ GReal(A(D)).main() @ &m : res /\ SLCommon.C.c <= max_size] <= + Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res]. proof. cut->:Pr [ RealIndif(Sponge, P, DRestr(D)).main() @ &m : res ] = - Pr [ NIndif(Squeeze(SqueezelessSponge(P)),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)=>//=. - by byequiv (equiv_sponge D)=>//=. + byequiv (equiv_sponge D)=>//=;progress. + qed. + + + print Real_Ideal. + + print SLCommon.SIMULATOR. + + print Last. + + module SimLast (S : SLCommon.SIMULATOR) (F : DFUNCTIONALITY) = S(Last(F)). + + op (<=) (m1 m2 : (block list, 'b) fmap) = + forall x, x <> [] => x \in dom 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 dom m2 => + m1 <= m2.[x <- y]. + proof. + move=>h_leq H_n_dom a H_a_dom;rewrite getP/=;smt(in_dom). + qed. + + + local lemma leq_add_in (m1 m2 : (block list, 'b) fmap) (x : block list) : + m1 <= m2 => + x \in dom m2 => + m1.[x <- oget m2.[x]] <= m2. + proof. + move=>h_leq H_n_dom a H_a_dom;rewrite getP/=;smt(in_dom getP). + qed. + + local lemma leq_nin_dom (m1 m2 : (block list, 'b) fmap) (x : block list) : + m1 <= m2 => + x <> [] => + ! x \in dom m2 => ! x \in dom m1 by smt(in_dom). + + local lemma prefixe_leq1 (l : block list) (m : (block list,block) fmap) i : + 0 <= i => + format l (i+1) \in dom m => + size (format l (i+1)) <= prefixe (format l (i+1+1)) + (get_max_prefixe (format l (i+1+1)) (elems (dom m))) <= size (format l (i+1+1)). + proof. + rewrite memE;move=>hi0 H_dom. + cut->:(format l (i + 1 + 1)) = format l (i + 1) ++ [b0]. + + by rewrite/format/=-2!(addzA _ 1 (-1))//=nseqSr//-cats1 catA. + cut:=prefixe_leq_prefixe_cat_size (format l (i + 1))[b0](elems (dom m)). + rewrite (prefixe_get_max_prefixe_eq_size _ _ H_dom)//=. + rewrite (size_cat _ [b0])/=;pose x:= format _ _. + cut:=get_max_prefixe_max (x ++ [b0]) _ _ H_dom. + cut->:prefixe (x ++ [b0]) (format l (i + 1)) = size x + by rewrite prefixeC-{1}(cats0 (format l (i+1)))/x prefixe_cat//=. + smt(prefixe_sizel size_cat prefixe_ge0 ). + qed. + + local lemma prefixe_le1 (l : block list) (m : (block list,block) fmap) i : + 0 <= i => + format l (i+1) \in dom m => + size (format l (i+1+1)) - prefixe (format l (i+1+1)) + (get_max_prefixe (format l (i+1+1)) (elems (dom m))) <= 1. + proof. + smt(prefixe_leq1 size_ge0 size_cat size_nseq). + qed. + + local lemma leq_add2 (m1 m2 : (block list, 'b) fmap) (x : block list) (y : 'b) : + m1 <= m2 => + ! x \in dom m2 => + m1.[x <- y] <= m2.[x <- y] by smt(in_dom getP dom_set in_fsetU1). + + + local equiv ideal_equiv (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, 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 getP/=dom_set in_fsetU1 dom0 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(prefixe_ge0 leq_add_in DBlock.dunifin_ll in_dom size_ge0 getP 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 dom F.RO.m){2});last first. + * rcondt{2}2;1:auto;rcondt{1}1;1:(auto;smt(leq_nin_dom size_cat size_eq0 size_nseq valid_spec)). + rcondt{1}1;1:auto;1:smt(prefixe_le1 in_dom size_cat size_nseq). + sp;rcondt{1}2;auto;progress. + - smt(). + - smt(). + - by rewrite!getP/=. + - smt(prefixe_le1 in_dom). + - by rewrite!getP/=oget_some leq_add2//=. + if{1}. + * rcondt{1}1;1:auto;1:smt(prefixe_le1 in_dom size_cat size_nseq). + sp;rcondf{1}2;2:rcondf{2}2;auto;progress. + - smt(). + - smt(). + - by rewrite!getP/=. + - smt(prefixe_ge0 prefixe_le1 in_dom). + - smt(leq_add_in in_dom). + rcondf{2}2;auto;progress. + - smt(DBlock.dunifin_ll). + - smt(). + - smt(). + - smt(). + - smt(set_eq in_dom). + - 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 dom F.RO.m{2}). + + rcondf{2}2;1:auto. + sp;if{1}. + - rcondt{1}1;1:auto;1:smt(prefixe_ge0). + sp;rcondf{1}2;auto;progress. + * by rewrite!getP/=. + * smt(prefixe_ge0). + * smt(leq_add_in in_dom). + auto;progress. + - exact DBlock.dunifin_ll. + - smt(in_dom). + - smt(in_dom get_oget). + - smt(size_ge0). + rcondt{1}1;1:auto;1:smt(leq_nin_dom in_dom). + rcondt{1}1;1:auto;1:smt(prefixe_ge0). + sp;auto;progress. + + by rewrite!getP/=. + + smt(prefixe_ge0). + + rewrite getP/=oget_some leq_add2//=. + + by rewrite!getP/=. + + smt(prefixe_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; + if (valid p) { + while (i < n) { + i <- i + 1; + F.sample(format p i); + } + b <@ F.get(x); + } + return b; + } + }. + + + local module SampleFirst (I : BIRO.IRO) = { + proc init = I.init + proc f (m : block list, k : int) = { + var r : block list <- []; + if (k <= 0) { + I.f(m,1); + } else { + r <- I.f(m,k); + } + return r; + } + }. + + + axiom valid_gt0 x : valid (parse x).`1 => 0 < (parse x).`2. + axiom valid_uniq p1 p2 n1 n2 : + valid p1 => valid p2 => format p1 n1 = format p2 n2 => p1 = p2 /\ n1 = n2. + + op inv_map (m1 : (block list, block) fmap) (m2 : (block list * int, block) fmap) = + (forall p n, valid p => (p,n) \in dom m2 <=> format p (n+1) \in dom m1) + /\ (forall x, x \in dom m1 <=> ((parse x).`1,(parse x).`2-1) \in dom m2) + /\ (forall p n, valid p => m2.[(p,n-1)] = m1.[format p n]) + /\ (forall x, m1.[x] = m2.[((parse x).`1,(parse x).`2-1)]). + +print BIRO. + + local equiv Ideal_equiv (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : + SLCommon.IdealIndif(IF'(F.RO), S, A(D)).main + ~ + IdealIndif(SampleFirst(BIRO.IRO), SimLast(S), DRestr(D)).main + : + ={glob D} ==> ={glob D, res}. + proof. + proc;inline*;auto;sp. + call(: ={glob S, glob C} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});auto;last first. + + smt(dom0 in_fset0 map0P). + + proc;inline*;auto;sp;if;1,3:auto;sp;if;1,3:auto;if;1,3:auto;sp. + if{1};last by auto;if{2};auto;sp;rcondf{2}1;auto;smt(). + rcondf{2}1;1:auto;1:smt(parse_valid valid_gt0). + sp;rcondt{2}1;1:auto=>/#. + seq 8 6 : (={x,y,glob S,C.c} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2}); + last by conseq(:_==> ={z,glob S,C.c});progress;sim;progress. + wp;rnd;auto=>//=;rcondt{1}1;2:rcondt{2}1;1,2:by auto;smt(valid_gt0). + sp;conseq(:_==> (x0{1} \in dom F.RO.m{1}) + /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} + /\ oget F.RO.m.[x0]{1} = last b0 bs0{2}); + 1:smt(DBlock.dunifin_ll getP dom_set in_fsetU1). + conseq(:_==> format p0{1} i{1} \in dom F.RO.m{1} + /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} + /\ i{1} = n{1} + /\ oget F.RO.m.[format p0{1} i{1}]{1} = last b0 bs0{2});1:smt(). + while((i,n){1} = (i0,n0){2} /\ x1{2} = p0{1} /\ valid p0{1} + /\ format p0{1} i{1} \in dom F.RO.m{1} + /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} /\ 0 < i{1} <= n{1} + /\ oget F.RO.m.[format p0{1} i{1}]{1} = last b0 bs0{2});progress. + - sp;if{2}. + * rcondt{1}2;1:auto=>/#;wp;rnd;skip;smt(dom_set in_fsetU1 valid_uniq + formatK parseK getP in_dom last_rcons). + by rcondf{1}2;auto;smt(dom_set in_fsetU1 valid_uniq formatK parseK getP + in_dom DBlock.dunifin_ll last_rcons). + sp;if{2}. + - rcondt{1}2;1:auto=>/#;wp;rnd;skip;smt(dom_set in_fsetU1 valid_uniq + formatK parseK getP in_dom last_rcons valid_gt0). + by rcondf{1}2;auto;smt(dom_set in_fsetU1 valid_uniq formatK parseK getP + in_dom DBlock.dunifin_ll last_rcons valid_gt0). + + by proc;inline*;auto;sp;if;auto;sp;if;auto. + proc;inline*;auto;sp;if;auto;sp. + if{2};sp. + + if;auto;sp;rcondt{1}1;1:auto;1:smt(parse_valid). + rcondt{1}1;auto;1:smt(parse_valid);sp. + rcondf{1}3;auto;1:smt(parse_valid);sp. + rcondf{1}5;auto;1:smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). + rcondt{2}1;auto;rcondf{2}7;1:by auto;sp;if;auto. + swap{1}4 3;auto;conseq(:_==> lres{1} = bs{2} /\ ={S.paths, S.mi, S.m} + /\ ={C.c} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});1:smt(DBlock.dunifin_ll). + rcondf{1}6;1:auto;1:smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). + sp;if{2}. + - by rcondt{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK + parseK getP in_dom DBlock.dunifin_ll last_rcons). + rcondf{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK parseK + getP in_dom DBlock.dunifin_ll last_rcons). + if;auto;sp;rcondt{1}1;auto;1:smt(parse_valid). + rcondt{1}1;auto;1:smt(parse_valid);sp. + rcondf{1}3;auto;1:smt(parse_valid). + rcondf{1}5;auto;1:smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). + swap{1}4 3;auto;conseq(:_==> lres{1} = bs0{2} /\ ={S.paths, S.mi, S.m} + /\ ={C.c} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});1:smt(DBlock.dunifin_ll). + rcondt{1}6;1:auto=>/#. + rcondt{2}1;1:auto=>/#. + (* TODO *) + + rcondt{2}1;auto;rcondf{2}7;1:by auto;sp;if;auto. + rcondf{1}7;auto. + + while + + qed. (* TODO : Ideal *) From f392ea7b9aa1b72876da05186161e446c05fa202 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Wed, 23 May 2018 16:18:46 +0200 Subject: [PATCH 280/394] increase timeout for CI --- sha3/config/tests.config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/config/tests.config b/sha3/config/tests.config index 9a3096e..501321f 100644 --- a/sha3/config/tests.config +++ b/sha3/config/tests.config @@ -1,6 +1,6 @@ [default] bin = easycrypt -args = -I proof -I proof/variant -I proof/core +args = -I proof -I proof/variant -I proof/core -timeout 180 [test-sha3] okdirs = !proof From 14fc877a8acc9169dac22f839e922edace7edf64 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Fri, 27 Apr 2018 18:48:08 +0200 Subject: [PATCH 281/394] GIdeal : step 1 : todo (easy), step 2,3 : done, step 4 : problem to solve --- sha3/proof/smart_counter/Gconcl_list.ec | 1187 +++++++++++++---------- 1 file changed, 657 insertions(+), 530 deletions(-) diff --git a/sha3/proof/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec index aaae1e9..c4be026 100644 --- a/sha3/proof/smart_counter/Gconcl_list.ec +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -74,227 +74,605 @@ module P = Perm. section Real_Ideal. - - pred inv_ideal (squeeze : (block list * int, block list) fmap) - (c : (block list, block) fmap) = - (forall p n, (p,n) \in dom squeeze => - forall i, 1 <= i <= n => (p,i) = parse (format p i)) /\ - (forall p n, (p,n) \in dom squeeze => - forall i, 1 <= i <= n => format p i \in dom c) /\ - (forall l, l \in dom c => - forall i, 1 <= i <= (parse l).`2 => ((parse l).`1,i) \in dom squeeze). - - - inductive m_p (m : (state, state) fmap) (p : (block list, state) fmap) = - | IND_M_P of (p.[[]] = Some (b0, c0)) - & (forall l, l \in dom 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). + module SimLast (S : SLCommon.SIMULATOR) (F : DFUNCTIONALITY) = S(Last(F)). - 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. + op (<=) (m1 m2 : (block list, 'b) fmap) = + forall x, x <> [] => x \in dom m1 => m1.[x] = m2.[x]. - local lemma INV_Real_addm_mi c1 c2 m mi p x y : - INV_Real c1 c2 m mi p => - ! x \in dom m => - ! y \in rng m => - INV_Real c1 c2 m.[x <- y] mi.[y <- x] p. + local lemma leq_add_nin (m1 m2 : (block list, 'b) fmap) (x : block list) (y : 'b): + m1 <= m2 => + ! x \in dom m2 => + m1 <= m2.[x <- y]. proof. - case=> H_c1c2 H_m_p H_invm H_x_dom H_y_rng;split=>//=. - + split;case:H_m_p=>//=; - smt(getP in_dom oget_some take_oversize size_take take_take). - exact invm_set. + move=>h_leq H_n_dom a H_a_dom;rewrite getP/=;smt(in_dom). 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. by move=>h;rewrite fsetP=>x;split;rewrite in_dom in_rng/#. qed. - local lemma all_prefixes_of_INV_real c1 c2 m mi p: - INV_Real c1 c2 m mi p => - all_prefixes p. + local lemma leq_add_in (m1 m2 : (block list, 'b) fmap) (x : block list) : + m1 <= m2 => + x \in dom m2 => + m1.[x <- oget m2.[x]] <= m2. proof. - move=>[]_[]Hp0 Hmp1 _ l H_dom i. - smt(take_le0 take_oversize size_take take_take take_size nth_take in_dom). + move=>h_leq H_n_dom a H_a_dom;rewrite getP/=;smt(in_dom getP). 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 dom m => - ! (format bl i) \in dom 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;cut[]//=_[] hmp0 hmp1 hinvm:=inv0;split=>//=. - + by rewrite getP;smt(size_cat size_nseq size_ge0). - + move=>l;rewrite dom_set in_fsetU1;case;1:smt(all_prefixes_of_INV_real getP). - move=>->>j[]hj0 hjsize;rewrite getP/=. - cut:=hmp1 (format bl (i - 1));rewrite in_dom H_p_val/==>help. - cut:=hjsize;rewrite !size_cat !size_nseq/=!max_ler 1:/#=>hjsizei. - cut->/=:!take j (format bl i) = format bl i by smt(size_take). - cut 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!max_ler/#. - rewrite!size_take//=1:/#!size_nseq!max_ler 1:/#. - pose o:=if _ then _ else _;cut->/={o}:o = k - size bl by smt(). - by progress;rewrite!nth_take//= 1,2:/# !nth_nseq//=/#. - case(j < size bl + i - 2)=>hj. - - cut:=help j _;1:smt(size_cat size_nseq). - move=>[]b c[]. - cut->: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'/=getP/=. - smt(size_take size_cat size_nseq). - cut->>/=:j = size (format bl (i-1)) by smt(size_cat size_nseq). - rewrite getP/=. - cut h':size (format bl (i-1)) = size bl + i - 2 by smt(size_cat size_nseq). - rewrite h'/=-(addzA _ _ 1)/=. - cut 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';cut->/=:! size bl + i - 2 < size bl by smt(). - by rewrite nth_nseq 1:/#;smt(Block.WRing.AddMonoid.addm0 in_dom get_oget). - qed. + local lemma leq_nin_dom (m1 m2 : (block list, 'b) fmap) (x : block list) : + m1 <= m2 => + x <> [] => + ! x \in dom m2 => ! x \in dom m1 by smt(in_dom). - 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). + local lemma prefixe_leq1 (l : block list) (m : (block list,block) fmap) i : + 0 <= i => + format l (i+1) \in dom m => + size (format l (i+1)) <= prefixe (format l (i+1+1)) + (get_max_prefixe (format l (i+1+1)) (elems (dom m))) <= size (format l (i+1+1)). + proof. + rewrite memE;move=>hi0 H_dom. + cut->:(format l (i + 1 + 1)) = format l (i + 1) ++ [b0]. + + by rewrite/format/=-2!(addzA _ 1 (-1))//=nseqSr//-cats1 catA. + cut:=prefixe_leq_prefixe_cat_size (format l (i + 1))[b0](elems (dom m)). + rewrite (prefixe_get_max_prefixe_eq_size _ _ H_dom)//=. + rewrite (size_cat _ [b0])/=;pose x:= format _ _. + cut:=get_max_prefixe_max (x ++ [b0]) _ _ H_dom. + cut->:prefixe (x ++ [b0]) (format l (i + 1)) = size x + by rewrite prefixeC-{1}(cats0 (format l (i+1)))/x prefixe_cat//=. + smt(prefixe_sizel size_cat prefixe_ge0 ). 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']. - cut->/=:i - size bl <= n - 1 by smt(). - case(i = size bl)=>[->>|H_isize'']//=;1:by rewrite nseq0 take_size cats0. - smt(). + local lemma prefixe_le1 (l : block list) (m : (block list,block) fmap) i : + 0 <= i => + format l (i+1) \in dom m => + size (format l (i+1+1)) - prefixe (format l (i+1+1)) + (get_max_prefixe (format l (i+1+1)) (elems (dom m))) <= 1. + proof. + smt(prefixe_leq1 size_ge0 size_cat size_nseq). qed. + local lemma leq_add2 (m1 m2 : (block list, 'b) fmap) (x : block list) (y : 'b) : + m1 <= m2 => + ! x \in dom m2 => + m1.[x <- y] <= m2.[x <- y] by smt(in_dom getP dom_set in_fsetU1). - 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]. + + local equiv ideal_equiv (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, 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*;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(dom0 in_fset0 dom_set in_fsetU1 getP map0P). - 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;cut<-//:=(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 dom Redo.prefixes{1} => - l \in dom pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) - /\ (forall l, l \in dom 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. - - cut inv0:=H3;cut[]h_c1c2[]Hmp0 Hmp1 Hinvm:=inv0;split=>//=. - - case:inv0;smt(size_ge0). - split=>//=. - - smt(in_dom). - - move=>l H_dom_R i []Hi0 Hisize;cut:=H4 l H_dom_R. - case(l \in dom Redo.prefixes{2})=>H_in_pref//=. - * cut:=Hmp1 l H_in_pref i _;rewrite//=. - rewrite ?H5//=;1:smt(in_dom). - case(i+1 < size l)=>h;1:smt(in_dom). - by rewrite take_oversize 1:/#. - move=>[]j[][]hj0 hjsize ->>. - cut:=Hisize;rewrite size_take 1:/#. - pose k:=if _ then _ else _;cut->>Hij{k}:k=j by rewrite/#. - by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#;smt(in_dom). - - smt(getP oget_some in_dom 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 dom Redo.prefixes{1} => - l \in dom pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) - /\ (forall l, l \in dom 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 dom 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;cut[]_[]->//=:=H. - - smt(). - - by cut[]->//=:=H. + 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 getP/=dom_set in_fsetU1 dom0 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(prefixe_ge0 leq_add_in DBlock.dunifin_ll in_dom size_ge0 getP 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 dom F.RO.m){2});last first. + * rcondt{2}2;1:auto;rcondt{1}1;1:(auto;smt(leq_nin_dom size_cat size_eq0 size_nseq valid_spec)). + rcondt{1}1;1:auto;1:smt(prefixe_le1 in_dom size_cat size_nseq). + sp;rcondt{1}2;auto;progress. + - smt(). + - smt(). + - by rewrite!getP/=. + - smt(prefixe_le1 in_dom). + - by rewrite!getP/=oget_some leq_add2//=. + if{1}. + * rcondt{1}1;1:auto;1:smt(prefixe_le1 in_dom size_cat size_nseq). + sp;rcondf{1}2;2:rcondf{2}2;auto;progress. + - smt(). + - smt(). + - by rewrite!getP/=. + - smt(prefixe_ge0 prefixe_le1 in_dom). + - smt(leq_add_in in_dom). + rcondf{2}2;auto;progress. + - smt(DBlock.dunifin_ll). + - smt(). + - smt(). + - smt(). + - smt(set_eq in_dom). + - 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 dom F.RO.m{2}). + + rcondf{2}2;1:auto. + sp;if{1}. + - rcondt{1}1;1:auto;1:smt(prefixe_ge0). + sp;rcondf{1}2;auto;progress. + * by rewrite!getP/=. + * smt(prefixe_ge0). + * smt(leq_add_in in_dom). + auto;progress. + - exact DBlock.dunifin_ll. + - smt(in_dom). + - smt(in_dom get_oget). + - smt(size_ge0). + rcondt{1}1;1:auto;1:smt(leq_nin_dom in_dom). + rcondt{1}1;1:auto;1:smt(prefixe_ge0). + sp;auto;progress. + + by rewrite!getP/=. + + smt(prefixe_ge0). + + rewrite getP/=oget_some leq_add2//=. + + by rewrite!getP/=. + + smt(prefixe_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; + if (valid p) { + while (i < n) { + i <- i + 1; + F.sample(format p i); + } + b <@ F.get(x); + } + return b; + } + }. + + + local module SampleFirst (I : BIRO.IRO) = { + proc init = I.init + proc f (m : block list, k : int) = { + var r : block list <- []; + if (k <= 0) { + I.f(m,1); + } else { + r <- I.f(m,k); + } + return r; + } + }. + + + axiom valid_gt0 x : valid (parse x).`1 => 0 < (parse x).`2. + axiom valid_uniq p1 p2 n1 n2 : + valid p1 => valid p2 => format p1 n1 = format p2 n2 => p1 = p2 /\ n1 = n2. + + op inv_map (m1 : (block list, block) fmap) (m2 : (block list * int, block) fmap) = + (forall p n, valid p => (p,n) \in dom m2 <=> format p (n+1) \in dom m1) + /\ (forall x, x \in dom m1 <=> ((parse x).`1,(parse x).`2-1) \in dom m2) + /\ (forall p n, valid p => m2.[(p,n-1)] = m1.[format p n]) + /\ (forall x, m1.[x] = m2.[((parse x).`1,(parse x).`2-1)]). + + + local module L (D : DISTINGUISHER) (F : F.RO) = SLCommon.IdealIndif(IF'(F), S, A(D)). + + local equiv Ideal_equiv (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : + L(D,F.RO).main + ~ + IdealIndif(SampleFirst(BIRO.IRO), SimLast(S), DRestr(D)).main + : + ={glob D} ==> ={glob D, res}. + proof. + proc;inline*;auto;sp. + call(: ={glob S, glob C} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});auto;last first. + + smt(dom0 in_fset0 map0P). + + proc;inline*;auto;sp;if;1,3:auto;sp;if;1,3:auto;if;1,3:auto;sp. + if{1};last by auto;if{2};auto;sp;rcondf{2}1;auto;smt(). + rcondf{2}1;1:auto;1:smt(parse_valid valid_gt0). + sp;rcondt{2}1;1:auto=>/#. + seq 8 6 : (={x,y,glob S,C.c} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2}); + last by conseq(:_==> ={z,glob S,C.c});progress;sim;progress. + wp;rnd;auto=>//=;rcondt{1}1;2:rcondt{2}1;1,2:by auto;smt(valid_gt0). + sp;conseq(:_==> (x0{1} \in dom F.RO.m{1}) + /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} + /\ oget F.RO.m.[x0]{1} = last b0 bs0{2}); + 1:smt(DBlock.dunifin_ll getP dom_set in_fsetU1). + conseq(:_==> format p0{1} i{1} \in dom F.RO.m{1} + /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} + /\ i{1} = n{1} + /\ oget F.RO.m.[format p0{1} i{1}]{1} = last b0 bs0{2});1:smt(). + while((i,n){1} = (i0,n0){2} /\ x1{2} = p0{1} /\ valid p0{1} + /\ format p0{1} i{1} \in dom F.RO.m{1} + /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} /\ 0 < i{1} <= n{1} + /\ oget F.RO.m.[format p0{1} i{1}]{1} = last b0 bs0{2});progress. + - sp;if{2}. + * rcondt{1}2;1:auto=>/#;wp;rnd;skip;smt(dom_set in_fsetU1 valid_uniq + formatK parseK getP in_dom last_rcons). + by rcondf{1}2;auto;smt(dom_set in_fsetU1 valid_uniq formatK parseK getP + in_dom DBlock.dunifin_ll last_rcons). + sp;if{2}. + - rcondt{1}2;1:auto=>/#;wp;rnd;skip;smt(dom_set in_fsetU1 valid_uniq + formatK parseK getP in_dom last_rcons valid_gt0). + by rcondf{1}2;auto;smt(dom_set in_fsetU1 valid_uniq formatK parseK getP + in_dom DBlock.dunifin_ll last_rcons valid_gt0). + + by proc;inline*;auto;sp;if;auto;sp;if;auto. + proc;inline*;auto;sp;if;auto;sp. + if{2};sp. + + if;auto;sp;rcondt{1}1;1:auto;1:smt(parse_valid). + rcondt{1}1;auto;1:smt(parse_valid);sp. + rcondf{1}3;auto;1:smt(parse_valid);sp. + rcondf{1}5;auto;1:smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). + rcondt{2}1;auto;rcondf{2}7;1:by auto;sp;if;auto. + swap{1}4 3;auto;conseq(:_==> lres{1} = bs{2} /\ ={S.paths, S.mi, S.m} + /\ ={C.c} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});1:smt(DBlock.dunifin_ll). + rcondf{1}6;1:auto;1:smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). + sp;if{2}. + - by rcondt{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK + parseK getP in_dom DBlock.dunifin_ll last_rcons). + rcondf{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK parseK + getP in_dom DBlock.dunifin_ll last_rcons). + if;auto;sp;rcondt{1}1;auto;1:smt(parse_valid). + rcondt{1}1;auto;1:smt(parse_valid);sp. + rcondf{1}3;auto;1:smt(parse_valid). + rcondf{1}5;auto;1:smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). + swap{1}4 3;auto;conseq(:_==> lres{1} = bs0{2} /\ ={S.paths, S.mi, S.m} + /\ ={C.c} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});1:smt(DBlock.dunifin_ll). + rcondt{2}1;1:auto=>/#;sp. + splitwhile{1} 6 : i + 1 < n. + rcondt{1}7;1:auto. + + by while(i < n);auto;2:smt();sp;if;auto;sp;if;auto;while(i < n);auto. + rcondf{1}9;1:auto. + + by while(i < n);auto;2:smt();sp;if;auto;sp;if;auto;while(i < n);auto. + rcondf{1}9;1:auto. + + by while(i < n);auto;2:smt();sp;if;auto;sp;if;auto;while(i < n);auto. + auto. + conseq(:_==> rcons lres{1} b{1} = bs0{2} + /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});auto. + while(i{1} + 1 = i0{2} /\ n{1} = n0{2} /\ valid p{1} + /\ F.RO.m.[format p (i+1)]{1} = Some b{1} + /\ (forall j, 0 < j <= i{1} + 1 => format p{1} j \in dom F.RO.m{1}) + /\ x0{2} = p{1} /\ 0 <= i{1} < n{1} + /\ rcons lres{1} b{1} = bs0{2} + /\ inv_map F.RO.m{1} BIRO.IRO.mp{2}). + + sp;rcondt{1}1;1:auto;sp;rcondt{1}1;1:auto;1:smt(parseK). + wp 4 1=>/=;swap{1}1;sp. + conseq(:_==> (forall j, 0 < j <= i{1}+1 => format p{1} j \in dom F.RO.m{1}) + /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});1:smt(get_oget in_dom). + splitwhile{1}1 : i1 + 1 < n1. + rcondt{1}2;first by auto;while(i1 < n1);auto;smt(parseK). + rcondf{1}7;first by auto;while(i1 < n1);auto;smt(parseK). + seq 4 0:( (forall j, 0 < j <= i{1} => format p{1} j \in dom F.RO.m{1}) + /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} /\ valid p{1} + /\ x4{1} = format p{1} (i{1} + 1) /\ 0 <= i{1} /\ x6{1} = x4{1} + /\ x2{2} = p{1} /\ n2{2} = i{1});last first. + - rcondf{1}4;1:auto;1:smt(dom_set in_fsetU1);rnd{1}. + if{2}. + * by rcondt{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK + parseK getP in_dom DBlock.dunifin_ll last_rcons dom_set in_fsetU1). + by rcondf{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK parseK + getP in_dom DBlock.dunifin_ll last_rcons). + alias{1} 1 m = F.RO.m;sp. + wp;conseq(:_==> F.RO.m{1} = m{1} /\ i1{1} = n1{1}-1);1:smt(parseK). + while{1}((forall j, 0 < j < n1{1} => format p1{1} j \in dom F.RO.m{1}) + /\ 0 <= i1{1} < n1{1} /\ p1{1} = p{1} + /\ F.RO.m{1} = m{1})(n1{1}-1-i1{1});progress. + + by sp;rcondf 2;auto;smt(DBlock.dunifin_ll). + by auto;smt(parseK). + if{2}. + + by rcondt{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK + parseK getP in_dom DBlock.dunifin_ll last_rcons dom_set in_fsetU1). + by rcondf{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK parseK + getP in_dom DBlock.dunifin_ll last_rcons). + qed. + + + local module Valid (F : F.RO) = { + proc init = F.init + proc f (q : block list) = { + var r : block <- b0; + var s,t; + (s,t) <- parse q; + if (valid s) { + r <@ F.get(q); + } else { + F.sample(q); + } + return r; + } + }. + + local module L2 (D : DISTINGUISHER) (F : F.RO) = + SLCommon.IdealIndif(Valid(F), S, A(D)). + + local equiv Ideal_equiv_valid (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : + L(D,F.LRO).main + ~ + L2(D,F.LRO).main + : + ={glob D} ==> ={glob D, res}. + proof. + proc;inline*;sp;wp. + call(: ={glob F.RO, glob S, glob C});auto. + + proc;sp;if;auto. + call(: ={glob IF,glob S});auto. + sp;if;auto;if;auto;sp. + - call(: ={glob IF});2:auto;2:smt();sp;if;auto;1:smt(). + inline F.LRO.sample;call(: ={glob IF});auto;progress. + by while{1}(true)(n{1}-i{1});auto;smt(). + by inline*;auto. + + 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. + sp;if;auto;progress;1,2:smt(). + + call(: ={glob IF});auto. + conseq(:_==> true);auto. + by inline*;while{1}(true)(n{1}-i{1});auto;smt(). + by inline*;auto. + call(: ={glob IF});auto;sp;if;auto;1:smt(). + + call(: ={glob IF});auto. + conseq(:_==> true);auto. + by inline*;while{1}(true)(n{1}-i{1});auto;smt(). + by inline*;auto. + qed. + + + (* Real part *) + + + + pred inv_ideal (squeeze : (block list * int, block list) fmap) + (c : (block list, block) fmap) = + (forall p n, (p,n) \in dom squeeze => + forall i, 1 <= i <= n => (p,i) = parse (format p i)) /\ + (forall p n, (p,n) \in dom squeeze => + forall i, 1 <= i <= n => format p i \in dom c) /\ + (forall l, l \in dom c => + forall i, 1 <= i <= (parse l).`2 => ((parse l).`1,i) \in dom squeeze). + + + inductive m_p (m : (state, state) fmap) (p : (block list, state) fmap) = + | IND_M_P of (p.[[]] = Some (b0, c0)) + & (forall l, l \in dom 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 dom m => + ! y \in rng m => + 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(getP in_dom 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. by move=>h;rewrite fsetP=>x;split;rewrite in_dom in_rng/#. 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 in_dom). + 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 dom m => + ! (format bl i) \in dom 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;cut[]//=_[] hmp0 hmp1 hinvm:=inv0;split=>//=. + + by rewrite getP;smt(size_cat size_nseq size_ge0). + + move=>l;rewrite dom_set in_fsetU1;case;1:smt(all_prefixes_of_INV_real getP). + move=>->>j[]hj0 hjsize;rewrite getP/=. + cut:=hmp1 (format bl (i - 1));rewrite in_dom H_p_val/==>help. + cut:=hjsize;rewrite !size_cat !size_nseq/=!max_ler 1:/#=>hjsizei. + cut->/=:!take j (format bl i) = format bl i by smt(size_take). + cut 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!max_ler/#. + rewrite!size_take//=1:/#!size_nseq!max_ler 1:/#. + pose o:=if _ then _ else _;cut->/={o}:o = k - size bl by smt(). + by progress;rewrite!nth_take//= 1,2:/# !nth_nseq//=/#. + case(j < size bl + i - 2)=>hj. + - cut:=help j _;1:smt(size_cat size_nseq). + move=>[]b c[]. + cut->: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'/=getP/=. + smt(size_take size_cat size_nseq). + cut->>/=:j = size (format bl (i-1)) by smt(size_cat size_nseq). + rewrite getP/=. + cut h':size (format bl (i-1)) = size bl + i - 2 by smt(size_cat size_nseq). + rewrite h'/=-(addzA _ _ 1)/=. + cut 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';cut->/=:! size bl + i - 2 < size bl by smt(). + by rewrite nth_nseq 1:/#;smt(Block.WRing.AddMonoid.addm0 in_dom get_oget). + 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']. + cut->/=: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(dom0 in_fset0 dom_set in_fsetU1 getP map0P). + 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;cut<-//:=(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 dom Redo.prefixes{1} => + l \in dom pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) + /\ (forall l, l \in dom 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. + - cut inv0:=H3;cut[]h_c1c2[]Hmp0 Hmp1 Hinvm:=inv0;split=>//=. + - case:inv0;smt(size_ge0). + split=>//=. + - smt(in_dom). + - move=>l H_dom_R i []Hi0 Hisize;cut:=H4 l H_dom_R. + case(l \in dom Redo.prefixes{2})=>H_in_pref//=. + * cut:=Hmp1 l H_in_pref i _;rewrite//=. + rewrite ?H5//=;1:smt(in_dom). + case(i+1 < size l)=>h;1:smt(in_dom). + by rewrite take_oversize 1:/#. + move=>[]j[][]hj0 hjsize ->>. + cut:=Hisize;rewrite size_take 1:/#. + pose k:=if _ then _ else _;cut->>Hij{k}:k=j by rewrite/#. + by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#;smt(in_dom). + - smt(getP oget_some in_dom 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 dom Redo.prefixes{1} => + l \in dom pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) + /\ (forall l, l \in dom 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 dom 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;cut[]_[]->//=:=H. + - smt(). + - by cut[]->//=:=H. - smt(all_prefixes_of_INV_real). - smt(). - smt(). @@ -789,346 +1167,95 @@ section Real_Ideal. pose x := if _ then _ else _ ;cut->/={x}: x = format p{1} (i_R+1). + rewrite/x size_cat size_nseq-(addzA _ 1 (-1))/=!max_ler 1:/#-(addzA _ _ (-1))-(addzA _ _ (-1))/=. case(size p{1} + i_R <= size p{1})=>//=h;2:smt(size_ge0 size_cat size_nseq). - cut->>/=: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 _ ;cut->/={x}: x = format p{1} (i_R+1). - + rewrite/x size_cat size_nseq-(addzA _ 1 (-1))/=!max_ler 1:/#-(addzA _ _ (-1))-(addzA _ _ (-1))/=. - case(size p{1} + i_R <= size p{1})=>//=h;2:smt(size_ge0 size_cat size_nseq). - cut->>/=: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 dom 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 in_dom H3. - + by rewrite take0;cut[]_[]:=H1. - + smt(). - + smt(). - rcondt 1;auto;progress. - + cut->: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 in_dom). - 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). - + cut->: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 in_dom). - rewrite!take_format;smt(valid_spec size_ge0 size_eq0 size_cat size_nseq). - smt(). - qed. - - - - local 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. - cut->: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. - qed. - - - print Real_Ideal. - - print SLCommon.SIMULATOR. - - print Last. - - module SimLast (S : SLCommon.SIMULATOR) (F : DFUNCTIONALITY) = S(Last(F)). - - op (<=) (m1 m2 : (block list, 'b) fmap) = - forall x, x <> [] => x \in dom 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 dom m2 => - m1 <= m2.[x <- y]. - proof. - move=>h_leq H_n_dom a H_a_dom;rewrite getP/=;smt(in_dom). - qed. - - - local lemma leq_add_in (m1 m2 : (block list, 'b) fmap) (x : block list) : - m1 <= m2 => - x \in dom m2 => - m1.[x <- oget m2.[x]] <= m2. - proof. - move=>h_leq H_n_dom a H_a_dom;rewrite getP/=;smt(in_dom getP). - qed. - - local lemma leq_nin_dom (m1 m2 : (block list, 'b) fmap) (x : block list) : - m1 <= m2 => - x <> [] => - ! x \in dom m2 => ! x \in dom m1 by smt(in_dom). - - local lemma prefixe_leq1 (l : block list) (m : (block list,block) fmap) i : - 0 <= i => - format l (i+1) \in dom m => - size (format l (i+1)) <= prefixe (format l (i+1+1)) - (get_max_prefixe (format l (i+1+1)) (elems (dom m))) <= size (format l (i+1+1)). - proof. - rewrite memE;move=>hi0 H_dom. - cut->:(format l (i + 1 + 1)) = format l (i + 1) ++ [b0]. - + by rewrite/format/=-2!(addzA _ 1 (-1))//=nseqSr//-cats1 catA. - cut:=prefixe_leq_prefixe_cat_size (format l (i + 1))[b0](elems (dom m)). - rewrite (prefixe_get_max_prefixe_eq_size _ _ H_dom)//=. - rewrite (size_cat _ [b0])/=;pose x:= format _ _. - cut:=get_max_prefixe_max (x ++ [b0]) _ _ H_dom. - cut->:prefixe (x ++ [b0]) (format l (i + 1)) = size x - by rewrite prefixeC-{1}(cats0 (format l (i+1)))/x prefixe_cat//=. - smt(prefixe_sizel size_cat prefixe_ge0 ). - qed. - - local lemma prefixe_le1 (l : block list) (m : (block list,block) fmap) i : - 0 <= i => - format l (i+1) \in dom m => - size (format l (i+1+1)) - prefixe (format l (i+1+1)) - (get_max_prefixe (format l (i+1+1)) (elems (dom m))) <= 1. - proof. - smt(prefixe_leq1 size_ge0 size_cat size_nseq). - qed. + cut->>/=: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 _ ;cut->/={x}: x = format p{1} (i_R+1). + + rewrite/x size_cat size_nseq-(addzA _ 1 (-1))/=!max_ler 1:/#-(addzA _ _ (-1))-(addzA _ _ (-1))/=. + case(size p{1} + i_R <= size p{1})=>//=h;2:smt(size_ge0 size_cat size_nseq). + cut->>/=: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 dom 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 in_dom H3. + + by rewrite take0;cut[]_[]:=H1. + + smt(). + + smt(). + rcondt 1;auto;progress. + + cut->: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 in_dom). + 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). + + cut->: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 in_dom). + rewrite!take_format;smt(valid_spec size_ge0 size_eq0 size_cat size_nseq). + smt(). + qed. - local lemma leq_add2 (m1 m2 : (block list, 'b) fmap) (x : block list) (y : 'b) : - m1 <= m2 => - ! x \in dom m2 => - m1.[x <- y] <= m2.[x <- y] by smt(in_dom getP dom_set in_fsetU1). - local equiv ideal_equiv (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : - SLCommon.IdealIndif(IF, S, SLCommon.DRestr(A(D))).main - ~ - SLCommon.IdealIndif(IF, S, A(D)).main - : - ={glob D} ==> ={glob D, res}. + local 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. - 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 getP/=dom_set in_fsetU1 dom0 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(prefixe_ge0 leq_add_in DBlock.dunifin_ll in_dom size_ge0 getP 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 dom F.RO.m){2});last first. - * rcondt{2}2;1:auto;rcondt{1}1;1:(auto;smt(leq_nin_dom size_cat size_eq0 size_nseq valid_spec)). - rcondt{1}1;1:auto;1:smt(prefixe_le1 in_dom size_cat size_nseq). - sp;rcondt{1}2;auto;progress. - - smt(). - - smt(). - - by rewrite!getP/=. - - smt(prefixe_le1 in_dom). - - by rewrite!getP/=oget_some leq_add2//=. - if{1}. - * rcondt{1}1;1:auto;1:smt(prefixe_le1 in_dom size_cat size_nseq). - sp;rcondf{1}2;2:rcondf{2}2;auto;progress. - - smt(). - - smt(). - - by rewrite!getP/=. - - smt(prefixe_ge0 prefixe_le1 in_dom). - - smt(leq_add_in in_dom). - rcondf{2}2;auto;progress. - - smt(DBlock.dunifin_ll). - - smt(). - - smt(). - - smt(). - - smt(set_eq in_dom). - - 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 dom F.RO.m{2}). - + rcondf{2}2;1:auto. - sp;if{1}. - - rcondt{1}1;1:auto;1:smt(prefixe_ge0). - sp;rcondf{1}2;auto;progress. - * by rewrite!getP/=. - * smt(prefixe_ge0). - * smt(leq_add_in in_dom). - auto;progress. - - exact DBlock.dunifin_ll. - - smt(in_dom). - - smt(in_dom get_oget). - - smt(size_ge0). - rcondt{1}1;1:auto;1:smt(leq_nin_dom in_dom). - rcondt{1}1;1:auto;1:smt(prefixe_ge0). - sp;auto;progress. - + by rewrite!getP/=. - + smt(prefixe_ge0). - + rewrite getP/=oget_some leq_add2//=. - + by rewrite!getP/=. - + smt(prefixe_ge0). - + exact leq_add_in. + cut->: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. 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; - if (valid p) { - while (i < n) { - i <- i + 1; - F.sample(format p i); - } - b <@ F.get(x); - } - return b; - } - }. - - - local module SampleFirst (I : BIRO.IRO) = { - proc init = I.init - proc f (m : block list, k : int) = { - var r : block list <- []; - if (k <= 0) { - I.f(m,1); - } else { - r <- I.f(m,k); - } - return r; - } - }. - - - axiom valid_gt0 x : valid (parse x).`1 => 0 < (parse x).`2. - axiom valid_uniq p1 p2 n1 n2 : - valid p1 => valid p2 => format p1 n1 = format p2 n2 => p1 = p2 /\ n1 = n2. - - op inv_map (m1 : (block list, block) fmap) (m2 : (block list * int, block) fmap) = - (forall p n, valid p => (p,n) \in dom m2 <=> format p (n+1) \in dom m1) - /\ (forall x, x \in dom m1 <=> ((parse x).`1,(parse x).`2-1) \in dom m2) - /\ (forall p n, valid p => m2.[(p,n-1)] = m1.[format p n]) - /\ (forall x, m1.[x] = m2.[((parse x).`1,(parse x).`2-1)]). - -print BIRO. +(* This lemma is false, overuse of valid tests *) - local equiv Ideal_equiv (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : - SLCommon.IdealIndif(IF'(F.RO), S, A(D)).main + local equiv Ideal_equiv_valid (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : + L2(D,F.RO).main ~ - IdealIndif(SampleFirst(BIRO.IRO), SimLast(S), DRestr(D)).main + SLCommon.IdealIndif(IF, S, A(D)).main : ={glob D} ==> ={glob D, res}. proof. - proc;inline*;auto;sp. - call(: ={glob S, glob C} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});auto;last first. - + smt(dom0 in_fset0 map0P). - + proc;inline*;auto;sp;if;1,3:auto;sp;if;1,3:auto;if;1,3:auto;sp. - if{1};last by auto;if{2};auto;sp;rcondf{2}1;auto;smt(). - rcondf{2}1;1:auto;1:smt(parse_valid valid_gt0). - sp;rcondt{2}1;1:auto=>/#. - seq 8 6 : (={x,y,glob S,C.c} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2}); - last by conseq(:_==> ={z,glob S,C.c});progress;sim;progress. - wp;rnd;auto=>//=;rcondt{1}1;2:rcondt{2}1;1,2:by auto;smt(valid_gt0). - sp;conseq(:_==> (x0{1} \in dom F.RO.m{1}) - /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} - /\ oget F.RO.m.[x0]{1} = last b0 bs0{2}); - 1:smt(DBlock.dunifin_ll getP dom_set in_fsetU1). - conseq(:_==> format p0{1} i{1} \in dom F.RO.m{1} - /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} - /\ i{1} = n{1} - /\ oget F.RO.m.[format p0{1} i{1}]{1} = last b0 bs0{2});1:smt(). - while((i,n){1} = (i0,n0){2} /\ x1{2} = p0{1} /\ valid p0{1} - /\ format p0{1} i{1} \in dom F.RO.m{1} - /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} /\ 0 < i{1} <= n{1} - /\ oget F.RO.m.[format p0{1} i{1}]{1} = last b0 bs0{2});progress. - - sp;if{2}. - * rcondt{1}2;1:auto=>/#;wp;rnd;skip;smt(dom_set in_fsetU1 valid_uniq - formatK parseK getP in_dom last_rcons). - by rcondf{1}2;auto;smt(dom_set in_fsetU1 valid_uniq formatK parseK getP - in_dom DBlock.dunifin_ll last_rcons). - sp;if{2}. - - rcondt{1}2;1:auto=>/#;wp;rnd;skip;smt(dom_set in_fsetU1 valid_uniq - formatK parseK getP in_dom last_rcons valid_gt0). - by rcondf{1}2;auto;smt(dom_set in_fsetU1 valid_uniq formatK parseK getP - in_dom DBlock.dunifin_ll last_rcons valid_gt0). - + by proc;inline*;auto;sp;if;auto;sp;if;auto. - proc;inline*;auto;sp;if;auto;sp. - if{2};sp. - + if;auto;sp;rcondt{1}1;1:auto;1:smt(parse_valid). - rcondt{1}1;auto;1:smt(parse_valid);sp. - rcondf{1}3;auto;1:smt(parse_valid);sp. - rcondf{1}5;auto;1:smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). - rcondt{2}1;auto;rcondf{2}7;1:by auto;sp;if;auto. - swap{1}4 3;auto;conseq(:_==> lres{1} = bs{2} /\ ={S.paths, S.mi, S.m} - /\ ={C.c} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});1:smt(DBlock.dunifin_ll). - rcondf{1}6;1:auto;1:smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). - sp;if{2}. - - by rcondt{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK - parseK getP in_dom DBlock.dunifin_ll last_rcons). - rcondf{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK parseK - getP in_dom DBlock.dunifin_ll last_rcons). - if;auto;sp;rcondt{1}1;auto;1:smt(parse_valid). - rcondt{1}1;auto;1:smt(parse_valid);sp. - rcondf{1}3;auto;1:smt(parse_valid). - rcondf{1}5;auto;1:smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). - swap{1}4 3;auto;conseq(:_==> lres{1} = bs0{2} /\ ={S.paths, S.mi, S.m} - /\ ={C.c} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});1:smt(DBlock.dunifin_ll). - rcondt{1}6;1:auto=>/#. - rcondt{2}1;1:auto=>/#. - (* TODO *) - - rcondt{2}1;auto;rcondf{2}7;1:by auto;sp;if;auto. - rcondf{1}7;auto. - + while - - - qed. + proc;inline*;sp;wp. + call(: ={glob F.RO, glob S, glob C});auto. + + proc;sp;if;auto. + call(: ={glob IF,glob S});auto. + sp;if;auto;if;auto;sp. + - call(: ={glob IF});2:auto;2:smt();sp;if;auto;1:smt(). + inline F.LRO.sample;call(: ={glob IF});auto;progress. + by while{1}(true)(n{1}-i{1});auto;smt(). + by inline*;auto. + + 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. + sp;if;auto;progress;1,2:smt(). + + call(: ={glob IF});auto. + conseq(:_==> true);auto. + by inline*;while{1}(true)(n{1}-i{1});auto;smt(). + by inline*;auto. + call(: ={glob IF});auto;sp;if;auto;1:smt(). + + call(: ={glob IF});auto. + conseq(:_==> true);auto. + by inline*;while{1}(true)(n{1}-i{1});auto;smt(). + by inline*;auto. + qed. (* TODO : Ideal *) + + local lemma equiv_ideal (IF <: FUNCTIONALITY{DSqueeze,C}) (S <: SIMULATOR{DSqueeze,C,IF}) From d3dd57d29612abe2f505031c9ef7d6df71d18980 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Wed, 23 May 2018 16:42:56 +0200 Subject: [PATCH 282/394] fix include paths --- sha3/config/tests.config | 2 +- sha3/proof/.dir-locals.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/sha3/config/tests.config b/sha3/config/tests.config index 501321f..d5c1ee1 100644 --- a/sha3/config/tests.config +++ b/sha3/config/tests.config @@ -1,6 +1,6 @@ [default] bin = easycrypt -args = -I proof -I proof/variant -I proof/core -timeout 180 +args = -I proof -I proof/smart_counter -timeout 180 [test-sha3] okdirs = !proof diff --git a/sha3/proof/.dir-locals.el b/sha3/proof/.dir-locals.el index 0337f77..9c03066 100644 --- a/sha3/proof/.dir-locals.el +++ b/sha3/proof/.dir-locals.el @@ -1,4 +1,4 @@ ((easycrypt-mode . ((eval . (flet ((pre (s) (concat (locate-dominating-file buffer-file-name ".dir-locals.el") s))) - (setq easycrypt-load-path `(,(pre ".") ,(pre "core") ,(pre "smart_counter")))))))) + (setq easycrypt-load-path `(,(pre "smart_counter")))))))) From 9e40950cdaa62d047bfe1de87c4cded9479ecb4c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Mon, 14 May 2018 15:53:12 +0200 Subject: [PATCH 283/394] forgot to commit. again. --- sha3/proof/smart_counter/Gconcl_list.ec | 613 +++++++++++------------- 1 file changed, 291 insertions(+), 322 deletions(-) diff --git a/sha3/proof/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec index c4be026..f2a77f9 100644 --- a/sha3/proof/smart_counter/Gconcl_list.ec +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -10,6 +10,10 @@ require (*--*) Handle. (** Validity of Functionality Queries **) op valid: block list -> bool = valid_block. axiom valid_spec p: valid p => p <> []. +axiom valid_ge0 x: 0 <= (parse x).`2. +axiom valid_gt0 x: valid (parse x).`1 => 0 < (parse x).`2. + + clone export Handle as Handle0. @@ -73,8 +77,18 @@ module P = Perm. section Real_Ideal. + module Valid (F : DFUNCTIONALITY) = { + proc init () = {} + proc f (q : block list, k : int) = { + var re : block list <- []; + if (valid q) { + re <@ F.f(q,k); + } + return re; + } + }. - module SimLast (S : SLCommon.SIMULATOR) (F : DFUNCTIONALITY) = S(Last(F)). + module SimLast (S : SLCommon.SIMULATOR) (F : DFUNCTIONALITY) = S(Last(Valid(F))). op (<=) (m1 m2 : (block list, 'b) fmap) = forall x, x <> [] => x \in dom m1 => m1.[x] = m2.[x]. @@ -273,7 +287,6 @@ section Real_Ideal. }. - axiom valid_gt0 x : valid (parse x).`1 => 0 < (parse x).`2. axiom valid_uniq p1 p2 n1 n2 : valid p1 => valid p2 => format p1 n1 = format p2 n2 => p1 = p2 /\ n1 = n2. @@ -284,119 +297,12 @@ section Real_Ideal. /\ (forall x, m1.[x] = m2.[((parse x).`1,(parse x).`2-1)]). - local module L (D : DISTINGUISHER) (F : F.RO) = SLCommon.IdealIndif(IF'(F), S, A(D)). - - local equiv Ideal_equiv (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : - L(D,F.RO).main - ~ - IdealIndif(SampleFirst(BIRO.IRO), SimLast(S), DRestr(D)).main - : - ={glob D} ==> ={glob D, res}. - proof. - proc;inline*;auto;sp. - call(: ={glob S, glob C} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});auto;last first. - + smt(dom0 in_fset0 map0P). - + proc;inline*;auto;sp;if;1,3:auto;sp;if;1,3:auto;if;1,3:auto;sp. - if{1};last by auto;if{2};auto;sp;rcondf{2}1;auto;smt(). - rcondf{2}1;1:auto;1:smt(parse_valid valid_gt0). - sp;rcondt{2}1;1:auto=>/#. - seq 8 6 : (={x,y,glob S,C.c} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2}); - last by conseq(:_==> ={z,glob S,C.c});progress;sim;progress. - wp;rnd;auto=>//=;rcondt{1}1;2:rcondt{2}1;1,2:by auto;smt(valid_gt0). - sp;conseq(:_==> (x0{1} \in dom F.RO.m{1}) - /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} - /\ oget F.RO.m.[x0]{1} = last b0 bs0{2}); - 1:smt(DBlock.dunifin_ll getP dom_set in_fsetU1). - conseq(:_==> format p0{1} i{1} \in dom F.RO.m{1} - /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} - /\ i{1} = n{1} - /\ oget F.RO.m.[format p0{1} i{1}]{1} = last b0 bs0{2});1:smt(). - while((i,n){1} = (i0,n0){2} /\ x1{2} = p0{1} /\ valid p0{1} - /\ format p0{1} i{1} \in dom F.RO.m{1} - /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} /\ 0 < i{1} <= n{1} - /\ oget F.RO.m.[format p0{1} i{1}]{1} = last b0 bs0{2});progress. - - sp;if{2}. - * rcondt{1}2;1:auto=>/#;wp;rnd;skip;smt(dom_set in_fsetU1 valid_uniq - formatK parseK getP in_dom last_rcons). - by rcondf{1}2;auto;smt(dom_set in_fsetU1 valid_uniq formatK parseK getP - in_dom DBlock.dunifin_ll last_rcons). - sp;if{2}. - - rcondt{1}2;1:auto=>/#;wp;rnd;skip;smt(dom_set in_fsetU1 valid_uniq - formatK parseK getP in_dom last_rcons valid_gt0). - by rcondf{1}2;auto;smt(dom_set in_fsetU1 valid_uniq formatK parseK getP - in_dom DBlock.dunifin_ll last_rcons valid_gt0). - + by proc;inline*;auto;sp;if;auto;sp;if;auto. - proc;inline*;auto;sp;if;auto;sp. - if{2};sp. - + if;auto;sp;rcondt{1}1;1:auto;1:smt(parse_valid). - rcondt{1}1;auto;1:smt(parse_valid);sp. - rcondf{1}3;auto;1:smt(parse_valid);sp. - rcondf{1}5;auto;1:smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). - rcondt{2}1;auto;rcondf{2}7;1:by auto;sp;if;auto. - swap{1}4 3;auto;conseq(:_==> lres{1} = bs{2} /\ ={S.paths, S.mi, S.m} - /\ ={C.c} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});1:smt(DBlock.dunifin_ll). - rcondf{1}6;1:auto;1:smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). - sp;if{2}. - - by rcondt{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK - parseK getP in_dom DBlock.dunifin_ll last_rcons). - rcondf{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK parseK - getP in_dom DBlock.dunifin_ll last_rcons). - if;auto;sp;rcondt{1}1;auto;1:smt(parse_valid). - rcondt{1}1;auto;1:smt(parse_valid);sp. - rcondf{1}3;auto;1:smt(parse_valid). - rcondf{1}5;auto;1:smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). - swap{1}4 3;auto;conseq(:_==> lres{1} = bs0{2} /\ ={S.paths, S.mi, S.m} - /\ ={C.c} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});1:smt(DBlock.dunifin_ll). - rcondt{2}1;1:auto=>/#;sp. - splitwhile{1} 6 : i + 1 < n. - rcondt{1}7;1:auto. - + by while(i < n);auto;2:smt();sp;if;auto;sp;if;auto;while(i < n);auto. - rcondf{1}9;1:auto. - + by while(i < n);auto;2:smt();sp;if;auto;sp;if;auto;while(i < n);auto. - rcondf{1}9;1:auto. - + by while(i < n);auto;2:smt();sp;if;auto;sp;if;auto;while(i < n);auto. - auto. - conseq(:_==> rcons lres{1} b{1} = bs0{2} - /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});auto. - while(i{1} + 1 = i0{2} /\ n{1} = n0{2} /\ valid p{1} - /\ F.RO.m.[format p (i+1)]{1} = Some b{1} - /\ (forall j, 0 < j <= i{1} + 1 => format p{1} j \in dom F.RO.m{1}) - /\ x0{2} = p{1} /\ 0 <= i{1} < n{1} - /\ rcons lres{1} b{1} = bs0{2} - /\ inv_map F.RO.m{1} BIRO.IRO.mp{2}). - + sp;rcondt{1}1;1:auto;sp;rcondt{1}1;1:auto;1:smt(parseK). - wp 4 1=>/=;swap{1}1;sp. - conseq(:_==> (forall j, 0 < j <= i{1}+1 => format p{1} j \in dom F.RO.m{1}) - /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});1:smt(get_oget in_dom). - splitwhile{1}1 : i1 + 1 < n1. - rcondt{1}2;first by auto;while(i1 < n1);auto;smt(parseK). - rcondf{1}7;first by auto;while(i1 < n1);auto;smt(parseK). - seq 4 0:( (forall j, 0 < j <= i{1} => format p{1} j \in dom F.RO.m{1}) - /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} /\ valid p{1} - /\ x4{1} = format p{1} (i{1} + 1) /\ 0 <= i{1} /\ x6{1} = x4{1} - /\ x2{2} = p{1} /\ n2{2} = i{1});last first. - - rcondf{1}4;1:auto;1:smt(dom_set in_fsetU1);rnd{1}. - if{2}. - * by rcondt{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK - parseK getP in_dom DBlock.dunifin_ll last_rcons dom_set in_fsetU1). - by rcondf{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK parseK - getP in_dom DBlock.dunifin_ll last_rcons). - alias{1} 1 m = F.RO.m;sp. - wp;conseq(:_==> F.RO.m{1} = m{1} /\ i1{1} = n1{1}-1);1:smt(parseK). - while{1}((forall j, 0 < j < n1{1} => format p1{1} j \in dom F.RO.m{1}) - /\ 0 <= i1{1} < n1{1} /\ p1{1} = p{1} - /\ F.RO.m{1} = m{1})(n1{1}-1-i1{1});progress. - + by sp;rcondf 2;auto;smt(DBlock.dunifin_ll). - by auto;smt(parseK). - if{2}. - + by rcondt{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK - parseK getP in_dom DBlock.dunifin_ll last_rcons dom_set in_fsetU1). - by rcondf{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK parseK - getP in_dom DBlock.dunifin_ll last_rcons). - qed. + local module (L (D : DISTINGUISHER) : F.RO_Distinguisher) (F : F.RO) = { + proc distinguish = SLCommon.IdealIndif(IF'(F), S, A(D)).main + }. - local module Valid (F : F.RO) = { + local module Valid2 (F : F.RO) = { proc init = F.init proc f (q : block list) = { var r : block <- b0; @@ -404,20 +310,19 @@ section Real_Ideal. (s,t) <- parse q; if (valid s) { r <@ F.get(q); - } else { - F.sample(q); } return r; } }. - local module L2 (D : DISTINGUISHER) (F : F.RO) = - SLCommon.IdealIndif(Valid(F), S, A(D)). + 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, BIRO.IRO, S}) : - L(D,F.LRO).main + L(D,F.LRO).distinguish ~ - L2(D,F.LRO).main + L2(D,F.LRO).distinguish : ={glob D} ==> ={glob D, res}. proof. @@ -426,10 +331,9 @@ section Real_Ideal. + proc;sp;if;auto. call(: ={glob IF,glob S});auto. sp;if;auto;if;auto;sp. - - call(: ={glob IF});2:auto;2:smt();sp;if;auto;1:smt(). - inline F.LRO.sample;call(: ={glob IF});auto;progress. - by while{1}(true)(n{1}-i{1});auto;smt(). - by inline*;auto. + call(: ={glob IF});2:auto;2:smt();sp;if;auto;1: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. @@ -437,18 +341,243 @@ section Real_Ideal. + sp;if;auto. call(: ={glob IF});auto. sp;if;auto;progress;1,2:smt(). - + call(: ={glob IF});auto. - conseq(:_==> true);auto. - by inline*;while{1}(true)(n{1}-i{1});auto;smt(). - by inline*;auto. - call(: ={glob IF});auto;sp;if;auto;1:smt(). - + call(: ={glob IF});auto. + call(: ={glob IF});auto. conseq(:_==> true);auto. by inline*;while{1}(true)(n{1}-i{1});auto;smt(). - by inline*;auto. + call(: ={glob IF});auto;sp;if;auto;1:smt(). + 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, BIRO.IRO, 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. + (* This is false *) + admit. + + by proc;sim. + proc;sp;if;auto;sp. + call(: ={glob F.RO});auto;sp;if;auto;inline*;auto;sp. + rcondt{1}1;1:auto;1:smt(parse_valid parseK formatK);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 sp;rcondt{1}1;auto;smt(parse_valid parseK formatK). + auto;smt(parse_valid parseK formatK). + auto;smt(parse_valid parseK formatK). + qed. + + + local module IF2(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; + if (valid p) { + if (0 < n) { + while (i < n) { + i <- i + 1; + F.sample(format p i); + } + b <@ F.get(x); + } else { + F.sample(x); + } + } + return b; + } + }. + + + local module (L3 (D : DISTINGUISHER) : F.RO_Distinguisher) (F : F.RO) = { + proc distinguish = SLCommon.IdealIndif(IF2(F), S, A(D)).main + }. + + + + local equiv Ideal_equiv3 (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : + L(D,F.RO).distinguish ~ L3(D,F.RO).distinguish + : ={glob D} ==> ={glob D, res}. + proof. + proc;inline*;auto;sp. + call(: ={glob S, glob F.RO, glob C});auto;first last. + + by proc;sim. + + proc;sp;if;auto;call(: ={glob F.RO});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). + rcondt{1}1;1:auto;1:smt(parse_valid parseK formatK);sp. + rcondf{1}3;1:auto;1:smt(parse_valid parseK formatK);sp. + rcondt{2}1;1:auto;1:smt(parse_valid parseK formatK);sp. + rcondf{2}3;1:auto;1:smt(parse_valid parseK formatK);sp. + case(0 < n{1});auto;last first. + - by rcondf{1}8;1:auto;rcondf{2}8;1:auto;sim=>/#. + while(={i,n,p,lres,b,F.RO.m} /\ valid p{1} /\ 0 <= i{1} <= n{1}). + - sp;if;1,3:auto=>/#. + sp;rcondt{2}1;1:auto;1:smt(parse_valid parseK formatK). + rcondt{1}1;2:rcondt{2}1;1,2:(auto;smt(parseK formatK parse_valid)). + conseq(:_==> ={b,F.RO.m});2:sim;progress=>/#. + by wp 5 5;conseq(:_==> ={F.RO.m,r,x2});2:sim;smt(). + proc;sp;if;auto;call(: ={F.RO.m, glob S});auto. + if;1,3:auto;sim;if;auto. + call(: ={glob F.RO});auto;sp;inline*. + if;1,3:auto;1:smt(). + rcondt{2}1;1:auto;1:smt(parse_valid parseK formatK valid_gt0);sim;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 + }. + + + local lemma equiv_ideal (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S,F.FRO}) &m: + Pr[SLCommon.IdealIndif(IF,S,SLCommon.DRestr(A(D))).main() @ &m : res] = + Pr[L3(D,F.RO).distinguish() @ &m : res]. + proof. + cut->: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)=>//=. + cut<-:Pr[L(D, F.RO).distinguish() @ &m : res] = + Pr[L3(D, F.RO).distinguish() @ &m : res]. + + by byequiv(Ideal_equiv3 D). + cut<-:Pr[L2(D,F.RO).distinguish() @ &m : res] = + Pr[SLCommon.IdealIndif(IF,S,A(D)).main() @ &m : res]. + + by byequiv(ideal_equiv2 D). + cut->:Pr[L2(D, F.RO).distinguish() @ &m : res] = + Pr[L2(D,F.LRO).distinguish() @ &m : res]. + + byequiv=>//=;proc;sp;inline*;sp;wp. + transitivity{1} { + b1 <@ D2(D,F.RO).distinguish(); + } + (={glob D, glob F.RO, glob C, glob S} ==> ={b1}) + (={glob D, glob F.RO, glob C, glob S} ==> ={b1});progress;1:smt();1:sim. + transitivity{1} { + b1 <@ D2(D,F.LRO).distinguish(); + } + (={glob D, glob F.RO, glob C, glob S} ==> ={b1}) + (={glob D, glob F.RO, glob C, glob S} ==> ={b1});progress;1:smt();2:sim. + by call(F.RO_LRO_D (D2(D)));auto. + cut->:Pr[L(D, F.RO).distinguish() @ &m : res] = + Pr[L(D,F.LRO).distinguish() @ &m : res]. + + byequiv=>//=;proc;sp;inline*;sp;wp. + transitivity{1} { + b1 <@ D3(D,F.RO).distinguish(); + } + (={glob D, glob F.RO, glob C, glob S} ==> ={b1}) + (={glob D, glob F.RO, glob C, glob S} ==> ={b1});progress;1:smt();1:sim. + transitivity{1} { + b1 <@ D3(D,F.LRO).distinguish(); + } + (={glob D, glob F.RO, glob C, glob S} ==> ={b1}) + (={glob D, glob F.RO, glob C, glob S} ==> ={b1});progress;1:smt();2:sim. + by call(F.RO_LRO_D (D3(D)));auto. + rewrite eq_sym. + by byequiv(Ideal_equiv_valid D). + qed. + + + local equiv double_squeeze : + DSqueeze(IF2(F.RO)).f ~ Squeeze(IF).f : + ={arg, F.RO.m} ==> ={res, F.RO.m}. + proof. + proc;inline*;auto;sp;if;auto;sp. + rcondt{1}1;1:(auto;smt(parse_valid valid_gt0)). + rcondt{1}1;1:(auto;smt(parse_valid valid_gt0)). + rcondt{1}1;1:(auto;smt(parse_valid valid_gt0));sp. + rcondf{1}3;1:(auto;smt(parse_valid valid_gt0));sp. + case(0 < n{1});last first. + + rcondf{2}4;1:auto=>/#. + rcondf{1}8;1:auto=>/#. + rcondf{1}5. + + auto;smt(nseq0 cats0 dom_set in_fsetU1 parse_valid). + by wp;rnd{1};auto;smt(DBlock.dunifin_ll nseq0 cats0 parse_valid set_eq in_dom). + while(={F.RO.m,n,b,i,lres,p} /\ valid p{1} /\ 0 < n{1} /\ 0 <= i{1} <= n{1} + /\ (i{1}+1 < n{1} => (forall j, 0 <= j <= i{1} => format p{1} (j+1) \in dom F.RO.m{1}))). + + sp;if;1,3:auto=>/#. + sp;rcondt{1}1;1:(auto;smt(parseK formatK)). + rcondt{1}1;1:(auto;smt(parseK formatK valid_gt0)). + conseq(:_==> ={b,F.RO.m} /\ (forall (j : int), 0 <= j <= i{1} => + format p{1} (j+1) \in dom F.RO.m{2}));1:smt(). + splitwhile{1} 1 : i1 + 1 < n1. + rcondt{1}2;1:auto. + + by while(i1 < n1);auto;smt(valid_gt0 parseK formatK). + rcondf{1}7;1:auto. + + by while(i1 < n1);auto;smt(valid_gt0 parseK formatK). + seq 3 0 : (={F.RO.m,x0} /\ x0{1} = format p{1} (i{1}+1) /\ x4{1} = x0{1} /\ + (forall (j : int), 0 <= j < i{1} => format p{1} (j+1) \in dom F.RO.m{2}));last first. + + sp;rcondf{1}5;1:auto;1:smt(dom_set in_fsetU1). + by wp;rnd{1};auto;smt(DBlock.dunifin_ll dom_set in_fsetU1). + wp. + conseq(:_==> ={F.RO.m} /\ i1{1} + 1 = n1{1});1:smt(parseK formatK). + while{1}(={F.RO.m} /\ 0 < i1{1} + 1 <= n1{1} <= n{1} /\ + (forall j, 0 <= j < n1{1}-1 => format p1{1} (j+1) \in dom F.RO.m{1}))(n1{1}-i1{1}). + + by progress;sp;rcondf 2;auto;smt(DBlock.dunifin_ll). + by auto;smt(formatK parseK). + by rcondf{1}5;2:(wp;rnd{1});auto;smt(DBlock.dunifin_ll dom_set in_fsetU1 nseq0 cats0 parse_valid). + qed. + + + local equiv Ideal_equiv (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : + L3(D,F.RO).distinguish + ~ + IdealIndif(Squeeze(IF), SimLast(S), DRestr(D)).main + : + ={glob D} ==> ={glob D, res}. + proof. + proc;inline*;auto;sp. + call(: ={glob S, glob C, F.RO.m});auto;first last. + + by proc;inline*;sp;if;auto;sp;if;auto. + + proc;sp;if;auto;sp. + by call(double_squeeze);auto;progress. + proc;sp;if;auto;inline{1}1;inline{2}1;sp;if;1:auto;sim;if;auto. + sp;inline*;sp;if;1,3:(auto;smt(parse_valid));sp. + rcondt{1}1;1:(auto;smt(parse_valid valid_gt0)). + rcondt{2}1;1:(auto;smt(parse_valid valid_gt0));sp. + rcondt{1}1;1:(auto;smt(parse_valid valid_gt0));sp. + splitwhile{2}4: i + 1 < n. + rcondt{2}5;1:auto. + + while(i < n);1:(sp;if);auto;smt(valid_gt0). + rcondf{2}7;1:auto. + + while(i < n);1:(sp;if);auto;smt(valid_gt0). + rcondf{2}7;1:auto. + + while(i < n);1:(sp;if);auto;smt(valid_gt0). + seq 3 4 : (F.RO.m.[x0]{1} = Some b{2} /\ ={x, C.c, S.paths, F.RO.m});last first. + + sp;rcondf{1}2;auto;smt(in_dom DBlock.dunifin_ll last_rcons). + conseq(: _==> F.RO.m{1}.[format p0{1} i{1}] = Some b{2} /\ i{1} = n{1} /\ ={F.RO.m});progress. + + rewrite-H7;congr;smt(parseK formatK). + while(={F.RO.m,n} /\ i{1} = i{2} + 1 /\ p0{1} = p1{2} /\ i{1} <= n{1} + /\ F.RO.m{1}.[format p0{1} i{1}] = Some b{2}). + + sp;rcondt{2}1;auto;smt(get_oget in_dom getP). + auto;smt(in_dom get_oget getP formatK parseK nseq0 cats0 valid_gt0). + qed. + + + + local lemma equiv_ideal' (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S,F.FRO}) &m: + Pr[SLCommon.IdealIndif(IF,S,SLCommon.DRestr(A(D))).main() @ &m : res] = + Pr[IdealIndif(Squeeze(IF), SimLast(S), DRestr(D)).main() @ &m : res]. + proof. + rewrite (equiv_ideal D &m). + byequiv(Ideal_equiv D)=>//. + qed. + + (* Real part *) @@ -1206,211 +1335,51 @@ section Real_Ideal. local lemma pr_real (D <: DISTINGUISHER{SLCommon.C, C, Perm, Redo}) &m : - Pr [ GReal(A(D)).main() @ &m : res /\ SLCommon.C.c <= max_size] <= + Pr [ GReal(A(D)).main() @ &m : res /\ SLCommon.C.c <= max_size] = Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res]. proof. cut->: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. + byequiv (equiv_sponge D)=>//=;progress;smt(). qed. -(* This lemma is false, overuse of valid tests *) + declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.RRO, S, BIRO.IRO}. - local equiv Ideal_equiv_valid (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : - L2(D,F.RO).main - ~ - 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;sp;if;auto. - call(: ={glob IF,glob S});auto. - sp;if;auto;if;auto;sp. - - call(: ={glob IF});2:auto;2:smt();sp;if;auto;1:smt(). - inline F.LRO.sample;call(: ={glob IF});auto;progress. - by while{1}(true)(n{1}-i{1});auto;smt(). - by inline*;auto. - + 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. - sp;if;auto;progress;1,2:smt(). - + call(: ={glob IF});auto. - conseq(:_==> true);auto. - by inline*;while{1}(true)(n{1}-i{1});auto;smt(). - by inline*;auto. - call(: ={glob IF});auto;sp;if;auto;1:smt(). - + call(: ={glob IF});auto. - conseq(:_==> true);auto. - by inline*;while{1}(true)(n{1}-i{1});auto;smt(). - by inline*;auto. - qed. + axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : + islossless P0.f => islossless P0.fi => islossless F0.f => + islossless D(F0, P0).distinguish. - (* TODO : Ideal *) - - - local lemma equiv_ideal - (IF <: FUNCTIONALITY{DSqueeze,C}) - (S <: SIMULATOR{DSqueeze,C,IF}) - (D <: NDISTINGUISHER{C,DSqueeze,IF,S}) : - equiv [ S(IF).init ~ S(IF).init : true ==> ={glob S} ] => - equiv [ IF.init ~ IF.init : true ==> ={glob IF} ] => - equiv [ Indif(IF,S(IF),DRestr(A(D))).main - ~ NIndif(Squeeze(IF),S(IF),NDRestr(D)).main - : ={glob D} - ==> - ={res, glob D, glob IF, glob S, NC.queries, C.c, C.c} ]. + 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. - move=>S_init IF_init. - proc;inline*;sp;wp;swap{2}2-1;swap{1}[3..5]-2;sp. - call(: ={glob IF, glob S, C.c, glob DSqueeze} - /\ SLCommon.C.c{1} <= NC.c{1} <= max_size - /\ inv_ideal NC.queries{1} C.queries{1});auto;last first. - + call IF_init;auto;call S_init;auto;smt(dom_set in_fsetU1 dom0 in_fset0 parse_nil max_ge0). - + proc;inline*;sp;if;auto;1:call(: ={glob IF});auto;1:proc(true);progress=>//=. - + by proc;inline*;sp;if;auto;1:call(: ={glob IF});auto;proc(true)=>//=. - proc;inline*;sp=>/=;if;auto;if{2};last first. - + wp;conseq(:_==> lres{1} = oget NC.queries.[(p,i)]{1} - /\ i{1} = n{1} - /\ inv_ideal NC.queries{1} C.queries{1} - /\ ={glob IF, glob S, C.c, NC.queries});progress. - while{1}((0 < i{1} => lres{1} = oget NC.queries.[(p,i)]{1}) - /\ 0 <= i{1} <= n{1} - /\ ((p{1}, n{1}) \in dom NC.queries{1}) - /\ valid p{1} /\ 0 < n{1} - /\ inv_ideal NC.queries{1} C.queries{1} - /\ ={glob IF, glob S, C.c, NC.queries})(n{1}-i{1});progress. - - sp;rcondf 1;auto;progress;2..:rewrite/#. - cut[]h1[]h2 h3 :=H5. - cut h5:=h2 _ _ H2 n{hr} _;1:rewrite/#. - cut :=h3 _ h5 (i2+1) _;1:rewrite/#. - by cut<-/= :=h1 _ _ H2 n{hr} _;1:rewrite/#. - by auto=>/#. - - sp;if{2}. - + rcondt{2}7;1:auto;wp;sp. print inv_ideal. - while(={glob IF, glob S, C.c, NC.queries} /\ - (i,n,p,lres){1} = (i0,n0,p0,lres0){2} /\ - inv_ideal NC.queries{1} C.queries{1} /\ - - alias - - - + sp;auto=>/=. - rcondf{2}1;1:auto;progress. - + move:H4;pose s:= List.map _ _;pose c:=C.c{hr};pose p:=p{hr};pose n:=n{hr}. - apply absurd=>//=. - print diff_size_prefixe_leq_cat. prefixe_leq_prefixe_cat_size. - search prefixe (++). - - cut h:size (format p n) = size p + n - 1 by rewrite size_cat size_nseq max_ler /#. -sear - cut h':max_size < c + size (format p n) - smt(prefixe_sizel). - while{1}(={n, p, glob IF, glob S, NC.queries} - /\ i{1} = nb_iter{2} /\ lres{1} = r{2} - /\ inv_ideal NC.queries{1} C.queries{1} - /\ max_size <= SLCommon.C.c{1} - - - conseq(:_ ==> lres{1} = mkseq (+Block.b0) i{1} /\ i{1} = n{1} - /\ ={glob IF, glob S} /\ SLCommon.C.c{1} = max_size - /\ inv_ideal NC.queries{1} C.queries{1} - /\ NC.queries{1} = NC.queries{2}.[(p{1}, n{1}) <- lres{1}]); - 1:smt(min_ler min_lel max_ler max_ler). - while{1}(lres{1} = mkseq (+Block.b0) i{1} /\ i{1} = n{1} - /\ ={glob IF, glob S} /\ SLCommon.C.c{1} = max_size - /\ inv_ideal NC.queries{1} C.queries{1} - /\ NC.queries{1} = NC.queries{2}.[(p{1}, n{1}) <- lres{1}]) - (n{1}-i{1}); - - rcondt{2}1;1:auto;progress. search min. - + pose m:=C.c{hr}+_. - cut/#:1 <=min n{hr} (max 0 (n{hr} + max_size - m)). - apply min_is_glb=>[/#|]. - - rewrite /min/max. + 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. -print RealIndif. - + (* REAL & IDEAL *) -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 <- map0; - mi <- map0; - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - paths <- map0.[c0 <- ([<:block>],b0)]; - } - - proc f(x : state): state = { - var p, v, y, y1, y2; - if (!mem (dom m) x) { - if (mem (dom paths) x.`2) { - (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 (mem (dom paths) x.`2) { - (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 (!mem (dom mi) x) { - y1 <$ bdistr; - y2 <$ cdistr; - y <- (y1,y2); - mi.[x] <- y; - m.[y] <- x; - } else { - y <- oget mi.[x]; - } - return y; - } -}. + lemma concl &m : + Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res ] <= + Pr [ IdealIndif(Squeeze(IF), SimLast(S), DRestr(D)).main() @ &m : res ] + + (max_size ^ 2)%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. + rewrite-(pr_real D &m). + rewrite-(equiv_ideal' D &m). + apply(Real_Ideal (A(D)) A_lossless &m). + qed. -lemma Real_Ideal &m (D <: DISTINGUISHER): - Pr[Indif(SqueezelessSponge(PC(Perm)), PC(Perm), D).main() @ &m: res /\ C.c <= max_size] <= - Pr[Indif(IF,S(IF),DRestr(D)).main() @ &m :res] + - (max_size ^ 2)%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. -search max_size. - apply (ler_trans _ _ _ (Pr_restr _ _ _ _ _ _ &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]). - + by byequiv (_: ={glob G3, F.RO.m} ==> _)=>//;symmetry;conseq (F.RO_LRO_D G3). - 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]);1:by byequiv (F.RO_LRO_D G4). - by byequiv G4_Ideal. -qed. - +end section Real_Ideal. \ No newline at end of file From cfb474abddb6758df54e4eb04827fe3566ec6661 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Wed, 23 May 2018 17:22:44 +0200 Subject: [PATCH 284/394] RP.eca is back --- sha3/proof/RP.eca | 79 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 79 insertions(+) create mode 100644 sha3/proof/RP.eca diff --git a/sha3/proof/RP.eca b/sha3/proof/RP.eca new file mode 100644 index 0000000..6c54150 --- /dev/null +++ b/sha3/proof/RP.eca @@ -0,0 +1,79 @@ +(*************************- Random Permutation -*************************) + +require import Core Real FSet NewFMap Distr. +require import Dexcepted StdOrder. import RealOrder. +require import Ring StdRing. import RField. +require Monoid. import AddMonoid. + +type t. +op dt : t distr. + +module type RP = { + proc init() : unit + proc f(x : t) : t + proc fi(x : t) : t +}. + +module type DRP = { + proc f(x : t) : t + proc fi(x : t) : t +}. + +module P : RP, DRP = { + var m : (t, t) fmap + var mi : (t, t) fmap + + proc init() = { m = map0; mi = map0; } + + proc f(x) = { + var y; + + if (! mem (dom m) x) { + y <$ dt \ (mem (rng m)); + m.[x] <- y; + mi.[y] <- x; + } + return oget m.[x]; + } + + proc fi(x) = { + var y; + + if (! mem (dom mi) x) { + y <$ dt \ (mem (rng mi)); + mi.[x] <- y; + m.[y] <- x; + } + return oget mi.[x]; + } +}. + +lemma P_init_ll: islossless P.init. +proof. by proc; auto. qed. + +(* maybe a useful standard lemma? *) + +lemma mu_except ['a] (d : 'a distr, y : 'a, P : 'a -> bool) : + y \in d => ! P y => mu d P < mu d predT. +proof. +move=> in_supp_yd notP_y. +have -> : mu d P = mu d predT - mu d (predC P) + by rewrite (mu_split d predT P) mu_not mu_and #ring. +rewrite ltr_subl_addl (ltr_le_trans (mu d (pred1 y) + mu d predT)). +by rewrite -(add0r (mu _ _)) 1:ltr_le_add. +by rewrite ler_add mu_sub /pred1; first move=> ?. +qed. + +lemma P_f_ll: is_lossless dt => support dt = predT => islossless P.f. +proof. +move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. +have [y not_mem_y_rng_m] := endo_dom_rng P.m{m} _; first by exists x{m}. +by rewrite dexcepted_ll // -d_ll (mu_except dt y) -/(support _ _) 1:d_fu. +qed. + +lemma P_fi_ll: is_lossless dt => support dt = predT => islossless P.fi. +proof. +move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. +have [y not_mem_y_rng_mi] := endo_dom_rng P.mi{m} _; first by exists x{m}. +by rewrite dexcepted_ll // -d_ll (mu_except dt y) -/(support _ _) 1:d_fu. +qed. From 2ddc87be26e9c0c3909b33533a64a139bceb50be Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Wed, 16 May 2018 15:05:01 +0200 Subject: [PATCH 285/394] Proof completed of the transformation : (block list -> block) ==> ((block list * int) -> block list). --- sha3/proof/smart_counter/Gconcl_list.ec | 794 +++++++++++++++++------- 1 file changed, 572 insertions(+), 222 deletions(-) diff --git a/sha3/proof/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec index f2a77f9..7645d37 100644 --- a/sha3/proof/smart_counter/Gconcl_list.ec +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -10,9 +10,14 @@ require (*--*) Handle. (** Validity of Functionality Queries **) op valid: block list -> bool = valid_block. axiom valid_spec p: valid p => p <> []. -axiom valid_ge0 x: 0 <= (parse x).`2. -axiom valid_gt0 x: valid (parse x).`1 => 0 < (parse x).`2. - +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. @@ -74,21 +79,39 @@ module NIndif (F : FUNCTIONALITY, P : PRIMITIVE, D : DISTINGUISHER) = { 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; + } +}. -section Real_Ideal. +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. - module Valid (F : DFUNCTIONALITY) = { - proc init () = {} - proc f (q : block list, k : int) = { - var re : block list <- []; - if (valid q) { - re <@ F.f(q,k); - } - return re; - } - }. - module SimLast (S : SLCommon.SIMULATOR) (F : DFUNCTIONALITY) = S(Last(Valid(F))). +section Ideal. op (<=) (m1 m2 : (block list, 'b) fmap) = forall x, x <> [] => x \in dom m1 => m1.[x] = m2.[x]. @@ -148,7 +171,7 @@ section Real_Ideal. m1.[x <- y] <= m2.[x <- y] by smt(in_dom getP dom_set in_fsetU1). - local equiv ideal_equiv (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : + 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 @@ -261,56 +284,29 @@ section Real_Ideal. 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); + while (i < n) { + i <- i + 1; + F.sample(format p i); } + b <@ F.get(x); return b; } }. - local module SampleFirst (I : BIRO.IRO) = { - proc init = I.init - proc f (m : block list, k : int) = { - var r : block list <- []; - if (k <= 0) { - I.f(m,1); - } else { - r <- I.f(m,k); - } - return r; - } - }. - - - axiom valid_uniq p1 p2 n1 n2 : - valid p1 => valid p2 => format p1 n1 = format p2 n2 => p1 = p2 /\ n1 = n2. - - op inv_map (m1 : (block list, block) fmap) (m2 : (block list * int, block) fmap) = - (forall p n, valid p => (p,n) \in dom m2 <=> format p (n+1) \in dom m1) - /\ (forall x, x \in dom m1 <=> ((parse x).`1,(parse x).`2-1) \in dom m2) - /\ (forall p n, valid p => m2.[(p,n-1)] = m1.[format p n]) - /\ (forall x, m1.[x] = m2.[((parse x).`1,(parse x).`2-1)]). 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; - if (valid s) { - r <@ F.get(q); - } + r <@ F.get(q); return r; } }. @@ -319,7 +315,7 @@ section Real_Ideal. proc distinguish = SLCommon.IdealIndif(Valid2(F), S, A(D)).main }. - local equiv Ideal_equiv_valid (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : + local equiv Ideal_equiv_valid (D <: DISTINGUISHER{SLCommon.C, C, IF, S}) : L(D,F.LRO).distinguish ~ L2(D,F.LRO).distinguish @@ -327,11 +323,11 @@ section Real_Ideal. ={glob D} ==> ={glob D, res}. proof. proc;inline*;sp;wp. - call(: ={glob F.RO, glob S, glob C});auto. + call(: ={glob S, glob C, glob F.RO});auto. + proc;sp;if;auto. - call(: ={glob IF,glob S});auto. + call(: ={glob S,glob F.RO});auto. sp;if;auto;if;auto;sp. - call(: ={glob IF});2:auto;2:smt();sp;if;auto;1:smt(). + 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. @@ -340,18 +336,17 @@ section Real_Ideal. while(={glob S,glob IF,lres,i,n,p,b}). + sp;if;auto. call(: ={glob IF});auto. - sp;if;auto;progress;1,2:smt(). call(: ={glob IF});auto. conseq(:_==> true);auto. by inline*;while{1}(true)(n{1}-i{1});auto;smt(). - call(: ={glob IF});auto;sp;if;auto;1: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, BIRO.IRO, S}) : + 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. @@ -361,39 +356,47 @@ section Real_Ideal. call(: ={glob F.RO, glob S});auto. if;1,3:auto;sim;if;auto. call(: ={glob F.RO});2:auto. - (* This is false *) - admit. + 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. - rcondt{1}1;1:auto;1:smt(parse_valid parseK formatK);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 sp;rcondt{1}1;auto;smt(parse_valid parseK formatK). - auto;smt(parse_valid parseK formatK). - auto;smt(parse_valid parseK formatK). + - by auto;smt(parse_valid parseK formatK). + by auto;smt(parse_valid parseK formatK). + by auto;smt(parse_valid parseK formatK). qed. - local module IF2(F : F.RO) = { - proc init = F.init + inductive inv_L_L3 (m1 m2 m3 : (block list, block) fmap) = + | INV of (m1 = m2 + m3) + & (forall l, l \in dom m2 => valid (parse l).`1) + & (forall l, l \in dom 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) { - if (0 < n) { - while (i < n) { - i <- i + 1; - F.sample(format p i); - } - b <@ F.get(x); - } else { - F.sample(x); + 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; } @@ -401,40 +404,169 @@ section Real_Ideal. local module (L3 (D : DISTINGUISHER) : F.RO_Distinguisher) (F : F.RO) = { - proc distinguish = SLCommon.IdealIndif(IF2(F), S, A(D)).main + 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 dom m1 => + ! format p i \in dom 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;cut[]add_maps valid_dom nvalid_dom:=INV0. + + rewrite add_maps fmapP=>x. + by rewrite getP !joinP getP;smt(parseK formatK). + + smt(dom_set in_fsetU1 parseK formatK). + + smt(dom_set in_fsetU1 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 dom m1 => + format p i \in dom m2. + proof. + move=>INV0 p_valid i_gt0 in_dom1;cut[]add_maps valid_dom nvalid_dom:=INV0. + cut:=in_dom1;rewrite add_maps dom_join in_fsetU=>[][]//=in_dom3. + by cut:=nvalid_dom _ in_dom3;rewrite parseK//=. + qed. + + + local lemma incl_dom m1 m2 m3 l : + inv_L_L3 m1 m2 m3 => + l \in dom m1 <=> (l \in dom m2 \/ l \in dom m3). + proof. + move=>INV0;cut[]add_maps valid_dom nvalid_dom:=INV0. + by rewrite add_maps dom_join in_fsetU. + qed. + - local equiv Ideal_equiv3 (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : + local lemma lemma3 m1 m2 m3 x r: + inv_L_L3 m1 m2 m3 => + ! valid (parse x).`1 => + ! x \in dom m1 => + inv_L_L3 m1.[x <- r] m2 m3.[x <- r]. + proof. + move=>INV0 not_valid nin_dom1;cut[]add_maps h1 h2:=INV0. + cut nin_dom3: ! x \in dom m3 by smt(incl_dom). + split. + + by rewrite fmapP=>y;rewrite add_maps !getP!joinP!getP dom_set in_fsetU1/#. + + exact h1. + smt(dom_set in_fsetU1). + 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 F.RO, glob C});auto;first last. - + by proc;sim. - + proc;sp;if;auto;call(: ={glob F.RO});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). - rcondt{1}1;1:auto;1:smt(parse_valid parseK formatK);sp. - rcondf{1}3;1:auto;1:smt(parse_valid parseK formatK);sp. 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(dom_set in_fsetU1 nseq0 cats0 parse_valid). case(0 < n{1});auto;last first. - - by rcondf{1}8;1:auto;rcondf{2}8;1:auto;sim=>/#. - while(={i,n,p,lres,b,F.RO.m} /\ valid p{1} /\ 0 <= i{1} <= n{1}). + - 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). - rcondt{1}1;2:rcondt{2}1;1,2:(auto;smt(parseK formatK parse_valid)). - conseq(:_==> ={b,F.RO.m});2:sim;progress=>/#. - by wp 5 5;conseq(:_==> ={F.RO.m,r,x2});2:sim;smt(). - proc;sp;if;auto;call(: ={F.RO.m, glob S});auto. - if;1,3:auto;sim;if;auto. - call(: ={glob F.RO});auto;sp;inline*. - if;1,3:auto;1:smt(). - rcondt{2}1;1:auto;1:smt(parse_valid parseK formatK valid_gt0);sim;smt(). + 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!getP//=. + * smt(lemma1 parse_valid). + * smt(lemma2 parse_valid). + * smt(lemma2 parse_valid). + * smt(incl_dom). + * smt(incl_dom). + * case:H8;smt(joinP). + 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 dom 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. + + cut[]add_maps h1 h2:=H5;rewrite add_maps joinP//=;smt(parse_valid). + + smt(). + case(x5{1} \in dom F.RO.m{1}). + - rcondf{1}2;2:rcondf{2}2;auto;progress. + * smt(lemma2 incl_dom parse_valid). + by cut[]add_maps h1 h2:=H1;rewrite add_maps joinP//=;smt(parse_valid). + rcondt{1}2;2:rcondt{2}2;auto;progress. + - smt(lemma2 incl_dom parse_valid). + - cut[]add_maps h1 h2:=H1;rewrite add_maps !getP joinP//=;smt(parse_valid nseq0 cats0). + - cut:=H;rewrite -H0=>//=[][]->>->>;apply lemma1=>//=;1:smt(parse_valid). + cut[]add_maps h1 h2:=H1;smt(parse_valid formatK parseK incl_dom). + + progress;split. + - by rewrite fmapP=>x;rewrite joinP map0P//=. + - smt(dom0 in_fset0). + - smt(dom0 in_fset0). + 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 dom F.RO.m{1}). + * rcondf{1}2;2:rcondf{2}2;auto;progress. + + cut:=H2;rewrite -formatK H/=;smt(lemma2 incl_dom parse_gt0). + cut[]add_maps h1 h2:=H1;rewrite add_maps joinP. + cut:=H2;rewrite -formatK H/==>in_dom1. + case(format p{2} n{2} \in dom F2.RO.m{2})=>//=in_dom3. + by cut:=h2 _ in_dom3;rewrite parseK//=;smt(parse_gt0). + rcondt{1}2;2:rcondt{2}2;auto;progress. + + smt(incl_dom lemma2). + + cut[]:=H1;smt(getP joinP). + by cut:=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 dom F.RO.m{1}). + - by rcondf{1}2;2:rcondf{2}2;auto;smt(lemma2). + by rcondt{1}2;2:rcondt{2}2;auto;progress;smt(incl_dom lemma1). + 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 dom F.RO.m{1}). + - rcondf{1}2;2:rcondf{2}2;auto;progress. + * cut[]:=H1;smt(incl_dom). + cut[]:=H1;smt(joinP incl_dom). + rcondt{1}2;2:rcondt{2}2;auto;progress. + * cut[]:=H1;smt(incl_dom). + * cut[]:=H1;smt(joinP incl_dom getP). + 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 dom F.RO.m{1}). + - rcondf{1}2;2:rcondf{2}2;auto;progress. + * cut[]:=H2;smt(incl_dom lemma2 formatK parse_not_valid). + smt(). + rcondt{1}2;2:rcondt{2}2;auto;progress. + * smt(incl_dom lemma1). + * smt(). + * by cut:=lemma3 _ _ _ _ r0L H2 _ H5;smt(parse_not_valid). + auto;smt(). qed. local module D2 (D : DISTINGUISHER) (F : F.RO) = { @@ -446,151 +578,368 @@ section Real_Ideal. }. - local lemma equiv_ideal (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S,F.FRO}) &m: - Pr[SLCommon.IdealIndif(IF,S,SLCommon.DRestr(A(D))).main() @ &m : res] = - Pr[L3(D,F.RO).distinguish() @ &m : res]. - proof. - cut->: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)=>//=. - cut<-:Pr[L(D, F.RO).distinguish() @ &m : res] = - Pr[L3(D, F.RO).distinguish() @ &m : res]. - + by byequiv(Ideal_equiv3 D). - cut<-:Pr[L2(D,F.RO).distinguish() @ &m : res] = - Pr[SLCommon.IdealIndif(IF,S,A(D)).main() @ &m : res]. - + by byequiv(ideal_equiv2 D). - cut->:Pr[L2(D, F.RO).distinguish() @ &m : res] = - Pr[L2(D,F.LRO).distinguish() @ &m : res]. - + byequiv=>//=;proc;sp;inline*;sp;wp. - transitivity{1} { - b1 <@ D2(D,F.RO).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); } - (={glob D, glob F.RO, glob C, glob S} ==> ={b1}) - (={glob D, glob F.RO, glob C, glob S} ==> ={b1});progress;1:smt();1:sim. - transitivity{1} { - b1 <@ D2(D,F.LRO).distinguish(); + while (i < n) { + i <- i + 1; + b <@ F.get(format p i); + lres <- rcons lres b; } - (={glob D, glob F.RO, glob C, glob S} ==> ={b1}) - (={glob D, glob F.RO, glob C, glob S} ==> ={b1});progress;1:smt();2:sim. - by call(F.RO_LRO_D (D2(D)));auto. - cut->:Pr[L(D, F.RO).distinguish() @ &m : res] = - Pr[L(D,F.LRO).distinguish() @ &m : res]. - + byequiv=>//=;proc;sp;inline*;sp;wp. - transitivity{1} { - b1 <@ D3(D,F.RO).distinguish(); + } else { + if (nn <= 0) { + F2.sample(pp); } - (={glob D, glob F.RO, glob C, glob S} ==> ={b1}) - (={glob D, glob F.RO, glob C, glob S} ==> ={b1});progress;1:smt();1:sim. - transitivity{1} { - b1 <@ D3(D,F.LRO).distinguish(); + while (i < nn - n) { + i <- i + 1; + F2.sample(format pp i); } - (={glob D, glob F.RO, glob C, glob S} ==> ={b1}) - (={glob D, glob F.RO, glob C, glob S} ==> ={b1});progress;1:smt();2:sim. - by call(F.RO_LRO_D (D3(D)));auto. - rewrite eq_sym. - by byequiv(Ideal_equiv_valid D). - qed. + 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 equiv double_squeeze : - DSqueeze(IF2(F.RO)).f ~ Squeeze(IF).f : - ={arg, F.RO.m} ==> ={res, F.RO.m}. + 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;if;auto;sp. - rcondt{1}1;1:(auto;smt(parse_valid valid_gt0)). - rcondt{1}1;1:(auto;smt(parse_valid valid_gt0)). - rcondt{1}1;1:(auto;smt(parse_valid valid_gt0));sp. - rcondf{1}3;1:(auto;smt(parse_valid valid_gt0));sp. - case(0 < n{1});last first. - + rcondf{2}4;1:auto=>/#. - rcondf{1}8;1:auto=>/#. - rcondf{1}5. - + auto;smt(nseq0 cats0 dom_set in_fsetU1 parse_valid). - by wp;rnd{1};auto;smt(DBlock.dunifin_ll nseq0 cats0 parse_valid set_eq in_dom). - while(={F.RO.m,n,b,i,lres,p} /\ valid p{1} /\ 0 < n{1} /\ 0 <= i{1} <= n{1} - /\ (i{1}+1 < n{1} => (forall j, 0 <= j <= i{1} => format p{1} (j+1) \in dom F.RO.m{1}))). - + sp;if;1,3:auto=>/#. - sp;rcondt{1}1;1:(auto;smt(parseK formatK)). - rcondt{1}1;1:(auto;smt(parseK formatK valid_gt0)). - conseq(:_==> ={b,F.RO.m} /\ (forall (j : int), 0 <= j <= i{1} => - format p{1} (j+1) \in dom F.RO.m{2}));1:smt(). + 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 dom_set in_fsetU1 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 dom 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(dom_set in_fsetU1 nseq0 cats0 parse_valid). + wp 4 2;rnd{1};wp 2 2. + conseq(:_==> ={F.RO.m} /\ r3{1} = r0{2} /\ x9{1} \in dom F.RO.m{1}); + 1:smt(DBlock.dunifin_ll nseq0 cats0 parse_valid). + by auto;smt(parse_valid nseq0 cats0 dom_set in_fsetU1). + 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(valid_gt0 parseK formatK). + - by while(i1 < n1);auto;smt(parse_gt0 parse_valid parseK formatK). rcondf{1}7;1:auto. - + by while(i1 < n1);auto;smt(valid_gt0 parseK formatK). - seq 3 0 : (={F.RO.m,x0} /\ x0{1} = format p{1} (i{1}+1) /\ x4{1} = x0{1} /\ - (forall (j : int), 0 <= j < i{1} => format p{1} (j+1) \in dom F.RO.m{2}));last first. - + sp;rcondf{1}5;1:auto;1:smt(dom_set in_fsetU1). - by wp;rnd{1};auto;smt(DBlock.dunifin_ll dom_set in_fsetU1). - wp. - conseq(:_==> ={F.RO.m} /\ i1{1} + 1 = n1{1});1:smt(parseK formatK). - while{1}(={F.RO.m} /\ 0 < i1{1} + 1 <= n1{1} <= n{1} /\ - (forall j, 0 <= j < n1{1}-1 => format p1{1} (j+1) \in dom F.RO.m{1}))(n1{1}-i1{1}). - + by progress;sp;rcondf 2;auto;smt(DBlock.dunifin_ll). - by auto;smt(formatK parseK). - by rcondf{1}5;2:(wp;rnd{1});auto;smt(DBlock.dunifin_ll dom_set in_fsetU1 nseq0 cats0 parse_valid). + - by while(i1 < n1);auto;smt(parse_gt0 parse_valid parseK formatK). + rcondf{1}9;1:auto. + - conseq(:_==> i1 + 1 = n1);1:smt(dom_set in_fsetU1 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 dom 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 dom F.RO.m{1});last first. + - auto;smt(dom_set in_fsetU1). + wp;conseq(:_==> ={F.RO.m} /\ i1{1} + 1 = n1{1} + /\ (forall (j : int), 1 <= j < n1{1} => + format p1{1} j \in dom 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 dom 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(DBlock.dunifin_ll). 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});1:smt(DBlock.dunifin_ll 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. - local equiv Ideal_equiv (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : - L3(D,F.RO).distinguish + 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 dom m2 <=> x \in dom m1) + /\ (forall p n x, parse x = (p,n+1) => x \in dom m1 <=> (p,n) \in dom 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 dom m2 => valid p /\ 0 <= n) + & (forall p n, (p,n) \in dom 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 dom 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;cut[]inv12 inv34 dom2 dom4:=INV0;cut[]h1[]h2[]h3 h4:=inv12;split=>//=. + + progress. + - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=[]->>->>;smt(parseK formatK). + - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=->>;smt(parseK formatK). + - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=->>;smt(parseK formatK). + - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=;smt(parseK formatK). + - smt(getP parseK formatK). + smt(getP parseK formatK). + smt(getP parseK formatK dom_set in_fsetU1). + qed. + + local lemma lemma5bis m1 m2 m3 m4 p i r : + INV_L4_ideal m1 m2 m3 m4 => + ! (p,i) \in dom 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; + cut[]inv12 inv34 dom2 dom4:=INV0; + cut[]h1[]h2[]h3 h4:=inv34; + split=>//=. + + progress. + - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=[]->>->>;smt(parseK formatK). + - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=->>;smt(parseK formatK). + - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=->>;smt(parseK formatK). + - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=;smt(parseK formatK). + - smt(getP parseK formatK). + smt(getP parseK formatK). + smt(getP parseK formatK dom_set in_fsetU1). + 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(Squeeze(IF), SimLast(S), DRestr(D)).main + IdealIndif(BIRO.IRO,SimLast(S),DRestr(D)).main : ={glob D} ==> ={glob D, res}. proof. - proc;inline*;auto;sp. - call(: ={glob S, glob C, F.RO.m});auto;first last. - + by proc;inline*;sp;if;auto;sp;if;auto. - + proc;sp;if;auto;sp. - by call(double_squeeze);auto;progress. - proc;sp;if;auto;inline{1}1;inline{2}1;sp;if;1:auto;sim;if;auto. - sp;inline*;sp;if;1,3:(auto;smt(parse_valid));sp. - rcondt{1}1;1:(auto;smt(parse_valid valid_gt0)). - rcondt{2}1;1:(auto;smt(parse_valid valid_gt0));sp. - rcondt{1}1;1:(auto;smt(parse_valid valid_gt0));sp. - splitwhile{2}4: i + 1 < n. - rcondt{2}5;1:auto. - + while(i < n);1:(sp;if);auto;smt(valid_gt0). - rcondf{2}7;1:auto. - + while(i < n);1:(sp;if);auto;smt(valid_gt0). - rcondf{2}7;1:auto. - + while(i < n);1:(sp;if);auto;smt(valid_gt0). - seq 3 4 : (F.RO.m.[x0]{1} = Some b{2} /\ ={x, C.c, S.paths, F.RO.m});last first. - + sp;rcondf{1}2;auto;smt(in_dom DBlock.dunifin_ll last_rcons). - conseq(: _==> F.RO.m{1}.[format p0{1} i{1}] = Some b{2} /\ i{1} = n{1} /\ ={F.RO.m});progress. - + rewrite-H7;congr;smt(parseK formatK). - while(={F.RO.m,n} /\ i{1} = i{2} + 1 /\ p0{1} = p1{2} /\ i{1} <= n{1} - /\ F.RO.m{1}.[format p0{1} i{1}] = Some b{2}). - + sp;rcondt{2}1;auto;smt(get_oget in_dom getP). - auto;smt(in_dom get_oget getP formatK parseK nseq0 cats0 valid_gt0). + 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(dom0 in_fset0 map0P)). + + 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. + - cut[]h1 _ _ _:=H1;cut[]h'1 _:=h1;smt(parseK). + - smt(getP). + - smt(). + - exact lemma5. + rcondf{1}2;auto;progress. + - cut[]h1 _ _ _:=H1;cut[]h'1 _:=h1;smt(parseK). + - smt(DBlock.dunifin_ll). + - cut[]h1:=H1;cut[]:=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. + - cut[]_ h1 _ _:=H2;cut[]:=h1;progress. + cut:=H7 x0{m} i0{m} (format x0{m} (i0{m} + 1));rewrite H5/==>->//=. + cut->/#:=parse_twice _ _ _ H. + - smt(getP). + - smt(). + - apply lemma5bis=>//=. + rewrite(parse_twice _ _ _ H)/#. + rcondf{1}2;auto;progress. + - cut[]_ h1 _ _:=H2;cut[]:=h1;progress. + cut:=H7 x0{m} i0{m} (format x0{m} (i0{m} + 1));rewrite H5/==>->//=. + cut->/#:=parse_twice _ _ _ H. + - smt(DBlock.dunifin_ll). + - cut[]_ h1 _ _:=H2;cut[]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. + - cut[]h1 _ _ _:=H1;cut[]h'1 _:=h1;smt(parseK). + - smt(getP). + - smt(). + - exact lemma5. + rcondf{1}2;auto;progress. + - cut[]h1 _ _ _:=H1;cut[]h'1 _:=h1;smt(parseK). + - smt(DBlock.dunifin_ll). + - cut[]h1:=H1;cut[]:=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))))). - local lemma equiv_ideal' (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S,F.FRO}) &m: + 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(Squeeze(IF), SimLast(S), DRestr(D)).main() @ &m : res]. + Pr[IdealIndif(BIRO.IRO,SimLast(S),DRestr(D)).main() @ &m : res]. proof. - rewrite (equiv_ideal D &m). - byequiv(Ideal_equiv D)=>//. + cut->: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)=>//=. + cut<-:Pr[L2(D,F.RO).distinguish() @ &m : res] = + Pr[SLCommon.IdealIndif(IF,S,A(D)).main() @ &m : res]. + + by byequiv(ideal_equiv2 D). + cut->:Pr[L2(D, F.RO).distinguish() @ &m : res] = + Pr[L2(D,F.LRO).distinguish() @ &m : res]. + + byequiv=>//=;proc;sp;inline*;sp;wp. + by call(F.RO_LRO_D (D2(D)));auto. + cut->: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)=>//=. + cut<-:Pr[L4(D, F.RO, F2.RO).distinguish() @ &m : res] = + Pr[L4(D,F.LRO,F2.LRO).distinguish() @ &m : res]. + + cut->: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. + by call(F.RO_LRO_D (D5(D)));auto. + byequiv=>//=;proc;sp;inline*;sp;wp. + by call(F2.RO_LRO_D (D6(D)));auto. + cut<-:Pr[L3(D, F.RO).distinguish() @ &m : res] = + Pr[L4(D, F.RO, F2.RO).distinguish() @ &m : res]. + + by byequiv(equiv_L3_L4 D)=>//=. + cut<-:Pr[L(D, F.RO).distinguish() @ &m : res] = + Pr[L3(D, F.RO).distinguish() @ &m : res]. + + by byequiv(Ideal_equiv3 D). + cut->:Pr[L(D, F.RO).distinguish() @ &m : res] = + Pr[L(D,F.LRO).distinguish() @ &m : res]. + + byequiv=>//=;proc;sp;inline*;sp;wp. + by call(F.RO_LRO_D (D3(D)));auto. + rewrite eq_sym. + by byequiv(Ideal_equiv_valid D). qed. +end section Ideal. - (* Real part *) + (* Real part *) - - pred inv_ideal (squeeze : (block list * int, block list) fmap) - (c : (block list, block) fmap) = - (forall p n, (p,n) \in dom squeeze => - forall i, 1 <= i <= n => (p,i) = parse (format p i)) /\ - (forall p n, (p,n) \in dom squeeze => - forall i, 1 <= i <= n => format p i \in dom c) /\ - (forall l, l \in dom c => - forall i, 1 <= i <= (parse l).`2 => ((parse l).`1,i) \in dom squeeze). +section Real. inductive m_p (m : (state, state) fmap) (p : (block list, state) fmap) = | IND_M_P of (p.[[]] = Some (b0, c0)) @@ -598,7 +947,6 @@ section Real_Ideal. 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) @@ -644,7 +992,7 @@ section Real_Ideal. smt(take_le0 take_oversize size_take take_take take_size nth_take in_dom). qed. - local lemma lemma2 c1 c2 m mi p bl i sa sc: + local lemma lemma2' c1 c2 m mi p bl i sa sc: INV_Real c1 c2 m mi p => 1 < i => valid bl => @@ -924,7 +1272,7 @@ section Real_Ideal. sp;if;auto;progress. - move:H4 H5;rewrite!getP/=!oget_some nth_last -(addzA _ _ 1)/=take_size. rewrite last_cat last_nseq 1:/# Block.WRing.addr0;progress. - cut//=:=lemma2(SLCommon.C.c{1} + 1)(C.c{2} + size bl{2} + i{2}) + cut//=:=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 -(addzA _ 1)/=H1/=!dom_set!in_fsetU1/=H4/=H2/=getP/=oget_some/=. @@ -936,7 +1284,7 @@ section Real_Ideal. - move:H4 H5;rewrite nth_last -(addzA _ _ 1)/=take_size. rewrite last_cat last_nseq 1:/# Block.WRing.addr0;progress. pose a:=(_, _);cut->/={a}:a = oget Perm.m{2}.[(sa0_R, sc0{2})] by smt(). - apply lemma2=>//=;first cut:=H3=>hinv0;split;case:hinv0=>//=/#. + apply lemma2'=>//=;first cut:=H3=>hinv0;split;case:hinv0=>//=/#. smt(). smt(). - by rewrite dom_set in_fsetU1//=-(addzA _ _ 1)/=take_size;smt(in_dom). @@ -1049,7 +1397,7 @@ section Real_Ideal. by rewrite Block.WRing.addr0=>H_pm;rewrite H_pm/=. qed. - local lemma lemma3 c1 c2 m mi p bl b (sa:block) sc: + 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 dom m => ! rcons bl b \in dom p => @@ -1172,7 +1520,7 @@ section Real_Ideal. + by rewrite getP/=. + by rewrite behead_drop drop_add. + rewrite!getP/=oget_some. - cut:=lemma3 0 C.c{2}Perm.m{2}.[(sa{2} +^ nth witness p0{1} i0{1}, sc{2}) <- yL] + cut:=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!dom_set!in_fsetU1/=-take_nth//=H5/=H1/=getP/=oget_some. @@ -1189,7 +1537,7 @@ section Real_Ideal. + by rewrite getP. + by rewrite behead_drop drop_add. + rewrite(take_nth witness)//=. - cut:=lemma3 0 C.c{2} Perm.m{2} Perm.mi{2} Redo.prefixes{1} + cut:=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). @@ -1266,7 +1614,7 @@ section Real_Ideal. cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). rewrite Block.WRing.addr0 !getP/=oget_some take_oversize;1:rewrite size_cat size_nseq/#. move=>H_dom_iS H_dom_p. - cut:=lemma2 0 C.c{2} Perm.m{2}.[(sa{2}, sc{2}) <- y0L] + cut:=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). @@ -1280,7 +1628,7 @@ section Real_Ideal. + move:H5 H6;rewrite take_oversize 1:size_cat 1:size_nseq 1:/#. rewrite nth_cat;cut->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). rewrite nth_nseq//=1:/# Block.WRing.addr0 =>h1 h2. - by cut:=lemma2 0 C.c{2} Perm.m{2} Perm.mi{2} Redo.prefixes{1} + by cut:=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;cut->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). @@ -1334,7 +1682,7 @@ section Real_Ideal. - local lemma pr_real (D <: DISTINGUISHER{SLCommon.C, C, Perm, Redo}) &m : + 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. @@ -1344,8 +1692,12 @@ section Real_Ideal. byequiv (equiv_sponge D)=>//=;progress;smt(). qed. +end section Real. - declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.RRO, S, BIRO.IRO}. + +section Real_Ideal. + (* REAL & IDEAL *) + declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.RRO, S}. axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : islossless P0.f => islossless P0.fi => islossless F0.f => @@ -1368,17 +1720,15 @@ section Real_Ideal. call H1;auto;smt(). qed. - (* REAL & IDEAL *) - lemma concl &m : Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res ] <= - Pr [ IdealIndif(Squeeze(IF), SimLast(S), DRestr(D)).main() @ &m : res ] + + Pr [ IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res ] + (max_size ^ 2)%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. - rewrite-(pr_real D &m). - rewrite-(equiv_ideal' D &m). + rewrite-(pr_real D &m). + rewrite-(equiv_ideal D &m). apply(Real_Ideal (A(D)) A_lossless &m). qed. From 34fb9fd38054fefac0a80b8d120bca419c4a25a7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 25 May 2018 03:08:45 +0100 Subject: [PATCH 286/394] Update PG include path --- sha3/proof/.dir-locals.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/proof/.dir-locals.el b/sha3/proof/.dir-locals.el index 9c03066..542d7f0 100644 --- a/sha3/proof/.dir-locals.el +++ b/sha3/proof/.dir-locals.el @@ -1,4 +1,4 @@ ((easycrypt-mode . ((eval . (flet ((pre (s) (concat (locate-dominating-file buffer-file-name ".dir-locals.el") s))) - (setq easycrypt-load-path `(,(pre "smart_counter")))))))) + (setq easycrypt-load-path `(,(pre ".") ,(pre "smart_counter")))))))) From c5d410122d7088db515ce400e7c293e0ff07f033 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 17 May 2018 11:30:02 +0200 Subject: [PATCH 287/394] Proof completed until high-level. Cleaning to do (e.g. distinguisher's restrictions). --- sha3/proof/BlockSponge.ec | 20 +-- sha3/proof/SHA3-Security.ec | 73 ++++++----- sha3/proof/smart_counter/Gconcl_list.ec | 155 +++++++++++++++++++++++- 3 files changed, 200 insertions(+), 48 deletions(-) diff --git a/sha3/proof/BlockSponge.ec b/sha3/proof/BlockSponge.ec index c2e3531..acdaf0d 100644 --- a/sha3/proof/BlockSponge.ec +++ b/sha3/proof/BlockSponge.ec @@ -151,13 +151,13 @@ module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { (* this is just for typechecking, right now: *) -lemma conclusion : - forall (D <: DISTINGUISHER) &m, - `| Pr[RealIndif(Sponge, Perm, DRestr(D)).main() @ &m : res] - - Pr[IdealIndif(IRO, Sim, DRestr(D)).main() @ &m : res]| - <= (max_size ^ 2)%r / 2%r * Distr.mu1 dstate witness + - max_size%r * ((2 * max_size)%r / (2 ^ c)%r) + - max_size%r * ((2 * max_size)%r / (2 ^ c)%r). -proof. -admit. -qed. +(* lemma conclusion : *) +(* forall (D <: DISTINGUISHER) &m, *) +(* `| Pr[RealIndif(Sponge, Perm, DRestr(D)).main() @ &m : res] *) +(* - Pr[IdealIndif(IRO, Sim, DRestr(D)).main() @ &m : res]| *) +(* <= (max_size ^ 2)%r / 2%r * Distr.mu1 dstate witness + *) +(* max_size%r * ((2 * max_size)%r / (2 ^ c)%r) + *) +(* max_size%r * ((2 * max_size)%r / (2 ^ c)%r). *) +(* proof. *) +(* admit. *) +(* qed. *) diff --git a/sha3/proof/SHA3-Security.ec b/sha3/proof/SHA3-Security.ec index d295459..05e892a 100644 --- a/sha3/proof/SHA3-Security.ec +++ b/sha3/proof/SHA3-Security.ec @@ -4,7 +4,7 @@ require import AllCore List IntDiv StdOrder Distr. require import Common Sponge. import BIRO. -require SLCommon BlockSponge. +require SLCommon Gconcl_list. (* FIX: would be nicer to define limit at top-level and then clone BlockSponge with it - so BlockSponge would then clone lower-level @@ -85,8 +85,14 @@ module DRestr (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { section. declare module Dist : - DISTINGUISHER{Perm, BlockSponge.Sim, IRO, Cntr, BlockSponge.BIRO.IRO, - BlockSponge.C}. + DISTINGUISHER{Perm, Gconcl_list.SimLast, IRO, Cntr, BlockSponge.BIRO.IRO, + BlockSponge.C, Gconcl.S, + SLCommon.F.RO, SLCommon.F.RRO, SLCommon.Redo, SLCommon.C, + Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO}. + +axiom Dist_lossless (F <: DFUNCTIONALITY) (P <: DPRIMITIVE) : + islossless P.f => islossless P.fi => islossless F.f => + islossless Dist(F,P).distinguish. lemma drestr_commute1 &m : Pr[BlockSponge.RealIndif @@ -121,21 +127,21 @@ qed. lemma drestr_commute2 &m : Pr[BlockSponge.IdealIndif - (BlockSponge.BIRO.IRO, BlockSponge.Sim, + (BlockSponge.BIRO.IRO, Gconcl_list.SimLast(Gconcl.S), LowerDist(DRestr(Dist))).main() @ &m : res] = Pr[BlockSponge.IdealIndif - (BlockSponge.BIRO.IRO, BlockSponge.Sim, + (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 BlockSponge.Sim}); first sim. + glob Gconcl_list.SimLast(Gconcl.S)}); first sim. inline*; wp; sp. call - (_ : - ={c}(Cntr, BlockSponge.C) /\ ={BlockSponge.BIRO.IRO.mp} /\ - ={glob BlockSponge.Sim}). + (_ : ={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=> /=. @@ -146,14 +152,15 @@ 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.S.paths, Gconcl.S.mi, Gconcl.S.m}). + ={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. -auto; progress; by rewrite blocks2bits_nil. +auto; progress. by rewrite blocks2bits_nil. auto. qed. @@ -162,7 +169,7 @@ op wit_pair : block * capacity = witness. lemma security &m : `|Pr[RealIndif(Sponge, Perm, DRestr(Dist)).main() @ &m : res] - Pr[IdealIndif - (IRO, RaiseSim(BlockSponge.Sim), + (IRO, RaiseSim(Gconcl_list.SimLast(Gconcl.S)), DRestr(Dist)).main() @ &m : res]| <= (limit ^ 2)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. proof. @@ -176,11 +183,7 @@ have -> : rewrite (fromintM (2 ^ r)) StdRing.RField.invfM StdRing.RField.mulrA -!StdRing.RField.mulrA. congr; by rewrite StdRing.RField.mul1r. -rewrite -{1}block_card -{1}capacity_card - -(DBlock.dunifin1E wit_pair.`1) -(DCapacity.dunifin1E wit_pair.`2) - -StdRing.RField.mulrA -DProd.dprod1E. -have -> : (wit_pair.`1, wit_pair.`2) = witness - by rewrite /wit_pair // {3}(pairS witness). +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). @@ -188,27 +191,31 @@ have -> : have {3}-> : 2 = 1 + 1 by trivial. rewrite powS // pow1 /#. rewrite -/SLCommon.dstate /limit. -rewrite - (RealOrder.ler_trans - (`|Pr[BlockSponge.RealIndif - (BlockSponge.Sponge, Perm, LowerDist(DRestr(Dist))).main() @ &m : res] - - Pr[BlockSponge.IdealIndif - (BlockSponge.BIRO.IRO, BlockSponge.Sim, - LowerDist(DRestr(Dist))).main() @ &m : res]|)) - 1:RealOrder.lerr_eq - 1:(conclusion BlockSponge.Sim (DRestr(Dist)) &m) // - (drestr_commute1 &m) (drestr_commute2 &m) StdRing.RField.addrA - (BlockSponge.conclusion (LowerDist(Dist)) &m). +cut->:=conclusion (Gconcl_list.SimLast(Gconcl.S)) (DRestr(Dist)) &m. +cut//=:=(Gconcl_list.Real_Ideal (LowerDist(Dist)) _ &m). ++ move=>F P hp hpi hf'//=. + cut hf:islossless RaiseFun(F).f. + - proc;call hf';auto. + exact(Dist_lossless (RaiseFun(F)) P hp hpi hf). +by rewrite(drestr_commute1 &m) (drestr_commute2 &m);smt(). qed. end section. lemma SHA3Security - (Dist <: - DISTINGUISHER{Perm, IRO, BlockSponge.BIRO.IRO, Cntr, - BlockSponge.Sim, BlockSponge.C}) &m : + (Dist <: DISTINGUISHER{ + Perm, IRO, BlockSponge.BIRO.IRO, Cntr, + Gconcl_list.SimLast(Gconcl.S), BlockSponge.C, Gconcl.S, + SLCommon.F.RO, SLCommon.F.RRO, SLCommon.Redo, SLCommon.C, + Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO}) + &m : + (forall (F <: DFUNCTIONALITY) (P <: DPRIMITIVE), + 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, RaiseSim(BlockSponge.Sim), DRestr(Dist)).main() @ &m : res]| <= + (IRO, RaiseSim(Gconcl_list.SimLast(Gconcl.S)), DRestr(Dist)).main() @ &m : res]| <= (limit ^ 2)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. -proof. apply (security Dist &m). qed. +proof. move=>h;apply (security Dist h &m). qed. diff --git a/sha3/proof/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec index 7645d37..e998c81 100644 --- a/sha3/proof/smart_counter/Gconcl_list.ec +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -1697,7 +1697,7 @@ end section Real. section Real_Ideal. (* REAL & IDEAL *) - declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.RRO, S}. + declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.RRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO}. axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : islossless P0.f => islossless P0.fi => islossless F0.f => @@ -1723,13 +1723,158 @@ section Real_Ideal. 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)%r / 2%r * mu dstate (pred1 witness) + + (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). proof. rewrite-(pr_real D &m). - rewrite-(equiv_ideal D &m). - apply(Real_Ideal (A(D)) A_lossless &m). + rewrite-(equiv_ideal D &m). + cut:=Real_Ideal (A(D)) A_lossless &m. print DProd. + pose x:=witness;elim:x=>a b. + by rewrite/dstate DProd.dprod1E DBlock.dunifin1E DCapacity.dunifin1E/= + block_card capacity_card;smt(). qed. -end section Real_Ideal. \ No newline at end of file + +end section Real_Ideal. + + +require import AdvAbsVal. + +print AdvAbsVal. + +section Real_Ideal_Abs. + + declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.RRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO}. + + 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 dom m => Distr.is_lossless ((bdistr `*` cdistr) \ mem (rng m)). + proof. + move=>hinvm nin_dom. + cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). + + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. + apply dexcepted_ll=>//=;rewrite-prod_ll. + cut->:predT = predU (predC (mem (rng m))) (mem (rng m));1:rewrite predCU//=. + rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. + cut/=->:=ltr_add2l (mu (bdistr `*` cdistr) (mem (rng m))) 0%r. + rewrite Distr.witness_support/predC. + move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. + cut{hyp}hyp:forall x, x \in rng m by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + move:a. + cut:=eqEcard (dom m) (rng m);rewrite leq_card_rng_dom/=. + cut->//=/#:dom m \subset rng m;rewrite subsetP=>x;rewrite hyp//=. + 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 cut:=useful _ _ _ H H1. + - smt(invm_set dexcepted1E). + + proc;inline*;sp;if;auto;sp;if;auto;progress. + - cut:=H;rewrite invmC=>h;cut/#:=useful _ _ _ h H1. + - move:H;rewrite invmC=>H;rewrite invmC;smt(invm_set dexcepted1E in_dom in_rng). + + 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 cut:=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 cut:=useful _ _ _ H H1. + * smt(invm_set dexcepted1E). + * smt(size_behead). + * smt(size_behead). + smt(size_ge0 size_eq0). + smt(map0P). + 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)%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. + cut->: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. + cut->: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. + cut h1 := Neg_A_Pr_minus (RealIndif(Sponge,P,DRestr(Neg_D(D)))) &m Real_lossless. + cut h2 := Neg_A_Pr_minus (IdealIndif(BIRO.IRO, SimLast(S), DRestr(Neg_D(D)))) &m Ideal_lossless. + cut/#:=concl (Neg_D(D)) _ &m;progress. + by proc;call(D_lossless F0 P0 H H0 H1);auto. + qed. + + lemma 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)%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. + cut := concl D D_lossless &m. + cut := 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!(StdRing.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. + From 672ea3ad1b4b5a82cc913c071a247aafe9a6ab21 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 25 May 2018 03:08:59 +0100 Subject: [PATCH 288/394] Remove large timeout --- sha3/config/tests.config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/config/tests.config b/sha3/config/tests.config index d5c1ee1..73f88f9 100644 --- a/sha3/config/tests.config +++ b/sha3/config/tests.config @@ -1,6 +1,6 @@ [default] bin = easycrypt -args = -I proof -I proof/smart_counter -timeout 180 +args = -I proof -I proof/smart_counter [test-sha3] okdirs = !proof From 8fe3c5c7cb55a9de1e75b05dfdb3df093a8c2d9b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Fri, 18 May 2018 15:47:59 +0200 Subject: [PATCH 289/394] inlined simulator to help the simulator's complexity analysis --- sha3/proof/SHA3-Security.ec | 130 +++++++++++++++++++++++++++++++++--- 1 file changed, 120 insertions(+), 10 deletions(-) diff --git a/sha3/proof/SHA3-Security.ec b/sha3/proof/SHA3-Security.ec index 05e892a..3cbd007 100644 --- a/sha3/proof/SHA3-Security.ec +++ b/sha3/proof/SHA3-Security.ec @@ -1,10 +1,10 @@ (* Top-level Proof of SHA-3 Security *) -require import AllCore List IntDiv StdOrder Distr. +require import AllCore List IntDiv StdOrder Distr NewFMap FSet. require import Common Sponge. import BIRO. -require SLCommon Gconcl_list. +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 @@ -12,9 +12,73 @@ require SLCommon Gconcl_list. 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 <- map0; + mi <- map0; + paths <- map0.[c0 <- ([],b0)]; + Gconcl_list.BIRO2.IRO.init(); + } + proc f (x : state) : state = { + var p,v,z,q,k,cs,y,y1,y2; + if (! x \in dom m) { + if (x.`2 \in dom 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 dom 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 dom 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 @@ -86,7 +150,7 @@ section. declare module Dist : DISTINGUISHER{Perm, Gconcl_list.SimLast, IRO, Cntr, BlockSponge.BIRO.IRO, - BlockSponge.C, Gconcl.S, + Simulator, BlockSponge.C, Gconcl.S, SLCommon.F.RO, SLCommon.F.RRO, SLCommon.Redo, SLCommon.C, Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO}. @@ -166,13 +230,55 @@ 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, RaiseSim(Gconcl_list.SimLast(Gconcl.S)), - DRestr(Dist)).main() @ &m : res]| <= + Pr[IdealIndif(IRO, Simulator, DRestr(Dist)).main() @ &m : res]| <= (limit ^ 2)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. proof. +rewrite -(replace_simulator &m). rewrite powS 1:addz_ge0 1:ge0_r 1:ge0_c -pow_add 1:ge0_r 1:ge0_c. have -> : (limit ^ 2)%r / (2 * (2 ^ r * 2 ^ c))%r = @@ -200,11 +306,14 @@ cut//=:=(Gconcl_list.Real_Ideal (LowerDist(Dist)) _ &m). by rewrite(drestr_commute1 &m) (drestr_commute2 &m);smt(). qed. + + + end section. lemma SHA3Security (Dist <: DISTINGUISHER{ - Perm, IRO, BlockSponge.BIRO.IRO, Cntr, + Perm, IRO, BlockSponge.BIRO.IRO, Cntr, Simulator, Gconcl_list.SimLast(Gconcl.S), BlockSponge.C, Gconcl.S, SLCommon.F.RO, SLCommon.F.RRO, SLCommon.Redo, SLCommon.C, Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO}) @@ -215,7 +324,8 @@ lemma SHA3Security islossless F.f => islossless Dist(F,P).distinguish) => `|Pr[RealIndif(Sponge, Perm, DRestr(Dist)).main() @ &m : res] - - Pr[IdealIndif - (IRO, RaiseSim(Gconcl_list.SimLast(Gconcl.S)), DRestr(Dist)).main() @ &m : res]| <= + Pr[IdealIndif(IRO, Simulator, DRestr(Dist)).main() @ &m : res]| <= (limit ^ 2)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. proof. move=>h;apply (security Dist h &m). qed. + + From 2fdec2219de0a5132427b84ec22e41fddf87e2eb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 30 Jul 2018 17:45:53 +0100 Subject: [PATCH 290/394] Fix Strong_rp_rf proof --- sha3/proof/smart_counter/Strong_rp_rf.eca | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/sha3/proof/smart_counter/Strong_rp_rf.eca b/sha3/proof/smart_counter/Strong_rp_rf.eca index 99d42fe..fae5908 100644 --- a/sha3/proof/smart_counter/Strong_rp_rf.eca +++ b/sha3/proof/smart_counter/Strong_rp_rf.eca @@ -24,7 +24,7 @@ clone import StrongPRP as PRPt with type K <- K, op dK <- dK, type D <- D -proof * by smt ml=0 w=dK_ll +proof * by smt(dK_ll) rename "StrongPRP_" as "". clone import IdealPRP as PRPi with @@ -450,7 +450,7 @@ section CollisionProbability. * by hoare; auto=> //=; smt w=(RealOrder.mulr_ge0 mu_bounded ge0_q). + move=> c; proc. rcondt 2; 1:by auto. sp; if=> //=. - * inline*;sp;if;auto;smt(size_set). + * inline*;sp;if;auto=> /#. * by auto=> /#. + by move=> b c; proc; rcondf 2; auto. + exists*FEL.c;elim*=> c. @@ -468,7 +468,7 @@ section CollisionProbability. * by hoare; auto; smt w=(RealOrder.mulr_ge0 mu_bounded ge0_q). + move=> c; proc; rcondt 2; 1:by auto. sp; if=> //=. - * inline*;sp;if;auto;smt(size_set). + * inline*;sp;if;auto=> /#. * by auto=> /#. + by move=> b c; proc; rcondf 2; auto. qed. From f171f831f0d6907614674a3ff593844cdf59f2df Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 25 May 2018 03:09:40 +0100 Subject: [PATCH 291/394] Simplify some smt calls in Handle --- sha3/proof/smart_counter/Handle.eca | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index aca0768..b821d31 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -1463,8 +1463,8 @@ have /incli_of_INV <- := inv0; 1:by rewrite Gmi_xaxc. rewrite Pmi_xaxc=> /= [#] <<*>. rcondf{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. by auto=> &1 &2 /#. -progress;cut[]//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H1;smt(in_dom). -progress;cut[]//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H1;smt(in_dom). ++ by move=> /> &1 &2 _ _ /m_p_of_INV []; smt(in_dom). +by move=> /> &1 &2 -> ->. qed. @@ -1765,7 +1765,7 @@ call(: !G1.bcol{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 in_dom;cut[]_->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. - inline*; if{2}; auto; smt (@Block @Capacity). + 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=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0} /= [p0 v0] [#] Hro Hpath. have /pi_of_INV [] /(_ x2 p0 v0) /iffRL /(_ _) := inv0. @@ -1788,7 +1788,7 @@ call(: !G1.bcol{2} cut[]_->_ _ _//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. case((x2, Unknown) \in rng hs0)=>//=_. exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). - progress;cut[]//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H1;smt(in_dom). + by move=> /> &1 &2 -> ->. qed. lemma head_nth (w:'a) l : head w l = nth w l 0. @@ -1946,8 +1946,8 @@ proof. * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom). * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom). * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom set_eq). - * by cut[]:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom). - * smt. + * by cut[]:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom). + * by rewrite build_hpathP; apply/Empty=> //; exact/take0. * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom size_take size_eq0). * smt(prefixe_sizel). From 52fc3bd60833fbfed7e2eb583930bb5050eec8d3 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Sun, 20 May 2018 08:39:33 +0200 Subject: [PATCH 292/394] CI --- sha3/config/tests.config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/config/tests.config b/sha3/config/tests.config index b386ecb..9a3096e 100644 --- a/sha3/config/tests.config +++ b/sha3/config/tests.config @@ -1,5 +1,5 @@ [default] -bin = ec.native +bin = easycrypt args = -I proof -I proof/variant -I proof/core [test-sha3] From 6a4b26ba96ae858984e6dcfe23544b5351e96dd7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Wed, 23 May 2018 13:00:13 +0200 Subject: [PATCH 293/394] remove unnecessary files --- sha3/proof/RP.eca | 79 - sha3/proof/attic/LeakyAbsorb.ec | 416 ---- sha3/proof/clean/BlockSponge.eca | 1014 --------- sha3/proof/clean/NewCommon.ec | 73 - sha3/proof/clean/NewCore.eca | 139 -- sha3/proof/core/ConcreteF.eca | 186 -- sha3/proof/core/CoreToBlockSponge.eca | 165 -- sha3/proof/core/Gcol.eca | 317 --- sha3/proof/core/Gconcl.ec | 384 ---- sha3/proof/core/Gext.eca | 675 ------ sha3/proof/core/Handle.eca | 1865 ----------------- sha3/proof/core/IndifPadding.ec | 123 -- sha3/proof/core/LazyRO.eca | 22 - sha3/proof/core/SLCommon.ec | 395 ---- sha3/proof/core/Utils.ec | 63 - .../proof/smart_counter/CoreToBlockSponge.eca | 165 -- sha3/proof/smart_counter/IndifPadding.ec | 123 -- sha3/proof/smart_counter/LazyRO.eca | 22 - 18 files changed, 6226 deletions(-) delete mode 100644 sha3/proof/RP.eca delete mode 100644 sha3/proof/attic/LeakyAbsorb.ec delete mode 100644 sha3/proof/clean/BlockSponge.eca delete mode 100644 sha3/proof/clean/NewCommon.ec delete mode 100644 sha3/proof/clean/NewCore.eca delete mode 100644 sha3/proof/core/ConcreteF.eca delete mode 100644 sha3/proof/core/CoreToBlockSponge.eca delete mode 100644 sha3/proof/core/Gcol.eca delete mode 100644 sha3/proof/core/Gconcl.ec delete mode 100644 sha3/proof/core/Gext.eca delete mode 100644 sha3/proof/core/Handle.eca delete mode 100644 sha3/proof/core/IndifPadding.ec delete mode 100644 sha3/proof/core/LazyRO.eca delete mode 100644 sha3/proof/core/SLCommon.ec delete mode 100644 sha3/proof/core/Utils.ec delete mode 100644 sha3/proof/smart_counter/CoreToBlockSponge.eca delete mode 100644 sha3/proof/smart_counter/IndifPadding.ec delete mode 100644 sha3/proof/smart_counter/LazyRO.eca diff --git a/sha3/proof/RP.eca b/sha3/proof/RP.eca deleted file mode 100644 index 6c54150..0000000 --- a/sha3/proof/RP.eca +++ /dev/null @@ -1,79 +0,0 @@ -(*************************- Random Permutation -*************************) - -require import Core Real FSet NewFMap Distr. -require import Dexcepted StdOrder. import RealOrder. -require import Ring StdRing. import RField. -require Monoid. import AddMonoid. - -type t. -op dt : t distr. - -module type RP = { - proc init() : unit - proc f(x : t) : t - proc fi(x : t) : t -}. - -module type DRP = { - proc f(x : t) : t - proc fi(x : t) : t -}. - -module P : RP, DRP = { - var m : (t, t) fmap - var mi : (t, t) fmap - - proc init() = { m = map0; mi = map0; } - - proc f(x) = { - var y; - - if (! mem (dom m) x) { - y <$ dt \ (mem (rng m)); - m.[x] <- y; - mi.[y] <- x; - } - return oget m.[x]; - } - - proc fi(x) = { - var y; - - if (! mem (dom mi) x) { - y <$ dt \ (mem (rng mi)); - mi.[x] <- y; - m.[y] <- x; - } - return oget mi.[x]; - } -}. - -lemma P_init_ll: islossless P.init. -proof. by proc; auto. qed. - -(* maybe a useful standard lemma? *) - -lemma mu_except ['a] (d : 'a distr, y : 'a, P : 'a -> bool) : - y \in d => ! P y => mu d P < mu d predT. -proof. -move=> in_supp_yd notP_y. -have -> : mu d P = mu d predT - mu d (predC P) - by rewrite (mu_split d predT P) mu_not mu_and #ring. -rewrite ltr_subl_addl (ltr_le_trans (mu d (pred1 y) + mu d predT)). -by rewrite -(add0r (mu _ _)) 1:ltr_le_add. -by rewrite ler_add mu_sub /pred1; first move=> ?. -qed. - -lemma P_f_ll: is_lossless dt => support dt = predT => islossless P.f. -proof. -move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. -have [y not_mem_y_rng_m] := endo_dom_rng P.m{m} _; first by exists x{m}. -by rewrite dexcepted_ll // -d_ll (mu_except dt y) -/(support _ _) 1:d_fu. -qed. - -lemma P_fi_ll: is_lossless dt => support dt = predT => islossless P.fi. -proof. -move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. -have [y not_mem_y_rng_mi] := endo_dom_rng P.mi{m} _; first by exists x{m}. -by rewrite dexcepted_ll // -d_ll (mu_except dt y) -/(support _ _) 1:d_fu. -qed. diff --git a/sha3/proof/attic/LeakyAbsorb.ec b/sha3/proof/attic/LeakyAbsorb.ec deleted file mode 100644 index 8f03201..0000000 --- a/sha3/proof/attic/LeakyAbsorb.ec +++ /dev/null @@ -1,416 +0,0 @@ -(* -------------------------------------------------------------------- *) -require import Option Pair Int Real Distr List FSet NewFMap DProd. -require (*--*) LazyRP RndOrcl. - -(* -------------------------------------------------------------------- *) - -type block. (* = {0,1}^r *) -type capacity. (* = {0,1}^c *) - -op cdist : capacity distr. -op bdist : block distr. -axiom bdist_ll : weight bdist = 1%r. - -(* isomorphic to the {0,1}^? uniform distributions *) - -op b0 : block. -op c0 : capacity. - -op (^) : block -> block -> block. - -(* -------------------------------------------------------------------- *) -clone import LazyRP as Perm with - type D <- block * capacity, - op d <- bdist `*` cdist - - rename [module] "P" as "Perm". - - -(* -------------------------------------------------------------------- *) -module type WeirdIRO = { - proc init(): unit - - proc f(_: block list * int): block list -}. - -module type WeirdIRO_ = { - proc f(_: block list * int): block list -}. - -op valid_query : block list -> int -> bool. -op valid_queries : (block list) fset. -axiom valid_queryP : forall m n, valid_query m n => forall k, 0 <= k <= n => mem valid_queries (m ++ mkseq (fun x => b0) k). -axiom valid_query_take : forall m n, valid_query m n => forall i, 0 <= i <= size m => mem valid_queries (take i m). -axiom valid_query_take1 : - forall m n, valid_query m n => forall i, 0 <= i <= size m => valid_query (take i m) 1. -axiom valid_query_size : forall m n, valid_query m n => 1 <= size m. - -module type RO = { - proc init () : unit - proc f(_:block list) : block -}. - -module Ro = { - var h : (block list,block) fmap - - proc init() = { h = map0; } - - proc f(m : block list) = { - var r; - r <$ bdist; - if (!mem (dom h) m) h.[m] <- r ; - return oget h.[m]; - } -}. - -module GenIdealFunctionalityThatDoesNotAbsorb(Ro:RO) = { - proc init = Ro.init - - proc f(m : block list, n : int) = { - var i <- 1; - var j <- 1; - var z <- []; - var b <- b0; - - if (valid_query m n) { - while (j <= size m) { - z <- rcons z b; - b <@ Ro.f(take j m); - j <- j + 1; - } - while (i < n) { - z <- rcons z b; - m <- rcons m b0; - b <@ Ro.f(m); - i <- i + 1; - } - } - return z; - } -}. - -module IdealFunctionalityThatDoesNotAbsorb = GenIdealFunctionalityThatDoesNotAbsorb(Ro). - -module GenIdealFunctionalityThatAbsorbs(Ro:RO) = { - proc init = Ro.init - - proc f(m : block list, n : int) = { - var i <- 1; - var z <- []; - var b; - - if (valid_query m n) { - b <@ Ro.f(m); - while (i < n) { - z <- rcons z b; - m <- rcons m b0; - b <@ Ro.f(m); - i<- i + 1; - } - } - return z; - } -}. - -module IdealFunctionalityThatAbsorbs = GenIdealFunctionalityThatAbsorbs(Ro). - -(* -------------------------------------------------------------------- *) -module type CONSTRUCTION(P : RP) = { - proc init() : unit - - proc f(bp : block list, n : int) : block list -}. - -module type SIMULATOR(F : WeirdIRO_) = { - proc init() : unit - - proc f(_ : block * capacity) : block * capacity - - proc fi(_ : block * capacity) : block * capacity -}. - -module type DISTINGUISHER(F : WeirdIRO_, P : RP_) = { - proc distinguish() : bool -}. - -(* -------------------------------------------------------------------- *) -module Experiment(F : WeirdIRO, P : RP, D : DISTINGUISHER) = { - proc main() : bool = { - var b; - - F.init(); - P.init(); - b <@ D(F, P).distinguish(); - - return b; - } -}. - -(* -------------------------------------------------------------------- *) -module SpongeThatDoesNotAbsorb (P : RP) : WeirdIRO, CONSTRUCTION(P) = { - proc init () = { } - - proc f(p : block list, n : int): block list = { - var z <- []; - var (sa,sc) <- (b0, c0); - var i <- 0; - var l <- size p; - - if (valid_query p n) { - (* Absorption *) - while (p <> []) { - z <- rcons z sa; - (sa,sc) <@ P.f(sa ^ head b0 p, sc); - p <- behead p; - } - (* Squeezing *) - while (i < n) { - z <- rcons z sa; - (sa,sc) <@ P.f(sa,sc); - } - } - - return z; - } -}. - -module SpongeThatAbsorbs (P : RP) : WeirdIRO, CONSTRUCTION(P) = { - proc init () = {} - - proc f(p : block list, n : int): block list = { - var z <- []; - var (sa,sc) <- (b0, c0); - var i <- 0; - - if (valid_query p n) { - (* Absorption *) - while (p <> []) { - (sa,sc) <@ P.f(sa ^ head b0 p, sc); - p <- behead p; - } - (* Squeezing *) - while (i < n) { - z <- rcons z sa; - (sa,sc) <@ P.f(sa,sc); - } - } - - return z; - } -}. - -(* -------------------------------------------------------------------- *) -section PROOF. - declare module S:SIMULATOR { IdealFunctionalityThatDoesNotAbsorb }. - declare module D:DISTINGUISHER { Perm, IdealFunctionalityThatDoesNotAbsorb, S }. - - (* From DoNot to Absorb *) - - module MkF(F:WeirdIRO_) = { - proc f(m:block list, n:int) = { - var r = []; - if (valid_query m n) { - r <@ F.f(m,n); - r <- drop (size m) r; - } - return r; - } - }. - - (* From Absord to do Not *) - module MkD (D:DISTINGUISHER, F:WeirdIRO_, P:RP_) = D(MkF(F),P). - - module MkFdoNot1 (F:WeirdIRO_) = { - proc f(m:block list, n:int) : block list = { - var i, r, tl, b; - r <- []; - if (valid_query m n) { - i <- 1; - b <- [b0]; - while (i <= size m) { - r <- r ++ b; - b <- F.f(take i m, 1); - i <- i + 1; - - } - tl <- F.f(m,n); - r <- r ++ tl; - } - return r; - } - }. - - module MkFdoNot (F:WeirdIRO) = { - proc init = F.init - proc f = MkFdoNot1(F).f - }. - - module MkS(S:SIMULATOR, F:WeirdIRO) = S(MkFdoNot(F)). - - local clone RndOrcl as RndOrcl0 with - type from <- block list, - type to <- block. - - local clone RndOrcl0.RestrIdeal as RI with - op sample <- fun (bl:block list) => bdist, - op test <- (mem valid_queries), - op univ <- valid_queries, - op dfl <- b0 - proof *. - realize sample_ll. by move=> _;apply bdist_ll. qed. - realize testP. by []. qed. - import RI. - - local module E1 (Ro:RO) = { - module F = { - proc f = GenIdealFunctionalityThatDoesNotAbsorb(Ro).f - } - module P = S(F) - proc distinguish () : bool = { - var b; - P.init(); - b <@ MkD(D, F, P).distinguish(); - return b; - } - }. - - local module E2 (Ro:RO) = { - module F = { - proc f = GenIdealFunctionalityThatAbsorbs(Ro).f - } - module P = S(MkFdoNot1(F)) - proc distinguish () : bool = { - var b; - P.init(); - b <@ D(F, P).distinguish(); - return b; - } - }. - - local equiv f_f : - GenIdealFunctionalityThatDoesNotAbsorb(Ro).f ~ E1(Restr(RO)).F.f : - ={m, n} /\ Ro.h{1} = RO.m{2} ==> ={res} /\ Ro.h{1} = RO.m{2}. - proof. - proc;sp;if => //. - inline{2} Restr(RO).f. - while (={z,i,n,b,m} /\ Ro.h{1} = RO.m{2} /\ - (forall k, 0 <= k <= n - i => mem valid_queries (m ++ map (fun x => b0) (iota_ 0 k))){2}). - + rcondt{2} 5=> //. - + auto;progress; rewrite - cats1;cut := H 1 _; [by smt| by rewrite iota1]. - auto; call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress]. - cut := H (k+1) _;1:by smt. - rewrite iotaS //= -cats1 -catA /= (_: map (fun (x : int) => b0) (iota_ 1 k) = map (fun (x : int) => b0) (iota_ 0 k)) //. - by rewrite (iota_addl 1 0 k) -map_comp;apply eq_map. - while (={z,j,n,b,m} /\ Ro.h{1} = RO.m{2} /\ valid_query m{1} n{1} /\ 0 <= j{1}). - + rcondt{2} 4=> //. - + auto;progress;apply (valid_query_take _ _ H)=> //. - auto; call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress;smt]. - skip;progress;apply (valid_queryP _ _ H2);smt. - qed. - - local equiv f_f_a : GenIdealFunctionalityThatAbsorbs(Ro).f ~ E2(Restr(RO)).F.f : ={m,n} /\ Ro.h{1} = RO.m{2} ==> ={res} /\ Ro.h{1} = RO.m{2}. - proof. - proc; sp;if=> //;inline{2} Restr(RO).f;sp. - rcondt{2} 1=> //. - + auto;progress;cut := valid_query_take _ _ H (size m{hr}). - rewrite take_size=> HH;apply HH;smt. - while (={z,i,n,b,m} /\ Ro.h{1} = RO.m{2} /\ - (forall k, 0 <= k <= n - i => mem valid_queries (m ++ map (fun x => b0) (iota_ 0 k))){2}). - + rcondt{2} 5=> //. - + auto;progress; rewrite -cats1;cut := H 1 _; [by smt| by rewrite iota1]. - auto; call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress]. - cut := H (k+1) _;1:by smt. - rewrite iotaS //= -cats1 -catA /= (_: map (fun (x : int) => b0) (iota_ 1 k) = map (fun (x : int) => b0) (iota_ 0 k)) //. - by rewrite (iota_addl 1 0 k) -map_comp;apply eq_map. - wp;call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress]. - apply (valid_queryP _ _ H);smt. - qed. - - local equiv f_f' : - MkFdoNot(GenIdealFunctionalityThatAbsorbs(Ro)).f ~ MkFdoNot1(E2(Restr(RO)).F).f : - ={m, n} /\ Ro.h{1} = RO.m{2} ==> - ={res} /\ Ro.h{1} = RO.m{2}. - proof. - proc;sp;if => //;wp. - call f_f_a. - while (={i,m,r,b} /\ Ro.h{1} = RO.m{2} /\ valid_query m{1} n{1} /\ 0 <= i{1});last by auto. - wp; call f_f_a;auto;progress;smt. - qed. - - local equiv f_dN : E1(ERO).F.f ~ MkFdoNot1(E2(ERO).F).f : ={m, n} /\ ={RO.m} ==> ={res, RO.m}. - proof. - proc;sp;if=> //;sp. - inline {2} E2(ERO).F.f. - rcondt{2} 6;auto; 1: by conseq (_: _ ==> true). - while (={RO.m} /\ z{1} = r{2} ++ z0{2} /\ i{1} = i1{2} /\ n{1} = n1{2} /\ b{1} = b1{2} /\ - m{1} = m1{2}). - + inline *;auto;progress;smt. - inline ERO.f;auto. - while (={RO.m,m,n} /\ z{1} = r{2} /\ b{2} = [b{1}] /\ valid_query m{1} n{1} /\ - j{1} = i{2} /\ 0 <= i{2} /\ - (1 < j => b = mem valid_queries (take j m) ? oget RO.m.[x] : Self.b0){1}). - + rcondt{2} 6;1:by auto;progress;smt. - rcondf{2} 8;1:by auto. - auto;progress;smt. - auto;progress;smt. - qed. - - lemma conclusion &m: - `| Pr[Experiment(SpongeThatDoesNotAbsorb(Perm), Perm, MkD(D)).main() @ &m : res] - - Pr[Experiment(IdealFunctionalityThatDoesNotAbsorb, - S(IdealFunctionalityThatDoesNotAbsorb), MkD(D)).main() @ &m : res] | = - `|Pr[Experiment(SpongeThatAbsorbs(Perm),Perm,D).main() @ &m : res] - - Pr[Experiment(IdealFunctionalityThatAbsorbs, MkS(S,IdealFunctionalityThatAbsorbs), D).main() @ &m : res]|. - proof. - do 3?congr. - + byequiv (_: ={glob D} ==> _) => //;proc;inline *. - call (_: ={glob Perm});1,2:(by sim); last by auto. - proc;inline{1}SpongeThatDoesNotAbsorb(Perm).f;sp 1 3;if=> //. - sp;rcondt{1} 1=> //;wp. - while (={glob Perm, i, sa, sc} /\ n0{1} = n{2} /\ z{1} = take (size m{1}) z{1} ++ z{2} /\ size m{1} <= size z{1}). - + call (_ : ={glob Perm});[by sim|auto;progress [-split];smt]. - while (={glob Perm, p, sa,sc} /\ (size z = size m - size p){1}). - + wp;call (_ : ={glob Perm});[by sim|auto;progress [-split]]. - by rewrite size_rcons H; move: H0; case: (p{2})=> //= x xs; ring. - by auto;progress [-split];smt. - cut -> : Pr[Experiment(IdealFunctionalityThatDoesNotAbsorb, S(IdealFunctionalityThatDoesNotAbsorb), MkD(D)).main () @ &m : res] = - Pr[RndOrcl0.IND(Restr(RO), E1).main() @ &m : res]. - + byequiv=> //. (* PY: BUG printer res *) - proc;inline{2} E1(Restr(RO)).distinguish;auto. - call (_: ={glob S} /\ Ro.h{1} = RO.m{2}). - + by proc (Ro.h{1} = RO.m{2}) => //;apply f_f. - + by proc (Ro.h{1} = RO.m{2}) => //;apply f_f. - + by proc;sp;if=> //;wp;call f_f. - by inline *; call (_: Ro.h{1} = RO.m{2});auto;apply f_f. - cut -> : Pr[Experiment(IdealFunctionalityThatAbsorbs, MkS(S, IdealFunctionalityThatAbsorbs), D).main() @ &m : res] = - Pr[RndOrcl0.IND(Restr(RO), E2).main() @ &m : res]. - + byequiv=> //. - proc;inline{2} E2(Restr(RO)).distinguish;auto. - call (_: ={glob S} /\ Ro.h{1} = RO.m{2}). - + proc (Ro.h{1} = RO.m{2}) => //; apply f_f'. - + by proc (Ro.h{1} = RO.m{2}) => //;apply f_f'. - + conseq f_f_a => //. - by inline *;call (_:Ro.h{1} = RO.m{2});[apply f_f'|auto]. - cut -> : Pr[RndOrcl0.IND(Restr(RO), E1).main() @ &m : res] = - Pr[RndOrcl0.IND(ERO, E1).main() @ &m : res]. - + byequiv (Eager E1)=> //. - cut -> : Pr[RndOrcl0.IND(Restr(RO), E2).main() @ &m : res] = - Pr[RndOrcl0.IND(ERO, E2).main() @ &m : res]. - + byequiv (Eager E2)=> //. - byequiv=> //. - proc; inline *;wp. - call (_: ={RO.m, glob S}). - + by proc (={RO.m})=> //;apply f_dN. - + by proc (={RO.m})=> //;apply f_dN. - + proc;sp;if => //. - inline{1} E1(ERO).F.f;sp;rcondt{1} 1; 1:by auto. - wp;while (={RO.m,i,b} /\ n0{1} = n{2} /\ m0{1} = m{2} /\ z{1} = take (size m{1}) z{1} ++ z{2} /\ (size m <= size z){1}). - + inline *;auto;progress [-split]; smt. - inline *;splitwhile{1} 1 : (j < size m0). - wp;seq 1 0 : (={i,RO.m, m, glob S} /\ n0{1} = n{2} /\ m0{1} = m{2} /\ size m0{1} - 1 = size z{1} /\ size m0{1} = j{1} /\ z{2} = []). - while{1} (size z{1} = j{1} - 1 /\ j{1} <= size m0{1}) ((size m0 - j){1});auto;progress [-split]; smt. - rcondt{1} 1;1:by auto. - rcondf{1} 5;auto;progress[-split];smt. - call (_: ={RO.m})=> //;1:by apply f_dN. - sim : (={glob S, glob D, RO.m})=> //. - qed. diff --git a/sha3/proof/clean/BlockSponge.eca b/sha3/proof/clean/BlockSponge.eca deleted file mode 100644 index bcb4796..0000000 --- a/sha3/proof/clean/BlockSponge.eca +++ /dev/null @@ -1,1014 +0,0 @@ -require import Core Logic Distr. -require import Int IntExtra Real List NewFMap FSet. -require (*--*) StdBigop. -(*---*) import StdBigop.Bigint. -require import StdOrder. -(*---*) import IntOrder. - -require import Gconcl. -(*---*) import Common SLCommon. -(*---*) import Block DBlock Capacity DCapacity. - -(*** THEORY PARAMETERS ***) -(** Validity of Functionality Queries **) -op valid: block list -> bool. -axiom valid_spec p: valid p => p <> []. - -(** 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 p => parse (format p n) = (p,n). - -lemma parse_injective: injective parse. -proof. by move=> bs1 bs2 eq_format; rewrite -formatK eq_format (@formatK bs2). qed. - -lemma parse_valid p: valid p => parse p = (p,1). -proof. -move=>h;cut{1}->:p=format p 1;2:smt(parseK). -by rewrite/format/=nseq0 cats0. -qed. - -(******************* Useful lemmas ******************) -lemma take_nseq (b:block) i j : take i (nseq j b) = nseq (min i j) b. -proof. -move:i;elim/natind=>//=. -+ smt(take_le0 nseq0_le). -move=>i hi0 hind. -case(i + 1 <= j)=>hi1j. -+ rewrite (take_nth b);1:smt(size_nseq). - rewrite hind nth_nseq 1:/# //=-nseqSr/#. -rewrite take_oversize;smt(size_nseq). -qed. - -lemma sumid_leq (n m p : int) : 0 <= n => m <= p => sumid n m <= sumid n p. -proof. -move=>Hn0 Hmp. -case(m<=n)=>Hmn. search BIA.big 0 (<=). -+ rewrite BIA.big_geq//. - by apply sumr_ge0_seq=>//=;smt(mem_iota size_ge0). -rewrite(BIA.big_cat_int m n p) 1:/# //. -cut/#:0<=sumid m p. -by apply sumr_ge0_seq=>//=;smt(mem_iota size_ge0). -qed. - -(*** DEFINITIONS ***) -(** Low-Level Definitions **) -require (*--*) NewCore. - -clone import NewCore as Low with - op valid bs <- let (b,s) = bs in valid b /\ 0 < s -proof * by done. - -(** High-Level Definitions **) -(* Indifferentiability *) -clone import Indifferentiability as BS_Ind with - type p <- block * capacity, - type f_in <- block list, - type f_out <- block -proof * by done. - -(* BlockSponge Construction *) -module (BlockSponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { - proc init() = {} - - proc f(p : block list) : block = { - var (sa,sc) <- (b0,c0); - var i <- 0; - var (x,n) <- parse p; - - if (valid x /\ 0 < n) { - while (i < size p) { - (sa,sc) <@ P.f((sa +^ nth b0 p i,sc)); - i <- i + 1; - } - } - return sa; - } -}. - -(* Ideal Block Sponge Functionality *) -module IBlockSponge : FUNCTIONALITY = { - var m : (block list,block) fmap - - proc init() = { - m <- map0; - } - - proc fill_in(x) = { - if (!mem (dom m) x) { - m.[x] <$ bdistr; - } - return oget m.[x]; - } - - proc f(x : block list) = { - var bs <- b0; - var i <- 1; - - var (p,n) <- parse x; - if (valid p /\ 0 < n) { - while (i < n) { - fill_in(format p i); - i <- i + 1; - } - bs <@ fill_in(x); - } - - return bs; - } -}. - - -(* Parametric Simulator *) -module (LowSim (S : SIMULATOR) : Low.SIMULATOR) (F : Low.DFUNCTIONALITY) = { - module LoF = { - proc f(x : block list) = { - var r <- []; - var b <- b0; - var i <- 1; - - if (let (p,n) = parse x in valid p /\ 0 < n) - { - r <@ F.f(parse x); - b <- last b0 r; - } - return b; - } - } - - proc init = S(LoF).init - proc f = S(LoF).f - proc fi = S(LoF).fi -}. - -pred INV (mc : (block list,block) fmap) (mb : (block list * int,block) fmap) = - forall p, mc.[p] = mb.[parse p]. - -(* Constructed Distinguisher *) -module (HiDist (D : Low.DISTINGUISHER) : DISTINGUISHER) - (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { - var c : int - module HiF = { - proc f(p : block list, n : int) = { - var r <- []; - var b <- b0; - var i <- 1; - - if (valid p /\ 0 < n /\ c + sumid (size p) (size p + n) <= max_size) { - while(i <= n) { - b <@ F.f(format p i); - c <- c + size p + i - 1; - r <- rcons r b; - i <- i + 1; - } - } - return r; - } - } - module C = { - proc f (x) = { - var y <- (b0,c0); - if (c + 1 <= max_size) { - c <- c + 1; - y <@ P.f(x); - } - return y; - } - proc fi (x) = { - var y <- (b0,c0); - if (c + 1 <= max_size) { - c <- c + 1; - y <@ P.fi(x); - } - return y; - } - } - - proc distinguish() = { - var a; - c <- 0; - a <@ D(HiF,C).distinguish(); - return a; - } -}. - -module DFCn (F : Low.FUNCTIONALITY) : Low.FUNCTIONALITY = { - proc init = F.init - proc f(p : block list, n : int) = { - var r : block list <- []; - if(C.c + sumid (size p) (size p + n) <= max_size /\ valid p /\ 0 < n) { - r <@ F.f(p,n); - C.c <- C.c + sumid (size p) (size p + n); - } - return r; - } -}. - -module DPC (P : PRIMITIVE) : PRIMITIVE = { - proc init () = { - C.init(); - P.init(); - } - proc f(x) = { - var y <- (b0,c0); - if (C.c + 1 <= max_size) { - y <@ P.f(x); - C.c <- C.c + 1; - } - return y; - } - proc fi(x) = { - var y <- (b0,c0); - if (C.c + 1 <= max_size) { - y <@ P.fi(x); - C.c <- C.c + 1; - } - return y; - } -}. - -module DFC1 (F : FUNCTIONALITY) : FUNCTIONALITY = { - proc init = F.init - proc f(x : block list) = { - var b : block <- b0; - if (C.c + size x <= max_size) { - C.c <- C.c + size x; - b <@ F.f(x); - } - return b; - } -}. - -module P = Common.Perm.Perm. -print Real_Ideal. -(*** PROOF - forall P D S, - HiDist(D)^{BlockSponge(P),P} ~ HiDist(D)^{IBlockSponge,S(IBlockSponge)} - => D^{Core(P),P} ~ D^{ICore,LowSim(S,ICore)} ***) -section PROOF. - declare module S : SIMULATOR { Low.ICORE, IBlockSponge, HiDist, C, P }. - declare module D : Low.DISTINGUISHER { Low.ICORE, IBlockSponge, HiDist, C, P, S }. - - - local module EagerCORE (P : Low.PRIMITIVE) = { - var order : block list - var capa : capacity - var blo : block - var map : (block * capacity) list - proc init() = { - order <- []; - capa <- c0; - blo <- b0; - map <- []; - CORE(P).init(); - } - proc g(bi,ci) = { - var bj, cj; - (bj,cj) <@ P.f(bi,ci); - map <- rcons map (bi,ci); - return (bj,cj); - } - proc f (p : block list, n : int) = { - var r : block list; - var i : int; - - (blo,capa) <- (b0,c0); - r <- []; - i <- 0; - if (valid p /\ 0 < n) { - while(i < size p) { - (blo,capa) <@ P.f(blo +^ nth b0 p i, capa); - i <- i + 1; - } - i <- 1; - order <- p; - r <- rcons r blo; - while (i < n) { - order <- rcons order b0; - (blo,capa) <@ P.f(blo,capa); - r <- rcons r blo; - i <- i + 1; - } - } - return r; - } - proc ewhile() = { - var i : int <- 0; - blo <- b0; - capa <- c0; - map <- []; - while(i < size order) { - (blo,capa) <@ g(blo +^ nth b0 order i,capa); - i <- i + 1; - } - } - proc nwhile(k : int) : block list = { - var i : int <- 1; - var result : block list <- []; - ewhile(); - result <- rcons result EagerCORE.blo; - while(i < k) { - EagerCORE.order <- rcons EagerCORE.order b0; - (blo,capa) <@ g(blo,capa); - result <- rcons result EagerCORE.blo; - i <- i + 1; - } - return result; - } - proc enwhile(k : int) : block list = { - var i : int <- 1; - var m : (block * capacity) list <- []; - var result : block list <- []; - ewhile(); - result <- rcons result EagerCORE.blo; - while(i < k) { - EagerCORE.order <- rcons EagerCORE.order b0; - m <- rcons EagerCORE.map (EagerCORE.blo, EagerCORE.capa); - ewhile(); - EagerCORE.map <- m; - result <- rcons result EagerCORE.blo; - i <- i + 1; - } - return result; - } - - }. - - local module EagCORE (P : Low.PRIMITIVE) : Low.FUNCTIONALITY = { - proc init = EagerCORE(P).init - - - proc f (p : block list, n : int) = { - var r : block list; - var i : int; - - (EagerCORE.blo,EagerCORE.capa) <- (b0,c0); - r <- []; - i <- 0; - if (valid p /\ 0 < n) { - i <- 1; - EagerCORE.order <- p; - EagerCORE(P).ewhile(); - r <- rcons r EagerCORE.blo; - while (i < n) { - EagerCORE.order <- rcons EagerCORE.order b0; - EagerCORE(P).ewhile(); - r <- rcons r EagerCORE.blo; - i <- i + 1; - } - } - return r; - } - }. - - - local equiv nwhile_enwhile (n : int) : - EagerCORE(P).nwhile ~ EagerCORE(P).enwhile : - ={arg, glob P, glob EagerCORE} /\ arg{1} = n ==> ={res, glob P, glob EagerCORE}. - proof. - move:n;elim/natind=>n Hn0. - + by proc;sp;rcondf{1}3;progress;2:rcondf{2}3;progress;-1:sim; - (inline*;wp;while(!i/#). - move=>Hind;case(1 <= n)=>Hn1;last first. - + by proc;sp;rcondf{1}3;2:rcondf{2}3;-1:sim;progress;inline*; - by wp;while(!i/#. - proc. - replace{1} { (!<-) as init ; rest} by { - init; - result <@ EagerCORE(P).nwhile(n); - EagerCORE.order <- rcons EagerCORE.order b0; - (EagerCORE.blo,EagerCORE.capa) <@ EagerCORE(P).g(EagerCORE.blo,EagerCORE.capa); - result <- rcons result EagerCORE.blo; - i <- i + 1; - } - (={glob P, glob EagerCORE} /\ k{1} = n + 1 - ==> ={result, glob P, glob EagerCORE}) - (={glob P, glob EagerCORE} /\ k{2} = n + 1 - ==> ={result, glob P, glob EagerCORE}); - progress;1:rewrite/#. - + sp;inline{2}1;sp;sim. - splitwhile{1}3: i < n. - rcondt{1}4;progress. - + inline*;while(i <= n /\ k = n + 1);1:(sp;if;auto=>/#). - by conseq(:_==> true);1:progress=>/#;auto. - rcondf{1}8;progress. - + inline*;sp;wp;conseq(:_==> i=n);progress. - seq 3 : (i = n);last by sp;if;auto. - while(i <= n);first by sp;if;auto=>/#. - by conseq(:_==> true);2:auto;progress=>/#. - wp;sim. - while(={glob P, glob EagerCORE} /\ (result,i,n){1} = (result0,i0,k0){2} - /\ k{1} = n + 1);1:(inline*;sp;if;auto=>/#). - by wp;conseq(:_==> ={glob P, glob EagerCORE});1:progress=>/#;sim. - - replace{2} { (!<-) as init ; rest} by { - init; - result <@ EagerCORE(P).enwhile(n); - EagerCORE.order <- rcons EagerCORE.order b0; - m <- rcons EagerCORE.map (EagerCORE.blo, EagerCORE.capa); - EagerCORE(P).ewhile(); - EagerCORE.map <- m; - result <- rcons result EagerCORE.blo; - i <- i + 1; - } - (={glob P, glob EagerCORE} - ==> ={result, glob P, glob EagerCORE}) - (={glob P, glob EagerCORE} /\ k{2} = n + 1 - ==> ={result, glob P, glob EagerCORE}); - progress;1:rewrite/#;last first. - + sp;inline{1}1;sp;sim. - splitwhile{2}3: i < n. - rcondt{2}4;2:rcondf{2}10;progress. - + by while(i <= n /\ k = n + 1);by inline*;sp;wp;conseq(:_==> true);auto=>/#. - + wp;conseq(:_==> i = n);progress. - seq 3 : (i = n);last by inline*;conseq(:_==> true);auto. - by while(i <= n /\ k = n + 1); by inline*;sp;wp;conseq(:_==> true);auto=>/#. - sim. - while(={glob P, glob EagerCORE} /\ (result,i,n){2} = (result0,i0,k0){1} - /\ k{2} = n + 1);1:inline*. - + by sp;wp;conseq(:_==> ={glob P, glob EagerCORE} /\ i1{1} = i0{2}); - 1:progress=>/#;sim. - by wp;conseq(:_==> ={glob P, glob EagerCORE});1:progress=>/#;sim. - - replace{2} { (! <- as before); <@ ; after} by { - before; - result <@ EagerCORE(P).nwhile(n); - after; - } - (={glob P, glob EagerCORE} ==> ={result, glob P, glob EagerCORE}) - (={glob P, glob EagerCORE} ==> ={result, glob P, glob EagerCORE}); - progress;1:rewrite/#;last by sim;call(Hind);auto. - - sp;sim. - - inline{2}4. - seq 1 1 : (={glob P, glob EagerCORE, result} - /\ size EagerCORE.order{2} = size EagerCORE.map{1} - /\ nth (b0,c0) EagerCORE.map{1} 0 = (nth b0 EagerCORE.order{1} 0, c0) - /\ (forall y, y \in EagerCORE.map{1} => y \in dom Perm.m{1}) - /\ (0 = size EagerCORE.map{1} => - (EagerCORE.blo,EagerCORE.capa){1} = (b0,c0)) - /\ (0 < size EagerCORE.map{1} => - (EagerCORE.blo,EagerCORE.capa){1} = - oget Perm.m{1}.[last (b0,c0) EagerCORE.map{1}]) - /\ (forall j, 0 < j < size EagerCORE.map{1} => - let ej = nth (b0,c0) EagerCORE.map{1} j in - let ej1 = nth (b0,c0) EagerCORE.map{1} (j-1) in - let mj = nth b0 EagerCORE.order{1} j in - Perm.m{1}.[ej1] = Some (ej.`1 +^ mj, ej.`2)));last first. - - + inline*. - splitwhile{2}7:i0 < size EagerCORE.order - 1. - rcondt{2}8;2:rcondf{2}16;progress. - + by while(i0 < size EagerCORE.order);1:(sp;if);auto;smt(size_rcons size_ge0). - + wp;conseq(:_==> i0 = size EagerCORE.order-1);1:progress=>/#. - seq 7:(i0 = size EagerCORE.order-1);2:(sp;if;auto=>/#). - by while(i0 <= size EagerCORE.order - 1);1:(sp;if);auto;smt(size_rcons size_ge0). - sim. - swap{1}-3;sim;sp 1 2;wp. - conseq(:_==> ={Perm.m, Perm.mi, EagerCORE.blo, EagerCORE.capa} - /\ i0{2} = size EagerCORE.order{2} - 1);progress. - + by rewrite nth_rcons size_rcons-addzA/=Block.WRing.addr0/#. - alias{2}1 permm = Perm.m. - alias{2}1 permmi = Perm.mi. - sp 0 2;conseq(:_==> m{2} = rcons EagerCORE.map{1} (EagerCORE.blo{1}, EagerCORE.capa{1}) - /\ (EagerCORE.blo{2}, EagerCORE.capa{2}) = last (b0, c0) m{2} - /\ i0{2} = size EagerCORE.order{2} - 1 - /\ (Perm.m = permm /\ Perm.mi = permmi){2});1:smt(last_rcons). - - while{2}(={glob P, EagerCORE.order} - /\ (i0 = 0 => (EagerCORE.blo,EagerCORE.capa)=(b0,c0)){2} - /\ 0 <= i0{2} <= size EagerCORE.order{2} - 1 - /\ i0{2} = size EagerCORE.map{2} - /\ size EagerCORE.order{2}-1 = size EagerCORE.map{1} - /\ rcons EagerCORE.map{1} (last (b0,c0) m{2}) = m{2} - /\ nth (b0,c0) EagerCORE.map{1} 0 = (nth b0 EagerCORE.order{1} 0, c0) - /\ (0 < i0{2} => (EagerCORE.blo,EagerCORE.capa){2} = - oget Perm.m{1}.[last (b0,c0) EagerCORE.map{2}]) - /\ EagerCORE.map{2} = take i0{2} m{2} - /\ (Perm.m = permm /\ Perm.mi = permmi){2} - /\ (forall y, y \in EagerCORE.map{1} => y \in dom Perm.m{1}) - /\ (forall j, 0 < j < size EagerCORE.map{1} => - let ej = nth (b0,c0) EagerCORE.map{1} j in - let ej1 = nth (b0,c0) EagerCORE.map{1} (j-1) in - let mj = nth b0 EagerCORE.order{1} j in - Perm.m{1}.[ej1] = Some (ej.`1 +^ mj, ej.`2)) - /\ (EagerCORE.blo{1}, EagerCORE.capa{1}) = last (b0, c0) m{2} - /\ 1 <= size EagerCORE.order{1} - ) - (size EagerCORE.order{2} - 1 - i0{2}); - progress;1:auto. - + sp;rcondf 1;auto;progress. - + case(0Hi0;last first. - + cut h:EagerCORE.map{hr} = [] by smt(size_eq0). - rewrite h/=;cut[->->]:=H _;1:rewrite/#. - by rewrite Block.WRing.add0r H7-H4 mem_nth/#. - cut:=H5 Hi0;rewrite-nth_last. - rewrite {1}H6 nth_take 1,2:/# -H3 nth_rcons-H2. - cut->/=:size EagerCORE.map{hr} - 1 < size EagerCORE.order{hr}-1 by rewrite/#. - rewrite H8 1:/# oget_some/==>[[->->]]. - rewrite -Block.WRing.addrA Block.xorwK Block.WRing.addr0//=. - rewrite H7 H6 size_take;1:smt(size_ge0). - rewrite-H3 size_rcons-H2-addzA/= H11/=. - by cut/#:=mem_nth (b0,c0)EagerCORE.map{m}(size EagerCORE.map{hr})_;smt(size_ge0). - + by rewrite/#. - + by rewrite/#. - + by rewrite/#. - + by rewrite/#. - + smt(size_rcons). - + by rewrite last_rcons/#. - + case(0Hi0;last first. - + cut h:EagerCORE.map{hr} = [] by smt(size_eq0). - rewrite h/=;cut[->->]:=H _;1:rewrite/#. - rewrite Block.WRing.add0r(take_nth(b0,c0)0)/= 2:/#. - smt(size_rcons size_ge0). - rewrite(take_nth(b0,c0));1:smt(size_rcons size_ge0). - congr;cut:=H5 Hi0. - rewrite-nth_last {1}H6 {2}H6. - rewrite nth_take 1,2:/#. - rewrite size_take 1:/#. - rewrite-H3 size_rcons-H2-addzA/=H11/=nth_rcons. - rewrite-H3-H2/=. - cut->/=:size EagerCORE.map{hr} - 1 < size EagerCORE.order{hr} - 1 by rewrite/#. - rewrite H8 1:/# oget_some/==>[[->->]]. - rewrite -Block.WRing.addrA Block.xorwK Block.WRing.addr0//=. - rewrite nth_rcons. - by rewrite-H3-H2/=H12/=/#. - by rewrite/#. - - sp;auto;progress. - + smt(size_ge0 size_rcons). - + smt(size_ge0 size_rcons). - + smt(last_rcons). - + smt(nth_rcons size_ge0). - + smt(take0). - + smt(nth_rcons). - + smt(last_rcons). - + smt(size_ge0 size_rcons). - + smt(size_ge0 size_rcons). - + case(size map_R = 0)=>HmapR. - + cut:=size_eq0 map_R;rewrite HmapR/==>{HmapR}HmapR. - cut Hmap1:(size EagerCORE.map{1} = 0) by rewrite/#. - cut:=size_eq0 EagerCORE.map{1};rewrite Hmap1/==>{Hmap1}Hmap1. - rewrite Hmap1=>/={Hind}. - move:H6;rewrite HmapR/==>[[->->]]. - by move:H2;rewrite Hmap1/==>[[->->]]. - cut h:size order_R = size map_R by rewrite/#. - rewrite last_rcons H12 1:/# -nth_last {1}H13 nth_take 1,2:/#. - rewrite nth_rcons-H9 size_rcons-addzA/=h. - cut->/=:size map_R - 1 < size map_R by rewrite/#. - cut->:size map_R = size EagerCORE.map{1} by rewrite/#. - by rewrite nth_last/#. - smt(size_ge0 size_rcons). - - inline*;wp. - case(size EagerCORE.order{1} = 0). - + sp;rcondf{1}1;2:rcondf{2}1;auto;progress;1,2:smt(size_eq0 size_ge0). - while(={Perm.mi, Perm.m, k0} /\ i0{1} = i1{2} /\ k0{1} = n /\ - ={EagerCORE.map, EagerCORE.blo, EagerCORE.capa, EagerCORE.order} /\ - ={result0} /\ - size EagerCORE.order{2} = size EagerCORE.map{1} /\ - nth (b0, c0) EagerCORE.map{1} 0 = (nth b0 EagerCORE.order{1} 0, c0) /\ - (forall (y1 : block * capacity), - y1 \in EagerCORE.map{1} => y1 \in dom Perm.m{1}) /\ - (0 = size EagerCORE.map{1} => - EagerCORE.blo{1} = b0 && EagerCORE.capa{1} = c0) /\ - (0 < size EagerCORE.map{1} => - (EagerCORE.blo{1}, EagerCORE.capa{1}) = - oget Perm.m{1}.[last (b0, c0) EagerCORE.map{1}]) /\ - forall (j : int), - 0 < j < size EagerCORE.map{1} => - Perm.m{1}.[nth (b0, c0) EagerCORE.map{1} (j - 1)] = - Some - ((nth (b0, c0) EagerCORE.map{1} j).`1 +^ - nth b0 EagerCORE.order{1} j, (nth (b0, c0) EagerCORE.map{1} j).`2));auto;progress. - + sp;if;auto;progress. - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + rewrite getP !nth_rcons. rewrite size_rcons in H11. - cut->/=:j - 1 < size EagerCORE.map{2} by rewrite/#. - rewrite H. - case(jHj/=. - + cut->/=:!nth (b0, c0) EagerCORE.map{2} (j - 1) = - (EagerCORE.blo{2}, EagerCORE.capa{2}) - by cut/#:nth (b0, c0) EagerCORE.map{2} (j - 1) \in dom Perm.m{2};smt(mem_nth). - by rewrite H4//. - cut->/=:j=size EagerCORE.map{2} by rewrite/#. - cut->/=:!nth (b0, c0) EagerCORE.map{2} (size EagerCORE.map{2} - 1) = - (EagerCORE.blo{2}, EagerCORE.capa{2}) by smt(mem_nth). - by rewrite Block.WRing.addr0 H3;smt(get_oget mem_nth nth_last). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + rewrite !nth_rcons. rewrite size_rcons in H9. - cut->/=:j - 1 < size EagerCORE.map{2} by rewrite/#. - rewrite H. - case(jHj/=. - by rewrite H4//. - cut->/=:j=size EagerCORE.map{2} by rewrite/#. - by rewrite Block.WRing.addr0 H3;smt(get_oget mem_nth nth_last). - smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons size_eq0). - smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - - - while(={glob P, glob EagerCORE, result0, k0} - /\ size EagerCORE.order{2} = size EagerCORE.map{1} - /\ i1{2} <= size EagerCORE.order{2} - /\ 1 <= i1{2} <= k0{2} /\ k0{2} = n - /\ i1{2} = i0{1} - /\ nth (b0, c0) EagerCORE.map{1} 0 = (nth b0 EagerCORE.order{1} 0, c0) - /\ (forall (y1 : block * capacity), - y1 \in EagerCORE.map{1} => y1 \in dom Perm.m{1}) - /\ (0 = size EagerCORE.map{1} => - (EagerCORE.blo{1}, EagerCORE.capa{1}) = (b0, c0)) - /\ (0 < size EagerCORE.order{1} => - (EagerCORE.blo{1}, EagerCORE.capa{1}) = - oget Perm.m{1}.[last (b0, c0) EagerCORE.map{1}]) - /\ (forall (j : int), 0 < j < size EagerCORE.map{1} => - let ej = nth (b0, c0) EagerCORE.map{1} j in - let ej1 = nth (b0, c0) EagerCORE.map{1} (j - 1) in - let mj = nth b0 EagerCORE.order{1} j in - Perm.m{1}.[ej1] = Some (ej.`1 +^ mj, ej.`2))). - + sp;if;auto;progress. - + smt(size_rcons size_ge0). - + smt(size_rcons size_ge0). - + smt(size_rcons size_ge0). - + smt(size_rcons size_ge0). - + smt(size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0). - + rewrite getP !nth_rcons. rewrite size_rcons in H14. - cut->/=:j - 1 < size EagerCORE.map{2} by rewrite/#. - rewrite H. - case(jHj/=. - + cut->/=:!nth (b0, c0) EagerCORE.map{2} (j - 1) = - (EagerCORE.blo{2}, EagerCORE.capa{2}) - by cut/#:nth (b0, c0) EagerCORE.map{2} (j - 1) \in dom Perm.m{2};smt(mem_nth). - by rewrite H7//. - cut->/=:j=size EagerCORE.map{2} by rewrite/#. - cut->/=:!nth (b0, c0) EagerCORE.map{2} (size EagerCORE.map{2} - 1) = - (EagerCORE.blo{2}, EagerCORE.capa{2}) by smt(mem_nth). - by rewrite Block.WRing.addr0 H6;smt(get_oget mem_nth nth_last). - - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + rewrite !nth_rcons. rewrite size_rcons in H12. - cut->/=:j - 1 < size EagerCORE.map{2} by rewrite/#. - rewrite H. - case(jHj/=. - by rewrite H7//. - cut->/=:j=size EagerCORE.map{2} by rewrite/#. - by rewrite Block.WRing.addr0 H6;smt(get_oget mem_nth nth_last). - wp;sp. - - conseq(:_==> ={glob P, glob EagerCORE, result0, k0} - /\ size EagerCORE.order{2} = size EagerCORE.map{1} - /\ nth (b0, c0) EagerCORE.map{1} 0 = (nth b0 EagerCORE.order{1} 0, c0) - /\ (forall (y1 : block * capacity), - y1 \in EagerCORE.map{1} => y1 \in dom Perm.m{1}) - /\ (0 = size EagerCORE.map{1} => - (EagerCORE.blo{1}, EagerCORE.capa{1}) = (b0, c0)) - /\ (0 < size EagerCORE.order{1} => - (EagerCORE.blo{1}, EagerCORE.capa{1}) = - oget Perm.m{1}.[last (b0, c0) EagerCORE.map{1}]) - /\ (forall (j : int), 0 < j < size EagerCORE.map{1} => - let ej = nth (b0, c0) EagerCORE.map{1} j in - let ej1 = nth (b0, c0) EagerCORE.map{1} (j - 1) in - let mj = nth b0 EagerCORE.order{1} j in - Perm.m{1}.[ej1] = Some (ej.`1 +^ mj, ej.`2)));1:smt(size_ge0). - - (* TODO : reprendre ici *) - while( ={glob P, glob EagerCORE, result0, k0} - /\ i1{1} = i2{2} - /\ 0 <= i1{1} <= size EagerCORE.order{1} - /\ i1{1} = size EagerCORE.map{1} - /\ (0 < i1{1} => nth (b0, c0) EagerCORE.map{1} 0 = (nth b0 EagerCORE.order{1} 0, c0)) - /\ (forall (y1 : block * capacity), - y1 \in EagerCORE.map{1} => y1 \in dom Perm.m{1}) - /\ (0 = size EagerCORE.map{1} => - (EagerCORE.blo{1}, EagerCORE.capa{1}) = (b0, c0)) - /\ (0 < size EagerCORE.map{1} => - (EagerCORE.blo{1}, EagerCORE.capa{1}) = - oget Perm.m{1}.[last (b0, c0) EagerCORE.map{1}]) - /\ (forall (j : int), 0 < j < size EagerCORE.map{1} => - let ej = nth (b0, c0) EagerCORE.map{1} j in - let ej1 = nth (b0, c0) EagerCORE.map{1} (j - 1) in - let mj = nth b0 EagerCORE.order{1} j in - Perm.m{1}.[ej1] = Some (ej.`1 +^ mj, ej.`2)));last first. - + auto;smt(size_ge0). - sp;if;auto;progress. - + smt(size_ge0). - + smt(size_ge0). - + smt(size_ge0 size_rcons). - + rewrite nth_rcons;case(0Hsize//=;1:rewrite/#. - move:H3;cut->/=[->->]/=:EagerCORE.map{2} = [] by smt(size_eq0 size_ge0). - by rewrite Block.WRing.add0r. - + smt(mem_rcons dom_set in_fsetU1). - + smt(size_rcons). - + smt(size_rcons). - + smt(last_rcons). - + rewrite size_rcons in H12;rewrite getP !nth_rcons. - cut->/=:j - 1 < size EagerCORE.map{2} by rewrite/#. - pose x:=nth _ _ _;pose y:=(_,_). - cut->/=:!x=y by smt(mem_nth). - case(j//=[/#|Hsize]. - rewrite/x/y=>{x y};cut Hj/=:j = size EagerCORE.map{2} by rewrite/#. - rewrite Hj/=. - by rewrite -Block.WRing.addrA Block.xorwK Block.WRing.addr0/=;smt(get_oget mem_nth nth_last). - + smt(size_rcons). - + smt(size_rcons). - + smt(size_rcons). - + rewrite nth_rcons;case(0Hsize//=;1:rewrite/#. - move:H3;cut->/=[->->]/=:EagerCORE.map{2} = [] by smt(size_eq0 size_ge0). - by rewrite Block.WRing.add0r. - + smt(size_rcons mem_rcons). - + smt(size_rcons). - + smt(size_rcons). - + smt(size_rcons last_rcons). - rewrite size_rcons in H10;rewrite !nth_rcons. - cut->/=:j - 1 < size EagerCORE.map{2} by rewrite/#. - case(j//=[/#|Hsize]. - cut Hj/=:j = size EagerCORE.map{2} by rewrite/#. - rewrite Hj/=. - by rewrite -Block.WRing.addrA Block.xorwK Block.WRing.addr0/=;smt(get_oget mem_nth nth_last). - - qed. - - equiv core_blocksponge : - Low.Indif(DFCn(CORE(P)),DPC(P),D).main ~ - Indif(DFC1(BlockSponge(P)),DPC(P),HiDist(D)).main : - ={glob D, glob P} ==> ={res, C.c} /\ ={c}(C,HiDist). - proof. - transitivity Low.Indif(DFCn(EagerCORE(P)),DPC(P),D).main - (={glob D, glob P} ==> ={res, C.c}) - (={glob D, glob P} ==> ={res, C.c} /\ ={c}(C,HiDist));progress;1:rewrite/#. - + proc=>/=;call (_: ={glob P, C.c}); first 2 by sim. - + proc=> /=;inline*;sp;if;auto;sp;if;auto;sim. - conseq(:_==> ={glob P} /\ sc{1} = EagerCORE.capa{2} - /\ sa{1} = EagerCORE.blo{2});progress. - by while(={glob P, p0, i} /\ 0 <= i{1} <= size p0{1} - /\ (i < size p0 => nth witness p0 i = nth b0 p0 i){1} - /\ sc{1} = EagerCORE.capa{2} - /\ sa{1} = EagerCORE.blo{2});1:(sp;if);auto; - smt(nth_onth onth_nth size_ge0). - - - by inline*;auto;call(:true);auto. - - transitivity Low.Indif(DFCn(EagCORE(P)),DPC(P),D).main - (={glob D, glob P} ==> ={res, C.c}) - (={glob D, glob P} ==> ={res, C.c} /\ ={c}(C,HiDist));progress;1:rewrite/#. - + proc. - call (_: ={glob P, C.c}); first 2 by sim. - + proc=> /=; sp. - if=>//=;auto. - conseq(:_==> ={r,glob P});progress. - transitivity{1} { - EagerCORE.capa <- c0; - EagerCORE.blo <- b0; - EagerCORE.map <- []; - EagerCORE.order <- p; - r <@ EagerCORE(P).nwhile(n); - } - (={glob P, p, n} /\ valid p{1} /\ 0 < n{1} ==> ={glob P, r}) - (={glob P, p, n} /\ valid p{1} /\ 0 < n{1} ==> ={glob P, r}); - progress;1:rewrite/#. - + inline*;sim. rcondt{1}6;1:auto;sim;sp;sim. - wp;conseq(:_==> ={EagerCORE.blo, EagerCORE.capa, glob P});progress. - by while( ={EagerCORE.blo, EagerCORE.capa, glob P} - /\ (i,p0){1} = (i0,EagerCORE.order){2});1:(sp;if);auto;progress. - transitivity{1} { - EagerCORE.capa <- c0; - EagerCORE.blo <- b0; - EagerCORE.map <- []; - EagerCORE.order <- p; - r <@ EagerCORE(P).enwhile(n); - } - (={glob P, p, n} ==> ={glob P, r}) - (={glob P, p, n} /\ valid p{1} /\ 0 < n{1} ==> ={glob P, r}); - progress;1:rewrite/#;last first. - + by inline*;sim;rcondt{2}6;1:auto;sim;auto. - by sp;exists*n{1};elim*=>n;call(nwhile_enwhile n);auto. - - by inline*;auto;call(:true);auto. - - - + proc;inline{2}3;wp;call (_: ={glob P, C.c} /\ ={c}(C,HiDist)). - + by proc;inline*;sp;auto;if;auto;sp;rcondt{2}1;auto;sp;if;auto. - + by proc;inline*;sp;auto;if;auto;sp;rcondt{2}1;auto;sp;if;auto. - proc;inline*;sp;auto. - if;1:progress=>/#;sp;wp. - rcondt{1}1;1:auto=>/#;sp. - rcondt{2}1;1:auto=>/#;sp. - rcondt{2}1;1:auto;progress. - + rewrite size_cat nseq0/=. - cut/#:size p{hr} <= sumid (size p{hr}) (size p{hr} + n{hr}). - rewrite BIA.big_ltn 1:/# /=. - cut/#:=sumr_ge0_seq predT(fun n=>n)(range (size p{hr} + 1) (size p{hr} + n{hr})) _. - smt(mem_iota size_ge0). - sp;rcondt{2}1;1:(auto;smt(parseK formatK));sp. - conseq(:_==> r0{1} = r{2} /\ ={glob P} /\ C.c{2} = HiDist.c{2} - /\ i{1} = n{1} - /\ C.c{1} + sumid (size p{1}) (size p{1} + i{1}) = C.c{2});progress. - while( r0{1} = r{2} /\ ={glob P,p} /\ C.c{2} = HiDist.c{2} - /\ C.c{1} + sumid (size p{1}) (size p{1} + n{2}) <= max_size - /\ C.c{1} + sumid (size p{1}) (size p{1} + i{1}) = C.c{2} - /\ (n0, EagerCORE.blo, EagerCORE.capa){1} = (n, sa, sc){2} - /\ EagerCORE.order{1} = format p{2} i{1} - /\ i{2} = i{1} + 1 - /\ 0 < i{1} <= n0{1} - /\ valid p{2}). - + sp;rcondt{2}1;auto;progress. - + cut/#:sumid (size p{hr}) (size p{hr} + i{m}) + - size (format p{hr} (i{m} + 1)) <= - sumid (size p{hr}) (size p{hr} + n{hr}). - rewrite size_cat size_nseq-addzA/=/max H0/=. - cut/=<-:=BIA.big_int_recr (size p{hr} + i{m})(size p{hr})(fun n=>n)_;1:rewrite/#. - smt(sumid_leq size_ge0). - swap{2}5;sp;auto. - rcondt{2}1;1:(auto;smt(formatK parseK)). - conseq(:_==> ={glob P} /\ - (EagerCORE.blo, EagerCORE.capa){1} = (sa, sc){2});progress. - + rewrite size_cat-(addzA _ 1)/=size_nseq/max H1/=/#. - + rewrite size_cat-(addzA _ 1)/=size_nseq/max H1/=. search BIA.big (+) 1. - by cut/#:=BIA.big_int_recr_cond(size p{2} + i{1})(size p{2})predT(fun n=>n)_;rewrite/#. - + by rewrite rcons_cat-nseqSr 1:/# -addzA/=/format-addzA/=. - + rewrite/#. - + rewrite/#. - + rewrite/#. - while(={glob P} /\ - (i1,EagerCORE.order,EagerCORE.blo,EagerCORE.capa){1} = (i0,p0,sa,sc){2});auto. - + by sp;if;auto. - progress. - + by rewrite rcons_cat-nseqSr 1:/# -addzA/=/format-addzA/=. - + by move:H6;rewrite rcons_cat-nseqSr 1:/# -addzA/=/format-addzA/=. - by move:H6;rewrite rcons_cat-nseqSr 1:/# -addzA/=/format-addzA/=. - wp;conseq(:_==> ={glob P} /\ - (EagerCORE.blo, EagerCORE.capa){1} = (sa, sc){2});progress. - + by rewrite size_cat nseq0/#. - + by rewrite size_cat nseq0/= BIA.big_int1. - + by rewrite/format nseq0 cats0/#. - + rewrite/#. - + rewrite/#. - + rewrite/#. - + rewrite/#. - while(={glob P} /\ - (i0,EagerCORE.order,EagerCORE.blo,EagerCORE.capa){1} = (i0,p0,sa,sc){2});auto. - + by sp;if;auto. - progress. - + by rewrite/format nseq0 cats0/#. - + by rewrite size_cat nseq0/#. - + by move:H3;rewrite size_cat nseq0/#. - by auto;progress. - by inline*;auto;call(:true);auto. - qed. - - equiv icore_iblocksponge : - Low.Indif(DFCn(ICORE),DPC(LowSim(S,ICORE)),D).main ~ - Indif(DFC1(IBlockSponge),DPC(S(IBlockSponge)),HiDist(D)).main : - ={glob S, glob D} ==> ={res, C.c} /\ ={c}(C,HiDist). - proof. - proc;inline{2}3;wp;call (_: - ={glob S,C.c} /\ ={c}(C,HiDist) - /\ INV IBlockSponge.m{2} ICORE.m{1}). - + proc;inline*;sp;if;auto. - swap{2}3;sp;rcondt{2}1;auto. - call(: ={C.c} /\ ={c}(C,HiDist) /\ INV IBlockSponge.m{2} ICORE.m{1})=>/=;auto. - proc=> /=; sp;if;1:progress=>/#;inline*;sp;auto. - rcondt{1}1;1:auto=>/#. - wp. - splitwhile{1}1:i0/#;sp;if;auto=>/#. - rcondf{1}8;progress. - + wp;seq 1:(i0=n);2:(sp;if;auto=>/#). - by while(i0<=n);2:auto=>/#;sp;if;auto=>/#. - wp. - conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ - ICORE.m{1}.[(p0{1}, n0{1})] = IBlockSponge.m{2}.[x1{2}]);progress. - + smt(last_rcons). - seq 3 2 : (INV IBlockSponge.m{2} ICORE.m{1} /\ - parse x1{2} = (p0{1}, n0{1}) /\ valid p0{1} /\ 0 < n0{1}); - last if;1:smt(in_dom);auto;smt(getP formatK parseK). - wp;conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ i0{1} = n{1});1:progress=>/#. - while( ={n,p} /\ INV IBlockSponge.m{2} ICORE.m{1} - /\ i0{1} = i{2} /\ valid p{1} /\ 0 < n{2} /\ 0 < i0{1} <= n{1}). - + sp;if;auto;smt(in_dom formatK parseK getP). - by auto;smt(in_dom formatK parseK getP). - - + proc;sp;if;auto;swap{2}1;inline{2}1;sp;rcondt{2}1;auto. - call(: ={C.c} /\ C.c{1} = HiDist.c{2}/\ INV IBlockSponge.m{2} ICORE.m{1})=> //. - proc=> /=; sp;if;1:progress=>/#;inline*;sp;auto. - rcondt{1}1;1:auto=>/#. - wp. - splitwhile{1}1:i0/#;sp;if;auto=>/#. - rcondf{1}8;progress. - + wp;seq 1:(i0=n);2:(sp;if;auto=>/#). - by while(i0<=n);2:auto=>/#;sp;if;auto=>/#. - wp. - conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ - ICORE.m{1}.[(p0{1}, n0{1})] = IBlockSponge.m{2}.[x1{2}]);progress. - + smt(last_rcons). - seq 3 2 : (INV IBlockSponge.m{2} ICORE.m{1} /\ - parse x1{2} = (p0{1}, n0{1}) /\ valid p0{1} /\ 0 < n0{1}); - last if;1:smt(in_dom);auto;smt(getP formatK parseK). - wp;conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ i0{1} = n{1});1:progress=>/#. - while( ={n,p} /\ INV IBlockSponge.m{2} ICORE.m{1} - /\ i0{1} = i{2} /\ valid p{1} /\ 0 < n{2} /\ 0 < i0{1} <= n{1}). - + sp;if;auto;smt(in_dom formatK parseK getP). - by auto;smt(in_dom formatK parseK getP). - - + proc=> /=; sp;if;1:progress=>/#;inline*;sp;auto. - rcondt{1}1;1:auto=>/#;wp. - conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} - /\ C.c{1} + sumid (size p{1}) (size p{1} + n{1}) = C.c{2} - /\ HiDist.c{2} = C.c{2} /\ r0{1} = r{2});progress. - while( INV IBlockSponge.m{2} ICORE.m{1} - /\ ={i,p,n} /\ n0{1} = n{2} /\ p0{1} = p{1} - /\ valid p{1} /\ 0 < n{1} /\ 0 < i{1} <= n0{1} + 1 - /\ C.c{1} + sumid (size p{1}) (size (format p{1} i{1})) = C.c{2} - /\ C.c{1} + sumid (size p{1}) (size p{1} + n{1}) <= max_size - /\ (forall j, 0 < j < i{1} => - format p{2} j \in dom IBlockSponge.m{2}) - /\ HiDist.c{2} = C.c{2} /\ r0{1} = r{2});last first. - + auto;progress. - + rewrite/#. - + by rewrite size_cat nseq0/= BIA.big_geq/=. - + smt(in_dom). - by rewrite size_cat size_nseq max_ler /#. - sp. - rcondt{2}1;1:auto;progress. - + rewrite-addzA. - cut/=<-:=BIA.big_int_recr_cond(size (format p{hr} i{hr}))(size p{hr})predT(fun n=>n)_. - + by rewrite size_cat size_nseq max_ler/#. - cut/#:=sumid_leq(size p{hr})(size (format p{hr} i{hr}) + 1)(size p{hr} + n{hr})_ _;1:smt(size_ge0). - by rewrite size_cat size_nseq max_ler/#. - swap{2}1 7;sp. - wp=>/=. - conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} - /\ (forall (j : int), - 0 < j < i{1} + 1 => format p{2} j \in dom IBlockSponge.m{2}) - /\ oget ICORE.m{1}.[(p1{1}, n1{1})] = bs{2});progress. - + rewrite/#. - + rewrite/#. - + rewrite -addzA;congr=>//. - rewrite 2!size_cat-addzA/=2!size_nseq{1}/max H3/=max_ler 1:/#. - cut/#:=BIA.big_int_recr_cond(size p{2} + (i{2} -1))(size p{2})predT(fun n=>n)_;rewrite/#. - + rewrite -4!addzA;congr=>//;congr. - by rewrite size_cat/=size_nseq max_ler 1:/#. - rcondt{2}1;1:(auto;smt(parseK formatK)). - alias{2}1 m = IBlockSponge.m;sp;wp=>/=;swap{2}2-1;sp. - if{1};2:rcondf{2}2;1:rcondt{2}2;progress. - + while(!(format p0 n0) \in dom IBlockSponge.m /\ 0 < i0 );auto. - + sp;if;auto;progress. - + by rewrite dom_set in_fsetU1 H/=/format;smt(catsI size_nseq). - + by rewrite/#. - + by rewrite/#. - smt(in_dom formatK parseK). - rnd=>//=. - conseq(:_==> INV m{2} ICORE.m{1} /\ IBlockSponge.m{2} = m{2});progress. - + smt(getP formatK parseK in_dom). - + smt(getP formatK parseK in_dom). - + smt(getP formatK parseK in_dom). - conseq(:_==> IBlockSponge.m{2} = m{2});progress. - while{2}(IBlockSponge.m{2} = m{2} /\ 0 < i0{2} /\ (forall (j : int), - 0 < j < n0{2} => format p0{2} j \in dom m{2}))(n0{2}-i0{2});auto. - + sp;rcondf 1;auto=>/#. - smt(parseK formatK). - + conseq(:_==> IBlockSponge.m = m);1:smt(in_dom parseK formatK). - while(IBlockSponge.m = m /\ 0 < i0 /\ (forall (j : int), - 0 < j < n0 => format p0 j \in dom m));auto. - + sp;rcondf 1;auto=>/#. - smt(parseK formatK). - + conseq(:_==> IBlockSponge.m{2} = m{2});1:smt(in_dom parseK formatK). - while{2}(IBlockSponge.m{2} = m{2} /\ 0 < i0{2} /\ (forall (j : int), - 0 < j < n0{2} => format p0{2} j \in dom m{2}))(n0{2}-i0{2});auto. - + sp;rcondf 1;auto=>/#. - smt(parseK formatK). - - by inline*;auto;call(:true);auto;smt(in_dom dom0 in_fset0). - qed. - - - -end section PROOF. diff --git a/sha3/proof/clean/NewCommon.ec b/sha3/proof/clean/NewCommon.ec deleted file mode 100644 index e2055d1..0000000 --- a/sha3/proof/clean/NewCommon.ec +++ /dev/null @@ -1,73 +0,0 @@ -require import Core Logic Distr. -require import Int IntExtra Real List NewFMap FSet. -require import StdOrder. -(*---*) import IntOrder. - -(*** THEORY PARAMETERS ***) -(** Block/Rate **) -theory Block. - op r : int. - axiom r_ge0: 0 <= r. - - type block. - - op b0: block. - op (+^): block -> block -> block. - - axiom addbA b1 b2 b3: b1 +^ (b2 +^ b3) = b1 +^ b2 +^ b3. - axiom addbC b1 b2: b1 +^ b2 = b2 +^ b1. - axiom add0b b: b0 +^ b = b. - axiom addbK b: b +^ b = b0. - - op blocks: block list. - axiom blocks_spec b: count (pred1 b) blocks = 1. - axiom card_block: size blocks = 2^r. - - clone import Ring.ZModule as BlockMonoid with - type t <- block, - op zeror <- b0, - op ( + ) <- (+^), - op [ - ] (b : block) <- b - remove abbrev (-) - proof *. - realize addrA by exact/addbA. - realize addrC by exact/addbC. - realize add0r by exact/add0b. - realize addNr by exact/addbK. - - clone import MFinite as DBlock with - type t <- block, - op Support.enum <- blocks - rename "dunifin" as "bdistr" - "duniform" as "bdistr" - proof *. - realize Support.enum_spec by exact/blocks_spec. -end Block. -import Block DBlock. - -(** Capacity **) -theory Capacity. - op c : int. - axiom c_ge0: 0 <= c. - - type capacity. - - op c0: capacity. - - op caps: capacity list. - axiom caps_spec b: count (pred1 b) caps = 1. - axiom card_capacity: size caps = 2^c. - - clone import MFinite as DCapacity with - type t <- capacity, - op Support.enum <- caps - rename "dunifin" as "cdistr" - "duniform" as "cdistr" - proof *. - realize Support.enum_spec by exact/caps_spec. -end Capacity. -import Capacity DCapacity. - -(** Query Bound **) -op max_query: int. -axiom max_query_ge0: 0 <= max_query. \ No newline at end of file diff --git a/sha3/proof/clean/NewCore.eca b/sha3/proof/clean/NewCore.eca deleted file mode 100644 index b42ce5c..0000000 --- a/sha3/proof/clean/NewCore.eca +++ /dev/null @@ -1,139 +0,0 @@ -require import Core Int Real List FSet NewFMap Distr. -require import StdOrder Ring DProd. -(*---*) import IntOrder. - -require (*..*) RP Indifferentiability. - -require import Common. -(*---*) import Block DBlock Capacity DCapacity. - -(** Validity of Functionality Queries **) -op valid: block list * int -> bool. - -(*** DEFINITIONS ***) -type state = block * capacity. -op dstate = bdistr `*` cdistr. - -(** Indifferentiability Experiment **) -clone include Indifferentiability with - type p <- state, - type f_in <- block list * int, - type f_out <- block list - rename [module] "GReal" as "RealIndif" - [module] "GIdeal" as "IdealIndif". - -(** CORE Construction **) -module (CORE : CONSTRUCTION) (P : DPRIMITIVE): FUNCTIONALITY = { - proc init () = {} - - proc f(p : block list, n : int): block list = { - var (sa,sc) <- (b0,c0); - var r <- []; - var i <- 0; - - if (valid (p,n)) { - while (i < size p) { - (sa,sc) <@ P.f((sa +^ nth witness p i,sc)); - i <- i + 1; - } - i <- 1; - r <- rcons r sa; - while(i < n) { - (sa,sc) <@ P.f(sa,sc); - r <- rcons r sa; - i <- i + 1; - } - } - return r; - } -}. - -(** Ideal CORE Functionality **) -module ICORE : FUNCTIONALITY = { - var m : (block list * int,block) fmap - - proc init() = { - m = map0; - } - - proc fill_in(p : block list, n : int): block = { - if (!mem (dom m) (p,n)) { - m.[(p,n)] <$ bdistr; - } - return oget m.[(p,n)]; - } - - proc f(p : block list, n : int): block list = { - var r <- []; - var i <- 1; - var b; - - if (valid (p,n)) { - while (i <= n) { - b <@ fill_in(p,i); - r <- rcons r b; - i <- i + 1; - } - } - return r; - } -}. - -(** CORE Simulator **) -module (S : SIMULATOR) (F : DFUNCTIONALITY) : PRIMITIVE = { - var m, mi : (state,state) fmap - var pi : (capacity, block list * block) fmap - - proc init() = { - m <- map0; - mi <- map0; - pi <- map0.[c0 <- ([<:block>],b0)]; - } - - proc f(x : state): state = { - var p, v, y, y1, y2; - var b; - - if (!mem (dom m) x) { - if (mem (dom pi) x.`2) { - (p,v) <- oget pi.[x.`2]; - b <- F.f (rcons p (v +^ x.`1),1); - y1 <- last b0 b; - } else { - y1 <$ bdistr; - } - y2 <$ cdistr; - y <- (y1,y2); - m.[x] <- y; - mi.[y] <- x; - if (mem (dom pi) x.`2) { - (p,v) <- oget pi.[x.`2]; - pi.[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 (!mem (dom mi) x) { - y1 <$ bdistr; - y2 <$ cdistr; - y <- (y1,y2); - mi.[x] <- y; - m.[y] <- x; - } else { - y <- oget mi.[x]; - } - return y; - } -}. - - -(* we want to build S such that, - forall D, - D^{Core(P),P} ~ D^{ICore,S(ICore)} -*) \ No newline at end of file diff --git a/sha3/proof/core/ConcreteF.eca b/sha3/proof/core/ConcreteF.eca deleted file mode 100644 index dde9a3c..0000000 --- a/sha3/proof/core/ConcreteF.eca +++ /dev/null @@ -1,186 +0,0 @@ -require import Core Int Real StdOrder Ring Distr IntExtra. -require import List FSet NewFMap Utils Common SLCommon DProd Dexcepted. - -(*...*) import Capacity IntOrder RealOrder. - -require (*..*) Strong_RP_RF. - -module PF = { - var m, mi: (state,state) fmap - - proc init(): unit = { - m <- map0; - mi <- map0; - } - - proc f(x : state): state = { - var y1, y2; - - if (!mem (dom m) x) { - 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 (!mem (dom mi) x) { - 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}. - - 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.DWord.supp_dunifin/=. - smt(dprod1E Block.DBlock.dunifin_funi Capacity.DWord.dunifin_funi). - split. - smt(dprod_ll Block.DBlock.dunifin_ll Capacity.DWord.dunifin_ll). - apply/dprod_fu. - rewrite Block.DBlock.dunifin_fu. - by rewrite Capacity.DWord.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': PRPt.Distinguisher) (P' : PRPt.Oracles) = { - proc distinguish = DRestr(D,SqueezelessSponge(P'),P').distinguish - }. - - local lemma DoubleBounding (P <: PRPt.StrongPRP {D, C, DBounder}) &m: - Pr[PRPt.IND(P,D').main() @ &m: res] - = Pr[PRPt.IND(P,DBounder(D')).main() @ &m: res]. - proof. - byequiv=> //=; proc; inline *. - wp. - call (_: ={glob C, glob P} /\ DBounder.FBounder.c{2} = C.c{2}). - + proc; sp; if=> //=; inline *. - rcondt{2} 4; 1: by auto=> /#. - by wp; call (_: true); auto. - + proc; sp; if=> //=; inline *. - rcondt{2} 4; 1: by auto=> /#. - by wp; call (_: true); auto. - + proc; sp; if=> //=; inline *. - wp; while ( ={glob C, glob P, p, sa, sc} - /\ C.c{2} <= max_size - /\ DBounder.FBounder.c{2} = C.c{2} - size p{2}). - rcondt{2} 3; 1: by auto; smt w=size_ge0. - by wp; call (_: true); auto=> /#. - by auto; progress; ring. - by wp; call (_: true). - qed. - - local clone import ProdSampling with - type t1 <- block, - op d1 <- bdistr, - type t2 <- capacity, - op d2 <- cdistr. - - lemma Real_Concrete &m : - Pr[GReal(D).main()@ &m: res /\ C.c <= max_size] <= - Pr[CF(DRestr(D)).main()@ &m: res] + (max_size ^ 2)%r * mu dstate (pred1 witness). - proof. - cut->: - 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});last by auto. - + by sim. + by sim. - proc; inline *; wp. - while (={glob Perm,sc,sa,p} /\ (C.c + size p){1} = C.c{2});2:by auto. - by sp; if=> //=; auto=> /> &2 cL /size_behead=> ->; progress; ring. - have p_ll := P_f_ll _ _. - + apply/dprod_ll; split. - + exact/Block.DBlock.dunifin_ll. - exact/Capacity.DWord.dunifin_ll. - + apply/fun_ext=>- [] a b; rewrite supp_dprod. - by rewrite/=/predT/=Block.DBlock.dunifin_fu Capacity.DWord.dunifin_fu. - have pi_ll := P_fi_ll _ _. - + apply/dprod_ll; split. - + exact/Block.DBlock.dunifin_ll. - exact/Capacity.DWord.dunifin_ll. - + apply/fun_ext=>- [] a b; rewrite supp_dprod. - by rewrite/=/predT/=Block.DBlock.dunifin_fu Capacity.DWord.dunifin_fu. - have f_ll : islossless SqueezelessSponge(Perm).f. - + proc; while true (size p)=> //=. - * by move=> z; wp; call p_ll; skip=> /> &hr /size_behead /#. - 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[PRPt.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. - by proc; if=> //=; auto. - have ->: Pr[CF(DRestr(D)).main() @ &m: res] - = Pr[PRPt.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(); } - (true ==> ={y1,y2}) - (true ==> (y1,y2){1} = x{2})=> //=. - - by inline *; auto. - transitivity{2} { x <@ S.sample(); } - (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(); } - (true ==> ={y1,y2}) - (true ==> (y1,y2){1} = y{2})=> //=. - - by inline *; auto. - transitivity{2} { y <@ S.sample(); } - (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; call (_: true)=> //=. - + apply D_ll. - + by proc; sp; if=> //=; call O_f_ll; auto. - + by proc; sp; if=> //=; call O_fi_ll; auto. - + proc; inline *; sp; if=> //=; auto. - while true (size p). - * by auto; call O_f_ll; auto=> /#. - by auto; smt w=size_ge0. - by inline *; auto. - qed. - -end section. diff --git a/sha3/proof/core/CoreToBlockSponge.eca b/sha3/proof/core/CoreToBlockSponge.eca deleted file mode 100644 index 6cf2b01..0000000 --- a/sha3/proof/core/CoreToBlockSponge.eca +++ /dev/null @@ -1,165 +0,0 @@ -(* -------------------------------------------------------------------- *) -require import Option Pair Int Real Distr List FSet NewFMap DProd. -require import BlockSponge. - -require (*--*) Core. - -op max_query : int. -axiom max_query_ge0: 0 <= max_query. - -clone Core as CoreConstruction with - op Block.r <- Common.r, - type Block.block <- Common.block, - op Block.b0 <- Common.Block.b0, - op Block.(+^) <- Common.Block.(+^), - op Block.enum <- Common.Block.blocks, - op Capacity.c <- Common.c, - type Capacity.capacity <- Common.capacity, - op Capacity.c0 <- Common.Capacity.c0, - op Capacity.enum <- Common.Capacity.caps, - op max_query <- max_query -proof *. -realize Block.r_ge0 by exact/Common.ge0_r. -search Common.Block.(+^). -realize Block.addbA by exact/Common.Block.addwA. - -(*---*) import Common Perm. - -(* -------------------------------------------------------------------- *) -section PROOF. - declare module D:DISTINGUISHER { Perm, Gconcl.IF, SLCommon.C, Gconcl.S, BIRO.IRO }. - - module Wrap (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { - module WF = { - proc f(x : block list * int) = { - var r <- []; - var p, n; - - (p,n) <- x; - if (valid_block p /\ 0 < n) { - r <@ F.f(x); - } - return r; - } - } - - proc distinguish = D(WF,P).distinguish - }. - - module LowerF (F:DFUNCTIONALITY) = { - proc f(m:block list) : block = { - var r <- []; - var p, n; - - (p,n) <- strip m; - if (p <> []) { - r <- F.f(p,n); - } - return last b0 r; - } - }. - - module RaiseF (F:SLCommon.DFUNCTIONALITY) = { - proc f(m:block list, n:int) : block list = { - var i, r, b; - r <- []; - - if (m <> []) { - i <- 0; - b <- b0; - while (i < n) { - b <- F.f(extend m i); - r <- rcons r b; - i <- i + 1; - - } - } - return r; - } - }. - - module LowerDist(D : DISTINGUISHER, F : SLCommon.DFUNCTIONALITY) = - D(RaiseF(F)). - - module RaiseSim(S:SLCommon.SIMULATOR, F:DFUNCTIONALITY) = - S(LowerF(F)). - - local equiv f_f: BIRO.IRO.f ~ RaiseF(Gconcl.IF).f: - ={n} /\ x{1} = m{2} - /\ 0 <= n{2} - /\ valid_block x{1} - /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) - /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p]) - ==> ={res} - /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) - /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p]). - proof. - proc. rcondt{2} 2; 1:by auto=> /#. rcondt{1} 3; 1:by auto=> /#. - inline *. wp. - while ( ={i,n} /\ x{1} = m{2} /\ bs{1} = r{2} - /\ 0 <= i{2} <= n{2} - /\ last b0 x{1} <> b0 - /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) - /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p])). - + sp; if{1}. - + rcondt{2} 2. - + auto=> &hr [#] !->> i_ge0 i_lt_n wf hinv1 hinv2 _ _ + _ _. - by rewrite !in_dom /= hinv2 extendK. - auto=> &1 &2 /= [#] !->> i_ge0 _ wf inv1 inv2 i_lt_n _. - rewrite in_dom wf=> mp_xi r -> /=; split; first by rewrite !getP. - split=> [/#|]; split=> [p n|p]. - + by rewrite getP; case: ((p,n) = (m,i){2})=> [[#] <*>|_ /inv1]. - rewrite !getP; case: (strip p = (m,i){2})=> [strip_p|]. - + by have := stripK p; rewrite strip_p=> /= ->. - case: (p = extend m{2} i{2})=> [<*>|_ _]; first by rewrite extendK. - exact/inv2. - rcondf{2} 2. - + auto=> &hr [#] !->> i_ge0 i_lt_n wf hinv1 hinv2 _ _ + _ _. - by rewrite !in_dom /= hinv2 extendK. - by auto=> &1 &2; smt (DWord.bdistr_ll extendK). - by auto; smt (valid_block_ends_not_b0). - qed. - - lemma conclusion &m: - `| Pr[RealIndif(Sponge,Perm,Wrap(D)).main() @ &m : res] - - Pr[IdealIndif(BIRO.IRO,RaiseSim(Gconcl.S),Wrap(D)).main() @ &m : res] | - = `| Pr[SLCommon.RealIndif(SLCommon.SqueezelessSponge,SLCommon.PC(Perm),LowerDist(Wrap(D))).main() @ &m : res] - - Pr[SLCommon.IdealIndif(Gconcl.IF,Gconcl.S,LowerDist(Wrap(D))).main() @ &m : res] |. - proof. - do 3?congr. - + byequiv (_: ={glob D} ==> _)=> //; proc; inline *. - call (_: ={glob Perm}). - + by proc; inline *; wp; sim. - + by proc; inline *; wp; sim. - + proc; sp; if=> //. - call (_: ={glob Perm, arg} - /\ valid_block xs{1} /\ 0 < n{1} - ==> ={glob Perm, res}). - + proc. rcondt{1} 4; 1:by auto. rcondt{2} 2; 1:by auto; smt (valid_block_ends_not_b0). - rcondt{2} 4; 1:by auto. - inline{2} SLCommon.SqueezelessSponge(SLCommon.PC(Perm)).f. - seq 4 6: ( ={glob Perm, n, i, sa, sc} - /\ (* some notion of path through Perm.m *) true). - + while ( ={glob Perm, sa, sc} - /\ xs{1} = p{2} - /\ (* some notion of path through Perm.m *) true). - + wp; call (_: ={glob Perm}). - + by inline *; wp; sim. - by auto=> /> /#. - by auto=> &1 &2 [#] !<<- vblock n_gt0 /=; rewrite /extend nseq0 cats0. - (* make sure that the notion of path guarantees that only the last call of each iteration adds something to the map, and that it is exactly the right call *) - admit. - by auto=> /#. - by auto. - byequiv (_: ={glob D} ==> _)=> //; proc; inline *. - call (_: ={glob S} - /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) - /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p]) - /\ (* relation between S.paths and presence in the RO map *) true). - + proc. if=> //=; last by auto. if=> //=; last by auto. - inline *. admit. (* something about valid queries *) - + admit. (* prove: S(LowerF(BIRO.IRO)).fi ~ S(IF).fi *) - + by proc; sp; if=> //; call (f_f); auto=> /#. - by auto=> />; split=> [?|] ?; rewrite !map0P. - qed. -end section PROOF. diff --git a/sha3/proof/core/Gcol.eca b/sha3/proof/core/Gcol.eca deleted file mode 100644 index fcc397c..0000000 --- a/sha3/proof/core/Gcol.eca +++ /dev/null @@ -1,317 +0,0 @@ -pragma -oldip. -require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. -require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. -require import DProd Dexcepted. -(*...*) import Capacity IntOrder Bigreal RealOrder BRA. - -require (*..*) Handle. - -clone export Handle as Handle0. - export ROhandle. - -(* -------------------------------------------------------------------------- *) - - (* TODO: move this *) - lemma c_gt0r : 0%r < (2^c)%r. - proof. by rewrite lt_fromint;apply /powPos. 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}. - - 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 (rng FRO.m)) <= 2*max_size /\ - count < max_size) { - c <$ cdistr; - G1.bcol <- G1.bcol \/ mem (image fst (rng FRO.m)) c; - count <- count + 1; - } - - return c; - } - - module C = { - - proc f(p : block list): block = { - var sa, sa', sc; - var h, i <- 0; - sa <- b0; - while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; - } else { - 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; - } - 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 (!mem (dom G1.m) x) { - if (!(mem (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 (mem (dom G1.paths) x.`2) { - (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 (mem (dom G1.mh) (x.`1, hx2) /\ - 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 (mem (dom G1.paths) x.`2) { - (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 (!mem (dom G1.mi) x) { - if (!(mem (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 (mem (dom G1.mhi) (x.`1, hx2) /\ - 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 <- map0; - G1.m <- map0; - G1.mi <- map0; - G1.mh <- map0; - G1.mhi <- map0; - G1.bcol <- false; - - FRO.m <- map0.[0 <- (c0, Known)]; - G1.paths <- map0.[c0 <- ([<:block>],b0)]; - G1.chandle <- 1; - count <- 0; - b <@ DRestr(D,C,S).distinguish(); - return b; - } - }. - - lemma card_rng_set (m:('a,'b)fmap) x y: card(rng m.[x<-y]) <= card(rng m) + 1. - proof. - rewrite rng_set fcardU fcard1. - cut := subset_leq_fcard (rng (rem x m)) (rng m) _;2:smt ml=0 w=fcard_ge0. - rewrite subsetP=> z;apply rng_rem_le. - qed. - - lemma hinv_image handles c: - hinv handles c <> None => - mem (image fst (rng handles)) c. - proof. - case: (hinv handles c) (hinvP handles c)=>//= h[f] Heq. - rewrite imageP;exists (c,f)=>@/fst/=. - by rewrite in_rng;exists (oget (Some h)). - qed. - - local equiv G1col : 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}/\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card (rng 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. - seq 2 2 : (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, - C.c,x0} /\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card(rng FRO.m) + 2 <= 2*C.c + 1/\ - Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. - if=>//;last by auto=>/#. - swap{1}[3..5]-2. - seq 3 2:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, - C.c,x0,hx2} /\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card (rng FRO.m) + 1 <= 2 * C.c + 1/\ - Gcol.count + 1 <= C.c <= max_size){2}). - + auto;smt ml=0 w=card_rng_set. - seq 2 2: - (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, - C.c,x0,hx2,y0} /\ - ((G1.bcol\/hinv FRO.m y0.`2 <> None){1} => G1.bcol{2}) /\ - (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ - Gcol.count <= C.c <= max_size){2});last by auto;smt ml=0 w=card_rng_set. - wp;if=>//;inline Gcol.sample_c. - + rcondt{2}4. - + auto;conseq (_:true)=>//;progress;2: smt ml=0. - by cut /#:= fcard_image_leq fst (rng FRO.m{hr}). - wp;conseq (_: ={p,v,F.RO.m,y1} /\ y2{1}=c{2})=>//;1:smt ml=0 w=hinv_image. - by sim. - rcondt{2}3. - + by auto;progress;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). - auto;progress;smt w=hinv_image. - - + proc;sp 1 1;if=>//. - inline G1(DRestr(D)).S.fi Gcol.S.fi. - seq 2 2 : (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, - C.c,x0} /\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card(rng FRO.m) + 2 <= 2*C.c + 1 /\ - Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. - if=>//;last by auto=>/#. - seq 3 2:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, - C.c,x0,hx2} /\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ - Gcol.count + 1 <= C.c <= max_size){2}). - + by 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,x0,hx2,y0,y1,y2} /\ y0{1} = (y1,y2){1} /\ - ((G1.bcol\/hinv FRO.m y0.`2 <> None){1} => G1.bcol{2}) /\ - (card (rng 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;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). -(* BUG: auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | H]. marche pas ???? *) - auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | X];right;apply hinv_image=> //. - - + proc;sp 1 1;if=>//. - inline G1(DRestr(D)).C.f Gcol.C.f. - seq 5 5: - (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c,b, - p,h,i,sa} /\ i{1}=0 /\ - (G1.bcol{1} => G1.bcol{2}) /\ - card (rng FRO.m{2}) + 2*(size p{2}) <= 2 * C.c{2} + 1 /\ - Gcol.count{2} + size p{2} <= C.c{2} <= max_size);1:by auto=>/#. - wp;call (_: ={F.RO.m});1:by sim. - 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} /\ (i <= size p){1} /\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card (rng FRO.m) + 2*(size p - i) <= 2 * C.c + 1 /\ - Gcol.count + size p - i <= C.c <= max_size){2}); - last by auto; smt ml=0 w=size_ge0. - if=>//;auto;1:smt ml=0 w=size_ge0. - call (_: ={F.RO.m});1:by sim. - inline *;rcondt{2} 2. - + auto;progress;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). - auto;smt ml=0 w=(hinv_image card_rng_set). - - auto;progress;3:by smt ml=0. - + by rewrite rng_set rem0 rng0 fset0U fcard1. - by apply max_ge0. - 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 (rng 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 (rng FRO.m)));skip;progress;2:smt ml=0. - cut->:=(Mu_mem.mu_mem (image fst (rng FRO.m{hr})) cdistr (1%r/(2^c)%r) _). - + move=>x _; rewrite DWord.dunifin1E;do !congr;exact cap_card. - 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. - - 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 G1col=> //#. - apply (Pr_col &m). - qed. - -end section PROOF. - - diff --git a/sha3/proof/core/Gconcl.ec b/sha3/proof/core/Gconcl.ec deleted file mode 100644 index bf80aed..0000000 --- a/sha3/proof/core/Gconcl.ec +++ /dev/null @@ -1,384 +0,0 @@ -pragma -oldip. -require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. -require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. -require import DProd Dexcepted. -(*...*) import Capacity 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 <- map0; - mi <- map0; - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - paths <- map0.[c0 <- ([<:block>],b0)]; - } - - proc f(x : state): state = { - var p, v, y, y1, y2; - - if (!mem (dom m) x) { - if (mem (dom paths) x.`2) { - (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 (mem (dom paths) x.`2) { - (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 (!mem (dom mi) x) { - 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 }. -local clone import Gext as Gext0. - -local module G3(RO:F.RO) = { - - module C = { - - proc f(p : block list): block = { - var sa, sa'; - var h, i <- 0; - sa <- b0; - while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { - RO.sample(take (i+1) p); - (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; - } else { - 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; - } - 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 (!mem (dom G1.m) x) { - if (mem (dom G1.paths) x.`2) { - (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.restrK(); - if (!mem (rng handles_) x.`2) { - RRO.set(G1.chandle, x.`2); - G1.chandle <- G1.chandle + 1; - } - handles_ <- RRO.restrK(); - hx2 <- oget (hinvc handles_ x.`2); - t <@ RRO.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); - if (mem (dom G1.mh) (x.`1, hx2) /\ 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 (mem (dom G1.paths) x.`2) { - (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 (!mem (dom G1.mi) x) { - handles_ <@ RRO.restrK(); - if (!mem (rng handles_) x.`2) { - RRO.set(G1.chandle, x.`2); - G1.chandle <- G1.chandle + 1; - } - handles_ <@ RRO.restrK(); - hx2 <- oget (hinvc handles_ x.`2); - t <@ RRO.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); - y1 <$ bdistr; - y2 <$ cdistr; - y <- (y1,y2); - if (mem (dom G1.mhi) (x.`1, hx2) /\ 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 <- map0; - G1.mi <- map0; - G1.mh <- map0; - G1.mhi <- map0; - - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - RRO.init(); - RRO.set(0,c0); - G1.paths <- map0.[c0 <- ([<:block>],b0)]; - G1.chandle <- 1; - b <@ DRestr(D,C,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}); last by auto. - - + proc;sp;if=> //. - call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c});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} /\ - (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}); - 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} - /\ (t = in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1}). - + by inline *;auto=> /> ? _;rewrite Block.DWord.bdistr_ll. - case ((mem (dom G1.mh) (x.`1, hx2) /\ 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=>/>. - wp;rnd;auto;progress[-split];rewrite DCapacity.dunifin_ll /= => ?_?->. - by rewrite !getP /= oget_some. - case ((mem (dom G1.mh) (x.`1, hx2) /\ 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=>/>. - wp;rnd;auto;rnd{1};auto;progress[-split]. - rewrite Block.DBlock.supp_dunifin DCapacity.dunifin_ll /==> ?_?->. - by rewrite !getP /= oget_some. - - + proc;sp;if=>//. - call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c});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} - /\ (t = in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1}). - + by inline *;auto. - case ((mem (dom G1.mhi) (x.`1, hx2) /\ 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=>/>. - wp;rnd;auto;progress[-split];rewrite DCapacity.dunifin_ll /= => ?_?->. - by rewrite !getP /= oget_some. - - proc;sp;if=>//. - call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c});2:by auto. - by inline F.LRO.sample;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 (!mem (dom G1.m) x) { - if (mem (dom G1.paths) x.`2) { - (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 (mem (dom G1.paths) x.`2) { - (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 (!mem (dom G1.mi) x) { - 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 <- map0; - G1.mi <- map0; - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - G1.paths <- map0.[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});last by auto. - + proc;sp;if=>//. - call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. - if => //;2:sim. - seq 3 3: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by sim. - sim;seq 5 0: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by inline *;auto. - by if{1};sim;inline *;auto. - + proc;sp;if=>//. - call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. - if => //;2:sim. - seq 5 0: (={x,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by inline *;auto. - seq 3 3: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by sim. - by if{1};sim;inline *;auto. - proc;sp;if=>//. - call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. - sp;sim; while(={i,p,F.RO.m})=>//. - inline F.RO.sample F.RO.get;if{1};1:by auto. - by sim;inline *;auto;progress;apply 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,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=>//. - 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. - -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)%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]). - + by byequiv (_: ={glob G3, F.RO.m} ==> _)=>//;symmetry;conseq (F.RO_LRO_D G3). - 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]);1:by byequiv (F.RO_LRO_D G4). - by byequiv G4_Ideal. -qed. - -end section. diff --git a/sha3/proof/core/Gext.eca b/sha3/proof/core/Gext.eca deleted file mode 100644 index 988a9a2..0000000 --- a/sha3/proof/core/Gext.eca +++ /dev/null @@ -1,675 +0,0 @@ -pragma -oldip. -require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. -require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. -require import DProd Dexcepted. -(*...*) import Capacity IntOrder Bigreal RealOrder BRA DCapacity. - -require (*..*) Gcol. - -clone export Gcol as Gcol0. - -op bad_ext (m mi:smap) y = - mem (image snd (dom m)) y \/ - mem (image snd (dom mi)) y. - -op hinvc (m:(handle,capacity)fmap) (c:capacity) = - find (+ pred1 c) m. - -module G2(D:DISTINGUISHER,HS:FRO) = { - - module C = { - - proc f(p : block list): block = { - var sa, sa'; - var h, i <- 0; - sa <- b0; - while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; - } else { - 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; - } - 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 (!mem (dom G1.m) x) { - if (mem (dom G1.paths) x.`2) { - (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.restrK(); - if (!mem (rng handles_) x.`2) { - HS.set(G1.chandle, x.`2); - G1.chandle <- G1.chandle + 1; - } - handles_ <- HS.restrK(); - hx2 <- oget (hinvc handles_ x.`2); - t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); - if (mem (dom G1.mh) (x.`1, hx2) /\ 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 (mem (dom G1.paths) x.`2) { - (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 (!mem (dom G1.mi) x) { - handles_ <@ HS.restrK(); - if (!mem (rng handles_) x.`2) { - HS.set(G1.chandle, x.`2); - G1.chandle <- G1.chandle + 1; - } - handles_ <@ HS.restrK(); - hx2 <- oget (hinvc handles_ x.`2); - y1 <$ bdistr; - y2 <$ cdistr; - y <- (y1,y2); - t <@ HS.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); - if (mem (dom G1.mhi) (x.`1, hx2) /\ 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 <- map0; - G1.m <- map0; - G1.mi <- map0; - G1.mh <- map0; - G1.mhi <- map0; - G1.bext <- false; - - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - HS.set(0,c0); - G1.paths <- map0.[c0 <- ([<:block>],b0)]; - G1.chandle <- 1; - b <@ D(C,S).distinguish(); - return b; - } -}. - -section. - - declare module D: DISTINGUISHER{G1, G2, FRO}. - - op inv_ext (m mi:smap) (FROm:handles) = - exists x h, mem (dom m `|` dom 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: - mem (rng (restr f m)) x <=> mem (rng m) (x,f). - proof. - rewrite !in_rng;split=>-[z]H;exists z;move:H;rewrite restrP; case m.[z]=>//=. - by move=> [t f'] /=;case (f'=f). - qed. - - equiv G1_G2 : G1(D).main ~ Eager(G2(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. - call (_: ={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m} /\ - inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ - (forall h, mem (dom FRO.m) h => h < G1.chandle){1}). - + proc;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,y} /\ - inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ - (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ - ! mem (dom G1.m{1}) x{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,y,hx2} /\ - t{2} = (in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1} /\ - (G1.bext{1} => (G1.bext{2} \/ (mem (rng FRO.m) (x.`2, Unknown)){2} \/ - inv_ext G1.m{2} G1.mi{2} FRO.m{2})) /\ - (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ - ! mem (dom G1.m{1}) x{1}). - + inline *;auto=> &ml&mr[#]10!-> Hi Hhand -> /=. - rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. - + rewrite rng_set !inE rem_id 1:/#;move:H0=>[/Hi[->|[x' h][]H1 H2]|->]//. - right;right;exists x' h;rewrite getP. - by cut ->//:(h<> G1.chandle{mr});move:(Hhand h);rewrite in_dom H2 /#. - by move:H0;rewrite dom_set !inE /#. - seq 1 1: (={x,y,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m} /\ - inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ - forall (h : handle), mem (dom FRO.m{1}) h => h < G1.chandle{1});2:by auto. - if=>//. - + inline *;rcondt{2} 4. - + by move=> &m;auto;rewrite /in_dom_with. -(* auto=> |>. (* Bug ???? *) *) - auto;progress. - + by apply sampleto_ll. - + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. - + case (h = (oget G1.mh{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. - + by left;rewrite Hh oget_some. - by right;exists x{2} h;rewrite dom_set getP Hneq !inE. - case (h = (oget G1.mh{2}.[(x{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 !dom_set getP Hneq //=. - by move:Hx;rewrite !inE Hh=>-[]->. - by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. - inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. - rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. - + right;exists x{2} h;rewrite getP dom_set !inE /=. - by move:(H0 h);rewrite in_dom Hh /#. - right;exists x' h;rewrite getP !dom_set !inE;split. - + by move:Hx;rewrite !inE=>-[]->. - by move:(H0 h);rewrite !in_dom Hh /#. - - + proc;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,y,hx2} /\ - t{2} = (in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1} /\ - (G1.bext{1} => (G1.bext{2} \/ (mem (rng FRO.m) (x.`2, Unknown)){2} \/ - inv_ext G1.m{2} G1.mi{2} FRO.m{2})) /\ - (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ - ! mem (dom G1.mi{1}) x{1}). - + inline *;auto=> &ml&mr[#]9!-> Hi Hhand -> /=. - rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. - + rewrite rng_set !inE rem_id 1:/#;move:H4=>[/Hi[->|[x' h][]HH1 HH2]|->]//. - right;right;exists x' h;rewrite getP. - by cut ->//:(h<> G1.chandle{mr});move:(Hhand h);rewrite in_dom HH2 /#. - by move:H4;rewrite dom_set !inE /#. - if=>//. - + inline *;rcondt{2} 4. - + by move=> &m;auto;rewrite /in_dom_with. - auto;progress. - + by apply sampleto_ll. - + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. - + case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. - + by left;rewrite Hh oget_some. - by right;exists x{2} h;rewrite !dom_set getP Hneq !inE. - case (h = (oget G1.mhi{2}.[(x{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 !dom_set getP Hneq //=. - by move:Hx;rewrite !inE Hh=>-[]->. - by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. - inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. - rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. - + right;exists x{2} h;rewrite getP !dom_set !inE /=. - by move:(H0 h);rewrite in_dom Hh /#. - right;exists x' h;rewrite getP !dom_set !inE;split. - + by move:Hx;rewrite !inE=>-[]->. - by move:(H0 h);rewrite !in_dom Hh /#. - - + proc; - conseq (_: ={sa,G1.mh,G1.mhi,F.RO.m, G1.chandle, FRO.m} /\ - inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ - forall (h0 : handle), mem (dom FRO.m{1}) h0 => h0 < G1.chandle{1})=>//. - sp 3 3;call (_: ={F.RO.m});1:by sim. - while (={sa,G1.mh,G1.mhi,F.RO.m,G1.chandle,FRO.m,i,h,sa,p} /\ - inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ - forall (h0 : handle), mem (dom FRO.m{1}) h0 => h0 < G1.chandle{1})=>//. - if=>//;inline *;1:by auto. - rcondt{2} 3;1:by auto=>/#. - auto=> &m1&m2 [#] 10!-> Hinv Hhand Hi _ _ /= ?->?->/=;split=>/= _;split. - + move:Hinv;rewrite /inv_ext1=> H/H{H}[->//|[x h]];rewrite inE=>-[Hmem Hh]. - by right;exists x h;rewrite !inE Hmem getP;smt w=in_dom. - + by move=>h;rewrite dom_set !inE /#. - + move:Hinv;rewrite /inv_ext1=> H/H{H}[->//|[x h]];rewrite inE=>-[Hmem Hh]. - by right;exists x h;rewrite !inE Hmem getP;smt w=in_dom. - by move=>h;rewrite dom_set !inE /#. - - (* **************** *) - inline *;auto;progress. - by move:H;rewrite dom_set dom0 !inE=>->. - qed. - -end section. - -section EXT. - - declare module D: DISTINGUISHER{C, PF, G1, G2, Perm, RO }. - - local module ReSample = { - var count:int - proc f (h:handle) = { - var c; - c <$ cdistr; - if (size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size) { - G1.bext <- G1.bext \/ mem (image snd (dom G1.m `|` dom G1.mi)) c; - FRO.m.[h] <- (c,Unknown); - count = count + 1 ; - } - } - - proc f1 (x:capacity,h:handle) = { - var c; - c <$ cdistr; - if (size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size) { - G1.bext <- G1.bext \/ mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x) c; - FRO.m.[h] <- (c,Unknown); - count = count + 1; - } - } - - }. - - local module Gext = { - - proc resample () = { - Iter(ReSample).iter (elems (dom (restr Unknown FRO.m))); - } - - module C = { - - proc f(p : block list): block = { - var sa, sa'; - var h, i <- 0; - sa <- b0; - while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; - } else { - 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; - } - 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 (!mem (dom G1.m) x) { - if (mem (dom G1.paths) x.`2) { - (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.restrK(); - if (!mem (rng handles_) x.`2) { - RRO.set(G1.chandle, x.`2); - G1.chandle <- G1.chandle + 1; - } - handles_ <- RRO.restrK(); - hx2 <- oget (hinvc handles_ x.`2); - t <@ RRO.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); - if (mem (dom G1.mh) (x.`1, hx2) /\ 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 (mem (dom G1.paths) x.`2) { - (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 (!mem (dom G1.mi) x) { - handles_ <@ RRO.restrK(); - if (!mem (rng handles_) x.`2) { - RRO.set(G1.chandle, x.`2); - G1.chandle <- G1.chandle + 1; - } - handles_ <@ RRO.restrK(); - hx2 <- oget (hinvc handles_ x.`2); - y1 <$ bdistr; - y2 <$ cdistr; - y <- (y1,y2); - t <@ RRO.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); - if (mem (dom G1.mhi) (x.`1, hx2) /\ 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 <- map0; - G1.m <- map0; - G1.mi <- map0; - G1.mh <- map0; - G1.mhi <- map0; - G1.bext <- false; - ReSample.count <- 0; - FRO.m <- map0; - - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - RRO.set(0,c0); - G1.paths <- map0.[c0 <- ([<:block>],b0)]; - G1.chandle <- 1; - b <@ DRestr(D,C,S).distinguish(); - resample(); - return b; - } - }. - - op inv_lt (m2 mi2:smap) c1 (Fm2:handles) count2 = - size m2 < c1 /\ size mi2 < c1 /\ - count2 + size (restr Unknown Fm2) < c1 /\ - c1 <= max_size. - - op inv_le (m2 mi2:smap) c1 (Fm2:handles) count2 = - size m2 <= c1 /\ size mi2 <= c1 /\ - count2 + size (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): - size (m.[x<-y]) = if mem (dom m) x then size m else size m + 1. - proof. - rewrite sizeE dom_set;case (mem (dom m) x)=> Hx. - + by rewrite fsetUC subset_fsetU_id 2:sizeE 2:// => z; rewrite ?inE. - rewrite fcardUI_indep 1:fset0_eqP=>[z|]. - + by rewrite !inE;case (z=x)=>//. - by rewrite fcard1 sizeE. - qed. - - lemma size_set_le (m:('a,'b)fmap) (x:'a) (y:'b): size (m.[x<-y]) <= size m + 1. - proof. rewrite size_set /#. qed. - - lemma size_rem (m:('a,'b)fmap) (x:'a): - size (rem x m) = if mem (dom m) x then size m - 1 else size m. - proof. - rewrite !sizeE dom_rem fcardD;case (mem (dom m) x)=> Hx. - + by rewrite subset_fsetI_id 2:fcard1// => z;rewrite !inE. - by rewrite (eq_fcards0 (_ `&` _)) 2:// fset0_eqP=>z;rewrite !inE /#. - qed. - - lemma size_rem_le (m:('a,'b)fmap) x : size (rem x m) <= size m. - proof. by rewrite size_rem /#. qed. - - lemma size_ge0 (m:('a,'b)fmap) : 0 <= size m. - proof. rewrite sizeE fcard_ge0. qed. - - lemma size0 : size map0<:'a,'b> = 0. - proof. by rewrite sizeE dom0 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 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} /\ size G1.m{2} <= max_size /\ - size G1.mi{2} <= max_size /\ - ReSample.count{2} + size l{2} <= max_size /\ - ((G1.bext{1} \/ - exists (x : state) (h : handle), - mem (dom G1.m{1} `|` dom 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 getP;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} /\ - inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}). - + proc;sp;if=> //. - 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 9 : (={x, y, 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});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} /\ - 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} /\ - 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.in_dom; wp;call (_: ={FRO.m});1:by sim. - inline RRO.restrK;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=(sizeE size_ge0). - rcondt{2} 10. by auto;progress;rewrite dom_set !inE. - wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. - rewrite/Distr.is_lossless (sampleto_ll 0)/= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. - 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=> //. - 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.in_dom; auto;call (_: ={FRO.m});1:by sim. - inline RRO.restrK;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=(sizeE size_ge0). - rcondt{2} 10. by auto;progress;rewrite dom_set !inE. - wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. - rewrite/Distr.is_lossless (sampleto_ll 0) /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. - 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=>//. - inline G2(DRestr(D), RRO).C.f Gext.C.f. - sp 5 5;elim *=> c0L c0R. - wp;call (_: ={F.RO.m});1:by sim. - while (={i,p,G1.mh,sa,h,FRO.m,F.RO.m,G1.mh,G1.mhi,G1.chandle} /\ 0 <= i{1} <= size p{1}/\ - c0R + size p{1} <= max_size /\ - inv_le G1.m{2} G1.mi{2} (c0R + i){2} FRO.m{2} ReSample.count{2}); - last by auto;smt w=List.size_ge0. - if=> //;1:by auto=>/#. - auto;call (_: ={F.RO.m});1:by sim. - inline *;auto=> ?&mr [#]!->@/inv_le Hi [#]. - case (p{mr})=> [/#|/=p1 p2] 4?_ /= 2?-> /=;split=>/= Hmem 4? [#]2->/= => [|/#]. - by rewrite restr_set /= size_set dom_restr /in_dom_with Hmem/= /#. - - auto;progress[delta];rewrite ?(size0,restr0,restr_set,rem0,max_ge0,-sizeE,-cardE) //=. - + smt ml=0. + smt ml=0. + smt ml=0. - + elim H7=>// [[x h] [#]];rewrite -memE dom_restr /in_dom_with in_dom=> _ ->/=. - by rewrite oget_some. - apply H10=>//. - 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 : - (size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size); - ReSample.f1 : - (size G1.m < max_size /\ size 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 (dom G1.m `|` dom G1.mi ))); skip=> /> &hr ? ? -> /= ? ?. - rewrite (Mu_mem.mu_mem - (image snd (dom G1.m{hr} `|` dom G1.mi{hr})) - cdistr (1%r/(2^c)%r))//. print DCapacity. - + 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 (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). - by rewrite -!sizeE;smt w=fcard_ge0. - + rewrite/#. - + 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 (dom G1.m `|` dom G1.mi) `|` fset1 x));skip=> /> &hr ??-> /= ??. - rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom 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 (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). - by rewrite -!sizeE;smt w=fcard_ge0. - + rewrite/#. - + by move=>c1;proc;auto=> &hr [^H 2->]/#. - move=> b1 c1;proc;auto=> /#. - qed. - - 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)%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 => //. - + cut ->: Pr[G1(DRestr(D)).main() @ &m : res] = Pr[Eager(G2(DRestr(D))).main1() @ &m : res]. - + by byequiv (G1_G2 (DRestr(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 (DRestr(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/core/Handle.eca b/sha3/proof/core/Handle.eca deleted file mode 100644 index a0c147d..0000000 --- a/sha3/proof/core/Handle.eca +++ /dev/null @@ -1,1865 +0,0 @@ -pragma -oldip. pragma +implicits. -require import Core Int Real StdOrder Ring IntExtra. -require import List FSet NewFMap Utils Common SLCommon RndO. -require import DProd Dexcepted. -(*...*) import Capacity IntOrder DCapacity. - -require ConcreteF. - -clone import GenEager as ROhandle with - type from <- handle, - type to <- capacity, - op sampleto <- fun (_:int) => cdistr - proof sampleto_ll by apply DCapacity.dunifin_ll. - -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 C = { - - proc f(p : block list): block = { - var sa, sa', sc; - var h, i <- 0; - sa <- b0; - while (i < size p ) { - if (mem (dom mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; - } else { - 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; - } - 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 (!mem (dom m) x) { - if (mem (dom paths) x.`2) { - (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 \/ mem (rng FRO.m) (x.`2, Unknown); - if (!(mem (rng FRO.m) (x.`2, Known))) { - FRO.m.[chandle] <- (x.`2, Known); - chandle <- chandle + 1; - } - hx2 <- oget (hinvK FRO.m x.`2); - if (mem (dom mh) (x.`1, hx2) /\ 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 (mem (dom paths) x.`2) { - (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 (!mem (dom mi) x) { - bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); - if (!(mem (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 (mem (dom mhi) (x.`1,hx2) /\ - 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 <- map0; - m <- map0; - mi <- map0; - mh <- map0; - mhi <- map0; - bext <- false; - bcol <- false; - - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - FRO.m <- map0.[0 <- (c0, Known)]; - paths <- map0.[c0 <- ([<:block>],b0)]; - chandle <- 1; - b <@ D(C,S).distinguish(); - return b; - } -}. - -(* -------------------------------------------------------------------------- *) -(** The state of CF contains only the map PF.m. - 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<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 = - | 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). - -(** 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: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => - 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: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => - 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: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => - 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: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => - 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: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => - 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: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => - 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: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => - hs_spec hs ch. -proof. by case. qed. - -lemma inv_of_INV hs ch m1 mi1 m2 mi2 ro pi - mh2 mhi2: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => - inv_spec mh2 mhi2. -proof. by case. qed. - -lemma invG_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => - inv_spec m2 mi2. -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_notin_dom_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_notin_dom_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_notin_dom2_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_notin_dom2_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_notin_dom2_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 !getP 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 !getP 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 !getP /= /#. - + by exists hy fy hy' fy'; rewrite !getP Hhy' /#. - + by exists hx' fx' hy fy; rewrite !getP Hhx' /#. - by exists hx' fx' hy' fy'; rewrite !getP 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 !getP /= /#. -+ by exists yc fy yc' fy'; rewrite !getP Hhy' /#. -+ by exists xc' fx' yc fy; rewrite !getP Hhx' /#. -by exists xc' fx' yc' fy'; rewrite !getP 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 getP. -+ case: ((xa0,xc0) = (xa,xc))=> [[#] <<*> [#] <<*>|] /=. - + by exists hx f hy f'; rewrite !getP /= /#. - move=> xaxc0_neq_xaxc /Hm_mh [hx0 fx0 hy0 fy0] [#] hs_hx0 hs_hy0 mh_xahx0. - by exists hx0 fx0 hy0 fy0; rewrite !getP /#. -case: ((xa0,hx0) = (xa,hx))=> [[#] <*>> [#] <<*>|] /=. -+ by exists xc f yc f'; rewrite !getP /= /#. -rewrite andaE=> /negb_and xahx0_neq_xahx /Hmh_m [xc0 fx0 yc0 fy0] [#] hs_hx0 hs_hy0 Pm_xaxc0. -exists xc0 fx0 yc0 fy0; rewrite !getP; 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 getP; case: ((ya0,yc0) = (ya,yc))=> [[#] <*>> [#] <*>>|]. - + by exists hy fy hx fx; rewrite !getP /= /#. - move=> yayc0_neq_yayc /Hm_mh [hy0 fy0 hx0 fx0] [#] hs_hy0 hs_hx0 mhi_yayc0. - by exists hy0 fy0 hx0 fx0; rewrite !getP /#. -move=> ya0 hy0 xa0 hx0; rewrite getP; case: ((ya0,hy0) = (ya,hy))=> [[#] <*>> [#] <<*>|]. -+ by exists yc fy xc fx; rewrite !getP //= /#. -rewrite /= andaE=> /negb_and yahy0_neq_yahy /Hmh_m [yc0 fy0 xc0 fx0] [#] hs_hy0 hs_hx0 mi_yayc0. -exists yc0 fy0 xc0 fx0; rewrite !getP; 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 !getP. -case: (h1 = h); case: (h2 = h)=> //= [Hh2 + [#]|+ Hh1 + [#]|_ _] - <*>. -+ by rewrite c_notin_rng1_hs. -+ by rewrite c_notin_rng1_hs. -exact/Hhuniq. -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 !getP /=. - case: (h1 = ch); case: (h2 = ch)=> //= [+ + [#]|+ + + [#]|]=> <*>; - first 2 by rewrite xc_notin_rng1_hs. - by move=> _ _ hs_h1 /(Hhuniq _ _ _ _ hs_h1). -+ by rewrite getP (ch_neq0 _ Hhs). -+ move=> [c f] h; rewrite !getP; 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. -+ by move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /= /#. -+ by rewrite getP hx_neq0. -move=> cf h; rewrite getP; 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 !getP 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 !getP; 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 !getP; 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 <=> mem (rng hs) (xc,f)). -proof. -move=> huniq_hs; split. -+ rewrite /getflag; case: (hinvP hs xc)=> [-> //|]. - rewrite in_rng; case: (hinv hs xc)=> //= h [f']. - rewrite oget_some=> ^ hs_h -> @/snd /= ->>. - by exists h. -rewrite in_rng=> -[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]. -+ by move=> ^/rconsIs <<- {b'} /rconssI <<- {p'}; 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 getP /#. -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]. -move=> v h /build_hpathP [/#|p' b' + + ^/rconsIs <<- /rconssI <<-]. -move=> v' h' /ih; rewrite getP. -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. -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: - INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi - => 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. -proof. -move=> HINV x2_neq_y2 Pm_x Gm_x x2_notin_rng1_hs y2_notin_rng1_hs; split. -+ rewrite (@addzA ch 1 1); apply/hs_addh. - + by move: HINV=> /hs_of_INV/hs_addh=> ->. - by move=> f h; rewrite getP; case: (h = ch)=> [/#|_]; exact/y2_notin_rng1_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_notin_rng1_hs. -+ apply/inv_addm; 1:by case: HINV. - + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. - by apply/(ch_notin_dom2_mh _ _ Hm_mh Hhs). - have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. - by apply/(Sch_notin_dom2_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 getP. - by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_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 getP; case: (h = ch)=> [_ //=|_ //=]; first by rewrite x2_neq_y2. - by rewrite y2_notin_rng1_hs. - + by rewrite getP. - by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. -+ by apply/incl_addm; case: HINV. -+ by apply/incl_addm; case: HINV. -+ split. - + move=> xa hx ya hy; rewrite getP; case: ((xa,hx) = (x1,ch))=> [|]. - + by move=> [#] <*> [#] <*>; exists x2 Known y2 Known; rewrite !getP /#. - 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 getP). - case: fy Hite hs_hy=> /= [[p v] [Hro Hpath] hs_hy|[#] Gm_xaxc <*> hs_hy] /=; last first. - + by rewrite getP; case: ((xa,xc) = (x1,x2))=> [/#|]. - exists p v; rewrite Hro /=; apply/build_hpath_up=> //. - have /m_mh_of_INV /notin_hs_notin_dom2_mh H:= HINV. - exact/H/ch_notin_dom_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_notin_dom2_mh hs Pm)/ch_notin_dom_hs; case: HINV. - have ch_notin_rng2_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_notin_dom_hs; case: HINV. - split=> -[#]. - + move=> Hpath mh_vxahx; rewrite getP; 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_notin_rng2_mh. - move=> ^ /build_hpathP + -> /=; rewrite getP. - 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_notin_dom2_mh hs Pm)/ch_notin_dom_hs; case: HINV. - by move=> -> /= ^ /dom_hs; rewrite !getP /#. -have ch_notin_rng2_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_notin_dom_hs; case: HINV. -have Sch_notin_rng2_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_notin_dom_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_notin_rng2_mh. -move=> ^ /build_hpathP + -> /=; rewrite !getP. -by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. -qed. - -lemma lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2: - INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi - => 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. -proof. -move=> HINV x2_neq_y2 Pm_x Gm_x xc_notin_rng1_hs yc_notin_rng1_hs; split. -+ rewrite (@addzA ch 1 1); apply/hs_addh. - + by move: HINV=> /hs_of_INV/hs_addh=> ->. - by move=> f h; rewrite getP; case: (h = ch)=> [/#|_]; exact/yc_notin_rng1_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_notin_rng1_hs. -+ apply/inv_addm; 1:by case: HINV. - + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. - by apply/(Sch_notin_dom2_mh _ _ Hm_mh Hhs). - have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. - by apply/(ch_notin_dom2_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 getP; case: (h = ch)=> [<*> /#|]; rewrite yc_notin_rng1_hs. - + by rewrite getP. - by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_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 getP. - by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. -+ by apply/incl_addm; case: HINV. -+ by apply/incl_addm; case: HINV. -+ split. - + move=> ya hy xa hx; rewrite getP; case: ((ya,hy) = (y1,ch + 1))=> [|]. - + by move=> [#] <*> [#] <*>; exists y2 Known x2 Known; rewrite !getP /#. - 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 getP). - case: fx Hite hs_hx=> /= [[p v] [Hro Hpath] hs_hx|[#] Gm_yayc <*> hs_hx] /=; last first. - + by rewrite getP; case: ((ya,yc) = (y1,y2))=> [/#|]. - exists p v; rewrite Hro /=; apply/build_hpath_up=> //. - have /m_mh_of_INV /notin_hs_notin_dom2_mh H:= HINV. - exact/H/Sch_notin_dom_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_notin_dom2_mh hs Pm)/Sch_notin_dom_hs; case: HINV. - have Sch_notin_rng2_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_notin_dom_hs; case: HINV. - split=> -[#]. - + move=> Hpath mh_vxahx; rewrite getP; 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_notin_rng2_mh. - move=> ^ /build_hpathP + -> /=; rewrite getP. - 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_notin_dom2_mh hs Pm)/Sch_notin_dom_hs; case: HINV. - by move=> -> /= ^ /dom_hs; rewrite !getP /#. -have ch_notin_rng2_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_notin_dom_hs; case: HINV. -have Sch_notin_rng2_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_notin_dom_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_notin_rng2_mh. -move=> ^ /build_hpathP + -> /=; rewrite !getP. -by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. -qed. - -lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x1 x2 y1 y2 hx: - INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi - => 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. -proof. -move=> HINV PFm_x1x2 G1m_x1x2 pi_x2 hs_hx y2_notin_rng1_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_notin_rng1_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_notin_dom2_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_notin_dom_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_notin_dom_hs. -+ by have /incl_of_INV/incl_addm ->:= HINV. -+ by have /incli_of_INV/incl_addm ->:= HINV. -+ split. - + move=> xa' hx' ya' hy'; rewrite getP; case: ((xa',hx') = (x1,hx))=> [[#] <*>> [#] <<*> /=|]. - + exists x2 Known y2 Known=> //=; rewrite !getP /=. - 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 !getP 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 !getP; 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 getP; 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 getP. 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 getP. - 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 getP; 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. -qed. - -lemma lemma2' hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x1 x2 y1 y2 hx: - INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi - => 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. -proof. -move=> HINV PFmi_x1x2 G1mi_x1x2 hs_hx y2_notin_rng1_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_notin_rng1_hs. -+ apply/inv_addm; 1:by case: HINV. - + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. - by apply/(ch_notin_dom2_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_notin_dom_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_notin_dom_hs. -+ by have /incl_of_INV/incl_addm ->:= HINV. -+ by have /incli_of_INV/incl_addm ->:= HINV. -+ split. - + move=> ya' hy' xa' hx'; rewrite getP; case: ((ya',hy') = (y1,ch))=> [[#] <*>> [#] <<*> /=|]. - + exists y2 Known x2 Known=> //=; rewrite !getP /=. - 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 !getP 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 !getP; 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_notin_dom2_mh hs PFm)/(ch_notin_dom_hs); by case: HINV. - move=> -> /=; rewrite getP /=; 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 getP. 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 getP. - 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 getP; 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. -qed. - -lemma lemma3 hs ch Pm Pmi Gm Gmi mh mhi ro pi xa xc hx ya yc hy p b: - INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi - => 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)]. -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 andaE -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 getP; 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!<<- {xct fxt} [#] 2!<<- {yct fyt} Pmi_yayc. - move=> [za zc]; rewrite getP; 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 !getP /=. - case: (hx = hy)=> [<*>|_]; first by move: hs_hx; rewrite hs_hy. - by exists xc Known yc Known; rewrite getP. - 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 (@getP _ _ _ hy') Hhy'=> /= hs_hx' ^ hs_hy' -> Hite. - exists xc' (if hx' = hy then Known else fx') yc' fy'. - rewrite (@getP Gm) (_: (xa',xc') <> (xa,xc)) /=. - + move: Hxahx'=> /=; case: (xa' = xa)=> [<*> /=|//]. - by apply/contra=> <*>; have /hs_of_INV [] + _ _ - /(_ _ _ _ _ hs_hx' hs_hx _) := HINV. - rewrite getP; case: (hx' = hy)=> /= [<*>|//]. - move: hs_hx'; rewrite hs_hy=> /= [#] <<*> /=. - by move: Hite=> /= [#]; case: fy' hs_hy'=> //= _ ->. -split=> c p' b'; rewrite !getP; 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 getP; case: (h = hy)=> [<*> /=|//=]. - by rewrite yc_neq_c hs_hy /=. -split=> [[#] <<*>|]. -+ exists hy; rewrite getP /=; 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 getP; 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. -qed. - -clone export ConcreteF as ConcreteF1. - -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 getP /=;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)=> [->> _ _ _ /Hch //|??? Hbu Hg]. - by rewrite build_hpath_prefix;exists v' h'. -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 oget_some. - rewrite getP. 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 getP;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 /= getP_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 getP_eq /=;apply build_hpath_up_None. -qed. - - - - -(* we should do a lemma to have the equivalence *) - -equiv eq_fi (D <: DISTINGUISHER {PF, RO, G1}): PF.fi ~ G1(D).S.fi: - !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} - ==> !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}. -proof. -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}. -elim* => hs ch Pm Pmi Gm Gmi mh mhi ro pi [xa xc]. -case @[ambient]: - {-1}(INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi) - (eq_refl (INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi)); 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 in_dom Pmi_xaxc. - rcondt{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. - case @[ambient]: {-1}(getflag hs xc) (eq_refl (getflag hs xc)). - + move=> /getflagP_none xc_notin_rng1_hs. - rcondt{2} 2. - + auto=> &hr [#] <<*> _ _ _; rewrite in_rng negb_exists=> h /=. - by rewrite xc_notin_rng1_hs. - rcondf{2} 8. - + auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _. - rewrite negb_and in_dom; left. - rewrite (@huniq_hinvK_h ch) 3:oget_some /=. - + by apply/huniq_addh=> //; have /hs_of_INV [] := inv0. - + by rewrite getP. - apply/(@notin_m_notin_mh hs.[ch <- (xc,Known)] Pmi _ _ xc ch Known)=> //. - + by apply/m_mh_addh=> //; case: inv0. - by rewrite getP. - auto=> ? ? [#] !<<- -> -> ->> _ /= ya -> /= yc -> /=. - case: (hinvP (hs.[ch <- (xc,Known)]) yc)=> [_|-> //] yc_notin_rng1_hs_addh _ _. - rewrite getP /= oget_some /= -addzA /=. - rewrite(@huniq_hinvK_h ch) 3:oget_some /=. - + by apply/huniq_addh=> //; have /hs_of_INV [] := inv0. - + by rewrite getP. - apply/(@lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi xa xc ya yc inv0 _ Pmi_xaxc Gmi_xaxc)=> //. - + rewrite -negP=> <*>; move: yc_notin_rng1_hs_addh => /=. - apply/negb_forall=> /=; exists ch; apply/negb_forall=> /=; exists Known. - by rewrite getP. - + move=> f h; move: (yc_notin_rng1_hs_addh h f); rewrite getP. - case: (h = ch)=> <*> //= _; rewrite -negP. - by have /hs_of_INV [] _ _ H /H {H} := inv0. - 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; rewrite in_rng=> -[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 in_dom /=; 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_notin_rng1_hs _ _|/#]. - rewrite getP /= oget_some /=. - by apply/lemma2'=> // f h; exact/y2_notin_rng1_hs. -rcondf{1} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom 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 in_dom Gmi_xaxc. - conseq (_: _ ==> G1.bext{2})=> //. - auto=> &1 &2 [#] !<<- _ -> ->> _ />. - rewrite !in_rng; 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. print Block.DBlock. - smt (@Block.DBlock @Capacity.DCapacity). -have /incli_of_INV <- := inv0; 1:by rewrite Gmi_xaxc. -rewrite Pmi_xaxc=> /= [#] <<*>. -rcondf{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. -by auto=> &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 => !mem (dom m2) x => incl m1 m2.[x <- y]. -proof. - move=> Hincl Hdom w ^/Hincl <- => Hw. - rewrite getP_neq // -negP => ->>. - by move: Hdom;rewrite in_dom. -qed. - - - -equiv PFf_Cf (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1(D).C.f : - ! (G1.bcol{2} \/ G1.bext{2}) /\ - ={p} /\ p{1} <> [] /\ - 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} ==> - ! (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}. -proof. - proc; seq 2 4: - ((!(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} /\ - F.RO.m.[p]{2} = Some sa{1})));last first. - + case : (! (G1.bcol{2} \/ G1.bext{2})); - 2: by conseq (_:_ ==> true)=> //; inline *;auto;rewrite Block.DBlock.dunifin_ll. - inline *; rcondf{2} 3. - + by move=> &m;auto=> &hr [#] H /H[_ H1] ??;rewrite in_dom H1. - by auto=> /> &m1 &m2;rewrite Block.DBlock.dunifin_ll /= => H /H [-> ->];rewrite oget_some. - while ( - p{1} = (drop i p){2} /\ (0 <= i <= size p){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} /\ - ={sa} /\ - (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})));last first. - + auto=> &m1 &m2 [#] -> -> Hp ^ Hinv -> /=;rewrite drop0 size_ge0 /=;split. - + split;[split|];1: by exists Known;case Hinv => -[] _ ->. - + by rewrite take0. - by case (p{m2}) => //=;smt w=size_ge0. - move=> ????? ????? ?? iR ? ->> ?[#] _ ?? H /H{H} [#] -> ->> _ ?. - have -> : iR = size p{m2} by smt (). - have -> /= : size p{m2} <> 0 by smt (size_ge0). - by rewrite take_size. - inline *;sp 1 0;wp=> /=. - conseq (_: _ ==> (! (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} /\ - (oget PF.m{1}.[x{1}]).`1 = sa{2} /\ - (exists (f : flag), FRO.m{2}.[h{2}] = Some ((oget PF.m{1}.[x{1}]).`2, f)) /\ - (build_hpath G1.mh (take (i + 1) p) = Some (sa,h)){2} /\ - if i{2} + 1 = 0 then sa{2} = b0 && h{2} = 0 - else F.RO.m{2}.[take (i{2} + 1) p{2}] = Some (oget PF.m{1}.[x{1}]).`1)). - + move=> &m1 &m2 [#] 2!->> ?? H ?? ?????????? H'. - rewrite behead_drop -drop_add //=;split=>[/#|]. - by have := size_drop (i{m2} + 1) p{m2};case (drop (i{m2} + 1) p{m2}) => //= [/#| ];smt w=size_ge0. - case ((G1.bcol{2} \/ G1.bext{2})). - + wp;conseq (_: _ ==> (G1.bcol{2} \/ G1.bext{2}))=> //. - by if{1};if{2};auto;2:(swap{2} 4 -3;auto); smt w=(Block.DBlock.dunifin_ll DCapacity.dunifin_ll). - conseq (_: (x{1} = (sa{1} +^ head witness p{1}, sc{1}) /\ - (p{1} = drop i{2} p{2} /\ - 0 <= i{2} <= size p{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} /\ - ={sa} /\ - (exists (f : flag), FRO.m{2}.[h{2}] = Some (sc{1}, f)) /\ - (build_hpath G1.mh (take i p) = Some (sa,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})) /\ - p{1} <> [] /\ i{2} < size p{2}) /\ - ! (G1.bcol{2} \/ G1.bext{2}) /\ - (mem (dom PF.m) x){1} = (mem (dom G1.mh) (sa +^ nth witness p i, h)){2} ==> _). - + move=> &m1 &m2 [#] 2!->> ?? H ?? ^ /H [#] /= Hinv ->> Hf -> -> ? /= />. - case: Hf=> f Hm; rewrite head_nth nth_drop // addz0 !in_dom. - pose X := sa{m2} +^ nth witness p{m2} i{m2}. - case (Hinv)=> -[Hu _ _] _ _ [] /(_ X sc{m1}) Hpf ^ HG1 /(_ X h{m2}) Hmh _ _ _ _ _. - case: {-1}(PF.m{m1}.[(X,sc{m1})]) (eq_refl (PF.m{m1}.[(X,sc{m1})])) Hpf Hmh. - + case (G1.mh{m2}.[(X, h{m2})]) => //= -[ya hy] Hpf. - by rewrite -negP => /(_ ya hy) [] ????[#];rewrite Hm /= => -[<-];rewrite Hpf. - move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. - rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _. - by have /= <<- -> := Hu _ _ _ _ Hm Hhx. - if{1};[rcondf{2} 1| rcondt{2} 1];1,3:(by auto;smt ());last first. - + auto => /> /= &m1 &m2 ?? [] Hhs Hinv Hinvi Hmmh Hmmhi Hincl Hincli Hmh Hpi f. - rewrite head_nth nth_drop // addz0 => Heq Hbu ????. - rewrite !in_dom. - have -> /= : i{m2} + 1 <> 0 by smt (). - pose sa' := sa{m2} +^ nth witness p{m2} i{m2}. - case (Hmmh) => /(_ sa' sc{m1});case (PF.m{m1}.[(sa', sc{m1})])=> //= -[ya yc] /(_ ya yc) /=. - move=> [hx fx hy fy]; case (Hhs) => Hu _ _ [#] Heq'. - have /= <<- /= Hhy ^? ->:= Hu _ _ _ _ Heq Heq'. - rewrite !oget_some /= => _;split;1: by exists fy. - rewrite (@take_nth witness) 1://. - case (Hmh) => _ -> _;rewrite build_hpath_prefix Hbu /#. - rcondt{2} 5. - + move=> &m;auto=> &hr /> ?? Hinv f. - rewrite head_nth nth_drop // addz0; pose sa' := sa{hr} +^ nth witness p{hr} i{hr}. - move=> ?Hbu????->Hmem ????. - case (Hinv) => ??????? [] H1 H2 H3 ?. - rewrite (@take_nth witness) 1:// -negP in_dom. - pose p' := (take i{hr} p{hr}); pose w:= (nth witness p{hr} i{hr}). - case {-1}(F.RO.m{hr}.[rcons p' w]) (eq_refl (F.RO.m{hr}.[rcons p' w]))=> //. - move=> ? /H2 [???];rewrite Hbu => -[] [!<<-] HG1. - by move: Hmem;rewrite in_dom HG1. - swap{2} 4 -3;auto => &m1 &m2 [#] 2!->?? [] Hhs Hinv Hinvi Hmmh Hmmhi Hincl Hincli Hmh Hpi -> /=. - move=> Hsc Hpa Hif Hdrop Hlt Hbad. - rewrite head_nth nth_drop // addz0; pose sa' := sa{m2} +^ nth witness p{m2} i{m2}. - move=> Heq Hdom y1L-> /= y2L-> /=. - have -> /= : i{m2} + 1 <> 0 by smt (). - rewrite !getP_eq !oget_some /=. - pose p' := (take (i{m2} + 1) p{m2});rewrite/==> [#] ? /=. - split;last first. - + split;1: by exists Unknown. - rewrite /p' (@take_nth witness) 1:// build_hpath_prefix. - exists sa{m2} h{m2}. - rewrite /sa' getP_eq /=;apply build_hpath_up => //. - by move: Hdom;rewrite Heq /sa' in_dom. - have Hy1L := ch_notin_dom2_mh _ _ _ y1L G1.chandle{m2} Hmmhi Hhs. - have := hinvP FRO.m{m2} y2L;rewrite /= => Hy2L. - have g1_sa' : G1.mh{m2}.[(sa', h{m2})] = None by move: Hdom;rewrite Heq in_dom. - case :Hsc => f Hsc; have Hh := dom_hs_neq_ch _ _ _ _ _ Hhs Hsc. - have Hch : FRO.m{m2}.[G1.chandle{m2}] = None. - + case Hhs => _ _ H. - by case {-1}(FRO.m{m2}.[G1.chandle{m2}]) (eq_refl (FRO.m{m2}.[G1.chandle{m2}])) => // ? /H. - have Hy2_mi: ! mem (dom PF.mi{m1}) (y1L, y2L). - + rewrite in_dom;case {-1}( PF.mi{m1}.[(y1L, y2L)]) (eq_refl (PF.mi{m1}.[(y1L, y2L)])) => //. - by move=> [] ??;case Hmmhi=> H _ /H [] ????/#. - have ch_0 := ch_neq0 _ _ Hhs. - have ch_None : - forall xa xb ha hb, G1.mh{m2}.[(xa,ha)] = Some(xb, hb) => - ha <> G1.chandle{m2} /\ hb <> G1.chandle{m2}. - + 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 => // ??/#. - + by apply inv_addm. - + by apply (m_mh_addh_addm f) => //;case Hhs. - + by apply (mi_mhi_addh_addmi f)=> // ??/#. - + by apply incl_upd_nin. - + by apply incl_upd_nin. - + case (Hmh)=> H1 H2 H3;split. - + move=> xa hx ya hy;rewrite getP;case((xa, hx) = (sa', h{m2}))=> [[2!->>] [2!<<-] | Hdiff]. - + exists sc{m1} f y2L Unknown. - rewrite getP_eq getP_neq 1:eq_sym //= Hsc /=. - exists (take i{m2} p{m2}) sa{m2}. - rewrite /p' (@take_nth witness) 1:// /sa' xorwA xorwK xorwC xorw0 getP_eq /=. - by apply build_hpath_up_None. - move=> /H1 [xc fx yc fy] [#] Hhx Hhy Hfy; exists xc fx yc fy. - rewrite !getP_neq. - + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhx). - + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhy). - rewrite Hhx Hhy /=;case: fy Hhy Hfy => //= Hhy [p v [Hro Hpath]]. - exists p v;rewrite getP_neq 1:-negP 1:/p' 1:(@take_nth witness) 1://. - + move => ^ /rconssI <<-;move: Hpath;rewrite Hpa=> -[!<<-] /rconsIs Heq'. - by move:Hdiff=> /=;rewrite /sa' Heq' xorwA xorwK xorwC xorw0. - by rewrite Hro /=;apply build_hpath_up_None. - + move=> p1 bn b; rewrite getP /p' (@take_nth witness) //. - case (rcons p1 bn = rcons (take i{m2} p{m2}) (nth witness p{m2} i{m2})). - + move=> ^ /rconssI ->> /rconsIs ->> /=; split => [<<- | ]. - + exists sa{m2} h{m2} G1.chandle{m2}. - by rewrite /sa' getP_eq /= (build_hpath_up Hpa) //. - move=> [v hx hy []] Heq1;rewrite getP /sa'. - case ((v +^ nth witness p{m2} i{m2}, hx) = (sa{m2} +^ nth witness p{m2} i{m2}, h{m2})) => //. - have := build_hpath_up_None G1.mh{m2} (sa', h{m2}) (y1L, G1.chandle{m2}) _ _ g1_sa' Hpa. - by rewrite Heq1 => -[!->>]. - move=> Hdiff;rewrite H2. - apply exists_iff=> v /= ;apply exists_iff => hx /=;apply exists_iff => hy /=. - have Hhx2 := dom_hs_neq_ch _ _ _ _ _ Hhs Hsc. - rewrite build_hpath_upd_ch_iff //. - case (hx = G1.chandle{m2}) => [->>|?]. - + split;1: by move=> [] _ /ch_None. - move=> [[p0' x [Hhx2']]]. - have [!<<-] [!->>]:= H3 _ _ _ _ _ Hpa Hhx2'. - by rewrite getP_neq /= ?Hhx2 // => /ch_None. - rewrite getP; case ((v +^ bn, hx) = (sa', h{m2})) => //= -[Hsa' ->>]. - rewrite Hsa' g1_sa' /= -negP => [#] Hbu !<<-. - have [!<<-]:= H3 _ _ _ _ _ Hpa Hbu. - move: Hsa'=> /Block.WRing.addrI /#. - move=> p1 v p2 v' hx. - rewrite !build_hpath_upd_ch_iff //. - case (hx = G1.chandle{m2})=> [->> | Hdiff ];2:by apply H3. - by move=> /> ?? Hp1 ?? Hp2;have [!->>] := H3 _ _ _ _ _ Hp1 Hp2. - case (Hpi) => H1;split=> c p1 v1;rewrite H1 => {H1}. - apply exists_iff => h1 /=. rewrite getP build_hpath_upd_ch_iff //. - by case (h1 = G1.chandle{m2}) => [->> /#|]. -qed. - -section AUX. - - declare module D : DISTINGUISHER {PF, RO, G1}. - - 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(D).main ~ G1(D).main: - ={glob D} ==> !(G1.bcol \/ G1.bext){2} => ={res}. - proof. - proc. - call (_: G1.bcol \/ G1.bext, - 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}). - (* 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} - /\ 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} - ==> !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}). - + by move=> &1 &2; rewrite negb_or. - + by move=> &1 &2 _ ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? [#]; rewrite negb_or. - (* 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. *) - (* We want to name everything for now, to make it easier to manage complexity *) - 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}. - elim * => hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 [] 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) - (eq_refl (INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0)); 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 in_dom PFm_x1x2. - rcondt{2} 1; 1:by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom Gm_x1x2. - case @[ambient]: {-1}(pi0.[x2]) (eq_refl (pi0.[x2])). - + move=> x2_in_pi; rcondf{2} 1. - + by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom x2_in_pi. - rcondf{2} 8. - + by move=> //= &1; auto=> &2 [#] !<<-; rewrite !in_dom 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} - /\ (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). - + by auto. - case @[ambient]: {-1}(getflag hs0 x2) (eq_refl (getflag hs0 x2)). - + rewrite getflagP_none => x2f_notin_rng_hs0; rcondt{2} 3. - + move=> &1; auto=> &2 /> _ _ _; rewrite in_rng negb_exists /=. - exact/(@x2f_notin_rng_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 !getP; case: (hx = G1.chandle{2}); case: (hy = G1.chandle{2})=> //=. - + by move=> _ + [#] - <*>; have:= (x2f_notin_rng_hs0 yf hy). - + by move=> + _ + [#] - <*>; have:= (x2f_notin_rng_hs0 xf hx). - by move=> _ _; have /hs_of_INV [] + _ _ - /(_ hx hy (xc,xf) (yc,yf)) := inv0. - by rewrite !getP. - rewrite oget_some=> _ _ _. - have -> //: !mem (dom G1.mh{2}) (x1,G1.chandle{2}). - rewrite in_dom /=; 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 [#] !<<- -> -> !->> {&1} /= _ x2_neq_y2 y2_notin_hs _ _. - rewrite getP /= oget_some /= -addzA /=. - rewrite (@huniq_hinvK_h ch0 hs0.[ch0 <- (x2,Known)] x2); 2:by rewrite getP. - + move=> @/huniq h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. - case: (h1 = ch0); case: (h2 = ch0)=> //=. - + by move=> _ + [#] - <*>; move: (x2f_notin_rng_hs0 f2 h2). - + by move=> + _ + [#] <*> - <*>; move: (x2f_notin_rng_hs0 f1 h1). - have /hs_of_INV [] + _ _ _ _ - h := inv0. - by apply/h; rewrite getP. - by rewrite oget_some; exact/lemma1. - conseq (_: _ ==> G1.bcol{2})=> //=. - auto=> &1 &2 [#] !<<- -> _ ->> !<<- _ /=. - case: (hinvP hs0.[ch0 <- (x2,Known)] y2{1})=> //= -> /=. - move=> hs0_spec; split=> [|f]. - + by have:= hs0_spec ch0 Known; rewrite getP. - move=> h; have:= hs0_spec h f; rewrite getP; 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. - + by move=> x2_is_U; conseq (_: G1.bext{2})=> //=; auto=> &1 &2 />; rewrite x2_is_U. - move=> x2_is_K; rcondf{2} 3; 1:by move=> &1; auto. - have:= x2_is_K; rewrite in_rng=> - [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} - /\ (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). - + auto=> &1 &2 /> _ -> /= _; split. - + move: x2_is_K; rewrite in_rng /= => -[hx2] hs_hx2. - rewrite in_rng 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 FRO.m{2} x2) //. - by have /hs_of_INV [] := inv0. - have x1hx_notin_G1m: !mem (dom G1mh) (x1,hx). - + rewrite in_dom; 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 [#] !<<- -> -> !->> _ /= hinv_y2_none. - rewrite getP /= oget_some /=; apply/lemma2=> //. - + by case: (hinvP hs0 y2{2})=> [_ + f h|//=] - ->. - move=> [p0 v0] ^ pi_x2. have /pi_of_INV [] -> [hx2] [#] Hpath hs_hx2:= inv0. - rcondt{2} 1. by move=> &m; auto=> &hr [#] !<<- _ _ ->> /= _; rewrite in_dom pi_x2. - rcondf{2} 6. - + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. - by rewrite in_rng; 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 in_dom; 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=> [#] !<<- {xc0 xf0}; rewrite PFm_x1x2. - rcondt{2} 15. - + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. - by rewrite in_dom pi_x2. - inline F.RO.get. rcondt{2} 4. - + auto=> &hr [#] !<<- _ _ !->> _ /= _ _; rewrite pi_x2 oget_some /=. - rewrite in_dom; 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 !getP_eq pi_x2 !oget_some /=. - have /hs_of_INV [] Hu _ _:= inv0; have -> := huniq_hinvK_h _ _ _ Hu hs_hx2. - rewrite oget_some => /= ? Hy2L . - case:inv0=> Hhs Hinv HinvG Hmmh Hmmhi Hincl Hincli Hmh Hpi. - 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 Hy2L => H _ + /H {H} [hx fx hy fy] [#]. - by case: (hinvP hs0 y2L)=> [_ ->|//]/#. - + by apply inv_addm=>//; apply (ch_notin_dom2_mh _ _ Hmmhi Hhs). - + by apply (m_mh_addh_addm _ Hmmh _ hs_hx2)=>//;apply ch_notin_dom_hs. - + apply (mi_mhi_addh_addmi _ Hmmhi _ hs_hx2);last by apply ch_notin_dom_hs. - by have := hinvP hs0 y2L;rewrite /#. - + by apply incl_addm. + by apply incl_addm. - + split. - + move=> xa hx ya hy;rewrite getP;case ((xa, hx) = (x1, hx2))=> /=. - + move=> [] !-> [] !<-; exists x2 Known y2L Known. - by rewrite !getP_eq /= getP_neq // eq_sym; apply (dom_hs_neq_ch _ _ _ Hhs hs_hx2). - move=> Hdiff Hxa; case Hmh=> /(_ _ _ _ _ Hxa) [] xc fx yc fy [#] Hhx Hhy HG1 _ _. - exists xc fx yc fy;rewrite !getP_neq //. - + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhx). - + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhy). - + rewrite /= -negP=> -[] <<- <<-;apply Hdiff=> /=. - by apply (Hu hx (x2, fx) (x2, Known)). - rewrite Hhx Hhy=> /=;move: HG1. - case: fy Hhy=> Hhy //= [p v [Hro Hbu]]. - exists p v;split. - + rewrite getP_neq // -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 getP. - case (rcons p bn = rcons p0 (v0 +^ x1)). - + move=> ^ /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 getP_eq. - move=> [v hx hy] [];rewrite getP ;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. - move=> 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'. - by rewrite getP_neq /= ?Hhx2 // => /ch_None. - rewrite getP;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 getP. case (c = y2L) => [->> /= | Hc]. - + split. - + move=> [!<<-];exists ch0;rewrite getP_eq /= build_hpath_prefix. - exists v0 hx2;rewrite xorwA xorwK Block.WRing.add0r getP_eq /=. - have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. - by apply build_hpath_up_None. - move=> [h []];rewrite getP 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 // getP;case (h = ch0) => [->> | //]. - split;1: by move=> [_ /(dom_hs_neq_ch _ _ _ _ _ Hhs)]. - by move=> /= [_ <<-];move:Hc. - - move=> [xa xc] PFm_x1x2. rcondf{1} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom 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 in_dom G1m_x1x2. - auto=> &1 &2 [#] <*> -> -> -> /=; have /incl_of_INV /(_ (x1,x2)) := inv0. - by rewrite PFm_x1x2 G1m_x1x2 /= => [#] !<<- {ya yc}. - move=> x1x2_notin_G1m; rcondt{2} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom x1x2_notin_G1m. - have <*>: fy2 = Unknown. - + have /mh_of_INV [] /(_ _ _ _ _ G1mh_x1hx2) + _ := inv0. - move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0}. - 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: (G1.bext{2}); last by inline*; if{2}; auto; smt (@Block @Capacity). - by auto=> ? ? [#] !<<- _ -> ->> _ /=; rewrite in_rng; exists hx2. - have /mh_of_INV []/(_ _ _ _ _ G1mh_x1hx2) + _ _:= inv0. - move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0} /= [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 in_dom pi_x2. - inline F.RO.get. - rcondf{2} 4; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite pi_x2 oget_some /= in_dom Hro. - rcondf{2} 8; first by auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _; rewrite in_rng; exists hx2. - rcondt{2} 9. - + auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _. - rewrite (@huniq_hinvK_h hx2 hs0 x2) // 2:in_dom 2:G1mh_x1hx2 2:!oget_some /=. - + by have /hs_of_INV []:= inv0. - by rewrite /in_dom_with in_dom hs_hy2. - rcondt{2} 14; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite in_dom pi_x2. - auto=> &1 &2 [#] !<<- -> -> ->> _ /=; rewrite Block.DBlock.dunifin_ll Capacity.DCapacity.dunifin_ll /=. - move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 !oget_some //=. - rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. - + by have /hs_of_INV []:= inv0. - rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //= => _. - exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). - (* lossless PF.f *) - + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. - smt (@Block.DBlock @Capacity.DCapacity). - (* lossless and do not reset bad G1.S.f *) - + move=> _; proc; 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 *) - + by conseq (eq_fi D)=> /#. - (* lossless PF.P.fi *) - + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. - smt (@Block.DBlock @Capacity.DCapacity). - (* lossless and do not reset bad G1.S.fi *) - + move=> _; proc; if; 2:by auto. - by wp; do 2!rnd predT; auto => &hr [#]; smt (@Block.DBlock @Capacity.DCapacity). - (** proofs for G1.C.f *) - (* equiv PF.C.f G1.C.f *) - + proc. - inline*;sp. admit. (* this is false *) - (* lossless PF.C.f *) - + move=> &2 _; proc; inline *; while (true) (size p); auto. - + sp; if; 2:by auto; smt (size_behead). - 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; rnd predT; auto. - while (G1.bcol \/ G1.bext) (size p - i)=> [z|]. - + if; 1:by auto=> /#. - wp; rnd predT; wp; rnd predT; auto. - smt (@Block.DBlock @Capacity.DCapacity). - by auto; smt (@Block.DBlock @Capacity.DCapacity). - (* Init ok *) - inline *; auto=> />; split=> [|/#]. - (do !split; last 3 smt (getP map0P build_hpath_map0)); last 5 by move=> ? ? ? ?; rewrite map0P. - + move=> h1 h2 ? ?; rewrite !getP !map0P. - by case: (h1 = 0); case: (h2 = 0)=> //=. - + by rewrite getP. - + by move=> ? h; rewrite getP map0P; case: (h = 0). - + by move=> ? ?; rewrite !map0P. - by move=> ? ?; rewrite !map0P. -qed. - -end section AUX. - -section. - - declare module D: DISTINGUISHER{Perm, C, PF, G1, RO}. - - 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)%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 D_ll &m)). - cut : Pr[CF(DRestr(D)).main() @ &m : res] <= - Pr[G1(DRestr(D)).main() @ &m : res] + - Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext]. - + byequiv (CF_G1 (DRestr(D)) _)=>//;1:by apply (DRestr_ll D D_ll). - smt ml=0. - cut /# : 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]. - rewrite Pr [mu_or]; smt. - qed. - -end section. - - diff --git a/sha3/proof/core/IndifPadding.ec b/sha3/proof/core/IndifPadding.ec deleted file mode 100644 index 192ca69..0000000 --- a/sha3/proof/core/IndifPadding.ec +++ /dev/null @@ -1,123 +0,0 @@ -require import Fun Pair Real NewFMap. -require (*..*) Indifferentiability LazyRO. - -clone import Indifferentiability as Ind1. - -clone import Indifferentiability as Ind2 - with type p <- Ind1.p, - type f_out <- Ind1.f_out. - -op pad : Ind2.f_in -> Ind1.f_in. -op padinv : Ind1.f_in -> Ind2.f_in. -axiom cancel_pad : cancel pad padinv. -axiom cancel_padinv : cancel padinv pad. - -clone import LazyRO as RO1 - with type from <- Ind1.f_in, - type to <- Ind1.f_out. - -clone import LazyRO as RO2 - with type from <- Ind2.f_in, - type to <- Ind1.f_out, - op d <- RO1.d. - -module ConstrPad (FC:Ind1.CONSTRUCTION, P:Ind1.DPRIMITIVE) = { - module C = FC(P) - - proc init = C.init - - proc f (x:Ind2.f_in) : f_out = { - var r; - r = C.f(pad x); - return r; - } -}. - -module DistPad(FD: Ind2.DISTINGUISHER, F:Ind1.DFUNCTIONALITY, P:Ind1.DPRIMITIVE) = { - module Fpad = { - proc f(x:Ind2.f_in) : f_out = { - var r; - r = F.f(pad x); - return r; - } - } - - proc distinguish = FD(Fpad,P).distinguish -}. - -module SimPadinv(S:Ind1.SIMULATOR, F2:Ind2.DFUNCTIONALITY) = { - module F1 = { - proc f(x:Ind1.f_in):Ind1.f_out = { - var r; - r = F2.f(padinv x); - return r; - } - } - - module S2 = S(F1) - - proc init = S2.init - - proc f = S2.f - proc fi = S2.fi -}. - -section Reduction. - declare module P : Ind1.PRIMITIVE. (* It is compatible with Ind2.Primitive *) - declare module C : Ind1.CONSTRUCTION {P}. - declare module S : Ind1.SIMULATOR{ RO1.H, RO2.H}. - - declare module D' : Ind2.DISTINGUISHER{P,C, RO1.H, RO2.H, S}. - - local equiv ConstrDistPad: - Ind2.GReal(ConstrPad(C), P, D').main ~ - Ind1.GReal(C, P, DistPad(D')).main : ={glob P, glob C, glob D'} ==> - ={glob P, glob C, glob D', res}. - proof. by sim. qed. - - local lemma PrConstrDistPad &m: - Pr[ Ind2.GReal(ConstrPad(C), P, D').main() @ &m : res] = - Pr[ Ind1.GReal(C, P, DistPad(D')).main() @ &m : res]. - proof. by byequiv ConstrDistPad. qed. - - local equiv DistH2H1: - Ind2.GIdeal(RO2.H, SimPadinv(S), D').main ~ - Ind1.GIdeal(RO1.H, S, DistPad(D')).main : - ={glob D', glob S} ==> - ={glob D',glob S, res} /\ forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]. - proof. - proc. - call (_: ={glob S} /\ forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]). - + proc *;inline *. - call (_: forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]);auto. - proc;inline *;wp;sp;if;first by progress [-split];rewrite !in_dom H. - + auto;progress;first by rewrite !getP_eq. - by rewrite !getP (can_eq _ _ cancel_padinv) H. - by auto;progress;rewrite H. - + proc *;inline *. - call (_: forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]);auto. - proc;inline *;wp;sp;if;first by progress [-split];rewrite !in_dom H. - + auto;progress;first by rewrite !getP_eq. - by rewrite !getP (can_eq _ _ cancel_padinv) H. - by auto;progress;rewrite H. - + proc;inline *;wp;sp;if;first by progress[-split];rewrite -{1}(cancel_pad x{2}) !in_dom H. - + auto;progress;first by rewrite !getP_eq. - by rewrite !getP (eq_sym x1) (can2_eq _ _ cancel_pad cancel_padinv) (eq_sym x{2}) H. - by auto;progress;rewrite -H cancel_pad. - inline *;wp. call (_: ={glob D'}). - auto;progress;by rewrite !map0P. - qed. - - local lemma PrDistH2H1 &m: - Pr[Ind2.GIdeal(RO2.H,SimPadinv(S),D').main() @ &m : res] = - Pr[Ind1.GIdeal(RO1.H,S, DistPad(D')).main() @ &m : res]. - proof. by byequiv DistH2H1. qed. - - lemma Conclusion &m: - `| Pr[Ind2.GReal (ConstrPad(C), P , D' ).main() @ &m : res] - - Pr[Ind2.GIdeal(RO2.H , SimPadinv(S), D' ).main() @ &m : res] | = - `| Pr[Ind1.GReal (C , P , DistPad(D')).main() @ &m : res] - - Pr[Ind1.GIdeal(RO1.H , S , DistPad(D')).main() @ &m : res] |. - proof. by rewrite (PrConstrDistPad &m) (PrDistH2H1 &m). qed. - -end section Reduction. diff --git a/sha3/proof/core/LazyRO.eca b/sha3/proof/core/LazyRO.eca deleted file mode 100644 index 96136e7..0000000 --- a/sha3/proof/core/LazyRO.eca +++ /dev/null @@ -1,22 +0,0 @@ -require import Option FSet NewFMap. -require (*..*) NewROM. - -type from, to. -op d: to distr. - -clone include NewROM with - type from <- from, - type to <- to, - op dsample <- fun (x:from) => d. - - -module H = { - var m : (from, to) fmap - - proc init() = { m = map0; } - - proc f(x) = { - if (!mem (dom m) x) m.[x] = $d; - return oget m.[x]; - } -}. diff --git a/sha3/proof/core/SLCommon.ec b/sha3/proof/core/SLCommon.ec deleted file mode 100644 index d46259d..0000000 --- a/sha3/proof/core/SLCommon.ec +++ /dev/null @@ -1,395 +0,0 @@ -(** 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 NewFMap Utils Common RndO DProd Dexcepted. - -require (*..*) Indifferentiability. -(*...*) import Capacity IntOrder. - -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 RndO.GenEager as F with - type from <- block list, - type to <- block, - op sampleto <- fun (_:block list)=> bdistr - proof * by exact Block.DBlock.dunifin_ll. - -(** We can now define the squeezeless sponge construction **) -module SqueezelessSponge (P:DPRIMITIVE): FUNCTIONALITY = { - proc init () = {} - - proc f(p : block list): block = { - var (sa,sc) <- (b0,c0); - - while (p <> []) { (* Absorption *) - (sa,sc) <@ P.f((sa +^ head witness p,sc)); - p <- behead p; - } - - return sa; (* Squeezing phase (non-iterated) *) - } -}. - -clone export DProd.ProdSampling as Sample2 with - type t1 <- block, - type t2 <- capacity, - op d1 <- bdistr, - op d2 <- cdistr. - -(* -------------------------------------------------------------------------- *) -(** 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, mem (rng m) x => mem (dom mi) x) - /\ (forall x, mem (rng mi) x => mem (dom m) x). - -lemma half_permutation_set (m' mi' : ('a,'a) fmap) x' y': - (forall x, mem (rng m') x => mem (dom mi') x) - => (forall x, mem (rng m'.[x' <- y']) x => mem (dom mi'.[y' <- x']) x). -proof. - move=> h x0. - rewrite rng_set domP !in_fsetU in_fset1 => -[/rng_rem_le in_rng|//=]. - by rewrite h. -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 rewrite andaE; split=> [!~#] <*>; [exact/Empty|move=> [] /#]. -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']. - move=> ^/rconssI <<- {p'} /rconsIs ->> {b}. - by rewrite /build_hpath=> ->. -move=> [v' h']; rewrite oget_some /= -/(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'' ^/rconssI <<- {p'} /rconsIs <<- {b'}. -by rewrite build /= => [#] <*>. -qed. - -lemma build_hpath_map0 p: - build_hpath map0 p - = if p = [] then Some (b0,0) else None. -proof. -elim/last_ind: p=> //= p b _. -by rewrite -{1}cats1 foldl_cat {1}/step_hpath /= map0P /= /#. -qed. - -(* -------------------------------------------------------------------------- *) - -module C = { - var c:int - proc init () = { c <- 0; } -}. - -module PC (P:PRIMITIVE) = { - - proc init () = { - C.init(); - P.init(); - } - - proc f (x:state) = { - var y; - C.c <- C.c + 1; - y <@ P.f(x); - return y; - } - - proc fi(x:state) = { - var y; - C.c <- C.c + 1; - y <@ P.fi(x); - return y; - } - -}. - -module DPRestr (P:DPRIMITIVE) = { - - proc f (x:state) = { - var y=(b0,c0); - if (C.c + 1 <= max_size) { - C.c <- C.c + 1; - y <@ P.f(x); - } - return y; - } - - proc fi(x:state) = { - var y=(b0,c0); - if (C.c + 1 <= max_size) { - C.c <- C.c + 1; - y <@ P.fi(x); - } - 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; - C.c <- C.c + size bs; - b <@ F.f(bs); - return b; - } -}. - -module DFRestr(F:DFUNCTIONALITY) = { - - proc f (bs:block list) = { - var b= b0; - if (C.c + size bs <= max_size) { - C.c <- C.c + size bs; - b <@ F.f(bs); - } - return b; - } -}. - -module FRestr(F:FUNCTIONALITY) = { - - proc 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): islossless P.f => islossless DPRestr(P).f. -proof. move=>Hll;proc;sp;if=>//;call Hll;auto. qed. - -lemma rpi_ll (P<:DPRIMITIVE): islossless P.fi => islossless DPRestr(P).fi. -proof. move=>Hll;proc;sp;if=>//;call Hll;auto. qed. - -lemma rf_ll (F<:DFUNCTIONALITY): islossless F.f => islossless DFRestr(F).f. -proof. move=>Hll;proc;sp;if=>//;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=>//. - proc;inline *;wp;swap{1}1 2;sim. - qed. - -end section RESTR. - -section COUNT. - - declare module P:PRIMITIVE{C}. - declare module CO:CONSTRUCTION{C,P}. - declare module D:DISTINGUISHER{C,P,CO}. - - axiom f_ll : islossless P.f. - axiom fi_ll : islossless P.fi. - - axiom CO_ll : islossless CO(P).f. - - 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;swap{2}1 2. - call (_: max_size < C.c, ={glob P, glob CO, glob C}). - + apply D_ll. - + proc; sp 1 0;if{1};1:by call(_:true);auto. - by call{2} f_ll;auto=>/#. - + by move=> ?_;proc;sp;if;auto;call f_ll;auto. - + by move=> _;proc;call f_ll;auto=>/#. - + proc;sp 1 0;if{1};1:by call(_:true);auto. - by call{2} fi_ll;auto=>/#. - + by move=> ?_;proc;sp;if;auto;call fi_ll;auto. - + by move=> _;proc;call fi_ll;auto=>/#. - + proc;sp 1 0;if{1};1:by call(_: ={glob P});auto;sim. - by call{2} CO_ll;auto=>/#. - + by move=> ?_;proc;sp;if;auto;call CO_ll;auto. - + move=> _;proc;call CO_ll;auto;smt ml=0 w=size_ge0. - wp;call (_:true);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. - cut @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := - findP (fun (_ : handle) => pred1 c \o fst) handles. - + by exists (oget handles.[h]).`2;rewrite oget_some get_oget;2:case (oget handles.[h]). - cut := H h;rewrite in_dom/#. -qed. - -lemma huniq_hinv (handles:handles) (h:handle): - huniq handles => mem (dom handles) h => hinv handles (oget handles.[h]).`1 = Some h. -proof. - move=> Huniq;pose c := (oget handles.[h]).`1. - cut:=Huniq h;cut:=hinvP handles c. - case (hinv _ _)=> /=[Hdiff _| h' +/(_ h')];1:by rewrite in_dom /#. - by move=> [f ->] /(_ (oget handles.[h]) (c,f)) H1 H2;rewrite H1 // get_oget. -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. - cut @/pred1/= [[h]|][->/=]:= findP (+ pred1 c) (restr Known handles). - + by rewrite oget_some in_dom restrP;case (handles.[h])=>//= /#. - by move=>+h-/(_ h);rewrite in_dom restrP => H1/#. -qed. - -lemma huniq_hinvK (handles:handles) c: - huniq handles => mem (rng handles) (c,Known) => handles.[oget (hinvK handles c)] = Some(c,Known). -proof. - move=> Huniq;rewrite in_rng=> -[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. - move=> Huniq;case: (hinvK _ _) (hinvKP handles c)=>/= [H|h'];1: by apply H. - by rewrite oget_some=> /Huniq H/H. -qed. - -(* -------------------------------------------------------------------------- *) -(** The initial Game *) -module GReal(D:DISTINGUISHER) = RealIndif(SqueezelessSponge, PC(Perm), D). diff --git a/sha3/proof/core/Utils.ec b/sha3/proof/core/Utils.ec deleted file mode 100644 index 3f2b506..0000000 --- a/sha3/proof/core/Utils.ec +++ /dev/null @@ -1,63 +0,0 @@ -(** These should make it into the standard libs **) -require import Core List FSet NewFMap. - -(* -------------------------------------------------------------------- *) - (* In NewFMap *) - -op reindex (f : 'a -> 'c) (m : ('a, 'b) fmap) = - NewFMap.oflist (map (fun (x : 'a * 'b) => (f x.`1,x.`2)) (elems m)) - axiomatized by reindexE. - - - -lemma dom_reindex (f : 'a -> 'c) (m : ('a, 'b) fmap) x: - mem (dom (reindex f m)) x <=> mem (image f (dom m)) x. -proof. - rewrite reindexE dom_oflist imageP mapP /fst; split. - move=> [[x' y] [+ ->>]]. - rewrite mapP=> -[[x0 y0]] /= [h [->> ->>]] {x' y}. - by exists x0; rewrite domE mem_oflist mapP /fst; exists (x0,y0). - move=> [a] [a_in_m <<-]. - exists (f a,oget m.[a])=> /=; rewrite mapP /=. - exists (a,oget m.[a])=> //=. - have:= a_in_m; rewrite in_dom; case {-1}(m.[a]) (eq_refl m.[a])=> //=. - by move=> y; rewrite getE mem_assoc_uniq 1:uniq_keys. -qed. - - -lemma reindex_injective_on (f : 'a -> 'c) (m : ('a, 'b) fmap): - (forall x y, mem (dom m) x => f x = f y => x = y) => - (forall x, m.[x] = (reindex f m).[f x]). -proof. - move=> f_pinj x. - pose s:= elems (reindex f m). - case (assocP s (f x)). - rewrite -dom_oflist {1}/s elemsK dom_reindex imageP. - move=> [[a]] [] /f_pinj h /(h x) ->> {a}. - rewrite !getE. - move=> [y] [+ ->]. - rewrite /s reindexE. - pose s':= map (fun (x : 'a * 'b) => (f x.`1,x.`2)) (elems m). - have <- := (perm_eq_mem _ _ (oflistK s')). - (** FIXME: make this a lemma **) - have h' /h': forall (s : ('c * 'b) list) x, mem (reduce s) x => mem s x. - rewrite /reduce=> s0 x0; rewrite -{2}(cat0s s0); pose acc:= []. - elim s0 acc x0=> {s'} [acc x0 /=|x' s' ih acc x0 /=]. - by rewrite cats0. - move=> /ih; rewrite -cat1s catA cats1 !mem_cat=> -[|-> //=]. - rewrite /augment; case (mem (map fst acc) x'.`1)=> _ h'; left=> //. - by rewrite mem_rcons /=; right. - rewrite /s' mapP=> -[[a' b']] /= [xy_in_m []]. - rewrite eq_sym. have h0 /h0 ->> <<- {a' b'}:= f_pinj a' x _; 1:by smt. - by apply/mem_assoc_uniq; 1:exact uniq_keys. - rewrite -mem_oflist {1}/s -domE=> -[] h; have := h; rewrite dom_reindex. - rewrite imageP=> h'. have {h'} h': forall (a : 'a), !mem (dom m) a \/ f a <> f x by smt. - have /= := h' x. - rewrite in_dom !getE /=. - by move=> -> ->. -qed. - -lemma reindex_injective (f : 'a -> 'c) (m : ('a, 'b) fmap): - injective f => - (forall x, m.[x] = (reindex f m).[f x]). -proof. by move=> f_inj; apply/reindex_injective_on=> + + _. qed. diff --git a/sha3/proof/smart_counter/CoreToBlockSponge.eca b/sha3/proof/smart_counter/CoreToBlockSponge.eca deleted file mode 100644 index 6cf2b01..0000000 --- a/sha3/proof/smart_counter/CoreToBlockSponge.eca +++ /dev/null @@ -1,165 +0,0 @@ -(* -------------------------------------------------------------------- *) -require import Option Pair Int Real Distr List FSet NewFMap DProd. -require import BlockSponge. - -require (*--*) Core. - -op max_query : int. -axiom max_query_ge0: 0 <= max_query. - -clone Core as CoreConstruction with - op Block.r <- Common.r, - type Block.block <- Common.block, - op Block.b0 <- Common.Block.b0, - op Block.(+^) <- Common.Block.(+^), - op Block.enum <- Common.Block.blocks, - op Capacity.c <- Common.c, - type Capacity.capacity <- Common.capacity, - op Capacity.c0 <- Common.Capacity.c0, - op Capacity.enum <- Common.Capacity.caps, - op max_query <- max_query -proof *. -realize Block.r_ge0 by exact/Common.ge0_r. -search Common.Block.(+^). -realize Block.addbA by exact/Common.Block.addwA. - -(*---*) import Common Perm. - -(* -------------------------------------------------------------------- *) -section PROOF. - declare module D:DISTINGUISHER { Perm, Gconcl.IF, SLCommon.C, Gconcl.S, BIRO.IRO }. - - module Wrap (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { - module WF = { - proc f(x : block list * int) = { - var r <- []; - var p, n; - - (p,n) <- x; - if (valid_block p /\ 0 < n) { - r <@ F.f(x); - } - return r; - } - } - - proc distinguish = D(WF,P).distinguish - }. - - module LowerF (F:DFUNCTIONALITY) = { - proc f(m:block list) : block = { - var r <- []; - var p, n; - - (p,n) <- strip m; - if (p <> []) { - r <- F.f(p,n); - } - return last b0 r; - } - }. - - module RaiseF (F:SLCommon.DFUNCTIONALITY) = { - proc f(m:block list, n:int) : block list = { - var i, r, b; - r <- []; - - if (m <> []) { - i <- 0; - b <- b0; - while (i < n) { - b <- F.f(extend m i); - r <- rcons r b; - i <- i + 1; - - } - } - return r; - } - }. - - module LowerDist(D : DISTINGUISHER, F : SLCommon.DFUNCTIONALITY) = - D(RaiseF(F)). - - module RaiseSim(S:SLCommon.SIMULATOR, F:DFUNCTIONALITY) = - S(LowerF(F)). - - local equiv f_f: BIRO.IRO.f ~ RaiseF(Gconcl.IF).f: - ={n} /\ x{1} = m{2} - /\ 0 <= n{2} - /\ valid_block x{1} - /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) - /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p]) - ==> ={res} - /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) - /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p]). - proof. - proc. rcondt{2} 2; 1:by auto=> /#. rcondt{1} 3; 1:by auto=> /#. - inline *. wp. - while ( ={i,n} /\ x{1} = m{2} /\ bs{1} = r{2} - /\ 0 <= i{2} <= n{2} - /\ last b0 x{1} <> b0 - /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) - /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p])). - + sp; if{1}. - + rcondt{2} 2. - + auto=> &hr [#] !->> i_ge0 i_lt_n wf hinv1 hinv2 _ _ + _ _. - by rewrite !in_dom /= hinv2 extendK. - auto=> &1 &2 /= [#] !->> i_ge0 _ wf inv1 inv2 i_lt_n _. - rewrite in_dom wf=> mp_xi r -> /=; split; first by rewrite !getP. - split=> [/#|]; split=> [p n|p]. - + by rewrite getP; case: ((p,n) = (m,i){2})=> [[#] <*>|_ /inv1]. - rewrite !getP; case: (strip p = (m,i){2})=> [strip_p|]. - + by have := stripK p; rewrite strip_p=> /= ->. - case: (p = extend m{2} i{2})=> [<*>|_ _]; first by rewrite extendK. - exact/inv2. - rcondf{2} 2. - + auto=> &hr [#] !->> i_ge0 i_lt_n wf hinv1 hinv2 _ _ + _ _. - by rewrite !in_dom /= hinv2 extendK. - by auto=> &1 &2; smt (DWord.bdistr_ll extendK). - by auto; smt (valid_block_ends_not_b0). - qed. - - lemma conclusion &m: - `| Pr[RealIndif(Sponge,Perm,Wrap(D)).main() @ &m : res] - - Pr[IdealIndif(BIRO.IRO,RaiseSim(Gconcl.S),Wrap(D)).main() @ &m : res] | - = `| Pr[SLCommon.RealIndif(SLCommon.SqueezelessSponge,SLCommon.PC(Perm),LowerDist(Wrap(D))).main() @ &m : res] - - Pr[SLCommon.IdealIndif(Gconcl.IF,Gconcl.S,LowerDist(Wrap(D))).main() @ &m : res] |. - proof. - do 3?congr. - + byequiv (_: ={glob D} ==> _)=> //; proc; inline *. - call (_: ={glob Perm}). - + by proc; inline *; wp; sim. - + by proc; inline *; wp; sim. - + proc; sp; if=> //. - call (_: ={glob Perm, arg} - /\ valid_block xs{1} /\ 0 < n{1} - ==> ={glob Perm, res}). - + proc. rcondt{1} 4; 1:by auto. rcondt{2} 2; 1:by auto; smt (valid_block_ends_not_b0). - rcondt{2} 4; 1:by auto. - inline{2} SLCommon.SqueezelessSponge(SLCommon.PC(Perm)).f. - seq 4 6: ( ={glob Perm, n, i, sa, sc} - /\ (* some notion of path through Perm.m *) true). - + while ( ={glob Perm, sa, sc} - /\ xs{1} = p{2} - /\ (* some notion of path through Perm.m *) true). - + wp; call (_: ={glob Perm}). - + by inline *; wp; sim. - by auto=> /> /#. - by auto=> &1 &2 [#] !<<- vblock n_gt0 /=; rewrite /extend nseq0 cats0. - (* make sure that the notion of path guarantees that only the last call of each iteration adds something to the map, and that it is exactly the right call *) - admit. - by auto=> /#. - by auto. - byequiv (_: ={glob D} ==> _)=> //; proc; inline *. - call (_: ={glob S} - /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) - /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p]) - /\ (* relation between S.paths and presence in the RO map *) true). - + proc. if=> //=; last by auto. if=> //=; last by auto. - inline *. admit. (* something about valid queries *) - + admit. (* prove: S(LowerF(BIRO.IRO)).fi ~ S(IF).fi *) - + by proc; sp; if=> //; call (f_f); auto=> /#. - by auto=> />; split=> [?|] ?; rewrite !map0P. - qed. -end section PROOF. diff --git a/sha3/proof/smart_counter/IndifPadding.ec b/sha3/proof/smart_counter/IndifPadding.ec deleted file mode 100644 index 192ca69..0000000 --- a/sha3/proof/smart_counter/IndifPadding.ec +++ /dev/null @@ -1,123 +0,0 @@ -require import Fun Pair Real NewFMap. -require (*..*) Indifferentiability LazyRO. - -clone import Indifferentiability as Ind1. - -clone import Indifferentiability as Ind2 - with type p <- Ind1.p, - type f_out <- Ind1.f_out. - -op pad : Ind2.f_in -> Ind1.f_in. -op padinv : Ind1.f_in -> Ind2.f_in. -axiom cancel_pad : cancel pad padinv. -axiom cancel_padinv : cancel padinv pad. - -clone import LazyRO as RO1 - with type from <- Ind1.f_in, - type to <- Ind1.f_out. - -clone import LazyRO as RO2 - with type from <- Ind2.f_in, - type to <- Ind1.f_out, - op d <- RO1.d. - -module ConstrPad (FC:Ind1.CONSTRUCTION, P:Ind1.DPRIMITIVE) = { - module C = FC(P) - - proc init = C.init - - proc f (x:Ind2.f_in) : f_out = { - var r; - r = C.f(pad x); - return r; - } -}. - -module DistPad(FD: Ind2.DISTINGUISHER, F:Ind1.DFUNCTIONALITY, P:Ind1.DPRIMITIVE) = { - module Fpad = { - proc f(x:Ind2.f_in) : f_out = { - var r; - r = F.f(pad x); - return r; - } - } - - proc distinguish = FD(Fpad,P).distinguish -}. - -module SimPadinv(S:Ind1.SIMULATOR, F2:Ind2.DFUNCTIONALITY) = { - module F1 = { - proc f(x:Ind1.f_in):Ind1.f_out = { - var r; - r = F2.f(padinv x); - return r; - } - } - - module S2 = S(F1) - - proc init = S2.init - - proc f = S2.f - proc fi = S2.fi -}. - -section Reduction. - declare module P : Ind1.PRIMITIVE. (* It is compatible with Ind2.Primitive *) - declare module C : Ind1.CONSTRUCTION {P}. - declare module S : Ind1.SIMULATOR{ RO1.H, RO2.H}. - - declare module D' : Ind2.DISTINGUISHER{P,C, RO1.H, RO2.H, S}. - - local equiv ConstrDistPad: - Ind2.GReal(ConstrPad(C), P, D').main ~ - Ind1.GReal(C, P, DistPad(D')).main : ={glob P, glob C, glob D'} ==> - ={glob P, glob C, glob D', res}. - proof. by sim. qed. - - local lemma PrConstrDistPad &m: - Pr[ Ind2.GReal(ConstrPad(C), P, D').main() @ &m : res] = - Pr[ Ind1.GReal(C, P, DistPad(D')).main() @ &m : res]. - proof. by byequiv ConstrDistPad. qed. - - local equiv DistH2H1: - Ind2.GIdeal(RO2.H, SimPadinv(S), D').main ~ - Ind1.GIdeal(RO1.H, S, DistPad(D')).main : - ={glob D', glob S} ==> - ={glob D',glob S, res} /\ forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]. - proof. - proc. - call (_: ={glob S} /\ forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]). - + proc *;inline *. - call (_: forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]);auto. - proc;inline *;wp;sp;if;first by progress [-split];rewrite !in_dom H. - + auto;progress;first by rewrite !getP_eq. - by rewrite !getP (can_eq _ _ cancel_padinv) H. - by auto;progress;rewrite H. - + proc *;inline *. - call (_: forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]);auto. - proc;inline *;wp;sp;if;first by progress [-split];rewrite !in_dom H. - + auto;progress;first by rewrite !getP_eq. - by rewrite !getP (can_eq _ _ cancel_padinv) H. - by auto;progress;rewrite H. - + proc;inline *;wp;sp;if;first by progress[-split];rewrite -{1}(cancel_pad x{2}) !in_dom H. - + auto;progress;first by rewrite !getP_eq. - by rewrite !getP (eq_sym x1) (can2_eq _ _ cancel_pad cancel_padinv) (eq_sym x{2}) H. - by auto;progress;rewrite -H cancel_pad. - inline *;wp. call (_: ={glob D'}). - auto;progress;by rewrite !map0P. - qed. - - local lemma PrDistH2H1 &m: - Pr[Ind2.GIdeal(RO2.H,SimPadinv(S),D').main() @ &m : res] = - Pr[Ind1.GIdeal(RO1.H,S, DistPad(D')).main() @ &m : res]. - proof. by byequiv DistH2H1. qed. - - lemma Conclusion &m: - `| Pr[Ind2.GReal (ConstrPad(C), P , D' ).main() @ &m : res] - - Pr[Ind2.GIdeal(RO2.H , SimPadinv(S), D' ).main() @ &m : res] | = - `| Pr[Ind1.GReal (C , P , DistPad(D')).main() @ &m : res] - - Pr[Ind1.GIdeal(RO1.H , S , DistPad(D')).main() @ &m : res] |. - proof. by rewrite (PrConstrDistPad &m) (PrDistH2H1 &m). qed. - -end section Reduction. diff --git a/sha3/proof/smart_counter/LazyRO.eca b/sha3/proof/smart_counter/LazyRO.eca deleted file mode 100644 index 96136e7..0000000 --- a/sha3/proof/smart_counter/LazyRO.eca +++ /dev/null @@ -1,22 +0,0 @@ -require import Option FSet NewFMap. -require (*..*) NewROM. - -type from, to. -op d: to distr. - -clone include NewROM with - type from <- from, - type to <- to, - op dsample <- fun (x:from) => d. - - -module H = { - var m : (from, to) fmap - - proc init() = { m = map0; } - - proc f(x) = { - if (!mem (dom m) x) m.[x] = $d; - return oget m.[x]; - } -}. From 634a0a8ec339d0b0935b6187fa6a6bda5b572850 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 30 Jul 2018 17:49:26 +0100 Subject: [PATCH 294/394] Fix Utils proof --- sha3/proof/smart_counter/Utils.ec | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/sha3/proof/smart_counter/Utils.ec b/sha3/proof/smart_counter/Utils.ec index 3f2b506..37ccdfa 100644 --- a/sha3/proof/smart_counter/Utils.ec +++ b/sha3/proof/smart_counter/Utils.ec @@ -48,10 +48,14 @@ proof. rewrite /augment; case (mem (map fst acc) x'.`1)=> _ h'; left=> //. by rewrite mem_rcons /=; right. rewrite /s' mapP=> -[[a' b']] /= [xy_in_m []]. - rewrite eq_sym. have h0 /h0 ->> <<- {a' b'}:= f_pinj a' x _; 1:by smt. + rewrite eq_sym. + have h0 /h0 ->> <<- {a' b'}:= f_pinj a' x _. + + by rewrite domE mem_oflist mapP; exists (a',b'). by apply/mem_assoc_uniq; 1:exact uniq_keys. rewrite -mem_oflist {1}/s -domE=> -[] h; have := h; rewrite dom_reindex. - rewrite imageP=> h'. have {h'} h': forall (a : 'a), !mem (dom m) a \/ f a <> f x by smt. + rewrite imageP=> h'. + have {h'} h': forall (a : 'a), !mem (dom m) a \/ f a <> f x. + + by move: h'=> /negb_exists /= + a - /(_ a) /negb_and. have /= := h' x. rewrite in_dom !getE /=. by move=> -> ->. @@ -60,4 +64,4 @@ qed. lemma reindex_injective (f : 'a -> 'c) (m : ('a, 'b) fmap): injective f => (forall x, m.[x] = (reindex f m).[f x]). -proof. by move=> f_inj; apply/reindex_injective_on=> + + _. qed. +proof. by move=> f_inj; apply/reindex_injective_on=> + + _. qed. \ No newline at end of file From 3263f85a07aceb99a179a999b887ac7eef2dd4e4 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Fri, 25 May 2018 23:05:33 +0200 Subject: [PATCH 295/394] --- sha3/config/tests.config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/config/tests.config b/sha3/config/tests.config index 73f88f9..1c6b73e 100644 --- a/sha3/config/tests.config +++ b/sha3/config/tests.config @@ -1,6 +1,6 @@ [default] bin = easycrypt -args = -I proof -I proof/smart_counter +args = -I proof -I proof/smart_counter -timeout 10 [test-sha3] okdirs = !proof From ca0513f5f62260c980f8302d50e11b4ae3116438 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 30 Jul 2018 18:18:12 +0100 Subject: [PATCH 296/394] Actually do some fixing on Strong_rp_rf. Probably still some goals that only went through with eprover in final reasoning on probs --- sha3/proof/smart_counter/Strong_rp_rf.eca | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/sha3/proof/smart_counter/Strong_rp_rf.eca b/sha3/proof/smart_counter/Strong_rp_rf.eca index fae5908..bf36112 100644 --- a/sha3/proof/smart_counter/Strong_rp_rf.eca +++ b/sha3/proof/smart_counter/Strong_rp_rf.eca @@ -450,7 +450,9 @@ section CollisionProbability. * by hoare; auto=> //=; smt w=(RealOrder.mulr_ge0 mu_bounded ge0_q). + move=> c; proc. rcondt 2; 1:by auto. sp; if=> //=. - * inline*;sp;if;auto=> /#. + * inline*;sp;if;auto; 2:smt(). + move=> &hr /> + + + + + y. + by rewrite !sizeE !dom_set !fcardU !fcard1; smt(fcard_ge0). * by auto=> /#. + by move=> b c; proc; rcondf 2; auto. + exists*FEL.c;elim*=> c. @@ -468,7 +470,9 @@ section CollisionProbability. * by hoare; auto; smt w=(RealOrder.mulr_ge0 mu_bounded ge0_q). + move=> c; proc; rcondt 2; 1:by auto. sp; if=> //=. - * inline*;sp;if;auto=> /#. + * inline*;sp;if;auto; 2:smt(). + move=> &hr /> + + + + + x. + by rewrite !sizeE !dom_set !fcardU !fcard1; smt(fcard_ge0). * by auto=> /#. + by move=> b c; proc; rcondf 2; auto. qed. From bbaecc483a9d2e51a58693927d12a023016ca794 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Sat, 15 Sep 2018 12:36:57 +0100 Subject: [PATCH 297/394] Remove prints --- sha3/proof/smart_counter/Gconcl_list.ec | 4 +--- sha3/proof/smart_counter/Gext.eca | 2 +- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/sha3/proof/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec index e998c81..ca43009 100644 --- a/sha3/proof/smart_counter/Gconcl_list.ec +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -1729,7 +1729,7 @@ section Real_Ideal. proof. rewrite-(pr_real D &m). rewrite-(equiv_ideal D &m). - cut:=Real_Ideal (A(D)) A_lossless &m. print DProd. + cut:=Real_Ideal (A(D)) A_lossless &m. pose x:=witness;elim:x=>a b. by rewrite/dstate DProd.dprod1E DBlock.dunifin1E DCapacity.dunifin1E/= block_card capacity_card;smt(). @@ -1741,8 +1741,6 @@ end section Real_Ideal. require import AdvAbsVal. -print AdvAbsVal. - section Real_Ideal_Abs. declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.RRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO}. diff --git a/sha3/proof/smart_counter/Gext.eca b/sha3/proof/smart_counter/Gext.eca index 34225b6..88f2077 100644 --- a/sha3/proof/smart_counter/Gext.eca +++ b/sha3/proof/smart_counter/Gext.eca @@ -538,7 +538,7 @@ section EXT. wp; rnd (mem (image snd (dom G1.m `|` dom G1.mi ))); skip=> /> &hr ? ? -> /= ? ?. rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr} `|` dom G1.mi{hr})) - cdistr (1%r/(2^c)%r))//. print DCapacity. + 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. From 9b4c3fffcde79de01130442fb38ee58085993803 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Sat, 15 Sep 2018 19:15:21 +0100 Subject: [PATCH 298/394] push some stuff through with current easycrypt HEAD this will fail in the CI. --- sha3/proof/Common.ec | 25 +- sha3/proof/Indifferentiability.eca | 6 +- sha3/proof/RndO.ec | 5 +- sha3/proof/smart_counter/ConcreteF.eca | 271 ++++---- sha3/proof/smart_counter/SLCommon.ec | 919 +++++++++++++------------ sha3/proof/smart_counter/Utils.ec | 7 +- 6 files changed, 654 insertions(+), 579 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 8555c2b..d8f6046 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -1,18 +1,11 @@ (*------------------- Common Definitions and Lemmas --------------------*) -(* checks with both Alt-Ergo and Z3; all smt applications are - restricted to specific lemmas *) - -(* -prover ["Z3"]. -prover ["Alt-Ergo"]. -*) +prover quorum=2 ["Z3" "Alt-Ergo"]. require import Core Int IntExtra IntDiv Real List Distr. require import Ring StdRing StdOrder StdBigop BitEncoding DProd. -require (*--*) FinType BitWord RP Monoid. +require (*--*) FinType BitWord IdealPRP Monoid. (*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv. -(* require import NewLogic. *) pragma +implicits. @@ -116,12 +109,16 @@ qed. (*------------------------------ Primitive -----------------------------*) -clone export RP as Perm with - type t <- block * capacity, - op dt <- bdistr `*` cdistr +clone export IdealPRP as Perm with + type D <- block * capacity, + op dD <- bdistr `*` cdistr rename - [module type] "RP" as "PRIMITIVE" - [module] "P" as "Perm". + [module type] "PRP" as "PRIMITIVE" + [module] "RandomPermutation" 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 ---------------------*) diff --git a/sha3/proof/Indifferentiability.eca b/sha3/proof/Indifferentiability.eca index d0cf65e..842756c 100644 --- a/sha3/proof/Indifferentiability.eca +++ b/sha3/proof/Indifferentiability.eca @@ -1,9 +1,6 @@ (** A primitive: the building block we assume ideal **) type p. -(** A functionality: the target construction **) -type f_in, f_out. - module type PRIMITIVE = { proc init(): unit proc f(x : p): p @@ -15,6 +12,9 @@ module type DPRIMITIVE = { 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 diff --git a/sha3/proof/RndO.ec b/sha3/proof/RndO.ec index fdc6799..f2bed8e 100644 --- a/sha3/proof/RndO.ec +++ b/sha3/proof/RndO.ec @@ -1,9 +1,10 @@ -pragma -oldip. require import Core List FSet NewFMap Distr. require IterProc. +pragma -oldip. + (* FIXME notation *) -abbrev ([+]) ['a 'b](x : 'b) = fun (_ : 'a) => x. +abbrev ([+]) ['a 'b] (x : 'b) = fun (_ : 'a) => x. type flag = [ Unknown | Known ]. diff --git a/sha3/proof/smart_counter/ConcreteF.eca b/sha3/proof/smart_counter/ConcreteF.eca index 4d4a963..76c32a9 100644 --- a/sha3/proof/smart_counter/ConcreteF.eca +++ b/sha3/proof/smart_counter/ConcreteF.eca @@ -1,22 +1,22 @@ require import Core Int Real StdOrder Ring Distr IntExtra. -require import List FSet NewFMap Utils Common SLCommon DProd Dexcepted. +require import List FSet SmtMap Common SLCommon DProd Dexcepted. (*...*) import Capacity IntOrder RealOrder. -require (*..*) Strong_rp_rf. +require (*..*) Strong_RP_RF. module PF = { var m, mi: (state,state) fmap proc init(): unit = { - m <- map0; - mi <- map0; + m <- empty; + mi <- empty; } proc f(x : state): state = { var y1, y2; - if (!mem (dom m) x) { + if (x \notin m) { y1 <$ bdistr; y2 <$ cdistr; m.[x] <- (y1,y2); @@ -28,7 +28,7 @@ module PF = { proc fi(x : state): state = { var y1, y2; - if (!mem (dom mi) x) { + if (x \notin mi) { y1 <$ bdistr; y2 <$ cdistr; mi.[x] <- (y1,y2); @@ -50,7 +50,7 @@ section. local module GReal' = Indif(FC(SqueezelessSponge(Perm)), PC(Perm), D). - local clone import Strong_rp_rf as Switching with + local clone import Strong_RP_RF as Switching with type D <- state, op uD <- dstate, type K <- unit, @@ -95,8 +95,8 @@ section. call (_: ={glob C, glob P, glob Redo} /\ all_prefixes Redo.prefixes{2} /\ Redo.prefixes{2}.[[]] = Some (b0,c0) - /\ dom C.queries{2} \subset dom Redo.prefixes{2} - /\ prefixe_inv C.queries{2} Redo.prefixes{2} + /\ (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=> /#. @@ -106,95 +106,110 @@ section. by wp; call (_: true); auto. + proc; sp; if=> //=; inline *;1:if;auto. - splitwhile{1}5:take (i+1) p \in dom Redo.prefixes. - splitwhile{2}5:take (i+1) p \in dom Redo.prefixes. + 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} - /\ dom query{2} \subset dom 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 dom pref{1} => pref{1}.[y] = Redo.prefixes{1}.[y]) - /\ (forall y, y \in dom Redo.prefixes{1} <=> (y \in dom pref{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}); - progress;..-2:smt(in_dom dom_set in_fsetU1 getP oget_some take_size cat_take_drop). + progress;..-2:smt(domE mem_set get_setE oget_some 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) - /\ dom query{2} \subset dom Redo.prefixes{2} - /\ (i{1} < size p{1} => ! take (i{1} + 1) p{1} \in dom Redo.prefixes{1}) - /\ 0 <= prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= i{1} <= size bs{1} + /\ (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 dom pref{1} => pref{1}.[y] = Redo.prefixes{1}.[y]) - /\ (forall y, y \in dom Redo.prefixes{1} <=> (y \in dom pref{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(get_oget in_dom). + + if; auto; 1:smt(domE). sp;rcondt{2}1;1:auto=>/#;auto;1:call(:true);auto;progress. - * move=>x;rewrite dom_set in_fsetU1=>[][|-> j];1:smt(in_fsetU1). + * move=>x;rewrite mem_set=>[][|-> j]; 1:smt(mem_set). case(0 <= j)=>hj0;last first. - + by rewrite (@take_le0 j)1:/# in_fsetU1 in_dom H0//=. - rewrite take_take in_fsetU1/min/#. - * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). - * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). - * rewrite dom_set in_fsetU1 negb_or H9 negb_or/=negb_exists/=. + + 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/=. cut 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(dom_set in_fsetU1 take_take in_dom getP oget_some). - * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). - * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). - * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). - * smt(dom_set in_fsetU1 take_take in_dom getP 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). + * 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} - /\ dom query{2} \subset dom Redo.prefixes{2} + /\ (forall x, x \in query{2} => x \in Redo.prefixes{2}) /\ C.c{1} <= max_size - /\ i{1} = prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) + /\ 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} + - prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1})))); - progress;..4,6..-2: - smt(prefixe_ge0 prefixe_lt_size prefixe_sizel prefixe_exchange prefixe_lt_size memE). - + move:H8=>[]//=[]j [[hj0 hjsize] htake]. - rewrite htake. - apply take_get_max_prefixe2=>//=;1:smt(in_dom memE). - by rewrite-(@prefixe_exchange _ _ _ H2 H). + 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. print take_take. + 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} - /\ dom query{2} \subset dom Redo.prefixes{2} + /\ (forall x, x \in query{2} => x \in Redo.prefixes{2}) /\ C.c{2} <= max_size - /\ i{1} = prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) + /\ 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} - /\ dom query{2} \subset dom Redo.prefixes{2} - /\ prefixe_inv C.queries{2} Redo.prefixes{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} <= prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) - /\ (forall j, 0 <= j <= prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) - => take j bs{2} \in dom Redo.prefixes{1}) + /\ 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 rewrite/#. - * by rewrite(@prefixe_exchange _ _ bs{2} H0 H1)all_take_in//=/#. - * smt(get_oget in_dom). - auto;progress. smt(prefixe_ge0). - * apply take_get_max_prefixe2=>//=;1:smt(in_dom memE). - by rewrite-(@prefixe_exchange _ _ _ H2 H). - * smt(get_oget in_dom). - * smt(@Prefixe). - auto;call(:true);auto;smt(dom0 in_fset0 dom_set in_fsetU1 getP oget_some). + * 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 @@ -212,11 +227,11 @@ section. res /\ C.c <= max_size] = Pr[GReal'.main()@ &m: res/\ C.c <= max_size]. + byequiv=>//;proc;inline *; call (_: ={C.c, glob Perm, Redo.prefixes} - /\ prefixe_inv C.queries{2} Redo.prefixes{1} + /\ prefix_inv C.queries{2} Redo.prefixes{1} /\ Redo.prefixes{1}.[[]] = Some (b0, c0) /\ all_prefixes Redo.prefixes{1}); last first. - + auto;smt(dom0 in_fset0 dom_set in_fsetU1 getP oget_some). + + 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. @@ -226,8 +241,8 @@ section. /\ 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 dom C.queries{2} - /\ prefixe_inv C.queries{2} Redo.prefixes{1} + /\ 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}] @@ -235,8 +250,8 @@ section. + auto;sp;rcondt 1;auto;smt(excepted_lossless). by auto;smt(size_ge0 take0 take_size). - splitwhile{1} 1 : take (i+1) p \in dom Redo.prefixes; - splitwhile{2} 1 : take (i+1) p \in dom Redo.prefixes. + 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=>/=. @@ -245,101 +260,119 @@ section. /\ 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 dom pref{2} => pref{2}.[l] = Redo.prefixes{2}.[l]) - /\ (forall j, 0 <= j <= i{2} => take j p{2} \in dom Redo.prefixes{2}) - /\ (forall l, l \in dom Redo.prefixes{2} => - l \in dom pref{2} \/ (exists j, 0 <= j <= i{2} /\ l = take j p{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 dom_set in_fsetU1 getP;case(bs0 = bs{2})=>//=[->|]h. + * 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;1:smt(take_size);rewrite H//=. - * smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0). - * smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop). - * smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop). - * smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop). + 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=> _; rewrite andaE=> [#] _ /(_ 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} - /\ prefixe_inv C.queries{2} pref{2} - /\ prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) <= i{2} <= size p{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 dom pref{2} => pref{2}.[l] = Redo.prefixes{2}.[l]) - /\ (forall j, 0 <= j <= i{2} => take j p{2} \in dom Redo.prefixes{2}) - /\ (forall l, l \in dom Redo.prefixes{2} => - l \in dom pref{2} \/ (exists j, 0 <= j <= i{2} /\ l = take j p{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. * cut:=H7 (take (i{m0}+1) p{m0}). - case((take (i{m0} + 1) p{m0} \in dom Redo.prefixes{m0}))=>//=_. - rewrite negb_or negb_exists/=;progress. - + by rewrite memE prefixe_lt_size//=-(@prefixe_exchange _ _ p{m0} H1 H0)//=/#. + 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). * cut:=H7 (take (i{hr}+1) p{hr}). - case((take (i{hr} + 1) p{hr} \in dom Redo.prefixes{hr}))=>//=_. + case((take (i{hr} + 1) p{hr} \in Redo.prefixes{hr}))=>//=_. rewrite negb_or negb_exists/=;progress. - + by rewrite memE prefixe_lt_size//=-(@prefixe_exchange _ _ p{hr} H1 H0)//=/#. + + 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 dom_set in_fsetU1=>[][|h];1: - smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop). - rewrite h=>j;rewrite take_take in_fsetU1/min. + * 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. - cut->:take j p{2} = take j (take i{2} p{2});smt(take_take take_le0). - * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). - * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). - * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). - * rewrite!getP/=. - cut/#: !take (i{2} + 1) p{2} \in dom pref{2}. - by rewrite memE prefixe_lt_size//=-(@prefixe_exchange _ _ _ H1 H0)//=/#. - * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). - * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). - * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). - * move=>x;rewrite dom_set in_fsetU1=>[][|h];1: - smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop). - rewrite h=>j;rewrite take_take in_fsetU1/min. + 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/=. + cut/#: !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. +(** HERE! CECILE! WE ARE HERE! **) cut->:take j p{2} = take j (take i{2} p{2});smt(take_take take_le0). - * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). - * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). - * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * smt(prefix_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * smt(prefix_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * smt(prefix_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). * rewrite!getP/=. - cut/#: !take (i{2} + 1) p{2} \in dom pref{2}. - by rewrite memE prefixe_lt_size//=-(@prefixe_exchange _ _ _ H1 H0)//=/#. - * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). - * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + cut/#: !take (i{2} + 1) p{2} \in pref{2}. + by rewrite memE prefix_lt_size//=-(@prefix_exchange _ _ _ H1 H0)//=/#. + * smt(prefix_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * smt(prefix_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). 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} - /\ prefixe_inv C.queries{2} pref{2} - /\ prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) = i{2} + /\ prefix_inv C.queries{2} pref{2} + /\ prefix p{2} (get_max_prefix p{2} (elems (dom C.queries{2}))) = i{2} /\ Redo.prefixes{2}.[take i{2} p{2}] = Some (sa{2}, sc{2}));1: - smt(prefixe_sizel take_get_max_prefixe2 in_dom prefixe_exchange). + smt(prefix_sizel take_get_max_prefix2 in_dom prefix_exchange). while( ={sa,sc,Perm.m,Perm.mi,Redo.prefixes,i,p} - /\ C.c{1} = C.c{2} - size p{2} + prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) + /\ C.c{1} = C.c{2} - size p{2} + prefix p{2} (get_max_prefix p{2} (elems (dom C.queries{2}))) /\ pref{2} = Redo.prefixes{2} /\ all_prefixes pref{2} - /\ prefixe_inv C.queries{2} pref{2} - /\ 0 <= i{2} <= prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) + /\ prefix_inv C.queries{2} pref{2} + /\ 0 <= i{2} <= prefix p{2} (get_max_prefix p{2} (elems (dom 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_prefixe (<=) take mem. - * rewrite(@prefixe_inv_leq _ _ _ _ _ _ H H7 H0)//= 1:/#. + * rewrite/#. search get_max_prefix (<=) take mem. + * rewrite(@prefix_inv_leq _ _ _ _ _ _ H H7 H0)//= 1:/#. cut:=H0=>[][h1 [h2 h3]]. cut:=h3 _ _ _ H7;last smt(memE). smt(size_eq0 size_take). * smt(get_oget in_dom). auto;progress. * rewrite/#. - * smt(prefixe_ge0). + * smt(prefix_ge0). * smt(take0). - * smt(prefixe_sizel @Prefixe memE). - * smt(prefixe_sizel @Prefixe memE). + * smt(prefix_sizel @Prefix memE). + * smt(prefix_sizel @Prefix memE). have p_ll := P_f_ll _ _. + apply/dprod_ll; split. diff --git a/sha3/proof/smart_counter/SLCommon.ec b/sha3/proof/smart_counter/SLCommon.ec index 8476601..4fda277 100644 --- a/sha3/proof/smart_counter/SLCommon.ec +++ b/sha3/proof/smart_counter/SLCommon.ec @@ -3,11 +3,16 @@ length is the input block size. We prove its security even when padding is not prefix-free. **) require import Core Int Real StdOrder Ring IntExtra. -require import List FSet NewFMap Utils Common RndO DProd Dexcepted. +require import List FSet SmtMap Common PROM DProd Dexcepted. require (*..*) Indifferentiability. (*...*) import Capacity IntOrder. +pragma -oldip. + +(** Really? **) +abbrev ([+]) ['a 'b] (x : 'b) = fun (_ : 'a) => x. + type state = block * capacity. op dstate = bdistr `*` cdistr. @@ -33,18 +38,17 @@ op bl_univ = FSet.oflist bl_enum. (* -------------------------------------------------------------------------- *) (* Random oracle from block list to block *) -clone import RndO.GenEager as F with +clone import PROM.GenEager as F with type from <- block list, type to <- block, op sampleto <- fun (_:block list)=> bdistr proof * by exact Block.DBlock.dunifin_ll. - module Redo = { var prefixes : (block list, state) fmap proc init() : unit = { - prefixes <- map0.[[] <- (b0,c0)]; + prefixes <- empty.[[] <- (b0,c0)]; } }. @@ -59,7 +63,7 @@ module SqueezelessSponge (P:DPRIMITIVE): FUNCTIONALITY = { var i : int <- 0; while (i < size p) { (* Absorption *) - if (take (i+1) p \in dom Redo.prefixes) { + 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); @@ -99,686 +103,683 @@ type hsmap = (hstate, hstate ) fmap. type handles = (handle, ccapacity) fmap. pred is_pre_permutation (m mi : ('a,'a) fmap) = - (forall x, mem (rng m) x => mem (dom mi) x) - /\ (forall x, mem (rng mi) x => mem (dom m) x). + (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, mem (rng m') x => mem (dom mi') x) - => (forall x, mem (rng m'.[x' <- y']) x => mem (dom mi'.[y' <- x']) x). + (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 rng_set domP !in_fsetU in_fset1 => -[/rng_rem_le in_rng|//=]. - by rewrite h. +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. +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)]. + 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. + 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)). +| 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 rewrite andaE; split=> [!~#] <*>; [exact/Empty|move=> [] /#]. +elim/last_ind: p v h=> @/build_hpath //= [v h|p b ih v h]. ++ by rewrite andaE; 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']. ++ apply/implybN; case=> [|p' b0 v' h']. + + smt(size_rcons size_ge0). move=> ^/rconssI <<- {p'} /rconsIs ->> {b}. by rewrite /build_hpath=> ->. move=> [v' h']; rewrite oget_some /= -/(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'' ^/rconssI <<- {p'} /rconsIs <<- {b'}. +case=> [| p' b' v'' h'']. ++ smt(size_rcons size_ge0). +move=> ^/rconssI <<- {p'} /rconsIs <<- {b'}. by rewrite build /= => [#] <*>. qed. lemma build_hpath_map0 p: - build_hpath map0 p - = if p = [] then Some (b0,0) else None. + build_hpath empty p = if p = [] then Some (b0,0) else None. proof. elim/last_ind: p=> //= p b _. -by rewrite -{1}cats1 foldl_cat {1}/step_hpath /= map0P /= /#. +by rewrite -{1}cats1 foldl_cat {1}/step_hpath /= emptyE /= [smt(size_rcons size_ge0)]. qed. (* -------------------------------------------------------------------------- *) -theory Prefixe. +theory Prefix. -op prefixe ['a] (s t : 'a list) = - with s = x :: s', t = y :: t' => if x = y then 1 + prefixe s' t' else 0 +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 prefixe_eq (l : 'a list) : prefixe l l = size l. +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 prefixeC (l1 l2 : 'a list) : - prefixe l1 l2 = prefixe l2 l1. +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/#. +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 prefixe_ge0 (l1 l2 : 'a list) : - 0 <= prefixe l1 l2. +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/#. +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 prefixe_sizel (l1 l2 : 'a list) : - prefixe l1 l2 <= size l1. +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). -move=>e2 l2 Hind2 e1 l1 Hind1/#. +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 prefixe_sizer (l1 l2 : 'a list) : - prefixe l1 l2 <= size l2. +lemma prefix_sizer (l1 l2 : 'a list) : + prefix l1 l2 <= size l2. proof. -by rewrite prefixeC prefixe_sizel. +by rewrite prefixC prefix_sizel. qed. - -lemma prefixe_take (l1 l2 : 'a list) : - take (prefixe l1 l2) l1 = take (prefixe l1 l2) l2. +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)=>[->//=/#|//=]. +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. + 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/=. - cut->: (if i < j then i else j) = i by rewrite/#. - move=>[Hk0 Hki]. - by rewrite !nth_take//=/#. -case(0//=Hj0;last smt(take_le0). -rewrite min_ler 1:/#. -pose l':=take j l. -rewrite take_oversize//=. -rewrite/l' size_take /#. +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_ler 1:/#. +by rewrite take_oversize //= size_take /#. qed. -lemma prefixe_take_leq (l1 l2 : 'a list) (i : int) : - i <= prefixe l1 l2 => take i l1 = take i l2. +lemma prefix_take_leq (l1 l2 : 'a list) (i : int) : + i <= prefix l1 l2 => take i l1 = take i l2. proof. -move=>Hi. -cut->:i = min i (prefixe l1 l2) by smt(min_lel). -by rewrite-(take_take l1 i _)-(take_take l2 i _) prefixe_take. +move=> Hi; have ->: i = min i (prefix l1 l2) by smt(min_lel). +by rewrite -(take_take l1 i _) -(take_take l2 i _) prefix_take. qed. -lemma prefixe_nth (l1 l2 : 'a list) : - let i = prefixe l1 l2 in - forall j, 0 <= j < i => - nth witness l1 j = nth witness l2 j. +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. -rewrite/=. -cut Htake:=prefixe_take l1 l2. search nth take. -move=>j[Hj0 Hjp];rewrite-(nth_take witness (prefixe l1 l2))1:prefixe_ge0//. -by rewrite-(nth_take witness (prefixe l1 l2) l2)1:prefixe_ge0//Htake. +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. - -op max_prefixe (l1 l2 : 'a list) (ll : 'a list list) = +(* 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 prefixe l1 l2 < prefixe l1 l' then max_prefixe l1 l' ll' - else max_prefixe l1 l2 ll'. - + if prefix l1 l2 < prefix l1 l' then max_prefix l1 l' ll' + else max_prefix l1 l2 ll'. -op get_max_prefixe (l : 'a list) (ll : 'a list list) = +op get_max_prefix (l : 'a list) (ll : 'a list list) = with ll = "[]" => [] - with ll = (::) l' ll' => max_prefixe l l' ll'. + with ll = (::) l' ll' => max_prefix l l' ll'. - -pred prefixe_inv (queries : (block list, block) fmap) - (prefixes : (block list, state) fmap) = +pred prefix_inv (queries : (block list, block) fmap) + (prefixes : (block list, state) fmap) = (forall (bs : block list), - bs \in dom queries => oget queries.[bs] = (oget prefixes.[bs]).`1) && + bs \in queries => oget queries.[bs] = (oget prefixes.[bs]).`1) && (forall (bs : block list), - bs \in dom queries => forall i, take i bs \in dom prefixes) && + bs \in queries => forall i, take i bs \in prefixes) && (forall (bs : block list), forall i, take i bs <> [] => - take i bs \in dom prefixes => - exists l2, (take i bs) ++ l2 \in dom queries). + 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 dom prefixes => forall i, take i bs \in dom prefixes. + forall (bs : block list), bs \in prefixes => forall i, take i bs \in prefixes. -lemma aux_mem_get_max_prefixe (l1 l2 : 'a list) ll : - max_prefixe l1 l2 ll = l2 \/ max_prefixe l1 l2 ll \in ll. +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(prefixe l1 l2 < prefixe l1 l3)=>//=hmax. -+ cut/#:=Hind l1 l3. -cut/#:=Hind l1 l2. +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_prefixe (l : 'a list) ll : - ll <> [] => get_max_prefixe l ll \in ll. +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_prefixe. +move: l; elim: ll=> //= l2 ll Hind l1. +exact/aux_mem_get_max_prefix. qed. - -lemma take_get_max_prefixe l prefixes : - (exists b, b \in dom prefixes) => - all_prefixes prefixes => - take (prefixe l (get_max_prefixe l (elems (dom prefixes)))) l \in dom prefixes. +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 prefixe_take all_pref memE mem_get_max_prefixe;smt(memE). +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_prefixe2 l prefixes i : - (exists b, b \in dom prefixes) => - all_prefixes prefixes => - i <= prefixe l (get_max_prefixe l (elems (dom prefixes))) => - take i l \in dom prefixes. +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 (prefixe_take_leq _ _ i hi) all_pref memE mem_get_max_prefixe;smt(memE). +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 prefixe_cat (l l1 l2 : 'a list) : - prefixe (l ++ l1) (l ++ l2) = size l + prefixe l1 l2. -proof. -move:l1 l2;elim l=>//=/#. -qed. - - -lemma prefixe_leq_take (l1 l2 : 'a list) i : - 0 <= i <= min (size l1) (size l2) => - take i l1 = take i l2 => - i <= prefixe l1 l2. +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 prefixe_cat size_take//=;smt(prefixe_ge0). +rewrite -(cat_take_drop i l1) -(cat_take_drop i l2) htake. +rewrite prefix_cat size_take //=; smt(prefix_ge0). qed. -lemma prefixe0 (l1 l2 : 'a list) : - prefixe l1 l2 = 0 <=> l1 = [] \/ l2 = [] \/ head witness l1 <> head witness l2 . +lemma prefix0 (l1 l2 : 'a list) : + prefix l1 l2 = 0 <=> l1 = [] \/ l2 = [] \/ head witness l1 <> head witness l2 . proof. -move:l2;elim:l1=>//=;1:rewrite/#;move=>e1 l1 Hind l2;move:e1 l1 Hind;elim:l2=>//=e2 l2 Hind2 e1 l1 Hind1. -smt(prefixe_ge0). +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_prefixe (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 = prefixe l1 l2. +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. - cut:=size_eq0 (drop i l1);rewrite {2}hi/=size_drop// =>h. - cut hsize: size l1 = i by rewrite/#. ++ 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)prefixe_cat/#. -+ move=>hi. - cut:=size_eq0 (drop i l2);rewrite {2}hi/=size_drop// =>h. - cut hsize: size l2 = i by rewrite/#. + 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)prefixe_cat/#. -move=>[himax hnth] htake. -rewrite-(cat_take_drop i l1)-(cat_take_drop i l2)htake. -rewrite prefixe_cat size_take//=. -+ cut[_ ->]:=prefixe0 (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. -rewrite/#. + 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_prefixe_leq (l1 l2 : 'a list) (ll : 'a list list) : - prefixe l1 l2 <= prefixe l1 (max_prefixe l1 l2 ll). -proof. -move:l1 l2;elim:ll=>//=/#. -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_prefixe_is_max (l1 l2 : 'a list) (ll : 'a list list) : - forall l3, l3 \in ll => prefixe l1 l3 <= prefixe l1 (max_prefixe l1 l2 ll). +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=>//=. -move=>l4 ll Hind l1 l2 l3. -case(prefixe l1 l2 < prefixe l1 l4)=>//=h [];smt( get_max_prefixe_leq ). +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_prefixe_max (l : 'a list) (ll : 'a list list) : - forall l2, l2 \in ll => prefixe l l2 <= prefixe l (get_max_prefixe l ll). -proof. smt(get_max_prefixe_is_max get_max_prefixe_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 dom prefixes => - i <= prefixe l (get_max_prefixe l (elems (dom 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_prefixe take_in_dom. -cut->:i = prefixe l (take i l);2:smt(get_max_prefixe_max memE). -apply get_prefixe. +move=>[hi0 hisize] all_prefix take_in_dom. +cut->: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 prefixe_inv_leq (l : block list) i prefixes queries : +lemma prefix_inv_leq (l : block list) i prefixes queries : 0 <= i <= size l => - elems (dom queries) <> [] => + elems (fdom queries) <> [] => all_prefixes prefixes => - take i l \in dom prefixes => - prefixe_inv queries prefixes => - i <= prefixe l (get_max_prefixe l (elems (dom queries))). + 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_prefixe_inv h_exist]]. +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(prefixe_ge0 size_eq0). ++ smt(prefix_ge0 size_take). cut[l2 h_l2_mem]:=h_exist l i h_take_neq_nil take_in_dom. -rewrite memE in h_l2_mem. -rewrite(StdOrder.IntOrder.ler_trans _ _ _ _ (get_max_prefixe_max _ _ _ h_l2_mem)). -rewrite-{1}(cat_take_drop i l)prefixe_cat size_take 1:/#;smt(prefixe_ge0). +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_prefixe_eq (l : 'a list) (ll : 'a list list) : - max_prefixe l l ll = l. +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( prefixe_eq prefixe_sizel). +move:l;elim:ll=>//=l2 ll Hind l1;smt( prefix_eq prefix_sizel). qed. -lemma prefixe_max_prefixe_eq_size (l1 l2 : 'a list) (ll : 'a list list) : +lemma prefix_max_prefix_eq_size (l1 l2 : 'a list) (ll : 'a list list) : l1 = l2 \/ l1 \in ll => - prefixe l1 (max_prefixe l1 l2 ll) = size l1. + prefix l1 (max_prefix l1 l2 ll) = size l1. proof. -move:l1 l2;elim:ll=>//=;1:smt(prefixe_eq). +move:l1 l2;elim:ll=>//=;1:smt(prefix_eq). move=>l3 ll Hind l1 l2[->|[->|h1]]. -+ rewrite prefixe_eq max_prefixe_eq;smt(max_prefixe_eq prefixe_eq prefixe_sizer). -+ rewrite prefixe_eq max_prefixe_eq. - case(prefixe l3 l2 < size l3)=>//=h;1:by rewrite prefixe_eq. - cut h1:prefixe l3 l2 = size l3 by smt(prefixe_sizel). - cut: size l3 <= prefixe l3 (max_prefixe l3 l2 ll);2:smt(prefixe_sizel). ++ rewrite prefix_eq max_prefix_eq;smt(max_prefix_eq prefix_eq prefix_sizer). ++ rewrite prefix_eq max_prefix_eq. + case(prefix l3 l2 < size l3)=>//=h;1:by rewrite prefix_eq. + cut h1:prefix l3 l2 = size l3 by smt(prefix_sizel). + cut: 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(prefixe l1 l2 < prefixe l1 l3)=>//=/#. +by case(prefix l1 l2 < prefix l1 l3)=>//=/#. qed. -lemma prefixe_get_max_prefixe_eq_size (l : 'a list) (ll : 'a list list) : +lemma prefix_get_max_prefix_eq_size (l : 'a list) (ll : 'a list list) : l \in ll => - prefixe l (get_max_prefixe l ll) = size l. + prefix l (get_max_prefix l ll) = size l. proof. -move:l;elim:ll=>//;smt(prefixe_max_prefixe_eq_size). +move:l;elim:ll=>//;smt(prefix_max_prefix_eq_size). qed. -lemma get_max_prefixe_exists (l : 'a list) (ll : 'a list list) : +lemma get_max_prefix_exists (l : 'a list) (ll : 'a list list) : ll <> [] => - exists l2, take (prefixe l (get_max_prefixe l ll)) l ++ l2 \in 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 prefixe_take). ++ smt(cat_take_drop prefix_take). move=>l3 ll Hind l1 l2. -case( prefixe l1 l2 < prefixe l1 l3 )=>//=h/#. +case( prefix l1 l2 < prefix l1 l3 )=>//=h/#. qed. -lemma prefixe_geq (l1 l2 : 'a list) : - prefixe l1 l2 = prefixe (take (prefixe l1 l2) l1) (take (prefixe l1 l2) l2). +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. +move:l2;elim:l1=>//=[[] //=|] e1 l1 Hind l2;elim:l2=>//=e2 l2 Hind2. case(e1=e2)=>//=h12. -cut->/=:! 1 + prefixe l1 l2 <= 0 by smt(prefixe_ge0). +cut->/=:! 1 + prefix l1 l2 <= 0 by smt(prefix_ge0). rewrite h12/=/#. qed. -lemma prefixe_take_prefixe (l1 l2 : 'a list) : - prefixe (take (prefixe l1 l2) l1) l2 = prefixe l1 l2. +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. -cut->/=:! 1 + prefixe l1 l2 <= 0 by smt(prefixe_ge0). +cut->/=:! 1 + prefix l1 l2 <= 0 by smt(prefix_ge0). rewrite h12/=/#. qed. -lemma prefixe_leq_prefixe_cat (l1 l2 l3 : 'a list) : - prefixe l1 l2 <= prefixe (l1 ++ l3) l2. +lemma prefix_leq_prefix_cat (l1 l2 l3 : 'a list) : + prefix l1 l2 <= prefix (l1 ++ l3) l2. proof. -move:l2 l3;elim l1=>//=;1:smt(take_le0 prefixe_ge0). +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 prefixe_take_leq_prefixe (l1 l2 : 'a list) i : - prefixe (take i l1) l2 <= prefixe l1 l2. +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 prefixe_leq_prefixe_cat. +exact prefix_leq_prefix_cat. qed. -lemma prefixe_take_geq_prefixe (l1 l2 : 'a list) i : - prefixe l1 l2 <= i => - prefixe l1 l2 = prefixe (take i l1) l2. +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. -cut:prefixe (take i l1) l2 <= prefixe l1 l2. -+ rewrite-{2}(cat_take_drop i l1) prefixe_leq_prefixe_cat. -cut/#:prefixe l1 l2 <= prefixe (take i l1) l2. -rewrite -prefixe_take_prefixe. -rewrite-(cat_take_drop (prefixe l1 l2) (take i l1))take_take min_lel// prefixe_leq_prefixe_cat. +cut:prefix (take i l1) l2 <= prefix l1 l2. ++ rewrite-{2}(cat_take_drop i l1) prefix_leq_prefix_cat. +cut/#:prefix l1 l2 <= prefix (take i l1) l2. +rewrite -prefix_take_prefix. +rewrite-(cat_take_drop (prefix l1 l2) (take i l1))take_take min_lel// prefix_leq_prefix_cat. qed. -lemma get_max_prefixe_take (l : 'a list) (ll : 'a list list) i : - prefixe l (get_max_prefixe l ll) <= i => - get_max_prefixe l ll = get_max_prefixe (take i l) ll. +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( prefixe l1 l2 < prefixe l1 l3 )=>//=h hi. -+ rewrite -prefixe_take_geq_prefixe//=;1:smt(get_max_prefixe_leq). - rewrite -prefixe_take_geq_prefixe//=;1:smt(get_max_prefixe_leq). +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 -prefixe_take_geq_prefixe//=;1:smt(get_max_prefixe_leq). -rewrite -prefixe_take_geq_prefixe//=;1:smt(get_max_prefixe_leq). +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_prefixe_neq (l1 l2 : 'a list) : - drop (prefixe l1 l2) l1 = [] \/ drop (prefixe l1 l2) l1 <> drop (prefixe l1 l2) l2. +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 l2;elim:l2=>//=e2 l2 hind2/#. +move: l2; elim: l1=> //= e1 l1 hind1; elim=> //= e2 l2 //= hind2 //=. +smt(prefix_ge0). qed. - -lemma prefixe_prefixe_prefixe (l1 l2 l3 : 'a list) (ll : 'a list list) : - prefixe l1 l2 <= prefixe l1 l3 => - prefixe l1 (max_prefixe l1 l2 ll) <= prefixe l1 (max_prefixe l1 l3 ll). +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 prefixe_lt_size (l : 'a list) (ll : 'a list list) : - prefixe l (get_max_prefixe l ll) < size l => - forall i, prefixe l (get_max_prefixe l ll) < i => +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 (prefixe l1 l2) (take i l1)) - -{3}(cat_take_drop (prefixe l1 l2) l2)take_take/min H0/=. - rewrite prefixe_take. - cut:drop (prefixe l1 l2) (take i l1) <> drop (prefixe l1 l2) l2;2:smt(catsI). - rewrite (prefixe_take_geq_prefixe l1 l2 i) 1:/#. - cut:=drop_prefixe_neq (take i l1) l2. - cut/#:drop (prefixe (take i l1) l2) (take i l1) <> []. - cut:0 < size (drop (prefixe (take i l1) l2) (take i l1));2:smt(size_eq0). - rewrite size_drop 1:prefixe_ge0 size_take;1:smt(prefixe_ge0). - by rewrite-prefixe_take_geq_prefixe /#. + 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. + cut:drop (prefix l1 l2) (take i l1) <> drop (prefix l1 l2) l2;2:smt(catsI). + rewrite (prefix_take_geq_prefix l1 l2 i) 1:/#. + cut:=drop_prefix_neq (take i l1) l2. + cut/#:drop (prefix (take i l1) l2) (take i l1) <> []. + cut: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(prefixe l1 l2 < prefixe l1 l3)=>//=h;progress. +case(prefix l1 l2 < prefix l1 l3)=>//=h;progress. + rewrite!negb_or/=. cut:=hind l1 l3 H i H0;rewrite negb_or=>[][->->]/=. - cut:=hind l1 l2 _ i _;smt(prefixe_prefixe_prefixe). -smt(prefixe_prefixe_prefixe). + cut:=hind l1 l2 _ i _;smt(prefix_prefix_prefix). +smt(prefix_prefix_prefix). qed. lemma asfadst queries prefixes (bs : block list) : - prefixe_inv queries prefixes => - elems (dom queries ) <> [] => + prefix_inv queries prefixes => + elems (fdom queries ) <> [] => all_prefixes prefixes => - (forall j, 0 <= j <= size bs => take j bs \in dom prefixes) => - take (prefixe bs (get_max_prefixe bs (elems (dom queries))) + 1) bs = bs. + (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. -cut h:=prefixe_inv_leq bs (size bs) prefixes queries _ _ _ _ _;rewrite//=. +cut h:=prefix_inv_leq bs (size bs) prefixes queries _ _ _ _ _;rewrite//=. + exact size_ge0. + rewrite H2//=;exact size_ge0. -cut->/=:prefixe bs (get_max_prefixe bs (elems (dom queries))) = size bs by smt(prefixe_sizel). +cut->/=:prefix bs (get_max_prefix bs (elems (fdom queries))) = size bs by smt(prefix_sizel). rewrite take_oversize/#. qed. -lemma prefixe_exchange_prefixe_inv (ll1 ll2 : 'a list list) (l : 'a list) : +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) => - prefixe l (get_max_prefixe l ll1) = prefixe l (get_max_prefixe l ll2). + prefix l (get_max_prefix l ll1) = prefix l (get_max_prefix l ll2). proof. -case(ll1 = [])=>//=[->/#|]//=ll1_nil. -move=>incl all_prefix incl2 ;cut ll2_nil:ll2 <> [] by rewrite/#. -cut:=get_max_prefixe_max l ll2 (get_max_prefixe l ll1) _. -+ by rewrite incl mem_get_max_prefixe ll1_nil. -cut mem_ll2:=mem_get_max_prefixe l ll2 ll2_nil. +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. +cut mem_ll2:=mem_get_max_prefix l ll2 ll2_nil. cut[]l3 mem_ll1:=incl2 _ mem_ll2. -cut:=get_max_prefixe_max l ll1 _ mem_ll1. -smt(prefixeC prefixe_leq_prefixe_cat). +cut:=get_max_prefix_max l ll1 _ mem_ll1. +smt(prefixC prefix_leq_prefix_cat). qed. -lemma prefixe_inv_nil queries prefixes : - prefixe_inv queries prefixes => - elems (dom queries) = [] => dom prefixes \subset fset1 []. +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. cut:=h3 x (size x). -rewrite take_size h5/=;apply absurd=>//=h6. -rewrite h6/=negb_exists/=;smt(memE). +rewrite take_size -mem_fdom h5/=;apply absurd=>//=h6. +rewrite h6/=negb_exists/=;smt(memE mem_fdom). qed. - -lemma aux_prefixe_exchange queries prefixes (l : block list) : - prefixe_inv queries prefixes => all_prefixes prefixes => - elems (dom queries) <> [] => - prefixe l (get_max_prefixe l (elems (dom queries))) = - prefixe l (get_max_prefixe l (elems (dom prefixes))). +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 prefixe_exchange_prefixe_inv. -+ smt(memE take_size). -+ smt(memE). -move=>l2;rewrite-memE=> mem_l2. +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/=/#. -smt(memE take_size). ++ 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 prefixe_exchange queries prefixes (l : block list) : - prefixe_inv queries prefixes => all_prefixes prefixes => - prefixe l (get_max_prefixe l (elems (dom queries))) = - prefixe l (get_max_prefixe l (elems (dom prefixes))). +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 (dom queries) = [])=>//=h4;2:smt(aux_prefixe_exchange). -cut h6:=prefixe_inv_nil queries prefixes _ h4;1:rewrite/#. -rewrite h4/=. -case(elems (dom prefixes) = [])=>//=[->//=|]h7. -cut h8:elems (dom prefixes) = [[]]. -+ cut [hh1 hh2]:[] \in dom prefixes /\ forall x, x \in elems (dom prefixes) => x = [] by smt(memE). - cut h9:=subset_leq_fcard _ _ h6. - apply (eq_from_nth witness)=>//=. - + rewrite-cardE-(fcard1 [<:block>]);move:h9;rewrite!fcard1!cardE=>h9. - cut/#:0 < size (elems (dom prefixes));smt(size_eq0 size_ge0 fcard1). - move:h9;rewrite!fcard1!cardE=>h9 i [hi0 hi1]. - cut->/=:i = 0 by rewrite/#. - by apply hh2;rewrite mem_nth/#. -by rewrite h8=>//=. +move=> [h1[h2 h3]] h5. +case: (elems (fdom queries) = [])=> h4. ++ cut 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. + cut 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_prefixe_block (queries : (block list, block) fmap) +pred inv_prefix_block (queries : (block list, block) fmap) (prefixes : (block list, block) fmap) = (forall (bs : block list), - bs \in dom queries => queries.[bs] = prefixes.[bs]) && + bs \in queries => queries.[bs] = prefixes.[bs]) && (forall (bs : block list), - bs \in dom queries => forall i, 0 < i <= size bs => take i bs \in dom prefixes). + bs \in queries => forall i, 0 < i <= size bs => take i bs \in prefixes). -lemma prefixe_gt0_mem l (ll : 'a list list) : - 0 < prefixe l (get_max_prefixe l ll) => - get_max_prefixe l ll \in ll. +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(prefixe l1 l2 < prefixe l1 l3)=>//=/#. +by case(prefix l1 l2 < prefix l1 l3)=>//=/#. qed. -lemma inv_prefixe_block_mem_take queries prefixes l i : - inv_prefixe_block queries prefixes => - 0 < i < prefixe l (get_max_prefixe l (elems (dom queries))) => - take i l \in dom prefixes. +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 (prefixe_take_leq _ (get_max_prefixe l (elems (dom queries))))1:/#. +rewrite (prefix_take_leq _ (get_max_prefix l (elems (fdom queries))))1:/#. rewrite H_all_prefixes. -cut:get_max_prefixe l (elems (dom queries)) \in dom queries;2:smt(in_dom). -by rewrite memE;apply prefixe_gt0_mem=>/#. -smt(prefixe_sizer). +cut: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 prefixe_cat_leq_prefixe_size (l1 l2 l3 : 'a list): - prefixe (l1 ++ l2) l3 <= prefixe l1 l3 + size l2. +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=>//=;1:smt(prefixe_sizel). +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];exact size_ge0. qed. - -lemma prefixe_cat1 (l1 l2 l3 : 'a list) : - prefixe (l1 ++ l2) l3 = prefixe l1 l3 + - if prefixe l1 l3 = size l1 - then prefixe l2 (drop (size l1) l3) +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=>//=;1:smt(prefixe_sizel). +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 prefixe_leq_prefixe_cat_size (l1 l2 : 'a list) (ll : 'a list list) : - prefixe (l1++l2) (get_max_prefixe (l1++l2) ll) <= - prefixe l1 (get_max_prefixe l1 ll) + - if (prefixe l1 (get_max_prefixe l1 ll) = size l1) - then prefixe l2 (get_max_prefixe l2 (map (drop (size l1)) ll)) +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=>//=;1:smt(size_cat size_ge0). -move=>l3 ll hind{hind};move:l3;elim:ll=>//=;1:smt(prefixe_cat1). +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(prefixe (l1 ++ l2) l3 < prefixe (l1 ++ l2) l4)=>//=. -+ rewrite 2!prefixe_cat1. - case(prefixe l1 l3 = size l1)=>//=H_l1l3;case(prefixe l1 l4 = size l1)=>//=H_l1l4. +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 _ _ _)). - cut->/=:prefixe l1 (max_prefixe l1 l4 ll) = size l1 - by move:{hind};elim:ll=>//=;smt(prefixe_sizel). - by cut->/=:prefixe l1 (max_prefixe l1 l3 ll) = size l1 - by move:{hind};elim:ll=>//=;smt(prefixe_sizel). - - smt(prefixe_sizel prefixe_ge0). - - cut->/=h:prefixe l1 l3 < prefixe l1 l4 by smt(prefixe_sizel). + cut->/=:prefix l1 (max_prefix l1 l4 ll) = size l1 + by move:{hind};elim:ll=>//=;smt(prefix_sizel). + by cut->/=:prefix l1 (max_prefix l1 l3 ll) = size l1 + by move:{hind};elim:ll=>//=;smt(prefix_sizel). + - smt(prefix_sizel prefix_ge0). + - cut->/=h:prefix l1 l3 < prefix l1 l4 by smt(prefix_sizel). rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _)). - cut->/=:prefixe l1 (max_prefixe l1 l4 ll) = size l1 - by move:{hind};elim:ll=>//=;smt(prefixe_sizel). - smt(prefixe_prefixe_prefixe). + cut->/=: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(prefixe l1 (max_prefixe l1 l4 ll) = size l1)=>//=->; - smt(prefixe_prefixe_prefixe). -rewrite 2!prefixe_cat1. -case(prefixe l1 l3 = size l1)=>//=H_l1l3;case(prefixe l1 l4 = size l1)=>//=H_l1l4. + 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. - cut->/=:!size l1 < prefixe l1 l4 by smt(prefixe_sizel). + cut->/=:!size l1 < prefix l1 l4 by smt(prefix_sizel). rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _))//=. - cut->//=:prefixe l1 (max_prefixe l1 l3 ll) = size l1 - by move:{hind};elim:ll=>//=;smt(prefixe_sizel). - smt(prefixe_prefixe_prefixe). -+ smt(prefixe_sizel prefixe_ge0). + cut->//=: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(prefixe_prefixe_prefixe). +smt(prefix_prefix_prefix). qed. -lemma diff_size_prefixe_leq_cat (l1 l2 : 'a list) (ll : 'a list list) : - size l1 - prefixe l1 (get_max_prefixe l1 ll) <= - size (l1++l2) - prefixe (l1++l2) (get_max_prefixe (l1++l2) ll). +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(prefixe_leq_prefixe_cat_size prefixe_sizel prefixe_ge0 size_ge0 prefixe_sizer size_cat). +smt(prefix_leq_prefix_cat_size prefix_sizel prefix_ge0 size_ge0 prefix_sizer size_cat). qed. -(* lemma prefixe_inv_prefixe queries prefixes l : *) -(* prefixe_inv queries prefixes => *) +(* lemma prefix_inv_prefix queries prefixes l : *) +(* prefix_inv queries prefixes => *) (* all_prefixes prefixes => *) -(* (elems (dom queries) = [] => elems (dom prefixes) = [[]]) => *) -(* prefixe l (get_max_prefixe l (elems (dom queries))) = *) -(* prefixe l (get_max_prefixe l (elems (dom 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_prefixe_inv] h_all_prefixes. *) -(* case(elems (dom queries) = [])=>//=h_nil. *) +(* move=>[? h_prefix_inv] h_all_prefixes. *) +(* case(elems (fdom queries) = [])=>//=h_nil. *) (* + by rewrite h_nil//==>->/=. *) -(* cut h_mem_queries:=mem_get_max_prefixe l (elems (dom queries)) h_nil. *) -(* cut h_leq :=all_take_in l (prefixe l (get_max_prefixe l (elems (dom queries)))) _ _ h_all_prefixes _. *) -(* + smt(prefixe_ge0 prefixe_sizel). *) -(* + by rewrite prefixe_take h_prefixe_inv memE h_mem_queries. *) -(* cut:=all_take_in l (prefixe l (get_max_prefixe l (elems (dom prefixes)))) _ _ h_all_prefixes _. *) -(* + smt(prefixe_ge0 prefixe_sizel). *) +(* 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 prefixe_take. *) +(* rewrite prefix_take. *) (* rewrite -take_size. *) -(* print mem_get_max_prefixe. *) +(* print mem_get_max_prefix. *) (* qed. *) @@ -786,22 +787,23 @@ 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 dom m => ! y \in rng m => invm m mi => invm m.[x <- y] mi.[y <- x]. + ! x \in m => ! rng m y => invm m mi => invm m.[x <- y] mi.[y <- x]. proof. -move=>Hxdom Hyrng Hinv a b;rewrite!getP;split. +move=>Hxdom Hyrng Hinv a b; rewrite !get_setE; split. + case(a=x)=>//=hax hab;cut->/#:b<>y. - by cut/#:b\in rng m;rewrite in_rng/#. + by cut/#: rng m b;rewrite rngE /#. case(a=x)=>//=hax. + case(b=y)=>//=hby. - by rewrite (eq_sym y b)hby/=-Hinv hax;rewrite in_dom/=/# in Hxdom. + by rewrite (eq_sym y b)hby/=-Hinv hax;rewrite domE /=/# in Hxdom. by rewrite Hinv/#. qed. +(** ???? op blocksponge (l : block list) (m : (state, state) fmap) (bc : state) = with l = "[]" => (l,bc) with l = (::) b' l' => let (b,c) = (bc.`1,bc.`2) in - if ((b +^ b', c) \in dom m) then blocksponge l' m (oget m.[(b +^ b', c)]) + if ((b +^ b', c) \in m) then blocksponge l' m (oget m.[(b +^ b', c)]) else (l,(b,c)). op s0 : state = (b0,c0). @@ -815,7 +817,7 @@ qed. lemma blocksponge_set l m bc x y : - (x \in dom m => y = oget m.[x]) => + (x \in m => y = oget m.[x]) => let bs1 = blocksponge l m bc in let bs2 = blocksponge l m.[x <- y] bc in let l1 = bs1.`1 in let l2 = bs2.`1 in let bc1 = bs1.`2 in let bc2 = bs2.`2 in @@ -865,8 +867,8 @@ by rewrite/=-2!cats1 blocksponge_cat/=. qed. -(* lemma prefixe_inv_bs_fst_nil queries prefixes m : *) -(* prefixe_inv queries prefixes m => *) +(* lemma prefix_inv_bs_fst_nil queries prefixes m : *) +(* prefix_inv queries prefixes m => *) (* forall l, l \in dom queries => *) (* forall i, 0 <= i <= size l => *) (* (blocksponge (take i l) m s0).`1 = []. *) @@ -893,10 +895,10 @@ qed. (* qed. *) -(* lemma prefixe_inv_set queries prefixes m x y : *) +(* lemma prefix_inv_set queries prefixes m x y : *) (* !x \in dom m => *) -(* prefixe_inv queries prefixes m => *) -(* prefixe_inv queries prefixes m.[x <- y]. *) +(* prefix_inv queries prefixes m => *) +(* prefix_inv queries prefixes m.[x <- y]. *) (* proof. *) (* move=>Hxdom Hpref;progress=>//=. *) (* + rewrite/#. *) @@ -907,10 +909,10 @@ qed. (* rewrite (take_nth b0)1:/#. *) (* rewrite 2!blocksponge_rcons/=. *) (* cut[?[? Hpre]]:=Hpref. *) -(* cut->/=:=prefixe_inv_bs_fst_nil _ _ _ Hpref _ Hbsdom i _;1:rewrite/#. *) +(* cut->/=:=prefix_inv_bs_fst_nil _ _ _ Hpref _ Hbsdom i _;1:rewrite/#. *) (* cut/=->/=:=Hpre _ Hbsdom i _;1:rewrite/#. *) (* cut->/=:=Hind bs _ Hbsdom;1:rewrite/#. *) -(* cut->/=:=prefixe_inv_bs_fst_nil _ _ _ Hpref _ Hbsdom i _;1:rewrite/#. *) +(* cut->/=:=prefix_inv_bs_fst_nil _ _ _ Hpref _ Hbsdom i _;1:rewrite/#. *) (* rewrite dom_set in_fsetU1. *) (* cut/=->/=:=Hpre _ Hbsdom i _;1:rewrite/#. *) (* rewrite getP. *) @@ -934,20 +936,20 @@ qed. (* qed. *) (* lemma size_blocksponge queries m l : *) -(* prefixe_inv queries m => *) -(* size (blocksponge l m s0).`1 <= size l - prefixe l (get_max_prefixe l (elems (dom queries))). *) +(* prefix_inv queries m => *) +(* size (blocksponge l m s0).`1 <= size l - prefix l (get_max_prefix l (elems (fdom queries))). *) (* proof. *) (* move=>Hinv. *) -(* pose l2:=get_max_prefixe _ _;pose p:=prefixe _ _. search take drop. *) +(* pose l2:=get_max_prefix _ _;pose p:=prefix _ _. search take drop. *) (* rewrite-{1}(cat_take_drop p l)blocksponge_cat/=. *) -(* rewrite(prefixe_take). *) +(* rewrite(prefix_take). *) (* qed. *) +**) - -end Prefixe. -export Prefixe. +end Prefix. +export Prefix. (* -------------------------------------------------------------------------- *) @@ -956,7 +958,7 @@ module C = { var queries : (block list, block) fmap proc init () = { c <- 0; - queries <- map0.[[] <- b0]; + queries <- empty.[[] <- b0]; } }. @@ -1026,8 +1028,8 @@ module FC(F:FUNCTIONALITY) = { proc f (bs:block list) = { var b <- b0; - if (!bs \in dom C.queries) { - C.c <- C.c + size bs - prefixe bs (get_max_prefixe bs (elems (dom C.queries))); + 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 { @@ -1041,9 +1043,9 @@ module DFRestr(F:DFUNCTIONALITY) = { proc f (bs:block list) = { var b= b0; - if (!bs \in dom C.queries) { - if (C.c + size bs - prefixe bs (get_max_prefixe bs (elems (dom C.queries))) <= max_size) { - C.c <- C.c + size bs - prefixe bs (get_max_prefixe bs (elems (dom C.queries))); + 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; } @@ -1151,13 +1153,50 @@ section COUNT. + 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(prefixe_sizel). + + by move=> _;proc;sp;if;auto;call CO_ll;auto;smt(prefix_sizel). auto;call (_:true);auto;call(:true);auto=>/#. qed. end section COUNT. (* -------------------------------------------------------------------------- *) +op has (P : 'a -> 'b -> bool) (m : ('a,'b) fmap) = + List.has (fun x=> x \in m /\ P x (oget m.[x])) (elems (fdom m)). + +lemma hasP (P : 'a -> 'b -> bool) (m : ('a,'b) fmap): + has P m <=> exists x, x \in m /\ P x (oget m.[x]). +proof. +rewrite hasP; split=> [] [x] [#]. ++ by move=> _ x_in_m Pxmx; exists x. +by move=> x_in_m Pxmx; exists x; rewrite -memE mem_fdom. +qed. + +op find (P : 'a -> 'b -> bool) (m : ('a,'b) fmap) = + onth (elems (fdom m)) (find (fun x=> x \in m /\ P x (oget m.[x])) (elems (fdom m))). + +lemma find_none (P : 'a -> 'b -> bool) (m : ('a,'b) fmap): + has P m <=> find P m <> None. +proof. +rewrite has_find; split=> [h|]. ++ by rewrite (onth_nth witness) 1:find_ge0 /=. +by apply/contraLR=> h; rewrite onth_nth_map nth_default 1:size_map 1:lezNgt. +qed. + +lemma findP (P : 'a -> 'b -> bool) (m : ('a,'b) fmap): + (exists x, find P m = Some x /\ x \in m /\ P x (oget m.[x])) \/ + (find P m = None /\ forall x, x \in m => !P x (oget m.[x])). +proof. +case: (has P m)=> ^ => [hasPm|nothasPm]; rewrite hasP. ++ move=> [x] [] x_in_m Pxmx; left. + exists (nth witness (elems (fdom m)) (find (fun x=> x \in m /\ P x (oget m.[x])) (elems (fdom m)))). + rewrite /find (onth_nth witness) /=. + + by rewrite find_ge0 /=; apply/has_find/hasPm. + by move: hasPm=> /(nth_find witness) /=. +rewrite negb_exists /=. +move: nothasPm; rewrite find_none=> /= -> h; right=> /= x. +by move: (h x); rewrite negb_and=> /#. +qed. + (** Operators and properties of handles *) op hinv (handles:handles) (c:capacity) = find (fun _ => pred1 c \o fst) handles. @@ -1177,17 +1216,21 @@ lemma hinvP handles c: proof. cut @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := findP (fun (_ : handle) => pred1 c \o fst) handles. - + by exists (oget handles.[h]).`2;rewrite oget_some get_oget;2:case (oget handles.[h]). - cut := H h;rewrite in_dom/#. + + exists (oget handles.[h]).`2;rewrite oget_some. + by move: Hmem; rewrite domE; case: (handles.[h])=> //= - []. + by cut := H h;rewrite domE /#. qed. lemma huniq_hinv (handles:handles) (h:handle): - huniq handles => mem (dom handles) h => hinv handles (oget handles.[h]).`1 = Some h. + huniq handles => dom handles h => hinv handles (oget handles.[h]).`1 = Some h. proof. move=> Huniq;pose c := (oget handles.[h]).`1. cut:=Huniq h;cut:=hinvP handles c. - case (hinv _ _)=> /=[Hdiff _| h' +/(_ h')];1:by rewrite in_dom /#. - by move=> [f ->] /(_ (oget handles.[h]) (c,f)) H1 H2;rewrite H1 // get_oget. + 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: @@ -1196,14 +1239,14 @@ lemma hinvKP handles c: proof. rewrite /hinvK. cut @/pred1/= [[h]|][->/=]:= findP (+ pred1 c) (restr Known handles). - + by rewrite oget_some in_dom restrP;case (handles.[h])=>//= /#. - by move=>+h-/(_ h);rewrite in_dom restrP => H1/#. + + by rewrite oget_some domE restrP;case (handles.[h])=>//= /#. + by move=>+h-/(_ h);rewrite domE restrP => H1/#. qed. lemma huniq_hinvK (handles:handles) c: - huniq handles => mem (rng handles) (c,Known) => handles.[oget (hinvK handles c)] = Some(c,Known). + huniq handles => rng handles (c,Known) => handles.[oget (hinvK handles c)] = Some(c,Known). proof. - move=> Huniq;rewrite in_rng=> -[h]H;case: (hinvK _ _) (Huniq h) (hinvKP handles c)=>//=. + move=> Huniq;rewrite rngE=> -[h]H;case: (hinvK _ _) (Huniq h) (hinvKP handles c)=>//=. by move=>_/(_ h);rewrite H. qed. diff --git a/sha3/proof/smart_counter/Utils.ec b/sha3/proof/smart_counter/Utils.ec index 37ccdfa..042cc64 100644 --- a/sha3/proof/smart_counter/Utils.ec +++ b/sha3/proof/smart_counter/Utils.ec @@ -1,11 +1,12 @@ (** These should make it into the standard libs **) -require import Core List FSet NewFMap. +require import Core List FSet SmtMap. (* -------------------------------------------------------------------- *) - (* In NewFMap *) +(* In SmtMap *) op reindex (f : 'a -> 'c) (m : ('a, 'b) fmap) = - NewFMap.oflist (map (fun (x : 'a * 'b) => (f x.`1,x.`2)) (elems m)) + SmtMap.ofmap ( + SmtMap.oflist (map (fun (x : 'a * 'b) => (f x.`1,x.`2)) (elems m)) axiomatized by reindexE. From a6c876a7917cabd441287e7f6db8a5043157fd59 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 17 Sep 2018 11:21:07 +0100 Subject: [PATCH 299/394] push ConcreteF through almost --- sha3/proof/smart_counter/ConcreteF.eca | 72 +++++++++++++------------- 1 file changed, 35 insertions(+), 37 deletions(-) diff --git a/sha3/proof/smart_counter/ConcreteF.eca b/sha3/proof/smart_counter/ConcreteF.eca index 76c32a9..da7600e 100644 --- a/sha3/proof/smart_counter/ConcreteF.eca +++ b/sha3/proof/smart_counter/ConcreteF.eca @@ -334,39 +334,44 @@ section. 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. -(** HERE! CECILE! WE ARE HERE! **) - cut->:take j p{2} = take j (take i{2} p{2});smt(take_take take_le0). - * smt(prefix_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). - * smt(prefix_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). - * smt(prefix_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). - * rewrite!getP/=. + 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//=. cut/#: !take (i{2} + 1) p{2} \in pref{2}. - by rewrite memE prefix_lt_size//=-(@prefix_exchange _ _ _ H1 H0)//=/#. - * smt(prefix_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). - * smt(prefix_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + 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 (dom C.queries{2}))) = i{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 in_dom prefix_exchange). + 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 (dom C.queries{2}))) + /\ 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 (dom C.queries{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:/#. cut:=H0=>[][h1 [h2 h3]]. - cut:=h3 _ _ _ H7;last smt(memE). + cut:=h3 _ _ _ H7;last smt(memE mem_fdom). smt(size_eq0 size_take). - * smt(get_oget in_dom). + * smt(domE). auto;progress. * rewrite/#. * smt(prefix_ge0). @@ -374,18 +379,10 @@ section. * smt(prefix_sizel @Prefix memE). * smt(prefix_sizel @Prefix memE). - have p_ll := P_f_ll _ _. - + apply/dprod_ll; split. - + exact/Block.DBlock.dunifin_ll. - exact/Capacity.DCapacity.dunifin_ll. - + apply/fun_ext=>- [] a b; rewrite supp_dprod. - by rewrite/=/predT/=Block.DBlock.dunifin_fu Capacity.DCapacity.dunifin_fu. - have pi_ll := P_fi_ll _ _. - + apply/dprod_ll; split. - + exact/Block.DBlock.dunifin_ll. - exact/Capacity.DCapacity.dunifin_ll. - + apply/fun_ext=>- [] a b; rewrite supp_dprod. - by rewrite/=/predT/=Block.DBlock.dunifin_fu Capacity.DCapacity.dunifin_fu. + 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)=> //=. * move=> z; wp;if;auto; 2:call p_ll; auto=>/#. @@ -422,16 +419,17 @@ section. (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. + 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(). (** This needs Cecile's improvements to Strong_RP_RF to be pushed to stdlib. **) qed. end section. From ffb59eabad7c00e3f142b77c7bc913df692d98ca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Mon, 17 Sep 2018 18:15:05 +0200 Subject: [PATCH 300/394] push ConcreteF & Handle : finished --- sha3/proof/smart_counter/ConcreteF.eca | 4 +- sha3/proof/smart_counter/Handle.eca | 1061 ++++++++++++------------ 2 files changed, 517 insertions(+), 548 deletions(-) diff --git a/sha3/proof/smart_counter/ConcreteF.eca b/sha3/proof/smart_counter/ConcreteF.eca index da7600e..a116ae8 100644 --- a/sha3/proof/smart_counter/ConcreteF.eca +++ b/sha3/proof/smart_counter/ConcreteF.eca @@ -220,7 +220,7 @@ section. lemma Real_Concrete &m : Pr[GReal(D).main()@ &m: res /\ C.c <= max_size] <= - Pr[CF(DRestr(D)).main()@ &m: res] + (max_size ^ 2)%r / 2%r * mu dstate (pred1 witness). + Pr[CF(DRestr(D)).main()@ &m: res] + (max_size ^ 2 - max_size)%r / 2%r * mu dstate (pred1 witness). proof. cut->: Pr[RealIndif(SqueezelessSponge,PC(Perm),D).main()@ &m: @@ -429,7 +429,7 @@ section. while true (size p - i);auto. * sp; if; auto; 2:call O_f_ll; auto=> /#. by auto; smt w=size_ge0. - smt(). (** This needs Cecile's improvements to Strong_RP_RF to be pushed to stdlib. **) + smt(). qed. end section. diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index b821d31..2c4c4f0 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -1,12 +1,12 @@ pragma -oldip. pragma +implicits. require import Core Int Real StdOrder Ring IntExtra. -require import List FSet NewFMap Utils Common SLCommon RndO. -require import DProd Dexcepted. +require import List FSet SmtMap Common SLCommon. +require import DProd Dexcepted PROM. (*...*) import Capacity IntOrder DCapacity. -require (*--*) ConcreteF. +require (*--*) ConcreteF PROM. -clone export GenEager as ROhandle with +clone export PROM.GenEager as ROhandle with type from <- handle, type to <- capacity, op sampleto <- fun (_:int) => cdistr @@ -14,6 +14,7 @@ clone export GenEager as ROhandle with clone export ConcreteF as ConcreteF1. + module G1(D:DISTINGUISHER) = { var m, mi : smap var mh, mhi : hsmap @@ -29,10 +30,10 @@ module G1(D:DISTINGUISHER) = { sa <- b0; sc <- c0; while (i < size p ) { - if (mem (dom mh) (sa +^ nth witness p i, h)) { + if ((sa +^ nth witness p i, h) \in mh) { (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; } else { - if (counter < size p - prefixe p (get_max_prefixe p (elems (dom C.queries)))) { + 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); @@ -57,8 +58,8 @@ module G1(D:DISTINGUISHER) = { proc f(x : state): state = { var p, v, y, y1, y2, hy2, hx2; - if (!mem (dom m) x) { - if (mem (dom paths) x.`2) { + 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; @@ -67,13 +68,13 @@ module G1(D:DISTINGUISHER) = { y2 <$ cdistr; } y <- (y1, y2); - bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); - if (!(mem (rng FRO.m) (x.`2, Known))) { + 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 (mem (dom mh) (x.`1, hx2) /\ in_dom_with FRO.m (oget mh.[(x.`1,hx2)]).`2 Unknown) { + 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); @@ -89,7 +90,7 @@ module G1(D:DISTINGUISHER) = { mi.[y] <- x; mhi.[(y.`1, hy2)] <- (x.`1, hx2); } - if (mem (dom paths) x.`2) { + if (x.`2 \in paths) { (p,v) <- oget paths.[x.`2]; paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); } @@ -102,9 +103,9 @@ module G1(D:DISTINGUISHER) = { proc fi(x : state): state = { var y, y1, y2, hx2, hy2; - if (!mem (dom mi) x) { - bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); - if (!(mem (rng FRO.m) (x.`2, Known))) { + 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; } @@ -112,7 +113,7 @@ module G1(D:DISTINGUISHER) = { y1 <$ bdistr; y2 <$ cdistr; y <- (y1,y2); - if (mem (dom mhi) (x.`1,hx2) /\ + 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); @@ -140,18 +141,18 @@ module G1(D:DISTINGUISHER) = { proc main(): bool = { var b; - F.RO.m <- map0; - m <- map0; - mi <- map0; - mh <- map0; - mhi <- map0; + F.RO.m <- empty; + m <- empty; + mi <- empty; + mh <- empty; + mhi <- empty; bext <- false; bcol <- false; - C.queries<- map0.[[] <- b0]; + C.queries<- empty.[[] <- b0]; (* the empty path is initially known by the adversary to lead to capacity 0^c *) - FRO.m <- map0.[0 <- (c0, Known)]; - paths <- map0.[c0 <- ([<:block>],b0)]; + FRO.m <- empty.[0 <- (c0, Known)]; + paths <- empty.[c0 <- ([<:block>],b0)]; chandle <- 1; b <@ D(M,S).distinguish(); return b; @@ -194,14 +195,14 @@ inductive m_p (m : smap) (p : (block list, state) fmap) | INV_m_p of (p.[[]] = Some (b0,c0)) & (q.[[]] = Some b0) & (forall (l : block list), - l \in dom p => + 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 dom q => exists c, p.[l] = Some (oget q.[l], c)) + l \in q => exists c, p.[l] = Some (oget q.[l], c)) & (forall (l : block list), - l \in dom p => exists (l2 : block list), l ++ l2 \in dom q). + 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) = @@ -353,9 +354,9 @@ proof. case=>h0 h0' h1 h2 _ l hl i. case(l = [])=>//=l_notnil. case(0 <= i)=>hi0;last first. -+ rewrite take_le0 1:/#;cut<-:=take0 l;smt(in_dom size_ge0). ++ rewrite take_le0 1:/#;cut<-:=take0 l;smt(domE size_ge0). case(i < size l)=>hisize;last smt(take_oversize). -smt(in_dom). +smt(domE). qed. lemma all_prefixes_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p q: @@ -375,17 +376,17 @@ 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_notin_dom_hs hs ch: hs_spec hs ch => hs.[ch] = None. +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_notin_dom_hs hs ch: hs_spec hs ch => hs.[ch + 1] = None. +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_notin_dom2_mh hs m mh xa ch: +lemma ch_notdomE2_mh hs m mh xa ch: m_mh hs m mh => hs_spec hs ch => mh.[(xa,ch)] = None. @@ -395,7 +396,7 @@ 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_notin_dom2_mh hs m mh xa ch: +lemma Sch_notdomE2_mh hs m mh xa ch: m_mh hs m mh => hs_spec hs ch => mh.[(xa,ch + 1)] = None. @@ -433,7 +434,7 @@ lemma notin_m_notin_Gm (m Gm : ('a,'b) fmap) x: => Gm.[x] = None. proof. by move=> Gm_leq_m; apply/contraLR=> ^ /Gm_leq_m ->. qed. -lemma notin_hs_notin_dom2_mh hs m mh xa hx: +lemma notin_hs_notdomE2_mh hs m mh xa hx: m_mh hs m mh => hs.[hx] = None => mh.[(xa,hx)] = None. @@ -450,11 +451,11 @@ lemma m_mh_addh hs ch m mh xc fx: 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 !getP mh_xaxc0 hs_hx0 hs_hy /=. + 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 !getP m_xaxc0 hs_hx hs_hy. +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. @@ -468,17 +469,17 @@ 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 !getP /= /#. - + by exists hy fy hy' fy'; rewrite !getP Hhy' /#. - + by exists hx' fx' hy fy; rewrite !getP Hhx' /#. - by exists hx' fx' hy' fy'; rewrite !getP 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 !getP /= /#. -+ by exists yc fy yc' fy'; rewrite !getP Hhy' /#. -+ by exists xc' fx' yc fy; rewrite !getP Hhx' /#. -by exists xc' fx' yc' fy'; rewrite !getP 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': @@ -489,15 +490,15 @@ lemma m_mh_addh_addm hs Pm mh hx xa xc hy ya yc f f': 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 getP. +split=> [xa0 xc0 ya0 yc0|xa0 hx0 ya0 hy0]; rewrite get_setE. + case: ((xa0,xc0) = (xa,xc))=> [[#] <<*> [#] <<*>|] /=. - + by exists hx f hy f'; rewrite !getP /= /#. + + 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 !getP /#. + by exists hx0 fx0 hy0 fy0; rewrite !get_setE /#. case: ((xa0,hx0) = (xa,hx))=> [[#] <*>> [#] <<*>|] /=. -+ by exists xc f yc f'; rewrite !getP /= /#. ++ by exists xc f yc f'; rewrite !get_setE /= /#. rewrite andaE=> /negb_and xahx0_neq_xahx /Hmh_m [xc0 fx0 yc0 fy0] [#] hs_hx0 hs_hy0 Pm_xaxc0. -exists xc0 fx0 yc0 fy0; rewrite !getP; do !split=> [/#|/#|/=]. +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. @@ -510,14 +511,14 @@ lemma mi_mhi_addh_addmi (hs : handles) mi mhi hx xa xc hy ya yc fx fy: 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 getP; case: ((ya0,yc0) = (ya,yc))=> [[#] <*>> [#] <*>>|]. - + by exists hy fy hx fx; rewrite !getP /= /#. ++ 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 !getP /#. -move=> ya0 hy0 xa0 hx0; rewrite getP; case: ((ya0,hy0) = (ya,hy))=> [[#] <*>> [#] <<*>|]. -+ by exists yc fy xc fx; rewrite !getP //= /#. + 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 //= /#. rewrite /= andaE=> /negb_and yahy0_neq_yahy /Hmh_m [yc0 fy0 xc0 fx0] [#] hs_hy0 hs_hx0 mi_yayc0. -exists yc0 fy0 xc0 fx0; rewrite !getP; do !split=> [/#|/#|]. +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. @@ -562,7 +563,7 @@ lemma huniq_addh hs h c f: => (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 !getP. +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. @@ -575,12 +576,12 @@ lemma hs_addh hs ch xc fx: => 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 !getP /=. ++ 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 getP (ch_neq0 _ Hhs). -+ move=> [c f] h; rewrite !getP; case: (h = ch)=> [<*> /#|_]. ++ by rewrite get_setE (ch_neq0 _ Hhs). ++ move=> [c f] h; rewrite !get_setE; case: (h = ch)=> [<*> /#|_]. by move=> /dom_hs /#. qed. @@ -591,9 +592,9 @@ lemma hs_updh hs ch fx hx xc fx': => hs_spec hs.[hx <- (xc,fx')] ch. proof. move=> ^Hhs [] Hhuniq hs_0 dom_hs hx_neq0 hs_hx; split. -+ by move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /= /#. -+ by rewrite getP hx_neq0. -move=> cf h; rewrite getP; case: (h = hx)=> [<*> _|_ /dom_hs //]. ++ by move=> h1 h2 [c1 f1] [c2 f2]; rewrite !get_setE /= /#. ++ by rewrite get_setE hx_neq0. +move=> cf h; rewrite get_setE; case: (h = hx)=> [<*> _|_ /dom_hs //]. by move: hs_hx=> /dom_hs. qed. @@ -605,7 +606,7 @@ lemma mh_addh hs ch Gm mh ro xc fx: 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 !getP Hite hs_hx hs_hy /=. +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. @@ -617,7 +618,7 @@ lemma inv_addm (m : ('a,'b) fmap) mi x y: => mi.[y] = None => inv_spec m.[x <- y] mi.[y <- x]. proof. -move=> [] Hinv m_x mi_y; split=> x' y'; rewrite !getP; split. +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 ^ + ->]. @@ -628,7 +629,7 @@ qed. 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 !getP; case: (x' = x)=> [|_ /m_leq_m']. qed. +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 = @@ -640,14 +641,14 @@ proof. by rewrite /getflag; case: (hinvP hs xc)=> [->|] //= /#. qed. lemma getflagP_some hs xc f: huniq hs - => (getflag hs xc = Some f <=> mem (rng hs) (xc,f)). + => (getflag hs xc = Some f <=> rng hs (xc,f)). proof. move=> huniq_hs; split. + rewrite /getflag; case: (hinvP hs xc)=> [-> //|]. - rewrite in_rng; case: (hinv hs xc)=> //= h [f']. + rewrite rngE; case: (hinv hs xc)=> //= h [f']. rewrite oget_some=> ^ hs_h -> @/snd /= ->>. by exists h. -rewrite in_rng=> -[h] hs_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) /= ->>. @@ -673,7 +674,7 @@ 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 getP /#. +by rewrite get_setE /#. qed. lemma build_hpath_down mh xa hx ya hy p v h: @@ -684,7 +685,7 @@ proof. move=> no_path_to_hx. elim/last_ind: p v h=> [v h /build_hpathP [<*>|/#] //=|p b ih]. move=> v h /build_hpathP [/#|p' b' + + ^/rconsIs <<- /rconssI <<-]. -move=> v' h' /ih; rewrite getP. +move=> v' h' /ih; rewrite get_setE. case: ((v' +^ b,h') = (xa,hx))=> [/#|_ Hpath Hextend]. exact/build_hpathP/(Extend _ _ _ _ _ Hpath Hextend). qed. @@ -742,59 +743,59 @@ lemma lemma1 hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2 prefixes queries: 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_notin_rng1_hs y2_notin_rng1_hs; split. +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 getP; case: (h = ch)=> [/#|_]; exact/y2_notin_rng1_hs. + 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_notin_rng1_hs. + 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_notin_dom2_mh _ _ Hm_mh Hhs). + by apply/(ch_notdomE2_mh _ _ Hm_mh Hhs). have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. - by apply/(Sch_notin_dom2_mh _ _ Hmi_mhi Hhs). + 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 getP. - by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. + + 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 getP; case: (h = ch)=> [_ //=|_ //=]; first by rewrite x2_neq_y2. - by rewrite y2_notin_rng1_hs. - + by rewrite getP. - by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. + + 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 getP; case: ((xa,hx) = (x1,ch))=> [|]. - + by move=> [#] <*> [#] <*>; exists x2 Known y2 Known; rewrite !getP /#. + + 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 getP). + 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 getP; case: ((xa,xc) = (x1,x2))=> [/#|]. + + 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_notin_dom2_mh H:= HINV. - exact/H/ch_notin_dom_hs/Hhs. + 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_notin_dom2_mh hs Pm)/ch_notin_dom_hs; case: HINV. - have ch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch). + + 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_notin_dom_hs; case: HINV. + by move=> [xc fx yc fy] [#] _; rewrite ch_notdomE_hs; case: HINV. split=> -[#]. - + move=> Hpath mh_vxahx; rewrite getP; case: ((v +^ xa,hx) = (x1,ch))=> [/#|_]. + + 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_notin_rng2_mh. - move=> ^ /build_hpathP + -> /=; rewrite getP. + 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)). @@ -807,19 +808,19 @@ move=> HINV x2_neq_y2 Pm_x Gm_x x2_notin_rng1_hs y2_notin_rng1_hs; split. 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_notin_dom2_mh hs Pm)/ch_notin_dom_hs; case: HINV. - by move=> -> /= ^ /dom_hs; rewrite !getP /#. -have ch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch). + + 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_notin_dom_hs; case: HINV. -have Sch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch + 1). + 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_notin_dom_hs; case: 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_notin_rng2_mh. -+ move=> ^ /build_hpathP + -> /=; rewrite !getP. + 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=>[]. @@ -829,7 +830,7 @@ split=>[]. cut[]_ _ h2 h3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]sa sc[]:=h2 l hmem i hi. cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - smt(in_dom getP). + smt(domE get_setE). by case:HINV=>_ _ _ _ _ _ _ _ _ []. by case:HINV=>_ _ _ _ _ _ _ _ _ []. qed. @@ -837,7 +838,7 @@ 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 dom Pm + => ! (y1,y2) \in Pm => x2 <> y2 => Pmi.[(x1,x2)] = None => Gmi.[(x1,x2)] = None @@ -850,58 +851,58 @@ lemma lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries 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_notin_rng1_hs yc_notin_rng1_hs; split. +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 getP; case: (h = ch)=> [/#|_]; exact/yc_notin_rng1_hs. + 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_notin_rng1_hs. + 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_notin_dom2_mh _ _ Hm_mh Hhs). + by apply/(Sch_notdomE2_mh _ _ Hm_mh Hhs). have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. - by apply/(ch_notin_dom2_mh _ _ Hmi_mhi Hhs). + 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 getP; case: (h = ch)=> [<*> /#|]; rewrite yc_notin_rng1_hs. - + by rewrite getP. - by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. + + 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 getP. - by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: 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 getP; case: ((ya,hy) = (y1,ch + 1))=> [|]. - + by move=> [#] <*> [#] <*>; exists y2 Known x2 Known; rewrite !getP /#. + + 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 getP). + 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 getP; case: ((ya,yc) = (y1,y2))=> [/#|]. + + 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_notin_dom2_mh H:= HINV. - exact/H/Sch_notin_dom_hs/Hhs. + 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_notin_dom2_mh hs Pm)/Sch_notin_dom_hs; case: HINV. - have Sch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch + 1). + + 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_notin_dom_hs; case: HINV. + by move=> [yc fy xc fx] [#] _; rewrite Sch_notdomE_hs; case: HINV. split=> -[#]. - + move=> Hpath mh_vxahx; rewrite getP; case: ((v +^ ya,hx) = (y1,ch + 1))=> [/#|_]. + + 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_notin_rng2_mh. - move=> ^ /build_hpathP + -> /=; rewrite getP. + 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)). @@ -914,19 +915,19 @@ move=> HINV hh x2_neq_y2 Pm_x Gm_x xc_notin_rng1_hs yc_notin_rng1_hs; split. 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_notin_dom2_mh hs Pm)/Sch_notin_dom_hs; case: HINV. - by move=> -> /= ^ /dom_hs; rewrite !getP /#. -have ch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch). + + 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_notin_dom_hs; case: HINV. -have Sch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch + 1). + 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_notin_dom_hs; case: 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_notin_rng2_mh. -+ move=> ^ /build_hpathP + -> /=; rewrite !getP. + 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=>[]. @@ -936,7 +937,7 @@ split=>[]. cut[]_ _ h2 h3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]sa sc[]:=h2 l hmem i hi. cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - smt(in_dom getP). + smt(domE get_setE). by case:HINV=>_ _ _ _ _ _ _ _ _ []. by case:HINV=>_ _ _ _ _ _ _ _ _ []. qed. @@ -954,45 +955,45 @@ lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes queries x1 x2 y1 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_notin_rng1_hs. +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_notin_rng1_hs. + 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_notin_dom2_mh _ _ Hmi_mhi Hhs). + 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_notin_dom_hs. + 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_notin_dom_hs. + 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 getP; case: ((xa',hx') = (x1,hx))=> [[#] <*>> [#] <<*> /=|]. - + exists x2 Known y2 Known=> //=; rewrite !getP /=. + + 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 !getP hs_hx' hs_hy'. + + 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 !getP; case: ((xa',xc) = (x1,x2))=> [/#|]. + 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 getP; case: ((v +^ xa,hi) = (x1,hx))=> [[#] <*>|_]. + 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=> //. @@ -1002,7 +1003,7 @@ split. + 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 getP. case: ((v +^ xa,hi) = (x1,hx))=> [[#] <*>|_ Hpath Hextend]. + 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. @@ -1015,13 +1016,13 @@ 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 getP. + 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 getP; case: (h = 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. @@ -1034,14 +1035,14 @@ split=>[]. cut[]_ _ h2 _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]sa sc[]:=h2 l hmem i hi. cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - smt(in_dom getP). + 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 dom PFm + => ! (y1,y2) \in PFm => PFmi.[(x1,x2)] = None => G1mi.[(x1,x2)] = None => hs.[hx] = Some (x2,Known) @@ -1052,49 +1053,49 @@ lemma lemma2' hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes queries x1 x2 y1 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_notin_rng1_hs. +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_notin_rng1_hs. + 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_notin_dom2_mh _ _ Hm_mh Hhs). + 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_notin_dom_hs. + 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_notin_dom_hs. + 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 getP; case: ((ya',hy') = (y1,ch))=> [[#] <*>> [#] <<*> /=|]. - + exists y2 Known x2 Known=> //=; rewrite !getP /=. + + 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 !getP hs_hx' hs_hy'. + + 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 !getP; case: ((ya',yc) = (y1,y2))=> [/#|]. + 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_notin_dom2_mh hs PFm)/(ch_notin_dom_hs); by case: HINV. - move=> -> /=; rewrite getP /=; case: (hx' = ch)=> <*> //. + + 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). @@ -1105,7 +1106,7 @@ split. 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 getP. case: ((v +^ ya,hx') = (y1,ch))=> [[#] <*>|_ Hpath Hextend //=]. + 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). @@ -1123,7 +1124,7 @@ apply/exists_iff=> h /=; split=> [#]. + 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 getP. + 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. @@ -1133,7 +1134,7 @@ have no_path_to_ch: forall p0 v0, build_hpath G1mh p0 <> Some (v0,ch). 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 getP; case: (h = 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. @@ -1146,7 +1147,7 @@ split=>[]. cut[]_ _ h2 _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]sa sc[]:=h2 l hmem i hi. cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - smt(in_dom getP). + smt(domE get_setE). by case:HINV=>_ _ _ _ _ _ _ _ _ []. by case:HINV=>_ _ _ _ _ _ _ _ _ []. qed. @@ -1179,18 +1180,18 @@ split. + by case: HINV. + by apply/(m_mh_updh Unknown)=> //; case: HINV. + by apply/(m_mh_updh Unknown)=> //; case: HINV. -+ move=> [za zc]; rewrite getP; case: ((za,zc) = (xa,xc))=> // _. ++ 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!<<- {xct fxt} [#] 2!<<- {yct fyt} Pmi_yayc. - move=> [za zc]; rewrite getP; case: ((za,zc) = (ya,yc))=> // _. + 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 !getP /=. + + rewrite mh_xahx=> /= [#] <<*>; rewrite !get_setE /=. case: (hx = hy)=> [<*>|_]; first by move: hs_hx; rewrite hs_hy. - by exists xc Known yc Known; rewrite getP. + 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. @@ -1205,24 +1206,24 @@ split. + 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 (@getP _ _ _ hy') Hhy'=> /= hs_hx' ^ hs_hy' -> Hite. + rewrite (@get_set_neqE _ _ hy' _ Hhy')=> /= hs_hx' ^ hs_hy' -> Hite. exists xc' (if hx' = hy then Known else fx') yc' fy'. - rewrite (@getP Gm) (_: (xa',xc') <> (xa,xc)) /=. + 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 getP; case: (hx' = hy)=> /= [<*>|//]. + rewrite get_setE; case: (hx' = hy)=> /= [<*>|//]. move: hs_hx'; rewrite hs_hy=> /= [#] <<*> /=. by move: Hite=> /= [#]; case: fy' hs_hy'=> //= _ ->. -+ split=> c p' b'; rewrite !getP; case: (yc = c)=> [<<*> /=|yc_neq_c]; last first. ++ 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 getP; case: (h = hy)=> [<*> /=|//=]. + apply/exists_iff=> h /=; rewrite get_setE; case: (h = hy)=> [<*> /=|//=]. by rewrite yc_neq_c hs_hy /=. split=> [[#] <<*>|]. - + exists hy; rewrite getP /=; apply/build_hpath_prefix. + + 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 getP; case: (h = hy)=> [<*> /=|]; last first. + 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 /=. @@ -1259,7 +1260,7 @@ proof. 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 getP /=;case (h' = ch) => [->> | ]. + 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. @@ -1276,7 +1277,7 @@ proof. elim: p (Some (b0,0)) => //= b p Hrec obi. rewrite {2 4}/step_hpath /=;case: obi => //= [ | bi'];1:by apply Hrec. rewrite oget_some. - rewrite getP. case ((bi'.`1 +^ b, bi'.`2) = bi1) => [-> | _];2:by apply Hrec. + rewrite get_setE. case ((bi'.`1 +^ b, bi'.`2) = bi1) => [-> | _];2:by apply Hrec. by rewrite Hbi1 build_hpath_None. qed. @@ -1289,9 +1290,9 @@ lemma build_hpath_down_None h ch mh xa ha ya a p: 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 getP;case ((bi.`1 +^ b, bi.`2) = (xa, ha)) => _;2:by apply Hrec. + 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 /= getP_neq /= ?Hha // Hmh build_hpath_None. + by rewrite {2}/step_hpath /= oget_some /= get_setE_neq /= ?Hha // Hmh build_hpath_None. qed. *) @@ -1308,28 +1309,28 @@ proof. 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 getP_eq /=;apply build_hpath_up_None. + 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 dom prefixes +=> 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 dom mh. +=> (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_prefixe hs_h_sc_f. -cut[]_ _ m_prefixe _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. -cut[]b1 c1[]:=m_prefixe _ take_i1_p_in_prefixes i _;1:smt(size_take). -rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/# prefixes_sa_sc/==>[][<-<-]{b1 c1}Pm_prefixe. +move=>inv0 hi take_i1_p_in_prefixes prefixes_sa_sc build_hpath_i_p ro_prefix hs_h_sc_f. +cut[]_ _ m_prefix _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. +cut[]b1 c1[]:=m_prefix _ take_i1_p_in_prefixes i _;1:smt(size_take). +rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/# prefixes_sa_sc/==>[][<-<-]{b1 c1}Pm_prefix. cut[]hh1 hh2 hh3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. -move:ro_prefixe;cut{1}->:=(take_nth witness i p);1:smt(size_take);move=>h1. +move:ro_prefix;cut{1}->:=(take_nth witness i p);1:smt(size_take);move=>h1. cut:=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(in_dom). +rewrite h1/==>[][] v hx hy;rewrite build_hpath_i_p/==>[][][?<-];smt(domE). qed. (* we should do a lemma to have the equivalence *) @@ -1346,7 +1347,7 @@ equiv eq_fi (D <: DISTINGUISHER {PF, RO, G1}): DPRestr(PF).fi ~ DPRestr(G1(DRest F.RO.m{2} G1.paths{2} Redo.prefixes{1} C.queries{2} ==> if G1.bcol{2} \/ G1.bext{2} - then ([] \in dom C.queries{1}) /\ ([] \in dom C.queries{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} @@ -1386,72 +1387,72 @@ 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 in_dom Pmi_xaxc. - rcondt{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom 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_notin_rng1_hs. + + move=> /getflagP_none xc_notrngE1_hs. rcondt{2} 2. - + auto=> &hr [#] <<*> _ _ _; rewrite in_rng negb_exists=> h /=. - by rewrite xc_notin_rng1_hs. + + auto=> &hr [#] <<*> _ _ _; rewrite rngE /= negb_exists=> h /=. + by rewrite xc_notrngE1_hs. rcondf{2} 8. + auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _. - rewrite negb_and in_dom; left. + rewrite negb_and domE; left. rewrite (@huniq_hinvK_h ch) 3:oget_some /=. + by apply/huniq_addh=> //; have /hs_of_INV [] := inv0. - + by rewrite getP. + + 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 getP. + by rewrite get_setE. auto=> ? ? [#] !<<- -> -> ->> _ /= ya -> /= yc -> /=. - case: (hinvP (hs.[ch <- (xc,Known)]) yc)=> [_|-> //] yc_notin_rng1_hs_addh _ _. - rewrite getP /= oget_some /= -addzA /=. + case: (hinvP (hs.[ch <- (xc,Known)]) yc)=> [_|-> //] yc_notrngE1_hs_addh _ _. + rewrite get_setE /= oget_some /=. rewrite(@huniq_hinvK_h ch) 3:oget_some /=. + by apply/huniq_addh=> //; have /hs_of_INV [] := inv0. - + by rewrite getP. + + 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_notin_rng1_hs_addh => /=. + + rewrite -negP=> <*>; move: yc_notrngE1_hs_addh => /=. apply/negb_forall=> /=; exists ch; apply/negb_forall=> /=; exists Known. - by rewrite getP. - + move=> f h; move: (yc_notin_rng1_hs_addh h f); rewrite getP. + 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 in_dom/=;cut[]h1 h2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + + rewrite domE/=;cut[]h1 h2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. cut h1':=h1 ya yc. cut :Pm.[(ya, yc)] <> None => exists (hx : handle) (fx : flag), hs.[hx] = Some (yc, fx) by rewrite/#. case(Pm.[(ya, yc)] = None)=>//=h; rewrite negb_exists/==>a;rewrite negb_exists/==>b. - cut:=yc_notin_rng1_hs_addh a b;rewrite getP;case(a=ch)=>//=hach. search (&&). + cut:=yc_notrngE1_hs_addh a b;rewrite get_setE;case(a=ch)=>//=hach. search (&&). case(xc=yc)=>[/#|]hxyc. cut[]_ _ help:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. by cut/#:=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; rewrite in_rng=> -[hx2] hs_hx2. + move=> ^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 in_dom /=; left. + 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_notin_rng1_hs _ _|/#]. - rewrite getP /= oget_some /=. + case: (hinvP hs y2)=> [_ y2_notrngE1_hs _ _|/#]. + rewrite get_setE /= oget_some /=. apply/lemma2'=> //. - + rewrite in_dom/=;cut[]h1 _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + + rewrite domE/=;cut[]h1 _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. cut h1':=h1 y1 y2. cut :Pm.[(y1, y2)] <> None => exists (hx : handle) (fx : flag), hs.[hx] = Some (y2, fx) by rewrite/#. case(Pm.[(y1, y2)] = None)=>//=h; rewrite negb_exists/==>a;rewrite negb_exists/==>b. - exact(y2_notin_rng1_hs). - move=> f h; exact/y2_notin_rng1_hs. -rcondf{1} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Pmi_xaxc. + 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 in_dom Gmi_xaxc. ++ rcondt{2} 1; 1:by auto=> &hr [#] <<*>; rewrite domE Gmi_xaxc. conseq (_: _ ==> G1.bext{2})=> //. auto=> &1 &2 [#] !<<- _ -> ->> _ />. - rewrite !in_rng; have ->: exists hx, hs.[hx] = Some (xc,Unknown). + 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. @@ -1461,9 +1462,9 @@ case @[ambient]: {-1}(Gmi.[(xa,xc)]) (eq_refl Gmi.[(xa,xc)])=> [|[ya' yc'] ^] Gm smt (@Block.DBlock @Capacity.DCapacity). have /incli_of_INV <- := inv0; 1:by rewrite Gmi_xaxc. rewrite Pmi_xaxc=> /= [#] <<*>. -rcondf{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_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(in_dom). ++ by move=> /> &1 &2 _ _ /m_p_of_INV []; smt(domE). by move=> /> &1 &2 -> ->. qed. @@ -1479,7 +1480,7 @@ equiv eq_f (D <: DISTINGUISHER {PF, RO, G1}): DPRestr(PF).f ~ DPRestr(G1(DRestr( F.RO.m{2} G1.paths{2} Redo.prefixes{1} C.queries{2} ==> if G1.bcol{2} \/ G1.bext{2} - then ([] \in dom C.queries{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} @@ -1499,7 +1500,7 @@ call(: !G1.bcol{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} C.queries{2} ==> if G1.bcol{2} \/ G1.bext{2} - then ([] \in dom C.queries{2}) + then ([] \in C.queries{2}) else ={res} /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} @@ -1520,13 +1521,13 @@ call(: !G1.bcol{2} 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 in_dom PFm_x1x2. - rcondt{2} 1; 1:by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom Gm_x1x2. + 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 in_dom x2_in_pi. + + by move=> //= &1; skip=> &2 [#] <*>; rewrite domE x2_in_pi. rcondf{2} 8. - + by move=> //= &1; auto=> &2 [#] !<<-; rewrite !in_dom x2_in_pi. + + 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} @@ -1546,51 +1547,50 @@ call(: !G1.bcol{2} /\ 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_notin_rng_hs0; rcondt{2} 3. - + move=> &1; auto=> &2 /> _ _ _; rewrite in_rng negb_exists /=. - exact/(@x2f_notin_rng_hs0 Known). + + 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 !getP; case: (hx = G1.chandle{2}); case: (hy = G1.chandle{2})=> //=. - + by move=> _ + [#] - <*>; have:= (x2f_notin_rng_hs0 yf hy). - + by move=> + _ + [#] - <*>; have:= (x2f_notin_rng_hs0 xf hx). + 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 !getP. + by rewrite !get_setE. rewrite oget_some=> _ _ _. - have -> //: !mem (dom G1.mh{2}) (x1,G1.chandle{2}). - rewrite in_dom /=; case: {-1}(G1.mh.[(x1,G1.chandle)]{2}) (eq_refl (G1.mh.[(x1,G1.chandle)]{2}))=> //= -[xa xh]; rewrite -negP. + 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 getP /= oget_some /= -addzA /=. - rewrite (@huniq_hinvK_h ch0 hs0.[ch0 <- (x2,Known)] x2); 2:by rewrite getP. - + move=> @/huniq h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. + rewrite get_setE /= oget_some /=. + 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_notin_rng_hs0 f2 h2). - + by move=> + _ + [#] <*> - <*>; move: (x2f_notin_rng_hs0 f1 h1). + + 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 getP. - rewrite !oget_some;rewrite in_dom;cut[]_ -> _ _ _ /=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + by apply/h; rewrite get_setE. + rewrite !oget_some;rewrite domE;cut[]_ -> _ _ _ /=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. smt(lemma1). conseq (_: _ ==> G1.bcol{2})=> //=. + by auto=> &1 &2 [#] !<<- bad1 bad2 -> _ ->> !<<- _ /=/>; - rewrite in_dom;cut[]_ ->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + rewrite domE;cut[]_ ->_ _ _/=:=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 getP. - move=> h; have:= hs0_spec h f; rewrite getP; case: (h = ch0)=> [<*>|//=]. + + 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 in_dom;cut[]_ -> _ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. - rewrite/#. + by rewrite domE;cut[]_ -> _ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. move=> x2_is_K; rcondf{2} 3; 1:by move=> &1; auto. - have:= x2_is_K; rewrite in_rng=> - [hx] hs0_hx. + have:= x2_is_K; rewrite rngE=> - [hx] hs0_hx. seq 0 3: ( hs0 = FRO.m{2} /\ ch0 = G1.chandle{2} /\ PFm = PF.m{1} @@ -1610,15 +1610,16 @@ call(: !G1.bcol{2} /\ y{2} = (y1,y2){2} /\ hx2{2} = hx /\ INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref queries). - + auto=> &1 &2 /> _ -> /= _; split. - + move: x2_is_K; rewrite in_rng /= => -[hx2] hs_hx2. - rewrite in_rng negb_exists /==> h; rewrite -negP=> hs_h. + (* 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 FRO.m{2} x2) //. + rewrite (@huniq_hinvK_h hx hs0 x2) //. by have /hs_of_INV [] := inv0. - have x1hx_notin_G1m: !mem (dom G1mh) (x1,hx). - + rewrite in_dom; case: {-1}(G1mh.[(x1,hx)]) (eq_refl G1mh.[(x1,hx)])=> //=. + 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. @@ -1626,27 +1627,27 @@ call(: !G1.bcol{2} rcondf{2} 1. + by move=> &m; auto=> //= &hr [#] <*>; rewrite x1hx_notin_G1m. auto=> &1 &2 [#] !<<- -> -> !->> _ /=. - rewrite in_dom;cut[]_ -> _ _ _ /=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + rewrite domE;cut[]_ -> _ _ _ /=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. case(hinv hs0 y2{2} = None)=>//=h; - rewrite getP /= oget_some /=;smt(lemma2 hinvP). + rewrite get_setE /= oget_some /=;smt(lemma2 hinvP). move=> [p0 v0] ^ pi_x2. have /pi_of_INV [] -> [hx2] [#] Hpath hs_hx2:= inv0. - rcondt{2} 1. by move=> &m; auto=> &hr [#] !<<- _ _ ->> /= _; rewrite in_dom pi_x2. + rcondt{2} 1. by move=> &m; auto=> &hr [#] !<<- _ _ ->> /= _; rewrite domE pi_x2. rcondf{2} 6. + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. - by rewrite in_rng; exists hx2. + 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 in_dom; case: {-1}(G1mh.[(x1,hx2)]) (eq_refl (G1mh.[(x1,hx2)]))=> [//=|[xa xc] G1mh_x1hx2]. + 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=> [#] !<<- {xc0 xf0}; rewrite PFm_x1x2. rcondt{2} 15. + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. - by rewrite in_dom pi_x2. + by rewrite domE pi_x2. inline F.RO.get. rcondt{2} 4. + auto=> &hr [#] !<<- _ _ !->> _ /= _ _; rewrite pi_x2 oget_some /=. - rewrite in_dom; case: {-1}(ro0.[rcons p0 (v0 +^ x1)]) (eq_refl (ro0.[rcons p0 (v0 +^ x1)])). + 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 /=. @@ -1656,9 +1657,9 @@ call(: !G1.bcol{2} move=> [xc xf yc yf] [#]; rewrite hs_hx2=> [#] <*>. by rewrite PFm_x1x2. auto => &m1 &m2 [#] !<- _ _ -> /= _ y1L -> y2L -> /=. - rewrite !getP_eq pi_x2 !oget_some /=. + rewrite !get_set_sameE pi_x2 !oget_some /=. have /hs_of_INV [] Hu _ _:= inv0; have -> := huniq_hinvK_h _ _ _ Hu hs_hx2. - rewrite oget_some in_dom => /= ;cut[]_->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + rewrite oget_some domE => /= ;cut[]_->_ _ _/=:=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. @@ -1675,35 +1676,35 @@ call(: !G1.bcol{2} 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_notin_dom2_mh _ _ Hmmhi Hhs). - + by apply (m_mh_addh_addm _ Hmmh _ hs_hx2)=>//;apply ch_notin_dom_hs. - + apply (mi_mhi_addh_addmi _ Hmmhi _ hs_hx2);last by apply ch_notin_dom_hs. + + 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 getP;case ((xa, hx) = (x1, hx2))=> /=. + + move=> xa hx ya hy;rewrite get_setE;case ((xa, hx) = (x1, hx2))=> /=. + move=> [] !-> [] !<-; exists x2 Known y2L Known. - by rewrite !getP_eq /= getP_neq // eq_sym; apply (dom_hs_neq_ch _ _ _ Hhs hs_hx2). + by rewrite !get_set_sameE /= get_set_neqE // eq_sym; apply (dom_hs_neq_ch _ _ _ Hhs hs_hx2). move=> Hdiff Hxa; case Hmh=> /(_ _ _ _ _ Hxa) [] xc fx yc fy [#] Hhx Hhy HG1 _ _. - exists xc fx yc fy;rewrite !getP_neq //. - + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhx). - + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhy). + 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 (x2, fx) (x2, Known)). + 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 getP_neq // -negP => ^ /rconssI <<- /rconsIs. + + 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 getP. + + move=> p bn b; rewrite get_setE. case (rcons p bn = rcons p0 (v0 +^ x1)). + move=> ^ /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 getP_eq. - move=> [v hx hy] [];rewrite getP ;case ((v +^ (v0 +^ x1), hx) = (x1, hx2)) => //. + 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. @@ -1714,8 +1715,10 @@ call(: !G1.bcol{2} + split;1: by move=> [] _ /ch_None. move=> [[p0' x [Hhx2']]]. have [!->>] [!->>]:= Huni _ _ _ _ _ Hpath Hhx2'. - by rewrite getP_neq /= ?Hhx2 // => /ch_None. - rewrite getP;case ((v +^ bn, hx) = (x1, hx2)) => //= -[<<- ->>]. + 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. @@ -1723,18 +1726,18 @@ call(: !G1.bcol{2} case (hx = ch0) => [->> [?? [# H1 -> ->]] [?? [# H2 -> ->]]|_ ] /=. + by have [!->>] := Huni _ _ _ _ _ H1 H2. by apply Huni. - split=> c p v;rewrite getP. case (c = y2L) => [->> /= | Hc]. + split=> c p v;rewrite get_setE. case (c = y2L) => [->> /= | Hc]. + split. - + move=> [!<<-];exists ch0;rewrite getP_eq /= build_hpath_prefix. - exists v0 hx2;rewrite xorwA xorwK Block.WRing.add0r getP_eq /=. + + 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 getP build_hpath_upd_ch_iff //. + 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 // getP;case (h = ch0) => [->> | //]. + 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. @@ -1742,51 +1745,51 @@ call(: !G1.bcol{2} + by cut[]/#:=Hmp. + cut[]_ _ h _ _ l hdom i hi:=Hmp. cut[]b c[]->h':=h l hdom i hi. - by exists b c=>//=;rewrite getP/=-h';smt(in_dom take_oversize). + by exists b c=>//=;rewrite get_setE/=-h';smt(domE take_oversize). + by cut[]/#:=Hmp. + by cut[]/#:=Hmp. - move=> [xa xc] PFm_x1x2. rcondf{1} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom PFm_x1x2. + 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 in_dom G1m_x1x2. + + 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 /= => [#] !<<- {ya yc}. - move=> x1x2_notin_G1m; rcondt{2} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom x1x2_notin_G1m. + 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=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0}. 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 in_rng; exists hx2. + - 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 in_dom;cut[]_->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + - by rewrite domE;cut[]_->_ _ _/=:=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=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0} /= [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 in_dom pi_x2. + 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 /= in_dom Hro. - rcondf{2} 8; first by auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _; rewrite in_rng; exists hx2. + 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:in_dom 2:G1mh_x1hx2 2:!oget_some /=. + 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 in_dom hs_hy2. - rcondt{2} 14; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite in_dom pi_x2. + by rewrite /in_dom_with domE hs_hy2. + rcondt{2} 14; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite domE pi_x2. auto=> &1 &2 [#] !<<- -> -> ->> _ /=; rewrite Block.DBlock.dunifin_ll Capacity.DCapacity.dunifin_ll /=. move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 !oget_some //=. rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. + by have /hs_of_INV []:= inv0. - rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //=in_dom. + rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //=domE. cut[]_->_ _ _//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. - case((x2, Unknown) \in rng hs0)=>//=_. + case(rng hs0 (x2, Unknown))=>//=_. exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). by move=> /> &1 &2 -> ->. qed. @@ -1803,11 +1806,11 @@ 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 => !mem (dom m2) x => incl m1 m2.[x <- y]. +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 getP_neq // -negP => ->>. - by move: Hdom;rewrite in_dom. + rewrite get_set_neqE // -negP => ->>. + by move: Hdom;rewrite domE. qed. @@ -1815,7 +1818,7 @@ 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 dom prefixes + => take (i + 1) p \in prefixes => prefixes.[take i p] = Some (b,c) => (exists f, hs.[h] = Some (c,f)) => exists b' c' h', @@ -1826,7 +1829,9 @@ move=>Hinv H_size H_take_iS H_take_i H_hs_h. cut[]_ _ H _ _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. cut[]sa sc:=H _ H_take_iS i _;1:smt(size_take). rewrite!take_take !min_lel//= 1:/# nth_take 1,2:/#H_take_i=>[][]/=[->>->>] H_pm. -cut[]b' c' H_Pm:exists b' c', Pm.[(sa +^ nth witness p i, sc)] = Some (b',c') by smt(in_dom). +cut[]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/=. cut[]h_Pm _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. cut[]h' f' hy fy[]H_h'[]H_hy H_mh:=h_Pm _ _ _ _ H_Pm. @@ -1856,7 +1861,7 @@ case(Pm.[(b +^ nth witness p i, c)] = None)=>//=H_Pm. by cut/#:=H_Gmh _ _ _ _ H_mh1. cut[]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(get_oget in_dom). + (oget Pm.[(b +^ nth witness p i, c)]).`2;smt(domE). cut[]H_P_m H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. cut:=H_P_m _ _ _ _ H_Pm1. by cut[]/#:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. @@ -1873,7 +1878,7 @@ equiv PFf_Cf (D<:DISTINGUISHER): 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 dom C.queries{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}. @@ -1885,10 +1890,10 @@ proof. 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 dom_set in_fsetU1 in_dom;left;cut[]_->_ _ _//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0. - + smt(dom_set in_fsetU1). - + smt(dom_set in_fsetU1). - + smt(dom_set in_fsetU1). + + by rewrite mem_set domE;left;cut[]_->_ _ _//=:=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}) => @@ -1898,7 +1903,7 @@ proof. /\ ={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(in_dom 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}) => @@ -1907,15 +1912,15 @@ proof. 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 < prefixe p (get_max_prefixe p (elems (dom C.queries))). - splitwhile{2} 1 : i < prefixe p (get_max_prefixe p (elems (dom C.queries))). + 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} /\ - (prefixe p (get_max_prefixe p (elems (dom C.queries))) = i){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 dom Redo.prefixes){1} /\ + (take i p \in Redo.prefixes){1} /\ (C.queries.[[]] = Some b0){1} /\ - (! p{2} \in dom C.queries{2}) /\ + (! 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} @@ -1927,11 +1932,11 @@ proof. 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 <= prefixe p (get_max_prefixe p (elems (dom C.queries)))){2} /\ + (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 dom Redo.prefixes){1} /\ + (take i p \in Redo.prefixes){1} /\ (C.queries.[[]] = Some b0){1} /\ - (! p{2} \in dom C.queries{2}) /\ + (! 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} @@ -1942,24 +1947,24 @@ proof. 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(@Prefixe). - * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom). - * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom). - * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom set_eq). - * by cut[]:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom). + * smt(@Prefix). + * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 domE). + * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 domE). + * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0. + * by cut[]:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 domE). * by rewrite build_hpathP; apply/Empty=> //; exact/take0. - * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom size_take size_eq0). - * smt(prefixe_sizel). + * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 domE size_take size_eq0). + * smt(prefix_sizel). case(G1.bcol{2} \/ G1.bext{2}). - - by if{1};auto;conseq(:_==> (G1.bcol{2} \/ G1.bext{2}));1,3:smt(get_oget in_dom getP); + - 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} <= prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) /\ + 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 dom C.queries{2}) /\ - (take i{1} p{1} \in dom Redo.prefixes{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} @@ -1971,41 +1976,41 @@ proof. 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} < prefixe p{1} (get_max_prefixe p{1} (elems (dom C.queries{1})))) /\ + i{1} < prefix p{1} (get_max_prefix p{1} (elems (fdom C.queries{1})))) /\ i{2} < size p{2} /\ - i{2} < prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) /\ - ! (G1.bcol{2} \/ G1.bext{2}) /\ (take (i+1) p \in dom Redo.prefixes){1} /\ + 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. - - cut:=prefixe_gt0_mem p{2} (elems (dom C.queries{2})) _;1:rewrite/#. + - cut:=prefix_gt0_mem p{2} (elems (fdom C.queries{2})) _;1:rewrite/#. rewrite-memE=>H_dom_q. cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H12. cut[]_ _ h1 h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut:=h2 (get_max_prefixe p{2} (elems (dom C.queries{2}))) _;1:rewrite /#. + cut:=h2 (get_max_prefix p{2} (elems (fdom C.queries{2}))) _; 1:smt(mem_fdom). move=>[]c; - cut H_dom_p:get_max_prefixe p{2} (elems (dom C.queries{2})) \in dom Redo.prefixes{1} by smt(in_dom). - cut->/=:=prefixe_take_leq p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) (i{2}+1) _;1:rewrite/#. - smt(in_dom take_oversize prefixe_sizer). + cut H_dom_p:get_max_prefix p{2} (elems (fdom C.queries{2})) \in Redo.prefixes{1} by smt(domE mem_fdom). + cut->/=:=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. - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{hr} p{hr} sa{hr} sc{m} h{hr} HINV _ _ _ _. * by rewrite H0/=H7/=. - * smt(in_dom). + * smt(domE). * rewrite/#. * rewrite/#. - by move=>[]b2 c2 h2[]H_PFm H_Gmh;rewrite in_dom H_Gmh/=. + by move=>[]b2 c2 h2[]H_PFm H_Gmh;rewrite domE H_Gmh/=. auto;progress. - rewrite /#. - rewrite /#. - rewrite /#. - - smt(get_oget in_dom). + - smt(domE). - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO/#:=H6 H11. - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. * by rewrite H0/=H7/=. - * smt(in_dom). + * smt(domE). * rewrite/#. * rewrite/#. move=>[]b2 c2 h2[]H_PFm H_Gmh. @@ -2017,7 +2022,7 @@ proof. cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. * by rewrite H0/=H7/=. - * smt(in_dom). + * smt(domE). * rewrite/#. * rewrite/#. move=>[]b2 c2 h2[]H_PFm H_Gmh. @@ -2029,7 +2034,7 @@ proof. cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. * by rewrite H0/=H7/=. - * smt(in_dom). + * smt(domE). * rewrite/#. * rewrite/#. move=>[]b2 c2 h2[]H_PFm H_Gmh. @@ -2040,7 +2045,7 @@ proof. cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. * by rewrite H0/=H7/=. - * smt(in_dom). + * smt(domE). * rewrite/#. * rewrite/#. move=>[]b2 c2 h2[]H_PFm H_Gmh. @@ -2051,52 +2056,13 @@ proof. alias{1} 1 prefixes = Redo.prefixes;sp. alias{2} 1 bad1 = G1.bcol;sp. - (* 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} prefixes{1} *) - (* C.queries{2} /\ (! (bad1{2} \/ G1.bext{2})) /\ *) - (* Redo.prefixes{1}.[take i{2} p{2}] = Some (sa{1}, sc{1}) /\ *) - (* (forall l, l \in dom prefixes{1} => *) - (* prefixes{1}.[l] = Redo.prefixes{1}.[l]) /\ *) - (* (forall l, l \in dom Redo.prefixes{1} => *) - (* exists l2, l ++ l2 = take i{2} p{2} \/ l ++ l2 \in dom C.queries{2}) /\ *) - (* (forall l, l \in dom Redo.prefixes{1} => *) - (* l \in dom prefixes{1} \/ exists j, 0 <= j < i{2} /\ take j p{2} = l) /\ *) - (* (forall j, 0 <= j < i{1} => exists (sa : block) (sc : capacity), *) - (* Redo.prefixes{1}.[take j p{2}] = Some (sa, sc) /\ *) - (* PF.m{1}.[(sa +^ nth witness p{2} j, sc)] = *) - (* Redo.prefixes{1}.[take (j + 1) p{2}]) /\ *) - (* ={sa} /\ F.RO.m{2}.[p{2}] = Some sa{1}));progress. *) - (* + cut[]HINV[]H_bad1[]H_prefixe[]H_pref[]H_pref2[]H_pref3[]H_pref4[]->> H_m_R0:=H6 H7. *) - (* cut[]HINV'[]->>[]->>[]H_h[]H_path H_F_RO:=H3 H_bad1. *) - (* rewrite take_size;split;..-2:by case:HINV=>//=. *) - (* cut[]H01 H02 H_m_p1 H_m_p2 H_m_p3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ *) - (* HINV;split=>//=. *) - (* - cut[]H01' H02' H_m_p1' H_m_p2' H_m_p3':=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ *) - (* HINV'. *) - (* smt(in_dom). *) - (* - smt(in_dom getP). *) - (* - move=>l H_l_dom j Hj. *) - (* cut[]:=H_pref3 _ H_l_dom. *) - (* * move=>H_dom;cut:=H_m_p1 l H_dom j Hj;smt(in_dom take_oversize). *) - (* move=>[]k [][Hk0 Hk] <<-. *) - (* move:Hj;rewrite size_take 1:/# Hk/==>[][]Hj0 Hjk. *) - (* rewrite!take_take!min_lel// 1,2:/# nth_take 1,2:/#;smt(in_dom take_oversize). *) - (* - smt(dom_set in_fsetU1 getP dom_set in_dom take_size). *) - (* move=>l H_dom;cut:=H_pref3 l H_dom. *) - (* case(l \in dom Redo.prefixes{1})=>H_dom1/=;1:smt(dom_set in_fsetU1). *) - (* move=>[]j[][]Hj0 Hj_size <<-. *) - (* by exists (drop j p{2});rewrite cat_take_drop dom_set in_fsetU1. *) - (* + by rewrite/#. *) - (* + by rewrite/#. *) while ( ={i, p, C.queries, C.c} - /\ prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) <= + /\ 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 dom C.queries{2}) + /\ (! 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} @@ -2104,23 +2070,23 @@ proof. /\ ! (bad1{2} \/ G1.bext{2}) /\ m_p PF.m{1} prefixes{1} C.queries{2} /\ (forall (l : block list), - l \in dom prefixes{1} => prefixes{1}.[l] = Redo.prefixes{1}.[l]) - /\ (forall (l : block list), l \in dom Redo.prefixes{1} => - (l \in dom prefixes{1}) \/ + 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} - prefixe p{2} - (get_max_prefixe p{2} (elems (dom C.queries{2}))) + /\ 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 dom Redo.prefixes{1})));last first. + /\ (i{2} < size p{2} => ! take (i{2}+1) p{2} \in Redo.prefixes{1})));last first. + auto;progress. - - smt(prefixe_sizel). + - smt(prefix_sizel). - cut[]HINV _:=H3 H6;split;..-2:case:HINV=>//=. by cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV; - split=>//=;smt(take0 getP dom_set in_fsetU1 take_oversize take_le0). + split=>//=;smt(take0 get_setE mem_set take_oversize take_le0). - by cut[]HINV _:=H3 H6;cut:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - rewrite/#. - rewrite/#. @@ -2132,12 +2098,12 @@ proof. - rewrite/#. - cut[]HINV[]->>[]->>[]H_h[]H_path H_F_RO:=H3 H6. cut[]H01 H02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut H_pref_eq:=prefixe_exchange_prefixe_inv (elems (dom C.queries{2})) - (elems (dom Redo.prefixes{1})) p{2} _ _ _. - * smt(memE in_dom). - * smt(memE in_dom take_oversize size_take take_take nth_take take_le0). - * smt(memE in_dom take_oversize size_take take_take nth_take take_le0). - by rewrite memE prefixe_lt_size 1:-H_pref_eq /#. + cut 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/#. @@ -2146,138 +2112,140 @@ proof. 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 dom Redo.prefixes{1}) - /\ (G1.bcol{2} \/ G1.bext{2}));1:smt(prefixe_ge0). + /\ (take (i{1} + 1) p{1} \in Redo.prefixes{1}) + /\ (G1.bcol{2} \/ G1.bext{2}));1:smt(prefix_ge0). if{1};sp;2:if{1};(if{2};2:if{2});sp;auto;5:swap{2}4-3;auto; - smt(getP get_oget dom_set in_fsetU1 DBlock.dunifin_ll DCapacity.dunifin_ll). + 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. cut[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{hr} bs{m} sa{hr} sc{m} h{hr} HINV _ _ _. - - smt(prefixe_ge0). + - smt(prefix_ge0). - exact H1. - exact H_h. - by cut:=H7;rewrite !in_dom=>->/=/#. + by cut:=H7;rewrite !domE=>->/=/#. + progress. - rewrite/#. - rewrite/#. - - by rewrite getP. + - by rewrite get_setE. - cut[]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=>//=. cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV;split=>//=. - * smt(getP size_take size_eq0 size_ge0 prefixe_ge0). + * smt(get_setE size_take size_eq0 size_ge0 prefix_ge0). * by cut[]_ Hmp02' _ _ _:=H_m_p0; - smt(getP size_take size_eq0 size_ge0 prefixe_ge0 take0). - * move=>l;rewrite!dom_set !in_fsetU1. + 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(prefixe_ge0). + + move=>j;rewrite size_take;1:smt(prefix_ge0). cut->/=:(if i{2} + 1 < size bs{1} then i{2} + 1 else size bs{1}) = i{2} + 1 by rewrite/#. - move=>[]H0j HjiS;rewrite!getP. + move=>[]H0j HjiS;rewrite!get_setE. cut->/=:! take j (take (i{2} + 1) bs{1}) = take (i{2} + 1) bs{1} by smt(size_take). - rewrite!take_take!min_lel 1,2:/# nth_take 2:/#;1:smt(prefixe_ge0). + rewrite!take_take!min_lel 1,2:/# nth_take 2:/#;1:smt(prefix_ge0). case(j < i{2})=>Hij. - cut->/=:!take (j + 1) bs{1} = take (i{2} + 1) bs{1} by smt(size_take). by cut:=Hmp1(take i{2} bs{1}) _ j _; - smt(in_dom take_take nth_take prefixe_ge0 size_take). + smt(domE take_take nth_take prefix_ge0 size_take). cut->>:j = i{2} by rewrite/#. - by exists sa{2} sc{1};rewrite H1/=;smt(get_oget). - move=>h H_dom j []Hi0 Hisize;rewrite!getP. - cut->/=:!take j l = take (i{2} + 1) bs{1} by smt(in_dom take_oversize size_take take_take). + by exists sa{2} sc{1};rewrite H1/=;smt(). + move=>h H_dom j []Hi0 Hisize;rewrite!get_setE. + cut->/=:!take j l = take (i{2} + 1) bs{1} by smt(domE take_oversize size_take take_take). by cut->/=/#:!take (j+1) l = take (i{2} + 1) bs{1} - by smt(in_dom take_oversize size_take take_take). - * move=>l;rewrite dom_set in_fsetU1. + by smt(domE take_oversize size_take take_take). + * move=>l;rewrite mem_set. case(l = take (i{2} + 1) bs{1})=>//=[->>|]. - + by rewrite!getP/=oget_some/=/#. - move=>h H_dom;rewrite!getP h/=. + + by rewrite!get_setE/=oget_some/=/#. + move=>h H_dom;rewrite!get_setE h/=. cut[]H2mp01 H2mp02 H2mp1 H2mp2 H2mp3:=H_m_p0. - rewrite-Hp1;1:smt(in_dom). + rewrite-Hp1;1:smt(domE). by apply H2mp2. - move=>l;rewrite !dom_set !in_fsetU1. + move=>l;rewrite !mem_set. case(l = take (i{2} + 1) bs{1})=>//=[->>|]. - + by exists []; smt(cats0 dom_set in_fsetU1). - move=>H_neq H_dom;cut[]l1:=Hmp3 _ H_dom;rewrite!dom_set!in_fsetU1;case=>H_case. - + exists l1;by rewrite in_fsetU1 H_case. - exists (rcons l1 (nth witness bs{1} i{2}));rewrite in_fsetU1;right. search rcons (++). - by rewrite-rcons_cat (@take_nth witness);smt(prefixe_ge0). + + by exists []; smt(cats0 mem_set). + move=>H_neq H_dom;cut[]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(in_dom getP). - - move:H9;rewrite dom_set in_fsetU1;case;smt(prefixe_ge0). + - smt(domE get_setE). + - move:H9;rewrite mem_set;case;smt(prefix_ge0). - cut[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. - - smt(prefixe_ge0). + - smt(prefix_ge0). - exact H1. - exact H_h. - by cut:=H7;rewrite !in_dom=>->/=/#. + by cut:=H7;rewrite !domE=>->/=/#. - rewrite/#. - cut[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. - - smt(prefixe_ge0). + - smt(prefix_ge0). - exact H1. - exact H_h. - cut:=H7;rewrite !in_dom=>->/=[]b4 c4 h4[]H_PFm H_Gmh;rewrite H_PFm H_Gmh !oget_some/=. + cut:=H7;rewrite !domE=>->/=[]b4 c4 h4[]H_PFm H_Gmh;rewrite H_PFm H_Gmh !oget_some/=. cut[]_ help:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut:=help _ _ _ _ H_Gmh. by cut[]f H_h':=H_h;rewrite H_h'/==>[][]a b c d[][]->>->>[];rewrite H_PFm/==>[]h'->>/#. - cut[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. - - smt(prefixe_ge0). + - smt(prefix_ge0). - exact H1. - exact H_h. - cut:=H7;rewrite !in_dom=>->/=[]b4 c4 h4[]H_PFm H_Gmh. - rewrite (@take_nth witness);1:smt(prefixe_ge0). - by rewrite build_hpath_prefix H_path/=;smt(get_oget in_dom). - - smt(prefixe_ge0). - - smt(prefixe_ge0). + cut:=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). - cut[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. - - smt(prefixe_ge0). + - smt(prefix_ge0). - exact H1. - exact H_h. - cut:=H7;rewrite !in_dom=>->/=[]b4 c4 h4[]H_PFm H_Gmh. - rewrite(@take_nth witness);1:smt(prefixe_ge0). + cut:=H7;rewrite !domE=>->/=[]b4 c4 h4[]H_PFm H_Gmh. + rewrite(@take_nth witness);1:smt(prefix_ge0). cut[]_ help H_uniq_path:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - by rewrite help H_path;smt(get_oget in_dom). + by rewrite help H_path;smt(domE). - cut[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. - rewrite dom_set in_fsetU1 negb_or/=;split;2:smt(size_take prefixe_ge0 take_oversize). + rewrite mem_set negb_or/=;split;2:smt(size_take prefix_ge0 take_oversize). cut:=Hp2 (take (i{2} + 1 + 1) bs{1}). pose P:= _ \/ _;cut/#:!P;rewrite/P;clear P;rewrite negb_or/=negb_exists/=;split. - * cut:=prefixe_exchange_prefixe_inv(elems (dom C.queries{2}))(elems (dom prefixes{1}))bs{1} _ _ _. - + by cut[]:=H_m_p0;smt(in_dom memE). + * cut:=prefix_exchange_prefix_inv(elems (fdom C.queries{2}))(elems (fdom prefixes{1}))bs{1} _ _ _. + + by cut[]:=H_m_p0;smt(domE memE mem_fdom). + cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=H_m_p0. - by cut:=all_prefixes_of_m_p _ _ _ H_m_p0;smt(memE in_dom). - + by cut[]:=H_m_p0;smt(memE in_dom). - by move=>H_pref_eq;rewrite memE prefixe_lt_size//= -H_pref_eq/#. - by move=>j;case(0<=j<=i{2})=>//=[][]Hj0 Hji;smt(size_take prefixe_ge0 take_le0). + by cut:=all_prefixes_of_m_p _ _ _ H_m_p0;smt(memE domE mem_fdom). + + by cut[]:=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. cut[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{hr} bs{m} sa{hr} sc{m} h{hr} HINV _ _ _. - - smt(prefixe_ge0). + - smt(prefix_ge0). - exact H1. - exact H_h. - by cut:=H7;rewrite !in_dom=>/=->/=. + by cut:=H7;rewrite !domE=>/=->/=. rcondt{2}1;1:auto=>/#. rcondt{2}5;auto;progress. - * rewrite(@take_nth witness);1:smt(prefixe_ge0);rewrite in_dom. + * rewrite(@take_nth witness);1:smt(prefix_ge0);rewrite domE. cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_i:=H3 H6. cut[]:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{hr} bs{m} sa{hr} sc{m} h{hr} HINV _ _ _. - * smt(prefixe_ge0). + * smt(prefix_ge0). * rewrite/#. * rewrite/#. - cut:=H7;rewrite in_dom =>/=->/=H_Gmh _ H_ H_path_uniq. + cut:=H7;rewrite domE =>/=->/=H_Gmh _ H_ H_path_uniq. cut help:=H_ (take i{hr} bs{m}) (nth witness bs{m} i{hr});rewrite H_path/= in help. cut: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. - by cut:=get_oget F.RO.m{hr} (rcons (take i{hr} bs{m}) (nth witness bs{m} i{hr}));rewrite in_dom H_F_Ro/=help=>[]/#. + 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!getP/=. + * by rewrite!get_setE/=. * cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. cut:=H12;rewrite !negb_or/==>[][][]bad1 hinv_none bad2. cut H_hs_spec:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. @@ -2286,19 +2254,19 @@ proof. cut H_mi_mhi:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut H_pi_spec:=pi_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut :=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. - * smt(prefixe_ge0). + * smt(prefix_ge0). * exact H1. * rewrite/#. - cut:=H7;rewrite in_dom/==>->/=h_g1. + cut:=H7;rewrite domE/==>->/=h_g1. cut 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. - cut[]h:=H_pi_spec;cut:=h c p0 v;rewrite H13/==>[][]h1[] h'1 h'2. - exists h1;rewrite -h'2 getP/=. + exists h1;rewrite -h'2 get_setE/=. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h'2. by apply build_hpath_up=>//=. - move:H14;rewrite getP/==>hh0. + move:H14;rewrite get_setE/==>hh0. cut h0_neq_ch:h0 <> G1.chandle{2} by rewrite/#. cut[]->:=H_pi_spec;rewrite-hh0 h0_neq_ch/=;exists h0=>/=. cut:=H;cut:=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. @@ -2310,38 +2278,38 @@ proof. by cut:=hinvP FRO.m{2} y2L;rewrite hinv_none/=/#. + by cut:=invG_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + apply inv_addm=>//;1:cut//:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - apply (notin_hs_notin_dom2_mh FRO.m{2} PF.mi{1})=>//=. - by apply ch_notin_dom_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + apply (notin_hs_notdomE2_mh FRO.m{2} PF.mi{1})=>//=. + by apply ch_notdomE_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - rewrite!getP/=oget_some. + rewrite!get_setE/=oget_some. apply (m_mh_addh_addm _ H_m_mh H_huniq H_h _)=>//=. - by apply ch_notin_dom_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by apply ch_notdomE_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - rewrite!getP/=oget_some;apply (mi_mhi_addh_addmi _ H_mi_mhi _ H_h _)=>//=. + rewrite!get_setE/=oget_some;apply (mi_mhi_addh_addmi _ H_mi_mhi _ H_h _)=>//=. - smt(hinvP). - by apply ch_notin_dom_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by apply ch_notdomE_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + apply incl_upd_nin=>//=. by cut:=incl_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + apply incl_upd_nin=>//=. - by cut:=incli_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut:=hinvP FRO.m{2} y2L;rewrite in_dom hinv_none/=;apply absurd=>H_P_mi. + cut:=hinvP FRO.m{2} y2L;rewrite domE hinv_none/=;apply absurd=>H_P_mi. rewrite negb_forall/=. cut H_inv_Gmh:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]H_inv_Pm:=inv_mh_inv_Pm _ _ _ _ _ H_m_mh H_mi_mhi H_inv_Gmh. cut[]H_Pmi H_Gmhi:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. by cut[]/#:=H_Pmi y1L y2L (oget PF.mi{1}.[(y1L, y2L)]).`1 - (oget PF.mi{1}.[(y1L, y2L)]).`2 _;1:smt(get_oget in_dom). - + cut H_take_Si:=take_nth witness i{2} bs{1} _;1:smt(prefixe_ge0). + (oget PF.mi{1}.[(y1L, y2L)]).`2 _;1:smt(domE). + + cut H_take_Si:=take_nth witness i{2} bs{1} _;1:smt(prefix_ge0). split=>//=. - - move=>x hx y hy;rewrite !getP. + - move=>x hx y hy;rewrite !get_setE. case((x, hx) = (sa{2} +^ nth witness bs{1} i{2}, h{2}))=>//=. * move=>[->> ->>][<<- <<-]/=. cut->/=:=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 getP Block.WRing.addKr/=. - rewrite oget_some/=(@take_nth witness)/=;1:smt(prefixe_ge0). - by apply build_hpath_up=>//=;smt(in_dom). + exists (take i{2} bs{1}) (sa{2})=>//=;rewrite get_setE Block.WRing.addKr/=. + rewrite oget_some/=(@take_nth witness)/=;1:smt(prefix_ge0). + by apply build_hpath_up=>//=;smt(domE). move=> neq h1. cut[]hh1 hh2 hh3:=H_mh_spec. cut[]xc hxx yc hyc []h2[]h3 h4:=hh1 _ _ _ _ h1. @@ -2349,26 +2317,24 @@ proof. cut->/=:=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 getP. + exists p0 b;rewrite get_setE. cut->/=:=build_hpath_up _ _ _ y1L G1.chandle{2} _ _ _ hb h_g1. cut/#:!rcons p0 (b +^ x) = rcons (take i{2} bs{1}) (nth witness bs{1} i{2});move:neq;apply absurd=>//=h'. cut<<-:take i{2} bs{1}=p0 by rewrite/#. cut hbex:b +^ x = nth witness bs{1} i{2} by rewrite/#. by cut:=hb;rewrite H_path/==>[][->>->>]/=;rewrite-hbex Block.WRing.addKr/=. - progress. - * move:H13;rewrite getP/=H_take_Si/=. - case(p0 = (take i{2} bs{1}))=>[->>|hpp0];rewrite!getP/=!oget_some/=. + * move:H13;rewrite get_setE/=H_take_Si/=. + case(p0 = (take i{2} bs{1}))=>[->>|hpp0];rewrite!get_setE/=!oget_some/=. + cut->/=:=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 getP/=. + - by exists sa{2} h{2} G1.chandle{2}=>//=;rewrite get_setE/=. cut->/=:!rcons (take i{2} bs{1}) bn = rcons (take i{2} bs{1}) (nth witness bs{1} i{2}). - move:hbni;apply absurd=>//=h. - cut->:bn = nth witness (rcons (take i{2} bs{1}) bn) i{2}. - * by rewrite nth_rcons size_take;smt(prefixe_ge0). - by rewrite h nth_rcons size_take;smt(prefixe_ge0). + exact/(rconsIs _ _ h). move=>h_ro_p_bn. cut[]_ hh4 _:=H_mh_spec. - by cut:=hh4 (take i{2} bs{1}) bn b0;rewrite h_ro_p_bn/=H_path/=;smt(getP @Block.WRing). + by cut:=hh4 (take i{2} bs{1}) bn b0;rewrite h_ro_p_bn/=H_path/=;smt(get_setE @Block.WRing). cut->/=:!rcons p0 bn = rcons (take i{2} bs{1}) (nth witness bs{1} i{2}). + move:hpp0;apply absurd=>/=h. cut:size p0 = size (take i{2} bs{1}) by smt(size_rcons). @@ -2378,9 +2344,9 @@ proof. cut[]_ hh4 _:=H_mh_spec. cut:=hh4 p0 bn b0;rewrite h_ro_p_bn/==>[][];progress. cut help:(sa{2} +^ nth witness bs{1} i{2}, h{2}) <> (v +^ bn, hx) by rewrite/#. - exists v hx hy=>//=;rewrite getP;rewrite eq_sym in help;rewrite help/=H14/=. + exists v hx hy=>//=;rewrite get_setE;rewrite eq_sym in help;rewrite help/=H14/=. by apply build_hpath_up=>//=. - move:H13 H14;rewrite!getP/=!oget_some/==>h_build_hpath_set. + move:H13 H14;rewrite!get_setE/=!oget_some/==>h_build_hpath_set. case(hy = G1.chandle{2})=>//=[->>|hy_neq_ch]/=. + move=>h;cut h_eq:v +^ bn = sa{2} +^ nth witness bs{1} i{2} && hx = h{2}. + cut/#:G1.mh{2}.[(v +^ bn, hx)] <> Some (b0, G1.chandle{2}). @@ -2398,7 +2364,7 @@ proof. F.RO.m{2}.[rcons p0 bn] = Some b0. move:H_h;case:f=>h_flag;last first. - cut:=known_path_uniq _ _ _ sc{1} h{2} p0 v (take i{2} bs{1}) sa{2} H2_pi_spec _ h_build_hpath_set _. - * rewrite getP/=h_flag. + * rewrite get_setE/=h_flag. by cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. * by apply build_hpath_up=>//=. move=>[]->>->>/=;apply absurd=>//=_. @@ -2425,85 +2391,88 @@ proof. progress. + cut:=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. cut:=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:H13 H14;rewrite!getP/=!oget_some/==>H13 H14;rewrite H13 H14. + move:H13 H14;rewrite!get_setE/=!oget_some/==>H13 H14;rewrite H13 H14. cut->/=:=ch_neq0 _ _ H_hs_spec. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). cut:=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. cut:=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:H13 H14;rewrite!getP/=!oget_some/==>H13 H14;rewrite H13 H14/=. + move:H13 H14;rewrite!get_setE/=!oget_some/==>H13 H14;rewrite H13 H14/=. cut->/=:=ch_neq0 _ _ H_hs_spec. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). - + rewrite!getP/=oget_some;exact H2_pi_spec. - + rewrite!getP/=!oget_some/=. + + rewrite!get_setE/=oget_some;exact H2_pi_spec. + + rewrite!get_setE/=!oget_some/=. cut H_m_p:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut H_all_prefixes:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. split;case:H_m_p=>//=Hmp01 Hmp02 Hmp1 Hmp2 Hmp3. - - smt(getP size_take prefixe_ge0). - - by cut[]:=H_m_p0;smt(getP size_take prefixe_ge0). - - move=>l;rewrite dom_set in_fsetU1;case=>H_case j []Hj0. - * move=>Hjsize;rewrite!getP/=. + - smt(get_setE size_take prefix_ge0). + - by cut[]:=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/=. cut->/=:!take j l = take (i{2} + 1) bs{1} by rewrite/#. cut->/=:!take (j+1) l = take (i{2} + 1) bs{1} by rewrite/#. - smt(in_dom getP). - cut->>:=H_case;rewrite size_take;1:smt(prefixe_ge0). + smt(domE get_setE). + cut->>:=H_case;rewrite size_take;1:smt(prefix_ge0). cut->/=:(if i{2} + 1 < size bs{1} then i{2} + 1 else size bs{1}) = i{2} + 1 by rewrite/#. - move=>HjiS;rewrite!getP. + move=>HjiS;rewrite!get_setE. cut->/=:! take j (take (i{2} + 1) bs{1}) = take (i{2} + 1) bs{1} by smt(size_take). - rewrite!take_take!min_lel 1,2:/# nth_take 2:/#;1:smt(prefixe_ge0). + rewrite!take_take!min_lel 1,2:/# nth_take 2:/#;1:smt(prefix_ge0). case(j < i{2})=>Hij. - cut->/=:!take (j + 1) bs{1} = take (i{2} + 1) bs{1} by smt(size_take). - by cut:=Hmp1(take i{2} bs{1}) _ j _;smt(in_dom take_take nth_take prefixe_ge0 size_take getP). + by cut:=Hmp1(take i{2} bs{1}) _ j _;smt(domE take_take nth_take prefix_ge0 size_take get_setE). cut->>:j = i{2} by rewrite/#. - by exists sa{2} sc{1};rewrite H1/=;smt(get_oget getP in_dom). - - move=>l;rewrite dom_set in_fsetU1. + 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!getP/=oget_some/=/#. - move=>h H_dom;rewrite!getP h/=. + + by rewrite!get_setE/=oget_some/=/#. + move=>h H_dom;rewrite!get_setE h/=. cut[]H2mp01 H2mp02 H2mp1 H2mp2 H2mp3:=H_m_p0. - rewrite-Hp1;1:smt(in_dom). + rewrite-Hp1;1:smt(domE). by apply H2mp2. - move=>l;rewrite !dom_set !in_fsetU1. + move=>l;rewrite !mem_set. case(l = take (i{2} + 1) bs{1})=>//=[->>|]. - + by exists []; smt(cats0 dom_set in_fsetU1). - move=>H_neq H_dom;cut[]l1:=Hmp3 _ H_dom;rewrite!dom_set!in_fsetU1;case=>H_case. - + exists l1;by rewrite in_fsetU1 H_case. - exists (rcons l1 (nth witness bs{1} i{2}));rewrite in_fsetU1;right. - by rewrite-rcons_cat (@take_nth witness);smt(prefixe_ge0). + + by exists []; smt(cats0 mem_set). + move=>H_neq H_dom;cut[]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/#. * cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. - by split;cut[]//=:=H_m_p0;smt(getP in_dom take_take take_nth size_take - prefixe_ge0 nth_take take_oversize take_le0). - + rewrite!getP/=oget_some;smt(in_dom). - + smt(getP in_dom take_take size_take prefixe_ge0 nth_take take_oversize take_le0). - + rewrite!getP/=oget_some;smt(in_dom). + split;cut[]//=:=H_m_p0; 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/=oget_some;smt(domE). + + smt(get_setE domE take_take size_take prefix_ge0 nth_take take_oversize take_le0). + + rewrite!get_setE/=oget_some;smt(domE). + rewrite/#. - + by rewrite!getP/=oget_some/#. - + rewrite!getP/=oget_some(@take_nth witness);1:smt(prefixe_ge0);rewrite build_hpath_prefix. + + by rewrite!get_setE/=oget_some/#. + + rewrite!get_setE/=oget_some(@take_nth witness);1:smt(prefix_ge0);rewrite build_hpath_prefix. cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. - - smt(prefixe_ge0). + - smt(prefix_ge0). - exact H1. - rewrite/#. - cut:=H7;rewrite in_dom=>/=->/=H_Gmh. - cut->/=:=build_hpath_up_None _ _ (y1L, G1.chandle{2})_ _ H_Gmh H_path;smt(getP). - + smt(prefixe_ge0). - + smt(prefixe_ge0). - + by rewrite!getP/=oget_some. - rewrite!dom_set!in_fsetU1 negb_or/=;split;2:smt(prefixe_ge0 size_take prefixe_ge0 take_oversize). + cut:=H7;rewrite domE=>/=->/=H_Gmh. + cut->/=:=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/=oget_some. + rewrite!mem_set negb_or/=;split;2:smt(prefix_ge0 size_take prefix_ge0 take_oversize). cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. cut:=Hp2 (take (i{2} + 1 + 1) bs{1}). pose P:= _ \/ _;cut/#:!P;rewrite/P;clear P;rewrite negb_or/=negb_exists/=;split. - * cut:=prefixe_exchange_prefixe_inv(elems (dom C.queries{2}))(elems (dom prefixes{1}))bs{1} _ _ _. - + by cut[]:=H_m_p0;smt(in_dom memE). + * cut:=prefix_exchange_prefix_inv(elems (fdom C.queries{2}))(elems (fdom prefixes{1}))bs{1} _ _ _. + + by cut[]:=H_m_p0;smt(domE memE mem_fdom). + cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=H_m_p0. - by cut:=all_prefixes_of_m_p _ _ _ H_m_p0;smt(memE in_dom). - + by cut[]:=H_m_p0;smt(memE in_dom). - by move=>H_pref_eq;rewrite memE prefixe_lt_size//= -H_pref_eq/#. - by move=>j;case(0<=j<=i{2})=>//=[][]Hj0 Hji;smt(size_take prefixe_ge0 take_le0). + cut:=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 cut[]:=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. @@ -2523,7 +2492,7 @@ section AUX. 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 dom C.queries{2}). + [] \in C.queries{2}). (* lossless D *) + exact/D_ll. (** proofs for G1.S.f *) @@ -2545,7 +2514,7 @@ section AUX. F.RO.m{2} G1.paths{2} Redo.prefixes{1} C.queries{2}). + by move=> &1 &2; rewrite negb_or. - + progress;cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(in_dom). + + progress;cut[]:=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 @@ -2577,7 +2546,7 @@ section AUX. smt (size_ge0). (* lossless and do not reset bad G1.C.f *) + move=> _; proc; inline *; wp;sp;if;auto;sp;if;auto;sp. - conseq(:_==> (G1.bcol \/ G1.bext));1:smt(@DBlock @DCapacity dom_set in_fsetU1). + conseq(:_==> (G1.bcol \/ G1.bext));1:smt(@DBlock @DCapacity mem_set). while (G1.bcol \/ G1.bext) (size p - i)=> [z|]. + if; 1:by auto=> /#. if;2:auto=>/#;wp; rnd predT; wp; rnd predT; auto. @@ -2586,24 +2555,24 @@ section AUX. (* Init ok *) inline *; auto=> />; split=> [|/#]. do !split. - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + by move=>l;rewrite dom_set in_fsetU1 dom0 in_fset0/==>->>/=/#. - + by move=>l;rewrite dom_set in_fsetU1 dom0 in_fset0/=!getP/==>->>/=/#. - + by move=>l;rewrite dom_set in_fsetU1 dom0 in_fset0/=/==>->>/=;exists[];rewrite dom_set in_fsetU1//=. + + 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. @@ -2620,7 +2589,7 @@ section. lemma Real_G1 &m: Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= Pr[G1(DRestr(D)).main() @ &m: res] - + (max_size ^ 2)%r * inv 2%r * mu dstate (pred1 witness) + + (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. From e507023bf991f2847c1bf667565e6c2067f43849 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Mon, 17 Sep 2018 19:33:11 +0200 Subject: [PATCH 301/394] push Gcol : beginning --- sha3/proof/smart_counter/Gcol.eca | 111 +++++++++++++++--------------- 1 file changed, 57 insertions(+), 54 deletions(-) diff --git a/sha3/proof/smart_counter/Gcol.eca b/sha3/proof/smart_counter/Gcol.eca index 1af352a..b0d6e4f 100644 --- a/sha3/proof/smart_counter/Gcol.eca +++ b/sha3/proof/smart_counter/Gcol.eca @@ -1,6 +1,6 @@ pragma -oldip. require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. -require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. +require import List FSet SmtMap Common SLCommon PROM FelTactic Mu_mem. require import DProd Dexcepted. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. @@ -36,10 +36,10 @@ section PROOF. proc sample_c () = { var c=c0; - if (card (image fst (rng FRO.m)) <= 2*max_size /\ + if (card (image fst (frng FRO.m)) <= 2*max_size /\ count < max_size) { c <$ cdistr; - G1.bcol <- G1.bcol \/ mem (image fst (rng FRO.m)) c; + G1.bcol <- G1.bcol \/ mem (image fst (frng FRO.m)) c; count <- count + 1; } @@ -53,10 +53,10 @@ section PROOF. var h, i, counter <- 0; sa <- b0; while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + 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 - prefixe p (get_max_prefixe p (elems (dom C.queries)))) { + 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; @@ -80,14 +80,14 @@ section PROOF. proc f(x : state): state = { var p, v, y, y1, y2, hy2, hx2; - if (!mem (dom G1.m) x) { + if (x \notin G1.m) { y <- (b0,c0); - if (!(mem (rng FRO.m) (x.`2, Known))) { + 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 (mem (dom G1.paths) 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(); @@ -96,7 +96,7 @@ section PROOF. y2 <@ sample_c(); } y <- (y1,y2); - if (mem (dom G1.mh) (x.`1, hx2) /\ + 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); @@ -112,7 +112,7 @@ section PROOF. G1.mi.[y] <- x; G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); } - if (mem (dom G1.paths) x.`2) { + if (x.`2 \in G1.paths) { (p,v) <- oget G1.paths.[x.`2]; G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); } @@ -125,9 +125,9 @@ section PROOF. proc fi(x : state): state = { var y, y1, y2, hx2, hy2; - if (!mem (dom G1.mi) x) { + if (x \notin G1.mi) { y <- (b0,c0); - if (!(mem (rng FRO.m) (x.`2, Known))) { + if (!(rng FRO.m (x.`2, Known))) { FRO.m.[G1.chandle] <- (x.`2, Known); G1.chandle <- G1.chandle + 1; } @@ -135,7 +135,7 @@ section PROOF. y1 <$ bdistr; y2 <@ sample_c(); y <- (y1,y2); - if (mem (dom G1.mhi) (x.`1, hx2) /\ + 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); @@ -162,15 +162,15 @@ section PROOF. proc main(): bool = { var b; - F.RO.m <- map0; - G1.m <- map0; - G1.mi <- map0; - G1.mh <- map0; - G1.mhi <- map0; + F.RO.m <- empty; + G1.m <- empty; + G1.mi <- empty; + G1.mh <- empty; + G1.mhi <- empty; G1.bcol <- false; - FRO.m <- map0.[0 <- (c0, Known)]; - G1.paths <- map0.[c0 <- ([<:block>],b0)]; + FRO.m <- empty.[0 <- (c0, Known)]; + G1.paths <- empty.[c0 <- ([<:block>],b0)]; G1.chandle <- 1; count <- 0; b <@ DRestr(D,M,S).distinguish(); @@ -178,20 +178,22 @@ section PROOF. } }. - lemma card_rng_set (m:('a,'b)fmap) x y: card(rng m.[x<-y]) <= card(rng m) + 1. - proof. - rewrite rng_set fcardU fcard1. - cut := subset_leq_fcard (rng (rem x m)) (rng m) _;2:smt ml=0 w=fcard_ge0. - rewrite subsetP=> z;apply rng_rem_le. + 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 (rng handles)) c. + 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 in_rng;exists (oget (Some h)). + by rewrite mem_frng rngE /=; exists (oget (Some h)). qed. local lemma Pr_col &m : @@ -200,14 +202,14 @@ section PROOF. proof. fel 10 Gcol.count (fun x=> (2*max_size)%r / (2^c)%r) max_size G1.bcol - [Gcol.sample_c : (card (image fst (rng FRO.m)) <= 2*max_size /\ Gcol.count < max_size)]=>//;2:by auto. + [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 (rng FRO.m)));skip;progress;2:smt ml=0. - cut->:=(Mu_mem.mu_mem (image fst (rng FRO.m{hr})) cdistr (1%r/(2^c)%r) _). + rnd (mem (image fst (frng FRO.m)));skip;progress;2:smt ml=0. + cut->:=(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. @@ -221,48 +223,49 @@ section 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 (rng FRO.m) <= 2*C.c + 1 /\ + (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 (rng FRO.m{2}) <= 2 * C.c{2} + 1 + /\ 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 (rng FRO.m{2}) <= 2 * C.c{2} + /\ card (frng FRO.m{2}) <= 2 * C.c{2} /\ Gcol.count{2} + 1 <= C.c{2} <= max_size);1: by if;auto;smt(card_rng_set). if;1:auto. - inline Gcol.sample_c;rcondt{2}4. * auto;inline*;auto;progress. - + by cut/#:=fcard_image_leq (fun (p : capacity * flag) => p.`1) (rng FRO.m{hr}). + + by cut/#:=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 (rng FRO.m{2}) <= 2 * C.c{2} + /\ card (frng FRO.m{2}) <= 2 * C.c{2} /\ Gcol.count{2} + 1 <= C.c{2} <= max_size - /\ (x0{1}.`2 \in dom G1.paths{1}) + /\ (x0{1}.`2 \in G1.paths{1}) /\ y2{1} = c{2});1: by inline*;auto. sp 1 4;if;auto;progress. + by cut->:=(H H6). + smt(card_rng_set). + case:H5=>/=[h|H_hinv];1: by cut->:=H h. - by cut:=hinvP FRO.m{2} c{2};rewrite H_hinv/=imageP/==>[][]f H_f;smt(in_rng). + cut:=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 cut/#:=fcard_image_leq (fun (p : capacity * flag) => p.`1) (rng FRO.m{hr}). + + by cut/#:=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 (rng FRO.m{2}) <= 2 * C.c{2} + /\ card (frng FRO.m{2}) <= 2 * C.c{2} /\ Gcol.count{2} + 1 <= C.c{2} <= max_size - /\ ! (x0{1}.`2 \in dom G1.paths{1}) + /\ ! (x0{1}.`2 \in G1.paths{1}) /\ y2{1} = c{2});1: by auto. sp 1 4;if;auto;progress. + by cut->:=(H H6). @@ -282,14 +285,14 @@ section PROOF. 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 (rng FRO.m) + 1 <= 2 * C.c + 1 /\ + (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 (rng FRO.m) + 1 <= 2 * C.c + 1 /\ + (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. @@ -304,33 +307,33 @@ section PROOF. 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} - - prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{1})))) /\ - card (rng FRO.m{2}) <= 2 * (C.c{2} + counter{2}) + 1 /\ + prefix p{2} (get_max_prefix p{2} (elems (dom C.queries{1})))) /\ + card (frng FRO.m{2}) <= 2 * (C.c{2} + counter{2}) + 1 /\ Gcol.count{2} + size p{2} - - prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{1}))) + prefix p{2} (get_max_prefix p{2} (elems (dom C.queries{1}))) - counter{2} <= C.c{2} + size p{2} - - prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{1}))) + prefix p{2} (get_max_prefix p{2} (elems (dom C.queries{1}))) <= max_size); - last by inline*;auto;smt(size_ge0 prefixe_sizel). + 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} - - prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{1})))) /\ - card (rng FRO.m{2}) <= 2 * (C.c{2} + counter{2}) + 1 /\ + prefix p{2} (get_max_prefix p{2} (elems (dom C.queries{1})))) /\ + card (frng FRO.m{2}) <= 2 * (C.c{2} + counter{2}) + 1 /\ Gcol.count{2} + size p{2} - - prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{1}))) + prefix p{2} (get_max_prefix p{2} (elems (dom C.queries{1}))) - counter{2} <= C.c{2} + size p{2} - - prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{1}))) - <= max_size);last by auto;smt(size_ge0 prefixe_sizel prefixe_ge0). + prefix p{2} (get_max_prefix p{2} (elems (dom C.queries{1}))) + <= max_size);last 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 prefixe_sizel). + 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 (rng FRO.m{hr})))=>/#. - smt(size_ge0 prefixe_sizel). + smt(size_ge0 prefix_sizel). auto;smt ml=0 w=(hinv_image card_rng_set). auto;progress;3:by smt ml=0. + by rewrite rng_set rem0 rng0 fset0U fcard1. From 62e0d7ba02d4e8464e5e6e84ac6af315e5664fe5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 17 Sep 2018 21:31:24 +0100 Subject: [PATCH 302/394] Gcol: finish --- sha3/proof/smart_counter/Gcol.eca | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/sha3/proof/smart_counter/Gcol.eca b/sha3/proof/smart_counter/Gcol.eca index b0d6e4f..5fa1634 100644 --- a/sha3/proof/smart_counter/Gcol.eca +++ b/sha3/proof/smart_counter/Gcol.eca @@ -271,7 +271,9 @@ section PROOF. + by cut->:=(H H6). + smt(card_rng_set). + case:H5=>/=[h|H_hinv];1: by cut->:=H h. - by cut:=hinvP FRO.m{2} c{2};rewrite H_hinv/=imageP/==>[][]f H_f;smt(in_rng). + cut:= 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=>//. @@ -279,7 +281,7 @@ section PROOF. 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(rng FRO.m) + 2 <= 2*C.c + 1 /\ + (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, @@ -296,7 +298,7 @@ section PROOF. 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;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). + + by auto;progress;cut /#:= fcard_image_leq fst (frng FRO.m{hr}). (* BUG: auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | H]. marche pas ???? *) auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | X];right;apply hinv_image=> //. @@ -307,12 +309,12 @@ section PROOF. 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 (dom C.queries{1})))) /\ + 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 (dom C.queries{1}))) + 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 (dom C.queries{1}))) + 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 @@ -320,23 +322,24 @@ section PROOF. 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 (dom C.queries{1})))) /\ + 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 (dom C.queries{1}))) + 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 (dom C.queries{1}))) + prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{1}))) <= max_size);last 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 (rng FRO.m{hr})))=>/#. + - 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. - + by rewrite rng_set rem0 rng0 fset0U fcard1. + + rewrite -(add0z 1) -{2}fcards0<:capacity*flag> -(frng0<:int,_>). + exact/card_rng_set/max_ge0. by apply max_ge0. qed. From 6a2e80c561cbc8821fc04b29d9092574ed35a0b2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 18 Sep 2018 13:02:36 +0200 Subject: [PATCH 303/394] push Gext --- sha3/proof/smart_counter/Gext.eca | 321 ++++++++++++++++-------------- 1 file changed, 170 insertions(+), 151 deletions(-) diff --git a/sha3/proof/smart_counter/Gext.eca b/sha3/proof/smart_counter/Gext.eca index 88f2077..fbdec43 100644 --- a/sha3/proof/smart_counter/Gext.eca +++ b/sha3/proof/smart_counter/Gext.eca @@ -1,6 +1,6 @@ pragma -oldip. require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. -require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. +require import List FSet SmtMap Common SLCommon PROM FelTactic Mu_mem. require import DProd Dexcepted. (*...*) import Capacity IntOrder Bigreal RealOrder BRA DCapacity. @@ -9,8 +9,8 @@ require (*..*) Gcol. clone export Gcol as Gcol0. op bad_ext (m mi:smap) y = - mem (image snd (dom m)) y \/ - mem (image snd (dom mi)) 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. @@ -24,10 +24,10 @@ module G2(D:DISTINGUISHER,HS:FRO) = { var h, i, counter <- 0; sa <- b0; while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + 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 - prefixe p (get_max_prefixe p (elems (dom C.queries)))) { + 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; @@ -50,8 +50,8 @@ module G2(D:DISTINGUISHER,HS:FRO) = { proc f(x : state): state = { var p, v, y, y1, y2, hy2, hx2, handles_,t; - if (!mem (dom G1.m) x) { - if (mem (dom G1.paths) x.`2) { + 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; @@ -62,14 +62,14 @@ module G2(D:DISTINGUISHER,HS:FRO) = { y <- (y1, y2); handles_ <@ HS.restrK(); - if (!mem (rng handles_) x.`2) { + if (!rng handles_ x.`2) { HS.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } handles_ <- HS.restrK(); hx2 <- oget (hinvc handles_ x.`2); t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); - if (mem (dom G1.mh) (x.`1, hx2) /\ t) { + 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; @@ -85,7 +85,7 @@ module G2(D:DISTINGUISHER,HS:FRO) = { G1.mi.[y] <- x; G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); } - if (mem (dom G1.paths) x.`2) { + if (x.`2 \in G1.paths) { (p,v) <- oget G1.paths.[x.`2]; G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); } @@ -98,9 +98,9 @@ module G2(D:DISTINGUISHER,HS:FRO) = { proc fi(x : state): state = { var y, y1, y2, hx2, hy2, handles_, t; - if (!mem (dom G1.mi) x) { + if (x \notin G1.mi) { handles_ <@ HS.restrK(); - if (!mem (rng handles_) x.`2) { + if (!rng handles_ x.`2) { HS.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } @@ -110,7 +110,7 @@ module G2(D:DISTINGUISHER,HS:FRO) = { y2 <$ cdistr; y <- (y1,y2); t <@ HS.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); - if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { + if ((x.`1, hx2) \in G1.mhi /\ t) { (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; y2 <@ HS.get(hy2); y <- (y.`1, y2); @@ -137,16 +137,16 @@ module G2(D:DISTINGUISHER,HS:FRO) = { proc distinguish(): bool = { var b; - F.RO.m <- map0; - G1.m <- map0; - G1.mi <- map0; - G1.mh <- map0; - G1.mhi <- map0; + F.RO.m <- empty; + G1.m <- empty; + G1.mi <- empty; + G1.mh <- empty; + G1.mhi <- empty; G1.bext <- false; - C.queries<- map0.[[] <- b0]; + 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 <- map0.[c0 <- ([<:block>],b0)]; + G1.paths <- empty.[c0 <- ([<:block>],b0)]; G1.chandle <- 1; b <@ D(M,S).distinguish(); return b; @@ -158,15 +158,15 @@ section. declare module D: DISTINGUISHER{G1, G2, FRO, C}. op inv_ext (m mi:smap) (FROm:handles) = - exists x h, mem (dom m `|` dom mi) x /\ FROm.[h] = Some (x.`2, Unknown). + 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: - mem (rng (restr f m)) x <=> mem (rng m) (x,f). + rng (restr f m) x <=> rng m (x,f). proof. - rewrite !in_rng;split=>-[z]H;exists z;move:H;rewrite restrP; case m.[z]=>//=. + rewrite !rngE;split=>-[z]H;exists z;move:H;rewrite restrP; case m.[z]=>//=. by move=> [t f'] /=;case (f'=f). qed. @@ -177,116 +177,133 @@ section. 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, mem (dom FRO.m) h => h < G1.chandle){1}). + (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, mem (dom FRO.m) h => h < G1.chandle){1} /\ - ! mem (dom G1.m{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} \/ (mem (rng FRO.m) (x.`2, Unknown)){2} \/ + (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, mem (dom FRO.m) h => h < G1.chandle){1} /\ - ! mem (dom G1.m{1}) x0{1}). + (forall h, h \in FRO.m => h < G1.chandle){1} /\ + x0{1} \notin G1.m{1}). + inline *;auto=> &ml&mr[#]10!-> -> ->->Hi-> Hhand -> /=. - rewrite -dom_restr rng_restr /=;progress;3:by smt ml=0. - + rewrite rng_set !inE rem_id 1:/#;move:H0=>[/Hi[->|[x' h][]H1 H2]|->]//. - right;right;exists x' h;rewrite getP. - by cut ->//:(h<> G1.chandle{mr});move:(Hhand h);rewrite in_dom H2 /#. - by move:H0;rewrite dom_set !inE /#. + rewrite -dom_restr rng_restr /=;progress;3:by smt ml=0. + + rewrite !rngE /=; move: H0=> [/Hi[->|[x h][]H1 H2]|H0]//. + + by right; right; exists x h; rewrite get_setE; smt(). + right; left; move: H0; rewrite rngE /= => [][] h Hh. + exists h; rewrite get_set_neqE //=. + by have:= Hhand h; rewrite domE Hh /#. + by move: H0; rewrite mem_set /#. 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), mem (dom FRO.m{1}) h => h < G1.chandle{1});2:by auto. + 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. + by apply sampleto_ll. - + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. - + case (h = (oget G1.mh{2}.[(x0{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + + 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 dom_set getP Hneq !inE. + 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;rewrite !dom_set getP Hneq //=. - by move:Hx;rewrite !inE Hh=>-[]->. - by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. - inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. - rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. - + right;exists x0{2} h;rewrite getP dom_set !inE /=. - by move:(H0 h);rewrite in_dom Hh /#. - right;exists x' h;rewrite getP !dom_set !inE;split. - + by move:Hx;rewrite !inE=>-[]->. - by move:(H0 h);rewrite !in_dom Hh /#. + right;exists (x1,x2) h; move:Hx. + by rewrite !fdom_set !in_fsetU !in_fset1 //= => [][] -> //=; rewrite get_set_neqE. + by move:H6 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} \/ (mem (rng FRO.m) (x.`2, Unknown)){2} \/ + (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, mem (dom FRO.m) h => h < G1.chandle){1} /\ - ! mem (dom G1.mi{1}) x{1}). + (forall h, h \in FRO.m => h < G1.chandle){1} /\ + x{1} \notin G1.mi{1}). + inline *;auto=> &ml&mr[#]-><-_ _9!-> Hi Hhand _ -> /=. rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. - + rewrite rng_set !inE rem_id 1:/#;move:H4=>[/Hi[->|[x' h][]HH1 HH2]|->]//. - right;right;exists x' h;rewrite getP. - by cut ->//:(h<> G1.chandle{mr});move:(Hhand h);rewrite in_dom HH2 /#. - by move:H4;rewrite dom_set !inE /#. + + rewrite rngE/=; case: H4 =>//= H4. + + move:Hi; rewrite/inv_ext1 H4 /= => [][->|] //= [] x h. + move=> [#] H5 Hh; right; right. + exists x h; rewrite H5 get_set_neqE//=. + by move:(Hhand h);rewrite domE Hh /#. + move: H4; rewrite rngE /= => [][] h Hh; right; left. + exists h; rewrite get_set_neqE //=. + by move:(Hhand h);rewrite domE Hh /#. + by move:H4;rewrite mem_set /#. if=>//. + inline *;rcondt{2} 4. + by move=> &m;auto;rewrite /in_dom_with. auto;progress. + by apply sampleto_ll. - + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. - + case (h = (oget G1.mhi{2}.[(x0{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + + 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. - by right;exists x0{2} h;rewrite !dom_set getP Hneq !inE. + 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 !dom_set getP Hneq //=. - by move:Hx;rewrite !inE Hh=>-[]->. - by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. - inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. - rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. - + right;exists x0{2} h;rewrite getP !dom_set !inE /=. - by move:(H0 h);rewrite in_dom Hh /#. - right;exists x' h;rewrite getP !dom_set !inE;split. - + by move:Hx;rewrite !inE=>-[]->. - by move:(H0 h);rewrite !in_dom Hh /#. + 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:H6 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 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), mem (dom FRO.m{1}) h0 => h0 < G1.chandle{1})=>//. + 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), mem (dom FRO.m{1}) h0 => h0 < G1.chandle{1})=>//. + 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;cut[/=->//|]:=H bad1;rewrite/inv_ext=>[][]x h[]H_dom Hh;right. - by exists x h;rewrite H_dom/=getP/= Hh;smt(in_dom getP). - + smt(dom_set in_fsetU1). + exists x h;rewrite H_dom/= get_set_neqE //=. + by move:(H0 h);rewrite domE Hh /#. + + smt(mem_set). + move=>bad1;cut[/=->//|]:=H bad1;rewrite/inv_ext=>[][]x h[]H_dom Hh;right. - by exists x h;rewrite H_dom/=getP/= Hh;smt(in_dom getP). - + smt(dom_set in_fsetU1). + exists x h;rewrite H_dom/= get_set_neqE //=. + by move:(H0 h);rewrite domE Hh /#. + + smt(mem_set). (* **************** *) inline *;auto;progress. - smt(dom_set in_fsetU1 dom0 in_fset0). + smt(mem_set mem_empty). qed. end section. @@ -300,8 +317,9 @@ section EXT. proc f (h:handle) = { var c; c <$ cdistr; - if (size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size) { - G1.bext <- G1.bext \/ mem (image snd (dom G1.m `|` dom G1.mi)) c; + 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 ; } @@ -310,8 +328,8 @@ section EXT. proc f1 (x:capacity,h:handle) = { var c; c <$ cdistr; - if (size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size) { - G1.bext <- G1.bext \/ mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x) c; + 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; } @@ -322,7 +340,7 @@ section EXT. local module Gext = { proc resample () = { - Iter(ReSample).iter (elems (dom (restr Unknown FRO.m))); + Iter(ReSample).iter (elems (fdom (restr Unknown FRO.m))); } module M = { @@ -332,10 +350,10 @@ section EXT. var h, i, counter <- 0; sa <- b0; while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + 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 - prefixe p (get_max_prefixe p (elems (dom C.queries)))) { + 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; @@ -358,8 +376,8 @@ section EXT. proc f(x : state): state = { var p, v, y, y1, y2, hy2, hx2, handles_,t; - if (!mem (dom G1.m) x) { - if (mem (dom G1.paths) x.`2) { + 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 { @@ -370,14 +388,14 @@ section EXT. (* exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) handles_ <@ RRO.restrK(); - if (!mem (rng handles_) x.`2) { + if (!rng handles_ x.`2) { RRO.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } handles_ <- RRO.restrK(); hx2 <- oget (hinvc handles_ x.`2); t <@ RRO.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); - if (mem (dom G1.mh) (x.`1, hx2) /\ t) { + 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); @@ -393,7 +411,7 @@ section EXT. G1.mi.[y] <- x; G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); } - if (mem (dom G1.paths) x.`2) { + if (x.`2 \in G1.paths) { (p,v) <- oget G1.paths.[x.`2]; G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); } @@ -406,9 +424,9 @@ section EXT. proc fi(x : state): state = { var y, y1, y2, hx2, hy2, handles_, t; - if (!mem (dom G1.mi) x) { + if (x \notin G1.mi) { handles_ <@ RRO.restrK(); - if (!mem (rng handles_) x.`2) { + if (!rng handles_ x.`2) { RRO.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } @@ -418,7 +436,7 @@ section EXT. y2 <$ cdistr; y <- (y1,y2); t <@ RRO.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); - if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { + 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); @@ -447,18 +465,18 @@ section EXT. var b; SLCommon.C.c <- 0; - F.RO.m <- map0; - G1.m <- map0; - G1.mi <- map0; - G1.mh <- map0; - G1.mhi <- map0; + F.RO.m <- empty; + G1.m <- empty; + G1.mi <- empty; + G1.mh <- empty; + G1.mhi <- empty; G1.bext <- false; ReSample.count <- 0; - FRO.m <- map0; + FRO.m <- empty; (* the empty path is initially known by the adversary to lead to capacity 0^c *) RRO.set(0,c0); - G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.paths <- empty.[c0 <- ([<:block>],b0)]; G1.chandle <- 1; b <@ DRestr(D,M,S).distinguish(); resample(); @@ -467,13 +485,13 @@ section EXT. }. op inv_lt (m2 mi2:smap) c1 (Fm2:handles) count2 = - size m2 < c1 /\ size mi2 < c1 /\ - count2 + size (restr Unknown Fm2) < c1 /\ + 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 = - size m2 <= c1 /\ size mi2 <= c1 /\ - count2 + size (restr Unknown Fm2) <= c1 /\ + 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. @@ -483,34 +501,34 @@ section EXT. qed. lemma size_set (m:('a,'b)fmap) (x:'a) (y:'b): - size (m.[x<-y]) = if mem (dom m) x then size m else size m + 1. + card (fdom (m.[x<-y])) = if x \in m then card (fdom m) else card (fdom m) + 1. proof. - rewrite sizeE dom_set;case (mem (dom m) x)=> Hx. - + by rewrite fsetUC subset_fsetU_id 2:sizeE 2:// => z; rewrite ?inE. + 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)=>//. - by rewrite fcard1 sizeE. + + 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): size (m.[x<-y]) <= size m + 1. + 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): - size (rem x m) = if mem (dom m) x then size m - 1 else size m. + card (fdom (rem m x)) = if x \in m then card (fdom m) - 1 else card (fdom m). proof. - rewrite !sizeE dom_rem fcardD;case (mem (dom m) x)=> Hx. - + by rewrite subset_fsetI_id 2:fcard1// => z;rewrite !inE. - by rewrite (@eq_fcards0 (dom m `&` fset1 x)) 2:// fset0_eqP=>z;rewrite !inE /#. + 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 : size (rem x m) <= size m. + 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 <= size m. - proof. rewrite sizeE fcard_ge0. qed. + lemma size_ge0 (m:('a,'b)fmap) : 0 <= card (fdom m). + proof. rewrite fcard_ge0. qed. - lemma size0 : size map0<:'a,'b> = 0. - proof. by rewrite sizeE dom0 fcards0. 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} ==> @@ -527,37 +545,35 @@ section EXT. fel 8 ReSample.count (fun x=> (2*max_size)%r / (2^c)%r) max_size G1.bext [ReSample.f : - (size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size); + (card (fdom G1.m) <= max_size /\ card (fdom G1.mi) <= max_size /\ ReSample.count < max_size); ReSample.f1 : - (size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size) + (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 (dom G1.m `|` dom G1.mi ))); skip=> /> &hr ? ? -> /= ? ?. + 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 (dom G1.m{hr} `|` dom G1.mi{hr})) + (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 (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). - by rewrite -!sizeE;smt w=fcard_ge0. - + rewrite/#. + 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 (dom G1.m `|` dom G1.mi) `|` fset1 x));skip=> /> &hr ??-> /= ??. - rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. + 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 (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). - by rewrite -!sizeE;smt w=fcard_ge0. - + rewrite/#. + 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->]/#. - move=> b1 c1;proc;auto=> /#. + by move=> b1 c1;proc;auto=> /#. qed. @@ -567,12 +583,12 @@ section EXT. ((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} /\ size G1.m{2} <= max_size /\ - size G1.mi{2} <= max_size /\ + 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 (dom G1.m{1} `|` dom G1.mi{1}) x /\ + 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. @@ -580,7 +596,7 @@ section EXT. 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 getP;case (h=h1)=> [/=->Hin->_ | Hneq ???]. + 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} /\ @@ -606,11 +622,11 @@ section EXT. inline RRO.restrK;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=(sizeE size_ge0). - rcondt{2} 10. by auto;progress;rewrite dom_set !inE. + + 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 3?->/=. - rewrite/Distr.is_lossless (sampleto_ll 0)/= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. + rewrite/Distr.is_lossless (sampleto_ll 0)/= => ? _;rewrite /bad_ext !get_setE /= !oget_some /= 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. @@ -629,10 +645,10 @@ section EXT. by wp;call RROset_inv_lt;auto. if=>//;wp. + inline *;rcondt{1} 4;1:by auto=>/#. - rcondt{2} 5;1:by auto;smt w=(sizeE size_ge0). - rcondt{2} 10. by auto;progress;rewrite dom_set !inE. + 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 3?->/=. - rewrite/Distr.is_lossless (sampleto_ll 0) /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. + rewrite/Distr.is_lossless (sampleto_ll 0) /= => ? _;rewrite /bad_ext !get_setE /= !oget_some /= 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. @@ -643,29 +659,32 @@ section EXT. 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} - - prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) /\ + prefix bs{1} (get_max_prefix bs{1} (elems (fdom C.queries{1}))) /\ c0R + size p{1} - - prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= max_size /\ + 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});1: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} - - prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) /\ + prefix bs{1} (get_max_prefix bs{1} (elems (fdom C.queries{1}))) /\ c0R + size p{1} - - prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= max_size /\ + 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 by auto;smt(List.size_ge0 prefixe_sizel). + last 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_prefixe c;rewrite DCapacity.dunifin_fu/=. - case(G1.chandle{mr} \in dom FRO.m{mr})=>//=[/#|]H_handle_in_dom. + 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 ml=0. + smt ml=0. + smt ml=0. - + elim H7=>// [[x h] [#]];rewrite -memE dom_restr /in_dom_with in_dom=> _ ->/=. + auto;progress[delta];rewrite ?(size0,restr0,restr_set,rem0,max_ge0,-sizeE,-cardE) //=. + + smt(size_rem_le size0). + + smt(). + + smt(). + + smt(). + + elim H7=>// [[x h] [#]];rewrite -memE mem_fdom dom_restr /in_dom_with domE=> _ ->/=. by rewrite oget_some. apply H10=>//. qed. @@ -677,7 +696,7 @@ section EXT. 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)%r / 2%r * mu dstate (pred1 witness) + + (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. From 637ed60c5725617f67e662b650b0557e16debc59 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 18 Sep 2018 14:24:55 +0200 Subject: [PATCH 304/394] push Gconcl --- sha3/proof/smart_counter/Gconcl.ec | 74 +++++++++++++++--------------- 1 file changed, 37 insertions(+), 37 deletions(-) diff --git a/sha3/proof/smart_counter/Gconcl.ec b/sha3/proof/smart_counter/Gconcl.ec index 0803dcb..a7167ff 100644 --- a/sha3/proof/smart_counter/Gconcl.ec +++ b/sha3/proof/smart_counter/Gconcl.ec @@ -1,6 +1,6 @@ pragma -oldip. require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. -require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. +require import List FSet SmtMap Common SLCommon PROM FelTactic Mu_mem. require import DProd Dexcepted. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. @@ -16,17 +16,17 @@ module S(F : DFUNCTIONALITY) = { var paths : (capacity, block list * block) fmap proc init() = { - m <- map0; - mi <- map0; + m <- empty; + mi <- empty; (* the empty path is initially known by the adversary to lead to capacity 0^c *) - paths <- map0.[c0 <- ([<:block>],b0)]; + paths <- empty.[c0 <- ([<:block>],b0)]; } proc f(x : state): state = { var p, v, y, y1, y2; - if (!mem (dom m) x) { - if (mem (dom paths) x.`2) { + if (x \notin m) { + if (x.`2 \in paths) { (p,v) <- oget paths.[x.`2]; y1 <- F.f (rcons p (v +^ x.`1)); } else { @@ -36,7 +36,7 @@ module S(F : DFUNCTIONALITY) = { y <- (y1,y2); m.[x] <- y; mi.[y] <- x; - if (mem (dom paths) x.`2) { + if (x.`2 \in paths) { (p,v) <- oget paths.[x.`2]; paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); } @@ -49,7 +49,7 @@ module S(F : DFUNCTIONALITY) = { proc fi(x : state): state = { var y, y1, y2; - if (!mem (dom mi) x) { + if (x \notin mi) { y1 <$ bdistr; y2 <$ cdistr; y <- (y1,y2); @@ -78,11 +78,11 @@ local module G3(RO:F.RO) = { var h, i, counter <- 0; sa <- b0; while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + 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 - prefixe p (get_max_prefixe p (elems (dom C.queries)))) { + 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; @@ -107,8 +107,8 @@ local module G3(RO:F.RO) = { proc f(x : state): state = { var p, v, y, y1, y2, hy2, hx2, handles_,t; - if (!mem (dom G1.m) x) { - if (mem (dom G1.paths) x.`2) { + 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 { @@ -117,14 +117,14 @@ local module G3(RO:F.RO) = { y2 <$ cdistr; y <- (y1, y2); handles_ <@ RRO.restrK(); - if (!mem (rng handles_) x.`2) { + if (!rng handles_ x.`2) { RRO.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } handles_ <- RRO.restrK(); hx2 <- oget (hinvc handles_ x.`2); t <@ RRO.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); - if (mem (dom G1.mh) (x.`1, hx2) /\ t) { + 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; @@ -138,7 +138,7 @@ local module G3(RO:F.RO) = { G1.mi.[y] <- x; G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); } - if (mem (dom G1.paths) x.`2) { + if (x.`2 \in G1.paths) { (p,v) <- oget G1.paths.[x.`2]; G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); } @@ -151,9 +151,9 @@ local module G3(RO:F.RO) = { proc fi(x : state): state = { var y, y1, y2, hx2, hy2, handles_, t; - if (!mem (dom G1.mi) x) { + if (x \notin G1.mi) { handles_ <@ RRO.restrK(); - if (!mem (rng handles_) x.`2) { + if (!rng handles_ x.`2) { RRO.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } @@ -163,7 +163,7 @@ local module G3(RO:F.RO) = { y1 <$ bdistr; y2 <$ cdistr; y <- (y1,y2); - if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { + 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; @@ -189,15 +189,15 @@ local module G3(RO:F.RO) = { var b; RO.init(); - G1.m <- map0; - G1.mi <- map0; - G1.mh <- map0; - G1.mhi <- map0; + 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 <- map0.[c0 <- ([<:block>],b0)]; + G1.paths <- empty.[c0 <- ([<:block>],b0)]; G1.chandle <- 1; b <@ DRestr(D,M,S).distinguish(); return b; @@ -222,19 +222,19 @@ proof. + 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 ((mem (dom G1.mh) (x.`1, hx2) /\ t){1}); + 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=>/>. wp;rnd;auto;progress[-split];rewrite DCapacity.dunifin_ll /= => ?_?->. - by rewrite !getP /= oget_some. - case ((mem (dom G1.mh) (x.`1, hx2) /\ t){1}); + by rewrite !get_setE /= oget_some. + 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=>/>. wp;rnd;auto;rnd{1};auto;progress[-split]. rewrite Block.DBlock.supp_dunifin DCapacity.dunifin_ll /==> ?_?->. - by rewrite !getP /= oget_some. + by rewrite !get_setE /= oget_some. + 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. @@ -243,12 +243,12 @@ proof. 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 ((mem (dom G1.mhi) (x.`1, hx2) /\ t){1}); + 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=>/>. wp;rnd;auto;progress[-split];rewrite DCapacity.dunifin_ll /= => ?_?->. - by rewrite !getP /= oget_some. + by rewrite !get_setE /= oget_some. 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. @@ -277,8 +277,8 @@ local module G4(RO:F.RO) = { proc f(x : state): state = { var p, v, y, y1, y2; - if (!mem (dom G1.m) x) { - if (mem (dom G1.paths) x.`2) { + 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 { @@ -288,7 +288,7 @@ local module G4(RO:F.RO) = { y <- (y1,y2); G1.m.[x] <- y; G1.mi.[y] <- x; - if (mem (dom G1.paths) x.`2) { + if (x.`2 \in G1.paths) { (p,v) <- oget G1.paths.[x.`2]; G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); } @@ -301,7 +301,7 @@ local module G4(RO:F.RO) = { proc fi(x : state): state = { var y, y1, y2; - if (!mem (dom G1.mi) x) { + if (x \notin G1.mi) { y1 <$ bdistr; y2 <$ cdistr; y <- (y1,y2); @@ -319,10 +319,10 @@ local module G4(RO:F.RO) = { var b; RO.init(); - G1.m <- map0; - G1.mi <- map0; + G1.m <- empty; + G1.mi <- empty; (* the empty path is initially known by the adversary to lead to capacity 0^c *) - G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.paths <- empty.[c0 <- ([<:block>],b0)]; b <@ DRestr(D,C,S).distinguish(); return b; } @@ -374,7 +374,7 @@ axiom D_ll : 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)%r / 2%r * mu dstate (pred1 witness) + + (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. From 2e0e2a1d5c6b31e645a5833eae2c580cd86584c7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 18 Sep 2018 16:50:50 +0200 Subject: [PATCH 305/394] push Gconcl_list --- sha3/proof/smart_counter/Gconcl_list.ec | 540 ++++++++++++------------ 1 file changed, 279 insertions(+), 261 deletions(-) diff --git a/sha3/proof/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec index ca43009..844dcfd 100644 --- a/sha3/proof/smart_counter/Gconcl_list.ec +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -1,6 +1,6 @@ pragma -oldip. require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. -require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. +require import List FSet SmtMap Common SLCommon PROM FelTactic Mu_mem. require import DProd Dexcepted BlockSponge Gconcl. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. @@ -114,61 +114,64 @@ clone F as F2. section Ideal. op (<=) (m1 m2 : (block list, 'b) fmap) = - forall x, x <> [] => x \in dom m1 => m1.[x] = m2.[x]. + 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 dom m2 => + ! x \in m2 => m1 <= m2.[x <- y]. proof. - move=>h_leq H_n_dom a H_a_dom;rewrite getP/=;smt(in_dom). + 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 dom m2 => + x \in m2 => m1.[x <- oget m2.[x]] <= m2. proof. - move=>h_leq H_n_dom a H_a_dom;rewrite getP/=;smt(in_dom getP). + 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 dom m2 => ! x \in dom m1 by smt(in_dom). + ! x \in m2 => ! x \in m1 by smt(domE). - local lemma prefixe_leq1 (l : block list) (m : (block list,block) fmap) i : + local lemma prefix_leq1 (l : block list) (m : (block list,block) fmap) i : 0 <= i => - format l (i+1) \in dom m => - size (format l (i+1)) <= prefixe (format l (i+1+1)) - (get_max_prefixe (format l (i+1+1)) (elems (dom m))) <= size (format l (i+1+1)). + 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 memE;move=>hi0 H_dom. + rewrite -mem_fdom memE;move=>hi0 H_dom. cut->:(format l (i + 1 + 1)) = format l (i + 1) ++ [b0]. - + by rewrite/format/=-2!(addzA _ 1 (-1))//=nseqSr//-cats1 catA. - cut:=prefixe_leq_prefixe_cat_size (format l (i + 1))[b0](elems (dom m)). - rewrite (prefixe_get_max_prefixe_eq_size _ _ H_dom)//=. + + by rewrite/format//=nseqSr//-cats1 catA. + cut:=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 _ _. - cut:=get_max_prefixe_max (x ++ [b0]) _ _ H_dom. - cut->:prefixe (x ++ [b0]) (format l (i + 1)) = size x - by rewrite prefixeC-{1}(cats0 (format l (i+1)))/x prefixe_cat//=. - smt(prefixe_sizel size_cat prefixe_ge0 ). + cut:=get_max_prefix_max (x ++ [b0]) _ _ H_dom. + cut->: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 prefixe_le1 (l : block list) (m : (block list,block) fmap) i : + local lemma prefix_le1 (l : block list) (m : (block list,block) fmap) i : 0 <= i => - format l (i+1) \in dom m => - size (format l (i+1+1)) - prefixe (format l (i+1+1)) - (get_max_prefixe (format l (i+1+1)) (elems (dom m))) <= 1. + 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. - smt(prefixe_leq1 size_ge0 size_cat size_nseq). + 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 dom m2 => - m1.[x <- y] <= m2.[x <- y] by smt(in_dom getP dom_set in_fsetU1). + ! 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}) : @@ -182,7 +185,7 @@ section Ideal. 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 getP/=dom_set in_fsetU1 dom0 in_fset0//==>->. + 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(). @@ -193,7 +196,7 @@ section Ideal. + 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(prefixe_ge0 leq_add_in DBlock.dunifin_ll in_dom size_ge0 getP leq_add2). + 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. @@ -220,29 +223,37 @@ section Ideal. /\ 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 dom F.RO.m){2});last first. + case((x0 \in F.RO.m){2});last first. * rcondt{2}2;1:auto;rcondt{1}1;1:(auto;smt(leq_nin_dom size_cat size_eq0 size_nseq valid_spec)). - rcondt{1}1;1:auto;1:smt(prefixe_le1 in_dom size_cat size_nseq). + 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!getP/=. - - smt(prefixe_le1 in_dom). - - by rewrite!getP/=oget_some leq_add2//=. + - by rewrite!get_setE/=. + - have//= /#:= prefix_le1 bl{2} SLCommon.C.queries{1} i_R H _. + by rewrite domE H1. + - by rewrite!get_setE/=oget_some leq_add2//=. if{1}. - * rcondt{1}1;1:auto;1:smt(prefixe_le1 in_dom size_cat size_nseq). + * 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!getP/=. - - smt(prefixe_ge0 prefixe_le1 in_dom). - - smt(leq_add_in in_dom). + - 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(DBlock.dunifin_ll). - smt(). - smt(). - - smt(). - - smt(set_eq in_dom). + - smt(). search "_.[_<-_]". + - 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} @@ -252,27 +263,27 @@ section Ideal. - smt(nseq0 cats0). - smt(size_ge0). - smt(). - case(p{2} \in dom F.RO.m{2}). + case(p{2} \in F.RO.m{2}). + rcondf{2}2;1:auto. sp;if{1}. - - rcondt{1}1;1:auto;1:smt(prefixe_ge0). + - rcondt{1}1;1:auto;1:smt(prefix_ge0). sp;rcondf{1}2;auto;progress. - * by rewrite!getP/=. - * smt(prefixe_ge0). - * smt(leq_add_in in_dom). + * by rewrite!get_setE/=. + * smt(prefix_ge0). + * smt(leq_add_in domE). auto;progress. - exact DBlock.dunifin_ll. - - smt(in_dom). - - smt(in_dom get_oget). + - smt(domE). + - smt(domE). - smt(size_ge0). - rcondt{1}1;1:auto;1:smt(leq_nin_dom in_dom). - rcondt{1}1;1:auto;1:smt(prefixe_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!getP/=. - + smt(prefixe_ge0). - + rewrite getP/=oget_some leq_add2//=. - + by rewrite!getP/=. - + smt(prefixe_ge0). + + by rewrite!get_setE/=. + + smt(prefix_ge0). + + rewrite get_setE/=oget_some leq_add2//=. + + by rewrite!get_setE/=. + + smt(prefix_ge0). + exact leq_add_in. qed. @@ -369,11 +380,12 @@ section Ideal. by auto;smt(parse_valid parseK formatK). qed. + require import JointFMap. inductive inv_L_L3 (m1 m2 m3 : (block list, block) fmap) = | INV of (m1 = m2 + m3) - & (forall l, l \in dom m2 => valid (parse l).`1) - & (forall l, l \in dom m3 => ! valid (parse l).`1). + & (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 () = { @@ -411,51 +423,50 @@ section Ideal. inv_L_L3 m1 m2 m3 => valid p => 0 < i => - ! format p i \in dom m1 => - ! format p i \in dom m2 => + ! 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;cut[]add_maps valid_dom nvalid_dom:=INV0. - + rewrite add_maps fmapP=>x. - by rewrite getP !joinP getP;smt(parseK formatK). - + smt(dom_set in_fsetU1 parseK formatK). - + smt(dom_set in_fsetU1 parseK formatK). + + 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 dom m1 => - format p i \in dom m2. + format p i \in m1 => + format p i \in m2. proof. - move=>INV0 p_valid i_gt0 in_dom1;cut[]add_maps valid_dom nvalid_dom:=INV0. - cut:=in_dom1;rewrite add_maps dom_join in_fsetU=>[][]//=in_dom3. - by cut:=nvalid_dom _ in_dom3;rewrite parseK//=. + move=>INV0 p_valid i_gt0 domE1;cut[]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 dom m1 <=> (l \in dom m2 \/ l \in dom m3). + l \in m1 <=> (l \in m2 \/ l \in m3). proof. move=>INV0;cut[]add_maps valid_dom nvalid_dom:=INV0. - by rewrite add_maps dom_join in_fsetU. + 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 dom m1 => + ! x \in m1 => inv_L_L3 m1.[x <- r] m2 m3.[x <- r]. proof. move=>INV0 not_valid nin_dom1;cut[]add_maps h1 h2:=INV0. - cut nin_dom3: ! x \in dom m3 by smt(incl_dom). + cut nin_dom3: ! x \in m3 by smt(incl_dom). split. - + by rewrite fmapP=>y;rewrite add_maps !getP!joinP!getP dom_set in_fsetU1/#. + + by apply/fmap_eqP=>y;rewrite add_maps !get_setE!joinE!get_setE mem_set/#. + exact h1. - smt(dom_set in_fsetU1). + smt(mem_set). qed. @@ -475,7 +486,7 @@ section Ideal. 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(dom_set in_fsetU1 nseq0 cats0 parse_valid). + 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 @@ -487,38 +498,38 @@ section Ideal. 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!getP//=. + * 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(joinP). + * 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 dom F.RO.m{1}). + 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. - + cut[]add_maps h1 h2:=H5;rewrite add_maps joinP//=;smt(parse_valid). + + cut[]add_maps h1 h2:=H5;rewrite add_maps joinE//=;smt(parse_valid). + smt(). - case(x5{1} \in dom F.RO.m{1}). + case(x5{1} \in F.RO.m{1}). - rcondf{1}2;2:rcondf{2}2;auto;progress. * smt(lemma2 incl_dom parse_valid). - by cut[]add_maps h1 h2:=H1;rewrite add_maps joinP//=;smt(parse_valid). + by cut[]add_maps h1 h2:=H1;rewrite add_maps joinE//=;smt(parse_valid). rcondt{1}2;2:rcondt{2}2;auto;progress. - smt(lemma2 incl_dom parse_valid). - - cut[]add_maps h1 h2:=H1;rewrite add_maps !getP joinP//=;smt(parse_valid nseq0 cats0). + - cut[]add_maps h1 h2:=H1;rewrite add_maps !get_setE joinE//=;smt(parse_valid nseq0 cats0). - cut:=H;rewrite -H0=>//=[][]->>->>;apply lemma1=>//=;1:smt(parse_valid). cut[]add_maps h1 h2:=H1;smt(parse_valid formatK parseK incl_dom). + progress;split. - - by rewrite fmapP=>x;rewrite joinP map0P//=. - - smt(dom0 in_fset0). - - smt(dom0 in_fset0). + - 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. @@ -528,37 +539,37 @@ section Ideal. 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 dom F.RO.m{1}). + - sp;case(x1{1} \in F.RO.m{1}). * rcondf{1}2;2:rcondf{2}2;auto;progress. + cut:=H2;rewrite -formatK H/=;smt(lemma2 incl_dom parse_gt0). - cut[]add_maps h1 h2:=H1;rewrite add_maps joinP. + cut[]add_maps h1 h2:=H1;rewrite add_maps joinE. cut:=H2;rewrite -formatK H/==>in_dom1. - case(format p{2} n{2} \in dom F2.RO.m{2})=>//=in_dom3. + case(format p{2} n{2} \in F2.RO.m{2})=>//=in_dom3. by cut:=h2 _ in_dom3;rewrite parseK//=;smt(parse_gt0). rcondt{1}2;2:rcondt{2}2;auto;progress. + smt(incl_dom lemma2). - + cut[]:=H1;smt(getP joinP). + + cut[]:=H1;smt(get_setE joinE). by cut:=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 dom F.RO.m{1}). + + sp;case(x2{1} \in F.RO.m{1}). - by rcondf{1}2;2:rcondf{2}2;auto;smt(lemma2). by rcondt{1}2;2:rcondt{2}2;auto;progress;smt(incl_dom lemma1). 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 dom F.RO.m{1}). + + sp;case(x1{1} \in F.RO.m{1}). - rcondf{1}2;2:rcondf{2}2;auto;progress. * cut[]:=H1;smt(incl_dom). - cut[]:=H1;smt(joinP incl_dom). + cut[]:=H1;smt(joinE incl_dom). rcondt{1}2;2:rcondt{2}2;auto;progress. * cut[]:=H1;smt(incl_dom). - * cut[]:=H1;smt(joinP incl_dom getP). + * cut[]:=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 dom F.RO.m{1}). + + sp;case(x2{1} \in F.RO.m{1}). - rcondf{1}2;2:rcondf{2}2;auto;progress. * cut[]:=H2;smt(incl_dom lemma2 formatK parse_not_valid). smt(). @@ -654,7 +665,7 @@ section Ideal. 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 dom_set in_fsetU1 nseq0 cats0)); 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. @@ -669,13 +680,13 @@ section Ideal. 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 dom F.RO.m{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(dom_set in_fsetU1 nseq0 cats0 parse_valid). + - 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 dom F.RO.m{1}); + 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 dom_set in_fsetU1). + 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)). @@ -686,23 +697,23 @@ section Ideal. 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(dom_set in_fsetU1 parseK parse_valid formatK). + - 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 dom F.RO.m{1})); + 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 dom F.RO.m{1});last first. - - auto;smt(dom_set in_fsetU1). + 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 dom F.RO.m{1}));1:smt(parseK). + 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 dom F.RO.m{1}))(n1{1}-i1{1}-1);progress. + 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. @@ -723,7 +734,7 @@ section Ideal. - by while(i ={F.RO.m} /\ p{2} = x0{2});progress. + smt(DBlock.dunifin_ll). smt(last_rcons formatK parseK). @@ -745,7 +756,7 @@ section Ideal. - by while(i ={F2.RO.m} /\ format pp{2} n{2} = x3{2});1:smt(DBlock.dunifin_ll 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}); @@ -757,39 +768,39 @@ section Ideal. 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 dom m2 <=> x \in dom m1) - /\ (forall p n x, parse x = (p,n+1) => x \in dom m1 <=> (p,n) \in dom m2) + (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 dom m2 => valid p /\ 0 <= n) - & (forall p n, (p,n) \in dom m4 => ! valid p /\ 0 <= n). + & (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 dom m2 => + ! (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;cut[]inv12 inv34 dom2 dom4:=INV0;cut[]h1[]h2[]h3 h4:=inv12;split=>//=. + progress. - - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=[]->>->>;smt(parseK formatK). - - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=->>;smt(parseK formatK). - - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=->>;smt(parseK formatK). - - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=;smt(parseK formatK). - - smt(getP parseK formatK). - smt(getP parseK formatK). - smt(getP parseK formatK dom_set in_fsetU1). + - 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 dom m4 => + ! (p,i) \in m4 => 0 <= i => ! valid p => parse (format p (i+1)) = (p,i+1) => @@ -800,13 +811,13 @@ section Ideal. cut[]h1[]h2[]h3 h4:=inv34; split=>//=. + progress. - - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=[]->>->>;smt(parseK formatK). - - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=->>;smt(parseK formatK). - - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=->>;smt(parseK formatK). - - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=;smt(parseK formatK). - - smt(getP parseK formatK). - smt(getP parseK formatK). - smt(getP parseK formatK dom_set in_fsetU1). + - 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. @@ -821,7 +832,7 @@ section Ideal. 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(dom0 in_fset0 map0P)). + 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} @@ -835,7 +846,7 @@ section Ideal. * sp;if{2}. + rcondt{1}2;auto;progress. - cut[]h1 _ _ _:=H1;cut[]h'1 _:=h1;smt(parseK). - - smt(getP). + - smt(get_setE). - smt(). - exact lemma5. rcondf{1}2;auto;progress. @@ -854,7 +865,7 @@ section Ideal. - cut[]_ h1 _ _:=H2;cut[]:=h1;progress. cut:=H7 x0{m} i0{m} (format x0{m} (i0{m} + 1));rewrite H5/==>->//=. cut->/#:=parse_twice _ _ _ H. - - smt(getP). + - smt(get_setE). - smt(). - apply lemma5bis=>//=. rewrite(parse_twice _ _ _ H)/#. @@ -877,7 +888,7 @@ section Ideal. sp;if{2}. + rcondt{1}2;auto;progress. - cut[]h1 _ _ _:=H1;cut[]h'1 _:=h1;smt(parseK). - - smt(getP). + - smt(get_setE). - smt(). - exact lemma5. rcondf{1}2;auto;progress. @@ -943,7 +954,7 @@ 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 dom p => forall i, 0 <= i < size l => + & (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]). @@ -962,14 +973,14 @@ section Real. local lemma INV_Real_addm_mi c1 c2 m mi p x y : INV_Real c1 c2 m mi p => - ! x \in dom m => - ! y \in rng m => + ! 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(getP in_dom oget_some take_oversize size_take take_take). - exact invm_set. + smt(get_setE domE oget_some take_oversize size_take take_take). + exact/invm_set. qed. local lemma invmC' (m mi : (state, state) fmap) : @@ -982,31 +993,33 @@ section Real. local lemma invm_dom_rng (m mi : (state, state) fmap) : invm m mi => dom m = rng mi. - proof. by move=>h;rewrite fsetP=>x;split;rewrite in_dom in_rng/#. qed. + proof. + by move=>h; rewrite fun_ext=> x; rewrite domE rngE /=; have := h x; smt(). + 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 in_dom). + 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 dom m => - ! (format bl i) \in dom p => + (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;cut[]//=_[] hmp0 hmp1 hinvm:=inv0;split=>//=. - + by rewrite getP;smt(size_cat size_nseq size_ge0). - + move=>l;rewrite dom_set in_fsetU1;case;1:smt(all_prefixes_of_INV_real getP). - move=>->>j[]hj0 hjsize;rewrite getP/=. - cut:=hmp1 (format bl (i - 1));rewrite in_dom H_p_val/==>help. + + 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/=. + cut:=hmp1 (format bl (i - 1));rewrite domE H_p_val/==>help. cut:=hjsize;rewrite !size_cat !size_nseq/=!max_ler 1:/#=>hjsizei. cut->/=:!take j (format bl i) = format bl i by smt(size_take). cut h:forall k, 0 <= k <= size bl + i - 2 => @@ -1021,16 +1034,16 @@ section Real. move=>[]b c[]. cut->: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'/=getP/=. + rewrite h 1:/# h 1:/# => -> h';exists b c=>//=;rewrite h'/=get_setE/=. smt(size_take size_cat size_nseq). cut->>/=:j = size (format bl (i-1)) by smt(size_cat size_nseq). - rewrite getP/=. + rewrite get_setE/=. cut h':size (format bl (i-1)) = size bl + i - 2 by smt(size_cat size_nseq). - rewrite h'/=-(addzA _ _ 1)/=. + rewrite h'/=. cut 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';cut->/=:! size bl + i - 2 < size bl by smt(). - by rewrite nth_nseq 1:/#;smt(Block.WRing.AddMonoid.addm0 in_dom get_oget). + by rewrite nth_nseq 1:/#; exists sa sc; smt(Block.WRing.AddMonoid.addm0 domE). qed. local lemma take_nseq (a : 'a) i j : @@ -1068,7 +1081,7 @@ section Real. 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(dom0 in_fset0 dom_set in_fsetU1 getP map0P). + + 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). @@ -1105,9 +1118,9 @@ section Real. /\ 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 dom Redo.prefixes{1} => - l \in dom pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) - /\ (forall l, l \in dom pref => pref.[l] = Redo.prefixes{1}.[l]) + /\ (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) /\ @@ -1117,28 +1130,28 @@ section Real. - cut inv0:=H3;cut[]h_c1c2[]Hmp0 Hmp1 Hinvm:=inv0;split=>//=. - case:inv0;smt(size_ge0). split=>//=. - - smt(in_dom). + - smt(domE). - move=>l H_dom_R i []Hi0 Hisize;cut:=H4 l H_dom_R. - case(l \in dom Redo.prefixes{2})=>H_in_pref//=. + case(l \in Redo.prefixes{2})=>H_in_pref//=. * cut:=Hmp1 l H_in_pref i _;rewrite//=. - rewrite ?H5//=;1:smt(in_dom). - case(i+1 < size l)=>h;1:smt(in_dom). + rewrite ?H5//=;1:smt(domE). + case(i+1 < size l)=>h;1:smt(domE). by rewrite take_oversize 1:/#. move=>[]j[][]hj0 hjsize ->>. cut:=Hisize;rewrite size_take 1:/#. pose k:=if _ then _ else _;cut->>Hij{k}:k=j by rewrite/#. - by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#;smt(in_dom). - - smt(getP oget_some in_dom take_oversize). + by rewrite!take_take!min_lel 1,2:/# 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 dom Redo.prefixes{1} => - l \in dom pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) - /\ (forall l, l \in dom pref => pref.[l] = Redo.prefixes{1}.[l]) + /\ (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 dom Redo.prefixes{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} => @@ -1156,11 +1169,11 @@ section Real. if;auto;progress. - smt(). - smt(). - - smt(get_oget in_dom). - - smt(in_dom). + - smt(domE). + - smt(domE). - smt(). - smt(). - - smt(all_prefixes_of_INV_real in_dom take_take size_take). + - smt(all_prefixes_of_INV_real domE take_take size_take). - case(j < i0{2})=>hj;1:smt(). cut<<-/=:j = i0{2} by smt(). cut->>:=H7 H10 H12. @@ -1170,44 +1183,45 @@ section Real. sp;if;auto;progress. - smt(). - smt(). - - smt(getP get_oget in_dom). + - smt(get_setE domE). - rewrite INV_Real_addm_mi//=;smt(supp_dexcepted). - - smt(dom_set in_fsetU1). - - smt(getP in_dom). + - smt(mem_set). + - smt(get_setE domE). - smt(). - smt(). - - move:H17;apply absurd=>//=_;rewrite dom_set in_fsetU1. + - move:H17;apply absurd=>//=_;rewrite mem_set. pose x:=_ = _;cut->/={x}:x=false by smt(size_take). - move:H12;apply absurd=>//=. - smt(all_prefixes_of_INV_real dom_set in_fsetU1 take_take size_take). - - move=>l;rewrite!dom_set!in_fsetU1;case=>[H_dom|->>]/=;1:smt(in_fsetU1). - move=>j;rewrite in_fsetU1. - case(0 <= j)=>hj0;2:smt(in_dom take_le0). - case(j < i0{2} + 1)=>hjiS;2:smt(in_dom take_take). - rewrite take_take/min hjiS//=;left. + 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;2:smt(domE take_le0 mem_set). + case(j < i0{2} + 1)=>hjiS;2:smt(domE take_take mem_set). + rewrite mem_set take_take/min hjiS//=;left. cut:=(take_take bl{2} j i0{2});rewrite min_lel 1:/#=><-. - smt(all_prefixes_of_INV_real in_dom). - - smt(getP get_oget in_dom dom_set in_fsetU1). - - smt(getP get_oget in_dom). + smt(all_prefixes_of_INV_real domE). + - smt(get_setE domE mem_set). + - smt(get_setE domE). - smt(). - - smt(getP get_oget in_dom). - - smt(dom_set in_fsetU1). - - smt(getP in_dom). + - smt(get_setE domE). + - smt(mem_set). + - smt(get_setE domE). - smt(). - smt(). - - move:H15;apply absurd=>//=_;rewrite dom_set in_fsetU1. + - move:H15;apply absurd=>//=_;rewrite mem_set. pose x:=_ = _;cut->/={x}:x=false by smt(size_take). move:H12;apply absurd=>//=. cut:=take_take bl{2}(i0{2} + 1)(i0{2} + 1 + 1);rewrite min_lel 1:/# =><-h. by rewrite (H8 _ h). - - move=>l;rewrite!dom_set!in_fsetU1;case=>[H_dom|->>]/=;1:smt(in_fsetU1). - move=>j;rewrite in_fsetU1. - case(0 <= j)=>hj0;2:smt(in_dom take_le0). - case(j < i0{2} + 1)=>hjiS;2:smt(in_dom take_take). + - move=>l;rewrite!mem_set;case=>[H_dom|->>]/=;1:smt(mem_set). + move=>j;rewrite mem_set. + case(0 <= j)=>hj0;2:smt(domE take_le0). + case(j < i0{2} + 1)=>hjiS;2:smt(domE take_take). rewrite take_take/min hjiS//=;left. cut:=(take_take bl{2} j i0{2});rewrite min_lel 1:/#=><-. - smt(all_prefixes_of_INV_real in_dom). - - smt(getP get_oget in_dom dom_set in_fsetU1). + 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. @@ -1254,7 +1268,7 @@ section Real. 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 dom 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). @@ -1267,28 +1281,28 @@ section Real. Redo.prefixes{1});last first. + if;auto;progress. - by split;case:H3=>//=;smt(). - - by rewrite in_dom H2//=. - - by move:H4;rewrite -(addzA _ _ 1)/=take_size;smt(get_oget in_dom). + - by rewrite domE H2//=. + - move:H4;rewrite take_size /= domE. + by case: (Redo.prefixes{2}.[format bl{2} (i{2} + 1)])=>//=; smt(). sp;if;auto;progress. - - move:H4 H5;rewrite!getP/=!oget_some nth_last -(addzA _ _ 1)/=take_size. + - move:H4 H5;rewrite!get_setE/=!oget_some nth_last/=take_size. rewrite last_cat last_nseq 1:/# Block.WRing.addr0;progress. cut//=:=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 -(addzA _ 1)/=H1/=!dom_set!in_fsetU1/=H4/=H2/=getP/=oget_some/=. + rewrite H1/=!mem_set/=H4/=H2/=get_setE/=oget_some/=. cut->->//=:y2L = (y2L.`1, y2L.`2);1,-1:smt(). rewrite INV_Real_addm_mi//=;2:smt(supp_dexcepted). by cut:=H3=>hinv0;split;case:hinv0=>//=/#. - - by rewrite dom_set in_fsetU1//=-(addzA _ _ 1)/=take_size in_dom H2. - - by rewrite!getP-(addzA _ _ 1)/=take_size/=;smt(). - - move:H4 H5;rewrite nth_last -(addzA _ _ 1)/=take_size. + - 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:=(_, _);cut->/={a}:a = oget Perm.m{2}.[(sa0_R, sc0{2})] by smt(). apply lemma2'=>//=;first cut:=H3=>hinv0;split;case:hinv0=>//=/#. smt(). - smt(). - - by rewrite dom_set in_fsetU1//=-(addzA _ _ 1)/=take_size;smt(in_dom). - - by rewrite!getP-(addzA _ _ 1)/=take_size/=;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} @@ -1298,10 +1312,9 @@ section Real. /\ 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(size_cat size_nseq set_eq in_dom). - + move:H8;rewrite size_cat size_nseq-(addzA _ 1 (-1))/=/max H0/=. - by pose x:= Int.(+) _ _;cut->/={x}: x = i_R + 1 by smt(). - + move:H8;rewrite size_cat size_nseq-(addzA _ 1 (-1))/=/max H0/=;smt(). + + smt(). + + by move: H8; rewrite size_cat size_nseq /= max_ler /#. + + 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) @@ -1309,7 +1322,7 @@ section Real. /\ 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 dom Redo.prefixes{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})). @@ -1322,18 +1335,21 @@ section Real. smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). + smt(). + smt(size_cat size_nseq). - + rewrite get_oget;2:smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). - cut->:format bl{2} (i1{2} + 1 - size bl{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). - smt(all_prefixes_of_INV_real). + + 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). + cut 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 dom Redo.prefixes{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). @@ -1343,14 +1359,14 @@ section Real. /\ 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 dom Redo.prefixes{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(). - - cut[]_[]:=H;smt(in_dom). + - cut[]_[]:=H;smt(domE). - exact size_ge0. - - cut[]_[]:=H;smt(in_dom take0). + - cut[]_[]:=H;smt(domE take0). - smt(size_cat size_nseq). rcondt{1}1;2:rcondt{2}1;auto;progress. - cut->:take (i1{m} + 1) (format bl{m} (i{m} + 1)) = @@ -1367,7 +1383,7 @@ section Real. cut->:take (i1{2} + 1) bl{2} = take (i1{2} + 1) (format bl{2} i{2}) by smt(take_cat take_le0 cats0). - rewrite get_oget//=;smt(all_prefixes_of_INV_real). + smt(all_prefixes_of_INV_real). qed. @@ -1375,7 +1391,7 @@ section Real. INV_Real c c' m mi p => 0 < i => p.[format bl i] = Some (sa,sc) => - format bl (i+1) \in dom p => + 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. @@ -1399,17 +1415,17 @@ section Real. 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 dom m => - ! rcons bl b \in dom 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;cut[]//=_[] hmp0 hmp1 hinvm:=inv0;split=>//=. - + by rewrite getP;smt(size_cat size_nseq size_ge0). - + move=>l;rewrite dom_set in_fsetU1;case;1:smt(all_prefixes_of_INV_real getP). - move=>->>j[]hj0 hjsize;rewrite getP/=. - cut:=hmp1 bl;rewrite in_dom H_p_val/==>help. + + 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/=. + cut:=hmp1 bl;rewrite domE H_p_val/==>help. cut->/=:!take j (rcons bl b) = rcons bl b by smt(size_take). move:hjsize;rewrite size_rcons=>hjsize. rewrite-cats1 !take_cat. @@ -1417,12 +1433,12 @@ section Real. rewrite nth_cat. case(j < size bl)=>//=hj;last first. + cut->>/=:j = size bl by smt(). - by rewrite take_size H_p_val/=;exists sa sc=>//=;smt(getP get_oget). + by rewrite take_size H_p_val/=;exists sa sc=>//=;smt(get_setE). cut->/=:j + 1 - size bl <= 0 by smt(). rewrite cats0. pose x := if _ then _ else _;cut->/={x}: x = take (j+1) bl by smt(take_le0 cats0 take_size). - cut:=hmp1 bl;rewrite in_dom H_p_val/==>hep. - cut:=hep j _;rewrite//=;smt(getP size_cat size_take). + cut:=hmp1 bl;rewrite domE H_p_val/==>hep. + cut:=hep j _;rewrite//=;smt(get_setE size_cat size_take). qed. @@ -1437,7 +1453,7 @@ section Real. /\ 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(getP dom0 map0P in_fset0 dom_set in_fsetU1). + 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(). @@ -1478,30 +1494,30 @@ section Real. cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{m} _;1:smt(size_take). move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. rewrite H1=>//=[][][]->>->>. - by rewrite nth_onth (onth_nth b0)//=;smt(in_dom). + by rewrite nth_onth (onth_nth b0)//=;smt(domE). + rewrite head_nth nth_drop//=. cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. rewrite H1=>//=[][][]->>->>. - by rewrite nth_onth (onth_nth b0)//=;smt(in_dom). + by rewrite nth_onth (onth_nth b0)//=;smt(domE). + rewrite head_nth nth_drop//=. cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. rewrite H1=>//=[][][]->>->>. - by rewrite nth_onth (onth_nth b0)//=;smt(in_dom). + by rewrite nth_onth (onth_nth b0)//=;smt(domE). + rewrite head_nth nth_drop//=. cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. rewrite H1=>//=[][][]->>->>. - by rewrite nth_onth (onth_nth b0)//=;smt(in_dom). + by rewrite nth_onth (onth_nth b0)//=;smt(domE). + rewrite head_nth nth_drop//=. cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. rewrite H1=>//=[][][]->>->>. - by rewrite nth_onth (onth_nth b0)//=;smt(in_dom). + by rewrite nth_onth (onth_nth b0)//=;smt(domE). + + smt(). + smt(). + smt(). - + smt(get_oget). + smt(behead_drop drop_add). + smt(size_drop size_eq0). + smt(size_drop size_eq0). @@ -1517,13 +1533,13 @@ section Real. + by rewrite head_nth nth_drop //=nth_onth (onth_nth b0)//=. + smt(). + smt(). - + by rewrite getP/=. + + by rewrite get_setE/=. + by rewrite behead_drop drop_add. - + rewrite!getP/=oget_some. + + rewrite!get_setE/=oget_some. cut:=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!dom_set!in_fsetU1/=-take_nth//=H5/=H1/=getP/=oget_some. + rewrite!mem_set/=-take_nth//=H5/=H1/=get_setE/=oget_some. cut->->//=:(yL.`1, yL.`2) = yL by smt(). rewrite INV_Real_addm_mi=>//=;smt(supp_dexcepted). + smt(size_drop size_eq0). @@ -1534,7 +1550,7 @@ section Real. + by rewrite head_nth nth_drop //=nth_onth (onth_nth b0)//=. + smt(). + smt(). - + by rewrite getP. + + by rewrite get_setE. + by rewrite behead_drop drop_add. + rewrite(take_nth witness)//=. cut:=lemma_3 0 C.c{2} Perm.m{2} Perm.mi{2} Redo.prefixes{1} @@ -1576,7 +1592,7 @@ section Real. + 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(). - by if;auto;1:smt();sp;if;auto;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} @@ -1586,13 +1602,13 @@ section Real. + if{1};auto. + rcondf{2}1;auto;progress. + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq max_ler/#. - move=>H_dom;rewrite in_dom. - by cut<-:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;rewrite-in_dom. + move=>H_dom;rewrite domE. + by cut<-:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;rewrite-domE. + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq max_ler/#;move=>H_dom. - by cut:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;smt(in_dom). + by cut:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;smt(domE). + smt(). + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq max_ler/#;move=>H_dom. - by cut:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;smt(in_dom). + by cut:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;smt(domE). sp;if;auto;progress. + move:H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). @@ -1612,16 +1628,16 @@ section Real. + smt(). + move:H5 H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). - rewrite Block.WRing.addr0 !getP/=oget_some take_oversize;1:rewrite size_cat size_nseq/#. + rewrite Block.WRing.addr0 !get_setE/=oget_some take_oversize;1:rewrite size_cat size_nseq/#. move=>H_dom_iS H_dom_p. cut:=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 dom_set in_fsetU1. - by rewrite!getP/=oget_some-(addzA)/=H2/=;smt(). - + by rewrite!getP/=take_oversize//=size_cat size_nseq/#. + + by rewrite mem_set. + by rewrite!get_setE/=oget_some/=H2/=;smt(). + + by rewrite!get_setE/=take_oversize//=size_cat size_nseq/#. + rewrite nth_cat;cut->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). by rewrite nth_nseq//=1:/# Block.WRing.addr0. + smt(). @@ -1632,7 +1648,7 @@ section Real. 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;cut->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). - by rewrite nth_nseq//=1:/# Block.WRing.addr0 !getP//=. + 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} @@ -1642,14 +1658,14 @@ section Real. + smt(). + move:H9;rewrite take_format/=1:/#;1:smt(size_ge0 size_cat size_nseq). pose x := if _ then _ else _ ;cut->/={x}: x = format p{1} (i_R+1). - + rewrite/x size_cat size_nseq-(addzA _ 1 (-1))/=!max_ler 1:/#-(addzA _ _ (-1))-(addzA _ _ (-1))/=. + + rewrite/x size_cat size_nseq/=!max_ler 1:/#-(addzA _ _ (-1))-(addzA _ _ (-1))/=. case(size p{1} + i_R <= size p{1})=>//=h;2:smt(size_ge0 size_cat size_nseq). cut->>/=: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 _ ;cut->/={x}: x = format p{1} (i_R+1). - + rewrite/x size_cat size_nseq-(addzA _ 1 (-1))/=!max_ler 1:/#-(addzA _ _ (-1))-(addzA _ _ (-1))/=. + + rewrite/x size_cat size_nseq/=!max_ler 1:/#-(addzA _ _ (-1))-(addzA _ _ (-1))/=. case(size p{1} + i_R <= size p{1})=>//=h;2:smt(size_ge0 size_cat size_nseq). cut->>/=:i_R = 0 by smt(). by rewrite take_size/format nseq0 cats0. @@ -1657,25 +1673,25 @@ section Real. + 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 dom pref{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 in_dom H3. + + by rewrite domE H3. + by rewrite take0;cut[]_[]:=H1. + smt(). + smt(). rcondt 1;auto;progress. + cut->: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 in_dom). + 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). + cut->: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 in_dom). + 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. @@ -1723,7 +1739,7 @@ section Real_Ideal. 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)%r / 2%r / (2^r)%r / (2^c)%r + + (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. @@ -1768,21 +1784,23 @@ section Real_Ideal_Abs. local lemma useful m mi a : - invm m mi => ! a \in dom m => Distr.is_lossless ((bdistr `*` cdistr) \ mem (rng m)). + invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). proof. move=>hinvm nin_dom. cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. apply dexcepted_ll=>//=;rewrite-prod_ll. - cut->:predT = predU (predC (mem (rng m))) (mem (rng m));1:rewrite predCU//=. + cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. - cut/=->:=ltr_add2l (mu (bdistr `*` cdistr) (mem (rng m))) 0%r. + cut/=->:=ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. rewrite Distr.witness_support/predC. move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. - cut{hyp}hyp:forall x, x \in rng m by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). move:a. - cut:=eqEcard (dom m) (rng m);rewrite leq_card_rng_dom/=. - cut->//=/#:dom m \subset rng m;rewrite subsetP=>x;rewrite hyp//=. + cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. + cut->//=: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) : @@ -1800,7 +1818,7 @@ section Real_Ideal_Abs. - smt(invm_set dexcepted1E). + proc;inline*;sp;if;auto;sp;if;auto;progress. - cut:=H;rewrite invmC=>h;cut/#:=useful _ _ _ h H1. - - move:H;rewrite invmC=>H;rewrite invmC;smt(invm_set dexcepted1E in_dom in_rng). + - 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. @@ -1815,7 +1833,7 @@ section Real_Ideal_Abs. * smt(size_behead). * smt(size_behead). smt(size_ge0 size_eq0). - smt(map0P). + smt(emptyE). qed. @@ -1840,7 +1858,7 @@ section Real_Ideal_Abs. 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)%r / 2%r / (2^r)%r / (2^c)%r + + (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. @@ -1859,7 +1877,7 @@ section Real_Ideal_Abs. lemma 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)%r / 2%r / (2^r)%r / (2^c)%r + + (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. From ce344d5e389374a6c831f0d2eb41f55054f15b22 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 18 Sep 2018 17:00:14 +0200 Subject: [PATCH 306/394] push IRO + adding joint map --- sha3/proof/IRO.eca | 20 ++++++++++---------- sha3/proof/smart_counter/JointFMap.ec | 19 +++++++++++++++++++ 2 files changed, 29 insertions(+), 10 deletions(-) create mode 100644 sha3/proof/smart_counter/JointFMap.ec diff --git a/sha3/proof/IRO.eca b/sha3/proof/IRO.eca index 05d512d..bad01db 100644 --- a/sha3/proof/IRO.eca +++ b/sha3/proof/IRO.eca @@ -3,7 +3,7 @@ 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 NewFMap. +require import Core Int Bool List FSet SmtMap. type to, from. @@ -19,15 +19,15 @@ module type IRO = { pred prefix_closed (m : (from * int,to) fmap) = forall x n, - mem (dom m) (x,n) => + (x,n) \in m => (forall i, 0 <= i < n => - mem (dom m) (x,i)). + (x,i) \in m). pred prefix_closed' (m : (from * int,to) fmap) = forall x n i, - mem (dom m) (x,n) => + (x,n) \in m => 0 <= i < n => - mem (dom m) (x,i). + (x,i) \in m. lemma prefix_closed_equiv m: prefix_closed m <=> prefix_closed' m. proof. smt(). qed. @@ -38,11 +38,11 @@ module IRO : IRO = { var mp : (from * int, to) fmap proc init() = { - mp <- map0; + mp <- empty; } proc fill_in(x, n) = { - if (!mem (dom mp) (x, n)) { + if ((x,n) \notin mp) { mp.[(x,n)] <$ dto; } return oget mp.[(x,n)]; @@ -74,7 +74,7 @@ module IRO' : IRO = { proc resample_invisible() = { var work, x; - work <- dom mp `\` visible; + work <- fdom mp `\` visible; while (work <> fset0) { x <- pick work; mp.[x] <$ dto; @@ -83,12 +83,12 @@ module IRO' : IRO = { } proc init() = { - mp <- map0; + mp <- empty; visible <- fset0; } proc fill_in(x,n) = { - if (!mem (dom mp) (x,n)) { + if ((x,n) \notin mp) { mp.[(x,n)] <$ dto; } return oget mp.[(x,n)]; diff --git a/sha3/proof/smart_counter/JointFMap.ec b/sha3/proof/smart_counter/JointFMap.ec new file mode 100644 index 0000000..7f53422 --- /dev/null +++ b/sha3/proof/smart_counter/JointFMap.ec @@ -0,0 +1,19 @@ +require import SmtMap. + +(*****) import Finite FSet List. + +op (+) (m1 m2 : ('a,'b) fmap) : ('a,'b) fmap = + ofmap (Map.offun (fun x=> if x \in m2 then m2.[x] else m1.[x])). + +lemma joinE ['a 'b] (m1 m2 : ('a,'b) fmap) (x : 'a): + (m1 + m2).[x] = if x \in m2 then m2.[x] else m1.[x]. +proof. +rewrite /(+) getE ofmapK /= 2:Map.getE 2:Map.offunK //. +apply/finiteP=> /=; exists (elems (fdom m1) ++ elems (fdom m2))=> x0 /=. +rewrite Map.getE Map.offunK /= mem_cat -!memE !mem_fdom !domE. +by case: (m2.[x0]). +qed. + +lemma mem_join ['a 'b] (m1 m2 : ('a,'b) fmap) (x : 'a): + x \in (m1 + m2) <=> x \in m1 \/ x \in m2. +proof. by rewrite domE joinE !domE; case: (m2.[x]). qed. \ No newline at end of file From 90cf57f9b767bc1eaed7bb307b312de693799962 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 18 Sep 2018 17:58:09 +0200 Subject: [PATCH 307/394] removing Utils that is never used --- sha3/proof/smart_counter/Utils.ec | 68 ------------------------------- 1 file changed, 68 deletions(-) delete mode 100644 sha3/proof/smart_counter/Utils.ec diff --git a/sha3/proof/smart_counter/Utils.ec b/sha3/proof/smart_counter/Utils.ec deleted file mode 100644 index 042cc64..0000000 --- a/sha3/proof/smart_counter/Utils.ec +++ /dev/null @@ -1,68 +0,0 @@ -(** These should make it into the standard libs **) -require import Core List FSet SmtMap. - -(* -------------------------------------------------------------------- *) -(* In SmtMap *) - -op reindex (f : 'a -> 'c) (m : ('a, 'b) fmap) = - SmtMap.ofmap ( - SmtMap.oflist (map (fun (x : 'a * 'b) => (f x.`1,x.`2)) (elems m)) - axiomatized by reindexE. - - - -lemma dom_reindex (f : 'a -> 'c) (m : ('a, 'b) fmap) x: - mem (dom (reindex f m)) x <=> mem (image f (dom m)) x. -proof. - rewrite reindexE dom_oflist imageP mapP /fst; split. - move=> [[x' y] [+ ->>]]. - rewrite mapP=> -[[x0 y0]] /= [h [->> ->>]] {x' y}. - by exists x0; rewrite domE mem_oflist mapP /fst; exists (x0,y0). - move=> [a] [a_in_m <<-]. - exists (f a,oget m.[a])=> /=; rewrite mapP /=. - exists (a,oget m.[a])=> //=. - have:= a_in_m; rewrite in_dom; case {-1}(m.[a]) (eq_refl m.[a])=> //=. - by move=> y; rewrite getE mem_assoc_uniq 1:uniq_keys. -qed. - - -lemma reindex_injective_on (f : 'a -> 'c) (m : ('a, 'b) fmap): - (forall x y, mem (dom m) x => f x = f y => x = y) => - (forall x, m.[x] = (reindex f m).[f x]). -proof. - move=> f_pinj x. - pose s:= elems (reindex f m). - case (assocP s (f x)). - rewrite -dom_oflist {1}/s elemsK dom_reindex imageP. - move=> [[a]] [] /f_pinj h /(h x) ->> {a}. - rewrite !getE. - move=> [y] [+ ->]. - rewrite /s reindexE. - pose s':= map (fun (x : 'a * 'b) => (f x.`1,x.`2)) (elems m). - have <- := (perm_eq_mem _ _ (oflistK s')). - (** FIXME: make this a lemma **) - have h' /h': forall (s : ('c * 'b) list) x, mem (reduce s) x => mem s x. - rewrite /reduce=> s0 x0; rewrite -{2}(cat0s s0); pose acc:= []. - elim s0 acc x0=> {s'} [acc x0 /=|x' s' ih acc x0 /=]. - by rewrite cats0. - move=> /ih; rewrite -cat1s catA cats1 !mem_cat=> -[|-> //=]. - rewrite /augment; case (mem (map fst acc) x'.`1)=> _ h'; left=> //. - by rewrite mem_rcons /=; right. - rewrite /s' mapP=> -[[a' b']] /= [xy_in_m []]. - rewrite eq_sym. - have h0 /h0 ->> <<- {a' b'}:= f_pinj a' x _. - + by rewrite domE mem_oflist mapP; exists (a',b'). - by apply/mem_assoc_uniq; 1:exact uniq_keys. - rewrite -mem_oflist {1}/s -domE=> -[] h; have := h; rewrite dom_reindex. - rewrite imageP=> h'. - have {h'} h': forall (a : 'a), !mem (dom m) a \/ f a <> f x. - + by move: h'=> /negb_exists /= + a - /(_ a) /negb_and. - have /= := h' x. - rewrite in_dom !getE /=. - by move=> -> ->. -qed. - -lemma reindex_injective (f : 'a -> 'c) (m : ('a, 'b) fmap): - injective f => - (forall x, m.[x] = (reindex f m).[f x]). -proof. by move=> f_inj; apply/reindex_injective_on=> + + _. qed. \ No newline at end of file From 21603d69cd4c373e7e209c6a9acb4a1b8bc1b954 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 18 Sep 2018 18:01:59 +0200 Subject: [PATCH 308/394] adding MapAux that is used in Sponge --- sha3/proof/MapAux.ec | 146 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 146 insertions(+) create mode 100644 sha3/proof/MapAux.ec diff --git a/sha3/proof/MapAux.ec b/sha3/proof/MapAux.ec new file mode 100644 index 0000000..a95f201 --- /dev/null +++ b/sha3/proof/MapAux.ec @@ -0,0 +1,146 @@ +(*---------------------- Auxiliary Lemmas on Maps ----------------------*) + +prover [""]. + +require import AllCore SmtMap FSet StdOrder. +import IntOrder. + +lemma get_none (m : ('a, 'b) fmap, x : 'a) : + x \notin m => m.[x] = None. +proof. by rewrite domE. qed. + +lemma get_some (m : ('a, 'b) fmap, x : 'a) : + x \in m => m.[x] = Some (oget m.[x]). +proof. move=> /domE; by case m.[x]. qed. + +lemma set_same (m : ('a, 'b) fmap, x : 'a) : + x \in m => m.[x <- oget m.[x]] = m. +proof. +move=> x_in_m. +apply fmap_eqP => y. +case (y = x) => [->> | ne_y_x]. +by rewrite get_set_sameE get_some. +by rewrite get_setE ne_y_x. +qed. + +lemma set_eq (m : ('a, 'b) fmap, x : 'a, y : 'b) : + m.[x] = Some y => m.[x <- y] = m. +proof. +move=> m_get_x_eq_y. +have x_in_m : x \in m by rewrite domE m_get_x_eq_y. +have -> : y = oget m.[x] by rewrite m_get_x_eq_y oget_some. +by rewrite set_same. +qed. + +lemma frng_set (m : ('a, 'b) fmap, x : 'a, y : 'b) : + frng m.[x <- y] = frng (rem m x) `|` fset1 y. +proof. +apply fsetP => z; rewrite in_fsetU in_fset1 2!mem_frng 2!rngE /=. +split => [[x'] | [[x'] | ->]]. +case (x' = x) => [-> | ne_x'_x]. +by rewrite get_set_sameE /= => ->. +rewrite get_setE ne_x'_x /= => get_x'_some_z. +left; exists x'; by rewrite remE ne_x'_x. +rewrite remE. +case (x' = x) => // ne_x'_x get_x'_some_z. +exists x'; by rewrite get_setE ne_x'_x. +exists x; by rewrite get_set_sameE. +qed. + +lemma eq_except_ne_in (x y : 'a, m1 m2 : ('a, 'b) fmap) : + eq_except (pred1 x) m1 m2 => y <> x => + y \in m1 => y \in m2. +proof. +move=> /eq_exceptP @/pred1 eq_exc ne_y_x. +by rewrite 2!domE eq_exc. +qed. + +lemma eq_except_setr_as_l (m1 m2 : ('a, 'b) fmap) x: + x \in m1 => eq_except (pred1 x) m1 m2 => + m1 = m2.[x <- oget m1.[x]]. +proof. +rewrite eq_exceptP -fmap_eqP=> x_in_m1 eqe x'. +rewrite get_setE /oget; case (x' = x)=> [->> |]. +by move: x_in_m1; rewrite domE; case (m1.[x]). +by move=> ne_x'_x; rewrite eqe. +qed. + +lemma eq_except_set_both x b b' (m : ('a, 'b) fmap): + eq_except (pred1 x) m.[x <- b] m.[x <- b']. +proof. by rewrite eq_exceptP=> x'; rewrite /pred1 !get_setE=> ->. qed. + +lemma eq_except_rem (m1 m2 : ('a,'b) fmap) (X : 'a -> bool) x: + X x => eq_except X m1 m2 => eq_except X m1 (rem m2 x). +proof. +move=> X_x /eq_exceptP eq_exc; rewrite eq_exceptP=> y X_y; rewrite remE. +case (y = x)=> [->> // | ne_y_x]; by apply eq_exc. +qed. + +lemma rem_id (m : ('a, 'b) fmap, x : 'a) : + x \notin m => rem m x = m. +proof. +move=> x_notin_m; apply fmap_eqP => y; rewrite remE. +case (y = x) => // ->. +case (None = m.[x]) => // get_not_none. +rewrite eq_sym -domE // in get_not_none. +qed. + +lemma map_empty (f : 'a -> 'b -> 'c, m : ('a, 'b) fmap) : + map f empty = empty. +proof. by rewrite -fmap_eqP=> x; rewrite mapE 2!emptyE. qed. + +lemma map_rem (f:'a -> 'b -> 'c) m (x:'a) : + map f (rem m x) = rem (map f m) x. +proof. +rewrite -fmap_eqP=> z; by rewrite !(mapE,remE); case (z = x). +qed. + +lemma map_id (m:('a,'b)fmap): map (fun _ b => b) m = m. +proof. by rewrite -fmap_eqP=>x; rewrite mapE; case (m.[x]). qed. + +lemma le_card_frng_fdom (m : ('a, 'b) fmap) : + card (frng m) <= card (fdom m). +proof. +move: m. +elim /fmapW=> [| m k v k_notin_m IH]. +by rewrite frng0 fdom0 2!fcards0. +rewrite mem_fdom in k_notin_m. +rewrite frng_set rem_id // fdom_set (fcardUI_indep _ (fset1 k)) + 1:fsetI1 1:mem_fdom 1:k_notin_m // fcard1 fcardU fcard1 + -addzA ler_add // -{2}(addz0 1) ler_add // oppz_le0 fcard_ge0. +qed. + +lemma fdom_frng_prop (X : 'a fset, m : ('a, 'a) fmap) : + fdom m \proper X => frng m \subset X => frng m \proper X. +proof. +rewrite /(\proper); move=> |>. +case (frng m = X)=> // ^ eq_frng_m_X -> fdom_m_sub_X fdom_m_ne_X _. +have card_fdom_m_lt_card_X : card (fdom m) < card X. + rewrite ltz_def; split. + case (card X = card (fdom m))=> // /eq_sym /subset_cardP. + by rewrite fdom_m_sub_X fdom_m_ne_X. + by rewrite subset_leq_fcard. +have card_X_le_card_fdom_m : card X <= card (fdom m) + by rewrite -eq_frng_m_X le_card_frng_fdom. +by rewrite /= -(ltzz (card X)) (ler_lt_trans (card (fdom m))). +qed. + +lemma fdom_frng_prop_type (m : ('a, 'a) fmap) : + (exists (x : 'a), ! x \in m) => + (exists (y : 'a), ! rng m y). +proof. +move=> [x x_notin_m]. +have : fdom m \proper fdom m `|` frng m `|` fset1 x. + rewrite /(\proper); split. + move=> z; rewrite 2!in_fsetU; move=> />. + case (fdom m = fdom m `|` frng m `|` fset1 x)=> // contra_eq. + rewrite -mem_fdom in x_notin_m. + have // : x \in fdom m by rewrite contra_eq 2!in_fsetU in_fset1. +pose univ := fdom m `|` frng m `|` fset1 x. +have fdom_prop_univ frng_sub_univ : frng m \subset univ + by move=> z @/univ; rewrite 2!in_fsetU; move=> />. +have : frng m \proper univ by apply fdom_frng_prop. +move=> /properP [_ [y [_ y_notin_frng_m]]]. +rewrite mem_frng in y_notin_frng_m. +by exists y. +qed. From 404c5aab3617b425d53ddd6d69e904659b1b1ff5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 18 Sep 2018 18:24:03 +0200 Subject: [PATCH 309/394] Clearing my confusion about branches : push Sponge --- sha3/proof/Sponge.ec | 202 +++++++++++++++++++++---------------------- 1 file changed, 99 insertions(+), 103 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 333ab74..72f010a 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -1,19 +1,13 @@ (*------------------------- Sponge Construction ------------------------*) -(* checks with both Alt-Ergo and Z3; all smt applications are - restricted to specific lemmas *) +prover quorum=2 ["Z3" "Alt-Ergo"]. -(* -prover ["Z3"]. -prover ["Alt-Ergo"]. -*) - -require import Core Int IntDiv Real List FSet NewFMap. +require import Core Int IntDiv Real List FSet SmtMap MapAux. (*---*) import IntExtra. require import Distr DBool DList. require import StdBigop StdOrder. import IntOrder. require import Common. -require (*--*) IRO BlockSponge RndO. +require (*--*) IRO BlockSponge PROM. (*------------------------- Indifferentiability ------------------------*) @@ -222,11 +216,11 @@ module HybridIROLazy : HYBRID_IRO, BlockSponge.BIRO.IRO = { var mp : (block list * int, bool) fmap proc init() : unit = { - mp <- map0; + mp <- empty; } proc fill_in(xs, i) = { - if (! mem (dom mp) (xs, i)) { + if (! dom mp (xs, i)) { mp.[(xs, i)] <$ dbool; } return oget mp.[(xs, i)]; @@ -262,11 +256,11 @@ module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { var mp : (block list * int, bool) fmap proc init() : unit = { - mp <- map0; + mp <- empty; } proc fill_in(xs, i) = { - if (! mem (dom mp) (xs, i)) { + if (! dom mp (xs, i)) { mp.[(xs, i)] <$ dbool; } return oget mp.[(xs, i)]; @@ -312,7 +306,7 @@ section. declare module D : HYBRID_IRO_DIST{HybridIROEager, HybridIROLazy}. -local clone RndO.GenEager as ERO with +local clone PROM.GenEager as ERO with type from <- block list * int, type to <- bool, op sampleto <- fun _ => dbool. @@ -381,7 +375,7 @@ local lemma HybridIROLazy_fill_in_LRO_get : ={res} /\ HybridIROLazy.mp{1} = ERO.RO.m{2}]. proof. proc=> /=. -case (mem (dom HybridIROLazy.mp{1}) (xs{1}, i{1})). +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. @@ -419,7 +413,7 @@ local lemma RO_get_HybridIROEager_fill_in : ={res} /\ ERO.RO.m{1} = HybridIROEager.mp{2}]. proof. proc=> /=. -case (mem (dom HybridIROEager.mp{2}) (xs{2}, i{2})). +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. @@ -432,7 +426,7 @@ local lemma RO_sample_HybridIROEager_fill_in : ERO.RO.m{1} = HybridIROEager.mp{2}]. proof. proc=> /=; inline ERO.RO.get; sp. -case (mem (dom HybridIROEager.mp{2}) (xs{2}, i{2})). +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. @@ -533,40 +527,41 @@ pred lazy_invar (mp1 : (bool list * int, bool) fmap, mp2 : (block list * int, bool) fmap) = (forall (bs : bool list, n : int), - mem (dom mp1) (bs, n) <=> mem (dom mp2) (pad2blocks bs, n)) /\ + dom mp1 (bs, n) <=> dom mp2 (pad2blocks bs, n)) /\ (forall (xs : block list, n), - mem (dom mp2) (xs, n) => valid_block xs) /\ + dom mp2 (xs, n) => valid_block xs) /\ (forall (bs : bool list, n : int), - mem (dom mp1) (bs, n) => + dom mp1 (bs, n) => oget mp1.[(bs, n)] = oget mp2.[(pad2blocks bs, n)]). -lemma lazy_invar0 : lazy_invar map0 map0. +lemma lazy_invar0 : lazy_invar empty empty. proof. -split; first smt(in_fset0 dom0). -split; smt(in_fset0 dom0). +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 => mem (dom mp1) (bs, i) => - mem (dom mp2) (pad2blocks bs, i). + 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 => mem (dom mp2) (pad2blocks bs, i) => - mem (dom mp1) (bs, i). + 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 => mem (dom mp2) (xs, n) => + lazy_invar mp1 mp2 => dom mp2 (xs, n) => valid_block xs. proof. smt(). qed. @@ -574,7 +569,7 @@ 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 => mem (dom mp1) (bs, n) => + lazy_invar mp1 mp2 => dom mp1 (bs, n) => oget mp1.[(bs, n)] = oget mp2.[(pad2blocks bs, n)]. proof. smt(). qed. @@ -583,15 +578,15 @@ lemma lazy_invar_upd_mem_dom_iff mp2 : (block list * int, bool) fmap, bs cs : bool list, n m : int, b : bool) : lazy_invar mp1 mp2 => - mem (dom mp1.[(bs, n) <- b]) (cs, m) <=> - mem (dom mp2.[(pad2blocks bs, n) <- b]) (pad2blocks cs, m). + 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 domP in_fsetU1; rewrite domP in_fsetU1 in mem_upd_mp1. +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 domP in_fsetU1; rewrite domP in_fsetU1 in mem_upd_mp2. +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. @@ -602,11 +597,11 @@ lemma lazy_invar_upd2_vb mp2 : (block list * int, bool) fmap, bs : bool list, xs : block list, n m : int, b : bool) : lazy_invar mp1 mp2 => - mem (dom mp2.[(pad2blocks bs, n) <- b]) (xs, m) => + dom mp2.[(pad2blocks bs, n) <- b] (xs, m) => valid_block xs. proof. move=> li mem_upd_mp2. -rewrite domP in_fsetU1 in mem_upd_mp2. +rewrite mem_set in mem_upd_mp2. elim mem_upd_mp2=> [/# | [-> _]]. apply valid_pad2blocks. qed. @@ -616,18 +611,18 @@ lemma lazy_invar_upd_lu_eq mp2 : (block list * int, bool) fmap, bs cs : bool list, n m : int, b : bool) : lazy_invar mp1 mp2 => - mem (dom mp1.[(bs, n) <- b]) (cs, m) => + 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]. -smt(getP_eq). -rewrite domP in_fsetU1 in mem_upd_mp1. +smt(get_setE). +rewrite mem_set in mem_upd_mp1. elim mem_upd_mp1=> [mem_mp1 | [-> ->]]. case: ((pad2blocks bs, n) = (pad2blocks cs, m))=> [[p2b_bs_p2b_cs eq_mn] | p2b_bs_n_neq_p2b_cs_m]. -smt(pad2blocks_inj). smt(getP). smt(getP). +smt(pad2blocks_inj). smt(get_setE). smt(get_setE). qed. lemma LowerFun_IRO_HybridIROLazy_f : @@ -662,7 +657,7 @@ progress; by apply (lazy_invar_mem_pad2blocks_r2l IRO.mp{1} HybridIROLazy.mp{2} x{1} i{2})]. rnd; auto; progress; - [by rewrite !getP_eq | + [by rewrite !get_setE | by rewrite -(lazy_invar_upd_mem_dom_iff IRO.mp{1}) | by rewrite (lazy_invar_upd_mem_dom_iff IRO.mp{1} HybridIROLazy.mp{2}) | by rewrite (lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} @@ -699,7 +694,7 @@ progress; by apply (lazy_invar_mem_pad2blocks_r2l IRO.mp{1} HybridIROLazy.mp{2} x{1} i{2})]. rnd; auto; progress; - [by rewrite !getP_eq | + [by rewrite !get_setE | by rewrite -(lazy_invar_upd_mem_dom_iff IRO.mp{1}) | by rewrite (lazy_invar_upd_mem_dom_iff IRO.mp{1} HybridIROLazy.mp{2}) | by rewrite (lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} @@ -716,21 +711,21 @@ pred eager_invar (mp1 : (block list * int, block) fmap, mp2 : (block list * int, bool) fmap) = (forall (xs : block list, i : int), - mem (dom mp1) (xs, i) => + 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), - mem (dom mp2) (xs, j) => mem (dom mp1) (xs, j %/ r)). + 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 => mem (dom mp) (xs, j). + 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 => ! mem (dom mp) (xs, j). + 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) = @@ -740,23 +735,23 @@ 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 => mem (dom mp1) (xs, i) => 0 <= i. + 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 => mem (dom mp2) (xs, j) => 0 <= j. + eager_invar mp1 mp2 => dom mp2 (xs, j) => 0 <= j. proof. move=> [ei1 ei2] mem_mp2_j. -have mem_mp1_j_div_r : mem (dom mp1) (xs, j %/ r) by smt(). +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 map0 map0. -proof. split; smt(dom0 in_fset0). 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, @@ -766,15 +761,15 @@ lemma eager_inv_imp_block_bits_dom block_bits_dom_all_in_or_out xs i mp2. proof. move=> ge0_i r_dvd_i [ei1 ei2]. -case: (mem (dom mp1) (xs, i %/ r))=> [mem_mp1 | not_mem_mp1]. +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 in_dom /#. +rewrite domE /#. right=> j j_rng. -case: (mem (dom mp2) (xs, j))=> // mem_mp2 /=. +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(). @@ -786,12 +781,12 @@ 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 => mem (dom mp1) (xs, i) => + 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 in_dom. +rewrite domE. have /# := eq_mp2_block_i j _; smt(). qed. @@ -799,11 +794,11 @@ 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 => ! mem (dom mp1) (xs, i) => + 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 (mem (dom mp2) (xs, j))=> // mem_mp2_j. +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 @@ -814,13 +809,13 @@ 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 => mem (dom mp) (xs, i) => + 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 => ! mem (dom mp) (xs, i) => + 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. @@ -871,7 +866,7 @@ module HybridIROEagerTrans = { proc next_block_split(xs, i, m : int, bs) = { var b, j, cs; - if (mem (dom HybridIROEager.mp) (xs, i)) { + if (dom HybridIROEager.mp (xs, i)) { while (i < m) { b <- oget HybridIROEager.mp.[(xs, i)]; bs <- rcons bs b; @@ -920,8 +915,8 @@ lemma eager_eq_except_mem_iff mp1 mp2 : (block list * int, bool) fmap) : eager_eq_except xs i j mp1 mp2 => ys <> xs \/ k < i \/ j <= k => - mem (dom mp1) (ys, k) <=> mem (dom mp2) (ys, k). -proof. smt(in_dom get_oget). qed. + dom mp1 (ys, k) <=> dom mp2 (ys, k). +proof. smt(domE get_some). qed. lemma eager_eq_except_upd1_eq_in (xs : block list, i j k : int, y : bool, @@ -931,7 +926,7 @@ lemma eager_eq_except_upd1_eq_in proof. move=> eee le_ik lt_kj ys l disj. have ne : (xs, k) <> (ys, l) by smt(). -smt(getP). +smt(get_setE). qed. lemma eager_eq_except_upd2_eq_in @@ -942,7 +937,7 @@ lemma eager_eq_except_upd2_eq_in proof. move=> eee le_ik lt_kj ys l disj. have ne : (xs, k) <> (ys, l) by smt(). -smt(getP). +smt(get_setE). qed. lemma eager_eq_except_maps_eq @@ -954,7 +949,7 @@ lemma eager_eq_except_maps_eq mp1 = mp2. proof. move=> lt_ij eee ran_k. -apply fmapP=> p. +apply fmap_eqP=> p. have [ys k] -> /# : exists ys k, p = (ys, k) by exists p.`1 p.`2; smt(). qed. @@ -977,12 +972,12 @@ 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 getP_eq mp2'_ran_eq -eq_k_i. -rewrite domP in_fsetU1 in mem_mp1_upd_xs_i_y_ys_k. +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 : mem (dom mp1) (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 getP. +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 <- : @@ -999,31 +994,31 @@ have /# : j < i * r \/ (i + 1) * r <= j. 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 domP in_fsetU1 in mem_mp1_upd_xs_i_y_ys_k. +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 : mem (dom mp1) (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 getP. +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 domP in_fsetU1. +rewrite domE. case: (xs = ys)=> [-> | ne_xs_ys]. case: (k < i * r)=> [lt_k_i_tim_r | not_lt_k_i_tim_r]. -smt(eager_eq_except_mem_iff). +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(eager_eq_except_mem_iff). -right. +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(eager_eq_except_mem_iff). +smt(get_setE eager_eq_except_mem_iff). +smt(get_setE eager_eq_except_mem_iff). qed. lemma HybridIROEagerTrans_next_block_split : @@ -1035,27 +1030,27 @@ lemma HybridIROEagerTrans_next_block_split : ={res, HybridIROEager.mp}]. proof. proc=> /=. -case (mem (dom HybridIROEager.mp{2}) (xs{2}, i{2})). -(* mem (dom HybridIROEager.mp{2}) (xs{2}, i{2}) *) +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} => - mem (dom HybridIROEager.mp{1}) (xs{1}, j)) ==> + 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} => - mem (dom HybridIROEager.mp{1}) (xs{1}, j))). + dom HybridIROEager.mp{1} (xs{1}, j))). wp; inline*. rcondf{1} 3; first auto; smt(). auto; smt(). auto. -(* ! mem (dom HybridIROEager.mp{2}) (xs{2}, i{2}) *) +(* ! dom HybridIROEager.mp{2} (xs{2}, i{2}) *) rcondf{2} 1; first auto. sp; exists* i{1}; elim*=> i'. conseq @@ -1064,7 +1059,7 @@ conseq i' + r = m{1} /\ size bs{1} = i' /\ cs{2} = [] /\ j{2} = 0 /\ (forall (j : int), i' <= j < i' + r => - ! mem (dom HybridIROEager.mp{1}) (xs{1}, j)) ==> + ! dom HybridIROEager.mp{1} (xs{1}, j)) ==> _). progress; smt(gt0_r). seq 1 2 : @@ -1084,7 +1079,7 @@ while HybridIROEager.mp{1}.[(xs{1}, k)] = Some(nth true bs{1} k)) /\ (forall (k : int), i{1} <= k < i' + r => - ! mem (dom HybridIROEager.mp{1}) (xs{1}, k)) /\ + ! 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. @@ -1092,13 +1087,14 @@ 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 getP_eq oget_some. +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 getP_eq oget_some. +by rewrite get_set_sameE oget_some. have -> /= : k < size(bs{2} ++ cs{2}) by smt(). -rewrite getP ne_k_size_bs_cat_cs /= /#. -rewrite domP in_fsetU1 /#. +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). @@ -1125,7 +1121,7 @@ while{2} HybridIROEager.mp{1} HybridIROEager.mp{2}) (m{2} - i{2}). progress; auto; progress; - [smt() | smt(gt0_r) | smt(getP) | smt() | + [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)]. @@ -1289,8 +1285,8 @@ 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 (mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2})). -(* mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2}) *) +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 : @@ -1303,7 +1299,7 @@ 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} /\ - mem (dom 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} ==> bs{1} = blocks2bits (rcons bs{2} (oget BlockSponge.BIRO.IRO.mp{2}.[(xs{1}, i2)])) /\ @@ -1316,7 +1312,7 @@ while{1} bs1 ++ take (i{1} - i1) (ofblock (oget(BlockSponge.BIRO.IRO.mp{2}.[(xs{1}, i2)]))) /\ - mem (dom 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. @@ -1354,7 +1350,7 @@ 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(). -(* ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2}) *) +(* ! 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} @@ -1409,7 +1405,7 @@ conseq progress; [by rewrite ofblockK | rewrite size_cat size_blocks2bits /#]. progress; - [by rewrite -cats1 blocks2bits_cat blocks2bits_sing getP_eq + [by rewrite -cats1 blocks2bits_cat blocks2bits_sing get_set_sameE oget_some ofblockK | by rewrite size_rcons]. while{1} @@ -1428,8 +1424,8 @@ 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 getP /=; smt(nth_onth onth_nth). -rewrite getP. +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(). @@ -1927,13 +1923,13 @@ local lemma Ideal_IRO_Experiment_HybridLazy &m : proof. byequiv=> //; proc. seq 2 2 : - (={glob Dist, glob BlockSim} /\ IRO.mp{1} = NewFMap.map0 /\ - HIRO.HybridIROLazy.mp{2} = NewFMap.map0). + (={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} = map0 /\ HIRO.HybridIROLazy.mp{2} = map0 ==> + IRO.mp{1} = empty /\ HIRO.HybridIROLazy.mp{2} = empty ==> ={res}). proc (={glob BlockSim} /\ @@ -2045,13 +2041,13 @@ local lemma Experiment_HybridEager_Ideal_BlockIRO &m : proof. byequiv=> //; proc. seq 2 2 : - (={glob Dist, glob BlockSim} /\ HIRO.HybridIROEager.mp{1} = NewFMap.map0 /\ - BlockSponge.BIRO.IRO.mp{2} = NewFMap.map0). + (={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} = map0 /\ BlockSponge.BIRO.IRO.mp{2} = map0 ==> + HIRO.HybridIROEager.mp{1} = empty /\ BlockSponge.BIRO.IRO.mp{2} = empty ==> ={res}). proc (={glob BlockSim} /\ From 6cdae5cbdf461dc6de6df583bb8b352e50313113 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 18 Sep 2018 18:33:10 +0200 Subject: [PATCH 310/394] updating complete --- sha3/proof/SHA3-Security.ec | 24 ++++++++++++------------ sha3/proof/smart_counter/Gconcl_list.ec | 2 -- 2 files changed, 12 insertions(+), 14 deletions(-) diff --git a/sha3/proof/SHA3-Security.ec b/sha3/proof/SHA3-Security.ec index 3cbd007..3116fcd 100644 --- a/sha3/proof/SHA3-Security.ec +++ b/sha3/proof/SHA3-Security.ec @@ -1,6 +1,6 @@ (* Top-level Proof of SHA-3 Security *) -require import AllCore List IntDiv StdOrder Distr NewFMap FSet. +require import AllCore List IntDiv StdOrder Distr SmtMap FSet. require import Common Sponge. import BIRO. @@ -27,15 +27,15 @@ module Simulator (F : DFUNCTIONALITY) = { var mi : (state, state) fmap var paths : (capacity, block list * block) fmap proc init() = { - m <- map0; - mi <- map0; - paths <- map0.[c0 <- ([],b0)]; + 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 \in dom m) { - if (x.`2 \in dom paths) { + if (x \notin m) { + if (x.`2 \in paths) { (p,v) <- oget paths.[x.`2]; z <- []; (q,k) <- parse (rcons p (v +^ x.`1)); @@ -53,7 +53,7 @@ module Simulator (F : DFUNCTIONALITY) = { y <- (y1,y2); m.[x] <- y; mi.[y] <- x; - if (x.`2 \in dom paths) { + if (x.`2 \in paths) { (p,v) <-oget paths.[x.`2]; paths.[y2] <- (rcons p (v +^ x.`1),y.`1); } @@ -64,7 +64,7 @@ module Simulator (F : DFUNCTIONALITY) = { } proc fi (x : state) : state = { var y,y1,y2; - if (! x \in dom mi) { + if (! x \in mi) { y1 <$ bdistr; y2 <$ cdistr; y <- (y1,y2); @@ -276,13 +276,13 @@ qed. lemma security &m : `|Pr[RealIndif(Sponge, Perm, DRestr(Dist)).main() @ &m : res] - Pr[IdealIndif(IRO, Simulator, DRestr(Dist)).main() @ &m : res]| <= - (limit ^ 2)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. + (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. proof. rewrite -(replace_simulator &m). rewrite powS 1:addz_ge0 1:ge0_r 1:ge0_c -pow_add 1:ge0_r 1:ge0_c. have -> : - (limit ^ 2)%r / (2 * (2 ^ r * 2 ^ c))%r = - ((limit ^ 2)%r / 2%r) * (1%r / (2 ^ r)%r) * (1%r / (2 ^ c)%r). + (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). rewrite (fromintM 2) StdRing.RField.invfM StdRing.RField.mulrA -!StdRing.RField.mulrA. congr. @@ -325,7 +325,7 @@ lemma SHA3Security 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)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. + (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/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec index 844dcfd..32e7e8d 100644 --- a/sha3/proof/smart_counter/Gconcl_list.ec +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -380,8 +380,6 @@ section Ideal. by auto;smt(parse_valid parseK formatK). qed. - require import JointFMap. - 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) From 8f88425dde19e1e37a4c3410fcf202251736811c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 18 Sep 2018 19:38:09 +0100 Subject: [PATCH 311/394] cleaning files out and reactivating CI --- sha3/proof/Common.ec | 6 +- sha3/proof/NewFMap.ec | 818 ---------------------- sha3/proof/RP.eca | 79 --- sha3/proof/RndO.ec | 699 ------------------ sha3/proof/SHA3-Security.ec | 8 +- sha3/proof/smart_counter/Handle.eca | 52 +- sha3/proof/smart_counter/JointFMap.ec | 19 - sha3/proof/smart_counter/Strong_rp_rf.eca | 608 ---------------- 8 files changed, 47 insertions(+), 2242 deletions(-) delete mode 100644 sha3/proof/NewFMap.ec delete mode 100644 sha3/proof/RP.eca delete mode 100644 sha3/proof/RndO.ec delete mode 100644 sha3/proof/smart_counter/JointFMap.ec delete mode 100644 sha3/proof/smart_counter/Strong_rp_rf.eca diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index d8f6046..65f6c06 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -98,13 +98,13 @@ 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 /=; have -> : 1 + size zs - 1 = size zs by ring. +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 (@last_nonempty y z). +case (zs = [])=> // zs_non_nil. elim ih=> //. +by rewrite addzC (@last_nonempty y z). qed. (*------------------------------ Primitive -----------------------------*) diff --git a/sha3/proof/NewFMap.ec b/sha3/proof/NewFMap.ec deleted file mode 100644 index 6d5b089..0000000 --- a/sha3/proof/NewFMap.ec +++ /dev/null @@ -1,818 +0,0 @@ -(* -------------------------------------------------------------------- - * Copyright (c) - 2012--2016 - IMDEA Software Institute - * Copyright (c) - 2012--2018 - Inria - * Copyright (c) - 2012--2018 - Ecole Polytechnique - * - * Distributed under the terms of the CeCILL-B-V1 license - * -------------------------------------------------------------------- *) - -(* -------------------------------------------------------------------- *) -require import AllCore Int List FSet. - -pragma -oldip. -pragma +implicits. - -(* -------------------------------------------------------------------- *) -lemma perm_eq_uniq_map (f : 'a -> 'b) (s1 s2 : 'a list): - perm_eq s1 s2 => uniq (map f s1) <=> uniq (map f s2). -proof. by move=> /(perm_eq_map f) /perm_eq_uniq ->. qed. - -lemma uniq_perm_eq_map (s1 s2 : ('a * 'b) list) (f: 'a * 'b -> 'c): - uniq (map f s1) => uniq (map f s2) - => (forall (x : 'a * 'b), mem s1 x <=> mem s2 x) - => perm_eq s1 s2. -proof. by move=> /uniq_map h1 /uniq_map h2 /(uniq_perm_eq _ _ h1 h2). qed. - -(* -------------------------------------------------------------------- *) -op augment (s : ('a * 'b) list) (kv : 'a * 'b) = - if mem (map fst s) kv.`1 then s else rcons s kv. - -lemma nosmt augment_nil (kv : 'a * 'b): augment [] kv = [kv]. -proof. by []. qed. - -lemma augmentP (s : ('a * 'b) list) x y: - ( mem (map fst s) x /\ augment s (x, y) = s) - \/ (! mem (map fst s) x /\ augment s (x, y) = rcons s (x, y)). -proof. by case: (mem (map fst s) x)=> //=; rewrite /augment => ->. qed. - -op reduce (xs : ('a * 'b) list): ('a * 'b) list = - foldl augment [] xs. - -lemma reduce_nil: reduce [<:'a * 'b>] = []. -proof. by []. qed. - -lemma nosmt reduce_cat (r s : ('a * 'b) list): - foldl augment r s - = r ++ filter (predC (mem (map fst r)) \o fst) (foldl augment [] s). -proof. -rewrite -(@revK s) !foldl_rev; pose f := fun x z => augment z x. -elim/last_ind: s r => /=. - by move=> r; rewrite !rev_nil /= cats0. -move=> s [x y] ih r; rewrite !rev_rcons /= ih => {ih}. -rewrite {1}/f {1}/augment map_cat mem_cat /=. -pose t1 := map fst _; pose t2 := map fst _. -case: (mem t1 x \/ mem t2 x) => //; last first. - rewrite negb_or => -[t1_x t2_x]; rewrite rcons_cat; congr. - rewrite {2}/f /augment /=; pose t := map fst _. - case: (mem t x) => h; last first. - by rewrite filter_rcons /= /(\o) /predC t1_x. - have: mem t2 x; rewrite // /t2 /(\o). - have <- := filter_map<:'a, 'a * 'b> fst (predC (mem t1)). - by rewrite mem_filter /predC t1_x. -case=> h; congr; rewrite {2}/f /augment /=; last first. - move: h; rewrite /t2 => /mapP [z] [h ->>]. - by move: h; rewrite mem_filter => -[_ /(map_f fst) ->]. -case: (List.mem _ _) => //=; rewrite filter_rcons. -by rewrite /(\o) /predC h. -qed. - -lemma reduce_cons (x : 'a) (y : 'b) s: - reduce ((x, y) :: s) - = (x, y) :: filter (predC1 x \o fst) (reduce s). -proof. by rewrite {1}/reduce /= augment_nil reduce_cat cat1s. qed. - -lemma assoc_reduce (s : ('a * 'b) list): - forall x, assoc (reduce s) x = assoc s x. -proof. -move=> x; elim: s => //; case=> x' y' s ih. -rewrite reduce_cons !assoc_cons; case: (x = x')=> // ne_xx'. -by rewrite assoc_filter /predC1 ne_xx'. -qed. - -lemma dom_reduce (s : ('a * 'b) list): - forall x, mem (map fst (reduce s)) x <=> mem (map fst s) x. -proof. -move=> x; elim: s => [|[x' y] s ih] /=; 1: by rewrite reduce_nil. -rewrite reduce_cons /=; apply/orb_id2l. -rewrite /(\o) /= => ne_xx'. -by rewrite -(@filter_map _ (predC1 x')) mem_filter /predC1 ne_xx' /= ih. -qed. - -lemma reduced_reduce (s : ('a * 'b) list): uniq (map fst (reduce s)). -proof. -elim: s => [|[x y] s ih]; 1: by rewrite reduce_nil. -rewrite reduce_cons /= ; split. -+ by apply/negP=> /mapP [[x' y']]; rewrite mem_filter=> -[# h1 h2 ->>]. -rewrite /(\o); have <- := filter_map fst<:'a, 'b> (predC1 x). -by rewrite filter_uniq. -qed. - -lemma reduce_reduced (s : ('a * 'b) list): - uniq (map fst s) => reduce s = s. -proof. -elim: s => [|[x y] s ih]; 1: by rewrite reduce_nil. -rewrite reduce_cons /= => -[x_notin_s /ih ->]. -rewrite (@eq_in_filter _ predT) ?filter_predT /predT //=. -case=> x' y' /(map_f fst) x'_in_s; apply/negP => <<-. -by move: x_notin_s. -qed. - -lemma reduceK (xs : ('a * 'b) list): reduce (reduce xs) = reduce xs. -proof. by rewrite reduce_reduced 1:reduced_reduce. qed. - -lemma mem_reduce_head (xs : ('a * 'b) list) a b: - mem (reduce ((a, b) :: xs)) (a, b). -proof. by rewrite reduce_cons. qed. - -(* -------------------------------------------------------------------- *) -(* Finite maps are abstractely represented as the quotient by *) -(* [perm_eq] of lists of pairs without first projection duplicates. *) - -type ('a, 'b) fmap. - -op elems : ('a, 'b) fmap -> ('a * 'b) list. -op oflist : ('a * 'b) list -> ('a,'b) fmap. - -axiom elemsK (m : ('a, 'b) fmap) : Self.oflist (elems m) = m. -axiom oflistK (s : ('a * 'b) list): perm_eq (reduce s) (elems (Self.oflist s)). - -lemma uniq_keys (m : ('a, 'b) fmap): uniq (map fst (elems m)). -proof. -rewrite -elemsK; move: (elems m) => {m} m. -apply (@perm_eq_uniq (map fst (reduce m)) _). -+ by apply perm_eq_map; apply oflistK. -by apply reduced_reduce. -qed. - -axiom fmap_eq (s1 s2 : ('a,'b) fmap): - (perm_eq (elems s1) (elems s2)) <=> (s1 = s2). - -(* -------------------------------------------------------------------- *) -lemma fmapW (p : ('a, 'b) fmap -> bool): - (forall m, uniq (map fst m) => p (Self.oflist m)) - => forall m, p m. -proof. by move=> ih m; rewrite -elemsK; apply/ih/uniq_keys. qed. - -(* -------------------------------------------------------------------- *) -op "_.[_]" (m : ('a,'b) fmap) (x : 'a) = assoc (elems m) x - axiomatized by getE. - -lemma get_oflist (s : ('a * 'b) list): - forall x, (Self.oflist s).[x] = assoc s x. -proof. -move=> x; rewrite getE; rewrite -(@assoc_reduce s). -apply/eq_sym/perm_eq_assoc; 1: by apply/uniq_keys. -by apply/oflistK. -qed. - -lemma fmapP (m1 m2 : ('a,'b) fmap): - (m1 = m2) <=> (forall x, m1.[x] = m2.[x]). -proof. -split=> // h; apply/fmap_eq/uniq_perm_eq; ~3:by apply/(@uniq_map fst)/uniq_keys. -case=> x y; move: (h x); rewrite !getE => {h} h. -by rewrite !mem_assoc_uniq ?uniq_keys // h. -qed. - -(* -------------------------------------------------------------------- *) -op map0 ['a,'b] = Self.oflist [<:'a * 'b>] axiomatized by map0E. - -(* -------------------------------------------------------------------- *) -op "_.[_<-_]" (m : ('a, 'b) fmap) (a : 'a) (b : 'b) = - Self.oflist (reduce ((a, b) :: elems m)) - axiomatized by setE. - -lemma getP (m : ('a, 'b) fmap) (a : 'a) (b : 'b) (x : 'a): - m.[a <- b].[x] = if x = a then Some b else m.[x]. -proof. -by rewrite setE get_oflist assoc_reduce assoc_cons getE; case: (x = a). -qed. - -lemma getP_eq (m : ('a, 'b) fmap) (a : 'a) (b : 'b): - m.[a <- b].[a] = Some b. -proof. by rewrite getP. qed. - -lemma getP_neq (m : ('a, 'b) fmap) (a1 a2 : 'a) (b : 'b): - a1 <> a2 => - m.[a1 <- b].[a2] = m.[a2]. -proof. by rewrite getP eq_sym=> ->. qed. - -lemma set_set (m : ('a,'b) fmap) x x' y y': - m.[x <- y].[x' <- y'] = if x = x' then m.[x' <- y'] - else m.[x' <- y'].[x <- y]. -proof. -rewrite fmapP=> a; case (x = x')=> [<<- {x'} | ne_x_x']; rewrite !getP. -+ by case (a = x). -by case (a = x')=> //; case (a = x)=> // ->;rewrite ne_x_x'. -qed. - -lemma nosmt set_set_eq y (m : ('a, 'b) fmap) x y': - m.[x <- y].[x <- y'] = m.[x <- y']. -proof. by rewrite fmapP=> a; rewrite set_set. qed. - -(* -------------------------------------------------------------------- *) -op rem (a : 'a) (m : ('a, 'b) fmap) = - Self.oflist (filter (predC1 a \o fst) (elems m)) - axiomatized by remE. - -lemma remP (a : 'a) (m : ('a, 'b) fmap): - forall x, (rem a m).[x] = if x = a then None else m.[x]. -proof. -move=> x; rewrite remE get_oflist assoc_filter; case (x = a)=> //=. -by rewrite /predC1 getE=> ->. -qed. - -(* -------------------------------------------------------------------- *) -op dom ['a 'b] (m : ('a, 'b) fmap) = - FSet.oflist (map fst (elems m)) - axiomatized by domE. - -lemma dom_oflist (s : ('a * 'b) list): - forall x, mem (dom (Self.oflist s)) x <=> mem (map fst s) x. -proof. -move=> x; rewrite domE mem_oflist. -have/perm_eq_sym/(perm_eq_map fst) := oflistK s. -by move/perm_eq_mem=> ->; apply/dom_reduce. -qed. - -lemma mem_domE (m : ('a, 'b) fmap) x: - mem (dom m) x <=> mem (map fst (elems m)) x. -proof. by rewrite domE mem_oflist. qed. - -lemma in_dom (m : ('a, 'b) fmap) x: - mem (dom m) x <=> m.[x] <> None. -proof. -rewrite mem_domE getE. -by case: (assocP (elems m) x)=> [[-> [y [_ ->]]] | [-> ->]]. -qed. - -lemma fmap_domP (m1 m2 : ('a, 'b) fmap): - (m1 = m2) <=> (forall x, mem (dom m1) x = mem (dom m2) x) - /\ (forall x, mem (dom m1) x => m1.[x] = m2.[x]). -proof. -split=> // [[]] eq_dom eq_on_dom. -apply fmapP=> x; case: (mem (dom m1) x). -+ by apply eq_on_dom. -move=> ^; rewrite {2}eq_dom !in_dom /=. -by move=> -> ->. -qed. - -lemma get_oget (m:('a,'b)fmap) (x:'a) : - mem (dom m) x => m.[x] = Some (oget m.[x]). -proof. by rewrite in_dom; case: (m.[x]). qed. - -(* -------------------------------------------------------------------- *) -op rng ['a 'b] (m : ('a, 'b) fmap) = - FSet.oflist (map snd (elems m)) - axiomatized by rngE. - -lemma mem_rngE (m : ('a, 'b) fmap) y: - mem (rng m) y <=> mem (map snd (elems m)) y. -proof. by rewrite rngE mem_oflist. qed. - -lemma in_rng (m: ('a,'b) fmap) (b : 'b): - mem (rng m) b <=> (exists a, m.[a] = Some b). -proof. -rewrite mem_rngE; split. -+ move/List.mapP=> [] [x y] [h ->]; exists x. - by rewrite getE -mem_assoc_uniq 1:uniq_keys. -case=> x; rewrite getE -mem_assoc_uniq ?uniq_keys // => h. -by apply/List.mapP; exists (x, b). -qed. - -(* -------------------------------------------------------------------- *) -op has (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap) = - List.has (fun (x : 'a * 'b), p x.`1 x.`2) (elems m) - axiomatized by hasE. - -lemma hasP p (m : ('a, 'b) fmap): - has p m <=> (exists x, mem (dom m) x /\ p x (oget m.[x])). -proof. -rewrite hasE hasP /=; split=> [[[a b]] /= [^ab_in_m+ p_a_b] |[a] []]. -+ rewrite mem_assoc_uniq 1:uniq_keys // -getE => ma_b. - by exists a; rewrite ma_b mem_domE /oget /= p_a_b /= mem_map_fst; exists b. -rewrite mem_domE mem_map_fst=> -[b] ^ab_in_m+. -by rewrite mem_assoc_uniq 1:uniq_keys // getE /oget=> -> /= p_a_b; exists (a,b). -qed. - -(* FIXME: name *) -lemma has_le p' (m : ('a, 'b) fmap) (p : 'a -> 'b -> bool): - (forall x y, mem (dom m) x /\ p x y => mem (dom m) x /\ p' x y) => - has p m => - has p' m. -proof. -by move=> le_p_p'; rewrite !hasP=> -[x] /le_p_p' [p'_x x_in_m]; exists x. -qed. - -(* -------------------------------------------------------------------- *) -op all (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap) = - List.all (fun (x : 'a * 'b), p x.`1 x.`2) (elems m) - axiomatized by allE. - -lemma allP p (m : ('a, 'b) fmap): - all p m <=> (forall x, mem (dom m) x => p x (oget m.[x])). -proof. -rewrite allE allP; split=> [h a|h [a b] /= ^ab_in_m]. -+ rewrite mem_domE mem_map_fst=> -[b] ^ab_in_m+. - by rewrite mem_assoc_uniq 1:uniq_keys -getE /oget=> ->; apply (@h (a,b)). -rewrite mem_assoc_uniq 1:uniq_keys -getE=> /(@congr1 oget) <-. -by apply/h; rewrite mem_domE mem_map_fst; exists b. -qed. - -lemma all_le p' (m : ('a, 'b) fmap) (p : 'a -> 'b -> bool): - (forall x y, mem (dom m) x /\ p x y => mem (dom m) x /\ p' x y) => - all p m => - all p' m. -proof. -move=> le_p_p'. rewrite !allP=> h x ^x_in_m /h p_x. -exact/(andWr _ (:@le_p_p' x (oget m.[x]) _)). -qed. - -(* -------------------------------------------------------------------- *) -lemma has_all (m : ('a, 'b) fmap) (p : 'a -> 'b -> bool): - has p m <=> !all (fun x y, !p x y) m. -proof. -rewrite hasP allP negb_forall /=; split=> [[x] [x_in_m p_x]|[] x]. -+ by exists x; rewrite p_x. -by rewrite negb_imply /= => h; exists x. -qed. - -(* -------------------------------------------------------------------- *) -op (+) (m1 m2 : ('a, 'b) fmap) = Self.oflist (elems m2 ++ elems m1) - axiomatized by joinE. - -lemma joinP (m1 m2 : ('a, 'b) fmap) x: - (m1 + m2).[x] = if mem (dom m2) x then m2.[x] else m1.[x]. -proof. by rewrite joinE get_oflist mem_domE assoc_cat -!getE. qed. - -(* -------------------------------------------------------------------- *) -op find (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap) = - onth (map fst (elems m)) (find (fun (x : 'a * 'b), p x.`1 x.`2) (elems m)) - axiomatized by findE. - -(** The following are inspired from lemmas on List.find. findP is a - total characterization, but a more usable interface may be useful. **) -lemma find_none (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap): - has p m <=> find p m <> None. -proof. -rewrite hasE /= findE List.has_find; split=> [h|]. -+ by rewrite (@onth_nth witness) 1:find_ge0/= 1:size_map. -by apply/contraLR=> h; rewrite onth_nth_map -map_comp nth_default 1:size_map 1:lezNgt. -qed. - -lemma findP (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap): - (exists x, find p m = Some x /\ mem (dom m) x /\ p x (oget m.[x])) - \/ (find p m = None /\ forall x, mem (dom m) x => !p x (oget m.[x])). -proof. -case: (has p m)=> [^has_p | ^all_not_p]. -+ rewrite hasE has_find. - have:= find_ge0 (fun (x : 'a * 'b) => p x.`1 x.`2) (elems m). - pose i:= find _ (elems m); move => le0_i lt_i_sizem; left. - exists (nth witness (map ofst (elems m)) i); split. - + by rewrite findE -/i (@onth_nth witness) 1:size_map. - split. - + by rewrite mem_domE -index_mem index_uniq 1,3:size_map 2:uniq_keys. - have /= := nth_find witness (fun (x : 'a * 'b) => p (ofst x) (osnd x)) (elems m) _. - + by rewrite -hasE. - rewrite -/i -(@nth_map _ witness) // getE /assoc - (@index_uniq witness i (map fst (elems m))). - + by rewrite size_map. - + exact/uniq_keys. - by rewrite (@onth_nth witness) //. -rewrite has_all /= allP /= => h; right. -by split=> //; move: all_not_p; rewrite find_none. -qed. - -(* -------------------------------------------------------------------- *) -op filter (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap) = - oflist (filter (fun (x : 'a * 'b) => p x.`1 x.`2) (elems m)) - axiomatized by filterE. - -(* FIXME: Move me *) -lemma filter_mem_map (p : 'a -> bool) (f : 'a -> 'b) (s : 'a list) x': - mem (map f (filter p s)) x' => mem (map f s) x'. -proof. by elim s=> //= x xs ih; case (p x)=> [_ [//= |] | _] /ih ->. qed. - -(* FIXME: Move me *) -lemma uniq_map_filter (p : 'a -> bool) (f : 'a -> 'b) (s : 'a list): - uniq (map f s) => uniq (map f (filter p s)). -proof. - elim s=> //= x xs ih [fx_notin_fxs uniq_fxs]. - by case (p x); rewrite ih //= -negP => h {h} /filter_mem_map. -qed. - -lemma perm_eq_elems_filter (m : ('a, 'b) fmap) (p: 'a -> 'b -> bool): - perm_eq (filter (fun (x : 'a * 'b) => p x.`1 x.`2) (elems m)) - (elems (filter p m)). -proof. - (* FIXME: curry-uncurry should probably go into Pair for some chosen arities *) - rewrite filterE; pose P:= fun (x : 'a * 'b) => p x.`1 x.`2. - apply (perm_eq_trans _ _ (:@oflistK _)). - rewrite reduce_reduced 2:perm_eq_refl //. - by apply/uniq_map_filter/uniq_keys. -qed. - -lemma mem_elems_filter (m : ('a, 'b) fmap) (p: 'a -> 'b -> bool) x y: - mem (filter (fun (x : 'a * 'b) => p x.`1 x.`2) (elems m)) (x,y) - <=> mem (elems (filter p m)) (x,y). -proof. by apply/perm_eq_mem/perm_eq_elems_filter. qed. - -lemma mem_map_filter_elems (p : 'a -> 'b -> bool) (f : ('a * 'b) -> 'c) (m : ('a, 'b) fmap) a: - mem (map f (filter (fun (x : 'a * 'b) => p x.`1 x.`2) (elems m))) a - <=> mem (map f (elems (filter p m))) a. -proof. by apply/perm_eq_mem/perm_eq_map/perm_eq_elems_filter. qed. - -lemma assoc_elems_filter (m : ('a, 'b) fmap) (p: 'a -> 'b -> bool) x: - assoc (filter (fun (x : 'a * 'b) => p x.`1 x.`2) (elems m)) x - = assoc (elems (filter p m)) x. -proof. by apply/perm_eq_assoc/perm_eq_elems_filter/uniq_keys. qed. - -lemma dom_filter (p : 'a -> 'b -> bool) (m : ('a,'b) fmap) x: - mem (dom (filter p m)) x <=> mem (dom m) x /\ p x (oget m.[x]). -proof. - (* FIXME: curry-uncurry should probably go into Pair for some chosen arities *) - pose P := fun (x : 'a * 'b) => p x.`1 x.`2. - rewrite !mem_domE !mem_map_fst; split=> [[y] | [[y] xy_in_m]]. - rewrite -mem_elems_filter mem_filter getE /= => -[p_x_y xy_in_pm]. - split; 1:by exists y. - by move: xy_in_pm; rewrite mem_assoc_uniq 1:uniq_keys // => ->. - have:= xy_in_m; rewrite mem_assoc_uniq 1:uniq_keys // getE /oget=> -> /= p_x_y. - by exists y; rewrite -mem_elems_filter mem_filter. -qed. - -lemma filterP (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap) x: - (filter p m).[x] = if mem (dom m) x /\ p x (oget m.[x]) - then m.[x] - else None. -proof. - case (mem (dom m) x /\ p x (oget m.[x])); rewrite -dom_filter in_dom //=. - case {-1}((filter p m).[x]) (eq_refl (filter p m).[x])=> //= y. - rewrite getE -mem_assoc_uniq 1:uniq_keys //. - rewrite -mem_elems_filter mem_filter /= mem_assoc_uniq 1:uniq_keys //. - by rewrite getE=> -[_ ->]. -qed. - -lemma filter_eq_dom (m:('a,'b)fmap) (p1 p2:'a->'b->bool): - (forall a, mem (dom m) a=> p1 a (oget m.[a]) = p2 a (oget m.[a])) => - filter p1 m = filter p2 m. -proof. - by move=> Hp;apply fmapP=>z;rewrite !filterP;case (mem (dom m) z)=>// Hz;rewrite Hp. -qed. - -lemma filter_eq (m:('a,'b)fmap) (p1 p2:'a->'b->bool): - (forall a b, p1 a b = p2 a b) => - filter p1 m = filter p2 m. -proof. by move=>Hp;apply filter_eq_dom=>?_;apply Hp. qed. - -lemma filter_dom (m : ('a,'b) fmap) (p : 'a -> 'b -> bool): - filter (relI p (fun a (_ : 'b)=> mem (dom m) a)) m = filter p m. -proof. by apply/filter_eq_dom=> a @/relI ->. qed. - -(* -------------------------------------------------------------------- *) -op map (f : 'a -> 'b -> 'c) (m : ('a, 'b) fmap) = - oflist (map (fun (x : 'a * 'b) => (x.`1,f x.`1 x.`2)) (elems m)) - axiomatized by mapE. - -lemma dom_map (m : ('a,'b) fmap) (f : 'a -> 'b -> 'c) x: - mem (dom (map f m)) x <=> mem (dom m) x. -proof. - rewrite mapE dom_oflist domE mem_oflist. - by elim (elems m)=> //= [[a b] l] /= ->. -qed. - -lemma perm_eq_elems_map (m : ('a, 'b) fmap) (f : 'a -> 'b -> 'c): - perm_eq (map (fun (x : 'a * 'b) => (x.`1,f x.`1 x.`2)) (elems m)) - (elems (map f m)). -proof. - pose F := fun (x : 'a * 'b) => (x.`1,f x.`1 x.`2). - apply (@perm_eq_trans (reduce (map F (elems m)))). - rewrite -{1}(@reduce_reduced (map F (elems m))) 2:perm_eq_refl //. - have ->: forall s, map fst (map F s) = map fst s by elim. - exact/uniq_keys. - by rewrite mapE; apply/oflistK. -qed. - -lemma mem_elems_map (m : ('a, 'b) fmap) (f : 'a -> 'b -> 'c) x y: - mem (map (fun (x : 'a * 'b) => (x.`1,f x.`1 x.`2)) (elems m)) (x,y) - <=> mem (elems (map f m)) (x,y). -proof. by apply/perm_eq_mem/perm_eq_elems_map. qed. - -lemma mapP (f : 'a -> 'b -> 'c) (m : ('a, 'b) fmap) x: - (map f m).[x] = omap (f x) m.[x]. -proof. - pose F := fun (x : 'a * 'b) => (x.`1,f x.`1 x.`2). - case (mem (dom (map f m)) x)=> h //=. - case {-1}((map f m).[x]) (eq_refl (map f m).[x])=> [nh | y]. - by move: h; rewrite in_dom nh. - rewrite getE -mem_assoc_uniq 1:uniq_keys// -mem_elems_map mapP=> -[[a b]] /=. - by rewrite mem_assoc_uniq 1:uniq_keys// -getE andbC=> -[[<<- ->>]] ->. - have:= h; rewrite dom_map=> h'. - by move: h h'; rewrite !in_dom /= => -> ->. -qed. - -(* -------------------------------------------------------------------- *) -op eq_except (m1 m2 : ('a, 'b) fmap) (X : 'a -> bool) = - filter (fun x y => !X x) m1 - = filter (fun x y => !X x) m2 - axiomatized by eq_exceptE. - -lemma eq_except_refl (m : ('a, 'b) fmap) X: eq_except m m X. -proof. by rewrite eq_exceptE. qed. - -lemma eq_except_sym (m1 m2 : ('a, 'b) fmap) X: - eq_except m1 m2 X <=> eq_except m2 m1 X. -proof. by rewrite eq_exceptE eq_sym -eq_exceptE. qed. - -lemma eq_except_trans (m2 m1 m3 : ('a, 'b) fmap) X: - eq_except m1 m2 X => - eq_except m2 m3 X => - eq_except m1 m3 X. -proof. by rewrite !eq_exceptE; apply eq_trans. qed. - -lemma eq_exceptP (m1 m2 : ('a, 'b) fmap) X: - eq_except m1 m2 X <=> - (forall x, !X x => m1.[x] = m2.[x]). -proof. - rewrite eq_exceptE fmapP; split=> h x. - move=> x_notin_X; have:= h x; rewrite !filterP /= x_notin_X /=. - case (mem (dom m1) x); case (mem (dom m2) x); rewrite !in_dom=> //=. - (* FIXME: Should the following two be dealt with by `trivial'? *) - by rewrite eq_sym. - by move=> -> ->. - by rewrite !filterP /=; case (X x)=> //= /h; rewrite !in_dom=> ->. -qed. - -(* -------------------------------------------------------------------- *) -op size (m : ('a, 'b) fmap) = card (dom m) - axiomatized by sizeE. - -(* -------------------------------------------------------------------- *) -(* TODO: Do we need unary variants of has, all, find and map? *) - -(* -------------------------------------------------------------------- *) -lemma map0P x: (map0<:'a, 'b>).[x] = None. -proof. by rewrite map0E get_oflist. qed. - -lemma map0_eq0 (m : ('a,'b) fmap): - (forall x, m.[x] = None) => m = map0. -proof. by move=> h; apply fmapP=> x; rewrite h map0P. qed. - -lemma remP_eq (a : 'a) (m : ('a,'b) fmap): (rem a m).[a] = None. -proof. by rewrite remP. qed. - -lemma rem_rem (a : 'a) (m : ('a, 'b) fmap): - rem a (rem a m) = rem a m. -proof. by rewrite fmapP=> x; rewrite !remP; case (x = a). qed. - -lemma dom0: dom map0<:'a, 'b> = fset0. -proof. by apply/fsetP=> x; rewrite map0E dom_oflist in_fset0. qed. - -lemma dom_eq0 (m : ('a,'b) fmap): - dom m = fset0 => m = map0. -proof. - move=> eq_dom; apply fmap_domP; rewrite eq_dom dom0 //= => x; - by rewrite in_fset0. -qed. - -lemma domP (m : ('a, 'b) fmap) (a : 'a) (b : 'b): - forall x, mem (dom m.[a <- b]) x <=> mem (dom m `|` fset1 a) x. -proof. - move=> x; rewrite in_fsetU in_fset1 !in_dom getP; - by case (x = a). -qed. - -lemma domP_eq (m : ('a, 'b) fmap) (a : 'a) (b : 'b): - mem (dom m.[a <- b]) a. -proof. by rewrite domP in_fsetU in_fset1. qed. - -lemma dom_set (m:('a,'b) fmap) a b : - dom m.[a<-b] = dom m `|` fset1 a. -proof. by apply/fsetP/domP. qed. - -lemma dom_rem (a : 'a) (m : ('a, 'b) fmap): - dom (rem a m) = dom m `\` fset1 a. -proof. - by rewrite fsetP=> x; rewrite in_fsetD in_fset1 !in_dom remP; case (x = a). -qed. - -lemma dom_rem_eq (a : 'a) (m : ('a, 'b) fmap): !mem (dom (rem a m)) a. -proof. by rewrite dom_rem in_fsetD in_fset1. qed. - -lemma rng0: rng map0<:'a, 'b> = fset0. -proof. - apply/fsetP=> x; rewrite in_fset0 //= in_rng. - by rewrite negb_exists => a; rewrite /= map0P. -qed. - -lemma find_set (m:('a,'b) fmap) y x (p:'a -> 'b -> bool): - (forall x, mem (dom m) x => !p x (oget m.[x])) => - find p m.[x <- y] = if p x y then Some x else None. -proof. - cut [[a []->[]] | []-> Hp Hnp]:= findP p (m.[x<-y]);1: rewrite getP dom_set !inE /#. - by case (p x y)=> //; cut := Hp x;rewrite getP dom_set !inE /= oget_some. -qed. - -lemma rng_set (m : ('a, 'b) fmap) (a : 'a) (b : 'b): - rng m.[a<-b] = rng (rem a m) `|` fset1 b. -proof. - rewrite fsetP=> y; rewrite in_fsetU in_fset1 !in_rng; split=> [[] x |]. - rewrite getP; case (x = a)=> [->> /= <<- |ne_xa mx_y]; [right=> // |left]. - by exists x; rewrite remP ne_xa /=. - rewrite orbC -oraE=> -[->> | ]. - by exists a; rewrite getP_eq. - move=> ne_yb [] x; rewrite remP. - case (x = a)=> //= ne_xa <-. - by exists x; rewrite getP ne_xa. -qed. - -lemma rng_set_eq (m : ('a, 'b) fmap) (a : 'a) (b : 'b): - mem (rng m.[a<-b]) b. -proof. by rewrite rng_set in_fsetU in_fset1. qed. - -lemma rng_rem (a : 'a) (m : ('a, 'b) fmap) (b : 'b): - mem (rng (rem a m)) b <=> (exists x, x <> a /\ m.[x] = Some b). -proof. - rewrite in_rng; split=> [[x]|[x] [ne_x_a mx_b]]. - rewrite remP; case (x = a)=> //=. - by move=> ne_x_a mx_b; exists x. - by exists x; rewrite remP ne_x_a. -qed. - -lemma dom_join (m1 m2 : ('a, 'b) fmap): - forall x, mem (dom (m1 + m2)) x <=> mem (dom m1 `|` dom m2) x. -proof. - by move=> x; rewrite in_fsetU !in_dom joinP in_dom; case (m2.[x]). -qed. - -lemma has_join (p : 'a -> 'b -> bool) (m1 m2 : ('a, 'b) fmap): - has p (m1 + m2) <=> has (fun x y => p x y /\ !mem (dom m2) x) m1 \/ has p m2. -proof. -rewrite !hasP; split=> [[x]|]. - rewrite joinP dom_join in_fsetU. - by case: (mem (dom m2) x)=> //= - [x_in_m2 p_x_m2x|x_notin_m2 [x_in_m1 p_x_m1x]]; - [right|left]; exists x. -by move=> [[]|[]] x /> => [x_in_m1|h] p_x => [h|]; exists x; rewrite dom_join joinP in_fsetU h. -qed. - -lemma get_find (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap): - has p m => p (oget (find p m)) (oget m.[oget (find p m)]). -proof. by rewrite find_none; have:= findP p m; case (find p m). qed. - -lemma has_find (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap): - has p m <=> exists x, find p m = Some x /\ mem (dom m) x. -proof. - rewrite find_none; have:= findP p m. - by case (find p m)=> //= x [x'] [eq_xx' [x'_in_m _]]; exists x'. -qed. - -lemma find_some (p:'a -> 'b -> bool) m x: - find p m = Some x => - mem (dom m) x /\ p x (oget m.[x]). -proof. by have:= findP p m; case (find p m). qed. - -lemma rem_filter (m : ('a, 'b) fmap) x: - rem x m = filter (fun x' y => x' <> x) m. -proof. - apply fmapP=> x'; rewrite remP filterP; case (mem (dom m) x'). - by case (x' = x). - by rewrite in_dom /= => ->. -qed. - -lemma filter_predI (p1 p2: 'a -> 'b -> bool) (m : ('a, 'b) fmap): - filter (fun a b => p1 a b /\ p2 a b) m = filter p1 (filter p2 m). -proof. by rewrite fmapP=>x;rewrite !(filterP, dom_filter)/#. qed. - -lemma filter_filter (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap): - filter p (filter p m) = filter p m. -proof. by rewrite -filter_predI;apply filter_eq => /#. qed. - -lemma filter_rem (p:'a->'b->bool) (m:('a,'b)fmap) x: - filter p (rem x m) = rem x (filter p m). -proof. rewrite !rem_filter -!filter_predI;apply filter_eq=>/#. qed. - -lemma join_filter (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap): - (filter p m) + (filter (fun x y=> !p x y) m) = m. -proof. - rewrite fmapP=> x; rewrite joinP dom_filter /= !filterP. - case (mem (dom m) x)=> /=. - by case (p x (oget m.[x])). - by rewrite in_dom /= eq_sym. -qed. - -lemma eq_except_set a b (m1 m2 : ('a, 'b) fmap) X: - eq_except m1 m2 X => - eq_except m1.[a <- b] m2.[a <- b] X. -proof. - rewrite !eq_exceptP=> h x x_notin_X. - rewrite !getP; case (x = a)=> //=. - by rewrite h. -qed. - -lemma filter_eq_except (m : ('a, 'b) fmap) (X : 'a -> bool): - eq_except (filter (fun x y => !X x) m) m X. -proof. by rewrite eq_exceptE filter_filter. qed. - -lemma eq_except_rem (m1 m2:('a,'b)fmap) (s:'a -> bool) x: - s x => eq_except m1 m2 s => eq_except m1 (rem x m2) s. -proof. - rewrite !eq_exceptE rem_filter -filter_predI=> Hmem ->;apply filter_eq=>/#. -qed. - -lemma set_eq_except x b (m : ('a, 'b) fmap): - eq_except m.[x <- b] m (pred1 x). -proof. by rewrite eq_exceptP=> x'; rewrite !getP=> ->. qed. - -lemma set2_eq_except x b b' (m : ('a, 'b) fmap): - eq_except m.[x <- b] m.[x <- b'] (pred1 x). -proof. by rewrite eq_exceptP=> x'; rewrite !getP=> ->. qed. - -lemma eq_except_set_eq (m1 m2 : ('a, 'b) fmap) x: - mem (dom m1) x => - eq_except m1 m2 (pred1 x) => - m1 = m2.[x <- oget m1.[x]]. -proof. - rewrite eq_exceptP fmapP=> x_in_m1 eqe x'. - rewrite !getP /oget; case (x' = x)=> [->> |]. - by move: x_in_m1; rewrite in_dom; case (m1.[x]). - by exact/eqe. -qed. - -(* -------------------------------------------------------------------- *) -lemma rem_id (x : 'a) (m : ('a,'b) fmap): - !mem (dom m) x => rem x m = m. -proof. -rewrite in_dom /= => x_notin_m; apply/fmapP=> x'; rewrite remP. -by case: (x' = x)=> //= ->>; rewrite x_notin_m. -qed. - -lemma dom_rem_le (x : 'a) (m : ('a,'b) fmap) (x' : 'a): - mem (dom (rem x m)) x' => mem (dom m) x'. -proof. by rewrite dom_rem in_fsetD. qed. - -lemma rng_rem_le (x : 'a) (m : ('a,'b) fmap) (x' : 'b): - mem (rng (rem x m)) x' => mem (rng m) x'. -proof. by rewrite rng_rem in_rng=> -[x0] [_ h]; exists x0. qed. - -(* -------------------------------------------------------------------- *) -(** FIXME: these two were minimally imported from old and need cleaning *) -lemma leq_card_rng_dom (m:('a,'b) fmap): - card (rng m) <= card (dom m). -proof. -elim/fset_ind: (dom m) {-2}m (eq_refl (dom m))=> {m} [m /dom_eq0 ->|]. -+ by rewrite rng0 dom0 !fcards0. -move=> x s x_notin_s ih m dom_m. -cut ->: m = (rem x m).[x <- oget m.[x]]. -+ apply fmapP=> x'; rewrite getP remP; case: (x' = x)=> [->|//]. - have /fsetP /(_ x):= dom_m; rewrite in_fsetU in_fset1 /= in_dom. - by case: m.[x]. -have ->:= rng_set (rem x m) x (oget m.[x]). -rewrite fcardU rem_rem fsetI1 fun_if !fcard1 fcards0. -rewrite dom_set fcardUI_indep 2:fcard1. -+ by apply/fsetP=> x0; rewrite in_fsetI dom_rem !inE -andbA andNb. -rewrite StdOrder.IntOrder.ler_subl_addr; apply/StdOrder.IntOrder.ler_paddr. -+ by case: (mem (rng _) _). -apply/StdOrder.IntOrder.ler_add2r/ih/fsetP=> x0. -by rewrite dom_rem dom_m !inE; case: (x0 = x). -qed. - -lemma endo_dom_rng (m:('a,'a) fmap): - (exists x, !mem (dom m) x) => - exists x, !mem (rng m) x. -proof. -elim=> x x_notin_m. -have h: 0 < card (((dom m) `|` fset1 x) `\` (rng m)); last first. -+ by have: forall (X : 'a fset), 0 < card X => exists x, mem X x; smt. -rewrite fcardD fcardUI_indep. -+ by apply/fsetP=> x'; rewrite !inE /#. -rewrite fcard1 fsetIUl fcardUI_indep. -+ by apply/fsetP=> x'; rewrite !inE /#. -have ->: card (fset1 x `&` rng m) = if mem (rng m) x then 1 else 0. -+ smt (@FSet). -smt (leq_card_rng_dom @FSet). -qed. - -(** TODO: lots of lemmas *) -lemma rem0 (a : 'a) : rem a map0<:'a,'b> = map0. -proof. - by apply map0_eq0=>x;rewrite remP;case (x=a)=>//=;rewrite map0P. -qed. - -lemma set_eq (m:('a,'b)fmap) x y: m.[x] = Some y => m.[x<-y] = m. -proof. - by rewrite fmapP=> Hx x';rewrite getP;case (x'=x)=>//->;rewrite Hx. -qed. - -lemma map_map0 (f:'a -> 'b -> 'c): map f map0 = map0. -proof. by rewrite fmapP=> x;rewrite mapP !map0P. qed. - -lemma map_set (f:'a -> 'b -> 'c) m x y : - map f m.[x<-y] = (map f m).[x<- f x y]. -proof. - by rewrite fmapP=>z;rewrite mapP !getP;case (z=x)=>// _;rewrite mapP. -qed. - -lemma map_rem (f:'a -> 'b -> 'c) m x: map f (rem x m) = rem x (map f m). -proof. by rewrite fmapP=>z;rewrite !(mapP,remP)/#. qed. - -lemma rem_set (m:('a,'b)fmap) x y v: - rem x (m.[y<-v]) = if x = y then rem x m else (rem x m).[y<-v]. -proof. - rewrite fmapP=>z;case (x=y)=>[->|]; rewrite !(remP,getP) /#. -qed. - -lemma map_comp (f1:'a->'b->'c) (f2:'a->'c->'d) (m:('a,'b)fmap): - map f2 (map f1 m) = map (fun a b => f2 a (f1 a b)) m. -proof. by rewrite fmapP=>x;rewrite !mapP;case (m.[x]). qed. - -lemma map_id (m:('a,'b)fmap): map (fun _ b => b) m = m. -proof. by rewrite fmapP=>x;rewrite mapP;case (m.[x]). qed. diff --git a/sha3/proof/RP.eca b/sha3/proof/RP.eca deleted file mode 100644 index 6c54150..0000000 --- a/sha3/proof/RP.eca +++ /dev/null @@ -1,79 +0,0 @@ -(*************************- Random Permutation -*************************) - -require import Core Real FSet NewFMap Distr. -require import Dexcepted StdOrder. import RealOrder. -require import Ring StdRing. import RField. -require Monoid. import AddMonoid. - -type t. -op dt : t distr. - -module type RP = { - proc init() : unit - proc f(x : t) : t - proc fi(x : t) : t -}. - -module type DRP = { - proc f(x : t) : t - proc fi(x : t) : t -}. - -module P : RP, DRP = { - var m : (t, t) fmap - var mi : (t, t) fmap - - proc init() = { m = map0; mi = map0; } - - proc f(x) = { - var y; - - if (! mem (dom m) x) { - y <$ dt \ (mem (rng m)); - m.[x] <- y; - mi.[y] <- x; - } - return oget m.[x]; - } - - proc fi(x) = { - var y; - - if (! mem (dom mi) x) { - y <$ dt \ (mem (rng mi)); - mi.[x] <- y; - m.[y] <- x; - } - return oget mi.[x]; - } -}. - -lemma P_init_ll: islossless P.init. -proof. by proc; auto. qed. - -(* maybe a useful standard lemma? *) - -lemma mu_except ['a] (d : 'a distr, y : 'a, P : 'a -> bool) : - y \in d => ! P y => mu d P < mu d predT. -proof. -move=> in_supp_yd notP_y. -have -> : mu d P = mu d predT - mu d (predC P) - by rewrite (mu_split d predT P) mu_not mu_and #ring. -rewrite ltr_subl_addl (ltr_le_trans (mu d (pred1 y) + mu d predT)). -by rewrite -(add0r (mu _ _)) 1:ltr_le_add. -by rewrite ler_add mu_sub /pred1; first move=> ?. -qed. - -lemma P_f_ll: is_lossless dt => support dt = predT => islossless P.f. -proof. -move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. -have [y not_mem_y_rng_m] := endo_dom_rng P.m{m} _; first by exists x{m}. -by rewrite dexcepted_ll // -d_ll (mu_except dt y) -/(support _ _) 1:d_fu. -qed. - -lemma P_fi_ll: is_lossless dt => support dt = predT => islossless P.fi. -proof. -move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. -have [y not_mem_y_rng_mi] := endo_dom_rng P.mi{m} _; first by exists x{m}. -by rewrite dexcepted_ll // -d_ll (mu_except dt y) -/(support _ _) 1:d_fu. -qed. diff --git a/sha3/proof/RndO.ec b/sha3/proof/RndO.ec deleted file mode 100644 index f2bed8e..0000000 --- a/sha3/proof/RndO.ec +++ /dev/null @@ -1,699 +0,0 @@ -require import Core List FSet NewFMap Distr. -require IterProc. - -pragma -oldip. - -(* FIXME notation *) -abbrev ([+]) ['a 'b] (x : 'b) = fun (_ : 'a) => x. - -type flag = [ Unknown | Known ]. - -lemma neqK_eqU f : f <> Known <=> f = Unknown. -proof. by case: f. qed. - -op in_dom_with (m:('from, 'to * 'flag)fmap) (x:'from) (f:'flag) = - mem (dom m) x /\ (oget (m.[x])).`2 = f. - -op restr f (m:('from, 'to * 'flag)fmap) = - let m = filter (fun _ (p:'to*'flag) => p.`2=f) m in - map (fun _ (p:'to*'flag) => p.`1) m. - -lemma restrP (m:('from, 'to * 'flag)fmap) f x: - (restr f m).[x] = - obind (fun (p:'to*'flag)=>if p.`2=f then Some p.`1 else None) m.[x]. -proof. - rewrite /restr /= mapP filterP in_dom /=. - by case (m.[x])=>//= -[x0 f'];rewrite oget_some /=;case (f' = f). -qed. - -lemma dom_restr (m:('from, 'to * 'flag)fmap) f x: - mem (dom(restr f m)) x <=> in_dom_with m x f. -proof. - rewrite /in_dom_with !in_dom;case: (m.[x]) (restrP m f x)=>//= -[t f'] /=. - by rewrite oget_some /=;case (f' = f)=> [_ ->|]. -qed. - -lemma restr_set (m:('from, 'to * 'flag)fmap) f1 f2 x y: - restr f1 m.[x<-(y,f2)] = if f1 = f2 then (restr f1 m).[x<-y] else rem x (restr f1 m). -proof. - rewrite fmapP;case (f1=f2)=>[->|Hneq]x0;rewrite !(restrP,getP);1: by case (x0=x). - case (x0=x)=>[->|Hnx];1:by rewrite (eq_sym f2) Hneq remP_eq. - by rewrite remP Hnx restrP. -qed. - -lemma restr_set_eq (m:('from, 'to * 'flag)fmap) f x y: - restr f m.[x<-(y,f)] = (restr f m).[x<-y]. -proof. by rewrite restr_set. qed. - -lemma restr0 f : restr f map0<:'from, 'to * 'flag> = map0. -proof. by apply fmapP=>x;rewrite restrP !map0P. qed. - -lemma restr_set_neq f2 f1 (m:('from, 'to * 'flag)fmap) x y: - !mem (dom m) x => - f2 <> f1 => restr f1 m.[x<-(y,f2)] = restr f1 m. -proof. - by move=>Hm Hneq;rewrite restr_set(eq_sym f1)Hneq rem_id//dom_restr/in_dom_with Hm. -qed. - -lemma restr_rem (m:('from,'to*'flag)fmap) x f: - restr f (rem x m) = - if in_dom_with m x f then rem x (restr f m) else restr f m. -proof. - rewrite fmapP=>z;rewrite restrP;case (in_dom_with m x f); - rewrite !(restrP,remP) /in_dom_with in_dom /#. -qed. - -abstract theory Ideal. - -type from, to. - -op sampleto : from -> to distr. - -module type RO = { - proc init () : unit - proc get (x : from) : to - proc set (x : from, y : to) : unit - proc rem (x : from) : unit - proc sample(x : from) : unit -}. - -module type RO_Distinguisher(G : RO) = { - proc distinguish(): bool -}. - -module type FRO = { - proc init () : unit - proc get (x : from) : to - proc set (x : from, y : to) : unit - proc rem (x : from) : unit - proc sample(x : from) : unit - proc in_dom(x : from,f : flag) : bool - proc restrK() : (from,to)fmap -}. - -module type FRO_Distinguisher(G : FRO) = { - proc distinguish(): bool -}. - -(* -------------------------------------------------------------------------- *) -module RO : RO = { - var m : (from, to)fmap - - proc init () = { m <- map0; } - - proc get(x:from) = { - var r; - r <$ sampleto x; - if (!mem (dom m) x) m.[x] <- r; - return (oget m.[x]); - } - - proc set (x:from, y:to) = { - m.[x] <- y; - } - - proc rem (x:from) = { - m <- rem x m; - } - - proc sample(x:from) = { - get(x); - } - - proc restrK() = { - return m; - } - -}. - -module FRO : FRO = { - var m : (from, to * flag)fmap - - proc init () = { m <- map0; } - - proc get(x:from) = { - var r; - r <$ sampleto x; - if (mem (dom m) x) r <- (oget m.[x]).`1; - m.[x] <- (r,Known); - return r; - } - - proc set (x:from, y:to) = { - m.[x] <- (y,Known); - } - - proc rem (x:from) = { - m <- rem x m; - } - - proc sample(x:from) = { - var c; - c <$ sampleto x; - if (!mem (dom m) x) m.[x] <- (c,Unknown); - } - - proc in_dom(x:from, f:flag) = { - return in_dom_with m x f; - } - - proc restrK() = { - return restr Known m; - } - -}. - -equiv RO_FRO_init : RO.init ~ FRO.init : true ==> RO.m{1} = map (+fst) FRO.m{2}. -proof. by proc;auto=>/=;rewrite map_map0. qed. - -equiv RO_FRO_get : RO.get ~ FRO.get : - ={x} /\ RO.m{1} = map (+fst) FRO.m{2} ==> ={res} /\ RO.m{1} = map (+fst) FRO.m{2}. -proof. - proc;auto=>?&ml[]->->/=?->/=. - rewrite !dom_map !map_set/fst/= getP_eq oget_some;progress. - + by rewrite mapP oget_omap_some // -in_dom. - by apply /eq_sym/set_eq;rewrite get_oget?dom_map// mapP oget_omap_some// -in_dom. -qed. - -equiv RO_FRO_set : RO.set ~ FRO.set : - ={x,y} /\ RO.m{1} = map (+fst) FRO.m{2} ==> RO.m{1} = map (+fst) FRO.m{2}. -proof. by proc;auto=>?&ml[#]3->;rewrite map_set. qed. - -equiv RO_FRO_rem : RO.rem ~ FRO.rem : - ={x} /\ RO.m{1} = map (+fst) FRO.m{2} ==> RO.m{1} = map (+fst) FRO.m{2}. -proof. by proc;auto=>??;rewrite map_rem. qed. - -equiv RO_FRO_sample : RO.sample ~ FRO.sample : - ={x} /\ RO.m{1} = map (+fst) FRO.m{2} ==> RO.m{1} = map (+fst) FRO.m{2}. -proof. - by proc;inline *;auto=>?&ml[]2!->/=?->;rewrite dom_map/= map_set. -qed. - -lemma RO_FRO_D (D<:RO_Distinguisher{RO,FRO}) : - equiv [D(RO).distinguish ~ D(FRO).distinguish : - ={glob D} /\ RO.m{1} = map (+fst) FRO.m{2} ==> - ={res,glob D} /\ RO.m{1} = map (+fst) FRO.m{2} ]. -proof. - proc (RO.m{1} = map (+fst) FRO.m{2})=>//. - + by conseq RO_FRO_init. + by conseq RO_FRO_get. + by conseq RO_FRO_set. - + by conseq RO_FRO_rem. + by conseq RO_FRO_sample. -qed. - -section LL. - -lemma RO_init_ll : islossless RO.init. -proof. by proc;auto. qed. - -lemma FRO_init_ll : islossless FRO.init. -proof. by proc;auto. qed. - -lemma FRO_in_dom_ll : islossless FRO.in_dom. -proof. by proc. qed. - -lemma FRO_restrK_ll : islossless FRO.restrK. -proof. by proc. qed. - -lemma RO_set_ll : islossless RO.set. -proof. by proc;auto. qed. - -lemma FRO_set_ll : islossless FRO.set. -proof. by proc;auto. qed. - -axiom sampleto_ll : forall x, Distr.weight (sampleto x) = 1%r. - -lemma RO_get_ll : islossless RO.get. -proof. by proc;auto;progress;apply sampleto_ll. qed. - -lemma FRO_get_ll : islossless FRO.get. -proof. by proc;auto;progress;apply sampleto_ll. qed. - -lemma RO_sample_ll : islossless RO.sample. -proof. by proc;call RO_get_ll. qed. - -lemma FRO_sample_ll : islossless FRO.sample. -proof. by proc;auto;progress;apply sampleto_ll. qed. - -end section LL. - -end Ideal. - -(* -------------------------------------------------------------------------- *) - -abstract theory GenEager. - -clone include Ideal. - -axiom sampleto_ll : forall x, Distr.weight (sampleto x) = 1%r. - -clone include IterProc with type t <- from. - -(** A module that resample query if the associate value is unknown *) -module RRO : FRO = { - - proc init = FRO.init - - proc get(x:from) = { - var r; - r <$ sampleto x; - if (!mem (dom FRO.m) x || (oget FRO.m.[x]).`2 = Unknown) { - FRO.m.[x] <- (r,Known); - } - return (oget FRO.m.[x]).`1; - } - - proc set = FRO.set - - proc rem = FRO.rem - - proc sample = FRO.sample - - proc in_dom = FRO.in_dom - - proc restrK = FRO.restrK - - module I = { - proc f (x:from) = { - var c; - c <$ sampleto x; - FRO.m.[x] <- (c,Unknown); - } - } - - proc resample () = { - Iter(I).iter (elems (dom (restr Unknown FRO.m))); - } - -}. - -(* A module which is lazy on sample *) -module LRO : RO = { - - proc init = RO.init - - proc get = RO.get - - proc set = RO.set - - proc rem = RO.rem - - proc sample(x:from) = {} - -}. - -lemma RRO_resample_ll : islossless RRO.resample. -proof. - proc;call (iter_ll RRO.I _)=>//;proc;auto=>/=?; - by split; first apply sampleto_ll. -qed. - -lemma eager_init : - eager [RRO.resample(); , FRO.init ~ RRO.init, RRO.resample(); : - ={FRO.m} ==> ={FRO.m} ]. -proof. - eager proc. inline{2} *;rcondf{2}3;auto=>/=. - + by move=>?_;rewrite restr0 dom0 elems_fset0. - by conseq (_:) (_:true==>true: =1%r) _=>//;call RRO_resample_ll. -qed. - -lemma iter_perm2 (i1 i2 : from): - equiv[ Iter(RRO.I).iter_12 ~ Iter(RRO.I).iter_21 : - ={glob RRO.I, t1, t2} ==> ={glob RRO.I}]. -proof. - proc;inline *;case ((t1=t2){1});1:by auto. - by swap{2}[4..5]-3;auto=> &ml&mr[#]3->neq/=?->?->;rewrite set_set neq. -qed. - -equiv I_f_neq x1 mx1: RRO.I.f ~ RRO.I.f : - ={x,FRO.m} /\ x1 <> x{1} /\ FRO.m{1}.[x1] = mx1 ==> - ={FRO.m} /\ FRO.m{1}.[x1] = mx1. -proof. - by proc;auto=>?&mr[#]2->Hneq Heq/=?->;rewrite getP Hneq. -qed. - -equiv I_f_eqex x1 mx1 mx2: RRO.I.f ~ RRO.I.f : - ={x} /\ x1 <> x{1} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x1) /\ - FRO.m{1}.[x1] = mx1 /\ FRO.m{2}.[x1] = mx2 ==> - eq_except FRO.m{1} FRO.m{2} (pred1 x1) /\ - FRO.m{1}.[x1] = mx1 /\ FRO.m{2}.[x1] = mx2. -proof. - by proc;auto=>?&mr[#]->Hneq Heq/= Heq1 Heq2?->/=;rewrite !getP Hneq eq_except_set. -qed. - -equiv I_f_set x1 r1 : RRO.I.f ~ RRO.I.f : - ={x} /\ x1 <> x{1} /\ FRO.m{1}.[x1] = None /\ FRO.m{2} = FRO.m{1}.[x1 <- (r1, Known)] ==> - FRO.m{1}.[x1] = None /\ FRO.m{2} = FRO.m{1}.[x1 <- (r1, Known)]. -proof. - by proc;auto=>?&mr[#]->Hneq H1->/=?->;rewrite getP Hneq/= H1 set_set Hneq. -qed. - -lemma eager_get : - eager [RRO.resample(); , FRO.get ~ RRO.get, RRO.resample(); : - ={x,FRO.m} ==> ={res,FRO.m} ]. -proof. - eager proc. - wp;case ((mem (dom FRO.m) x /\ (oget FRO.m.[x]).`2=Known){1}). - + rnd{1};rcondf{2} 2;1:by auto=> /#. - exists*x{1}, ((oget FRO.m.[x{2}]){1});elim*=>x1 mx;inline RRO.resample. - call (iter_inv RRO.I (fun z=>x1<>z) (fun o1 o2 => o1 = o2 /\ o1.[x1]= Some mx) _)=>/=. - + by conseq (I_f_neq x1 (Some mx))=>//. - auto=>?&mr[#]4->Hd Hget. - split; first apply sampleto_ll. - move=> /=_?_; split. - + by rewrite get_oget//oget_some/==> x;rewrite -memE dom_restr/#. - move=>[#]_ Heq?mr[#]->Heq'. - split=> [| _ r _]; first apply sampleto_ll. - rewrite in_dom Heq' oget_some /= set_eq /#. - case ((mem (dom FRO.m) x){1}). - + inline{1} RRO.resample=>/=;rnd{1}. - transitivity{1} - { Iter(RRO.I).iter_1s(x, elems ((dom (restr Unknown FRO.m)) `\` fset1 x)); } - (={x,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown ==> - ={x,FRO.m}) - (={x,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown==> - ={x} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ - FRO.m{1}.[x{2}] = Some (result{2},Unknown) /\ - FRO.m{2}.[x{2}] = Some (result{2},Known)). - + by move=>?&mr[#]-> -> ??;exists FRO.m{mr} x{mr}=>/#. - + move=>???;rewrite in_dom=>[#]<*>[#]->/eq_except_sym H Hxm Hx2. - split=> [| _ r _]; first apply sampleto_ll. - rewrite /= Hxm oget_some /=;apply /eq_sym. - have /(congr1 oget):= Hx2 => <-;apply eq_except_set_eq=>//. - by rewrite in_dom Hx2. - + symmetry;call (iter1_perm RRO.I iter_perm2). - skip=> &1 &2 [[->> ->>]] [Hdom Hm];split=>//=. - by apply /perm_eq_sym/perm_to_rem/dom_restr;rewrite /in_dom_with Hdom Hm. - inline Iter(RRO.I).iter_1s RRO.I.f RRO.resample. - seq 5 3 : (={x} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ - (l =elems(dom (restr Unknown FRO.m) `\` fset1 x)){1} /\ - FRO.m{1}.[x{2}] = Some (result{2}, Unknown) /\ - FRO.m{2}.[x{2}] = Some (result{2}, Known)). - + auto=>?&mr[#]2->/=^Hdom->^Hget->?->/=. - by rewrite !getP /=oget_some !restr_set/= dom_set set2_eq_except fsetDK. - exists*x{1}, FRO.m{1}.[x{2}], FRO.m{2}.[x{2}];elim*=>x1 mx1 mx2. - call (iter_inv RRO.I (fun z=>x1<>z) - (fun o1 o2 => eq_except o1 o2 (pred1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) - (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[#]4->^H->->^H1->^H2->/=;split. - + congr;rewrite fsetP=>z;rewrite !inE !dom_restr /in_dom_with !in_dom; smt. - by move=>x;rewrite -memE in_fsetD1 eq_sym. - swap{1}-1;seq 1 1 : (={r,x,FRO.m} /\ ! mem (dom FRO.m{1}) x{1});1:by auto. - inline RRO.resample;exists*x{1},r{1};elim*=>x1 r1. - call (iter_inv RRO.I (fun z=>x1<>z) - (fun o1 o2 => o1.[x1] = None /\ o2= o1.[x1<-(r1,Known)]) (I_f_set x1 r1));auto. - move=>?&mr[#]5-> ^Hnin^ + ->/=;rewrite in_dom=>/=->/=;rewrite restr_set_neq //=;split. - + by move=>z; rewrite -memE dom_restr /#. - by move=>_?mr[#]^Hmem 2!->;rewrite in_dom Hmem /= getP /=oget_some. -qed. - -lemma eager_set : - eager [RRO.resample(); , FRO.set ~ RRO.set, RRO.resample(); : - ={x,y} /\ ={FRO.m} ==> ={res,FRO.m} ]. -proof. - eager proc. - inline RRO.resample=>/=;wp. - case ((mem (dom FRO.m) x /\ (oget FRO.m.[x]).`2 = Unknown){1}). - + transitivity{1} { Iter(RRO.I).iter_1s(x,elems ((dom (restr Unknown FRO.m)) `\` fset1 x));} - (={x,y,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown ==> - ={x,y,FRO.m}) - (={x,y,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown==> - ={x,y} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ - FRO.m{2}.[x{2}] = Some (y{2},Known)). - + by move=>?&mr[#]2->???;exists FRO.m{mr} x{mr} y{mr}=>/#. - + move=>?&m&mr[#]<*>[#]2->Hex Hm2. - by rewrite (eq_except_set_eq FRO.m{mr} FRO.m{m} x{mr}) ?in_dom ?Hm2// eq_except_sym. - + symmetry;call (iter1_perm RRO.I iter_perm2);auto=>?&mr[#]3-> Hdom Hm;split=>//=. - by apply /perm_eq_sym/perm_to_rem/dom_restr;rewrite /in_dom_with Hdom. - inline{1}Iter(RRO.I).iter_1s. - seq 3 1: (={x,y} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ - l{1} = (elems (dom (restr Unknown FRO.m))){2} /\ !mem l{1} x{1} /\ - (FRO.m.[x]=Some(y, Known)){2}). - + inline *;auto=>?&mr[#]3->/=Hmem Hget. - split=> [|_ c _]; first apply sampleto_ll. - by rewrite set2_eq_except getP_eq restr_set /= dom_rem -memE !inE negb_and. - exists* x{1},y{1},(FRO.m.[x]{1});elim*=>x1 y1 mx1;pose mx2:=Some(y1,Known). - call (iter_inv RRO.I (fun z=>x1<>z) - (fun o1 o2 => eq_except o1 o2 (pred1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) - (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[#]-><-2!->->>2!->Hmem->/#. - exists* x{1},y{1},(FRO.m.[x]{1});elim*=>x1 y1 mx1;pose mx2:=Some(y1,Known). - call (iter_inv RRO.I (fun z=>x1<>z) - (fun o1 o2 => eq_except o1 o2 (pred1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) - (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[#]-><-2!->->>->/= Hidm. - rewrite restr_set getP_eq/mx2 eq_except_sym set_eq_except/=;split;[split|]. - + by congr;apply fsetP=>z;rewrite !(dom_rem,inE,dom_restr) /#. - + by move=>z;rewrite -memE dom_restr /#. - move=>_??[#]Hex HLx HRx;apply /eq_sym. - have/(congr1 oget):=HRx=><-;apply eq_except_set_eq=>//;1:by rewrite in_dom HRx. - by apply /eq_except_sym. -qed. - -lemma eager_rem: - eager [RRO.resample(); , FRO.rem ~ RRO.rem, RRO.resample(); : - ={x} /\ ={FRO.m} ==> ={res,FRO.m} ]. -proof. - eager proc;case ((in_dom_with FRO.m x Unknown){1}). - + inline RRO.resample;wp. - transitivity{1} - { Iter(RRO.I).iter_1s(x,elems (dom (restr Unknown FRO.m) `\` fset1 x)); } - (={x,FRO.m}/\(in_dom_with FRO.m x Unknown){1}==> ={x,FRO.m}) - (={x,FRO.m}/\ (in_dom_with FRO.m x Unknown){1} ==> (rem x FRO.m){1} = FRO.m{2})=>//. - + by move=>?&mr[#]2->?;exists FRO.m{mr} x{mr}. - + symmetry;call (iter1_perm RRO.I iter_perm2);skip=>?&mr[#]2!->?/=;split=>//. - by apply /perm_eq_sym/perm_to_rem/dom_restr. - inline{1}Iter(RRO.I).iter_1s. - seq 3 1: (={x} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ - l{1} = (elems (dom (restr Unknown FRO.m))){2} /\ !mem l{1} x{1} /\ - (FRO.m.[x]=None){2}). - + inline *;auto=>??[#]2->Hidm/=. - split=> [| _ c _]; first apply sampleto_ll. - rewrite eq_except_rem 2:set_eq_except // remP -memE in_fsetD1 negb_and /=. - by rewrite restr_rem Hidm /= dom_rem. - exists* x{1},(FRO.m.[x]{1});elim*=>x1 mx1. - call (iter_inv RRO.I (fun z=>x1<>z) - (fun o1 o2 => eq_except o1 o2 (pred1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=None) _). - + by conseq (I_f_eqex x1 mx1 None). - auto=>?&mr[#]3->^Hex 2!->Hmem ^Hx->/=;split=>[/#|_ mL mR[#]/eq_exceptP Hex'?Heq]. - apply fmapP=>z;rewrite remP;case (z=x{mr})=>[->/=|Hneq];1:by rewrite Heq. - by apply Hex'. - inline RRO.resample;wp. - exists *x{1},(FRO.m.[x]{1});elim*=>x1 mx1. - call (iter_inv RRO.I (fun z=>x1<>z) - (fun o1 o2 => eq_except o1 o2 (pred1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=None) _). - + by conseq (I_f_eqex x1 mx1 None). - auto=>?&mr[#]4->Hin/=. - rewrite restr_rem Hin/= remP eq_except_rem // 1:eq_except_refl /=;split. - + by move=>z;rewrite -memE dom_restr /#. - move=>_ mL mR[#] /eq_exceptP Hex'?Heq. - apply fmapP=>z;rewrite remP;case (z=x{mr})=>[->/=|Hneq];1:by rewrite Heq. - by apply Hex'. -qed. - -lemma eager_in_dom: - eager [RRO.resample(); , FRO.in_dom ~ RRO.in_dom, RRO.resample(); : - ={x,f} /\ ={FRO.m} ==> ={res,FRO.m} ]. -proof. - eager proc;inline *;wp. - while (={l,FRO.m} /\ (forall z, mem l z => in_dom_with FRO.m z Unknown){1} /\ - in_dom_with FRO.m{1} x{1} f{1} = result{2}). - + auto=>?&mr[#]2->Hz <-?_/=?->/=. - split=>[z /mem_drop Hm|]. - rewrite /in_dom_with dom_set getP !inE /#. - rewrite /in_dom_with in Hz. - rewrite /in_dom_with dom_set getP !inE; smt(mem_head_behead). - by auto=>?&mr/=[#]3->/=;split=>// z;rewrite -memE dom_restr. -qed. - -lemma eager_restrK: - eager [RRO.resample(); , FRO.restrK ~ RRO.restrK, RRO.resample(); : - ={FRO.m} ==> ={res,FRO.m} ]. -proof. - eager proc;inline *;wp. - while (={l,FRO.m} /\ (forall z, mem l z => in_dom_with FRO.m z Unknown){1} /\ - restr Known FRO.m{1} = result{2}). - + auto=>?&mr[#]2->Hz<-?H/=?->/=. - split=>[z /mem_drop Hm|];1:by rewrite /in_dom_with dom_set getP !inE /#. - rewrite restr_set rem_id?dom_restr//. - by move:H=>/(mem_head_behead witness) /(_ (head witness l{mr})) /= /Hz /#. - by auto=>?&mr/=->/=;split=>// z;rewrite -memE dom_restr. -qed. - -lemma eager_sample: - eager [RRO.resample(); , FRO.sample ~ RRO.sample, RRO.resample(); : - ={x,FRO.m} ==> ={res,FRO.m} ]. -proof. - eager proc. - case (!mem (dom (FRO.m{2})) x{2}). - + rcondt{2}2;1:by auto. - transitivity{2} { - c <$ sampleto x; FRO.m.[x] <- (c, Unknown); - Iter(RRO.I).iter_1s(x,elems ((dom (restr Unknown FRO.m)) `\` fset1 x));} - (={x,FRO.m} /\ ! mem (dom FRO.m{2}) x{2} ==> ={x,FRO.m}) - (={x,FRO.m} /\ ! mem (dom FRO.m{2}) x{2} ==> ={x,FRO.m})=>//;last first. - + inline{2} RRO.resample;call (iter1_perm RRO.I iter_perm2);auto=>?&mr[#]2->Hmem/=?->/=. - by apply /perm_eq_sym/perm_to_rem;rewrite restr_set/=dom_set !inE. - + by move=>?&mr[#]2->?;exists FRO.m{mr} x{mr}. - inline Iter(RRO.I).iter_1s RRO.I.f RRO.resample;wp;swap{1}-1. - seq 1 7 : (={x} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ - l{2} = (elems (dom (restr Unknown FRO.m))){1} /\ - (FRO.m.[x]){2} = Some(c{1},Unknown) /\ (FRO.m.[x]){1} = None). - + wp;rnd;auto=>?&mr[#]2->; rewrite in_dom /=. - move=> Heq; split; first apply sampleto_ll. - move=> _ c _ ??; split=> // _. - rewrite getP_eq restr_set/=dom_set fsetDK eq_except_sym set_set Heq/=set_eq_except/=. - congr;apply fsetP=>z;rewrite in_fsetD1 dom_restr /in_dom_with !in_dom /#. - exists*x{1},c{1};elim*=>x1 c1;pose mx2:=Some(c1,Unknown). - call (iter_inv RRO.I (fun z=>x1<>z) - (fun o1 o2 => eq_except o1 o2 (pred1 x1) /\ o1.[x1]= None /\ o2.[x1]=mx2) _). - + by conseq (I_f_eqex x1 None mx2). - auto=>?&mr[#]2<-->^Hex 3!->^Hx1-> @/mx2/=;split=>[z|_ mL mR[#]]. - + rewrite -memE dom_restr /in_dom_with in_dom /#. - rewrite in_dom=>Hex'->HRx/=;apply /eq_sym. - have/(congr1 oget):=HRx=><-;apply eq_except_set_eq;1:by rewrite in_dom HRx. - by apply eq_except_sym. - rcondf{2}2;1:by auto. - swap{1}2-1;inline*;auto. - while (={l,FRO.m} /\ (mem (dom FRO.m) x){1});auto. - by move=>?&mr[#]2->Hm Hl _/=?->;rewrite dom_set !inE Hm. -qed. - -section. - -declare module D:FRO_Distinguisher {FRO}. - -lemma eager_D : eager [RRO.resample(); , D(FRO).distinguish ~ - D(RRO).distinguish, RRO.resample(); : - ={glob D,FRO.m} ==> ={FRO.m, glob D} /\ ={res} ]. -proof. - eager proc (H_: RRO.resample(); ~ RRO.resample();: ={FRO.m} ==> ={FRO.m}) - (={FRO.m})=>//; try by sim. - + by apply eager_init. + by apply eager_get. + by apply eager_set. - + by apply eager_rem. + by apply eager_sample. - + by apply eager_in_dom. + by apply eager_restrK. -qed. - -module Eager (D:FRO_Distinguisher) = { - - proc main1() = { - var b; - FRO.init(); - b <@ D(FRO).distinguish(); - return b; - } - - proc main2() = { - var b; - FRO.init(); - b <@ D(RRO).distinguish(); - RRO.resample(); - return b; - } - -}. - -equiv Eager_1_2: Eager(D).main1 ~ Eager(D).main2 : - ={glob D} ==> ={res,glob FRO, glob D}. -proof. - proc. - transitivity{1} - { FRO.init(); RRO.resample(); b <@ D(FRO).distinguish(); } - (={glob D} ==> ={b,FRO.m,glob D}) - (={glob D} ==> ={b,FRO.m,glob D})=> //. - + by move=> ?&mr->;exists (glob D){mr}. - + inline *;rcondf{2}3;2:by sim. - by auto=>?;rewrite restr0 dom0 elems_fset0. - seq 1 1: (={glob D, FRO.m});1:by inline *;auto. - by eager call eager_D. -qed. - -end section. - -equiv LRO_RRO_init : LRO.init ~ RRO.init : true ==> RO.m{1} = restr Known FRO.m{2}. -proof. by proc;auto=>/=;rewrite restr0. qed. - -equiv LRO_RRO_get : LRO.get ~ RRO.get : - ={x} /\ RO.m{1} = restr Known FRO.m{2} ==> ={res} /\ RO.m{1} = restr Known FRO.m{2}. -proof. - proc;auto=>?&ml[]->->/=?->/=. - rewrite dom_restr orabP negb_and neqK_eqU. - rewrite !restr_set/= !getP_eq oget_some;progress. - by move:H;rewrite negb_or/= restrP in_dom /#. -qed. - -equiv LRO_RRO_set : LRO.set ~ RRO.set : - ={x,y} /\ RO.m{1} = restr Known FRO.m{2} ==> RO.m{1} = restr Known FRO.m{2}. -proof. by proc;auto=>?&ml[#]3->;rewrite restr_set. qed. - -equiv LRO_RRO_rem : LRO.rem ~ RRO.rem : - ={x} /\ RO.m{1} = restr Known FRO.m{2} ==> RO.m{1} = restr Known FRO.m{2}. -proof. - proc;inline *;auto=>?&mr[#]->->. rewrite restr_rem. - case (in_dom_with FRO.m{mr} x{mr} Known)=>// Hidw. - by rewrite rem_id // dom_restr. -qed. - -equiv LRO_RRO_sample : LRO.sample ~ RRO.sample: - ={x} /\ RO.m{1} = restr Known FRO.m{2} ==> RO.m{1} = restr Known FRO.m{2}. -proof. - proc;auto=>?&ml[]_->. -split=> [| _ ? _]; first apply sampleto_ll. -rewrite restr_set /==>Hnd. -by rewrite rem_id // dom_restr /in_dom_with Hnd. -qed. - -lemma LRO_RRO_D (D<:RO_Distinguisher{RO,FRO}) : - equiv [D(LRO).distinguish ~ D(RRO).distinguish : - ={glob D} /\ RO.m{1} = restr Known FRO.m{2} ==> - ={res,glob D} /\ RO.m{1} = restr Known FRO.m{2} ]. -proof. - proc (RO.m{1} = restr Known FRO.m{2})=>//. - + by conseq LRO_RRO_init. + by conseq LRO_RRO_get. + by conseq LRO_RRO_set. - + by conseq LRO_RRO_rem. + by conseq LRO_RRO_sample. -qed. - -section. - -declare module D : RO_Distinguisher{RO,FRO}. - -local module M = { - proc main1() = { - var b; - RRO.resample(); - b <@ D(FRO).distinguish(); - return b; - } - - proc main2() = { - var b; - b <@ D(RRO).distinguish(); - RRO.resample(); - return b; - } -}. - -lemma RO_LRO_D : - equiv [D(RO).distinguish ~ D(LRO).distinguish : - ={glob D,RO.m} ==> ={res,glob D}]. -proof. - transitivity M.main1 - (={glob D} /\ FRO.m{2} = map (fun _ c => (c,Known)) RO.m{1} ==> - ={res,glob D}) - (={glob D} /\ FRO.m{1} = map (fun _ c => (c,Known)) RO.m{2} ==> - ={res,glob D})=>//. - + by move=>?&mr[]2!->;exists (glob D){mr}(map(fun _ c =>(c,Known))RO.m{mr}). - + proc*;inline M.main1;wp;call (RO_FRO_D D);inline *. - rcondf{2}2;auto. - + move=> &mr[]_->;apply mem_eq0=>z;rewrite -memE dom_restr /in_dom_with mapP dom_map in_dom. - by case(RO.m{m}.[_]). - by move=>?&mr[]2!->/=;rewrite map_comp /fst/= map_id. - transitivity M.main2 - (={glob D, FRO.m} ==> ={res, glob D}) - (={glob D} /\ FRO.m{1} = map (fun _ c => (c,Known)) RO.m{2} ==> - ={res,glob D})=>//. - + by move=>?&mr[]2!->;exists (glob D){mr} (map(fun _ c =>(c,Known))RO.m{mr}). - + by proc; eager call (eager_D D);auto. - proc*;inline M.main2;wp;call{1} RRO_resample_ll. - symmetry;call (LRO_RRO_D D);auto=> &ml&mr[#]2->;split=>//=. - by rewrite fmapP=>x;rewrite restrP mapP;case (RO.m{ml}.[x]). -qed. - -end section. - -end GenEager. diff --git a/sha3/proof/SHA3-Security.ec b/sha3/proof/SHA3-Security.ec index 3116fcd..fad7927 100644 --- a/sha3/proof/SHA3-Security.ec +++ b/sha3/proof/SHA3-Security.ec @@ -2,9 +2,13 @@ require import AllCore List IntDiv StdOrder Distr SmtMap FSet. -require import Common Sponge. import BIRO. +require (*--*) Common Sponge SLCommon Gconcl_list BlockSponge. -require SLCommon Gconcl_list BlockSponge. +clone import IRO as BIRO with + type from <- bool list, + type to <- bool, + op valid <- predT, + op dto <- {0,1}. (* FIX: would be nicer to define limit at top-level and then clone BlockSponge with it - so BlockSponge would then clone lower-level diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index 2c4c4f0..08febc2 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -354,7 +354,7 @@ proof. case=>h0 h0' h1 h2 _ l hl i. case(l = [])=>//=l_notnil. case(0 <= i)=>hi0;last first. -+ rewrite take_le0 1:/#;cut<-:=take0 l;smt(domE size_ge0). ++ by rewrite take_le0 1:/# domE h0. case(i < size l)=>hisize;last smt(take_oversize). smt(domE). qed. @@ -660,7 +660,8 @@ 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]. +rewrite build_hpathP; split=> [[|p' b' v' h' [#] + Hhpath Hmh]|[v' h'] [] Hhpath Hmh]. ++ smt(size_rcons size_ge0). + by move=> ^/rconsIs <<- {b'} /rconssI <<- {p'}; exists v' h'. exact/(Extend _ _ _ _ _ Hhpath Hmh). qed. @@ -683,7 +684,8 @@ lemma build_hpath_down mh xa hx ya hy p 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]. +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]. @@ -717,8 +719,9 @@ lemma path_split hs ch m mh xc hx p xa: /\ hs.[hz] = Some (zc,Unknown). proof. move=> Ihs [] _ Imh_m. -elim/last_ind: p hx xa xc=> [hx xa xc + /build_hpathP [_ <*>|/#]|]. +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. @@ -1418,10 +1421,13 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] by have /hs_of_INV [] _ _ H /H {H} := inv0. + rewrite domE/=;cut[]h1 h2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. cut h1':=h1 ya yc. - cut :Pm.[(ya, yc)] <> None => exists (hx : handle) (fx : flag), hs.[hx] = Some (yc, fx) by rewrite/#. + cut :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. - cut:=yc_notrngE1_hs_addh a b;rewrite get_setE;case(a=ch)=>//=hach. search (&&). + cut:=yc_notrngE1_hs_addh a b;rewrite get_setE;case(a=ch)=>//=hach. case(xc=yc)=>[/#|]hxyc. cut[]_ _ help:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. by cut/#:=help (yc,b) a. @@ -1442,7 +1448,10 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] apply/lemma2'=> //. + rewrite domE/=;cut[]h1 _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. cut h1':=h1 y1 y2. - cut :Pm.[(y1, y2)] <> None => exists (hx : handle) (fx : flag), hs.[hx] = Some (y2, fx) by rewrite/#. + cut :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). @@ -1856,7 +1865,9 @@ 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. - cut[]b1 h1 H_mh1:exists b1 h1, mh.[(b +^ nth witness p i, h)] = Some (b1,h1) by rewrite/#. + cut[]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)])=> //= - []. cut[]H_Pm H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. by cut/#:=H_Gmh _ _ _ _ H_mh1. cut[]b1 c1 H_Pm1:exists b1 c1, Pm.[(b +^ nth witness p i, c)] = Some (b1,c1) @@ -1953,7 +1964,7 @@ proof. * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0. * by cut[]:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 domE). * by rewrite build_hpathP; apply/Empty=> //; exact/take0. - * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 domE size_take size_eq0). + * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0; smt(take0 domE size_take size_eq0 size_ge0). * smt(prefix_sizel). case(G1.bcol{2} \/ G1.bext{2}). @@ -2084,9 +2095,18 @@ proof. /\ (i{2} < size p{2} => ! take (i{2}+1) p{2} \in Redo.prefixes{1})));last first. + auto;progress. - smt(prefix_sizel). - - cut[]HINV _:=H3 H6;split;..-2:case:HINV=>//=. - by cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV; - split=>//=;smt(take0 get_setE mem_set take_oversize take_le0). + - cut[]HINV [#] ->> _ _ _ h_sa_b0:=H3 H6;split;..-2:case:HINV=>//=. + cut[]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 cut[]HINV _:=H3 H6;cut:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - rewrite/#. - rewrite/#. @@ -2213,7 +2233,11 @@ proof. * cut:=prefix_exchange_prefix_inv(elems (fdom C.queries{2}))(elems (fdom prefixes{1}))bs{1} _ _ _. + by cut[]:=H_m_p0;smt(domE memE mem_fdom). + cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=H_m_p0. - by cut:=all_prefixes_of_m_p _ _ _ H_m_p0;smt(memE domE mem_fdom). + cut:=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 cut[]:=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). @@ -2387,7 +2411,7 @@ proof. cut:=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/=. cut->/=:=ch_neq0 _ _ H_hs_spec. - by cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h;smt(dom_hs_neq_ch). + by cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h; smt(dom_hs_neq_ch). progress. + cut:=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. cut:=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. diff --git a/sha3/proof/smart_counter/JointFMap.ec b/sha3/proof/smart_counter/JointFMap.ec deleted file mode 100644 index 7f53422..0000000 --- a/sha3/proof/smart_counter/JointFMap.ec +++ /dev/null @@ -1,19 +0,0 @@ -require import SmtMap. - -(*****) import Finite FSet List. - -op (+) (m1 m2 : ('a,'b) fmap) : ('a,'b) fmap = - ofmap (Map.offun (fun x=> if x \in m2 then m2.[x] else m1.[x])). - -lemma joinE ['a 'b] (m1 m2 : ('a,'b) fmap) (x : 'a): - (m1 + m2).[x] = if x \in m2 then m2.[x] else m1.[x]. -proof. -rewrite /(+) getE ofmapK /= 2:Map.getE 2:Map.offunK //. -apply/finiteP=> /=; exists (elems (fdom m1) ++ elems (fdom m2))=> x0 /=. -rewrite Map.getE Map.offunK /= mem_cat -!memE !mem_fdom !domE. -by case: (m2.[x0]). -qed. - -lemma mem_join ['a 'b] (m1 m2 : ('a,'b) fmap) (x : 'a): - x \in (m1 + m2) <=> x \in m1 \/ x \in m2. -proof. by rewrite domE joinE !domE; case: (m2.[x]). qed. \ No newline at end of file diff --git a/sha3/proof/smart_counter/Strong_rp_rf.eca b/sha3/proof/smart_counter/Strong_rp_rf.eca deleted file mode 100644 index bf36112..0000000 --- a/sha3/proof/smart_counter/Strong_rp_rf.eca +++ /dev/null @@ -1,608 +0,0 @@ -(* -------------------------------------------------------------------- - * Copyright (c) - 2012--2016 - IMDEA Software Institute - * Copyright (c) - 2012--2018 - Inria - * Copyright (c) - 2012--2018 - Ecole Polytechnique - * - * Distributed under the terms of the CeCILL-B-V1 license - * -------------------------------------------------------------------- *) - -require import AllCore Distr List FSet NewFMap StdRing StdOrder. -require import Dexcepted. -require (*--*) NewPRP StrongPRP IdealPRP FelTactic. -(*---*) import RField RealOrder. - -(** We assume a finite domain D, equipped with its uniform - distribution. **) -type D. -op uD: { D distr | is_uniform uD /\ is_lossless uD /\ is_full uD } as uD_uf_fu. - -(** and a type K equipped with a lossless distribution **) -type K. -op dK: { K distr | is_lossless dK } as dK_ll. - -clone import StrongPRP as PRPt with - type K <- K, - op dK <- dK, - type D <- D -proof * by smt(dK_ll) -rename "StrongPRP_" as "". - -clone import IdealPRP as PRPi with - type K <- K, - op dK <- dK, - type D <- D, - op dD <- uD -proof * by smt ml=0 w=(dK_ll uD_uf_fu) -rename "RandomPermutation" as "PRPi". - -(* This is an "Almost (Random Permutation)" (the Almost applies to Permutation) *) -(* We keep track of collisions explicitly because it's going to be useful anyway *) -module ARP = { - var coll : bool - var m, mi: (D,D) fmap - - proc init(): unit = { - m <- map0; - mi <- map0; - coll <- false; - } - - proc f(x : D) = { - var y; - - if (!mem (dom m) x) { - y <$ uD; - coll <- coll \/ mem (rng m) y; - m.[x] <- y; - mi.[y] <- x; - } - return oget m.[x]; - } - - proc fi(y : D) = { - var x; - - if (!mem (dom mi) y) { - x <$ uD; - coll <- coll \/ mem (rng mi) x; - m.[x] <- y; - mi.[y] <- x; - } - return oget mi.[y]; - } -}. - -op q : { int | 0 <= q } as ge0_q. - -(** To factor out the difficult step, we parameterize the PRP by a - procedure that samples its output, and provide two instantiations - of it. **) -module type Sample_t = { - proc sample(X:D fset): D -}. - -module Direct = { - proc sample(X:D fset): D = { - var r; - - r = $uD \ (mem X); - return r; - } -}. - -module Indirect = { - proc sample(X:D fset): D = { - var r; - - r = $uD; - if (mem X r) { - r = $uD \ (mem X); - } - return r; - } -}. - -module PRPi'(S:Sample_t) = { - proc init = PRPi.init - - proc f(x:D): D = { - if (!mem (dom PRPi.m) x) { - PRPi.m.[x] = S.sample(rng PRPi.m); - PRPi.mi.[oget PRPi.m.[x]] <- x; - } - return oget PRPi.m.[x]; - } - - proc fi(x:D): D = { - if (!mem (dom PRPi.mi) x) { - PRPi.mi.[x] = S.sample(rng PRPi.mi); - PRPi.m.[oget PRPi.mi.[x]] <- x; - } - return oget PRPi.mi.[x]; - } -}. - -(* Some losslessness lemmas *) -(* FIXME: cleanup *) - -(* FIXME: Duplicate lemmas with RP_RF *) -lemma nosmt notin_supportIP (P : 'a -> bool) (d : 'a distr): - (exists a, support d a /\ !P a) <=> mu d P < mu d predT. -proof. -rewrite (mu_split _ predT P) /predI /predT /predC /=. -rewrite (exists_eq (fun a => support d a /\ !P a) (fun a => !P a /\ a \in d)) /=. -+ by move=> a /=; rewrite andbC. -by rewrite -(witness_support (predC P)) -/(predC _) /#. -qed. - -lemma excepted_lossless (m:(D,D) fmap): - (exists x, !mem (dom m) x) => - mu (uD \ (mem (rng m))) predT = 1%r. -proof. -move=> /endo_dom_rng [x h]; rewrite dexcepted_ll //. -+ smt w=uD_uf_fu. -have [?[<- @/is_full Hsupp]]:= uD_uf_fu. -apply/notin_supportIP;exists x => />;apply Hsupp. -qed. - -phoare Indirect_ll: [Indirect.sample: exists x, support uD x /\ !mem X x ==> true] = 1%r. -proof. -proc; seq 1: (exists x, support uD x /\ !mem X x)=> //=. -+ by rnd (predT); skip; smt ml=0 w=uD_uf_fu. -if=> //=. -+ rnd (predT); skip. - by progress [-split]; split=> //=; smt. -by hoare; rnd=> //=; skip=> &hr ->. -qed. - -lemma PRPi'_Indirect_f_ll: islossless PRPi'(Indirect).f. -proof. -proc; if=> //=; auto; call Indirect_ll. -skip=> /> &hr x_notin_m. -have [x0] x0_notinr_m := endo_dom_rng PRPi.m{hr} _; first by exists x{hr}. -by exists x0; rewrite x0_notinr_m /=; smt w=uD_uf_fu. -qed. - -lemma PRPi'_Indirect_fi_ll: islossless PRPi'(Indirect).fi. -proof. -proc; if=> //=; auto; call Indirect_ll. -skip=> /> &hr x_notin_mi. -have [x0] x0_notinr_mi := endo_dom_rng PRPi.mi{hr} _; first by exists x{hr}. -by exists x0; rewrite x0_notinr_mi; smt w=uD_uf_fu. -qed. - -(** The proof is cut into 3 parts (sections): - - We first focus on proving - Pr[IND(PRPi'(Indirect),D).main() @ &m: res] - <= Pr[IND(PRFi,D).main() @ &m: res] - + Pr[IND(PRFi,D).main() @ &m: collision PRFi.m]. - - Second, we concretely bound (when the PRF oracle stops - answering queries after the q-th): - Pr[IND(PRFi,D).main() @ &m: collision PRFi.m] - <= q^2 * Pr[x = $uD: x = witness] - - We conclude by proving (difficult!) - Pr[IND(PRPi,D).main() @ &m: res] - = Pr[IND(PRPi'(Indirect),D).main() @ &m: res]. - - Purists are then invited to turn the security statement about - restricted oracles into a security statement about restricted - adversaries. **) -section Upto. - declare module D:Distinguisher {PRPi, ARP}. - axiom D_ll (O <: Oracles {D}): islossless O.f => islossless O.fi => islossless D(O).distinguish. - - local module PRP_indirect_bad = { - var bad : bool - - proc init(): unit = { - PRPi.init(); - bad <- false; - } - - proc sample(X:D fset): D = { - var r; - - r = $uD; - if (mem X r) { - bad <- true; - r = $uD \ (mem X); - } - return r; - } - - proc f(x:D): D = { - if (!mem (dom PRPi.m) x) { - PRPi.m.[x] = sample(rng PRPi.m); - PRPi.mi.[oget PRPi.m.[x]] <- x; - } - return oget PRPi.m.[x]; - } - - proc fi(y:D): D = { - if (!mem (dom PRPi.mi) y) { - PRPi.mi.[y] = sample(rng PRPi.mi); - PRPi.m.[oget PRPi.mi.[y]] <- y; - } - return oget PRPi.mi.[y]; - } - }. - - local lemma PRPi'_Indirect_eq &m: - Pr[IND(PRPi'(Indirect),D).main() @ &m: res] - = Pr[IND(PRP_indirect_bad,D).main() @ &m: res]. - proof. by byequiv=> //=; proc; inline *; sim. qed. - - (** Upto failure: if a collision does not occur in PRFi.m, then the - programs are equivalent **) - lemma pr_PRPi'_Indirect_ARP &m: - `|Pr[IND(PRPi'(Indirect),D).main() @ &m: res] - - Pr[IND(ARP,D).main() @ &m: res]| - <= Pr[IND(ARP,D).main() @ &m: ARP.coll]. - proof. - rewrite (PRPi'_Indirect_eq &m). - byequiv: PRP_indirect_bad.bad=> //=; 2:smt ml=0. - proc. - call (_: ARP.coll, - !PRP_indirect_bad.bad{1} /\ ={m,mi}(PRPi,ARP), - (PRP_indirect_bad.bad{1} <=> ARP.coll{2})). - + exact D_ll. - + proc. if=> //=; inline *. - swap{1} 1. - seq 1 4: (={x} /\ - !mem (dom PRPi.m{1}) x{1} /\ - ARP.m{2} = PRPi.m.[x <- r]{1} /\ - ARP.mi{2} = PRPi.mi.[r <- x]{1} /\ - ((PRP_indirect_bad.bad \/ mem (rng PRPi.m) r){1} <=> ARP.coll{2})). - by auto=> /#. - sp; if{1}. - conseq (_: PRP_indirect_bad.bad{1} /\ ARP.coll{2})=> //=. - auto; progress [-split]; split=> //= [|_]; 1:smt. - by progress; right. - by auto; progress [-split]; rewrite H0 /=; split=> //=; rewrite getP. - + move=> &2 bad; conseq (_: true ==> true: =1%r) - (_: PRP_indirect_bad.bad ==> PRP_indirect_bad.bad)=> //=. - by proc; if=> //=; inline *; seq 2: PRP_indirect_bad.bad; [auto|if=> //=; auto]. - proc; if=> //=; inline *. - seq 2: (X = rng PRPi.m /\ !mem (dom PRPi.m) x) 1%r 1%r 0%r _ => //=. - by auto; rewrite -/predT; smt ml=0 w=uD_uf_fu. (* predT should be an abbreviation *) - by if=> //=; auto; smt. - by hoare; auto. - + move=> &1. - proc; if; auto; progress [-split]; rewrite -/predT; split=> //= [|_]; 1:smt ml=0 w=uD_uf_fu. - by progress [-split]; rewrite H. - + proc. if=> //=; inline *. - swap{1} 1. - seq 1 4: (={y} /\ - !mem (dom PRPi.mi{1}) y{1} /\ - ARP.m{2} = PRPi.m.[r <- y]{1} /\ - ARP.mi{2} = PRPi.mi.[y <- r]{1} /\ - ((PRP_indirect_bad.bad \/ mem (rng PRPi.mi) r){1} <=> ARP.coll{2})). - by auto=> /#. - sp; if{1}. - conseq (_: PRP_indirect_bad.bad{1} /\ ARP.coll{2})=> //=. - auto; progress [-split]; split=> //= [|_]; 1:smt. - by progress; right. - by auto; progress [-split]; rewrite H0 /=; split=> //=; rewrite getP. - + move=> &2 bad; conseq (_: true ==> true: =1%r) - (_: PRP_indirect_bad.bad ==> PRP_indirect_bad.bad)=> //=. - by proc; if=> //=; inline *; seq 2: PRP_indirect_bad.bad; [auto|if=> //=; auto]. - proc; if=> //=; inline *. - seq 2: (X = rng PRPi.mi /\ !mem (dom PRPi.mi) y) 1%r 1%r 0%r _ => //=. - by auto; rewrite -/predT; smt ml=0 w=uD_uf_fu. (* predT should be an abbreviation *) - by if=> //=; auto; smt. - by hoare; auto. - + move=> &1. - proc; if; auto; progress [-split]; rewrite -/predT; split=> //= [|_]; 1:smt ml=0 w=uD_uf_fu. - by progress [-split]; rewrite H. - by inline *; auto; progress; smt. - qed. -end section Upto. - -(** We now bound the probability of collisions. We cannot do so - by instantiating the generic Birthday Bound result. It's still - the Birthday Bound, though, just not generic: - Pr[IND(ARP,DBounder(D)).main() @ &m: ARP.coll] - <= q^2 * Pr[x = $uD: x = witness], - - where DBounder prevents the distinguisher from calling the - f-oracle more than q times. **) -module DBounder (D:Distinguisher,F:Oracles) = { - module FBounder = { - var c:int - - proc f(x:D): D = { - var r = witness; - - if (c < q) { - r = F.f(x); - c = c + 1; - } - return r; - } - - proc fi(x:D): D = { - var r = witness; - - if (c < q) { - r = F.fi(x); - c = c + 1; - } - return r; - } - } - - proc distinguish(): bool = { - var b; - - FBounder.c <- 0; - b <@ D(FBounder).distinguish(); - return b; - } -}. - -section CollisionProbability. - require import Mu_mem. - (*---*) import StdBigop StdRing StdOrder IntExtra. - (*---*) import Bigreal.BRA RField RField.AddMonoid IntOrder. - - declare module D:Distinguisher {ARP, DBounder}. - axiom D_ll (O <: Oracles {D}): islossless O.f => islossless O.fi => islossless D(O).distinguish. - - local module FEL (D : Distinguisher) = { - var c : int - - module FBounder = { - proc f(x:D): D = { - var r = witness; - - if (c < q) { - if (card (rng ARP.m) < q) { - r = ARP.f(x); - } - c = c + 1; - } - return r; - } - - proc fi(x:D): D = { - var r = witness; - - if (c < q) { - if (card (rng ARP.mi) < q) { - r = ARP.fi(x); - } - c = c + 1; - } - return r; - } - } - - proc main(): bool = { - var b : bool; - - ARP.init(); - c <- 0; - b <@ D(FBounder).distinguish(); - return b; - } - }. - - lemma pr_PRFi_collision &m: - Pr[IND(ARP,DBounder(D)).main() @ &m: ARP.coll] - <= (q^2)%r / 2%r * mu uD (pred1 witness). - proof. - have ->: Pr[IND(ARP,DBounder(D)).main() @ &m: ARP.coll] - = Pr[IND(ARP,DBounder(D)).main() @ &m: ARP.coll /\ DBounder.FBounder.c <= q]. - + byequiv=> //=; conseq (_: ={glob D} ==> ={ARP.coll,DBounder.FBounder.c}) - (_: true ==> DBounder.FBounder.c <= q)=> //=. - * proc; inline *; wp; call (_: DBounder.FBounder.c <= q). - - by proc; sp; if=> //=; inline*; sp; if=> //=; auto=> /#. - - by proc; sp; if=> //=; inline*; sp; if=> //=; auto=> /#. - by auto=> /=; apply/ge0_q. - by sim. - have ->: Pr[IND(ARP,DBounder(D)).main() @ &m: ARP.coll /\ DBounder.FBounder.c <= q] - = Pr[FEL(D).main() @ &m: ARP.coll /\ FEL.c <= q]. - + byequiv=> //=; proc; inline *; wp. - call (_: ={glob ARP} /\ ={c}(DBounder.FBounder,FEL) /\ card (rng ARP.m){1} <= FEL.c{2} /\ card (rng ARP.mi){1} <= FEL.c{2}). - * proc; sp; if=> //=. rcondt{2} 1; first by auto=> /#. - inline *; sp; if=> //=; auto. - - progress. - + apply/(ler_trans (card (rng ARP.m{2} `|` fset1 yL))). - apply/subset_leq_fcard=> x; rewrite rng_set !inE rng_rem in_rng. - by move=> [[a] [] _ ma|-> //=]; left; exists a. - smt. - + apply/(ler_trans (card (rng ARP.mi{2} `|` fset1 x{2}))). - apply/subset_leq_fcard=> x; rewrite rng_set !inE rng_rem in_rng. - by move=> [[a] [] _ ma|-> //=]; left; exists a. - smt. - - smt ml=0. - * proc; sp; if=> //=. rcondt{2} 1; first by auto=> /#. - inline *; sp; if=> //=; auto. - - progress. - + apply/(ler_trans (card (rng ARP.m{2} `|` fset1 x{2}))). - apply/subset_leq_fcard=> x; rewrite rng_set !inE rng_rem in_rng. - by move=> [[a] [] _ ma|-> //=]; left; exists a. - smt. - + apply/(ler_trans (card (rng ARP.mi{2} `|` fset1 x0L))). - apply/subset_leq_fcard=> x; rewrite rng_set !inE rng_rem in_rng. - by move=> [[a] [] _ ma|-> //=]; left; exists a. - smt. - - smt ml=0. - by auto; progress; rewrite rng0 fcards0. - fel 2 FEL.c (fun x, x%r * mu uD (pred1 witness)) q (ARP.coll) [FEL(D).FBounder.f: (FEL.c < q); FEL(D).FBounder.fi: (FEL.c < q)] (size ARP.m <= FEL.c /\ size ARP.mi <= FEL.c)=> //. - + rewrite-mulr_suml Bigreal.sumidE 1:ge0_q. - by rewrite (powS 1) // pow1;smt(mu_bounded ge0_q). - + by inline*; auto; smt(dom0 fcards0 sizeE). - + exists*FEL.c;elim*=> c. - conseq(:_==>_ : (c%r * mu1 uD witness));progress. - proc; sp; rcondt 1=> //. - inline *; sp; if=> //=; last first. - * hoare; auto=> // /> &hr _ _ _ _ _ _. - by apply/RealOrder.mulr_ge0; smt w=(mu_bounded ge0_q). - sp; if=> //=. - * wp; rnd (mem (rng ARP.m)); skip. - progress. - - apply/(RealOrder.ler_trans ((card (rng ARP.m{hr}))%r * mu uD (pred1 witness))). - apply/mu_mem_le; move=> x _; have [] uD_suf [] ? uD_fu:= uD_uf_fu. - apply/RealOrder.lerr_eq/uD_suf; 1,2:rewrite uD_fu //. - by apply/RealOrder.ler_wpmul2r; smt w=(mu_bounded lt_fromint ltrW sizeE leq_card_rng_dom). - - by move: H9;rewrite H1. - * by hoare; auto=> //=; smt w=(RealOrder.mulr_ge0 mu_bounded ge0_q). - + move=> c; proc. rcondt 2; 1:by auto. - sp; if=> //=. - * inline*;sp;if;auto; 2:smt(). - move=> &hr /> + + + + + y. - by rewrite !sizeE !dom_set !fcardU !fcard1; smt(fcard_ge0). - * by auto=> /#. - + by move=> b c; proc; rcondf 2; auto. - + exists*FEL.c;elim*=> c. - conseq(:_==>_ : (c%r * mu1 uD witness));progress. - proc; sp; rcondt 1=> //=. - inline *; sp; if=> //=; last by hoare; auto; smt w=(RealOrder.mulr_ge0 mu_bounded ge0_q). - sp; if=> //=. - * wp; rnd (mem (rng ARP.mi)); skip. - progress. - - apply/(RealOrder.ler_trans ((card (rng ARP.mi{hr}))%r * mu uD (pred1 witness))). - apply/mu_mem_le; move=> x _; have [] uD_suf [] _ uD_fu:= uD_uf_fu. - apply/RealOrder.lerr_eq/uD_suf; 1,2:rewrite uD_fu //. - smt w=(RealOrder.ler_wpmul2r mu_bounded le_fromint ltrW sizeE leq_card_rng_dom). - - by move: H9; rewrite H1. - * by hoare; auto; smt w=(RealOrder.mulr_ge0 mu_bounded ge0_q). - + move=> c; proc; rcondt 2; 1:by auto. - sp; if=> //=. - * inline*;sp;if;auto; 2:smt(). - move=> &hr /> + + + + + x. - by rewrite !sizeE !dom_set !fcardU !fcard1; smt(fcard_ge0). - * by auto=> /#. - + by move=> b c; proc; rcondf 2; auto. - qed. -end section CollisionProbability. - -(* We pull together the results of the first two sections *) -lemma PartialConclusion (D <: Distinguisher {PRPi, ARP, DBounder}) &m: - (forall (O <: Oracles {D}), islossless O.f => islossless O.fi => islossless D(O).distinguish) => - `|Pr[IND(PRPi'(Indirect),DBounder(D)).main() @ &m: res] - - Pr[IND(ARP,DBounder(D)).main() @ &m: res]| - <= (q^2)%r / 2%r * mu uD (pred1 witness). -proof. -move=> D_ll. -have:= pr_PRFi_collision D D_ll &m. -have /#:= pr_PRPi'_Indirect_ARP (DBounder(D)) _ &m. -move=> O O_f_ll O_fi_ll; proc. -call (D_ll (<: DBounder(D,O).FBounder) _ _). - by proc; sp; if=> //=; wp; call O_f_ll. - by proc; sp; if=> //=; wp; call O_fi_ll. -by auto. -qed. - -(** This section proves the equivalence between the Ideal PRP and the - module PRPi'(Indirect) used in section Upto. **) -section PRPi_PRPi'_Indirect. - (* The key is in proving that Direct.sample and Indirect.sample - define the same distribution. We do this by extensional equality - of distributions: - forall a, Pr[Direct.sample: res = a] = Pr[Indirect.sample: res = a]. *) - equiv eq_Direct_Indirect: Direct.sample ~ Indirect.sample: ={X} ==> ={res}. - proof. - bypr (res{1}) (res{2})=> //. (* Pointwise equality of distributions *) - progress. - (* We first perform the computation on the easy side,... *) - cut ->: Pr[Direct.sample(X{1}) @ &1: res = a] = mu (uD \ (mem X){1}) (pred1 a). - byphoare (_: X = X{1} ==> _)=> //=. - by proc; rnd=> //=; auto. - subst X{1}. - (* ... and we are left with the difficult side *) - byphoare (_: X = X{2} ==> _)=> //=. - (* We deal separately with the case where a is in X and thus has - probability 0 of being sampled) *) - case (mem X{2} a)=> [a_in_X | a_notin_X]. - conseq (_: _ ==> _: 0%r); first smt. - proc. - seq 1: (mem X r) - _ 0%r - _ 0%r - (X = X{2}). - by auto. - by rcondt 1=> //=; rnd=> //=; skip; smt. - by rcondf 1=> //=; hoare; skip; smt. - done. - (* And we are now left with the case where a is not in X *) - proc. - alias 2 r0 = r. - (* There are two scenarios that lead to a = r: - - r0 = a /\ r = a (with probability mu uD (pred1 a)); - - r0 <> a /\ r = a (with probability mu uD (fun x, mem x X) * mu (uD \ X) (pred1 a)). *) - phoare split (mu uD (pred1 a)) (mu uD (mem X) * mu (uD \ (mem X)) (pred1 a)): (r0 = a). - (* Bound *) - progress. - rewrite dexcepted1E. - have [] uD_suf [] uD_ll uD_fu /=:= uD_uf_fu. - cut not_empty: mu uD predT - mu uD (mem X{2}) <> 0%r. - rewrite -mu_not. - cut: 0%r < mu uD (predC (mem X{2})); last smt. - by rewrite witness_support; exists a; rewrite uD_fu /= /predC a_notin_X. - by smt ml=0 w=uD_uf_fu. - (* case r0 = a *) - seq 2: (a = r0) (mu uD (pred1 a)) 1%r _ 0%r (r0 = r /\ X = X{2}). - by auto. - by wp; rnd; skip; progress; rewrite pred1E -(etaE ((=) a)) etaP. - by rcondf 1. - by hoare; conseq (_: _ ==> true)=> //=; smt. - done. - (* case r0 <> a *) - seq 2: (!mem X r) - _ 0%r - (mu uD (mem X)) (mu (uD \ (mem X)) (pred1 a)) - (r0 = r /\ X = X{2}). - by auto. - by hoare; rcondf 1=> //=; skip; smt. - by wp; rnd. - rcondt 1=> //=; rnd (pred1 a). - by skip; smt. - done. - qed. - - (* The rest is easy *) - local equiv eq_PRPi_PRPi'_f_Indirect: PRPi.f ~ PRPi'(Indirect).f: - ={x, PRPi.m, PRPi.mi} ==> ={res, PRPi.m, PRPi.mi}. - proof. - transitivity PRPi'(Direct).f (={PRPi.m,PRPi.mi,x} ==> ={PRPi.m,PRPi.mi,res}) (={PRPi.m,PRPi.mi,x} ==> ={PRPi.m,PRPi.mi,res}). - + by move=> &1 &2 [->> [->> ->>]]; exists PRPi.m{2} PRPi.mi{2} x{2}. - + done. - + by proc; inline *; if=> //=; auto; progress; rewrite getP. - + by proc; if=> //=; wp; call eq_Direct_Indirect. - qed. - - local equiv eq_PRPi_PRPi'_fi_Indirect: PRPi.fi ~ PRPi'(Indirect).fi: - y{1} = x{2} /\ ={PRPi.m, PRPi.mi} ==> ={res, PRPi.m, PRPi.mi}. - proof. - transitivity PRPi'(Direct).fi (={PRPi.m,PRPi.mi} /\ y{1} = x{2} ==> ={PRPi.m,PRPi.mi,res}) (={PRPi.m,PRPi.mi,x} ==> ={PRPi.m,PRPi.mi,res}). - + by move=> &1 &2 [->> [->> ->>]]; exists PRPi.m{2} PRPi.mi{2} x{2}. - + done. - + by proc; inline *; if=> //=; auto; progress; rewrite getP. - + by proc; if=> //=; wp; call eq_Direct_Indirect. - qed. - - declare module D:Distinguisher {PRPi}. - - lemma pr_PRPi_PRPi'_Indirect &m: - Pr[IND(PRPi,D).main() @ &m: res] = Pr[IND(PRPi'(Indirect),D).main() @ &m: res]. - proof. - byequiv=> //=. - proc. - call (_: ={PRPi.m,PRPi.mi}). - by apply eq_PRPi_PRPi'_f_Indirect. - by apply eq_PRPi_PRPi'_fi_Indirect. - by inline*; auto. - qed. -end section PRPi_PRPi'_Indirect. - -lemma Conclusion (D <: Distinguisher {PRPi, ARP, DBounder}) &m: - (forall (O <: Oracles {D}), islossless O.f => islossless O.fi => islossless D(O).distinguish) => - `|Pr[IND(PRPi,DBounder(D)).main() @ &m: res] - - Pr[IND(ARP,DBounder(D)).main() @ &m: res]| - <= (q^2)%r / 2%r * mu uD (pred1 witness). -proof. -move=> D_ll. -by rewrite (pr_PRPi_PRPi'_Indirect (DBounder(D)) &m) (PartialConclusion D &m D_ll). -qed. From 2c133356185c692f805172319700aac8b49f8850 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 18 Sep 2018 20:58:50 +0200 Subject: [PATCH 312/394] repush Handle --- sha3/proof/smart_counter/Handle.eca | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index 08febc2..ccd780f 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -2465,7 +2465,10 @@ proof. by rewrite-rcons_cat (@take_nth witness);smt(prefix_ge0). * rewrite/#. * cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. - split;cut[]//=:=H_m_p0; smt(get_setE domE take_take take_nth size_take + split;cut[]//= 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/=oget_some;smt(domE). + smt(get_setE domE take_take size_take prefix_ge0 nth_take take_oversize take_le0). From 24731c9368ddd885bd7761bdd5a9b3c1409214e5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 19 Sep 2018 11:52:06 +0100 Subject: [PATCH 313/394] undoing CI breakage --- sha3/proof/SHA3-Security.ec | 2 ++ 1 file changed, 2 insertions(+) diff --git a/sha3/proof/SHA3-Security.ec b/sha3/proof/SHA3-Security.ec index fad7927..ec8af81 100644 --- a/sha3/proof/SHA3-Security.ec +++ b/sha3/proof/SHA3-Security.ec @@ -4,6 +4,8 @@ require import AllCore List IntDiv StdOrder Distr SmtMap FSet. require (*--*) Common Sponge SLCommon Gconcl_list BlockSponge. +(*---*) import Common Sponge BIRO. + clone import IRO as BIRO with type from <- bool list, type to <- bool, From 5e1aada98e9c5c15cf9dc24b0973f45817b2c370 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Wed, 19 Sep 2018 21:49:32 +0200 Subject: [PATCH 314/394] lowering down the simulator's complexity --- sha3/proof/smart_counter/Gconcl_list.ec | 309 ++++++++++++++++++++++-- 1 file changed, 292 insertions(+), 17 deletions(-) diff --git a/sha3/proof/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec index 32e7e8d..9c5452e 100644 --- a/sha3/proof/smart_counter/Gconcl_list.ec +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -250,9 +250,9 @@ section Ideal. - smt(leq_add_in domE). rcondf{2}2;auto;progress. - smt(DBlock.dunifin_ll). + - smt(size_cat size_nseq size_eq0 size_ge0). - smt(). - - smt(). - - smt(). search "_.[_<-_]". + - smt(). - by move: H11; rewrite domE; case: (SLCommon.C.queries{1}.[format bl{2} (i_R + 2)]). - smt(). sp;conseq(:_==> ={F.RO.m,b} @@ -513,14 +513,17 @@ section Ideal. 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. - + cut[]add_maps h1 h2:=H5;rewrite add_maps joinE//=;smt(parse_valid). + + cut[]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 cut[]add_maps h1 h2:=H1;rewrite add_maps joinE//=;smt(parse_valid). rcondt{1}2;2:rcondt{2}2;auto;progress. - - smt(lemma2 incl_dom parse_valid). + - 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). - cut[]add_maps h1 h2:=H1;rewrite add_maps !get_setE joinE//=;smt(parse_valid nseq0 cats0). - cut:=H;rewrite -H0=>//=[][]->>->>;apply lemma1=>//=;1:smt(parse_valid). cut[]add_maps h1 h2:=H1;smt(parse_valid formatK parseK incl_dom). @@ -552,7 +555,12 @@ section Ideal. 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). - by rcondt{1}2;2:rcondt{2}2;auto;progress;smt(incl_dom lemma1). + 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. @@ -569,12 +577,17 @@ section Ideal. /\ 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. - * cut[]:=H2;smt(incl_dom lemma2 formatK parse_not_valid). + * cut[]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(). - * by cut:=lemma3 _ _ _ _ r0L H2 _ H5;smt(parse_not_valid). + * cut//=:=lemma3 _ _ _ _ r0L H2 _ H5. + by have:= parse_not_valid x{2}; rewrite H1 /= H0 /= => h; exact/(h (i_R+1)). auto;smt(). qed. @@ -756,7 +769,10 @@ section Ideal. - by while(i+1<=n);auto; smt(parse_valid parse_gt0 parseK mem_set formatK). wp 8 5;rnd{1};wp 6 5. - conseq(:_==> ={F2.RO.m} /\ format pp{2} n{2} = x3{2});1:smt(DBlock.dunifin_ll last_rcons formatK parseK). + conseq(:_==> ={F2.RO.m} /\ format pp{2} n{2} = x3{2}). + + move=> /> &1 &2 H H0 /= /> [#] H1 H2 m lres. + rewrite DBlock.dunifin_ll /= => ?; rewrite DBlock.supp_dunifin /=. + 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). @@ -992,7 +1008,10 @@ section Real. local lemma invm_dom_rng (m mi : (state, state) fmap) : invm m mi => dom m = rng mi. proof. - by move=>h; rewrite fun_ext=> x; rewrite domE rngE /=; have := h x; smt(). + 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: @@ -1194,11 +1213,13 @@ section Real. 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;2:smt(domE take_le0 mem_set). - case(j < i0{2} + 1)=>hjiS;2:smt(domE take_take mem_set). - rewrite mem_set take_take/min hjiS//=;left. - cut:=(take_take bl{2} j i0{2});rewrite min_lel 1:/#=><-. - smt(all_prefixes_of_INV_real domE). + 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 min_lel 1:/# min_lel. + 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(). @@ -1214,7 +1235,9 @@ section Real. 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;2:smt(domE take_le0). + 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. cut:=(take_take bl{2} j i0{2});rewrite min_lel 1:/#=><-. @@ -1280,8 +1303,9 @@ section Real. + if;auto;progress. - by split;case:H3=>//=;smt(). - by rewrite domE H2//=. - - move:H4;rewrite take_size /= domE. - by case: (Redo.prefixes{2}.[format bl{2} (i{2} + 1)])=>//=; smt(). + - 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/=!oget_some nth_last/=take_size. rewrite last_cat last_nseq 1:/# Block.WRing.addr0;progress. @@ -1892,3 +1916,254 @@ section Real_Ideal_Abs. 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,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(q, k); + y1 <- last b0 z; + } else { + if ((q,k) \notin unvalid_map) { + unvalid_map.[(q,k)] <$ bdistr; + } + y1 <- oget unvalid_map.[(q,k)]; + } + } 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; + } +}. + +print BIRO2.IRO. +section Simplify_Simulator. + +declare module D : DISTINGUISHER{Simulator, F.RO, BIRO.IRO, C, S, BIRO2.IRO}. + +axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : + islossless P0.f => islossless P0.fi => islossless F0.f => + islossless D(F0, P0).distinguish. + +module type FRO_While = { + proc init () : unit + proc f (p : block list, n : int) : block +}. + +local module Simu (FRO : FRO_While) (F : DFUNCTIONALITY) = { + proc init() = { + Simulator(F).init(); + FRO.init(); + } + proc f (x : state) : state = { + var p,q,v,k,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) { + y1 <- FRO.f(q,k); + } 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 Lator (F : F.RO) : FRO_While = { + proc init() = { + F.init(); + } + proc f (p : block list, n : int) : block = { + var i; + i <- 0; + while (i < n) { + i <- i + 1; + F.sample(format p i); + } + Simulator.unvalid_map.[(p,n)] <@ F.get(format p n); + return oget Simulator.unvalid_map.[(p,n)]; + } +}. + +op inv_map2 (m1 : (block list, block) fmap) (m2 : (block list * int, + block) fmap) : bool = + (forall (p : block list) (n : int) (x : block list), + !valid (parse x).`1 => + x = format p (n + 1) => + (p, n) \in m2 <=> x \in m1) /\ + (forall (p : block list) (n : int) (x : block list), + !valid (parse x).`1 => + x = format p (n + 1) => + x \in m1 <=> (p, n) \in m2) /\ + (forall (p : block list) (n : int) (x : block list), + !valid (parse x).`1 => + x = format p (n + 1) => + m2.[(p, n)] = m1.[x]) /\ + (forall (p : block list) (n : int) (x : block list), + !valid (parse x).`1 => + x = format p (n + 1) => + m1.[x] = m2.[(p, n)]). + +local lemma equal1 &m : + Pr [ IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res ] = + Pr [ IdealIndif(BIRO.IRO, Simu(Lator(F.RO)), DRestr(D)).main() @ &m : res ]. +proof. +byequiv=>//=; proc; inline*; auto. +call (: ={BIRO.IRO.mp,C.c} /\ ={m,mi,paths}(S,Simulator) /\ + inv_map2 F.RO.m{2} BIRO2.IRO.mp{1} /\ + incl Simulator.unvalid_map{2} BIRO2.IRO.mp{1}); first last. ++ by proc; inline*; conseq=>/>; sim. ++ by proc; inline*; conseq=>/>; sim. ++ by auto; progress; smt(mem_empty). +proc;sp;if;auto. +call(: ={BIRO.IRO.mp} /\ ={m,mi,paths}(S,Simulator) /\ + inv_map2 F.RO.m{2} BIRO2.IRO.mp{1} /\ + 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) /\ + inv_map2 F.RO.m{2} BIRO2.IRO.mp{1} /\ + 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 h9 h10 h11 h12. + 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 h11 h12. + 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(:_ ==> format p0 n0 \in F.RO.m)=> />. + splitwhile 1 : i0 + 1 < n0. + rcondt 2; 1:(auto; while (i0 + 1 <= n0); auto; smt()). + rcondf 7; 1:(auto; while (i0 + 1 <= n0); auto; smt()). + seq 1 : (q = p0 /\ n0 = k /\ i0 + 1 = n0). + - by while(q = p0 /\ n0 = k /\ i0 + 1 <= n0); auto; smt(). + by auto=> />; smt(mem_set). +wp; rnd{2}; wp=> /=. +(** TODO : reprendre ici !! **) +conseq(:_==> ={BIRO.IRO.mp, i0, n0, p0, x} /\ i0{1} = n0{1} /\ + (0 < i0{1} => last Block.b0 bs0{1} = oget F.RO.m{2}.[format p0{2} i0{2}]) /\ + inv_map2 F.RO.m{2} BIRO2.IRO.mp{1} /\ + (0 < i0{1} => format p0{2} i0{2} \in F.RO.m{2}));progress. ++ exact/DBlock.dunifin_ll. ++ by rewrite get_set_sameE oget_some H10//=. ++ move=>z; rewrite get_setE; pose y := rcons p{1} (v{1} +^ x{2}.`1). + case: (z = (y,k{2}))=>//= />. + - have[]h1[]h2[]h3 h4:= H4. + have/=:= h3 q{2} k{2} (format y (k{2} + 1)). + have:= H; rewrite -H1 => [#] />. + have:= H3. + have-> : q_L = (parse y).`1 by smt(). + have-> : k_L = (parse y).`2 by smt(). + rewrite (formatK y) => [#]. + have:= H0; rewrite -H2 => [#] />. + have />: k{2} = (parse y).`2 by smt(). + have {1}->: (rcons p{1} (v{1} +^ x{2}.`1)) = (parse y).`1 by smt(). +move: H3; have{1}-> H3: rcons p{1} (v{1} +^ x{2}.`1) = (parse (format(rcons p{1} (v{1} +^ x{2}.`1)) k{2})).`1 by smt(). + have:= parse_not_valid (format q{2} k{2}) H8 (k{2}+1). + have-> : format (parse (format q{2} k{2})).`1 (k{2} + 1) = + format (format (parse (format q{2} k{2})).`1 k{2}) 2. + - rewrite/(format _ 2)/=/format/=-catA; congr. + by rewrite nseq1 cats1 -nseqSr 1:/#. + have{2}-> : k{2} = (parse (format q{2} k{2})).`2 by smt(). + rewrite (formatK (format q{2} k{2})). + have->: format (format q{2} k{2}) 2 = format q{2} (k{2} + 1). + - rewrite/(format _ 2)/=/format/=-catA; congr. + by rewrite nseq1 cats1 -nseqSr 1:/#. + by move=> -> /= ->; move: H11; rewrite domE; case: (m_R.[format q{2} k{2}]). + smt(). + +while(i0{2} <= n0{2} /\ ={i0,p0,n0} /\ inv_map2 F.RO.m{2} BIRO2.IRO.mp{1} /\ + format p0{2} (i0{2} + 1) \in F.RO.m{2} /\ x1{1} = p0{1} /\ + incl Simulator.unvalid_map{2} BIRO2.IRO.mp{1} /\ ! valid p0{2} /\ + (0 < i0{2} => last Block.b0 bs0{1} = + oget F.RO.m{2}.[format p0{2} (i0{2} + 1)])). ++ sp; if{1}; 2: rcondf{2} 2; 1: rcondt{2} 2; auto; progress. + +qed. From bc5944595265b610947fc40ca7ce298d774bed58 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 19 Sep 2018 19:22:21 -0400 Subject: [PATCH 315/394] The lemmas of MapAux are now in SmtMap on EasyCrypt:deploy-new-prom. Fixed comments to substitute PROM for RndO. --- sha3/proof/Sponge.ec | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 72f010a..8df8e7c 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -2,7 +2,7 @@ prover quorum=2 ["Z3" "Alt-Ergo"]. -require import Core Int IntDiv Real List FSet SmtMap MapAux. +require import Core Int IntDiv Real List FSet SmtMap. (*---*) import IntExtra. require import Distr DBool DList. require import StdBigop StdOrder. import IntOrder. @@ -162,7 +162,7 @@ module RaiseSim (S : BlockSponge.SIMULATOR, F : DFUNCTIONALITY) = Dist).main() @ &m : res] This step is proved using the eager sampling lemma provided by - RndO. + PROM. Step 3: @@ -294,7 +294,7 @@ module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { } }. -(* we are going to use RndO.GenEager to prove: +(* we are going to use PROM.GenEager to prove: lemma HybridIROExper_Lazy_Eager (D <: HYBRID_IRO_DIST{HybridIROEager, HybridIROLazy}) &m : From b575fd90359ae14c5a980ae9c8cb6f9452835ef4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 20 Sep 2018 14:59:19 +0200 Subject: [PATCH 316/394] Making the simulator great again: time complexity improved --- sha3/proof/smart_counter/Gconcl_list.ec | 234 +++++++++++++----------- 1 file changed, 129 insertions(+), 105 deletions(-) diff --git a/sha3/proof/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec index 9c5452e..1216a6d 100644 --- a/sha3/proof/smart_counter/Gconcl_list.ec +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -1896,7 +1896,7 @@ section Real_Ideal_Abs. by proc;call(D_lossless F0 P0 H H0 H1);auto. qed. - lemma Real_Ideal &m : + 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 + @@ -1930,20 +1930,23 @@ module Simulator (F : DFUNCTIONALITY) = { unvalid_map <- empty; } proc f (x : state) : state = { - var p,v,z,q,k,cs,y,y1,y2; + var p,v,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(q, k); - y1 <- last b0 z; + y1 <- last b0 cs; } else { - if ((q,k) \notin unvalid_map) { - unvalid_map.[(q,k)] <$ bdistr; + if (0 < k) { + if ((q,k-1) \notin unvalid_map) { + unvalid_map.[(q,k-1)] <$ bdistr; + } + y1 <- oget unvalid_map.[(q,k-1)]; + } else { + y1 <- b0; } - y1 <- oget unvalid_map.[(q,k)]; } } else { y1 <$ bdistr; @@ -1976,7 +1979,6 @@ module Simulator (F : DFUNCTIONALITY) = { } }. -print BIRO2.IRO. section Simplify_Simulator. declare module D : DISTINGUISHER{Simulator, F.RO, BIRO.IRO, C, S, BIRO2.IRO}. @@ -1985,18 +1987,19 @@ axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : islossless P0.f => islossless P0.fi => islossless F0.f => islossless D(F0, P0).distinguish. -module type FRO_While = { - proc init () : unit - proc f (p : block list, n : int) : block -}. +local clone import PROM.GenEager as IRO2 with + type from <- block list * int, + type to <- block, + op sampleto <- fun _, bdistr +proof * by exact/DBlock.dunifin_ll. -local module Simu (FRO : FRO_While) (F : DFUNCTIONALITY) = { +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,cs,y,y1,y2; + 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]; @@ -2006,7 +2009,12 @@ local module Simu (FRO : FRO_While) (F : DFUNCTIONALITY) = { y1 <- last b0 cs; } else { if (0 < k) { - y1 <- FRO.f(q,k); + i <- 0; + while (i < k) { + FRO.sample(q,i); + i <- i + 1; + } + y1 <- FRO.get(q,k-1); } else { y1 <- b0; } @@ -2042,64 +2050,33 @@ local module Simu (FRO : FRO_While) (F : DFUNCTIONALITY) = { } }. -local module Lator (F : F.RO) : FRO_While = { - proc init() = { - F.init(); - } - proc f (p : block list, n : int) : block = { - var i; - i <- 0; - while (i < n) { - i <- i + 1; - F.sample(format p i); - } - Simulator.unvalid_map.[(p,n)] <@ F.get(format p n); - return oget Simulator.unvalid_map.[(p,n)]; - } +local module L (F : IRO2.RO) = { + proc distinguish = IdealIndif(BIRO.IRO, Simu(F), DRestr(D)).main }. -op inv_map2 (m1 : (block list, block) fmap) (m2 : (block list * int, - block) fmap) : bool = - (forall (p : block list) (n : int) (x : block list), - !valid (parse x).`1 => - x = format p (n + 1) => - (p, n) \in m2 <=> x \in m1) /\ - (forall (p : block list) (n : int) (x : block list), - !valid (parse x).`1 => - x = format p (n + 1) => - x \in m1 <=> (p, n) \in m2) /\ - (forall (p : block list) (n : int) (x : block list), - !valid (parse x).`1 => - x = format p (n + 1) => - m2.[(p, n)] = m1.[x]) /\ - (forall (p : block list) (n : int) (x : block list), - !valid (parse x).`1 => - x = format p (n + 1) => - m1.[x] = m2.[(p, n)]). - local lemma equal1 &m : Pr [ IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res ] = - Pr [ IdealIndif(BIRO.IRO, Simu(Lator(F.RO)), 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) /\ - inv_map2 F.RO.m{2} BIRO2.IRO.mp{1} /\ + 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; progress; smt(mem_empty). -proc;sp;if;auto. ++ by auto. +proc; sp; if; auto. call(: ={BIRO.IRO.mp} /\ ={m,mi,paths}(S,Simulator) /\ - inv_map2 F.RO.m{2} BIRO2.IRO.mp{1} /\ - incl Simulator.unvalid_map{2} BIRO2.IRO.mp{1});auto. + 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) /\ - inv_map2 F.RO.m{2} BIRO2.IRO.mp{1} /\ - incl Simulator.unvalid_map{2} BIRO2.IRO.mp{1}); last first. +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 h9 h10 h11 h12. +- 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(). @@ -2107,7 +2084,7 @@ inline*; sp; if; 1,2: auto. 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 h11 h12. + * 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(). @@ -2118,52 +2095,99 @@ inline*; sp; if; 1,2: auto. 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(:_ ==> format p0 n0 \in F.RO.m)=> />. - splitwhile 1 : i0 + 1 < n0. - rcondt 2; 1:(auto; while (i0 + 1 <= n0); auto; smt()). - rcondf 7; 1:(auto; while (i0 + 1 <= n0); auto; smt()). - seq 1 : (q = p0 /\ n0 = k /\ i0 + 1 = n0). - - by while(q = p0 /\ n0 = k /\ i0 + 1 <= n0); auto; smt(). ++ 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=> /=. -(** TODO : reprendre ici !! **) -conseq(:_==> ={BIRO.IRO.mp, i0, n0, p0, x} /\ i0{1} = n0{1} /\ - (0 < i0{1} => last Block.b0 bs0{1} = oget F.RO.m{2}.[format p0{2} i0{2}]) /\ - inv_map2 F.RO.m{2} BIRO2.IRO.mp{1} /\ - (0 < i0{1} => format p0{2} i0{2} \in F.RO.m{2}));progress. -+ exact/DBlock.dunifin_ll. -+ by rewrite get_set_sameE oget_some H10//=. -+ move=>z; rewrite get_setE; pose y := rcons p{1} (v{1} +^ x{2}.`1). - case: (z = (y,k{2}))=>//= />. - - have[]h1[]h2[]h3 h4:= H4. - have/=:= h3 q{2} k{2} (format y (k{2} + 1)). - have:= H; rewrite -H1 => [#] />. - have:= H3. - have-> : q_L = (parse y).`1 by smt(). - have-> : k_L = (parse y).`2 by smt(). - rewrite (formatK y) => [#]. - have:= H0; rewrite -H2 => [#] />. - have />: k{2} = (parse y).`2 by smt(). - have {1}->: (rcons p{1} (v{1} +^ x{2}.`1)) = (parse y).`1 by smt(). -move: H3; have{1}-> H3: rcons p{1} (v{1} +^ x{2}.`1) = (parse (format(rcons p{1} (v{1} +^ x{2}.`1)) k{2})).`1 by smt(). - have:= parse_not_valid (format q{2} k{2}) H8 (k{2}+1). - have-> : format (parse (format q{2} k{2})).`1 (k{2} + 1) = - format (format (parse (format q{2} k{2})).`1 k{2}) 2. - - rewrite/(format _ 2)/=/format/=-catA; congr. - by rewrite nseq1 cats1 -nseqSr 1:/#. - have{2}-> : k{2} = (parse (format q{2} k{2})).`2 by smt(). - rewrite (formatK (format q{2} k{2})). - have->: format (format q{2} k{2}) 2 = format q{2} (k{2} + 1). - - rewrite/(format _ 2)/=/format/=-catA; congr. - by rewrite nseq1 cats1 -nseqSr 1:/#. - by move=> -> /= ->; move: H11; rewrite domE; case: (m_R.[format q{2} k{2}]). - smt(). +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. + cut-> : q{2} = (parse (rcons p{1} (v{1} +^ x{2}.`1))).`1 by smt(). + cut-> : 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. -while(i0{2} <= n0{2} /\ ={i0,p0,n0} /\ inv_map2 F.RO.m{2} BIRO2.IRO.mp{1} /\ - format p0{2} (i0{2} + 1) \in F.RO.m{2} /\ x1{1} = p0{1} /\ - incl Simulator.unvalid_map{2} BIRO2.IRO.mp{1} /\ ! valid p0{2} /\ - (0 < i0{2} => last Block.b0 bs0{1} = - oget F.RO.m{2}.[format p0{2} (i0{2} + 1)])). -+ sp; if{1}; 2: rcondf{2} 2; 1: rcondt{2} 2; auto; progress. - + +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)=>//=. qed. + + +end section Simplify_Simulator. + + + + + +section Real_Ideal. + declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.RRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO, Simulator}. + + 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. From 5323a6f4112c98d52ac11492c262e12a9006c63c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 20 Sep 2018 17:11:59 +0100 Subject: [PATCH 317/394] push on some painful smt calls in Sponge --- sha3/proof/Sponge.ec | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 8df8e7c..c72b857 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -617,12 +617,16 @@ lemma lazy_invar_upd_lu_eq proof. move=> li mem_upd_mp1. case: ((cs, m) = (bs, n))=> [[-> ->] | cs_m_neq_bs_n]. -smt(get_setE). ++ 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 eq_mn] | p2b_bs_n_neq_p2b_cs_m]. -smt(pad2blocks_inj). smt(get_setE). smt(get_setE). ++ 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 : @@ -916,7 +920,7 @@ lemma eager_eq_except_mem_iff 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 get_some). qed. +proof. smt(domE). qed. lemma eager_eq_except_upd1_eq_in (xs : block list, i j k : int, y : bool, From 43f1dce818b46a5a2d780500f994be7c52347ad4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 21 Sep 2018 11:40:34 +0100 Subject: [PATCH 318/394] Finally fix CI on SHA3-Security? --- sha3/proof/SHA3-Security.ec | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) diff --git a/sha3/proof/SHA3-Security.ec b/sha3/proof/SHA3-Security.ec index ec8af81..f13740c 100644 --- a/sha3/proof/SHA3-Security.ec +++ b/sha3/proof/SHA3-Security.ec @@ -2,15 +2,8 @@ require import AllCore List IntDiv StdOrder Distr SmtMap FSet. -require (*--*) Common Sponge SLCommon Gconcl_list BlockSponge. - -(*---*) import Common Sponge BIRO. - -clone import IRO as BIRO with - type from <- bool list, - type to <- bool, - op valid <- predT, - op dto <- {0,1}. +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 @@ -158,7 +151,8 @@ declare module Dist : DISTINGUISHER{Perm, Gconcl_list.SimLast, IRO, Cntr, BlockSponge.BIRO.IRO, Simulator, BlockSponge.C, Gconcl.S, SLCommon.F.RO, SLCommon.F.RRO, SLCommon.Redo, SLCommon.C, - Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO}. + Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO, + Gconcl_list.Simulator}. axiom Dist_lossless (F <: DFUNCTIONALITY) (P <: DPRIMITIVE) : islossless P.f => islossless P.fi => islossless F.f => @@ -322,7 +316,8 @@ lemma SHA3Security Perm, IRO, BlockSponge.BIRO.IRO, Cntr, Simulator, Gconcl_list.SimLast(Gconcl.S), BlockSponge.C, Gconcl.S, SLCommon.F.RO, SLCommon.F.RRO, SLCommon.Redo, SLCommon.C, - Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO}) + Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO, + Gconcl_list.Simulator}) &m : (forall (F <: DFUNCTIONALITY) (P <: DPRIMITIVE), islossless P.f => From 377f6e3738bbb386fcd48c27b766e1fb4ce9872f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 20 Nov 2018 10:36:00 +0100 Subject: [PATCH 319/394] A secure RO is preimage, second preimage and collision resistant. --- sha3/proof/SecureRO.eca | 444 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 444 insertions(+) create mode 100644 sha3/proof/SecureRO.eca diff --git a/sha3/proof/SecureRO.eca b/sha3/proof/SecureRO.eca new file mode 100644 index 0000000..a3318d2 --- /dev/null +++ b/sha3/proof/SecureRO.eca @@ -0,0 +1,444 @@ +require import Int Distr Real SmtMap FSet Mu_mem. +require (****) PROM FelTactic. + + + +abstract theory RO_Security. + + 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.GenEager as RO with + type from <- from, + type to <- to, + op sampleto <- fun _ => sampleto + proof * by exact/sampleto_ll. + + module type RF = { + proc init() : unit + proc get(x : from) : to + }. + + module Bounder (F : RF) : RF = { + var counter : int + proc init () : unit = { + counter <- 0; + F.init(); + } + proc get(x : from) : to = { + var y : to <- witness; + if (counter < bound) { + counter <- counter + 1; + 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'; + Bounder(F).init(); + m <@ A(Bounder(F)).guess(hash); + hash' <@ F.get(m); + b <- hash = hash'; + 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); + hash' <@ F.get(m); + b <- hash = hash'; + return b; + } + }. + + lemma RO_is_preimage_resistant &m (h : to) : + Pr [ Preimage(A,LRO).main(h) @ &m : res ] <= (bound + 1)%r * mu1 sampleto h. + proof. + cut->: Pr [ Preimage (A,LRO).main(h) @ &m : res ] = + Pr [ Preimage2(A,LRO).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.counter <= bound /\ hash = h). + + inline*; auto; call(: card (fdom RO.m) <= Bounder.counter <= bound)=> //=. + - proc; inline*; auto; sp; if; 2:auto; wp. + conseq(:_==> card (fdom RO.m) + 1 <= Bounder.counter <= bound); 2: by auto;smt(). + move=> &h /> H1 _ H2 c 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.counter (fun _, mu1 sampleto h) bound (rng RO.m h) + [Bounder(LRO).get: (card (fdom RO.m) <= Bounder.counter < bound)] + (card (fdom RO.m) <= Bounder.counter <= bound) + =>//. + - rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. + rewrite IntExtra.Extrema.max_ler //=; 1:smt(bound_gt0). + rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_gt0). + by rewrite StdRing.RField.intmulr; smt(). + - inline*; auto=> />. + by rewrite mem_rng_empty /= fdom0 fcards0 /=; smt(bound_gt0). + - proc. + sp; if; auto; sp; inline*; sp; wp=> /=. + case: (x0 \in RO.m). + + by hoare; auto; smt(mu_bounded). + rnd (pred1 h); auto=> /> &h c ????????. + rewrite rngE/= => [][] a; rewrite get_setE. + case: (a=x{h}) => [->>|] //=. + by move:H1; rewrite rngE /= negb_exists/= => /(_ a) //=. + - move=> c; proc; inline*; sp; if. + + auto; progress. + + smt(). + + by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + + smt(). + + smt(). + + smt(). + smt(). + by auto. + move=> b c; proc; sp; if; auto; inline*; auto; progress. + - rewrite 2!rngE /= eq_iff; split=> [][] a. + + by rewrite get_setE; move: H4; rewrite domE /=; smt(). + move=> H7; 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. + case: (x \in RO.m). + - hoare; auto; progress. + + smt(mu_bounded). + rewrite H2/=; move: H1; rewrite rngE /= negb_exists /=. + by have:=H2; rewrite domE; smt(). + rnd (pred1 h); auto=> //= &hr [#]->>??<<-????. + by rewrite H2 /= 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 <@ F.get(m1); + hash2 <@ F.get(m2); + return hash1 = hash2 /\ m1 <> m2; + } + }. + + 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 hash1,hash2; + m2 <@ FEL(A,F).main(m1); + hash1 <@ F.get(m1); + hash2 <@ F.get(m2); + return hash1 = hash2 /\ m1 <> m2; + } + }. + + 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,LRO).main(mess1) @ &m : res ] + <= (bound + 1)%r * mu1 sampleto witness. + proof. + 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. + by call(RO_LRO_D (D1(A))); 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.counter <= bound + /\ mess1 \in RO.m /\ mess1 = m1). + + inline*; auto; call(: card (fdom RO.m) - 1 <= Bounder.counter <= bound + /\ mess1 \in RO.m). + - proc; inline*; auto; sp; if; auto=> /> &h Hc _ Hdom Hc2 sample. + by rewrite sampleto_full/=!fdom_set !fcardU !fcard1;smt(mem_set fcard_ge0). + auto=> /> &h 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.counter (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.counter < bound)] + (card (fdom RO.m) - 1 <= Bounder.counter <= bound /\ mess1 \in RO.m)=> {h} + =>//. + + rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. + rewrite IntExtra.Extrema.max_ler //=; 1:smt(bound_gt0). + rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_gt0). + by rewrite StdRing.RField.intmulr; smt(mu_bounded bound_gt0). + + inline*; auto=> />. + move=> &h 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; case: (x0 \in RO.m)=> //=. + - 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*. + rcondf 3; 1: auto. + case: (SecondPreimage2.m2 \in RO.m). + - rcondf 6; 1: auto; hoare; auto=> /> &h _ _ in_dom1 not_rng in_dom2. + + smt(mu_bounded). + 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 6; 1: auto; wp; rnd (pred1 hash1); auto. + move => /> &h _ _ 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 m1,m2,hash1,hash2; + Bounder(F).init(); + (m1,m2) <@ A(Bounder(F)).guess(); + hash1 <@ F.get(m1); + hash2 <@ F.get(m2); + return hash1 = hash2 /\ m1 <> m2; + } + }. + + 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 m1,m2,hash1,hash2; + (m1,m2) <@ FEL(A,F).main(); + hash1 <@ F.get(m1); + hash2 <@ F.get(m2); + return hash1 = hash2 /\ m1 <> m2; + } + }. + + 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.counter <= bound); first last; first last. + + auto. + + auto. + + inline*. + case: (m1 = m2); 1: (by hoare; auto; smt(bound_gt0 mu_bounded)). + case: (m1 \in RO.m); case: (m2 \in RO.m). + - rcondf 3; 1: auto; rcondf 6; 1: auto; hoare; auto; 1: smt(bound_gt0 mu_bounded). + move=> /> &h _ _ 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 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 _ _ 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 _ _ 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.counter <= bound); auto. + - proc; inline*; sp; if; auto. + move=> /> &h 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.counter (fun i, i%r * mu1 sampleto witness) bound + (collision RO.m) + [Bounder(RO).get: (card (fdom RO.m) <= Bounder.counter < bound)] + (card (fdom RO.m) <= Bounder.counter <= bound)=> //. + + rewrite -StdBigop.Bigreal.BRA.mulr_suml StdRing.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.counter{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 4; 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 counter _ h _. + rewrite (mu_mem (frng RO.m{h}) sampleto (mu1 sampleto witness)); 1: smt(sampleto_fu). + rewrite StdOrder.RealOrder.ler_wpmul2r //; 1: smt(mu_bounded). + by rewrite RealExtra.le_fromint; smt(le_card_frng_fdom). + + move=> c; proc; sp; if; auto; inline*; auto=> />. + move=> &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 _ sample _. + by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + qed. + + + end section Collision. + + +end RO_Security. From 3a771a6c0f21051bcf193f9e3fa4f3b9f25932ff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 20 Nov 2018 10:42:41 +0100 Subject: [PATCH 320/394] normalizing using RO, not LRO. --- sha3/proof/SecureRO.eca | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/sha3/proof/SecureRO.eca b/sha3/proof/SecureRO.eca index a3318d2..d02144a 100644 --- a/sha3/proof/SecureRO.eca +++ b/sha3/proof/SecureRO.eca @@ -87,10 +87,10 @@ abstract theory RO_Security. }. lemma RO_is_preimage_resistant &m (h : to) : - Pr [ Preimage(A,LRO).main(h) @ &m : res ] <= (bound + 1)%r * mu1 sampleto h. + Pr [ Preimage(A,RO).main(h) @ &m : res ] <= (bound + 1)%r * mu1 sampleto h. proof. - cut->: Pr [ Preimage (A,LRO).main(h) @ &m : res ] = - Pr [ Preimage2(A,LRO).main(h) @ &m : res ]. + cut->: 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) @@ -103,7 +103,7 @@ abstract theory RO_Security. by auto=> />; rewrite fdom0 fcards0; smt(bound_gt0). + call(: true ==> rng RO.m h)=> //; bypr=> /> {&m} &m. fel 1 Bounder.counter (fun _, mu1 sampleto h) bound (rng RO.m h) - [Bounder(LRO).get: (card (fdom RO.m) <= Bounder.counter < bound)] + [Bounder(RO).get: (card (fdom RO.m) <= Bounder.counter < bound)] (card (fdom RO.m) <= Bounder.counter <= bound) =>//. - rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. @@ -218,9 +218,12 @@ abstract theory RO_Security. lemma RO_is_second_preimage_resistant &m (mess1 : from) : - Pr [ SecondPreimage(A,LRO).main(mess1) @ &m : res ] + 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. From c278e1255398d000c3f8b7aed11f39f54d297dfd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 8 Apr 2019 14:28:00 +0100 Subject: [PATCH 321/394] make .dir-locals compatible with emacs >= 26 flet was deprecated in emacs 22 --- sha3/proof/.dir-locals.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/proof/.dir-locals.el b/sha3/proof/.dir-locals.el index 542d7f0..650cbbf 100644 --- a/sha3/proof/.dir-locals.el +++ b/sha3/proof/.dir-locals.el @@ -1,4 +1,4 @@ ((easycrypt-mode . ((eval . - (flet ((pre (s) (concat (locate-dominating-file buffer-file-name ".dir-locals.el") s))) + (cl-flet ((pre (s) (concat (locate-dominating-file buffer-file-name ".dir-locals.el") s))) (setq easycrypt-load-path `(,(pre ".") ,(pre "smart_counter")))))))) From e1da3ecdcfc98f6b452ac72a37d3f90fdd1541a9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Wed, 10 Apr 2019 18:48:24 +0200 Subject: [PATCH 322/394] proof of collision probability of SHA3 --- sha3/proof/IndifRO_is_secure.ec | 124 +++ .../proof/{SHA3-Security.ec => SHA3Indiff.ec} | 13 +- sha3/proof/SHA3Security.ec | 479 ++++++++++ sha3/proof/SecureRO.eca | 873 ++++++++++-------- 4 files changed, 1085 insertions(+), 404 deletions(-) create mode 100644 sha3/proof/IndifRO_is_secure.ec rename sha3/proof/{SHA3-Security.ec => SHA3Indiff.ec} (97%) create mode 100644 sha3/proof/SHA3Security.ec diff --git a/sha3/proof/IndifRO_is_secure.ec b/sha3/proof/IndifRO_is_secure.ec new file mode 100644 index 0000000..1abde7d --- /dev/null +++ b/sha3/proof/IndifRO_is_secure.ec @@ -0,0 +1,124 @@ +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 D (A : AdvCollision) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + proc distinguish = Collision(A,FInit(F)).main +}. + +section Proof. + + declare module A : AdvCollision{Bounder, SRO.RO.RO, SRO.RO.FRO}. + + axiom D_ll (F <: Oracle) : + 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,D(A)).main() @ &m : res] - + Pr[GIdeal(RO,S,D(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. + cut->: Pr[Collision(A, FM(C,P)).main() @ &m : res] = + Pr[GReal(C, P, D(A)).main() @ &m : res]. + + byequiv=>//=; proc; inline*; wp; sim. + by swap{1} [1..2] 2; sim. + cut/#:Pr[GIdeal(RO, S, D(A)).main() @ &m : res] <= + (limit * (limit - 1) + 2)%r / 2%r * mu1 sampleto witness. + cut->:Pr[GIdeal(RO, S, D(A)).main() @ &m : res] = + Pr[Collision(A, SRO.RO.RO).main() @ &m : res]. + + byequiv=>//=; proc; inline D(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 Proof. \ No newline at end of file diff --git a/sha3/proof/SHA3-Security.ec b/sha3/proof/SHA3Indiff.ec similarity index 97% rename from sha3/proof/SHA3-Security.ec rename to sha3/proof/SHA3Indiff.ec index f13740c..56fad44 100644 --- a/sha3/proof/SHA3-Security.ec +++ b/sha3/proof/SHA3Indiff.ec @@ -1,5 +1,3 @@ -(* Top-level Proof of SHA-3 Security *) - require import AllCore List IntDiv StdOrder Distr SmtMap FSet. require import Common Sponge. import BIRO. @@ -303,7 +301,13 @@ cut//=:=(Gconcl_list.Real_Ideal (LowerDist(Dist)) _ &m). cut hf:islossless RaiseFun(F).f. - proc;call hf';auto. exact(Dist_lossless (RaiseFun(F)) P hp hpi hf). -by rewrite(drestr_commute1 &m) (drestr_commute2 &m);smt(). +rewrite(drestr_commute1 &m) (drestr_commute2 &m). +cut->:=Gconcl_list.Simplify_simulator (LowerDist(Dist)) _ &m. ++ move=>F P hp hpi hf'//=. + cut hf:islossless RaiseFun(F).f. + - proc;call hf';auto. + exact(Dist_lossless (RaiseFun(F)) P hp hpi hf). +smt(). qed. @@ -311,7 +315,7 @@ qed. end section. -lemma SHA3Security +lemma SHA3Indiff (Dist <: DISTINGUISHER{ Perm, IRO, BlockSponge.BIRO.IRO, Cntr, Simulator, Gconcl_list.SimLast(Gconcl.S), BlockSponge.C, Gconcl.S, @@ -329,4 +333,3 @@ lemma SHA3Security (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/SHA3Security.ec b/sha3/proof/SHA3Security.ec new file mode 100644 index 0000000..6519085 --- /dev/null +++ b/sha3/proof/SHA3Security.ec @@ -0,0 +1,479 @@ +(* Top-level Proof of SHA-3 Security *) + +require import AllCore Distr DList DBool List IntExtra IntDiv Dexcepted DProd SmtMap FSet. +require import Common SLCommon Sponge SHA3Indiff. +require (****) IndifRO_is_secure. + + +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. + +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 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}. + + axiom A_ll (F <: SRO.Oracle) : 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 : + invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). + proof. + move=>hinvm nin_dom. + cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). + + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. + apply dexcepted_ll=>//=;rewrite-prod_ll. + cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. + rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. + cut/=->:=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. + cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + move:a. + cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. + cut->//=: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. + cut->:i_R = size_out by smt(). + cut<-:=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 /= oget_some; 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). search dout. + - 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). print Prog. + 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. + rnd; auto; progress. + - smt(size_ge0). + - smt(). + - by rewrite size_cat/=. + - by rewrite mem_set; left; rewrite H3. + - rewrite get_setE (H4 _ _ H12). + cut/#: !(l1, j) = (x0{2}, size bs0{2}). + move:H2; apply absurd=> //=[#] <<- ->>. + have[] h1 [] h2 h3 := H1. + by apply h2; smt(). + - move:H12; 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 {H13} 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 max_ler 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 SHA3_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 * mu1 dout witness. + proof. + rewrite (coll_resistant_if_indifferentiable A A_ll (CSetSize(Sponge)) Perm &m). + exists (SimSetSize(Simulator)); split. + + by move=> F _; proc; inline*; auto. + cut->:Pr[Indiff0.Indif(CSetSize(Sponge, Perm), Perm, D(A)).main() @ &m : res] = + Pr[RealIndif(Sponge, Perm, DRestr(DSetSize(D(A)))).main() @ &m : res]. + + byequiv=>//=; proc. + inline Perm.init CSetSize(Sponge, Perm).init Sponge(Perm).init + FC(Sponge(Perm)).init; sp. + inline D(A, CSetSize(Sponge, Perm), Perm).distinguish. + inline DRestr(DSetSize(D(A)), Sponge(Perm), Perm).distinguish + DSetSize(D(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=>//=. search (\). + 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. + cut->:Pr[Indiff0.Indif(RO, SimSetSize(Simulator, RO), D(A)).main() @ &m : res] = + Pr[IdealIndif(BIRO.IRO, Simulator, DRestr(DSetSize(D(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 D(A, RO, Simulator(FGetSize(RO))).distinguish. + inline DRestr(DSetSize(D(A)), BIRO.IRO, Simulator(BIRO.IRO)).distinguish + DSetSize(D(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). print SHA3Indiff. + have->//=:= SHA3Indiff (DSetSize(D(A))) &m _. + move=> F P P_f_ll P_fi_ll F_ll; proc; inline*; auto; sp. + seq 1 : true; auto. print A_ll. + + 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. \ No newline at end of file diff --git a/sha3/proof/SecureRO.eca b/sha3/proof/SecureRO.eca index d02144a..283a6b8 100644 --- a/sha3/proof/SecureRO.eca +++ b/sha3/proof/SecureRO.eca @@ -2,446 +2,521 @@ require import Int Distr Real SmtMap FSet Mu_mem. require (****) PROM FelTactic. +type from, to. -abstract theory RO_Security. +op sampleto : to distr. - type from, to. +op bound : int. +axiom bound_gt0 : 0 < bound. - op sampleto : to distr. +axiom sampleto_ll: is_lossless sampleto. +axiom sampleto_full: is_full sampleto. +axiom sampleto_fu: is_funiform sampleto. - op bound : int. - axiom bound_gt0 : 0 < bound. +clone import PROM.GenEager as RO with + type from <- from, + type to <- to, + op sampleto <- fun _ => sampleto +proof * by exact/sampleto_ll. - axiom sampleto_ll: is_lossless sampleto. - axiom sampleto_full: is_full sampleto. - axiom sampleto_fu: is_funiform sampleto. +op increase_counter (c : int) (m : from) : int. +axiom increase_counter_spec c m : c <= increase_counter c m. - clone import PROM.GenEager as RO with - type from <- from, - type to <- to, - op sampleto <- fun _ => sampleto - proof * by exact/sampleto_ll. +op bound_counter : int. +axiom bound_counter_ge0 : 0 <= bound_counter. - module type RF = { - proc init() : unit - proc get(x : from) : to - }. +module Counter = { + var c : int + proc init() = { + c <- 0; + } +}. - module Bounder (F : RF) : RF = { - var counter : int - proc init () : unit = { - counter <- 0; - F.init(); - } - proc get(x : from) : to = { - var y : to <- witness; - if (counter < bound) { - counter <- counter + 1; +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; } - }. + return y; + } +}. - module type Oracle = { - proc get(x : from) : to {} - }. - - module type AdvPreimage (F : Oracle) = { - proc guess(h : to) : from +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; + } }. - - module Preimage (A : AdvPreimage, F : RF) = { + + local module Preimage2 (A : AdvPreimage, F : RF) = { proc main (hash : to) : bool = { var b,m,hash'; - Bounder(F).init(); - m <@ A(Bounder(F)).guess(hash); - hash' <@ F.get(m); - b <- hash = 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; } }. - section Preimage. + lemma RO_is_preimage_resistant &m (h : to) : + Pr [ Preimage(A,RO).main(h) @ &m : res ] <= (bound + 1)%r * mu1 sampleto h. + proof. + cut->: 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 IntExtra.Extrema.max_ler //=; 1:smt(bound_gt0). + rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_gt0). + by rewrite StdRing.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 ????????. + rewrite rngE/= => hh [] a; rewrite get_setE. + case: (a=x{h}) => [->>|] //=. + by move:H1; 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. + + smt(mu_bounded). + rewrite H3/=; move: H1; rewrite rngE /= negb_exists /=. + by have:=H3; rewrite domE; smt(). + rnd (pred1 h); auto=> //= &hr [#]->>??<<-????. + by rewrite H3 /= get_setE /=; smt(). + smt(). + qed. - declare module A : AdvPreimage{RO,Preimage}. +end section 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; - } - }. +(*-------------------------------------------------------------------------*) +module type AdvSecondPreimage (F : Oracle) = { + proc guess(m : from) : from +}. - local module Preimage2 (A : AdvPreimage, F : RF) = { - proc main (hash : to) : bool = { - var b,m,hash'; - m <@ FEL(A,F).main(hash); - hash' <@ F.get(m); - b <- hash = hash'; - return b; +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; } - }. - - lemma RO_is_preimage_resistant &m (h : to) : - Pr [ Preimage(A,RO).main(h) @ &m : res ] <= (bound + 1)%r * mu1 sampleto h. - proof. - cut->: 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.counter <= bound /\ hash = h). - + inline*; auto; call(: card (fdom RO.m) <= Bounder.counter <= bound)=> //=. - - proc; inline*; auto; sp; if; 2:auto; wp. - conseq(:_==> card (fdom RO.m) + 1 <= Bounder.counter <= bound); 2: by auto;smt(). - move=> &h /> H1 _ H2 c 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.counter (fun _, mu1 sampleto h) bound (rng RO.m h) - [Bounder(RO).get: (card (fdom RO.m) <= Bounder.counter < bound)] - (card (fdom RO.m) <= Bounder.counter <= bound) - =>//. - - rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. - rewrite IntExtra.Extrema.max_ler //=; 1:smt(bound_gt0). - rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_gt0). - by rewrite StdRing.RField.intmulr; smt(). - - inline*; auto=> />. - by rewrite mem_rng_empty /= fdom0 fcards0 /=; smt(bound_gt0). - - proc. - sp; if; auto; sp; inline*; sp; wp=> /=. - case: (x0 \in RO.m). - + by hoare; auto; smt(mu_bounded). - rnd (pred1 h); auto=> /> &h c ????????. - rewrite rngE/= => [][] a; rewrite get_setE. - case: (a=x{h}) => [->>|] //=. - by move:H1; rewrite rngE /= negb_exists/= => /(_ a) //=. - - move=> c; proc; inline*; sp; if. - + auto; progress. - + smt(). - + by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). - + smt(). - + smt(). - + smt(). - smt(). - by auto. - move=> b c; proc; sp; if; auto; inline*; auto; progress. - - rewrite 2!rngE /= eq_iff; split=> [][] a. - + by rewrite get_setE; move: H4; rewrite domE /=; smt(). - move=> H7; exists a; rewrite get_setE; move: H4; rewrite domE /=; smt(). + 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. + by call(RO_LRO_D (D1(A))); 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=> /> &h 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 IntExtra.Extrema.max_ler //=; 1:smt(bound_gt0). + rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_gt0). + by rewrite StdRing.RField.intmulr; smt(mu_bounded bound_gt0). + + inline*; auto=> />. + move=> &h 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(). - + by inline*; auto. - + by inline*; auto. - + inline*; sp; wp. - case: (x \in RO.m). - - hoare; auto; progress. - + smt(mu_bounded). - rewrite H2/=; move: H1; rewrite rngE /= negb_exists /=. - by have:=H2; rewrite domE; smt(). - rnd (pred1 h); auto=> //= &hr [#]->>??<<-????. - by rewrite H2 /= get_setE /=; smt(). - smt(). - qed. + - 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. + + smt(mu_bounded). + 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 Preimage. +end section SecondPreimage. - (*-------------------------------------------------------------------------*) - 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); + +(*--------------------------------------------------------------------------*) +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); - hash2 <@ F.get(m2); - return hash1 = hash2 /\ m1 <> m2; - } - }. - - 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 hash1,hash2; - m2 <@ FEL(A,F).main(m1); - hash1 <@ F.get(m1); + if (increase_counter Counter.c m2 < bound_counter) { + Counter.c <- increase_counter Counter.c m2; hash2 <@ F.get(m2); - return hash1 = hash2 /\ m1 <> m2; - } - }. - - 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. - by call(RO_LRO_D (D1(A))); 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.counter <= bound - /\ mess1 \in RO.m /\ mess1 = m1). - + inline*; auto; call(: card (fdom RO.m) - 1 <= Bounder.counter <= bound - /\ mess1 \in RO.m). - - proc; inline*; auto; sp; if; auto=> /> &h Hc _ Hdom Hc2 sample. - by rewrite sampleto_full/=!fdom_set !fcardU !fcard1;smt(mem_set fcard_ge0). - auto=> /> &h 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.counter (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.counter < bound)] - (card (fdom RO.m) - 1 <= Bounder.counter <= bound /\ mess1 \in RO.m)=> {h} - =>//. - + rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. - rewrite IntExtra.Extrema.max_ler //=; 1:smt(bound_gt0). - rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_gt0). - by rewrite StdRing.RField.intmulr; smt(mu_bounded bound_gt0). - + inline*; auto=> />. - move=> &h 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; case: (x0 \in RO.m)=> //=. - - 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*. - rcondf 3; 1: auto. - case: (SecondPreimage2.m2 \in RO.m). - - rcondf 6; 1: auto; hoare; auto=> /> &h _ _ in_dom1 not_rng in_dom2. - + smt(mu_bounded). - 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 6; 1: auto; wp; rnd (pred1 hash1); auto. - move => /> &h _ _ 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 m1,m2,hash1,hash2; + 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(); - hash1 <@ F.get(m1); - hash2 <@ F.get(m2); - return hash1 = hash2 /\ m1 <> m2; + return (m1,m2); } }. - - 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 m1,m2,hash1,hash2; - (m1,m2) <@ FEL(A,F).main(); + 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); - hash2 <@ F.get(m2); - return hash1 = hash2 /\ m1 <> m2; + 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.counter <= bound); first last; first last. - + auto. - + auto. - + inline*. - case: (m1 = m2); 1: (by hoare; auto; smt(bound_gt0 mu_bounded)). - case: (m1 \in RO.m); case: (m2 \in RO.m). - - rcondf 3; 1: auto; rcondf 6; 1: auto; hoare; auto; 1: smt(bound_gt0 mu_bounded). - move=> /> &h _ _ 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 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 _ _ 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 _ _ Hcoll neq12 in_dom1 in_dom2 sample1 _; split. + 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; 1: smt(mu_bounded); auto. + case: (m1 \in RO.m); case: (m2 \in RO.m). + - rcondf 3; 1: auto; rcondf 6; 1: auto; hoare; auto; 1: smt(bound_gt0 mu_bounded). + 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). - move=> _ sample2 _. - by rewrite get_set_sameE get_set_sameE; smt(). - + by move=> />; smt(mu_bounded). - + inline*; wp; call(: card (fdom RO.m) <= Bounder.counter <= bound); auto. - - proc; inline*; sp; if; auto. - move=> /> &h 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.counter (fun i, i%r * mu1 sampleto witness) bound - (collision RO.m) - [Bounder(RO).get: (card (fdom RO.m) <= Bounder.counter < bound)] - (card (fdom RO.m) <= Bounder.counter <= bound)=> //. - + rewrite -StdBigop.Bigreal.BRA.mulr_suml StdRing.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.counter{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 4; 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 counter _ h _. - rewrite (mu_mem (frng RO.m{h}) sampleto (mu1 sampleto witness)); 1: smt(sampleto_fu). - rewrite StdOrder.RealOrder.ler_wpmul2r //; 1: smt(mu_bounded). - by rewrite RealExtra.le_fromint; smt(le_card_frng_fdom). - + move=> c; proc; sp; if; auto; inline*; auto=> />. - move=> &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 _ sample _. + 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 StdRing.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 bounder _ h _. + rewrite (mu_mem (frng RO.m{h}) sampleto (mu1 sampleto witness)); 1: smt(sampleto_fu). + rewrite StdOrder.RealOrder.ler_wpmul2r //; 1: smt(mu_bounded). + by rewrite RealExtra.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). - qed. + move=> b c; proc; inline*; sp; if; auto; sp; if; auto; 2: smt(). + move=> /> &h h1 h2 _ _ _ sample _. + by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + qed. - - end section Collision. - - -end RO_Security. + +end section Collision. From b32d44b22e526b7e770a0236c934a2727923c41c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 11 Apr 2019 12:44:18 +0200 Subject: [PATCH 323/394] SHA3Security.ec : Sponge is : - preimage resitant - second preimage resistant - collision resistant --- sha3/proof/IndifRO_is_secure.ec | 111 ++++- sha3/proof/SHA3Security.ec | 795 ++++++++++++++++++++++++++++++-- 2 files changed, 867 insertions(+), 39 deletions(-) diff --git a/sha3/proof/IndifRO_is_secure.ec b/sha3/proof/IndifRO_is_secure.ec index 1abde7d..dc90d5e 100644 --- a/sha3/proof/IndifRO_is_secure.ec +++ b/sha3/proof/IndifRO_is_secure.ec @@ -84,11 +84,12 @@ module FM (C : CONSTRUCTION) (P : PRIMITIVE) = { proc rem (a : f_in) = {} }. -module D (A : AdvCollision) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + +module DColl (A : AdvCollision) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { proc distinguish = Collision(A,FInit(F)).main }. -section Proof. +section Collision. declare module A : AdvCollision{Bounder, SRO.RO.RO, SRO.RO.FRO}. @@ -100,25 +101,117 @@ section Proof. (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,D(A)).main() @ &m : res] - - Pr[GIdeal(RO,S,D(A)).main() @ &m : res]| <= bound) => + `|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. cut->: Pr[Collision(A, FM(C,P)).main() @ &m : res] = - Pr[GReal(C, P, D(A)).main() @ &m : res]. + Pr[GReal(C, P, DColl(A)).main() @ &m : res]. + byequiv=>//=; proc; inline*; wp; sim. by swap{1} [1..2] 2; sim. - cut/#:Pr[GIdeal(RO, S, D(A)).main() @ &m : res] <= + cut/#:Pr[GIdeal(RO, S, DColl(A)).main() @ &m : res] <= (limit * (limit - 1) + 2)%r / 2%r * mu1 sampleto witness. - cut->:Pr[GIdeal(RO, S, D(A)).main() @ &m : res] = + cut->:Pr[GIdeal(RO, S, DColl(A)).main() @ &m : res] = Pr[Collision(A, SRO.RO.RO).main() @ &m : res]. - + byequiv=>//=; proc; inline D(A, RO, S(RO)).distinguish; wp; sim. + + 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 Proof. \ No newline at end of file +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}. + + axiom D_ll (F <: Oracle) : + 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. + cut->: 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(). + cut/#:Pr[GIdeal(RO, S, DPre(A)).main() @ &m : res] <= + (limit + 1)%r * mu1 sampleto hash. + cut->: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}. + + axiom D_ll (F <: Oracle) : + 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. + cut->: 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(). + cut/#:Pr[GIdeal(RO, S, D2Pre(A)).main() @ &m : res] <= + (limit + 1)%r * mu1 sampleto witness. + cut->: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/SHA3Security.ec b/sha3/proof/SHA3Security.ec index 6519085..faa8aa7 100644 --- a/sha3/proof/SHA3Security.ec +++ b/sha3/proof/SHA3Security.ec @@ -91,6 +91,754 @@ 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}. + + axiom A_ll (F <: SRO.Oracle) : 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 : + invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). + proof. + move=>hinvm nin_dom. + cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). + + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. + apply dexcepted_ll=>//=;rewrite-prod_ll. + cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. + rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. + cut/=->:=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. + cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + move:a. + cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. + cut->//=: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. + cut->:i_R = size_out by smt(). + cut<-:=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 /= oget_some; 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. + rnd; auto; progress. + - smt(size_ge0). + - smt(). + - by rewrite size_cat/=. + - by rewrite mem_set; left; rewrite H3. + - rewrite get_setE (H4 _ _ H12). + cut/#: !(l1, j) = (x0{2}, size bs0{2}). + move:H2; apply absurd=> //=[#] <<- ->>. + have[] h1 [] h2 h3 := H1. + by apply h2; smt(). + - move:H12; 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 {H13} 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 max_ler 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 SHA3_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 * mu1 dout ha. + proof. + move=>init_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. + cut->//: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. + cut->//: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}. + + axiom A_ll (F <: SRO.Oracle) : 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 : + invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). + proof. + move=>hinvm nin_dom. + cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). + + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. + apply dexcepted_ll=>//=;rewrite-prod_ll. + cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. + rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. + cut/=->:=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. + cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + move:a. + cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. + cut->//=: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. + cut->:i_R = size_out by smt(). + cut<-:=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 /= oget_some; 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. + rnd; auto; progress. + - smt(size_ge0). + - smt(). + - by rewrite size_cat/=. + - by rewrite mem_set; left; rewrite H3. + - rewrite get_setE (H4 _ _ H12). + cut/#: !(l1, j) = (x0{2}, size bs0{2}). + move:H2; apply absurd=> //=[#] <<- ->>. + have[] h1 [] h2 h3 := H1. + by apply h2; smt(). + - move:H12; 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 {H13} 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 max_ler 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 SHA3_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 * mu1 dout witness. + proof. + move=> init_mess. + 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. + cut->: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. + cut->: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, @@ -162,18 +910,7 @@ section Collision. 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 + clone import Program as Prog3 with type t <- bool, op d <- dbool proof *. @@ -262,7 +999,7 @@ section Collision. + 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). search dout. + - 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). @@ -283,7 +1020,7 @@ section Collision. + 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). print Prog. + smt(spec2_dout). transitivity{1} { l <@ LoopSnoc.sample(size_out); } @@ -371,14 +1108,14 @@ section Collision. rewrite (coll_resistant_if_indifferentiable A A_ll (CSetSize(Sponge)) Perm &m). exists (SimSetSize(Simulator)); split. + by move=> F _; proc; inline*; auto. - cut->:Pr[Indiff0.Indif(CSetSize(Sponge, Perm), Perm, D(A)).main() @ &m : res] = - Pr[RealIndif(Sponge, Perm, DRestr(DSetSize(D(A)))).main() @ &m : res]. + cut->: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 D(A, CSetSize(Sponge, Perm), Perm).distinguish. - inline DRestr(DSetSize(D(A)), Sponge(Perm), Perm).distinguish - DSetSize(D(A), FC(Sponge(Perm)), PC(Perm)).distinguish Cntr.init; wp; sp; sim. + 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. @@ -393,7 +1130,7 @@ section Collision. + auto; sp; if; auto. - sp; if ;auto; progress. * exact (useful _ _ _ H H2). - * rewrite invm_set=>//=. search (\). + * rewrite invm_set=>//=. by move:H4; rewrite supp_dexcepted. * smt(). smt(). @@ -422,14 +1159,14 @@ section Collision. by call(equiv_sponge_perm c1 m); auto; smt(). inline*; auto; progress. by rewrite /invm=> x y; rewrite 2!emptyE. - cut->:Pr[Indiff0.Indif(RO, SimSetSize(Simulator, RO), D(A)).main() @ &m : res] = - Pr[IdealIndif(BIRO.IRO, Simulator, DRestr(DSetSize(D(A)))).main() @ &m : res]. + cut->: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 D(A, RO, Simulator(FGetSize(RO))).distinguish. - inline DRestr(DSetSize(D(A)), BIRO.IRO, Simulator(BIRO.IRO)).distinguish - DSetSize(D(A), FC(BIRO.IRO), PC(Simulator(BIRO.IRO))).distinguish; wp; sim. + 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. @@ -462,10 +1199,10 @@ section Collision. + 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). print SHA3Indiff. - have->//=:= SHA3Indiff (DSetSize(D(A))) &m _. + 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. print A_ll. + 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. @@ -474,6 +1211,4 @@ section Collision. sp; if; auto; sp; call F_ll; auto. qed. - - end section Collision. \ No newline at end of file From 8c23891ab0de35d914d500a25dfbc2cc5230ec80 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 10 Apr 2019 15:40:13 +0100 Subject: [PATCH 324/394] Common.ec --- sha3/proof/Common.ec | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 65f6c06..e02a614 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -74,7 +74,7 @@ have // : 2 < 2 by rewrite (@ler_lt_trans m). qed. lemma chunk_nil' ['a] r : BitChunking.chunk r [<:'a>] = []. -proof. by rewrite /chunk /= div0z mkseq0. qed. +proof. by rewrite /chunk /= mkseq0. qed. lemma chunk_sing' r (xs : bool list) : 0 < r => size xs = r => BitChunking.chunk r xs = [xs]. @@ -274,7 +274,7 @@ 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 mod0z. qed. +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. @@ -328,12 +328,12 @@ 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. +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 //= -iE. +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 //= max_ler ?subr_ge0 ?ltrW // /j #ring. + by rewrite sz_js /= addrC size_nseq max_ler. @@ -376,7 +376,7 @@ 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'. qed. +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. From 48e4a10f40bb9da91b9206b329748c4a0bdd5937 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 10 Apr 2019 18:31:41 +0100 Subject: [PATCH 325/394] SLCommon and Handle --- sha3/proof/smart_counter/Handle.eca | 19 +++++++++---------- sha3/proof/smart_counter/SLCommon.ec | 2 +- 2 files changed, 10 insertions(+), 11 deletions(-) diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index ccd780f..0989005 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -497,7 +497,7 @@ split=> [xa0 xc0 ya0 yc0|xa0 hx0 ya0 hy0]; rewrite get_setE. by exists hx0 fx0 hy0 fy0; rewrite !get_setE /#. case: ((xa0,hx0) = (xa,hx))=> [[#] <*>> [#] <<*>|] /=. + by exists xc f yc f'; rewrite !get_setE /= /#. -rewrite andaE=> /negb_and xahx0_neq_xahx /Hmh_m [xc0 fx0 yc0 fy0] [#] hs_hx0 hs_hy0 Pm_xaxc0. +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). @@ -517,7 +517,7 @@ move=> [] Hm_mh Hmh_m yc_notin_rng1_hs hs_hx hs_hy; split. 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 //= /#. -rewrite /= andaE=> /negb_and yahy0_neq_yahy /Hmh_m [yc0 fy0 xc0 fx0] [#] hs_hy0 hs_hx0 mi_yayc0. +move=> /= /negb_and 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. @@ -1177,7 +1177,7 @@ split. 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 andaE -negP=> [#] <<*>. + rewrite -negP=> [#] <<*>. move: h; have /invG_of_INV [] <- := HINV. by rewrite Gm_xaxc. + by case: HINV. @@ -1265,7 +1265,7 @@ proof. 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) => [[!<<-] /= ?? [!->>] /=| ]. + case (v' +^ x = xa /\ h' = ha) => [[!<<-] /= ?? [!->>] /=| ]. + by exists p v';rewrite xorwA xorwK xorwC xorw0. case (hx = ch)=> [->> _ _ _ /Hch //|??? Hbu Hg]. by rewrite build_hpath_prefix;exists v' h'. @@ -2040,7 +2040,8 @@ proof. cut[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). rewrite!take_take !min_lel 1,2:/# nth_take 1,2:/# H2/=H_Gmh oget_some=>[][]<<-<<-<-. rewrite H_PFm oget_some/=. - by cut[]help1 help2/# :=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut [] help1 help2:= m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + + by have [] xc fx yc fy [#] /# := help2 _ _ _ _ H_Gmh. - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. @@ -2405,7 +2406,7 @@ proof. rewrite eq_xor h_g1/=;move:h_neq;apply absurd=>//=. cut:=hh3 _ _ _ _ _ H_path h_build_hpath_p0. cut->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). - move=>help;cut h_neq:! (v +^ bn = sa{2} +^ nth witness bs{1} i{2} && hx = h{2}) by rewrite/#. + move=>help;cut 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. cut[]hh1 hh2 hh3:=H_mh_spec. cut:=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. @@ -2573,7 +2574,7 @@ section AUX. smt (size_ge0). (* lossless and do not reset bad G1.C.f *) + move=> _; proc; inline *; wp;sp;if;auto;sp;if;auto;sp. - conseq(:_==> (G1.bcol \/ G1.bext));1:smt(@DBlock @DCapacity mem_set). + conseq(:_==> (G1.bcol \/ G1.bext));1:smt(@DBlock @DCapacity mem_set). while (G1.bcol \/ G1.bext) (size p - i)=> [z|]. + if; 1:by auto=> /#. if;2:auto=>/#;wp; rnd predT; wp; rnd predT; auto. @@ -2631,6 +2632,4 @@ section. rewrite Pr[mu_or];smt(Distr.mu_bounded). qed. -end section. - - +end section. \ No newline at end of file diff --git a/sha3/proof/smart_counter/SLCommon.ec b/sha3/proof/smart_counter/SLCommon.ec index 4fda277..d392b04 100644 --- a/sha3/proof/smart_counter/SLCommon.ec +++ b/sha3/proof/smart_counter/SLCommon.ec @@ -148,7 +148,7 @@ 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 rewrite andaE; split=> [!~#] <*>; [exact/Empty|move=> []]; smt(size_rcons size_ge0). ++ 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']. From 4f68d3dff14824f44b3c6faebdc519496538dc4e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 10 Apr 2019 22:10:49 +0100 Subject: [PATCH 326/394] Sync with deploy-kms head --- sha3/proof/SHA3Security.ec | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/sha3/proof/SHA3Security.ec b/sha3/proof/SHA3Security.ec index faa8aa7..1ad3776 100644 --- a/sha3/proof/SHA3Security.ec +++ b/sha3/proof/SHA3Security.ec @@ -164,12 +164,12 @@ section Preimage. 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, 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, 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)). @@ -230,7 +230,7 @@ section Preimage. + 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. + + rewrite mem_set //=; have [] //= h:= H5 _ _ H11; left. have []h1 []->//=:= H2. by exists i0=>//=. + move:H7; rewrite take_oversize 1:spec_dout//= => H7. @@ -1211,4 +1211,4 @@ section Collision. sp; if; auto; sp; call F_ll; auto. qed. -end section Collision. \ No newline at end of file +end section Collision. From c6f2bdfbf5782cfb7b11c3e1c49d95e150d65245 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 11 Apr 2019 15:53:06 +0200 Subject: [PATCH 327/394] replace the "mu _ _" by its value --- sha3/proof/SHA3Security.ec | 31 ++++++++++++++++++++++++++++--- 1 file changed, 28 insertions(+), 3 deletions(-) diff --git a/sha3/proof/SHA3Security.ec b/sha3/proof/SHA3Security.ec index 1ad3776..160fc57 100644 --- a/sha3/proof/SHA3Security.ec +++ b/sha3/proof/SHA3Security.ec @@ -28,6 +28,28 @@ 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. +cut->: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 _ _ _. + cut->: p = StdBigop.Bigreal.BRM.big predT (fun _ => inv 2%r) (to_list x). + - rewrite /p =>{p}. print StdBigop.Bigreal.BRM. + apply StdBigop.Bigreal.BRM.eq_bigr. + by move=> i; rewrite//= dbool1E. + rewrite StdBigop.Bigreal.BRM.big_const count_predT spec_dout=> {p}. search 0 Int.(+) 1 (<=). + have:=size_out_gt0; move/ltzW. + move:size_out;apply intind=> //=. + - by rewrite powr0 iter0 //= fromint1. + move=> i hi0 rec. + by rewrite powrS//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) = { @@ -367,9 +389,10 @@ section Preimage. 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 * mu1 dout ha. + (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. @@ -713,9 +736,10 @@ section SecondPreimage. 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 * mu1 dout witness. + (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. @@ -1103,8 +1127,9 @@ section Collision. 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 * mu1 dout witness. + (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. From dc38700f58d9e190e6bef9f79390fe29efb700c3 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 25 Apr 2019 17:15:22 -0400 Subject: [PATCH 328/394] Improvement of documentation. Removal of redundant tactic application. --- sha3/proof/Sponge.ec | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index c72b857..7d5f35d 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -131,11 +131,15 @@ module RaiseSim (S : BlockSponge.SIMULATOR, F : DFUNCTIONALITY) = 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, f is defined in terms of g. In the lazy - version, g 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 were + bool. In both versions, f is defined in terms of g, and, as in + BlockSponge.BIRO.IRO, g returns [] if x isn't a valid block. In + both versions, the input/output behavior of f is identical to that + of BlockSponge.BIRO.IRO.f. + + In the lazy version, g 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 were consulted/randomly updated (those extra bits are discarded) We have a parameterized module RaiseHybridIRO for turning a Hybrid @@ -268,7 +272,7 @@ module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { proc g(xs, n) = { var b, bs; - var m <- ((n + r - 1) %/ r) * r; + var m <- ((n + r - 1) %/ r) * r; (* eager part *) var i <- 0; bs <- []; @@ -2063,7 +2067,6 @@ proc (HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} proc (HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1})=> //; conseq HIRO.HybridIROEager_BlockIRO_f=> //. -exists* n{1}; elim *=> n'. conseq RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f=> //. auto. qed. From 50f53d5e65fbb4a136240fdb6f4ccadbe028a7cc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 2 May 2019 11:32:30 +0100 Subject: [PATCH 329/394] Split CI tasks to make failure reports more granular, tasks more timely --- sha3/config/tests.config | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/sha3/config/tests.config b/sha3/config/tests.config index 1c6b73e..fc72c0d 100644 --- a/sha3/config/tests.config +++ b/sha3/config/tests.config @@ -4,3 +4,12 @@ args = -I proof -I proof/smart_counter -timeout 10 [test-sha3] okdirs = !proof + +[test-sponge] +okdirs = proof proof/smart_counter + +[test-jsponge] +okdirs = proof/impl + +[test-jperm] +okdirs = proof/impl/perm From 743929afb78615b3f7839c128a6ccc8eb1ebb8ca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 2 May 2019 16:09:59 +0100 Subject: [PATCH 330/394] Fix Sponge proof pHL conseq has changed --- sha3/proof/smart_counter/Handle.eca | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index 0989005..281958b 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -2420,7 +2420,7 @@ proof. cut->/=:=ch_neq0 _ _ H_hs_spec. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. - by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). + by cut[]:=H_mh_spec; smt(dom_hs_neq_ch). cut:=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. cut:=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:H13 H14;rewrite!get_setE/=!oget_some/==>H13 H14;rewrite H13 H14/=. @@ -2574,12 +2574,18 @@ section AUX. smt (size_ge0). (* lossless and do not reset bad G1.C.f *) + move=> _; proc; inline *; wp;sp;if;auto;sp;if;auto;sp. - conseq(:_==> (G1.bcol \/ G1.bext));1:smt(@DBlock @DCapacity mem_set). - while (G1.bcol \/ G1.bext) (size p - i)=> [z|]. + 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:auto=>/#;wp; rnd predT; wp; rnd predT; auto. - smt (@Block.DBlock @Capacity.DCapacity). - by auto; smt (@Block.DBlock @Capacity.DCapacity). + if; 2:by auto=> /#. + by wp; rnd predT; wp; rnd predT; auto=> />; smt(@DBlock @DCapacity). + by auto=> /#. (* Init ok *) inline *; auto=> />; split=> [|/#]. do !split. @@ -2632,4 +2638,4 @@ section. rewrite Pr[mu_or];smt(Distr.mu_bounded). qed. -end section. \ No newline at end of file +end section. From 54364b38ae0af5899ae75c6cb0df7ad6caea5456 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Sat, 18 May 2019 19:13:17 +0100 Subject: [PATCH 331/394] Standard Sponge is our Sponge --- sha3/proof/Sponge.ec | 72 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 72 insertions(+) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 7d5f35d..aa88203 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -31,6 +31,34 @@ clone import IRO as BIRO with (*------------------------- 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 = {} @@ -58,6 +86,50 @@ module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { } }. +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 = { From bcb49509b7cbb10aedf249453089932a0a3b022b Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Mon, 5 Aug 2019 09:22:13 +0200 Subject: [PATCH 332/394] max-provers --- sha3/config/tests.config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/config/tests.config b/sha3/config/tests.config index fc72c0d..e52640a 100644 --- a/sha3/config/tests.config +++ b/sha3/config/tests.config @@ -1,6 +1,6 @@ [default] bin = easycrypt -args = -I proof -I proof/smart_counter -timeout 10 +args = -I proof -I proof/smart_counter -timeout 10 -max-provers 4 [test-sha3] okdirs = !proof From e062b6aafc1e05c1aa444abfac748494fbbd92c1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 5 Aug 2019 14:57:18 +0100 Subject: [PATCH 333/394] Make the CI run over libc --- sha3/config/tests.config | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/sha3/config/tests.config b/sha3/config/tests.config index e52640a..d2d1d5f 100644 --- a/sha3/config/tests.config +++ b/sha3/config/tests.config @@ -13,3 +13,7 @@ okdirs = proof/impl [test-jperm] okdirs = proof/impl/perm + +[test-libc] +args = -I proof/impl -I proof/impl/perm -timeout 10 +okdirs = proof/impl/libc From b8cae30cd1e4392b21678a8f604995ae18a841ec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 6 Aug 2019 11:56:18 +0100 Subject: [PATCH 334/394] CI: reduce parallelism; simplify test suite config --- sha3/config/tests.config | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/sha3/config/tests.config b/sha3/config/tests.config index d2d1d5f..dc6bc6b 100644 --- a/sha3/config/tests.config +++ b/sha3/config/tests.config @@ -1,6 +1,6 @@ [default] bin = easycrypt -args = -I proof -I proof/smart_counter -timeout 10 -max-provers 4 +args = -timeout 10 -max-provers 3 -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm [test-sha3] okdirs = !proof @@ -15,5 +15,4 @@ okdirs = proof/impl okdirs = proof/impl/perm [test-libc] -args = -I proof/impl -I proof/impl/perm -timeout 10 okdirs = proof/impl/libc From 47efeec39fb609860aa0d39a1ce69c1fd011bb5e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 6 Aug 2019 18:34:39 +0000 Subject: [PATCH 335/394] Reduce parallelism further --- sha3/config/tests.config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/config/tests.config b/sha3/config/tests.config index dc6bc6b..e031c32 100644 --- a/sha3/config/tests.config +++ b/sha3/config/tests.config @@ -1,6 +1,6 @@ [default] bin = easycrypt -args = -timeout 10 -max-provers 3 -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm +args = -timeout 10 -max-provers 2 -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm [test-sha3] okdirs = !proof From f6fd6a3ff2db23ac54ffc90e9e41b1096d3331bb Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Tue, 6 Aug 2019 21:27:41 +0200 Subject: [PATCH 336/394] --- sha3/config/tests.config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/config/tests.config b/sha3/config/tests.config index e031c32..6382a1d 100644 --- a/sha3/config/tests.config +++ b/sha3/config/tests.config @@ -1,6 +1,6 @@ [default] bin = easycrypt -args = -timeout 10 -max-provers 2 -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm +args = -timeout 30 -max-provers 2 -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm [test-sha3] okdirs = !proof From 45755c39f8bb71af437dc3a96007c81987e04aaf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Fri, 17 May 2019 17:02:07 +0200 Subject: [PATCH 337/394] add padding of 01, but it's exactly the definition of resistance of SHA3 --- sha3/proof/SHA3Security.ec | 52 +++++++++++++++++++++++++++++++++++--- 1 file changed, 49 insertions(+), 3 deletions(-) diff --git a/sha3/proof/SHA3Security.ec b/sha3/proof/SHA3Security.ec index 160fc57..26e2598 100644 --- a/sha3/proof/SHA3Security.ec +++ b/sha3/proof/SHA3Security.ec @@ -4,6 +4,14 @@ require import AllCore Distr DList DBool List IntExtra IntDiv Dexcepted DProd Sm require import Common SLCommon Sponge SHA3Indiff. 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. @@ -384,7 +392,7 @@ section Preimage. smt(). qed. - lemma SHA3_preimage_resistant &m ha : + 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 + @@ -731,7 +739,7 @@ section SecondPreimage. smt(). qed. - lemma SHA3_second_preimage_resistant &m mess : + 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 + @@ -1123,7 +1131,7 @@ section Collision. smt(). qed. - lemma SHA3_coll_resistant &m : + 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 + @@ -1237,3 +1245,41 @@ section Collision. 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}. + + axiom A_ll (F <: SRO.Oracle) : 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 Collision. From 6ae19531b6b690cd2c414959991eacea6173f330 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Fri, 17 May 2019 17:02:54 +0200 Subject: [PATCH 338/394] Structure of the properties (preimage, second preimage & collision) for a random oracle (SecureIRO), not a random function(SecureRO). --- sha3/proof/SecureIRO.eca | 147 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 147 insertions(+) create mode 100644 sha3/proof/SecureIRO.eca diff --git a/sha3/proof/SecureIRO.eca b/sha3/proof/SecureIRO.eca new file mode 100644 index 0000000..8a03fb3 --- /dev/null +++ b/sha3/proof/SecureIRO.eca @@ -0,0 +1,147 @@ +require import Core Int Real Distr List. + +require (****) IRO. + + +(* Define the random function *) +type from. +type to. + +op dto : to distr. + +clone import IRO as URO with + type from <- from, + type to <- to, + op dto <- dto + proof *. + +(* Define module types for the preimage, second preimage and collision games *) + +module type OIRO = { + proc f (x : from, n : int) : to list +}. +module type Adversary (F : OIRO) = { + proc guess_preimage (h : to list) : from + proc guess_second_preimage (m1 : from, s : int) : from + proc guess_collision (s : int) : from * from +}. + +(* Define the bound on the counter cost and the operator updating the cost *) +module Cost = { + var counter : int +}. + +op update_cost : int -> from -> int. +axiom update_cost c m : c <= update_cost c m. + +op t : int. +axiom t_gt0 : 0 < t. + +module Count (F : OIRO) = { + proc init() = { + Cost.counter <- 0; + } + proc f (m : from, n : int) = { + var r : to list; + r <- []; + if (update_cost Cost.counter m < t) { + r <- F.f(m,n); + Cost.counter <- update_cost Cost.counter m; + } + return r; + } +}. + + +(************************** Preimage Game *************************************) +module PreImage (A : Adversary, F : IRO) = { + proc game (h : to list) : bool = { + var m, h2, b; + b <- false; + Cost.counter <- 0; + F.init(); + m <@ A(Count(F)).guess_preimage(h); + if (update_cost Cost.counter m < t) { + h2 <- F.f(m, size h); + b <- h = h2; + Cost.counter <- update_cost Cost.counter m; + } + return b; + } +}. + +(************************** Second Preimage Game ******************************) +module SecondPreImage (A : Adversary, F : IRO) = { + proc game (m : from, s : int) : bool = { + var m2, h1, h2, b; + b <- false; + Cost.counter <- 0; + F.init(); + m2 <@ A(Count(F)).guess_second_preimage(m,s); + if (update_cost Cost.counter m < t) { + h1 <- F.f(m,s); + Cost.counter <- update_cost Cost.counter m; + if (update_cost Cost.counter m2 < t) { + h2 <- F.f(m2,s); + b <- h1 = h2; + Cost.counter <- update_cost Cost.counter m2; + } + } + return b; + } +}. + +(************************** Collision Game ************************************) +module Collision (A : Adversary, F : IRO) = { + proc game (s : int) : bool = { + var m1, m2, h1, h2, b; + b <- false; + Cost.counter <- 0; + F.init(); + (m1,m2) <@ A(Count(F)).guess_collision(s); + if (update_cost Cost.counter m1 < t) { + h1 <- F.f(m1,s); + Cost.counter <- update_cost Cost.counter m1; + if (update_cost Cost.counter m2 < t) { + h2 <- F.f(m2,s); + b <- h1 = h2; + Cost.counter <- update_cost Cost.counter m2; + } + } + return b; + } +}. + + +(*********************************** Proofs ***********************************) +section Proof. + + declare module A : Adversary{IRO, Cost}. + + + lemma PreImage_Resistance &m (h : to list) : + Pr [ PreImage(A, IRO).game(h) @ &m : res ] <= mu1 dto witness<:to>. + proof. + admit. + qed. + + lemma SecondPreImage_Resistance &m (m : from) (output_size : int) : + 0 < output_size => + Pr [ SecondPreImage(A, IRO).game(m, output_size) @ &m : res ] + <= mu1 dto witness<:to>. + proof. + admit. + qed. + + lemma Collision_Resistance &m (output_size : int) : + 0 < output_size => + Pr [ Collision(A, IRO).game(output_size) @ &m : res ] <= mu1 dto witness<:to>. + proof. + admit. + qed. + +end section Proof. + + + + From a4fab77abc2d728004ea16567c819ad9768cd7af Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Mon, 12 Aug 2019 16:32:23 +0200 Subject: [PATCH 339/394] old attempt to formalize non-fixed output indifferentiability --- sha3/proof/SecureIRO.eca | 392 ++++++++++++++++++++++++++++++++++++--- 1 file changed, 371 insertions(+), 21 deletions(-) diff --git a/sha3/proof/SecureIRO.eca b/sha3/proof/SecureIRO.eca index 8a03fb3..9a65e18 100644 --- a/sha3/proof/SecureIRO.eca +++ b/sha3/proof/SecureIRO.eca @@ -1,4 +1,4 @@ -require import Core Int Real Distr List. +require import AllCore Int Real Distr List SmtMap FSet FelTactic DList. require (****) IRO. @@ -15,11 +15,15 @@ clone import IRO as URO with op dto <- dto proof *. +axiom dto_ll : is_lossless dto. +axiom dto_funi : is_funiform dto. + (* Define module types for the preimage, second preimage and collision games *) module type OIRO = { proc f (x : from, n : int) : to list }. + module type Adversary (F : OIRO) = { proc guess_preimage (h : to list) : from proc guess_second_preimage (m1 : from, s : int) : from @@ -27,16 +31,33 @@ module type Adversary (F : OIRO) = { }. (* Define the bound on the counter cost and the operator updating the cost *) + module Cost = { var counter : int }. -op update_cost : int -> from -> int. -axiom update_cost c m : c <= update_cost c m. +op update_cost : int -> from -> int -> int. +axiom update_cost c m i : c <= update_cost c m i. +axiom update_costS c m i : + update_cost c m i <= update_cost c m (i+1) <= update_cost c m i + 1. +lemma update_cost_leq c m (i : int) j : + i <= j => update_cost c m i <= update_cost c m j. +proof. +pose k := j - i. +cut -> : j = k + i by smt(). +rewrite StdOrder.IntOrder.ler_addr. +by elim:k=>//= {j} k H0k; rewrite addzAC; smt(update_costS). +qed. op t : int. axiom t_gt0 : 0 < t. +op map_cost (m : ('a, 'b) fmap) : int. +axiom map_cost0 (m : ('a, 'b) fmap) : m = empty => 0 = map_cost m. +axiom map_cost_update_cost (map : ('a * 'b, 'c) fmap) c m i x j y : + map_cost map <= update_cost c m i => + map_cost map.[(x,j) <- y] <= update_cost c m (i+1). + module Count (F : OIRO) = { proc init() = { Cost.counter <- 0; @@ -44,27 +65,71 @@ module Count (F : OIRO) = { proc f (m : from, n : int) = { var r : to list; r <- []; - if (update_cost Cost.counter m < t) { + if (0 <= n /\ update_cost Cost.counter m n < t) { r <- F.f(m,n); - Cost.counter <- update_cost Cost.counter m; + Cost.counter <- update_cost Cost.counter m n; } return r; } }. +(***** Useful Material ********************************************************) +op rngm (m : ('a * int, 'b) fmap) (l : 'b list) = + exists (x : 'a), forall i, 0 <= i < size l => m.[(x,i)] = Some (nth witness l i). + +lemma not_rngm (m : ('a * int, 'b) fmap) (l : 'b list) : + ! rngm m l <=> forall x, exists i, 0 <= i < size l /\ m.[(x,i)] <> Some (nth witness l i). + +op set_at (l : 'a list) (i : int) (a : 'a) = + (take i l) ++ [a] ++ (drop (i+1) l). + +lemma nth_set_at_eq (a b : 'a) (l : 'a list) j : + 0 <= j < size l => nth a (set_at l j b) j = b. +proof. +move=>[#] hj0 hjn. +rewrite/set_at nth_cat size_cat/= size_take // hjn /=. +have->/=: j < j + 1 by smt(). +by rewrite nth_cat size_take // hjn /=. +qed. + +lemma nth_set_at_lt (a b : 'a) (l : 'a list) i j : + 0 <= j < i < size l => nth a (set_at l i b) j = nth a l j. +proof. +move=>[#] hj0 hji hin. +rewrite/set_at nth_cat size_cat/= size_take // 1:/# hin/=. +have->/=: j < i + 1 by smt(). +by rewrite nth_cat size_take // 1:/# hin /= hji /= nth_take /#. +qed. + +lemma nth_set_at_gt (a b : 'a) (l : 'a list) i j : + 0 <= i < j < size l => nth a (set_at l i b) j = nth a l j. +proof. +move=>[#] hi0 hji hjn. +have hin : i < size l by smt(). +rewrite/set_at nth_cat size_cat/= size_take // hin /=. +have->/=: ! j < i + 1 by smt(). +by rewrite nth_drop; smt(). +qed. + +lemma size_set_at (l : 'a list) i a : + 0 <= i < size l => size (set_at l i a) = size l. +proof. +move=> [#] hi0 hin; rewrite /set_at 2!size_cat /=. +by rewrite size_take // hin /= size_drop /#. +qed. (************************** Preimage Game *************************************) module PreImage (A : Adversary, F : IRO) = { proc game (h : to list) : bool = { var m, h2, b; b <- false; - Cost.counter <- 0; + Count(F).init(); F.init(); m <@ A(Count(F)).guess_preimage(h); - if (update_cost Cost.counter m < t) { + if (update_cost Cost.counter m (size h) < t) { h2 <- F.f(m, size h); b <- h = h2; - Cost.counter <- update_cost Cost.counter m; + Cost.counter <- update_cost Cost.counter m (size h); } return b; } @@ -75,16 +140,16 @@ module SecondPreImage (A : Adversary, F : IRO) = { proc game (m : from, s : int) : bool = { var m2, h1, h2, b; b <- false; - Cost.counter <- 0; + Count(F).init(); F.init(); m2 <@ A(Count(F)).guess_second_preimage(m,s); - if (update_cost Cost.counter m < t) { + if (0 <= s /\ update_cost Cost.counter m s < t) { h1 <- F.f(m,s); - Cost.counter <- update_cost Cost.counter m; - if (update_cost Cost.counter m2 < t) { + Cost.counter <- update_cost Cost.counter m s; + if (update_cost Cost.counter m2 s < t) { h2 <- F.f(m2,s); b <- h1 = h2; - Cost.counter <- update_cost Cost.counter m2; + Cost.counter <- update_cost Cost.counter m2 s; } } return b; @@ -96,16 +161,16 @@ module Collision (A : Adversary, F : IRO) = { proc game (s : int) : bool = { var m1, m2, h1, h2, b; b <- false; - Cost.counter <- 0; + Count(F).init(); F.init(); (m1,m2) <@ A(Count(F)).guess_collision(s); - if (update_cost Cost.counter m1 < t) { + if (0 <= s /\ update_cost Cost.counter m1 s < t) { h1 <- F.f(m1,s); - Cost.counter <- update_cost Cost.counter m1; - if (update_cost Cost.counter m2 < t) { + Cost.counter <- update_cost Cost.counter m1 s; + if (update_cost Cost.counter m2 s < t) { h2 <- F.f(m2,s); b <- h1 = h2; - Cost.counter <- update_cost Cost.counter m2; + Cost.counter <- update_cost Cost.counter m2 s; } } return b; @@ -117,14 +182,297 @@ module Collision (A : Adversary, F : IRO) = { section Proof. declare module A : Adversary{IRO, Cost}. + + + (***** Useful Material ******************************************************) + local lemma card_domS (m : ('a, 'b) fmap) x y : + card (fdom m) <= card (fdom m.[x <- y]) <= card (fdom m) + 1. + proof. + rewrite fdom_set fcardU fcard1 fsetI1. + case: (x \in fdom m) => //=. + + by rewrite fcard1 /#. + by rewrite fcards0 /#. + qed. + + (****** Preimage Resistance ********) + local module FEL (A : Adversary, F : IRO) = { + proc main (hash : to list) : from = { + var m; + Count(F).init(); + m <@ A(Count(F)).guess_preimage(hash); + return m; + } + }. + local module PreImage2 (A : Adversary, F : IRO) = { + proc game (h : to list) : bool = { + var m, h2, b; + b <- false; + F.init(); + m <@ FEL(A,F).main(h); + if (update_cost Cost.counter m (size h) < t) { + h2 <- F.f(m, size h); + b <- h = h2; + Cost.counter <- update_cost Cost.counter m (size h); + } + return b; + } + }. - lemma PreImage_Resistance &m (h : to list) : - Pr [ PreImage(A, IRO).game(h) @ &m : res ] <= mu1 dto witness<:to>. + + local module DListIRO : IRO = { + proc init() = { + IRO.mp <- empty; + } + proc f (m : from, n : int) = { + var bs, i; + bs <- []; + if (valid m) { + bs <$ dlist dto n; + i <- 0; + while (i < n) { + if ((m,i) \notin IRO.mp) { + IRO.mp.[(m,i)] <- nth witness bs i; + } else { + bs <- set_at bs i (oget IRO.mp.[(m,i)]); + } + i <- i + 1; + } + } + return bs; + } + }. + + local clone DList.Program as MyPr with + type t <- to, + op d <- dto + proof *. + + local equiv equiv_dlist_IRO : + DListIRO.f ~ IRO.f : ={arg, glob IRO} /\ 0 <= arg{2}.`2 ==> ={res, glob IRO}. proof. - admit. + proc; sp; if; 1,3:auto; inline*. + transitivity{2} { + i <- 0; + bs <- []; + while (i < n) { + b <$ dto; + bs <- rcons bs b; + i <- i + 1; + } + i <- 0; + while (i < n) { + if ((x, i) \notin IRO.mp) { + IRO.mp.[(x,i)] <- nth witness bs i; + } else { + bs <- set_at bs i (oget IRO.mp.[(x,i)]); + } + i <- i + 1; + } + } + (={bs, n, glob IRO} /\ bs{1} = [] /\ m{1} = x{2} ==> ={bs, IRO.mp}) + (={bs, n, x, glob IRO} /\ bs{1} = [] /\ i{2} = 0 /\ 0 <= n{1} ==> ={bs, IRO.mp})=>//=. + + smt(). + + sim. + conseq(:_==> ={bs})=> //=. + transitivity{1} { + bs <@ MyPr.Sample.sample(n); + } + (={n} ==> ={bs}) (={n} ==> ={bs})=> //=. + - smt(). + - by inline*; sim. + transitivity{2} { + bs <@ MyPr.LoopSnoc.sample(n); + } + (={n} ==> ={bs}) (={n} ==> ={bs})=> //=. + - smt(). + - by call MyPr.Sample_LoopSnoc_eq; auto. + inline*; sim. + by while( (i0, n1, l){1} = (i, n, bs){2}); auto; smt(cats1). + transitivity{2} { + i <- 0; + while (i < n) { + b <$ dto; + bs <- rcons bs b; + if ((x, i) \notin IRO.mp) { + IRO.mp.[(x,i)] <- nth witness bs i; + } else { + bs <- set_at bs i (oget IRO.mp.[(x,i)]); + } + i <- i + 1; + } + } + (={bs, n, x, glob IRO} /\ bs{1} = [] /\ 0 <= n{1} ==> ={bs, IRO.mp}) + (={bs, n, x, glob IRO} /\ bs{1} = [] /\ i{2} = 0 ==> ={bs, IRO.mp})=>//=. + + smt(). + + seq 3 2 : (={n, x} /\ size bs{1} = n{1} /\ size bs{2} = size bs{1} /\ + (forall y j, (y,j) \in IRO.mp{1} => (y,j) \in IRO.mp{2}) /\ + (forall y j, (y,j) \in IRO.mp{1} => + IRO.mp{1}.[(y,j)] = IRO.mp{2}.[(y,j)]) /\ + (forall y j, (y,j) \in IRO.mp{2} => + (y,j) \in IRO.mp{1} \/ (y = x{1} /\ 0 <= j < n{1})) /\ + (forall j, 0 <= j < n{1} => (x{1},j) \in IRO.mp{2} /\ + nth witness bs{2} j = oget IRO.mp{2}.[(x{1},j)]) /\ + (forall j, 0 <= j < n{1} => (x{1},j) \notin IRO.mp{1} => + nth witness bs{2} j = nth witness bs{1} j)); last first. + - sp; while{1}(={n, x} /\ size bs{1} = n{1} /\ 0 <= i{1} <= n{1} /\ + size bs{2} = size bs{1} /\ + (forall x j, (x,j) \in IRO.mp{1} => (x,j) \in IRO.mp{2}) /\ + (forall y j, (y,j) \in IRO.mp{1} => + IRO.mp{1}.[(y,j)] = IRO.mp{2}.[(y,j)]) /\ + (forall y j, (y,j) \in IRO.mp{2} => + (y,j) \in IRO.mp{1} \/ (y = x{1} /\ i{1} <= j < n{1})) /\ + (forall j, 0 <= j < n{1} => (x{1},j) \in IRO.mp{2} /\ + nth witness bs{2} j = oget IRO.mp{2}.[(x{1},j)]) /\ + (forall j, 0 <= j < i{1} => (x{1},j) \in IRO.mp{1} /\ + nth witness bs{1} j = oget IRO.mp{1}.[(x{1},j)]) /\ + (forall j, 0 <= j < n{1} => (x{1},j) \notin IRO.mp{1} => + nth witness bs{2} j = nth witness bs{1} j)) (n{1} - i{1}). + + move=> &1 c; if; auto; 1:smt(mem_set get_setE); + smt(nth_set_at_eq nth_set_at_lt nth_set_at_gt size_set_at). + auto=> &1 &2 [#] 3->> <<- hs2 4?; do !split=> //=. + + exact size_ge0. + + smt(). + move=> [#] map1 bs1 i1; split; 1: smt(). + + move=> hnis [#] hs hi0 his /= 6?. + have ->>/=: map1 = IRO.mp{2}. + - apply fmap_eqP. + move=> [] y j. + case: ((y,j) \in map1)=> hin; 1:smt(). + have := hin; rewrite domE /= => ->. + have := H7 y j; rewrite hin /=. + have -> /= : ! i1 <= j < size bs{1} by smt(). + by rewrite domE /= => ->. + apply/(eq_from_nth witness)=> //=. + - by rewrite hs hs2. + move=> j [] hj0 hjs. + have [] h -> {h} := H9 j _; 1: smt(). + by have [] h -> {h} := H8 j _; 1: smt(). + while(={i, n, x} /\ 0 <= i{1} <= n{1} /\ + size bs{1} = i{1} /\ size bs{1} = size bs{2} /\ + (forall y j, (y,j) \in IRO.mp{1} => (y,j) \in IRO.mp{2}) /\ + (forall y j, (y,j) \in IRO.mp{1} => + IRO.mp{1}.[(y,j)] = IRO.mp{2}.[(y,j)]) /\ + (forall y j, (y,j) \in IRO.mp{2} => + (y,j) \in IRO.mp{1} \/ (y = x{1} /\ 0 <= j < i{1})) /\ + (forall j, 0 <= j < i{1} => (x{1},j) \in IRO.mp{2} /\ + nth witness bs{2} j = oget IRO.mp{2}.[(x{1},j)]) /\ + (forall j, 0 <= j < i{1} => (x{1},j) \notin IRO.mp{1} => + nth witness bs{2} j = nth witness bs{1} j)). + wp; rnd; auto. + move=> &1 &2 [#] 3->> hi0 hin <<- hs 4? {hin} his h {h} b hbin //=. + rewrite hbin //; case: ((x{2}, size bs{1}) \in IRO.mp{2})=> hin//=. + + do !split. + - smt(size_ge0). + - smt(). + - exact size_rcons. + - smt(size_set_at size_rcons). + - smt(). + - smt(). + - smt(). + - move=> j [] hj0 hjs; split; 1:smt(). + case: (j < size bs{1})=> hjs1. + + rewrite nth_set_at_lt 1:size_rcons 1:/#. + have//=[]_ <-:= H2 j _; 1: by done. + by rewrite nth_rcons -hs hjs1 /=. + have->>: j = size bs{1} by smt(). + by rewrite nth_set_at_eq 1:size_rcons 1:-hs 1:/#. + - move=> j [] hj0 hjs hnin. + have hjs1: (j < size bs{1}) by smt(). + rewrite nth_set_at_lt 1:size_rcons 1:/#. + rewrite !nth_rcons -hs hjs1 /=. + by apply H3=> //=. + do !split. + + smt(size_ge0). + + smt(). + + exact size_rcons. + + smt(size_rcons). + + smt(mem_set). + + smt(get_setE). + + smt(mem_set). + + move=>j [] hj0 hjs1; split. + - rewrite mem_set; smt(). + by rewrite nth_rcons get_setE /= nth_rcons; smt(). + + smt(nth_rcons). + by auto; smt(). + while(={i, n, IRO.mp, x, bs} /\ i{1} = size bs{1}); 2:auto. + + sp; if{2}. + - rcondt{1} 3; 1: auto; wp; rnd; auto; progress. + + smt(size_rcons nth_rcons). + + smt(get_setE). + + smt(size_rcons). + rcondf{1} 3; auto; progress. + + exact dto_ll. + apply (eq_from_nth witness). + + rewrite size_set_at //= 1: size_rcons 1:size_ge0 1:/#. + by rewrite 2!size_rcons. + move=> i [] hi0; rewrite size_set_at 1:size_ge0 size_rcons//= 1:/# => his. + case: (i < size bs{2})=> his2. + + by rewrite nth_set_at_lt 1:size_rcons 1:/# 2!nth_rcons his2/=. + have->>: i = size bs{2} by smt(). + rewrite nth_set_at_eq 1:size_rcons 1:size_ge0 1:/#. + by rewrite nth_rcons /=. + by rewrite size_set_at size_rcons 1:size_ge0 1:/#. qed. + + lemma PreImage_Resistance &m (ha : to list) : + Pr [ PreImage(A, IRO).game(ha) @ &m : res ] + <= mu1 (dlist dto (size ha)) ha. + proof. + have->: Pr [ PreImage (A, IRO).game(ha) @ &m : res ] = + Pr [ PreImage2(A, IRO).game(ha) @ &m : res ]. + + by byequiv=>//=; proc; inline*; sp; sim. + have->: Pr [ PreImage2(A, IRO).game(ha) @ &m : res ] = + Pr [ PreImage2(A, DListIRO).game(ha) @ &m : res ]. + + byequiv=> //=; proc; inline{1} 2; inline{2} 2; sp. + seq 1 1 : (={b, m, h, glob IRO, glob Cost}). + + inline*; wp; call(: ={glob IRO, glob Cost}); auto. + by proc; sp; if; auto; symmetry; call equiv_dlist_IRO. + by if; auto; symmetry; call equiv_dlist_IRO; auto; smt(size_ge0). + byphoare(: arg = ha ==> _)=> //=; proc; inline 2; swap 1 2. + sp; seq 1 : (rngm IRO.mp ha) (mu1 (dlist dto (size ha)) ha) 1%r 1%r + (mu1 (dlist dto (size ha)) ha) + (map_cost IRO.mp <= Cost.counter <= t /\ ha = h)=>//=. + + inline*; sp; auto. + conseq(: _ ==> map_cost IRO.mp <= Cost.counter <= t); 1: auto. + call(: map_cost IRO.mp <= Cost.counter <= t)=> //=; auto. + + proc; inline*; sp; if; auto; sp; if; auto. + + conseq(:_==> map_cost IRO.mp <= update_cost Cost.counter m n0 <= t); 1: auto. + while(map_cost IRO.mp <= update_cost Cost.counter m i <= t + /\ update_cost Cost.counter m n0 < t /\ 0 <= i <= n0). + + auto; smt(map_cost_update_cost card_domS update_costS update_cost_leq). + by auto; smt(update_cost update_cost_leq). + smt(update_cost). + + smt(fdom0 fcards0 t_gt0 map_cost0). + + call(: true ==> rngm IRO.mp ha)=> //; bypr=> /> {&m} &m. + fel 1 Cost.counter (fun _, mu1 (dlist dto (size ha)) ha) t (rngm IRO.mp ha) + [Count(IRO).f: (map_cost IRO.mp <= Cost.counter < t)] + (map_cost IRO.mp <= Cost.counter <= t) + =>//; admit. + + sp; if; last first. + - by hoare; auto; smt(mu_bounded size_ge0). + inline*; wp; sp; if; last first. + - by hoare; auto; smt(mu_bounded size_ge0). + case: (n = size ha); last first. + - hoare; conseq(:_==> size bs = n); progress. + by while(size bs = n /\ 0 <= i <= n); auto; smt(size_set_at). print rngm. + seq 1 : (bs = ha) (mu1 (dlist dto (size ha)) ha) 1%r _ 0%r + (size ha = n /\ ! rngm IRO.mp ha)=>//=. + + by auto. + + by rnd; auto. + hoare; auto; while(h <> bs /\ !rngm IRO.mp ha /\ 0 <= i /\ n = size ha /\ + (forall j, 0 <= j < i => IRO.mp.[(m0,j)] = Some (nth witness bs j))); auto; progress. + + rewrite/rngm negb_exists/= => a; rewrite negb_forall /=. + case: (a = m0{hr}) => //=. + + move=> <<-. + have:=H0; rewrite negb_exists /= => /(_ a); rewrite negb_forall /= => [][] b. + case: (0 <= b < size ha) =>//=. + + exists i{hr}=> /=; rewrite H1 H2 /=. + qed. + + (****** Second Preimage Resistance ********) lemma SecondPreImage_Resistance &m (m : from) (output_size : int) : 0 < output_size => Pr [ SecondPreImage(A, IRO).game(m, output_size) @ &m : res ] @@ -133,6 +481,8 @@ section Proof. admit. qed. + + (****** Collision Resistance ********) lemma Collision_Resistance &m (output_size : int) : 0 < output_size => Pr [ Collision(A, IRO).game(output_size) @ &m : res ] <= mu1 dto witness<:to>. From ef2e6878a3813311aa59e17aeb7b1a22f9b79435 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Mon, 12 Aug 2019 20:43:26 +0200 Subject: [PATCH 340/394] modify security model to output types as 'a option --- sha3/proof/OptionIndifferentiability.eca | 61 +++ sha3/proof/SHA3_OIndiff.ec | 266 ++++++++++++ sha3/proof/SecureORO.eca | 491 +++++++++++++++++++++++ 3 files changed, 818 insertions(+) create mode 100644 sha3/proof/OptionIndifferentiability.eca create mode 100644 sha3/proof/SHA3_OIndiff.ec create mode 100644 sha3/proof/SecureORO.eca 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/SHA3_OIndiff.ec b/sha3/proof/SHA3_OIndiff.ec new file mode 100644 index 0000000..f039ee3 --- /dev/null +++ b/sha3/proof/SHA3_OIndiff.ec @@ -0,0 +1,266 @@ +require import AllCore List Int IntDiv IntExtra 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.RRO, SLCommon.Redo, SLCommon.C, + Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO, + 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.RRO, SLCommon.Redo, SLCommon.C, + Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO, + 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. +cut->: 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=> />. +cut->: 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, 3: auto; 1: smt(); sp. + * if; auto=> />. + by conseq(:_==> ={IRO.mp} /\ bs0{1} = bs{2})=> />; sim=> />; smt(). + by if; auto=> />; sim; smt(). + - 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. + + + diff --git a/sha3/proof/SecureORO.eca b/sha3/proof/SecureORO.eca new file mode 100644 index 0000000..38949c6 --- /dev/null +++ b/sha3/proof/SecureORO.eca @@ -0,0 +1,491 @@ +require import Int Distr Real SmtMap FSet Mu_mem. +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.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. + +op bound_counter : int. +axiom bound_counter_ge0 : 0 <= bound_counter. + +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. + cut->: 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_gt0). + + 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 {h} <-. + 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 IntExtra.Extrema.max_ler //=; 1:smt(bound_gt0). + rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_gt0). + by rewrite StdRing.RField.intmulr; smt(). + - inline*; auto=> /> &h. + rewrite mem_rng_empty /= fdom0 fcards0 /=; smt(bound_gt0). + - 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 ??????. + rewrite (sampleto_fu h witness) /= => ? ?. + rewrite rngE/= => [][] a; rewrite get_setE. + case: (a=x{h}) => [->>|] //=. + by move:H1; 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. + + smt(mu_bounded). + rewrite H3/=; move: H1; rewrite rngE /= negb_exists /=. + by have:=H3; rewrite domE; smt(). + rnd (pred1 Preimage2.hash); auto=> /> &hr 6?. + 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. + by call(RO_LRO_D (D1(A))); 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=> /> &h 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(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 IntExtra.Extrema.max_ler //=; 1:smt(bound_gt0). + rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_gt0). + by rewrite StdRing.RField.intmulr; smt(mu_bounded bound_gt0). + + inline*; auto=> />. + move=> &h 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; 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; 1: smt(mu_bounded); if; auto. + case(Bounder.bounder < bound); last first. + - by rcondf 8; 1: auto; hoare; auto; smt(mu_bounded). + 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 _ in_dom2. + + smt(mu_bounded). + 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 (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; 1: smt(mu_bounded); auto. + case: (Bounder.bounder < bound); last first. + - rcondf 8; 1:auto; hoare; auto; smt(mu_bounded). + 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; 1: smt(mu_bounded); auto. + case: (m1 \in RO.m); case: (m2 \in RO.m). + - rcondf 3; 1: auto; rcondf 4; 1: auto; hoare; auto; 1: smt(bound_gt0 mu_bounded). + 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_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(RF(RO)).get: (card (fdom RO.m) <= Bounder.bounder < bound)] + (card (fdom RO.m) <= Bounder.bounder <= bound)=> //. + + rewrite -StdBigop.Bigreal.BRA.mulr_suml StdRing.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). + 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 //; 1: smt(mu_bounded). + by rewrite RealExtra.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 _ _ sample _. + by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + qed. + + +end section Collision. From 95ea86466c7bdc8d4d9ef5bc987fe8f9d088412c Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 15 Aug 2019 16:18:01 -0400 Subject: [PATCH 341/394] Slight refactoring: Hybrid IROs now have just one procedure (f) in addition to init, and there is now LowerHybridIRO as well as RaiseHybridIRO. --- sha3/proof/Sponge.ec | 163 +++++++++++++++++++------------------------ 1 file changed, 72 insertions(+), 91 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index aa88203..d9b1644 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -193,36 +193,34 @@ module RaiseSim (S : BlockSponge.SIMULATOR, F : DFUNCTIONALITY) = (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res]. into three steps, involving Hybrid IROs, which, in addition to - an init procedure, have procedures + an init procedure, have the procedure (* hashing block lists, giving n bits *) - proc g(x : block list, n : int) : bool list - - (* hashing block lists, giving n blocks *) - proc f(x : block list, n : int) : block list + 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, f is defined in terms of g, and, as in - BlockSponge.BIRO.IRO, g returns [] if x isn't a valid block. In - both versions, the input/output behavior of f is identical to that - of BlockSponge.BIRO.IRO.f. + bool. In both versions, as in BlockSponge.BIRO.IRO, f returns [] if + x isn't a valid block list. - In the lazy version, g consults/randomly updates just those + 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 were + 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 (not using f), and we - split the proof of the Ideal side into three steps: + 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(HybridIROLazy), + (RaiseHybridIRO(HybridIROLazy), + BlockSim(LowerHybridIRO(HybridIROLazy)), Dist).main() @ &m : res] This step is proved using a lazy invariant relating the @@ -231,10 +229,12 @@ module RaiseSim (S : BlockSponge.SIMULATOR, F : DFUNCTIONALITY) = Step 2: Pr[Experiment - (RaiseHybridIRO(HybridIROLazy), BlockSim(HybridIROLazy), + (RaiseHybridIRO(HybridIROLazy), + BlockSim(LowerHybridIRO(HybridIROLazy)), Dist).main() @ &m : res] = Pr[Experiment - (RaiseHybridIRO(HybridIROEager), BlockSim(HybridIROEager), + (RaiseHybridIRO(HybridIROEager), + BlockSim(LowerHybridIRO(HybridIROEager)), Dist).main() @ &m : res] This step is proved using the eager sampling lemma provided by @@ -243,7 +243,8 @@ module RaiseSim (S : BlockSponge.SIMULATOR, F : DFUNCTIONALITY) = Step 3: Pr[Experiment - (RaiseHybridIRO(HybridIROEager), BlockSim(HybridIROEager), + (RaiseHybridIRO(HybridIROEager), + BlockSim(LowerHybridIRO(HybridIROEager)), Dist).main() @ &m : res] = Pr[BlockSponge.IdealIndif (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res] @@ -263,16 +264,13 @@ module type HYBRID_IRO = { proc init() : unit (* hashing block lists, giving n bits *) - proc g(x : block list, n : int) : bool list - - (* hashing block lists, giving n blocks *) - proc f(x : block list, n : int) : block list + proc f(x : block list, n : int) : bool list }. (* distinguisher for Hybrid IROs *) module type HYBRID_IRO_DIST(HI : HYBRID_IRO) = { - proc distinguish() : bool + proc distinguish() : bool {HI.f} }. (* experiments for Hybrid IROs *) @@ -288,21 +286,21 @@ module HybridIROExper(HI : HYBRID_IRO, D : HYBRID_IRO_DIST) = { (* lazy implementation of Hybrid IROs *) -module HybridIROLazy : HYBRID_IRO, BlockSponge.BIRO.IRO = { +module HybridIROLazy : HYBRID_IRO = { var mp : (block list * int, bool) fmap proc init() : unit = { mp <- empty; } - proc fill_in(xs, i) = { + proc fill_in(xs : block list, i : int) = { if (! dom mp (xs, i)) { mp.[(xs, i)] <$ dbool; } return oget mp.[(xs, i)]; } - proc g(xs, n) = { + proc f(xs : block list, n : int) = { var b, bs; var i <- 0; @@ -316,18 +314,11 @@ module HybridIROLazy : HYBRID_IRO, BlockSponge.BIRO.IRO = { } return bs; } - - proc f(xs, n) = { (* implemented using g *) - var bs, ys; - bs <@ g(xs, n * r); - ys <- bits2blocks bs; - return ys; - } }. (* eager implementation of Hybrid IROs *) -module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { +module HybridIROEager : HYBRID_IRO = { (* same as lazy implementation, except for indicated part *) var mp : (block list * int, bool) fmap @@ -335,14 +326,14 @@ module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { mp <- empty; } - proc fill_in(xs, i) = { + proc fill_in(xs : block list, i : int) = { if (! dom mp (xs, i)) { mp.[(xs, i)] <$ dbool; } return oget mp.[(xs, i)]; } - proc g(xs, n) = { + proc f(xs : block list, n : int) = { var b, bs; var m <- ((n + r - 1) %/ r) * r; (* eager part *) var i <- 0; @@ -361,13 +352,6 @@ module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { } return bs; } - - proc f(xs, n) = { - var bs, ys; - bs <@ g(xs, n * r); - ys <- bits2blocks bs; - return ys; - } }. (* we are going to use PROM.GenEager to prove: @@ -412,7 +396,7 @@ local module HIRO(RO : ERO.RO) : HYBRID_IRO = { RO.init(); } - proc g(xs, n) = { + proc f(xs, n) = { var b, bs; var m <- ((n + r - 1) %/ r) * r; var i <- 0; @@ -431,13 +415,6 @@ local module HIRO(RO : ERO.RO) : HYBRID_IRO = { } return bs; } - - proc f(xs, n) = { - var bs, ys; - bs <@ g(xs, n * r); - ys <- bits2blocks bs; - return ys; - } }. local lemma HybridIROLazy_HIRO_LRO_init : @@ -458,8 +435,8 @@ rcondt{1} 1; first auto. rcondt{2} 2; first auto. wp; rnd; auto. qed. -local lemma HybridIROLazy_HIRO_LRO_g : - equiv[HybridIROLazy.g ~ HIRO(ERO.LRO).g : +local lemma HybridIROLazy_HIRO_LRO_f : + equiv[HybridIROLazy.f ~ HIRO(ERO.LRO).f : ={xs, n} /\ HybridIROLazy.mp{1} = ERO.RO.m{2} ==> ={res} /\ HybridIROLazy.mp{1} = ERO.RO.m{2}]. proof. @@ -472,12 +449,6 @@ wp; call HybridIROLazy_fill_in_LRO_get; auto. auto; progress; smt(). qed. -local lemma HybridIROLazy_HIRO_LRO_f : - equiv[HybridIROLazy.f ~ HIRO(ERO.LRO).f : - ={xs, n} /\ HybridIROLazy.mp{1} = ERO.RO.m{2} ==> - ={res} /\ HybridIROLazy.mp{1} = ERO.RO.m{2}]. -proof. proc; wp; call HybridIROLazy_HIRO_LRO_g; auto. qed. - local lemma HIRO_RO_HybridIROEager_init : equiv[HIRO(ERO.RO).init ~ HybridIROEager.init : true ==> ={res} /\ ERO.RO.m{1} = HybridIROEager.mp{2}]. @@ -509,8 +480,8 @@ rcondt{1} 2; first auto. rcondt{2} 1; first auto. wp; rnd; auto. qed. -local lemma HIRO_RO_HybridIROEager_g : - equiv[HIRO(ERO.RO).g ~ HybridIROEager.g : +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. @@ -523,12 +494,6 @@ wp; call RO_get_HybridIROEager_fill_in; auto. 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; wp; call HIRO_RO_HybridIROEager_g; auto. qed. - (* make distinguisher for random oracles out of HIRO and D *) local module RODist(RO : ERO.RO) = { @@ -546,8 +511,6 @@ 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_init. -conseq HybridIROLazy_HIRO_LRO_g. conseq HybridIROLazy_HIRO_LRO_f. auto. qed. @@ -559,8 +522,6 @@ 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_init. -conseq HIRO_RO_HybridIROEager_g. conseq HIRO_RO_HybridIROEager_f. auto. qed. @@ -583,7 +544,7 @@ lemma HybridIROExper_Lazy_Eager proof. by apply (HybridIROExper_Lazy_Eager' D &m). qed. (* turn a Hybrid IRO implementation (lazy or eager) into top-level - ideal functionality; its f procedure only uses HI.g *) + ideal functionality *) module RaiseHybridIRO (HI : HYBRID_IRO) : FUNCTIONALITY = { proc init() = { @@ -592,11 +553,23 @@ module RaiseHybridIRO (HI : HYBRID_IRO) : FUNCTIONALITY = { proc f(bs : bool list, n : int) = { var cs; - cs <@ HI.g(pad2blocks bs, n); + 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 @@ -706,11 +679,11 @@ by rewrite !get_set_sameE. qed. lemma LowerFun_IRO_HybridIROLazy_f : - equiv[LowerFun(IRO).f ~ 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.g. +proc=> /=; inline HybridIROLazy.f. seq 0 1 : (={n} /\ xs{1} = xs0{2} /\ lazy_invar IRO.mp{1} HybridIROLazy.mp{2}); first auto. @@ -899,8 +872,8 @@ lemma block_bits_dom_first_out_imp_all_out block_bits_all_out_dom xs i mp. proof. smt(). qed. -lemma HybridIROEager_f_g : - equiv[HybridIROEager.f ~ HybridIROEager.g : +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. @@ -1637,8 +1610,8 @@ wp; sp. call (_ : ={BlockSponge.BIRO.IRO.mp}). if=> //; rnd; skip; smt(). auto. qed. -lemma HybridIROEager_g_BlockIRO_f (n1 : int) (x2 : block list) : - equiv[HybridIROEager.g ~ BlockSponge.BIRO.IRO.f : +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} ==> @@ -1898,13 +1871,13 @@ auto. qed. lemma HybridIROEager_BlockIRO_f : - equiv[HybridIROEager.f ~ BlockSponge.BIRO.IRO.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.g + 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}) @@ -1916,9 +1889,9 @@ 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 HybridIROEager_f_g=> |> &1 &2 ? -> ?. +by conseq Lower_HybridIROEager_f=> |> &1 &2 ? -> ?. exists* n{1}; elim*=> n1; exists* xs{1}; elim*=> xs'. -conseq (HybridIROEager_g_BlockIRO_f n1 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]. @@ -1998,7 +1971,8 @@ qed. local lemma Ideal_IRO_Experiment_HybridLazy &m : Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = Pr[Experiment - (HIRO.RaiseHybridIRO(HIRO.HybridIROLazy), BlockSim(HIRO.HybridIROLazy), + (HIRO.RaiseHybridIRO(HIRO.HybridIROLazy), + BlockSim(HIRO.LowerHybridIRO(HIRO.HybridIROLazy)), Dist).main() @ &m : res]. proof. byequiv=> //; proc. @@ -2035,8 +2009,10 @@ qed. local module (HybridIRODist : HIRO.HYBRID_IRO_DIST) (HI : HIRO.HYBRID_IRO) = { proc distinguish() : bool = { var b : bool; - BlockSim(HI).init(); - b <@ Dist(HIRO.RaiseHybridIRO(HI), BlockSim(HI)).distinguish(); + BlockSim(HIRO.LowerHybridIRO(HI)).init(); + b <@ + Dist(HIRO.RaiseHybridIRO(HI), + BlockSim(HIRO.LowerHybridIRO(HI))).distinguish(); return b; } }. @@ -2045,7 +2021,8 @@ local module (HybridIRODist : HIRO.HYBRID_IRO_DIST) (HI : HIRO.HYBRID_IRO) = { local lemma Experiment_HybridIROExper_Lazy &m : Pr[Experiment - (HIRO.RaiseHybridIRO(HIRO.HybridIROLazy), BlockSim(HIRO.HybridIROLazy), + (HIRO.RaiseHybridIRO(HIRO.HybridIROLazy), + BlockSim(HIRO.LowerHybridIRO(HIRO.HybridIROLazy)), Dist).main() @ &m : res] = Pr[HIRO.HybridIROExper(HIRO.HybridIROLazy, HybridIRODist).main() @ &m : res]. proof. @@ -2061,7 +2038,8 @@ local lemma HybridIROExper_Experiment_Eager &m : Pr[HIRO.HybridIROExper(HIRO.HybridIROEager, HybridIRODist).main() @ &m : res] = Pr[Experiment - (HIRO.RaiseHybridIRO(HIRO.HybridIROEager), BlockSim(HIRO.HybridIROEager), + (HIRO.RaiseHybridIRO(HIRO.HybridIROEager), + BlockSim(HIRO.LowerHybridIRO(HIRO.HybridIROEager)), Dist).main() @ &m : res]. proof. byequiv=> //; proc; inline*. @@ -2075,10 +2053,12 @@ qed. local lemma Experiment_Hybrid_Lazy_Eager &m : Pr[Experiment - (HIRO.RaiseHybridIRO(HIRO.HybridIROLazy), BlockSim(HIRO.HybridIROLazy), + (HIRO.RaiseHybridIRO(HIRO.HybridIROLazy), + BlockSim(HIRO.LowerHybridIRO(HIRO.HybridIROLazy)), Dist).main() @ &m : res] = Pr[Experiment - (HIRO.RaiseHybridIRO(HIRO.HybridIROEager), BlockSim(HIRO.HybridIROEager), + (HIRO.RaiseHybridIRO(HIRO.HybridIROEager), + BlockSim(HIRO.LowerHybridIRO(HIRO.HybridIROEager)), Dist).main() @ &m : res]. proof. by rewrite (Experiment_HybridIROExper_Lazy &m) @@ -2099,7 +2079,7 @@ proof. proc=> /=. exists* n{1}; elim*=> n'. exists* (pad2blocks bs{2}); elim*=> xs2. -call (HIRO.HybridIROEager_g_BlockIRO_f n' 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. @@ -2114,7 +2094,8 @@ qed. local lemma Experiment_HybridEager_Ideal_BlockIRO &m : Pr[Experiment - (HIRO.RaiseHybridIRO(HIRO.HybridIROEager), BlockSim(HIRO.HybridIROEager), + (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]. From 3122de6f84ba3a47752217107203dce45e7dd896 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Mon, 19 Aug 2019 23:58:09 +0200 Subject: [PATCH 342/394] some work --- sha3/proof/SHA3_OIndiff.ec | 1 + sha3/proof/SecureORO.eca | 31 ++++++++++++++----------------- 2 files changed, 15 insertions(+), 17 deletions(-) diff --git a/sha3/proof/SHA3_OIndiff.ec b/sha3/proof/SHA3_OIndiff.ec index f039ee3..1900a47 100644 --- a/sha3/proof/SHA3_OIndiff.ec +++ b/sha3/proof/SHA3_OIndiff.ec @@ -264,3 +264,4 @@ qed. +end section. diff --git a/sha3/proof/SecureORO.eca b/sha3/proof/SecureORO.eca index 38949c6..99c90e8 100644 --- a/sha3/proof/SecureORO.eca +++ b/sha3/proof/SecureORO.eca @@ -7,7 +7,7 @@ type from, to. op sampleto : to distr. op bound : int. -axiom bound_gt0 : 0 < bound. +axiom bound_ge0 : 0 <= bound. axiom sampleto_ll: is_lossless sampleto. axiom sampleto_full: is_full sampleto. @@ -22,9 +22,6 @@ proof * by exact/sampleto_ll. 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 type RF = { proc init() : unit proc get(x : from) : to option @@ -117,7 +114,7 @@ section Preimage. 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). + 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 {h} <-. @@ -131,11 +128,11 @@ section Preimage. (card (fdom RO.m) <= Bounder.bounder <= bound) =>//. - rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. - rewrite IntExtra.Extrema.max_ler //=; 1:smt(bound_gt0). - rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_gt0). + rewrite IntExtra.Extrema.max_ler //=; 1:smt(bound_ge0). + rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_ge0). by rewrite StdRing.RField.intmulr; smt(). - inline*; auto=> /> &h. - rewrite mem_rng_empty /= fdom0 fcards0 /=; smt(bound_gt0). + rewrite mem_rng_empty /= fdom0 fcards0 /=; smt(bound_ge0). - proc. sp; if; auto; sp; inline*; sp; wp=> /=. case: (x \in RO.m); wp => //=. @@ -277,7 +274,7 @@ section SecondPreimage. auto=> /> &h c Hc Hdom Hc2 sample. by rewrite sampleto_full/=!fdom_set !fcardU !fcard1;smt(mem_set fcard_ge0). auto=> /> &h sample. - by rewrite mem_set mem_empty/= fdom_set fdom0 fset0U fcard1; smt(bound_gt0). + 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 @@ -286,12 +283,12 @@ section SecondPreimage. (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 IntExtra.Extrema.max_ler //=; 1:smt(bound_gt0). - rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_gt0). - by rewrite StdRing.RField.intmulr; smt(mu_bounded bound_gt0). + rewrite IntExtra.Extrema.max_ler //=; 1:smt(bound_ge0). + rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_ge0). + by rewrite StdRing.RField.intmulr; smt(mu_bounded bound_ge0). + inline*; auto=> />. move=> &h 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). + 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)=> //=. @@ -414,7 +411,7 @@ section Collision. case: (m1 = m2). - by hoare; 1: smt(mu_bounded); auto. case: (m1 \in RO.m); case: (m2 \in RO.m). - - rcondf 3; 1: auto; rcondf 4; 1: auto; hoare; auto; 1: smt(bound_gt0 mu_bounded). + - rcondf 3; 1: auto; rcondf 4; 1: auto; hoare; auto; 1: smt(bound_ge0 mu_bounded). move=> /> &h d _ _ Hcoll _ _ neq12 in_dom1 in_dom2 _ _ _ _. move: Hcoll; rewrite /collision negb_exists /= => /(_ m1{h}). rewrite negb_exists /= => /(_ m2{h}). @@ -442,7 +439,7 @@ section Collision. 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). + 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) @@ -450,9 +447,9 @@ section Collision. (card (fdom RO.m) <= Bounder.bounder <= bound)=> //. + rewrite -StdBigop.Bigreal.BRA.mulr_suml StdRing.RField.mulrAC. rewrite StdOrder.RealOrder.ler_wpmul2r; 1: smt(mu_bounded). - by rewrite StdBigop.Bigreal.sumidE //; smt(bound_gt0). + by rewrite StdBigop.Bigreal.sumidE //; smt(bound_ge0). + inline*; auto=> />. - rewrite fdom0 fcards0; split; 2: smt(bound_gt0). + 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 _. From aaa64a93c072e2fbdd30064816289df62019e2fa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 20 Aug 2019 00:14:55 +0200 Subject: [PATCH 343/394] forgot some files. --- sha3/proof/SHA3OSecurity.ec | 1410 +++++++++++++++++++++++++++++++++++ sha3/proof/SecureHash.eca | 148 ++++ 2 files changed, 1558 insertions(+) create mode 100644 sha3/proof/SHA3OSecurity.ec create mode 100644 sha3/proof/SecureHash.eca diff --git a/sha3/proof/SHA3OSecurity.ec b/sha3/proof/SHA3OSecurity.ec new file mode 100644 index 0000000..2dfc615 --- /dev/null +++ b/sha3/proof/SHA3OSecurity.ec @@ -0,0 +1,1410 @@ +(* Top-level Proof of SHA-3 Security *) + +require import AllCore Distr DList DBool List IntExtra IntDiv Dexcepted DProd SmtMap FSet. +require import Common SLCommon Sponge SHA3_OIndiff. +require (****) SecureORO SecureHash. +(*****) import OIndif. + + +(* 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. +cut->: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 _ _ _. + cut->: p = StdBigop.Bigreal.BRM.big predT (fun _ => inv 2%r) (to_list x). + - rewrite /p =>{p}. print StdBigop.Bigreal.BRM. + apply StdBigop.Bigreal.BRM.eq_bigr. + by move=> i; rewrite//= dbool1E. + rewrite StdBigop.Bigreal.BRM.big_const count_predT spec_dout=> {p}. search 0 Int.(+) 1 (<=). + have:=size_out_gt0; move/ltzW. + move:size_out;apply intind=> //=. + - by rewrite powr0 iter0 //= fromint1. + move=> i hi0 rec. + by rewrite powrS//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; + } +}. + +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)). + +section Preimage. +(* TODO : stopped here *) + + + 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 (Dist_of_P1Adv (A : SH.AdvPreimage) : ODISTINGUISHER) (F : ODFUNCTIONALITY) (P : ODPRIMITIVE) = { + proc distinguish () = { + var hash, hash', m; + hash <$ dout; + m <@ A(DFSetSize(F),P).guess(hash); + hash' <@ DFSetSize(F).f(m); + return hash' = Some hash; + } + }. + +local lemma leq_ideal &m + (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 }): + 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. +print SORO. +print SORO.RO_is_preimage_resistant. +admit. +qed. + + local lemma rw_real &m (A <: SH.AdvPreimage { Perm, Counter, Bounder }): + 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(). + - by proc; inline*; sp; if; auto; 2:sim=> />; 1: 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 + (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 }): + (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 A). +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 A. +qed. + + + declare module A : SH.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}. + + axiom A_ll (F <: SRO.Oracle) : 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 : + invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). + proof. + move=>hinvm nin_dom. + cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). + + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. + apply dexcepted_ll=>//=;rewrite-prod_ll. + cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. + rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. + cut/=->:=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. + cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + move:a. + cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. + cut->//=: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. + cut->:i_R = size_out by smt(). + cut<-:=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 /= oget_some; 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. + rnd; auto; progress. + - smt(size_ge0). + - smt(). + - by rewrite size_cat/=. + - by rewrite mem_set; left; rewrite H3. + - rewrite get_setE (H4 _ _ H12). + cut/#: !(l1, j) = (x0{2}, size bs0{2}). + move:H2; apply absurd=> //=[#] <<- ->>. + have[] h1 [] h2 h3 := H1. + by apply h2; smt(). + - move:H12; 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 {H13} 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 max_ler 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. + cut->//: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. + cut->//: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}. + + axiom A_ll (F <: SRO.Oracle) : 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 : + invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). + proof. + move=>hinvm nin_dom. + cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). + + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. + apply dexcepted_ll=>//=;rewrite-prod_ll. + cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. + rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. + cut/=->:=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. + cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + move:a. + cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. + cut->//=: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. + cut->:i_R = size_out by smt(). + cut<-:=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 /= oget_some; 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. + rnd; auto; progress. + - smt(size_ge0). + - smt(). + - by rewrite size_cat/=. + - by rewrite mem_set; left; rewrite H3. + - rewrite get_setE (H4 _ _ H12). + cut/#: !(l1, j) = (x0{2}, size bs0{2}). + move:H2; apply absurd=> //=[#] <<- ->>. + have[] h1 [] h2 h3 := H1. + by apply h2; smt(). + - move:H12; 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 {H13} 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 max_ler 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. + cut->: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. + cut->: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}. + + axiom A_ll (F <: SRO.Oracle) : 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 : + invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). + proof. + move=>hinvm nin_dom. + cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). + + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. + apply dexcepted_ll=>//=;rewrite-prod_ll. + cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. + rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. + cut/=->:=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. + cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + move:a. + cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. + cut->//=: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. + cut->:i_R = size_out by smt(). + cut<-:=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 /= oget_some; 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. + rnd; auto; progress. + - smt(size_ge0). + - smt(). + - by rewrite size_cat/=. + - by rewrite mem_set; left; rewrite H3. + - rewrite get_setE (H4 _ _ H12). + cut/#: !(l1, j) = (x0{2}, size bs0{2}). + move:H2; apply absurd=> //=[#] <<- ->>. + have[] h1 [] h2 h3 := H1. + by apply h2; smt(). + - move:H12; 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 {H13} 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 max_ler 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. + cut->: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. + cut->: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}. + + axiom A_ll (F <: SRO.Oracle) : 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 Collision. \ No newline at end of file diff --git a/sha3/proof/SecureHash.eca b/sha3/proof/SecureHash.eca new file mode 100644 index 0000000..d29ccf4 --- /dev/null +++ b/sha3/proof/SecureHash.eca @@ -0,0 +1,148 @@ +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. + +print OIndif. + +(* 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; + } +}. + + From 99fae63d44a9d385809baf03cb9277d8247781a3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 22 Aug 2019 06:53:03 +0200 Subject: [PATCH 344/394] Security proof in the random permutation model proof should be done by tomorrow (or the day after) --- sha3/proof/SHA3OSecurity.ec | 230 ++++++++++++++++++++++++++++++++++-- 1 file changed, 217 insertions(+), 13 deletions(-) diff --git a/sha3/proof/SHA3OSecurity.ec b/sha3/proof/SHA3OSecurity.ec index 2dfc615..b32aec8 100644 --- a/sha3/proof/SHA3OSecurity.ec +++ b/sha3/proof/SHA3OSecurity.ec @@ -173,6 +173,11 @@ module (OSponge : OIndif.OCONSTRUCTION) (P : OIndif.ODPRIMITIVE) = section Preimage. (* TODO : stopped here *) + 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, RO.RO }. local module FInit (F : OIndif.ODFUNCTIONALITY) : OIndif.OFUNCTIONALITY = { proc init () = {} @@ -195,16 +200,217 @@ section Preimage. } }. -local lemma leq_ideal &m - (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 }): + +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, prefix, suffix, i; + l <- None; + i <- 0; + prefix <- []; + suffix <- []; + o <@ F.get(x); + if (o <> None) { + prefix <- take k (to_list (oget o)); + i <- size_out; + } + while (i < k) { + if ((x,i) \notin Log.m) { + Log.m.[(x,i)] <$ {0,1}; + } + 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 (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) = {} +}. + +module type TOTO (F : Oracle) = { + proc main () : bool +}. + +clone import Program as PBool with + type t <- bool, + op d <- dbool +proof *. + + +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. + + +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: smt(); 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; smt(). + smt(). + smt(). + - 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. +(* TODO : reprendre ici, avec le spit des domaines *) + + +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(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} /\ + RO.RO.m{2} = empty /\ ={glob A, h, hash}); 1: auto=> />. +seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, + mi, h, hash} /\ RFList.m{1} = RO.RO.m{2}). ++ call(: ={glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter} /\ + RFList.m{1} = RO.RO.m{2}); auto. + - admit. + - admit. + - admit. +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. search to_list. + 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. -print SORO. -print SORO.RO_is_preimage_resistant. +print SORO.RO_is_preimage_resistant. +have:=rw_ideal &m. admit. qed. @@ -225,11 +431,7 @@ qed. by sp; if; auto=>/=; sim; auto. qed. -lemma Sponge_preimage_resistant &m - (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 }): +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] <= @@ -244,10 +446,12 @@ have := SHA3OIndiff (Dist_of_P1Adv(A)) &m _. call(A_ll (DFSetSize(F)) P _ Hp Hpi); auto. - proc; inline*; auto; call Hf; auto. smt(dout_ll). -by have/#:=leq_ideal &m A. +by have/#:=leq_ideal &m. qed. +(* old proof *) + declare module A : SH.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, From 89532ea84583341456421851976ba77d7d64be1b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Mon, 26 Aug 2019 11:58:20 +0200 Subject: [PATCH 345/394] . --- sha3/proof/SHA3OSecurity.ec | 103 +++++++++++++++++++++++++++++++++++- 1 file changed, 102 insertions(+), 1 deletion(-) diff --git a/sha3/proof/SHA3OSecurity.ec b/sha3/proof/SHA3OSecurity.ec index b32aec8..8edd997 100644 --- a/sha3/proof/SHA3OSecurity.ec +++ b/sha3/proof/SHA3OSecurity.ec @@ -318,6 +318,83 @@ 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} /\ 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 11?. + rewrite take_oversize 1:spec_dout 1:H4 //. + rewrite eq_sym to_listK => ->. + by have:=H3; 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 8?. + rewrite size_rcons //=; do!split; 1, 2, 4: smt(size_ge0). + rewrite (take_nth witness) 1:spec_dout 1:size_ge0//=. + rewrite - H6; congr; rewrite H4=> //=. + by apply H3=> //=. + 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 11?; do!split; ..-2 : smt(domE mem_set). + move=> l j Hin. + rewrite get_setE/=. + case: (l = x{r}) => [<<-|]. + - rewrite oget_some H8; 1:smt(); congr; congr. + by rewrite eq_sym to_listK; smt(spec2_dout). + move=> Hneq. + by rewrite -(H6 _ _ Hneq) H2; 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 13?. + rewrite get_setE/=oget_some/=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/=H8//=. +by auto; smt(size_out_gt0). +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] <= @@ -350,7 +427,31 @@ have->:Pr[SORO.Preimage(SORO_P1(A), RFList).main() @ &m : res] = 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. -(* TODO : reprendre ici, avec le spit des domaines *) +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, 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. + auto; call(eq_IRO_RFWhile); auto. +auto; call(: ={glob OSimulator, glob Counter} /\ inv BIRO.IRO.mp{1} RFList.m{2} /\ + SORO.Bounder.bounder{2} <= Counter.c{1}); auto=> />. ++ smt(). ++ proc; sp; if; auto=> />; 2: smt(); inline{1} 1; inline{2} 1; sp; auto. + if; 1, 3: auto; -1: smt(). + (* TODO : reprendre ici, avec le spit des domaines *) qed. From d57d764ce7b6f3d9cf94df0b6d43a334688d7242 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Mon, 26 Aug 2019 13:27:11 +0200 Subject: [PATCH 346/394] . --- sha3/proof/SHA3OSecurity.ec | 76 +++++++++++++++++++++++++++++++------ 1 file changed, 65 insertions(+), 11 deletions(-) diff --git a/sha3/proof/SHA3OSecurity.ec b/sha3/proof/SHA3OSecurity.ec index 8edd997..1a5efb2 100644 --- a/sha3/proof/SHA3OSecurity.ec +++ b/sha3/proof/SHA3OSecurity.ec @@ -146,6 +146,7 @@ module FSetSize (F : OFUNCTIONALITY) : OIndif.OFUNCTIONALITY = { r <- (y <> None) ? of_list (oget y) : None; return r; } + proc get = f }. module DFSetSize (F : ODFUNCTIONALITY) : OIndif.OFUNCTIONALITY = { @@ -190,16 +191,6 @@ section Preimage. proc fi = P.fi }. - local module (Dist_of_P1Adv (A : SH.AdvPreimage) : ODISTINGUISHER) (F : ODFUNCTIONALITY) (P : ODPRIMITIVE) = { - proc distinguish () = { - var hash, hash', m; - hash <$ dout; - m <@ A(DFSetSize(F),P).guess(hash); - hash' <@ DFSetSize(F).f(m); - return hash' = Some hash; - } - }. - local module OF (F : Oracle) : OIndif.ODFUNCTIONALITY = { proc f = F.get @@ -235,6 +226,26 @@ local module ExtendOutputSize (F : Oracle) : ODFUNCTIONALITY = { }. 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) = { @@ -394,6 +405,22 @@ while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ 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, 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 equiv eq_extend : + 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{1} 1; auto; rcondt{2} 1; auto. +qed. + local lemma rw_ideal_2 &m: Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), @@ -427,6 +454,32 @@ have->:Pr[SORO.Preimage(SORO_P1(A), RFList).main() @ &m : res] = 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. +have->: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(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. + while(={i, n, x1, bs} /\ 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). + by move=> /> &l &r Heq1 Heq2 Heq3 Hc Hvalid; smt(size_out_gt0). + 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: smt(); last first. + - by conseq=> />; sim; smt(). + wp=> />; 1: smt(). + rnd; auto=> />; 1: smt(). + call(: eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); last by auto; smt(). + byequiv=> //=; proc. inline{1} 1; inline{2} 2; sp. inline{1} 1; inline{2} 3; swap{2}[1..2]1; sp. @@ -434,7 +487,7 @@ 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. +inline{1} 1; sp; auto. print ExtendOutputSize. seq 2 5 : (={glob A, glob OSimulator, glob Counter, hash, m} /\ inv BIRO.IRO.mp{1} RFList.m{2} /\ SORO.Bounder.bounder{2} <= Counter.c{1}); last first. @@ -451,6 +504,7 @@ auto; call(: ={glob OSimulator, glob Counter} /\ inv BIRO.IRO.mp{1} RFList.m{2} + smt(). + proc; sp; if; auto=> />; 2: smt(); inline{1} 1; inline{2} 1; sp; auto. if; 1, 3: auto; -1: smt(). + (* TODO : reprendre ici, avec le spit des domaines *) From 43592261df4d249191834d7d16e16fcd739df9b8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Wed, 28 Aug 2019 00:55:08 +0200 Subject: [PATCH 347/394] preimage finished, second preimage to finish to debug, and collision to CC from preimage --- sha3/proof/SHA3OSecurity.ec | 2257 +++++++++++++++++------------------ 1 file changed, 1090 insertions(+), 1167 deletions(-) diff --git a/sha3/proof/SHA3OSecurity.ec b/sha3/proof/SHA3OSecurity.ec index 1a5efb2..16128b9 100644 --- a/sha3/proof/SHA3OSecurity.ec +++ b/sha3/proof/SHA3OSecurity.ec @@ -5,6 +5,8 @@ require import Common SLCommon Sponge SHA3_OIndiff. require (****) SecureORO SecureHash. (*****) import OIndif. +require import PROM. + (* module SHA3 (P : DPRIMITIVE) = { *) (* proc init() : unit = {} *) @@ -171,14 +173,25 @@ module FIgnoreSize (F : OIndif.ODFUNCTIONALITY) : OFUNCTIONALITY = { 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 GenEager as Eager with + type from <- bool list * int, + type to <- bool, + op sampleto <- fun _ => dbool +proof * by smt(dbool_ll). + section Preimage. -(* TODO : stopped here *) 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, RO.RO }. + SORO.Bounder, SORO.RO.RO, RO, FRO }. local module FInit (F : OIndif.ODFUNCTIONALITY) : OIndif.OFUNCTIONALITY = { proc init () = {} @@ -203,16 +216,13 @@ local module Log = { local module ExtendOutputSize (F : Oracle) : ODFUNCTIONALITY = { proc f (x : bool list, k : int) = { - var o, l, prefix, suffix, i; + var o, l, suffix, prefix, i; l <- None; - i <- 0; prefix <- []; suffix <- []; o <@ F.get(x); - if (o <> None) { - prefix <- take k (to_list (oget o)); - i <- size_out; - } + prefix <- take k (to_list (oget o)); + i <- size_out; while (i < k) { if ((x,i) \notin Log.m) { Log.m.[(x,i)] <$ {0,1}; @@ -296,16 +306,6 @@ local module RFWhile = { proc sample (x: bool list) = {} }. -module type TOTO (F : Oracle) = { - proc main () : bool -}. - -clone import Program as PBool with - type t <- bool, - op d <- dbool -proof *. - - local equiv rw_RF_List_While : RFList.get ~ RFWhile.get : ={arg, glob RFList} ==> ={res, glob RFWhile}. @@ -339,7 +339,7 @@ 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} /\ 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. @@ -405,23 +405,249 @@ while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ 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 : - FSome(BIRO.IRO).f ~ ExtendOutputSize(FSetSize(FSome(BIRO.IRO))).f : + 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{1} 1; auto; rcondt{2} 1; auto. +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}). ++ 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; + } +}. + +print module RO. + +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}). + * 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_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. +cut->: + 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: auto; 1: smt(); sim. + * inline{1} 1; inline{2} 1; sp; sim. + by call eq_eager_ideal; auto; smt(). + smt(). + - 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. +cut->: + 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: auto; 1: smt(); sim. + * by call eq_eager_ideal2; auto; smt(). + smt(). + - 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); 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] <= @@ -454,20 +680,26 @@ have->:Pr[SORO.Preimage(SORO_P1(A), RFList).main() @ &m : res] = 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. -have->:Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), - OSimulator(FSome(BIRO.IRO)), +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(FSome(BIRO.IRO), + 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. - while(={i, n, x1, bs} /\ 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). - by move=> /> &l &r Heq1 Heq2 Heq3 Hc Hvalid; smt(size_out_gt0). + - 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). + 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). @@ -478,8 +710,18 @@ have->:Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), - by conseq=> />; sim; smt(). wp=> />; 1: smt(). rnd; auto=> />; 1: smt(). - call(: eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); last by auto; smt(). - + call(eq_extend); last by auto; smt(). + + 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} 2; sp. inline{1} 1; inline{2} 3; swap{2}[1..2]1; sp. @@ -487,8 +729,8 @@ 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. print ExtendOutputSize. -seq 2 5 : (={glob A, glob OSimulator, glob Counter, hash, m} /\ +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. @@ -498,22 +740,52 @@ seq 2 5 : (={glob A, glob OSimulator, glob Counter, hash, m} /\ 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. - auto; call(eq_IRO_RFWhile); auto. -auto; call(: ={glob OSimulator, glob Counter} /\ inv BIRO.IRO.mp{1} RFList.m{2} /\ - SORO.Bounder.bounder{2} <= Counter.c{1}); auto=> />. -+ smt(). -+ proc; sp; if; auto=> />; 2: smt(); inline{1} 1; inline{2} 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(). - - (* TODO : reprendre ici, avec le spit des domaines *) - - + if; 1, 3: auto; -1: smt(). + sp; if; 1: auto; 1: smt(); last first. + - by conseq(:_==> ={y, glob OSimulator}); 1: smt(); sim; smt(). + 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; smt(). ++ 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 13?; split; 2: smt(divz_ge0 gt0_r size_ge0). +rewrite 2!oget_some cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. +have h:=spec2_dout result_L H5. +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_P1Adv(A))).main() @ &m : res] <= - Pr[SORO.Preimage(SORO_P1(A),RF(RO.RO)).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. @@ -529,14 +801,41 @@ seq 2 2 : ( RFList.m{1} = empty /\ Counter.c{2} = 0 /\ ={Log.m, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter} /\ - RO.RO.m{2} = empty /\ ={glob A, h, hash}); 1: auto=> />. + 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, - mi, h, hash} /\ RFList.m{1} = RO.RO.m{2}). -+ call(: ={glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter} /\ - RFList.m{1} = RO.RO.m{2}); auto. - - admit. - - admit. - - admit. + 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; 1: (auto; smt()); sim; 2: smt(). + sp; if; 1: auto; sim; -1: smt(). + sp; if{1}. + * rcondt{2} 2; auto; 1: smt(BlockSponge.parse_valid). + rnd (fun l => oget (of_list l)) to_list; auto=> />. + move=> &l &r 10?; 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/=oget_some/=dout_full/= => h; split; 2: smt(). + 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/=oget_some/= 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=> />. @@ -564,12 +863,14 @@ 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. -print SORO.RO_is_preimage_resistant. -have:=rw_ideal &m. -admit. +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 (A <: SH.AdvPreimage { Perm, Counter, Bounder }): + + + 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]. @@ -595,7 +896,7 @@ lemma Sponge_preimage_resistant &m: (sigma + 1)%r / (2%r ^ size_out). proof. move=> A_ll. -rewrite (rw_real &m A). +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. @@ -604,1166 +905,788 @@ have := SHA3OIndiff (Dist_of_P1Adv(A)) &m _. by have/#:=leq_ideal &m. qed. +end section Preimage. -(* old proof *) - - declare module A : SH.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}. - - axiom A_ll (F <: SRO.Oracle) : 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. +section SecondPreimage. - 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 : - invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). - proof. - move=>hinvm nin_dom. - cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). - + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. - apply dexcepted_ll=>//=;rewrite-prod_ll. - cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. - rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. - cut/=->:=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. - cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). - move:a. - cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. - cut->//=:fdom m \subset frng m. - + by move=> x; rewrite mem_fdom mem_frng hyp. - smt(mem_fdom mem_frng). - qed. + 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, RO, FRO }. + local module FInit (F : OIndif.ODFUNCTIONALITY) : OIndif.OFUNCTIONALITY = { + proc init () = {} + proc f = F.f + }. - 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. + local module PInit (P : ODPRIMITIVE) : OPRIMITIVE = { + proc init () = {} + proc f = P.f + proc fi = P.fi + }. - 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. - cut->:i_R = size_out by smt(). - cut<-:=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 /= oget_some; 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. - rnd; auto; progress. - - smt(size_ge0). - - smt(). - - by rewrite size_cat/=. - - by rewrite mem_set; left; rewrite H3. - - rewrite get_setE (H4 _ _ H12). - cut/#: !(l1, j) = (x0{2}, size bs0{2}). - move:H2; apply absurd=> //=[#] <<- ->>. - have[] h1 [] h2 h3 := H1. - by apply h2; smt(). - - move:H12; 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 {H13} 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 max_ler 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. +local module OF (F : Oracle) : OIndif.ODFUNCTIONALITY = { + proc f = F.get +}. - 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. - cut->//: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. - cut->//: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. +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; + 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) { + Log.m.[(x,i)] <$ {0,1}; + } + 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)). -section SecondPreimage. +local module ExtendOutput (F : RF) = { + proc init () = { + Log.m <- empty; + F.init(); + } + proc f = ExtendOutputSize(F).f + proc get = f +}. - 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}. + 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; + } + }. + - axiom A_ll (F <: SRO.Oracle) : islossless F.get => islossless A(F).guess. +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 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 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 lemma invmC' (m mi : (state, state) fmap) : - invm m mi => invm mi m. - proof. by rewrite /#. qed. +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 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 : - invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). - proof. - move=>hinvm nin_dom. - cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). - + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. - apply dexcepted_ll=>//=;rewrite-prod_ll. - cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. - rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. - cut/=->:=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. - cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). - move:a. - cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. - cut->//=:fdom m \subset frng m. - + by move=> x; rewrite mem_fdom mem_frng hyp. - smt(mem_fdom mem_frng). - qed. +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 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. +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 11?. + rewrite take_oversize 1:spec_dout 1:H4 //. + rewrite eq_sym to_listK => ->. + by have:=H3; 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 8?. + rewrite size_rcons //=; do!split; 1, 2, 4: smt(size_ge0). + rewrite (take_nth witness) 1:spec_dout 1:size_ge0//=. + rewrite - H6; congr; rewrite H4=> //=. + by apply H3=> //=. + 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 11?; do!split; ..-2 : smt(domE mem_set). + move=> l j Hin. + rewrite get_setE/=. + case: (l = x{r}) => [<<-|]. + - rewrite oget_some H8; 1:smt(); congr; congr. + by rewrite eq_sym to_listK; smt(spec2_dout). + move=> Hneq. + by rewrite -(H6 _ _ Hneq) H2; 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 13?. + rewrite get_setE/=oget_some/=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/=H8//=. +by auto; smt(size_out_gt0). +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. - cut->:i_R = size_out by smt(). - cut<-:=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 /= oget_some; 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); +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); } - (={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. - rnd; auto; progress. - - smt(size_ge0). - - smt(). - - by rewrite size_cat/=. - - by rewrite mem_set; left; rewrite H3. - - rewrite get_setE (H4 _ _ H12). - cut/#: !(l1, j) = (x0{2}, size bs0{2}). - move:H2; apply absurd=> //=[#] <<- ->>. - have[] h1 [] h2 h3 := H1. - by apply h2; smt(). - - move:H12; 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 {H13} 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 max_ler 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. + return y; + } +}. - 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. - cut->: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. - cut->: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. +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}). ++ 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. -section Collision. +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; + } +}. - 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}. +print module RO. - axiom A_ll (F <: SRO.Oracle) : islossless F.get => islossless A(F).guess. +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 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 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}). + * 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 lemma invmC' (m mi : (state, state) fmap) : - invm m mi => invm mi m. - proof. by rewrite /#. 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 lemma invmC (m mi : (state, state) fmap) : - invm m mi <=> invm mi m. - proof. by split;exact invmC'. qed. +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 useful m mi a : - invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). - proof. - move=>hinvm nin_dom. - cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). - + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. - apply dexcepted_ll=>//=;rewrite-prod_ll. - cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. - rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. - cut/=->:=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. - cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). - move:a. - cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. - cut->//=:fdom m \subset frng m. - + by move=> x; rewrite mem_fdom mem_frng hyp. - smt(mem_fdom mem_frng). - qed. +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. +cut->: + 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: smt(); sim. + * inline{1} 1; inline{2} 1; sp; sim. + by call eq_eager_ideal; auto; smt(). + smt(). + - 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. +cut->: + 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: smt(); sim. + * by call eq_eager_ideal2; auto; smt(). + smt(). + - 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. +by call(RO_LRO_D Dist); inline*; auto=> />. +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. - cut->:i_R = size_out by smt(). - cut<-:=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 /= oget_some; 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. - rnd; auto; progress. - - smt(size_ge0). - - smt(). - - by rewrite size_cat/=. - - by rewrite mem_set; left; rewrite H3. - - rewrite get_setE (H4 _ _ H12). - cut/#: !(l1, j) = (x0{2}, size bs0{2}). - move:H2; apply absurd=> //=[#] <<- ->>. - have[] h1 [] h2 h3 := H1. - by apply h2; smt(). - - move:H12; 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 {H13} 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 max_ler 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. - cut->: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. - cut->: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. +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: auto; sim; sp; sim; if; auto=> />; 1: smt(); 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; smt(). + smt(). + smt(). + - 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*; sp. + (* TODO : refaire un seq de + pour gérer mieux les 2 boucles, ou faire un lemme général *) -end section Collision. -module X (F : SRO.Oracle) = { - proc get (bl : bool list) = { - var r; - r <@ F.get(bl ++ [ false ; true ]); - return r; - } -}. + seq 1 1 : (={m', glob OSimulator, glob OFC, glob Dist_of_P2Adv} /\ + 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). + 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: smt(); last first. + - by conseq=> />; sim; smt(). + wp=> />; 1: smt(). + rnd; auto=> />; 1: smt(). + call(eq_extend); last by auto; smt(). + + 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} 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; -1: smt(). + sp; if; 1: auto; 1: smt(); last first. + - by conseq(:_==> ={y, glob OSimulator}); 1: smt(); sim; smt(). + 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; smt(). ++ 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 13?; split; 2: smt(divz_ge0 gt0_r size_ge0). +rewrite 2!oget_some cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. +have h:=spec2_dout result_L H5. +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_P1Adv(A))).main() @ &m : res] <= + Pr[SORO.SecondPreimage(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; 1: (auto; smt()); sim; 2: smt(). + sp; if; 1: auto; sim; -1: smt(). + sp; if{1}. + * rcondt{2} 2; auto; 1: smt(BlockSponge.parse_valid). + rnd (fun l => oget (of_list l)) to_list; auto=> />. + move=> &l &r 10?; 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/=oget_some/=dout_full/= => h; split; 2: smt(). + 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/=oget_some/= 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. search to_list. + 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. -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. +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. - 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}. - axiom A_ll (F <: SRO.Oracle) : 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). + local lemma rw_real &m : + Pr[SecondPreimage(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. - 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. + 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(). + - by proc; inline*; sp; if; auto; 2:sim=> />; 1: 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[SecondPreimage(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 SecondSecondPreimage. + -end section Collision. \ No newline at end of file From 261e6414eacfb4dad7dc8855d4fb02bd255755d6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Wed, 28 Aug 2019 15:24:04 +0200 Subject: [PATCH 348/394] P1, P2 & coll resistance proven in the random permutation model. --- sha3/proof/SHA3OSecurity.ec | 1117 ++++++++++++++++++++++++++++++++--- 1 file changed, 1032 insertions(+), 85 deletions(-) diff --git a/sha3/proof/SHA3OSecurity.ec b/sha3/proof/SHA3OSecurity.ec index 16128b9..1b68112 100644 --- a/sha3/proof/SHA3OSecurity.ec +++ b/sha3/proof/SHA3OSecurity.ec @@ -916,7 +916,7 @@ section SecondPreimage. 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 }. + SORO.Bounder, SORO.RO.RO, SORO.RO.FRO, RO, FRO }. local module FInit (F : OIndif.ODFUNCTIONALITY) : OIndif.OFUNCTIONALITY = { proc init () = {} @@ -1410,7 +1410,54 @@ by call(RO_LRO_D Dist); 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=> /> 15?. + rewrite oget_some take_oversize 1:/# /=. + have:=spec2_dout _ H5. + 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 => @@ -1465,34 +1512,27 @@ have->:Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), 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*; sp. - (* TODO : refaire un seq de + pour gérer mieux les 2 boucles, ou faire un lemme général *) - - - seq 1 1 : (={m', glob OSimulator, glob OFC, glob Dist_of_P2Adv} /\ - 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). - 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} /\ ++ 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. + + proc; sp; if; auto. inline{1} 1; inline{2} 1; sp; if; 1, 3: auto. if; 1, 3: auto; sp. if; 1: auto; 1: smt(); last first. - by conseq=> />; sim; smt(). wp=> />; 1: smt(). - rnd; auto=> />; 1: smt(). - call(eq_extend); last by auto; smt(). + rnd; auto. + call(eq_extend); by auto; smt(). + 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. @@ -1505,30 +1545,44 @@ have->:Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), - by sp; if; auto; 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} /\ +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. -+ 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). ++ 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 inline*; auto; smt(mem_empty). ++ by smt(mem_empty). + proc; sp; if; auto=> />; 1: smt(). inline{1} 1; inline{2} 1; sp; auto. if; 1, 3: auto; -1: smt(). @@ -1564,28 +1618,17 @@ have-> := some_oget _ h. by rewrite eq_sym -to_listK; congr. qed. -local lemma rw_ideal &m: +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_P1Adv(A))).main() @ &m : res] <= - Pr[SORO.SecondPreimage(SORO_P1(A),RF(SORO.RO.RO)).main() @ &m : res]. + ODRestr(Dist_of_P2Adv(A))).main() @ &m : res] <= + Pr[SORO.SecondPreimage(SORO_P2(A),RF(SORO.RO.RO)).main(mess) @ &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=> />. +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, h, hash} /\ RFList.m{1} = SORO.RO.RO.m{2}). + 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. @@ -1618,10 +1661,33 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, rewrite supp_dmap dout_full/= =>/> a. by rewrite get_setE/=oget_some/= dout_full/=; congr; rewrite of_listK oget_some. by auto; smt(dout_ll). -sp; if; 1, 3: auto; sp; wp 1 2. +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. search to_list. + 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}. -+ wp=> />. - rnd (fun x => oget (of_list x)) to_list; auto=> />. +- 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. search to_list. by have/= ->:= (to_listK ret (to_list ret)). @@ -1636,57 +1702,938 @@ if{1}. 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 rewrite get_setE/=; smt(). by auto=> />; smt(dout_ll). qed. -local lemma leq_ideal &m : +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_P1Adv(A))).main() @ &m : res] <= (sigma + 1)%r / 2%r ^ size_out. + ODRestr(Dist_of_P2Adv(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)). +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 : - Pr[SecondPreimage(A, OSponge, PSome(Perm)).main() @ &m : res] = + 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_P1Adv(A))).main() @ &m : res]. + ODRestr(Dist_of_P2Adv(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})=> //=. + 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=> />; 1: smt(). - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). - proc; inline*; sp; if; auto; sp=> />. by conseq(:_==> ={z0, glob Perm})=> />; sim. - by auto. - by sp; if; auto=>/=; sim; auto. + 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. -lemma Sponge_preimage_resistant &m: +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() @ &m : res] <= + 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. -rewrite (rw_real &m). -have := SHA3OIndiff (Dist_of_P1Adv(A)) &m _. -+ move=> F P Hp Hpi Hf; proc; inline*; sp; auto; call Hf; auto. +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. - smt(dout_ll). + 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; + 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) { + Log.m.[(x,i)] <$ {0,1}; + } + 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 11?. + rewrite take_oversize 1:spec_dout 1:H4 //. + rewrite eq_sym to_listK => ->. + by have:=H3; 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 8?. + rewrite size_rcons //=; do!split; 1, 2, 4: smt(size_ge0). + rewrite (take_nth witness) 1:spec_dout 1:size_ge0//=. + rewrite - H6; congr; rewrite H4=> //=. + by apply H3=> //=. + 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 11?; do!split; ..-2 : smt(domE mem_set). + move=> l j Hin. + rewrite get_setE/=. + case: (l = x{r}) => [<<-|]. + - rewrite oget_some H8; 1:smt(); congr; congr. + by rewrite eq_sym to_listK; smt(spec2_dout). + move=> Hneq. + by rewrite -(H6 _ _ Hneq) H2; 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 13?. + rewrite get_setE/=oget_some/=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/=H8//=. +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}). ++ 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; + } +}. + +print module RO. + +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}). + * 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. +cut->: + 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: auto; 1: smt(); sim. + * inline{1} 1; inline{2} 1; sp; sim. + by call eq_eager_ideal; auto; smt(). + smt(). + - 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. +cut->: + 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: auto; 1: smt(); sim. + * by call eq_eager_ideal2; auto; smt(). + smt(). + - 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. +by call(RO_LRO_D Dist); 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=> /> 15?. + rewrite oget_some take_oversize 1:/# /=. + have:=spec2_dout _ H5. + 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: auto; sim; sp; sim; if; auto=> />; 1: smt(); 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; smt(). + smt(). + smt(). + - 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: auto; 1: smt(); last first. + - by conseq=> />; sim; smt(). + wp=> />; 1: smt(). + rnd; auto. + call(eq_extend); by auto; smt(). + + 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; -1: smt(). + sp; if; 1: auto; 1: smt(); last first. + - by conseq(:_==> ={y, glob OSimulator}); 1: smt(); sim; smt(). + 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; smt(). ++ 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 13?; split; 2: smt(divz_ge0 gt0_r size_ge0). +rewrite 2!oget_some cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. +have h:=spec2_dout result_L H5. +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; 1: (auto; smt()); sim; 2: smt(). + sp; if; 1: auto; sim; -1: smt(). + sp; if{1}. + * rcondt{2} 2; auto; 1: smt(BlockSponge.parse_valid). + rnd (fun l => oget (of_list l)) to_list; auto=> />. + move=> &l &r 10?; 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/=oget_some/=dout_full/= => h; split; 2: smt(). + 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/=oget_some/= 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. search to_list. + 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. search to_list. + 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=> />; 1: smt(). + - by proc; inline*; sp; if; auto; 2:sim=> />; 1: 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 SecondSecondPreimage. +end section Collision. From a2d22903f5e6acff5cd8b4bd8879fbfdf0558050 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Thu, 29 Aug 2019 10:07:15 +0200 Subject: [PATCH 349/394] CI --- sha3/config/tests.config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/config/tests.config b/sha3/config/tests.config index 6382a1d..5e7de4f 100644 --- a/sha3/config/tests.config +++ b/sha3/config/tests.config @@ -1,6 +1,6 @@ [default] bin = easycrypt -args = -timeout 30 -max-provers 2 -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm +args = -timeout 30 -p Z3 -p Alt-Ergo -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm [test-sha3] okdirs = !proof From 965c5fef8d162c955e92c3ff32dc602529e3b2fa Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 29 Aug 2019 10:12:46 +0200 Subject: [PATCH 350/394] Fix end of section --- sha3/proof/SHA3Security.ec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/proof/SHA3Security.ec b/sha3/proof/SHA3Security.ec index 26e2598..97a7705 100644 --- a/sha3/proof/SHA3Security.ec +++ b/sha3/proof/SHA3Security.ec @@ -1282,4 +1282,4 @@ section SHA3_Collision. qed. -end section Collision. +end section SHA3_Collision. From 27656980d3900bfbe669436ae95fa5b9737ac528 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 29 Aug 2019 11:35:28 +0200 Subject: [PATCH 351/394] fix SHA3Indiff.ec --- sha3/proof/SHA3Indiff.ec | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/sha3/proof/SHA3Indiff.ec b/sha3/proof/SHA3Indiff.ec index 56fad44..d04da54 100644 --- a/sha3/proof/SHA3Indiff.ec +++ b/sha3/proof/SHA3Indiff.ec @@ -281,12 +281,7 @@ rewrite powS 1:addz_ge0 1:ge0_r 1:ge0_c -pow_add 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). - rewrite (fromintM 2) StdRing.RField.invfM StdRing.RField.mulrA - -!StdRing.RField.mulrA. - congr. - rewrite (fromintM (2 ^ r)) StdRing.RField.invfM StdRing.RField.mulrA - -!StdRing.RField.mulrA. - congr; by rewrite StdRing.RField.mul1r. + by rewrite (fromintM 2); smt(). rewrite/=. have -> : (4 * limit ^ 2)%r / (2 ^ c)%r = From a0caab01afdeadf593f8496e76e596b0d2a67bf7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 29 Aug 2019 11:38:08 +0200 Subject: [PATCH 352/394] rm SecureIRO.eca --- sha3/proof/SecureIRO.eca | 497 --------------------------------------- 1 file changed, 497 deletions(-) delete mode 100644 sha3/proof/SecureIRO.eca diff --git a/sha3/proof/SecureIRO.eca b/sha3/proof/SecureIRO.eca deleted file mode 100644 index 9a65e18..0000000 --- a/sha3/proof/SecureIRO.eca +++ /dev/null @@ -1,497 +0,0 @@ -require import AllCore Int Real Distr List SmtMap FSet FelTactic DList. - -require (****) IRO. - - -(* Define the random function *) -type from. -type to. - -op dto : to distr. - -clone import IRO as URO with - type from <- from, - type to <- to, - op dto <- dto - proof *. - -axiom dto_ll : is_lossless dto. -axiom dto_funi : is_funiform dto. - -(* Define module types for the preimage, second preimage and collision games *) - -module type OIRO = { - proc f (x : from, n : int) : to list -}. - -module type Adversary (F : OIRO) = { - proc guess_preimage (h : to list) : from - proc guess_second_preimage (m1 : from, s : int) : from - proc guess_collision (s : int) : from * from -}. - -(* Define the bound on the counter cost and the operator updating the cost *) - -module Cost = { - var counter : int -}. - -op update_cost : int -> from -> int -> int. -axiom update_cost c m i : c <= update_cost c m i. -axiom update_costS c m i : - update_cost c m i <= update_cost c m (i+1) <= update_cost c m i + 1. -lemma update_cost_leq c m (i : int) j : - i <= j => update_cost c m i <= update_cost c m j. -proof. -pose k := j - i. -cut -> : j = k + i by smt(). -rewrite StdOrder.IntOrder.ler_addr. -by elim:k=>//= {j} k H0k; rewrite addzAC; smt(update_costS). -qed. - -op t : int. -axiom t_gt0 : 0 < t. - -op map_cost (m : ('a, 'b) fmap) : int. -axiom map_cost0 (m : ('a, 'b) fmap) : m = empty => 0 = map_cost m. -axiom map_cost_update_cost (map : ('a * 'b, 'c) fmap) c m i x j y : - map_cost map <= update_cost c m i => - map_cost map.[(x,j) <- y] <= update_cost c m (i+1). - -module Count (F : OIRO) = { - proc init() = { - Cost.counter <- 0; - } - proc f (m : from, n : int) = { - var r : to list; - r <- []; - if (0 <= n /\ update_cost Cost.counter m n < t) { - r <- F.f(m,n); - Cost.counter <- update_cost Cost.counter m n; - } - return r; - } -}. - -(***** Useful Material ********************************************************) -op rngm (m : ('a * int, 'b) fmap) (l : 'b list) = - exists (x : 'a), forall i, 0 <= i < size l => m.[(x,i)] = Some (nth witness l i). - -lemma not_rngm (m : ('a * int, 'b) fmap) (l : 'b list) : - ! rngm m l <=> forall x, exists i, 0 <= i < size l /\ m.[(x,i)] <> Some (nth witness l i). - -op set_at (l : 'a list) (i : int) (a : 'a) = - (take i l) ++ [a] ++ (drop (i+1) l). - -lemma nth_set_at_eq (a b : 'a) (l : 'a list) j : - 0 <= j < size l => nth a (set_at l j b) j = b. -proof. -move=>[#] hj0 hjn. -rewrite/set_at nth_cat size_cat/= size_take // hjn /=. -have->/=: j < j + 1 by smt(). -by rewrite nth_cat size_take // hjn /=. -qed. - -lemma nth_set_at_lt (a b : 'a) (l : 'a list) i j : - 0 <= j < i < size l => nth a (set_at l i b) j = nth a l j. -proof. -move=>[#] hj0 hji hin. -rewrite/set_at nth_cat size_cat/= size_take // 1:/# hin/=. -have->/=: j < i + 1 by smt(). -by rewrite nth_cat size_take // 1:/# hin /= hji /= nth_take /#. -qed. - -lemma nth_set_at_gt (a b : 'a) (l : 'a list) i j : - 0 <= i < j < size l => nth a (set_at l i b) j = nth a l j. -proof. -move=>[#] hi0 hji hjn. -have hin : i < size l by smt(). -rewrite/set_at nth_cat size_cat/= size_take // hin /=. -have->/=: ! j < i + 1 by smt(). -by rewrite nth_drop; smt(). -qed. - -lemma size_set_at (l : 'a list) i a : - 0 <= i < size l => size (set_at l i a) = size l. -proof. -move=> [#] hi0 hin; rewrite /set_at 2!size_cat /=. -by rewrite size_take // hin /= size_drop /#. -qed. - -(************************** Preimage Game *************************************) -module PreImage (A : Adversary, F : IRO) = { - proc game (h : to list) : bool = { - var m, h2, b; - b <- false; - Count(F).init(); - F.init(); - m <@ A(Count(F)).guess_preimage(h); - if (update_cost Cost.counter m (size h) < t) { - h2 <- F.f(m, size h); - b <- h = h2; - Cost.counter <- update_cost Cost.counter m (size h); - } - return b; - } -}. - -(************************** Second Preimage Game ******************************) -module SecondPreImage (A : Adversary, F : IRO) = { - proc game (m : from, s : int) : bool = { - var m2, h1, h2, b; - b <- false; - Count(F).init(); - F.init(); - m2 <@ A(Count(F)).guess_second_preimage(m,s); - if (0 <= s /\ update_cost Cost.counter m s < t) { - h1 <- F.f(m,s); - Cost.counter <- update_cost Cost.counter m s; - if (update_cost Cost.counter m2 s < t) { - h2 <- F.f(m2,s); - b <- h1 = h2; - Cost.counter <- update_cost Cost.counter m2 s; - } - } - return b; - } -}. - -(************************** Collision Game ************************************) -module Collision (A : Adversary, F : IRO) = { - proc game (s : int) : bool = { - var m1, m2, h1, h2, b; - b <- false; - Count(F).init(); - F.init(); - (m1,m2) <@ A(Count(F)).guess_collision(s); - if (0 <= s /\ update_cost Cost.counter m1 s < t) { - h1 <- F.f(m1,s); - Cost.counter <- update_cost Cost.counter m1 s; - if (update_cost Cost.counter m2 s < t) { - h2 <- F.f(m2,s); - b <- h1 = h2; - Cost.counter <- update_cost Cost.counter m2 s; - } - } - return b; - } -}. - - -(*********************************** Proofs ***********************************) -section Proof. - - declare module A : Adversary{IRO, Cost}. - - - (***** Useful Material ******************************************************) - local lemma card_domS (m : ('a, 'b) fmap) x y : - card (fdom m) <= card (fdom m.[x <- y]) <= card (fdom m) + 1. - proof. - rewrite fdom_set fcardU fcard1 fsetI1. - case: (x \in fdom m) => //=. - + by rewrite fcard1 /#. - by rewrite fcards0 /#. - qed. - - (****** Preimage Resistance ********) - local module FEL (A : Adversary, F : IRO) = { - proc main (hash : to list) : from = { - var m; - Count(F).init(); - m <@ A(Count(F)).guess_preimage(hash); - return m; - } - }. - - local module PreImage2 (A : Adversary, F : IRO) = { - proc game (h : to list) : bool = { - var m, h2, b; - b <- false; - F.init(); - m <@ FEL(A,F).main(h); - if (update_cost Cost.counter m (size h) < t) { - h2 <- F.f(m, size h); - b <- h = h2; - Cost.counter <- update_cost Cost.counter m (size h); - } - return b; - } - }. - - - local module DListIRO : IRO = { - proc init() = { - IRO.mp <- empty; - } - proc f (m : from, n : int) = { - var bs, i; - bs <- []; - if (valid m) { - bs <$ dlist dto n; - i <- 0; - while (i < n) { - if ((m,i) \notin IRO.mp) { - IRO.mp.[(m,i)] <- nth witness bs i; - } else { - bs <- set_at bs i (oget IRO.mp.[(m,i)]); - } - i <- i + 1; - } - } - return bs; - } - }. - - local clone DList.Program as MyPr with - type t <- to, - op d <- dto - proof *. - - local equiv equiv_dlist_IRO : - DListIRO.f ~ IRO.f : ={arg, glob IRO} /\ 0 <= arg{2}.`2 ==> ={res, glob IRO}. - proof. - proc; sp; if; 1,3:auto; inline*. - transitivity{2} { - i <- 0; - bs <- []; - while (i < n) { - b <$ dto; - bs <- rcons bs b; - i <- i + 1; - } - i <- 0; - while (i < n) { - if ((x, i) \notin IRO.mp) { - IRO.mp.[(x,i)] <- nth witness bs i; - } else { - bs <- set_at bs i (oget IRO.mp.[(x,i)]); - } - i <- i + 1; - } - } - (={bs, n, glob IRO} /\ bs{1} = [] /\ m{1} = x{2} ==> ={bs, IRO.mp}) - (={bs, n, x, glob IRO} /\ bs{1} = [] /\ i{2} = 0 /\ 0 <= n{1} ==> ={bs, IRO.mp})=>//=. - + smt(). - + sim. - conseq(:_==> ={bs})=> //=. - transitivity{1} { - bs <@ MyPr.Sample.sample(n); - } - (={n} ==> ={bs}) (={n} ==> ={bs})=> //=. - - smt(). - - by inline*; sim. - transitivity{2} { - bs <@ MyPr.LoopSnoc.sample(n); - } - (={n} ==> ={bs}) (={n} ==> ={bs})=> //=. - - smt(). - - by call MyPr.Sample_LoopSnoc_eq; auto. - inline*; sim. - by while( (i0, n1, l){1} = (i, n, bs){2}); auto; smt(cats1). - transitivity{2} { - i <- 0; - while (i < n) { - b <$ dto; - bs <- rcons bs b; - if ((x, i) \notin IRO.mp) { - IRO.mp.[(x,i)] <- nth witness bs i; - } else { - bs <- set_at bs i (oget IRO.mp.[(x,i)]); - } - i <- i + 1; - } - } - (={bs, n, x, glob IRO} /\ bs{1} = [] /\ 0 <= n{1} ==> ={bs, IRO.mp}) - (={bs, n, x, glob IRO} /\ bs{1} = [] /\ i{2} = 0 ==> ={bs, IRO.mp})=>//=. - + smt(). - + seq 3 2 : (={n, x} /\ size bs{1} = n{1} /\ size bs{2} = size bs{1} /\ - (forall y j, (y,j) \in IRO.mp{1} => (y,j) \in IRO.mp{2}) /\ - (forall y j, (y,j) \in IRO.mp{1} => - IRO.mp{1}.[(y,j)] = IRO.mp{2}.[(y,j)]) /\ - (forall y j, (y,j) \in IRO.mp{2} => - (y,j) \in IRO.mp{1} \/ (y = x{1} /\ 0 <= j < n{1})) /\ - (forall j, 0 <= j < n{1} => (x{1},j) \in IRO.mp{2} /\ - nth witness bs{2} j = oget IRO.mp{2}.[(x{1},j)]) /\ - (forall j, 0 <= j < n{1} => (x{1},j) \notin IRO.mp{1} => - nth witness bs{2} j = nth witness bs{1} j)); last first. - - sp; while{1}(={n, x} /\ size bs{1} = n{1} /\ 0 <= i{1} <= n{1} /\ - size bs{2} = size bs{1} /\ - (forall x j, (x,j) \in IRO.mp{1} => (x,j) \in IRO.mp{2}) /\ - (forall y j, (y,j) \in IRO.mp{1} => - IRO.mp{1}.[(y,j)] = IRO.mp{2}.[(y,j)]) /\ - (forall y j, (y,j) \in IRO.mp{2} => - (y,j) \in IRO.mp{1} \/ (y = x{1} /\ i{1} <= j < n{1})) /\ - (forall j, 0 <= j < n{1} => (x{1},j) \in IRO.mp{2} /\ - nth witness bs{2} j = oget IRO.mp{2}.[(x{1},j)]) /\ - (forall j, 0 <= j < i{1} => (x{1},j) \in IRO.mp{1} /\ - nth witness bs{1} j = oget IRO.mp{1}.[(x{1},j)]) /\ - (forall j, 0 <= j < n{1} => (x{1},j) \notin IRO.mp{1} => - nth witness bs{2} j = nth witness bs{1} j)) (n{1} - i{1}). - + move=> &1 c; if; auto; 1:smt(mem_set get_setE); - smt(nth_set_at_eq nth_set_at_lt nth_set_at_gt size_set_at). - auto=> &1 &2 [#] 3->> <<- hs2 4?; do !split=> //=. - + exact size_ge0. - + smt(). - move=> [#] map1 bs1 i1; split; 1: smt(). - + move=> hnis [#] hs hi0 his /= 6?. - have ->>/=: map1 = IRO.mp{2}. - - apply fmap_eqP. - move=> [] y j. - case: ((y,j) \in map1)=> hin; 1:smt(). - have := hin; rewrite domE /= => ->. - have := H7 y j; rewrite hin /=. - have -> /= : ! i1 <= j < size bs{1} by smt(). - by rewrite domE /= => ->. - apply/(eq_from_nth witness)=> //=. - - by rewrite hs hs2. - move=> j [] hj0 hjs. - have [] h -> {h} := H9 j _; 1: smt(). - by have [] h -> {h} := H8 j _; 1: smt(). - while(={i, n, x} /\ 0 <= i{1} <= n{1} /\ - size bs{1} = i{1} /\ size bs{1} = size bs{2} /\ - (forall y j, (y,j) \in IRO.mp{1} => (y,j) \in IRO.mp{2}) /\ - (forall y j, (y,j) \in IRO.mp{1} => - IRO.mp{1}.[(y,j)] = IRO.mp{2}.[(y,j)]) /\ - (forall y j, (y,j) \in IRO.mp{2} => - (y,j) \in IRO.mp{1} \/ (y = x{1} /\ 0 <= j < i{1})) /\ - (forall j, 0 <= j < i{1} => (x{1},j) \in IRO.mp{2} /\ - nth witness bs{2} j = oget IRO.mp{2}.[(x{1},j)]) /\ - (forall j, 0 <= j < i{1} => (x{1},j) \notin IRO.mp{1} => - nth witness bs{2} j = nth witness bs{1} j)). - wp; rnd; auto. - move=> &1 &2 [#] 3->> hi0 hin <<- hs 4? {hin} his h {h} b hbin //=. - rewrite hbin //; case: ((x{2}, size bs{1}) \in IRO.mp{2})=> hin//=. - + do !split. - - smt(size_ge0). - - smt(). - - exact size_rcons. - - smt(size_set_at size_rcons). - - smt(). - - smt(). - - smt(). - - move=> j [] hj0 hjs; split; 1:smt(). - case: (j < size bs{1})=> hjs1. - + rewrite nth_set_at_lt 1:size_rcons 1:/#. - have//=[]_ <-:= H2 j _; 1: by done. - by rewrite nth_rcons -hs hjs1 /=. - have->>: j = size bs{1} by smt(). - by rewrite nth_set_at_eq 1:size_rcons 1:-hs 1:/#. - - move=> j [] hj0 hjs hnin. - have hjs1: (j < size bs{1}) by smt(). - rewrite nth_set_at_lt 1:size_rcons 1:/#. - rewrite !nth_rcons -hs hjs1 /=. - by apply H3=> //=. - do !split. - + smt(size_ge0). - + smt(). - + exact size_rcons. - + smt(size_rcons). - + smt(mem_set). - + smt(get_setE). - + smt(mem_set). - + move=>j [] hj0 hjs1; split. - - rewrite mem_set; smt(). - by rewrite nth_rcons get_setE /= nth_rcons; smt(). - + smt(nth_rcons). - by auto; smt(). - while(={i, n, IRO.mp, x, bs} /\ i{1} = size bs{1}); 2:auto. - + sp; if{2}. - - rcondt{1} 3; 1: auto; wp; rnd; auto; progress. - + smt(size_rcons nth_rcons). - + smt(get_setE). - + smt(size_rcons). - rcondf{1} 3; auto; progress. - + exact dto_ll. - apply (eq_from_nth witness). - + rewrite size_set_at //= 1: size_rcons 1:size_ge0 1:/#. - by rewrite 2!size_rcons. - move=> i [] hi0; rewrite size_set_at 1:size_ge0 size_rcons//= 1:/# => his. - case: (i < size bs{2})=> his2. - + by rewrite nth_set_at_lt 1:size_rcons 1:/# 2!nth_rcons his2/=. - have->>: i = size bs{2} by smt(). - rewrite nth_set_at_eq 1:size_rcons 1:size_ge0 1:/#. - by rewrite nth_rcons /=. - by rewrite size_set_at size_rcons 1:size_ge0 1:/#. - qed. - - - lemma PreImage_Resistance &m (ha : to list) : - Pr [ PreImage(A, IRO).game(ha) @ &m : res ] - <= mu1 (dlist dto (size ha)) ha. - proof. - have->: Pr [ PreImage (A, IRO).game(ha) @ &m : res ] = - Pr [ PreImage2(A, IRO).game(ha) @ &m : res ]. - + by byequiv=>//=; proc; inline*; sp; sim. - have->: Pr [ PreImage2(A, IRO).game(ha) @ &m : res ] = - Pr [ PreImage2(A, DListIRO).game(ha) @ &m : res ]. - + byequiv=> //=; proc; inline{1} 2; inline{2} 2; sp. - seq 1 1 : (={b, m, h, glob IRO, glob Cost}). - + inline*; wp; call(: ={glob IRO, glob Cost}); auto. - by proc; sp; if; auto; symmetry; call equiv_dlist_IRO. - by if; auto; symmetry; call equiv_dlist_IRO; auto; smt(size_ge0). - byphoare(: arg = ha ==> _)=> //=; proc; inline 2; swap 1 2. - sp; seq 1 : (rngm IRO.mp ha) (mu1 (dlist dto (size ha)) ha) 1%r 1%r - (mu1 (dlist dto (size ha)) ha) - (map_cost IRO.mp <= Cost.counter <= t /\ ha = h)=>//=. - + inline*; sp; auto. - conseq(: _ ==> map_cost IRO.mp <= Cost.counter <= t); 1: auto. - call(: map_cost IRO.mp <= Cost.counter <= t)=> //=; auto. - + proc; inline*; sp; if; auto; sp; if; auto. - + conseq(:_==> map_cost IRO.mp <= update_cost Cost.counter m n0 <= t); 1: auto. - while(map_cost IRO.mp <= update_cost Cost.counter m i <= t - /\ update_cost Cost.counter m n0 < t /\ 0 <= i <= n0). - + auto; smt(map_cost_update_cost card_domS update_costS update_cost_leq). - by auto; smt(update_cost update_cost_leq). - smt(update_cost). - + smt(fdom0 fcards0 t_gt0 map_cost0). - + call(: true ==> rngm IRO.mp ha)=> //; bypr=> /> {&m} &m. - fel 1 Cost.counter (fun _, mu1 (dlist dto (size ha)) ha) t (rngm IRO.mp ha) - [Count(IRO).f: (map_cost IRO.mp <= Cost.counter < t)] - (map_cost IRO.mp <= Cost.counter <= t) - =>//; admit. - + sp; if; last first. - - by hoare; auto; smt(mu_bounded size_ge0). - inline*; wp; sp; if; last first. - - by hoare; auto; smt(mu_bounded size_ge0). - case: (n = size ha); last first. - - hoare; conseq(:_==> size bs = n); progress. - by while(size bs = n /\ 0 <= i <= n); auto; smt(size_set_at). print rngm. - seq 1 : (bs = ha) (mu1 (dlist dto (size ha)) ha) 1%r _ 0%r - (size ha = n /\ ! rngm IRO.mp ha)=>//=. - + by auto. - + by rnd; auto. - hoare; auto; while(h <> bs /\ !rngm IRO.mp ha /\ 0 <= i /\ n = size ha /\ - (forall j, 0 <= j < i => IRO.mp.[(m0,j)] = Some (nth witness bs j))); auto; progress. - + rewrite/rngm negb_exists/= => a; rewrite negb_forall /=. - case: (a = m0{hr}) => //=. - + move=> <<-. - have:=H0; rewrite negb_exists /= => /(_ a); rewrite negb_forall /= => [][] b. - case: (0 <= b < size ha) =>//=. - - exists i{hr}=> /=; rewrite H1 H2 /=. - qed. - - (****** Second Preimage Resistance ********) - lemma SecondPreImage_Resistance &m (m : from) (output_size : int) : - 0 < output_size => - Pr [ SecondPreImage(A, IRO).game(m, output_size) @ &m : res ] - <= mu1 dto witness<:to>. - proof. - admit. - qed. - - - (****** Collision Resistance ********) - lemma Collision_Resistance &m (output_size : int) : - 0 < output_size => - Pr [ Collision(A, IRO).game(output_size) @ &m : res ] <= mu1 dto witness<:to>. - proof. - admit. - qed. - -end section Proof. - - - - From 0f34c295343246ed6722ef37dca4a83433df505f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 29 Aug 2019 11:55:36 +0200 Subject: [PATCH 353/394] remove print/search in SHA3_OSecurity.ec --- sha3/proof/SHA3OSecurity.ec | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/sha3/proof/SHA3OSecurity.ec b/sha3/proof/SHA3OSecurity.ec index 1b68112..c2437eb 100644 --- a/sha3/proof/SHA3OSecurity.ec +++ b/sha3/proof/SHA3OSecurity.ec @@ -50,10 +50,10 @@ cut->:inv (2%r ^ size_out) = mu1 (dlist dbool size_out) (to_list x). rewrite spec_dout/=. pose p:= StdBigop.Bigreal.BRM.big _ _ _. cut->: p = StdBigop.Bigreal.BRM.big predT (fun _ => inv 2%r) (to_list x). - - rewrite /p =>{p}. print StdBigop.Bigreal.BRM. + - 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}. search 0 Int.(+) 1 (<=). + rewrite StdBigop.Bigreal.BRM.big_const count_predT spec_dout=> {p}. have:=size_out_gt0; move/ltzW. move:size_out;apply intind=> //=. - by rewrite powr0 iter0 //= fromint1. @@ -492,7 +492,6 @@ local module Fill_In (F : RO) = { } }. -print module RO. local equiv eq_eager_ideal : BIRO.IRO.f ~ Fill_In(LRO).f : @@ -841,7 +840,7 @@ if{1}. + wp=> />. rnd (fun x => oget (of_list x)) to_list; auto=> />. move=> &l c Hc Hnin; split. - - move=> ret Hret. search to_list. + - move=> ret Hret. by have/= ->:= (to_listK ret (to_list ret)). move=> h{h}; split. - move=> ret Hret; rewrite -dout_equal_dlist. @@ -1206,7 +1205,6 @@ local module Fill_In (F : RO) = { } }. -print module RO. local equiv eq_eager_ideal : BIRO.IRO.f ~ Fill_In(LRO).f : @@ -1669,7 +1667,7 @@ seq 4 4 : (={SORO.Bounder.bounder, x0, m1, m2, hash1, y0} /\ y0{1} = None /\ - 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. search to_list. + - move=> ret Hret. by have/= ->:= (to_listK ret (to_list ret)). move=> h{h}; split. - move=> ret Hret; rewrite -dout_equal_dlist. @@ -1689,7 +1687,7 @@ 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. search to_list. + - move=> ret Hret. by have/= ->:= (to_listK ret (to_list ret)). move=> h{h}; split. - move=> ret Hret; rewrite -dout_equal_dlist. @@ -2086,7 +2084,6 @@ local module Fill_In (F : RO) = { } }. -print module RO. local equiv eq_eager_ideal : BIRO.IRO.f ~ Fill_In(LRO).f : @@ -2541,7 +2538,7 @@ seq 4 4 : (={SORO.Bounder.bounder, x0, m1, m2, hash1, y0} /\ y0{1} = None /\ - 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. search to_list. + - move=> ret Hret. by have/= ->:= (to_listK ret (to_list ret)). move=> h{h}; split. - move=> ret Hret; rewrite -dout_equal_dlist. @@ -2561,7 +2558,7 @@ 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. search to_list. + - move=> ret Hret. by have/= ->:= (to_listK ret (to_list ret)). move=> h{h}; split. - move=> ret Hret; rewrite -dout_equal_dlist. From c5c30c2ab0945967bb1389c46d44972954ad9aae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Fri, 30 Aug 2019 13:31:30 +0200 Subject: [PATCH 354/394] update lossless axioms (check) verify no admit (check) --- sha3/proof/IndifRO_is_secure.ec | 12 ++++++------ sha3/proof/SHA3Indiff.ec | 4 ++-- sha3/proof/SHA3Security.ec | 16 ++++++++-------- 3 files changed, 16 insertions(+), 16 deletions(-) diff --git a/sha3/proof/IndifRO_is_secure.ec b/sha3/proof/IndifRO_is_secure.ec index dc90d5e..3b1de8c 100644 --- a/sha3/proof/IndifRO_is_secure.ec +++ b/sha3/proof/IndifRO_is_secure.ec @@ -93,7 +93,7 @@ section Collision. declare module A : AdvCollision{Bounder, SRO.RO.RO, SRO.RO.FRO}. - axiom D_ll (F <: Oracle) : + axiom D_ll (F <: Oracle { A }) : islossless F.get => islossless A(F).guess. lemma coll_resistant_if_indifferentiable @@ -117,7 +117,7 @@ section Collision. 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. + call{1}(S_ll RO _); auto. by proc; auto; smt(sampleto_ll). exact(RO_is_collision_resistant A &m). qed. @@ -138,7 +138,7 @@ section Preimage. declare module A : AdvPreimage{Bounder, SRO.RO.RO, SRO.RO.FRO, DPre}. - axiom D_ll (F <: Oracle) : + axiom D_ll (F <: Oracle{A}) : islossless F.get => islossless A(F).guess. lemma preimage_resistant_if_indifferentiable @@ -163,7 +163,7 @@ section Preimage. 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. + call{1} (S_ll RO _); auto. by proc; auto; smt(sampleto_ll). exact(RO_is_preimage_resistant A &m hash). qed. @@ -184,7 +184,7 @@ section SecondPreimage. declare module A : AdvSecondPreimage{Bounder, SRO.RO.RO, SRO.RO.FRO, D2Pre}. - axiom D_ll (F <: Oracle) : + axiom D_ll (F <: Oracle{A}) : islossless F.get => islossless A(F).guess. lemma second_preimage_resistant_if_indifferentiable @@ -209,7 +209,7 @@ section SecondPreimage. 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. + call{1} (S_ll RO _); auto. by proc; auto; smt(sampleto_ll). exact(RO_is_second_preimage_resistant A &m mess). qed. diff --git a/sha3/proof/SHA3Indiff.ec b/sha3/proof/SHA3Indiff.ec index d04da54..1e3390d 100644 --- a/sha3/proof/SHA3Indiff.ec +++ b/sha3/proof/SHA3Indiff.ec @@ -152,7 +152,7 @@ declare module Dist : Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO, Gconcl_list.Simulator}. -axiom Dist_lossless (F <: DFUNCTIONALITY) (P <: DPRIMITIVE) : +axiom Dist_lossless (F <: DFUNCTIONALITY { Dist }) (P <: DPRIMITIVE { Dist }) : islossless P.f => islossless P.fi => islossless F.f => islossless Dist(F,P).distinguish. @@ -318,7 +318,7 @@ lemma SHA3Indiff Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO, Gconcl_list.Simulator}) &m : - (forall (F <: DFUNCTIONALITY) (P <: DPRIMITIVE), + (forall (F <: DFUNCTIONALITY { Dist }) (P <: DPRIMITIVE { Dist }), islossless P.f => islossless P.fi => islossless F.f => diff --git a/sha3/proof/SHA3Security.ec b/sha3/proof/SHA3Security.ec index 97a7705..d1a382d 100644 --- a/sha3/proof/SHA3Security.ec +++ b/sha3/proof/SHA3Security.ec @@ -128,7 +128,7 @@ section Preimage. Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, Gconcl_list.Simulator, DPre}. - axiom A_ll (F <: SRO.Oracle) : islossless F.get => islossless A(F).guess. + 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. @@ -468,7 +468,7 @@ section Preimage. 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. + + 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. @@ -485,7 +485,7 @@ section SecondPreimage. Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, Gconcl_list.Simulator, D2Pre}. - axiom A_ll (F <: SRO.Oracle) : islossless F.get => islossless A(F).guess. + 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. @@ -859,7 +859,7 @@ section SecondPreimage. 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. + + 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. @@ -878,7 +878,7 @@ section Collision. Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, Gconcl_list.Simulator}. - axiom A_ll (F <: SRO.Oracle) : islossless F.get => islossless A(F).guess. + 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. @@ -1236,7 +1236,7 @@ section Collision. 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. + + 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. @@ -1269,7 +1269,7 @@ section SHA3_Collision. Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, Gconcl_list.Simulator}. - axiom A_ll (F <: SRO.Oracle) : islossless F.get => islossless A(F).guess. + 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] <= @@ -1278,7 +1278,7 @@ section SHA3_Collision. (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. + by move=> F F_ll; proc; inline*; call(A_ll (X(F)) _); auto; proc; call F_ll; auto. qed. From a8495b108b72b4c968f8484934ff358beec45373 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Fri, 30 Aug 2019 15:13:17 +0200 Subject: [PATCH 355/394] remove print/search --- sha3/proof/Common.ec | 1 - sha3/proof/SHA3Security.ec | 4 ++-- sha3/proof/SecureHash.eca | 1 - 3 files changed, 2 insertions(+), 4 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index e02a614..29be89f 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -53,7 +53,6 @@ export DBlock. op cdistr = DCapacity.dunifin. op bdistr = DBlock.dunifin. -search c. (* ------------------------- Auxiliary Lemmas ------------------------- *) diff --git a/sha3/proof/SHA3Security.ec b/sha3/proof/SHA3Security.ec index d1a382d..ac8cd90 100644 --- a/sha3/proof/SHA3Security.ec +++ b/sha3/proof/SHA3Security.ec @@ -44,10 +44,10 @@ cut->:inv (2%r ^ size_out) = mu1 (dlist dbool size_out) (to_list x). rewrite spec_dout/=. pose p:= StdBigop.Bigreal.BRM.big _ _ _. cut->: p = StdBigop.Bigreal.BRM.big predT (fun _ => inv 2%r) (to_list x). - - rewrite /p =>{p}. print StdBigop.Bigreal.BRM. + - 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}. search 0 Int.(+) 1 (<=). + rewrite StdBigop.Bigreal.BRM.big_const count_predT spec_dout=> {p}. have:=size_out_gt0; move/ltzW. move:size_out;apply intind=> //=. - by rewrite powr0 iter0 //= fromint1. diff --git a/sha3/proof/SecureHash.eca b/sha3/proof/SecureHash.eca index d29ccf4..76caecd 100644 --- a/sha3/proof/SecureHash.eca +++ b/sha3/proof/SecureHash.eca @@ -29,7 +29,6 @@ axiom sampleto_fu: is_funiform sampleto. op increase_counter (c : int) (m : from) : int. axiom increase_counter_spec c m : c <= increase_counter c m. -print OIndif. (* module type RF = { *) (* proc init() : unit *) From 90711b674278924eaaa3fb10bf040117ba3c3b60 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Fri, 30 Aug 2019 15:15:07 +0200 Subject: [PATCH 356/394] clear everything --- sha3/proof/BlockSponge.ec | 15 --------------- 1 file changed, 15 deletions(-) diff --git a/sha3/proof/BlockSponge.ec b/sha3/proof/BlockSponge.ec index acdaf0d..9baad40 100644 --- a/sha3/proof/BlockSponge.ec +++ b/sha3/proof/BlockSponge.ec @@ -146,18 +146,3 @@ module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { return z; } }. - -(*----------------------------- Conclusion -----------------------------*) - -(* this is just for typechecking, right now: *) - -(* lemma conclusion : *) -(* forall (D <: DISTINGUISHER) &m, *) -(* `| Pr[RealIndif(Sponge, Perm, DRestr(D)).main() @ &m : res] *) -(* - Pr[IdealIndif(IRO, Sim, DRestr(D)).main() @ &m : res]| *) -(* <= (max_size ^ 2)%r / 2%r * Distr.mu1 dstate witness + *) -(* max_size%r * ((2 * max_size)%r / (2 ^ c)%r) + *) -(* max_size%r * ((2 * max_size)%r / (2 ^ c)%r). *) -(* proof. *) -(* admit. *) -(* qed. *) From 2d62ef09ca802e238f4bc6191103a8cb534ce8c2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Fri, 30 Aug 2019 16:06:16 +0200 Subject: [PATCH 357/394] Resolve some problems with conversions between (&&) and (/\). --- sha3/proof/smart_counter/Handle.eca | 41 +++++++++++++++++------------ 1 file changed, 24 insertions(+), 17 deletions(-) diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index 281958b..dd2241a 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -496,8 +496,9 @@ split=> [xa0 xc0 ya0 yc0|xa0 hx0 ya0 hy0]; 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. ++ by exists xc f yc f'; rewrite !get_setE /= /#. search (&&) (/\). +rewrite andaE. +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). @@ -517,7 +518,7 @@ move=> [] Hm_mh Hmh_m yc_notin_rng1_hs hs_hx hs_hy; split. 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=> /= /negb_and yahy0_neq_yahy /Hmh_m [yc0 fy0 xc0 fx0] [#] hs_hy0 hs_hx0 mi_yayc0. +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. @@ -567,7 +568,8 @@ 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. -exact/Hhuniq. +move=> H1 H2. +by have/=:=Hhuniq _ _ _ _ H1 H2. qed. lemma hs_addh hs ch xc fx: @@ -1267,8 +1269,9 @@ proof. + 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)=> [->> _ _ _ /Hch //|??? Hbu Hg]. - by rewrite build_hpath_prefix;exists v' h'. + case (hx = ch)=> [->> |??? Hbu Hg]. + + by rewrite andaE=> -> /= _ _ /Hch //. + by rewrite build_hpath_prefix;exists v' h';smt(). qed. lemma build_hpath_up_None (G1mh:hsmap) bi1 bi2 bi p: @@ -1433,8 +1436,8 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] by cut/#:=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; rewrite rngE=> -[hx2] hs_hx2. + 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 [#] !<<- _ _ ->> _. @@ -1457,7 +1460,7 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] 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. +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 [#] !<<- _ -> ->> _ />. @@ -1469,6 +1472,7 @@ case @[ambient]: {-1}(Gmi.[(xa,xc)]) (eq_refl Gmi.[(xa,xc)])=> [|[ya' yc'] ^] Gm 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. @@ -1639,7 +1643,8 @@ call(: !G1.bcol{2} rewrite domE;cut[]_ -> _ _ _ /=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. case(hinv hs0 y2{2} = None)=>//=h; rewrite get_setE /= oget_some /=;smt(lemma2 hinvP). - move=> [p0 v0] ^ pi_x2. have /pi_of_INV [] -> [hx2] [#] Hpath hs_hx2:= inv0. + 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 [#] !<<- _ _ !->> _ /= _ _ _ _ /=. @@ -1666,7 +1671,7 @@ call(: !G1.bcol{2} 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 /=. + 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 => /= ;cut[]_->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. case(G1.bcol{m2} \/ hinv hs0 y2L <> None)=>//=;rewrite !negb_or/==>[][]? hinv0[]? hinv1. @@ -1703,13 +1708,14 @@ call(: !G1.bcol{2} rewrite Hhx Hhy=> /=;move: HG1. case: fy Hhy=> Hhy //= [p v [Hro Hbu]]. exists p v;split. - + rewrite get_set_neqE // -negP => ^ /rconssI <<- /rconsIs. + + rewrite oget_some /=. + 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)). - + move=> ^ /rconssI <<- /rconsIs ->> /=; split => [<<- | ]. + + rewrite oget_some/= => ^ /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. @@ -1717,7 +1723,8 @@ call(: !G1.bcol{2} 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. - move=> Hdiff; case Hmh => ? -> Huni. + rewrite 2!oget_some /==> Hdiff; 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) => [->>|?]. @@ -1793,8 +1800,8 @@ call(: !G1.bcol{2} by rewrite /in_dom_with domE hs_hy2. rcondt{2} 14; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite domE pi_x2. auto=> &1 &2 [#] !<<- -> -> ->> _ /=; rewrite Block.DBlock.dunifin_ll Capacity.DCapacity.dunifin_ll /=. - move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 !oget_some //=. - rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. + move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 3!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. cut[]_->_ _ _//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. @@ -2407,7 +2414,7 @@ proof. cut:=hh3 _ _ _ _ _ H_path h_build_hpath_p0. cut->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). move=>help;cut 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. + move:help. rewrite andaE h_neq/==>h_g1_v_bn_hx. cut[]hh1 hh2 hh3:=H_mh_spec. cut:=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/=. From 3fd0ae1eb816db58ba0e50fb64a6341d39043808 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 30 Aug 2019 16:45:06 +0200 Subject: [PATCH 358/394] try to fix a pb --- sha3/proof/smart_counter/Handle.eca | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index dd2241a..612b94c 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -594,7 +594,12 @@ lemma hs_updh hs ch fx hx xc fx': => hs_spec hs.[hx <- (xc,fx')] ch. proof. move=> ^Hhs [] Hhuniq hs_0 dom_hs hx_neq0 hs_hx; split. -+ by move=> h1 h2 [c1 f1] [c2 f2]; rewrite !get_setE /= /#. ++ 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. @@ -1882,7 +1887,11 @@ cut[]b1 c1 H_Pm1:exists b1 c1, Pm.[(b +^ nth witness p i, c)] = Some (b1,c1) (oget Pm.[(b +^ nth witness p i, c)]).`2;smt(domE). cut[]H_P_m H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. cut:=H_P_m _ _ _ _ H_Pm1. -by cut[]/#:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. +cut[] :=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. @@ -2427,14 +2436,17 @@ proof. cut->/=:=ch_neq0 _ _ H_hs_spec. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. - by cut[]:=H_mh_spec; smt(dom_hs_neq_ch). + cut[]:=H_mh_spec => *. +admit. +(*smt(dom_hs_neq_ch).*) cut:=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. cut:=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:H13 H14;rewrite!get_setE/=!oget_some/==>H13 H14;rewrite H13 H14/=. cut->/=:=ch_neq0 _ _ H_hs_spec. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. - by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). + admit. +(*by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). *) + rewrite!get_setE/=oget_some;exact H2_pi_spec. + rewrite!get_setE/=!oget_some/=. cut H_m_p:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. From df81cb0c5c9d82e4c388e2807e78bd8508e74145 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Sat, 31 Aug 2019 13:24:59 +0200 Subject: [PATCH 359/394] patched smart_counter/Handle.eca --- sha3/proof/smart_counter/Handle.eca | 47 ++++++++++++++++++++++++++--- 1 file changed, 42 insertions(+), 5 deletions(-) diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index 612b94c..652f8c0 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -2436,17 +2436,54 @@ proof. cut->/=:=ch_neq0 _ _ H_hs_spec. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. - cut[]:=H_mh_spec => *. -admit. -(*smt(dom_hs_neq_ch).*) + cut[]:=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. cut:=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. cut:=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:H13 H14;rewrite!get_setE/=!oget_some/==>H13 H14;rewrite H13 H14/=. cut->/=:=ch_neq0 _ _ H_hs_spec. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. - admit. -(*by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). *) + cut[]:=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/=oget_some;exact H2_pi_spec. + rewrite!get_setE/=!oget_some/=. cut H_m_p:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. From 6499dee7d3369c6b4d33ea64f521ca9f37f6ac6d Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 2 Sep 2019 11:09:27 +0200 Subject: [PATCH 360/394] fix handle --- sha3/proof/smart_counter/Handle.eca | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index 652f8c0..5ed6614 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -496,8 +496,7 @@ split=> [xa0 xc0 ya0 yc0|xa0 hx0 ya0 hy0]; 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 /= /#. search (&&) (/\). -rewrite andaE. ++ 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)=> [<*>>|//=]. @@ -1275,7 +1274,7 @@ proof. case (v' +^ x = xa /\ h' = ha) => [[!<<-] /= ?? [!->>] /=| ]. + by exists p v';rewrite xorwA xorwK xorwC xorw0. case (hx = ch)=> [->> |??? Hbu Hg]. - + by rewrite andaE=> -> /= _ _ /Hch //. + + by move=> ??? /= /Hch. by rewrite build_hpath_prefix;exists v' h';smt(). qed. @@ -1805,7 +1804,7 @@ call(: !G1.bcol{2} by rewrite /in_dom_with domE hs_hy2. rcondt{2} 14; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite domE pi_x2. auto=> &1 &2 [#] !<<- -> -> ->> _ /=; rewrite Block.DBlock.dunifin_ll Capacity.DCapacity.dunifin_ll /=. - move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 3!oget_some //=. + 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. @@ -2423,7 +2422,7 @@ proof. cut:=hh3 _ _ _ _ _ H_path h_build_hpath_p0. cut->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). move=>help;cut h_neq:! (v +^ bn = sa{2} +^ nth witness bs{1} i{2} /\ hx = h{2}) by rewrite/#. - move:help. rewrite andaE h_neq/==>h_g1_v_bn_hx. + move:help. rewrite h_neq/==>h_g1_v_bn_hx. cut[]hh1 hh2 hh3:=H_mh_spec. cut:=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/=. From 23d9006162d83fce5429cbd91bb75c020e94d2a1 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Fri, 13 Sep 2019 00:43:00 +0200 Subject: [PATCH 361/394] --- sha3/proof/smart_counter/SLCommon.ec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/proof/smart_counter/SLCommon.ec b/sha3/proof/smart_counter/SLCommon.ec index d392b04..873e62d 100644 --- a/sha3/proof/smart_counter/SLCommon.ec +++ b/sha3/proof/smart_counter/SLCommon.ec @@ -3,7 +3,7 @@ length is the input block size. We prove its security even when padding is not prefix-free. **) require import Core Int Real StdOrder Ring IntExtra. -require import List FSet SmtMap Common PROM DProd Dexcepted. +require import List FSet SmtMap Common PROM Distr DProd Dexcepted. require (*..*) Indifferentiability. (*...*) import Capacity IntOrder. From 26281f720f81c41442326992aeebc1b16f50ac0c Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 13 Sep 2019 16:09:50 +0200 Subject: [PATCH 362/394] fix sha3 with change in EC --- sha3/proof/SecureORO.eca | 16 +++++++--------- sha3/proof/SecureRO.eca | 8 +++----- sha3/proof/smart_counter/ConcreteF.eca | 14 ++++++-------- sha3/proof/smart_counter/Gconcl_list.ec | 8 +++++--- sha3/proof/smart_counter/SLCommon.ec | 4 +--- 5 files changed, 22 insertions(+), 28 deletions(-) diff --git a/sha3/proof/SecureORO.eca b/sha3/proof/SecureORO.eca index 99c90e8..17d5782 100644 --- a/sha3/proof/SecureORO.eca +++ b/sha3/proof/SecureORO.eca @@ -167,7 +167,6 @@ section Preimage. if; sp; wp; last by hoare;auto;progress; smt(mu_bounded). case: (x \in RO.m). - hoare; auto; progress. - + smt(mu_bounded). rewrite H3/=; move: H1; rewrite rngE /= negb_exists /=. by have:=H3; rewrite domE; smt(). rnd (pred1 Preimage2.hash); auto=> /> &hr 6?. @@ -317,16 +316,15 @@ section SecondPreimage. + by auto. + inline*; sp; auto. if; sp; last first. - + sp; hoare; auto; 1: smt(mu_bounded); if; auto. + + sp; hoare; auto; if; auto. case(Bounder.bounder < bound); last first. - - by rcondf 8; 1: auto; hoare; auto; smt(mu_bounded). + - 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 _ in_dom2. - + smt(mu_bounded). move=> sample2 _ sample1 _; rewrite negb_and/=. move: not_rng; rewrite rngE /= negb_exists /= => /(_ SecondPreimage2.m2{h}). rewrite remE; case: (SecondPreimage2.m2{h} = m1{h})=> //=. @@ -400,18 +398,18 @@ section Collision. + auto. + inline*; sp. if; sp; last first. - - by wp; conseq(:_==> false)=> />; hoare; 1: smt(mu_bounded); auto. + - by wp; conseq(:_==> false)=> />; hoare; auto. case: (Bounder.bounder < bound); last first. - - rcondf 8; 1:auto; hoare; auto; smt(mu_bounded). + - 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; 1: smt(mu_bounded); auto. + - by hoare; auto. case: (m1 \in RO.m); case: (m2 \in RO.m). - - rcondf 3; 1: auto; rcondf 4; 1: auto; hoare; auto; 1: smt(bound_ge0 mu_bounded). + - 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}). @@ -474,7 +472,7 @@ section Collision. 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 //; 1: smt(mu_bounded). + rewrite StdOrder.RealOrder.ler_wpmul2r //. by rewrite RealExtra.le_fromint; smt(le_card_frng_fdom). + move=> c; proc; inline*; auto; sp; if; last by auto; smt(). auto=> /> &h h1 h2 _ sample _. diff --git a/sha3/proof/SecureRO.eca b/sha3/proof/SecureRO.eca index 283a6b8..cc38600 100644 --- a/sha3/proof/SecureRO.eca +++ b/sha3/proof/SecureRO.eca @@ -172,7 +172,6 @@ section Preimage. if; sp; wp; last by hoare;auto;progress; smt(mu_bounded). case: (x \in RO.m). - hoare; auto; progress. - + smt(mu_bounded). rewrite H3/=; move: H1; rewrite rngE /= negb_exists /=. by have:=H3; rewrite domE; smt(). rnd (pred1 h); auto=> //= &hr [#]->>??<<-????. @@ -348,7 +347,6 @@ section SecondPreimage. swap 3 -2; sp. case: (SecondPreimage2.m2 \in RO.m). - rcondf 5; 1: auto; hoare; auto=> /> &h d _ _ in_dom1 not_rng _ in_dom2. - + smt(mu_bounded). move=> sample2 _ sample1 _; rewrite negb_and/=. move: not_rng; rewrite rngE /= negb_exists /= => /(_ SecondPreimage2.m2{h}). rewrite remE; case: (SecondPreimage2.m2{h} = m1{h})=> //=. @@ -443,9 +441,9 @@ section Collision. rcondt 4; 1: auto. swap 4 -3. case: (m1 = m2). - - by hoare; 1: smt(mu_bounded); auto. + - by hoare; auto. case: (m1 \in RO.m); case: (m2 \in RO.m). - - rcondf 3; 1: auto; rcondf 6; 1: auto; hoare; auto; 1: smt(bound_gt0 mu_bounded). + - 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}). @@ -508,7 +506,7 @@ section Collision. 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 //; 1: smt(mu_bounded). + rewrite StdOrder.RealOrder.ler_wpmul2r //. by rewrite RealExtra.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 _. diff --git a/sha3/proof/smart_counter/ConcreteF.eca b/sha3/proof/smart_counter/ConcreteF.eca index a116ae8..f20a1f8 100644 --- a/sha3/proof/smart_counter/ConcreteF.eca +++ b/sha3/proof/smart_counter/ConcreteF.eca @@ -166,7 +166,7 @@ section. by rewrite -mem_fdom memE; apply/prefix_lt_size=> /#. + exact/prefix_ge0. + exact/prefix_sizel. - + case: H9=> //= - [j] [#] H42 H72. print take_take. + + 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. @@ -214,9 +214,7 @@ section. local clone import ProdSampling with type t1 <- block, - op d1 <- bdistr, - type t2 <- capacity, - op d2 <- cdistr. + type t2 <- capacity. lemma Real_Concrete &m : Pr[GReal(D).main()@ &m: res /\ C.c <= max_size] <= @@ -400,21 +398,21 @@ section. + 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(); } + 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(); } + 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(); } + 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(); } + transitivity{2} { y <@ S.sample(bdistr,cdistr); } (true ==> (y1,y2){1} = y{2}) (true ==> ={y})=> //=. - by symmetry; call sample_sample2; skip=> /> []. diff --git a/sha3/proof/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec index 1216a6d..810d196 100644 --- a/sha3/proof/smart_counter/Gconcl_list.ec +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -1,7 +1,7 @@ pragma -oldip. require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. require import List FSet SmtMap Common SLCommon PROM FelTactic Mu_mem. -require import DProd Dexcepted BlockSponge Gconcl. +require import Distr DProd Dexcepted BlockSponge Gconcl. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. require (*--*) Handle. @@ -224,7 +224,9 @@ section Ideal. /\ 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;1:(auto;smt(leq_nin_dom size_cat size_eq0 size_nseq valid_spec)). + * 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 _. @@ -1769,7 +1771,7 @@ section Real_Ideal. rewrite-(equiv_ideal D &m). cut:=Real_Ideal (A(D)) A_lossless &m. pose x:=witness;elim:x=>a b. - by rewrite/dstate DProd.dprod1E DBlock.dunifin1E DCapacity.dunifin1E/= + rewrite/dstate dprod1E DBlock.dunifin1E DCapacity.dunifin1E/= block_card capacity_card;smt(). qed. diff --git a/sha3/proof/smart_counter/SLCommon.ec b/sha3/proof/smart_counter/SLCommon.ec index 873e62d..89d7dee 100644 --- a/sha3/proof/smart_counter/SLCommon.ec +++ b/sha3/proof/smart_counter/SLCommon.ec @@ -79,9 +79,7 @@ module SqueezelessSponge (P:DPRIMITIVE): FUNCTIONALITY = { clone export DProd.ProdSampling as Sample2 with type t1 <- block, - type t2 <- capacity, - op d1 <- bdistr, - op d2 <- cdistr. + type t2 <- capacity. (* -------------------------------------------------------------------------- *) (** TODO move this **) From d6c8dc8bbe1fbedd1c103dfd56903dcf2135d491 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Sun, 15 Sep 2019 22:29:50 +0200 Subject: [PATCH 363/394] CI --- sha3/config/tests.config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/config/tests.config b/sha3/config/tests.config index 5e7de4f..bac5b80 100644 --- a/sha3/config/tests.config +++ b/sha3/config/tests.config @@ -1,6 +1,6 @@ [default] bin = easycrypt -args = -timeout 30 -p Z3 -p Alt-Ergo -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm +args = -timeout 30 -max-provers 2 -p Z3 -p Alt-Ergo -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm [test-sha3] okdirs = !proof From 06b176291f4a2f86dccf38774bfb0716403cbdc8 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 16 Sep 2019 08:21:03 +0200 Subject: [PATCH 364/394] fix sha3 with the modification of PROM --- sha3/proof/SHA3OSecurity.ec | 4 +++- sha3/proof/SecureORO.eca | 4 +++- sha3/proof/SecureRO.eca | 4 +++- sha3/proof/Sponge.ec | 5 ++++- sha3/proof/smart_counter/Gconcl_list.ec | 4 +++- sha3/proof/smart_counter/Handle.eca | 4 +++- sha3/proof/smart_counter/SLCommon.ec | 5 ++++- 7 files changed, 23 insertions(+), 7 deletions(-) diff --git a/sha3/proof/SHA3OSecurity.ec b/sha3/proof/SHA3OSecurity.ec index c2437eb..1b70e92 100644 --- a/sha3/proof/SHA3OSecurity.ec +++ b/sha3/proof/SHA3OSecurity.ec @@ -182,7 +182,9 @@ proof *. clone import GenEager as Eager with type from <- bool list * int, type to <- bool, - op sampleto <- fun _ => dbool + op sampleto <- fun _ => dbool, + type input <- unit, + type output <- bool proof * by smt(dbool_ll). section Preimage. diff --git a/sha3/proof/SecureORO.eca b/sha3/proof/SecureORO.eca index 17d5782..949a009 100644 --- a/sha3/proof/SecureORO.eca +++ b/sha3/proof/SecureORO.eca @@ -16,7 +16,9 @@ axiom sampleto_fu: is_funiform sampleto. clone import PROM.GenEager as RO with type from <- from, type to <- to, - op sampleto <- fun _ => sampleto + op sampleto <- fun _ => sampleto, + type input <- unit, + type output <- bool proof * by exact/sampleto_ll. op increase_counter (c : int) (m : from) : int. diff --git a/sha3/proof/SecureRO.eca b/sha3/proof/SecureRO.eca index cc38600..3e0fed3 100644 --- a/sha3/proof/SecureRO.eca +++ b/sha3/proof/SecureRO.eca @@ -16,7 +16,9 @@ axiom sampleto_fu: is_funiform sampleto. clone import PROM.GenEager as RO with type from <- from, type to <- to, - op sampleto <- fun _ => sampleto + op sampleto <- fun _ => sampleto, + type input <- unit, + type output <- bool proof * by exact/sampleto_ll. op increase_counter (c : int) (m : from) : int. diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index d9b1644..350701c 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -369,7 +369,10 @@ declare module D : HYBRID_IRO_DIST{HybridIROEager, HybridIROLazy}. local clone PROM.GenEager as ERO with type from <- block list * int, type to <- bool, - op sampleto <- fun _ => dbool. + op sampleto <- fun _ => dbool, + type input <- unit, + type output <- bool + proof sampleto_ll by apply dbool_ll. local module EROExper(O : ERO.RO, D : ERO.RO_Distinguisher) = { proc main() : bool = { diff --git a/sha3/proof/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec index 810d196..6496123 100644 --- a/sha3/proof/smart_counter/Gconcl_list.ec +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -1992,7 +1992,9 @@ axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : local clone import PROM.GenEager as IRO2 with type from <- block list * int, type to <- block, - op sampleto <- fun _, bdistr + op sampleto <- fun _, bdistr, + type input <- unit, + type output <- bool proof * by exact/DBlock.dunifin_ll. local module Simu (FRO : IRO2.RO) (F : DFUNCTIONALITY) = { diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index 5ed6614..87da3c0 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -9,7 +9,9 @@ require (*--*) ConcreteF PROM. clone export PROM.GenEager as ROhandle with type from <- handle, type to <- capacity, - op sampleto <- fun (_:int) => cdistr + op sampleto <- fun (_:int) => cdistr, + type input <- unit, + type output <- bool proof sampleto_ll by apply DCapacity.dunifin_ll. clone export ConcreteF as ConcreteF1. diff --git a/sha3/proof/smart_counter/SLCommon.ec b/sha3/proof/smart_counter/SLCommon.ec index 89d7dee..5480815 100644 --- a/sha3/proof/smart_counter/SLCommon.ec +++ b/sha3/proof/smart_counter/SLCommon.ec @@ -38,10 +38,13 @@ op bl_univ = FSet.oflist bl_enum. (* -------------------------------------------------------------------------- *) (* Random oracle from block list to block *) + clone import PROM.GenEager as F with type from <- block list, type to <- block, - op sampleto <- fun (_:block list)=> bdistr + op sampleto <- fun (_:block list)=> bdistr, + type input <- unit, + type output <- bool proof * by exact Block.DBlock.dunifin_ll. module Redo = { From 02d0247bc41645ad394a822ebd4f88b77167ac7b Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Tue, 17 Sep 2019 15:59:06 +0200 Subject: [PATCH 365/394] fix intro pattern n? --- sha3/proof/SHA3OSecurity.ec | 36 ++++++++++++++--------------- sha3/proof/SecureORO.eca | 2 +- sha3/proof/smart_counter/Gext.eca | 2 +- sha3/proof/smart_counter/Handle.eca | 2 +- 4 files changed, 20 insertions(+), 22 deletions(-) diff --git a/sha3/proof/SHA3OSecurity.ec b/sha3/proof/SHA3OSecurity.ec index 1b70e92..c3fee79 100644 --- a/sha3/proof/SHA3OSecurity.ec +++ b/sha3/proof/SHA3OSecurity.ec @@ -350,7 +350,7 @@ if{2}; sp; last first. 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 11?. + - move=> &l &r 12?. rewrite take_oversize 1:spec_dout 1:H4 //. rewrite eq_sym to_listK => ->. by have:=H3; rewrite domE; smt(). @@ -361,7 +361,7 @@ if{2}; sp; last first. 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 8?. + move=> &h 9?. rewrite size_rcons //=; do!split; 1, 2, 4: smt(size_ge0). rewrite (take_nth witness) 1:spec_dout 1:size_ge0//=. rewrite - H6; congr; rewrite H4=> //=. @@ -379,7 +379,7 @@ conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{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 11?; do!split; ..-2 : smt(domE mem_set). ++ move=> /> &l &r 12?; do!split; ..-2 : smt(domE mem_set). move=> l j Hin. rewrite get_setE/=. case: (l = x{r}) => [<<-|]. @@ -395,7 +395,7 @@ while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ (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 13?. + move=> &l &r *. rewrite get_setE/=oget_some/=size_rcons/=; do!split; 1,2: smt(size_ge0). - smt(mem_set). - smt(get_setE). @@ -407,7 +407,6 @@ while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ 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) /\ *) @@ -776,7 +775,7 @@ rcondf{2} 4; 1: 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 13?; split; 2: smt(divz_ge0 gt0_r size_ge0). +move=> &l &r 14?; split; 2: smt(divz_ge0 gt0_r size_ge0). rewrite 2!oget_some cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. have h:=spec2_dout result_L H5. have-> := some_oget _ h. @@ -816,7 +815,7 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, sp; if{1}. * rcondt{2} 2; auto; 1: smt(BlockSponge.parse_valid). rnd (fun l => oget (of_list l)) to_list; auto=> />. - move=> &l &r 10?; split; 1: smt(of_listK). + move=> &l &r 11?; 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. @@ -830,7 +829,7 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, if{1}. * rcondt{2} 2; auto. rnd (fun l => oget (of_list l)) to_list; auto=> />. - move=> &l 4?; split=> ?; 1: smt(of_listK). + 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. @@ -859,7 +858,6 @@ if{1}. 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. @@ -1071,7 +1069,7 @@ if{2}; sp; last first. 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 11?. + - move=> &l &r 12?. rewrite take_oversize 1:spec_dout 1:H4 //. rewrite eq_sym to_listK => ->. by have:=H3; rewrite domE; smt(). @@ -1082,7 +1080,7 @@ if{2}; sp; last first. 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 8?. + move=> &h 9?. rewrite size_rcons //=; do!split; 1, 2, 4: smt(size_ge0). rewrite (take_nth witness) 1:spec_dout 1:size_ge0//=. rewrite - H6; congr; rewrite H4=> //=. @@ -1100,7 +1098,7 @@ conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{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 11?; do!split; ..-2 : smt(domE mem_set). ++ move=> /> &l &r 12?; do!split; ..-2 : smt(domE mem_set). move=> l j Hin. rewrite get_setE/=. case: (l = x{r}) => [<<-|]. @@ -1611,7 +1609,7 @@ rcondf{2} 4; 1: 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 13?; split; 2: smt(divz_ge0 gt0_r size_ge0). +move=> &l &r 14?; split; 2: smt(divz_ge0 gt0_r size_ge0). rewrite 2!oget_some cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. have h:=spec2_dout result_L H5. have-> := some_oget _ h. @@ -1640,7 +1638,7 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, sp; if{1}. * rcondt{2} 2; auto; 1: smt(BlockSponge.parse_valid). rnd (fun l => oget (of_list l)) to_list; auto=> />. - move=> &l &r 10?; split; 1: smt(of_listK). + move=> &l &r 11?; 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. @@ -1950,7 +1948,7 @@ if{2}; sp; last first. 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 11?. + - move=> &l &r 12?. rewrite take_oversize 1:spec_dout 1:H4 //. rewrite eq_sym to_listK => ->. by have:=H3; rewrite domE; smt(). @@ -1961,7 +1959,7 @@ if{2}; sp; last first. 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 8?. + move=> &h 9?. rewrite size_rcons //=; do!split; 1, 2, 4: smt(size_ge0). rewrite (take_nth witness) 1:spec_dout 1:size_ge0//=. rewrite - H6; congr; rewrite H4=> //=. @@ -1979,7 +1977,7 @@ conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{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 11?; do!split; ..-2 : smt(domE mem_set). ++ move=> /> &l &r 12?; do!split; ..-2 : smt(domE mem_set). move=> l j Hin. rewrite get_setE/=. case: (l = x{r}) => [<<-|]. @@ -2484,7 +2482,7 @@ rcondf{2} 4; 1: 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 13?; split; 2: smt(divz_ge0 gt0_r size_ge0). +move=> &l &r 14?; split; 2: smt(divz_ge0 gt0_r size_ge0). rewrite 2!oget_some cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. have h:=spec2_dout result_L H5. have-> := some_oget _ h. @@ -2511,7 +2509,7 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, sp; if{1}. * rcondt{2} 2; auto; 1: smt(BlockSponge.parse_valid). rnd (fun l => oget (of_list l)) to_list; auto=> />. - move=> &l &r 10?; split; 1: smt(of_listK). + move=> &l &r 11?; 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. diff --git a/sha3/proof/SecureORO.eca b/sha3/proof/SecureORO.eca index 949a009..cc8ac8f 100644 --- a/sha3/proof/SecureORO.eca +++ b/sha3/proof/SecureORO.eca @@ -171,7 +171,7 @@ section Preimage. - hoare; auto; progress. rewrite H3/=; move: H1; rewrite rngE /= negb_exists /=. by have:=H3; rewrite domE; smt(). - rnd (pred1 Preimage2.hash); auto=> /> &hr 6?. + rnd (pred1 Preimage2.hash); auto=> /> &hr *. rewrite (sampleto_fu Preimage2.hash{hr} witness)/= => ??. by rewrite get_setE /=; smt(). smt(). diff --git a/sha3/proof/smart_counter/Gext.eca b/sha3/proof/smart_counter/Gext.eca index fbdec43..2e204bc 100644 --- a/sha3/proof/smart_counter/Gext.eca +++ b/sha3/proof/smart_counter/Gext.eca @@ -625,7 +625,7 @@ section EXT. + 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 3?->/=. + wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3? -> /=. rewrite/Distr.is_lossless (sampleto_ll 0)/= => ? _;rewrite /bad_ext !get_setE /= !oget_some /= 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. diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index 87da3c0..d847652 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -1450,7 +1450,7 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] 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=> ? ? [#] !<<- -> -> ->> _. + auto => ? ? [#] !<<- -> -> ->> _. rewrite (@huniq_hinvK_h hx2) // oget_some /= => y1 -> /= y2 -> /=. case: (hinvP hs y2)=> [_ y2_notrngE1_hs _ _|/#]. rewrite get_setE /= oget_some /=. From f1ad34def8ece5d95a432fa368ec4b36b338a871 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Mon, 14 Oct 2019 11:42:14 +0200 Subject: [PATCH 366/394] misc --- sha3/config/tests.config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/config/tests.config b/sha3/config/tests.config index bac5b80..305b823 100644 --- a/sha3/config/tests.config +++ b/sha3/config/tests.config @@ -1,6 +1,6 @@ [default] bin = easycrypt -args = -timeout 30 -max-provers 2 -p Z3 -p Alt-Ergo -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm +args = -I Jasmin:jasmin/eclib -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm [test-sha3] okdirs = !proof From db92159ef7e9c1c168c70c0236b0eb77aae3334c Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Mon, 14 Oct 2019 11:54:50 +0200 Subject: [PATCH 367/394] CI: use submodules --- sha3/config/tests.config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/config/tests.config b/sha3/config/tests.config index 305b823..580b3a8 100644 --- a/sha3/config/tests.config +++ b/sha3/config/tests.config @@ -1,6 +1,6 @@ [default] bin = easycrypt -args = -I Jasmin:jasmin/eclib -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm +args = -timeout 30 -I Jasmin:jasmin/eclib -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm [test-sha3] okdirs = !proof From 753236ef1fff6e120278ebce6d064d0a18ae848e Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Mon, 14 Oct 2019 13:06:10 +0200 Subject: [PATCH 368/394] Remove explicit calls to the option "prover" --- sha3/proof/Common.ec | 3 --- sha3/proof/MapAux.ec | 3 --- sha3/proof/Sponge.ec | 3 --- 3 files changed, 9 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 29be89f..72d1d38 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -1,7 +1,4 @@ (*------------------- Common Definitions and Lemmas --------------------*) - -prover quorum=2 ["Z3" "Alt-Ergo"]. - require import Core Int IntExtra IntDiv Real List Distr. require import Ring StdRing StdOrder StdBigop BitEncoding DProd. require (*--*) FinType BitWord IdealPRP Monoid. diff --git a/sha3/proof/MapAux.ec b/sha3/proof/MapAux.ec index a95f201..fefc337 100644 --- a/sha3/proof/MapAux.ec +++ b/sha3/proof/MapAux.ec @@ -1,7 +1,4 @@ (*---------------------- Auxiliary Lemmas on Maps ----------------------*) - -prover [""]. - require import AllCore SmtMap FSet StdOrder. import IntOrder. diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 350701c..3df0fd1 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -1,7 +1,4 @@ (*------------------------- Sponge Construction ------------------------*) - -prover quorum=2 ["Z3" "Alt-Ergo"]. - require import Core Int IntDiv Real List FSet SmtMap. (*---*) import IntExtra. require import Distr DBool DList. From f0340025c84e50f7b2bac8890e64cfd086a258d4 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Mon, 14 Oct 2019 11:30:58 -0400 Subject: [PATCH 369/394] This is no longer used. (Its contents (adapted) were moved into SmtMap.) --- sha3/proof/MapAux.ec | 143 ------------------------------------------- 1 file changed, 143 deletions(-) delete mode 100644 sha3/proof/MapAux.ec diff --git a/sha3/proof/MapAux.ec b/sha3/proof/MapAux.ec deleted file mode 100644 index fefc337..0000000 --- a/sha3/proof/MapAux.ec +++ /dev/null @@ -1,143 +0,0 @@ -(*---------------------- Auxiliary Lemmas on Maps ----------------------*) -require import AllCore SmtMap FSet StdOrder. -import IntOrder. - -lemma get_none (m : ('a, 'b) fmap, x : 'a) : - x \notin m => m.[x] = None. -proof. by rewrite domE. qed. - -lemma get_some (m : ('a, 'b) fmap, x : 'a) : - x \in m => m.[x] = Some (oget m.[x]). -proof. move=> /domE; by case m.[x]. qed. - -lemma set_same (m : ('a, 'b) fmap, x : 'a) : - x \in m => m.[x <- oget m.[x]] = m. -proof. -move=> x_in_m. -apply fmap_eqP => y. -case (y = x) => [->> | ne_y_x]. -by rewrite get_set_sameE get_some. -by rewrite get_setE ne_y_x. -qed. - -lemma set_eq (m : ('a, 'b) fmap, x : 'a, y : 'b) : - m.[x] = Some y => m.[x <- y] = m. -proof. -move=> m_get_x_eq_y. -have x_in_m : x \in m by rewrite domE m_get_x_eq_y. -have -> : y = oget m.[x] by rewrite m_get_x_eq_y oget_some. -by rewrite set_same. -qed. - -lemma frng_set (m : ('a, 'b) fmap, x : 'a, y : 'b) : - frng m.[x <- y] = frng (rem m x) `|` fset1 y. -proof. -apply fsetP => z; rewrite in_fsetU in_fset1 2!mem_frng 2!rngE /=. -split => [[x'] | [[x'] | ->]]. -case (x' = x) => [-> | ne_x'_x]. -by rewrite get_set_sameE /= => ->. -rewrite get_setE ne_x'_x /= => get_x'_some_z. -left; exists x'; by rewrite remE ne_x'_x. -rewrite remE. -case (x' = x) => // ne_x'_x get_x'_some_z. -exists x'; by rewrite get_setE ne_x'_x. -exists x; by rewrite get_set_sameE. -qed. - -lemma eq_except_ne_in (x y : 'a, m1 m2 : ('a, 'b) fmap) : - eq_except (pred1 x) m1 m2 => y <> x => - y \in m1 => y \in m2. -proof. -move=> /eq_exceptP @/pred1 eq_exc ne_y_x. -by rewrite 2!domE eq_exc. -qed. - -lemma eq_except_setr_as_l (m1 m2 : ('a, 'b) fmap) x: - x \in m1 => eq_except (pred1 x) m1 m2 => - m1 = m2.[x <- oget m1.[x]]. -proof. -rewrite eq_exceptP -fmap_eqP=> x_in_m1 eqe x'. -rewrite get_setE /oget; case (x' = x)=> [->> |]. -by move: x_in_m1; rewrite domE; case (m1.[x]). -by move=> ne_x'_x; rewrite eqe. -qed. - -lemma eq_except_set_both x b b' (m : ('a, 'b) fmap): - eq_except (pred1 x) m.[x <- b] m.[x <- b']. -proof. by rewrite eq_exceptP=> x'; rewrite /pred1 !get_setE=> ->. qed. - -lemma eq_except_rem (m1 m2 : ('a,'b) fmap) (X : 'a -> bool) x: - X x => eq_except X m1 m2 => eq_except X m1 (rem m2 x). -proof. -move=> X_x /eq_exceptP eq_exc; rewrite eq_exceptP=> y X_y; rewrite remE. -case (y = x)=> [->> // | ne_y_x]; by apply eq_exc. -qed. - -lemma rem_id (m : ('a, 'b) fmap, x : 'a) : - x \notin m => rem m x = m. -proof. -move=> x_notin_m; apply fmap_eqP => y; rewrite remE. -case (y = x) => // ->. -case (None = m.[x]) => // get_not_none. -rewrite eq_sym -domE // in get_not_none. -qed. - -lemma map_empty (f : 'a -> 'b -> 'c, m : ('a, 'b) fmap) : - map f empty = empty. -proof. by rewrite -fmap_eqP=> x; rewrite mapE 2!emptyE. qed. - -lemma map_rem (f:'a -> 'b -> 'c) m (x:'a) : - map f (rem m x) = rem (map f m) x. -proof. -rewrite -fmap_eqP=> z; by rewrite !(mapE,remE); case (z = x). -qed. - -lemma map_id (m:('a,'b)fmap): map (fun _ b => b) m = m. -proof. by rewrite -fmap_eqP=>x; rewrite mapE; case (m.[x]). qed. - -lemma le_card_frng_fdom (m : ('a, 'b) fmap) : - card (frng m) <= card (fdom m). -proof. -move: m. -elim /fmapW=> [| m k v k_notin_m IH]. -by rewrite frng0 fdom0 2!fcards0. -rewrite mem_fdom in k_notin_m. -rewrite frng_set rem_id // fdom_set (fcardUI_indep _ (fset1 k)) - 1:fsetI1 1:mem_fdom 1:k_notin_m // fcard1 fcardU fcard1 - -addzA ler_add // -{2}(addz0 1) ler_add // oppz_le0 fcard_ge0. -qed. - -lemma fdom_frng_prop (X : 'a fset, m : ('a, 'a) fmap) : - fdom m \proper X => frng m \subset X => frng m \proper X. -proof. -rewrite /(\proper); move=> |>. -case (frng m = X)=> // ^ eq_frng_m_X -> fdom_m_sub_X fdom_m_ne_X _. -have card_fdom_m_lt_card_X : card (fdom m) < card X. - rewrite ltz_def; split. - case (card X = card (fdom m))=> // /eq_sym /subset_cardP. - by rewrite fdom_m_sub_X fdom_m_ne_X. - by rewrite subset_leq_fcard. -have card_X_le_card_fdom_m : card X <= card (fdom m) - by rewrite -eq_frng_m_X le_card_frng_fdom. -by rewrite /= -(ltzz (card X)) (ler_lt_trans (card (fdom m))). -qed. - -lemma fdom_frng_prop_type (m : ('a, 'a) fmap) : - (exists (x : 'a), ! x \in m) => - (exists (y : 'a), ! rng m y). -proof. -move=> [x x_notin_m]. -have : fdom m \proper fdom m `|` frng m `|` fset1 x. - rewrite /(\proper); split. - move=> z; rewrite 2!in_fsetU; move=> />. - case (fdom m = fdom m `|` frng m `|` fset1 x)=> // contra_eq. - rewrite -mem_fdom in x_notin_m. - have // : x \in fdom m by rewrite contra_eq 2!in_fsetU in_fset1. -pose univ := fdom m `|` frng m `|` fset1 x. -have fdom_prop_univ frng_sub_univ : frng m \subset univ - by move=> z @/univ; rewrite 2!in_fsetU; move=> />. -have : frng m \proper univ by apply fdom_frng_prop. -move=> /properP [_ [y [_ y_notin_frng_m]]]. -rewrite mem_frng in y_notin_frng_m. -by exists y. -qed. From 36837dd9198819191368cb4f58cf014b06467eb8 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 9 Dec 2019 11:09:27 +0100 Subject: [PATCH 370/394] fix proof with 1.0 --- sha3/proof/SHA3OSecurity.ec | 153 +++++++++++----------- sha3/proof/SHA3Security.ec | 6 +- sha3/proof/smart_counter/Gconcl.ec | 6 +- sha3/proof/smart_counter/Gconcl_list.ec | 16 +-- sha3/proof/smart_counter/Gext.eca | 9 +- sha3/proof/smart_counter/Handle.eca | 60 +++++---- sha3/proof/smart_counter/SLCommon.ec | 161 +----------------------- 7 files changed, 123 insertions(+), 288 deletions(-) diff --git a/sha3/proof/SHA3OSecurity.ec b/sha3/proof/SHA3OSecurity.ec index c3fee79..390797d 100644 --- a/sha3/proof/SHA3OSecurity.ec +++ b/sha3/proof/SHA3OSecurity.ec @@ -396,7 +396,7 @@ while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ + sp; rcondt{1} 1; auto=> />. - smt(). move=> &l &r *. - rewrite get_setE/=oget_some/=size_rcons/=; do!split; 1,2: smt(size_ge0). + rewrite get_setE /= size_rcons /=; do!split; 1,2: smt(size_ge0). - smt(mem_set). - smt(get_setE). - smt(mem_set). @@ -645,9 +645,6 @@ rewrite eq_sym; byequiv=> //=; proc. call(RO_LRO_D Dist); 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] <= @@ -776,10 +773,10 @@ 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 14?; split; 2: smt(divz_ge0 gt0_r size_ge0). -rewrite 2!oget_some cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. +rewrite cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. have h:=spec2_dout result_L H5. have-> := some_oget _ h. -by rewrite eq_sym -to_listK; congr. +by rewrite /= eq_sym -to_listK. qed. local lemma rw_ideal &m: @@ -819,7 +816,7 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, rewrite -dout_equal_dlist=> ?; split=> ?. + by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). move=> sample. - rewrite !get_setE/=oget_some/=dout_full/= => h; split; 2: smt(). + rewrite !get_setE/=dout_full/= => h; split; 2: smt(). rewrite eq_sym to_listK; apply some_oget. apply spec2_dout. by move:h; rewrite supp_dmap; smt(spec_dout). @@ -834,7 +831,7 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, * 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/=oget_some/= dout_full/=; congr; rewrite of_listK oget_some. + 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}. @@ -1115,7 +1112,7 @@ while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ + sp; rcondt{1} 1; auto=> />. - smt(). move=> &l &r 13?. - rewrite get_setE/=oget_some/=size_rcons/=; do!split; 1,2: smt(size_ge0). + rewrite get_setE/=size_rcons/=; do!split; 1,2: smt(size_ge0). - smt(mem_set). - smt(get_setE). - smt(mem_set). @@ -1448,7 +1445,7 @@ if{1}. sp; rcondt{1} 1; auto. inline{1} 1; sp; auto. call(eq_IRO_RFWhile); auto=> /> 15?. - rewrite oget_some take_oversize 1:/# /=. + rewrite take_oversize 1:/# /=. have:=spec2_dout _ H5. move=>/(some_oget)-> /=; smt(divz_ge0 gt0_r size_ge0 spec2_dout). move=>/=. @@ -1610,7 +1607,7 @@ 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 14?; split; 2: smt(divz_ge0 gt0_r size_ge0). -rewrite 2!oget_some cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. +rewrite cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. have h:=spec2_dout result_L H5. have-> := some_oget _ h. by rewrite eq_sym -to_listK; congr. @@ -1642,7 +1639,7 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, rewrite -dout_equal_dlist=> ?; split=> ?. + by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). move=> sample. - rewrite !get_setE/=oget_some/=dout_full/= => h; split; 2: smt(). + rewrite !get_setE/=dout_full/= => h; split; 2: smt(). rewrite eq_sym to_listK; apply some_oget. apply spec2_dout. by move:h; rewrite supp_dmap; smt(spec_dout). @@ -1657,7 +1654,7 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, * 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/=oget_some/= dout_full/=; congr; rewrite of_listK oget_some. + 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 /\ @@ -1716,40 +1713,38 @@ rewrite (StdOrder.RealOrder.ler_trans _ _ _ (RO_is_second_preimage_resistant (SO 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=> />; 1: smt(). - - by proc; inline*; sp; if; auto; 2:sim=> />; 1: 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 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=> />; 1: smt(). + - by proc; inline*; sp; if; auto; 2:sim=> />; 1: 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) = { @@ -1994,7 +1989,7 @@ while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ + sp; rcondt{1} 1; auto=> />. - smt(). move=> &l &r 13?. - rewrite get_setE/=oget_some/=size_rcons/=; do!split; 1,2: smt(size_ge0). + rewrite get_setE/=size_rcons/=; do!split; 1,2: smt(size_ge0). - smt(mem_set). - smt(get_setE). - smt(mem_set). @@ -2286,7 +2281,6 @@ rewrite eq_sym; byequiv=> //=; proc. by call(RO_LRO_D Dist); inline*; auto=> />. qed. - local equiv toto : DFSetSize(OFC(ExtendSample(FSome(BIRO.IRO)))).f ~ DFSetSize(OFC(ExtendSample(FSome(BIRO.IRO)))).f : @@ -2327,7 +2321,7 @@ if{1}. sp; rcondt{1} 1; auto. inline{1} 1; sp; auto. call(eq_IRO_RFWhile); auto=> /> 15?. - rewrite oget_some take_oversize 1:/# /=. + rewrite take_oversize 1:/# /=. have:=spec2_dout _ H5. move=>/(some_oget)-> /=; smt(divz_ge0 gt0_r size_ge0 spec2_dout). move=>/=. @@ -2483,7 +2477,7 @@ 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 14?; split; 2: smt(divz_ge0 gt0_r size_ge0). -rewrite 2!oget_some cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. +rewrite cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. have h:=spec2_dout result_L H5. have-> := some_oget _ h. by rewrite eq_sym -to_listK; congr. @@ -2513,7 +2507,7 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, rewrite -dout_equal_dlist=> ?; split=> ?. + by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). move=> sample. - rewrite !get_setE/=oget_some/=dout_full/= => h; split; 2: smt(). + rewrite !get_setE/= dout_full/= => h; split; 2: smt(). rewrite eq_sym to_listK; apply some_oget. apply spec2_dout. by move:h; rewrite supp_dmap; smt(spec_dout). @@ -2528,7 +2522,7 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, * 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/=oget_some/= dout_full/=; congr; rewrite of_listK oget_some. + 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 /\ @@ -2575,7 +2569,6 @@ if{1}. 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] <= @@ -2586,33 +2579,31 @@ rewrite (StdOrder.RealOrder.ler_trans _ _ _ (RO_is_collision_resistant (SORO_Col 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=> />; 1: smt(). - - by proc; inline*; sp; if; auto; 2:sim=> />; 1: 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. +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=> />; 1: smt(). + - by proc; inline*; sp; if; auto; 2:sim=> />; 1: 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), diff --git a/sha3/proof/SHA3Security.ec b/sha3/proof/SHA3Security.ec index ac8cd90..6c68981 100644 --- a/sha3/proof/SHA3Security.ec +++ b/sha3/proof/SHA3Security.ec @@ -256,7 +256,7 @@ section Preimage. (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 /= oget_some; smt(to_listK take_oversize spec_dout). + + 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 //=. @@ -603,7 +603,7 @@ section SecondPreimage. (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 /= oget_some; smt(to_listK take_oversize spec_dout). + + 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 //=. @@ -995,7 +995,7 @@ section Collision. (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 /= oget_some; smt(to_listK take_oversize spec_dout). + + 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 //=. diff --git a/sha3/proof/smart_counter/Gconcl.ec b/sha3/proof/smart_counter/Gconcl.ec index a7167ff..b11f889 100644 --- a/sha3/proof/smart_counter/Gconcl.ec +++ b/sha3/proof/smart_counter/Gconcl.ec @@ -227,14 +227,14 @@ proof. 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. inline *;rcondt{1} 6;1:by auto=>/>. wp;rnd;auto;progress[-split];rewrite DCapacity.dunifin_ll /= => ?_?->. - by rewrite !get_setE /= oget_some. + by 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=>/>. wp;rnd;auto;rnd{1};auto;progress[-split]. rewrite Block.DBlock.supp_dunifin DCapacity.dunifin_ll /==> ?_?->. - by rewrite !get_setE /= oget_some. + by 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. @@ -248,7 +248,7 @@ proof. 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. inline *;rcondt{1} 6;1:by auto=>/>. wp;rnd;auto;progress[-split];rewrite DCapacity.dunifin_ll /= => ?_?->. - by rewrite !get_setE /= oget_some. + by 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. diff --git a/sha3/proof/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec index 6496123..f286c68 100644 --- a/sha3/proof/smart_counter/Gconcl_list.ec +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -237,7 +237,7 @@ section Ideal. - by rewrite!get_setE/=. - have//= /#:= prefix_le1 bl{2} SLCommon.C.queries{1} i_R H _. by rewrite domE H1. - - by rewrite!get_setE/=oget_some leq_add2//=. + - 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. @@ -283,7 +283,7 @@ section Ideal. sp;auto;progress. + by rewrite!get_setE/=. + smt(prefix_ge0). - + rewrite get_setE/=oget_some leq_add2//=. + + rewrite get_setE/= leq_add2//=. + by rewrite!get_setE/=. + smt(prefix_ge0). + exact leq_add_in. @@ -1309,12 +1309,12 @@ section Real. 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/=!oget_some nth_last/=take_size. + - move:H4 H5;rewrite!get_setE/= nth_last/=take_size. rewrite last_cat last_nseq 1:/# Block.WRing.addr0;progress. cut//=:=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/=oget_some/=. + rewrite H1/=!mem_set/=H4/=H2/=get_setE/=. cut->->//=:y2L = (y2L.`1, y2L.`2);1,-1:smt(). rewrite INV_Real_addm_mi//=;2:smt(supp_dexcepted). by cut:=H3=>hinv0;split;case:hinv0=>//=/#. @@ -1559,11 +1559,11 @@ section Real. + smt(). + by rewrite get_setE/=. + by rewrite behead_drop drop_add. - + rewrite!get_setE/=oget_some. + + rewrite!get_setE/=. cut:=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/=oget_some. + rewrite!mem_set/=-take_nth//=H5/=H1/=get_setE/=. cut->->//=:(yL.`1, yL.`2) = yL by smt(). rewrite INV_Real_addm_mi=>//=;smt(supp_dexcepted). + smt(size_drop size_eq0). @@ -1652,7 +1652,7 @@ section Real. + smt(). + move:H5 H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). - rewrite Block.WRing.addr0 !get_setE/=oget_some take_oversize;1:rewrite size_cat size_nseq/#. + rewrite Block.WRing.addr0 !get_setE/= take_oversize;1:rewrite size_cat size_nseq/#. move=>H_dom_iS H_dom_p. cut:=lemma2' 0 C.c{2} Perm.m{2}.[(sa{2}, sc{2}) <- y0L] Perm.mi{2}.[y0L <- (sa{2}, sc{2})] Redo.prefixes{1} @@ -1660,7 +1660,7 @@ section Real. + by rewrite INV_Real_addm_mi//=;smt(supp_dexcepted). + smt(). + by rewrite mem_set. - by rewrite!get_setE/=oget_some/=H2/=;smt(). + by rewrite!get_setE/=H2/=;smt(). + by rewrite!get_setE/=take_oversize//=size_cat size_nseq/#. + rewrite nth_cat;cut->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). by rewrite nth_nseq//=1:/# Block.WRing.addr0. diff --git a/sha3/proof/smart_counter/Gext.eca b/sha3/proof/smart_counter/Gext.eca index 2e204bc..a6ad8d9 100644 --- a/sha3/proof/smart_counter/Gext.eca +++ b/sha3/proof/smart_counter/Gext.eca @@ -626,7 +626,7 @@ section EXT. 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 3? -> /=. - rewrite/Distr.is_lossless (sampleto_ll 0)/= => ? _;rewrite /bad_ext !get_setE /= !oget_some /= set_set_eqE //=. + rewrite/Distr.is_lossless (sampleto_ll 0)/= => ? _;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. @@ -648,7 +648,7 @@ section EXT. 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 3?->/=. - rewrite/Distr.is_lossless (sampleto_ll 0) /= => ? _;rewrite /bad_ext !get_setE /= !oget_some /= set_set_eqE //=. + rewrite/Distr.is_lossless (sampleto_ll 0) /= => ? _;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. @@ -684,9 +684,8 @@ section EXT. + smt(). + smt(). + smt(). - + elim H7=>// [[x h] [#]];rewrite -memE mem_fdom dom_restr /in_dom_with domE=> _ ->/=. - by rewrite oget_some. - apply H10=>//. + + by elim H7=>// [[x h] [#]];rewrite -memE mem_fdom dom_restr /in_dom_with domE=> _ ->. + by apply H10. qed. axiom D_ll: diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index d847652..47c8007 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -653,8 +653,7 @@ lemma getflagP_some hs xc f: proof. move=> huniq_hs; split. + rewrite /getflag; case: (hinvP hs xc)=> [-> //|]. - rewrite rngE; case: (hinv hs xc)=> //= h [f']. - rewrite oget_some=> ^ hs_h -> @/snd /= ->>. + 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) //|]. @@ -1288,7 +1287,6 @@ 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 oget_some. rewrite get_setE. case ((bi'.`1 +^ b, bi'.`2) = bi1) => [-> | _];2:by apply Hrec. by rewrite Hbi1 build_hpath_None. qed. @@ -1417,8 +1415,7 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] by rewrite get_setE. auto=> ? ? [#] !<<- -> -> ->> _ /= ya -> /= yc -> /=. case: (hinvP (hs.[ch <- (xc,Known)]) yc)=> [_|-> //] yc_notrngE1_hs_addh _ _. - rewrite get_setE /= oget_some /=. - rewrite(@huniq_hinvK_h ch) 3:oget_some /=. + 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. @@ -1453,7 +1450,7 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] auto => ? ? [#] !<<- -> -> ->> _. rewrite (@huniq_hinvK_h hx2) // oget_some /= => y1 -> /= y2 -> /=. case: (hinvP hs y2)=> [_ y2_notrngE1_hs _ _|/#]. - rewrite get_setE /= oget_some /=. + rewrite get_setE /=. apply/lemma2'=> //. + rewrite domE/=;cut[]h1 _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. cut h1':=h1 y1 y2. @@ -1586,7 +1583,7 @@ call(: !G1.bcol{2} 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 /= oget_some /=. + 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)=> //=. @@ -1648,7 +1645,7 @@ call(: !G1.bcol{2} auto=> &1 &2 [#] !<<- -> -> !->> _ /=. rewrite domE;cut[]_ -> _ _ _ /=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. case(hinv hs0 y2{2} = None)=>//=h; - rewrite get_setE /= oget_some /=;smt(lemma2 hinvP). + 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. @@ -1714,14 +1711,13 @@ call(: !G1.bcol{2} rewrite Hhx Hhy=> /=;move: HG1. case: fy Hhy=> Hhy //= [p v [Hro Hbu]]. exists p v;split. - + rewrite oget_some /=. - rewrite get_set_neqE // -negP => ^ /rconssI <<- /rconsIs. + + 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 oget_some/= => ^ /rconssI <<- /rconsIs ->> /=; split => [<<- | ]. + + 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. @@ -1729,7 +1725,7 @@ call(: !G1.bcol{2} 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 2!oget_some /==> Hdiff; rewrite Hdiff/=. + rewrite /= => Hdiff. case Hmh => ? -> Huni. apply exists_iff=> v /= ;apply exists_iff => hx /=;apply exists_iff => hy /=. rewrite build_hpath_upd_ch_iff //. @@ -1776,7 +1772,7 @@ call(: !G1.bcol{2} 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 /= => [#] !<<- {ya yc}. + 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. @@ -2042,7 +2038,7 @@ proof. * rewrite/#. * rewrite/#. move=>[]b2 c2 h2[]H_PFm H_Gmh. - rewrite H_Gmh/=oget_some/=. + rewrite H_Gmh/=. cut[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). by rewrite!take_take !min_lel 1,2:/# nth_take 1,2:/# H2/==>[][]->>->><-;rewrite H_PFm oget_some. - rewrite/#. @@ -2067,7 +2063,7 @@ proof. * rewrite/#. * rewrite/#. move=>[]b2 c2 h2[]H_PFm H_Gmh. - by rewrite H_Gmh/=oget_some/=(@take_nth witness) 1:/# build_hpath_prefix/#. + by rewrite H_Gmh/= (@take_nth witness) 1:/# build_hpath_prefix/#. - rewrite/#. - rewrite/#. - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. @@ -2080,7 +2076,7 @@ proof. move=>[]b2 c2 h2[]H_PFm H_Gmh. cut[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). rewrite!take_take !min_lel 1,2:/# nth_take 1,2:/# H2/==>[][]<<-<<-<-. - rewrite H_PFm/=oget_some/=(@take_nth witness)1:/#. + rewrite H_PFm/=(@take_nth witness)1:/#. by cut[]help1 help2/# :=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. alias{1} 1 prefixes = Redo.prefixes;sp. @@ -2193,7 +2189,7 @@ proof. 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/=oget_some/=/#. + + by rewrite!get_setE/= /#. move=>h H_dom;rewrite!get_setE h/=. cut[]H2mp01 H2mp02 H2mp1 H2mp2 H2mp3:=H_m_p0. rewrite-Hp1;1:smt(domE). @@ -2323,11 +2319,11 @@ proof. apply (notin_hs_notdomE2_mh FRO.m{2} PF.mi{1})=>//=. by apply ch_notdomE_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - rewrite!get_setE/=oget_some. + rewrite!get_setE/=. apply (m_mh_addh_addm _ H_m_mh H_huniq H_h _)=>//=. by apply ch_notdomE_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - rewrite!get_setE/=oget_some;apply (mi_mhi_addh_addmi _ H_mi_mhi _ H_h _)=>//=. + rewrite!get_setE/=;apply (mi_mhi_addh_addmi _ H_mi_mhi _ H_h _)=>//=. - smt(hinvP). by apply ch_notdomE_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + apply incl_upd_nin=>//=. @@ -2350,7 +2346,7 @@ proof. rewrite H_h/=. exists sc{1} f y2L Unknown=>//=. exists (take i{2} bs{1}) (sa{2})=>//=;rewrite get_setE Block.WRing.addKr/=. - rewrite oget_some/=(@take_nth witness)/=;1:smt(prefix_ge0). + rewrite/=(@take_nth witness)/=;1:smt(prefix_ge0). by apply build_hpath_up=>//=;smt(domE). move=> neq h1. cut[]hh1 hh2 hh3:=H_mh_spec. @@ -2367,7 +2363,7 @@ proof. by cut:=hb;rewrite H_path/==>[][->>->>]/=;rewrite-hbex Block.WRing.addKr/=. - progress. * move:H13;rewrite get_setE/=H_take_Si/=. - case(p0 = (take i{2} bs{1}))=>[->>|hpp0];rewrite!get_setE/=!oget_some/=. + case(p0 = (take i{2} bs{1}))=>[->>|hpp0];rewrite!get_setE/=. + cut->/=:=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/=. @@ -2388,7 +2384,7 @@ proof. cut 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/=H14/=. by apply build_hpath_up=>//=. - move:H13 H14;rewrite!get_setE/=!oget_some/==>h_build_hpath_set. + move:H13 H14;rewrite!get_setE/= =>h_build_hpath_set. case(hy = G1.chandle{2})=>//=[->>|hy_neq_ch]/=. + move=>h;cut h_eq:v +^ bn = sa{2} +^ nth witness bs{1} i{2} && hx = h{2}. + cut/#:G1.mh{2}.[(v +^ bn, hx)] <> Some (b0, G1.chandle{2}). @@ -2433,7 +2429,7 @@ proof. progress. + cut:=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. cut:=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:H13 H14;rewrite!get_setE/=!oget_some/==>H13 H14;rewrite H13 H14. + move:H13 H14;rewrite!get_setE/= =>H13 H14;rewrite H13 H14. cut->/=:=ch_neq0 _ _ H_hs_spec. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. @@ -2460,7 +2456,7 @@ proof. by have[#]->>->>:=HH3 _ _ _ _ _ hp21 hp11. cut:=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. cut:=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:H13 H14;rewrite!get_setE/=!oget_some/==>H13 H14;rewrite H13 H14/=. + move:H13 H14;rewrite!get_setE/= =>H13 H14;rewrite H13 H14/=. cut->/=:=ch_neq0 _ _ H_hs_spec. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. @@ -2485,8 +2481,8 @@ proof. by have[#]->><<-//=:=HH3 _ _ _ _ _ hp11 H_path. move=>hp21 hp11. by have[#]->>->>:=HH3 _ _ _ _ _ hp21 hp11. - + rewrite!get_setE/=oget_some;exact H2_pi_spec. - + rewrite!get_setE/=!oget_some/=. + + rewrite!get_setE/=;exact H2_pi_spec. + + rewrite!get_setE/=. cut H_m_p:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut H_all_prefixes:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. split;case:H_m_p=>//=Hmp01 Hmp02 Hmp1 Hmp2 Hmp3. @@ -2509,7 +2505,7 @@ proof. 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/=oget_some/=/#. + + by rewrite!get_setE/= /#. move=>h H_dom;rewrite!get_setE h/=. cut[]H2mp01 H2mp02 H2mp1 H2mp2 H2mp3:=H_m_p0. rewrite-Hp1;1:smt(domE). @@ -2528,12 +2524,12 @@ proof. 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/=oget_some;smt(domE). + + rewrite!get_setE/=;smt(domE). + smt(get_setE domE take_take size_take prefix_ge0 nth_take take_oversize take_le0). - + rewrite!get_setE/=oget_some;smt(domE). + + rewrite!get_setE/=;smt(domE). + rewrite/#. - + by rewrite!get_setE/=oget_some/#. - + rewrite!get_setE/=oget_some(@take_nth witness);1:smt(prefix_ge0);rewrite build_hpath_prefix. + + by rewrite!get_setE/=/#. + + rewrite!get_setE/=(@take_nth witness);1:smt(prefix_ge0);rewrite build_hpath_prefix. cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. - smt(prefix_ge0). @@ -2543,7 +2539,7 @@ proof. cut->/=:=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/=oget_some. + + by rewrite!get_setE. rewrite!mem_set negb_or/=;split;2:smt(prefix_ge0 size_take prefix_ge0 take_oversize). cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. cut:=Hp2 (take (i{2} + 1 + 1) bs{1}). diff --git a/sha3/proof/smart_counter/SLCommon.ec b/sha3/proof/smart_counter/SLCommon.ec index 5480815..2fa773b 100644 --- a/sha3/proof/smart_counter/SLCommon.ec +++ b/sha3/proof/smart_counter/SLCommon.ec @@ -156,7 +156,7 @@ case: {-1}(foldl _ _ _) (eq_refl (foldl (step_hpath mh) (Some (b0,0)) p))=> //=. + smt(size_rcons size_ge0). move=> ^/rconssI <<- {p'} /rconsIs ->> {b}. by rewrite /build_hpath=> ->. -move=> [v' h']; rewrite oget_some /= -/(build_hpath _ _)=> build. +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'']. @@ -442,7 +442,7 @@ lemma prefix_max_prefix_eq_size (l1 l2 : 'a list) (ll : 'a list list) : proof. move:l1 l2;elim:ll=>//=;1:smt(prefix_eq). move=>l3 ll Hind l1 l2[->|[->|h1]]. -+ rewrite prefix_eq max_prefix_eq;smt(max_prefix_eq prefix_eq prefix_sizer). ++ 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. cut h1:prefix l3 l2 = size l3 by smt(prefix_sizel). @@ -799,156 +799,6 @@ case(a=x)=>//=hax. by rewrite Hinv/#. qed. -(** ???? -op blocksponge (l : block list) (m : (state, state) fmap) (bc : state) = - with l = "[]" => (l,bc) - with l = (::) b' l' => - let (b,c) = (bc.`1,bc.`2) in - if ((b +^ b', c) \in m) then blocksponge l' m (oget m.[(b +^ b', c)]) - else (l,(b,c)). - -op s0 : state = (b0,c0). - -lemma blocksponge_size_leq l m bc : - size (blocksponge l m bc).`1 <= size l. -proof. -move:m bc;elim l=>//=. -move=>e l Hind m bc/#. -qed. - - -lemma blocksponge_set l m bc x y : - (x \in m => y = oget m.[x]) => - let bs1 = blocksponge l m bc in - let bs2 = blocksponge l m.[x <- y] bc in - let l1 = bs1.`1 in let l2 = bs2.`1 in let bc1 = bs1.`2 in let bc2 = bs2.`2 in - size l2 <= size l1 /\ (size l1 = size l2 => (l1 = l2 /\ bc1 = bc2)). -proof. -move=>Hxy/=;split. -+ move:m bc x y Hxy;elim l=>//=. - move=>/=e l Hind m bc x y Hxy/=;rewrite dom_set in_fsetU1. - case((bc.`1 +^ e, bc.`2) = x)=>//=[->//=|hx]. - + rewrite getP/=oget_some;case(x\in dom m)=>//=[/#|]. - smt(blocksponge_size_leq getP). - rewrite getP hx/=. - case((bc.`1 +^ e, bc.`2) \in dom m)=>//=Hdom. - by cut//:=Hind m (oget m.[(bc.`1 +^ e, bc.`2)]) x y Hxy. -move:m bc x y Hxy;elim l=>//=. -move=>e l Hind m bx x y Hxy. -rewrite!dom_set !in_fsetU1 !getP. -case((bx.`1 +^ e, bx.`2) \in dom m)=>//=Hdom. -+ case(((bx.`1 +^ e, bx.`2) = x))=>//=Hx. - + move:Hdom;rewrite Hx=>Hdom. - cut:=Hxy;rewrite Hdom/==>Hxy2. - rewrite oget_some -Hxy2/=. - by cut:=Hind m y x y Hxy. - by cut:=Hind m (oget m.[(bx.`1 +^ e, bx.`2)]) x y Hxy. -case(((bx.`1 +^ e, bx.`2) = x))=>//=;smt(blocksponge_size_leq). -qed. - - -lemma blocksponge_cat m l1 l2 bc : - blocksponge (l1 ++ l2) m bc = - let lbc = blocksponge l1 m bc in - blocksponge (lbc.`1 ++ l2) m (lbc.`2). -proof. -rewrite/=. -move:m bc l2;elim l1=>//= e1 l1 Hind m bc b. -case((bc.`1 +^ e1, bc.`2) \in dom m)=>//=[|->//=]Hdom. -by cut//:=Hind m (oget m.[(bc.`1 +^ e1, bc.`2)]) b. -qed. - - -lemma blocksponge_rcons m l bc b : - blocksponge (rcons l b) m bc = - let lbc = blocksponge l m bc in - blocksponge (rcons lbc.`1 b) m (lbc.`2). -proof. -by rewrite/=-2!cats1 blocksponge_cat/=. -qed. - - -(* lemma prefix_inv_bs_fst_nil queries prefixes m : *) -(* prefix_inv queries prefixes m => *) -(* forall l, l \in dom queries => *) -(* forall i, 0 <= i <= size l => *) -(* (blocksponge (take i l) m s0).`1 = []. *) -(* proof. *) -(* move=>[h2 [h3 Hinv]] l Hdom i [Hi0 Hisize];move:i Hi0 l Hisize Hdom;apply intind=>//=. *) -(* + by move=>l;rewrite take0/=. *) -(* move=>i Hi0 Hind l Hil Hldom. *) -(* rewrite(take_nth b0)1:/#. *) -(* rewrite blocksponge_rcons/=. *) -(* cut->/=:=Hind l _ Hldom;1:rewrite/#. *) -(* by cut/=->/=/#:=Hinv _ Hldom i. *) -(* qed. *) - - -(* lemma blocksponge_drop l m bc : *) -(* exists i, 0 <= i <= List.size l /\ (blocksponge l m bc).`1 = drop i l. *) -(* proof. *) -(* move:l bc=>l;elim:l=>//=;1:exists 0=>//=;progress. *) -(* case((bc.`1 +^ x, bc.`2) \in dom m)=>//=h. *) -(* + cut[i [[hi0 His] Hi]]:=H (oget m.[(bc.`1 +^ x, bc.`2)]). *) -(* exists(i+1)=>/#. *) -(* cut[i [[hi0 His] Hi]]:=H (oget m.[(bc.`1 +^ x, bc.`2)]). *) -(* exists 0=>/#. *) -(* qed. *) - - -(* lemma prefix_inv_set queries prefixes m x y : *) -(* !x \in dom m => *) -(* prefix_inv queries prefixes m => *) -(* prefix_inv queries prefixes m.[x <- y]. *) -(* proof. *) -(* move=>Hxdom Hpref;progress=>//=. *) -(* + rewrite/#. *) -(* + rewrite/#. *) -(* cut->:blocksponge (take i bs) m.[x <- y] s0 = blocksponge (take i bs) m s0. *) -(* + move:i H2 bs H3 H1;apply intind=>//=i;first smt(take0). *) -(* move=>Hi0 Hind bs Hisize Hbsdom. *) -(* rewrite (take_nth b0)1:/#. *) -(* rewrite 2!blocksponge_rcons/=. *) -(* cut[?[? Hpre]]:=Hpref. *) -(* cut->/=:=prefix_inv_bs_fst_nil _ _ _ Hpref _ Hbsdom i _;1:rewrite/#. *) -(* cut/=->/=:=Hpre _ Hbsdom i _;1:rewrite/#. *) -(* cut->/=:=Hind bs _ Hbsdom;1:rewrite/#. *) -(* cut->/=:=prefix_inv_bs_fst_nil _ _ _ Hpref _ Hbsdom i _;1:rewrite/#. *) -(* rewrite dom_set in_fsetU1. *) -(* cut/=->/=:=Hpre _ Hbsdom i _;1:rewrite/#. *) -(* rewrite getP. *) -(* cut/#:=Hpre _ Hbsdom i _;1:rewrite/#. *) -(* rewrite dom_set in_fsetU1. *) -(* cut[?[? Hpre]]:=Hpref. *) -(* cut/#:=Hpre _ H1 i _;1:rewrite/#. *) -(* qed. *) - - -(* lemma blocksponge_set_nil l m bc x y : *) -(* !x \in dom m => *) -(* let bs1 = blocksponge l m bc in *) -(* let bs2 = blocksponge l m.[x <- y] bc in *) -(* bs1.`1 = [] => *) -(* bs2 = ([], bs1.`2). *) -(* proof. *) -(* rewrite/==>hdom bs1. *) -(* cut/=:=blocksponge_set l m bc x y. *) -(* smt(size_ge0 size_eq0). *) -(* qed. *) - -(* lemma size_blocksponge queries m l : *) -(* prefix_inv queries m => *) -(* size (blocksponge l m s0).`1 <= size l - prefix l (get_max_prefix l (elems (fdom queries))). *) -(* proof. *) -(* move=>Hinv. *) -(* pose l2:=get_max_prefix _ _;pose p:=prefix _ _. search take drop. *) -(* rewrite-{1}(cat_take_drop p l)blocksponge_cat/=. *) -(* rewrite(prefix_take). *) -(* qed. *) - -**) - - end Prefix. export Prefix. @@ -1217,7 +1067,7 @@ lemma hinvP handles c: proof. cut @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := findP (fun (_ : handle) => pred1 c \o fst) handles. - + exists (oget handles.[h]).`2;rewrite oget_some. + + exists (oget handles.[h]).`2. by move: Hmem; rewrite domE; case: (handles.[h])=> //= - []. by cut := H h;rewrite domE /#. qed. @@ -1240,7 +1090,7 @@ lemma hinvKP handles c: proof. rewrite /hinvK. cut @/pred1/= [[h]|][->/=]:= findP (+ pred1 c) (restr Known handles). - + by rewrite oget_some domE restrP;case (handles.[h])=>//= /#. + + by rewrite domE restrP;case (handles.[h])=>//= /#. by move=>+h-/(_ h);rewrite domE restrP => H1/#. qed. @@ -1254,8 +1104,7 @@ qed. lemma huniq_hinvK_h h (handles:handles) c: huniq handles => handles.[h] = Some (c,Known) => hinvK handles c = Some h. proof. - move=> Huniq;case: (hinvK _ _) (hinvKP handles c)=>/= [H|h'];1: by apply H. - by rewrite oget_some=> /Huniq H/H. + by move=> Huniq;case: (hinvK _ _) (hinvKP handles c)=>/= [ H | h' /Huniq H/H //]; apply H. qed. (* -------------------------------------------------------------------------- *) From 0642ceb13c0a5bd4c93b20d1f256e1e806f7b24e Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 16 Dec 2019 21:05:11 +0100 Subject: [PATCH 371/394] fixing proofs to 1.0 --- sha3/proof/SHA3OSecurity.ec | 2 +- sha3/proof/SHA3Security.ec | 18 +++++++++--------- sha3/proof/smart_counter/Gconcl.ec | 10 +++------- sha3/proof/smart_counter/Gconcl_list.ec | 10 ++-------- sha3/proof/smart_counter/Gext.eca | 20 +++++++++----------- sha3/proof/smart_counter/Handle.eca | 24 ++++++++++++------------ 6 files changed, 36 insertions(+), 48 deletions(-) diff --git a/sha3/proof/SHA3OSecurity.ec b/sha3/proof/SHA3OSecurity.ec index 390797d..cd91595 100644 --- a/sha3/proof/SHA3OSecurity.ec +++ b/sha3/proof/SHA3OSecurity.ec @@ -706,7 +706,7 @@ have->:Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), if; 1: auto; 1: smt(); last first. - by conseq=> />; sim; smt(). wp=> />; 1: smt(). - rnd; auto=> />; 1: smt(). + rnd; auto=> />. call(eq_extend); last by auto; smt(). + 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. diff --git a/sha3/proof/SHA3Security.ec b/sha3/proof/SHA3Security.ec index 6c68981..5ea10ab 100644 --- a/sha3/proof/SHA3Security.ec +++ b/sha3/proof/SHA3Security.ec @@ -364,17 +364,17 @@ section Preimage. - smt(). - by rewrite size_cat/=. - by rewrite mem_set; left; rewrite H3. - - rewrite get_setE (H4 _ _ H12). + - rewrite get_setE (H4 _ _ H11). cut/#: !(l1, j) = (x0{2}, size bs0{2}). move:H2; apply absurd=> //=[#] <<- ->>. have[] h1 [] h2 h3 := H1. by apply h2; smt(). - - move:H12; rewrite mem_set. + - 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 {H13} H13 {h} : j < size bs0{2} by smt(). + 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. @@ -711,17 +711,17 @@ section SecondPreimage. - smt(). - by rewrite size_cat/=. - by rewrite mem_set; left; rewrite H3. - - rewrite get_setE (H4 _ _ H12). + - rewrite get_setE (H4 _ _ H11). cut/#: !(l1, j) = (x0{2}, size bs0{2}). move:H2; apply absurd=> //=[#] <<- ->>. have[] h1 [] h2 h3 := H1. by apply h2; smt(). - - move:H12; rewrite mem_set. + - 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 {H13} H13 {h} : j < size bs0{2} by smt(). + 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. @@ -1103,17 +1103,17 @@ section Collision. - smt(). - by rewrite size_cat/=. - by rewrite mem_set; left; rewrite H3. - - rewrite get_setE (H4 _ _ H12). + - rewrite get_setE (H4 _ _ H11). cut/#: !(l1, j) = (x0{2}, size bs0{2}). move:H2; apply absurd=> //=[#] <<- ->>. have[] h1 [] h2 h3 := H1. by apply h2; smt(). - - move:H12; rewrite mem_set. + - 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 {H13} H13 {h} : j < size bs0{2} by smt(). + 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. diff --git a/sha3/proof/smart_counter/Gconcl.ec b/sha3/proof/smart_counter/Gconcl.ec index b11f889..7e9fb9b 100644 --- a/sha3/proof/smart_counter/Gconcl.ec +++ b/sha3/proof/smart_counter/Gconcl.ec @@ -226,15 +226,12 @@ proof. [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=>/>. - wp;rnd;auto;progress[-split];rewrite DCapacity.dunifin_ll /= => ?_?->. - by rewrite !get_setE. + 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=>/>. - wp;rnd;auto;rnd{1};auto;progress[-split]. - rewrite Block.DBlock.supp_dunifin DCapacity.dunifin_ll /==> ?_?->. - by rewrite !get_setE. + 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. @@ -247,8 +244,7 @@ proof. [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=>/>. - wp;rnd;auto;progress[-split];rewrite DCapacity.dunifin_ll /= => ?_?->. - by rewrite !get_setE. + 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. diff --git a/sha3/proof/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec index f286c68..63ae1aa 100644 --- a/sha3/proof/smart_counter/Gconcl_list.ec +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -251,7 +251,6 @@ section Ideal. by rewrite domE H1. - smt(leq_add_in domE). rcondf{2}2;auto;progress. - - smt(DBlock.dunifin_ll). - smt(size_cat size_nseq size_eq0 size_ge0). - smt(). - smt(). @@ -274,7 +273,6 @@ section Ideal. * smt(prefix_ge0). * smt(leq_add_in domE). auto;progress. - - exact DBlock.dunifin_ll. - smt(domE). - smt(domE). - smt(size_ge0). @@ -750,7 +748,7 @@ section Ideal. smt(parse_valid parse_gt0 parseK mem_set formatK). wp 8 5;rnd{1};wp 6 5. conseq(:_==> ={F.RO.m} /\ p{2} = x0{2});progress. - + smt(DBlock.dunifin_ll). smt(last_rcons formatK parseK). + + 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). @@ -772,8 +770,7 @@ section Ideal. smt(parse_valid parse_gt0 parseK mem_set formatK). wp 8 5;rnd{1};wp 6 5. conseq(:_==> ={F2.RO.m} /\ format pp{2} n{2} = x3{2}). - + move=> /> &1 &2 H H0 /= /> [#] H1 H2 m lres. - rewrite DBlock.dunifin_ll /= => ?; rewrite DBlock.supp_dunifin /=. + + 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. @@ -867,7 +864,6 @@ section Ideal. - exact lemma5. rcondf{1}2;auto;progress. - cut[]h1 _ _ _:=H1;cut[]h'1 _:=h1;smt(parseK). - - smt(DBlock.dunifin_ll). - cut[]h1:=H1;cut[]:=h1;smt(parseK). smt(). by if{1};auto;smt(parseK parse_gt0 formatK). @@ -889,7 +885,6 @@ section Ideal. - cut[]_ h1 _ _:=H2;cut[]:=h1;progress. cut:=H7 x0{m} i0{m} (format x0{m} (i0{m} + 1));rewrite H5/==>->//=. cut->/#:=parse_twice _ _ _ H. - - smt(DBlock.dunifin_ll). - cut[]_ h1 _ _:=H2;cut[]h'1 _:=h1;smt(parseK parse_twice). - smt(). by rcondf{1}1;auto;smt(parseK formatK). @@ -909,7 +904,6 @@ section Ideal. - exact lemma5. rcondf{1}2;auto;progress. - cut[]h1 _ _ _:=H1;cut[]h'1 _:=h1;smt(parseK). - - smt(DBlock.dunifin_ll). - cut[]h1:=H1;cut[]:=h1;smt(parseK). smt(). qed. diff --git a/sha3/proof/smart_counter/Gext.eca b/sha3/proof/smart_counter/Gext.eca index a6ad8d9..3c35494 100644 --- a/sha3/proof/smart_counter/Gext.eca +++ b/sha3/proof/smart_counter/Gext.eca @@ -209,7 +209,6 @@ section. + by move=> &m;auto;rewrite /in_dom_with. (* auto=> |>. (* Bug ???? *) *) auto;progress. - + by apply sampleto_ll. + 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]. @@ -220,7 +219,7 @@ section. 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:H6 H2;rewrite /in_dom_with mem_set /#. + 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. @@ -242,7 +241,7 @@ section. x{1} \notin G1.mi{1}). + inline *;auto=> &ml&mr[#]-><-_ _9!-> Hi Hhand _ -> /=. rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. - + rewrite rngE/=; case: H4 =>//= H4. + + rewrite rngE/=; case: H2 =>//= H4. + move:Hi; rewrite/inv_ext1 H4 /= => [][->|] //= [] x h. move=> [#] H5 Hh; right; right. exists x h; rewrite H5 get_set_neqE//=. @@ -250,12 +249,11 @@ section. move: H4; rewrite rngE /= => [][] h Hh; right; left. exists h; rewrite get_set_neqE //=. by move:(Hhand h);rewrite domE Hh /#. - by move:H4;rewrite mem_set /#. + by move:H2;rewrite mem_set /#. if=>//. + inline *;rcondt{2} 4. + by move=> &m;auto;rewrite /in_dom_with. auto;progress. - + by apply sampleto_ll. + 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]. @@ -268,7 +266,7 @@ section. 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:H6 H2;rewrite /in_dom_with mem_set /#. + 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. @@ -593,7 +591,7 @@ section EXT. 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. + 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 ???]. @@ -625,8 +623,8 @@ section EXT. + 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 3? -> /=. - rewrite/Distr.is_lossless (sampleto_ll 0)/= => ? _;rewrite /bad_ext !get_setE /= set_set_eqE //=. + 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. @@ -647,8 +645,8 @@ section EXT. + 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 3?->/=. - rewrite/Distr.is_lossless (sampleto_ll 0) /= => ? _;rewrite /bad_ext !get_setE /= set_set_eqE //=. + 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. diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index 47c8007..7b6143e 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -1413,7 +1413,7 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] 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 -> /=. + 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. @@ -1448,7 +1448,7 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] 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 -> /=. + rewrite (@huniq_hinvK_h hx2) // oget_some /= => y1 ? /= y2 ? /=. case: (hinvP hs y2)=> [_ y2_notrngE1_hs _ _|/#]. rewrite get_setE /=. apply/lemma2'=> //. @@ -1673,7 +1673,7 @@ call(: !G1.bcol{2} 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 -> /=. + 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 => /= ;cut[]_->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. @@ -1801,7 +1801,7 @@ call(: !G1.bcol{2} + 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 [#] !<<- -> -> ->> _ /=; rewrite Block.DBlock.dunifin_ll Capacity.DCapacity.dunifin_ll /=. + 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. @@ -2285,7 +2285,7 @@ proof. * rewrite/#. * by rewrite!get_setE/=. * cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. - cut:=H12;rewrite !negb_or/==>[][][]bad1 hinv_none bad2. + cut:=H10;rewrite !negb_or/==>[][][]bad1 hinv_none bad2. cut H_hs_spec:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut H_mh_spec:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut H_m_mh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. @@ -2300,11 +2300,11 @@ proof. G1.mh{2}.[(sa{2} +^ nth witness bs{1} i{2}, h{2}) <- (y1L, G1.chandle{2})] G1.paths{2}. + split;progress. - - cut[]h:=H_pi_spec;cut:=h c p0 v;rewrite H13/==>[][]h1[] h'1 h'2. + - cut[]h:=H_pi_spec;cut:=h c p0 v;rewrite H11/==>[][]h1[] h'1 h'2. exists h1;rewrite -h'2 get_setE/=. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h'2. by apply build_hpath_up=>//=. - move:H14;rewrite get_setE/==>hh0. + move:H12;rewrite get_setE/==>hh0. cut h0_neq_ch:h0 <> G1.chandle{2} by rewrite/#. cut[]->:=H_pi_spec;rewrite-hh0 h0_neq_ch/=;exists h0=>/=. cut:=H;cut:=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. @@ -2362,7 +2362,7 @@ proof. cut hbex:b +^ x = nth witness bs{1} i{2} by rewrite/#. by cut:=hb;rewrite H_path/==>[][->>->>]/=;rewrite-hbex Block.WRing.addKr/=. - progress. - * move:H13;rewrite get_setE/=H_take_Si/=. + * move:H11;rewrite get_setE/=H_take_Si/=. case(p0 = (take i{2} bs{1}))=>[->>|hpp0];rewrite!get_setE/=. + cut->/=:=build_hpath_up _ _ _ y1L G1.chandle{2} _ _ _ H_path h_g1. case(bn = (nth witness bs{1} i{2}))=>[->> /= ->>|hbni]/=. @@ -2382,9 +2382,9 @@ proof. cut[]_ hh4 _:=H_mh_spec. cut:=hh4 p0 bn b0;rewrite h_ro_p_bn/==>[][];progress. cut 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/=H14/=. + exists v hx hy=>//=;rewrite get_setE;rewrite eq_sym in help;rewrite help/=H12/=. by apply build_hpath_up=>//=. - move:H13 H14;rewrite!get_setE/= =>h_build_hpath_set. + move:H11 H12;rewrite!get_setE/= =>h_build_hpath_set. case(hy = G1.chandle{2})=>//=[->>|hy_neq_ch]/=. + move=>h;cut h_eq:v +^ bn = sa{2} +^ nth witness bs{1} i{2} && hx = h{2}. + cut/#:G1.mh{2}.[(v +^ bn, hx)] <> Some (b0, G1.chandle{2}). @@ -2429,7 +2429,7 @@ proof. progress. + cut:=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. cut:=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:H13 H14;rewrite!get_setE/= =>H13 H14;rewrite H13 H14. + move:H11 H12;rewrite!get_setE/= =>H13 H14;rewrite H13 H14. cut->/=:=ch_neq0 _ _ H_hs_spec. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. @@ -2456,7 +2456,7 @@ proof. by have[#]->>->>:=HH3 _ _ _ _ _ hp21 hp11. cut:=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. cut:=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:H13 H14;rewrite!get_setE/= =>H13 H14;rewrite H13 H14/=. + move:H11 H12;rewrite!get_setE/= =>H13 H14;rewrite H13 H14/=. cut->/=:=ch_neq0 _ _ H_hs_spec. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. From 57beeed06d29e055071216fe8d08f934432980db Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Sun, 5 Jan 2020 16:31:47 -0500 Subject: [PATCH 372/394] fix proofs --- sha3/proof/Sponge.ec | 2 +- sha3/proof/smart_counter/Handle.eca | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 3df0fd1..57fcec4 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -1393,7 +1393,7 @@ skip=> split. split. split=> [// | _]; rewrite i1_eq_i2_tim_r; smt(ge0_r). split=> //. split; first smt(). split=> //. split; first by rewrite /= take0 cats0. split=> //. -clear bs1; move=> bs1 i1'. +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. diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index 7b6143e..34e5df6 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -669,7 +669,7 @@ lemma build_hpath_prefix mh p b 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 <<- {b'} /rconssI <<- {p'}; exists v' h'. ++ by move=> ^/rconsIs <<- /rconssI <<-; exists v' h'. exact/(Extend _ _ _ _ _ Hhpath Hmh). qed. @@ -1194,7 +1194,7 @@ split. 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!<<- {xct fxt} [#] 2!<<- {yct fyt} Pmi_yayc. + 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. @@ -1658,7 +1658,7 @@ call(: !G1.bcol{2} + 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=> [#] !<<- {xc0 xf0}; rewrite PFm_x1x2. + by move=> [#]; rewrite hs_hx2=> [#] !<<-; rewrite PFm_x1x2. rcondt{2} 15. + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. by rewrite domE pi_x2. @@ -1776,7 +1776,7 @@ call(: !G1.bcol{2} 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=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0}. + 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}). @@ -1788,7 +1788,7 @@ call(: !G1.bcol{2} - by rewrite domE;cut[]_->_ _ _/=:=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=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0} /= [p0 v0] [#] Hro Hpath. + 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. From 726a71844a7c649fc7896b59ce275dd0d1de285b Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Mon, 6 Jan 2020 06:10:04 -0500 Subject: [PATCH 373/394] fix proofs --- sha3/proof/smart_counter/SLCommon.ec | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sha3/proof/smart_counter/SLCommon.ec b/sha3/proof/smart_counter/SLCommon.ec index 2fa773b..37f6ceb 100644 --- a/sha3/proof/smart_counter/SLCommon.ec +++ b/sha3/proof/smart_counter/SLCommon.ec @@ -154,14 +154,14 @@ 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 <<- {p'} /rconsIs ->> {b}. + 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 <<- {p'} /rconsIs <<- {b'}. +move=> ^/rconssI <<- /rconsIs <<-. by rewrite build /= => [#] <*>. qed. From 498c7ec1bb1f12bfb54b0438d9b1dafd689db2f2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 11 Feb 2020 19:22:48 +0000 Subject: [PATCH 374/394] Update to follow EasyCrypt 1.0 --- sha3/proof/Common.ec | 11 +++++++---- sha3/proof/smart_counter/ConcreteF.eca | 12 ++++++------ 2 files changed, 13 insertions(+), 10 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 72d1d38..1f66658 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -1,7 +1,7 @@ (*------------------- Common Definitions and Lemmas --------------------*) require import Core Int IntExtra IntDiv Real List Distr. require import Ring StdRing StdOrder StdBigop BitEncoding DProd. -require (*--*) FinType BitWord IdealPRP Monoid. +require (*--*) FinType BitWord PRP Monoid. (*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv. pragma +implicits. @@ -104,13 +104,16 @@ by rewrite addzC (@last_nonempty y z). qed. (*------------------------------ Primitive -----------------------------*) +clone export PRP as PRPt with + type D <- block * capacity. -clone export IdealPRP as Perm 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] "RandomPermutation" as "Perm" + [module] "RP" as "Perm" proof dD_ll. realize dD_ll. by apply/dprod_ll; rewrite Block.DBlock.dunifin_ll Capacity.DCapacity.dunifin_ll. diff --git a/sha3/proof/smart_counter/ConcreteF.eca b/sha3/proof/smart_counter/ConcreteF.eca index f20a1f8..904f061 100644 --- a/sha3/proof/smart_counter/ConcreteF.eca +++ b/sha3/proof/smart_counter/ConcreteF.eca @@ -77,7 +77,7 @@ section. lemma size_behead (l : 'a list) : l <> [] => size (behead l) = size l - 1. proof. by case l=> // ?? /=; ring. qed. - local module (D': PRPt.Distinguisher) (P' : PRPt.Oracles) = { + local module (D': PRPSec.Distinguisher) (P' : PRPSec.SPRP_Oracles) = { proc distinguish () : bool = { var b : bool; Redo.init(); @@ -86,9 +86,9 @@ section. } }. - local lemma DoubleBounding (P <: PRPt.StrongPRP {D, C, DBounder, Redo}) &m: - Pr[PRPt.IND(P,D').main() @ &m: res] - = Pr[PRPt.IND(P,DBounder(D')).main() @ &m: res]. + 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. @@ -388,13 +388,13 @@ section. 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[PRPt.IND(PRPi.PRPi,DBounder(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. by proc; if=> //=; auto. have ->: Pr[CF(DRestr(D)).main() @ &m: res] - = Pr[PRPt.IND(ARP,DBounder(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})=> //=. From c8ea42e560696a5b19d79841f9b63d285d3585cc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 11 Feb 2020 19:36:42 +0000 Subject: [PATCH 375/394] Update to follow EasyCrypt 1.0 Drop '=' as notation for assignments --- sha3/proof/smart_counter/Gcol.eca | 2 +- sha3/proof/smart_counter/Gext.eca | 4 ++-- sha3/proof/smart_counter/SLCommon.ec | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/sha3/proof/smart_counter/Gcol.eca b/sha3/proof/smart_counter/Gcol.eca index 5fa1634..9414347 100644 --- a/sha3/proof/smart_counter/Gcol.eca +++ b/sha3/proof/smart_counter/Gcol.eca @@ -35,7 +35,7 @@ section PROOF. var count : int proc sample_c () = { - var c=c0; + var c <- c0; if (card (image fst (frng FRO.m)) <= 2*max_size /\ count < max_size) { c <$ cdistr; diff --git a/sha3/proof/smart_counter/Gext.eca b/sha3/proof/smart_counter/Gext.eca index 3c35494..2902362 100644 --- a/sha3/proof/smart_counter/Gext.eca +++ b/sha3/proof/smart_counter/Gext.eca @@ -319,7 +319,7 @@ section EXT. /\ 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 ; + count <- count + 1 ; } } @@ -329,7 +329,7 @@ section EXT. 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; + count <- count + 1; } } diff --git a/sha3/proof/smart_counter/SLCommon.ec b/sha3/proof/smart_counter/SLCommon.ec index 37f6ceb..75541eb 100644 --- a/sha3/proof/smart_counter/SLCommon.ec +++ b/sha3/proof/smart_counter/SLCommon.ec @@ -893,7 +893,7 @@ module FC(F:FUNCTIONALITY) = { module DFRestr(F:DFUNCTIONALITY) = { proc f (bs:block list) = { - var b= b0; + 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))); From bc304d47450c9bf460eb498674c1aaf62d0e5249 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 1 Apr 2020 14:16:15 +0100 Subject: [PATCH 376/394] Update to follow EasyCrypt 1.0 Issues remain with Jasmin standard libs --- sha3/proof/Common.ec | 2 +- sha3/proof/IRO.eca | 15 +++++-- sha3/proof/SHA3OSecurity.ec | 15 ++++--- sha3/proof/SHA3Security.ec | 6 +-- sha3/proof/Sponge.ec | 56 +++++++++++++------------ sha3/proof/smart_counter/Gconcl_list.ec | 5 ++- 6 files changed, 57 insertions(+), 42 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 1f66658..60b759b 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -284,7 +284,7 @@ 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. +rewrite /mkpad -cats1 //= index_cat mem_nseq size_nseq. by rewrite max_ler // /num0 modz_ge0 gtr_eqF ?gt0_r. qed. diff --git a/sha3/proof/IRO.eca b/sha3/proof/IRO.eca index bad01db..6d72077 100644 --- a/sha3/proof/IRO.eca +++ b/sha3/proof/IRO.eca @@ -42,8 +42,11 @@ module IRO : IRO = { } proc fill_in(x, n) = { + var r; + if ((x,n) \notin mp) { - mp.[(x,n)] <$ dto; + r <$ dto; + mp.[(x,n)] <- r; } return oget mp.[(x,n)]; } @@ -72,12 +75,13 @@ module IRO' : IRO = { var visible : (from * int) fset proc resample_invisible() = { - var work, x; + var work, x, r; work <- fdom mp `\` visible; while (work <> fset0) { x <- pick work; - mp.[x] <$ dto; + r <$ dto; + mp.[x] <- r; work <- work `\` fset1 x; } } @@ -88,8 +92,11 @@ module IRO' : IRO = { } proc fill_in(x,n) = { + var r; + if ((x,n) \notin mp) { - mp.[(x,n)] <$ dto; + r <$ dto; + mp.[(x,n)] <- r; } return oget mp.[(x,n)]; } diff --git a/sha3/proof/SHA3OSecurity.ec b/sha3/proof/SHA3OSecurity.ec index cd91595..1c7fc62 100644 --- a/sha3/proof/SHA3OSecurity.ec +++ b/sha3/proof/SHA3OSecurity.ec @@ -218,7 +218,7 @@ local module Log = { local module ExtendOutputSize (F : Oracle) : ODFUNCTIONALITY = { proc f (x : bool list, k : int) = { - var o, l, suffix, prefix, i; + var o, l, suffix, prefix, i, r; l <- None; prefix <- []; suffix <- []; @@ -227,7 +227,8 @@ local module ExtendOutputSize (F : Oracle) : ODFUNCTIONALITY = { i <- size_out; while (i < k) { if ((x,i) \notin Log.m) { - Log.m.[(x,i)] <$ {0,1}; + r <$ {0,1}; + Log.m.[(x,i)] <- r; } suffix <- rcons suffix (oget Log.m.[(x,i)]); i <- i + 1; @@ -937,7 +938,7 @@ local module Log = { local module ExtendOutputSize (F : Oracle) : ODFUNCTIONALITY = { proc f (x : bool list, k : int) = { - var o, l, suffix, prefix, i; + var o, l, suffix, prefix, i, r; l <- None; prefix <- []; suffix <- []; @@ -946,7 +947,8 @@ local module ExtendOutputSize (F : Oracle) : ODFUNCTIONALITY = { i <- size_out; while (i < k) { if ((x,i) \notin Log.m) { - Log.m.[(x,i)] <$ {0,1}; + r <$ {0,1}; + Log.m.[(x,i)] <- r; } suffix <- rcons suffix (oget Log.m.[(x,i)]); i <- i + 1; @@ -1815,7 +1817,7 @@ local module Log = { local module ExtendOutputSize (F : Oracle) : ODFUNCTIONALITY = { proc f (x : bool list, k : int) = { - var o, l, suffix, prefix, i; + var o, l, suffix, prefix, i, r; l <- None; prefix <- []; suffix <- []; @@ -1824,7 +1826,8 @@ local module ExtendOutputSize (F : Oracle) : ODFUNCTIONALITY = { i <- size_out; while (i < k) { if ((x,i) \notin Log.m) { - Log.m.[(x,i)] <$ {0,1}; + r <$ {0,1}; + Log.m.[(x,i)] <- r; } suffix <- rcons suffix (oget Log.m.[(x,i)]); i <- i + 1; diff --git a/sha3/proof/SHA3Security.ec b/sha3/proof/SHA3Security.ec index 5ea10ab..049454c 100644 --- a/sha3/proof/SHA3Security.ec +++ b/sha3/proof/SHA3Security.ec @@ -359,7 +359,7 @@ section Preimage. have:=h2 x0{hr}; rewrite H2/= negb_exists/= =>/(_ (size bs0{hr})). rewrite size_ge0 H9/=; apply absurd =>/= h. by have //=:= H5 _ _ h. - rnd; auto; progress. + wp; rnd; auto; progress. - smt(size_ge0). - smt(). - by rewrite size_cat/=. @@ -706,7 +706,7 @@ section SecondPreimage. have:=h2 x0{hr}; rewrite H2/= negb_exists/= =>/(_ (size bs0{hr})). rewrite size_ge0 H9/=; apply absurd =>/= h. by have //=:= H5 _ _ h. - rnd; auto; progress. + wp; rnd; auto; progress. - smt(size_ge0). - smt(). - by rewrite size_cat/=. @@ -1098,7 +1098,7 @@ section Collision. have:=h2 x0{hr}; rewrite H2/= negb_exists/= =>/(_ (size bs0{hr})). rewrite size_ge0 H9/=; apply absurd =>/= h. by have //=:= H5 _ _ h. - rnd; auto; progress. + wp; rnd; auto; progress. - smt(size_ge0). - smt(). - by rewrite size_cat/=. diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 57fcec4..062e246 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -291,8 +291,11 @@ module HybridIROLazy : HYBRID_IRO = { } proc fill_in(xs : block list, i : int) = { + var r; + if (! dom mp (xs, i)) { - mp.[(xs, i)] <$ dbool; + r <$ dbool; + mp.[(xs, i)] <- r; } return oget mp.[(xs, i)]; } @@ -324,8 +327,11 @@ module HybridIROEager : HYBRID_IRO = { } proc fill_in(xs : block list, i : int) = { + var r; + if (! dom mp (xs, i)) { - mp.[(xs, i)] <$ dbool; + r <$ dbool; + mp.[(xs, i)] <- r; } return oget mp.[(xs, i)]; } @@ -709,13 +715,12 @@ progress; HybridIROLazy.mp{2} x{1} i{2}) | by apply (lazy_invar_mem_pad2blocks_r2l IRO.mp{1} HybridIROLazy.mp{2} x{1} i{2})]. -rnd; auto; progress; - [by rewrite !get_setE | - by rewrite -(lazy_invar_upd_mem_dom_iff IRO.mp{1}) | - by rewrite (lazy_invar_upd_mem_dom_iff IRO.mp{1} HybridIROLazy.mp{2}) | - by rewrite (lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} - x{1} xs2 i{2} n2 mpL) | - by rewrite (lazy_invar_upd_lu_eq IRO.mp{1} HybridIROLazy.mp{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. @@ -746,13 +751,12 @@ progress; HybridIROLazy.mp{2} x{1} i{2}) | by apply (lazy_invar_mem_pad2blocks_r2l IRO.mp{1} HybridIROLazy.mp{2} x{1} i{2})]. -rnd; auto; progress; - [by rewrite !get_setE | - by rewrite -(lazy_invar_upd_mem_dom_iff IRO.mp{1}) | - by rewrite (lazy_invar_upd_mem_dom_iff IRO.mp{1} HybridIROLazy.mp{2}) | - by rewrite (lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} - x{1} xs1 i{2} n1 mpL) | - by rewrite (lazy_invar_upd_lu_eq IRO.mp{1} HybridIROLazy.mp{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. @@ -887,12 +891,12 @@ 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=> //; rnd; auto. +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=> //; rnd; auto. +sp; wp; if=> //; wp; rnd; auto. auto. qed. @@ -1546,7 +1550,7 @@ transitivity{1} 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=> //; rnd; auto. +wp. call (_ : ={HybridIROEager.mp}). if=> //; wp; rnd; auto. skip; progress; smt(ge0_r). auto; smt(). transitivity{2} @@ -1568,7 +1572,7 @@ 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=> //; rnd; auto. +wp. call (_ : ={BlockSponge.BIRO.IRO.mp}). if=> //; wp; rnd; auto. auto; smt(). auto; smt(). unroll{2} 1. rcondt{2} 1; first auto; progress; smt(). @@ -1590,7 +1594,7 @@ 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=> //; rnd; auto. +wp. call (_ : ={HybridIROEager.mp}). if=> //; wp; rnd; auto. auto. auto. transitivity{2} { (bs, i) <@ BlockSpongeTrans.next_block(xs, i, bs); } @@ -1606,7 +1610,7 @@ 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=> //; rnd; skip; smt(). +wp; sp. call (_ : ={BlockSponge.BIRO.IRO.mp}). if=> //; wp; rnd; skip; smt(). auto. qed. @@ -1738,7 +1742,7 @@ 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=> //; rnd; auto. +wp. call (_ : ={HybridIROEager.mp}). if=> //; wp; rnd; auto. auto. auto. (transitivity{2} { (i, bs) <@ BlockSpongeTrans.loop(n1 %/ r, x); } @@ -1755,7 +1759,7 @@ 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=> //; rnd; auto. +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). @@ -1823,14 +1827,14 @@ seq 1 1 : 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 => //; rnd; auto. +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 => //; rnd; auto. +wp; call (_ : ={HybridIROEager.mp}); first if => //; wp; rnd; auto. skip; progress; [smt() | smt() | smt(size_rcons) | rewrite -cats1 take_cat; diff --git a/sha3/proof/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec index 63ae1aa..0b5c1b2 100644 --- a/sha3/proof/smart_counter/Gconcl_list.ec +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -1926,7 +1926,7 @@ module Simulator (F : DFUNCTIONALITY) = { unvalid_map <- empty; } proc f (x : state) : state = { - var p,v,q,k,cs,y,y1,y2; + 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]; @@ -1937,7 +1937,8 @@ module Simulator (F : DFUNCTIONALITY) = { } else { if (0 < k) { if ((q,k-1) \notin unvalid_map) { - unvalid_map.[(q,k-1)] <$ bdistr; + r <$ bdistr; + unvalid_map.[(q,k-1)] <- r; } y1 <- oget unvalid_map.[(q,k-1)]; } else { From 82da58714b8ff09dfbe0bb3f7c78e6eb2dcf4710 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Sun, 19 Apr 2020 09:18:29 +0100 Subject: [PATCH 377/394] Follow EasyCrypt 1.0 --- sha3/proof/SHA3Security.ec | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/sha3/proof/SHA3Security.ec b/sha3/proof/SHA3Security.ec index 049454c..22e1e01 100644 --- a/sha3/proof/SHA3Security.ec +++ b/sha3/proof/SHA3Security.ec @@ -148,7 +148,7 @@ section Preimage. proof. by split;exact invmC'. qed. local lemma useful m mi a : - invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). + Prefix.invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). proof. move=>hinvm nin_dom. cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). @@ -505,7 +505,7 @@ section SecondPreimage. proof. by split;exact invmC'. qed. local lemma useful m mi a : - invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). + Prefix.invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). proof. move=>hinvm nin_dom. cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). @@ -898,7 +898,7 @@ section Collision. proof. by split;exact invmC'. qed. local lemma useful m mi a : - invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). + Prefix.invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). proof. move=>hinvm nin_dom. cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). From 8f371858e92bc706cfcacb3535758e16d02134d1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 1 Apr 2020 18:40:45 +0100 Subject: [PATCH 378/394] Update to follow new ROM libraries --- sha3/proof/IRO.eca | 4 +- sha3/proof/SHA3Indiff.ec | 8 +-- sha3/proof/SHA3OSecurity.ec | 20 +++--- sha3/proof/SHA3_OIndiff.ec | 8 +-- sha3/proof/SecureORO.eca | 16 ++--- sha3/proof/SecureRO.eca | 16 ++--- sha3/proof/Sponge.ec | 32 +++++----- sha3/proof/smart_counter/Gcol.eca | 4 +- sha3/proof/smart_counter/Gconcl.ec | 28 ++++----- sha3/proof/smart_counter/Gconcl_list.ec | 52 ++++++++-------- sha3/proof/smart_counter/Gext.eca | 83 ++++++++++++++----------- sha3/proof/smart_counter/Handle.eca | 20 +++--- sha3/proof/smart_counter/SLCommon.ec | 17 ++--- 13 files changed, 158 insertions(+), 150 deletions(-) diff --git a/sha3/proof/IRO.eca b/sha3/proof/IRO.eca index 6d72077..7c3af6a 100644 --- a/sha3/proof/IRO.eca +++ b/sha3/proof/IRO.eca @@ -79,8 +79,8 @@ module IRO' : IRO = { work <- fdom mp `\` visible; while (work <> fset0) { - x <- pick work; - r <$ dto; + x <- pick work; + r <$ dto; mp.[x] <- r; work <- work `\` fset1 x; } diff --git a/sha3/proof/SHA3Indiff.ec b/sha3/proof/SHA3Indiff.ec index 1e3390d..94a2d64 100644 --- a/sha3/proof/SHA3Indiff.ec +++ b/sha3/proof/SHA3Indiff.ec @@ -148,8 +148,8 @@ section. declare module Dist : DISTINGUISHER{Perm, Gconcl_list.SimLast, IRO, Cntr, BlockSponge.BIRO.IRO, Simulator, BlockSponge.C, Gconcl.S, - SLCommon.F.RO, SLCommon.F.RRO, SLCommon.Redo, SLCommon.C, - Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO, + 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}. axiom Dist_lossless (F <: DFUNCTIONALITY { Dist }) (P <: DPRIMITIVE { Dist }) : @@ -314,8 +314,8 @@ 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.RRO, SLCommon.Redo, SLCommon.C, - Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO, + 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 }), diff --git a/sha3/proof/SHA3OSecurity.ec b/sha3/proof/SHA3OSecurity.ec index 1c7fc62..4272486 100644 --- a/sha3/proof/SHA3OSecurity.ec +++ b/sha3/proof/SHA3OSecurity.ec @@ -179,13 +179,13 @@ clone import Program as PBool with op d <- dbool proof *. -clone import GenEager as Eager with - type from <- bool list * int, - type to <- bool, - op sampleto <- fun _ => dbool, - type input <- unit, - type output <- bool -proof * by smt(dbool_ll). +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. @@ -643,7 +643,7 @@ cut->: 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); inline*; auto=> />. +call(RO_LRO_D Dist dbool_ll); inline*; auto=> />. qed. local lemma rw_ideal_2 &m: @@ -1403,7 +1403,7 @@ cut->: inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. by call eq_eager_ideal2; auto. rewrite eq_sym; byequiv=> //=; proc. -by call(RO_LRO_D Dist); inline*; auto=> />. +by call(RO_LRO_D Dist dbool_ll); inline*; auto=> />. qed. @@ -2281,7 +2281,7 @@ cut->: inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. by call eq_eager_ideal2; auto. rewrite eq_sym; byequiv=> //=; proc. -by call(RO_LRO_D Dist); inline*; auto=> />. +by call(RO_LRO_D Dist dbool_ll); inline*; auto=> />. qed. local equiv toto : diff --git a/sha3/proof/SHA3_OIndiff.ec b/sha3/proof/SHA3_OIndiff.ec index 1900a47..d2723ce 100644 --- a/sha3/proof/SHA3_OIndiff.ec +++ b/sha3/proof/SHA3_OIndiff.ec @@ -171,8 +171,8 @@ section. declare module Dist : ODISTINGUISHER{Perm, Gconcl_list.SimLast, IRO, Cntr, BlockSponge.BIRO.IRO, Simulator, BlockSponge.C, Gconcl.S, - SLCommon.F.RO, SLCommon.F.RRO, SLCommon.Redo, SLCommon.C, - Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO, + 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}. @@ -210,8 +210,8 @@ 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.RRO, SLCommon.Redo, SLCommon.C, - Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO, + 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), diff --git a/sha3/proof/SecureORO.eca b/sha3/proof/SecureORO.eca index cc8ac8f..bcd0a01 100644 --- a/sha3/proof/SecureORO.eca +++ b/sha3/proof/SecureORO.eca @@ -13,13 +13,13 @@ 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, - type input <- unit, - type output <- bool -proof * by exact/sampleto_ll. +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. @@ -261,7 +261,7 @@ section SecondPreimage. Pr [ SecondPreimage3(A,RO).main(mess1) @ &m : res ]. - rewrite eq_sym. byequiv=>//=; proc. - by call(RO_LRO_D (D1(A))); inline*; auto. + by call(RO_LRO_D (D1(A)) sampleto_ll); 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])) diff --git a/sha3/proof/SecureRO.eca b/sha3/proof/SecureRO.eca index 3e0fed3..4510737 100644 --- a/sha3/proof/SecureRO.eca +++ b/sha3/proof/SecureRO.eca @@ -13,13 +13,13 @@ 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, - type input <- unit, - type output <- bool -proof * by exact/sampleto_ll. +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. @@ -281,7 +281,7 @@ section SecondPreimage. Pr [ SecondPreimage3(A,RO).main(mess1) @ &m : res ]. - rewrite eq_sym. byequiv=>//=; proc. - by call(RO_LRO_D (D1(A))); inline*; auto. + by call(RO_LRO_D (D1(A)) sampleto_ll); 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])) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 062e246..343e803 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -3,8 +3,8 @@ require import Core Int IntDiv Real List FSet SmtMap. (*---*) import IntExtra. require import Distr DBool DList. require import StdBigop StdOrder. import IntOrder. -require import Common. -require (*--*) IRO BlockSponge PROM. +require import Common PROM. +require (*--*) IRO BlockSponge. (*------------------------- Indifferentiability ------------------------*) @@ -369,13 +369,13 @@ section. declare module D : HYBRID_IRO_DIST{HybridIROEager, HybridIROLazy}. -local clone PROM.GenEager as ERO with - type from <- block list * int, - type to <- bool, - op sampleto <- fun _ => dbool, - type input <- unit, - type output <- bool - proof sampleto_ll by apply dbool_ll. +local clone 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. +import ERO.FullEager. local module EROExper(O : ERO.RO, D : ERO.RO_Distinguisher) = { proc main() : bool = { @@ -387,12 +387,12 @@ local module EROExper(O : ERO.RO, D : ERO.RO_Distinguisher) = { }. local lemma LRO_RO (D <: ERO.RO_Distinguisher{ERO.RO, ERO.FRO}) &m : - Pr[EROExper(ERO.LRO, D).main() @ &m : res] = + 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. -symmetry; call (ERO.RO_LRO_D D); auto. +symmetry; call (RO_LRO_D D dbool_ll); auto. qed. (* make a Hybrid IRO out of a random oracle *) @@ -424,12 +424,12 @@ local module HIRO(RO : ERO.RO) : HYBRID_IRO = { }. local lemma HybridIROLazy_HIRO_LRO_init : - equiv[HybridIROLazy.init ~ HIRO(ERO.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 ~ ERO.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. @@ -442,11 +442,11 @@ wp; rnd; auto. qed. local lemma HybridIROLazy_HIRO_LRO_f : - equiv[HybridIROLazy.f ~ HIRO(ERO.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 ERO.LRO.sample; sp=> /=. +proc; inline LRO.sample; sp=> /=. if=> //. while{2} (true) (m{2} - i{2}). progress; auto; progress; smt(). @@ -512,7 +512,7 @@ local module RODist(RO : ERO.RO) = { local lemma Exper_HybridIROLazy_LRO &m : Pr[HybridIROExper(HybridIROLazy, D).main() @ &m : res] = - Pr[EROExper(ERO.LRO, RODist).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. diff --git a/sha3/proof/smart_counter/Gcol.eca b/sha3/proof/smart_counter/Gcol.eca index 9414347..3edb93f 100644 --- a/sha3/proof/smart_counter/Gcol.eca +++ b/sha3/proof/smart_counter/Gcol.eca @@ -1,7 +1,7 @@ pragma -oldip. require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. -require import List FSet SmtMap Common SLCommon PROM FelTactic Mu_mem. -require import DProd Dexcepted. +require import List FSet SmtMap Common SLCommon FelTactic Mu_mem. +require import DProd Dexcepted PROM. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. require (*..*) Handle. diff --git a/sha3/proof/smart_counter/Gconcl.ec b/sha3/proof/smart_counter/Gconcl.ec index 7e9fb9b..12d4767 100644 --- a/sha3/proof/smart_counter/Gconcl.ec +++ b/sha3/proof/smart_counter/Gconcl.ec @@ -1,7 +1,7 @@ pragma -oldip. require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. -require import List FSet SmtMap Common SLCommon PROM FelTactic Mu_mem. -require import DProd Dexcepted. +require import List FSet SmtMap Common SLCommon FelTactic Mu_mem. +require import DProd Dexcepted PROM. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. require (*..*) Gext. @@ -116,14 +116,14 @@ local module G3(RO:F.RO) = { } y2 <$ cdistr; y <- (y1, y2); - handles_ <@ RRO.restrK(); + handles_ <@ RRO.allKnown(); if (!rng handles_ x.`2) { RRO.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } - handles_ <- RRO.restrK(); + handles_ <- RRO.allKnown(); hx2 <- oget (hinvc handles_ x.`2); - t <@ RRO.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); + 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); @@ -152,14 +152,14 @@ local module G3(RO:F.RO) = { var y, y1, y2, hx2, hy2, handles_, t; if (x \notin G1.mi) { - handles_ <@ RRO.restrK(); + handles_ <@ RRO.allKnown(); if (!rng handles_ x.`2) { RRO.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } - handles_ <@ RRO.restrK(); + handles_ <@ RRO.allKnown(); hx2 <- oget (hinvc handles_ x.`2); - t <@ RRO.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); + t <@ RRO.queried((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); y1 <$ bdistr; y2 <$ cdistr; y <- (y1,y2); @@ -204,7 +204,7 @@ local module G3(RO:F.RO) = { } }. -local equiv G2_G3: Eager(G2(DRestr(D))).main2 ~ G3(F.LRO).distinguish : ={glob D} ==> ={res}. +local equiv G2_G3: Eager(G2(DRestr(D))).main2 ~ G3(F.FullEager.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. @@ -348,7 +348,7 @@ proof. by sim;inline *;auto;progress;smt(DCapacity.dunifin_ll). qed. -local equiv G4_Ideal : G4(F.LRO).distinguish ~ IdealIndif(IF,S,DRestr(D)).main : +local equiv G4_Ideal : G4(F.FullEager.LRO).distinguish ~ IdealIndif(IF,S,DRestr(D)).main : ={glob D} ==> ={res}. proof. proc;inline *;wp. @@ -356,7 +356,7 @@ proof. + 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. + inline F.FullEager.LRO.get F.FRO.sample;wp 7 2;sim. by while{1} (true) (size p - i){1};auto;1:inline*;auto=>/#. by auto. qed. @@ -376,11 +376,11 @@ lemma Real_Ideal &m: 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.FullEager.LRO).distinguish() @ &m : res]);1:by byequiv G2_G3. apply (eq_trans _ Pr[G3(F.RO ).distinguish() @ &m : res]). - + by byequiv (_: ={glob G3, F.RO.m} ==> _)=>//;symmetry;conseq (F.RO_LRO_D G3). + + by byequiv (_: ={glob G3, F.RO.m} ==> _)=>//;symmetry;conseq (F.FullEager.RO_LRO_D G3 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]);1:by byequiv (F.RO_LRO_D G4). + apply (eq_trans _ Pr[G4(F.FullEager.LRO).distinguish() @ &m : res]);1:by byequiv (F.FullEager.RO_LRO_D G4 Block.DBlock.dunifin_ll). by byequiv G4_Ideal. qed. diff --git a/sha3/proof/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec index 0b5c1b2..6158e27 100644 --- a/sha3/proof/smart_counter/Gconcl_list.ec +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -327,9 +327,9 @@ section Ideal. }. local equiv Ideal_equiv_valid (D <: DISTINGUISHER{SLCommon.C, C, IF, S}) : - L(D,F.LRO).distinguish + L(D,F.FullEager.LRO).distinguish ~ - L2(D,F.LRO).distinguish + L2(D,F.FullEager.LRO).distinguish : ={glob D} ==> ={glob D, res}. proof. @@ -339,7 +339,7 @@ section Ideal. 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. + inline F.FullEager.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. @@ -836,7 +836,7 @@ section Ideal. 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 + L4(D,F.FullEager.LRO,F2.FullEager.LRO).distinguish ~ IdealIndif(BIRO.IRO,SimLast(S),DRestr(D)).main : @@ -912,7 +912,7 @@ section Ideal. 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))))). + D(FC(FValid(DSqueeze2(F.FullEager.LRO, F2))), PC(S(Last(DSqueeze2(F.FullEager.LRO, F2))))). lemma equiv_ideal (D <: DISTINGUISHER{SLCommon.C, C, IF, S, F.FRO, F2.RO, F2.FRO, BIRO.IRO, BIRO2.IRO}) &m: @@ -926,20 +926,20 @@ section Ideal. Pr[SLCommon.IdealIndif(IF,S,A(D)).main() @ &m : res]. + by byequiv(ideal_equiv2 D). cut->:Pr[L2(D, F.RO).distinguish() @ &m : res] = - Pr[L2(D,F.LRO).distinguish() @ &m : res]. + Pr[L2(D,F.FullEager.LRO).distinguish() @ &m : res]. + byequiv=>//=;proc;sp;inline*;sp;wp. - by call(F.RO_LRO_D (D2(D)));auto. + by call(F.FullEager.RO_LRO_D (D2(D)) dunifin_ll);auto. cut->:Pr[IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res] = - Pr[L4(D,F.LRO,F2.LRO).distinguish() @ &m : res]. + Pr[L4(D,F.FullEager.LRO,F2.FullEager.LRO).distinguish() @ &m : res]. + by rewrite eq_sym;byequiv(equiv_L4_ideal D)=>//=. cut<-:Pr[L4(D, F.RO, F2.RO).distinguish() @ &m : res] = - Pr[L4(D,F.LRO,F2.LRO).distinguish() @ &m : res]. + Pr[L4(D,F.FullEager.LRO,F2.FullEager.LRO).distinguish() @ &m : res]. + cut->:Pr[L4(D, F.RO, F2.RO).distinguish() @ &m : res] = - Pr[L4(D,F.LRO, F2.RO).distinguish() @ &m : res]. + Pr[L4(D,F.FullEager.LRO, F2.RO).distinguish() @ &m : res]. - byequiv=>//=;proc;sp;inline*;sp;wp. - by call(F.RO_LRO_D (D5(D)));auto. + by call(F.FullEager.RO_LRO_D (D5(D)) dunifin_ll);auto. byequiv=>//=;proc;sp;inline*;sp;wp. - by call(F2.RO_LRO_D (D6(D)));auto. + by call(F2.FullEager.RO_LRO_D (D6(D)) dunifin_ll);auto. cut<-:Pr[L3(D, F.RO).distinguish() @ &m : res] = Pr[L4(D, F.RO, F2.RO).distinguish() @ &m : res]. + by byequiv(equiv_L3_L4 D)=>//=. @@ -947,9 +947,9 @@ section Ideal. Pr[L3(D, F.RO).distinguish() @ &m : res]. + by byequiv(Ideal_equiv3 D). cut->:Pr[L(D, F.RO).distinguish() @ &m : res] = - Pr[L(D,F.LRO).distinguish() @ &m : res]. + Pr[L(D,F.FullEager.LRO).distinguish() @ &m : res]. + byequiv=>//=;proc;sp;inline*;sp;wp. - by call(F.RO_LRO_D (D3(D)));auto. + by call(F.FullEager.RO_LRO_D (D3(D)) dunifin_ll);auto. rewrite eq_sym. by byequiv(Ideal_equiv_valid D). qed. @@ -1731,7 +1731,7 @@ end section Real. section Real_Ideal. (* REAL & IDEAL *) - declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.RRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO}. + declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.FRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO}. axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : islossless P0.f => islossless P0.fi => islossless F0.f => @@ -1777,7 +1777,7 @@ require import AdvAbsVal. section Real_Ideal_Abs. - declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.RRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO}. + declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.FRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO}. axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : islossless P0.f => islossless P0.fi => islossless F0.f => @@ -1984,13 +1984,13 @@ 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.GenEager as IRO2 with - type from <- block list * int, - type to <- block, - op sampleto <- fun _, bdistr, - type input <- unit, - type output <- bool -proof * by exact/DBlock.dunifin_ll. +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() = { @@ -2128,7 +2128,7 @@ qed. local lemma equal2 &m : Pr [ IdealIndif(BIRO.IRO, Simulator, DRestr(D)).main() @ &m : res ] = - Pr [ L(IRO2.LRO).distinguish() @ &m : res ]. + Pr [ L(IRO2.FullEager.LRO).distinguish() @ &m : res ]. proof. byequiv=>//=; proc; inline*; auto. call (: ={BIRO.IRO.mp,C.c,Simulator.m,Simulator.mi,Simulator.paths} /\ @@ -2160,7 +2160,7 @@ lemma Simplify_simulator &m : 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)=>//=. +by byequiv(RO_LRO_D L dunifin_ll)=>//=. qed. @@ -2171,7 +2171,7 @@ end section Simplify_Simulator. section Real_Ideal. - declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.RRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO, Simulator}. + declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.FRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO, Simulator}. axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : islossless P0.f => islossless P0.fi => islossless F0.f => diff --git a/sha3/proof/smart_counter/Gext.eca b/sha3/proof/smart_counter/Gext.eca index 2902362..977508e 100644 --- a/sha3/proof/smart_counter/Gext.eca +++ b/sha3/proof/smart_counter/Gext.eca @@ -1,7 +1,7 @@ pragma -oldip. require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. -require import List FSet SmtMap Common SLCommon PROM FelTactic Mu_mem. -require import DProd Dexcepted. +require import List FSet SmtMap Common SLCommon FelTactic Mu_mem. +require import DProd Dexcepted PROM. (*...*) import Capacity IntOrder Bigreal RealOrder BRA DCapacity. require (*..*) Gcol. @@ -61,14 +61,14 @@ module G2(D:DISTINGUISHER,HS:FRO) = { } y <- (y1, y2); - handles_ <@ HS.restrK(); + handles_ <@ HS.allKnown(); if (!rng handles_ x.`2) { HS.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } - handles_ <- HS.restrK(); + handles_ <- HS.allKnown(); hx2 <- oget (hinvc handles_ x.`2); - t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); + 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); @@ -99,17 +99,17 @@ module G2(D:DISTINGUISHER,HS:FRO) = { var y, y1, y2, hx2, hy2, handles_, t; if (x \notin G1.mi) { - handles_ <@ HS.restrK(); + handles_ <@ HS.allKnown(); if (!rng handles_ x.`2) { HS.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } - handles_ <@ HS.restrK(); + handles_ <@ HS.allKnown(); hx2 <- oget (hinvc handles_ x.`2); y1 <$ bdistr; y2 <$ cdistr; y <- (y1,y2); - t <@ HS.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); + 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); @@ -153,8 +153,10 @@ module G2(D:DISTINGUISHER,HS:FRO) = { } }. +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) = @@ -193,14 +195,18 @@ section. 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[#]10!-> -> ->->Hi-> Hhand -> /=. - rewrite -dom_restr rng_restr /=;progress;3:by smt ml=0. - + rewrite !rngE /=; move: H0=> [/Hi[->|[x h][]H1 H2]|H0]//. - + by right; right; exists x h; rewrite get_setE; smt(). - right; left; move: H0; rewrite rngE /= => [][] h Hh. - exists h; rewrite get_set_neqE //=. - by have:= Hhand h; rewrite domE Hh /#. - by move: H0; rewrite mem_set /#. + + 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. @@ -239,17 +245,18 @@ section. 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[#]-><-_ _9!-> Hi Hhand _ -> /=. - rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. - + rewrite rngE/=; case: H2 =>//= H4. - + move:Hi; rewrite/inv_ext1 H4 /= => [][->|] //= [] x h. - move=> [#] H5 Hh; right; right. - exists x h; rewrite H5 get_set_neqE//=. - by move:(Hhand h);rewrite domE Hh /#. - move: H4; rewrite rngE /= => [][] h Hh; right; left. - exists h; rewrite get_set_neqE //=. - by move:(Hhand h);rewrite domE Hh /#. - by move:H2;rewrite mem_set /#. + + 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. @@ -385,14 +392,14 @@ section EXT. y <- (y1, y2); (* exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) - handles_ <@ RRO.restrK(); + handles_ <@ RRO.allKnown(); if (!rng handles_ x.`2) { RRO.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } - handles_ <- RRO.restrK(); + handles_ <- RRO.allKnown(); hx2 <- oget (hinvc handles_ x.`2); - t <@ RRO.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); + 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); @@ -423,17 +430,17 @@ section EXT. var y, y1, y2, hx2, hy2, handles_, t; if (x \notin G1.mi) { - handles_ <@ RRO.restrK(); + handles_ <@ RRO.allKnown(); if (!rng handles_ x.`2) { RRO.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } - handles_ <@ RRO.restrK(); + handles_ <@ RRO.allKnown(); hx2 <- oget (hinvc handles_ x.`2); y1 <$ bdistr; y2 <$ cdistr; y <- (y1,y2); - t <@ RRO.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); + 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); @@ -616,8 +623,8 @@ section EXT. (={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.in_dom; wp;call (_: ={FRO.m});1:by sim. - inline RRO.restrK;sp 1 1;if=>//. + + 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=>/#. @@ -638,8 +645,8 @@ section EXT. (={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.in_dom; auto;call (_: ={FRO.m});1:by sim. - inline RRO.restrK;sp 1 1;if=>//. + + 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=>/#. diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index 34e5df6..d87c985 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -1,22 +1,22 @@ pragma -oldip. pragma +implicits. require import Core Int Real StdOrder Ring IntExtra. require import List FSet SmtMap Common SLCommon. -require import DProd Dexcepted PROM. +require import DProd Dexcepted. +require import PROM. (*...*) import Capacity IntOrder DCapacity. -require (*--*) ConcreteF PROM. +require (*--*) ConcreteF. -clone export PROM.GenEager as ROhandle with - type from <- handle, - type to <- capacity, - op sampleto <- fun (_:int) => cdistr, - type input <- unit, - type output <- bool - proof sampleto_ll by apply DCapacity.dunifin_ll. +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 diff --git a/sha3/proof/smart_counter/SLCommon.ec b/sha3/proof/smart_counter/SLCommon.ec index 75541eb..ff3c7f8 100644 --- a/sha3/proof/smart_counter/SLCommon.ec +++ b/sha3/proof/smart_counter/SLCommon.ec @@ -3,7 +3,8 @@ length is the input block size. We prove its security even when padding is not prefix-free. **) require import Core Int Real StdOrder Ring IntExtra. -require import List FSet SmtMap Common PROM Distr DProd Dexcepted. +require import List FSet SmtMap Common Distr DProd Dexcepted. +require import PROM. require (*..*) Indifferentiability. (*...*) import Capacity IntOrder. @@ -39,13 +40,13 @@ op bl_univ = FSet.oflist bl_enum. (* -------------------------------------------------------------------------- *) (* Random oracle from block list to block *) -clone import PROM.GenEager as F with - type from <- block list, - type to <- block, - op sampleto <- fun (_:block list)=> bdistr, - type input <- unit, - type output <- bool - proof * by exact Block.DBlock.dunifin_ll. +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 From eaa355270f96418ab1e6a9fe1e51eefae7514d4d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 6 Jul 2020 16:44:17 +0100 Subject: [PATCH 379/394] Follow 1.0 in sponge proof - Rewriting no longer performs head delta before matching - Rework of number libs and algebraic instances --- sha3/proof/Common.ec | 46 ++++++++++++------------- sha3/proof/SHA3Indiff.ec | 4 +-- sha3/proof/SHA3OSecurity.ec | 6 ++-- sha3/proof/SHA3Security.ec | 19 +++++----- sha3/proof/SHA3_OIndiff.ec | 2 +- sha3/proof/SecureORO.eca | 18 +++++----- sha3/proof/SecureRO.eca | 18 +++++----- sha3/proof/Sponge.ec | 8 ++--- sha3/proof/smart_counter/ConcreteF.eca | 4 +-- sha3/proof/smart_counter/Gcol.eca | 6 ++-- sha3/proof/smart_counter/Gconcl.ec | 4 +-- sha3/proof/smart_counter/Gconcl_list.ec | 46 +++++++++++++------------ sha3/proof/smart_counter/Gext.eca | 4 +-- sha3/proof/smart_counter/Handle.eca | 22 ++++++------ sha3/proof/smart_counter/SLCommon.ec | 40 +++++++++++---------- 15 files changed, 128 insertions(+), 119 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 60b759b..b756760 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -1,5 +1,5 @@ (*------------------- Common Definitions and Lemmas --------------------*) -require import Core Int IntExtra IntDiv Real List Distr. +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. @@ -250,7 +250,7 @@ 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 max_ler. +rewrite /mkpad /= size_rcons size_nseq ler_maxr. by rewrite /num0 modz_ge0 gtr_eqF ?gt0_r. by ring. qed. @@ -285,7 +285,7 @@ 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 max_ler // /num0 modz_ge0 gtr_eqF ?gt0_r. +by rewrite ler_maxr // /num0 modz_ge0 gtr_eqF ?gt0_r. qed. lemma padE (s : bool list, n : int) : @@ -334,8 +334,8 @@ 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 //= max_ler ?subr_ge0 ?ltrW // /j #ring. -+ by rewrite sz_js /= addrC size_nseq max_ler. ++ 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. @@ -509,7 +509,7 @@ 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 max_ler // -addzA. +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. @@ -518,7 +518,7 @@ 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 max_ler //. + 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. @@ -532,8 +532,8 @@ 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 /= max_ler. -apply/(eq_from_nth b0) => [|j]; rewrite ?size_nseq ?max_ler //. + 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. @@ -571,9 +571,9 @@ 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 unpadP (@Unpad (blocks2bits 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 max_ler /#ring. + by rewrite b2b_xs_eq 3!size_cat /= size_nseq ler_maxr /#ring. by apply size_blocks2bits_dvd_r. qed. @@ -602,7 +602,7 @@ 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:max_ler 1:ge0_r // last_cat + 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. @@ -637,14 +637,14 @@ 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 max_ler /#. + 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 max_lel /#. + 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 max_ler 1:ge0_n #ring. + 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). @@ -657,7 +657,7 @@ 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 max_ler 1:ge0_n. ++ 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]. @@ -675,12 +675,12 @@ have sz_drp_plus1_eq_r : size drp + 1 = 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:max_ler 1:ge0_n /= 1:/# + 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:max_ler 1:ge0_n /#. + 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 max_ler /#. +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. @@ -696,16 +696,16 @@ move=> xs_eq. rewrite (@bits2blocks_sing (drp ++ ([true] ++ (nseq n false ++ [true])))) in xs_eq. -+ rewrite !size_cat /= size_nseq max_ler 1:ge0_n 1:sz_drp. ++ 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:max_ler 1:ge0_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 max_ler // in sz_w2b_x_eq_r. +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. @@ -740,6 +740,6 @@ lemma nosmt valid_absorbP (xs : block list) : 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) 2:(@stripK xs). + 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/SHA3Indiff.ec b/sha3/proof/SHA3Indiff.ec index 94a2d64..5cf8ea9 100644 --- a/sha3/proof/SHA3Indiff.ec +++ b/sha3/proof/SHA3Indiff.ec @@ -277,7 +277,7 @@ lemma security &m : (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. proof. rewrite -(replace_simulator &m). -rewrite powS 1:addz_ge0 1:ge0_r 1:ge0_c -pow_add 1:ge0_r 1:ge0_c. +rewrite exprS 1:addz_ge0 1:ge0_r 1:ge0_c exprDn 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). @@ -288,7 +288,7 @@ have -> : 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 powS // pow1 /#. + rewrite exprS // expr1 /#. rewrite -/SLCommon.dstate /limit. cut->:=conclusion (Gconcl_list.SimLast(Gconcl.S)) (DRestr(Dist)) &m. cut//=:=(Gconcl_list.Real_Ideal (LowerDist(Dist)) _ &m). diff --git a/sha3/proof/SHA3OSecurity.ec b/sha3/proof/SHA3OSecurity.ec index 4272486..d513bf6 100644 --- a/sha3/proof/SHA3OSecurity.ec +++ b/sha3/proof/SHA3OSecurity.ec @@ -1,6 +1,6 @@ (* Top-level Proof of SHA-3 Security *) -require import AllCore Distr DList DBool List IntExtra IntDiv Dexcepted DProd SmtMap FSet. +require import AllCore Distr DList DBool List IntDiv Dexcepted DProd SmtMap FSet. require import Common SLCommon Sponge SHA3_OIndiff. require (****) SecureORO SecureHash. (*****) import OIndif. @@ -56,9 +56,9 @@ cut->:inv (2%r ^ size_out) = mu1 (dlist dbool size_out) (to_list x). rewrite StdBigop.Bigreal.BRM.big_const count_predT spec_dout=> {p}. have:=size_out_gt0; move/ltzW. move:size_out;apply intind=> //=. - - by rewrite powr0 iter0 //= fromint1. + - by rewrite RField.expr0 iter0 //= fromint1. move=> i hi0 rec. - by rewrite powrS//iterS// -rec; smt(). + by rewrite RField.exprS//iterS// -rec; smt(). rewrite -dout_equal_dlist dmap1E. apply mu_eq. by move=> l; rewrite /pred1/(\o); smt(to_listK). diff --git a/sha3/proof/SHA3Security.ec b/sha3/proof/SHA3Security.ec index 22e1e01..9a87f94 100644 --- a/sha3/proof/SHA3Security.ec +++ b/sha3/proof/SHA3Security.ec @@ -1,7 +1,8 @@ (* Top-level Proof of SHA-3 Security *) -require import AllCore Distr DList DBool List IntExtra IntDiv Dexcepted DProd SmtMap FSet. +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) = { @@ -50,9 +51,9 @@ cut->:inv (2%r ^ size_out) = mu1 (dlist dbool size_out) (to_list x). rewrite StdBigop.Bigreal.BRM.big_const count_predT spec_dout=> {p}. have:=size_out_gt0; move/ltzW. move:size_out;apply intind=> //=. - - by rewrite powr0 iter0 //= fromint1. + - by rewrite RField.expr0 iter0 //= fromint1. move=> i hi0 rec. - by rewrite powrS//iterS// -rec; smt(). + by rewrite RField.exprS //iterS// -rec; smt(). rewrite -dout_equal_dlist dmap1E. apply mu_eq. by move=> l; rewrite /pred1/(\o); smt(to_listK). @@ -155,7 +156,7 @@ section Preimage. + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. apply dexcepted_ll=>//=;rewrite-prod_ll. cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. - rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. + rewrite Distr.mu_disjoint 1:predCI//=RField.addrC. cut/=->:=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. @@ -380,7 +381,7 @@ section Preimage. - 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 max_ler 1:size_ge0 map_rcons /=get_set_sameE oget_some; congr. + 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(). @@ -512,7 +513,7 @@ section SecondPreimage. + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. apply dexcepted_ll=>//=;rewrite-prod_ll. cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. - rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. + rewrite Distr.mu_disjoint 1:predCI//=RField.addrC. cut/=->:=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. @@ -727,7 +728,7 @@ section SecondPreimage. - 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 max_ler 1:size_ge0 map_rcons /=get_set_sameE oget_some; congr. + 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(). @@ -905,7 +906,7 @@ section Collision. + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. apply dexcepted_ll=>//=;rewrite-prod_ll. cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. - rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. + rewrite Distr.mu_disjoint 1:predCI//=RField.addrC. cut/=->:=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. @@ -1119,7 +1120,7 @@ section Collision. - 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 max_ler 1:size_ge0 map_rcons /=get_set_sameE oget_some; congr. + 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(). diff --git a/sha3/proof/SHA3_OIndiff.ec b/sha3/proof/SHA3_OIndiff.ec index d2723ce..4590e95 100644 --- a/sha3/proof/SHA3_OIndiff.ec +++ b/sha3/proof/SHA3_OIndiff.ec @@ -1,4 +1,4 @@ -require import AllCore List Int IntDiv IntExtra StdOrder Distr SmtMap FSet. +require import AllCore List Int IntDiv StdOrder Distr SmtMap FSet. require import Common Sponge. import BIRO. require (*--*) SLCommon Gconcl_list BlockSponge. diff --git a/sha3/proof/SecureORO.eca b/sha3/proof/SecureORO.eca index bcd0a01..a39eaa3 100644 --- a/sha3/proof/SecureORO.eca +++ b/sha3/proof/SecureORO.eca @@ -1,4 +1,6 @@ require import Int Distr Real SmtMap FSet Mu_mem. +require (*--*) StdOrder. +(*---*) import StdOrder.IntOrder. require (****) PROM FelTactic. @@ -130,9 +132,9 @@ section Preimage. (card (fdom RO.m) <= Bounder.bounder <= bound) =>//. - rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. - rewrite IntExtra.Extrema.max_ler //=; 1:smt(bound_ge0). - rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_ge0). - by rewrite StdRing.RField.intmulr; smt(). + rewrite ler_maxr //=; 1:smt(bound_ge0). + rewrite-RField.AddMonoid.iteropE-RField.intmulpE; 1: smt(bound_ge0). + by rewrite RField.intmulr; smt(). - inline*; auto=> /> &h. rewrite mem_rng_empty /= fdom0 fcards0 /=; smt(bound_ge0). - proc. @@ -284,9 +286,9 @@ section SecondPreimage. (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 IntExtra.Extrema.max_ler //=; 1:smt(bound_ge0). - rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_ge0). - by rewrite StdRing.RField.intmulr; smt(mu_bounded bound_ge0). + 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=> &h 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). @@ -445,7 +447,7 @@ section Collision. (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 StdRing.RField.mulrAC. + + 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=> />. @@ -475,7 +477,7 @@ section Collision. 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 RealExtra.le_fromint; smt(le_card_frng_fdom). + 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). diff --git a/sha3/proof/SecureRO.eca b/sha3/proof/SecureRO.eca index 4510737..143ff55 100644 --- a/sha3/proof/SecureRO.eca +++ b/sha3/proof/SecureRO.eca @@ -1,4 +1,6 @@ require import Int Distr Real SmtMap FSet Mu_mem. +require (*--*) StdOrder. +(*---*) import StdOrder.IntOrder. require (****) PROM FelTactic. @@ -129,9 +131,9 @@ section Preimage. (card (fdom RO.m) <= Bounder.bounder <= bound) =>//. - rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. - rewrite IntExtra.Extrema.max_ler //=; 1:smt(bound_gt0). - rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_gt0). - by rewrite StdRing.RField.intmulr; smt(). + 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. @@ -304,9 +306,9 @@ section SecondPreimage. (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 IntExtra.Extrema.max_ler //=; 1:smt(bound_gt0). - rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_gt0). - by rewrite StdRing.RField.intmulr; smt(mu_bounded bound_gt0). + 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=> />. move=> &h 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). @@ -478,7 +480,7 @@ section Collision. (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 StdRing.RField.mulrAC. + + 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=> />. @@ -509,7 +511,7 @@ section Collision. 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 RealExtra.le_fromint; smt(le_card_frng_fdom). + 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). diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 343e803..122cff2 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -1,8 +1,7 @@ (*------------------------- Sponge Construction ------------------------*) require import Core Int IntDiv Real List FSet SmtMap. -(*---*) import IntExtra. require import Distr DBool DList. -require import StdBigop StdOrder. import IntOrder. +require import Ring StdBigop StdOrder. import IntID IntOrder. require import Common PROM. require (*--*) IRO BlockSponge. @@ -1243,9 +1242,8 @@ have -> /# // : 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 pow1 /#. -by rewrite iterS // IH 1:/# powS // RealExtra.fromintM - StdRing.RField.invfM. +rewrite iter1 expr1 /#. +by rewrite iterS // IH 1:/# exprS // fromintM RField.invfM. qed. (* module for adapting PrLoopSnoc_sample to block generation *) diff --git a/sha3/proof/smart_counter/ConcreteF.eca b/sha3/proof/smart_counter/ConcreteF.eca index 904f061..c913c9e 100644 --- a/sha3/proof/smart_counter/ConcreteF.eca +++ b/sha3/proof/smart_counter/ConcreteF.eca @@ -1,7 +1,7 @@ -require import Core Int Real StdOrder Ring Distr IntExtra. +require import Core Int Real StdOrder Ring Distr. require import List FSet SmtMap Common SLCommon DProd Dexcepted. -(*...*) import Capacity IntOrder RealOrder. +(*...*) import Capacity IntID IntOrder RealOrder. require (*..*) Strong_RP_RF. diff --git a/sha3/proof/smart_counter/Gcol.eca b/sha3/proof/smart_counter/Gcol.eca index 3edb93f..dc462ad 100644 --- a/sha3/proof/smart_counter/Gcol.eca +++ b/sha3/proof/smart_counter/Gcol.eca @@ -1,8 +1,8 @@ pragma -oldip. -require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. +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 IntOrder Bigreal RealOrder BRA. +(*...*) import Capacity IntID IntOrder Bigreal RealOrder BRA. require (*..*) Handle. @@ -12,7 +12,7 @@ import ROhandle. (* TODO: move this *) lemma c_gt0r : 0%r < (2^c)%r. - proof. by rewrite lt_fromint;apply /powPos. qed. + 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. diff --git a/sha3/proof/smart_counter/Gconcl.ec b/sha3/proof/smart_counter/Gconcl.ec index 12d4767..4bbd724 100644 --- a/sha3/proof/smart_counter/Gconcl.ec +++ b/sha3/proof/smart_counter/Gconcl.ec @@ -1,8 +1,8 @@ pragma -oldip. -require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. +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 IntOrder Bigreal RealOrder BRA. +(*...*) import Capacity IntID IntOrder Bigreal RealOrder BRA. require (*..*) Gext. diff --git a/sha3/proof/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec index 6158e27..8378743 100644 --- a/sha3/proof/smart_counter/Gconcl_list.ec +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -1,8 +1,8 @@ pragma -oldip. -require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. +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 IntOrder Bigreal RealOrder BRA. +(*...*) import Capacity IntID IntOrder Bigreal RealOrder BRA. require (*--*) Handle. @@ -1033,13 +1033,13 @@ section Real. + move=>l;rewrite mem_set;case;1:smt(all_prefixes_of_INV_real get_setE). move=>->>j[]hj0 hjsize;rewrite get_setE/=. cut:=hmp1 (format bl (i - 1));rewrite domE H_p_val/==>help. - cut:=hjsize;rewrite !size_cat !size_nseq/=!max_ler 1:/#=>hjsizei. + cut:=hjsize;rewrite !size_cat !size_nseq/=!ler_maxr 1:/#=>hjsizei. cut->/=:!take j (format bl i) = format bl i by smt(size_take). cut 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!max_ler/#. - rewrite!size_take//=1:/#!size_nseq!max_ler 1:/#. + 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 _;cut->/={o}:o = k - size bl by smt(). by progress;rewrite!nth_take//= 1,2:/# !nth_nseq//=/#. case(j < size bl + i - 2)=>hj. @@ -1153,7 +1153,7 @@ section Real. move=>[]j[][]hj0 hjsize ->>. cut:=Hisize;rewrite size_take 1:/#. pose k:=if _ then _ else _;cut->>Hij{k}:k=j by rewrite/#. - by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#;smt(domE). + 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} @@ -1212,7 +1212,7 @@ section Real. 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 min_lel 1:/# min_lel. + * 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. @@ -1227,7 +1227,8 @@ section Real. - move:H15;apply absurd=>//=_;rewrite mem_set. pose x:=_ = _;cut->/={x}:x=false by smt(size_take). move:H12;apply absurd=>//=. - cut:=take_take bl{2}(i0{2} + 1)(i0{2} + 1 + 1);rewrite min_lel 1:/# =><-h. + cut:=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. @@ -1236,7 +1237,8 @@ section Real. 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. - cut:=(take_take bl{2} j i0{2});rewrite min_lel 1:/#=><-. + cut:=(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. @@ -1331,7 +1333,7 @@ section Real. /\ 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 /= max_ler /#. + + 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} @@ -1510,27 +1512,27 @@ section Real. + sp;rcondf{2}1;auto;progress. + rewrite head_nth nth_drop//=. cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{m} _;1:smt(size_take). - move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. + 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//=. cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). - move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. + 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//=. cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). - move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. + 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//=. cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). - move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. + 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//=. cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). - move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. + 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(). @@ -1619,13 +1621,13 @@ section Real. /\ valid p{1});last first. + if{1};auto. + rcondf{2}1;auto;progress. - + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq max_ler/#. + + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq ler_maxr/#. move=>H_dom;rewrite domE. by cut<-:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;rewrite-domE. - + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq max_ler/#;move=>H_dom. + + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq ler_maxr/#;move=>H_dom. by cut:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;smt(domE). + smt(). - + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq max_ler/#;move=>H_dom. + + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq ler_maxr/#;move=>H_dom. by cut:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;smt(domE). sp;if;auto;progress. + move:H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). @@ -1676,14 +1678,14 @@ section Real. + smt(). + move:H9;rewrite take_format/=1:/#;1:smt(size_ge0 size_cat size_nseq). pose x := if _ then _ else _ ;cut->/={x}: x = format p{1} (i_R+1). - + rewrite/x size_cat size_nseq/=!max_ler 1:/#-(addzA _ _ (-1))-(addzA _ _ (-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). cut->>/=: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 _ ;cut->/={x}: x = format p{1} (i_R+1). - + rewrite/x size_cat size_nseq/=!max_ler 1:/#-(addzA _ _ (-1))-(addzA _ _ (-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). cut->>/=:i_R = 0 by smt(). by rewrite take_size/format nseq0 cats0. @@ -1809,7 +1811,7 @@ section Real_Ideal_Abs. + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. apply dexcepted_ll=>//=;rewrite-prod_ll. cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. - rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. + rewrite Distr.mu_disjoint 1:predCI//= RField.addrC. cut/=->:=ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. rewrite Distr.witness_support/predC. move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. @@ -1903,7 +1905,7 @@ section Real_Ideal_Abs. cut := 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!(StdRing.RField.addrA). + 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)). diff --git a/sha3/proof/smart_counter/Gext.eca b/sha3/proof/smart_counter/Gext.eca index 977508e..d46799e 100644 --- a/sha3/proof/smart_counter/Gext.eca +++ b/sha3/proof/smart_counter/Gext.eca @@ -1,8 +1,8 @@ pragma -oldip. -require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. +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 IntOrder Bigreal RealOrder BRA DCapacity. +(*...*) import Capacity IntID IntOrder Bigreal RealOrder BRA DCapacity. require (*..*) Gcol. diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index d87c985..44d8e98 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -1,9 +1,9 @@ pragma -oldip. pragma +implicits. -require import Core Int Real StdOrder Ring IntExtra. +require import Core Int Real StdOrder Ring. require import List FSet SmtMap Common SLCommon. require import DProd Dexcepted. require import PROM. -(*...*) import Capacity IntOrder DCapacity. +(*...*) import Capacity IntID IntOrder DCapacity. require (*--*) ConcreteF. @@ -1336,7 +1336,7 @@ proof. move=>inv0 hi take_i1_p_in_prefixes prefixes_sa_sc build_hpath_i_p ro_prefix hs_h_sc_f. cut[]_ _ m_prefix _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. cut[]b1 c1[]:=m_prefix _ take_i1_p_in_prefixes i _;1:smt(size_take). -rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/# prefixes_sa_sc/==>[][<-<-]{b1 c1}Pm_prefix. +rewrite!take_take!minrE //= (: i <= i + 1) 1:/# nth_take 1,2:/# prefixes_sa_sc/==>[][<-<-]{b1 c1}Pm_prefix. cut[]hh1 hh2 hh3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. move:ro_prefix;cut{1}->:=(take_nth witness i p);1:smt(size_take);move=>h1. cut:=hh2 (take i p) (nth witness p i) (oget prefixes.[take (i + 1) p]).`1. @@ -1846,7 +1846,7 @@ proof. move=>Hinv H_size H_take_iS H_take_i H_hs_h. cut[]_ _ H _ _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. cut[]sa sc:=H _ H_take_iS i _;1:smt(size_take). -rewrite!take_take !min_lel//= 1:/# nth_take 1,2:/#H_take_i=>[][]/=[->>->>] H_pm. +rewrite!take_take !minrE (: i <= i + 1) 1: /# nth_take 1,2:/#H_take_i=>[][]/=[->>->>] H_pm. cut[]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])=> //= - []. @@ -2040,7 +2040,7 @@ proof. move=>[]b2 c2 h2[]H_PFm H_Gmh. rewrite H_Gmh/=. cut[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). - by rewrite!take_take !min_lel 1,2:/# nth_take 1,2:/# H2/==>[][]->>->><-;rewrite H_PFm oget_some. + by rewrite!take_take !minrE (: i{2} <= i{2} + 1) //= 1:/# nth_take 1,2:/# H2/==>[][]->>->><-;rewrite H_PFm oget_some. - rewrite/#. - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. @@ -2051,7 +2051,7 @@ proof. * rewrite/#. move=>[]b2 c2 h2[]H_PFm H_Gmh. cut[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). - rewrite!take_take !min_lel 1,2:/# nth_take 1,2:/# H2/=H_Gmh oget_some=>[][]<<-<<-<-. + rewrite!take_take !minrE (: i{2} <= i{2} + 1) // 1:/# nth_take 1,2:/# H2/=H_Gmh oget_some=>[][]<<-<<-<-. rewrite H_PFm oget_some/=. cut [] help1 help2:= m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by have [] xc fx yc fy [#] /# := help2 _ _ _ _ H_Gmh. @@ -2075,7 +2075,7 @@ proof. * rewrite/#. move=>[]b2 c2 h2[]H_PFm H_Gmh. cut[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). - rewrite!take_take !min_lel 1,2:/# nth_take 1,2:/# H2/==>[][]<<-<<-<-. + rewrite!take_take !minrE (: i{2} <= i{2} + 1) 1:/# nth_take 1,2:/# H2/==>[][]<<-<<-<-. rewrite H_PFm/=(@take_nth witness)1:/#. by cut[]help1 help2/# :=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. @@ -2176,7 +2176,8 @@ proof. cut->/=:(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. cut->/=:! take j (take (i{2} + 1) bs{1}) = take (i{2} + 1) bs{1} by smt(size_take). - rewrite!take_take!min_lel 1,2:/# nth_take 2:/#;1:smt(prefix_ge0). + 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. - cut->/=:!take (j + 1) bs{1} = take (i{2} + 1) bs{1} by smt(size_take). by cut:=Hmp1(take i{2} bs{1}) _ j _; @@ -2397,7 +2398,7 @@ proof. rewrite negb_exists/=;progress;rewrite !negb_and. by cut[]/#:=H_hs_spec. cut[]eq_xor ->>:=h_eq. - move:h;rewrite h_eq/==>->>. + move:h;rewrite eq_xor/==>->>. cut/#:!(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. @@ -2497,7 +2498,8 @@ proof. cut->/=:(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. cut->/=:! take j (take (i{2} + 1) bs{1}) = take (i{2} + 1) bs{1} by smt(size_take). - rewrite!take_take!min_lel 1,2:/# nth_take 2:/#;1:smt(prefix_ge0). + 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. - cut->/=:!take (j + 1) bs{1} = take (i{2} + 1) bs{1} by smt(size_take). by cut:=Hmp1(take i{2} bs{1}) _ j _;smt(domE take_take nth_take prefix_ge0 size_take get_setE). diff --git a/sha3/proof/smart_counter/SLCommon.ec b/sha3/proof/smart_counter/SLCommon.ec index ff3c7f8..76cecbf 100644 --- a/sha3/proof/smart_counter/SLCommon.ec +++ b/sha3/proof/smart_counter/SLCommon.ec @@ -2,7 +2,7 @@ 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 IntExtra. +require import Core Int Real StdOrder Ring. require import List FSet SmtMap Common Distr DProd Dexcepted. require import PROM. @@ -170,7 +170,7 @@ 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 foldl_cat {1}/step_hpath /= emptyE /= [smt(size_rcons size_ge0)]. +by rewrite -{1}cats1 /build_hpath foldl_cat {1}/step_hpath /= emptyE /= [smt(size_rcons size_ge0)]. qed. (* -------------------------------------------------------------------------- *) @@ -243,14 +243,14 @@ case: (i <= j)=> Hij. move=> [Hk0 Hki]. by rewrite !nth_take /#. case: (0 < j)=> //= Hj0; last smt(take_le0). -rewrite min_ler 1:/#. +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(min_lel). +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. @@ -512,7 +512,8 @@ cut:prefix (take i l1) l2 <= prefix l1 l2. + rewrite-{2}(cat_take_drop i l1) prefix_leq_prefix_cat. cut/#:prefix l1 l2 <= prefix (take i l1) l2. rewrite -prefix_take_prefix. -rewrite-(cat_take_drop (prefix l1 l2) (take i l1))take_take min_lel// prefix_leq_prefix_cat. +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 : @@ -1018,7 +1019,7 @@ op has (P : 'a -> 'b -> bool) (m : ('a,'b) fmap) = lemma hasP (P : 'a -> 'b -> bool) (m : ('a,'b) fmap): has P m <=> exists x, x \in m /\ P x (oget m.[x]). proof. -rewrite hasP; split=> [] [x] [#]. +rewrite /has hasP; split=> [] [x] [#]. + by move=> _ x_in_m Pxmx; exists x. by move=> x_in_m Pxmx; exists x; rewrite -memE mem_fdom. qed. @@ -1029,7 +1030,7 @@ op find (P : 'a -> 'b -> bool) (m : ('a,'b) fmap) = lemma find_none (P : 'a -> 'b -> bool) (m : ('a,'b) fmap): has P m <=> find P m <> None. proof. -rewrite has_find; split=> [h|]. +rewrite /find /has has_find; split=> [h|]. + by rewrite (onth_nth witness) 1:find_ge0 /=. by apply/contraLR=> h; rewrite onth_nth_map nth_default 1:size_map 1:lezNgt. qed. @@ -1066,23 +1067,24 @@ 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. - cut @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := - findP (fun (_ : handle) => pred1 c \o fst) handles. - + exists (oget handles.[h]).`2. - by move: Hmem; rewrite domE; case: (handles.[h])=> //= - []. - by cut := H h;rewrite domE /#. +move=> @/hinv. +cut @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := + findP (fun (_ : handle) => pred1 c \o fst) handles. ++ exists (oget handles.[h]).`2. + by move: Hmem; rewrite domE; case: (handles.[h])=> //= - []. +by cut := H h;rewrite domE /#. 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. - cut:=Huniq h;cut:=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]). +move=> Huniq;pose c := (oget handles.[h]).`1. +cut:=Huniq h;cut:=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: From 59946b8f605d95fef07087cd1249ed3e5283b1c9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Sun, 29 Nov 2020 06:56:21 +0000 Subject: [PATCH 380/394] Fix Sponge proof --- sha3/proof/SHA3Indiff.ec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sha3/proof/SHA3Indiff.ec b/sha3/proof/SHA3Indiff.ec index 5cf8ea9..2675d66 100644 --- a/sha3/proof/SHA3Indiff.ec +++ b/sha3/proof/SHA3Indiff.ec @@ -277,7 +277,7 @@ lemma security &m : (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. proof. rewrite -(replace_simulator &m). -rewrite exprS 1:addz_ge0 1:ge0_r 1:ge0_c exprDn 1:ge0_r 1:ge0_c. +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). From 913dfbb7836d93331c757a76e4f99a5413bc1988 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Sun, 13 Dec 2020 10:01:43 +0000 Subject: [PATCH 381/394] Partial fix for sponge Can't dive into prefix-based hell right now. --- sha3/proof/Common.ec | 9 +-------- sha3/proof/SHA3Indiff.ec | 4 +--- sha3/proof/SHA3OSecurity.ec | 9 ++++++--- sha3/proof/SecureORO.eca | 3 ++- sha3/proof/SecureRO.eca | 3 ++- sha3/proof/Sponge.ec | 5 ++--- 6 files changed, 14 insertions(+), 19 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index b756760..601c889 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -586,14 +586,7 @@ 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 <> []. - case: xs b2b_xs_eq last_xs_eq_b0 vb_xs=> // contrad. - rewrite blocks2bits_nil in contrad. - have contrad_last : - false = last false (s ++ [true] ++ nseq n false ++ [true]). - have {1}-> : false = last false [] by trivial. - by rewrite {1}contrad. - rewrite last_cat /= in contrad_last. - elim contrad_last. + 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. diff --git a/sha3/proof/SHA3Indiff.ec b/sha3/proof/SHA3Indiff.ec index 2675d66..db7cfd0 100644 --- a/sha3/proof/SHA3Indiff.ec +++ b/sha3/proof/SHA3Indiff.ec @@ -184,7 +184,6 @@ wp; sp. call (_ : ={Perm.m, Perm.mi}); first sim. auto. auto; progress; by rewrite blocks2bits_nil. -auto. qed. lemma drestr_commute2 &m : @@ -222,8 +221,7 @@ inline RaiseFun(BlockSponge.BIRO.IRO).f. wp; sp. call (_ : ={BlockSponge.BIRO.IRO.mp}); first sim. auto. -auto; progress. by rewrite blocks2bits_nil. -auto. +by auto. qed. op wit_pair : block * capacity = witness. diff --git a/sha3/proof/SHA3OSecurity.ec b/sha3/proof/SHA3OSecurity.ec index d513bf6..10b041a 100644 --- a/sha3/proof/SHA3OSecurity.ec +++ b/sha3/proof/SHA3OSecurity.ec @@ -643,7 +643,8 @@ cut->: 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 dbool_ll); inline*; auto=> />. +call(RO_LRO_D Dist _); first by rewrite dbool_ll. +by inline*; auto=> />. qed. local lemma rw_ideal_2 &m: @@ -1403,7 +1404,8 @@ cut->: inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. by call eq_eager_ideal2; auto. rewrite eq_sym; byequiv=> //=; proc. -by call(RO_LRO_D Dist dbool_ll); inline*; auto=> />. +call(RO_LRO_D Dist _); first by rewrite dbool_ll. +by inline*; auto=> />. qed. @@ -2281,7 +2283,8 @@ cut->: inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. by call eq_eager_ideal2; auto. rewrite eq_sym; byequiv=> //=; proc. -by call(RO_LRO_D Dist dbool_ll); inline*; auto=> />. +call(RO_LRO_D Dist _); first by rewrite dbool_ll. +by inline*; auto=> />. qed. local equiv toto : diff --git a/sha3/proof/SecureORO.eca b/sha3/proof/SecureORO.eca index a39eaa3..f6c47d8 100644 --- a/sha3/proof/SecureORO.eca +++ b/sha3/proof/SecureORO.eca @@ -263,7 +263,8 @@ section SecondPreimage. Pr [ SecondPreimage3(A,RO).main(mess1) @ &m : res ]. - rewrite eq_sym. byequiv=>//=; proc. - by call(RO_LRO_D (D1(A)) sampleto_ll); inline*; auto. + 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])) diff --git a/sha3/proof/SecureRO.eca b/sha3/proof/SecureRO.eca index 143ff55..1725115 100644 --- a/sha3/proof/SecureRO.eca +++ b/sha3/proof/SecureRO.eca @@ -283,7 +283,8 @@ section SecondPreimage. Pr [ SecondPreimage3(A,RO).main(mess1) @ &m : res ]. - rewrite eq_sym. byequiv=>//=; proc. - by call(RO_LRO_D (D1(A)) sampleto_ll); inline*; auto. + 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])) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 122cff2..1b68af3 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -391,7 +391,7 @@ local lemma LRO_RO (D <: ERO.RO_Distinguisher{ERO.RO, ERO.FRO}) &m : proof. byequiv=> //; proc. seq 1 1 : (={glob D, ERO.RO.m}); first sim. -symmetry; call (RO_LRO_D D dbool_ll); auto. +by symmetry; call (RO_LRO_D D _); auto; rewrite dbool_ll. qed. (* make a Hybrid IRO out of a random oracle *) @@ -1639,8 +1639,7 @@ 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. -auto; progress; - [by rewrite blocks2bits_nil | by smt(needed_blocks0)]. +by auto; progress; smt(needed_blocks0). (* 0 <= n1 *) conseq (_ : From 7197ec92774bd2b1ec3e678f4ecd86fad834a940 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 2 Mar 2021 11:36:33 +0000 Subject: [PATCH 382/394] Almost following HEAD Tracking down an issue with pRHL producing ill-formed formulas --- sha3/proof/BlockSponge.ec | 2 +- sha3/proof/Common.ec | 2 +- sha3/proof/IndifRO_is_secure.ec | 18 +- sha3/proof/SHA3Indiff.ec | 10 +- sha3/proof/SHA3Security.ec | 70 ++-- sha3/proof/SecureRO.eca | 28 +- sha3/proof/Sponge.ec | 10 +- sha3/proof/smart_counter/ConcreteF.eca | 26 +- sha3/proof/smart_counter/Gcol.eca | 20 +- sha3/proof/smart_counter/Gconcl.ec | 7 +- sha3/proof/smart_counter/Gconcl_list.ec | 338 ++++++++-------- sha3/proof/smart_counter/Gext.eca | 6 +- sha3/proof/smart_counter/Handle.eca | 512 ++++++++++++------------ sha3/proof/smart_counter/SLCommon.ec | 72 ++-- 14 files changed, 567 insertions(+), 554 deletions(-) diff --git a/sha3/proof/BlockSponge.ec b/sha3/proof/BlockSponge.ec index 9baad40..2000adc 100644 --- a/sha3/proof/BlockSponge.ec +++ b/sha3/proof/BlockSponge.ec @@ -40,7 +40,7 @@ qed. lemma parse_valid p: valid_block p => parse p = (p,1). proof. -move=>h;cut{1}->:p=format p 1;2:smt(parseK). +move=>h;have{1}->:p=format p 1;2:smt(parseK). by rewrite/format/=nseq0 cats0. qed. diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 601c889..a844fbb 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -154,7 +154,7 @@ have -> : (n + r - 1) %/r * r = (n + r - 1) - (n + r - 1)%% r have -> : n + r - 1 - (n + r - 1) %% r - n = r - 1 - (n + r - 1) %% r by ring. rewrite ltzE -(@ler_add2r (-r)) /=. -cut -> : r - 1 - (n + r - 1) %% r + 1 - r = -(n + r - 1) %% r by ring. +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. diff --git a/sha3/proof/IndifRO_is_secure.ec b/sha3/proof/IndifRO_is_secure.ec index 3b1de8c..aa2a625 100644 --- a/sha3/proof/IndifRO_is_secure.ec +++ b/sha3/proof/IndifRO_is_secure.ec @@ -107,13 +107,13 @@ section Collision. bound + ((limit * (limit - 1) + 2)%r / 2%r * mu1 sampleto witness). proof. move=>[] S [] S_ll Hbound. - cut->: Pr[Collision(A, FM(C,P)).main() @ &m : res] = + 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. - cut/#:Pr[GIdeal(RO, S, DColl(A)).main() @ &m : res] <= + have/#:Pr[GIdeal(RO, S, DColl(A)).main() @ &m : res] <= (limit * (limit - 1) + 2)%r / 2%r * mu1 sampleto witness. - cut->:Pr[GIdeal(RO, S, DColl(A)).main() @ &m : res] = + 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. @@ -153,13 +153,13 @@ section Preimage. bound + (limit + 1)%r * mu1 sampleto hash. proof. move=>init_hash [] S [] S_ll Hbound. - cut->: Pr[Preimage(A, FM(C,P)).main(hash) @ &m : res] = + 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(). - cut/#:Pr[GIdeal(RO, S, DPre(A)).main() @ &m : res] <= + have/#:Pr[GIdeal(RO, S, DPre(A)).main() @ &m : res] <= (limit + 1)%r * mu1 sampleto hash. - cut->:Pr[GIdeal(RO, S, DPre(A)).main() @ &m : res] = + 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. @@ -199,13 +199,13 @@ section SecondPreimage. bound + (limit + 1)%r * mu1 sampleto witness. proof. move=>init_mess [] S [] S_ll Hbound. - cut->: Pr[SecondPreimage(A, FM(C,P)).main(mess) @ &m : res] = + 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(). - cut/#:Pr[GIdeal(RO, S, D2Pre(A)).main() @ &m : res] <= + have/#:Pr[GIdeal(RO, S, D2Pre(A)).main() @ &m : res] <= (limit + 1)%r * mu1 sampleto witness. - cut->:Pr[GIdeal(RO, S, D2Pre(A)).main() @ &m : res] = + 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. diff --git a/sha3/proof/SHA3Indiff.ec b/sha3/proof/SHA3Indiff.ec index db7cfd0..7afdf98 100644 --- a/sha3/proof/SHA3Indiff.ec +++ b/sha3/proof/SHA3Indiff.ec @@ -288,16 +288,16 @@ have -> : have {3}-> : 2 = 1 + 1 by trivial. rewrite exprS // expr1 /#. rewrite -/SLCommon.dstate /limit. -cut->:=conclusion (Gconcl_list.SimLast(Gconcl.S)) (DRestr(Dist)) &m. -cut//=:=(Gconcl_list.Real_Ideal (LowerDist(Dist)) _ &m). +have->:=conclusion (Gconcl_list.SimLast(Gconcl.S)) (DRestr(Dist)) &m. +have//=:=(Gconcl_list.Real_Ideal (LowerDist(Dist)) _ &m). + move=>F P hp hpi hf'//=. - cut hf:islossless RaiseFun(F).f. + 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). -cut->:=Gconcl_list.Simplify_simulator (LowerDist(Dist)) _ &m. +have->:=Gconcl_list.Simplify_simulator (LowerDist(Dist)) _ &m. + move=>F P hp hpi hf'//=. - cut hf:islossless RaiseFun(F).f. + have hf:islossless RaiseFun(F).f. - proc;call hf';auto. exact(Dist_lossless (RaiseFun(F)) P hp hpi hf). smt(). diff --git a/sha3/proof/SHA3Security.ec b/sha3/proof/SHA3Security.ec index 9a87f94..80e1070 100644 --- a/sha3/proof/SHA3Security.ec +++ b/sha3/proof/SHA3Security.ec @@ -39,12 +39,12 @@ axiom dout_equal_dlist : dmap dout to_list = dlist dbool size_out. lemma doutE1 x : mu1 dout x = inv (2%r ^ size_out). proof. -cut->:inv (2%r ^ size_out) = mu1 (dlist dbool size_out) (to_list x). +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 _ _ _. - cut->: p = StdBigop.Bigreal.BRM.big predT (fun _ => inv 2%r) (to_list x). + 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. @@ -152,18 +152,18 @@ section Preimage. Prefix.invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). proof. move=>hinvm nin_dom. - cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). + have prod_ll:Distr.is_lossless (bdistr `*` cdistr). + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. apply dexcepted_ll=>//=;rewrite-prod_ll. - cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. + have->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. rewrite Distr.mu_disjoint 1:predCI//=RField.addrC. - cut/=->:=StdOrder.RealOrder.ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. + 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. - cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + have{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). move:a. - cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. - cut->//=:fdom m \subset frng m. + 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. @@ -244,8 +244,8 @@ section Preimage. - smt(). - exact(dout_ll). - have[] h[#] h1 h2 := H. - cut->:i_R = size_out by smt(). - cut<-:=h2 _ H3. + 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. @@ -366,7 +366,7 @@ section Preimage. - by rewrite size_cat/=. - by rewrite mem_set; left; rewrite H3. - rewrite get_setE (H4 _ _ H11). - cut/#: !(l1, j) = (x0{2}, size bs0{2}). + have/#: !(l1, j) = (x0{2}, size bs0{2}). move:H2; apply absurd=> //=[#] <<- ->>. have[] h1 [] h2 h3 := H1. by apply h2; smt(). @@ -405,7 +405,7 @@ section Preimage. 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. - cut->//:Pr[Indiff0.Indif(CSetSize(Sponge, Perm), Perm, DPre(A)).main() @ &m : res] = + 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. @@ -434,7 +434,7 @@ section Preimage. by call(equiv_sponge_perm c1 m); auto; smt(). auto; progress. by rewrite /invm=> x y; rewrite 2!emptyE. - cut->//:Pr[Indiff0.Indif(RO, SimSetSize(Simulator, RO), DPre(A)).main() @ &m : res] = + 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 @@ -509,18 +509,18 @@ section SecondPreimage. Prefix.invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). proof. move=>hinvm nin_dom. - cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). + have prod_ll:Distr.is_lossless (bdistr `*` cdistr). + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. apply dexcepted_ll=>//=;rewrite-prod_ll. - cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. + have->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. rewrite Distr.mu_disjoint 1:predCI//=RField.addrC. - cut/=->:=StdOrder.RealOrder.ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. + 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. - cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + have{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). move:a. - cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. - cut->//=:fdom m \subset frng m. + 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. @@ -591,8 +591,8 @@ section SecondPreimage. - smt(). - exact(dout_ll). - have[] h[#] h1 h2 := H. - cut->:i_R = size_out by smt(). - cut<-:=h2 _ H3. + 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. @@ -713,7 +713,7 @@ section SecondPreimage. - by rewrite size_cat/=. - by rewrite mem_set; left; rewrite H3. - rewrite get_setE (H4 _ _ H11). - cut/#: !(l1, j) = (x0{2}, size bs0{2}). + have/#: !(l1, j) = (x0{2}, size bs0{2}). move:H2; apply absurd=> //=[#] <<- ->>. have[] h1 [] h2 h3 := H1. by apply h2; smt(). @@ -752,7 +752,7 @@ section SecondPreimage. 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. - cut->:Pr[Indiff0.Indif(CSetSize(Sponge, Perm), Perm, D2Pre(A)).main() @ &m : res] = + 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 @@ -810,7 +810,7 @@ section SecondPreimage. by call(equiv_sponge_perm c1 m); auto; smt(). inline*; auto; progress. by rewrite /invm=> x y; rewrite 2!emptyE. - cut->:Pr[Indiff0.Indif(RO, SimSetSize(Simulator, RO), D2Pre(A)).main() @ &m : res] = + 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 @@ -902,18 +902,18 @@ section Collision. Prefix.invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). proof. move=>hinvm nin_dom. - cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). + have prod_ll:Distr.is_lossless (bdistr `*` cdistr). + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. apply dexcepted_ll=>//=;rewrite-prod_ll. - cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. + have->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. rewrite Distr.mu_disjoint 1:predCI//=RField.addrC. - cut/=->:=StdOrder.RealOrder.ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. + 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. - cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + have{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). move:a. - cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. - cut->//=:fdom m \subset frng m. + 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. @@ -983,8 +983,8 @@ section Collision. - smt(). - exact(dout_ll). - have[] h[#] h1 h2 := H. - cut->:i_R = size_out by smt(). - cut<-:=h2 _ H3. + 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. @@ -1105,7 +1105,7 @@ section Collision. - by rewrite size_cat/=. - by rewrite mem_set; left; rewrite H3. - rewrite get_setE (H4 _ _ H11). - cut/#: !(l1, j) = (x0{2}, size bs0{2}). + have/#: !(l1, j) = (x0{2}, size bs0{2}). move:H2; apply absurd=> //=[#] <<- ->>. have[] h1 [] h2 h3 := H1. by apply h2; smt(). @@ -1142,7 +1142,7 @@ section Collision. rewrite (coll_resistant_if_indifferentiable A A_ll (CSetSize(Sponge)) Perm &m). exists (SimSetSize(Simulator)); split. + by move=> F _; proc; inline*; auto. - cut->:Pr[Indiff0.Indif(CSetSize(Sponge, Perm), Perm, DColl(A)).main() @ &m : res] = + 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 @@ -1193,7 +1193,7 @@ section Collision. by call(equiv_sponge_perm c1 m); auto; smt(). inline*; auto; progress. by rewrite /invm=> x y; rewrite 2!emptyE. - cut->:Pr[Indiff0.Indif(RO, SimSetSize(Simulator, RO), DColl(A)).main() @ &m : res] = + 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 diff --git a/sha3/proof/SecureRO.eca b/sha3/proof/SecureRO.eca index 1725115..c261f1d 100644 --- a/sha3/proof/SecureRO.eca +++ b/sha3/proof/SecureRO.eca @@ -112,7 +112,7 @@ section Preimage. lemma RO_is_preimage_resistant &m (h : to) : Pr [ Preimage(A,RO).main(h) @ &m : res ] <= (bound + 1)%r * mu1 sampleto h. proof. - cut->: Pr [ Preimage (A,RO).main(h) @ &m : res ] = + 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. @@ -141,10 +141,10 @@ section Preimage. 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 ????????. - rewrite rngE/= => hh [] a; rewrite get_setE. + 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:H1; rewrite rngE /= negb_exists/= => /(_ a) //=. + by move:h_notin_rngRO; rewrite rngE /= negb_exists/= => /(_ a) //=. - move=> c; proc; inline*; sp; if; sp. + if; auto; progress. + smt(). @@ -178,8 +178,8 @@ section Preimage. - hoare; auto; progress. rewrite H3/=; move: H1; rewrite rngE /= negb_exists /=. by have:=H3; rewrite domE; smt(). - rnd (pred1 h); auto=> //= &hr [#]->>??<<-????. - by rewrite H3 /= get_setE /=; smt(). + rnd (pred1 h); auto=> //= &hr [#]->>H0 H1<<-H2 H3 H4 H5 H6. + by rewrite H4 /= get_setE /=; smt(). smt(). qed. @@ -297,7 +297,7 @@ section SecondPreimage. - 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=> /> &h sample. + 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. @@ -310,8 +310,8 @@ section SecondPreimage. 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=> />. - move=> &h r; rewrite mem_empty /= !mem_set mem_empty/= sampleto_full /=. + + 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. @@ -351,7 +351,7 @@ section SecondPreimage. 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. + - 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})=> //=. @@ -472,7 +472,7 @@ section Collision. + 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. + 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). @@ -509,15 +509,15 @@ section Collision. have:= Hcoll2; rewrite negb_exists /= => /(_ m1). rewrite negb_exists /= => /(_ m2). by rewrite neq in_dom1 in_dom2 /= => ->. - rnd; skip=> /> &h bounder _ h _. + 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 _. + 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 _ _ _ sample _. + move=> /> &h h1 h2 _ h3 _ sample _. by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). qed. diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 1b68af3..e7f6f21 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -107,7 +107,7 @@ case: (n{1} <= 0). + by auto; smt(size_ge0). rcondf{1} 3; 1:by auto. rcondf{2} 1. - + by auto=> /> &hr _ /needed_blocks_non_pos /#. + + 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}) @@ -1778,7 +1778,7 @@ rcondf{1} 1; first auto; progress; smt(). rcondf{1} 1; first auto; progress; smt(). auto=> |> &1 &2 ? ? sz_eq ? ? need_blks_eq. split. -have -> : n{1} = size (blocks2bits bs{2}) +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. @@ -2084,9 +2084,9 @@ 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{2} <= 0)=> [le0_n2 /# | not_le0_n2]. -have gt0_n2 : 0 < n{2} by smt(). -by have [-> _] := gt0_n2_imp gt0_n2. +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. diff --git a/sha3/proof/smart_counter/ConcreteF.eca b/sha3/proof/smart_counter/ConcreteF.eca index c913c9e..f8fa6a0 100644 --- a/sha3/proof/smart_counter/ConcreteF.eca +++ b/sha3/proof/smart_counter/ConcreteF.eca @@ -138,11 +138,11 @@ section. * 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 //= /#. + 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/=. - cut htake:take (i{2} + 1) bs{1} = take (i{2} + 1) (take (i{2} + 1 + 1) bs{1}); + 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/#. @@ -220,7 +220,7 @@ section. 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. - cut->: + 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 *; @@ -287,12 +287,12 @@ section. /\ (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. - * cut:=H7 (take (i{m0}+1) p{m0}). + * 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). - * cut:=H7 (take (i{hr}+1) p{hr}). + * 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)//=/#. @@ -312,7 +312,7 @@ section. * 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/=. - cut/#: !take (i{2} + 1) p{2} \in pref{2}. + 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}. @@ -343,7 +343,7 @@ section. * 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//=. - cut/#: !take (i{2} + 1) p{2} \in pref{2}. + 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). @@ -366,8 +366,8 @@ section. + rcondt{1}1;2:rcondt{2}1;auto;progress. * rewrite/#. search get_max_prefix (<=) take mem. * rewrite(@prefix_inv_leq _ _ _ _ _ _ H H7 H0)//= 1:/#. - cut:=H0=>[][h1 [h2 h3]]. - cut:=h3 _ _ _ H7;last smt(memE mem_fdom). + have :=H0=>[][h1 [h2 h3]]. + have :=h3 _ _ _ H7;last smt(memE mem_fdom). smt(size_eq0 size_take). * smt(domE). auto;progress. @@ -391,8 +391,12 @@ section. = 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. - by proc; if=> //=; auto. + (** * 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). diff --git a/sha3/proof/smart_counter/Gcol.eca b/sha3/proof/smart_counter/Gcol.eca index dc462ad..2421692 100644 --- a/sha3/proof/smart_counter/Gcol.eca +++ b/sha3/proof/smart_counter/Gcol.eca @@ -209,7 +209,7 @@ section PROOF. + proc;sp;if;2:by hoare=>//??;apply eps_ge0. wp. rnd (mem (image fst (frng FRO.m)));skip;progress;2:smt ml=0. - cut->:=(Mu_mem.mu_mem (image fst (frng FRO.m{hr})) cdistr (1%r/(2^c)%r) _). + 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. @@ -240,7 +240,7 @@ section PROOF. if;1:auto. - inline Gcol.sample_c;rcondt{2}4. * auto;inline*;auto;progress. - + by cut/#:=fcard_image_leq (fun (p : capacity * flag) => p.`1) (frng FRO.m{hr}). + + 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} @@ -250,15 +250,15 @@ section PROOF. /\ (x0{1}.`2 \in G1.paths{1}) /\ y2{1} = c{2});1: by inline*;auto. sp 1 4;if;auto;progress. - + by cut->:=(H H6). + + by have->:=(H H6). + smt(card_rng_set). - + case:H5=>/=[h|H_hinv];1: by cut->:=H h. - cut:=hinvP FRO.m{2} c{2};rewrite H_hinv/=imageP/==>[][]f H_f. + + 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 cut/#:=fcard_image_leq (fun (p : capacity * flag) => p.`1) (frng FRO.m{hr}). + + 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} @@ -268,10 +268,10 @@ section PROOF. /\ ! (x0{1}.`2 \in G1.paths{1}) /\ y2{1} = c{2});1: by auto. sp 1 4;if;auto;progress. - + by cut->:=(H H6). + + by have->:=(H H6). + smt(card_rng_set). - + case:H5=>/=[h|H_hinv];1: by cut->:=H h. - cut:= hinvP FRO.m{2} c{2}. + + 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). @@ -298,7 +298,7 @@ section PROOF. 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;cut /#:= fcard_image_leq fst (frng FRO.m{hr}). + + 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=> //. diff --git a/sha3/proof/smart_counter/Gconcl.ec b/sha3/proof/smart_counter/Gconcl.ec index 4bbd724..e4f0724 100644 --- a/sha3/proof/smart_counter/Gconcl.ec +++ b/sha3/proof/smart_counter/Gconcl.ec @@ -378,9 +378,12 @@ proof. rewrite !(ler_add2l, ler_add2r);apply lerr_eq. apply (eq_trans _ Pr[G3(F.FullEager.LRO).distinguish() @ &m : res]);1:by byequiv G2_G3. apply (eq_trans _ Pr[G3(F.RO ).distinguish() @ &m : res]). - + by byequiv (_: ={glob G3, F.RO.m} ==> _)=>//;symmetry;conseq (F.FullEager.RO_LRO_D G3 Block.DBlock.dunifin_ll). + + 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.FullEager.LRO).distinguish() @ &m : res]);1:by byequiv (F.FullEager.RO_LRO_D G4 Block.DBlock.dunifin_ll). + apply (eq_trans _ Pr[G4(F.FullEager.LRO).distinguish() @ &m : res]). + + byequiv (F.FullEager.RO_LRO_D G4 _)=> //. + by move=> _; exact/Block.DBlock.dunifin_ll. by byequiv G4_Ideal. qed. diff --git a/sha3/proof/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec index 8378743..924030d 100644 --- a/sha3/proof/smart_counter/Gconcl_list.ec +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -145,13 +145,13 @@ section Ideal. (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. - cut->:(format l (i + 1 + 1)) = format l (i + 1) ++ [b0]. + have->:(format l (i + 1 + 1)) = format l (i + 1) ++ [b0]. + by rewrite/format//=nseqSr//-cats1 catA. - cut:=prefix_leq_prefix_cat_size (format l (i + 1))[b0](elems (fdom m)). + 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 _ _. - cut:=get_max_prefix_max (x ++ [b0]) _ _ H_dom. - cut->:prefix (x ++ [b0]) (format l (i + 1)) = size x + 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. @@ -425,7 +425,7 @@ section Ideal. ! 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;cut[]add_maps valid_dom nvalid_dom:=INV0. + 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). @@ -439,7 +439,7 @@ section Ideal. format p i \in m1 => format p i \in m2. proof. - move=>INV0 p_valid i_gt0 domE1;cut[]add_maps valid_dom nvalid_dom:=INV0. + 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. @@ -448,7 +448,7 @@ section Ideal. inv_L_L3 m1 m2 m3 => l \in m1 <=> (l \in m2 \/ l \in m3). proof. - move=>INV0;cut[]add_maps valid_dom nvalid_dom:=INV0. + move=>INV0;have[]add_maps valid_dom nvalid_dom:=INV0. by rewrite add_maps mem_join. qed. @@ -459,8 +459,8 @@ section Ideal. ! x \in m1 => inv_L_L3 m1.[x <- r] m2 m3.[x <- r]. proof. - move=>INV0 not_valid nin_dom1;cut[]add_maps h1 h2:=INV0. - cut nin_dom3: ! x \in m3 by smt(incl_dom). + 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. @@ -513,20 +513,20 @@ section Ideal. 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. - + cut[]add_maps h1 h2:=H5;rewrite add_maps joinE//=. + + 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 cut[]add_maps h1 h2:=H1;rewrite add_maps joinE//=;smt(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). - - cut[]add_maps h1 h2:=H1;rewrite add_maps !get_setE joinE//=;smt(parse_valid nseq0 cats0). - - cut:=H;rewrite -H0=>//=[][]->>->>;apply lemma1=>//=;1:smt(parse_valid). - cut[]add_maps h1 h2:=H1;smt(parse_valid formatK parseK incl_dom). + - 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). @@ -542,15 +542,15 @@ section Ideal. /\ 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. - + cut:=H2;rewrite -formatK H/=;smt(lemma2 incl_dom parse_gt0). - cut[]add_maps h1 h2:=H1;rewrite add_maps joinE. - cut:=H2;rewrite -formatK H/==>in_dom1. + + 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 cut:=h2 _ in_dom3;rewrite parseK//=;smt(parse_gt0). + by have:=h2 _ in_dom3;rewrite parseK//=;smt(parse_gt0). rcondt{1}2;2:rcondt{2}2;auto;progress. + smt(incl_dom lemma2). - + cut[]:=H1;smt(get_setE joinE). - by cut:=H2;rewrite-formatK H/==>nin_dom1;rewrite lemma1//=;smt(parse_gt0 lemma2 incl_dom). + + 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}). @@ -566,18 +566,18 @@ section Ideal. /\ 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. - * cut[]:=H1;smt(incl_dom). - cut[]:=H1;smt(joinE incl_dom). + * have[]:=H1;smt(incl_dom). + have[]:=H1;smt(joinE incl_dom). rcondt{1}2;2:rcondt{2}2;auto;progress. - * cut[]:=H1;smt(incl_dom). - * cut[]:=H1;smt(joinE incl_dom get_setE). + * 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. - * cut[]h_join h1 h2:=H2. + * 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. @@ -586,7 +586,7 @@ section Ideal. rcondt{1}2;2:rcondt{2}2;auto;progress. * smt(incl_dom lemma1). * smt(). - * cut//=:=lemma3 _ _ _ _ r0L H2 _ H5. + * have//=:=lemma3 _ _ _ _ r0L H2 _ H5. by have:= parse_not_valid x{2}; rewrite H1 /= H0 /= => h; exact/(h (i_R+1)). auto;smt(). qed. @@ -800,7 +800,7 @@ section Ideal. 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;cut[]inv12 inv34 dom2 dom4:=INV0;cut[]h1[]h2[]h3 h4:=inv12;split=>//=. + 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). @@ -820,8 +820,8 @@ section Ideal. 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; - cut[]inv12 inv34 dom2 dom4:=INV0; - cut[]h1[]h2[]h3 h4:=inv34; + have[]inv12 inv34 dom2 dom4:=INV0; + have[]h1[]h2[]h3 h4:=inv34; split=>//=. + progress. - move:H0;rewrite 2!mem_set=>[][/#|]/=[]->>->>;smt(parseK formatK). @@ -858,13 +858,13 @@ section Ideal. /\ 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. - - cut[]h1 _ _ _:=H1;cut[]h'1 _:=h1;smt(parseK). + - have[]h1 _ _ _:=H1;have[]h'1 _:=h1;smt(parseK). - smt(get_setE). - smt(). - exact lemma5. rcondf{1}2;auto;progress. - - cut[]h1 _ _ _:=H1;cut[]h'1 _:=h1;smt(parseK). - - cut[]h1:=H1;cut[]:=h1;smt(parseK). + - 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. @@ -874,18 +874,18 @@ section Ideal. /\ 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. - - cut[]_ h1 _ _:=H2;cut[]:=h1;progress. - cut:=H7 x0{m} i0{m} (format x0{m} (i0{m} + 1));rewrite H5/==>->//=. - cut->/#:=parse_twice _ _ _ H. + - 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. - - cut[]_ h1 _ _:=H2;cut[]:=h1;progress. - cut:=H7 x0{m} i0{m} (format x0{m} (i0{m} + 1));rewrite H5/==>->//=. - cut->/#:=parse_twice _ _ _ H. - - cut[]_ h1 _ _:=H2;cut[]h'1 _:=h1;smt(parseK parse_twice). + - 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. @@ -898,13 +898,13 @@ section Ideal. /\ 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. - - cut[]h1 _ _ _:=H1;cut[]h'1 _:=h1;smt(parseK). + - have[]h1 _ _ _:=H1;have[]h'1 _:=h1;smt(parseK). - smt(get_setE). - smt(). - exact lemma5. rcondf{1}2;auto;progress. - - cut[]h1 _ _ _:=H1;cut[]h'1 _:=h1;smt(parseK). - - cut[]h1:=H1;cut[]:=h1;smt(parseK). + - have[]h1 _ _ _:=H1;have[]h'1 _:=h1;smt(parseK). + - have[]h1:=H1;have[]:=h1;smt(parseK). smt(). qed. @@ -919,37 +919,41 @@ section Ideal. Pr[SLCommon.IdealIndif(IF,S,SLCommon.DRestr(A(D))).main() @ &m : res] = Pr[IdealIndif(BIRO.IRO,SimLast(S),DRestr(D)).main() @ &m : res]. proof. - cut->:Pr[SLCommon.IdealIndif(IF, S, SLCommon.DRestr(A(D))).main() @ &m : res] + 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)=>//=. - cut<-:Pr[L2(D,F.RO).distinguish() @ &m : res] = + have<-:Pr[L2(D,F.RO).distinguish() @ &m : res] = Pr[SLCommon.IdealIndif(IF,S,A(D)).main() @ &m : res]. + by byequiv(ideal_equiv2 D). - cut->:Pr[L2(D, F.RO).distinguish() @ &m : res] = + have->:Pr[L2(D, F.RO).distinguish() @ &m : res] = Pr[L2(D,F.FullEager.LRO).distinguish() @ &m : res]. + byequiv=>//=;proc;sp;inline*;sp;wp. - by call(F.FullEager.RO_LRO_D (D2(D)) dunifin_ll);auto. - cut->:Pr[IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res] = + 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.FullEager.LRO,F2.FullEager.LRO).distinguish() @ &m : res]. + by rewrite eq_sym;byequiv(equiv_L4_ideal D)=>//=. - cut<-:Pr[L4(D, F.RO, F2.RO).distinguish() @ &m : res] = + have<-:Pr[L4(D, F.RO, F2.RO).distinguish() @ &m : res] = Pr[L4(D,F.FullEager.LRO,F2.FullEager.LRO).distinguish() @ &m : res]. - + cut->:Pr[L4(D, F.RO, F2.RO).distinguish() @ &m : res] = + + have->:Pr[L4(D, F.RO, F2.RO).distinguish() @ &m : res] = Pr[L4(D,F.FullEager.LRO, F2.RO).distinguish() @ &m : res]. - byequiv=>//=;proc;sp;inline*;sp;wp. - by call(F.FullEager.RO_LRO_D (D5(D)) dunifin_ll);auto. + call(F.FullEager.RO_LRO_D (D5(D)) _); auto. + by move=> _; exact/dunifin_ll. byequiv=>//=;proc;sp;inline*;sp;wp. - by call(F2.FullEager.RO_LRO_D (D6(D)) dunifin_ll);auto. - cut<-:Pr[L3(D, F.RO).distinguish() @ &m : res] = + 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)=>//=. - cut<-:Pr[L(D, F.RO).distinguish() @ &m : res] = + have<-:Pr[L(D, F.RO).distinguish() @ &m : res] = Pr[L3(D, F.RO).distinguish() @ &m : res]. + by byequiv(Ideal_equiv3 D). - cut->:Pr[L(D, F.RO).distinguish() @ &m : res] = + have->:Pr[L(D, F.RO).distinguish() @ &m : res] = Pr[L(D,F.FullEager.LRO).distinguish() @ &m : res]. + byequiv=>//=;proc;sp;inline*;sp;wp. - by call(F.FullEager.RO_LRO_D (D3(D)) dunifin_ll);auto. + call(F.FullEager.RO_LRO_D (D3(D)) _); auto. + by move=> _; exact/dunifin_ll. rewrite eq_sym. by byequiv(Ideal_equiv_valid D). qed. @@ -1028,34 +1032,34 @@ section Real. 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;cut[]//=_[] hmp0 hmp1 hinvm:=inv0;split=>//=. + 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/=. - cut:=hmp1 (format bl (i - 1));rewrite domE H_p_val/==>help. - cut:=hjsize;rewrite !size_cat !size_nseq/=!ler_maxr 1:/#=>hjsizei. - cut->/=:!take j (format bl i) = format bl i by smt(size_take). - cut h:forall k, 0 <= k <= size bl + i - 2 => + 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 _;cut->/={o}:o = k - size bl by smt(). + 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. - - cut:=help j _;1:smt(size_cat size_nseq). + - have:=help j _;1:smt(size_cat size_nseq). move=>[]b c[]. - cut->:nth witness (format bl (i - 1)) j = nth witness (format bl i) j. + 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). - cut->>/=:j = size (format bl (i-1)) by smt(size_cat size_nseq). + have->>/=:j = size (format bl (i-1)) by smt(size_cat size_nseq). rewrite get_setE/=. - cut h':size (format bl (i-1)) = size bl + i - 2 by smt(size_cat size_nseq). + have h':size (format bl (i-1)) = size bl + i - 2 by smt(size_cat size_nseq). rewrite h'/=. - cut h'':(size bl + i - 1) = size (format bl i) by smt(size_cat size_nseq). + 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';cut->/=:! size bl + i - 2 < size bl by smt(). + 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. @@ -1078,7 +1082,7 @@ section Real. proof. move=>Hn0[]Hi0 Hisize;rewrite take_cat take_nseq. case(i < size bl)=>//=[/#|H_isize']. - cut->/=:i - size bl <= n - 1 by smt(). + have->/=:i - size bl <= n - 1 by smt(). case(i = size bl)=>[->>|H_isize'']//=;1:by rewrite nseq0 take_size cats0. smt(). qed. @@ -1103,7 +1107,7 @@ section Real. 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;cut<-//:=(invm_dom_rng Perm.mi{2} Perm.m{2}). + 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. @@ -1140,19 +1144,21 @@ section Real. Perm.m{1}.[(b +^ nth witness p{1} j, c)] = Redo.prefixes{1}.[take (j+1) p{1}])); progress. - - cut inv0:=H3;cut[]h_c1c2[]Hmp0 Hmp1 Hinvm:=inv0;split=>//=. + - 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;cut:=H4 l H_dom_R. + - move=>l H_dom_R i []Hi0 Hisize;have:=H4 l H_dom_R. case(l \in Redo.prefixes{2})=>H_in_pref//=. - * cut:=Hmp1 l H_in_pref i _;rewrite//=. + * 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 ->>. - cut:=Hisize;rewrite size_take 1:/#. - pose k:=if _ then _ else _;cut->>Hij{k}:k=j by rewrite/#. + 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} @@ -1173,9 +1179,9 @@ section Real. Redo.prefixes{1}.[take (j+1) p{1}]));last first. + auto;progress. - exact size_ge0. - - by rewrite take0;cut[]_[]->//=:=H. + - by rewrite take0;have[]_[]->//=:=H. - smt(). - - by cut[]->//=:=H. + - by have[]->//=:=H. - smt(all_prefixes_of_INV_real). - smt(). - smt(). @@ -1188,10 +1194,10 @@ section Real. - smt(). - smt(all_prefixes_of_INV_real domE take_take size_take). - case(j < i0{2})=>hj;1:smt(). - cut<<-/=:j = i0{2} by smt(). - cut->>:=H7 H10 H12. - cut[]_[]hmp0 hmp1 _:=H2. - cut[]b3 c3:=hmp1 _ H12 j _;1:smt(size_take). + 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(). @@ -1203,7 +1209,7 @@ section Real. - smt(). - smt(). - move:H17;apply absurd=>//=_;rewrite mem_set. - pose x:=_ = _;cut->/={x}:x=false by smt(size_take). + 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). @@ -1225,9 +1231,9 @@ section Real. - smt(). - smt(). - move:H15;apply absurd=>//=_;rewrite mem_set. - pose x:=_ = _;cut->/={x}:x=false by smt(size_take). + pose x:=_ = _;have->/={x}:x=false by smt(size_take). move:H12;apply absurd=>//=. - cut:=take_take bl{2}(i0{2} + 1)(i0{2} + 1 + 1). + 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). @@ -1237,7 +1243,7 @@ section Real. 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. - cut:=(take_take bl{2} j i0{2}). + 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). @@ -1307,19 +1313,19 @@ section Real. sp;if;auto;progress. - move:H4 H5;rewrite!get_setE/= nth_last/=take_size. rewrite last_cat last_nseq 1:/# Block.WRing.addr0;progress. - cut//=:=lemma2'(SLCommon.C.c{1} + 1)(C.c{2} + size bl{2} + i{2}) + 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/=. - cut->->//=:y2L = (y2L.`1, y2L.`2);1,-1:smt(). + have->->//=:y2L = (y2L.`1, y2L.`2);1,-1:smt(). rewrite INV_Real_addm_mi//=;2:smt(supp_dexcepted). - by cut:=H3=>hinv0;split;case:hinv0=>//=/#. + 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:=(_, _);cut->/={a}:a = oget Perm.m{2}.[(sa0_R, sc0{2})] by smt(). - apply lemma2'=>//=;first cut:=H3=>hinv0;split;case:hinv0=>//=/#. + 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(). @@ -1347,10 +1353,10 @@ section Real. /\ 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. - + cut->:take (i1{m} + 1) (format bl{m} (i{m} + 1)) = + + 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). - + cut->:take (i1{hr} + 1) (format bl{hr} (i{hr} + 1)) = + + 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(). @@ -1361,7 +1367,7 @@ section Real. 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). - cut all_pref:=all_prefixes_of_INV_real _ _ _ _ _ H. + 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) @@ -1384,23 +1390,23 @@ section Real. /\ Redo.prefixes{1}.[take i1{1} p{1}] = Some (sa0{1}, sc0{1}));last first. + auto;progress. - smt(). - - cut[]_[]:=H;smt(domE). + - have[]_[]:=H;smt(domE). - exact size_ge0. - - cut[]_[]:=H;smt(domE take0). + - have[]_[]:=H;smt(domE take0). - smt(size_cat size_nseq). rcondt{1}1;2:rcondt{2}1;auto;progress. - - cut->:take (i1{m} + 1) (format bl{m} (i{m} + 1)) = + - 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). - - cut->:take (i1{hr} + 1) (format bl{hr} (i{hr} + 1)) = + - 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(). - - cut->:take (i1{2} + 1) (format bl{2} (i{2} + 1)) = + - 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). - cut->:take (i1{2} + 1) bl{2} = + 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). @@ -1415,19 +1421,19 @@ section Real. p.[format bl (i+1)] = m.[(sa,sc)]. proof. move=>inv0 H_i0 H_p_i H_dom_iS. - cut[]_[]_ hmp1 _ :=inv0. - cut:=hmp1 (format bl (i+1)) H_dom_iS=>help. - cut:=help (size (format bl i)) _;1:smt(size_ge0 size_cat size_nseq). + 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). - cut->/=:!size (format bl i) + 1 <= size bl by smt(size_cat size_nseq size_ge0). + have->/=:!size (format bl i) + 1 <= size bl by smt(size_cat size_nseq size_ge0). rewrite nth_cat. - cut->/=:!size (format bl i) < size bl by smt(size_cat size_ge0). + 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 _;cut->/={x}:x = format bl i. + 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;cut->/={x}:x=i+1 + 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/=. @@ -1441,24 +1447,24 @@ section Real. 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;cut[]//=_[] hmp0 hmp1 hinvm:=inv0;split=>//=. + 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/=. - cut:=hmp1 bl;rewrite domE H_p_val/==>help. - cut->/=:!take j (rcons bl b) = rcons bl b by smt(size_take). + 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 _;cut->/={x}: x = take j bl by smt(take_le0 cats0 take_size). + 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. - + cut->>/=:j = size bl by smt(). + + have->>/=:j = size bl by smt(). by rewrite take_size H_p_val/=;exists sa sc=>//=;smt(get_setE). - cut->/=:j + 1 - size bl <= 0 by smt(). + have->/=:j + 1 - size bl <= 0 by smt(). rewrite cats0. - pose x := if _ then _ else _;cut->/={x}: x = take (j+1) bl by smt(take_le0 cats0 take_size). - cut:=hmp1 bl;rewrite domE H_p_val/==>hep. - cut:=hep j _;rewrite//=;smt(get_setE size_cat size_take). + 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. @@ -1511,27 +1517,27 @@ section Real. + if{1};auto. + sp;rcondf{2}1;auto;progress. + rewrite head_nth nth_drop//=. - cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{m} _;1:smt(size_take). + 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//=. - cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). + 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//=. - cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). + 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//=. - cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). + 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//=. - cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). + 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). @@ -1556,11 +1562,11 @@ section Real. + by rewrite get_setE/=. + by rewrite behead_drop drop_add. + rewrite!get_setE/=. - cut:=lemma_3 0 C.c{2}Perm.m{2}.[(sa{2} +^ nth witness p0{1} i0{1}, sc{2}) <- yL] + 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/=. - cut->->//=:(yL.`1, yL.`2) = yL by smt(). + 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). @@ -1573,14 +1579,14 @@ section Real. + by rewrite get_setE. + by rewrite behead_drop drop_add. + rewrite(take_nth witness)//=. - cut:=lemma_3 0 C.c{2} Perm.m{2} Perm.mi{2} Redo.prefixes{1} + 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;cut[]_[]->:=H. + + by rewrite take0;have[]_[]->:=H. + by rewrite drop0. + split;case:H=>//=;smt(size_ge0). + smt(size_ge0 size_eq0). @@ -1623,34 +1629,34 @@ section Real. + rcondf{2}1;auto;progress. + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq ler_maxr/#. move=>H_dom;rewrite domE. - by cut<-:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 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 cut:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;smt(domE). + 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 cut:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;smt(domE). + 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). - cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). + 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). - cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). + 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). - cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). + 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). - cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). + 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). - cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). + 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). - cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). + 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. - cut:=lemma2' 0 C.c{2} Perm.m{2}.[(sa{2}, sc{2}) <- y0L] + 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). @@ -1658,16 +1664,16 @@ section Real. + by rewrite mem_set. by rewrite!get_setE/=H2/=;smt(). + by rewrite!get_setE/=take_oversize//=size_cat size_nseq/#. - + rewrite nth_cat;cut->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). + + 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;cut->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). + 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 cut:=lemma2' 0 C.c{2} Perm.m{2} Perm.mi{2} Redo.prefixes{1} + 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;cut->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). + 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} @@ -1677,17 +1683,17 @@ section Real. /\ 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 _ ;cut->/={x}: x = format p{1} (i_R+1). + 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). - cut->>/=:i_R = 0 by smt(). + 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 _ ;cut->/={x}: x = format p{1} (i_R+1). + 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). - cut->>/=:i_R = 0 by smt(). + have->>/=:i_R = 0 by smt(). by rewrite take_size/format nseq0 cats0. by rewrite H3/=. + by rewrite size_cat size_nseq;smt(). @@ -1701,16 +1707,16 @@ section Real. + smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). + smt(). + by rewrite domE H3. - + by rewrite take0;cut[]_[]:=H1. + + by rewrite take0;have[]_[]:=H1. + smt(). + smt(). rcondt 1;auto;progress. - + cut->:take (i1{hr} + 1) (format p{hr} (i{hr} + 1)) = + + 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). - + cut->:take (i1{hr} + 1) (format p{hr} (i{hr} + 1)) = + + 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(). @@ -1722,7 +1728,7 @@ section Real. Pr [ GReal(A(D)).main() @ &m : res /\ SLCommon.C.c <= max_size] = Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res]. proof. - cut->:Pr [ RealIndif(Sponge, P, DRestr(D)).main() @ &m : res ] = + 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(). @@ -1765,7 +1771,7 @@ section Real_Ideal. proof. rewrite-(pr_real D &m). rewrite-(equiv_ideal D &m). - cut:=Real_Ideal (A(D)) A_lossless &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(). @@ -1807,18 +1813,18 @@ section Real_Ideal_Abs. invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). proof. move=>hinvm nin_dom. - cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). + have prod_ll:Distr.is_lossless (bdistr `*` cdistr). + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. apply dexcepted_ll=>//=;rewrite-prod_ll. - cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. + have->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. rewrite Distr.mu_disjoint 1:predCI//= RField.addrC. - cut/=->:=ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. + have/=->:=ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. rewrite Distr.witness_support/predC. move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. - cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + have{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). move:a. - cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. - cut->//=:fdom m \subset frng m. + 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. @@ -1834,21 +1840,21 @@ section Real_Ideal_Abs. proc;inline*;auto;call(: invm Perm.m Perm.mi);2..:auto. + exact D_lossless. + proc;inline*;sp;if;auto;sp;if;auto;progress. - - by cut:=useful _ _ _ H H1. + - by have:=useful _ _ _ H H1. - smt(invm_set dexcepted1E). + proc;inline*;sp;if;auto;sp;if;auto;progress. - - cut:=H;rewrite invmC=>h;cut/#:=useful _ _ _ h H1. + - 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 cut:=useful _ _ _ H H2. + * 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 cut:=useful _ _ _ H H1. + * by have:=useful _ _ _ H H1. * smt(invm_set dexcepted1E). * smt(size_behead). * smt(size_behead). @@ -1882,15 +1888,15 @@ section Real_Ideal_Abs. max_size%r * ((2*max_size)%r / (2^c)%r) + max_size%r * ((2*max_size)%r / (2^c)%r). proof. - cut->:Pr[IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res] = + 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. - cut->:Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res ] = + 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. - cut h1 := Neg_A_Pr_minus (RealIndif(Sponge,P,DRestr(Neg_D(D)))) &m Real_lossless. - cut h2 := Neg_A_Pr_minus (IdealIndif(BIRO.IRO, SimLast(S), DRestr(Neg_D(D)))) &m Ideal_lossless. - cut/#:=concl (Neg_D(D)) _ &m;progress. + 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. @@ -1901,8 +1907,8 @@ section Real_Ideal_Abs. max_size%r * ((2*max_size)%r / (2^c)%r) + max_size%r * ((2*max_size)%r / (2^c)%r). proof. - cut := concl D D_lossless &m. - cut := neg_D_concl &m. + 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). @@ -2121,8 +2127,8 @@ while (i{2} <= k{2} /\ n0{1} = k{2} /\ i0{1} = i{2} /\ x1{1} = q{2} /\ ={k} /\ 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. - cut-> : q{2} = (parse (rcons p{1} (v{1} +^ x{2}.`1))).`1 by smt(). - cut-> : k{2} = (parse (rcons p{1} (v{1} +^ x{2}.`1))).`2 by smt(). + 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. @@ -2162,7 +2168,7 @@ lemma Simplify_simulator &m : 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 dunifin_ll)=>//=. +by byequiv(RO_LRO_D L _)=> //=; exact/dunifin_ll. qed. diff --git a/sha3/proof/smart_counter/Gext.eca b/sha3/proof/smart_counter/Gext.eca index d46799e..7177863 100644 --- a/sha3/proof/smart_counter/Gext.eca +++ b/sha3/proof/smart_counter/Gext.eca @@ -297,11 +297,11 @@ section. if;1,3:auto;progress. rcondt{2} 3;1:by auto=>/#. auto;progress. - + move=>bad1;cut[/=->//|]:=H bad1;rewrite/inv_ext=>[][]x h[]H_dom Hh;right. + + 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;cut[/=->//|]:=H bad1;rewrite/inv_ext=>[][]x h[]H_dom Hh;right. + + 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). @@ -706,7 +706,7 @@ section EXT. proof. apply (ler_trans _ _ _ (Real_G1 D D_ll &m)). do !apply ler_add => //. - + cut ->: Pr[G1(DRestr(D)).main() @ &m : res] = Pr[Eager(G2(DRestr(D))).main1() @ &m : res]. + + 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). diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index 44d8e98..5c9f283 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -837,9 +837,9 @@ split=>[]. + by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. + by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] //. + move=>l hmem i hi. - cut[]_ _ h2 h3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut[]sa sc[]:=h2 l hmem i hi. - cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + 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=>_ _ _ _ _ _ _ _ _ []. @@ -944,9 +944,9 @@ split=>[]. + by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. + by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ []. + move=>l hmem i hi. - cut[]_ _ h2 h3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut[]sa sc[]:=h2 l hmem i hi. - cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + 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=>_ _ _ _ _ _ _ _ _ []. @@ -1042,9 +1042,9 @@ split=>[]. + by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. + by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ []. + move=>l hmem i hi. - cut[]_ _ h2 _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut[]sa sc[]:=h2 l hmem i hi. - cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + 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=>_ _ _ _ _ _ _ _ _ []. @@ -1154,9 +1154,9 @@ split=>[]. + by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ []. + by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ []. + move=>l hmem i hi. - cut[]_ _ h2 _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut[]sa sc[]:=h2 l hmem i hi. - cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + 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=>_ _ _ _ _ _ _ _ _ []. @@ -1268,7 +1268,7 @@ lemma build_hpath_upd_ch ha ch mh xa ya p v hx: proof. move=> Hch0 Hha Hch. elim/last_ind: p v hx=> /=. - + by move=> v hx;rewrite /build_hpath /= => -[!<<-];rewrite Hch0. + + 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. @@ -1334,12 +1334,12 @@ lemma lemma4 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries i p sa sc h 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. -cut[]_ _ m_prefix _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. -cut[]b1 c1[]:=m_prefix _ take_i1_p_in_prefixes i _;1:smt(size_take). +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. -cut[]hh1 hh2 hh3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. -move:ro_prefix;cut{1}->:=(take_nth witness i p);1:smt(size_take);move=>h1. -cut:=hh2 (take i p) (nth witness p i) (oget prefixes.[take (i + 1) p]).`1. +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. @@ -1425,18 +1425,18 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] + 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/=;cut[]h1 h2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. - cut h1':=h1 ya yc. - cut :Pm.[(ya, yc)] <> None => exists (hx : handle) (fx : flag), hs.[hx] = Some (yc, fx). + + 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. - cut:=yc_notrngE1_hs_addh a b;rewrite get_setE;case(a=ch)=>//=hach. + have:=yc_notrngE1_hs_addh a b;rewrite get_setE;case(a=ch)=>//=hach. case(xc=yc)=>[/#|]hxyc. - cut[]_ _ help:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. - by cut/#:=help (yc,b) a. + 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. @@ -1452,9 +1452,9 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] case: (hinvP hs y2)=> [_ y2_notrngE1_hs _ _|/#]. rewrite get_setE /=. apply/lemma2'=> //. - + rewrite domE/=;cut[]h1 _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. - cut h1':=h1 y1 y2. - cut :Pm.[(y1, y2)] <> None => exists (hx : handle) (fx : flag), hs.[hx] = Some (y2, fx). + + 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. @@ -1591,11 +1591,11 @@ call(: !G1.bcol{2} + 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;cut[]_ -> _ _ _ /=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + 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;cut[]_ ->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + rewrite domE;have[]_ ->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. auto=> &1 &2 [#] !<<- -> _ ->> !<<- _ /=/>. case: (hinvP hs0.[ch0 <- (x2,Known)] y2{1})=> //= -> /=. move=> hs0_spec; split=> [|f]. @@ -1604,7 +1604,7 @@ call(: !G1.bcol{2} 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;cut[]_ -> _ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + 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} @@ -1643,7 +1643,7 @@ call(: !G1.bcol{2} rcondf{2} 1. + by move=> &m; auto=> //= &hr [#] <*>; rewrite x1hx_notin_G1m. auto=> &1 &2 [#] !<<- -> -> !->> _ /=. - rewrite domE;cut[]_ -> _ _ _ /=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + 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. @@ -1676,7 +1676,7 @@ call(: !G1.bcol{2} 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 => /= ;cut[]_->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + 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. @@ -1759,13 +1759,13 @@ call(: !G1.bcol{2} split;1: by move=> [_ /(dom_hs_neq_ch _ _ _ _ _ Hhs)]. by move=> /= [_ <<-];move:Hc. split. - + by cut[]/#:=Hmp. - + by cut[]/#:=Hmp. - + cut[]_ _ h _ _ l hdom i hi:=Hmp. - cut[]b c[]->h':=h l hdom i hi. + + 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 cut[]/#:=Hmp. - + by cut[]/#:=Hmp. + + 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. @@ -1785,7 +1785,7 @@ call(: !G1.bcol{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;cut[]_->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + - 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. @@ -1806,7 +1806,7 @@ call(: !G1.bcol{2} 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. - cut[]_->_ _ _//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + have[]_->_ _ _//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. case(rng hs0 (x2, Unknown))=>//=_. exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). by move=> /> &1 &2 -> ->. @@ -1844,18 +1844,18 @@ lemma lemma5 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries i (p : block list mh.[(b +^ nth witness p i, h)] = Some (b',h'). proof. move=>Hinv H_size H_take_iS H_take_i H_hs_h. -cut[]_ _ H _ _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. -cut[]sa sc:=H _ H_take_iS i _;1:smt(size_take). +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. -cut[]b' c' H_Pm:exists b' c', Pm.[(sa +^ nth witness p i, sc)] = Some (b',c'). +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/=. -cut[]h_Pm _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. -cut[]h' f' hy fy[]H_h'[]H_hy H_mh:=h_Pm _ _ _ _ H_Pm. -cut[]h_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. -cut[]f H_h := H_hs_h. -cut/=<<-:=h_huniq _ _ _ _ H_h H_h'. +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. @@ -1874,17 +1874,17 @@ 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. - cut[]b1 h1 H_mh1:exists b1 h1, mh.[(b +^ nth witness p i, h)] = Some (b1,h1). + 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)])=> //= - []. - cut[]H_Pm H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. - by cut/#:=H_Gmh _ _ _ _ H_mh1. -cut[]b1 c1 H_Pm1:exists b1 c1, Pm.[(b +^ nth witness p i, c)] = Some (b1,c1) + 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). -cut[]H_P_m H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. -cut:=H_P_m _ _ _ _ H_Pm1. -cut[] :=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. +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 => />. @@ -1914,7 +1914,7 @@ proof. 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;cut[]_->_ _ _//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0. + + by rewrite mem_set domE;left;have[]_->_ _ _//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0. + smt(mem_set). + smt(mem_set). + smt(mem_set). @@ -1972,12 +1972,12 @@ proof. else F.RO.m.[take i p]{2} = Some sa{1})) /\ 0 < size p{2});last first. - auto;progress. * smt(@Prefix). - * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 domE). - * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 domE). - * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0. - * by cut[]:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 domE). + * 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 cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0; smt(take0 domE size_take size_eq0 size_ge0). + * 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}). @@ -2006,19 +2006,19 @@ proof. ! (G1.bcol{2} \/ G1.bext{2}) /\ (take (i+1) p \in Redo.prefixes){1} /\ 0 < size p{2} ==>_);progress. - - cut:=prefix_gt0_mem p{2} (elems (fdom C.queries{2})) _;1:rewrite/#. + - have:=prefix_gt0_mem p{2} (elems (fdom C.queries{2})) _;1:rewrite/#. rewrite-memE=>H_dom_q. - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H12. - cut[]_ _ h1 h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut:=h2 (get_max_prefix p{2} (elems (fdom C.queries{2}))) _; 1:smt(mem_fdom). + 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; - cut H_dom_p:get_max_prefix p{2} (elems (fdom C.queries{2})) \in Redo.prefixes{1} by smt(domE mem_fdom). - cut->/=:=prefix_take_leq p{2} (get_max_prefix p{2} (elems (fdom C.queries{2}))) (i{2}+1) _;1:rewrite/#. + 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. - - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. - cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{hr} p{hr} sa{hr} sc{m} h{hr} HINV _ _ _ _. + - 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/#. @@ -2029,35 +2029,35 @@ proof. - rewrite /#. - rewrite /#. - smt(domE). - - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO/#:=H6 H11. - - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. - cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + - 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/=. - cut[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). + 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/#. - - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. - cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + - 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. - cut[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). + 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/=. - cut [] help1 help2:= m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have [] help1 help2:= m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by have [] xc fx yc fy [#] /# := help2 _ _ _ _ H_Gmh. - - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. - cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + - 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/#. @@ -2066,18 +2066,18 @@ proof. by rewrite H_Gmh/= (@take_nth witness) 1:/# build_hpath_prefix/#. - rewrite/#. - rewrite/#. - - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. - cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + - 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. - cut[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). + 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 cut[]help1 help2/# :=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by have[]help1 help2/# :=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. alias{1} 1 prefixes = Redo.prefixes;sp. alias{2} 1 bad1 = G1.bcol;sp. @@ -2109,8 +2109,8 @@ proof. /\ (i{2} < size p{2} => ! take (i{2}+1) p{2} \in Redo.prefixes{1})));last first. + auto;progress. - smt(prefix_sizel). - - cut[]HINV [#] ->> _ _ _ h_sa_b0:=H3 H6;split;..-2:case:HINV=>//=. - cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV; split=> //=. + - 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). @@ -2121,7 +2121,7 @@ proof. 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 cut[]HINV _:=H3 H6;cut:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + - by have[]HINV _:=H3 H6;have:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - rewrite/#. - rewrite/#. - rewrite/#. @@ -2130,9 +2130,9 @@ proof. - rewrite/#. - rewrite/#. - rewrite/#. - - cut[]HINV[]->>[]->>[]H_h[]H_path H_F_RO:=H3 H6. - cut[]H01 H02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut H_pref_eq:=prefix_exchange_prefix_inv (elems (fdom C.queries{2})) + - 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). @@ -2154,51 +2154,51 @@ proof. sp;wp. if{1};2:rcondt{2}1;first last;3:rcondf{2}1;..3:auto. + progress. - cut[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. - cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{hr} bs{m} sa{hr} sc{m} h{hr} HINV _ _ _. + 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 cut:=H7;rewrite !domE=>->/=/#. + by have:=H7;rewrite !domE=>->/=/#. + progress. - rewrite/#. - rewrite/#. - by rewrite get_setE. - - cut[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + - 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=>//=. - cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV;split=>//=. + have[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV;split=>//=. * smt(get_setE size_take size_eq0 size_ge0 prefix_ge0). - * by cut[]_ Hmp02' _ _ _:=H_m_p0; + * 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). - cut->/=:(if i{2} + 1 < size bs{1} then i{2} + 1 else size bs{1}) = i{2} + 1 by rewrite/#. + 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. - cut->/=:! take j (take (i{2} + 1) bs{1}) = take (i{2} + 1) bs{1} by smt(size_take). + 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. - - cut->/=:!take (j + 1) bs{1} = take (i{2} + 1) bs{1} by smt(size_take). - by cut:=Hmp1(take i{2} bs{1}) _ j _; + - 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). - cut->>:j = i{2} by rewrite/#. + 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. - cut->/=:!take j l = take (i{2} + 1) bs{1} by smt(domE take_oversize size_take take_take). - by cut->/=/#:!take (j+1) l = take (i{2} + 1) bs{1} + 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/=. - cut[]H2mp01 H2mp02 H2mp1 H2mp2 H2mp3:=H_m_p0. + 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;cut[]l1:=Hmp3 _ H_dom;rewrite!mem_set;case=>H_case. + 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). @@ -2206,75 +2206,75 @@ proof. - rewrite/#. - smt(domE get_setE). - move:H9;rewrite mem_set;case;smt(prefix_ge0). - - cut[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. - cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + - 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 cut:=H7;rewrite !domE=>->/=/#. + by have:=H7;rewrite !domE=>->/=/#. - rewrite/#. - - cut[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. - cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + - 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. - cut:=H7;rewrite !domE=>->/=[]b4 c4 h4[]H_PFm H_Gmh;rewrite H_PFm H_Gmh !oget_some/=. - cut[]_ help:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut:=help _ _ _ _ H_Gmh. - by cut[]f H_h':=H_h;rewrite H_h'/==>[][]a b c d[][]->>->>[];rewrite H_PFm/==>[]h'->>/#. - - cut[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. - cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + 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. - cut:=H7;rewrite !domE=>->/=[]b4 c4 h4[]H_PFm H_Gmh. + 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). - - cut[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. - cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + - 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. - cut:=H7;rewrite !domE=>->/=[]b4 c4 h4[]H_PFm H_Gmh. + have:=H7;rewrite !domE=>->/=[]b4 c4 h4[]H_PFm H_Gmh. rewrite(@take_nth witness);1:smt(prefix_ge0). - cut[]_ help H_uniq_path:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have[]_ help H_uniq_path:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. by rewrite help H_path;smt(domE). - - cut[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + - 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). - cut:=Hp2 (take (i{2} + 1 + 1) bs{1}). - pose P:= _ \/ _;cut/#:!P;rewrite/P;clear P;rewrite negb_or/=negb_exists/=;split. - * cut:=prefix_exchange_prefix_inv(elems (fdom C.queries{2}))(elems (fdom prefixes{1}))bs{1} _ _ _. - + by cut[]:=H_m_p0;smt(domE memE mem_fdom). - + cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=H_m_p0. - cut:=all_prefixes_of_m_p _ _ _ H_m_p0. + 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 cut[]:=H_m_p0;smt(memE domE 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. - cut[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. - cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{hr} bs{m} sa{hr} sc{m} h{hr} HINV _ _ _. + 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 cut:=H7;rewrite !domE=>/=->/=. + 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. - cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_i:=H3 H6. - cut[]:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{hr} bs{m} sa{hr} sc{m} h{hr} HINV _ _ _. + 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/#. - cut:=H7;rewrite domE =>/=->/=H_Gmh _ H_ H_path_uniq. - cut help:=H_ (take i{hr} bs{m}) (nth witness bs{m} i{hr});rewrite H_path/= in help. - cut:forall (b : block), + 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. @@ -2285,156 +2285,156 @@ proof. * rewrite/#. * rewrite/#. * by rewrite!get_setE/=. - * cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. - cut:=H10;rewrite !negb_or/==>[][][]bad1 hinv_none bad2. - cut H_hs_spec:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut H_mh_spec:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut H_m_mh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut H_mi_mhi:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut H_pi_spec:=pi_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut :=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + * 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/#. - cut:=H7;rewrite domE/==>->/=h_g1. - cut H2_pi_spec:pi_spec FRO.m{2}.[G1.chandle{2} <- (y2L, Unknown)] + 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. - - cut[]h:=H_pi_spec;cut:=h c p0 v;rewrite H11/==>[][]h1[] h'1 h'2. + - have[]h:=H_pi_spec;have:=h c p0 v;rewrite H11/==>[][]h1[] h'1 h'2. exists h1;rewrite -h'2 get_setE/=. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h'2. + have->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h'2. by apply build_hpath_up=>//=. move:H12;rewrite get_setE/==>hh0. - cut h0_neq_ch:h0 <> G1.chandle{2} by rewrite/#. - cut[]->:=H_pi_spec;rewrite-hh0 h0_neq_ch/=;exists h0=>/=. - cut:=H;cut:=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. + 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/=. - cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. - cut -> /= <-//=:=ch_neq0 _ _ H_hs_spec;progress;cut[]hh1 hh2 hh3:=H_mh_spec;smt(dom_hs_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:cut//:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - by cut:=hinvP FRO.m{2} y2L;rewrite hinv_none/=/#. - + by cut:=invG_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - + apply inv_addm=>//;1:cut//:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + + 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;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - + cut[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + 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;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - + cut[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + 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;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by apply ch_notdomE_hs;have:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + apply incl_upd_nin=>//=. - by cut:=incl_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by have:=incl_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + apply incl_upd_nin=>//=. - - by cut:=incli_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut:=hinvP FRO.m{2} y2L;rewrite domE hinv_none/=;apply absurd=>H_P_mi. + - by have:=incli_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have:=hinvP FRO.m{2} y2L;rewrite domE hinv_none/=;apply absurd=>H_P_mi. rewrite negb_forall/=. - cut H_inv_Gmh:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut[]H_inv_Pm:=inv_mh_inv_Pm _ _ _ _ _ H_m_mh H_mi_mhi H_inv_Gmh. - cut[]H_Pmi H_Gmhi:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - by cut[]/#:=H_Pmi y1L y2L (oget PF.mi{1}.[(y1L, y2L)]).`1 + 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). - + cut H_take_Si:=take_nth witness i{2} bs{1} _;1:smt(prefix_ge0). + + 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=>[->> ->>][<<- <<-]/=. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. + 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. - cut[]hh1 hh2 hh3:=H_mh_spec. - cut[]xc hxx yc hyc []h2[]h3 h4:=hh1 _ _ _ _ h1. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h2. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h3. + 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. - cut->/=:=build_hpath_up _ _ _ y1L G1.chandle{2} _ _ _ hb h_g1. - cut/#:!rcons p0 (b +^ x) = rcons (take i{2} bs{1}) (nth witness bs{1} i{2});move:neq;apply absurd=>//=h'. - cut<<-:take i{2} bs{1}=p0 by rewrite/#. - cut hbex:b +^ x = nth witness bs{1} i{2} by rewrite/#. - by cut:=hb;rewrite H_path/==>[][->>->>]/=;rewrite-hbex Block.WRing.addKr/=. + 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/=. - + cut->/=:=build_hpath_up _ _ _ y1L G1.chandle{2} _ _ _ H_path h_g1. + + 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/=. - cut->/=:!rcons (take i{2} bs{1}) bn = rcons (take i{2} bs{1}) (nth witness bs{1} i{2}). + 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. - cut[]_ hh4 _:=H_mh_spec. - by cut:=hh4 (take i{2} bs{1}) bn b0;rewrite h_ro_p_bn/=H_path/=;smt(get_setE @Block.WRing). - cut->/=:!rcons p0 bn = rcons (take i{2} bs{1}) (nth witness bs{1} i{2}). + 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. - cut:size p0 = size (take i{2} bs{1}) by smt(size_rcons). + 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. - cut[]_ hh4 _:=H_mh_spec. - cut:=hh4 p0 bn b0;rewrite h_ro_p_bn/==>[][];progress. - cut help:(sa{2} +^ nth witness bs{1} i{2}, h{2}) <> (v +^ bn, hx) by rewrite/#. + 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;cut h_eq:v +^ bn = sa{2} +^ nth witness bs{1} i{2} && hx = h{2}. - + cut/#:G1.mh{2}.[(v +^ bn, hx)] <> Some (b0, G1.chandle{2}). - cut[]_ hh2:=H_m_mh. - cut:=hh2 (v +^ bn) hx b0 G1.chandle{2}. + + 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 cut[]/#:=H_hs_spec. - cut[]eq_xor ->>:=h_eq. + by have[]/#:=H_hs_spec. + have[]eq_xor ->>:=h_eq. move:h;rewrite eq_xor/==>->>. - cut/#:!(p0 = (take i{2} bs{1}) /\ bn = (nth witness bs{1} i{2})) => + 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. - - cut:=known_path_uniq _ _ _ sc{1} h{2} p0 v (take i{2} bs{1}) sa{2} H2_pi_spec _ h_build_hpath_set _. + - 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 cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. + by have->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. * by apply build_hpath_up=>//=. move=>[]->>->>/=;apply absurd=>//=_. - cut->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). - cut[]hh1 hh2 hh3:=H_mh_spec. - cut:=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}. + 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/=. - cut->/=:=ch_neq0 _ _ H_hs_spec. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. - move=>help;cut:= help _;1:smt(dom_hs_neq_ch). + 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=>//=. - cut:=hh3 _ _ _ _ _ H_path h_build_hpath_p0. - cut->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). - move=>help;cut h_neq:! (v +^ bn = sa{2} +^ nth witness bs{1} i{2} /\ hx = h{2}) by rewrite/#. + 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. - cut[]hh1 hh2 hh3:=H_mh_spec. - cut:=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[]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/=. - cut->/=:=ch_neq0 _ _ H_hs_spec. - by cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h; smt(dom_hs_neq_ch). + have->/=:=ch_neq0 _ _ H_hs_spec. + by have->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h; smt(dom_hs_neq_ch). progress. - + cut:=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. - cut:=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. + + 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. - cut->/=:=ch_neq0 _ _ H_hs_spec. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. + have->/=:=ch_neq0 _ _ H_hs_spec. + have->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. - cut[]:=H_mh_spec => HH1 HH2 HH3 HH4 HH5. + 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}). @@ -2455,13 +2455,13 @@ proof. by have[#]->><<-//=:=HH3 _ _ _ _ _ hp11 H_path. move=>hp21 hp11. by have[#]->>->>:=HH3 _ _ _ _ _ hp21 hp11. - cut:=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. - cut:=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. + 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/=. - cut->/=:=ch_neq0 _ _ H_hs_spec. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. + have->/=:=ch_neq0 _ _ H_hs_spec. + have->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. - cut[]:=H_mh_spec => HH1 HH2 HH3 HH4 HH5. + 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}). @@ -2484,44 +2484,44 @@ proof. by have[#]->>->>:=HH3 _ _ _ _ _ hp21 hp11. + rewrite!get_setE/=;exact H2_pi_spec. + rewrite!get_setE/=. - cut H_m_p:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut H_all_prefixes:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + 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 cut[]:=H_m_p0;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/=. - cut->/=:!take j l = take (i{2} + 1) bs{1} by rewrite/#. - cut->/=:!take (j+1) l = take (i{2} + 1) bs{1} by rewrite/#. + 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). - cut->>:=H_case;rewrite size_take;1:smt(prefix_ge0). - cut->/=:(if i{2} + 1 < size bs{1} then i{2} + 1 else size bs{1}) = i{2} + 1 by rewrite/#. + 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. - cut->/=:! take j (take (i{2} + 1) bs{1}) = take (i{2} + 1) bs{1} by smt(size_take). + 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. - - cut->/=:!take (j + 1) bs{1} = take (i{2} + 1) bs{1} by smt(size_take). - by cut:=Hmp1(take i{2} bs{1}) _ j _;smt(domE take_take nth_take prefix_ge0 size_take get_setE). - cut->>:j = i{2} by rewrite/#. + - 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/=. - cut[]H2mp01 H2mp02 H2mp1 H2mp2 H2mp3:=H_m_p0. + 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;cut[]l1:=Hmp3 _ H_dom;rewrite!mem_set;case=>H_case. + 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/#. - * cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. - split;cut[]//= hmp01 hmp02 hmp1 hmp2 hmp3:=H_m_p0. + * 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 @@ -2532,28 +2532,28 @@ proof. + rewrite/#. + by rewrite!get_setE/=/#. + rewrite!get_setE/=(@take_nth witness);1:smt(prefix_ge0);rewrite build_hpath_prefix. - cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. - cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + 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/#. - cut:=H7;rewrite domE=>/=->/=H_Gmh. - cut->/=:=build_hpath_up_None _ _ (y1L, G1.chandle{2})_ _ H_Gmh H_path;smt(get_setE). + 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). - cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. - cut:=Hp2 (take (i{2} + 1 + 1) bs{1}). - pose P:= _ \/ _;cut/#:!P;rewrite/P;clear P;rewrite negb_or/=negb_exists/=;split. - * cut:=prefix_exchange_prefix_inv(elems (fdom C.queries{2}))(elems (fdom prefixes{1}))bs{1} _ _ _. - + by cut[]:=H_m_p0;smt(domE memE mem_fdom). - + cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=H_m_p0. - cut:=all_prefixes_of_m_p _ _ _ H_m_p0. + 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 cut[]:=H_m_p0;smt(memE domE 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. @@ -2597,7 +2597,7 @@ section AUX. F.RO.m{2} G1.paths{2} Redo.prefixes{1} C.queries{2}). + by move=> &1 &2; rewrite negb_or. - + progress;cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(domE). + + 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 @@ -2683,11 +2683,11 @@ section. + Pr[G1(DRestr(D)).main() @&m: G1.bext]. proof. apply (@RealOrder.ler_trans _ _ _ (Real_Concrete D D_ll &m))=>//=. - cut : Pr[CF(DRestr(D)).main() @ &m : res] <= + 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]. + byequiv (CF_G1 D D_ll)=>//=/#. - cut/#:Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext] + 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]. rewrite Pr[mu_or];smt(Distr.mu_bounded). diff --git a/sha3/proof/smart_counter/SLCommon.ec b/sha3/proof/smart_counter/SLCommon.ec index 76cecbf..33fdb7b 100644 --- a/sha3/proof/smart_counter/SLCommon.ec +++ b/sha3/proof/smart_counter/SLCommon.ec @@ -406,7 +406,7 @@ lemma all_take_in (l : block list) i prefixes : i <= prefix l (get_max_prefix l (elems (fdom prefixes))). proof. move=>[hi0 hisize] all_prefix take_in_dom. -cut->:i = prefix l (take i l);2:smt(get_max_prefix_max memE mem_fdom). +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//=/#. @@ -424,7 +424,7 @@ 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). -cut[l2 h_l2_mem]:=h_exist l i h_take_neq_nil take_in_dom. +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). @@ -446,8 +446,8 @@ 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. - cut h1:prefix l3 l2 = size l3 by smt(prefix_sizel). - cut: size l3 <= prefix l3 (max_prefix l3 l2 ll);2:smt(prefix_sizel). + 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)=>//=/#. @@ -475,7 +475,7 @@ lemma prefix_geq (l1 l2 : 'a list) : proof. move:l2;elim:l1=>//=[[] //=|] e1 l1 Hind l2;elim:l2=>//=e2 l2 Hind2. case(e1=e2)=>//=h12. -cut->/=:! 1 + prefix l1 l2 <= 0 by smt(prefix_ge0). +have ->/=:! 1 + prefix l1 l2 <= 0 by smt(prefix_ge0). rewrite h12/=/#. qed. @@ -484,7 +484,7 @@ lemma prefix_take_prefix (l1 l2 : 'a list) : proof. move:l2;elim:l1=>//=e1 l1 Hind l2;elim:l2=>//=e2 l2 Hind2. case(e1=e2)=>//=h12. -cut->/=:! 1 + prefix l1 l2 <= 0 by smt(prefix_ge0). +have ->/=:! 1 + prefix l1 l2 <= 0 by smt(prefix_ge0). rewrite h12/=/#. qed. @@ -508,11 +508,11 @@ lemma prefix_take_geq_prefix (l1 l2 : 'a list) i : prefix l1 l2 = prefix (take i l1) l2. proof. move=>hi. -cut:prefix (take i l1) l2 <= prefix l1 l2. +have: prefix (take i l1) l2 <= prefix l1 l2. + rewrite-{2}(cat_take_drop i l1) prefix_leq_prefix_cat. -cut/#:prefix l1 l2 <= prefix (take i l1) l2. +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 //=. +rewrite -(cat_take_drop (prefix l1 l2) (take i l1))take_take minrE hi //=. by rewrite prefix_leq_prefix_cat. qed. @@ -555,19 +555,19 @@ move:l;elim:ll=>//=l2 ll Hind l1;clear Hind;move:l1 l2;elim:ll=>//=. 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. - cut:drop (prefix l1 l2) (take i l1) <> drop (prefix l1 l2) l2;2:smt(catsI). + 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:/#. - cut:=drop_prefix_neq (take i l1) l2. - cut/#:drop (prefix (take i l1) l2) (take i l1) <> []. - cut:0 < size (drop (prefix (take i l1) l2) (take i l1));2:smt(size_eq0). + 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/=. - cut:=hind l1 l3 H i H0;rewrite negb_or=>[][->->]/=. - cut:=hind l1 l2 _ i _;smt(prefix_prefix_prefix). + have:= hind l1 l3 H i H0;rewrite negb_or=>[][->->]/=. + have:= hind l1 l2 _ i _;smt(prefix_prefix_prefix). smt(prefix_prefix_prefix). qed. @@ -579,10 +579,10 @@ lemma asfadst queries prefixes (bs : block list) : take (prefix bs (get_max_prefix bs (elems (fdom queries))) + 1) bs = bs. proof. progress. -cut h:=prefix_inv_leq bs (size bs) prefixes queries _ _ _ _ _;rewrite//=. +have h:=prefix_inv_leq bs (size bs) prefixes queries _ _ _ _ _;rewrite//=. + exact size_ge0. + rewrite H2//=;exact size_ge0. -cut->/=:prefix bs (get_max_prefix bs (elems (fdom queries))) = size bs by smt(prefix_sizel). +have ->/=: prefix bs (get_max_prefix bs (elems (fdom queries))) = size bs by smt(prefix_sizel). rewrite take_oversize/#. qed. @@ -598,9 +598,9 @@ case(ll1 = [])=>//=[-> _ _|]. 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. -cut mem_ll2:=mem_get_max_prefix l ll2 ll2_nil. -cut[]l3 mem_ll1:=incl2 _ mem_ll2. -cut:=get_max_prefix_max l ll1 _ mem_ll1. +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. @@ -609,7 +609,7 @@ lemma prefix_inv_nil queries prefixes : elems (fdom queries) = [] => fdom prefixes \subset fset1 []. proof. move=>[h1 [h2 h3]] h4 x h5;rewrite in_fset1. -cut:=h3 x (size x). +have:=h3 x (size x). rewrite take_size -mem_fdom h5/=;apply absurd=>//=h6. rewrite h6/=negb_exists/=;smt(memE mem_fdom). qed. @@ -639,12 +639,12 @@ lemma prefix_exchange queries prefixes (l : block list) : proof. move=> [h1[h2 h3]] h5. case: (elems (fdom queries) = [])=> h4. -+ cut h6:=prefix_inv_nil queries prefixes _ h4;1:rewrite/#. ++ 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. - cut h8:elems (fdom prefixes) = [[]]. + have h8:elems (fdom prefixes) = [[]]. + have []:= fdom_prefixP. + by move=> h8; move: h7; rewrite h8 elems_fset0. by move=> ->; rewrite elems_fset1. @@ -679,7 +679,7 @@ proof. move=>[]H_incl H_all_prefixes Hi. rewrite (prefix_take_leq _ (get_max_prefix l (elems (fdom queries))))1:/#. rewrite H_all_prefixes. -cut:get_max_prefix l (elems (fdom queries)) \in queries;2:smt(domE). +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. @@ -722,14 +722,14 @@ case(prefix (l1 ++ l2) l3 < prefix (l1 ++ l2) l4)=>//=. 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 _ _ _)). - cut->/=:prefix l1 (max_prefix l1 l4 ll) = size l1 + have->/=:prefix l1 (max_prefix l1 l4 ll) = size l1 by move:{hind};elim:ll=>//=;smt(prefix_sizel). - by cut->/=:prefix l1 (max_prefix l1 l3 ll) = size l1 + by have->/=:prefix l1 (max_prefix l1 l3 ll) = size l1 by move:{hind};elim:ll=>//=;smt(prefix_sizel). - smt(prefix_sizel prefix_ge0). - - cut->/=h:prefix l1 l3 < prefix l1 l4 by smt(prefix_sizel). + - have->/=h:prefix l1 l3 < prefix l1 l4 by smt(prefix_sizel). rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _)). - cut->/=:prefix l1 (max_prefix l1 l4 ll) = size l1 + 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/=. @@ -740,9 +740,9 @@ 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. - cut->/=:!size l1 < prefix l1 l4 by smt(prefix_sizel). + have->/=:!size l1 < prefix l1 l4 by smt(prefix_sizel). rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _))//=. - cut->//=:prefix l1 (max_prefix l1 l3 ll) = size l1 + 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). @@ -793,8 +793,8 @@ 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;cut->/#:b<>y. - by cut/#: rng m b;rewrite rngE /#. ++ 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. @@ -1068,18 +1068,18 @@ lemma hinvP handles c: else exists f, handles.[oget (hinv handles c)] = Some(c,f). proof. move=> @/hinv. -cut @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := +have @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := findP (fun (_ : handle) => pred1 c \o fst) handles. + exists (oget handles.[h]).`2. by move: Hmem; rewrite domE; case: (handles.[h])=> //= - []. -by cut := H h;rewrite domE /#. +by have := H h;rewrite domE /#. 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. -cut:=Huniq h;cut:=hinvP handles c. +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]=> //= - []. @@ -1092,7 +1092,7 @@ lemma hinvKP handles c: else handles.[oget (hinvK handles c)] = Some(c,Known). proof. rewrite /hinvK. - cut @/pred1/= [[h]|][->/=]:= findP (+ pred1 c) (restr Known handles). + have @/pred1/= [[h]|][->/=]:= findP (+ pred1 c) (restr Known handles). + by rewrite domE restrP;case (handles.[h])=>//= /#. by move=>+h-/(_ h);rewrite domE restrP => H1/#. qed. From 8e52e50e0634fc4ddd43d4d2754c2a41e4cf5d73 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 2 Mar 2021 14:06:44 +0000 Subject: [PATCH 383/394] Finish fixing Sponge --- sha3/proof/SHA3OSecurity.ec | 120 ++++++++++++++++++------------------ sha3/proof/SHA3_OIndiff.ec | 4 +- sha3/proof/SecureORO.eca | 21 ++++--- 3 files changed, 74 insertions(+), 71 deletions(-) diff --git a/sha3/proof/SHA3OSecurity.ec b/sha3/proof/SHA3OSecurity.ec index 10b041a..b1e5936 100644 --- a/sha3/proof/SHA3OSecurity.ec +++ b/sha3/proof/SHA3OSecurity.ec @@ -44,12 +44,12 @@ axiom dout_equal_dlist : dmap dout to_list = dlist dbool size_out. lemma doutE1 x : mu1 dout x = inv (2%r ^ size_out). proof. -cut->:inv (2%r ^ size_out) = mu1 (dlist dbool size_out) (to_list x). +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 _ _ _. - cut->: p = StdBigop.Bigreal.BRM.big predT (fun _ => inv 2%r) (to_list x). + 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. @@ -351,10 +351,10 @@ if{2}; sp; last first. 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 12?. - rewrite take_oversize 1:spec_dout 1:H4 //. + - 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:=H3; rewrite domE; smt(). + 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 /\ @@ -362,11 +362,11 @@ if{2}; sp; last first. 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 9?. + 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 - H6; congr; rewrite H4=> //=. - by apply H3=> //=. + 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 /\ @@ -380,14 +380,14 @@ conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{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 12?; do!split; ..-2 : smt(domE mem_set). ++ 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 H8; 1:smt(); congr; congr. + - rewrite oget_some H9; 1:smt(); congr; congr. by rewrite eq_sym to_listK; smt(spec2_dout). move=> Hneq. - by rewrite -(H6 _ _ Hneq) H2; smt(domE). + 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}) /\ @@ -396,7 +396,7 @@ while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ (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 *. + 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). @@ -404,7 +404,7 @@ while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ - 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/=H8//=. + by rewrite Hjs/=H9//=. by auto; smt(size_out_gt0). qed. @@ -583,7 +583,7 @@ local lemma eager_ideal &m : OSimulator(ExtendSample(FSome(BIRO.IRO))), ODRestr(Dist_of_P1Adv(A))).main() @ &m : res]. proof. -cut->: +have->: Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] = @@ -614,7 +614,7 @@ cut->: 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. -cut->: +have->: Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), OSimulator(ExtendSample(FSome(BIRO.IRO))), ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] = @@ -774,9 +774,9 @@ rcondf{2} 4; 1: 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 14?; split; 2: smt(divz_ge0 gt0_r size_ge0). +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 H5. +have h:=spec2_dout result_L H7. have-> := some_oget _ h. by rewrite /= eq_sym -to_listK. qed. @@ -877,8 +877,10 @@ qed. 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(). - - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). +(** - 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. @@ -1069,10 +1071,10 @@ if{2}; sp; last first. 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 12?. - rewrite take_oversize 1:spec_dout 1:H4 //. + - 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:=H3; rewrite domE; smt(). + 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 /\ @@ -1080,11 +1082,11 @@ if{2}; sp; last first. 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 9?. + 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 - H6; congr; rewrite H4=> //=. - by apply H3=> //=. + 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 /\ @@ -1098,14 +1100,14 @@ conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{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 12?; do!split; ..-2 : smt(domE mem_set). ++ 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 H8; 1:smt(); congr; congr. + - rewrite oget_some H9; 1:smt(); congr; congr. by rewrite eq_sym to_listK; smt(spec2_dout). move=> Hneq. - by rewrite -(H6 _ _ Hneq) H2; smt(domE). + 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}) /\ @@ -1114,7 +1116,7 @@ while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ (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 13?. + 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). @@ -1122,7 +1124,7 @@ while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ - 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/=H8//=. + by rewrite Hjs/=H9//=. by auto; smt(size_out_gt0). qed. @@ -1294,7 +1296,7 @@ local lemma eager_ideal &m : OSimulator(ExtendSample(FSome(BIRO.IRO))), ODRestr(Dist_of_P2Adv(A))).main() @ &m : res]. proof. -cut->: +have->: Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), ODRestr(Dist_of_P2Adv(A))).main() @ &m : res] = @@ -1351,7 +1353,7 @@ cut->: 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. -cut->: +have->: Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), OSimulator(ExtendSample(FSome(BIRO.IRO))), ODRestr(Dist_of_P2Adv(A))).main() @ &m : res] = @@ -1448,9 +1450,9 @@ if{1}. inline{1} 1; sp; auto. sp; rcondt{1} 1; auto. inline{1} 1; sp; auto. - call(eq_IRO_RFWhile); auto=> /> 15?. + 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 _ H5. + have:=spec2_dout _ H6. move=>/(some_oget)-> /=; smt(divz_ge0 gt0_r size_ge0 spec2_dout). move=>/=. conseq(:_==> true); auto. @@ -1556,7 +1558,7 @@ seq 1 1 : (={glob A, glob OFC, glob OSimulator, Log.m} /\ 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))=> /= />. + call(titi mess2 (increase_counter c mess1 size_out))=> /=. by call(titi mess1 c)=> />; auto; smt(). inline*; sp. rcondf{1} 1; 1: auto; sp. @@ -1610,9 +1612,9 @@ rcondf{2} 4; 1: 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 14?; split; 2: smt(divz_ge0 gt0_r size_ge0). +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 H5. +have h:=spec2_dout result_L H6. have-> := some_oget _ h. by rewrite eq_sym -to_listK; congr. qed. @@ -1734,8 +1736,8 @@ 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=> />; 1: smt(). - - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). + - 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(). @@ -1948,10 +1950,10 @@ if{2}; sp; last first. 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 12?. - rewrite take_oversize 1:spec_dout 1:H4 //. + - 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:=H3; rewrite domE; smt(). + 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 /\ @@ -1959,11 +1961,11 @@ if{2}; sp; last first. 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 9?. + 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 - H6; congr; rewrite H4=> //=. - by apply H3=> //=. + 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 /\ @@ -1977,14 +1979,14 @@ conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{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 12?; do!split; ..-2 : smt(domE mem_set). ++ 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 H8; 1:smt(); congr; congr. + - rewrite oget_some H9; 1:smt(); congr; congr. by rewrite eq_sym to_listK; smt(spec2_dout). move=> Hneq. - by rewrite -(H6 _ _ Hneq) H2; smt(domE). + 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}) /\ @@ -1993,7 +1995,7 @@ while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ (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 13?. + 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). @@ -2001,7 +2003,7 @@ while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ - 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/=H8//=. + by rewrite Hjs/=H9//=. by auto; smt(size_out_gt0). qed. @@ -2173,7 +2175,7 @@ local lemma eager_ideal &m : OSimulator(ExtendSample(FSome(BIRO.IRO))), ODRestr(Dist_of_CollAdv(A))).main() @ &m : res]. proof. -cut->: +have->: Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), ODRestr(Dist_of_CollAdv(A))).main() @ &m : res] = @@ -2230,7 +2232,7 @@ cut->: 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. -cut->: +have->: Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), OSimulator(ExtendSample(FSome(BIRO.IRO))), ODRestr(Dist_of_CollAdv(A))).main() @ &m : res] = @@ -2326,9 +2328,9 @@ if{1}. inline{1} 1; sp; auto. sp; rcondt{1} 1; auto. inline{1} 1; sp; auto. - call(eq_IRO_RFWhile); auto=> /> 15?. + 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 _ H5. + have:=spec2_dout _ H6. move=>/(some_oget)-> /=; smt(divz_ge0 gt0_r size_ge0 spec2_dout). move=>/=. conseq(:_==> true); auto. @@ -2430,7 +2432,7 @@ seq 1 2 : (={glob A, glob OFC, glob OSimulator, Log.m, m1, m2} /\ 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))=> /= />. + call(titi mess2 (increase_counter c mess1 size_out))=> /=. by call(titi mess1 c)=> />; auto; smt(). inline*; sp. rcondf{1} 1; 1: auto; sp. @@ -2482,9 +2484,9 @@ rcondf{2} 4; 1: 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 14?; split; 2: smt(divz_ge0 gt0_r size_ge0). +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 H5. +have h:=spec2_dout result_L H6. have-> := some_oget _ h. by rewrite eq_sym -to_listK; congr. qed. @@ -2599,8 +2601,8 @@ 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=> />; 1: smt(). - - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). + - 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. diff --git a/sha3/proof/SHA3_OIndiff.ec b/sha3/proof/SHA3_OIndiff.ec index 4590e95..9dca303 100644 --- a/sha3/proof/SHA3_OIndiff.ec +++ b/sha3/proof/SHA3_OIndiff.ec @@ -224,7 +224,7 @@ lemma SHA3OIndiff (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. proof. move=>h. -cut->: Pr[OGReal(CSome(Sponge), PSome(Perm), ODRestr(Dist)).main() @ &m : res] = +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. @@ -239,7 +239,7 @@ cut->: Pr[OGReal(CSome(Sponge), PSome(Perm), ODRestr(Dist)).main() @ &m : res] = - by sp; if; auto; sp; if; auto. conseq(:_==> ={glob Perm, sa, sc})=> />; sim. by while(={glob Perm, sa, sc, xs}); auto; sp; if; auto=> />. -cut->: Pr[OGIdeal(FSome(IRO), OSimulator, ODRestr(Dist)).main() @ &m : res] = +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. diff --git a/sha3/proof/SecureORO.eca b/sha3/proof/SecureORO.eca index f6c47d8..b3328c2 100644 --- a/sha3/proof/SecureORO.eca +++ b/sha3/proof/SecureORO.eca @@ -106,7 +106,7 @@ section Preimage. lemma RO_is_preimage_resistant &m : Pr [ Preimage(A,RF(RO)).main() @ &m : res ] <= (bound + 1)%r * mu1 sampleto witness. proof. - cut->: Pr [ Preimage (A,RF(RO)).main() @ &m : res ] = + have->: Pr [ Preimage (A,RF(RO)).main() @ &m : res ] = Pr [ Preimage2(A,RF(RO)).main() @ &m : res ]. + by byequiv=> //=; proc; inline*; sim. byphoare(: _ ==> _) => //=; proc. @@ -121,7 +121,8 @@ section Preimage. 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 {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. @@ -135,17 +136,17 @@ section Preimage. rewrite ler_maxr //=; 1:smt(bound_ge0). rewrite-RField.AddMonoid.iteropE-RField.intmulpE; 1: smt(bound_ge0). by rewrite RField.intmulr; smt(). - - inline*; auto=> /> &h. + - 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 ??????. + 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:H1; rewrite rngE /= negb_exists/= => /(_ a) //=. + by move:H2; rewrite rngE /= negb_exists/= => /(_ a) //=. - move=> c; proc; inline*; sp; if; sp. + auto; progress. + smt(). @@ -277,7 +278,7 @@ section SecondPreimage. - 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=> /> &h sample. + 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. @@ -291,7 +292,7 @@ section SecondPreimage. rewrite-RField.AddMonoid.iteropE-RField.intmulpE; 1: smt(bound_ge0). by rewrite RField.intmulr; smt(mu_bounded bound_ge0). + inline*; auto=> />. - move=> &h r; rewrite mem_empty /= !mem_set mem_empty/= sampleto_full /=. + 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. @@ -329,8 +330,8 @@ section SecondPreimage. 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 _ in_dom2. - move=> sample2 _ sample1 _; rewrite negb_and/=. + - 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(). @@ -483,7 +484,7 @@ section Collision. 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 _ _ sample _. + move=> /> &h h1 h2 _ h3 sample _. by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). qed. From 81573780b6beff3df1bb80554cb838b61d910a66 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 15 Nov 2021 15:18:21 +0000 Subject: [PATCH 384/394] Update to follow new section mechanism and smt syntax --- sha3/proof/IndifRO_is_secure.ec | 12 ++++++------ sha3/proof/SHA3Indiff.ec | 6 +++--- sha3/proof/SHA3OSecurity.ec | 6 +++--- sha3/proof/SHA3Security.ec | 16 +++++++-------- sha3/proof/SHA3_OIndiff.ec | 4 ++-- sha3/proof/SecureORO.eca | 6 +++--- sha3/proof/SecureRO.eca | 6 +++--- sha3/proof/Sponge.ec | 8 ++++---- sha3/proof/smart_counter/ConcreteF.eca | 6 +++--- sha3/proof/smart_counter/Gcol.eca | 4 ++-- sha3/proof/smart_counter/Gconcl.ec | 4 ++-- sha3/proof/smart_counter/Gconcl_list.ec | 16 +++++++-------- sha3/proof/smart_counter/Gext.eca | 6 +++--- sha3/proof/smart_counter/Handle.eca | 15 +++++++------- sha3/proof/smart_counter/SLCommon.ec | 26 ++++++++++++------------- 15 files changed, 70 insertions(+), 71 deletions(-) diff --git a/sha3/proof/IndifRO_is_secure.ec b/sha3/proof/IndifRO_is_secure.ec index aa2a625..be9534a 100644 --- a/sha3/proof/IndifRO_is_secure.ec +++ b/sha3/proof/IndifRO_is_secure.ec @@ -91,9 +91,9 @@ module DColl (A : AdvCollision) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { section Collision. - declare module A : AdvCollision{Bounder, SRO.RO.RO, SRO.RO.FRO}. + declare module A <: AdvCollision {Bounder, SRO.RO.RO, SRO.RO.FRO}. - axiom D_ll (F <: Oracle { A }) : + declare axiom D_ll (F <: Oracle { A }) : islossless F.get => islossless A(F).guess. lemma coll_resistant_if_indifferentiable @@ -136,9 +136,9 @@ module DPre (A : AdvPreimage) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { section Preimage. - declare module A : AdvPreimage{Bounder, SRO.RO.RO, SRO.RO.FRO, DPre}. + declare module A <: AdvPreimage {Bounder, SRO.RO.RO, SRO.RO.FRO, DPre}. - axiom D_ll (F <: Oracle{A}) : + declare axiom D_ll (F <: Oracle{A}) : islossless F.get => islossless A(F).guess. lemma preimage_resistant_if_indifferentiable @@ -182,9 +182,9 @@ module D2Pre (A : AdvSecondPreimage) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { section SecondPreimage. - declare module A : AdvSecondPreimage{Bounder, SRO.RO.RO, SRO.RO.FRO, D2Pre}. + declare module A <: AdvSecondPreimage {Bounder, SRO.RO.RO, SRO.RO.FRO, D2Pre}. - axiom D_ll (F <: Oracle{A}) : + declare axiom D_ll (F <: Oracle{A}) : islossless F.get => islossless A(F).guess. lemma second_preimage_resistant_if_indifferentiable diff --git a/sha3/proof/SHA3Indiff.ec b/sha3/proof/SHA3Indiff.ec index 7afdf98..fa02597 100644 --- a/sha3/proof/SHA3Indiff.ec +++ b/sha3/proof/SHA3Indiff.ec @@ -145,14 +145,14 @@ module DRestr (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { section. -declare module Dist : - DISTINGUISHER{Perm, Gconcl_list.SimLast, IRO, Cntr, BlockSponge.BIRO.IRO, +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}. -axiom Dist_lossless (F <: DFUNCTIONALITY { Dist }) (P <: DPRIMITIVE { Dist }) : +declare axiom Dist_lossless (F <: DFUNCTIONALITY { Dist }) (P <: DPRIMITIVE { Dist }) : islossless P.f => islossless P.fi => islossless F.f => islossless Dist(F,P).distinguish. diff --git a/sha3/proof/SHA3OSecurity.ec b/sha3/proof/SHA3OSecurity.ec index b1e5936..e78cef3 100644 --- a/sha3/proof/SHA3OSecurity.ec +++ b/sha3/proof/SHA3OSecurity.ec @@ -189,7 +189,7 @@ import FullEager. section Preimage. - declare module A : SH.AdvPreimage { Perm, Counter, Bounder, F.RO, F.FRO, + 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, @@ -912,7 +912,7 @@ end section Preimage. section SecondPreimage. - declare module A : SH.AdvSecondPreimage { Perm, Counter, Bounder, F.RO, + 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, @@ -1792,7 +1792,7 @@ end section SecondPreimage. section Collision. - declare module A : SH.AdvCollision { Perm, Counter, Bounder, F.RO, + 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, diff --git a/sha3/proof/SHA3Security.ec b/sha3/proof/SHA3Security.ec index 80e1070..696f94c 100644 --- a/sha3/proof/SHA3Security.ec +++ b/sha3/proof/SHA3Security.ec @@ -124,12 +124,12 @@ module (DSetSize (D : Indiff0.DISTINGUISHER) : DISTINGUISHER) section Preimage. - declare module A : SRO.AdvPreimage{SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, + 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}. - axiom A_ll (F <: SRO.Oracle { A }) : islossless F.get => islossless A(F).guess. + 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. @@ -481,12 +481,12 @@ end section Preimage. section SecondPreimage. - declare module A : SRO.AdvSecondPreimage{SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, + 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}. - axiom A_ll (F <: SRO.Oracle { A }) : islossless F.get => islossless A(F).guess. + 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. @@ -874,12 +874,12 @@ end section SecondPreimage. section Collision. - declare module A : SRO.AdvCollision{SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, + 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}. - axiom A_ll (F <: SRO.Oracle { A }) : islossless F.get => islossless A(F).guess. + 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. @@ -1265,12 +1265,12 @@ module AdvCollisionSHA3 (A : SRO.AdvCollision) (F : SRO.Oracle) = { section SHA3_Collision. - declare module A : SRO.AdvCollision{SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, + 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}. - axiom A_ll (F <: SRO.Oracle { A }) : islossless F.get => islossless A(F).guess. + 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] <= diff --git a/sha3/proof/SHA3_OIndiff.ec b/sha3/proof/SHA3_OIndiff.ec index 9dca303..3f5a6ea 100644 --- a/sha3/proof/SHA3_OIndiff.ec +++ b/sha3/proof/SHA3_OIndiff.ec @@ -168,8 +168,8 @@ module ODRestr (D : ODISTINGUISHER) (F : ODFUNCTIONALITY) (P : ODPRIMITIVE) = { }. section. -declare module Dist : - ODISTINGUISHER{Perm, Gconcl_list.SimLast, IRO, Cntr, BlockSponge.BIRO.IRO, +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, diff --git a/sha3/proof/SecureORO.eca b/sha3/proof/SecureORO.eca index b3328c2..8a4ae24 100644 --- a/sha3/proof/SecureORO.eca +++ b/sha3/proof/SecureORO.eca @@ -81,7 +81,7 @@ module Preimage (A : AdvPreimage, F : RF) = { section Preimage. - declare module A : AdvPreimage{RO,Preimage}. + declare module A <: AdvPreimage {RO,Preimage}. local module FEL (A : AdvPreimage, F : RF) = { proc main (hash : to) : from = { @@ -201,7 +201,7 @@ module SecondPreimage (A : AdvSecondPreimage, F : RF) = { section SecondPreimage. - declare module A : AdvSecondPreimage{Bounder,RO,FRO}. + declare module A <: AdvSecondPreimage {Bounder,RO,FRO}. local module FEL (A : AdvSecondPreimage, F : RF) = { proc main (m1 : from) : from = { @@ -364,7 +364,7 @@ module Collision (A : AdvCollision, F : RF) = { section Collision. - declare module A : AdvCollision {RO, FRO, Bounder}. + declare module A <: AdvCollision {RO, FRO, Bounder}. local module FEL (A : AdvCollision, F : RF) = { proc main () : from * from = { diff --git a/sha3/proof/SecureRO.eca b/sha3/proof/SecureRO.eca index c261f1d..c1917a4 100644 --- a/sha3/proof/SecureRO.eca +++ b/sha3/proof/SecureRO.eca @@ -86,7 +86,7 @@ module Preimage (A : AdvPreimage, F : RF) = { section Preimage. - declare module A : AdvPreimage{RO,Preimage}. + declare module A <: AdvPreimage {RO,Preimage}. local module FEL (A : AdvPreimage, F : RF) = { proc main (hash : to) : from = { @@ -212,7 +212,7 @@ module SecondPreimage (A : AdvSecondPreimage, F : RF) = { section SecondPreimage. - declare module A : AdvSecondPreimage{Bounder,RO,FRO}. + declare module A <: AdvSecondPreimage {Bounder,RO,FRO}. local module FEL (A : AdvSecondPreimage, F : RO) = { proc main (m1 : from) : from = { @@ -392,7 +392,7 @@ module Collision (A : AdvCollision, F : RO) = { section Collision. - declare module A : AdvCollision {RO, FRO, Bounder}. + declare module A <: AdvCollision {RO, FRO, Bounder}. local module FEL (A : AdvCollision, F : RO) = { proc main () : from * from = { diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index e7f6f21..ba4662d 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -90,7 +90,7 @@ 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. +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 /#. @@ -366,7 +366,7 @@ lemma HybridIROExper_Lazy_Eager section. -declare module D : HYBRID_IRO_DIST{HybridIROEager, HybridIROLazy}. +declare module D <: HYBRID_IRO_DIST {HybridIROEager, HybridIROLazy}. local clone PROM.FullRO as ERO with type in_t <- block list * int, @@ -1913,8 +1913,8 @@ end HybridIRO. section. -declare module BlockSim : BlockSponge.SIMULATOR{IRO, BlockSponge.BIRO.IRO}. -declare module Dist : DISTINGUISHER{Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}. +declare module BlockSim <: BlockSponge.SIMULATOR {IRO, BlockSponge.BIRO.IRO}. +declare module Dist <: DISTINGUISHER {Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}. local clone HybridIRO as HIRO. diff --git a/sha3/proof/smart_counter/ConcreteF.eca b/sha3/proof/smart_counter/ConcreteF.eca index f8fa6a0..18b0358 100644 --- a/sha3/proof/smart_counter/ConcreteF.eca +++ b/sha3/proof/smart_counter/ConcreteF.eca @@ -42,9 +42,9 @@ module PF = { module CF(D:DISTINGUISHER) = Indif(SqueezelessSponge(PF), PF, D). section. - declare module D : DISTINGUISHER {Perm, C, PF, Redo}. + declare module D <: DISTINGUISHER {Perm, C, PF, Redo}. - axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + declare axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. @@ -383,7 +383,7 @@ section. + 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)=> //=. - * move=> z; wp;if;auto; 2:call p_ll; auto=>/#. + * 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)). diff --git a/sha3/proof/smart_counter/Gcol.eca b/sha3/proof/smart_counter/Gcol.eca index 2421692..2211a44 100644 --- a/sha3/proof/smart_counter/Gcol.eca +++ b/sha3/proof/smart_counter/Gcol.eca @@ -24,9 +24,9 @@ import ROhandle. qed. section PROOF. - declare module D: DISTINGUISHER{C, PF, G1}. + declare module D <: DISTINGUISHER{C, PF, G1}. - axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + declare axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. diff --git a/sha3/proof/smart_counter/Gconcl.ec b/sha3/proof/smart_counter/Gconcl.ec index e4f0724..6810902 100644 --- a/sha3/proof/smart_counter/Gconcl.ec +++ b/sha3/proof/smart_counter/Gconcl.ec @@ -65,7 +65,7 @@ module S(F : DFUNCTIONALITY) = { section. -declare module D: DISTINGUISHER{C, Perm, F.RO, F.FRO, S, Redo}. +declare module D <: DISTINGUISHER{C, Perm, F.RO, F.FRO, S, Redo}. local clone import Gext as Gext0. @@ -361,7 +361,7 @@ proof. by auto. qed. -axiom D_ll : +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. diff --git a/sha3/proof/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec index 924030d..72cb5ec 100644 --- a/sha3/proof/smart_counter/Gconcl_list.ec +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -1739,9 +1739,9 @@ 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 module D <: DISTINGUISHER {SLCommon.C, C, Perm, Redo, F.RO, F.FRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO}. - axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : + declare axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : islossless P0.f => islossless P0.fi => islossless F0.f => islossless D(F0, P0).distinguish. @@ -1785,9 +1785,9 @@ 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 module D <: DISTINGUISHER {SLCommon.C, C, Perm, Redo, F.RO, F.FRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO}. - axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : + declare axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : islossless P0.f => islossless P0.fi => islossless F0.f => islossless D(F0, P0).distinguish. @@ -1986,9 +1986,9 @@ module Simulator (F : DFUNCTIONALITY) = { section Simplify_Simulator. -declare module D : DISTINGUISHER{Simulator, F.RO, BIRO.IRO, C, S, BIRO2.IRO}. +declare module D <: DISTINGUISHER {Simulator, F.RO, BIRO.IRO, C, S, BIRO2.IRO}. -axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : +declare axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : islossless P0.f => islossless P0.fi => islossless F0.f => islossless D(F0, P0).distinguish. @@ -2179,9 +2179,9 @@ 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 module D <: DISTINGUISHER {SLCommon.C, C, Perm, Redo, F.RO, F.FRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO, Simulator}. - axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : + declare axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : islossless P0.f => islossless P0.fi => islossless F0.f => islossless D(F0, P0).distinguish. diff --git a/sha3/proof/smart_counter/Gext.eca b/sha3/proof/smart_counter/Gext.eca index 7177863..7a46c06 100644 --- a/sha3/proof/smart_counter/Gext.eca +++ b/sha3/proof/smart_counter/Gext.eca @@ -157,7 +157,7 @@ clone include EagerCore proof * by (move=> _; exact/Capacity.DCapacity.dunifin_ll). section. - declare module D: DISTINGUISHER{G1, G2, FRO, C}. + 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). @@ -315,7 +315,7 @@ end section. section EXT. - declare module D: DISTINGUISHER{C, PF, G1, G2, Perm, RO, Redo}. + declare module D <: DISTINGUISHER{C, PF, G1, G2, Perm, RO, Redo}. local module ReSample = { var count:int @@ -693,7 +693,7 @@ section EXT. by apply H10. qed. - axiom D_ll: + 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. diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index 5c9f283..69232b1 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -2561,9 +2561,9 @@ qed. section AUX. - declare module D : DISTINGUISHER {PF, RO, G1, Redo, C}. + declare module D <: DISTINGUISHER {PF, RO, G1, Redo, C}. - axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + declare axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. @@ -2669,9 +2669,9 @@ end section AUX. section. - declare module D: DISTINGUISHER{Perm, C, PF, G1, RO, Redo}. + declare module D <: DISTINGUISHER{Perm, C, PF, G1, RO, Redo}. - axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + declare axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. @@ -2682,15 +2682,16 @@ section. + Pr[G1(DRestr(D)).main() @&m: G1.bcol] + Pr[G1(DRestr(D)).main() @&m: G1.bext]. proof. - apply (@RealOrder.ler_trans _ _ _ (Real_Concrete D D_ll &m))=>//=. + 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]. - + byequiv (CF_G1 D D_ll)=>//=/#. + + 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]. - rewrite Pr[mu_or];smt(Distr.mu_bounded). + 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 index 33fdb7b..c30b9e0 100644 --- a/sha3/proof/smart_counter/SLCommon.ec +++ b/sha3/proof/smart_counter/SLCommon.ec @@ -170,7 +170,7 @@ 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)]. +by rewrite -{1}cats1 /build_hpath foldl_cat {1}/step_hpath /= emptyE /= #smt:(size_rcons size_ge0). qed. (* -------------------------------------------------------------------------- *) @@ -580,7 +580,6 @@ lemma asfadst queries prefixes (bs : block list) : proof. progress. have h:=prefix_inv_leq bs (size bs) prefixes queries _ _ _ _ _;rewrite//=. -+ exact size_ge0. + rewrite H2//=;exact size_ge0. have ->/=: prefix bs (get_max_prefix bs (elems (fdom queries))) = size bs by smt(prefix_sizel). rewrite take_oversize/#. @@ -689,8 +688,7 @@ lemma prefix_cat_leq_prefix_size (l1 l2 l3 : 'a list): 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];exact size_ge0. +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) : @@ -956,9 +954,9 @@ qed. section RESTR. - declare module F:FUNCTIONALITY{C}. - declare module P:PRIMITIVE{C,F}. - declare module D:DISTINGUISHER{F,P,C}. + 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] = @@ -973,16 +971,16 @@ end section RESTR. section COUNT. - declare module P:PRIMITIVE{C}. - declare module CO:CONSTRUCTION{C,P}. - declare module D:DISTINGUISHER{C,P,CO}. + declare module P <: PRIMITIVE{C}. + declare module CO <: CONSTRUCTION{C,P}. + declare module D <: DISTINGUISHER{C,P,CO}. - axiom f_ll : islossless P.f. - axiom fi_ll : islossless P.fi. + declare axiom f_ll : islossless P.f. + declare axiom fi_ll : islossless P.fi. - axiom CO_ll : islossless CO(P).f. + declare axiom CO_ll : islossless CO(P).f. - axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + declare axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. From e273054c2261249d5b27fa69334e950d1d3b7f03 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 26 Nov 2021 12:17:16 +0000 Subject: [PATCH 385/394] Folloe EasyCrypt HEAD Use standard library find, map on finite maps. --- sha3/proof/smart_counter/SLCommon.ec | 60 +++++----------------------- 1 file changed, 10 insertions(+), 50 deletions(-) diff --git a/sha3/proof/smart_counter/SLCommon.ec b/sha3/proof/smart_counter/SLCommon.ec index c30b9e0..9d4d596 100644 --- a/sha3/proof/smart_counter/SLCommon.ec +++ b/sha3/proof/smart_counter/SLCommon.ec @@ -1010,44 +1010,6 @@ section COUNT. end section COUNT. -(* -------------------------------------------------------------------------- *) -op has (P : 'a -> 'b -> bool) (m : ('a,'b) fmap) = - List.has (fun x=> x \in m /\ P x (oget m.[x])) (elems (fdom m)). - -lemma hasP (P : 'a -> 'b -> bool) (m : ('a,'b) fmap): - has P m <=> exists x, x \in m /\ P x (oget m.[x]). -proof. -rewrite /has hasP; split=> [] [x] [#]. -+ by move=> _ x_in_m Pxmx; exists x. -by move=> x_in_m Pxmx; exists x; rewrite -memE mem_fdom. -qed. - -op find (P : 'a -> 'b -> bool) (m : ('a,'b) fmap) = - onth (elems (fdom m)) (find (fun x=> x \in m /\ P x (oget m.[x])) (elems (fdom m))). - -lemma find_none (P : 'a -> 'b -> bool) (m : ('a,'b) fmap): - has P m <=> find P m <> None. -proof. -rewrite /find /has has_find; split=> [h|]. -+ by rewrite (onth_nth witness) 1:find_ge0 /=. -by apply/contraLR=> h; rewrite onth_nth_map nth_default 1:size_map 1:lezNgt. -qed. - -lemma findP (P : 'a -> 'b -> bool) (m : ('a,'b) fmap): - (exists x, find P m = Some x /\ x \in m /\ P x (oget m.[x])) \/ - (find P m = None /\ forall x, x \in m => !P x (oget m.[x])). -proof. -case: (has P m)=> ^ => [hasPm|nothasPm]; rewrite hasP. -+ move=> [x] [] x_in_m Pxmx; left. - exists (nth witness (elems (fdom m)) (find (fun x=> x \in m /\ P x (oget m.[x])) (elems (fdom m)))). - rewrite /find (onth_nth witness) /=. - + by rewrite find_ge0 /=; apply/has_find/hasPm. - by move: hasPm=> /(nth_find witness) /=. -rewrite negb_exists /=. -move: nothasPm; rewrite find_none=> /= -> h; right=> /= x. -by move: (h x); rewrite negb_and=> /#. -qed. - (** Operators and properties of handles *) op hinv (handles:handles) (c:capacity) = find (fun _ => pred1 c \o fst) handles. @@ -1066,11 +1028,9 @@ lemma hinvP handles c: else exists f, handles.[oget (hinv handles c)] = Some(c,f). proof. move=> @/hinv. -have @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := - findP (fun (_ : handle) => pred1 c \o fst) handles. -+ exists (oget handles.[h]).`2. - by move: Hmem; rewrite domE; case: (handles.[h])=> //= - []. -by have := H h;rewrite domE /#. +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): @@ -1089,23 +1049,23 @@ 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]|][->/=]:= findP (+ pred1 c) (restr Known handles). - + by rewrite domE restrP;case (handles.[h])=>//= /#. - by move=>+h-/(_ h);rewrite domE restrP => H1/#. +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. +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. +by move=> Huniq;case: (hinvK _ _) (hinvKP handles c)=>/= [ H | h' /Huniq H/H //]; apply H. qed. (* -------------------------------------------------------------------------- *) From 427a3d816e73b282621a2661e6d4044d9400782d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 3 Dec 2021 14:46:39 +0000 Subject: [PATCH 386/394] LRO is now top-level in PROM --- sha3/proof/Sponge.ec | 5 ++--- sha3/proof/smart_counter/Gconcl.ec | 10 +++++----- sha3/proof/smart_counter/Gconcl_list.ec | 22 +++++++++++----------- 3 files changed, 18 insertions(+), 19 deletions(-) diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index ba4662d..11b6352 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -368,13 +368,12 @@ section. declare module D <: HYBRID_IRO_DIST {HybridIROEager, HybridIROLazy}. -local clone PROM.FullRO as ERO with +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. -import ERO.FullEager. local module EROExper(O : ERO.RO, D : ERO.RO_Distinguisher) = { proc main() : bool = { @@ -391,7 +390,7 @@ local lemma LRO_RO (D <: ERO.RO_Distinguisher{ERO.RO, ERO.FRO}) &m : proof. byequiv=> //; proc. seq 1 1 : (={glob D, ERO.RO.m}); first sim. -by symmetry; call (RO_LRO_D D _); auto; rewrite dbool_ll. +by symmetry; call (FullEager.RO_LRO_D D _); auto; rewrite dbool_ll. qed. (* make a Hybrid IRO out of a random oracle *) diff --git a/sha3/proof/smart_counter/Gconcl.ec b/sha3/proof/smart_counter/Gconcl.ec index 6810902..1a37704 100644 --- a/sha3/proof/smart_counter/Gconcl.ec +++ b/sha3/proof/smart_counter/Gconcl.ec @@ -204,7 +204,7 @@ local module G3(RO:F.RO) = { } }. -local equiv G2_G3: Eager(G2(DRestr(D))).main2 ~ G3(F.FullEager.LRO).distinguish : ={glob D} ==> ={res}. +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. @@ -348,7 +348,7 @@ proof. by sim;inline *;auto;progress;smt(DCapacity.dunifin_ll). qed. -local equiv G4_Ideal : G4(F.FullEager.LRO).distinguish ~ IdealIndif(IF,S,DRestr(D)).main : +local equiv G4_Ideal : G4(F.LRO).distinguish ~ IdealIndif(IF,S,DRestr(D)).main : ={glob D} ==> ={res}. proof. proc;inline *;wp. @@ -356,7 +356,7 @@ proof. + by sim. + by sim. + proc;sp;if=>//;auto;if=>//;auto. call (_: ={F.RO.m});2:by auto. - inline F.FullEager.LRO.get F.FRO.sample;wp 7 2;sim. + 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. @@ -376,12 +376,12 @@ lemma Real_Ideal &m: proof. apply (ler_trans _ _ _ (Real_G2 D D_ll &m)). rewrite !(ler_add2l, ler_add2r);apply lerr_eq. - apply (eq_trans _ Pr[G3(F.FullEager.LRO).distinguish() @ &m : res]);1:by byequiv G2_G3. + 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.FullEager.LRO).distinguish() @ &m : res]). + 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. diff --git a/sha3/proof/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec index 72cb5ec..f01a1c4 100644 --- a/sha3/proof/smart_counter/Gconcl_list.ec +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -327,9 +327,9 @@ section Ideal. }. local equiv Ideal_equiv_valid (D <: DISTINGUISHER{SLCommon.C, C, IF, S}) : - L(D,F.FullEager.LRO).distinguish + L(D,F.LRO).distinguish ~ - L2(D,F.FullEager.LRO).distinguish + L2(D,F.LRO).distinguish : ={glob D} ==> ={glob D, res}. proof. @@ -339,7 +339,7 @@ section Ideal. call(: ={glob S,glob F.RO});auto. sp;if;auto;if;auto;sp. call(: ={glob F.RO});2:auto;2:smt(). - inline F.FullEager.LRO.sample;call(: ={glob IF});auto;progress. + 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. @@ -836,7 +836,7 @@ section Ideal. local equiv equiv_L4_ideal (D <: DISTINGUISHER{SLCommon.C, C, IF, S, F2.RO, BIRO.IRO, BIRO2.IRO}) : - L4(D,F.FullEager.LRO,F2.FullEager.LRO).distinguish + L4(D,F.LRO,F2.LRO).distinguish ~ IdealIndif(BIRO.IRO,SimLast(S),DRestr(D)).main : @@ -912,7 +912,7 @@ section Ideal. 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.FullEager.LRO, F2))), PC(S(Last(DSqueeze2(F.FullEager.LRO, F2))))). + 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: @@ -926,17 +926,17 @@ section Ideal. 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.FullEager.LRO).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.FullEager.LRO,F2.FullEager.LRO).distinguish() @ &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.FullEager.LRO,F2.FullEager.LRO).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.FullEager.LRO, 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. @@ -950,7 +950,7 @@ section Ideal. 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.FullEager.LRO).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. @@ -2136,7 +2136,7 @@ qed. local lemma equal2 &m : Pr [ IdealIndif(BIRO.IRO, Simulator, DRestr(D)).main() @ &m : res ] = - Pr [ L(IRO2.FullEager.LRO).distinguish() @ &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} /\ From 6c527141acfab206e93e63fdecd71352262d71f1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 12 Jan 2022 11:36:54 +0000 Subject: [PATCH 387/394] [chore] Uniform use of <@ --- sha3/proof/SHA3Indiff.ec | 2 +- sha3/proof/SHA3OSecurity.ec | 2 -- sha3/proof/SHA3_OIndiff.ec | 2 +- sha3/proof/SecureHash.eca | 6 +++--- sha3/proof/SecureORO.eca | 2 +- sha3/proof/SecureRO.eca | 2 +- sha3/proof/smart_counter/Gcol.eca | 6 +++--- sha3/proof/smart_counter/Gconcl.ec | 12 ++++++------ sha3/proof/smart_counter/Gconcl_list.ec | 2 +- sha3/proof/smart_counter/Gext.eca | 12 ++++++------ sha3/proof/smart_counter/Handle.eca | 4 ++-- 11 files changed, 25 insertions(+), 27 deletions(-) diff --git a/sha3/proof/SHA3Indiff.ec b/sha3/proof/SHA3Indiff.ec index fa02597..fa74e83 100644 --- a/sha3/proof/SHA3Indiff.ec +++ b/sha3/proof/SHA3Indiff.ec @@ -40,7 +40,7 @@ module Simulator (F : DFUNCTIONALITY) = { cs <@ F.f(oget (unpad_blocks q), k * r); z <- bits2blocks cs; } else { - z <- Gconcl_list.BIRO2.IRO.f(q,k); + z <@ Gconcl_list.BIRO2.IRO.f(q,k); } y1 <- last b0 z; } else { diff --git a/sha3/proof/SHA3OSecurity.ec b/sha3/proof/SHA3OSecurity.ec index e78cef3..23520fc 100644 --- a/sha3/proof/SHA3OSecurity.ec +++ b/sha3/proof/SHA3OSecurity.ec @@ -2631,5 +2631,3 @@ by have/#:=leq_ideal &m. qed. end section Collision. - - diff --git a/sha3/proof/SHA3_OIndiff.ec b/sha3/proof/SHA3_OIndiff.ec index 3f5a6ea..f031292 100644 --- a/sha3/proof/SHA3_OIndiff.ec +++ b/sha3/proof/SHA3_OIndiff.ec @@ -77,7 +77,7 @@ module OSimulator (F : ODFUNCTIONALITY) = { cs <- oget o; z <- bits2blocks cs; } else { - z <- Gconcl_list.BIRO2.IRO.f(q,k); + z <@ Gconcl_list.BIRO2.IRO.f(q,k); } y1 <- last b0 z; } else { diff --git a/sha3/proof/SecureHash.eca b/sha3/proof/SecureHash.eca index 76caecd..db62960 100644 --- a/sha3/proof/SecureHash.eca +++ b/sha3/proof/SecureHash.eca @@ -62,7 +62,7 @@ module FBounder (F : OFUNCTIONALITY) : OFUNCTIONALITY = { var y : to option <- None; if (increase_counter Bounder.bounder x <= bound) { Bounder.bounder <- increase_counter Bounder.bounder x; - y <- F.f(x); + y <@ F.f(x); } return y; } @@ -77,7 +77,7 @@ module PBounder (P : OPRIMITIVE) : OPRIMITIVE = { proc f (x : block) : block option = { var y <- None; if (Bounder.bounder < bound) { - y <- P.f(x); + y <@ P.f(x); Bounder.bounder <- Bounder.bounder + 1; } return y; @@ -85,7 +85,7 @@ module PBounder (P : OPRIMITIVE) : OPRIMITIVE = { proc fi (x : block) : block option = { var y <- None; if (Bounder.bounder < bound) { - y <- P.fi(x); + y <@ P.fi(x); Bounder.bounder <- Bounder.bounder + 1; } return y; diff --git a/sha3/proof/SecureORO.eca b/sha3/proof/SecureORO.eca index 8a4ae24..78cc3b1 100644 --- a/sha3/proof/SecureORO.eca +++ b/sha3/proof/SecureORO.eca @@ -52,7 +52,7 @@ module Bounder (F : RF) : RF = { var y : to option <- None; if (bounder < bound) { bounder <- bounder + 1; - y <- F.get(x); + y <@ F.get(x); } return y; } diff --git a/sha3/proof/SecureRO.eca b/sha3/proof/SecureRO.eca index c1917a4..763a27e 100644 --- a/sha3/proof/SecureRO.eca +++ b/sha3/proof/SecureRO.eca @@ -54,7 +54,7 @@ module Bounder (F : RF) : RF = { bounder <- bounder + 1; if (increase_counter Counter.c x < bound_counter) { Counter.c <- increase_counter Counter.c x; - y <- F.get(x); + y <@ F.get(x); } } return y; diff --git a/sha3/proof/smart_counter/Gcol.eca b/sha3/proof/smart_counter/Gcol.eca index 2211a44..511eab0 100644 --- a/sha3/proof/smart_counter/Gcol.eca +++ b/sha3/proof/smart_counter/Gcol.eca @@ -58,7 +58,7 @@ section PROOF. } 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' <@ 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); @@ -70,7 +70,7 @@ section PROOF. } i <- i + 1; } - sa <- F.RO.get(p); + sa <@ F.RO.get(p); return sa; } } @@ -89,7 +89,7 @@ section PROOF. 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)); + y1 <@ F.RO.get (rcons p (v +^ x.`1)); y2 <@ sample_c(); } else { y1 <$ bdistr; diff --git a/sha3/proof/smart_counter/Gconcl.ec b/sha3/proof/smart_counter/Gconcl.ec index 1a37704..557f6c5 100644 --- a/sha3/proof/smart_counter/Gconcl.ec +++ b/sha3/proof/smart_counter/Gconcl.ec @@ -28,7 +28,7 @@ module S(F : DFUNCTIONALITY) = { if (x \notin m) { if (x.`2 \in paths) { (p,v) <- oget paths.[x.`2]; - y1 <- F.f (rcons p (v +^ x.`1)); + y1 <@ F.f (rcons p (v +^ x.`1)); } else { y1 <$ bdistr; } @@ -97,7 +97,7 @@ local module G3(RO:F.RO) = { } i <- i + 1; } - sa <- RO.get(p); + sa <@ RO.get(p); return sa; } } @@ -110,7 +110,7 @@ local module G3(RO:F.RO) = { 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)); + y1 <@ RO.get (rcons p (v +^ x.`1)); } else { y1 <$ bdistr; } @@ -121,7 +121,7 @@ local module G3(RO:F.RO) = { RRO.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } - handles_ <- RRO.allKnown(); + 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) { @@ -263,7 +263,7 @@ local module G4(RO:F.RO) = { RO.sample(take (i+1) p); i <- i + 1; } - sa <- RO.get(p); + sa <@ RO.get(p); return sa; } } @@ -276,7 +276,7 @@ local module G4(RO:F.RO) = { 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)); + y1 <@ RO.get (rcons p (v +^ x.`1)); } else { y1 <$ bdistr; } diff --git a/sha3/proof/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec index f01a1c4..83c146d 100644 --- a/sha3/proof/smart_counter/Gconcl_list.ec +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -2021,7 +2021,7 @@ local module Simu (FRO : IRO2.RO) (F : DFUNCTIONALITY) = { FRO.sample(q,i); i <- i + 1; } - y1 <- FRO.get(q,k-1); + y1 <@ FRO.get(q,k-1); } else { y1 <- b0; } diff --git a/sha3/proof/smart_counter/Gext.eca b/sha3/proof/smart_counter/Gext.eca index 7a46c06..8787e44 100644 --- a/sha3/proof/smart_counter/Gext.eca +++ b/sha3/proof/smart_counter/Gext.eca @@ -40,7 +40,7 @@ module G2(D:DISTINGUISHER,HS:FRO) = { } i <- i + 1; } - sa <- F.RO.get(p); + sa <@ F.RO.get(p); return sa; } } @@ -53,7 +53,7 @@ module G2(D:DISTINGUISHER,HS:FRO) = { 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)); + y1 <@ F.RO.get (rcons p (v +^ x.`1)); y2 <$ cdistr; } else { y1 <$ bdistr; @@ -66,7 +66,7 @@ module G2(D:DISTINGUISHER,HS:FRO) = { HS.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } - handles_ <- HS.allKnown(); + 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) { @@ -371,7 +371,7 @@ section EXT. } i <- i + 1; } - sa <- F.RO.get(p); + sa <@ F.RO.get(p); return sa; } } @@ -384,7 +384,7 @@ section EXT. 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)); + y1 <@ F.RO.get (rcons p (v +^ x.`1)); } else { y1 <$ bdistr; } @@ -397,7 +397,7 @@ section EXT. RRO.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } - handles_ <- RRO.allKnown(); + 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) { diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index 69232b1..a56c533 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -50,7 +50,7 @@ module G1(D:DISTINGUISHER) = { } i <- i + 1; } - sa <- F.RO.get(p); + sa <@ F.RO.get(p); return sa; } } @@ -63,7 +63,7 @@ module G1(D:DISTINGUISHER) = { if (x \notin m) { if (x.`2 \in paths) { (p,v) <- oget paths.[x.`2]; - y1 <- F.RO.get (rcons p (v +^ x.`1)); + y1 <@ F.RO.get (rcons p (v +^ x.`1)); y2 <$ cdistr; } else { y1 <$ bdistr; From d992af165e9ce16d432b9f41f5f2a0a66a5a2380 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 8 Apr 2022 10:20:15 +0100 Subject: [PATCH 388/394] follow EasyCrypt HEAD (syntax) --- sha3/proof/Common.ec | 4 +-- sha3/proof/IndifRO_is_secure.ec | 36 ++++++++++----------- sha3/proof/SHA3Indiff.ec | 21 ++++-------- sha3/proof/SHA3OSecurity.ec | 18 ++--------- sha3/proof/SHA3Security.ec | 34 +++++++------------ sha3/proof/SHA3_OIndiff.ec | 13 ++------ sha3/proof/SecureORO.eca | 6 ++-- sha3/proof/SecureRO.eca | 6 ++-- sha3/proof/Sponge.ec | 21 ++++++------ sha3/proof/smart_counter/ConcreteF.eca | 13 ++++---- sha3/proof/smart_counter/Gcol.eca | 4 +-- sha3/proof/smart_counter/Gconcl.ec | 9 +++--- sha3/proof/smart_counter/Gconcl_list.ec | 43 ++++++++++++------------- sha3/proof/smart_counter/Gext.eca | 8 ++--- sha3/proof/smart_counter/Handle.eca | 22 ++++++------- sha3/proof/smart_counter/SLCommon.ec | 26 +++++++-------- 16 files changed, 119 insertions(+), 165 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index a844fbb..044a8f4 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -138,8 +138,8 @@ 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. +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. diff --git a/sha3/proof/IndifRO_is_secure.ec b/sha3/proof/IndifRO_is_secure.ec index be9534a..2b9d332 100644 --- a/sha3/proof/IndifRO_is_secure.ec +++ b/sha3/proof/IndifRO_is_secure.ec @@ -91,15 +91,15 @@ module DColl (A : AdvCollision) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { section Collision. - declare module A <: AdvCollision {Bounder, SRO.RO.RO, SRO.RO.FRO}. + declare module A <: AdvCollision {-Bounder, -SRO.RO.RO, -SRO.RO.FRO}. - declare axiom D_ll (F <: Oracle { A }) : + 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}), + (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) => @@ -110,7 +110,7 @@ section Collision. 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. + 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] = @@ -136,16 +136,16 @@ module DPre (A : AdvPreimage) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { section Preimage. - declare module A <: AdvPreimage {Bounder, SRO.RO.RO, SRO.RO.FRO, DPre}. + declare module A <: AdvPreimage {-Bounder, -SRO.RO.RO, -SRO.RO.FRO, -DPre}. - declare axiom D_ll (F <: Oracle{A}) : + 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 : + (C <: CONSTRUCTION{-A, -Bounder, -DPre}) + (P <: PRIMITIVE{-C, -A, -Bounder, -DPre}) &m hash : (DPre.h{m} = hash) => - (exists (S <: SIMULATOR{Bounder, A, DPre}), + (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) => @@ -156,7 +156,7 @@ section Preimage. 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(). + 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] = @@ -182,16 +182,16 @@ module D2Pre (A : AdvSecondPreimage) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { section SecondPreimage. - declare module A <: AdvSecondPreimage {Bounder, SRO.RO.RO, SRO.RO.FRO, D2Pre}. + declare module A <: AdvSecondPreimage {-Bounder, -SRO.RO.RO, -SRO.RO.FRO, -D2Pre}. - declare axiom D_ll (F <: Oracle{A}) : + 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 : + (C <: CONSTRUCTION{-A, -Bounder, -D2Pre}) + (P <: PRIMITIVE{-C, -A, -Bounder, -D2Pre}) &m mess : (D2Pre.m2{m} = mess) => - (exists (S <: SIMULATOR{Bounder, A, D2Pre}), + (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) => @@ -202,7 +202,7 @@ section SecondPreimage. 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(). + 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] = diff --git a/sha3/proof/SHA3Indiff.ec b/sha3/proof/SHA3Indiff.ec index fa74e83..85aed88 100644 --- a/sha3/proof/SHA3Indiff.ec +++ b/sha3/proof/SHA3Indiff.ec @@ -146,13 +146,9 @@ module DRestr (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { 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}. + 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 }) : +declare axiom Dist_lossless (F <: DFUNCTIONALITY {-Dist}) (P <: DPRIMITIVE {-Dist}) : islossless P.f => islossless P.fi => islossless F.f => islossless Dist(F,P).distinguish. @@ -226,7 +222,7 @@ qed. op wit_pair : block * capacity = witness. -local equiv equiv_sim_f (F <: DFUNCTIONALITY{Gconcl.S, Simulator}) : +local equiv equiv_sim_f (F <: DFUNCTIONALITY{-Gconcl.S, -Simulator}) : RaiseSim(Gconcl_list.SimLast(Gconcl.S),F).f ~ Simulator(F).f @@ -244,7 +240,7 @@ by sp;wp;rcondt{1}1;auto;call(: true);auto;smt(BlockSponge.parseK BlockSponge.fo qed. -local equiv equiv_sim_fi (F <: DFUNCTIONALITY{Gconcl.S, Simulator}) : +local equiv equiv_sim_fi (F <: DFUNCTIONALITY{-Gconcl.S, -Simulator}) : RaiseSim(Gconcl_list.SimLast(Gconcl.S),F).fi ~ Simulator(F).fi @@ -309,14 +305,9 @@ 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}) + (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 }), + (forall (F <: DFUNCTIONALITY {-Dist}) (P <: DPRIMITIVE {-Dist}), islossless P.f => islossless P.fi => islossless F.f => diff --git a/sha3/proof/SHA3OSecurity.ec b/sha3/proof/SHA3OSecurity.ec index 23520fc..eac1490 100644 --- a/sha3/proof/SHA3OSecurity.ec +++ b/sha3/proof/SHA3OSecurity.ec @@ -189,11 +189,7 @@ 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 }. + 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 () = {} @@ -912,11 +908,7 @@ 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 }. + 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 () = {} @@ -1792,11 +1784,7 @@ 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 }. + 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 () = {} diff --git a/sha3/proof/SHA3Security.ec b/sha3/proof/SHA3Security.ec index 696f94c..6fe3370 100644 --- a/sha3/proof/SHA3Security.ec +++ b/sha3/proof/SHA3Security.ec @@ -124,12 +124,9 @@ module (DSetSize (D : Indiff0.DISTINGUISHER) : DISTINGUISHER) 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 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. + 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. @@ -272,7 +269,7 @@ section Preimage. 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} { + transitivity {1} { l <@ Sample.sample(size_out); r <- oget (of_list l); } @@ -481,12 +478,9 @@ 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 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. + 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. @@ -619,7 +613,7 @@ section SecondPreimage. 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} { + transitivity {1} { l <@ Sample.sample(size_out); r <- oget (of_list l); } @@ -874,12 +868,9 @@ 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 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. + 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. @@ -1011,7 +1002,7 @@ section Collision. 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} { + transitivity {1} { l <@ Sample.sample(size_out); r <- oget (of_list l); } @@ -1265,12 +1256,9 @@ module AdvCollisionSHA3 (A : SRO.AdvCollision) (F : SRO.Oracle) = { 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 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. + 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] <= diff --git a/sha3/proof/SHA3_OIndiff.ec b/sha3/proof/SHA3_OIndiff.ec index f031292..c046d8b 100644 --- a/sha3/proof/SHA3_OIndiff.ec +++ b/sha3/proof/SHA3_OIndiff.ec @@ -169,11 +169,7 @@ module ODRestr (D : ODISTINGUISHER) (F : ODFUNCTIONALITY) (P : ODPRIMITIVE) = { 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}. + 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 = { @@ -207,12 +203,7 @@ local module (OD (D : ODISTINGUISHER) : DISTINGUISHER) (F : DFUNCTIONALITY) (P : }. 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}) + (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 => diff --git a/sha3/proof/SecureORO.eca b/sha3/proof/SecureORO.eca index 78cc3b1..ee3a014 100644 --- a/sha3/proof/SecureORO.eca +++ b/sha3/proof/SecureORO.eca @@ -81,7 +81,7 @@ module Preimage (A : AdvPreimage, F : RF) = { section Preimage. - declare module A <: AdvPreimage {RO,Preimage}. + declare module A <: AdvPreimage {-RO, -Preimage}. local module FEL (A : AdvPreimage, F : RF) = { proc main (hash : to) : from = { @@ -201,7 +201,7 @@ module SecondPreimage (A : AdvSecondPreimage, F : RF) = { section SecondPreimage. - declare module A <: AdvSecondPreimage {Bounder,RO,FRO}. + declare module A <: AdvSecondPreimage {-Bounder, -RO, -FRO}. local module FEL (A : AdvSecondPreimage, F : RF) = { proc main (m1 : from) : from = { @@ -364,7 +364,7 @@ module Collision (A : AdvCollision, F : RF) = { section Collision. - declare module A <: AdvCollision {RO, FRO, Bounder}. + declare module A <: AdvCollision {-RO, -FRO, -Bounder}. local module FEL (A : AdvCollision, F : RF) = { proc main () : from * from = { diff --git a/sha3/proof/SecureRO.eca b/sha3/proof/SecureRO.eca index 763a27e..c7df62a 100644 --- a/sha3/proof/SecureRO.eca +++ b/sha3/proof/SecureRO.eca @@ -86,7 +86,7 @@ module Preimage (A : AdvPreimage, F : RF) = { section Preimage. - declare module A <: AdvPreimage {RO,Preimage}. + declare module A <: AdvPreimage {-RO, -Preimage}. local module FEL (A : AdvPreimage, F : RF) = { proc main (hash : to) : from = { @@ -212,7 +212,7 @@ module SecondPreimage (A : AdvSecondPreimage, F : RF) = { section SecondPreimage. - declare module A <: AdvSecondPreimage {Bounder,RO,FRO}. + declare module A <: AdvSecondPreimage {-Bounder, -RO, -FRO}. local module FEL (A : AdvSecondPreimage, F : RO) = { proc main (m1 : from) : from = { @@ -392,7 +392,7 @@ module Collision (A : AdvCollision, F : RO) = { section Collision. - declare module A <: AdvCollision {RO, FRO, Bounder}. + declare module A <: AdvCollision {-RO, -FRO, -Bounder}. local module FEL (A : AdvCollision, F : RO) = { proc main () : from * from = { diff --git a/sha3/proof/Sponge.ec b/sha3/proof/Sponge.ec index 11b6352..7ad47bb 100644 --- a/sha3/proof/Sponge.ec +++ b/sha3/proof/Sponge.ec @@ -161,8 +161,8 @@ module RaiseSim (S : BlockSponge.SIMULATOR, F : DFUNCTIONALITY) = (* Our main result will be: lemma conclusion - (BlockSim <: BlockSponge.SIMULATOR{IRO, BlockSponge.BIRO.IRO}) - (Dist <: DISTINGUISHER{Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}) + (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]| = @@ -359,14 +359,14 @@ module HybridIROEager : HYBRID_IRO = { (* we are going to use PROM.GenEager to prove: lemma HybridIROExper_Lazy_Eager - (D <: HYBRID_IRO_DIST{HybridIROEager, HybridIROLazy}) &m : + (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}. +declare module D <: HYBRID_IRO_DIST {-HybridIROEager, -HybridIROLazy}. local clone import PROM.FullRO as ERO with type in_t <- block list * int, @@ -384,7 +384,7 @@ local module EROExper(O : ERO.RO, D : ERO.RO_Distinguisher) = { } }. -local lemma LRO_RO (D <: ERO.RO_Distinguisher{ERO.RO, ERO.FRO}) &m : +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. @@ -542,7 +542,7 @@ qed. end section. lemma HybridIROExper_Lazy_Eager - (D <: HYBRID_IRO_DIST{HybridIROEager, HybridIROLazy}) &m : + (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. @@ -1912,8 +1912,8 @@ end HybridIRO. section. -declare module BlockSim <: BlockSponge.SIMULATOR {IRO, BlockSponge.BIRO.IRO}. -declare module Dist <: DISTINGUISHER {Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}. +declare module BlockSim <: BlockSponge.SIMULATOR {-IRO, -BlockSponge.BIRO.IRO}. +declare module Dist <: DISTINGUISHER {-Perm, -BlockSim, -IRO, -BlockSponge.BIRO.IRO}. local clone HybridIRO as HIRO. @@ -1950,7 +1950,6 @@ 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 @@ -2152,8 +2151,8 @@ end section. (*----------------------------- Conclusion -----------------------------*) lemma conclusion - (BlockSim <: BlockSponge.SIMULATOR{IRO, BlockSponge.BIRO.IRO}) - (Dist <: DISTINGUISHER{Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}) + (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]| = diff --git a/sha3/proof/smart_counter/ConcreteF.eca b/sha3/proof/smart_counter/ConcreteF.eca index 18b0358..425198c 100644 --- a/sha3/proof/smart_counter/ConcreteF.eca +++ b/sha3/proof/smart_counter/ConcreteF.eca @@ -42,9 +42,9 @@ module PF = { module CF(D:DISTINGUISHER) = Indif(SqueezelessSponge(PF), PF, D). section. - declare module D <: DISTINGUISHER {Perm, C, PF, Redo}. + declare module D <: DISTINGUISHER {-Perm, -C, -PF, -Redo}. - declare axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + declare axiom D_ll (F <: DFUNCTIONALITY{-D}) (P <: DPRIMITIVE{-D}): islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. @@ -81,12 +81,11 @@ section. proc distinguish () : bool = { var b : bool; Redo.init(); - b <@ DRestr(D,SqueezelessSponge(P'),P').distinguish(); - return b; - } + b <@ DRestr(D, SqueezelessSponge(P'), P').distinguish(); + return b;} }. - local lemma DoubleBounding (P <: PRPSec.PRP {D, C, DBounder, Redo}) &m: + 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. @@ -270,7 +269,7 @@ section. 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=> _; rewrite andaE=> [#] _ /(_ bs0 i0 H9) h /h [l2] hl2. + + 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). diff --git a/sha3/proof/smart_counter/Gcol.eca b/sha3/proof/smart_counter/Gcol.eca index 511eab0..a025edf 100644 --- a/sha3/proof/smart_counter/Gcol.eca +++ b/sha3/proof/smart_counter/Gcol.eca @@ -24,9 +24,9 @@ import ROhandle. qed. section PROOF. - declare module D <: DISTINGUISHER{C, PF, G1}. + declare module D <: DISTINGUISHER{-C, -PF, -G1}. - declare axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + declare axiom D_ll (F <: DFUNCTIONALITY{-D}) (P <: DPRIMITIVE{-D}): islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. diff --git a/sha3/proof/smart_counter/Gconcl.ec b/sha3/proof/smart_counter/Gconcl.ec index 557f6c5..f114324 100644 --- a/sha3/proof/smart_counter/Gconcl.ec +++ b/sha3/proof/smart_counter/Gconcl.ec @@ -27,9 +27,8 @@ module S(F : DFUNCTIONALITY) = { if (x \notin m) { if (x.`2 \in paths) { - (p,v) <- oget paths.[x.`2]; - y1 <@ F.f (rcons p (v +^ x.`1)); - } else { + (p, v) <- oget paths.[x.`2]; + y1 <@ F.f (rcons p (v +^ x.`1));} else { y1 <$ bdistr; } y2 <$ cdistr; @@ -65,7 +64,7 @@ module S(F : DFUNCTIONALITY) = { section. -declare module D <: DISTINGUISHER{C, Perm, F.RO, F.FRO, S, Redo}. +declare module D <: DISTINGUISHER{-C, -Perm, -F.RO, -F.FRO, -S, -Redo}. local clone import Gext as Gext0. @@ -362,7 +361,7 @@ proof. qed. declare axiom D_ll : - forall (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}), + forall (F <: DFUNCTIONALITY{-D}) (P <: DPRIMITIVE{-D}), islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. diff --git a/sha3/proof/smart_counter/Gconcl_list.ec b/sha3/proof/smart_counter/Gconcl_list.ec index 83c146d..a9235b8 100644 --- a/sha3/proof/smart_counter/Gconcl_list.ec +++ b/sha3/proof/smart_counter/Gconcl_list.ec @@ -174,7 +174,7 @@ section Ideal. 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}) : + 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 @@ -326,7 +326,7 @@ section Ideal. proc distinguish = SLCommon.IdealIndif(Valid2(F), S, A(D)).main }. - local equiv Ideal_equiv_valid (D <: DISTINGUISHER{SLCommon.C, C, IF, S}) : + local equiv Ideal_equiv_valid (D <: DISTINGUISHER{-SLCommon.C, -C, -IF, -S}) : L(D,F.LRO).distinguish ~ L2(D,F.LRO).distinguish @@ -357,7 +357,7 @@ section Ideal. qed. - local equiv ideal_equiv2 (D <: DISTINGUISHER{SLCommon.C, C, IF, S}) : + 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. @@ -468,7 +468,7 @@ section Ideal. qed. - local equiv Ideal_equiv3 (D <: DISTINGUISHER{SLCommon.C, C, IF, S, F2.RO}) : + 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. @@ -657,7 +657,7 @@ section Ideal. 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}) : + 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 @@ -835,7 +835,7 @@ section Ideal. - local equiv equiv_L4_ideal (D <: DISTINGUISHER{SLCommon.C, C, IF, S, F2.RO, BIRO.IRO, BIRO2.IRO}) : + 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 @@ -914,8 +914,7 @@ section Ideal. 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: + 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. @@ -1088,7 +1087,7 @@ section Real. qed. - local lemma equiv_sponge (D <: DISTINGUISHER {P, Redo, C, SLCommon.C}) : + 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]. @@ -1469,7 +1468,7 @@ section Real. - local lemma squeeze_squeezeless (D <: DISTINGUISHER {P, Redo, C, SLCommon.C}) : + 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]. @@ -1724,7 +1723,7 @@ section Real. - lemma pr_real (D <: DISTINGUISHER{SLCommon.C, C, Perm, Redo}) &m : + 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. @@ -1739,15 +1738,15 @@ 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 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}) : + 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)}) : + 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. @@ -1785,9 +1784,9 @@ 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 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}) : + declare axiom D_lossless (F0 <: DFUNCTIONALITY{-D}) (P0 <: DPRIMITIVE{-D}) : islossless P0.f => islossless P0.fi => islossless F0.f => islossless D(F0, P0).distinguish. @@ -1801,7 +1800,7 @@ section Real_Ideal_Abs. }. - local lemma Neg_D_lossless (F <: DFUNCTIONALITY{Neg_D(D)}) (P <: DPRIMITIVE{Neg_D(D)}) : + 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. @@ -1986,9 +1985,9 @@ module Simulator (F : DFUNCTIONALITY) = { section Simplify_Simulator. -declare module D <: DISTINGUISHER {Simulator, F.RO, BIRO.IRO, C, S, BIRO2.IRO}. +declare module D <: DISTINGUISHER {-Simulator, -F.RO, -BIRO.IRO, -C, -S, -BIRO2.IRO}. -declare axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : +declare axiom D_lossless (F0 <: DFUNCTIONALITY{-D}) (P0 <: DPRIMITIVE{-D}) : islossless P0.f => islossless P0.fi => islossless F0.f => islossless D(F0, P0).distinguish. @@ -2179,9 +2178,9 @@ 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 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}) : + declare axiom D_lossless (F0 <: DFUNCTIONALITY{-D}) (P0 <: DPRIMITIVE{-D}) : islossless P0.f => islossless P0.fi => islossless F0.f => islossless D(F0, P0).distinguish. diff --git a/sha3/proof/smart_counter/Gext.eca b/sha3/proof/smart_counter/Gext.eca index 8787e44..43187e4 100644 --- a/sha3/proof/smart_counter/Gext.eca +++ b/sha3/proof/smart_counter/Gext.eca @@ -157,7 +157,7 @@ clone include EagerCore proof * by (move=> _; exact/Capacity.DCapacity.dunifin_ll). section. - declare module D <: DISTINGUISHER{G1, G2, FRO, C}. + 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). @@ -315,7 +315,7 @@ end section. section EXT. - declare module D <: DISTINGUISHER{C, PF, G1, G2, Perm, RO, Redo}. + declare module D <: DISTINGUISHER{-C, -PF, -G1, -G2, -Perm, -RO, -Redo}. local module ReSample = { var count:int @@ -536,7 +536,7 @@ section EXT. 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} ==> + ={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 [*]. @@ -694,7 +694,7 @@ section EXT. qed. declare axiom D_ll: - forall (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}), + 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: diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index a56c533..ab1bf00 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -499,7 +499,7 @@ split=> [xa0 xc0 ya0 yc0|xa0 hx0 ya0 hy0]; rewrite get_setE. 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. +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). @@ -1273,7 +1273,7 @@ proof. 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. + + 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(). @@ -1346,7 +1346,7 @@ 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: +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} @@ -1485,7 +1485,7 @@ by move=> /> &1 &2 -> ->. qed. -equiv eq_f (D <: DISTINGUISHER {PF, RO, G1}): DPRestr(PF).f ~ DPRestr(G1(DRestr(D)).S).f: +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} @@ -1700,8 +1700,8 @@ call(: !G1.bcol{2} + 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 // eq_sym; apply (dom_hs_neq_ch _ _ _ Hhs hs_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). @@ -2421,7 +2421,7 @@ proof. 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. + 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/=. @@ -2561,9 +2561,9 @@ qed. section AUX. - declare module D <: DISTINGUISHER {PF, RO, G1, Redo, C}. + declare module D <: DISTINGUISHER {-PF, -RO, -G1, -Redo, -C}. - declare axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + declare axiom D_ll (F <: DFUNCTIONALITY{-D}) (P <: DPRIMITIVE{-D}): islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. @@ -2669,9 +2669,9 @@ end section AUX. section. - declare module D <: DISTINGUISHER{Perm, C, PF, G1, RO, Redo}. + declare module D <: DISTINGUISHER{-Perm, -C, -PF, -G1, -RO, -Redo}. - declare axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + declare axiom D_ll (F <: DFUNCTIONALITY{-D}) (P <: DPRIMITIVE{-D}): islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. diff --git a/sha3/proof/smart_counter/SLCommon.ec b/sha3/proof/smart_counter/SLCommon.ec index 9d4d596..fa82181 100644 --- a/sha3/proof/smart_counter/SLCommon.ec +++ b/sha3/proof/smart_counter/SLCommon.ec @@ -929,20 +929,20 @@ module DRestr(D:DISTINGUISHER, F:DFUNCTIONALITY, P:DPRIMITIVE) = { } }. -lemma rp_ll (P<:DPRIMITIVE{C}): islossless P.f => islossless DPRestr(P).f. +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. +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. +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}), +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)}), + 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. @@ -954,9 +954,9 @@ qed. section RESTR. - declare module F <: FUNCTIONALITY{C}. - declare module P <: PRIMITIVE{C,F}. - declare module D <: DISTINGUISHER{F,P,C}. + 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] = @@ -971,16 +971,16 @@ end section RESTR. section COUNT. - declare module P <: PRIMITIVE{C}. - declare module CO <: CONSTRUCTION{C,P}. - declare module D <: DISTINGUISHER{C,P,CO}. + 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}): + declare axiom D_ll (F <: DFUNCTIONALITY{-D}) (P <: DPRIMITIVE{-D}): islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. From 80e024795881929072d6690838afd307ab61eeb5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 8 Apr 2022 10:24:06 +0100 Subject: [PATCH 389/394] 'stabilise' smt calls post cost merge --- sha3/proof/SHA3OSecurity.ec | 263 +++++++++++++++++++----------------- sha3/proof/SHA3_OIndiff.ec | 9 +- 2 files changed, 143 insertions(+), 129 deletions(-) diff --git a/sha3/proof/SHA3OSecurity.ec b/sha3/proof/SHA3OSecurity.ec index eac1490..95fa0bc 100644 --- a/sha3/proof/SHA3OSecurity.ec +++ b/sha3/proof/SHA3OSecurity.ec @@ -446,23 +446,25 @@ if{1}; sp. 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). + - 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). ++ 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}). -+ smt(cats0 take_oversize spec_dout to_listK spec2_dout). + 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). ++ by sp; if; auto=> />; smt(size_rcons domE get_setE size_rcons mem_set). +by auto=> />; smt(size_out_gt0). qed. @@ -516,7 +518,7 @@ 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}). - * smt(). + * 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})=> />. @@ -530,8 +532,8 @@ if{1}; sp. 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). + - 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). @@ -539,12 +541,12 @@ if{1}; sp. 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). + - 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(). ++ 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}). @@ -601,10 +603,10 @@ have->: - 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: smt(); sim. + if; [1:by auto=> /> &1 &2 <- /> <- />]; sim. * inline{1} 1; inline{2} 1; sp; sim. - by call eq_eager_ideal; auto; smt(). - smt(). + 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. @@ -631,9 +633,9 @@ have->: - 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: smt(); sim. - * by call eq_eager_ideal2; auto; smt(). - smt(). + 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. @@ -664,12 +666,12 @@ have->:Pr[SORO.Preimage(SORO_P1(A), RFList).main() @ &m : res] = 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: smt(); 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; smt(). - smt(). - smt(). + - 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. @@ -690,8 +692,8 @@ have->:Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), 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). - smt(size_out_gt0 take_oversize size_out_gt0). + * 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). @@ -701,11 +703,11 @@ have->:Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + proc; sp; if; auto. inline{1} 1; inline{2} 1; sp; if; 1, 3: auto. if; 1, 3: auto; sp. - if; 1: auto; 1: smt(); last first. - - by conseq=> />; sim; smt(). + if; [1:auto=> /> &1 &2 <- /> <- />]; last first. + - by conseq=> />; sim=> /> &1 &2 <- /> <- />. wp=> />; 1: smt(). rnd; auto=> />. - call(eq_extend); last by auto; smt(). + 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. @@ -715,8 +717,12 @@ have->:Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), 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). + + 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. @@ -745,9 +751,9 @@ auto; call(: ={glob OSimulator, glob Counter, glob Log} /\ + proc; sp; if; auto=> />; 1: smt(). inline{1} 1; inline{2} 1; sp; auto. if; 1, 3: auto; -1: smt(). - if; 1, 3: auto; -1: smt(). - sp; if; 1: auto; 1: smt(); last first. - - by conseq(:_==> ={y, glob OSimulator}); 1: smt(); sim; 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(). @@ -757,7 +763,7 @@ auto; call(: ={glob OSimulator, glob Counter, glob Log} /\ 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; smt(). + 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=> /=. @@ -805,20 +811,22 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, inline *; sp; sim. if; 1: auto; sim. if; 1: auto; sim. - sp; if; 1: (auto; smt()); sim; 2: smt(). + sp; if; [2,3:sim]; [1,3:by auto=> /> &1 &2 <- /> <- />]. sp; if; 1: auto; sim; -1: smt(). sp; if{1}. - * rcondt{2} 2; auto; 1: smt(BlockSponge.parse_valid). + * rcondt{2} 2. + + by auto=> /> + + <- /> <- />. + auto. rnd (fun l => oget (of_list l)) to_list; auto=> />. - move=> &l &r 11?; split; 1: smt(of_listK). + 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; split; 2: smt(). + 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 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}. @@ -830,7 +838,7 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, 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). + by auto=> />; smt(dout_ll). sp; if; 1, 3: auto; sp; wp 1 2. if{1}. + wp=> />. @@ -1155,23 +1163,26 @@ if{1}; sp. 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). + - 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). ++ 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}). -+ smt(cats0 take_oversize spec_dout to_listK spec2_dout). ++ 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). ++ by sp; if; auto=> />; smt(size_rcons domE get_setE size_rcons mem_set). +by auto=> />; smt(size_out_gt0). qed. @@ -1225,7 +1236,7 @@ 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}). - * smt(). + * 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})=> />. @@ -1239,21 +1250,21 @@ if{1}; sp. 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). + - 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). + + 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). + - 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(). ++ 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}). @@ -1336,10 +1347,10 @@ have->: - 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: smt(); sim. + if; [1:auto; [1:by move=> /> + + <- /> <-]]; sim. * inline{1} 1; inline{2} 1; sp; sim. - by call eq_eager_ideal; auto; smt(). - smt(). + 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. @@ -1390,9 +1401,9 @@ have->: - 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: smt(); sim. - * by call eq_eager_ideal2; auto; smt(). - smt(). + 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. @@ -1413,8 +1424,8 @@ proc; inline*; sp; if; auto; sp; if; auto; sp; (rcondt{1} 1; 1: auto; rcondt{2} + 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 sp; if; auto=> /> => [|+ + + + + + + + + + _|]; smt(domE get_setE size_out_gt0). + by auto=> />; smt(size_out_gt0). by conseq(:_==> true); auto; sim. qed. @@ -1487,12 +1498,12 @@ have->:Pr[SORO.SecondPreimage(SORO_P2(A), RFList).main(mess) @ &m : res] = glob Dist_of_P2Adv}); 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: smt(); 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; smt(). - smt(). - smt(). + - 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. @@ -1521,11 +1532,11 @@ have->:Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + proc; sp; if; auto. inline{1} 1; inline{2} 1; sp; if; 1, 3: auto. if; 1, 3: auto; sp. - if; 1: auto; 1: smt(); last first. - - by conseq=> />; sim; smt(). - wp=> />; 1: smt(). + if; [1:by auto=> /> + + <- /> <-]; last first. + - by conseq=> />; sim=> /> + + <- /> <-. + wp=> />; [1:by auto=> /> + + <- /> <-]. rnd; auto. - call(eq_extend); by auto; smt(). + 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. @@ -1535,8 +1546,8 @@ have->:Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), 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). + - 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. @@ -1579,9 +1590,11 @@ auto; call(: ={glob OSimulator, glob Counter, glob Log} /\ + proc; sp; if; auto=> />; 1: smt(). inline{1} 1; inline{2} 1; sp; auto. if; 1, 3: auto; -1: smt(). - if; 1, 3: auto; -1: smt(). - sp; if; 1: auto; 1: smt(); last first. - - by conseq(:_==> ={y, glob OSimulator}); 1: smt(); sim; 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(). @@ -1591,7 +1604,7 @@ auto; call(: ={glob OSimulator, glob Counter, glob Log} /\ 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; smt(). + 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=> /=. @@ -1628,20 +1641,20 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, inline *; sp; sim. if; 1: auto; sim. if; 1: auto; sim. - sp; if; 1: (auto; smt()); sim; 2: smt(). + sp; if; [1:by auto=> /> + + <- /> <-]; sim; 2:by auto=> /> + + <- /> <-. sp; if; 1: auto; sim; -1: smt(). sp; if{1}. - * rcondt{2} 2; auto; 1: smt(BlockSponge.parse_valid). + * rcondt{2} 2; auto; [1:by auto=> /> + + <- /> <-; smt(BlockSponge.parse_valid)]. rnd (fun l => oget (of_list l)) to_list; auto=> />. - move=> &l &r 11?; split; 1: smt(of_listK). + 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; split; 2: smt(). + 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 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}. @@ -1653,7 +1666,7 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, 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). + 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. @@ -2030,23 +2043,23 @@ if{1}; sp. 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). + - 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). ++ 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}). -+ smt(cats0 take_oversize spec_dout to_listK spec2_dout). + 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). ++ by sp; if; auto=> /> => [|+ + + + + + + + + + + + _|]; smt(size_rcons domE get_setE size_rcons mem_set). +by auto=> />; smt(size_out_gt0). qed. @@ -2100,7 +2113,7 @@ 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}). - * smt(). + * 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})=> />. @@ -2114,8 +2127,8 @@ if{1}; sp. 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). + - 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). @@ -2123,12 +2136,12 @@ if{1}; sp. 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). + - 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(). ++ 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}). @@ -2211,10 +2224,10 @@ have->: - 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: smt(); sim. + if; [1:by auto=> /> + + <- /> <-]; sim. * inline{1} 1; inline{2} 1; sp; sim. - by call eq_eager_ideal; auto; smt(). - smt(). + 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. @@ -2265,9 +2278,9 @@ have->: - 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: smt(); sim. - * by call eq_eager_ideal2; auto; smt(). - smt(). + 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. @@ -2287,8 +2300,8 @@ proc; inline*; sp; if; auto; sp; if; auto; sp; (rcondt{1} 1; 1: auto; rcondt{2} + 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 sp; if; auto=> /> => [|+ + + + + + + + + + _|]; smt(domE get_setE size_out_gt0). + by auto=> />; smt(size_out_gt0). by conseq(:_==> true); auto; sim. qed. @@ -2358,12 +2371,12 @@ have->:Pr[SORO.Collision(SORO_Coll(A), RFList).main() @ &m : res] = 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: smt(); 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; smt(). - smt(). - smt(). + - 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. @@ -2392,12 +2405,12 @@ have->:Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + proc; sp; if; auto. inline{1} 1; inline{2} 1; sp; if; 1, 3: auto. if; 1, 3: auto; sp. - if; 1: auto; 1: smt(); last first. - - by conseq=> />; sim; smt(). + if; [1:by auto=> /> + + <- /> <-]; last first. + - by conseq=> />; sim=> /> + + <- /> <-. wp=> />; 1: smt(). rnd; auto. - call(eq_extend); by auto; smt(). - + by proc; sp; if; auto; inline{1} 1; inline{2} 1; sp; if; 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. @@ -2406,8 +2419,8 @@ have->:Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), 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). + - 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. @@ -2447,9 +2460,9 @@ auto; call(: ={glob OSimulator, glob Counter, glob Log} /\ + proc; sp; if; auto=> />; 1: smt(). inline{1} 1; inline{2} 1; sp; auto. if; 1, 3: auto; -1: smt(). - if; 1, 3: auto; -1: smt(). - sp; if; 1: auto; 1: smt(); last first. - - by conseq(:_==> ={y, glob OSimulator}); 1: smt(); sim; 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(). @@ -2459,7 +2472,7 @@ auto; call(: ={glob OSimulator, glob Counter, glob Log} /\ 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; smt(). + 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=> /=. @@ -2494,20 +2507,20 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, inline *; sp; sim. if; 1: auto; sim. if; 1: auto; sim. - sp; if; 1: (auto; smt()); sim; 2: smt(). + sp; if; [3:sim]; [1,3:by auto=> /> + + <- /> <-]. sp; if; 1: auto; sim; -1: smt(). sp; if{1}. - * rcondt{2} 2; auto; 1: smt(BlockSponge.parse_valid). + * rcondt{2} 2; auto; [1:by auto=> /> + + <- /> <-; smt(BlockSponge.parse_valid)]. rnd (fun l => oget (of_list l)) to_list; auto=> />. - move=> &l &r 11?; split; 1: smt(of_listK). + 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; split; 2: smt(). + 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 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}. @@ -2519,7 +2532,7 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, 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). + 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. diff --git a/sha3/proof/SHA3_OIndiff.ec b/sha3/proof/SHA3_OIndiff.ec index c046d8b..34f6679 100644 --- a/sha3/proof/SHA3_OIndiff.ec +++ b/sha3/proof/SHA3_OIndiff.ec @@ -236,10 +236,11 @@ have->: Pr[OGIdeal(FSome(IRO), OSimulator, ODRestr(Dist)).main() @ &m : res] = 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, 3: auto; 1: smt(); sp. - * if; auto=> />. - by conseq(:_==> ={IRO.mp} /\ bs0{1} = bs{2})=> />; sim=> />; smt(). - by if; auto=> />; sim; smt(). + 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. From 0c9e84d233bf80f4a93ac44230b450d802a55d94 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 11 Jul 2022 11:25:37 +0100 Subject: [PATCH 390/394] Refine some edgy SMT calls --- sha3/proof/smart_counter/ConcreteF.eca | 10 ++++++++-- sha3/proof/smart_counter/Gcol.eca | 6 ++++-- sha3/proof/smart_counter/Gext.eca | 6 ++++-- 3 files changed, 16 insertions(+), 6 deletions(-) diff --git a/sha3/proof/smart_counter/ConcreteF.eca b/sha3/proof/smart_counter/ConcreteF.eca index 425198c..5c510f2 100644 --- a/sha3/proof/smart_counter/ConcreteF.eca +++ b/sha3/proof/smart_counter/ConcreteF.eca @@ -118,8 +118,14 @@ section. /\ (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}); - progress;..-2:smt(domE mem_set get_setE oget_some take_size cat_take_drop). + /\ 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) diff --git a/sha3/proof/smart_counter/Gcol.eca b/sha3/proof/smart_counter/Gcol.eca index a025edf..e5b2fe0 100644 --- a/sha3/proof/smart_counter/Gcol.eca +++ b/sha3/proof/smart_counter/Gcol.eca @@ -236,7 +236,8 @@ section PROOF. 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);1: by if;auto;smt(card_rng_set). + /\ 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. @@ -328,7 +329,8 @@ section PROOF. 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 auto;smt(size_ge0 prefix_sizel prefix_ge0). + <= 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. diff --git a/sha3/proof/smart_counter/Gext.eca b/sha3/proof/smart_counter/Gext.eca index 43187e4..e90c3a1 100644 --- a/sha3/proof/smart_counter/Gext.eca +++ b/sha3/proof/smart_counter/Gext.eca @@ -667,7 +667,8 @@ section EXT. 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});1:smt(List.size_ge0). + 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} - @@ -675,7 +676,8 @@ section EXT. 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 by auto;smt(List.size_ge0 prefix_sizel). + 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. From 4801702284da70801c103eb0aed0ecc4f286f3a3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 2 Aug 2023 18:45:14 +0100 Subject: [PATCH 391/394] [chore] update to follow main --- sha3/proof/Common.ec | 5 ----- 1 file changed, 5 deletions(-) diff --git a/sha3/proof/Common.ec b/sha3/proof/Common.ec index 044a8f4..e836d4b 100644 --- a/sha3/proof/Common.ec +++ b/sha3/proof/Common.ec @@ -11,9 +11,6 @@ pragma +implicits. op r : { int | 2 <= r } as ge2_r. op c : { int | 0 < c } as gt0_c. -type block. (* ~ bitstrings of size r *) -type capacity. (* ~ bitstrings of size c *) - (* -------------------------------------------------------------------- *) lemma gt0_r : 0 < r. @@ -27,7 +24,6 @@ proof. by apply/ltrW/gt0_c. qed. (* -------------------------------------------------------------------- *) clone export BitWord as Capacity with - type word <- capacity, op n <- c proof gt0_n by apply/gt0_c @@ -38,7 +34,6 @@ clone export BitWord as Capacity with export Capacity DCapacity. clone export BitWord as Block with - type word <- block, op n <- r proof gt0_n by apply/gt0_r From d9e3bbca354704b3d4a6cc59ca58401ea108fa60 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 10 Aug 2023 11:06:25 +0100 Subject: [PATCH 392/394] [ci] switch to nix-based CI --- sha3/config/tests.config | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/sha3/config/tests.config b/sha3/config/tests.config index 580b3a8..351875b 100644 --- a/sha3/config/tests.config +++ b/sha3/config/tests.config @@ -1,18 +1,23 @@ [default] -bin = easycrypt -args = -timeout 30 -I Jasmin:jasmin/eclib -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm +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 From ab5542f1d6457184d65875e9affea9d678f8cda0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 12 Sep 2023 16:47:34 +0100 Subject: [PATCH 393/394] =?UTF-8?q?Stabilise=20SMT=20the=20One=20True=20Wa?= =?UTF-8?q?y=E2=84=A2?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- sha3/proof/smart_counter/Handle.eca | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/sha3/proof/smart_counter/Handle.eca b/sha3/proof/smart_counter/Handle.eca index ab1bf00..4ba8b17 100644 --- a/sha3/proof/smart_counter/Handle.eca +++ b/sha3/proof/smart_counter/Handle.eca @@ -2148,8 +2148,29 @@ proof. 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};sp;2:if{1};(if{2};2:if{2});sp;auto;5:swap{2}4-3;auto; + 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. From e574adad902ed3c4dcffa6ebc1833f80621da519 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 8 Dec 2023 20:49:04 +0000 Subject: [PATCH 394/394] update SHA3 ci config --- .github/workflows/ci.yml | 3 ++- sha3/config/tests.config | 18 +----------------- 2 files changed, 3 insertions(+), 18 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 71a962d..afc7aeb 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -27,7 +27,8 @@ jobs: strategy: fail-fast: false matrix: - target: [ [ 'ci-test', 'config/tests.config', 'all' ] ] + target: [ [ 'ci-test', 'config/tests.config', 'all' ] + , [ 'sha3', 'config/tests.config', 'sha3' ] ] steps: - uses: actions/checkout@v4 - name: Compile & Cache EasyCrypt diff --git a/sha3/config/tests.config b/sha3/config/tests.config index 351875b..c04ab14 100644 --- a/sha3/config/tests.config +++ b/sha3/config/tests.config @@ -3,21 +3,5 @@ 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 +args = -I proof -I proof/smart_counter -p Z3 -p Alt-Ergo@2.4