(* Constants *)

free TLSClientHello, 
     TLSServerHello, 
     TLSServerCert, 
     TLSClientKE, 
     TLSFinished,
     CertRequest, 
     ClientStart, 
     CCFromClient,
     Certificate, 
     PhoneNo, 
     PhoneReq,
     DDSName,
     SUCCESS,
     Tag1,Tag2,Tag3,Tag4,Tag5,Tag6,Tag7,Tag8.

(* event constructors *)

fun ServerEnd/2.
fun UserEnd/2.
private free ServerOK.

(* Secret message for modeling the security of keys *)

private free SecretMsg.

(* Symmetric encryption (non-randomized) *)

fun senc/2.
reduc sdec(x,senc(x,y)) = y.

(* Weak symmetric encryption (non-randomized) *)

fun wsenc/2.
reduc wsdec(x,wsenc(x,y)) = y.

(* signatures *)

fun sign/2.
fun pks/1.
reduc getmess(sign(k,m)) = m.
reduc checksign(pks(k),sign(k,m)) = m.

(* Asymmetric encryption (non-randomized) *)

fun penc/2.
fun pke/1.
reduc pdec(k,penc(pke(k),m)) = m.

(* PRF and hash functions *)

fun PRF/1.
fun Hash/1.
fun TLSclientK/3.
fun TLSserverK/3.

(* Control Code and its collision computation *)

fun CCode/1.
(* fun ccodeprefixcoll/2. *)
data ccodesuffixcoll/2.

pred testCCEq/2.

clauses testCCEq:x,CCode(x);
        testCCEq:(x,ccodesuffixcoll(z,x)),CCode(z).

(* Internet *)

free net.

(* Private channels *)

private free DDS2EMT.

(* CA and DDS stuff *)

private fun cert/2.
reduc readcert(cert(x,y)) = (x,y).

private fun phonereg/2.
reduc readphoneowner(phonereg(x,y)) = x.
private reduc readphonekey(phonereg(x,y)) = y.

(* CA process *)

let simpleca =
  ! in(net, (pubkey, phonekey)); new n; 
  out(net, (cert(n,pubkey),phonereg(n,phonekey))).

(* Channels to access TLS protocol (no client authentication) *)

private free tlsclientin.
private free tlsserverin.

(* TLS subroutines *)  

let tlsclient = 
  in(tlsclientin, (outchan, clientname, servername));
  new Na; new Sid; new Pa; (* Pa == options *)
  out(net, (TLSClientHello, clientname, Na, Sid, Pa));
  in(net, (=TLSServerHello, Nb, =Sid, Pb));
  in(net, (=TLSServerCert, servercert));
  let (=servername, serverPK) = readcert(servercert) in
  new PMS;
  out(net, penc(serverPK, (TLSClientKE, PMS)));
  let M = PRF((PMS, Na, Nb)) in
  let Fin = Hash((M, Sid, Na, Nb, Pa, Pb, clientname, servercert)) in
  let clkey = TLSclientK(Na, Nb, Fin) in
  let srkey = TLSserverK(Na, Nb, Fin) in
  out(net, senc(clkey, (Tag7,Fin)));
  in(net, e5);
  if (Tag8,Fin) = sdec(srkey, e5) then
  out(outchan, (clkey, srkey)).

let tlsserver = 
  in(tlsserverin, (outchan, privkey, servercert));
  in(net, (=TLSClientHello, clientname, Na, Sid, Pa));
  new Nb; new Pb; (* Pb == options *)
  out(net, (TLSServerHello, Nb, Sid, Pb));
  out(net, (TLSServerCert, servercert));
  in(net, e4);
  let (=TLSClientKE, PMS) = pdec(privkey, e4) in
  in(net, encfin);
  let M = PRF((PMS, Na, Nb)) in
  let Fin = Hash((M, Sid, Na, Nb, Pa, Pb, clientname, servercert)) in
  let clkey = TLSclientK(Na, Nb, Fin) in
  let srkey = TLSserverK(Na, Nb, Fin) in
  out(net, senc(srkey, (Tag8,Fin)));
  if (Tag7,Fin) = sdec(clkey, encfin) then
  out(outchan, (clientname, clkey, srkey)).

