(* JFKi *)

set redundantHypElim = beginOnly.

(* Setting required to prove the second query *)
set nounifIgnoreAFewTimes = auto.

type G.
type texponent.
type skey.
type pkey.
type key.
type tag.
type nonce.
type grpinfo.
type sainfo.

fun G_to_key(G):key [data, typeConverter].

(* Exponential and Diffie-Hellman *)

const g: G.
fun exp(G, texponent): G.
equation forall y: texponent, z: texponent; exp(exp(g,y),z) = exp(exp(g,z),y).

(* Signature *)

fun S(skey, bitstring): bitstring.
fun Pk(skey): pkey.

fun V(bitstring, pkey, bitstring): bool
reduc forall k: skey, v: bitstring; V(S(k,v), Pk(k),v) = true
otherwise forall pk: pkey, s,v: bitstring; V(s, pk,v) = false.

fun RecoverKey(bitstring): pkey
reduc forall k: skey, v: bitstring; RecoverKey(S(k,v)) = Pk(k). (* For the attacker *)

fun RecoverText(bitstring): bitstring
reduc forall k: skey, v: bitstring; RecoverText(S(k,v)) = v.    (* For the attacker *)

(* Shared-key encryption *)

fun E(key, bitstring): bitstring.
fun D(key, bitstring): bitstring.
equation forall k: key, v: bitstring; D(k,E(k,v)) = v.

(* Keyed hash function *)

fun H(key, bitstring): key.

(* Sets *)

type keyset.
fun consset(key, keyset): keyset [data].
const emptyset: keyset [data].
pred member(key, keyset).
clauses
  forall x: key, y: keyset; member(x,consset(x,y));
  forall x: key, y: keyset, z: key; member(x,y) -> member(x,consset(z,y)).

type idset.
fun considset(pkey, idset): idset [data].
const emptyidset: idset [data].
pred memberid(pkey, idset).
clauses
  forall x: pkey, y: idset; memberid(x,considset(x,y));
  forall x: pkey, y: idset, z: pkey; memberid(x,y) -> memberid(x,considset(z,y)).

(* Tags *)

const tagE, tagA, tagV: tag [data].

(* Constructors for JFK's formatted messages
   Selectors are implicit when using "data" *)

fun cons1(nonce, G, pkey): bitstring [data].
fun cons2(nonce, nonce, G, grpinfo, pkey, bitstring, key): bitstring [data] .
fun cons3(nonce, nonce, G, G, key, bitstring, key): bitstring [data].
fun cons4(bitstring, key): bitstring [data].

(* More constants *)

const constI, constR: tag [data].

(* Free names *)

free c: channel. (* Public channel *)
free pub, getprinc, getexponential: channel.

(* Queries: properties to prove *)

(* Correspondence assertions *)

event princ(skey, pkey, channel, channel, channel, idset).
event enddosi(pkey, nonce).
event enddosr(pkey, nonce, nonce).
event initev(channel, idset, pkey, sainfo).
event mess1(pkey, nonce, G, pkey, channel, idset, sainfo).
event mess1rec(pkey, nonce, G, pkey).
event mess2(pkey, nonce, nonce, G, G, grpinfo, bitstring, key, pkey).
event mess2rec(pkey, nonce, nonce, G, grpinfo, pkey, bitstring, key, G, pkey, sainfo).
event mess3(pkey, nonce, nonce, G, G, key, bitstring, key, grpinfo, pkey, sainfo, key).
event mess3rec(pkey, nonce, nonce, G, G, key, bitstring, key).
event mess4(pkey, pkey, bitstring, key, nonce, nonce, G, G, key, bitstring, key).
event mess4rec(pkey, bitstring, key, channel, pkey, sainfo, sainfo, key).
event acceptev(channel, pkey, sainfo, sainfo, key).
event accepthonest(channel, pkey, sainfo, sainfo, key).
event connectev(channel, pkey, sainfo, sainfo, key).
event connecthonest(channel, pkey, sainfo, sainfo, key).

(* Queries with user-defined predicates before ==>.
   Such queries are rather strange, because they do not depend on
   the execution of the protocol, just on the clauses for user-defined
   predicates. *)

query x: key, y: keyset; member(x,y) ==> attacker(x).
query x: key, y: keyset, z: key, z': keyset; member(x,y) ==> y = consset(z,z').

const a : keyset.
query x: key; member(x,a).

(* Secrecy assumptions *)

not attacker(new kAminus) phase 0.

not attacker(new d).
not attacker(new f).


(* Initiator
   The process processI corresponds to I^A in the figure. *)

