(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(* Tezos Protocol Implementation - Low level Repr. of Operations *)

module Kind = struct
  type seed_nonce_revelation = Seed_nonce_revelation_kind
  type double_endorsement_evidence = Double_endorsement_evidence_kind
  type double_baking_evidence = Double_baking_evidence_kind
  type activate_account = Activate_account_kind
  type endorsement = Endorsement_kind
  type proposals = Proposals_kind
  type ballot = Ballot_kind
  type reveal = Reveal_kind
  type transaction = Transaction_kind
  type origination = Origination_kind
  type delegation = Delegation_kind
  type 'a manager =
    | Reveal_manager_kind : reveal manager
    | Transaction_manager_kind : transaction manager
    | Origination_manager_kind : origination manager
    | Delegation_manager_kind : delegation manager
end

type raw = Operation.t = {
  shell: Operation.shell_header ;
  proto: MBytes.t ;
}

let raw_encoding = Operation.encoding

type 'kind operation = {
  shell: Operation.shell_header ;
  protocol_data: 'kind protocol_data ;
}

and 'kind protocol_data = {
  contents: 'kind contents_list ;
  signature: Signature.t option ;
}

and _ contents_list =
  | Single : 'kind contents -> 'kind contents_list
  | Cons : 'kind Kind.manager contents * 'rest Kind.manager contents_list ->
    (('kind * 'rest) Kind.manager ) contents_list

and _ contents =
  | Endorsement : {
      level: Raw_level_repr.t ;
    } -> Kind.endorsement contents
  | Seed_nonce_revelation : {
      level: Raw_level_repr.t ;
      nonce: Seed_repr.nonce ;
    } -> Kind.seed_nonce_revelation contents
  | Double_endorsement_evidence : {
      op1: Kind.endorsement operation ;
      op2: Kind.endorsement operation ;
    } -> Kind.double_endorsement_evidence contents
  | Double_baking_evidence : {
      bh1: Block_header_repr.t ;
      bh2: Block_header_repr.t ;
    } -> Kind.double_baking_evidence contents
  | Activate_account : {
      id: Ed25519.Public_key_hash.t ;
      activation_code: Blinded_public_key_hash.activation_code ;
    } -> Kind.activate_account contents
  | Proposals : {
      source: Signature.Public_key_hash.t ;
      period: Voting_period_repr.t ;
      proposals: Protocol_hash.t list ;
    } -> Kind.proposals contents
  | Ballot : {
      source: Signature.Public_key_hash.t ;
      period: Voting_period_repr.t ;
      proposal: Protocol_hash.t ;
      ballot: Vote_repr.ballot ;
    } -> Kind.ballot contents
  | Manager_operation : {
      source: Signature.public_key_hash ;
      fee: Tez_repr.tez ;
      counter: counter ;
      operation: 'kind manager_operation ;
      gas_limit: Z.t;
      storage_limit: Z.t;
    } -> 'kind Kind.manager contents

and _ manager_operation =
  | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation
  | Transaction : {
      amount: Tez_repr.tez ;
      parameters: Script_repr.lazy_expr ;
      entrypoint: string ;
      destination: Contract_repr.contract ;
    } -> Kind.transaction manager_operation
  | Origination : {
      delegate: Signature.Public_key_hash.t option ;
      script: Script_repr.t ;
      credit: Tez_repr.tez ;
      preorigination: Contract_repr.t option ;
    } -> Kind.origination manager_operation
  | Delegation :
      Signature.Public_key_hash.t option -> Kind.delegation manager_operation

and counter = Z.t

let manager_kind : type kind. kind manager_operation -> kind Kind.manager =
  function
  | Reveal _ -> Kind.Reveal_manager_kind
  | Transaction _ -> Kind.Transaction_manager_kind
  | Origination _ -> Kind.Origination_manager_kind
  | Delegation _ -> Kind.Delegation_manager_kind

type 'kind internal_operation = {
  source: Contract_repr.contract ;
  operation: 'kind manager_operation ;
  nonce: int ;
}

type packed_manager_operation =
  | Manager : 'kind manager_operation -> packed_manager_operation

type packed_contents =
  | Contents : 'kind contents -> packed_contents

type packed_contents_list =
  | Contents_list : 'kind contents_list -> packed_contents_list

