From bc16b027c2355c864eb325c99a50c82822638850 Mon Sep 17 00:00:00 2001
From: Benjamin Canou <benjamin@canou.fr>
Date: Thu, 16 Feb 2017 19:01:35 +0100
Subject: [PATCH] Proto: allow origination of two contract with the same
 properties.

fixes #124
---
 .../bootstrap/client_proto_context.ml         |  67 ++++---
 .../bootstrap/client_proto_context.mli        |   2 +-
 .../embedded/bootstrap/client_proto_rpcs.ml   |  27 +--
 .../embedded/bootstrap/client_proto_rpcs.mli  |   8 +-
 src/proto/bootstrap/apply.ml                  |  48 +++--
 src/proto/bootstrap/contract_repr.ml          |  83 +++++----
 src/proto/bootstrap/contract_repr.mli         |  28 ++-
 src/proto/bootstrap/contract_storage.ml       |  23 +--
 src/proto/bootstrap/contract_storage.mli      |   4 +-
 src/proto/bootstrap/script_interpreter.ml     | 169 +++++++++---------
 src/proto/bootstrap/script_interpreter.mli    |  12 +-
 src/proto/bootstrap/services.ml               |  24 ++-
 src/proto/bootstrap/services_registration.ml  |  61 ++++---
 src/proto/bootstrap/storage.ml                |   2 +-
 src/proto/bootstrap/tezos_context.mli         |  20 +--
 test/scripts/originator.tz                    |  17 ++
 test/test_basic.ml                            |   9 +-
 17 files changed, 323 insertions(+), 281 deletions(-)
 create mode 100644 test/scripts/originator.tz

diff --git a/src/client/embedded/bootstrap/client_proto_context.ml b/src/client/embedded/bootstrap/client_proto_context.ml
index 93ff1b0f5..887a4bde3 100644
--- a/src/client/embedded/bootstrap/client_proto_context.ml
+++ b/src/client/embedded/bootstrap/client_proto_context.ml
@@ -76,17 +76,39 @@ let transfer cctxt
   Client_proto_rpcs.Helpers.Forge.Manager.transaction cctxt block
     ~net ~source ~sourcePubKey:src_pk ~counter ~amount
     ~destination ?parameters ~fee () >>=? fun bytes ->
-  cctxt.message "Forged the raw transaction frame." >>= fun () ->
-  let signed_bytes = Ed25519.append_signature src_sk bytes in
-  Client_node_rpcs.inject_operation cctxt ?force ~wait:true signed_bytes >>=? fun oph ->
-  cctxt.answer "Operation successfully injected in the node." >>= fun () ->
-  cctxt.answer "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
-  return ()
+  cctxt.Client_commands.message "Forged the raw origination frame." >>= fun () ->
+  Client_node_rpcs.Blocks.predecessor cctxt block >>= fun predecessor ->
+  let signature = Ed25519.sign src_sk bytes in
+  let signed_bytes = MBytes.concat bytes signature in
+  let oph = Operation_hash.hash_bytes [ signed_bytes ] in
+  Client_proto_rpcs.Helpers.apply_operation cctxt block
+    predecessor oph bytes (Some signature) >>=? fun contracts ->
+  Client_node_rpcs.inject_operation cctxt ?force ~wait:true signed_bytes >>=? fun injected_oph ->
+  assert (Operation_hash.equal oph injected_oph) ;
+  cctxt.message "Operation successfully injected in the node." >>= fun () ->
+  cctxt.message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
+  return contracts
+
+let originate cctxt ?force ~block ~src_sk bytes =
+  cctxt.Client_commands.message "Forged the raw origination frame." >>= fun () ->
+  Client_node_rpcs.Blocks.predecessor cctxt block >>= fun predecessor ->
+  let signature = Ed25519.sign src_sk bytes in
+  let signed_bytes = MBytes.concat bytes signature in
+  let oph = Operation_hash.hash_bytes [ signed_bytes ] in
+  Client_proto_rpcs.Helpers.apply_operation cctxt block
+    predecessor oph bytes (Some signature) >>=? function
+  | [ contract ] ->
+      Client_node_rpcs.inject_operation cctxt ?force ~wait:true signed_bytes >>=? fun injected_oph ->
+      assert (Operation_hash.equal oph injected_oph) ;
+      cctxt.message "Operation successfully injected in the node." >>= fun () ->
+      cctxt.message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
+      return contract
+  | contracts ->
+      cctxt.error "The origination introduced %d contracts instead of one." (List.length contracts)
 
 let originate_account cctxt
     block ?force
     ~source ~src_pk ~src_sk ~manager_pkh ?delegatable ?spendable ?delegate ~balance ~fee () =
-  let open Cli_entries in
   Client_node_rpcs.Blocks.net cctxt block >>= fun net ->
   Client_proto_rpcs.Context.Contract.counter cctxt block source >>=? fun pcounter ->
   let counter = Int32.succ pcounter in
@@ -95,19 +117,13 @@ let originate_account cctxt
   Client_proto_rpcs.Helpers.Forge.Manager.origination cctxt block
     ~net ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh
     ~counter ~balance ?spendable
-    ?delegatable ?delegatePubKey:delegate ~fee () >>=? fun (contract, bytes) ->
-  cctxt.message "Forged the raw origination frame." >>= fun () ->
-  let signed_bytes = Ed25519.append_signature src_sk bytes in
-  Client_node_rpcs.inject_operation cctxt ?force ~wait:true signed_bytes >>=? fun oph ->
-  cctxt.message "Operation successfully injected in the node." >>= fun () ->
-  cctxt.message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
-  return contract
+    ?delegatable ?delegatePubKey:delegate ~fee () >>=? fun bytes ->
+  originate cctxt ?force ~block ~src_sk bytes
 
 let originate_contract cctxt
     block ?force
     ~source ~src_pk ~src_sk ~manager_pkh ~balance ?delegatable ?delegatePubKey
     ~(code:Script.code) ~init ~fee () =
-  let open Cli_entries in
   Client_proto_programs.parse_data cctxt init >>= fun storage ->
   let init = Script.{ storage ; storage_type = code.storage_type } in
   Client_proto_rpcs.Context.Contract.counter cctxt block source >>=? fun pcounter ->
@@ -119,13 +135,8 @@ let originate_contract cctxt
     ~net ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh
     ~counter ~balance ~spendable:!spendable
     ?delegatable ?delegatePubKey
-    ~script:(code, init) ~fee () >>=? fun (contract, bytes) ->
-  cctxt.message "Forged the raw origination frame." >>= fun () ->
-  let signed_bytes = Ed25519.append_signature src_sk bytes in
-  Client_node_rpcs.inject_operation cctxt ?force ~wait:true signed_bytes >>=? fun oph ->
-  cctxt.message "Operation successfully injected in the node." >>= fun () ->
-  cctxt.message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
-  return contract
+    ~script:(code, init) ~fee () >>=? fun bytes ->
+  originate cctxt ?force ~block ~src_sk bytes
 
 let group =
   { Cli_entries.name = "context" ;
@@ -248,9 +259,13 @@ let commands () =
        @@ stop)
       (fun amount (_, source) (_, destination) cctxt ->
          (Client_proto_contracts.get_manager cctxt (block ()) source >>=? fun src_pkh ->
-         Client_keys.get_key cctxt src_pkh >>=? fun (src_name, src_pk, src_sk) ->
-         cctxt.message "Got the source's manager keys (%s)." src_name >>= fun () ->
-         transfer cctxt (block ()) ~force:!force
-           ~source ~src_pk ~src_sk ~destination ?arg:!arg ~amount ~fee:!fee ()) >>=
+          Client_keys.get_key cctxt src_pkh >>=? fun (src_name, src_pk, src_sk) ->
+          cctxt.message "Got the source's manager keys (%s)." src_name >>= fun () ->
+          (transfer cctxt (block ()) ~force:!force
+             ~source ~src_pk ~src_sk ~destination ?arg:!arg ~amount ~fee:!fee ()) >>=? fun contracts ->
+          Lwt_list.iter_s
+            (fun c -> cctxt.message "New contract %a originated from a smart contract."
+                Contract.pp c)
+            contracts >>= fun () -> return ()) >>=
          Client_proto_rpcs.handle_error cctxt)
   ]
