ligo/vendors/ligo-utils/tezos-protocol-alpha/contract_repr.ml

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t =
  | Implicit of Signature.Public_key_hash.t
  | Originated of Contract_hash.t

include Compare.Make(struct
    type nonrec t = t
    let compare l1 l2 =
      match l1, l2 with
      | Implicit pkh1, Implicit pkh2 ->
          Signature.Public_key_hash.compare pkh1 pkh2
      | Originated h1, Originated h2 ->
          Contract_hash.compare h1 h2
      | Implicit _, Originated _ -> -1
      | Originated _, Implicit _ -> 1
  end)

type contract = t

type error += Invalid_contract_notation of string (* `Permanent *)

let to_b58check = function
  | Implicit pbk -> Signature.Public_key_hash.to_b58check pbk
  | Originated h -> Contract_hash.to_b58check h

let of_b58check s =
  match Base58.decode s with
  | Some (Ed25519.Public_key_hash.Data h) -> ok (Implicit (Signature.Ed25519 h))
  | Some (Secp256k1.Public_key_hash.Data h) -> ok (Implicit (Signature.Secp256k1 h))
  | Some (P256.Public_key_hash.Data h) -> ok (Implicit (Signature.P256 h))
  | Some (Contract_hash.Data h) -> ok (Originated h)
  | _ -> error (Invalid_contract_notation s)

let pp ppf = function
  | Implicit pbk -> Signature.Public_key_hash.pp ppf pbk
  | Originated h -> Contract_hash.pp ppf h

let pp_short ppf = function
  | Implicit pbk -> Signature.Public_key_hash.pp_short ppf pbk
  | Originated h -> Contract_hash.pp_short ppf h

let encoding =
  let open Data_encoding in
  def "contract_id"
    ~title:
      "A contract handle"
    ~description:
      "A contract notation as given to an RPC or inside scripts. \
       Can be a base58 implicit contract hash \
       or a base58 originated contract hash." @@
  splitted
    ~binary:
      (union ~tag_size:`Uint8 [
          case (Tag 0)
            ~title:"Implicit"
            Signature.Public_key_hash.encoding
            (function Implicit k -> Some k | _ -> None)
            (fun k -> Implicit k) ;
          case (Tag 1) (Fixed.add_padding Contract_hash.encoding 1)
            ~title:"Originated"
            (function Originated k -> Some k | _ -> None)
            (fun k -> Originated k) ;
        ])
    ~json:
      (conv
         to_b58check
         (fun s ->
            match of_b58check s with
            | Ok s -> s
            | Error _ -> Json.cannot_destruct "Invalid contract notation.")
         string)

let () =
  let open Data_encoding in
  register_error_kind
    `Permanent
    ~id:"contract.invalid_contract_notation"
    ~title: "Invalid contract notation"
    ~pp: (fun ppf x -> Format.fprintf ppf "Invalid contract notation %S" x)
    ~description:
      "A malformed contract notation was given to an RPC or in a script."
    (obj1 (req "notation" string))
    (function Invalid_contract_notation loc -> Some loc | _ -> None)
    (fun loc -> Invalid_contract_notation loc)

let implicit_contract id = Implicit id

let originated_contract_004 id = Originated id

let is_implicit = function
  | Implicit m -> Some m
  | Originated _ -> None

let is_originated = function
  | Implicit _ -> None
  | Originated h -> Some h

type origination_nonce =
  { operation_hash: Operation_hash.t ;
    origination_index: int32 }

let origination_nonce_encoding =
  let open Data_encoding in
  conv
    (fun { operation_hash ; origination_index } ->
       (operation_hash, origination_index))
    (fun (operation_hash, origination_index) ->
       { operation_hash ; origination_index }) @@
  obj2
    (req "operation" Operation_hash.encoding)
    (dft "index" int32 0l)

let originated_contract nonce =
  let data =
    Data_encoding.Binary.to_bytes_exn origination_nonce_encoding nonce in
  Originated (Contract_hash.hash_bytes [data])

let originated_contracts
    ~since: { origination_index = first ; operation_hash = first_hash }
    ~until: ({ origination_index = last ; operation_hash = last_hash } as origination_nonce) =
  assert (Operation_hash.equal first_hash last_hash) ;
  let rec contracts acc origination_index =
    if Compare.Int32.(origination_index < first) then
      acc
    else
      let origination_nonce =
        { origination_nonce with origination_index } in
      let acc = originated_contract origination_nonce :: acc in
      contracts acc (Int32.pred origination_index) in
  contracts [] (Int32.pred last)

let initial_origination_nonce operation_hash =
  { operation_hash ; origination_index = 0l }

let incr_origination_nonce nonce =
  let origination_index = Int32.succ nonce.origination_index in
  { nonce with origination_index }

let rpc_arg =
  let construct = to_b58check in
  let destruct hash =
    match of_b58check hash with
    | Error _ -> Error "Cannot parse contract id"
    | Ok contract -> Ok contract in
  RPC_arg.make
    ~descr: "A contract identifier encoded in b58check."
    ~name: "contract_id"
    ~construct
    ~destruct
    ()

module Index = struct

  type t = contract

  let path_length = 7

  let to_path c l =
    let raw_key = Data_encoding.Binary.to_bytes_exn encoding c in
    let `Hex key = MBytes.to_hex raw_key in
    let `Hex index_key = MBytes.to_hex (Raw_hashes.blake2b raw_key) in
    String.sub index_key 0 2 ::
    String.sub index_key 2 2 ::
    String.sub index_key 4 2 ::
    String.sub index_key 6 2 ::
    String.sub index_key 8 2 ::
    String.sub index_key 10 2 ::
    key ::
    l

  let of_path = function
    | [] | [_] | [_;_] | [_;_;_] | [_;_;_;_] | [_;_;_;_;_] | [_;_;_;_;_;_]
    | _::_::_::_::_::_::_::_::_ ->
        None
    | [ index1 ; index2 ; index3 ; index4 ; index5 ; index6 ; key ] ->
        let raw_key = MBytes.of_hex (`Hex key) in
        let `Hex index_key = MBytes.to_hex (Raw_hashes.blake2b raw_key) in
        assert Compare.String.(String.sub index_key 0 2 = index1) ;
        assert Compare.String.(String.sub index_key 2 2 = index2) ;
        assert Compare.String.(String.sub index_key 4 2 = index3) ;
        assert Compare.String.(String.sub index_key 6 2 = index4) ;
        assert Compare.String.(String.sub index_key 8 2 = index5) ;
        assert Compare.String.(String.sub index_key 10 2 = index6) ;
        Data_encoding.Binary.of_bytes encoding raw_key

  let rpc_arg = rpc_arg
  let encoding = encoding
  let compare = compare

end