type packed_protocol_data =
  | Operation_data : 'kind protocol_data -> packed_protocol_data

type packed_operation = {
  shell: Operation.shell_header ;
  protocol_data: packed_protocol_data ;
}

let pack ({ shell ; protocol_data} : _ operation) : packed_operation = {
  shell ;
  protocol_data = Operation_data protocol_data ;
}

type packed_internal_operation =
  | Internal_operation : 'kind internal_operation -> packed_internal_operation

let rec to_list = function
  | Contents_list (Single o) -> [Contents o]
  | Contents_list (Cons (o, os)) ->
      Contents o :: to_list (Contents_list os)

let rec of_list = function
  | [] -> assert false
  | [Contents o] -> Contents_list (Single o)
  | (Contents o) :: os ->
      let Contents_list os = of_list os in
      match o, os with
      | Manager_operation _, Single (Manager_operation _) ->
          Contents_list (Cons (o, os))
      | Manager_operation _, Cons _ ->
          Contents_list (Cons (o, os))
      | _ ->
          Pervasives.failwith "Operation list of length > 1 \
                               should only contains manager operations."

module Encoding = struct

  open Data_encoding

  let case tag name args proj inj =
    let open Data_encoding in
    case tag
      ~title:(String.capitalize_ascii name)
      (merge_objs
         (obj1 (req "kind" (constant name)))
         args)
      (fun x -> match proj x with None -> None | Some x -> Some ((), x))
      (fun ((), x) -> inj x)

  module Manager_operations = struct

    type 'kind case =
        MCase : { tag: int ;
                  name: string ;
                  encoding: 'a Data_encoding.t ;
                  select: packed_manager_operation -> 'kind manager_operation option ;
                  proj: 'kind manager_operation -> 'a ;
                  inj: 'a -> 'kind manager_operation } -> 'kind case

    let reveal_case =
      MCase {
        tag = 0 ;
        name = "reveal" ;
        encoding =
          (obj1
             (req "public_key" Signature.Public_key.encoding)) ;
        select =
          (function
            | Manager (Reveal _ as op) -> Some op
            | _ -> None) ;
        proj =
          (function Reveal pkh -> pkh) ;
        inj =
          (fun pkh -> Reveal pkh)
      }

    let entrypoint_encoding =
      def
        ~title:"entrypoint"
        ~description:"Named entrypoint to a Michelson smart contract"
        "entrypoint" @@
      let builtin_case tag name =
        Data_encoding.case (Tag tag) ~title:name
          (constant name)
          (fun n -> if Compare.String.(n = name) then Some () else None) (fun () -> name) in
      union [ builtin_case 0 "default" ;
              builtin_case 1 "root" ;
              builtin_case 2 "do" ;
              builtin_case 3 "set_delegate" ;
              builtin_case 4 "remove_delegate" ;
              Data_encoding.case (Tag 255) ~title:"named" (Bounded.string 31) (fun s -> Some s) (fun s -> s) ]

    let transaction_case =
      MCase {
        tag = 1 ;
        name = "transaction" ;
        encoding =
          (obj3
             (req "amount" Tez_repr.encoding)
             (req "destination" Contract_repr.encoding)
             (opt "parameters"
                (obj2
                   (req "entrypoint" entrypoint_encoding)
                   (req "value" Script_repr.lazy_expr_encoding)))) ;
        select =
          (function
            | Manager (Transaction _ as op) -> Some op
            | _ -> None) ;
        proj =
          (function
            | Transaction { amount ; destination ; parameters ; entrypoint } ->
                let parameters =
                  if Script_repr.is_unit_parameter parameters && Compare.String.(entrypoint = "default") then
                    None
                  else
                    Some (entrypoint, parameters) in
                (amount, destination, parameters)) ;
        inj =
          (fun (amount, destination, parameters) ->
             let entrypoint, parameters = match parameters with
               | None -> "default", Script_repr.unit_parameter
               | Some (entrypoint, value) -> entrypoint, value in
             Transaction { amount ; destination ; parameters ; entrypoint })
      }

    let origination_case =
      MCase {
        tag = 2 ;
        name = "origination" ;
        encoding =
          (obj3
             (req "balance" Tez_repr.encoding)
             (opt "delegate" Signature.Public_key_hash.encoding)
             (req "script" Script_repr.encoding)) ;
        select =
          (function
            | Manager (Origination _ as op) -> Some op
            | _ -> None) ;
        proj =
          (function
            | Origination { credit ; delegate ; script ;
                            preorigination = _
                            (* the hash is only used internally
                               when originating from smart
                               contracts, don't serialize it *) } ->
                (credit, delegate, script)) ;
        inj =
          (fun (credit, delegate, script) ->
             Origination
               {credit ; delegate ; script ; preorigination = None })
      }

    let delegation_case =
      MCase {
        tag = 3 ;
        name = "delegation" ;
        encoding =
          (obj1
             (opt "delegate" Signature.Public_key_hash.encoding)) ;
        select =
          (function
            | Manager (Delegation _ as op) -> Some op
            | _ -> None) ;
        proj =
          (function Delegation key -> key) ;
        inj =
          (fun key -> Delegation key)
      }

    let encoding =
      let make (MCase { tag ; name ; encoding ; select ; proj ; inj }) =
        case (Tag tag) name encoding
          (fun o -> match select o with None -> None | Some o -> Some (proj o))
          (fun x -> Manager (inj x)) in
      union ~tag_size:`Uint8 [
        make reveal_case ;
        make transaction_case ;
        make origination_case ;
        make delegation_case ;
      ]

  end

  type 'b case =
      Case : { tag: int ;
               name: string ;
               encoding: 'a Data_encoding.t ;
               select: packed_contents -> 'b contents option ;
               proj: 'b contents -> 'a ;
               inj: 'a -> 'b contents } -> 'b case

  let endorsement_encoding =
    obj1
      (req "level" Raw_level_repr.encoding)

  let endorsement_case =
    Case {
      tag = 0 ;
      name = "endorsement" ;
      encoding = endorsement_encoding ;
      select =
        (function
          | Contents (Endorsement _ as op) -> Some op
          | _ -> None) ;
      proj =
        (fun (Endorsement { level }) -> level) ;
      inj =
        (fun level -> Endorsement { level })
    }

  let endorsement_encoding =
    let make (Case { tag ; name ; encoding ; select = _ ; proj ; inj }) =
      case (Tag tag) name encoding
        (fun o -> Some (proj o))
        (fun x -> inj x) in
    let to_list : Kind.endorsement contents_list -> _ = function
      | Single o -> o in
    let of_list : Kind.endorsement contents -> _ = function
      | o -> Single o in
    def "inlined.endorsement" @@
    conv
      (fun ({ shell ; protocol_data = { contents ; signature } } : _ operation)->
         (shell, (contents, signature)))
      (fun (shell, (contents, signature)) ->
         ({ shell ; protocol_data = { contents ; signature }} : _ operation))
      (merge_objs
         Operation.shell_header_encoding
         (obj2
            (req "operations"
               (conv to_list of_list  @@
                def "inlined.endorsement.contents" @@
                union [
                  make endorsement_case ;
                ]))
            (varopt "signature" Signature.encoding)))

  let seed_nonce_revelation_case =
    Case {
      tag = 1;
      name = "seed_nonce_revelation" ;
      encoding =
        (obj2
           (req "level" Raw_level_repr.encoding)
           (req "nonce" Seed_repr.nonce_encoding)) ;
      select =
        (function
          | Contents (Seed_nonce_revelation _ as op) -> Some op
          | _ -> None) ;
      proj =
        (fun (Seed_nonce_revelation { level ; nonce }) -> (level, nonce)) ;
      inj =
        (fun (level, nonce) -> Seed_nonce_revelation { level ; nonce })
    }

  let double_endorsement_evidence_case : Kind.double_endorsement_evidence case =
    Case {
      tag = 2 ;
      name = "double_endorsement_evidence" ;
      encoding =
        (obj2
           (req "op1" (dynamic_size endorsement_encoding))
           (req "op2" (dynamic_size endorsement_encoding))) ;
      select =
        (function
          | Contents (Double_endorsement_evidence _ as op) -> Some op
          | _ -> None) ;
      proj =
        (fun (Double_endorsement_evidence { op1 ; op2 }) -> (op1, op2)) ;
      inj =
        (fun (op1, op2) -> (Double_endorsement_evidence { op1 ; op2 }))
    }

  let double_baking_evidence_case =
    Case {
      tag = 3 ;
      name = "double_baking_evidence" ;
      encoding =
        (obj2
           (req "bh1" (dynamic_size Block_header_repr.encoding))
           (req "bh2" (dynamic_size Block_header_repr.encoding))) ;
      select =
        (function
          | Contents (Double_baking_evidence _ as op) -> Some op
          | _ -> None) ;
      proj =
        (fun (Double_baking_evidence { bh1 ; bh2 }) -> (bh1, bh2)) ;
      inj =
        (fun (bh1, bh2) -> Double_baking_evidence { bh1 ; bh2 }) ;
    }

  let activate_account_case =
    Case {
      tag = 4 ;
      name = "activate_account" ;
      encoding =
        (obj2
           (req "pkh" Ed25519.Public_key_hash.encoding)
           (req "secret" Blinded_public_key_hash.activation_code_encoding)) ;
      select =
        (function
          | Contents (Activate_account _ as op) -> Some op
          | _ -> None) ;
      proj =
        (fun (Activate_account { id ; activation_code }) -> (id, activation_code)) ;
      inj =
        (fun (id, activation_code) -> Activate_account { id ; activation_code })
    }

  let proposals_case =
    Case {
      tag = 5 ;
      name = "proposals" ;
      encoding =
        (obj3
           (req "source" Signature.Public_key_hash.encoding)
           (req "period" Voting_period_repr.encoding)
           (req "proposals" (list Protocol_hash.encoding))) ;
      select =
        (function
          | Contents (Proposals _ as op) -> Some op
          | _ -> None) ;
      proj =
        (fun (Proposals { source ; period ; proposals }) ->
           (source, period, proposals)) ;
      inj =
        (fun (source, period, proposals) ->
           Proposals { source ; period ; proposals }) ;
    }

  let ballot_case =
    Case {
      tag = 6 ;
      name = "ballot" ;
      encoding =
        (obj4
           (req "source" Signature.Public_key_hash.encoding)
           (req "period" Voting_period_repr.encoding)
           (req "proposal" Protocol_hash.encoding)
           (req "ballot" Vote_repr.ballot_encoding)) ;
      select =
        (function
          | Contents (Ballot _ as op) -> Some op
          | _ -> None) ;
      proj =
        (function
            (Ballot { source ; period ; proposal ; ballot }) ->
              (source, period, proposal, ballot)) ;
      inj =
        (fun (source, period, proposal, ballot) ->
           Ballot { source ; period ; proposal ; ballot }) ;
    }

  let manager_encoding =
    (obj5
       (req "source" Signature.Public_key_hash.encoding)
       (req "fee" Tez_repr.encoding)
       (req "counter" (check_size 10 n))
       (req "gas_limit" (check_size 10 n))
       (req "storage_limit" (check_size 10 n)))

  let extract
      (type kind)
      (Manager_operation { source ; fee ; counter ;
                           gas_limit ; storage_limit ; operation = _ } : kind Kind.manager contents) =
    (source, fee, counter, gas_limit, storage_limit)

  let rebuild (source, fee, counter, gas_limit, storage_limit) operation =
    Manager_operation { source ; fee ; counter ;
                        gas_limit ; storage_limit ; operation }

  let make_manager_case tag
      (type kind)
      (Manager_operations.MCase mcase : kind Manager_operations.case) =
    Case {
      tag ;
      name = mcase.name ;
      encoding =
        merge_objs
          manager_encoding
          mcase.encoding ;
      select =
        (function
          | Contents (Manager_operation ({ operation ; _ } as op)) -> begin
              match mcase.select (Manager operation) with
              | None -> None
              | Some operation ->
                  Some (Manager_operation { op with operation })
            end
          | _ -> None) ;
      proj =
        (function
          | Manager_operation { operation ; _ } as op ->
              (extract op, mcase.proj operation )) ;
      inj =
        (fun (op, contents) ->
           (rebuild op (mcase.inj contents)))
    }

  let reveal_case = make_manager_case 107 Manager_operations.reveal_case
  let transaction_case = make_manager_case 108 Manager_operations.transaction_case
  let origination_case = make_manager_case 109 Manager_operations.origination_case
  let delegation_case = make_manager_case 110 Manager_operations.delegation_case

  let contents_encoding =
    let make (Case { tag ; name ; encoding ; select ; proj ; inj }) =
      case (Tag tag) name encoding
        (fun o -> match select o with None -> None | Some o -> Some (proj o))
        (fun x -> Contents (inj x)) in
    def "operation.alpha.contents" @@
    union [
      make endorsement_case ;
      make seed_nonce_revelation_case ;
      make double_endorsement_evidence_case ;
      make double_baking_evidence_case ;
      make activate_account_case ;
      make proposals_case ;
      make ballot_case ;
      make reveal_case ;
      make transaction_case ;
      make origination_case ;
      make delegation_case ;
    ]

  let contents_list_encoding =
    conv to_list of_list (Variable.list contents_encoding)

  let optional_signature_encoding =
    conv
      (function Some s -> s | None -> Signature.zero)
      (fun s -> if Signature.equal s Signature.zero then None else Some s)
      Signature.encoding

  let protocol_data_encoding =
    def "operation.alpha.contents_and_signature" @@
    conv
      (fun (Operation_data { contents ; signature }) ->
         (Contents_list contents, signature))
      (fun (Contents_list contents, signature) ->
         Operation_data { contents ; signature })
      (obj2
         (req "contents" contents_list_encoding)
         (req "signature" optional_signature_encoding))

  let operation_encoding =
    conv
      (fun ({ shell ; protocol_data }) ->
         (shell, protocol_data))
      (fun (shell, protocol_data) ->
         { shell ; protocol_data })
      (merge_objs
         Operation.shell_header_encoding
         protocol_data_encoding)

  let unsigned_operation_encoding =
    def "operation.alpha.unsigned_operation" @@
    merge_objs
      Operation.shell_header_encoding
      (obj1 (req "contents" contents_list_encoding))

  let internal_operation_encoding =
    def "operation.alpha.internal_operation" @@
    conv
      (fun (Internal_operation { source ; operation ; nonce }) ->
         ((source, nonce), Manager operation))
      (fun ((source, nonce), Manager operation) ->
         Internal_operation { source ; operation ; nonce })
      (merge_objs
         (obj2
            (req "source" Contract_repr.encoding)
            (req "nonce" uint16))
         Manager_operations.encoding)

end

let encoding = Encoding.operation_encoding
let contents_encoding = Encoding.contents_encoding
let contents_list_encoding = Encoding.contents_list_encoding
let protocol_data_encoding = Encoding.protocol_data_encoding
let unsigned_operation_encoding = Encoding.unsigned_operation_encoding
let internal_operation_encoding = Encoding.internal_operation_encoding

let raw ({ shell ; protocol_data } : _ operation) =
  let proto =
    Data_encoding.Binary.to_bytes_exn
      protocol_data_encoding
      (Operation_data protocol_data) in
  { Operation.shell ; proto }

let acceptable_passes (op : packed_operation) =
  let Operation_data protocol_data = op.protocol_data in
  match protocol_data.contents with

  | Single (Endorsement _) -> [0]

  | Single (Proposals _ ) -> [1]
  | Single (Ballot _ ) -> [1]

  | Single (Seed_nonce_revelation _) -> [2]
  | Single (Double_endorsement_evidence _) -> [2]
  | Single (Double_baking_evidence _) -> [2]
  | Single (Activate_account _) -> [2]

  | Single (Manager_operation _) -> [3]
  | Cons _ -> [3]

type error += Invalid_signature (* `Permanent *)
type error += Missing_signature (* `Permanent *)

let () =
  register_error_kind
    `Permanent
    ~id:"operation.invalid_signature"
    ~title:"Invalid operation signature"
    ~description:"The operation signature is ill-formed \
                  or has been made with the wrong public key"
    ~pp:(fun ppf () ->
        Format.fprintf ppf "The operation signature is invalid")
    Data_encoding.unit
    (function Invalid_signature -> Some () | _ -> None)
    (fun () -> Invalid_signature) ;
  register_error_kind
    `Permanent
    ~id:"operation.missing_signature"
    ~title:"Missing operation signature"
    ~description:"The operation is of a kind that must be signed, \
                  but the signature is missing"
    ~pp:(fun ppf () ->
        Format.fprintf ppf "The operation requires a signature")
    Data_encoding.unit
    (function Missing_signature -> Some () | _ -> None)
    (fun () -> Missing_signature)

let check_signature_sync (type kind) key chain_id ({ shell ; protocol_data } : kind operation) =
  let check ~watermark contents signature =
    let unsigned_operation =
      Data_encoding.Binary.to_bytes_exn
        unsigned_operation_encoding (shell, contents) in
    if Signature.check ~watermark key signature unsigned_operation then
      Ok ()
    else
      error Invalid_signature in
  match protocol_data.contents, protocol_data.signature with
  | Single _, None ->
      error Missing_signature
  | Cons _, None ->
      error Missing_signature
  | Single (Endorsement _) as contents, Some signature ->
      check ~watermark:(Endorsement chain_id) (Contents_list contents) signature
  | Single _ as contents, Some signature ->
      check ~watermark:Generic_operation (Contents_list contents) signature
  | Cons _ as contents, Some signature ->
      check ~watermark:Generic_operation (Contents_list contents) signature

let check_signature pk chain_id op =
  Lwt.return (check_signature_sync pk chain_id op)

let hash_raw = Operation.hash
let hash (o : _ operation) =
  let proto =
    Data_encoding.Binary.to_bytes_exn
      protocol_data_encoding
      (Operation_data o.protocol_data) in
  Operation.hash { shell = o.shell ; proto }
let hash_packed (o : packed_operation) =
  let proto =
    Data_encoding.Binary.to_bytes_exn
      protocol_data_encoding
      o.protocol_data in
  Operation.hash { shell = o.shell ; proto }

type ('a, 'b) eq = Eq : ('a, 'a) eq

let equal_manager_operation_kind
  : type a b. a manager_operation -> b manager_operation -> (a, b) eq option
  = fun op1 op2 ->
    match op1, op2 with
    | Reveal _, Reveal _ -> Some Eq
    | Reveal _, _ -> None
    | Transaction _, Transaction _ -> Some Eq
    | Transaction _, _ -> None
    | Origination _, Origination _ -> Some Eq
    | Origination _, _ -> None
    | Delegation _, Delegation _ -> Some Eq
    | Delegation _, _ -> None

let equal_contents_kind
  : type a b. a contents -> b contents -> (a, b) eq option
  = fun op1 op2 ->
    match op1, op2 with
    | Endorsement _, Endorsement _ -> Some Eq
    | Endorsement _, _ -> None
    | Seed_nonce_revelation _, Seed_nonce_revelation _ -> Some Eq
    | Seed_nonce_revelation _, _ -> None
    | Double_endorsement_evidence _, Double_endorsement_evidence _ -> Some Eq
    | Double_endorsement_evidence _, _ -> None
    | Double_baking_evidence _, Double_baking_evidence _ -> Some Eq
    | Double_baking_evidence _, _ -> None
    | Activate_account _, Activate_account _ -> Some Eq
    | Activate_account _, _ -> None
    | Proposals _, Proposals _ -> Some Eq
    | Proposals _, _ -> None
    | Ballot _, Ballot _ -> Some Eq
    | Ballot _, _ -> None
    | Manager_operation op1, Manager_operation op2 -> begin
        match equal_manager_operation_kind op1.operation op2.operation with
        | None -> None
        | Some Eq -> Some Eq
      end
    | Manager_operation _, _ -> None

let rec equal_contents_kind_list
  : type a b. a contents_list -> b contents_list -> (a, b) eq option
  = fun op1 op2 ->
    match op1, op2 with
    | Single op1, Single op2 ->
        equal_contents_kind op1 op2
    | Single _, Cons _ -> None
    | Cons _, Single _ -> None
    | Cons (op1, ops1), Cons (op2, ops2) -> begin
        match equal_contents_kind op1 op2 with
        | None -> None
        | Some Eq ->
            match equal_contents_kind_list ops1 ops2 with
            | None -> None
            | Some Eq -> Some Eq
      end

let equal
  : type a b. a operation -> b operation -> (a, b) eq option
  = fun op1 op2 ->
    if not (Operation_hash.equal (hash op1) (hash op2)) then
      None
    else
      equal_contents_kind_list
        op1.protocol_data.contents op2.protocol_data.contents