diff --git a/src/client/embedded/bootstrap/client_proto_context.mli b/src/client/embedded/bootstrap/client_proto_context.mli
index 03859e72b..4b519aec8 100644
--- a/src/client/embedded/bootstrap/client_proto_context.mli
+++ b/src/client/embedded/bootstrap/client_proto_context.mli
@@ -18,7 +18,7 @@ val transfer:
   ?arg:string ->
   amount:Tez.t ->
   fee:Tez.t ->
-  unit -> unit tzresult Lwt.t
+  unit -> Contract.t list tzresult Lwt.t
 
 val originate_account:
   Client_commands.context ->
diff --git a/src/client/embedded/bootstrap/client_proto_rpcs.ml b/src/client/embedded/bootstrap/client_proto_rpcs.ml
index e8053bb99..4ca1c9c75 100644
--- a/src/client/embedded/bootstrap/client_proto_rpcs.ml
+++ b/src/client/embedded/bootstrap/client_proto_rpcs.ml
@@ -132,13 +132,17 @@ module Helpers = struct
   let typecheck_code cctxt =
     call_error_service1 cctxt Services.Helpers.typecheck_code
 
+  let apply_operation cctxt block pred_block hash forged_operation signature =
+    call_error_service1 cctxt Services.Helpers.apply_operation
+      block (pred_block, hash, forged_operation, signature)
+
   let run_code cctxt block code (storage, input) =
     call_error_service1 cctxt Services.Helpers.run_code
-      block (code, storage, input, None, None)
+      block (code, storage, input, None, None, None)
 
   let trace_code cctxt block code (storage, input) =
     call_error_service1 cctxt Services.Helpers.trace_code
-      block (code, storage, input, None, None)
+      block (code, storage, input, None, None, None)
 
   let typecheck_data cctxt =
     call_error_service1 cctxt Services.Helpers.typecheck_data
@@ -180,16 +184,11 @@ module Helpers = struct
                                counter ; operations ; fee } in
         (call_error_service1 cctxt Services.Helpers.Forge.operations block
            ({net_id=net}, Sourced_operations ops))
-        >>=? fun (bytes, contracts) ->
-        return (bytes, match contracts with None -> [] | Some l -> l)
       let transaction cctxt
           block ~net ~source ?sourcePubKey ~counter
           ~amount ~destination ?parameters ~fee ()=
         operations cctxt block ~net ~source ?sourcePubKey ~counter ~fee
           Tezos_context.[Transaction { amount ; parameters ; destination }]
-        >>=? fun (bytes, contracts) ->
-        assert (contracts = []) ;
-        return bytes
       let origination cctxt
           block ~net
           ~source ?sourcePubKey ~counter
@@ -207,24 +206,14 @@ module Helpers = struct
                           delegatable ;
                           credit = balance }
           ]
-        >>=? fun (bytes, contracts) ->
-        match contracts with
-        | [contract] -> return (contract, bytes)
-        | _ -> assert false
       let issuance cctxt
           block ~net ~source ?sourcePubKey ~counter ~assetType ~quantity ~fee ()=
         operations cctxt block ~net ~source ?sourcePubKey ~counter ~fee
           Tezos_context.[Issuance { asset = assetType ; amount = quantity }]
-        >>=? fun (bytes, contracts) ->
-        assert (contracts = []) ;
-        return bytes
       let delegation cctxt
           block ~net ~source ?sourcePubKey ~counter ~fee delegate =
         operations cctxt block ~net ~source ?sourcePubKey ~counter ~fee
           Tezos_context.[Delegation delegate]
-        >>=? fun (bytes, contracts) ->
-        assert (contracts = []) ;
-        return bytes
     end
     module Delegate = struct
       let operations cctxt
@@ -232,8 +221,6 @@ module Helpers = struct
         let ops = Delegate_operations { source ; operations } in
         (call_error_service1 cctxt Services.Helpers.Forge.operations block
            ({net_id=net}, Sourced_operations ops))
-        >>=? fun (hash, _contracts) ->
-        return hash
       let endorsement cctxt
           b ~net ~source ~block ~slot () =
         operations cctxt b ~net ~source
@@ -243,8 +230,6 @@ module Helpers = struct
       let operations cctxt block ~net operations =
         (call_error_service1 cctxt Services.Helpers.Forge.operations block
            ({net_id=net}, Anonymous_operations operations))
-        >>=? fun (hash, _contracts) ->
-        return hash
       let seed_nonce_revelation cctxt
           block ~net ~level ~nonce () =
         operations cctxt block ~net [Seed_nonce_revelation { level ; nonce }]
diff --git a/src/client/embedded/bootstrap/client_proto_rpcs.mli b/src/client/embedded/bootstrap/client_proto_rpcs.mli
index 69b877adf..9bb26d016 100644
--- a/src/client/embedded/bootstrap/client_proto_rpcs.mli
+++ b/src/client/embedded/bootstrap/client_proto_rpcs.mli
@@ -135,6 +135,10 @@ module Helpers : sig
   val minimal_time:
     Client_commands.context ->
     block -> ?prio:int -> unit -> Time.t tzresult Lwt.t
+  val apply_operation:
+    Client_commands.context ->
+    block -> Block_hash.t -> Operation_hash.t -> MBytes.t -> MBytes.t option ->
+    (Contract.t list) tzresult Lwt.t
   val run_code:
     Client_commands.context ->
     block -> Script.code ->
@@ -188,7 +192,7 @@ module Helpers : sig
         counter:int32 ->
         fee:Tez.t ->
         manager_operation list ->
-        (MBytes.t * Contract.t list) tzresult Lwt.t
+        MBytes.t tzresult Lwt.t
       val transaction:
         Client_commands.context ->
         block ->
@@ -216,7 +220,7 @@ module Helpers : sig
         ?script:(Script.code * Script.storage) ->
         fee:Tez.t->
         unit ->
-        (Contract.t * MBytes.t) tzresult Lwt.t
+        MBytes.t tzresult Lwt.t
       val issuance:
         Client_commands.context ->
         block ->
diff --git a/src/proto/bootstrap/apply.ml b/src/proto/bootstrap/apply.ml
index 7db9a1c1f..24a0e3d0f 100644
--- a/src/proto/bootstrap/apply.ml
+++ b/src/proto/bootstrap/apply.ml
@@ -48,14 +48,15 @@ let rec is_reject = function
 type error += Non_scripted_contract_with_parameter
 type error += Scripted_contract_without_paramater
 
-let apply_manager_operation_content ctxt accept_failing_script source = function
+let apply_manager_operation_content ctxt origination_nonce accept_failing_script source = function
   | Transaction { amount ; parameters ; destination } -> begin
       Contract.spend ctxt source amount >>=? fun ctxt ->
       Contract.credit ctxt destination amount >>=? fun ctxt ->
       Contract.get_script ctxt destination >>=? function
       | No_script -> begin
           match parameters with
-          | None | Some (Prim (_, "Unit", [])) -> return ctxt
+          | None | Some (Prim (_, "Unit", [])) ->
+              return (ctxt, origination_nonce)
           | Some _ -> fail Non_scripted_contract_with_parameter
         end
       | Script { code ; storage } ->
@@ -63,18 +64,19 @@ let apply_manager_operation_content ctxt accept_failing_script source = function
           | None -> fail Scripted_contract_without_paramater
           | Some parameters ->
               Script_interpreter.execute
+                origination_nonce
                 source destination ctxt storage code amount parameters
                 (Constants.instructions_per_transaction ctxt)
               >>= function
