aneris_examples.ccddb.code

From iris Require Import invariants.
From iris.proofmode Require Import tactics.
From iris.base_logic Require Export gen_heap.
From aneris.aneris_lang Require Import lang network notation tactics proofmode lifting.
From aneris.aneris_lang.lib Require Export dictionary lock network_helpers.
From aneris.aneris_lang.lib.vector_clock Require Export vector_clock.
From aneris.aneris_lang.lib.serialization Require Export serialization.
From aneris_examples.ccddb.spec Require Export base.

Section code.
  Context (val_ser val_deser : base_lang.val).
  (* We follow the following variable naming convention:

     - DB    : a reference to the local database
     - T     : a reference to the local time (vector clock)
     - m     : tuple (origin, key, value) where origin is the id of
                 the node that caused the event
     - msg   : tuple (origin, key, value, timestamp)
     - t, s  : timestamp (vector clock)
     - nodes : list of ips of other nodes
   *)

  Definition store_update : base_lang.val :=
    λ: "DB" "T" "m",
      let: "origin" := Snd "m" in
      let: "key" := Fst (Fst (Fst "m")) in
      let: "value" := Snd (Fst (Fst "m")) in
      "T" <- vect_inc !"T" "origin";;
      "DB" <- dict.insert "key" "value" !"DB".

  Definition store_test : base_lang.val :=
    λ: "t" "i",
    let: "l" := list_length "t" in
    λ: "w",
    let: "s" := Snd (Fst "w") in (* timestamp of event *)
    let: "j" := Snd "w" in (* origin *)
    if: "i" = "j" then
      #false
    else
      if: "j" < "l" then
        vect_applicable "s" "t" "j"
      else
        #false.

  Definition store_apply : base_lang.val :=
    λ: "DB" "T" "lock" "InQueue" "i",
    (rec: "apply" <> :=
       acquire "lock" ;;
       let: "x" := list_find_remove (store_test (!"T") "i") !"InQueue" in
       match: "x" with
         SOME "a" =>
           let: "msg" := Fst "a" in
           let: "rest" := Snd "a" in
           "InQueue" <- "rest";;
           store_update "DB" "T" "msg"
       | NONE => #()
       end;;
       release "lock";; "apply" #()) #().

  Definition write_event_ser : base_lang.val :=
    prod_ser (prod_ser (prod_ser string_ser val_ser) vect_serialize) int_ser.

  Definition write_event_deser : base_lang.val :=
    prod_deser
      (prod_deser (prod_deser string_deser val_deser) vect_deserialize)
      int_deser.

  Definition send_thread : base_lang.val :=
    λ: "i" "socket_handler" "lock" "nodes" "OutQueue",
    (rec: "out" <> :=
       acquire "lock" ;;
       let: "tmp" := !"OutQueue" in
       if: ~ (list_is_empty "tmp")
       then
         "OutQueue" <- list_tail "tmp";;
         release "lock";;
         let: "we" := unSOME (list_head "tmp") in
         let: "msg" := write_event_ser "we" in
         letrec: "send" "j" :=
           if: "j" < list_length "nodes" then
             if: "i" = "j" then
               "send" ("j" + #1)
             else
               let: "n" := unSOME (list_nth "nodes" "j") in
               SendTo "socket_handler" "msg" "n";;
               "send" ("j" + #1)
           else #()
         in
         "send" #0;;
         "out" #()
       else
         release "lock";;
         "out" #()) #().

  Definition recv_thread : base_lang.val :=
    λ: "socket_handler" "lock" "InQueue",
    (rec: "in" <> :=
       let: "msg" := Fst (listen_wait "socket_handler") in
       acquire "lock";;
       let: "we" := write_event_deser "msg" in
       "InQueue" <- list_cons "we" (!"InQueue");;
       release "lock";;
       "in" #()) #().

  Definition store_read : base_lang.val :=
    λ: "DB" "lock" "key",
      acquire "lock" ;;
      let: "r" := dict.lookup "key" !"DB" in
      release "lock";; "r".

  Definition store_write : base_lang.val :=
    λ: "DB" "T" "OutQueue" "lock" "i" "key" "value",
      acquire "lock" ;;
      "T" <- vect_inc !"T" "i";;
      "DB" <- dict.insert "key" "value" !"DB";;
      "OutQueue" <- list_cons ("key", "value", !"T", "i") (!"OutQueue");;
      release "lock".

  (* Node i with list of addresses addrlst *)
  Definition ccddb_init : base_lang.val :=
    λ: "addrlst" "i",
      let: "DB" := ref (dict.empty #()) in
      let: "N" := list_length "addrlst" in
      let: "T" := ref (vect_make "N" #0) in
      let: "InQueue" := ref (list_make #()) in
      let: "OutQueue" := ref (list_make #()) in
      let: "lock" := newlock #() in
      let: "socket_handler" := NewSocket #Network.PF_INET
                                 #Network.SOCK_DGRAM
                                 #Network.IPPROTO_UDP in
      let: "addr" := unSOME (list_nth "addrlst" "i") in
      SocketBind "socket_handler" "addr";;
      Fork (store_apply "DB" "T" "lock" "InQueue" "i");;
      Fork (send_thread "i" "socket_handler" "lock" "addrlst" "OutQueue");;
      Fork (recv_thread "socket_handler" "lock" "InQueue");;
      (store_read "DB" "lock", store_write "DB" "T" "OutQueue" "lock" "i").

End code.