Models and Tools for Cryptographic Proofs
Nancy, France, 1013 July 2017
Interactive proof assistants  Semiautomated verifiers of imperative programs  

Coq,  CompCert,  air  Dafny,  Verve, 
Isabelle,  seL4,  FramaC,  IronClad,  
Agda,  Bedrock,  Why3  miTLS  
Lean,  4 colors  gap  Vale 
In the left corner:
Very expressive dependentlytyped logics,
but only purely functional programming
In the right:
effectful programming, SMTbased automation,
but only firstorder logic
Functional programming language with effects
Semiautomated verification system using SMT
Interactive proof assistant based on dependent types
Functional programming language with effects
Semiautomated verification system
Proof assistant based on dependent types
Microsoft Research, Inria Paris, Univ of Edinburgh, MIT, …


The functional core of F*
Verifying functional programs
Using very simple examples throughout
Small handson exercises here and there
Recursive functions
val factorial : int > int
let rec factorial n = (if n = 0 then 1 else n * (factorial (n  1)))
Inductive datatypes
type list (a:Type) =
 Nil : list a
 Cons : hd:a > tl:list a > list a
val map : ('a > 'b) > list 'a > list 'b
let rec map f x = match x with
 [] > []
 h :: t > f h :: map f t
Lambdas
map (fun x > x + 42) [1;2;3]
type nat = x:int{x>=0}
Refinements introduced by type annotations (code unchanged)
val factorial : nat > nat
let rec factorial n = (if n = 0 then 1 else n * (factorial (n  1)))
Logical obligations discharged by SMT (simplified)
n >= 0, n <> 0 = n  1 >= 0
n >= 0, n <> 0, (factorial (n  1)) >= 0 = n * (factorial (n  1)) >= 0
Refinements eliminated by subtyping: nat<:int
let i : int = factorial 42
Dependent function types (), here together with refinements:
val incr : x:int > y:int{x < y}
let incr x = x + 1
Can express pre and post conditions of pure functions
val incr : x:int > y:int{y = x + 1}
Quiz: can you find other types for incr
?
The F* functions we saw so far were all total
Tot
effect (default) = no sideeffects, terminates on all inputs
val factorial : nat > Tot nat
let rec factorial n = (if n = 0 then 1 else n * (factorial (n  1)))
Quiz: How about giving this weak type to factorial?
val factorial : int > Tot int
let rec factorial n = (if n = 0 then 1 else n * (factorial (n  1)))
^^^^^
Subtyping check failed; expected type (x:int{(x << n)}); got type int
factorial (1)
loops! (int
type in F* is unbounded)
<<
)
<
(negative integers unrelated)
%[a;b;c]
with lexicographic ordering
val ackermann: m:nat > n:nat > Tot nat (decreases %[m;n])
let rec ackermann n m =
if m=0 then n + 1
else if n = 0 then ackermann 1 (m  1)
else ackermann (ackermann (n  1) m) (m  1)
val ackermann: m:nat > n:nat > Tot nat
We might not want to prove all code terminating
val factorial : int > Dv int
Some useful code really is not always terminating
val eval : exp > Dv exp
let rec eval e =
match e with
 App (Lam x e1) e2 > eval (subst x e2 e1)
 App e1 e2 > eval (App (eval e1) e2)
 Lam x e1 > Lam x (eval e1)
 _ > e