-              | Ok (storage_res, _res, _steps, ctxt) ->
+              | Ok (storage_res, _res, _steps, ctxt, origination_nonce) ->
                   (* TODO: pay for the steps and the storage diff:
                      update_script_storage checks the storage cost *)
                   Contract.update_script_storage
                     ctxt destination storage_res >>=? fun ctxt ->
-                  return ctxt
+                  return (ctxt, origination_nonce)
               | Error err ->
                   if accept_failing_script && is_reject err then
-                    return ctxt
+                    return (ctxt, origination_nonce)
                   else
                     Lwt.return (Error err)
     end
@@ -94,16 +96,19 @@ let apply_manager_operation_content ctxt accept_failing_script source = function
       Contract.spend ctxt source credit >>=? fun ctxt ->
       Lwt.return Tez.(credit -? Constants.origination_burn) >>=? fun balance ->
       Contract.originate ctxt
+        origination_nonce
         ~manager ~delegate ~balance
-        ~script ~spendable ~delegatable >>=? fun (ctxt, _) ->
-      return ctxt
+        ~script ~spendable ~delegatable >>=? fun (ctxt, _, origination_nonce) ->
+      return (ctxt, origination_nonce)
   | Issuance { asset = (asset, key); amount } ->
-      Contract.issue ctxt source asset key amount
+      Contract.issue ctxt source asset key amount >>=? fun ctxt ->
+      return (ctxt, origination_nonce)
       (* TODO: pay for the storage diff *)
   | Delegation delegate ->
       Contract.is_delegatable ctxt source >>=? fun delegatable ->
       fail_unless delegatable Contract_not_delegatable >>=? fun () ->
-      Contract.set_delegate ctxt source delegate
+      Contract.set_delegate ctxt source delegate >>=? fun ctxt ->
+      return (ctxt, origination_nonce)
 
 let check_signature_and_update_public_key ctxt id public_key op =
   begin
@@ -118,7 +123,8 @@ let check_signature_and_update_public_key ctxt id public_key op =
 
 (* TODO document parameters *)
 let apply_sourced_operation
-    ctxt accept_failing_script miner_contract pred_block block_prio operation ops =
+    ctxt accept_failing_script miner_contract pred_block block_prio
+    operation origination_nonce ops =
   match ops with
   | Manager_operations { source ; public_key ; fee ; counter ; operations = contents } ->
       Contract.get_manager ctxt source >>=? fun manager ->
@@ -132,10 +138,10 @@ let apply_sourced_operation
        | None -> return ctxt
        | Some contract ->
            Contract.credit ctxt contract fee) >>=? fun ctxt ->
-      fold_left_s (fun ctxt content ->
-          apply_manager_operation_content ctxt accept_failing_script source content)
-        ctxt contents >>=? fun ctxt ->
-      return ctxt
+      fold_left_s (fun (ctxt, origination_nonce) content ->
+          apply_manager_operation_content ctxt origination_nonce
+            accept_failing_script source content)
+        (ctxt, origination_nonce) contents
   | Delegate_operations { source ; operations = contents } ->
       let delegate = Ed25519.hash source in
       check_signature_and_update_public_key
@@ -146,7 +152,7 @@ let apply_sourced_operation
           apply_delegate_operation_content
             ctxt delegate pred_block block_prio content)
         ctxt contents >>=? fun ctxt ->
-      return ctxt
+      return (ctxt, origination_nonce)
 
 let apply_anonymous_operation ctxt miner_contract kind =
   match kind with
@@ -167,11 +173,14 @@ let apply_operation
   | Anonymous_operations ops ->
       fold_left_s
         (fun ctxt -> apply_anonymous_operation ctxt miner_contract)
-        ctxt ops
+        ctxt ops >>=? fun ctxt ->
+      return (ctxt, [])
   | Sourced_operations op ->
+      let origination_nonce = Contract.initial_origination_nonce operation.hash in
       apply_sourced_operation
         ctxt accept_failing_script miner_contract pred_block block_prio
-        operation op
+        operation origination_nonce op >>=? fun (ctxt, origination_nonce) ->
+      return (ctxt, Contract.originated_contracts origination_nonce)
 
 let may_start_new_cycle ctxt =
   Mining.dawn_of_a_new_cycle ctxt >>=? function
@@ -210,7 +219,8 @@ let apply_main ctxt accept_failing_script block operations =
       apply_operation
         ctxt accept_failing_script
         (Some (Contract.default_contract delegate_pkh))
-        block.shell.predecessor priority operation)
+        block.shell.predecessor priority operation
+      >>=? fun (ctxt, _contracts) -> return ctxt)
     ctxt operations >>=? fun ctxt ->
   (* end of level (from this point nothing should fail) *)
   let reward =
