Definition empty_on_path o p :=
    forall lvl, locate_node_in_tr o lvl p = None.Fixpoint diverge_at_level (p p' : path) (lvl : nat) :=
    match lvl with
    | 0%nat => False
    | S lvl' =>
      match p, p' with
      | [], [] => False
      | (true :: p_tail), (true :: p'_tail) =>
        diverge_at_level p_tail p'_tail lvl'
      | (false :: p_tail), (false :: p'_tail) =>
        diverge_at_level p_tail p'_tail lvl'
      | _, _ => True
      end
    end.(* off_path id v o p p' means that (id, v) lies on
      p' and not on p *)
  Definition off_path id v o p p' :=
    exists lvl,
      diverge_at_level p p' lvl /\
      match lookup_tree o lvl p' with
      | Some (Some bucket) => In (Block id v) bucket
      | _ => False
      end.

(* Specifications: *)
Lemma lookup_tree_lookup_path_oram_invert o : forall bkt p, In bkt (lookup_path_oram o p) -> exists lvl, lookup_tree o lvl p = Some (Some bkt).
Lemma empty_true data o1 o2 p : empty_on_path (node data o1 o2) (true :: p) -> empty_on_path o1 p.
Lemma empty_false data o1 o2 p : empty_on_path (node data o1 o2) (false :: p) -> empty_on_path o2 p.
Lemma off_path_true id v data o1 o2 p p' : off_path id v o1 p p' -> off_path id v (node data o1 o2) (true :: p) (true :: p').
Lemma off_path_false id v data o1 o2 p p' : off_path id v o2 p p' -> off_path id v (node data o1 o2) (false :: p) (false :: p').
Lemma empty_off_path id v o : forall p p', blk_in_p id v o p' -> empty_on_path o p -> off_path id v o p p'.
Lemma lookup_tree_update_tree_diverge {X} (o : tree X) : forall (lvl lvl' : nat) (p p' : path) (x : X), diverge_at_level p' p lvl -> lookup_tree (update_tree o lvl' x p') lvl p = lookup_tree o lvl p.
Lemma off_path_blocks_selection id v s p p' lvl : off_path id v (state_oram s) p p' -> off_path id v (state_oram (blocks_selection p lvl s)) p p'.
Lemma iterate_right_ind {X} (P : X -> Prop) (x : X) f p : P x -> (forall x n, P x -> P (f p n x)) -> forall steps start, P (iterate_right start p f steps x).
Lemma iterate_right_inversion {X} (P : X -> Prop) (x : X) f p : (forall x n, P (f p n x) -> P x) -> forall steps start, P (iterate_right start p f steps x) -> P x.
Lemma lookup_tree_lookup_path_oram o : forall bkt lvl p, lookup_tree o lvl p = Some (Some bkt) -> In bkt (lookup_path_oram o p).
Lemma off_path_blk_in_p id v o p p' : off_path id v o p p' -> blk_in_p id v o p'.
Lemma get_post_wb_st_state_state : forall (id : block_id) (v : nat) (s : state) (p : path), well_formed s -> length p = LOP -> empty_on_path (state_oram s) p -> blk_in_state id v s -> blk_in_state id v (get_post_wb_st s p).
Lemma up_oram_tr_inversion id v o : forall lvl delta p p', blk_in_p id v (up_oram_tr o lvl delta p) p' -> blk_in_p id v o p' \/ In (Block id v) delta.
Lemma distribute_via_get_post_wb_st_undef : forall (id : block_id) (s : state) (p : path), well_formed s -> length p = LOP -> empty_on_path (state_oram s) p -> undef id s -> undef id (get_post_wb_st s p).
Lemma NoDup_path_oram : forall o p, NoDup (List.map block_blockid (get_all_blks_tree o)) -> NoDup (List.map block_blockid (concat (lookup_path_oram o p))).
Lemma get_all_blks_tree_clear_path_weaken : forall o id p, In id (List.map block_blockid (get_all_blks_tree (clear_path o p))) -> In id (List.map block_blockid (get_all_blks_tree o)).
Lemma NoDup_clear_path : forall o p, NoDup (List.map block_blockid (get_all_blks_tree o)) -> NoDup (List.map block_blockid (get_all_blks_tree (clear_path o p))).
Lemma clear_path_p_b_tree : forall o n p, is_p_b_tr o n -> is_p_b_tr (clear_path o p) n.
Lemma on_path_not_off_path: forall o p id, NoDup (List.map block_blockid (get_all_blks_tree o)) -> In id (List.map block_blockid (concat (lookup_path_oram o p))) -> ~ In id (List.map block_blockid (get_all_blks_tree (clear_path o p))).
Lemma disjoint_list_dlt : forall o p h, disjoint_list (List.map block_blockid (get_all_blks_tree o)) (List.map block_blockid h) -> NoDup (List.map block_blockid (get_all_blks_tree o)) -> disjoint_list (List.map block_blockid (get_all_blks_tree (clear_path o p))) (List.map block_blockid (concat (lookup_path_oram o p) ++ h)).
Lemma disjoint_list_sub : forall {A} (l1 l2 l3: list A), (forall x, In x l1 -> In x l2) -> disjoint_list l2 l3 -> disjoint_list l1 l3.
Lemma lookup_off_path : forall o id p p', NoDup (List.map block_blockid (get_all_blks_tree o)) -> In id (List.map block_blockid (get_all_blks_tree (clear_path o p))) -> In id (List.map block_blockid (concat (lookup_path_oram o p'))) -> In id (List.map block_blockid (concat (lookup_path_oram (clear_path o p) p'))).
Lemma rd_op_wf : forall (id : block_id) (m : position_map) (h : stash) (o : oram) (p p_new : path), lookup_dict (makeBoolList false LOP) id m = p -> well_formed (State m h o) -> length p_new = LOP -> well_formed {| state_position_map := update_dict id p_new m; state_stash := (concat (lookup_path_oram o p) ++ h)%list; state_oram := clear_path o p |}.
Lemma not_in_removed : forall l id, ~ In id (List.map block_blockid (remove_list (fun blk : block => block_blockid blk =? id) l)).
Lemma NoDup_remove_list: forall l id, NoDup (List.map block_blockid l) -> NoDup (List.map block_blockid (remove_list (fun blk : block => block_blockid blk =? id) l)).
Lemma wr_op_wf : forall (id : block_id) (v : nat) (m : position_map) (h : stash) (o : oram) (p p_new : path), well_formed (State m h o) -> length p_new = LOP -> lookup_dict (makeBoolList false LOP) id m = p -> well_formed {| state_position_map := update_dict id p_new m; state_stash := {| block_blockid := id; block_payload := v |} :: remove_list (fun blk : block => block_blockid blk =? id) (concat (lookup_path_oram o p) ++ h); state_oram := clear_path o p |}.
Lemma get_pre_wb_st_wf : forall (id : block_id) (op : operation) (s : state) (p p_new : path), well_formed s -> length p_new = LOP -> lookup_dict (makeBoolList false LOP) id (state_position_map s) = p -> well_formed (get_pre_wb_st id op s p p_new).
Lemma get_post_wb_st_wf : forall (s : state) (p : path), well_formed s -> length p = LOP -> well_formed (get_post_wb_st s p).
Lemma zero_sum_stsh_tr_Wr (s : state) (id : block_id) (v : nat) (p p_new : path): well_formed s -> length p = LOP -> length p_new = LOP -> blk_in_state id v (get_post_wb_st (get_pre_wb_st id (Write v) s (calc_path id s) p_new) p).
Lemma zero_sum_stsh_tr_Rd_rev : forall (id : block_id) (v : nat) (s : state) (p p_new : path), well_formed s -> length p = LOP -> length p_new = LOP -> blk_in_state id v s -> blk_in_state id v (get_post_wb_st (get_pre_wb_st id Read s (calc_path id s) p_new) p).
Lemma locate_node_in_tr_clear_path o : forall p lvl, locate_node_in_tr (clear_path o p) lvl p = None.
Lemma read_access_state_state : forall (id id' : block_id) (v : nat) (s : state) (p_new : path), well_formed s -> length p_new = LOP -> blk_in_state id v s -> blk_in_state id v (get_post_wb_st (get_pre_wb_st id' Read s (calc_path id' s) p_new) (calc_path id' s)).
Lemma write_access_state_state : forall (id id' : block_id) (v v': nat) (s : state) (p_new : path), id <> id' -> well_formed s -> length p_new = LOP -> blk_in_state id v s -> blk_in_state id v (get_post_wb_st (get_pre_wb_st id' (Write v') s (calc_path id' s) p_new) (calc_path id' s)).
Lemma zero_sum_stsh_tr_Rd_rev_undef : forall (id id' : block_id) (s : state) (p_new : path), well_formed s -> length p_new = LOP -> undef id s -> undef id (get_post_wb_st (get_pre_wb_st id' Read s (calc_path id' s) p_new) (calc_path id' s)).
Lemma zero_sum_stsh_tr_Wr_rev_undef : forall (id id' : block_id) (v : nat) (s : state) (p_new : path), well_formed s -> id <> id' -> length p_new = LOP -> undef id' s -> undef id' (get_post_wb_st (get_pre_wb_st id (Write v) s (calc_path id s) p_new) (calc_path id s)).
Lemma lookup_ret_data_block_in_list (id : block_id) (v : nat) (l : list block) : NoDup (List.map block_blockid l) -> In (Block id v) l -> lookup_ret_data id l = v.
Lemma zero_sum_stsh_tr_Rd (id : block_id) (v : nat) (m : position_map) (h : stash) (o : oram) : well_formed (State m h o) -> blk_in_state id v (State m h o) -> get_ret_data id h (calc_path id (State m h o)) o = v.
Lemma read_access_just_wf (id : block_id) : state_plift well_formed well_formed (fun _ => True) (read_access id).
Lemma lookup_ret_data_0 k l : (forall v, ~ In {| block_blockid := k; block_payload := v |} l) -> lookup_ret_data k l = 0%nat.
Lemma get_ret_data_0 k s : well_formed s -> undef k s -> get_ret_data k (state_stash s) (lookup_dict (makeBoolList false LOP) k (state_position_map s)) (state_oram s) = 0%nat.
Lemma read_access_undef_0 k : state_plift (fun st => well_formed st /\ undef k st) well_formed (has_value 0) (read_access k).
Lemma read_access_wf (id : block_id)(v : nat) : state_plift (fun st => well_formed st /\ blk_in_state id v st) (fun st => well_formed st /\ blk_in_state id v st) (has_value v) (read_access id).
Lemma write_access_just_wf (id : block_id) (v : nat) : state_plift well_formed well_formed (fun _ => True) (write_access id v).
Lemma write_access_wf (id : block_id) (v : nat) : state_plift (fun st => well_formed st) (fun st => well_formed st /\ blk_in_state id v st) (fun _ => True) (write_access id v).
Lemma write_and_read_access_lift (id : block_id)(v : nat): state_plift (well_formed) well_formed (has_value v) (write_and_read_access id v).
Lemma read_access_state id v id' : state_plift (fun st => well_formed st /\ blk_in_state id v st) (fun st => well_formed st /\ blk_in_state id v st) (fun _ => True) (read_access id').
Lemma read_access_undef id id' : state_plift (fun s => well_formed s /\ undef id s) (fun s : state => well_formed s /\ undef id s) (fun _ => True) (read_access id').
Lemma write_access_undef id id' v : id <> id' -> state_plift (fun s : state => well_formed s /\ undef id' s) (fun s : state => well_formed s /\ undef id' s) (fun _ => True) (write_access id v).
Lemma extract_payload (id : block_id) (v : nat) (s : state) : plift (fun '(x, s') => has_value v x /\ well_formed s') (write_and_read_access id v s) -> get_payload (write_and_read_access id v s) = v.
Theorem PathORAM_simulates_RAM_idx_eq (i : block_id) (v : nat) (s : state) : well_formed s -> get_payload(write_and_read_access i v s) = v.
Lemma write_access_neq : forall i k v v', i <> k -> state_plift (fun s : state => well_formed s /\ blk_in_state i v' s) (fun st : state => well_formed st /\ blk_in_state i v' st) (fun _ => True) (write_access k v).
Lemma lookup_tree_lookup_path_oram_invert o : forall bkt p, In bkt (lookup_path_oram o p) -> exists lvl, lookup_tree o lvl p = Some (Some bkt).
Lemma empty_true data o1 o2 p : empty_on_path (node data o1 o2) (true :: p) -> empty_on_path o1 p.
Lemma empty_false data o1 o2 p : empty_on_path (node data o1 o2) (false :: p) -> empty_on_path o2 p.
Lemma off_path_true id v data o1 o2 p p' : off_path id v o1 p p' -> off_path id v (node data o1 o2) (true :: p) (true :: p').
Lemma off_path_false id v data o1 o2 p p' : off_path id v o2 p p' -> off_path id v (node data o1 o2) (false :: p) (false :: p').
Lemma empty_off_path id v o : forall p p', blk_in_p id v o p' -> empty_on_path o p -> off_path id v o p p'.
Lemma lookup_tree_update_tree_diverge {X} (o : tree X) : forall (lvl lvl' : nat) (p p' : path) (x : X), diverge_at_level p' p lvl -> lookup_tree (update_tree o lvl' x p') lvl p = lookup_tree o lvl p.
Lemma off_path_blocks_selection id v s p p' lvl : off_path id v (state_oram s) p p' -> off_path id v (state_oram (blocks_selection p lvl s)) p p'.
Lemma iterate_right_ind {X} (P : X -> Prop) (x : X) f p : P x -> (forall x n, P x -> P (f p n x)) -> forall steps start, P (iterate_right start p f steps x).
Lemma iterate_right_inversion {X} (P : X -> Prop) (x : X) f p : (forall x n, P (f p n x) -> P x) -> forall steps start, P (iterate_right start p f steps x) -> P x.
Lemma lookup_tree_lookup_path_oram o : forall bkt lvl p, lookup_tree o lvl p = Some (Some bkt) -> In bkt (lookup_path_oram o p).
Lemma off_path_blk_in_p id v o p p' : off_path id v o p p' -> blk_in_p id v o p'.
Lemma get_post_wb_st_state_state : forall (id : block_id) (v : nat) (s : state) (p : path), well_formed s -> length p = LOP -> empty_on_path (state_oram s) p -> blk_in_state id v s -> blk_in_state id v (get_post_wb_st s p).
Lemma up_oram_tr_inversion id v o : forall lvl delta p p', blk_in_p id v (up_oram_tr o lvl delta p) p' -> blk_in_p id v o p' \/ In (Block id v) delta.
Lemma distribute_via_get_post_wb_st_undef : forall (id : block_id) (s : state) (p : path), well_formed s -> length p = LOP -> empty_on_path (state_oram s) p -> undef id s -> undef id (get_post_wb_st s p).
Lemma NoDup_path_oram : forall o p, NoDup (List.map block_blockid (get_all_blks_tree o)) -> NoDup (List.map block_blockid (concat (lookup_path_oram o p))).
Lemma get_all_blks_tree_clear_path_weaken : forall o id p, In id (List.map block_blockid (get_all_blks_tree (clear_path o p))) -> In id (List.map block_blockid (get_all_blks_tree o)).
Lemma NoDup_clear_path : forall o p, NoDup (List.map block_blockid (get_all_blks_tree o)) -> NoDup (List.map block_blockid (get_all_blks_tree (clear_path o p))).
Lemma clear_path_p_b_tree : forall o n p, is_p_b_tr o n -> is_p_b_tr (clear_path o p) n.
Lemma on_path_not_off_path: forall o p id, NoDup (List.map block_blockid (get_all_blks_tree o)) -> In id (List.map block_blockid (concat (lookup_path_oram o p))) -> ~ In id (List.map block_blockid (get_all_blks_tree (clear_path o p))).
Lemma disjoint_list_dlt : forall o p h, disjoint_list (List.map block_blockid (get_all_blks_tree o)) (List.map block_blockid h) -> NoDup (List.map block_blockid (get_all_blks_tree o)) -> disjoint_list (List.map block_blockid (get_all_blks_tree (clear_path o p))) (List.map block_blockid (concat (lookup_path_oram o p) ++ h)).
Lemma disjoint_list_sub : forall {A} (l1 l2 l3: list A), (forall x, In x l1 -> In x l2) -> disjoint_list l2 l3 -> disjoint_list l1 l3.
Lemma lookup_off_path : forall o id p p', NoDup (List.map block_blockid (get_all_blks_tree o)) -> In id (List.map block_blockid (get_all_blks_tree (clear_path o p))) -> In id (List.map block_blockid (concat (lookup_path_oram o p'))) -> In id (List.map block_blockid (concat (lookup_path_oram (clear_path o p) p'))).
Lemma rd_op_wf : forall (id : block_id) (m : position_map) (h : stash) (o : oram) (p p_new : path), lookup_dict (makeBoolList false LOP) id m = p -> well_formed (State m h o) -> length p_new = LOP -> well_formed {| state_position_map := update_dict id p_new m; state_stash := (concat (lookup_path_oram o p) ++ h)%list; state_oram := clear_path o p |}.
Lemma not_in_removed : forall l id, ~ In id (List.map block_blockid (remove_list (fun blk : block => block_blockid blk =? id) l)).
Lemma NoDup_remove_list: forall l id, NoDup (List.map block_blockid l) -> NoDup (List.map block_blockid (remove_list (fun blk : block => block_blockid blk =? id) l)).
Lemma wr_op_wf : forall (id : block_id) (v : nat) (m : position_map) (h : stash) (o : oram) (p p_new : path), well_formed (State m h o) -> length p_new = LOP -> lookup_dict (makeBoolList false LOP) id m = p -> well_formed {| state_position_map := update_dict id p_new m; state_stash := {| block_blockid := id; block_payload := v |} :: remove_list (fun blk : block => block_blockid blk =? id) (concat (lookup_path_oram o p) ++ h); state_oram := clear_path o p |}.
Lemma get_pre_wb_st_wf : forall (id : block_id) (op : operation) (s : state) (p p_new : path), well_formed s -> length p_new = LOP -> lookup_dict (makeBoolList false LOP) id (state_position_map s) = p -> well_formed (get_pre_wb_st id op s p p_new).
Lemma get_post_wb_st_wf : forall (s : state) (p : path), well_formed s -> length p = LOP -> well_formed (get_post_wb_st s p).
Lemma zero_sum_stsh_tr_Wr (s : state) (id : block_id) (v : nat) (p p_new : path): well_formed s -> length p = LOP -> length p_new = LOP -> blk_in_state id v (get_post_wb_st (get_pre_wb_st id (Write v) s (calc_path id s) p_new) p).
Lemma zero_sum_stsh_tr_Rd_rev : forall (id : block_id) (v : nat) (s : state) (p p_new : path), well_formed s -> length p = LOP -> length p_new = LOP -> blk_in_state id v s -> blk_in_state id v (get_post_wb_st (get_pre_wb_st id Read s (calc_path id s) p_new) p).
Lemma locate_node_in_tr_clear_path o : forall p lvl, locate_node_in_tr (clear_path o p) lvl p = None.
Lemma read_access_state_state : forall (id id' : block_id) (v : nat) (s : state) (p_new : path), well_formed s -> length p_new = LOP -> blk_in_state id v s -> blk_in_state id v (get_post_wb_st (get_pre_wb_st id' Read s (calc_path id' s) p_new) (calc_path id' s)).
Lemma write_access_state_state : forall (id id' : block_id) (v v': nat) (s : state) (p_new : path), id <> id' -> well_formed s -> length p_new = LOP -> blk_in_state id v s -> blk_in_state id v (get_post_wb_st (get_pre_wb_st id' (Write v') s (calc_path id' s) p_new) (calc_path id' s)).
Lemma zero_sum_stsh_tr_Rd_rev_undef : forall (id id' : block_id) (s : state) (p_new : path), well_formed s -> length p_new = LOP -> undef id s -> undef id (get_post_wb_st (get_pre_wb_st id' Read s (calc_path id' s) p_new) (calc_path id' s)).
Lemma zero_sum_stsh_tr_Wr_rev_undef : forall (id id' : block_id) (v : nat) (s : state) (p_new : path), well_formed s -> id <> id' -> length p_new = LOP -> undef id' s -> undef id' (get_post_wb_st (get_pre_wb_st id (Write v) s (calc_path id s) p_new) (calc_path id s)).
Lemma lookup_ret_data_block_in_list (id : block_id) (v : nat) (l : list block) : NoDup (List.map block_blockid l) -> In (Block id v) l -> lookup_ret_data id l = v.
Lemma zero_sum_stsh_tr_Rd (id : block_id) (v : nat) (m : position_map) (h : stash) (o : oram) : well_formed (State m h o) -> blk_in_state id v (State m h o) -> get_ret_data id h (calc_path id (State m h o)) o = v.
Lemma read_access_just_wf (id : block_id) : state_plift well_formed well_formed (fun _ => True) (read_access id).
Lemma lookup_ret_data_0 k l : (forall v, ~ In {| block_blockid := k; block_payload := v |} l) -> lookup_ret_data k l = 0%nat.
Lemma get_ret_data_0 k s : well_formed s -> undef k s -> get_ret_data k (state_stash s) (lookup_dict (makeBoolList false LOP) k (state_position_map s)) (state_oram s) = 0%nat.
Lemma read_access_undef_0 k : state_plift (fun st => well_formed st /\ undef k st) well_formed (has_value 0) (read_access k).
Lemma read_access_wf (id : block_id)(v : nat) : state_plift (fun st => well_formed st /\ blk_in_state id v st) (fun st => well_formed st /\ blk_in_state id v st) (has_value v) (read_access id).
Lemma write_access_just_wf (id : block_id) (v : nat) : state_plift well_formed well_formed (fun _ => True) (write_access id v).
Lemma write_access_wf (id : block_id) (v : nat) : state_plift (fun st => well_formed st) (fun st => well_formed st /\ blk_in_state id v st) (fun _ => True) (write_access id v).
Lemma write_and_read_access_lift (id : block_id)(v : nat): state_plift (well_formed) well_formed (has_value v) (write_and_read_access id v).
Lemma read_access_state id v id' : state_plift (fun st => well_formed st /\ blk_in_state id v st) (fun st => well_formed st /\ blk_in_state id v st) (fun _ => True) (read_access id').
Lemma read_access_undef id id' : state_plift (fun s => well_formed s /\ undef id s) (fun s : state => well_formed s /\ undef id s) (fun _ => True) (read_access id').
Lemma write_access_undef id id' v : id <> id' -> state_plift (fun s : state => well_formed s /\ undef id' s) (fun s : state => well_formed s /\ undef id' s) (fun _ => True) (write_access id v).
Lemma extract_payload (id : block_id) (v : nat) (s : state) : plift (fun '(x, s') => has_value v x /\ well_formed s') (write_and_read_access id v s) -> get_payload (write_and_read_access id v s) = v.
Theorem PathORAM_simulates_RAM_idx_eq (i : block_id) (v : nat) (s : state) : well_formed s -> get_payload(write_and_read_access i v s) = v.
Lemma write_access_neq : forall i k v v', i <> k -> state_plift (fun s : state => well_formed s /\ blk_in_state i v' s) (fun st : state => well_formed st /\ blk_in_state i v' st) (fun _ => True) (write_access k v).