(* Date: 10.04.2020
   Very simplified model of DP-3T, design 1. https://github.com/DP-3T/documents

   ## Modeling choices:
   We let the system be made of a Backend, an HealthAuhority, and an unbounded number of phones.
   Each phone, can, at any moment, send an EphID, receive an EphID, fetch an infected SK, and check if it has been in contact with this SK, and upload all the SKs it has used, when infected. When the intruder decides so, the phone computes a new SK for the next day.
We make the following abstractions:
    - Time: we consider internal clock for each P(id), intruder chooses when the clock evolves.
      We will then express clock synchronization (if that is a system assumption) as extra restrictions (if possible?).
    - Randomized list of EphdID for a certain SK is abstracted away: a fixed number of EphIDs are sent in parallel.

   ## Properties:
   WIP but currently struggling with non-termination for the first security property (Authorization to publish InfectedSK)
*)


(*************************** THEORY *******************************************)
type id.
type key.
type short.     (* 16 bytes messages *)
fun keyToBit(key): bitstring [typeConverter].
fun bitToKey(bitstring): key [typeConverter].

free b:channel. (* Bluetooth *)
free i:channel. (* Internet: phone P <-> backend B *)
free p:channel. (* Physical, out of band: health authority HA <-> phone user I <-> phone P *)
free a:channel. (* Open channel: attacker *)

free skB:key [private].  (* Health authority private key *)
free skH:key [private].  (* Backend private key *)
free midnight:bitstring. (* Trigger the next day in phones *)

fun h(bitstring):bitstring.         (* hash function -> random oracle *)
fun HKDF(key,nat):short.            (* HKDF(SK,epoch) = one EphID (random oracle) *)
fun MAC(bitstring,key):bitstring.   (* MAC function, we use global, private keys to verify *)

table recvTokens(id,nat,nat,short). (* Table of received tokens: (id, day, epoch, token) when P(id) has received token on dat 'day' at epoch 'epoch' *)
table usedSK(id,nat,key).           (* Table of used SKs (id, day, usedSK) when P(id) has generated SK on day 'day' *)