@@ -279,7 +289,7 @@ let prevalidate ctxt pred_block sort operations =
     (Lwt_list.fold_left_s
        (fun (ctxt, r) op ->
           apply_operation ctxt false None pred_block 0l op >>= function
-          | Ok ctxt ->
+          | Ok (ctxt, _contracts) ->
               let applied = op.hash :: r.Updater.applied in
               Lwt.return (ctxt, { r with Updater.applied} )
           | Error errors ->
diff --git a/src/proto/bootstrap/contract_repr.ml b/src/proto/bootstrap/contract_repr.ml
index cca8ce94f..52b4f4c06 100644
--- a/src/proto/bootstrap/contract_repr.ml
+++ b/src/proto/bootstrap/contract_repr.ml
@@ -9,29 +9,21 @@
 
 open Tezos_hash
 
-type descr = {
-  manager: Ed25519.Public_key_hash.t ;
-  delegate: Ed25519.Public_key_hash.t option ;
-  spendable: bool ;
-  delegatable: bool ;
-  script: Script_repr.t ;
-}
-
 type t =
   | Default of Ed25519.Public_key_hash.t
-  | Hash of Contract_hash.t
+  | Originated of Contract_hash.t
 type contract = t
 
 type error += Invalid_contract_notation of string
 
 let to_b58check = function
   | Default pbk -> Ed25519.Public_key_hash.to_b58check pbk
-  | Hash h -> Contract_hash.to_b58check h
+  | Originated h -> Contract_hash.to_b58check h
 
 let of_b58check s =
   match Base58.decode s with
   | Some (Ed25519.Public_key_hash.Hash h) -> ok (Default h)
-  | Some (Contract_hash.Hash h) -> ok (Hash h)
+  | Some (Contract_hash.Hash h) -> ok (Originated h)
   | _ -> error (Invalid_contract_notation s)
 
 let encoding =
@@ -52,8 +44,8 @@ let encoding =
             (function Default k -> Some k | _ -> None)
             (fun k -> Default k) ;
           case ~tag:1 Contract_hash.encoding
-            (function Hash k -> Some k | _ -> None)
-            (fun k -> Hash k) ;
+            (function Originated k -> Some k | _ -> None)
+            (fun k -> Originated k) ;
         ])
     ~json:
       (conv
@@ -84,33 +76,46 @@ let default_contract id = Default id
 
 let is_default = function
   | Default m -> Some m
-  | Hash _ -> None
+  | Originated _ -> None
 
-let descr_encoding =
+
+type origination_nonce =
+  { operation_hash: Operation_hash.t ;
+    origination_index: int32 }
+
+let origination_nonce_encoding =
   let open Data_encoding in
   conv
-    (fun { manager; delegate; spendable; delegatable; script } ->
-       (manager, delegate, spendable, delegatable, script))
-    (fun (manager, delegate, spendable, delegatable, script) ->
-       { manager; delegate; spendable; delegatable; script })
-    (obj5
-       (req "manager" Ed25519.Public_key_hash.encoding)
-       (opt "delegate" Ed25519.Public_key_hash.encoding)
-       (dft "spendable" bool false)
-       (dft "delegatable" bool false)
-       (req "script" Script_repr.encoding))
+    (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 generic_contract ~manager ~delegate ~spendable ~delegatable ~script =
-  match delegate, spendable, delegatable, script with
-  | Some delegate, true, false, Script_repr.No_script
-    when Ed25519.Public_key_hash.equal manager delegate ->
-      default_contract manager
-  | _ ->
-      let data =
-        Data_encoding.Binary.to_bytes
-          descr_encoding
-          { manager; delegate; spendable; delegatable; script } in
-      Hash (Contract_hash.hash_bytes [data])
+let originated_contract nonce =
+  let data =
+    Data_encoding.Binary.to_bytes origination_nonce_encoding nonce in
+  Originated (Contract_hash.hash_bytes [data])
+
+let originated_contracts ({ origination_index } as origination_nonce) =
+  let rec contracts acc origination_index =
+    if Compare.Int32.(origination_index < 0l) 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 origination_index)
+
+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 arg =
   let construct = to_b58check in
@@ -129,10 +134,10 @@ let compare l1 l2 =
   match l1, l2 with
   | Default pkh1, Default pkh2 ->
       Ed25519.Public_key_hash.compare pkh1 pkh2
-  | Hash h1, Hash h2 ->
+  | Originated h1, Originated h2 ->
       Contract_hash.compare h1 h2
-  | Default _, Hash _ -> -1
-  | Hash _, Default _ -> 1
+  | Default _, Originated _ -> -1
+  | Originated _, Default _ -> 1
 let (=) l1 l2 = Compare.Int.(=) (compare l1 l2) 0
 let (<>) l1 l2 = Compare.Int.(<>) (compare l1 l2) 0
 let (>) l1 l2 = Compare.Int.(>) (compare l1 l2) 0
diff --git a/src/proto/bootstrap/contract_repr.mli b/src/proto/bootstrap/contract_repr.mli
index adf28907b..2d43688c9 100644
--- a/src/proto/bootstrap/contract_repr.mli
+++ b/src/proto/bootstrap/contract_repr.mli
@@ -11,30 +11,23 @@ open Tezos_hash
 
 type t = private
   | Default of Ed25519.Public_key_hash.t
-  | Hash of Contract_hash.t
+  | Originated of Contract_hash.t
 type contract = t
 
-type descr = {
-  manager: Ed25519.Public_key_hash.t ;
-  delegate: Ed25519.Public_key_hash.t option ;
-  spendable: bool ;
-  delegatable: bool ;
-  script: Script_repr.t ;
-}
-
 include Compare.S with type t := contract
 
 val default_contract : Ed25519.Public_key_hash.t -> contract
 
 val is_default : contract -> Ed25519.Public_key_hash.t option
 
-val generic_contract :
-  manager:Ed25519.Public_key_hash.t ->
-  delegate:Ed25519.Public_key_hash.t option ->
-  spendable:bool ->
-  delegatable:bool ->
-  script:Script_repr.t ->
-  contract
+type origination_nonce
+
+val originated_contract : origination_nonce -> contract
+val originated_contracts : origination_nonce -> contract list
+
+val initial_origination_nonce : Operation_hash.t -> origination_nonce
+val incr_origination_nonce : origination_nonce -> origination_nonce
+
 
 (** {2 Human readable notation} ***********************************************)
 
@@ -47,6 +40,7 @@ val of_b58check: string -> contract tzresult
 (** {2 Serializers} ***********************************************************)
 
 val encoding : contract Data_encoding.t
-val descr_encoding : descr Data_encoding.t
+
+val origination_nonce_encoding : origination_nonce Data_encoding.t
 
 val arg : contract RPC.Arg.arg
diff --git a/src/proto/bootstrap/contract_storage.ml b/src/proto/bootstrap/contract_storage.ml
index 97dfa8cd1..2dc58be5c 100644
--- a/src/proto/bootstrap/contract_storage.ml
+++ b/src/proto/bootstrap/contract_storage.ml
@@ -7,8 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Contract_repr
-
 type error +=
   | Insert_coin of Contract_repr.contract (* TODO: doc *)
   | Initial_amount_too_low (* TODO: doc *)
@@ -82,11 +80,10 @@ let create_base c contract ~balance ~manager ~delegate ~script ~spendable ~deleg
   Storage.Contract.Set.add c contract >>=? fun c ->
   Lwt.return (Ok (c, contract))
 
-let create c ~balance ~manager ~delegate ~script ~spendable ~delegatable =
-  let contract =
-    Contract_repr.generic_contract ~manager ~delegate
-      ~script ~spendable ~delegatable in
-  create_base c contract ~balance ~manager ~delegate ~script ~spendable ~delegatable
+let create c nonce ~balance ~manager ~delegate ~script ~spendable ~delegatable =
+  let contract = Contract_repr.originated_contract nonce in
+  create_base c contract ~balance ~manager ~delegate ~script ~spendable ~delegatable >>=? fun (ctxt, contract) ->
+  return (ctxt, contract, Contract_repr.incr_origination_nonce nonce)
 
 let create_default c manager ~balance =
   let contract = Contract_repr.default_contract manager in
@@ -201,14 +198,6 @@ let is_spendable c contract =
     end
   | Some v -> return v
 
-let get_descr c contract =
-  get_manager c contract >>=? fun manager ->
-  get_delegate_opt c contract >>=? fun delegate ->
-  is_spendable c contract >>=? fun spendable ->
-  is_delegatable c contract >>=? fun delegatable ->
-  get_script c contract >>=? fun script ->
-  return { manager ; delegate ; spendable ; delegatable ; script }
-
 let set_delegate c contract delegate =
   (* A contract delegate can be set only if the contract is delegatable *)
   Storage.Contract.Delegatable.get c contract >>=? fun delegatable ->
@@ -300,10 +289,10 @@ let spend c contract amount =
   then fail Unspendable_contract
   else unconditional_spend c contract amount
 
-let originate c ~balance ~manager ~script ~delegate ~spendable ~delegatable  =
+let originate c nonce ~balance ~manager ~script ~delegate ~spendable ~delegatable  =
   check_fee script balance >>=? fun possible ->
   fail_unless possible Initial_amount_too_low >>=? fun () ->
-  create c ~balance ~manager ~delegate ~script ~spendable ~delegatable
+  create c nonce ~balance ~manager ~delegate ~script ~spendable ~delegatable
 
 let init c =
   Storage.Contract.Global_counter.init c 0l
diff --git a/src/proto/bootstrap/contract_storage.mli b/src/proto/bootstrap/contract_storage.mli
index 589fb2b03..b86917f39 100644
--- a/src/proto/bootstrap/contract_storage.mli
+++ b/src/proto/bootstrap/contract_storage.mli
@@ -32,7 +32,6 @@ val increment_counter: Storage.t -> Contract_repr.t -> Storage.t tzresult Lwt.t
 val is_delegatable : Storage.t -> Contract_repr.t -> bool tzresult Lwt.t
 val is_spendable : Storage.t -> Contract_repr.t -> bool tzresult Lwt.t
 
-val get_descr: Storage.t -> Contract_repr.t -> Contract_repr.descr tzresult Lwt.t
 val get_manager: Storage.t -> Contract_repr.t -> Ed25519.Public_key_hash.t tzresult Lwt.t
 val get_delegate: Storage.t -> Contract_repr.t -> Ed25519.Public_key_hash.t tzresult Lwt.t
 val get_delegate_opt: Storage.t -> Contract_repr.t -> Ed25519.Public_key_hash.t option tzresult Lwt.t
@@ -64,13 +63,14 @@ val issue :
 
 val originate :
   Storage.t ->
+  Contract_repr.origination_nonce ->
   balance:Tez_repr.t ->
   manager:Ed25519.Public_key_hash.t ->
   script:Script_repr.t ->
   delegate:Ed25519.Public_key_hash.t option ->
   spendable:bool ->
   delegatable:bool ->
-  (Storage.t * Contract_repr.t) tzresult Lwt.t
+  (Storage.t * Contract_repr.t * Contract_repr.origination_nonce) tzresult Lwt.t
 
 val init :
   Storage.t -> Storage.t tzresult Lwt.t
diff --git a/src/proto/bootstrap/script_interpreter.ml b/src/proto/bootstrap/script_interpreter.ml
index 42bd891a9..d398c3d3f 100644
--- a/src/proto/bootstrap/script_interpreter.ml
+++ b/src/proto/bootstrap/script_interpreter.ml
@@ -75,23 +75,24 @@ let rec unparse_stack
 let rec interp
   : type p r.
     ?log: (Script.location * int * Script.expr list) list ref ->
-    int -> Contract.t -> Contract.t -> Tez.t ->
-    context -> (p, r) lambda -> p -> (r * int * context) tzresult Lwt.t
-  = fun ?log qta orig source amount ctxt (Lam (code, _)) arg ->
+    Contract.origination_nonce -> int -> Contract.t -> Contract.t -> Tez.t ->
+    context -> (p, r) lambda -> p ->
+    (r * int * context * Contract.origination_nonce) tzresult Lwt.t
+  = fun ?log origination qta orig source amount ctxt (Lam (code, _)) arg ->
     let rec step
       : type b a.
-        int -> context -> (b, a) descr -> b stack ->
-        (a stack * int * context) tzresult Lwt.t =
-      fun qta ctxt ({ instr ; loc } as descr) stack ->
+        Contract.origination_nonce -> int -> context -> (b, a) descr -> b stack ->
+        (a stack * int * context * Contract.origination_nonce) tzresult Lwt.t =
+      fun origination qta ctxt ({ instr ; loc } as descr) stack ->
         if Compare.Int.(qta <= 0) then
           fail Quota_exceeded
         else
-          let logged_return ((ret, qta, _) as res) =
+          let logged_return ?(origination = origination) (ret, qta, ctxt) =
             match log with
-            | None -> return res
+            | None -> return (ret, qta, ctxt, origination)
             | Some log ->
                 log := (descr.loc, qta, unparse_stack (ret, descr.aft)) :: !log ;
-                return res in
+                return (ret, qta, ctxt, origination) in
           match instr, stack with
           (* stack ops *)
           | Drop, Item (_, rest) ->
@@ -108,9 +109,9 @@ let rec interp
           | Cons_none _, rest ->
               logged_return (Item (None, rest), qta - 1, ctxt)
           | If_none (bt, _), Item (None, rest) ->
-              step qta ctxt bt rest
+              step origination qta ctxt bt rest
           | If_none (_, bf), Item (Some v, rest) ->
-              step qta ctxt bf (Item (v, rest))
+              step origination qta ctxt bf (Item (v, rest))
           (* pairs *)
           | Cons_pair, Item (a, Item (b, rest)) ->
               logged_return (Item ((a, b), rest), qta - 1, ctxt)
@@ -124,33 +125,33 @@ let rec interp
           | Right, Item (v, rest) ->
               logged_return (Item (R v, rest), qta - 1, ctxt)
           | If_left (bt, _), Item (L v, rest) ->
-              step qta ctxt bt (Item (v, rest))
+              step origination qta ctxt bt (Item (v, rest))
           | If_left (_, bf), Item (R v, rest) ->
-              step qta ctxt bf (Item (v, rest))
+              step origination qta ctxt bf (Item (v, rest))
           (* lists *)
           | Cons_list, Item (hd, Item (tl, rest)) ->
               logged_return (Item (hd :: tl, rest), qta - 1, ctxt)
           | Nil, rest ->
               logged_return (Item ([], rest), qta - 1, ctxt)
           | If_cons (_, bf), Item ([], rest) ->
-              step qta ctxt bf rest
+              step origination qta ctxt bf rest
           | If_cons (bt, _), Item (hd :: tl, rest) ->
-              step qta ctxt bt (Item (hd, Item (tl, rest)))
+              step origination qta ctxt bt (Item (hd, Item (tl, rest)))
           | List_map, Item (lam, Item (l, rest)) ->
-              fold_left_s (fun (tail, qta, ctxt) arg ->
-                  interp ?log qta orig source amount ctxt lam arg
-                  >>=? fun (ret, qta, ctxt) ->
-                  return (ret :: tail, qta, ctxt))
-                ([], qta, ctxt) l >>=? fun (res, qta, ctxt) ->
-              logged_return (Item (res, rest), qta, ctxt)
+              fold_left_s (fun (tail, qta, ctxt, origination) arg ->
+                  interp ?log origination qta orig source amount ctxt lam arg
+                  >>=? fun (ret, qta, ctxt, origination) ->
+                  return (ret :: tail, qta, ctxt, origination))
+                ([], qta, ctxt, origination) l >>=? fun (res, qta, ctxt, origination) ->
+              logged_return ~origination (Item (res, rest), qta, ctxt)
           | List_reduce, Item (lam, Item (l, Item (init, rest))) ->
               fold_left_s
-                (fun (partial, qta, ctxt) arg ->
-                   interp ?log qta orig source amount ctxt lam (arg, partial)
-                   >>=? fun (partial, qta, ctxt) ->
-                   return (partial, qta, ctxt))
-                (init, qta, ctxt) l >>=? fun (res, qta, ctxt) ->
-              logged_return (Item (res, rest), qta, ctxt)
+                (fun (partial, qta, ctxt, origination) arg ->
+                   interp ?log origination qta orig source amount ctxt lam (arg, partial)
+                   >>=? fun (partial, qta, ctxt, origination) ->
+                   return (partial, qta, ctxt, origination))
+                (init, qta, ctxt, origination) l >>=? fun (res, qta, ctxt, origination) ->
+              logged_return ~origination (Item (res, rest), qta, ctxt)
           (* sets *)
           | Empty_set t, rest ->
               logged_return (Item (empty_set t, rest), qta - 1, ctxt)
@@ -158,22 +159,22 @@ let rec interp
               let items =
                 List.rev (set_fold (fun e acc -> e :: acc) set []) in
               fold_left_s
-                (fun (res, qta, ctxt) arg ->
-                   interp ?log qta orig source amount ctxt lam arg >>=?
-                   fun (ret, qta, ctxt) ->
-                   return (set_update ret true res, qta, ctxt))
-                (empty_set t, qta, ctxt) items >>=? fun (res, qta, ctxt) ->
-              logged_return (Item (res, rest), qta, ctxt)
+                (fun (res, qta, ctxt, origination) arg ->
+                   interp ?log origination qta orig source amount ctxt lam arg >>=?
+                   fun (ret, qta, ctxt, origination) ->
+                   return (set_update ret true res, qta, ctxt, origination))
+                (empty_set t, qta, ctxt, origination) items >>=? fun (res, qta, ctxt, origination) ->
+              logged_return ~origination (Item (res, rest), qta, ctxt)
           | Set_reduce, Item (lam, Item (set, Item (init, rest))) ->
               let items =
                 List.rev (set_fold (fun e acc -> e :: acc) set []) in
               fold_left_s
-                (fun (partial, qta, ctxt) arg ->
-                   interp ?log qta orig source amount ctxt lam (arg, partial)
-                   >>=? fun (partial, qta, ctxt) ->
-                   return (partial, qta, ctxt))
-                (init, qta, ctxt) items >>=? fun (res, qta, ctxt) ->
-              logged_return (Item (res, rest), qta, ctxt)
+                (fun (partial, qta, ctxt, origination) arg ->
+                   interp ?log origination qta orig source amount ctxt lam (arg, partial)
+                   >>=? fun (partial, qta, ctxt, origination) ->
+                   return (partial, qta, ctxt, origination))
+                (init, qta, ctxt, origination) items >>=? fun (res, qta, ctxt, origination) ->
+              logged_return ~origination (Item (res, rest), qta, ctxt)
           | Set_mem, Item (v, Item (set, rest)) ->
               logged_return (Item (set_mem v set, rest), qta - 1, ctxt)
           | Set_update, Item (v, Item (presence, Item (set, rest))) ->
@@ -185,22 +186,22 @@ let rec interp
               let items =
                 List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in
               fold_left_s
-                (fun (acc, qta, ctxt) (k, v) ->
-                   interp ?log qta orig source amount ctxt lam (k, v)
-                   >>=? fun (ret, qta, ctxt) ->
-                   return (map_update k (Some ret) acc, qta, ctxt))
-                (empty_map (map_key_ty map), qta, ctxt) items >>=? fun (res, qta, ctxt) ->
-              logged_return (Item (res, rest), qta, ctxt)
+                (fun (acc, qta, ctxt, origination) (k, v) ->
+                   interp ?log origination qta orig source amount ctxt lam (k, v)
+                   >>=? fun (ret, qta, ctxt, origination) ->
+                   return (map_update k (Some ret) acc, qta, ctxt, origination))
+                (empty_map (map_key_ty map), qta, ctxt, origination) items >>=? fun (res, qta, ctxt, origination) ->
+              logged_return ~origination (Item (res, rest), qta, ctxt)
           | Map_reduce, Item (lam, Item (map, Item (init, rest))) ->
               let items =
                 List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in
               fold_left_s
-                (fun (partial, qta, ctxt) arg ->
-                   interp ?log qta orig source amount ctxt lam (arg, partial)
-                   >>=? fun (partial, qta, ctxt) ->
-                   return (partial, qta, ctxt))
-                (init, qta, ctxt) items >>=? fun (res, qta, ctxt) ->
-              logged_return (Item (res, rest), qta, ctxt)
+                (fun (partial, qta, ctxt, origination) arg ->
+                   interp ?log origination qta orig source amount ctxt lam (arg, partial)
+                   >>=? fun (partial, qta, ctxt, origination) ->
+                   return (partial, qta, ctxt, origination))
+                (init, qta, ctxt, origination) items >>=? fun (res, qta, ctxt, origination) ->
+              logged_return ~origination (Item (res, rest), qta, ctxt)
           | Map_mem, Item (v, Item (map, rest)) ->
               logged_return (Item (map_mem v map, rest), qta - 1, ctxt)
           | Map_get, Item (v, Item (map, rest)) ->
@@ -307,25 +308,25 @@ let rec interp
               logged_return (Item (Script_int.lognot kind x, rest), qta - 1, ctxt)
           (* control *)
           | Seq (hd, tl), stack ->
-              step qta ctxt hd stack >>=? fun (trans, qta, ctxt) ->
-              step qta ctxt tl trans
+              step origination qta ctxt hd stack >>=? fun (trans, qta, ctxt, origination) ->
+              step origination qta ctxt tl trans
           | If (bt, _), Item (true, rest) ->
-              step qta ctxt bt rest
+              step origination qta ctxt bt rest
           | If (_, bf), Item (false, rest) ->
-              step qta ctxt bf rest
+              step origination qta ctxt bf rest
           | Loop body, Item (true, rest) ->
-              step qta ctxt body rest >>=? fun (trans, qta, ctxt) ->
-              step (qta - 1) ctxt descr trans
+              step origination qta ctxt body rest >>=? fun (trans, qta, ctxt, origination) ->
+              step origination (qta - 1) ctxt descr trans
           | Loop _, Item (false, rest) ->
               logged_return (rest, qta, ctxt)
           | Dip b, Item (ign, rest) ->
-              step qta ctxt b rest >>=? fun (res, qta, ctxt) ->
-              logged_return (Item (ign, res), qta, ctxt)
+              step origination qta ctxt b rest >>=? fun (res, qta, ctxt, origination) ->
+              logged_return ~origination (Item (ign, res), qta, ctxt)
           | Exec, Item (arg, Item (lam, rest)) ->
-              interp ?log qta orig source amount ctxt lam arg >>=? fun (res, qta, ctxt) ->
-              logged_return (Item (res, rest), qta - 1, ctxt)
+              interp ?log origination qta orig source amount ctxt lam arg >>=? fun (res, qta, ctxt, origination) ->
+              logged_return ~origination (Item (res, rest), qta - 1, ctxt)
           | Lambda lam, rest ->
-              logged_return (Item (lam, rest), qta - 1, ctxt)
+              logged_return ~origination (Item (lam, rest), qta - 1, ctxt)
           | Fail, _ ->
               fail (Reject loc)
           | Nop, stack ->
@@ -403,23 +404,23 @@ let rec interp
                     (* we see non scripted contracts as (unit, unit) contract *)
                     Lwt.return (ty_eq tp Unit_t |>
                                 record_trace (Invalid_contract (loc, destination))) >>=? fun (Eq _) ->
-                    return (ctxt, qta)
+                    return (ctxt, qta, origination)
                 | Script { code ; storage } ->
                     let p = unparse_data tp p in
-                    execute source destination ctxt storage code amount p qta
-                    >>=? fun (csto, ret, qta, ctxt) ->
+                    execute origination source destination ctxt storage code amount p qta
+                    >>=? fun (csto, ret, qta, ctxt, origination) ->
                     Contract.update_script_storage
                       ctxt destination csto >>=? fun ctxt ->
                     trace
                       (Invalid_contract (loc, destination))
                       (parse_data ctxt Unit_t ret) >>=? fun () ->
-                    return (ctxt, qta)
-              end >>=? fun (ctxt, qta) ->
+                    return (ctxt, qta, origination)
+              end >>=? fun (ctxt, qta, origination) ->
               Contract.get_script ctxt source >>=? (function
                   | No_script -> assert false
                   | Script { storage = { storage } } ->
                       parse_data ctxt storage_type storage >>=? fun sto ->
-                      logged_return (Item ((), Item (sto, Empty)), qta - 1, ctxt))
+                      logged_return ~origination (Item ((), Item (sto, Empty)), qta - 1, ctxt))
             end
           | Transfer_tokens storage_type,
             Item (p, Item (amount, Item ((tp, tr, destination), Item (sto, Empty)))) -> begin
