Alpha: add operation Double_baking

src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL

@@ -25,9 +25,9 @@
         "Contract_repr",
         "Roll_repr",
         "Vote_repr",
+        "Block_header_repr",
         "Operation_repr",
         "Manager_repr",
-        "Block_header_repr",
 
         "Raw_context",
         "Storage_sigs",

src/proto_alpha/lib_protocol/src/alpha_context.mli

@@ -87,6 +87,7 @@ module Raw_level : sig
   val succ: raw_level -> raw_level
   val pred: raw_level -> raw_level option
   val to_int32: raw_level -> int32
+  val of_int32: int32 -> raw_level tzresult
 
 end
 
@@ -567,6 +568,56 @@ module Vote : sig
 
 end
 
+module Block_header : sig
+
+  type t = {
+    shell: Block_header.shell_header ;
+    protocol_data: protocol_data ;
+    signature: Ed25519.Signature.t ;
+  }
+
+  and protocol_data = {
+    priority: int ;
+    seed_nonce_hash: Nonce_hash.t option ;
+    proof_of_work_nonce: MBytes.t ;
+  }
+
+  type block_header = t
+
+  type raw = Block_header.t
+  type shell_header = Block_header.shell_header
+
+  val hash: block_header -> Block_hash.t
+  val hash_raw: raw -> Block_hash.t
+
+  val encoding: block_header Data_encoding.encoding
+  val raw_encoding: raw Data_encoding.t
+  val protocol_data_encoding: protocol_data Data_encoding.encoding
+  val shell_header_encoding: shell_header Data_encoding.encoding
+
+  val max_header_length: int
+  (** The maximum size of block headers in bytes *)
+
+  val parse: Block_header.t -> block_header tzresult
+  (** Parse the protocol-specific part of a block header. *)
+
+  val parse_unsigned_protocol_data: MBytes.t -> protocol_data tzresult
+  (** Parse the (unsigned) protocol-specific part of a block header. *)
+
+  val forge_unsigned_protocol_data: protocol_data -> MBytes.t
+  (** [forge_header proto_hdr] is the binary serialization
+      (using [protocol_data_encoding]) of the protocol-specific part
+      of a block header, without the signature. *)
+
+  val forge_unsigned:
+    Block_header.shell_header -> protocol_data -> MBytes.t
+    (** [forge_header shell_hdr proto_hdr] is the binary serialization
+        (using [unsigned_header_encoding]) of a block header,
+        comprising both the shell and the protocol part of the header,
+        without the signature. *)
+
+end
+
 type operation = {
   shell: Operation.shell_header ;
   contents: proto_operation ;
@@ -586,6 +637,10 @@ and anonymous_operation =
       op1: operation ;
       op2: operation ;
     }