(*************************** PROPERTIES ***************************************)
event PClaimAtRisk(id,nat,key,short). (* PClaimAtRisk(id,t,SK,EphID): P(id) claims to be at-risk at time t, due to received EphID derived from SK *)
event HAClaimInfected(id,id,nat,key). (* HAClaimInfected(id,idL,t,SK): HA claims that P(id)'s owner I(idL) has been tested positive and consider SK to be "publishable" at time t *)
event PReceiveInfected(id,nat,key).   (* PReceiveInfected(id,t,SK): P(id) receives from B an infected SK *)
event Close(id,id,nat).               (* Close(id,id2,t): P(id) and P(id2) are close at time t (below a certain threshold that allows genuine BLE transmissions and reasonable contamination risk) *)
event Register(id,id).                (* Register(id,idL): I(idL) registered with P(id) *)
event BPublish(key).                  (* BPublish(SK): B publishes some infected SK *)


(** Sanity checks *)
query SK:key; event(BPublish(SK)).

(** Authorization to publish InfectedIDs (here SK):
  publication of InfectedIDs by P(id) has been authorized by HA for I(idI), who owns P(id), which has created InfectedIDs:
  ∀ id InfectedIDs t, ReceiveInfected(id,InfectedIDs,t) ⇒ ∃ t’ id’ idI’. HAClaimInfected(id’,idI’,t’,infectedIDs) /\ t’ < t. *)
query id:id, idL2:id, t:nat, t2:nat, id2:id, SK:key;
  event(PReceiveInfected(id,t,SK)) ==> event(HAClaimInfected(id2,idL2,t2,SK)).
(* Abstractions: we already know that the HAClaimInfected event must happen before the PReceiveInfected, no need to add the time constraint.*)

(** At-risk detection is sound (no/minimal false-positives) w.r.t. ClaimAtRisk, Close(), and Infectious():
  ∀ id t, PClaimAtRisk(id,t) ⇒ ∃ t’ id’ idI’ d. Close(id,id’,t’,d) /\ Infectious(id’,idI’,t’) /\ t’ ∈ [t-14,t). *)
query id:id, t:nat, SK:key, EphID:short, id2:id, t2:nat, idL2:id, SK2:key;
  event(PClaimAtRisk(id,t,SK,EphID)) ==> (event(Close(id,id2,t2)) && event(HAClaimInfected(id2,idL2,t2,SK2))).

(** At-risk detection is complete (no/minimal false-negatives) w.r.t. ClaimAtRisk(), Close(), and Infectious(). That’s almost a liveness property:
  ∀ t’ id id’ idI’ d. Close(id,id’,t’,d) /\ Infectious(id’,idI’,t’)  ⇒ System can progress until time t such that: PClaimAtRisk(id,t) /\ t’ ∈ [t-14,t). *)
(* ???? *)

(** Axiom **)

not attacker(new cSK).

event Cell(channel,nat,key).

axiom d:channel, i:nat, k:key, k':key;
	event(Cell(d,i,k)) && event(Cell(d,i,k')) ==> k = k'.

lemma d:channel, i:nat, k:key, k':key;
  event(Cell(d,i,k)) ==> is_nat(i) [induction,fullSat].

set nounifIgnoreAFewTimes = auto.
set removeEventsForLemma = true.
set preciseActions = true.

(*************************** PROCESSES ****************************************)
(* When it is midnight (in the intruder's control), compute the next SK for P(id) *)
let NextDay(id:id, cSK:channel) =
  in(a, =midnight);  (* Attacker chooses to moves P(id) clock forward *)
  in(cSK, (t:nat,SK:key));
  event Cell(cSK,t,SK);
  let newSK = bitToKey(h(keyToBit(SK))) in  (* newSK = h(SK) *)
  let newTime = t+1 in
  insert usedSK(id,newTime,newSK);
  event Cell(cSK,newTime,newSK);
  out(cSK, (newTime,newSK)).

(* Send a new EphID (potentially multiple times) *)
let GenSendEph(id:id, cSK:channel) =
  in(cSK, (t:nat,SK:key));
  event Cell(cSK,t,SK);
  let EphID0 = HKDF(SK,0) in
  let EphID1 = HKDF(SK,1) in
  let EphID2 = HKDF(SK,2) in
  let EphID3 = HKDF(SK,3) in
  ( out(cSK, (t,SK))
  | ! out(b, EphID0)
  | ! out(b, EphID1)
  | ! out(b, EphID2)
  | ! out(b, EphID3)
  ).

(* Receive and log a broadcasted EphID *)
let RecvEph(id:id, cSK:channel) =
  in(cSK, (t:nat,SK:key));
  event Cell(cSK,t,SK);
  in(b, EphID:short);
  in(a, epoch:nat);  (* We suppose the attacker controls P(id)'s clock *)
  insert recvTokens(id, t, epoch, EphID);
  out(cSK, (t,SK)).

(* Fetch an infected SK and check if id is at risk *)
let CheckAtRisk(id:id, cSK:channel) =
  in(i, (SKinfected:key,xMAC:bitstring));
  if xMAC = MAC(keyToBit(SKinfected),skB) then
  get recvTokens(=id,t:nat,epoch:nat,EphID:short) suchthat HKDF(SKinfected, epoch) = EphID in
  in(cSK, (tOwn:nat,SKOwn:key));
  event Cell(cSK,tOwn,SKOwn);
  event PClaimAtRisk(id,tOwn,SKinfected,EphID);
  out(cSK, (tOwn,SKOwn)).

(* id has been tested positive --> upload its SKs*)
let TestPositive(id:id, cSK:channel) =
  ! in(cSK, (t:nat,SK:key));
    event Cell(cSK,t,SK);
    let told:nat = t-14 in
    get usedSK(=id,told:nat,SKold:key) in (* We should use =told instead of told, but this leads to non-termination *)
    event HAClaimInfected(id,id,t,SKold);
    new r:bitstring;
    let hc:bitstring = h((SKold,told,r)) in
    let tc:bitstring = (told,hc) in
    out(p, tc);
    out(i, (SK,told,r));
    out(cSK, (t,SK)).

let HealthAuthority =
  in(p, tc:bitstring);
(*  let t2:nat = t in
    Abstraction: we only model the case t2 = t, so message 2 in the protocol is not needed any more. *)
  out(i, MAC(tc,skH)).  (* potential authorization protocol*)

let Backend () =
  in(i, (SK:key,t:nat,r:bitstring)); (* Infected SK receievd from some P(id) *)
  in(i, xMAC:bitstring);                     (* Authorized token received from HA *)
  if xMAC = MAC((t,h((SK,t,r))), skH) then   (* Upload is authorized *)
  event BPublish(SK);
  out(i, (SK, MAC(keyToBit(SK),skB))).  (* We only assume authentic fetch of infected SKs *)

let Phone(id:id) =
   new cSK:channel; new SK:key;(
   (out(cSK, (0,SK)); event Cell(cSK,0,SK); insert usedSK(id,0,SK)) (* Day 0, random initial SK key *)
 | ! NextDay(id,cSK)
 | ! GenSendEph(id,cSK)
 | ! RecvEph(id,cSK)
 | ! CheckAtRisk(id,cSK)
 | ! TestPositive(id,cSK)
 ).

let System =
      ! new id:id; Phone(id)  (* Create a new account *)
    | HealthAuthority
    | Backend.

process System

(* EXPECTPV
RESULT event(Cell(d,i_1,k)) ==> is_nat(i_1) is true.
RESULT not event(BPublish(SK_6)) is false.
RESULT event(PReceiveInfected(id_3,t_6,SK_6)) ==> event(HAClaimInfected(id2,idL2,t2,SK_6)) is true.
RESULT event(PClaimAtRisk(id_3,t_6,SK_6,EphID_2)) ==> event(Close(id_3,id2,t2)) && event(HAClaimInfected(id2,idL2,t2,SK2)) is false.
54.216s (user 54.144s + system 0.072s), max rss 353772K
END *)
