(* Needham Schroeder public key protocol. *)

(* Example updated from CV 1.28 by Benjamin Beurdouche *)

(* In order to determine the proof, use interactive mode:
   set interactiveMode = true.
The proof is as follows: *)

proof {
crypto uf_cma(sign) rkS;
success;
crypto ind_cca2(enc) rkA;
crypto ind_cca2(enc) rkB;
crypto rom(hash);
success;
auto
}

param NA, NB, NS, NK.

type nonce [large,fixed].
type host [bounded].
type pkey [bounded].
type skey [bounded].
type keyseed [large,fixed].
type spkey [bounded].
type sskey [bounded].
type skeyseed [large,fixed].
type signature [bounded].
type blocksize [fixed].
type blocksizebot [bounded].
type sblocksize [bounded].
type shkey [large,fixed].

(* Concatenation functions *)
fun concat1(nonce, host):blocksize [data].
fun concat2(nonce, nonce, host):blocksize [data].
fun concat3(pkey, host):sblocksize [data].
fun pad(nonce):blocksize [data].

equation forall z:nonce,t:nonce,u:host,y2:nonce,z2:host;
	concat2(z,t,u) <> concat1(y2,z2).
equation forall y:nonce,y2:nonce,z2:host;
	pad(y) <> concat1(y2,z2).
equation forall z:nonce,t:nonce,u:host,y2:nonce;
	concat2(z,t,u) <> pad(y2).

(* Public-key encryption (CCA2) *)
proba Penc.
proba Penccoll.
expand IND_CCA2_public_key_enc(keyseed, pkey, skey, blocksize, bitstring, skgen, pkgen, enc, dec, injbot, Z, Penc, Penccoll).

const Zblocksize: blocksize.
equation forall x: blocksize; Z(x) = Zblocksize.

(* Signatures *)
proba Psign.
proba Psigncoll.
expand UF_CMA_proba_signature(skeyseed, spkey, sskey, sblocksize, signature, sskgen, spkgen, sign, check, Psign, Psigncoll).

(* Hash function, random oracle model *)
type hashkey [fixed].
expand ROM_hash_large(hashkey, bitstring, shkey, hash, hashoracle, qH).

table keys(host, pkey).

(* Peers *)
const A : host.
const B : host.
fun acceptA(host):bitstring.
fun acceptB(host):bitstring.

(* Queries and Events *)
event fullA(host, shkey, bitstring).
event partA(host, bitstring).
event fullB(host, shkey, bitstring).
event partB(host, bitstring).

query secret keyA.
query x:bitstring; inj-event(partA(B, x)) ==> inj-event(partB(A, x)) public_vars keyA.
query x:bitstring, k:shkey; inj-event(fullB(A, k, x)) ==> inj-event(fullA(B, k, x)) public_vars keyA.
query x:bitstring, k:shkey, k':shkey;
   event(fullB(A, k, x)) && event(fullA(B, k', x)) ==> (k = k') public_vars keyA.

(* The correspondence

a) query x:bitstring, k:shkey;
	inj-event(fullB(A, k, x)) ==> inj-event(fullA(B, k, x)).

is not proved by CryptoVerif. Essentially, the difficulty is that
an argument of the proof is that k is a function of the second message,
so a function of x. However, while this is clear after applying
  crypto sign rkS;
  SArename Rkey;
which makes it possible to prove
  event(fullB(A, k, x)) && event(fullA(B, k', x)) ==> (k = k') public_vars kA,
this information is much more difficult to recover after applying the
game transformations for encryption and for the hash function, but we
need to perform these transformations before being able to prove a).

Still, one can prove the weaker correspondence

b) query x:bitstring;
	inj-event(fullB(A, x)) ==> inj-event(fullA(B, x)).

