(* Needham Schroeder shared key protocol.
   With messages of key confirmation, in order to prove correspondence
   properties.
 *)

ifdef(`ProVerif',`
(* Parameters required to prove the first query. *)
set preciseActions = true.
set nounifIgnoreAFewTimes = auto.
')

param NA, NB, NS, NK.

type nonce [large,fixed].
type host [bounded].
type key [fixed].
type enc_seed [fixed].


(* Shared-key encryption (IND-CPA + INT-CTXT Stream cipher) *)
proba Penc.
proba Pencctxt.
expand IND_CPA_INT_CTXT_sym_enc_all_args(key, bitstring, bitstring, enc_seed, enc, enc_r, enc_r', dec, injbot, Z, Penc, Pencctxt).

(* Concatenation functions *)
fun concat1(nonce, host, key, bitstring):bitstring [data].
fun concat2(host, nonce):bitstring [data].
fun concat3(key, host):bitstring [data].

fun minusone(nonce):nonce [data].
fun nonceToBitstring(nonce):bitstring [data].

ifdef(`CryptoVerif',`
equation forall y:key,z:host,y2:nonce,z2:host,t2:key,v2:bitstring;
	concat3(y,z) <> concat1(y2,z2,t2,v2).
equation forall z:host,t:nonce,y2:nonce,z2:host,t2:key,v2:bitstring;
	concat2(z,t) <> concat1(y2,z2,t2,v2).
equation forall z:host,t:nonce,y2:key,z2:host;
	concat2(z,t) <> concat3(y2,z2).

equation forall x:nonce; minusone(x) <> x.

(* The function Z returns for each bitstring, a bitstring
   of the same length, consisting only of zeroes. *)
fun Zconcat1(bitstring):bitstring.
const Zconcat2:bitstring.
const Zconcat3:bitstring.
equation forall y:nonce,z:host,t:key,u:bitstring;
	Z(concat1(y,z,t,u)) = Zconcat1(Z(u)).
equation forall y:host,z:nonce;
	Z(concat2(y,z)) = Zconcat2.
equation forall y:key,z:host;
	Z(concat3(y,z)) = Zconcat3.
equation forall m:bitstring, k:key, r: enc_seed;
	Z(enc_r(m, k, r)) = Z(m).
',`
const Zbitstring:bitstring.
equation forall x:bitstring; Z(x) = Zbitstring.
')

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

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

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

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

let processA(Kas:key) =
	in(c1, h: host);
        new Na: nonce;
        out(c3, (A, h, Na)); (* To server *)
        in(c4, m2: bitstring); (* From server *)
        let injbot(concat1(=Na, =h, k, m)) = dec(m2, Kas) in
	out(c5, m); (* To B *)
	in(c15, e4:bitstring); (* From B *)
	let injbot(nonceToBitstring(Nb)) = dec(e4, k) in
	let e5 = enc(nonceToBitstring(minusone(Nb)), k) in
	event partA(h, (m,e4));
	event fullA(h, (m,e4,e5));
	out(c16, (e5, acceptA(h))).

let processB(Kbs:key) =
	in(c8, m4: bitstring);
	let injbot(concat3(k, h)) = dec(m4, Kbs) in
	new Nb:nonce;
	let e3 = enc(nonceToBitstring(Nb), k) in
	event partB(h, (m4,e3));
	out(c14, e3);
	in(c17, e6:bitstring);
	if injbot(nonceToBitstring(minusone(Nb))) = dec(e6, k) then
	event fullB(h, (m4,e3,e6));
	out(c13, acceptB(h)).

table keys(host, key).

let processK(Kas:key, Kbs:key) =
	in(c9, (Khost: host, Kkey: key));
	if Khost = A then
	   insert keys(A, Kas)
	else if Khost = B then
	   insert keys(B, Kbs)
	else
	   insert keys(Khost, Kkey).

let processS =
	in(c10, (h1: host, h2: host, n: nonce));
	get keys(=h1, kh1) in
	get keys(=h2, kh2) in
	new k: key;
	let e3 = enc(concat3(k, h1), kh2) in
	let e4 = enc(concat1(n, h2, k, e3), kh1) in
	out(c11, e4).

process
	in(start, ());
	new Kas: key;
	new Kbs: key;
	out(start, ());
	((! iA <= NA processA(Kas)) |
	 (! iB <= NB processB(Kbs)) |
	 (! iS <= NS processS) |
	 (! iK <= NK processK(Kas,Kbs)))


(* EXPECTED
All queries proved.
0.440s (user 0.420s + system 0.020s), max rss 27280K
END *)

(* EXPECTPV
RESULT inj-event(partA(B,x)) ==> inj-event(partB(A,x)) is true.
RESULT inj-event(fullB(A,x)) ==> inj-event(fullA(B,x)) is true.
0.096s (user 0.088s + system 0.008s), max rss 12656K
END *)
