Section PRF_DRBG.
Variable Key D : Set.
(* The range of the PRF is a bit vector of length eta. *)
Variable eta : nat.
Hypothesis D_EqDec : EqDec D.
Variable RndKey : Comp Key.
(* f is an adaptively-secure PRF. *)
Variable f : Key -> D -> Bvector eta.
(* For this construction, we need an injection from the range of the PRF to the domain.  This allows us to use the previous PRF output to compute the next one. *)
Variable injD : Bvector eta -> D.
Hypothesis injD_correct :
forall r1 r2, (injD r1) = (injD r2) -> r1 = r2.
(* The length (in PRF output blocks) of the DRBG output is l.  This value must be positive. *)
Variable l : nat.
Hypothesis l_pos : l  > 0.
(* Because the DRBG is constructed using feedback from the previous iteration, we need an initial value.  We assume an arbitrary bit vector and then inject it into the domain of the PRF.  This arrangement was chosen for simplicity, and it could easily be modified or generalized. *)
Variable r_init : Bvector eta.
Definition v_init := injD r_init.
(* The computation used to obtain uniform random values in the range of the DRBG.  This computation is used only in the security definition. *)
Definition RndOut := compMap _ (fun _ => {0, 1}^eta) (forNats l).
(* We model the DRBG using a function that uses the previous output value (injected into the domain) as the current input value of the PRF. *)
Fixpoint PRF_DRBG_f (v : D)(n : nat)(k : Key) :=
match n with
| O => nil
| S n' =>
r <- (f k v);
r :: (PRF_DRBG_f (injD r) n' k)
end.
Definition PRF_DRBG (k : Key) :=
PRF_DRBG_f v_init l k.
(* The adversary against the DRBG. *)
Variable A : list (Bvector eta) -> Comp bool.
Hypothesis A_wf : forall c, well_formed_comp (A c).
(* Step 1: inline definitions and simplify. *)
Definition PRF_DRBG_G1 :=
s <-$ RndKey ;
A (PRF_DRBG_f v_init l s).
reflexivity.
Qed.
(* Step 2: use the PRF as an oracle.  This will allow us to apply the security definition and replace it in the next step.*)
Fixpoint PRF_DRBG_f_G2 (v : D)(n : nat) :=
match n with
| O => $ ret nil
| S n' =>
r <--$ (OC_Query _ v);
ls' <--$ (PRF_DRBG_f_G2 (injD r) n');
$ ret (r :: ls')
end.
(* The constructed adversary against the PRF. *)
Definition PRF_A := (ls <--$ PRF_DRBG_f_G2 v_init l; $ A ls).
induction n; intuition; simpl in *;
fcf_well_formed.
Qed.
unfold PRF_A; fcf_well_formed.
apply PRF_DRBG_f_G2_wf.
Qed.
Definition PRF_DRBG_G2 :=
s <-$ RndKey ;
[b, _] <-$2 PRF_A unit _ (f_oracle f _ s) tt;
ret b.
(* In an intermediate step, put the construction in the form of a (deterministic) computation.  Then we can more easily change it to an oracle interaction in the following step. *)
Fixpoint PRF_DRBG_f_G1_1 (v : D)(n : nat)(k : Key) :=
match n with
| O => ret nil
| S n' =>
r <-$ ret (f k v);
ls <-$ (PRF_DRBG_f_G1_1 (injD r) n' k);
ret (r :: ls)
end.
Definition PRF_DRBG_G1_1 :=
s <-$ RndKey ;
ls <-$ PRF_DRBG_f_G1_1 v_init l s;
A ls.
induction n; intuition; simpl in *.
(* comp_spec eq is registered as a setoid, so intuition will discharge simple goals. *)
fcf_reflexivity.
fcf_simp.
fcf_transitivity.
fcf_skip_eq.
fcf_reflexivity.
fcf_simp.
fcf_reflexivity.
Qed.
unfold PRF_DRBG_G1, PRF_DRBG_G1_1.
fcf_skip.
fcf_to_prhl_eq.
fcf_symmetry.
fcf_transitivity.
fcf_with PRF_DRBG_f_G1_1_eq_ret fcf_skip_eq.
fcf_reflexivity.
fcf_simp.
fcf_reflexivity.
Qed.
induction n; intuition; simpl in *.
fcf_simp.
fcf_spec_ret.
fcf_skip.
unfold f_oracle.
(* we are left with a unification variable for the specification, we can supply a value for it by specializing the appropriate theorem. *)
eapply (comp_spec_ret _ _ (fun x1 x2 => x1 = fst x2)).
trivial.
simpl in *.
intuition; subst.
fcf_skip.
fcf_simp.
fcf_spec_ret.
Qed.
(* equality for rational numbers is a setoid, so we can rewrite with it. *)
rewrite PRF_DRBG_G1_1_equiv.
unfold  PRF_DRBG_G1_1,  PRF_DRBG_G2.
unfold PRF_A.
simpl.
fcf_skip.
fcf_inline_first.
fcf_to_prhl_eq.
fcf_with PRF_DRBG_f_G1_1_G2_equiv fcf_skip.
fcf_simp.
simpl.
fcf_inline_first.
fcf_ident_expand_l.
fcf_skip.
fcf_simp.
fcf_reflexivity.
Qed.
(* Step 3: replace the PRF with a random function *)
Definition PRF_DRBG_G3 :=
[b, _] <-$2 PRF_A _ _ (randomFunc ({0,1}^eta) _) nil;
ret b.
reflexivity.
Qed.
(* Step 4 : Replace the random function with random values.  This is the same as long as there are no duplicates in the list of random function inputs. *)
Definition PRF_DRBG_G4 :=
[b, _] <-$2 PRF_A _ _ (fun _ _ => x <-$ {0, 1}^eta; ret (x, tt)) tt;
ret b.
(* Step 3.1: Preserve duplicate inputs using an oracle that keeps track of all the queries. *)
Definition randomFunc_withDups ls x :=
y <-$
(match (arrayLookup _ ls x) with
| Some y => ret y
| None => {0,1}^eta
end);
ret (y, (x, y) :: ls).
Definition PRF_DRBG_G3_1 :=
[b, _] <-$2 PRF_A _ _ (randomFunc_withDups) nil;
ret b.
intuition.
unfold randomFunc, randomFunc_withDups.
rewrite H.
case_eq (arrayLookup D_EqDec x2 a); intuition.
fcf_simp.
fcf_spec_ret.
simpl.
case_eq (eqb a0 a); intuition.
rewrite eqb_leibniz in H1.
subst.
rewrite H.
trivial.
fcf_skip.
fcf_spec_ret.
simpl.
rewrite H.
trivial.
Qed.
unfold PRF_DRBG_G3, PRF_DRBG_G3_1.
fcf_to_prhl_eq.
fcf_skip.
eapply (fcf_oracle_eq (fun x1 x2 => forall a, arrayLookup _ x1 a = arrayLookup _ x2 a)); intuition.
apply randomFunc_withDups_spec; intuition.
fcf_simp.
simpl in H1; intuition; subst.
fcf_reflexivity.
Qed.
(* Expose the bad event to the game. *)
Definition PRF_DRBG_G3_2 :=
[b, ls] <-$2 PRF_A _ _ (randomFunc_withDups) nil;
ret (b, hasDups _ (fst (split ls))).
unfold PRF_DRBG_G3_1, PRF_DRBG_G3_2.
simpl.
fcf_inline_first.
fcf_skip.
fcf_simp.
fcf_inline_first.
fcf_skip.
fcf_simp.
simpl.
fcf_reflexivity.
Qed.
(* Obtain a new random value for all inputs.  This game is only equal to the previous game when there are no duplicates in the inputs. *)
Definition PRF_DRBG_G3_3 :=
[b, ls] <-$2 PRF_A _ _  (fun ls a => x <-$ {0, 1}^eta; ret (x, (a, x)::ls)) nil;
ret (b, hasDups _ (fst (split ls))).

(* The "equal until bad" specification for randomFunc_withDups and the oracle that always produces a new random value.  This specification forms the core of the proofs of the two parts of the fundamental lemma in the following two theorems. *)
Theorem PRF_A_randomFunc_eq_until_bad :
comp_spec
(fun y1 y2 =>
hasDups _ (fst (split (snd y1))) =
hasDups _ (fst (split (snd y2))) /\
(hasDups _ (fst (split (snd y1))) = false ->
snd y1 = snd y2 /\ fst y1 = fst y2))
(PRF_A _ _ randomFunc_withDups nil)
(PRF_A _ _
(fun (ls : list (D * Bvector eta)) (x : D) =>
r <-$ { 0 , 1 }^eta; ret (r, (x, r) :: ls)) nil).