+  | Double_baking of {
+      bh1: Block_header.t ;
+      bh2: Block_header.t ;
+    }
   | Faucet of {
       id: Ed25519.Public_key_hash.t ;
       nonce: MBytes.t ;
@@ -681,56 +736,6 @@ module Operation : sig
 
 end
 
-module Block_header : sig
-
-  type t = {
-    shell: Block_header.shell_header ;
-    protocol_data: protocol_data ;
-    signature: Ed25519.Signature.t ;
-  }
-
-  and protocol_data = {
-    priority: int ;
-    seed_nonce_hash: Nonce_hash.t option ;
-    proof_of_work_nonce: MBytes.t ;
-  }
-
-  type block_header = t
-
-  type raw = Block_header.t
-  type shell_header = Block_header.shell_header
-
-  val hash: block_header -> Block_hash.t
-  val hash_raw: raw -> Block_hash.t
-
-  val encoding: block_header Data_encoding.encoding
-  val raw_encoding: raw Data_encoding.t
-  val protocol_data_encoding: protocol_data Data_encoding.encoding
-  val shell_header_encoding: shell_header Data_encoding.encoding
-
-  val max_header_length: int
-  (** The maximum size of block headers in bytes *)
-
-  val parse: Block_header.t -> block_header tzresult
-  (** Parse the protocol-specific part of a block header. *)
-
-  val parse_unsigned_protocol_data: MBytes.t -> protocol_data tzresult
-  (** Parse the (unsigned) protocol-specific part of a block header. *)
-
-  val forge_unsigned_protocol_data: protocol_data -> MBytes.t
-  (** [forge_header proto_hdr] is the binary serialization
-      (using [protocol_data_encoding]) of the protocol-specific part
-      of a block header, without the signature. *)
-
-  val forge_unsigned:
-    Block_header.shell_header -> protocol_data -> MBytes.t
-    (** [forge_header shell_hdr proto_hdr] is the binary serialization
-        (using [unsigned_header_encoding]) of a block header,
-        comprising both the shell and the protocol part of the header,
-        without the signature. *)
-
-end
-
 module Roll : sig
 
   val value: context -> Tez.t

src/proto_alpha/lib_protocol/src/apply.ml

@@ -26,6 +26,14 @@ type error += Too_early_double_endorsement of { level: Raw_level.t ; current: Ra
 type error += Outdated_double_endorsement of { level: Raw_level.t ; last: Raw_level.t } (* `Permanent *)
 
 
+type error += Invalid_double_baking of { level1: Int32.t ; level2: Int32.t } (* `Permanent *)
+type error += Inconsistent_double_baking of { delegate1: Ed25519.Public_key_hash.t ; delegate2: Ed25519.Public_key_hash.t } (* `Permanent *)
+type error += Unrequired_double_baking (* `Branch*)
+type error += Too_early_double_baking of { level: Raw_level.t ; current: Raw_level.t } (* `Temporary *)
+type error += Outdated_double_baking of { level: Raw_level.t ; last: Raw_level.t } (* `Permanent *)
+
+
+
 let () =
   register_error_kind
     `Temporary
@@ -196,7 +204,97 @@ let () =
           Some (level, last)
       | _ -> None)
     (fun (level, last) ->
-       Outdated_double_endorsement { level ; last })
+       Outdated_double_endorsement { level ; last }) ;
+  register_error_kind
+    `Permanent
+    ~id:"block.invalid_double_baking"
+    ~title:"Invalid double baking"
+    ~description:"A double-baking denunciation is inconsistent \
+                 \ (two distinct level)"
+    ~pp:(fun ppf (level1, level2) ->
+        Format.fprintf ppf
+          "Inconsistent double-baking denunciation (levels: %ld and %ld)"
+          level1 level2)
+    Data_encoding.(obj2
+                     (req "level1" int32)
+                     (req "level2" int32))
+    (function
+      | Invalid_double_baking { level1 ; level2 } -> Some (level1, level2)
+      | _ -> None)
+    (fun (level1, level2) -> Invalid_double_baking { level1 ; level2 }) ;
+  register_error_kind
+    `Permanent
+    ~id:"block.inconsistent_double_baking"
+    ~title:"Inconsistent double baking"
+    ~description:"A double-baking denunciation is inconsistent \
+                 \ (two distinct delegates)"
+    ~pp:(fun ppf (delegate1, delegate2) ->
+        Format.fprintf ppf
+          "Inconsistent double-baking denunciation \
+          \ (distinct delegate: %a and %a)"
+          Ed25519.Public_key_hash.pp_short delegate1
+          Ed25519.Public_key_hash.pp_short delegate2)
+    Data_encoding.(obj2
+                     (req "delegate1" Ed25519.Public_key_hash.encoding)
+                     (req "delegate2" Ed25519.Public_key_hash.encoding))
+    (function
+      | Inconsistent_double_baking { delegate1 ; delegate2 } ->
+          Some (delegate1, delegate2)
+      | _ -> None)
+    (fun (delegate1, delegate2) ->
+       Inconsistent_double_baking { delegate1 ; delegate2 }) ;
+  register_error_kind
+    `Branch
+    ~id:"block.unrequired_double_baking"
+    ~title:"Unrequired double baking"
+    ~description:"A double-baking denunciation is unrequired"
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf "A valid double-baking operation cannot \
+                           \ be applied: the associated delegate \
+                           \ has previously been denunciated in this cycle.")
+    Data_encoding.empty
+    (function Unrequired_double_baking -> Some () | _ -> None)
+    (fun () -> Unrequired_double_baking) ;
+  register_error_kind
+    `Temporary
+    ~id:"block.too_early_double_baking"
+    ~title:"Too early double baking"
+    ~description:"A double-baking denunciation is in the future"
+    ~pp:(fun ppf (level, current) ->
+        Format.fprintf ppf
+          "A double-baking denunciation is in the future \
+          \ (current level: %a, baking level: %a)"
+          Raw_level.pp current
+          Raw_level.pp level)
+    Data_encoding.(obj2
+                     (req "level" Raw_level.encoding)
+                     (req "current" Raw_level.encoding))
+    (function
+      | Too_early_double_baking { level ; current } ->
+          Some (level, current)
+      | _ -> None)
+    (fun (level, current) ->
+       Too_early_double_baking { level ; current }) ;
+  register_error_kind
+    `Permanent
+    ~id:"block.outdated_double_baking"
+    ~title:"Outdated double baking"
+    ~description:"A double-baking denunciation is outdated."
+    ~pp:(fun ppf (level, last) ->
+        Format.fprintf ppf
+          "A double-baking denunciation is outdated \
+          \ (last acceptable level: %a, baking level: %a)"
+          Raw_level.pp last
+          Raw_level.pp level)
+    Data_encoding.(obj2
+                     (req "level" Raw_level.encoding)
+                     (req "last" Raw_level.encoding))
+    (function
+      | Outdated_double_baking { level ; last } ->
+          Some (level, last)
+      | _ -> None)
+    (fun (level, last) ->
+       Outdated_double_baking { level ; last })
 
 let apply_consensus_operation_content ctxt
     pred_block block_priority operation = function
@@ -421,6 +519,42 @@ let apply_anonymous_operation ctxt delegate origination_nonce kind =
           return (ctxt, origination_nonce, Tez.zero, reward)
       | _, _ -> fail Invalid_double_endorsement
     end
+  | Double_baking { bh1 ; bh2 } ->
+      fail_unless Compare.Int32.(bh1.shell.level = bh2.shell.level)
+        (Invalid_double_baking
+           { level1 = bh1.shell.level ;
+             level2 = bh2.shell.level }) >>=? fun () ->
+      Lwt.return (Raw_level.of_int32 bh1.shell.level) >>=? fun raw_level ->
+      let oldest_level = Level.last_allowed_fork_level ctxt in
+      fail_unless Raw_level.(raw_level < (Level.current ctxt).level)
+        (Too_early_double_baking
+           { level = raw_level ;
+             current = (Level.current ctxt).level }) >>=? fun () ->
+      fail_unless Raw_level.(oldest_level <= raw_level)
+        (Outdated_double_baking
+           { level = raw_level ;
+             last = oldest_level }) >>=? fun () ->
+      let level = Level.from_raw ctxt raw_level in
+      Roll.baking_rights_owner
+        ctxt level ~priority:bh1.protocol_data.priority >>=? fun delegate1 ->
+      Baking.check_signature bh1 delegate1 >>=? fun () ->
+      Roll.baking_rights_owner
+        ctxt level ~priority:bh2.protocol_data.priority >>=? fun delegate2 ->
+      Baking.check_signature bh2 delegate2 >>=? fun () ->
+      fail_unless
+        (Ed25519.Public_key.equal delegate1 delegate2)
+        (Inconsistent_double_baking
+           { delegate1 = Ed25519.Public_key.hash delegate1 ;
+             delegate2 = Ed25519.Public_key.hash delegate2 }) >>=? fun () ->
+      let delegate = Ed25519.Public_key.hash delegate1 in
+      Delegate.has_frozen_balance ctxt delegate level.cycle >>=? fun valid ->
+      fail_unless valid Unrequired_double_baking >>=? fun () ->
+      Delegate.punish ctxt delegate level.cycle >>=? fun (ctxt, burned) ->
+      let reward =
+        match Tez.(burned /? 2L) with
+        | Ok v -> v
+        | Error _ -> Tez.zero in
+      return (ctxt, origination_nonce, Tez.zero, reward)
   | Faucet { id = manager ; _ } ->
       (* Free tez for all! *)
       if Compare.Int.(faucet_count ctxt < 5) then

src/proto_alpha/lib_protocol/src/operation_repr.ml

@@ -35,6 +35,10 @@ and anonymous_operation =
       op1: operation ;
       op2: operation ;
     }