(* The client side *)

let clientuserphone =
  new username;
  new kbDisplay; out(net, kbDisplay);
  new clsk;
  new a51key;
  out(net, cert(username, pks(clsk)));
  out(net, phonereg(username, a51key));
  (    (* user and phone *)
  !
    in(net, servername);
    new sessid;
    out(kbDisplay, (ClientStart, sessid, servername));
    in(net, e3);
    let (=Tag1, =servername, smthtosign) = wsdec(a51key, e3) in
    in(kbDisplay, (=sessid, clientcc));
    if testCCEq:smthtosign,clientcc then   (* Here the PIN is entered *)
    event UserEnd(username, servername);
    out(net, wsenc(a51key, (Tag2,sign(clsk, smthtosign))))
  ) |
  (!out(ServerOK, username)).

let server = 
  new servername;
  new srvsk;
  let srvcert = cert(servername, pke(srvsk)) in
  out(net, srvcert);
  !
  new tlschan1;
  out(tlsserverin, (tlschan1, srvsk, srvcert));
  in(tlschan1, (clientname, clientkey, serverkey));
  new tlschan2;
  out(tlsclientin, (tlschan2, servername, DDSName));
  in(tlschan2, (ddsclkey, ddssrvkey));
  new clientmustsign;
  out(net, senc(ddsclkey, (Tag4,clientname, clientmustsign)));
  in(net, e7);
  let (=Tag5,clmustsign, clientcc, clcert) = sdec(ddssrvkey, e7) in
  let (=clientmustsign, dummy) = clmustsign in
  out(net, senc(serverkey, (Tag3,clientcc)));
  in(net, e8);
  let (=Tag6, clsig) = sdec(ddssrvkey, e8) in
  let (=clientname, clientpk) = readcert(clcert) in
  if checksign(clientpk, clsig) = clmustsign then
  in(ServerOK, =clientname);
  event ServerEnd(clientname, servername);
  out(net, (senc(clientkey,SecretMsg),senc(serverkey,SecretMsg))).

let dds =
  new skDDS;
  let ddscert = cert(DDSName, pke(skDDS)) in
  out(net, ddscert);
  !
  new tlschan;
  out(tlsserverin, (tlschan, skDDS, ddscert));
  in(tlschan, (servername, srvsesskey, ddssesskey));
  in(net, e9);
  let (=Tag4,clientname, clientmustsign1) = sdec(srvsesskey, e9) in
  in(net, clientcert);
  let (=clientname, clientpk) = readcert(clientcert) in
  new clientmustsign2;
  let clms = (clientmustsign1, clientmustsign2) in
  out(net, senc(ddssesskey, (Tag5, clms, CCode(clms), clientcert)));
  out(DDS2EMT, (clientname, servername, clms));
  in(DDS2EMT, clsig);
  if checksign(clientpk, clsig) = clms then
  out(net, senc(ddssesskey, (Tag6,clsig))).

let emtprocess = 
  in(DDS2EMT, (clientname, servername, clientmustsign));
  in(net, phrecord);
  if readphoneowner(phrecord) = clientname then
  let a51key = readphonekey(phrecord) in
  out(net, wsenc(a51key, (Tag1, servername, clientmustsign)));
  in(net, esignedmsg);
  let (=Tag2,signedmsg) =  wsdec(a51key, esignedmsg) in
  if getmess(signedmsg) = clientmustsign then
  out(DDS2EMT, signedmsg).

(* Queries *)

query
evinj:ServerEnd(c,s) ==> evinj:UserEnd(c,s).

process

simpleca |
(!tlsclient) |
(!tlsserver) |
(!clientuserphone) |
(!server) |
dds |
(!emtprocess)

(* EXPECTPV
RESULT evinj:ServerEnd(c,s) ==> evinj:UserEnd(c,s) is true.
9.620s (user 9.408s + system 0.212s), max rss 984828K
END *)