@@ -431,8 +432,8 @@ let rec interp
                   let sto = unparse_data storage_type sto in
                   Contract.update_script_storage ctxt source sto >>=? fun ctxt ->
                   let p = unparse_data tp p in
-                  execute source destination ctxt storage code amount p qta
-                  >>=? fun (sto, ret, qta, ctxt) ->
+                  execute origination source destination ctxt storage code amount p qta
+                  >>=? fun (sto, ret, qta, ctxt, origination) ->
                   Contract.update_script_storage
                     ctxt destination sto >>=? fun ctxt ->
                   trace
@@ -442,16 +443,17 @@ let rec interp
                       | No_script -> assert false
                       | Script { storage = { storage } } ->
                           parse_data ctxt storage_type storage >>=? fun sto ->
-                          logged_return (Item (v, Item (sto, Empty)), qta - 1, ctxt))
+                          logged_return ~origination (Item (v, Item (sto, Empty)), qta - 1, ctxt))
             end
           | Create_account,
             Item (manager, Item (delegate, Item (delegatable, Item (credit, rest)))) ->
               Contract.unconditional_spend ctxt source credit >>=? fun ctxt ->
               Lwt.return Tez.(credit -? Constants.origination_burn) >>=? fun balance ->
               Contract.originate ctxt
