(* Loops if types are ignored *)
set ignoreTypes = false.

free c: channel.

type host.
type nonce.
type pkey.
type skey.
type spkey.
type sskey.

fun nonce_to_bitstring(nonce): bitstring [data,typeConverter].

(* Public key encryption *)
fun pk(skey): pkey.
fun encrypt(bitstring, pkey): bitstring.
reduc forall x: bitstring, y: skey; decrypt(encrypt(x,pk(y)),y) = x.

(* Signatures *)
fun spk(sskey): spkey.
fun sign(bitstring, sskey): bitstring.
reduc forall m: bitstring, k: sskey; getmess(sign(m,k)) = m.
reduc forall m: bitstring, k: sskey; checksign(sign(m,k), spk(k)) = m.

(* Shared key encryption *)
fun sencrypt(bitstring,nonce): bitstring.
reduc forall x: bitstring, y: nonce; sdecrypt(sencrypt(x,y),y) = x.

(* Secrecy assumptions *)
not attacker(new skA).
not attacker(new skB).
not attacker(new skS).

(* 2 honest host names A and B *)
free A, B: host.

table keys(host, pkey).

(* Queries *)
free secretANa, secretANb, secretBNa, secretBNb: bitstring [private].
query attacker(secretANa);
      attacker(secretANb);
      attacker(secretBNa);
      attacker(secretBNb).

event beginBparam(host, host).
event endBparam(host, host).
event beginAparam(host, host).
event endAparam(host, host).
event beginBfull(host, host, pkey, pkey, nonce, nonce).
event endBfull(host, host, pkey, pkey, nonce, nonce).
event beginAfull(host, host, pkey, pkey, nonce, nonce).
event endAfull(host, host, pkey, pkey, nonce, nonce).

query x: host, y: host; 
	inj-event(endBparam(x,y)) ==> inj-event(beginBparam(x,y)).

query x1: host, x2: host, x3: pkey, x4: pkey, x5: nonce, x6: nonce; 
	inj-event(endBfull(x1,x2,x3,x4,x5,x6))  
			==> inj-event(beginBfull(x1,x2,x3,x4,x5,x6)).

query x: host, y: host; 
	inj-event(endAparam(x,y)) ==> inj-event(beginAparam(x,y)).

query x1: host, x2: host, x3: pkey, x4: pkey, x5: nonce, x6: nonce; 
	inj-event(endAfull(x1,x2,x3,x4,x5,x6)) 
			==> inj-event(beginAfull(x1,x2,x3,x4,x5,x6)).

fun choosekey(host, host, host, skey, skey): skey
reduc forall x1: host, x2: host, sk1: skey, sk2: skey; 
         choosekey(x1, x1, x2, sk1, sk2) = sk1
otherwise forall x1: host, x2: host, sk1: skey, sk2: skey; 
         choosekey(x2, x1, x2, sk1, sk2) = sk2.

(* Role of the initiator with identity xA and secret key skxA *)
let processInitiator(pkS: spkey, skA: skey, skB: skey) =
	(* The attacker starts the initiator by choosing identity xA,
	   and its interlocutor xB0.
	   We check that xA is honest (i.e. is A or B)
	   and get its corresponding key. *)
	in(c, (xA: host, hostX: host));
	let skxA = choosekey(xA, A, B, skA, skB) in
	let pkxA = pk(skxA) in
	(* Real start of the role *)
	event beginBparam(xA, hostX); 
	(* Message 1: Get the public key certificate for the other host *)
	out(c, (xA, hostX));
	(* Message 2 *)
	in(c, ms: bitstring); 
	let (pkX: pkey, =hostX) = checksign(ms,pkS) in
	(* Message 3 *)
	new Na: nonce; 
	out(c, encrypt((Na, xA), pkX));
	(* Message 6 *)
	in(c, m: bitstring); 
	let (=Na, NX2: nonce) = decrypt(m, skxA) in
	event beginBfull(xA, hostX, pkX, pkxA, Na, NX2);
	(* Message 7 *)
	out(c, encrypt(nonce_to_bitstring(NX2), pkX));
	(* OK *)
	if hostX = B || hostX = A then
	event endAparam(xA, hostX);
	event endAfull(xA, hostX, pkX, pkxA, Na, NX2);
	out(c, sencrypt(secretANa, Na));
	out(c, sencrypt(secretANb, NX2)).

(* Role of the responder with identity xB and secret key skxB *)
let processResponder(pkS: spkey, skA: skey, skB: skey) =
	(* The attacker starts the responder by choosing identity xB.
	   We check that xB is honest (i.e. is A or B). *)
	in(c, xB: host);
	let skxB = choosekey(xB, A, B, skA, skB) in
	let pkxB = pk(skxB) in
	(* Real start of the role *)
	(* Message 3 *)
	in(c, m: bitstring);
	let (NY: nonce, hostY: host) = decrypt(m, skxB) in
	event beginAparam(hostY, xB);
	(* Message 4: Get the public key certificate for the other host *)
	out(c, (xB, hostY));
	(* Message 5 *)
	in(c,ms: bitstring);
	let (pkY: pkey,=hostY) = checksign(ms,pkS) in
	(* Message 6 *)
	new Nb: nonce;
	event beginAfull(hostY, xB, pkxB, pkY, NY, Nb);
	out(c, encrypt((NY, Nb), pkY));
	(* Message 7 *)
	in(c, m3: bitstring);
	if nonce_to_bitstring(Nb) = decrypt(m3, skB) then
	(* OK *)
	if hostY = A || hostY = B then
	event endBparam(hostY, xB);
	event endBfull(hostY, xB, pkxB, pkY, NY, Nb);
	out(c, sencrypt(secretBNa, NY));
	out(c, sencrypt(secretBNb, Nb)).

(* Server *)
let processS(skS: sskey) =  
	in(c,(a: host, b: host)); 
	get keys(=b, sb) in
	out(c,sign((sb,b),skS)).

(* Key registration *)
let processK =
	in(c, (h: host, k: pkey));
	if h <> A && h <> B then insert keys(h,k).

(* Main *)
process 
	new skA: skey; let pkA = pk(skA) in	out(c, pkA); insert keys(A, pkA);
	new skB: skey; let pkB = pk(skB) in out(c, pkB); insert keys(B, pkB);
	new skS: sskey; let pkS = spk(skS) in out(c, pkS);
	(
		(* Launch an unbounded number of sessions of the initiator *)
		(!processInitiator(pkS, skA, skB)) | 
		(* Launch an unbounded number of sessions of the responder *)
		(!processResponder(pkS, skA, skB)) |
		(* Launch an unbounded number of sessions of the server *)
		(!processS(skS)) |
		(* Key registration process *)
		(!processK)
	)
