Michelson: forbid internal operation replay

src/bin_client/test/contracts/replay.tz

@@ -0,0 +1,6 @@
+parameter unit ;
+storage unit ;
+code { CDR ; NIL operation ;
+       SELF ; PUSH mutez 0 ; UNIT ; TRANSFER_TOKENS ;
+       DUP ; DIP { CONS } ; CONS ;
+       PAIR }

src/bin_client/test/test_contracts.sh

@@ -385,6 +385,10 @@ bake_after $client transfer 100 from bootstrap1 to transfer_to \
 assert_balance test_transfer_account2 "120 ꜩ" # Why isn't this 120 ꜩ? Baking fee?
 
 
+# Test replay prevention
+init_with_transfer $contract_dir/replay.tz $key2 Unit 0 bootstrap1
+assert_fails $client transfer 0 from bootstrap1 to replay
+
 # Tests create_account
 init_with_transfer $contract_dir/create_account.tz $key2 None 1,000 bootstrap1
 $client transfer 100 from bootstrap1 to create_account \

src/proto_alpha/lib_client/michelson_v1_error_reporter.ml

@@ -209,6 +209,12 @@ let report_errors ~details ~show_source ?parsed ppf errs =
           print_source (parsed, hilights) ;
         if rest <> [] then Format.fprintf ppf "@," ;
         print_trace (parsed_locations parsed) rest
+    | Alpha_environment.Ecoproto_error (Apply.Internal_operation_replay op) :: rest ->
+        Format.fprintf ppf
+          "@[<v 2>Internal operation replay attempt:@,%a@]"
+          Operation_result.pp_internal_operation op ;
+        if rest <> [] then Format.fprintf ppf "@," ;
+        print_trace locations rest
     | Alpha_environment.Ecoproto_error Gas.Gas_limit_too_high :: rest ->
         Format.fprintf ppf
           "Gas limit for the block is out of the protocol hard bounds." ;

src/proto_alpha/lib_protocol/src/alpha_context.ml

@@ -136,6 +136,11 @@ let fork_test_chain = Raw_context.fork_test_chain
 let endorsement_already_recorded = Raw_context.endorsement_already_recorded
 let record_endorsement = Raw_context.record_endorsement
 
+let reset_internal_nonce = Raw_context.reset_internal_nonce
+let fresh_internal_nonce = Raw_context.fresh_internal_nonce
+let record_internal_nonce = Raw_context.record_internal_nonce
+let internal_nonce_already_recorded = Raw_context.internal_nonce_already_recorded
+
 let add_fees = Raw_context.add_fees
 let add_rewards = Raw_context.add_rewards
 

src/proto_alpha/lib_protocol/src/alpha_context.mli

@@ -817,6 +817,7 @@ and counter = Int32.t
 type internal_operation = {
   source: Contract.contract ;
   operation: manager_operation ;
+  nonce : int ;
 }
 
 module Operation : sig
@@ -921,6 +922,11 @@ val fork_test_chain: context -> Protocol_hash.t -> Time.t -> context Lwt.t
 val endorsement_already_recorded: context -> int -> bool
 val record_endorsement: context -> int -> context
 
+val reset_internal_nonce: context -> context
+val fresh_internal_nonce: context -> (context * int) tzresult
+val record_internal_nonce: context -> int -> context
+val internal_nonce_already_recorded: context -> int -> bool
+
 val add_fees: context -> Tez.t -> context tzresult Lwt.t
 val add_rewards: context -> Tez.t -> context tzresult Lwt.t
 

src/proto_alpha/lib_protocol/src/apply.ml

@@ -17,6 +17,7 @@ type error += Duplicate_endorsement of int (* `Branch *)
 type error += Bad_contract_parameter of Contract.t * Script.expr option * Script.lazy_expr option (* `Permanent *)
 type error += Invalid_endorsement_level
 type error += Invalid_commitment of { expected: bool }