after removing the key from the events fullA and fullB (see
needham-schroeder-pkcorr3BlockKeyHash2). Then b) implies that in
this file
	inj-event(fullB(A, k, x)) ==> inj-event(fullA(B, k', x)).
Combining this correspondence with
   event(fullB(A, k, x)) && event(fullA(B, k', x)) ==> (k = k') public_vars keyA.
we obtain a).  With these manual arguments, we get the proof of
authenticated key exchange.

7/10/2016: The correspondence
query x:bitstring, k:shkey;
	inj-event(fullB(A, k, x)) ==> inj-event(fullA(B, k, x)).
is now proved by CryptoVerif.
*)

(* Channels and Processes *)
channel c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14,
	c15, c16, c17, c18, c19, start, finish.

let processA(skA:skey, pkS:spkey, hk:hashkey) =
	in(c1, hostX: host);
	out(c2, (A, hostX));
	in(c3, (pkX: pkey, =hostX, ms: signature));
	if check(concat3(pkX, hostX), pkS, ms) then
	(* Message 3 *)
        new Na: nonce;
	let m1 = enc(concat1(Na, A), pkX) in
        out(c4, m1);
	(* Message 6 *)
        in(c5, m: bitstring);
	let injbot(concat2(=Na, Nb, =hostX)) = dec(m, skA) in
	(* Message 7 *)
	let m3 = enc(pad(Nb), pkX) in
	event partA(hostX, (m1, m));
	let key = hash(hk, (Na,Nb)) in
	event fullA(hostX, key, (m1, m, m3));
	if hostX = B then
	   let keyA:shkey = key in out(c6, (m3, acceptA(hostX)))
	else
	   out(c6, (m3, acceptA(hostX))); in(c18, =()); out(c18, key).

let processB(skB:skey, pkS:spkey, hk:hashkey) =
	(* Message 3 *)
	in(c7, m:bitstring);
	let injbot(concat1(Na, hostY)) = dec(m, skB) in
	out(c8, (B, hostY));
	in(c9, (pkY: pkey, =hostY, ms: signature));
	if check(concat3(pkY, hostY), pkS, ms) then
	(* Message 6 *)
	new Nb: nonce;
	let m2 = enc(concat2(Na, Nb, B), pkY) in
	event partB(hostY, (m, m2));
	out(c10, m2);
	(* Message 7 *)
	in(c11, m3: bitstring);
	let injbot(pad(=Nb)) = dec(m3, skB) in
	(* OK *)
	let key = hash(hk, (Na,Nb)) in
	event fullB(hostY, key, (m, m2, m3));
	if hostY = A then
	   out(c17, acceptB(hostY))
	else
      out(c17, acceptB(hostY)); in(c19, =()); out(c19, key).

let processK(pkA:pkey, pkB:pkey) =
	in(c12, (Khost: host, Kkey: pkey));
	if Khost = A then insert keys(A, pkA) else
	if Khost = B then insert keys(B, pkB) else
	insert keys(Khost, Kkey).

let processS(skS:sskey) =
	in(c13, (h1: host, h2: host));
	get keys(=h2, pk2) in
	out(c14, (pk2, h2, sign(concat3(pk2, h2), skS))).

process
	in(start, ());
	new hk: hashkey;
	new rkA: keyseed;
	let pkA = pkgen(rkA) in
	let skA = skgen(rkA) in
	new rkB: keyseed;
	let pkB = pkgen(rkB) in
	let skB = skgen(rkB) in
	new rkS: skeyseed;
	let pkS = spkgen(rkS) in
	let skS = sskgen(rkS) in
	out(c15, (pkA, pkB, pkS));
	((! iA <= NA processA(skA,pkS,hk)) |
	 (! iB <= NB processB(skB,pkS,hk)) |
	 (! iS <= NS processS(skS)) |
	 (! iK <= NK processK(pkA,pkB)) | hashoracle(hk))


(* EXPECTED
All queries proved.
21.508s (user 21.492s + system 0.016s), max rss 45784K
END *)

(* EXPECTPV
RESULT secret keyA is true.
RESULT inj-event(partA(B,x)) ==> inj-event(partB(A,x)) public_vars keyA is true.
RESULT inj-event(fullB(A,k,x)) ==> inj-event(fullA(B,k,x)) public_vars keyA is true.
RESULT event(fullB(A,k,x)) && event(fullA(B,k',x)) ==> k = k' public_vars keyA is true.
0.072s (user 0.068s + system 0.004s), max rss 12648K
END *)