+                origination
                 ~manager ~delegate ~balance
-                ~script:No_script ~spendable:true ~delegatable >>=? fun (ctxt, contract) ->
-              logged_return (Item ((Unit_t, Unit_t, contract), rest), qta - 1, ctxt)
+                ~script:No_script ~spendable:true ~delegatable >>=? fun (ctxt, contract, origination) ->
+              logged_return ~origination (Item ((Unit_t, Unit_t, contract), rest), qta - 1, ctxt)
           | Create_contract (g, p, r),
             Item (manager, Item (delegate, Item (delegatable, Item (credit,
                                                                     Item (Lam (_, code), Item (init, rest)))))) ->
@@ -468,10 +470,11 @@ let rec interp
               Contract.unconditional_spend ctxt source credit >>=? fun ctxt ->
               Lwt.return Tez.(credit -? Constants.origination_burn) >>=? fun balance ->
               Contract.originate ctxt
+                origination
                 ~manager ~delegate ~balance
                 ~script:(Script { code ; storage }) ~spendable:true ~delegatable
-              >>=? fun (ctxt, contract) ->
-              logged_return (Item ((p, r, contract), rest), qta - 1, ctxt)
+              >>=? fun (ctxt, contract, origination) ->
+              logged_return ~origination (Item ((p, r, contract), rest), qta - 1, ctxt)
           | Balance, rest ->
               Contract.get_balance ctxt source >>=? fun balance ->
               logged_return (Item (balance, rest), qta - 1, ctxt)