let processI(exponent: channel, init: channel, connect: channel, honestC: channel, IDA: pkey, kAminus: skey) =
  !
  in(exponent, (dI: texponent, xI: G));
  !
  in(init, (autorid: idset, IDRp: pkey, saI: sainfo));    (* Init message *)
  event initev(init, autorid, IDRp, saI);
  new NI: nonce;
  event mess1(IDA, NI, xI, IDRp, init, autorid, saI);
  out(c, cons1(NI, xI, IDRp));
  in(c, cons2(=NI, NR, xR, grpinfoR, IDRl, sR2, tR));
  event mess2rec(IDA, NI, NR, xR, grpinfoR, IDRl, sR2, tR, xI, IDRp, saI);

  if memberid(IDRl,autorid) then

  event enddosi(IDA, NI);
  if V(sR2, IDRl, (xR, grpinfoR)) = true then
  let h = G_to_key(exp(xR, dI)) in
  let Ka = H(h, (NI, NR, tagA)) in
  let Ke = H(h, (NI, NR, tagE)) in
  let Kv = H(h, (NI, NR, tagV)) in
  let sI = S(kAminus, (NI, NR, xI, xR, IDRl, saI)) in
  let eI = E(Ke, (IDA, saI, sI)) in
  let hI = H(Ka, (constI, eI)) in
  event mess3(IDA, NI, NR, xI, xR, tR, eI, hI, grpinfoR, IDRp, saI, Kv);
  out(c, cons3(NI, NR, xI, xR, tR, eI, hI));
  in(c, cons4(eR, hR));
  if H(Ka, (constR, eR)) = hR then
  let (sR: bitstring, saR: sainfo) = D(Ke, eR) in
  if V(sR, IDRl, (NI, NR, xI, xR, IDA, saI, saR)) = true then
  event mess4rec(IDA, eR, hR, connect, IDRl, saI, saR, Kv);
(
    in(honestC, =IDRl);
    event connecthonest(connect, IDRl, saI, saR, Kv)
  )
  |

  event connectev(connect, IDRl, saI, saR, Kv);
  out(connect, (IDRl, saI, saR, Kv));

  0.

(* Responder
   The process processR corresponds to R^A in the figure. *)

free grpinfoR: grpinfo.
const saR: sainfo [data].

let processR4(accept: channel, honestC: channel, IDA: pkey, kAminus: skey, NI: nonce, NR: nonce, xI: G, xR: G, dR: texponent, tR: key, eI: bitstring, hI: key, SIA: idset) =
  event enddosr(IDA, NI, NR);
  let h = G_to_key(exp(xI,dR)) in
  let Ka = H(h, (NI, NR, tagA)) in
  let Ke = H(h, (NI, NR, tagE)) in
  let Kv = H(h, (NI, NR, tagV)) in
  if H(Ka, (constI, eI)) = hI then
  let (IDIl: pkey, saI: sainfo, sI: bitstring) = D(Ke,eI) in

  if memberid(IDIl,SIA) then

  if V(sI, IDIl, (NI, NR, xI, xR, IDA, grpinfoR)) = true then
(
    in(honestC, =IDIl);
    event accepthonest(accept, IDIl, saI, saR, Kv)
  )
  |

  event acceptev(accept, IDIl, saI, saR, Kv);
  out(accept, (IDIl, saI, saR, Kv));
  (
    (
      let sR = S(kAminus, (NI, NR, xI, xR, IDIl, saI, saR)) in
      let eR = E(Ke, (sR, saR)) in
      let hR = H(Ka, (constR, eR)) in
      event mess4(IDA, IDIl, eR, hR, NI, NR, xI, xR, tR, eI, hI);
      out(c, cons4(eR, hR));

      0
    )
  ).




let processR(exponent: channel, accept: channel, honestC: channel, IDA: pkey, kAminus: skey, SIA: idset) =
  new KR: key;
  (
    (
    !
    in(exponent, (dR: texponent, xR: G));
    !
    in(c, cons1(NI, xI, IDRp));
    new NR: nonce;
    let tR = H(KR, (xR, NR, NI)) in
    event mess2(IDA, NI, NR, xI, xR, grpinfoR, S(kAminus, (xR, grpinfoR)), tR, IDRp);
    out(c, cons2(NI, NR, xR, grpinfoR, IDA, S(kAminus, (xR, grpinfoR)), tR))
    )
  |
    new f: channel;
    (
      out(f, emptyset)
    |
      (
        !
        in(c, cons3(NI,NR,xI,xR,tR,eI,hI));
        event mess3rec(IDA, NI, NR, xI, xR, tR, eI, hI);
        if tR = H(KR, (xR, NR, NI)) then
        in(f, cache: keyset);
        (
          out(f, consset(tR, cache))
        |
          if member(tR,cache) then 0 else
          new l: channel;
          (
	    (
            !
            in(exponent, (dR: texponent, =xR));
            out(l, dR)
            )
          |
            (
            in(l, dR: texponent);
            processR4(accept, honestC, IDA, kAminus, NI, NR, xI, xR, dR, tR, eI, hI, SIA)
            )
          )
        )
      )
    )
  ).





(* Whole JFK system. *)

(* Standard version of the process *)

process

  new exponent: channel;
  ( ! new d: texponent; let x = exp(g,d) in out(getexponential, x); ! out(exponent, (d,x)) )
  |
  new honestC: channel;  (* private channel used to simulate the set C of honest principals *)
  !
  new kAminus: skey;
  let IDA = Pk(kAminus) in
  new connect: channel; new accept: channel; new init: channel; new channelSIA: channel;
out(getprinc, (IDA, init, accept, connect, channelSIA));
  in(channelSIA, SIA: idset);
  event princ(kAminus, IDA, init, accept, connect, SIA);
  (
    (! out(honestC, IDA) )   (* IDA is in C *)
  | processI(exponent, init, connect, honestC, IDA, kAminus)
  | processR(exponent, accept, honestC, IDA, kAminus, SIA)
  )

(* EXPECTPV
RESULT member(x_1,y) ==> attacker(x_1) cannot be proved.
RESULT member(x_1,y) ==> y = consset(z,z') is true.
RESULT not member(x_1,a) is true.
0.372s (user 0.368s + system 0.004s), max rss 20608K
END *)
