dune_alea.lov.ml

#love

(* Type Definitions *)

(* giving a name to block levels to ease reading *)
type date = nat                 (* block level *)
type denounced = bool           (* whether the absence of something has been denounced *)


(* Types around prophecies and slots *)

(* type for indices of slots *)
type slot_index = int
(* the type of answers of the oracle *)
type answer = nat
(* the type of client-chosen query ids *)
type query_id = nat
(* a slot is identified by the address that booked it and the qid *)
type slot = address * query_id * date * denounced
(* Type of map from query ids to addresses and slots *)
type query_map = (query_id, (address * slot_index) list) bigmap
(* Type of the map reserved prophecies: Prophecy of index i is mapped
   to its slot  (=address,query_id) *)
type res_prophecies = (slot_index, slot) bigmap
(* Type of the map revealed prophecies: Prophecy of index i is mapped
   to its revealed oracle prophecy of type asnwer (=nat) *)
type rev_prophecies = (slot_index, answer) bigmap

(* Types around commitments and nonces *)

(* type for indices of commitments *)
type comm_index = int
type opt_gcable = nat option
type commitment = bytes * opt_gcable * date * denounced
type commitments = (comm_index, commitment) bigmap

(* Parameters set by the owner at origination *)

type params = {
  owners : address set;           (* list of accepted oracle addresses *)
  nb_prophecies_per_commit : nat; (* # of prophecies per oracle commitment *)
  nonces_safety_limit : nat;      (* max # nonces committed without reveal *)
  gc_protection_window : nat; (* in minutes, eg 24p *+ 60p = 1 day, if 1 block/60 *)
  min_safety_deposit_per_reservation : dun; (* insurance for each request *)
  reservation_cost : dun;                   (* cost of reserving a slot *)
  (* the next two in minutes = blocks *)
  prophecy_reveal_delay : nat;  (* delay to reveal a reserved prophecy *)
  nonce_reveal_delay : nat; (* delay to reveal a reserved nonce *)
}


type storage = {
  authorized : (address, unit) bigmap; (* list of authorized "client" dapps *)
  commitments : commitments;           (* list of oracle commitments *)
  reserved_prophecies : res_prophecies; (* reservations of client users/dapps *)
  revealed_prophecies : rev_prophecies; (* non-gced revealed prophecies *)
  inv_queries : query_map;              (* map for lookup of client queries *)

  last_inserted_commit : comm_index;
  last_revealed_commit : comm_index; (* last revealed commit = last_revealed nonce *)

  last_GCed_commit : comm_index;

  last_reserved_prophecy : slot_index;
  last_revealed_prophecy : slot_index;
  terminated : bool;            (* once terminated the contract is unusable *)
  min_safety_deposit : dun;     (* total bond computed from "insurance" *)
  params : params;
}

(* --- auxiliary functions --- *)

(* initial storage *)
val%init storage (params : params) = {
  authorized = BigMap.empty [:address] [:unit];
  commitments = BigMap.empty [:int] [:commitment];
  reserved_prophecies = BigMap.empty [:int] [:slot];
  revealed_prophecies = BigMap.empty [:int] [:nat];
  inv_queries = BigMap.empty [:query_id] [:(address * int) list];
  last_inserted_commit = -1;
  last_revealed_commit = -1;
  last_GCed_commit = -1;
  last_revealed_prophecy = -1;
  last_reserved_prophecy = -1;
  terminated = false;
  (* Below the bond is computed as the maximum amount of "insurance"
     to be paid to users of the contract should the obligation to provide
     random numbers in time not be fulfilled *)
  min_safety_deposit = (2p *+ params.nb_prophecies_per_commit *+
    params.nonces_safety_limit) *+$
    params.min_safety_deposit_per_reservation;
  params;
}

(* Checkers when entering functions *)

val check_not_terminated (storage : storage) : unit =
  if storage.terminated then
    failwith [:string] ("Cannot call a terminated contract") [:unit]

(* check that the sender is one of the oracles owning the contract *)
val check_is_owner (storage : storage) : unit =
  if not (Set.mem [:address] (Current.sender ()) storage.params.owners) then
    failwith [:string * address] ("Sender not owner", Current.sender ()) [:unit]

(* check that the sender is one of the authorized dapps or users *)
val check_is_authorized (storage : storage) : unit =
  if not (BigMap.mem [:address] [:unit] (Current.sender()) storage.authorized) then
    failwith [:string * address] ("Sender not autorized", Current.sender ()) [:unit]

val check_sufficient_deposit (storage : storage) (d : dun) : unit =
  if d < [:dun] storage.min_safety_deposit then
    failwith [:string * dun * dun]
      ("Contract balance is/will be below min_safety_deposit. ", d, storage.min_safety_deposit)
      [:unit]

val check_sufficient_cost (params : params) : unit =
  if Current.amount () < [:dun] params.reservation_cost then
    failwith [:string * dun * dun]
      ("Amount is lower than min reservation cost ",
       Current.amount (),
       params.reservation_cost) [:unit]

(* A view useful for the oracle to reveal the next nonce of index index *)
val%view ready_to_reveal_nonce (storage : storage) (index : int) : bool =
  storage.last_revealed_prophecy >=[:int]
    ((index + 1) *!+ storage.params.nb_prophecies_per_commit) - 1

(* helper function for reverse lookup of slot from query id *)
val rec get_slot_aux
    (l:(address * int) list) (addr : address option) (qid : query_id) :
  int option =
  match l with
  | [] -> None [:int]
  | (addr_i,i)::l ->
    begin
      match addr with
      | Some addr_ ->
        if addr_i=[:address]addr_ then Some i [:int] else
          get_slot_aux l addr qid
      | None -> Some i [:int]
    end

(* a view to get the answer from storage once it has been provided
   by the oracle; useful for client dapps *)
val%view get_answer (storage : storage) ((qid,addr) : query_id * address option) : nat option =
  match BigMap.find [:query_id] [:(address * int) list] qid storage.inv_queries with
  | None -> failwith [:string * (address option) * query_id] ("Error: qid does not exist for (addr,qid)",addr,qid) [:nat option]
  | Some l ->
    begin
      match get_slot_aux l addr qid with
      | Some i ->
        begin
          match BigMap.find [:int] [:nat] i storage.revealed_prophecies with
          | None ->
            (* failwith [:string * int * address * query_id] ("No answer yet for (slot,addr,qid)", j,addr,qid) *)
              None [: nat]
          | Some p -> Some p [:nat]
        end
    end

(* Update the list of authorized clients (dapps or users) of the contract *)
val%entry updateAuthorized storage _d (a : address) =
  check_is_owner storage;
  check_not_terminated storage;
  (* check only done in insert and reveal commits
     check_sufficient_deposit storage.params (Current.balance()); *)
  let auth = storage.authorized in
  [][:operation],
  { storage with
   authorized =
     if BigMap.mem [:address] [:unit] a auth then
       BigMap.remove [:address] [:unit] a auth
     else
       BigMap.add [:address] [:unit] a () auth
  }

(* entrypoint for reserving a slot. Query id is provided by the client dapp,
   which is expected to do its own bookkeeping relative to its queries.
   A fee must be paid whose amount is defined in params *)
val%entry reserve storage _d (qid : query_id) =
  check_not_terminated storage;
  check_is_authorized storage;
  check_sufficient_cost storage.params;
  let rp = storage.last_reserved_prophecy + 1 in
  if BigMap.mem [:int] [:nat] rp storage.revealed_prophecies then
    failwith [:string * int]
      ("invariant broken: prophecy to reserve already revealed", rp) [:unit];
  (* if lic = -1, max_r = -1. if lic = 0, max_r = 9 *)
  let max_reservable = (storage.last_inserted_commit+1) *!+ storage.params.nb_prophecies_per_commit - 1 in
  if (rp >[:int] max_reservable) then
    failwith [:string * int * int]
      ("there is no commited prophecy to reserve. (your slot, max_reservable) = ",
       rp, max_reservable) [:unit];
  let reserved_prophecies = storage.reserved_prophecies in
  let queries =
    match BigMap.find [:query_id] [:(address * int) list] qid storage.inv_queries with
    | None -> [] [:address * int]
    | Some queries -> queries in
  [][:operation],
  { storage with
    last_reserved_prophecy = rp;
    reserved_prophecies =
      BigMap.add [:int] [:slot] rp
        (Current.sender(),qid, Current.level (), false) reserved_prophecies;
    inv_queries =
      BigMap.add [:query_id] [:(address * int) list] qid
        ((Current.sender(),rp)::queries) storage.inv_queries;
  }

(* entrypoint for the oracle to insert a list of commitments,
   each bound to a nonce and a series of fresh random numbers  *)
val%entry insertCommitments storage d (cl : bytes list) =
  check_is_owner storage;
  check_not_terminated storage;
  (* We check that the contract has sufficient deposit before inserting new commitments *)
  check_sufficient_deposit storage (Current.balance());
  let cur_level = Current.level () in
  let commitments, last_inserted_commit =
    List.fold [:bytes] [:commitments * int]
      begin
        fun (c : bytes) ((commitments, last_inserted_commit) : commitments * int) ->
          let last_inserted_commit = last_inserted_commit + 1 in
          BigMap.add [:int] [:commitment]
            last_inserted_commit (c, None [:nat], cur_level,false) commitments,
          last_inserted_commit
      end
      cl
      (storage.commitments, storage.last_inserted_commit)
  in
  let nb_unrevealed_commits = last_inserted_commit - storage.last_revealed_commit in
  if nb_unrevealed_commits > [:int] (Int.of_nat storage.params.nonces_safety_limit) then
    failwith [:string * int * int * nat]
      ("Cannot insert too many unrevealed commits. (last_inserted_commit, last_revealed_commit, nonces_safety_limit) = ",
       storage.last_inserted_commit, storage.last_revealed_commit, storage.params.nonces_safety_limit) [:unit];
  [] [:operation], { storage with commitments; last_inserted_commit}

(* entrypoint for an oracle to reveal prophecies it has committed to. There is
   no question of nonces or commitments here, only answers to queries. *)
val%entry revealProphecies storage d (pl : nat list) =
  check_is_owner storage;
  check_not_terminated storage;
  (* We check that the contract has sufficient deposit before revealing prophecies *)
  check_sufficient_deposit storage (Current.balance());
  (* let reserved_prophecies = storage.reserved_prophecies in *)
  let revealed_prophecies, last_revealed_prophecy,reserved_prophecies =
    List.fold [:nat] [:rev_prophecies * int * res_prophecies]
      begin
        fun (pr : nat) ((rev_prophecies, last_revealed_prophecy, res_prophecies) :
                          rev_prophecies * int * res_prophecies) ->
          let last_revealed_prophecy = last_revealed_prophecy + 1 in
          match BigMap.find [:int] [:slot]
                  last_revealed_prophecy res_prophecies with
          | None ->
            (* We should selft-reserve this slot if this happens to prevent
               reuse of revealed (but un-reserved) prophecy *)
            failwith [:string * int] ("revealing non reserved prophecy", last_revealed_prophecy)
              [:rev_prophecies * int * res_prophecies]

          | Some (a,b,c,d) (* (sender,qid,level,denounced) *) ->
            BigMap.add [:int] [:nat] last_revealed_prophecy pr rev_prophecies,
            last_revealed_prophecy,
            BigMap.add [:int] [:slot] last_revealed_prophecy (a,b,c,false) res_prophecies
      end
      pl
      (storage.revealed_prophecies, storage.last_revealed_prophecy, storage.reserved_prophecies)
  in
  [] [:operation],
  { storage with
    revealed_prophecies; last_revealed_prophecy;reserved_prophecies }

(* helper functions to obtain a list of already revealed prophecies
   for indices k with i <= k <= j  *)
val rec fetch_corresponding_prophecies (i : slot_index) (j : slot_index)
    (map : rev_prophecies) (acc : answer list)  : answer list =
  if i >[:int] j then acc
  else
    match BigMap.find [:slot_index] [:answer] j map with
    | None ->
      failwith [:string * slot_index]
        ("Cannot reveal nonce of unrevealed prophecy of slot index j=", j)
        [: nat list]
    | Some p ->
      fetch_corresponding_prophecies i (j - 1) map (p :: acc)

(* When a revealed nonce does not match revealed prophecies,
   we simply reject the transaction. If the oracle is unable
   to produce a matching nonce, it will become punishable by
   the denouce_* methods *)
val punish (storage: storage) (i : int) (j : int) (c : bytes) (c2 : bytes) (nonce : nat) : storage =
  failwith [: string * bytes * nat * bytes * int * int]
    ("revelation does not match commitment. (commit, nonce, computed commit, proph start, proph end) =",
     c, nonce, c2, i, j) [:storage]

(* Function to compute the hash of a (nonce, answer list) combo.
   This function is isolated in order to be callable off-chain,
   for example by the oracle *)
val pack_and_hash (nonce : nat) (l : answer list) : bytes =
  Crypto.sha256 (Bytes.pack [:nat * answer list] (nonce, l))

(* Reveal nonces from last_revealed and increasing *)
val rec doRevealNonces (nl : nat list) (storage: storage) : storage =
  match nl with
  | [] ->
    storage
  | nonce :: nl ->
    let storage =
      let i = (storage.last_revealed_commit+1) *!+ storage.params.nb_prophecies_per_commit in
      let j = i +!+ storage.params.nb_prophecies_per_commit - 1 in

      let l =
        fetch_corresponding_prophecies i j storage.revealed_prophecies ([] [:nat])
      in

      let last_revealed_commit = storage.last_revealed_commit + 1 in
      match BigMap.find [:int] [:commitment] last_revealed_commit storage.commitments with
      | None ->
        failwith [:string * int]("cannot reveal of unrevealed commitment", last_revealed_commit)
          [: storage]
      | Some (c, Some _,_,_) ->
        failwith [:string * int]
          ("invariant: unrevealed commit should not have a timestamp", last_revealed_commit)
          [: storage]

      | Some (c, None,level,denounced) ->
        let c2 = pack_and_hash nonce l in
        if c <>[:bytes] c2 then
          punish storage i j c c2 nonce
        else
          let gc_lvl = storage.params.gc_protection_window ++ Current.level () in
          { storage with
            last_revealed_commit;
            commitments =
              BigMap.add [:int] [:commitment]
                last_revealed_commit
                (c, (Some gc_lvl [:nat]),level,false) storage.commitments (* undenouncing *)
          }
    in
    doRevealNonces nl storage

(* Helper function for the gc to remove inverse lookup entries *)
val remove_slot_inv_queries
    (inv_queries : query_map)
    (reserved_prophecies : res_prophecies)
    (i : int) : query_map =
      match
        BigMap.find [:int] [:slot] i reserved_prophecies with
          | None ->
            failwith [:string * int] ("attempting to remove non-reserved prophecy", i) [:query_map]
          | Some (_,qid,_,_) ->
            match BigMap.find
                    [:query_id] [:(address * int) list] qid inv_queries with
            | None -> failwith [:string * int] ("there should be a query here for index:",i) [:query_map]
            | Some queries ->
              let new_queries =
                begin
                  List.fold [:address*int] [:(address*int) list]
                    begin
                      fun ((addr,j) : address*int) (acc : (address*int) list) ->
                        if i=[:int]j then acc else (addr,j)::acc
                    end
                    queries
                    ([] [:(address*int)])
                end in
              match new_queries with
              | [] -> BigMap.remove [:query_id] [:(address * int) list] qid inv_queries
              | new_queries ->
                BigMap.add [:query_id] [:(address * int) list] qid
                  new_queries
                  inv_queries

(* GC of old prophecies *)
val rec doGC (storage : storage) : storage =
  let last_GCed_commit = storage.last_GCed_commit + 1 in
  match BigMap.find [:int] [:commitment] last_GCed_commit storage.commitments with
  | None ->
    storage

  | Some (_, None,_,_) ->
    storage

  | Some (_, Some gc_lvl,_,_) ->
    if gc_lvl >[:nat] Current.level () then storage
    else
      let commitments =
        BigMap.remove [:int] [:commitment]
          last_GCed_commit storage.commitments
      in
      let i = last_GCed_commit *!+ storage.params.nb_prophecies_per_commit in
      let j = i +!+ storage.params.nb_prophecies_per_commit - 1 in
      let _, reserved_prophecies, inv_queries =
        Loop.loop [:int *
                    (int, slot) bigmap *
                    (query_id, (address * int) list) bigmap]
          (fun
            ((i, reserved_prophecies,inv_queries) :
               (int *
                (int, slot) bigmap *
                (query_id,(address * int) list) bigmap)) ->
            (i <[:int] j,
             (i + 1,
              BigMap.remove [:int] [:slot] i reserved_prophecies,
              remove_slot_inv_queries inv_queries reserved_prophecies i))
          ) (i, storage.reserved_prophecies,storage.inv_queries)
      in
      let _, revealed_prophecies =
        Loop.loop [:int * rev_prophecies]
          (fun ((i, revealed_prophecies) : (int * rev_prophecies)) ->

             (i <[:int] j, (i + 1, BigMap.remove [:int] [:nat] i revealed_prophecies))
          ) (i, storage.revealed_prophecies)
      in
      {storage with
       last_GCed_commit;
       commitments;
       reserved_prophecies;
       revealed_prophecies;
       inv_queries
      }

(* entrypoint for the oracle to reveal nonces *)
val%entry revealNonces storage d (nl : nat list) =
  check_is_owner storage;
  check_not_terminated storage;
  (* We check that the contract has sufficient deposit before revealing nonces *)
  check_sufficient_deposit storage (Current.balance());
  [] [:operation], doRevealNonces nl storage

(* entrypoint for anyone to trigger gc of old enough history *)
val%entry gc storage d (_ : unit) =
  check_not_terminated storage;
  let old_gced_commit = storage.last_GCed_commit in
  let storage = doGC storage in
  if old_gced_commit = [:int] storage.last_GCed_commit then
    failwith [:string] "GC collected nothing!" [:unit];
  [][:operation], storage

(* entrypoint to add an owner (i.e. oracle) to the contract *)
val%entry updateOwners storage d (o : address) =
  check_is_owner storage;
  check_not_terminated storage;
  (* check only done in insert and reveal commits
     check_sufficient_deposit storage.params (Current.balance()); *)
  let owners = storage.params.owners in
  let owners =
    if Set.mem [:address] o owners then Set.remove [:address] o owners
    else Set.add [:address] o owners
  in
  if Set.cardinal [:address] owners =[:nat] 0p then
    failwith [:string * address]
      ("cannot remove the unique owner of the contract. ", o) [:unit];
  [][:operation], { storage with params = { storage.params with owners } }

(* entrypoint for an oracle to withdraw their deposit, provided
   they leave enough of a security deposit *)
val%entry withdraw storage d ((amount, dest) : dun * address) =
  check_not_terminated storage;
  check_is_owner storage;
  let new_balance = Current.balance () -$ amount in
  match new_balance with
  | None ->
    failwith [:string * dun * dun]
      ("Amount is greater than current balance", amount, Current.balance())
      [: operation list * storage]
  | Some new_balance ->
    check_sufficient_deposit storage new_balance;
    [Account.transfer dest amount] [:operation], storage

(* entrypoint for the oracle to deposit towards the security bond *)
val%entry deposit storage d (_ : unit) =
  check_not_terminated storage;
  [][:operation], storage

(* entrypoint to terminate the contract provided all revelations
   have been done. *)
val%entry terminate storage d (_ : unit) =
  check_is_owner storage;
  check_not_terminated storage;
  if storage.last_inserted_commit >[:int] storage.last_revealed_commit then
    failwith [:string] "Cannot terminate a contract with pending revelations" [:unit];
  [Account.transfer (Current.sender()) (Current.balance())] [:operation],
  {storage with terminated = true}

(* Helper functions for denouncing the oracle *)

val is_revealed_prophecy_index (storage : storage) (i : slot_index) : bool =
  storage.last_revealed_prophecy >=[:int] i

val is_revealed_nonce_index (storage : storage) (i : comm_index) : bool =
  storage.last_revealed_commit >=[:int] i

val get_level_of_prophecy (storage : storage) (i : slot_index) : date =
  match BigMap.find [:slot_index] [:slot] i storage.reserved_prophecies with
  | None ->
    failwith [:string*slot_index] ("No such prophecy at index:",i) [:date]
  | Some (_addr,_qid,date,_denounced) ->
    date

val is_overdue_date (d : date)  (delay : nat) : bool =
  d ++ delay <[:nat] Current.level ()

val not_already_denounced_prophecy (storage : storage) (i : slot_index) : bool =
  match BigMap.find [:slot_index] [:slot] i storage.reserved_prophecies with
    | None -> true
    | Some (_,_,_,denounced) -> not denounced

val not_already_denounced_comm (storage : storage) (i : comm_index) : bool =
  match BigMap.find [:comm_index] [:commitment] i storage.commitments with
    | None -> true
    | Some (_,_,_,denounced) -> not denounced

val is_punishable_prophecy_by_index (storage : storage) (i : slot_index) : bool =
  (not (is_revealed_prophecy_index storage i)) &&
  begin
    let date = get_level_of_prophecy storage i in
    is_overdue_date date storage.params.prophecy_reveal_delay
  end &&
  not_already_denounced_prophecy storage i

val is_punishable_comm_by_index (storage : storage) (i : comm_index) : bool =
  not (is_revealed_nonce_index storage i) &&
  begin
    (* i = 0, nb = 10 -> last_reservation = 9 *)
    let last_reservation = (i+1) *!+ storage.params.nb_prophecies_per_commit - 1 in
    let date = get_level_of_prophecy storage last_reservation in
    is_overdue_date date storage.params.nonce_reveal_delay
  end &&
  not_already_denounced_comm storage i

(* Denunciation functions, callable by anyone.
   They fail if conditions are not met. *)

(* denouncing is only done relative to time, since it is impossible to
   reveal an incorrect nonce by design: if a prophecy is incorrect, this
   is discovered after the oracle has failed to provide a correct nonce
   relative to its previous commitment. *)
val%entry denounce_prophecy storage d (i : slot_index) =
  if not (is_punishable_prophecy_by_index storage i) then
    failwith
      [:string * int] ("Conditions are not met to denounce prophecy", i)
      [:unit];
  let reserved_prophecies =
    match BigMap.find [:slot_index] [:slot] i storage.reserved_prophecies with
    | None ->
      failwith [:string * int] ("No existing reserved prophecy to denounce at index",i) [:res_prophecies]
    | Some (a,b,c,d) ->
      BigMap.add [:slot_index] [:slot] i (a,b,c,true)
        storage.reserved_prophecies in
  ([Account.transfer (Current.sender ()) storage.params.min_safety_deposit_per_reservation] [:operation],
   {storage with reserved_prophecies
   })

val get_all_senders (storage : storage) (c_i : comm_index) : address list =
  let i = c_i *!+ storage.params.nb_prophecies_per_commit in
  let j = i +!+ storage.params.nb_prophecies_per_commit - 1 in
  let _, sender_list =
        Loop.loop [:int *
                    address list]
          (fun
            ((i, sender_list) :
               (int *
                address list)) ->
            (i <[:int] j,
             (i + 1,
              match BigMap.find [:comm_index] [:slot] i storage.reserved_prophecies with
              | None -> sender_list
              | Some (a,_,_,_) -> a::sender_list))
          ) (i, [] [:address]) in
  sender_list

(* entrypoint for anyone to denounce the absence of revelation
   of a nonce corresponding to commitment of index i *)
val%entry denounce_comm storage d (i : comm_index) =
  if not (is_punishable_comm_by_index storage i) then
    failwith
      [:string * int] ("Conditions are not met to denounce commitment", i)
      [:unit];
  let amount = storage.params.min_safety_deposit_per_reservation *$+
           storage.params.nb_prophecies_per_commit in
  let commitments =
    match BigMap.find [:comm_index] [:commitment] i storage.commitments with
    | None ->
      failwith [:string * int] ("No existing reserved prophecy to denounce at index",i) [:commitments]
    | Some (a,b,c,d) ->
      if d then failwith [:string * int] ("Commitment already denounced at index",i) [:commitments]
      else
      BigMap.add [:comm_index] [:commitment] i (a,b,c,true) storage.commitments in
  let ops = List.fold [:address] [:operation list]
      begin
        fun (a : address) (accu : operation list) ->
          let op = Account.transfer a amount in
          (op::accu)
      end (get_all_senders storage i)  ([] [:operation])
 (* [Account.transfer (Current.sender ()) amount] [:operation] *) in
  (ops,
   {storage with commitments
   })

val%entry delegate storage d (pkh_opt:keyhash option) =
  check_is_owner storage;
  [Contract.set_delegate pkh_opt][:operation], storage