+  | Double_baking of {
+      bh1: Block_header_repr.t ;
+      bh2: Block_header_repr.t ;
+    }
   | Faucet of {
       id: Ed25519.Public_key_hash.t ;
       nonce: MBytes.t ;
@@ -324,6 +328,20 @@ module Encoding = struct
       )
       (fun ((), op1, op2) -> Double_endorsement { op1 ; op2 })
 
+  let double_baking_encoding =
+    (obj3
+       (req "kind" (constant "double_baking"))
+       (req "op1" (dynamic_size Block_header_repr.encoding))
+       (req "op2" (dynamic_size Block_header_repr.encoding)))
+
+  let double_baking_case tag =
+    case tag double_baking_encoding
+      (function
+        | Double_baking { bh1 ; bh2 } -> Some ((), bh1, bh2)
+        | _ -> None
+      )
+      (fun ((), bh1, bh2) -> Double_baking { bh1 ; bh2 })
+
   let faucet_encoding =
     (obj3
        (req "kind" (constant "faucet"))
@@ -346,7 +364,8 @@ module Encoding = struct
                (union [
                    seed_nonce_revelation_case (Tag 0) ;
                    double_endorsement_case (Tag 1) op_encoding ;
-                   faucet_case (Tag 2) ;
+                   double_baking_case (Tag 2) ;
+                   faucet_case (Tag 3) ;
                  ]))))
       (function Anonymous_operations ops -> Some ops | _ -> None)
       (fun ops -> Anonymous_operations ops)

src/proto_alpha/lib_protocol/src/operation_repr.mli

@@ -35,6 +35,10 @@ and anonymous_operation =
       op1: operation ;
       op2: operation ;
     }
+  | Double_baking of {
+      bh1: Block_header_repr.t ;
+      bh2: Block_header_repr.t ;
+    }
   | Faucet of {
       id: Ed25519.Public_key_hash.t ;
       nonce: MBytes.t ;