@@ -500,12 +503,12 @@ let rec interp
       | Some log ->
           log := (code.loc, qta, unparse_stack (stack, code.bef)) :: !log
     end ;
-    step qta ctxt code stack >>=? fun (Item (ret, Empty), qta, ctxt) ->
-    return (ret, qta, ctxt)
+    step origination qta ctxt code stack >>=? fun (Item (ret, Empty), qta, ctxt, origination) ->
+    return (ret, qta, ctxt, origination)
 
 (* ---- contract handling ---------------------------------------------------*)
 
-and execute ?log orig source ctxt storage script amount arg qta =
+and execute ?log origination orig source ctxt storage script amount arg qta =
   let { Script.storage ; storage_type } = storage in
   let { Script.code ; arg_type ; ret_type } = script in
   (Lwt.return (parse_ty arg_type)) >>=? fun (Ex_ty arg_type) ->
@@ -516,16 +519,16 @@ and execute ?log orig source ctxt storage script amount arg qta =
   parse_lambda ctxt arg_type_full ret_type_full code >>=? fun lambda ->
   parse_data ctxt arg_type arg >>=? fun arg ->
   parse_data ctxt storage_type storage >>=? fun storage ->
-  interp ?log qta orig source amount ctxt lambda ((amount, arg), storage)
-  >>=? fun (ret, qta, ctxt) ->
+  interp ?log origination qta orig source amount ctxt lambda ((amount, arg), storage)
+  >>=? fun (ret, qta, ctxt, origination) ->
   let ret, storage = ret in
   return (unparse_data storage_type storage,
           unparse_data ret_type ret,
-          qta, ctxt)
+          qta, ctxt, origination)
 
-let trace orig source ctxt storage script amount arg qta =
+let trace origination orig source ctxt storage script amount arg qta =
   let log = ref [] in
-  execute ~log orig source ctxt storage script amount arg qta >>=? fun res ->
+  execute ~log origination orig source ctxt storage script amount arg qta >>=? fun res ->
   return (res, List.rev !log)
 
 let execute orig source ctxt storage script amount arg qta =
diff --git a/src/proto/bootstrap/script_interpreter.mli b/src/proto/bootstrap/script_interpreter.mli
index 3fbae676f..a5aad7940 100644
--- a/src/proto/bootstrap/script_interpreter.mli
+++ b/src/proto/bootstrap/script_interpreter.mli
@@ -17,13 +17,17 @@ type error += Division_by_zero of Script.location
 (* calling convention :
    ((amount, arg), globals)) -> (ret, globals) *)
 
-val execute: Contract.t -> Contract.t -> Tezos_context.t ->
+val execute:
+  Contract.origination_nonce ->
+  Contract.t -> Contract.t -> Tezos_context.t ->
   Script.storage -> Script.code -> Tez.t ->
   Script.expr -> int ->
-  (Script.expr * Script.expr * int * context) tzresult Lwt.t
+  (Script.expr * Script.expr * int * context * Contract.origination_nonce) tzresult Lwt.t
 
-val trace: Contract.t -> Contract.t -> Tezos_context.t ->
+val trace:
+  Contract.origination_nonce ->
+  Contract.t -> Contract.t -> Tezos_context.t ->
   Script.storage -> Script.code -> Tez.t ->
   Script.expr -> int ->
-  ((Script.expr * Script.expr * int * context) *
+  ((Script.expr * Script.expr * int * context * Contract.origination_nonce) *
    (Script.location * int * Script.expr list) list) tzresult Lwt.t
diff --git a/src/proto/bootstrap/services.ml b/src/proto/bootstrap/services.ml
index b8141b172..a140f989d 100644
--- a/src/proto/bootstrap/services.ml
+++ b/src/proto/bootstrap/services.ml
@@ -328,12 +328,13 @@ module Helpers = struct
       RPC.Path.(custom_root / "helpers" / "minimal_timestamp")
 
   let run_code_input_encoding =
-    (obj5
+    (obj6
        (req "script" Script.code_encoding)
        (req "storage" Script.expr_encoding)
        (req "input" Script.expr_encoding)
        (opt "amount" Tez.encoding)
-       (opt "contract" Contract.encoding))
+       (opt "contract" Contract.encoding)
+       (opt "origination_nonce" Contract.origination_nonce_encoding))
 
   let run_code custom_root =
     RPC.service
@@ -345,6 +346,19 @@ module Helpers = struct
                      (req "output" Script.expr_encoding)))
       RPC.Path.(custom_root / "helpers" / "run_code")
 
+  let apply_operation custom_root =
+    RPC.service
+      ~description: "Applies an operation in the current context"
+      ~input: (obj4
+                 (req "pred_block" Block_hash.encoding)
+                 (req "operation_hash" Operation_hash.encoding)
+                 (req "forged_operation" bytes)
+                 (opt "signature" Ed25519.signature_encoding))
+      ~output: (wrap_tzerror
+                  (obj1 (req "contracts" (list Contract.encoding))))
+      RPC.Path.(custom_root / "helpers" / "apply_operation")
+
+
   let trace_code custom_root =
     RPC.service
       ~description: "Run a piece of code in the current context, \
@@ -541,11 +555,9 @@ module Helpers = struct
         ~input: Operation.unsigned_operation_encoding
         ~output:
           (wrap_tzerror @@
-           (obj2
+           (obj1
               (req "operation" @@
-               describe ~title: "hex encoded operation" bytes)
-              (opt "contracts" @@
-               describe ~title: "new contracts" (list Contract.encoding))))
+               describe ~title: "hex encoded operation" bytes)))
         RPC.Path.(custom_root / "helpers" / "forge" / "operations" )
 
     let block custom_root =
diff --git a/src/proto/bootstrap/services_registration.ml b/src/proto/bootstrap/services_registration.ml
index 606f861f7..1328f2399 100644
--- a/src/proto/bootstrap/services_registration.ml
+++ b/src/proto/bootstrap/services_registration.ml
@@ -181,7 +181,23 @@ let minimal_timestamp ctxt prio =
 let () = register1 Services.Helpers.minimal_timestamp minimal_timestamp
 
 let () =
-  let run_parameters ctxt (script, storage, input, amount, contract) =
+  (* ctxt accept_failing_script miner_contract pred_block block_prio operation *)
+  register1 Services.Helpers.apply_operation
+    (fun ctxt (pred_block, hash, forged_operation, signature) ->
+       match Data_encoding.Binary.of_bytes
+               Operation.unsigned_operation_encoding
+               forged_operation with
+       | None -> Error_monad.fail Operation.Cannot_parse_operation
+       | Some (shell, contents) ->
+           let operation = { hash ; shell ; contents ; signature } in
+           Tezos_context.Level.current ctxt >>=? fun level ->
+           Mining.mining_priorities ctxt level >>=? fun (Misc.LCons (miner_pkh, _)) ->
+           let miner_contract = Contract.default_contract miner_pkh in
+           let block_prio = 0l in
+           Apply.apply_operation ctxt false (Some miner_contract) pred_block block_prio operation
+           >>=? fun (_ctxt, contracts) ->
+           Error_monad.return contracts) ;
+  let run_parameters ctxt (script, storage, input, amount, contract, origination_nonce) =
     let amount =
       match amount with
       | Some amount -> amount