let main = eval (App (Lam 0 (App (Var 0) (Var 0)))
(Lam 0 (App (Var 0) (Var 0))))
./Divergence.exe
Pure code cannot call potentially divergent code
Only pure code can appear in specifications
val factorial : int > Dv int
type tau = x:int{x = factorial (1)}
^^^^^^^^^^^^^^^^^^
Expected a pure expression; got an expression ... with effect "DIV"
Subeffecting: Tot t <: Dv t
(e.g. divergent code can include pure code)
incr 2 + factorial (1) : Dv int
val factorial : nat > Tot nat
val factorial : x:int > Pure int (requires (x >= 0))
(ensures (fun y > y >= 0))
Pure
, Div
), result type (int
),
spec (e.g. pre and post)
Tot
can be seen as just an abbreviation
Tot t = Pure t (requires True) (ensures (fun _ > True))
val factorial : nat > Dv nat
Div
computation type (pre and post conditions)
val eval_closed : e:exp > Div exp (requires (closed e))
(ensures (fun e' > Lam? e' /\ closed e'))
let rec eval_closed e =
match e with
 App e1 e2 > let Lam e1' = eval_closed e1 in
below_subst_beta 0 e1' e2;
eval_closed (subst (sub_beta e2) e1')
 Lam e1 > Lam e1
Dv
just an abbreviation
Dv t = Div t (requires True) (ensures (fun _ > True))
Two classes of types
t
): int
, list int
, …
C
): Tot t
and Dv t
Dependent function types of the form: x:t > C
Two forms of refinement types
x:t{p}
Pure t pre post
and Div t pre post
let rec append (#a:Type) (xs : list a) (ys : list a) : Tot (list a) =
match xs with
 [] > ys
 x :: xs' > x :: append xs' ys
let rec append_length (#a:Type) (xs : list a) (ys : list a) :
Pure unit
(requires True)
(ensures (fun _ > length (append xs ys) = length xs + length ys))
= match xs with
 [] > ()
 x :: xs' > append_length xs' ys
Syntax sugar (Lemma
)
let rec append_length (#a:Type) (xs : list a) (ys : list a) :
Lemma (ensures (length (append xs ys) = length xs + length ys)) = ...
Prove that mem
satisfies the following property:
let rec append (#a:Type) (xs : list a) (ys : list a) : Tot (list a) =
match xs with
 [] > ys
 x :: xs' > x :: append xs' ys
let rec mem (#a:eqtype) (x:a) (xs:list a) : Tot bool =
match xs with
 [] > false
 hd :: tl > hd = x  mem x tl
val append_mem: #a:eqtype > l1:list a > l2:list a > x:a
> Lemma (mem x (append l1 l2) <==> mem x l1  mem x l2)
let rec append_mem #a l1 l2 x =
match l1 with
 [] > ()
 hd1::tl1 > append_mem tl1 l2 x
let snoc l h = l @ [h]
val reverse: #a:Type > list a > Tot (list a)
let rec reverse (#a:Type) l =
match l with
 [] > []
 hd::tl > snoc (reverse tl) hd
val rev_snoc: #a:Type > l:list a > h:a >
Lemma (reverse (snoc l h) == h::reverse l)
let rec rev_snoc (#a:Type) l h =
match l with
 [] > ()
 hd::tl > rev_snoc tl h
val rev_involutive: #a:Type > l:list a > Lemma (reverse (reverse l) == l)
let rec rev_involutive (#a:Type) l =
match l with
 [] > ()
 hd::tl > rev_involutive tl; rev_snoc (reverse tl) hd
Dependent type theory variant
Recursion and semantic termination check
Refined value and computation types
Subtyping and subeffecting
Stack.fsti
module Stack
val stack : Type0 (* type stack *)
val empty : stack
val push : int > stack > stack
val is_empty : stack > bool
val pop : stack > option stack
val top : stack > option int
StackClient.fst
module StackClient
let main =
let s0 = Stack.empty in
let s1 = Stack.push 3 s0 in
let s2 = Stack.push 4 s1 in
Stack.top s2
Stack.fst
module Stack
let stack = list int
let empty = []
let push x xs = x :: xs
let is_empty xs = match xs with
 [] > true
 x::xs' > false
let pop xs = match xs with
 [] > None
 x::xs' > Some xs'
let top xs = match xs with
 [] > None
 x::xs' > Some x
StackClientBad.fst
module StackClientBad
let main =
let s0 = Stack.empty in
let s1 = Stack.push 3 s0 in
2 :: s1
[hritcu@detained code]$ fstar.exe StackClientBad.fst
./StackClientBad.fst(6,96,11) : Error
Expected expression of type "list (?32566 s0 s1)";
got expression "s1" of type "Stack.stack"
module RefinedStack
abstract type stack = list int
abstract val is_empty : stack > Tot bool
let is_empty = Nil?
abstract val empty : s:stack{is_empty s}
let empty = []
abstract val push : int > stack > Tot (s:stack{~(is_empty s)})
let push x xs = Cons x xs
abstract val pop : s:stack{~(is_empty s)} > Tot stack
let pop = Cons?.tl
abstract val top : s:stack{~(is_empty s)} > Tot int
let top = Cons?.hd
module RefinedStackClient
open RefinedStack
let main() : Tot stack =
let s = push 1 (push 2 (push 3 empty)) in
let t = top s in
let s' = pop s in s'
(* pop s'  Subtyping check failed;
expected type (s:stack{~(is_empty s)}); got type stack *)
Exercise: redesign RefinedStack
interface so that this works
module AbstractStack
abstract type stack = list int
abstract let is_empty : stack > Tot bool = Nil?
abstract let empty : s:stack{is_empty s} = []
abstract let push (x:int) (xs:stack) : Tot (s:stack{~(is_empty s)}) = Cons x xs
abstract let pop : s:stack{~(is_empty s)} > Tot stack = Cons?.tl
abstract let top : s:stack{~(is_empty s)} > Tot int = Cons?.hd
let top_push (i:int) (s:stack) :
Lemma (top (push i s) = i) [SMTPat (top (push i s))] = ()
let pop_push (i:int) (s:stack) :
Lemma (pop (push i s) = s) [SMTPat (pop (push i s))] = ()
let push_top_pop (s:stack{~(is_empty s)}) :
Lemma (ensures (s = push (top s) (pop s))) = ()
module AbstractStackClient
open AbstractStack
let main() : Tot stack =
let s = push 1 (push 2 (push 3 empty)) in
let t = top s in
(* top_push 1 (push 2 (push 3 empty)); *)
assert (t = 1);
let s' = pop s in
(* pop_push 1 (push 2 (push 3 empty)); *)
pop s'
Verifying Stateful Programs in F* (Catalin, Kenji)
CodeBased Cryptographic Verification in F* (Markulf)