Verifying Stateful Programs with F*

Verifying stateful programs

Variant #1: intrinsically (at definition time)

• State in F*: mutable references

  val incr : r:ref int -> St unit
  let incr r = (r := (!r + 1))

• Hoare logic-style pre- and post-conditions

  val incr : r:ref int -> ST unit (requires (fun h0 -> True))
                             (ensures (fun h0 _ h1 -> sel h1 r = sel h0 r + 1))

• Beyond what can be expressed with refinements

• Now pre-condition is relation on initial states; post-condition is relation on initial states, result values, and final states

  • the more complex the effect, the more complex the specs (and proofs)

Heap and ST operations (simplified)

module FStar.Heap

  val heap : Type
  val ref : Type -> Type

  val sel : #a:Type -> heap -> ref a -> Tot a
  val upd : #a:Type -> heap -> ref a -> a -> Tot heap

  val selUpdEq : #a:Type -> h:heap -> r:ref a -> v:a ->
        Lemma (sel (upd h r v) r  == v) [SMTPat (sel (upd h r v) r)]
                   
  val selUpdNeq : #a:Type -> h:heap -> r1:ref a -> r2:ref a -> v:a ->
        Lemma (r1 =!= r2 ==>
               sel (upd h r1 v) r2 == sel h r2) [SMTPat (sel (upd h r1 v) r2)]

module FStar.ST
  open FStar.Heap

  val (!): #a:Type -> r:ref a -> ST a
    (requires (fun (h:heap) -> True))
    (ensures (fun (h0:heap) (x:a) (h1:heap) -> h0 == h1 /\ x == sel h0 r))

  val (:=): #a:Type -> r:ref a -> v:a -> ST unit
    (requires (fun (h:heap) -> True))
    (ensures (fun (h0:heap) (x:a) (h1:heap) -> h1 == upd h0 r v))

Verifying incr (intuition)

module FStar.ST

  val (!) : #a:Type -> r:ref a -> ST a
    (requires (fun h0 -> True))
    (ensures (fun h0 x h1 -> h0 == h1 /\ x == sel h0 r))

  val (:=) : #a:Type -> r:ref a -> v:a -> ST unit
    (requires (fun h -> True))
    (ensures (fun h0 x h1 -> h1 == upd h0 r v))

val incr r:ref int -> ST unit (requires (fun h0 -> True))
            (ensures (fun h0 _ h2 -> exists h1 x. h0 == h1 /\ x == sel h0 r /\
                                                  h2 == upd h1 r (x + 1)))
let incr r = let x = !r in r := x + 1

val incr : r:ref int -> ST unit (requires (fun h0 -> True))
                           (ensures (fun h0 _ h2 -> sel h2 r = sel h0 r + 1))

sel (upd h0 r ((sel h0 r) + 1)) r = sel h0 r + 1

sel h0 r + 1 = sel h0 r + 1

Swapping two references

val swap_add_sub : r1:ref int -> r2:ref int -> St unit
let swap_add_sub r1 r2 =
  r1 := !r1 + !r2;
  r2 := !r1 - !r2;
  r1 := !r1 - !r2

let main =
  let r1 = alloc 1 in
  let r2 = alloc 2 in
  swap_add_sub r1 r2;
  print_string ("r1=" ^ string_of_int !r1 ^ "; " ^
                "r2=" ^ string_of_int !r2 ^ "\n")

...
r1=2; r2=1

Specifying reference swapping