@@ -199,26 +215,34 @@ let () =
       { storage ; storage_type = (script : Script.code).storage_type } in
     let qta =
       Constants.instructions_per_transaction ctxt in
-    (script, storage, input, amount, contract, qta) in
+    let origination_nonce =
+      match origination_nonce with
+      | Some origination_nonce -> origination_nonce
+      | None ->
+          Contract.initial_origination_nonce
+            (Operation_hash.hash_string [ "FAKE " ; "FAKE" ; "FAKE" ]) in
+    (script, storage, input, amount, contract, qta, origination_nonce) in
   register1 Services.Helpers.run_code
     (fun ctxt parameters ->
-       let (script, storage, input, amount, contract, qta) =
+       let (script, storage, input, amount, contract, qta, origination_nonce) =
          run_parameters ctxt parameters in
        Script_interpreter.execute
+         origination_nonce
          contract (* transaction initiator *)
          contract (* script owner *)
          ctxt storage script amount input
-         qta >>=? fun (sto, ret, _qta, _ctxt) ->
+         qta >>=? fun (sto, ret, _qta, _ctxt, _) ->
        Error_monad.return (sto, ret)) ;
   register1 Services.Helpers.trace_code
     (fun ctxt parameters ->
-       let (script, storage, input, amount, contract, qta) =
+       let (script, storage, input, amount, contract, qta, origination_nonce) =
          run_parameters ctxt parameters in
        Script_interpreter.trace
+         origination_nonce
          contract (* transaction initiator *)
          contract (* script owner *)
          ctxt storage script amount input
-         qta >>=? fun ((sto, ret, _qta, _ctxt), trace) ->
+         qta >>=? fun ((sto, ret, _qta, _ctxt, _), trace) ->
        Error_monad.return (sto, ret, trace))
 
 let () =
@@ -401,29 +425,8 @@ let operation_public_key ctxt = function
       | None -> return (Some public_key)
       | Some _ -> return None
 
-let get_contracts ctxt op =
-  match op with
-  | Anonymous_operations _
-  | Sourced_operations (Delegate_operations _) -> return (ctxt, None)
-  | Sourced_operations (Manager_operations { operations }) ->
-      fold_left_s
-        (fun (ctxt, contracts) operation ->
-           match operation with
-           | Origination { manager ; delegate ; script ;
-                           spendable ; delegatable ; credit } ->
-               Contract.originate ctxt
-                 ~balance:credit ~manager ~delegate
-                 ~spendable ~delegatable ~script >>=? fun (ctxt, contract) ->
-               return (ctxt, contract :: contracts)
-           | _ -> return (ctxt, contracts))
-        (ctxt, []) operations >>=? fun (ctxt, contracts) ->
-      match contracts with
-      | [] -> return (ctxt, None)
-      | _ -> return (ctxt, Some (List.rev contracts))
-
-let forge_operations ctxt (shell, proto) =
-  get_contracts ctxt proto >>=? fun (_ctxt, contracts) ->
-  return (Operation.forge shell proto, contracts)
+let forge_operations _ctxt (shell, proto) =
+  return (Operation.forge shell proto)
 
 let () = register1 Services.Helpers.Forge.operations forge_operations
 
diff --git a/src/proto/bootstrap/storage.ml b/src/proto/bootstrap/storage.ml
index 8a0c5e189..90a06fb92 100644
--- a/src/proto/bootstrap/storage.ml
+++ b/src/proto/bootstrap/storage.ml
@@ -97,7 +97,7 @@ module Key = struct
       match c with
       | Contract_repr.Default k ->
           pubkey_contract @@ Ed25519.Public_key_hash.to_path k @ l
-      | Contract_repr.Hash h ->
+      | Contract_repr.Originated h ->
           generic_contract @@ Contract_hash.to_path h @ l
     let roll_list c = contract_store c ["roll_list"]
     let change c = contract_store c ["change"]
diff --git a/src/proto/bootstrap/tezos_context.mli b/src/proto/bootstrap/tezos_context.mli
index f55298a84..88d3afc55 100644
--- a/src/proto/bootstrap/tezos_context.mli
+++ b/src/proto/bootstrap/tezos_context.mli
@@ -317,17 +317,14 @@ module Contract : sig
   val exists: context -> contract -> bool tzresult Lwt.t
   val list: context -> contract list tzresult Lwt.t
 
-  type descr = {
-    manager: public_key_hash ;
-    delegate: public_key_hash option ;
-    spendable: bool ;
-    delegatable: bool ;
-    script: Script.t ;
-  }
-  val descr_encoding: descr Data_encoding.t
+  type origination_nonce
+
+  val origination_nonce_encoding : origination_nonce Data_encoding.t
+  val originated_contract : origination_nonce -> contract
+  val originated_contracts : origination_nonce -> contract list
+
+  val initial_origination_nonce : Operation_hash.t -> origination_nonce
 
-  val get_descr:
-    context -> contract -> descr tzresult Lwt.t
   val get_manager:
     context -> contract -> public_key_hash tzresult Lwt.t
   val get_delegate:
@@ -355,12 +352,13 @@ module Contract : sig
 
   val originate:
     context ->
+    origination_nonce ->
     balance: Tez.t ->
     manager: public_key_hash ->
     script: Script.t ->
     delegate: public_key_hash option ->
     spendable: bool ->
-    delegatable: bool -> (context * contract) tzresult Lwt.t
+    delegatable: bool -> (context * contract * origination_nonce) tzresult Lwt.t
 
   type error += Too_low_balance
 
diff --git a/test/scripts/originator.tz b/test/scripts/originator.tz
new file mode 100644
index 000000000..e7d80d0ee
--- /dev/null
+++ b/test/scripts/originator.tz
@@ -0,0 +1,17 @@
+storage unit ;
+parameter uint16 ;
+return (list (contract unit unit)) ;
+code
+  { CADR ; DUP ; PUSH uint16 0 ; CMPNEQ ;
+    DIIP { NIL (contract unit unit) } ;
+    LOOP
+      { PUSH tez "5.00" ;
+        PUSH bool True ; # delegatable
+        NONE key ; # delegate
+        PUSH key "Nf4DPTCksayh83VhjDVE8M8et7KmXAppD3s7" ; # manager
+        CREATE_ACCOUNT ;
+        SWAP ; DIP { CONS } ;
+        PUSH uint16 1 ; SWAP ; SUB ;
+        DUP ; PUSH uint16 0 ; CMPNEQ } ;
+    DROP ;
+    UNIT ; SWAP ; PAIR }
\ No newline at end of file
diff --git a/test/test_basic.ml b/test/test_basic.ml
index c5f47f110..7bb71518d 100644
--- a/test/test_basic.ml
+++ b/test/test_basic.ml
@@ -143,10 +143,13 @@ let main () =
   let bootstrap = List.hd bootstrap_accounts in
   create_account "foo" >>= fun foo ->
   create_account "bar" >>= fun bar ->
-  transfer ~src:bootstrap ~target:foo 1000_00L >>=? fun () ->
-  transfer ~src:bootstrap ~target:bar 2000_00L >>=? fun () ->
+  transfer ~src:bootstrap ~target:foo 1000_00L >>=? fun contracts ->
+  Assert.equal_int ~msg:__LOC__ 0 (List.length contracts) ;
+  transfer ~src:bootstrap ~target:bar 2000_00L >>=? fun contracts ->
+  Assert.equal_int ~msg:__LOC__ 0 (List.length contracts) ;
   check_balance foo 1000_00L >>=? fun () ->
-  transfer ~src:bar ~target:foo 999_95L >>=? fun () ->
+  transfer ~src:bar ~target:foo 999_95L >>=? fun contracts ->
+  Assert.equal_int ~msg:__LOC__ 0 (List.length contracts) ;
   check_balance foo 1999_95L >>=? fun () ->
   check_balance bar 1000_00L >>=? fun () ->
   should_fail