+type error += Internal_operation_replay of internal_operation
 
 type error += Invalid_double_endorsement_evidence (* `Permanent *)
 type error += Inconsistent_double_endorsement_evidence
@@ -117,6 +118,16 @@ let () =
     Data_encoding.(obj1 (req "expected" bool))
     (function Invalid_commitment { expected } -> Some expected | _ -> None)
     (fun expected -> Invalid_commitment { expected }) ;
+  register_error_kind
+    `Permanent
+    ~id:"internal_operation_replay"
+    ~title:"Internal operation replay"
+    ~description:"An internal operation was emitted twice by a script"
+    ~pp:(fun ppf { nonce } ->
+        Format.fprintf ppf "Internal operation %d was emitted twice by a script" nonce)
+    Operation.internal_operation_encoding
+    (function Internal_operation_replay op -> Some op | _ -> None)
+    (fun op -> Internal_operation_replay op) ;
   register_error_kind
     `Permanent
     ~id:"block.invalid_double_endorsement_evidence"
@@ -498,8 +509,13 @@ let apply_internal_manager_operations ctxt ~payer ops =
   let rec apply ctxt applied worklist =
     match worklist with
     | [] -> Lwt.return (Ok (ctxt, applied))
-    | { source ; operation } as op :: rest ->
+    | { source ; operation ; nonce } as op :: rest ->
-        apply_manager_operation_content ctxt ~source ~payer ~internal:true operation >>= function
+        begin if internal_nonce_already_recorded ctxt nonce then
+            fail (Internal_operation_replay op)
+          else
+            let ctxt = record_internal_nonce ctxt nonce in
+            apply_manager_operation_content ctxt ~source ~payer ~internal:true operation
+        end >>= function
         | Error errors ->
             let result = Internal op, Failed errors in
             let skipped = List.rev_map (fun op -> Internal op, Skipped) rest in
@@ -561,6 +577,7 @@ let apply_sourced_operation ctxt pred_block operation ops =
       Contract.increment_counter ctxt source >>=? fun ctxt ->
       Contract.spend ctxt source fee >>=? fun ctxt ->
       add_fees ctxt fee >>=? fun ctxt ->
+      let ctxt = reset_internal_nonce ctxt in
       Lwt.return (Gas.set_limit ctxt gas_limit) >>=? fun ctxt ->
       Lwt.return (Contract.set_storage_limit ctxt storage_limit) >>=? fun ctxt ->
       apply_manager_operations ctxt source operations >>= begin function

src/proto_alpha/lib_protocol/src/operation_repr.ml

@@ -105,6 +105,7 @@ and counter = Int32.t
 type internal_operation = {
   source: Contract_repr.contract ;
   operation: manager_operation ;
+  nonce: int ;
 }
 
 module Encoding = struct
@@ -429,11 +430,12 @@ module Encoding = struct
 
   let internal_operation_encoding =
     conv
-      (fun { source ; operation } -> (source, operation))
+      (fun { source ; operation ; nonce } -> ((source, nonce), operation))
-      (fun (source, operation) -> { source ; operation })
+      (fun ((source, nonce), operation) -> { source ; operation ; nonce })
       (merge_objs
-         (obj1
+         (obj2
-            (req "source" Contract_repr.encoding))
+            (req "source" Contract_repr.encoding)
+            (req "nonce" uint16))
          (union ~tag_size:`Uint8 [
              reveal_case (Tag 0) ;
              transaction_case (Tag 1) ;

src/proto_alpha/lib_protocol/src/operation_repr.mli

@@ -135,6 +135,7 @@ val unsigned_operation_encoding:
 type internal_operation = {
   source: Contract_repr.contract ;
   operation: manager_operation ;
+  nonce: int ;
 }
 
 val internal_operation_encoding:

src/proto_alpha/lib_protocol/src/raw_context.ml

@@ -24,6 +24,8 @@ type t = {
   block_storage: Int64.t ;
   operation_storage: Storage_limit_repr.t ;
   origination_nonce: Contract_repr.origination_nonce option ;
+  internal_nonce: int ;
+  internal_nonces_used: Int_set.t ;
 }
 
 type context = t
@@ -39,6 +41,33 @@ let recover ctxt = ctxt.context
 let record_endorsement ctxt k = { ctxt with endorsements_received = Int_set.add k ctxt.endorsements_received }
 let endorsement_already_recorded ctxt k = Int_set.mem k ctxt.endorsements_received
 
+type error += Too_many_internal_operations (* `Permanent *)
+
+let () =
+  let open Data_encoding in
+  register_error_kind
+    `Permanent
+    ~id:"too_many_internal_operations"
+    ~title: "Too many internal operations"
+    ~description:
+      "A transaction exceeded the hard limit \
+       of internal operations it can emit"
+    empty
+    (function Too_many_internal_operations -> Some () | _ -> None)
+    (fun () -> Too_many_internal_operations)
+
+let fresh_internal_nonce ctxt =
+  if Compare.Int.(ctxt.internal_nonce >= 65_535) then
+    error Too_many_internal_operations
+  else
+    ok ({ ctxt with internal_nonce = ctxt.internal_nonce + 1 }, ctxt.internal_nonce)
+let reset_internal_nonce ctxt =
+  { ctxt with internal_nonces_used = Int_set.empty ; internal_nonce = 0 }
+let record_internal_nonce ctxt k =
+  { ctxt with internal_nonces_used = Int_set.add k ctxt.internal_nonces_used }
+let internal_nonce_already_recorded ctxt k =
+  Int_set.mem k ctxt.internal_nonces_used
+
 let set_current_fitness ctxt fitness = { ctxt with fitness }
 
 let add_fees ctxt fees =
@@ -362,6 +391,8 @@ let prepare ~level ~timestamp ~fitness ctxt =
     operation_storage = Unaccounted ;
     block_storage = constants.Constants_repr.hard_storage_limit_per_block ;
     origination_nonce = None ;
+    internal_nonce = 0 ;
+    internal_nonces_used = Int_set.empty ;
   }
 
 let check_first_block ctxt =
@@ -411,6 +442,8 @@ let register_resolvers enc resolve =
       block_storage = Constants_repr.default.hard_storage_limit_per_block ;
       operation_storage = Unaccounted ;
       origination_nonce = None ;
+      internal_nonce = 0 ;
+      internal_nonces_used = Int_set.empty ;
     } in
     resolve faked_context str in
   Context.register_resolver enc  resolve

src/proto_alpha/lib_protocol/src/raw_context.mli

@@ -188,3 +188,16 @@ include T with type t := t and type context := context
 
 val record_endorsement: context -> int -> context
 val endorsement_already_recorded: context -> int -> bool
+
+(** Initialize the local nonce used for preventing a script to
+    duplicate an internal operation to replay it. *)
+val reset_internal_nonce: context -> context
+
+(** Increments the internal operation nonce. *)
+val fresh_internal_nonce: context -> (context * int) tzresult
+
+(** Mark an internal operation nonce as taken. *)
+val record_internal_nonce: context -> int -> context
+
+(** Check is the internal operation nonce has been taken. *)
+val internal_nonce_already_recorded: context -> int -> bool

src/proto_alpha/lib_protocol/src/script_interpreter.ml

@@ -593,7 +593,8 @@ let rec interp
               Transaction
                 { amount ; destination ;
                   parameters = Some (Script.lazy_expr (Micheline.strip_locations p)) } in
-            logged_return (Item ({ source = self ; operation }, rest), ctxt)
+            Lwt.return (fresh_internal_nonce ctxt) >>=? fun (ctxt, nonce) ->
+            logged_return (Item ({ source = self ; operation ; nonce }, rest), ctxt)
         | Create_account,
           Item (manager, Item (delegate, Item (delegatable, Item (credit, rest)))) ->
             Lwt.return (Gas.consume ctxt Interp_costs.create_account) >>=? fun ctxt ->
@@ -602,7 +603,8 @@ let rec interp
               Origination
                 { credit ; manager ; delegate ; preorigination = Some contract ;
                   delegatable ; script = None ; spendable = true } in
-            logged_return (Item ({ source = self ; operation },
+            Lwt.return (fresh_internal_nonce ctxt) >>=? fun (ctxt, nonce) ->
+            logged_return (Item ({ source = self ; operation ; nonce },
                                  Item (contract, rest)), ctxt)
         | Implicit_account, Item (key, rest) ->
             Lwt.return (Gas.consume ctxt Interp_costs.implicit_account) >>=? fun ctxt ->
@@ -631,14 +633,16 @@ let rec interp
                   delegatable ; spendable ;
                   script = Some { code = Script.lazy_expr code ;
                                   storage = Script.lazy_expr storage } } in
+            Lwt.return (fresh_internal_nonce ctxt) >>=? fun (ctxt, nonce) ->
             logged_return
-              (Item ({ source = self ; operation },
+              (Item ({ source = self ; operation ; nonce },
                      Item (contract, rest)), ctxt)
         | Set_delegate,
           Item (delegate, rest) ->
             Lwt.return (Gas.consume ctxt Interp_costs.create_account) >>=? fun ctxt ->
             let operation = Delegation delegate in
-            logged_return (Item ({ source = self ; operation }, rest), ctxt)
+            Lwt.return (fresh_internal_nonce ctxt) >>=? fun (ctxt, nonce) ->
+            logged_return (Item ({ source = self ; operation ; nonce }, rest), ctxt)
         | Balance, rest ->
             Lwt.return (Gas.consume ctxt Interp_costs.balance) >>=? fun ctxt ->
             Contract.get_balance ctxt self >>=? fun balance ->