val swap : r1:ref int -> r2:ref int -> ST unit
    (requires (fun h' -> True ))
    (ensures (fun h' _ h ->
                sel h r1 = sel h' r2 /\ sel h r2 = sel h' r1))
let swap r1 r2 =
  let t = !r1 in
  r1 := !r2;
  r2 := t

Hand proof sketch in code/03/SwapVerify.fst

Exercise: specify imperative factorial

val factorial_tot : nat -> Tot nat
let rec factorial_tot x = if x = 0 then 1 else x * factorial_tot (x - 1)

(* TODO: write a stronger ensures clause for factorial that proves
         it does the same thing as factorial_tot *)
val factorial : r1:ref nat -> r2:ref nat -> ST unit
      (requires (fun h' -> True))
      (ensures (fun h' a h -> True))
let rec factorial r1 r2 =
  let x1 = !r1 in
  if x1 = 0
  then r2 := 1
  else 
    (r1 := x1 - 1;
     factorial r1 r2;
     r2 := !r2 * x1)

Stateful invariants

  let r = alloc #nat 0 in
  r := 1;
  r := 2
(*   r := -2 -- expected type Prims.nat; got type Prims.int *)

Monotonic references, by example

let increases (n m:nat) : Type0 = n <= m

let incr (r:mref nat increases) : ST unit (requires (fun _ -> True))
                                          (ensures (fun _ _ h -> sel h r > 0))
  = r := !r + 1

(* let decr (r:mref nat increases) : St unit =  -- fails as it should
  r := (!r - 1) *)

assume val complex_procedure (r:mref nat increases) : St unit

let nonzero (n:nat) : Type0 = n > 0

let main() : St unit =
  let r = alloc increases 0 in
  incr r;
  witness r nonzero;
  complex_procedure r;
  let x = !r in
  (* assert (x > 0); -- fails as it should *)
  recall r nonzero;
  assert (x > 0)

Monotonic references interface (part 1)

type relation (a:Type) = a -> a -> Type0

type preorder (a:Type) = rel:relation a{(forall (x:a). rel x x)
    /\ (forall (x:a) (y:a) (z:a). (rel x y /\ rel y z) ==> rel x z)}

val alloc : #a:Type -> preorder a -> a -> ST (mref a rel) ...
val (:=) : #a:Type -> #rel:preorder a -> r:mref a rel -> v:a -> : ST unit
  (requires (fun h -> rel (sel h r) v))
  (ensures (fun h0 x h1 -> h1 == upd h0 r v))

Stable predicates, witness and recall (part 2)

type predicate (a:Type) = a -> Type0

let stable (#a:Type) (p:predicate a) (rel:preorder a) =
  forall (x:a) (y:a). (p x /\ rel x y) ==> p y

token : #a:Type -> #rel:preorder a -> mref a rel ->
            p:(a -> Type){stable p rel} -> Type

witness: #a:Type -> #rel:preorder a -> m:mref a rel -> p:(pred a){stable p rel}
                        -> ST unit (requires (fun h0 -> p (sel h0 m)))
                                   (ensures (fun h0 _ h1 -> h0==h1 /\ token m p))

recall: #a:Type -> #rel:preorder a -> m:mref a rel -> p:(pred a){stable p rel}
                    -> ST unit (requires (fun _ ->  token m p))
                               (ensures (fun h0 _ h1 -> h0==h1 /\ p (sel h1 m)))

Simple monotonic log

let subset' (#a:eqtype) (l1:list a) (l2:list a)
  = (forall x. x `mem` l1 ==> x `mem` l2)
let subset (#a:eqtype) : Tot (preorder (list a)) = subset'

let lref = mref (list int) subset

let add_to_log (r:lref) (v:int) : ST unit (requires (fun _ -> True))
                                     (ensures (fun _ _ h -> v `mem` (sel h r))) =
  r := (v :: !r)

assume val complex_procedure (r:lref) : St unit

let main() : St unit =
  let r = alloc (subset #int) [] in
  add_to_log r 42;
  witness r (fun xs -> 42 `mem` xs);
  assert (token r (fun xs -> 42 `mem` xs));
  complex_procedure r;
  assert (token r (fun xs -> 42 `mem` xs));
  recall r (fun xs -> 42 `mem` xs);
  let xs = !r in
  assert (42 `mem` xs)

Preorder for Initializing and Freezing references

type rstate (a:Type) =
  | Empty : rstate a
  | Mutable : v:a -> rstate a
  | Frozen : v:a -> rstate a

let evolve (a:Type) = fun r1 r2 ->
  match r1, r2 with
  | Empty, Mutable _
  | Mutable _, Mutable _ -> True
  | Mutable v1, Frozen v2 -> v1 == v2
  | _, _ -> False
(* let evolve (a:Type) : Tot (preorder (rstate a)) = evolve a *)

let evolve' (a:Type) = fun r1 r2 ->
  match r1, r2 with
  | Empty, _
  | Mutable _, Mutable _
  | Mutable _, Frozen _  -> True 
  | Frozen v1, Frozen v2 -> v1 == v2
  | _, _ -> False
let evolve (a:Type) : Tot (preorder (rstate a)) = evolve' a

Initializing and Freezing references

let alloc (a:Type) = alloc (evolve a) Empty
let read (#a:Type) (r:eref a) = match (!r) with | Mutable v | Frozen v -> v
let write (#a:Type) (r:eref a) (v:a) = r := Mutable v
let freeze (#a:Type) (r:eref a) = r := Frozen (Mutable?.v !r)

assume val complex_procedure (r:eref int) : St unit

let main() : St unit =
  let r = alloc int in
  (* ignore (read r) -- fails like it should *)
  write r 42;
  ignore (read r);
  write r 0;
  witness r (fun rs -> ~(Empty? rs));
  freeze r;
  (* write r 7; -- fails like it should *)
  ignore (read r);
  witness r (fun rs -> rs == Frozen 0);
  complex_procedure r;
  (* ignore (read r); -- fails like it should *)
  recall r (fun rs -> ~(Empty? rs));
  let x = read r in
  (* assert (x == 0) -- fails like it should *)
  recall r (fun rs -> rs == Frozen 0);
  assert (x == 0)

Giving specs to our new primitives

let eref (a:Type) : Type = mref (rstate a) (evolve a)

let alloc (a:Type) : ST (eref a) (requires (fun _ -> True))
                                 (ensures (fun _ r h -> Empty? (sel h r)))
  = alloc (evolve a) Empty

let read (#a:Type) (r:eref a) : ST a (requires (fun h -> ~(Empty? (sel h r))))
      (ensures (fun h v h' -> h == h' /\
                              (sel h r == Mutable v \/ sel h r == Frozen v)))
  = match (!r) with | Mutable v | Frozen v -> v

let write (#a:Type) (r:eref a) (v:a) :
      ST unit (requires (fun h -> ~(Frozen? (sel h r))))
              (ensures (fun _ _ h -> sel h r == Mutable v))
  = r := Mutable v

let freeze (#a:Type) (r:eref a) : ST ...
  = r := Frozen (Mutable?.v !r)

Verifying stateful programs

Variant #2: extrinsically (by monadic reification)

• Revealing pure effect representation

    STATE.reify (e : ST a pre post)
      : n0:nat -> Pure (a * nat) (requires (pre n0))
                                 (ensures (fun r -> post n0 (fst r) (snd r))

• Allows us to give weak specification to an effectful function

    let incr () : ST a (requires (fun _ -> True)) (ensures (fun _ _ _ -> True))
      = let n = STATE.get() in STATE.put (n + 1)

• … then prove lemmas about reification of effectful computation

    let incr_increases (s0:s) : Lemma (snd (ST.reify (incr()) s0) = s0 + 1) = ()

• reify only when the abstraction permits (e.g. ghost code)

Some dreams and ongoing work on F*

• Find best balance between automation and control

  • adding tactics à la Lean/Idris, using F* itself for meta-programming

• Fully work out metatheory of F*

  • formalizing monotonic state and F* to SMT encoding
  • longer term: semantic model; self-certify implementation

• Verify and deploy new, efficient HTTPS stack (Everest)

  • verified interoperability of F* (OCaml), Low* (C), and Vale (ASM)

• Opportunities brought in by extensible effect system

  • beyond ML effects: probabilities, concurrency, …
  • relational verification, e.g. for more flexible confidentiality proofs

F*: verification of effectful programs

• Functional programming language with effects

• Semi-automated verification system using SMT

• Interactive proof assistant based on dependent types

• Open source, code on GitHub

• Tutorial, papers, slides at fstar-lang.org

• PhD internships at Microsoft Research (Cambridge, Redmond, Bangalore); application in Dec 2017 - Jan 2018

• Next: Code-Based Cryptographic Verification in F* (Markulf)