Alpha: simplify the operation datatype

docs/doc_gen/rpcs/rpc_doc.ml

@@ -347,17 +347,19 @@ let pp_document ppf descriptions =
   (* Index *)
   Format.pp_set_margin ppf 10000 ;
   Format.pp_set_max_indent ppf 9000 ;
+  Rst.pp_h2 ppf "RPCs - Index" ;
   List.iter
     (fun (name, prefix, rpc_dir) ->
-       Rst.pp_h2 ppf (Format.asprintf "%s RPCs - Index" name) ;
+       Rst.pp_h3 ppf name ;
        Format.fprintf ppf "%a@\n@\n" (Index.pp prefix) rpc_dir)
     descriptions ;
   (* Full description *)
+  Rst.pp_h2 ppf "RPCs - Full description" ;
   Format.pp_set_margin ppf 80 ;
   Format.pp_set_max_indent ppf 76 ;
   List.iter
     (fun (name, prefix, rpc_dir) ->
-       Rst.pp_h2 ppf (Format.asprintf "%s RPCs - Full description" name) ;
+       Rst.pp_h3 ppf name ;
        Format.fprintf ppf "%a@\n@\n" (Description.pp prefix) rpc_dir)
     descriptions
 
@@ -418,3 +420,4 @@ let () =
         Format.eprintf "%a@." pp_print_error err ;
         Pervasives.exit 1
   end
+

src/bin_client/test/demo/main.ml

@@ -19,13 +19,21 @@ type block_header_metadata = unit
 let block_header_metadata_encoding = Data_encoding.unit
 
 type operation_data = unit
-type operation = {
-  shell : Operation.shell_header ;
-  protocol_data : operation_data ;
-}
 let operation_data_encoding = Data_encoding.unit
-type operation_metadata = unit
+
-let operation_metadata_encoding = Data_encoding.unit
+type operation_receipt = unit
+let operation_receipt_encoding = Data_encoding.unit
+
+let operation_data_and_receipt_encoding =
+  Data_encoding.conv
+    (function ((), ()) -> ())
+    (fun () -> ((), ()))
+    Data_encoding.unit
+
+type operation = {
+  shell: Operation.shell_header ;
+  protocol_data: operation_data ;
+}
 
 let max_block_length = 42
 let validation_passes = []

src/bin_client/test/test_injection.sh

@@ -14,7 +14,7 @@ show_logs="no"
 sleep 2
 
 # autogenerated from the demo source
-protocol_version="PtamL2BUfeNFM2A8Thq2Wde8vNaVD9DhoARDVB41QsHFj89kQpT"
+protocol_version="PsgZ1PB2h82sTKznNbmZxtbsU432eKDv1W6cf1cJFhCFmGYSiJs"
 
 $admin_client inject protocol "$test_dir/demo"
 $admin_client list protocols

src/lib_protocol_environment/sigs/v1/updater.mli

@@ -90,8 +90,10 @@ module type PROTOCOL = sig
   (** The version specific type of operations. *)
   type operation_data
 
-  (** Encoding for version specific part of operations.  *)
+  (** Version-specific side information computed by the protocol
-  val operation_data_encoding: operation_data Data_encoding.t
+      during the validation of each operation, to be used conjointly
+      with {!block_header_metadata}. *)
+  type operation_receipt
 
   (** A fully parsed operation. *)
   type operation = {
@@ -99,13 +101,15 @@ module type PROTOCOL = sig
     protocol_data: operation_data ;
   }
 
-  (** Version-specific side information computed by the protocol
+  (** Encoding for version-specific operation data. *)
-      during the validation of each operation, to be used conjointly
+  val operation_data_encoding: operation_data Data_encoding.t
-      with {!block_header_metadata}. *)
-  type operation_metadata
 
-  (** Encoding for version-specific operation metadata. *)
+  (** Encoding for version-specific operation receipts. *)
-  val operation_metadata_encoding: operation_metadata Data_encoding.t
+  val operation_receipt_encoding: operation_receipt Data_encoding.t
+
+  (** Encoding that mixes an operation data and its receipt. *)
+  val operation_data_and_receipt_encoding:
+    (operation_data * operation_receipt) Data_encoding.t
 
   (** The Validation passes in which an operation can appear.
       For instance [[0]] if it only belongs to the first pass.
@@ -178,7 +182,7 @@ module type PROTOCOL = sig
   val apply_operation:
     validation_state ->
     operation ->
-    (validation_state * operation_metadata) tzresult Lwt.t
+    (validation_state * operation_receipt) tzresult Lwt.t
 
   (** The last step in a block validation sequence. It produces the
       context that will be used as input for the validation of its

src/lib_protocol_environment/tezos_protocol_environment.ml

@@ -68,13 +68,15 @@ module Make (Context : CONTEXT) = struct
     type block_header_metadata
     val block_header_metadata_encoding: block_header_metadata Data_encoding.t
     type operation_data
-    val operation_data_encoding: operation_data Data_encoding.t
+    type operation_receipt
     type operation = {
       shell: Operation.shell_header ;
       protocol_data: operation_data ;
     }
-    type operation_metadata
+    val operation_data_encoding: operation_data Data_encoding.t
-    val operation_metadata_encoding: operation_metadata Data_encoding.t
+    val operation_receipt_encoding: operation_receipt Data_encoding.t
+    val operation_data_and_receipt_encoding:
+      (operation_data * operation_receipt) Data_encoding.t
     val acceptable_passes: operation -> int list
     val compare_operations: operation -> operation -> int
     type validation_state
@@ -101,7 +103,7 @@ module Make (Context : CONTEXT) = struct
       unit -> validation_state tzresult Lwt.t
     val apply_operation:
       validation_state -> operation ->
-      (validation_state * operation_metadata)  tzresult Lwt.t
+      (validation_state * operation_receipt) tzresult Lwt.t
     val finalize_block:
       validation_state ->
       (validation_result * block_header_metadata) tzresult Lwt.t
@@ -166,6 +168,7 @@ module Make (Context : CONTEXT) = struct
       with type block_header_data = P.block_header_data
        and type block_header = P.block_header
        and type operation_data = P.operation_data
+       and type operation_receipt = P.operation_receipt
        and type operation = P.operation
        and type validation_state = P.validation_state
 

src/lib_protocol_environment/tezos_protocol_environment.mli

@@ -61,13 +61,15 @@ module Make (Context : CONTEXT) : sig
     type block_header_metadata
     val block_header_metadata_encoding: block_header_metadata Data_encoding.t
     type operation_data
-    val operation_data_encoding: operation_data Data_encoding.t
+    type operation_receipt
     type operation = {
       shell: Operation.shell_header ;
       protocol_data: operation_data ;
     }
-    type operation_metadata
+    val operation_data_encoding: operation_data Data_encoding.t
-    val operation_metadata_encoding: operation_metadata Data_encoding.t
+    val operation_receipt_encoding: operation_receipt Data_encoding.t
+    val operation_data_and_receipt_encoding:
+      (operation_data * operation_receipt) Data_encoding.t
     val acceptable_passes: operation -> int list
     val compare_operations: operation -> operation -> int
     type validation_state
@@ -94,7 +96,7 @@ module Make (Context : CONTEXT) : sig
       unit -> validation_state tzresult Lwt.t
     val apply_operation:
       validation_state -> operation ->
-      (validation_state * operation_metadata) tzresult Lwt.t
+      (validation_state * operation_receipt) tzresult Lwt.t
     val finalize_block:
       validation_state ->
       (validation_result * block_header_metadata) tzresult Lwt.t
@@ -159,6 +161,7 @@ module Make (Context : CONTEXT) : sig
       with type block_header_data = P.block_header_data
        and type block_header = P.block_header
        and type operation_data = P.operation_data
+       and type operation_receipt = P.operation_receipt
        and type operation = P.operation
        and type validation_state = P.validation_state
 

src/lib_shell/block_directory.ml

@@ -160,20 +160,20 @@ let build_raw_rpc_directory
 
   (* operations *)
 
-  let convert chain_id (op : Operation.t) metadata =
+  let convert chain_id (op : Operation.t) metadata : Block_services.operation =
     let protocol_data =
       Data_encoding.Binary.of_bytes_exn
         Proto.operation_data_encoding
         op.proto in
-    let metadata =
+    let receipt =
       Data_encoding.Binary.of_bytes_exn
-        Proto.operation_metadata_encoding
+        Proto.operation_receipt_encoding
         metadata in
     { Block_services.chain_id ;
       hash = Operation.hash op ;
       shell = op.shell ;
       protocol_data ;
-      metadata ;
+      receipt ;
     } in
 
   let operations block =
@@ -268,11 +268,11 @@ let build_raw_rpc_directory
     let operations =
       List.map
         (List.map
-           (fun (op : Next_proto.operation) ->
+           (fun op ->
               let proto =
                 Data_encoding.Binary.to_bytes_exn
                   Next_proto.operation_data_encoding
-                  op.protocol_data in
+                  op.Next_proto.protocol_data in
               { Operation.shell = op.shell ; proto }))
         p.operations in
     Prevalidation.preapply
@@ -297,7 +297,7 @@ let build_raw_rpc_directory
     fold_left_s
       (fun (state, acc) op ->
          Next_proto.apply_operation state op >>=? fun (state, result) ->
-         return (state, result :: acc))
+         return (state, (op.protocol_data, result) :: acc))
       (state, []) ops >>=? fun (state, acc) ->
     Next_proto.finalize_block state >>=? fun _ ->
     return (List.rev acc)

src/lib_shell/block_validator.ml

@@ -230,7 +230,8 @@ let apply_block
   let ops_metadata =
     List.map
       (List.map
-         (Data_encoding.Binary.to_bytes_exn Proto.operation_metadata_encoding))
+         (Data_encoding.Binary.to_bytes_exn
+            Proto.operation_receipt_encoding))
       ops_metadata in
   return (validation_result, block_data, ops_metadata)
 

src/lib_shell/prevalidation.ml

@@ -122,7 +122,8 @@ let prevalidate
                    Proto.operation_data_encoding
                    op.Operation.proto with
            | None -> error Parse_error
-           | Some protocol_data -> Ok ({ shell = op.shell ; protocol_data }: Proto.operation) in
+           | Some protocol_data ->
+               Ok ({ shell = op.shell ; protocol_data } : Proto.operation) in
          (h, op, parsed_op))
       ops in
   let invalid_ops =
@@ -140,14 +141,15 @@ let prevalidate
       let compare (_, _, op1) (_, _, op2) = Proto.compare_operations op1 op2 in
       List.sort compare parsed_ops
     else parsed_ops in
-  let apply_operation state max_ops op parse_op =
+  let apply_operation state max_ops op (parse_op) =
     let size = Data_encoding.Binary.length Operation.encoding op in
     if max_ops <= 0 then
       fail Too_many_operations
     else if size > max_operation_data_length then
       fail (Oversized_operation { size ; max = max_operation_data_length })
     else
-      Proto.apply_operation state parse_op in
+      Proto.apply_operation state parse_op >>=? fun (state, receipt) ->
+      return (state, receipt) in
   apply_operations
     apply_operation
     state Preapply_result.empty max_number_of_operations

src/lib_shell_services/block_services.ml

@@ -146,13 +146,16 @@ module type PROTO = sig
   val block_header_metadata_encoding:
     block_header_metadata Data_encoding.t
   type operation_data
-  val operation_data_encoding: operation_data Data_encoding.t
+  type operation_receipt
-  type operation_metadata
-  val operation_metadata_encoding: operation_metadata Data_encoding.t
   type operation = {
     shell: Operation.shell_header ;
     protocol_data: operation_data ;
   }
+
+  val operation_data_encoding: operation_data Data_encoding.t
+  val operation_receipt_encoding: operation_receipt Data_encoding.t
+  val operation_data_and_receipt_encoding:
+    (operation_data * operation_receipt) Data_encoding.t
 end
 
 module Make(Proto : PROTO)(Next_proto : PROTO) = struct
@@ -238,8 +241,10 @@ module Make(Proto : PROTO)(Next_proto : PROTO) = struct
     let open Data_encoding in
     def "next_operation" @@
     conv
-      (fun Next_proto.{ shell ; protocol_data } -> ((), (shell, protocol_data)))
+      (fun Next_proto.{ shell ; protocol_data } ->
-      (fun ((), (shell, protocol_data)) -> { shell ; protocol_data } )
+         ((), (shell, protocol_data)))
+      (fun ((), (shell, protocol_data)) ->
+         { shell ; protocol_data } )
       (merge_objs
          (obj1 (req "protocol" (constant next_protocol_hash)))
          (merge_objs
@@ -251,28 +256,25 @@ module Make(Proto : PROTO)(Next_proto : PROTO) = struct
     hash: Operation_hash.t ;
     shell: Operation.shell_header ;
     protocol_data: Proto.operation_data ;
-    metadata: Proto.operation_metadata ;
+    receipt: Proto.operation_receipt ;
   }
 
   let operation_encoding =
     def "operation" @@
     let open Data_encoding in
     conv
-      (fun { chain_id ; hash ; shell ; protocol_data ; metadata } ->
+      (fun { chain_id ; hash ; shell ; protocol_data ; receipt } ->
-         (((), chain_id, hash), ((shell, protocol_data), metadata)))
+         (((), chain_id, hash), (shell, (protocol_data, receipt))))
-      (fun (((), chain_id, hash), ((shell, protocol_data), metadata)) ->
+      (fun (((), chain_id, hash), (shell, (protocol_data,  receipt))) ->
-         { chain_id ; hash ; shell ; protocol_data ; metadata } )
+         { chain_id ; hash ; shell ; protocol_data ; receipt })
       (merge_objs
          (obj3
             (req "protocol" (constant protocol_hash))
             (req "chain_id" Chain_id.encoding)
             (req "hash" Operation_hash.encoding))
          (merge_objs
-            (dynamic_size
+            (dynamic_size Operation.shell_header_encoding)
-               (merge_objs
+            (dynamic_size Proto.operation_data_and_receipt_encoding)))
-                  Operation.shell_header_encoding
-                  Proto.operation_data_encoding))
-            (dynamic_size Proto.operation_metadata_encoding)))
 
   type block_info = {
     chain_id: Chain_id.t ;
@@ -285,20 +287,17 @@ module Make(Proto : PROTO)(Next_proto : PROTO) = struct
   let block_info_encoding =
     conv
       (fun { chain_id ; hash ; header ; metadata ; operations } ->
-         ((((), chain_id, hash), (header, metadata)), operations))
+         ((), chain_id, hash, header, metadata, operations))
-      (fun ((((), chain_id, hash), (header, metadata)), operations) ->
+      (fun ((), chain_id, hash, header, metadata, operations) ->
          { chain_id ; hash ; header ; metadata ; operations })
-      (merge_objs
+      (obj6
-         (merge_objs
-            (obj3
          (req "protocol" (constant protocol_hash))
          (req "chain_id" Chain_id.encoding)
-               (req "hash" Block_hash.encoding))
+         (req "hash" Block_hash.encoding)
-            (merge_objs
+         (req "header" (dynamic_size raw_block_header_encoding))
-               (dynamic_size raw_block_header_encoding)
+         (req "metadata" (dynamic_size block_metadata_encoding))
-               (dynamic_size block_metadata_encoding)))
+         (req "operations"
-         (obj1 (req "operations"
+            (list (dynamic_size (list operation_encoding)))))
-                  (list (dynamic_size (list operation_encoding))))))
 
   module S = struct
 
@@ -630,7 +629,7 @@ module Make(Proto : PROTO)(Next_proto : PROTO) = struct
               "Simulate the validation of an operation."
             ~query: RPC_query.empty
             ~input: (list next_operation_encoding)
-            ~output: (list (dynamic_size Next_proto.operation_metadata_encoding))
+            ~output: (list (dynamic_size Next_proto.operation_data_and_receipt_encoding))
             RPC_path.(path / "operations")
 
       end
@@ -936,13 +935,18 @@ module Fake_protocol = struct
   type block_header_metadata = unit
   let block_header_metadata_encoding = Data_encoding.empty
   type operation_data = unit
-  let operation_data_encoding = Data_encoding.empty
+  type operation_receipt = unit
-  type operation_metadata = unit
-  let operation_metadata_encoding = Data_encoding.empty
   type operation = {
     shell: Operation.shell_header ;
     protocol_data: operation_data ;
   }
+  let operation_data_encoding = Data_encoding.empty
+  let operation_receipt_encoding = Data_encoding.empty
+  let operation_data_and_receipt_encoding =
+    Data_encoding.conv
+      (fun ((), ()) -> ())
+      (fun () -> ((), ()))
+      Data_encoding.empty
 end
 
 module Empty = Make(Fake_protocol)(Fake_protocol)

src/lib_shell_services/block_services.mli

@@ -57,13 +57,16 @@ module type PROTO = sig
   val block_header_metadata_encoding:
     block_header_metadata Data_encoding.t
   type operation_data
-  val operation_data_encoding: operation_data Data_encoding.t
+  type operation_receipt
-  type operation_metadata
-  val operation_metadata_encoding: operation_metadata Data_encoding.t
   type operation = {
     shell: Operation.shell_header ;
     protocol_data: operation_data ;
   }
+
+  val operation_data_encoding: operation_data Data_encoding.t
+  val operation_receipt_encoding: operation_receipt Data_encoding.t
+  val operation_data_and_receipt_encoding:
+    (operation_data * operation_receipt) Data_encoding.t
 end
 
 module Make(Proto : PROTO)(Next_proto : PROTO) : sig
@@ -96,7 +99,7 @@ module Make(Proto : PROTO)(Next_proto : PROTO) : sig
     hash: Operation_hash.t ;
     shell: Operation.shell_header ;
     protocol_data: Proto.operation_data ;
-    metadata: Proto.operation_metadata ;
+    receipt: Proto.operation_receipt ;
   }
 
   type block_info = {
@@ -255,7 +258,7 @@ module Make(Proto : PROTO)(Next_proto : PROTO) : sig
       val operations:
         #simple -> ?chain:chain -> ?block:block ->
         Next_proto.operation list ->
-        Next_proto.operation_metadata list tzresult Lwt.t
+        (Next_proto.operation_data * Next_proto.operation_receipt) list tzresult Lwt.t
 
     end
 
@@ -462,7 +465,7 @@ module Make(Proto : PROTO)(Next_proto : PROTO) : sig
         val operations:
           ([ `POST ], prefix,
            prefix, unit, Next_proto.operation list,
-           Next_proto.operation_metadata list) RPC_service.t
+           (Next_proto.operation_data * Next_proto.operation_receipt) list) RPC_service.t
 
       end
 

src/proto_alpha/lib_baking/client_baking_endorsement.ml

@@ -96,7 +96,7 @@ let inject_endorsement
     ?(chain = `Main) block level ?async
     src_sk slots =
   Shell_services.Blocks.hash cctxt ~chain ~block () >>=? fun hash ->
-  Alpha_services.Forge.Consensus.endorsement cctxt
+  Alpha_services.Forge.endorsement cctxt
     (chain, block)
     ~branch:hash
     ~block:hash

src/proto_alpha/lib_baking/client_baking_forge.ml

@@ -98,25 +98,27 @@ let () =
       | _ -> None)
     (fun (hash, err) -> Failed_to_preapply (hash, err))
 
-let classify_operations (ops: Operation.t list) =
+let classify_operations (ops: Proto_alpha.operation list) =
   let t = Array.make (List.length Proto_alpha.Main.validation_passes) [] in
   List.iter
-    (fun (op: Operation.t) ->
+    (fun (op: Proto_alpha.operation) ->
        List.iter
          (fun pass -> t.(pass) <- op :: t.(pass))
          (Proto_alpha.Main.acceptable_passes op))
     ops ;
   Array.fold_right (fun ops acc -> List.rev ops :: acc) t []
 
-let parse (op : Operation.raw) : Operation.t = {
+let parse (op : Operation.raw) : Operation.packed =
-  shell = op.shell ;
+  let protocol_data =
-  protocol_data =
     Data_encoding.Binary.of_bytes_exn
       Alpha_context.Operation.protocol_data_encoding
-      op.proto
+      op.proto in
-}
+  {
+    shell = op.shell ;
+    protocol_data ;
+  }
 
-let forge (op : Operation.t) : Operation.raw = {
+let forge (op : Operation.packed) : Operation.raw = {
   shell = op.shell ;
   proto =
     Data_encoding.Binary.to_bytes_exn

src/proto_alpha/lib_baking/client_baking_forge.mli

@@ -40,7 +40,7 @@ val forge_block:
   ?chain:Chain_services.chain ->
   Block_services.block ->
   ?force:bool ->
-  ?operations:Operation.t list ->
+  ?operations: Operation.packed list ->
   ?best_effort:bool ->
   ?sort:bool ->
   ?timestamp:Time.t ->

src/proto_alpha/lib_baking/client_baking_operations.ml

@@ -12,7 +12,7 @@ open Alpha_context
 
 type operation = {
   hash: Operation_hash.t ;
-  content: Operation.t option
+  content: Operation.packed option
 }
 
 

src/proto_alpha/lib_baking/client_baking_operations.mli

@@ -12,7 +12,7 @@ open Alpha_context
 
 type operation = {
   hash: Operation_hash.t ;
-  content: Operation.t option ;
+  content: Operation.packed option ;
 }
 
 type valid_endorsement = {

src/proto_alpha/lib_baking/client_baking_revelation.ml

@@ -8,18 +8,16 @@
 (**************************************************************************)
 
 open Proto_alpha
-open Alpha_context
 
 let inject_seed_nonce_revelation rpc_config ?(chain = `Main) block ?async nonces =
-  let operations =
-    List.map
-      (fun (level, nonce) ->
-         Seed_nonce_revelation { level ; nonce }) nonces in
   Alpha_block_services.hash rpc_config ~chain ~block () >>=? fun branch ->
-  Alpha_services.Forge.Anonymous.operations rpc_config
+  map_p
-    (chain, block) ~branch operations >>=? fun bytes ->
+    (fun (level, nonce) ->
-  Shell_services.Injection.operation rpc_config ?async ~chain bytes >>=? fun oph ->
+       Alpha_services.Forge.seed_nonce_revelation rpc_config
-  return oph
+         (chain, block) ~branch ~level ~nonce () >>=? fun bytes ->
+       Shell_services.Injection.operation rpc_config ?async ~chain bytes)
+    nonces >>=? fun ophs ->
+  return ophs
 
 let forge_seed_nonce_revelation
     (cctxt: #Proto_alpha.full)
@@ -37,6 +35,6 @@ let forge_seed_nonce_revelation
         "Operation successfully injected %d revelation(s) for %a."
         (List.length nonces)
         Block_hash.pp_short hash >>= fun () ->
-      cctxt#answer "Operation hash is '%a'."
+      cctxt#answer "@[<v 2>Operation hash are:@ %a@]"
-        Operation_hash.pp_short oph >>= fun () ->
+        (Format.pp_print_list Operation_hash.pp_short) oph >>= fun () ->
       return ()

src/proto_alpha/lib_baking/client_baking_revelation.mli

@@ -16,7 +16,7 @@ val inject_seed_nonce_revelation:
   Block_services.block ->
   ?async:bool ->
   (Raw_level.t * Nonce.t) list ->
-  Operation_hash.t tzresult Lwt.t
+  Operation_hash.t list tzresult Lwt.t
 
 val forge_seed_nonce_revelation:
   #Proto_alpha.full ->

src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml

@@ -322,14 +322,13 @@ module Account = struct
 
 end
 
-let sign ?watermark src_sk shell contents =
+let sign ?watermark src_sk shell (Contents_list contents) =
-  let contents = Sourced_operation contents in
   let bytes =
     Data_encoding.Binary.to_bytes_exn
       Operation.unsigned_encoding
-      (shell, contents) in
+      (shell, (Contents_list contents)) in
   let signature = Some (Signature.sign ?watermark src_sk bytes) in
-  let protocol_data = { contents ; signature } in
+  let protocol_data = Operation_data { contents ; signature } in
   return { shell ; protocol_data }
 
 module Protocol = struct
@@ -347,11 +346,10 @@ module Protocol = struct
       !rpc_ctxt ~offset:1l (`Main, block) >>=? fun next_level ->
     let shell = { Tezos_base.Operation.branch = hash } in
     let contents =
-      Amendment_operation
+      Proposals { source = pkh ;
-        { source = pkh ;
+                  period = next_level.voting_period ;
-          operation = Proposals { period = next_level.voting_period ;
+                  proposals } in
-                                  proposals } } in
+    sign ~watermark:Generic_operation sk shell (Contents_list (Single contents))
-    sign ~watermark:Generic_operation sk shell contents
 
   let ballot ?(block = `Head 0) ~src:({ pkh; sk } : Account.t) ~proposal ballot =
     Shell_services.Blocks.hash !rpc_ctxt ~block () >>=? fun hash ->
@@ -359,12 +357,12 @@ module Protocol = struct
       !rpc_ctxt ~offset:1l (`Main, block) >>=? fun next_level ->
     let shell = { Tezos_base.Operation.branch = hash } in
     let contents =
-      Amendment_operation
+      Single
-        { source = pkh ;
+        (Ballot { source = pkh ;
-          operation = Ballot { period = next_level.voting_period ;
+                  period = next_level.voting_period ;
                   proposal ;
-                               ballot } } in
+                  ballot }) in
-    sign ~watermark:Generic_operation sk shell contents
+    sign ~watermark:Generic_operation sk shell (Contents_list contents)
 
 end
 
@@ -431,8 +429,8 @@ module Assert = struct
           begin
             match op with
             | None -> true
-            | Some op ->
+            | Some { shell ; protocol_data = Operation_data protocol_data } ->
-                let h = Operation.hash op and h' = hash op' in
+                let h = Operation.hash { shell ; protocol_data } and h' = hash op' in
                 Operation_hash.equal h h'
           end && List.exists (ecoproto_error f) err
       | _ -> false
@@ -557,9 +555,8 @@ module Endorse = struct
     let level = level.level in
     let shell = { Tezos_base.Operation.branch = hash } in
     let contents =
-      Consensus_operation
+      Single (Endorsements { block = hash ; level ; slots = [ slot ]}) in
-        (Endorsements { block = hash ; level ; slots = [ slot ]}) in
+    sign ~watermark:Endorsement src_sk shell (Contents_list contents)
-    sign ~watermark:Endorsement src_sk shell contents
 
   let signing_slots
       block

src/proto_alpha/lib_baking/test/proto_alpha_helpers.mli

@@ -104,7 +104,7 @@ module Baking : sig
   val bake:
     Block_services.block ->
     Account.t ->
-    Operation.t list ->
+    Operation.packed list ->
     Block_hash.t tzresult Lwt.t
 
 end
@@ -115,7 +115,7 @@ module Endorse : sig
     ?slot:int ->
     Account.t ->
     Block_services.block ->
-    Operation.t tzresult Lwt.t
+    Operation.packed tzresult Lwt.t
 
   val endorsers_list :
     Block_services.block ->
@@ -134,14 +134,14 @@ module Protocol : sig
     ?block:Block_services.block ->
     src:Account.t ->
     Protocol_hash.t list ->
-    Operation.t tzresult Lwt.t
+    Operation.packed tzresult Lwt.t
 
   val ballot :
     ?block:Block_services.block ->
     src:Account.t ->
     proposal:Protocol_hash.t ->
     Vote.ballot ->
-    Operation.t tzresult Lwt.t
+    Operation.packed tzresult Lwt.t
 
 end
 
@@ -166,7 +166,7 @@ module Assert : sig
 
   val failed_to_preapply:
     msg:string ->
-    ?op:Operation.t ->
+    ?op:Operation.packed ->
     (Alpha_environment.Error_monad.error ->
      bool) ->
     'a tzresult -> unit

src/proto_alpha/lib_client/client_proto_context.ml

@@ -24,43 +24,24 @@ let parse_expression arg =
     (Micheline_parser.no_parsing_error
        (Michelson_v1_parser.parse_expression arg))
 
-let append_reveal
-    cctxt ~chain ~block
-    ~source ~src_pk ops =
-  Alpha_services.Contract.manager_key
-    cctxt (chain, block) source >>=? fun (_pkh, pk) ->
-  let is_reveal = function
-    | Reveal _ -> true
-    | _ -> false in
-  match pk with
-  | None when not (List.exists is_reveal ops) ->
-      return (Reveal src_pk :: ops)
-  | _ -> return ops
-
 let transfer (cctxt : #Proto_alpha.full)
     ~chain ~block ?confirmations
     ?branch ~source ~src_pk ~src_sk ~destination ?arg
-    ~amount ~fee ?(gas_limit = Z.minus_one) ?(storage_limit = -1L) () =
+    ~amount ~fee ?gas_limit ?storage_limit () =
   begin match arg with
     | Some arg ->
         parse_expression arg >>=? fun { expanded = arg } ->
         return (Some arg)
     | None -> return None
   end >>=? fun parameters ->
-  Alpha_services.Contract.counter
-    cctxt (chain, block) source >>=? fun pcounter ->
-  let counter = Int32.succ pcounter in
   let parameters = Option.map ~f:Script.lazy_expr parameters in
-  let operations = [Transaction { amount ; parameters ; destination }] in
+  let contents = Transaction { amount ; parameters ; destination } in
-  append_reveal cctxt ~chain ~block
+  Injection.inject_manager_operation
-    ~source ~src_pk operations >>=? fun operations ->
+    cctxt ~chain ~block ?confirmations
-  let contents =
+    ?branch ~source ~fee ?gas_limit ?storage_limit
-    Sourced_operation
+    ~src_pk ~src_sk contents >>=? fun (_oph, _op, result as res) ->
-      (Manager_operations { source ; fee ; counter ;
+  Lwt.return
-                            gas_limit ; storage_limit ; operations }) in
+    (Injection.originated_contracts (Single_result result)) >>=? fun contracts ->
-  Injection.inject_operation cctxt ~chain ~block ?confirmations
-    ?branch ~src_sk contents >>=? fun (_oph, _op, result as res) ->
-  Lwt.return (Injection.originated_contracts result) >>=? fun contracts ->
   return (res, contracts)
 
 let reveal cctxt
@@ -69,37 +50,36 @@ let reveal cctxt
   Alpha_services.Contract.counter
     cctxt (chain, block) source >>=? fun pcounter ->
   let counter = Int32.succ pcounter in
-  append_reveal cctxt ~chain ~block ~source ~src_pk [] >>=? fun operations ->
+  Alpha_services.Contract.manager_key
-  match operations with
+    cctxt (chain, block) source >>=? fun (_, key) ->
-  | [] ->
+  match key with
+  | Some _ ->
       failwith "The manager key was previously revealed."
-  | _ :: _ ->
+  | None -> begin
       let contents =
-        Sourced_operation
+        Single
-          (Manager_operations { source ; fee ; counter ;
+          (Manager_operation { source ; fee ; counter ;
                                gas_limit = Z.zero ; storage_limit = 0L ;
-                                operations }) in
+                               operation = Reveal src_pk }) in
       Injection.inject_operation cctxt ~chain ~block ?confirmations
-        ?branch ~src_sk contents >>=? fun res ->
+        ?branch ~src_sk contents >>=? fun (oph, op, result) ->
-      return res
+      match Apply_operation_result.pack_contents_list op result with
+      | Apply_operation_result.Single_and_result
+          (Manager_operation _ as op, result) ->
+          return (oph, op, result)
+      | _ -> .
+    end
 
 let originate
     cctxt ~chain ~block ?confirmations
     ?branch ~source ~src_pk ~src_sk ~fee
-    ?(gas_limit = Z.minus_one) ?(storage_limit = -1L) origination =
+    ?gas_limit ?storage_limit contents =
-  Alpha_services.Contract.counter
+  Injection.inject_manager_operation
-    cctxt (chain, block) source >>=? fun pcounter ->
+    cctxt ~chain ~block ?confirmations
-  let counter = Int32.succ pcounter in
+    ?branch ~source ~fee ?gas_limit ?storage_limit
-  let operations = [origination] in
+    ~src_pk ~src_sk contents >>=? fun (_oph, _op, result as res) ->
-  append_reveal
+  Lwt.return
-    cctxt ~chain ~block ~source ~src_pk operations >>=? fun operations ->
+    (Injection.originated_contracts (Single_result result)) >>=? function
-  let contents =
-    Sourced_operation
-      (Manager_operations { source ; fee ; counter ;
-                            gas_limit ; storage_limit ; operations }) in
-  Injection.inject_operation cctxt ~chain ~block ?confirmations
-    ?branch ~src_sk contents >>=? fun (_oph, _op, result as res) ->
-  Lwt.return (Injection.originated_contracts result) >>=? function
   | [ contract ] -> return (res, contract)
   | contracts ->
       failwith
@@ -120,25 +100,17 @@ let originate_account
                   preorigination = None } in
   originate
     cctxt ~chain ~block ?confirmations
-    ?branch ~source ~gas_limit:Z.zero~src_pk ~src_sk ~fee origination
+    ?branch ~source ~gas_limit:Z.zero ~src_pk ~src_sk ~fee origination
 
 let delegate_contract cctxt
     ~chain ~block ?branch ?confirmations
     ~source ~src_pk ~src_sk
     ~fee delegate_opt =
-  Alpha_services.Contract.counter
+  let operation = Delegation delegate_opt in
-    cctxt (chain, block) source >>=? fun pcounter ->
+  Injection.inject_manager_operation
-  let counter = Int32.succ pcounter in
+    cctxt ~chain ~block ?confirmations
-  let operations = [Delegation delegate_opt] in
+    ?branch ~source ~fee ~gas_limit:Z.zero ~storage_limit:0L
-  append_reveal
+    ~src_pk ~src_sk operation >>=? fun res ->
-    cctxt ~chain ~block ~source ~src_pk operations >>=? fun operations ->
-  let contents =
-    Sourced_operation
-      (Manager_operations { source ; fee ; counter ;
-                            gas_limit = Z.zero ; storage_limit = 0L ;
-                            operations }) in
-  Injection.inject_operation cctxt ~chain ~block ?confirmations
-    ?branch ~src_sk contents >>=? fun res ->
   return res
 
 let list_contract_labels
@@ -179,14 +151,27 @@ let get_manager
   Client_keys.get_key cctxt src_pkh >>=? fun (src_name, src_pk, src_sk) ->
   return (src_name, src_pkh, src_pk, src_sk)
 
-let dictate rpc_config ~chain ~block ?confirmations command src_sk =
+let activate_protocol rpc_config ~chain ~block ?confirmations hash src_sk =
-  let contents = Sourced_operation (Dictator_operation command) in
   Injection.inject_operation
     rpc_config ~chain ~block ?confirmations
-    ~src_sk contents >>=? fun res ->
+    ~src_sk (Single (Activate_protocol hash)) >>=? fun (oph, op, result) ->
-  return res
+  match Apply_operation_result.pack_contents_list op result with
+  | Apply_operation_result.Single_and_result
+      (Activate_protocol _ as op, result) ->
+      return (oph, op, result)
+  | _ -> .
 
-let set_delegate
+    let activate_test_protocol rpc_config ~chain ~block ?confirmations hash src_sk =
+      Injection.inject_operation
+        rpc_config ~chain ~block ?confirmations
+        ~src_sk (Single (Activate_test_protocol hash)) >>=? fun (oph, op, result) ->
+      match Apply_operation_result.pack_contents_list op result with
+      | Apply_operation_result.Single_and_result
+          (Activate_test_protocol _ as op, result) ->
+          return (oph, op, result)
+      | _ -> .
+
+        let set_delegate
             cctxt ~chain ~block ?confirmations
             ~fee contract ~src_pk ~manager_sk opt_delegate =
           delegate_contract
@@ -306,7 +291,7 @@ let read_key key =
       let pkh = Signature.Public_key.hash pk in
       return (pkh, pk, sk)
 
-let claim_commitment
+let activate_account
     (cctxt : #Proto_alpha.full)
     ~chain ~block ?confirmations
     ?(encrypted = false) ?force key name =
@@ -318,11 +303,10 @@ let claim_commitment
        Signature.Public_key_hash.pp pkh
        Ed25519.Public_key_hash.pp key.pkh) >>=? fun () ->
   let contents =
-    Anonymous_operations
+    Single ( Activate_account { id = key.pkh ; activation_code = key.activation_code } ) in
-      [ Activation { id = key.pkh ; activation_code = key.activation_code } ] in
   Injection.inject_operation
     cctxt ?confirmations ~chain ~block
-    contents >>=? fun (_oph, _op, _result as res) ->
+    contents >>=? fun (oph, op, result) ->
   let pk_uri = Tezos_signer_backends.Unencrypted.make_pk pk in
   begin
     if encrypted then
@@ -346,5 +330,9 @@ let claim_commitment
           Tez.pp balance >>= fun () ->
         return ()
   end >>=? fun () ->
-  return res
+  match Apply_operation_result.pack_contents_list op result with
+  | Apply_operation_result.Single_and_result
+      (Activate_account _ as op, result) ->
+      return (oph, op, result)
+  | _ -> .
 

src/proto_alpha/lib_client/client_proto_context.mli

@@ -48,7 +48,7 @@ val set_delegate:
   src_pk:public_key ->
   manager_sk:Client_keys.sk_uri ->
   public_key_hash option ->
-  Injection.result tzresult Lwt.t
+  Kind.delegation Kind.manager Injection.result tzresult Lwt.t
 
 val register_as_delegate:
   #Proto_alpha.full ->
@@ -58,7 +58,7 @@ val register_as_delegate:
   fee:Tez.tez ->
   manager_sk:Client_keys.sk_uri ->
   public_key ->
-  Injection.result tzresult Lwt.t
+  Kind.delegation Kind.manager Injection.result tzresult Lwt.t
 
 val source_to_keys:
   #Proto_alpha.full ->
@@ -81,7 +81,7 @@ val originate_account :
   ?delegate:public_key_hash ->
   balance:Tez.tez ->
   fee:Tez.tez ->
-  unit -> (Injection.result * Contract.t) tzresult Lwt.t
+  unit -> (Kind.origination Kind.manager Injection.result * Contract.t) tzresult Lwt.t
 
 val save_contract :
   force:bool ->
@@ -109,7 +109,7 @@ val originate_contract:
   src_pk:public_key ->
   src_sk:Client_keys.sk_uri ->
   code:Script.expr ->
-  unit -> (Injection.result * Contract.t) tzresult Lwt.t
+  unit -> (Kind.origination Kind.manager Injection.result * Contract.t) tzresult Lwt.t
 
 val transfer :
   #Proto_alpha.full ->
@@ -127,7 +127,7 @@ val transfer :
   ?gas_limit:Z.t ->
   ?storage_limit:Int64.t ->
   unit ->
-  (Injection.result * Contract.t list) tzresult Lwt.t
+  (Kind.transaction Kind.manager Injection.result * Contract.t list) tzresult Lwt.t
 
 val reveal :
   #Proto_alpha.full ->
@@ -139,16 +139,25 @@ val reveal :
   src_pk:public_key ->
   src_sk:Client_keys.sk_uri ->
   fee:Tez.t ->
-  unit -> Injection.result tzresult Lwt.t
+  unit -> Kind.reveal Kind.manager Injection.result tzresult Lwt.t
 
-val dictate :
+val activate_protocol :
   #Proto_alpha.full ->
   chain:Shell_services.chain ->
   block:Shell_services.block ->
   ?confirmations:int ->
-  dictator_operation ->
+  Protocol_hash.t ->
   Client_keys.sk_uri ->
-  Injection.result tzresult Lwt.t
+  Kind.activate_protocol Injection.result tzresult Lwt.t
+
+val activate_test_protocol :
+  #Proto_alpha.full ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  ?confirmations:int ->
+  Protocol_hash.t ->
+  Client_keys.sk_uri ->
+  Kind.activate_test_protocol Injection.result tzresult Lwt.t
 
 type activation_key =
   { pkh : Ed25519.Public_key_hash.t ;
@@ -161,7 +170,7 @@ type activation_key =
 
 val activation_key_encoding: activation_key Data_encoding.t
 
-val claim_commitment:
+val activate_account:
   #Proto_alpha.full ->
   chain:Shell_services.chain ->
   block:Shell_services.block ->
@@ -170,5 +179,5 @@ val claim_commitment:
   ?force:bool ->
   activation_key ->
   string ->
-  Injection.result tzresult Lwt.t
+  Kind.activate_account Injection.result tzresult Lwt.t
 

src/proto_alpha/lib_client/client_proto_programs.mli

@@ -25,7 +25,7 @@ val run :
   input:Michelson_v1_parser.parsed ->
   unit ->
   (Script.expr *
-   internal_operation list *
+   packed_internal_operation list *
    Contract.big_map_diff option) tzresult Lwt.t
 
 val trace :
@@ -39,7 +39,7 @@ val trace :
   input:Michelson_v1_parser.parsed ->
   unit ->
   (Script.expr *
-   internal_operation list *
+   packed_internal_operation list *
    Script_interpreter.execution_trace *
    Contract.big_map_diff option) tzresult Lwt.t
 
@@ -48,7 +48,7 @@ val print_run_result :
   show_source:bool ->
   parsed:Michelson_v1_parser.parsed ->
   (Script_repr.expr *
-   internal_operation list *
+   packed_internal_operation list *
    Contract.big_map_diff option) tzresult -> unit tzresult Lwt.t
 
 val print_trace_result :
@@ -56,7 +56,7 @@ val print_trace_result :
   show_source:bool ->
   parsed:Michelson_v1_parser.parsed ->
   (Script_repr.expr *
-   internal_operation list *
+   packed_internal_operation list *
    Script_interpreter.execution_trace *
    Contract.big_map_diff option)
     tzresult -> unit tzresult Lwt.t

src/proto_alpha/lib_client/injection.ml

@@ -23,22 +23,27 @@ let get_branch (rpc_config: #Proto_alpha.full)
   Shell_services.Blocks.hash rpc_config ~chain ~block () >>=? fun hash ->
   return hash
 
-type result = Operation_hash.t * operation * operation_result
+type 'kind preapply_result =
+  Operation_hash.t * 'kind operation * 'kind operation_metadata
 
-let preapply
+type 'kind result_list =
+  Operation_hash.t * 'kind contents_list * 'kind contents_result_list
+
+type 'kind result =
+  Operation_hash.t * 'kind contents * 'kind contents_result
+
+let preapply (type t)
     (cctxt: #Proto_alpha.full) ~chain ~block
-    ?branch ?src_sk contents =
+    ?branch ?src_sk (contents : t contents_list) =
   get_branch cctxt ~chain ~block branch >>=? fun branch ->
   let bytes =
     Data_encoding.Binary.to_bytes_exn
       Operation.unsigned_encoding
-      ({ branch }, contents) in
+      ({ branch }, Contents_list contents) in
   let watermark =
     match contents with
-    | Sourced_operation (Consensus_operation (Endorsements _)) ->
+    | Single (Endorsements _) -> Signature.Endorsement
-        Signature.Endorsement
+    | _ -> Signature.Generic_operation in
-    | _ ->
-        Signature.Generic_operation in
   begin
     match src_sk with
     | None -> return None
@@ -47,90 +52,196 @@ let preapply
           ~watermark src_sk bytes >>=? fun signature ->
         return (Some signature)
   end >>=? fun signature ->
-  let op =
+  let op : _ Operation.t =
     { shell = { branch } ;
       protocol_data = { contents ; signature } } in
   let oph = Operation.hash op in
   Alpha_block_services.Helpers.Preapply.operations
-    cctxt ~chain ~block [op] >>=? function
+    cctxt ~chain ~block [Operation.pack op] >>=? function
-  | [result] -> return (oph, op, result)
+  | [(Operation_data op', Operation_metadata result)] -> begin
+      match Operation.equal
+              op { shell = { branch } ; protocol_data = op' },
+            Apply_operation_result.kind_equal_list contents result.contents with
+      | Some Operation.Eq, Some Apply_operation_result.Eq ->
+          return ((oph, op, result) : t preapply_result)
+      | _ -> failwith "Unexpected result"
+    end
   | _ -> failwith "Unexpected result"
 
-let estimated_gas = function
+let estimated_gas_single
-  | Sourced_operation_result (Manager_operations_result { operation_results }) ->
+    (type kind)
+    (Manager_operation_result { operation_result ;
+                                internal_operation_results }
+     : kind Kind.manager contents_result) =
+  let consumed_gas (type kind) (result : kind manager_operation_result) =
+    match result with
+    | Applied (Transaction_result { consumed_gas }) -> Ok consumed_gas
+    | Applied (Origination_result { consumed_gas }) -> Ok consumed_gas
+    | Applied Reveal_result -> Ok Z.zero
+    | Applied Delegation_result -> Ok Z.zero
+    | Skipped _ -> assert false
+    | Failed (_, errs) -> Alpha_environment.wrap_error (Error errs) in
   List.fold_left
-        (fun acc (_, r) -> acc >>? fun acc ->
+    (fun acc (Internal_operation_result (_, r)) ->
-          match r with
+       acc >>? fun acc ->
-          | Applied (Transaction_result { consumed_gas }
+       consumed_gas r >>? fun gas ->
-                    | Origination_result { consumed_gas }) ->
+       Ok (Z.add acc gas))
-              Ok (Z.add consumed_gas acc)
+    (consumed_gas operation_result) internal_operation_results
-          | Applied Reveal_result -> Ok acc
-          | Applied Delegation_result -> Ok acc
-          | Skipped -> assert false
-          | Failed errs -> Alpha_environment.wrap_error (Error errs))
-        (Ok Z.zero) operation_results
-  | _ -> Ok Z.zero
 
-let estimated_storage = function
+let rec estimated_gas :
-  | Sourced_operation_result (Manager_operations_result { operation_results }) ->
+  type kind. kind Kind.manager contents_result_list -> _ =
+  function
+  | Single_result res -> estimated_gas_single res
+  | Cons_result (res, rest) ->
+      estimated_gas_single res >>? fun gas1 ->
+      estimated_gas rest >>? fun gas2 ->
+      Ok (Z.add gas1 gas2)
+
+let estimated_storage_single
+    (type kind)
+    (Manager_operation_result { operation_result ;
+                                internal_operation_results }
+     : kind Kind.manager contents_result) =
+  let storage_size_diff (type kind) (result : kind manager_operation_result) =
+    match result with
+    | Applied (Transaction_result { storage_size_diff }) -> Ok storage_size_diff
+    | Applied (Origination_result { storage_size_diff }) -> Ok storage_size_diff
+    | Applied Reveal_result -> Ok Int64.zero
+    | Applied Delegation_result -> Ok Int64.zero
+    | Skipped _ -> assert false
+    | Failed (_, errs) -> Alpha_environment.wrap_error (Error errs) in
   List.fold_left
-        (fun acc (_, r) -> acc >>? fun acc ->
+    (fun acc (Internal_operation_result (_, r)) ->
-          match r with
+       acc >>? fun acc ->
-          | Applied (Transaction_result { storage_size_diff }
+       storage_size_diff r >>? fun storage ->
-                    | Origination_result { storage_size_diff }) ->
+       Ok (Int64.add acc storage))
-              Ok (Int64.add storage_size_diff acc)
+    (storage_size_diff operation_result) internal_operation_results
-          | Applied Reveal_result -> Ok acc
+
-          | Applied Delegation_result -> Ok acc
+let estimated_storage res =
-          | Skipped -> assert false
+  let rec estimated_storage :
-          | Failed errs -> Alpha_environment.wrap_error (Error errs))
+    type kind. kind Kind.manager contents_result_list -> _ =
-        (Ok 0L) operation_results >>? fun diff ->
+    function
+    | Single_result res -> estimated_storage_single res
+    | Cons_result (res, rest) ->
+        estimated_storage_single res >>? fun storage1 ->
+        estimated_storage rest >>? fun storage2 ->
+        Ok (Int64.add storage1 storage2) in
+  estimated_storage res >>? fun diff ->
   Ok (max 0L diff)
-  | _ -> Ok 0L
 
-let originated_contracts = function
+let originated_contracts_single
-  | Sourced_operation_result (Manager_operations_result { operation_results }) ->
+    (type kind)
+    (Manager_operation_result { operation_result ;
+                                internal_operation_results }
+     : kind Kind.manager contents_result) =
+  let originated_contracts (type kind) (result : kind manager_operation_result) =
+    match result with
+    | Applied (Transaction_result { originated_contracts }) -> Ok originated_contracts
+    | Applied (Origination_result { originated_contracts }) -> Ok originated_contracts
+    | Applied Reveal_result -> Ok []
+    | Applied Delegation_result -> Ok []
+    | Skipped _ -> assert false
+    | Failed (_, errs) -> Alpha_environment.wrap_error (Error errs) in
   List.fold_left
-        (fun acc (_, r) -> acc >>? fun acc ->
+    (fun acc (Internal_operation_result (_, r)) ->
-          match r with
+       acc >>? fun acc ->
-          | Applied (Transaction_result { originated_contracts }
+       originated_contracts r >>? fun contracts ->
-                    | Origination_result { originated_contracts }) ->
+       Ok (List.rev_append contracts acc))
-              Ok (originated_contracts @ acc)
+    (originated_contracts operation_result >|? List.rev)
-          | Applied Reveal_result -> Ok acc
+    internal_operation_results
-          | Applied Delegation_result -> Ok acc
-          | Skipped -> assert false
-          | Failed errs -> Alpha_environment.wrap_error (Error errs))
-        (Ok []) operation_results
-  | _ -> Ok []
 
-let detect_script_failure = function
+let rec originated_contracts :
-  | Sourced_operation_result (Manager_operations_result { operation_results }) ->
+  type kind. kind contents_result_list -> _ =
-      List.fold_left
+  function
-        (fun acc (_, r) -> acc >>? fun () ->
+  | Single_result (Manager_operation_result _ as res) ->
-          match r with
+      originated_contracts_single res >|? List.rev
+  | Single_result _ -> Ok []
+  | Cons_result (res, rest) ->
+      originated_contracts_single res >>? fun contracts1 ->
+      originated_contracts rest >>? fun contracts2 ->
+      Ok (List.rev_append contracts1 contracts2)
+
+let detect_script_failure :
+  type kind. kind operation_metadata -> _ =
+  let rec detect_script_failure :
+    type kind. kind contents_result_list -> _ =
+    let detect_script_failure_single
+        (type kind)
+        (Manager_operation_result { operation_result ;
+                                    internal_operation_results }
+         : kind Kind.manager contents_result) =
+      let detect_script_failure (type kind) (result : kind manager_operation_result) =
+        match result with
         | Applied _ -> Ok ()
-          | Skipped -> assert false
+        | Skipped _ -> assert false
-          | Failed errs ->
+        | Failed (_, errs) ->
             record_trace
               (failure "The transfer simulation failed.")
-                (Alpha_environment.wrap_error (Error errs)))
+              (Alpha_environment.wrap_error (Error errs)) in
-        (Ok ()) operation_results
+      List.fold_left
-  | _ -> Ok ()
+        (fun acc (Internal_operation_result (_, r)) ->
+           acc >>? fun () ->
+           detect_script_failure r)
+        (detect_script_failure operation_result)
+        internal_operation_results in
+    function
+    | Single_result (Manager_operation_result _ as res) ->
+        detect_script_failure_single res
+    | Single_result _ ->
+        Ok ()
+    | Cons_result (res, rest) ->
+        detect_script_failure_single res >>? fun () ->
+        detect_script_failure rest in
+  fun { contents } -> detect_script_failure contents
+
 
 let may_patch_limits
-    (cctxt : #Proto_alpha.full) ~chain ~block ?branch
+    (type kind) (cctxt : #Proto_alpha.full) ~chain ~block ?branch
-    ?src_sk contents =
+    ?src_sk (contents: kind contents_list) : kind contents_list tzresult Lwt.t =
-  Alpha_services.Constants.hard_gas_limits cctxt (chain, block) >>=? fun (_, gas_limit) ->
+  Alpha_services.Constants.hard_gas_limits
-  Alpha_services.Constants.hard_storage_limits cctxt (chain, block) >>=? fun (_, storage_limit) ->
+    cctxt (chain, block) >>=? fun (_, gas_limit) ->
-
+  Alpha_services.Constants.hard_storage_limits
-  match contents with
+    cctxt (chain, block) >>=? fun (_, storage_limit) ->
-  | Sourced_operation (Manager_operations c)
+  let may_need_patching_single
+    : type kind. kind contents -> kind contents option = function
+    | Manager_operation c
       when c.gas_limit < Z.zero || gas_limit < c.gas_limit
            || c.storage_limit < 0L || storage_limit < c.storage_limit ->
-      let contents =
+        let gas_limit =
-        Sourced_operation (Manager_operations { c with gas_limit ; storage_limit }) in
+          if c.gas_limit < Z.zero || gas_limit < c.gas_limit then
-      preapply cctxt ~chain ~block ?branch ?src_sk contents >>=? fun (_, _, result) ->
+            gas_limit
-      begin if c.gas_limit < Z.zero || gas_limit < c.gas_limit then
+          else
-          Lwt.return (estimated_gas result) >>=? fun gas ->
+            c.gas_limit in
+        let storage_limit =
+          if c.storage_limit < 0L || storage_limit < c.storage_limit then
+            storage_limit
+          else
+            c.storage_limit in
+        Some (Manager_operation { c with gas_limit ; storage_limit })
+    | _ -> None in
+  let rec may_need_patching
+    : type kind. kind contents_list -> kind contents_list option =
+    function
+    | Single (Manager_operation _ as c) -> begin
+        match may_need_patching_single c with
+        | None -> None
+        | Some op -> Some (Single op)
+      end
+    | Single _ -> None
+    | Cons (Manager_operation _ as c, rest) -> begin
+        match may_need_patching_single c, may_need_patching rest with
+        | None, None -> None
+        | Some c, None -> Some (Cons (c, rest))
+        | None, Some rest -> Some (Cons (c, rest))
+        | Some c, Some rest -> Some (Cons (c, rest))
+      end in
+
+  let patch :
+    type kind. kind contents * kind contents_result -> kind contents tzresult Lwt.t = function
+    | Manager_operation c, (Manager_operation_result _ as result) ->
+        begin
+          if c.gas_limit < Z.zero || gas_limit < c.gas_limit then
+            Lwt.return (estimated_gas_single result) >>=? fun gas ->
             begin
               if Z.equal gas Z.zero then
                 cctxt#message "Estimated gas: none" >>= fun () ->
@@ -143,8 +254,9 @@ let may_patch_limits
             end
           else return c.gas_limit
         end >>=? fun gas_limit ->
-      begin if c.storage_limit < 0L || storage_limit < c.storage_limit then
+        begin
-          Lwt.return (estimated_storage result) >>=? fun storage ->
+          if c.storage_limit < 0L || storage_limit < c.storage_limit then
+            Lwt.return (estimated_storage_single result) >>=? fun storage ->
             begin
               if Int64.equal storage 0L then
                 cctxt#message "Estimated storage: no bytes added" >>= fun () ->
@@ -157,12 +269,32 @@ let may_patch_limits
             end
           else return c.storage_limit
         end >>=? fun storage_limit ->
-      return (Sourced_operation (Manager_operations { c with gas_limit ; storage_limit }))
+        return (Manager_operation { c with gas_limit ; storage_limit })
-  | op -> return op
+    | (c, _) -> return c in
+  let rec patch_list :
+    type kind. kind contents_and_result_list -> kind contents_list tzresult Lwt.t =
+    function
+    | Single_and_result
+        ((Manager_operation _ as op), (Manager_operation_result _ as res)) ->
+        patch (op, res) >>=? fun op -> return (Single op)
+    | Single_and_result (op, _) -> return (Single op)
+    | Cons_and_result ((Manager_operation _ as op),
+                       (Manager_operation_result _ as res), rest) -> begin
+        patch (op, res) >>=? fun op ->
+        patch_list rest >>=? fun rest ->
+        return (Cons (op, rest))
+      end in
+  match may_need_patching contents with
+  | Some contents ->
+      preapply cctxt ~chain ~block
+        ?branch ?src_sk contents >>=? fun (_, _, result) ->
+      let res = pack_contents_list contents result.contents in
+      patch_list res
+  | None -> return contents
 
 let inject_operation
-    cctxt ~chain ~block
+    (type kind) cctxt ~chain ~block
-    ?confirmations ?branch ?src_sk contents =
+    ?confirmations ?branch ?src_sk (contents: kind contents_list)  =
   may_patch_limits
     cctxt ~chain ~block ?branch ?src_sk contents >>=? fun contents ->
   preapply cctxt ~chain ~block
@@ -172,10 +304,13 @@ let inject_operation
     | Error _ as res ->
         cctxt#message
           "@[<v 2>This simulation failed:@,%a@]"
-          Operation_result.pp_operation_result (op, result) >>= fun () ->
+          Operation_result.pp_operation_result
+          (op.protocol_data.contents, result.contents) >>= fun () ->
         Lwt.return res
   end >>=? fun () ->
-  let bytes = Data_encoding.Binary.to_bytes_exn Operation.encoding op in
+  let bytes =
+    Data_encoding.Binary.to_bytes_exn
+      Operation.encoding (Operation.pack op) in
   Shell_services.Injection.operation cctxt ~chain bytes >>=? fun oph ->
   cctxt#message "Operation successfully injected in the node." >>= fun () ->
   cctxt#message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
@@ -187,17 +322,65 @@ let inject_operation
         Client_confirmations.wait_for_operation_inclusion
           ~confirmations cctxt ~chain oph >>=? fun (h, i , j) ->
         Alpha_block_services.Operation.operation
-          cctxt ~block:(`Hash (h, 0)) i j >>=? fun op ->
+          cctxt ~block:(`Hash (h, 0)) i j >>=? fun op' ->
-        return op.metadata
+        let Operation_metadata receipt = op'.receipt in
+        match Apply_operation_result.kind_equal_list contents receipt.contents
+        with
+        | Some Apply_operation_result.Eq ->
+            return (receipt : kind operation_metadata)
+        | None -> failwith "Internal error: unexpected receipt."
   end >>=? fun result ->
   cctxt#message
     "@[<v 2>This sequence of operations was run:@,%a@]"
-    Operation_result.pp_operation_result (op, result) >>= fun () ->
+    Operation_result.pp_operation_result
-  Lwt.return (originated_contracts result) >>=? fun contracts ->
+    (op.protocol_data.contents, result.contents) >>= fun () ->
+  Lwt.return (originated_contracts result.contents) >>=? fun contracts ->
   Lwt_list.iter_s
     (fun c ->
        cctxt#message
          "New contract %a originated."
          Contract.pp c)
     contracts >>= fun () ->
+  return (oph, op.protocol_data.contents, result.contents)
+
+let inject_manager_operation
+    cctxt ~chain ~block ?branch ?confirmations
+    ~source ~src_pk ~src_sk ~fee ?(gas_limit = Z.minus_one) ?(storage_limit = -1L)
+    (type kind) (operation : kind manager_operation)
+  : (Operation_hash.t * kind Kind.manager contents *  kind Kind.manager contents_result) tzresult Lwt.t =
+  Alpha_services.Contract.counter
+    cctxt (chain, block) source >>=? fun pcounter ->
+  let counter = Int32.succ pcounter in
+  Alpha_services.Contract.manager_key
+    cctxt (chain, block) source >>=? fun (_, key) ->
+  let is_reveal : type kind. kind manager_operation -> bool = function
+    | Reveal _ -> true
+    | _ -> false in
+  match key with
+  | None when not (is_reveal operation) -> begin
+      let contents =
+        Cons
+          (Manager_operation { source ; fee = Tez.zero ; counter ;
+                               gas_limit = Z.zero ; storage_limit = 0L ;
+                               operation = Reveal src_pk },
+           Single (Manager_operation { source ; fee ; counter = Int32.succ counter ;
+                                       gas_limit ; storage_limit ; operation })) in
+      inject_operation cctxt ~chain ~block ?confirmations
+        ?branch ~src_sk contents >>=? fun (oph, op, result) ->
+      match pack_contents_list op result with
+      | Cons_and_result (_, _, Single_and_result (op, result)) ->
           return (oph, op, result)
+      | Single_and_result (Manager_operation _, _) -> .
+      | _ -> assert false (* Grrr... *)
+    end
+  | _ ->
+      let contents =
+        Single (Manager_operation { source ; fee ; counter ;
+                                    gas_limit ; storage_limit ; operation }) in
+      inject_operation cctxt ~chain ~block ?confirmations
+        ?branch ~src_sk contents >>=? fun (oph, op, result) ->
+      match pack_contents_list op result with
+      | Single_and_result (Manager_operation _ as op, result) ->
+          return (oph, op, result)
+      | _ -> assert false (* Grrr... *)
+

src/proto_alpha/lib_client/injection.mli

@@ -11,7 +11,8 @@ open Proto_alpha
 open Alpha_context
 open Apply_operation_result
 
-type result = Operation_hash.t * operation * operation_result
+type 'kind preapply_result =
+  Operation_hash.t * 'kind operation * 'kind operation_metadata
 
 val preapply:
   #Proto_alpha.full ->
@@ -19,8 +20,11 @@ val preapply:
   block:Shell_services.block ->
   ?branch:int ->
   ?src_sk:Client_keys.sk_uri ->
-  Operation.contents ->
+  'kind contents_list ->
-  result tzresult Lwt.t
+  'kind preapply_result tzresult Lwt.t
+
+type 'kind result_list =
+  Operation_hash.t * 'kind contents_list * 'kind contents_result_list
 
 val inject_operation:
   #Proto_alpha.full ->
@@ -29,7 +33,26 @@ val inject_operation:
   ?confirmations:int ->
   ?branch:int ->
   ?src_sk:Client_keys.sk_uri ->
-  Operation.contents ->
+  'kind contents_list ->
-  result tzresult Lwt.t
+  'kind result_list tzresult Lwt.t
 
-val originated_contracts: operation_result -> Contract.t list tzresult
+type 'kind result =
+  Operation_hash.t * 'kind contents * 'kind contents_result
+
+val inject_manager_operation:
+  #Proto_alpha.full ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  ?branch:int ->
+  ?confirmations:int ->
+  source:Contract.t ->
+  src_pk:Signature.public_key ->
+  src_sk:Client_keys.sk_uri ->
+  fee:Tez.t ->
+  ?gas_limit:Z.t ->
+  ?storage_limit:int64 ->
+  'kind manager_operation ->
+  'kind Kind.manager result tzresult Lwt.t
+
+val originated_contracts:
+  'kind contents_result_list -> Contract.t list tzresult

src/proto_alpha/lib_client/operation_result.ml

@@ -11,10 +11,12 @@ open Proto_alpha
 open Alpha_context
 open Apply_operation_result
 
-let pp_manager_operation_content ppf source operation internal pp_result result =
+let pp_manager_operation_content
+    (type kind) source internal pp_result
+    ppf (operation, result : kind manager_operation * _) =
   Format.fprintf ppf "@[<v 0>" ;
   begin match operation with
-    | Alpha_context.Transaction { destination ; amount ; parameters } ->
+    | Transaction { destination ; amount ; parameters } ->
         Format.fprintf ppf
           "@[<v 2>%s:@,\
            Amount: %s%a@,\
@@ -134,123 +136,17 @@ let pp_balance_updates ppf = function
       Format.fprintf ppf "@[<v 0>%a@]"
         (Format.pp_print_list pp_one) balance_updates
 
-let pp_operation_result ppf
+let pp_manager_operation_contents_and_result ppf
-    ({ protocol_data = { contents ; _ } }, operation_result) =
+    (Manager_operation { source ; fee ; operation ; counter ; gas_limit ; storage_limit },
-  Format.fprintf ppf "@[<v 0>" ;
+     Manager_operation_result { balance_updates ; operation_result ;
-  begin match contents, operation_result with
+                                internal_operation_results }) =
-    | Anonymous_operations ops, Anonymous_operations_result rs ->
+  let pp_result (type kind) ppf (result : kind manager_operation_result) =
-        let ops_rs = List.combine ops rs in
-        let pp_anonymous_operation_result ppf = function
-          | Seed_nonce_revelation { level ; nonce },
-            Seed_nonce_revelation_result bus ->
-              Format.fprintf ppf
-                "@[<v 2>Seed nonce revelation:@,\
-                 Level: %a@,\
-                 Nonce (hash): %a@,\
-                 Balance updates:@,\
-                \  %a@]"
-                Raw_level.pp level
-                Nonce_hash.pp (Nonce.hash nonce)
-                pp_balance_updates bus
-          | Double_baking_evidence { bh1 ; bh2 },
-            Double_baking_evidence_result bus ->
-              Format.fprintf ppf
-                "@[<v 2>Double baking evidence:@,\
-                 Exhibit A: %a@,\
-                 Exhibit B: %a@,\
-                 Balance updates:@,\
-                \  %a@]"
-                Block_hash.pp (Block_header.hash bh1)
-                Block_hash.pp (Block_header.hash bh2)
-                pp_balance_updates bus
-          | Double_endorsement_evidence { op1 ; op2},
-            Double_endorsement_evidence_result bus ->
-              Format.fprintf ppf
-                "@[<v 2>Double endorsement evidence:@,\
-                 Exhibit A: %a@,\
-                 Exhibit B: %a@,\
-                 Balance updates:@,\
-                \  %a@]"
-                Operation_hash.pp (Operation.hash op1)
-                Operation_hash.pp (Operation.hash op2)
-                pp_balance_updates bus
-          | Activation { id ; _ },
-            Activation_result bus ->
-              Format.fprintf ppf
-                "@[<v 2>Genesis account activation:@,\
-                 Account: %a@,\
-                 Balance updates:@,\
-                \  %a@]"
-                Ed25519.Public_key_hash.pp id
-                pp_balance_updates bus
-          | _, _ -> invalid_arg "Apply_operation_result.pp"
-        in
-        Format.pp_print_list pp_anonymous_operation_result ppf ops_rs
-    | Sourced_operation
-        (Consensus_operation
-           (Endorsements { block ; level ; slots })),
-      Sourced_operation_result
-        (Consensus_operation_result
-           (Endorsements_result (delegate, _slots))) ->
-        Format.fprintf ppf
-          "@[<v 2>Endorsement:@,\
-           Block: %a@,\
-           Level: %a@,\
-           Delegate: %a@,\
-           Slots: %a@]"
-          Block_hash.pp block
-          Raw_level.pp level
-          Signature.Public_key_hash.pp delegate
-          (Format.pp_print_list
-             ~pp_sep:Format.pp_print_space
-             Format.pp_print_int)
-          slots
-    | Sourced_operation
-        (Amendment_operation { source ; operation = Proposals { period ; proposals } }),
-      Sourced_operation_result Amendment_operation_result ->
-        Format.fprintf ppf
-          "@[<v 2>Proposals:@,\
-           From: %a@,\
-           Period: %a@,\
-           Protocols:@,\
-          \  @[<v 0>%a@]@]"
-          Signature.Public_key_hash.pp source
-          Voting_period.pp period
-          (Format.pp_print_list Protocol_hash.pp) proposals
-    | Sourced_operation
-        (Amendment_operation { source ; operation = Ballot { period ; proposal ; ballot } }),
-      Sourced_operation_result Amendment_operation_result ->
-        Format.fprintf ppf
-          "@[<v 2>Ballot:@,\
-           From: %a@,\
-           Period: %a@,\
-           Protocol: %a@,\
-           Vote: %s@]"
-          Signature.Public_key_hash.pp source
-          Voting_period.pp period
-          Protocol_hash.pp proposal
-          (match ballot with Yay -> "YAY" | Pass -> "PASS" | Nay -> "NAY")
-    | Sourced_operation (Dictator_operation (Activate protocol)),
-      Sourced_operation_result Dictator_operation_result ->
-        Format.fprintf ppf
-          "@[<v 2>Dictator protocol activation:@,\
-           Protocol: %a@]"
-          Protocol_hash.pp protocol
-    | Sourced_operation (Dictator_operation (Activate_testchain protocol)),
-      Sourced_operation_result Dictator_operation_result ->
-        Format.fprintf ppf
-          "@[<v 2>Dictator test protocol activation:@,\
-           Protocol: %a@]"
-          Protocol_hash.pp protocol
-    | Sourced_operation (Manager_operations { source ; fee ; counter ; operations ; gas_limit ; storage_limit }),
-      Sourced_operation_result (Manager_operations_result { balance_updates ; operation_results }) ->
-        let pp_result ppf result =
     Format.fprintf ppf "@," ;
     match result with
-          | Skipped ->
+    | Skipped _ ->
         Format.fprintf ppf
           "This operation was skipped"
-          | Failed _errs ->
+    | Failed (_, _errs) ->
         Format.fprintf ppf
           "This operation FAILED."
     | Applied Reveal_result ->
@@ -260,14 +156,10 @@ let pp_operation_result ppf
         Format.fprintf ppf
           "This delegation was successfully applied"
     | Applied (Transaction_result { balance_updates ; consumed_gas ;
-                                          operations ; storage ;
+                                    storage ;
                                     originated_contracts ; storage_size_diff }) ->
         Format.fprintf ppf
           "This transaction was successfully applied" ;
-              begin match operations with
-                | [] -> ()
-                | ops -> Format.fprintf ppf "@,Internal operations: %d" (List.length ops)
-              end ;
         begin match originated_contracts with
           | [] -> ()
           | contracts ->
@@ -320,18 +212,6 @@ let pp_operation_result ppf
                 "@,Balance updates:@,  %a"
                 pp_balance_updates balance_updates
         end in
-        let rec pp_manager_operations_results ppf = function
-          | [], [] -> ()
-          | operation :: ops, (External, r) :: rs ->
-              Format.fprintf ppf "@," ;
-              pp_manager_operation_content ppf source operation false pp_result r ;
-              pp_manager_operations_results ppf (ops, rs)
-          | ops, (Internal { source ; operation }, r) :: rs ->
-              Format.fprintf ppf "@," ;
-              pp_manager_operation_content ppf source operation true pp_result r ;
-              pp_manager_operations_results ppf (ops, rs)
-          | [], _ :: _
-          | _ :: _, [] -> invalid_arg "Apply_operation_result.pp" in
   Format.fprintf ppf
     "@[<v 0>@[<v 2>Manager signed operations:@,\
      From: %a@,\
@@ -353,11 +233,146 @@ let pp_operation_result ppf
           pp_balance_updates balance_updates
   end ;
   Format.fprintf ppf
-          "@]%a@]"
+    "@,%a"
-          pp_manager_operations_results (operations, operation_results)
+    (pp_manager_operation_content source false pp_result)
-    | _, _ -> invalid_arg "Apply_operation_result.pp"
+    (operation, operation_result) ;
+  begin
+    match internal_operation_results with
+    | [] -> ()
+    | _ :: _ ->
+        Format.fprintf ppf
+          "@,@[<v 2>Internal operations:@ %a@]"
+          (Format.pp_print_list
+             (fun ppf (Internal_operation_result (op, res)) ->
+                pp_manager_operation_content op.source false pp_result
+                  ppf (op.operation, res)))
+          internal_operation_results
   end ;
   Format.fprintf ppf "@]"
 
-let pp_internal_operation ppf { source ; operation } =
+let rec pp_contents_and_result_list :
-  pp_manager_operation_content ppf source operation true (fun _ppf () -> ()) ()
+  type kind. Format.formatter -> kind contents_and_result_list -> unit =
+  fun ppf -> function
+    | Single_and_result
+        (Seed_nonce_revelation { level ; nonce },
+         Seed_nonce_revelation_result bus) ->
+        Format.fprintf ppf
+          "@[<v 2>Seed nonce revelation:@,\
+           Level: %a@,\
+           Nonce (hash): %a@,\
+           Balance updates:@,\
+          \  %a@]"
+          Raw_level.pp level
+          Nonce_hash.pp (Nonce.hash nonce)
+          pp_balance_updates bus
+    | Single_and_result
+        (Double_baking_evidence { bh1 ; bh2 },
+         Double_baking_evidence_result bus) ->
+        Format.fprintf ppf
+          "@[<v 2>Double baking evidence:@,\
+           Exhibit A: %a@,\
+           Exhibit B: %a@,\
+           Balance updates:@,\
+          \  %a@]"
+          Block_hash.pp (Block_header.hash bh1)
+          Block_hash.pp (Block_header.hash bh2)
+          pp_balance_updates bus
+    | Single_and_result
+        (Double_endorsement_evidence { op1 ; op2 },
+         Double_endorsement_evidence_result bus) ->
+        Format.fprintf ppf
+          "@[<v 2>Double endorsement evidence:@,\
+           Exhibit A: %a@,\
+           Exhibit B: %a@,\
+           Balance updates:@,\
+          \  %a@]"
+          Operation_hash.pp (Operation.hash op1)
+          Operation_hash.pp (Operation.hash op2)
+          pp_balance_updates bus
+    | Single_and_result
+        (Activate_account { id ; _ },
+         Activate_account_result bus) ->
+        Format.fprintf ppf
+          "@[<v 2>Genesis account activation:@,\
+           Account: %a@,\
+           Balance updates:@,\
+          \  %a@]"
+          Ed25519.Public_key_hash.pp id
+          pp_balance_updates bus
+    | Single_and_result
+        (Endorsements { block ; level ; slots },
+         Endorsements_result (delegate, _slots)) ->
+        Format.fprintf ppf
+          "@[<v 2>Endorsement:@,\
+           Block: %a@,\
+           Level: %a@,\
+           Delegate: %a@,\
+           Slots: %a@]"
+          Block_hash.pp block
+          Raw_level.pp level
+          Signature.Public_key_hash.pp delegate
+          (Format.pp_print_list
+             ~pp_sep:Format.pp_print_space
+             Format.pp_print_int)
+          slots
+    | Single_and_result
+        (Proposals { source ; period ; proposals },
+         Proposals_result) ->
+        Format.fprintf ppf
+          "@[<v 2>Proposals:@,\
+           From: %a@,\
+           Period: %a@,\
+           Protocols:@,\
+          \  @[<v 0>%a@]@]"
+          Signature.Public_key_hash.pp source
+          Voting_period.pp period
+          (Format.pp_print_list Protocol_hash.pp) proposals
+    | Single_and_result
+        (Ballot { source ;period ; proposal ; ballot },
+         Ballot_result) ->
+        Format.fprintf ppf
+          "@[<v 2>Ballot:@,\
+           From: %a@,\
+           Period: %a@,\
+           Protocol: %a@,\
+           Vote: %s@]"
+          Signature.Public_key_hash.pp source
+          Voting_period.pp period
+          Protocol_hash.pp proposal
+          (match ballot with Yay -> "YAY" | Pass -> "PASS" | Nay -> "NAY")
+    | Single_and_result
+        (Activate_protocol protocol,
+         Activate_protocol_result) ->
+        Format.fprintf ppf
+          "@[<v 2>Dictator protocol activation:@,\
+           Protocol: %a@]"
+          Protocol_hash.pp protocol
+    | Single_and_result
+        (Activate_test_protocol protocol,
+         Activate_test_protocol_result) ->
+        Format.fprintf ppf
+          "@[<v 2>Dictator test protocol activation:@,\
+           Protocol: %a@]"
+          Protocol_hash.pp protocol
+    | Single_and_result (Manager_operation _ as op,
+                         (Manager_operation_result _ as res))->
+        Format.fprintf ppf "%a"
+          pp_manager_operation_contents_and_result (op, res)
+    | Cons_and_result (Manager_operation _ as op,
+                       (Manager_operation_result _ as res),
+                       rest) ->
+        Format.fprintf ppf "%a@\n%a"
+          pp_manager_operation_contents_and_result (op, res)
+          pp_contents_and_result_list rest
+
+let pp_operation_result ppf
+    (op, res : 'kind contents_list * 'kind contents_result_list) =
+  Format.fprintf ppf "@[<v 0>" ;
+  let contents_and_result_list =
+    Apply_operation_result.pack_contents_list op res in
+  pp_contents_and_result_list ppf contents_and_result_list ;
+  Format.fprintf ppf "@]@."
+
+let pp_internal_operation ppf (Internal_operation { source ; operation }) =
+  pp_manager_operation_content source true (fun _ppf () -> ())
+    ppf (operation, ())

src/proto_alpha/lib_client/operation_result.mli

@@ -11,7 +11,8 @@ open Proto_alpha
 open Alpha_context
 
 val pp_internal_operation:
-  Format.formatter -> internal_operation -> unit
+  Format.formatter -> packed_internal_operation -> unit
 
 val pp_operation_result:
-  Format.formatter -> (operation * Apply_operation_result.operation_result) -> unit
+  Format.formatter ->
+  ('kind contents_list * 'kind Apply_operation_result.contents_result_list) -> unit

src/proto_alpha/lib_client_commands/client_proto_context_commands.ml

@@ -323,7 +323,7 @@ let commands () =
                (fun ppf -> Data_encoding.Json.print_error ppf) exn
                Data_encoding.Json.pp json
          | key ->
-             claim_commitment cctxt
+             activate_account cctxt
                ~chain:`Main ~block:cctxt#block ?confirmations:cctxt#confirmations
                ~encrypted ~force key name >>=? fun _res ->
              return ()
@@ -339,9 +339,9 @@ let commands () =
          ~name:"password" ~desc:"dictator's key"
        @@ stop)
       begin fun () hash seckey cctxt ->
-        dictate cctxt
+        activate_protocol cctxt
           ~chain:`Main ~block:cctxt#block
-          (Activate hash) seckey >>=? fun _ ->
+          hash seckey >>=? fun _ ->
         return ()
       end ;
 
@@ -395,9 +395,9 @@ let commands () =
          ~name:"password" ~desc:"dictator's key"
        @@ stop)
       begin fun () hash seckey cctxt ->
-        dictate cctxt
+        activate_test_protocol cctxt
           ~chain:`Main ~block:cctxt#block
-          (Activate_testchain hash) seckey >>=? fun _res ->
+          hash seckey >>=? fun _res ->
         return ()
       end ;
 

src/proto_alpha/lib_protocol/src/alpha_context.ml

@@ -27,10 +27,11 @@ end
 
 include Operation_repr
 module Operation = struct
-  type t = operation = {
+  type 'kind t = 'kind operation = {
     shell: Operation.shell_header ;
-    protocol_data: protocol_data ;
+    protocol_data: 'kind protocol_data ;
   }
+  type packed = packed_operation
   let unsigned_encoding = unsigned_operation_encoding
   include Operation_repr
 end

src/proto_alpha/lib_protocol/src/alpha_context.mli

@@ -758,110 +758,147 @@ module Block_header : sig
 
 end
 
-type operation = {
+module Kind : sig
+  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 endorsements = Endorsements_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
+  type activate_protocol = Activate_protocol_kind
+  type activate_test_protocol = Activate_test_protocol_kind
+end
+
+type 'kind operation = {
   shell: Operation.shell_header ;
-  protocol_data: protocol_data ;
+  protocol_data: 'kind protocol_data ;
 }
 
-and protocol_data = {
+and 'kind protocol_data = {
-  contents: contents ;
+  contents: 'kind contents_list ;
   signature: Signature.t option ;
 }
 
-and contents =
+and _ contents_list =
-  | Anonymous_operations of anonymous_operation list
+  | Single : 'kind contents -> 'kind contents_list
-  | Sourced_operation of sourced_operation
+  | Cons : 'kind Kind.manager contents * 'rest Kind.manager contents_list ->
+    (('kind * 'rest) Kind.manager ) contents_list
 
-and anonymous_operation =
+and _ contents =
-  | Seed_nonce_revelation of {
+  | Endorsements : {
-      level: Raw_level.t ;
-      nonce: Nonce.t ;
-    }
-  | Double_endorsement_evidence of {
-      op1: operation ;
-      op2: operation ;
-    }
-  | Double_baking_evidence of {
-      bh1: Block_header.t ;
-      bh2: Block_header.t ;
-    }
-  | Activation of {
-      id: Ed25519.Public_key_hash.t ;
-      activation_code: Blinded_public_key_hash.activation_code ;
-    }
-
-and sourced_operation =
-  | Consensus_operation of consensus_operation
-  | Amendment_operation of {
-      source: Signature.Public_key_hash.t ;
-      operation: amendment_operation ;
-    }
-  | Manager_operations of {
-      source: Contract.contract ;
-      fee: Tez.t ;
-      counter: counter ;
-      operations: manager_operation list ;
-      gas_limit: Z.t ;
-      storage_limit: Int64.t;
-    }
-  | Dictator_operation of dictator_operation
-
-and consensus_operation =
-  | Endorsements of {
       block: Block_hash.t ;
       level: Raw_level.t ;
       slots: int list ;
-    }
+    } -> Kind.endorsements contents
-
+  | Seed_nonce_revelation : {
-and amendment_operation =
+      level: Raw_level.t ;
-  | Proposals of {
+      nonce: Nonce.t ;
+    } -> Kind.seed_nonce_revelation contents
+  | Double_endorsement_evidence : {
+      op1: Kind.endorsements operation ;
+      op2: Kind.endorsements operation ;
+    } -> Kind.double_endorsement_evidence contents
+  | Double_baking_evidence : {
+      bh1: Block_header.t ;
+      bh2: Block_header.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.t ;
       proposals: Protocol_hash.t list ;
-    }
+    } -> Kind.proposals contents
-  | Ballot of {
+  | Ballot : {
+      source: Signature.Public_key_hash.t ;
       period: Voting_period.t ;
       proposal: Protocol_hash.t ;
       ballot: Vote.ballot ;
-    }
+    } -> Kind.ballot contents
+  | Manager_operation : {
+      source: Contract.contract ;
+      fee: Tez.tez ;
+      counter: counter ;
+      operation: 'kind manager_operation ;
+      gas_limit: Z.t;
+      storage_limit: Int64.t;
+    } -> 'kind Kind.manager contents
+  | Activate_protocol :
+      Protocol_hash.t -> Kind.activate_protocol contents
+  | Activate_test_protocol :
+      Protocol_hash.t -> Kind.activate_test_protocol contents
 
-and manager_operation =
+and _ manager_operation =
-  | Reveal of Signature.Public_key.t
+  | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation
-  | Transaction of {
+  | Transaction : {
-      amount: Tez.t ;
+      amount: Tez.tez ;
       parameters: Script.lazy_expr option ;
       destination: Contract.contract ;
-    }
+    } -> Kind.transaction manager_operation
-  | Origination of {
+  | Origination : {
-      manager: public_key_hash ;
+      manager: Signature.Public_key_hash.t ;
-      delegate: public_key_hash option ;
+      delegate: Signature.Public_key_hash.t option ;
       script: Script.t option ;
       spendable: bool ;
       delegatable: bool ;
-      credit: Tez.t ;
+      credit: Tez.tez ;
       preorigination: Contract.t option ;
-    }
+    } -> Kind.origination manager_operation
-  | Delegation of public_key_hash option
+  | Delegation :
-
+      Signature.Public_key_hash.t option -> Kind.delegation manager_operation
-and dictator_operation =
-  | Activate of Protocol_hash.t
-  | Activate_testchain of Protocol_hash.t
 
 and counter = Int32.t
 
-type internal_operation = {
+type 'kind internal_operation = {
   source: Contract.contract ;
-  operation: manager_operation ;
+  operation: 'kind manager_operation ;
-  nonce : int ;
+  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 ;
+}
+
+type packed_internal_operation =
+  | Internal_operation : 'kind internal_operation -> packed_internal_operation
+
+val manager_kind: 'kind manager_operation -> 'kind Kind.manager
+
 module Operation : sig
 
-  type nonrec contents = contents
+  type nonrec 'kind contents = 'kind contents
-  val contents_encoding: contents Data_encoding.t
+  type nonrec packed_contents = packed_contents
+  val contents_encoding: packed_contents Data_encoding.t
 
-  type nonrec protocol_data = protocol_data
+  type nonrec 'kind protocol_data = 'kind protocol_data
-  val protocol_data_encoding: protocol_data Data_encoding.t
+  type nonrec packed_protocol_data = packed_protocol_data
-  val unsigned_encoding: (Operation.shell_header * contents) Data_encoding.t
+  val protocol_data_encoding: packed_protocol_data Data_encoding.t
+  val unsigned_encoding: (Operation.shell_header * packed_contents_list) Data_encoding.t
 
   type raw = Operation.t = {
     shell: Operation.shell_header ;
@@ -869,24 +906,77 @@ module Operation : sig
   }
   val raw_encoding: raw Data_encoding.t
 
-  type t = operation = {
+  type 'kind t = 'kind operation = {
     shell: Operation.shell_header ;
-    protocol_data: protocol_data ;
+    protocol_data: 'kind protocol_data ;
   }
-  val raw: operation -> raw
+  type nonrec packed = packed_operation
-  val encoding: operation Data_encoding.t
+  val encoding: packed Data_encoding.t
 
-  val hash: operation -> Operation_hash.t
+  val raw: _ operation -> raw
+
+  val hash: _ operation -> Operation_hash.t
   val hash_raw: raw -> Operation_hash.t
 
-  val acceptable_passes: operation -> int list
+  val acceptable_passes: packed_operation -> int list
 
   type error += Missing_signature (* `Permanent *)
   type error += Invalid_signature (* `Permanent *)
 
-  val check_signature: public_key -> operation -> unit tzresult Lwt.t
+  val check_signature: public_key -> _ operation -> unit tzresult Lwt.t
 
-  val internal_operation_encoding: internal_operation Data_encoding.t
+  val internal_operation_encoding: packed_internal_operation Data_encoding.t
+
+  val pack: 'kind operation -> packed_operation
+
+  type ('a, 'b) eq = Eq : ('a, 'a) eq
+  val equal: 'a operation -> 'b operation -> ('a, 'b) eq option
+
+  module Encoding : sig
+
+    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
+
+    val endorsement_case: Kind.endorsements case
+    val seed_nonce_revelation_case: Kind.seed_nonce_revelation case
+    val double_endorsement_evidence_case: Kind.double_endorsement_evidence case
+    val double_baking_evidence_case: Kind.double_baking_evidence case
+    val activate_account_case: Kind.activate_account case
+    val proposals_case: Kind.proposals case
+    val ballot_case: Kind.ballot case
+    val reveal_case: Kind.reveal Kind.manager case
+    val transaction_case: Kind.transaction Kind.manager case
+    val origination_case: Kind.origination Kind.manager case
+    val delegation_case: Kind.delegation Kind.manager case
+    val activate_protocol_case: Kind.activate_protocol case
+    val activate_test_protocol_case: Kind.activate_test_protocol case
+
+    module Manager_operations : sig
+
+      type 'b 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
+
+      val reveal_case: Kind.reveal case
+      val transaction_case: Kind.transaction case
+      val origination_case: Kind.origination case
+      val delegation_case: Kind.delegation case
+
+    end
+
+  end
+
+  val of_list: packed_contents list -> packed_contents_list
+  val to_list: packed_contents_list -> packed_contents list
 
 end
 

src/proto_alpha/lib_protocol/src/apply.ml

@@ -17,7 +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 += Internal_operation_replay of packed_internal_operation
 
 type error += Invalid_double_endorsement_evidence (* `Permanent *)
 type error += Inconsistent_double_endorsement_evidence
@@ -122,7 +122,7 @@ let () =
     ~id:"internal_operation_replay"
     ~title:"Internal operation replay"
     ~description:"An internal operation was emitted twice by a script"
-    ~pp:(fun ppf { nonce } ->
+    ~pp:(fun ppf (Internal_operation { 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)
@@ -328,49 +328,6 @@ let () =
 
 open Apply_operation_result
 
-let apply_consensus_operation_content ctxt
-    pred_block operation = function
-  | Endorsements { block ; level ; slots } ->
-      begin
-        match Level.pred ctxt (Level.current ctxt) with
-        | None -> failwith ""
-        | Some lvl -> return lvl
-      end >>=? fun ({ level = current_level ;_ } as lvl) ->
-      fail_unless
-        (Block_hash.equal block pred_block)
-        (Wrong_endorsement_predecessor (pred_block, block)) >>=? fun () ->
-      fail_unless
-        Raw_level.(level = current_level)
-        Invalid_endorsement_level >>=? fun () ->
-      fold_left_s (fun ctxt slot ->
-          fail_when
-            (endorsement_already_recorded ctxt slot)
-            (Duplicate_endorsement slot) >>=? fun () ->
-          return (record_endorsement ctxt slot))
-        ctxt slots >>=? fun ctxt ->
-      Baking.check_endorsements_rights ctxt lvl slots >>=? fun delegate ->
-      Operation.check_signature delegate operation >>=? fun () ->
-      let delegate = Signature.Public_key.hash delegate in
-      let ctxt = Fitness.increase ~gap:(List.length slots) ctxt in
-      Baking.freeze_endorsement_deposit
-        ctxt delegate (List.length slots) >>=? fun ctxt ->
-      Global.get_last_block_priority ctxt >>=? fun block_priority ->
-      Baking.endorsement_reward ctxt ~block_priority (List.length slots) >>=? fun reward ->
-      Delegate.freeze_rewards ctxt delegate reward >>=? fun ctxt ->
-      return (ctxt, Endorsements_result (delegate, slots))
-
-let apply_amendment_operation_content ctxt delegate = function
-  | Proposals { period ; proposals } ->
-      let level = Level.current ctxt in
-      fail_unless Voting_period.(level.voting_period = period)
-        (Wrong_voting_period (level.voting_period, period)) >>=? fun () ->
-      Amendment.record_proposals ctxt delegate proposals
-  | Ballot { period ; proposal ; ballot } ->
-      let level = Level.current ctxt in
-      fail_unless Voting_period.(level.voting_period = period)
-        (Wrong_voting_period (level.voting_period, period)) >>=? fun () ->
-      Amendment.record_ballot ctxt delegate proposal ballot
-
 let gas_difference ctxt_before ctxt_after =
   match Gas.level ctxt_before, Gas.level ctxt_after with
   | Limited { remaining = before }, Limited { remaining = after } -> Z.sub before after
@@ -387,7 +344,12 @@ let cleanup_balance_updates balance_updates =
        not (Tez.equal update Tez.zero))
     balance_updates
 
-let apply_manager_operation_content ctxt mode ~payer ~source ~internal operation =
+let apply_manager_operation_content :
+  type kind.
+  ( Alpha_context.t -> Script_ir_translator.unparsing_mode -> payer:Contract.t -> source:Contract.t ->
+    internal:bool -> kind manager_operation ->
+    (context * kind successful_manager_operation_result * packed_internal_operation list) tzresult Lwt.t ) =
+  fun ctxt mode ~payer ~source ~internal operation ->
     let before_operation = ctxt in
     Contract.must_exist ctxt source >>=? fun () ->
     let spend =
@@ -395,11 +357,14 @@ let apply_manager_operation_content ctxt mode ~payer ~source ~internal operation
     let set_delegate =
       if internal then Delegate.set_from_script else Delegate.set in
     match operation with
-  | Reveal _ -> return (ctxt, Reveal_result)
+    | Reveal _ ->
+        return
+          (ctxt, (Reveal_result : kind successful_manager_operation_result), [])
     | Transaction { amount ; parameters ; destination } -> begin
         spend ctxt source amount >>=? fun ctxt ->
         Contract.credit ctxt destination amount >>=? fun ctxt ->
-      Contract.get_script ctxt destination >>=? fun (ctxt, script) -> match script with
+        Contract.get_script ctxt destination >>=? fun (ctxt, script) ->
+        match script with
         | None -> begin
             match parameters with
             | None -> return ()
@@ -412,8 +377,7 @@ let apply_manager_operation_content ctxt mode ~payer ~source ~internal operation
           end >>=? fun () ->
             let result =
               Transaction_result
-              { operations = [] ;
+                { storage = None ;
-                storage = None ;
                   balance_updates =
                     cleanup_balance_updates
                       [ Contract source, Debited amount ;
@@ -421,7 +385,7 @@ let apply_manager_operation_content ctxt mode ~payer ~source ~internal operation
                   originated_contracts = [] ;
                   consumed_gas = gas_difference before_operation ctxt ;
                   storage_size_diff = 0L } in
-          return (ctxt, result)
+            return (ctxt, result, [])
         | Some script ->
             Lwt.return (Script.force_decode script.code) >>=? fun code ->
             Lwt.return @@ Script_ir_translator.parse_toplevel code >>=? fun (arg_type, _, _) ->
@@ -438,7 +402,8 @@ let apply_manager_operation_content ctxt mode ~payer ~source ~internal operation
               | None, _ -> fail (Bad_contract_parameter (destination, Some arg_type, None))
             end >>=? fun (ctxt, parameter) ->
             Script_interpreter.execute
-            ctxt mode ~source ~payer ~self:(destination, script) ~amount ~parameter
+              ctxt mode
+              ~source ~payer ~self:(destination, script) ~amount ~parameter
             >>=? fun { ctxt ; storage ; big_map_diff ; operations } ->
             Contract.used_storage_space ctxt destination >>=? fun old_size ->
             Contract.update_script_storage
@@ -448,8 +413,7 @@ let apply_manager_operation_content ctxt mode ~payer ~source ~internal operation
             new_contracts before_operation ctxt >>=? fun originated_contracts ->
             let result =
               Transaction_result
-              { operations ;
+                { storage = Some storage ;
-                storage = Some storage ;
                   balance_updates =
                     cleanup_balance_updates
                       [ Contract payer, Debited fees ;
@@ -458,7 +422,7 @@ let apply_manager_operation_content ctxt mode ~payer ~source ~internal operation
                   originated_contracts ;
                   consumed_gas = gas_difference before_operation ctxt ;
                   storage_size_diff = Int64.sub new_size old_size } in
-          return (ctxt, result)
+            return (ctxt, result, operations)
       end
     | Origination { manager ; delegate ; script ; preorigination ;
                     spendable ; delegatable ; credit } ->
@@ -489,134 +453,190 @@ let apply_manager_operation_content ctxt mode ~payer ~source ~internal operation
               originated_contracts = [ contract ] ;
               consumed_gas = gas_difference before_operation ctxt ;
               storage_size_diff = size } in
-      return (ctxt, result)
+        return (ctxt, result, [])
     | Delegation delegate ->
         set_delegate ctxt source delegate >>=? fun ctxt ->
-      return (ctxt, Delegation_result)
+        return (ctxt, Delegation_result, [])
 
 let apply_internal_manager_operations ctxt mode ~payer ops =
   let rec apply ctxt applied worklist =
     match worklist with
-    | [] -> Lwt.return (Ok (ctxt, applied))
+    | [] -> Lwt.return (Ok (ctxt, List.rev applied))
-    | { source ; operation ; nonce } as op :: rest ->
+    | (Internal_operation
-        begin if internal_nonce_already_recorded ctxt nonce then
+         ({ source ; operation ; nonce } as op)) :: rest ->
-            fail (Internal_operation_replay op)
+        begin
+          if internal_nonce_already_recorded ctxt nonce then
+            fail (Internal_operation_replay (Internal_operation op))
           else
             let ctxt = record_internal_nonce ctxt nonce in
-            apply_manager_operation_content ctxt mode ~source ~payer ~internal:true operation
+            apply_manager_operation_content
+              ctxt mode ~source ~payer ~internal:true operation
         end >>= function
         | Error errors ->
-            let result = Internal op, Failed errors in
+            let result =
-            let skipped = List.rev_map (fun op -> Internal op, Skipped) rest in
+              Internal_operation_result (op, Failed (manager_kind op.operation, errors)) in
-            Lwt.return (Error (skipped @ (result :: applied)))
+            let skipped =
-        | Ok (ctxt, (Transaction_result { operations = emitted ; _ } as result)) ->
+              List.rev_map
-            apply ctxt ((Internal op, Applied result) :: applied) (rest @ emitted)
+                (fun (Internal_operation op) ->
-        | Ok (ctxt, result) ->
+                   Internal_operation_result (op, Skipped (manager_kind op.operation)))
-            apply ctxt ((Internal op, Applied result) :: applied) rest in
+                rest in
-  apply ctxt [] ops
-
-let apply_manager_operations ctxt mode source ops =
-  let rec apply ctxt applied ops =
-    match ops with
-    | [] -> Lwt.return (Ok (ctxt, List.rev applied))
-    | operation :: rest ->
-        apply_manager_operation_content ctxt mode ~source ~payer:source ~internal:false operation
-        >>= function
-        | Error errors ->
-            let result = External, Failed errors in
-            let skipped = List.rev_map (fun _ -> External, Skipped) rest in
             Lwt.return (Error (List.rev (skipped @ (result :: applied))))
-        | Ok (ctxt, result) ->
+        | Ok (ctxt, result, emitted) ->
-            let emitted =
+            apply ctxt
-              match result with
+              (Internal_operation_result (op, Applied result) :: applied)
-              | Transaction_result { operations = emitted ; _ } -> emitted
+              (rest @ emitted) in
-              | _ -> [] in
-            apply_internal_manager_operations ctxt mode ~payer:source emitted
-            >>= function
-            | Error (results) ->
-                let result = (External, Applied result) in
-                let skipped = List.map (fun _ -> External, Skipped) rest in
-                Lwt.return (Error (List.rev (skipped @ results @ (result :: applied))))
-            | Ok (ctxt, results) ->
-                let result = (External, Applied result) in
-                let applied = results @ (result :: applied) in
-                apply ctxt applied rest in
   apply ctxt [] ops
 
-let apply_sourced_operation ctxt mode pred_block operation ops =
+let apply_manager_contents
-  match ops with
+    (type kind) ctxt mode raw_operation (op : kind Kind.manager contents)
-  | Manager_operations { source ; fee ; counter ; operations ; gas_limit ; storage_limit } ->
+  : (context * kind Kind.manager contents_result) tzresult Lwt.t =
-      let revealed_public_keys =
+  let Manager_operation
-        List.fold_left (fun acc op ->
+      { source ; fee ; counter ; operation ; gas_limit ; storage_limit } = op in
-            match op with
-            | Reveal pk -> pk :: acc
-            | _ -> acc) [] operations in
   Contract.must_be_allocated ctxt source >>=? fun () ->
   Contract.check_counter_increment ctxt source counter >>=? fun () ->
   begin
-        match revealed_public_keys with
+    match operation with
-        | [] -> return ctxt
+    | Reveal pk ->
-        | [pk] ->
         Contract.reveal_manager_key ctxt source pk
-        | _ :: _ :: _ ->
+    | _ -> return ctxt
-            fail Multiple_revelation
   end >>=? fun ctxt ->
   Contract.get_manager_key ctxt source >>=? fun public_key ->
-      Operation.check_signature public_key operation >>=? fun () ->
+  Operation.check_signature public_key raw_operation >>=? fun () ->
   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 mode source operations >>= begin function
+  apply_manager_operation_content ctxt mode
-        | Ok (ctxt, operation_results) -> return (ctxt, operation_results)
+    ~source ~payer:source ~internal:false operation >>= begin function
-        | Error operation_results -> return (ctxt (* backtracked *), operation_results)
+    | Ok (ctxt, operation_results, internal_operations) -> begin
-      end >>=? fun (ctxt, operation_results) ->
+        apply_internal_manager_operations
+          ctxt mode ~payer:source internal_operations >>= function
+        | Ok (ctxt, internal_operations_results) ->
             return (ctxt,
-              Manager_operations_result
+                    Applied operation_results, internal_operations_results)
+        | Error internal_operations_results ->
+            return (ctxt (* backtracked *),
+                    Applied operation_results, internal_operations_results)
+      end
+    | Error operation_results ->
+        return (ctxt (* backtracked *),
+                Failed (manager_kind operation, operation_results), [])
+  end >>=? fun (ctxt, operation_result, internal_operation_results) ->
+  return (ctxt,
+          Manager_operation_result
             { balance_updates =
                 cleanup_balance_updates
                   [ Contract source, Debited fee ;
                     (* FIXME: add credit to the baker *) ] ;
-                  operation_results })
+              operation_result ;
-  | Consensus_operation content ->
+              internal_operation_results })
-      apply_consensus_operation_content ctxt
-        pred_block operation content >>=? fun (ctxt, result) ->
-      return (ctxt, Consensus_operation_result result)
-  | Amendment_operation { source ; operation = content } ->
-      Roll.delegate_pubkey ctxt source >>=? fun delegate ->
-      Operation.check_signature delegate operation >>=? fun () ->
-      (* TODO, see how to extract the public key hash after this operation to
-         pass it to apply_delegate_operation_content *)
-      apply_amendment_operation_content ctxt source content >>=? fun ctxt ->
-      return (ctxt, Amendment_operation_result)
-  | Dictator_operation (Activate hash) ->
-      let dictator_pubkey = Constants.dictator_pubkey ctxt in
-      Operation.check_signature dictator_pubkey operation >>=? fun () ->
-      activate ctxt hash >>= fun ctxt ->
-      return (ctxt, Dictator_operation_result)
-  | Dictator_operation (Activate_testchain hash) ->
-      let dictator_pubkey = Constants.dictator_pubkey ctxt in
-      Operation.check_signature dictator_pubkey operation >>=? fun () ->
-      let expiration = (* in two days maximum... *)
-        Time.add (Timestamp.current ctxt) (Int64.mul 48L 3600L) in
-      fork_test_chain ctxt hash expiration >>= fun ctxt ->
-      return (ctxt, Dictator_operation_result)
 
-let apply_anonymous_operation ctxt kind =
+let rec mark_skipped
-  match kind with
+  : type kind.
-  | Seed_nonce_revelation { level ; nonce } ->
+    kind Kind.manager contents_list ->
+    kind Kind.manager contents_result_list = function
+  | Single (Manager_operation op) ->
+      Single_result
+        (Manager_operation_result
+           { balance_updates = [] ;
+             operation_result = Skipped (manager_kind op.operation) ;
+             internal_operation_results = [] })
+  | Cons (Manager_operation op, rest) ->
+      Cons_result
+        (Manager_operation_result {
+            balance_updates = [] ;
+            operation_result = Skipped (manager_kind op.operation) ;
+            internal_operation_results = [] },
+         mark_skipped rest)
+
+let rec apply_manager_contents_list
+  : type kind.
+    Alpha_context.t -> _ -> _ Operation.t -> kind Kind.manager contents_list ->
+    (context * kind Kind.manager contents_result_list) Lwt.t =
+  fun ctxt mode raw_operation contents_list ->
+    match contents_list with
+    | Single (Manager_operation { operation ; _ } as op) -> begin
+        apply_manager_contents ctxt mode raw_operation op >>= function
+        | Error errors ->
+            let result =
+              Manager_operation_result {
+                balance_updates = [] ;
+                operation_result = Failed (manager_kind operation, errors) ;
+                internal_operation_results = []
+              } in
+            Lwt.return (ctxt, Single_result (result))
+        | Ok (ctxt, (Manager_operation_result
+                       { operation_result = Applied _ ; _ } as result)) ->
+            Lwt.return (ctxt, Single_result (result))
+        | Ok (ctxt,
+              (Manager_operation_result
+                 { operation_result = (Skipped _ | Failed _) ; _ } as result)) ->
+            Lwt.return (ctxt, Single_result (result))
+      end
+    | Cons (Manager_operation { operation ; _ } as op, rest) ->
+        apply_manager_contents ctxt mode raw_operation op >>= function
+        | Error errors ->
+            let result =
+              Manager_operation_result {
+                balance_updates = [] ;
+                operation_result = Failed (manager_kind operation, errors) ;
+                internal_operation_results = []
+              } in
+            Lwt.return (ctxt, Cons_result (result, mark_skipped rest))
+        | Ok (ctxt, (Manager_operation_result
+                       { operation_result = Applied _ ; _ } as result)) ->
+            apply_manager_contents_list
+              ctxt mode raw_operation rest >>= fun (ctxt, results) ->
+            Lwt.return (ctxt, Cons_result (result, results))
+        | Ok (ctxt,
+              (Manager_operation_result
+                 { operation_result = (Skipped _ | Failed _) ; _ } as result)) ->
+            Lwt.return (ctxt, Cons_result (result, mark_skipped rest))
+
+let apply_contents_list
+    (type kind) ctxt mode pred_block operation (contents_list : kind contents_list)
+  : (context * kind contents_result_list) tzresult Lwt.t =
+  match contents_list with
+  | Single (Endorsements { block ; level ; slots }) ->
+      begin
+        match Level.pred ctxt (Level.current ctxt) with
+        | None -> failwith ""
+        | Some lvl -> return lvl
+      end >>=? fun ({ level = current_level ;_ } as lvl) ->
+      fail_unless
+        (Block_hash.equal block pred_block)
+        (Wrong_endorsement_predecessor (pred_block, block)) >>=? fun () ->
+      fail_unless
+        Raw_level.(level = current_level)
+        Invalid_endorsement_level >>=? fun () ->
+      fold_left_s (fun ctxt slot ->
+          fail_when
+            (endorsement_already_recorded ctxt slot)
+            (Duplicate_endorsement slot) >>=? fun () ->
+          return (record_endorsement ctxt slot))
+        ctxt slots >>=? fun ctxt ->
+      Baking.check_endorsements_rights ctxt lvl slots >>=? fun delegate ->
+      Operation.check_signature delegate operation >>=? fun () ->
+      let delegate = Signature.Public_key.hash delegate in
+      let gap = List.length slots in
+      let ctxt = Fitness.increase ~gap ctxt in
+      Baking.freeze_endorsement_deposit ctxt delegate gap >>=? fun ctxt ->
+      Global.get_last_block_priority ctxt >>=? fun block_priority ->
+      Baking.endorsement_reward ctxt ~block_priority gap >>=? fun reward ->
+      Delegate.freeze_rewards ctxt delegate reward >>=? fun ctxt ->
+      return (ctxt, Single_result (Endorsements_result (delegate, slots)))
+  | Single (Seed_nonce_revelation { level ; nonce }) ->
       let level = Level.from_raw ctxt level in
       Nonce.reveal ctxt level nonce >>=? fun ctxt ->
       let seed_nonce_revelation_tip =
         Constants.seed_nonce_revelation_tip ctxt in
       add_rewards ctxt seed_nonce_revelation_tip >>=? fun ctxt ->
-      return (ctxt, Seed_nonce_revelation_result [(* FIXME *)])
+      return (ctxt, Single_result (Seed_nonce_revelation_result [(* FIXME *)]))
-  | Double_endorsement_evidence { op1 ; op2 } -> begin
+  | Single (Double_endorsement_evidence { op1 ; op2 }) -> begin
       match op1.protocol_data.contents, op2.protocol_data.contents with
-      | Sourced_operation (Consensus_operation (Endorsements e1)),
+      | Single (Endorsements e1),
-        Sourced_operation (Consensus_operation (Endorsements e2))
+        Single (Endorsements e2)
         when Raw_level.(e1.level = e2.level) &&
              not (Block_hash.equal e1.block e2.block) ->
           let level = Level.from_raw ctxt e1.level in
@@ -651,10 +671,10 @@ let apply_anonymous_operation ctxt kind =
             | Ok v -> v
             | Error _ -> Tez.zero in
           add_rewards ctxt reward >>=? fun ctxt ->
-          return (ctxt, Double_endorsement_evidence_result [(* FIXME *)])
+          return (ctxt, Single_result (Double_endorsement_evidence_result [(* FIXME *)]))
       | _, _ -> fail Invalid_double_endorsement_evidence
     end
-  | Double_baking_evidence { bh1 ; bh2 } ->
+  | Single (Double_baking_evidence { bh1 ; bh2 }) ->
       fail_unless Compare.Int32.(bh1.shell.level = bh2.shell.level)
         (Invalid_double_baking_evidence
            { level1 = bh1.shell.level ;
@@ -690,8 +710,8 @@ let apply_anonymous_operation ctxt kind =
         | Ok v -> v
         | Error _ -> Tez.zero in
       add_rewards ctxt reward >>=? fun ctxt ->
-      return (ctxt, Double_baking_evidence_result [(* FIXME *)])
+      return (ctxt, Single_result (Double_baking_evidence_result [(* FIXME *)]))
-  | Activation { id = pkh ; activation_code } ->
+  | Single (Activate_account { id = pkh ; activation_code }) -> begin
       let blinded_pkh =
         Blinded_public_key_hash.of_ed25519_pkh activation_code pkh in
       Commitment.get_opt ctxt blinded_pkh >>=? function
@@ -699,28 +719,52 @@ let apply_anonymous_operation ctxt kind =
       | Some amount ->
           Commitment.delete ctxt blinded_pkh >>=? fun ctxt ->
           Contract.(credit ctxt (implicit_contract (Signature.Ed25519 pkh)) amount) >>=? fun ctxt ->
-          return (ctxt, Activation_result [(* FIXME *)])
+          return (ctxt, Single_result (Activate_account_result [(* FIXME *)]))
+    end
+  | Single (Proposals { source ; period ; proposals }) ->
+      Roll.delegate_pubkey ctxt source >>=? fun delegate ->
+      Operation.check_signature delegate operation >>=? fun () ->
+      let level = Level.current ctxt in
+      fail_unless Voting_period.(level.voting_period = period)
+        (Wrong_voting_period (level.voting_period, period)) >>=? fun () ->
+      Amendment.record_proposals ctxt source proposals >>=? fun ctxt ->
+      return (ctxt, Single_result Proposals_result)
+  | Single (Ballot { source ; period ; proposal ; ballot }) ->
+      Roll.delegate_pubkey ctxt source >>=? fun delegate ->
+      Operation.check_signature delegate operation >>=? fun () ->
+      let level = Level.current ctxt in
+      fail_unless Voting_period.(level.voting_period = period)
+        (Wrong_voting_period (level.voting_period, period)) >>=? fun () ->
+      Amendment.record_ballot ctxt source proposal ballot >>=? fun ctxt ->
+      return (ctxt, Single_result Ballot_result)
+  | Single (Manager_operation _) as op ->
+      apply_manager_contents_list ctxt mode operation op >>= fun (ctxt, result) ->
+      return (ctxt, result)
+  | Cons (Manager_operation _, _) as op ->
+      apply_manager_contents_list ctxt mode operation op >>= fun (ctxt, result) ->
+      return (ctxt, result)
+  | Single (Activate_protocol hash) ->
+      let dictator_pubkey = Constants.dictator_pubkey ctxt in
+      Operation.check_signature dictator_pubkey operation >>=? fun () ->
+      activate ctxt hash >>= fun ctxt ->
+      return (ctxt, Single_result Activate_protocol_result)
+  | Single (Activate_test_protocol hash) ->
+      let dictator_pubkey = Constants.dictator_pubkey ctxt in
+      Operation.check_signature dictator_pubkey operation >>=? fun () ->
+      let expiration = (* in two days maximum... *)
+        Time.add (Timestamp.current ctxt) (Int64.mul 48L 3600L) in
+      fork_test_chain ctxt hash expiration >>= fun ctxt ->
+      return (ctxt, Single_result Activate_test_protocol_result)
 
 let apply_operation ctxt mode pred_block hash operation =
   let ctxt = Contract.init_origination_nonce ctxt hash in
-  begin match operation.protocol_data.contents with
+  apply_contents_list
-    | Anonymous_operations ops ->
+    ctxt mode pred_block operation
-        fold_left_s
+    operation.protocol_data.contents >>=? fun (ctxt, result) ->
-          (fun (ctxt, acc) op ->
-             apply_anonymous_operation ctxt op >>=? fun (ctxt, result) ->
-             return (ctxt, result :: acc))
-          (ctxt, []) ops
-        >>=? fun (ctxt, results) ->
-        return (ctxt, Anonymous_operations_result (List.rev results))
-    | Sourced_operation ops ->
-        apply_sourced_operation ctxt mode pred_block operation ops
-        >>=? fun (ctxt, result) ->
-        return (ctxt, Sourced_operation_result result)
-  end >>=? fun (ctxt, result) ->
   let ctxt = Gas.set_unlimited ctxt in
   let ctxt = Contract.set_storage_unlimited ctxt in
   let ctxt = Contract.unset_origination_nonce ctxt in
-  return (ctxt, result)
+  return (ctxt, { contents = result })
 
 let may_snapshot_roll ctxt =
   let level = Alpha_context.Level.current ctxt in
@@ -801,21 +845,52 @@ let finalize_application ctxt protocol_data delegate =
   return ctxt
 
 let compare_operations op1 op2 =
-  match op1.protocol_data.contents, op2.protocol_data.contents with
+  let Operation_data op1 = op1.protocol_data in
-  | Anonymous_operations _, Anonymous_operations _ -> 0
+  let Operation_data op2 = op2.protocol_data in
-  | Anonymous_operations _, Sourced_operation _ -> -1
+  match op1.contents, op2.contents with
-  | Sourced_operation _, Anonymous_operations _ -> 1
+  | Single (Endorsements _), Single (Endorsements _) -> 0
-  | Sourced_operation op1, Sourced_operation op2 ->
+  | _, Single (Endorsements _) -> 1
-      match op1, op2 with
+  | Single (Endorsements _), _ -> -1
-      | Consensus_operation _, (Amendment_operation _ | Manager_operations _ | Dictator_operation _) -> -1
+
-      | (Amendment_operation _ | Manager_operations _ | Dictator_operation _), Consensus_operation _ -> 1
+  | Single (Seed_nonce_revelation _), Single (Seed_nonce_revelation _) -> 0
-      | Amendment_operation _, (Manager_operations _ | Dictator_operation _) -> -1
+  | _, Single (Seed_nonce_revelation _) -> 1
-      | (Manager_operations _ | Dictator_operation _), Amendment_operation _ -> 1
+  | Single (Seed_nonce_revelation _), _ -> -1
-      | Manager_operations _, Dictator_operation _ -> -1
+
-      | Dictator_operation _, Manager_operations _ -> 1
+  | Single (Double_endorsement_evidence _), Single (Double_endorsement_evidence _) -> 0
-      | Consensus_operation _, Consensus_operation _ -> 0
+  | _, Single (Double_endorsement_evidence _) -> 1
-      | Amendment_operation _, Amendment_operation _ -> 0
+  | Single (Double_endorsement_evidence _), _ -> -1
-      | Manager_operations op1, Manager_operations op2 ->
+
+  | Single (Double_baking_evidence _), Single (Double_baking_evidence _) -> 0
+  | _, Single (Double_baking_evidence _) -> 1
+  | Single (Double_baking_evidence _), _ -> -1
+
+  | Single (Activate_account _), Single (Activate_account _) -> 0
+  | _, Single (Activate_account _) -> 1
+  | Single (Activate_account _), _ -> -1
+
+  | Single (Proposals _), Single (Proposals _) -> 0
+  | _, Single (Proposals _) -> 1
+  | Single (Proposals _), _ -> -1
+
+  | Single (Ballot _), Single (Ballot _) -> 0
+  | _, Single (Ballot _) -> 1
+  | Single (Ballot _), _ -> -1
+
+  | Single (Activate_protocol _), Single (Activate_protocol _) -> 0
+  | _, Single (Activate_protocol _) -> 1
+  | Single (Activate_protocol _), _ -> -1
+
+  | Single (Activate_test_protocol _), Single (Activate_test_protocol _) -> 0
+  | _, Single (Activate_test_protocol _) -> 1
+  | Single (Activate_test_protocol _), _ -> -1
+
   (* Manager operations with smaller counter are pre-validated first. *)
+  | Single (Manager_operation op1), Single (Manager_operation op2) ->
       Int32.compare op1.counter op2.counter
-      | Dictator_operation _, Dictator_operation _ -> 0
+  | Cons (Manager_operation op1, _), Single (Manager_operation op2) ->
+      Int32.compare op1.counter op2.counter
+  | Single (Manager_operation op1), Cons (Manager_operation op2, _) ->
+      Int32.compare op1.counter op2.counter
+  | Cons (Manager_operation op1, _), Cons (Manager_operation op2, _) ->
+      Int32.compare op1.counter op2.counter
+

src/proto_alpha/lib_protocol/src/apply_operation_result.ml

@@ -85,210 +85,802 @@ let balance_updates_encoding =
   def "operation_metadata.alpha.balance_updates" @@
   list (merge_objs balance_encoding balance_update_encoding)
 
-type anonymous_operation_result =
+type _ successful_manager_operation_result =
-  | Seed_nonce_revelation_result of balance_updates
+  | Reveal_result : Kind.reveal successful_manager_operation_result
-  | Double_endorsement_evidence_result of balance_updates
+  | Transaction_result :
-  | Double_baking_evidence_result of balance_updates
+      { storage : Script.expr option ;
-  | Activation_result of balance_updates
-
-let anonymous_operation_result_encoding =
-  union
-    [ case (Tag 0)
-        (obj2
-           (req "kind" (constant "revelation"))
-           (req "balance_updates" balance_updates_encoding))
-        (function Seed_nonce_revelation_result bus -> Some ((), bus) | _ -> None)
-        (fun ((), bus) -> Seed_nonce_revelation_result bus) ;
-      case (Tag 1)
-        (obj2
-           (req "kind" (constant "double_endorsement"))
-           (req "balance_updates" balance_updates_encoding))
-        (function Double_endorsement_evidence_result bus -> Some ((), bus) | _ -> None)
-        (fun ((), bus) -> Double_endorsement_evidence_result bus) ;
-      case (Tag 2)
-        (obj2
-           (req "kind" (constant "double_baking"))
-           (req "balance_updates" balance_updates_encoding))
-        (function Double_baking_evidence_result bus -> Some ((), bus) | _ -> None)
-        (fun ((), bus) -> Double_baking_evidence_result bus) ;
-      case (Tag 3)
-        (obj2
-           (req "kind" (constant "activation"))
-           (req "balance_updates" balance_updates_encoding))
-        (function Activation_result bus -> Some ((), bus) | _ -> None)
-        (fun ((), bus) -> Activation_result bus) ]
-
-type successful_manager_operation_result =
-  | Reveal_result
-  | Transaction_result of
-      { operations : internal_operation list ;
-        storage : Script.expr option ;
         balance_updates : balance_updates ;
         originated_contracts : Contract.t list ;
         consumed_gas : Z.t ;
-        storage_size_diff : Int64.t }
+        storage_size_diff : Int64.t ;
-  | Origination_result of
+      } -> Kind.transaction successful_manager_operation_result
+  | Origination_result :
       { balance_updates : balance_updates ;
         originated_contracts : Contract.t list ;
         consumed_gas : Z.t ;
-        storage_size_diff : Int64.t }
+        storage_size_diff : Int64.t ;
-  | Delegation_result
+      } -> Kind.origination successful_manager_operation_result
+  | Delegation_result : Kind.delegation successful_manager_operation_result
 
-type manager_operation_kind =
+type packed_successful_manager_operation_result =
-  | External
+  | Successful_manager_result :
-  | Internal of internal_operation
+      'kind successful_manager_operation_result -> packed_successful_manager_operation_result
 
-let manager_operation_kind_encoding =
+type 'kind manager_operation_result =
-  union
+  | Applied of 'kind successful_manager_operation_result
-    [ case (Tag 0) (constant "external")
+  | Failed : 'kind Kind.manager * error list -> 'kind manager_operation_result
-        (function External -> Some () | _ -> None)
+  | Skipped : 'kind Kind.manager -> 'kind manager_operation_result
-        (fun () -> External) ;
-      case (Tag 1) Operation.internal_operation_encoding
-        (function Internal op -> Some op | _ -> None)
-        (fun op -> Internal op) ]
 
-type manager_operation_result =
+type packed_internal_operation_result =
-  | Applied of successful_manager_operation_result
+  | Internal_operation_result :
-  | Failed of error list
+      'kind internal_operation * 'kind manager_operation_result -> packed_internal_operation_result
-  | Skipped
 
-let manager_operation_result_encoding =
+module Manager_result = struct
-  union
+
-    [ case (Tag 0)
+  type 'kind case =
-        (obj2
+      MCase : {
-           (req "status" (constant "applied"))
+        op_case: 'kind Operation.Encoding.Manager_operations.case ;
-           (req "operation_kind" (constant "reveal")))
+        encoding: 'a Data_encoding.t ;
-        (function Applied Reveal_result -> Some ((),()) | _ -> None)
+        kind: 'kind Kind.manager ;
-        (fun ((),()) -> Applied Reveal_result) ;
+        iselect:
+          packed_internal_operation_result ->
+          ('kind internal_operation * 'kind manager_operation_result) option;
+        select:
+          packed_successful_manager_operation_result ->
+          'kind successful_manager_operation_result option ;
+        proj: 'kind successful_manager_operation_result -> 'a ;
+        inj: 'a -> 'kind successful_manager_operation_result ;
+        t: 'kind manager_operation_result Data_encoding.t ;
+      } -> 'kind case
+
+  let make ~op_case ~encoding ~kind ~iselect ~select ~proj ~inj =
+    let Operation.Encoding.Manager_operations.MCase { name ; _ } = op_case in
+    let t =
+      def (Format.asprintf "operation.alpha.operation_result.%s" name) @@
+      union ~tag_size:`Uint8 [
+        case (Tag 0)
+          (merge_objs
+             (obj1
+                (req "status" (constant "applied")))
+             encoding)
+          (fun o ->
+             match o with
+             | Skipped _ | Failed _ -> None
+             | Applied o ->
+                 match select (Successful_manager_result o) with
+                 | None -> None
+                 | Some o -> Some ((), proj o))
+          (fun ((), x) ->  (Applied (inj x))) ;
         case (Tag 1)
-        (obj8
+          (obj2
-           (req "status" (constant "applied"))
+             (req "status" (constant "failed"))
-           (req "operation_kind" (constant "transaction"))
+             (req "errors" (list error_encoding)))
-           (dft "emitted" (list Operation.internal_operation_encoding) [])
+          (function  (Failed (_, errs)) -> Some ((), errs) | _ -> None)
+          (fun ((), errs) -> Failed (kind, errs)) ;
+        case (Tag 2)
+          (obj1 (req "status" (constant "skipped")))
+          (function Skipped _ -> Some () | _ -> None)
+          (fun () -> Skipped kind)
+      ] in
+    MCase { op_case ; encoding ; kind ; iselect ; select ; proj ; inj ; t }
+
+  let reveal_case =
+    make
+      ~op_case: Operation.Encoding.Manager_operations.reveal_case
+      ~encoding: Data_encoding.empty
+      ~iselect:
+        (function
+          | Internal_operation_result
+              ({ operation = Reveal _ ; _} as op, res) ->
+              Some (op, res)
+          | _ -> None)
+      ~select:
+        (function
+          | Successful_manager_result (Reveal_result as op) -> Some op
+          | _ -> None)
+      ~kind: Kind.Reveal_manager_kind
+      ~proj: (function Reveal_result -> ())
+      ~inj: (fun () -> Reveal_result)
+
+  let transaction_case =
+    make
+      ~op_case: Operation.Encoding.Manager_operations.transaction_case
+      ~encoding:
+        (obj5
            (opt "storage" Script.expr_encoding)
            (dft "balance_updates" balance_updates_encoding [])
            (dft "originated_contracts" (list Contract.encoding) [])
            (dft "consumed_gas" z Z.zero)
            (dft "storage_size_diff" int64 0L))
+      ~iselect:
         (function
-          | Applied (Transaction_result
+          | Internal_operation_result
-                       { operations ; storage ; balance_updates ;
+              ({ operation = Transaction _ ; _} as op, res) ->
-                         originated_contracts ; consumed_gas ;
+              Some (op, res)
-                         storage_size_diff }) ->
-              Some ((), (), operations, storage, balance_updates,
-                    originated_contracts, consumed_gas,
-                    storage_size_diff)
           | _ -> None)
-        (fun ((), (), operations, storage, balance_updates,
+      ~select:
+        (function
+          | Successful_manager_result (Transaction_result _ as op) -> Some op
+          | _ -> None)
+      ~kind: Kind.Transaction_manager_kind
+      ~proj:
+        (function
+          | Transaction_result
+              { storage ; balance_updates ;
+                originated_contracts ; consumed_gas ;
+                storage_size_diff } ->
+              (storage, balance_updates,
+               originated_contracts, consumed_gas,
+               storage_size_diff))
+      ~inj:
+        (fun (storage, balance_updates,
               originated_contracts, consumed_gas,
               storage_size_diff) ->
-          Applied (Transaction_result
+          Transaction_result { storage ; balance_updates ;
-                     { operations ; storage ; balance_updates ;
                                originated_contracts ; consumed_gas ;
-                       storage_size_diff })) ;
+                               storage_size_diff })
-      case (Tag 2)
+
-        (obj6
+  let origination_case =
-           (req "status" (constant "applied"))
+    make
-           (req "operation_kind" (constant "origination"))
+      ~op_case: Operation.Encoding.Manager_operations.origination_case
+      ~encoding:
+        (obj4
            (dft "balance_updates" balance_updates_encoding [])
            (dft "originated_contracts" (list Contract.encoding) [])
            (dft "consumed_gas" z Z.zero)
            (dft "storage_size_diff" int64 0L))
+      ~iselect:
         (function
-          | Applied (Origination_result
+          | Internal_operation_result
+              ({ operation = Origination _ ; _} as op, res) ->
+              Some (op, res)
+          | _ -> None)
+      ~select:
+        (function
+          | Successful_manager_result (Origination_result _ as op) -> Some op
+          | _ -> None)
+      ~proj:
+        (function
+          | Origination_result
               { balance_updates ;
                 originated_contracts ; consumed_gas ;
-                         storage_size_diff }) ->
+                storage_size_diff } ->
-              Some ((), (), balance_updates,
+              (balance_updates,
                originated_contracts, consumed_gas,
-                    storage_size_diff)
+               storage_size_diff))
-          | _ -> None)
+      ~kind: Kind.Origination_manager_kind
-        (fun ((), (), balance_updates,
+      ~inj:
+        (fun (balance_updates,
               originated_contracts, consumed_gas,
               storage_size_diff) ->
-          Applied (Origination_result
+          Origination_result
             { balance_updates ;
               originated_contracts ; consumed_gas ;
-                       storage_size_diff })) ;
+              storage_size_diff })
-      case (Tag 3)
-        (obj2
-           (req "status" (constant "applied"))
-           (req "operation_kind" (constant "delegation")))
-        (function Applied Delegation_result -> Some ((),()) | _ -> None)
-        (fun ((),()) -> Applied Delegation_result) ;
-      case (Tag 4)
-        (obj2
-           (req "status" (constant "failed"))
-           (req "errors" (list error_encoding)))
-        (function Failed errs -> Some ((), errs) | _ -> None)
-        (fun ((), errs) -> Failed errs) ;
-      case (Tag 5)
-        (obj1 (req "status" (constant "skipped")))
-        (function Skipped -> Some () | _ -> None)
-        (fun () -> Skipped) ]
 
-type consensus_operation_result =
+  let delegation_case =
-  | Endorsements_result of Signature.Public_key_hash.t * int list
+    make
-
+      ~op_case: Operation.Encoding.Manager_operations.delegation_case
-type sourced_operation_result =
+      ~encoding: Data_encoding.empty
-  | Consensus_operation_result of consensus_operation_result
+      ~iselect:
-  | Amendment_operation_result
-  | Manager_operations_result of
-      { balance_updates : balance_updates ;
-        operation_results : (manager_operation_kind * manager_operation_result) list }
-  | Dictator_operation_result
-
-type operation_result =
-  | Anonymous_operations_result of anonymous_operation_result list
-  | Sourced_operation_result of sourced_operation_result
-
-let encoding =
-  def "alpha.metadata" @@
-  union
-    [ case (Tag 0)
-        (obj2
-           (req "kind" (constant "anonymous"))
-           (req "results" (list anonymous_operation_result_encoding)))
-        (function Anonymous_operations_result rs -> Some ((), rs) | _ -> None)
-        (fun ((), rs) -> Anonymous_operations_result rs) ;
-      case (Tag 1)
-        (obj3
-           (req "kind" (constant "endorsements"))
-           (req "delegate" Signature.Public_key_hash.encoding)
-           (req "slots" (list uint8)))
         (function
-          | Sourced_operation_result
+          | Internal_operation_result
-              (Consensus_operation_result
+              ({ operation = Delegation _ ; _} as op, res) ->
-                 (Endorsements_result (d, s))) -> Some ((), d, s)
+              Some (op, res)
           | _ -> None)
-        (fun ((), d, s) ->
+      ~select:
-           Sourced_operation_result
-             (Consensus_operation_result
-                (Endorsements_result (d, s)))) ;
-      case (Tag 2)
-        (obj1
-           (req "kind" (constant "amendment")))
-        (function Sourced_operation_result Amendment_operation_result -> Some () | _ -> None)
-        (fun () -> Sourced_operation_result Amendment_operation_result) ;
-      case (Tag 3)
-        (obj1
-           (req "kind" (constant "dictator")))
-        (function Sourced_operation_result Dictator_operation_result -> Some () | _ -> None)
-        (fun () -> Sourced_operation_result Dictator_operation_result) ;
-      case (Tag 4)
-        (obj3
-           (req "kind" (constant "manager"))
-           (req "balance_updates" balance_updates_encoding)
-           (req "operation_results"
-              (list (merge_objs
-                       (obj1 (req "operation" manager_operation_kind_encoding))
-                       manager_operation_result_encoding))))
         (function
-          | Sourced_operation_result
+          | Successful_manager_result (Delegation_result as op) -> Some op
-              (Manager_operations_result
+          | _ -> None)
-                 { balance_updates = bus ; operation_results = rs }) ->
+      ~kind: Kind.Delegation_manager_kind
-              Some ((), bus, rs) | _ -> None)
+      ~proj: (function Delegation_result -> ())
-        (fun ((), bus, rs) ->
+      ~inj: (fun () -> Delegation_result)
-           Sourced_operation_result
+
-             (Manager_operations_result
+end
-                { balance_updates = bus ; operation_results = rs })) ]
+
+let internal_operation_result_encoding :
+  packed_internal_operation_result Data_encoding.t =
+  let make (type kind)
+      (Manager_result.MCase res_case : kind Manager_result.case) =
+    let Operation.Encoding.Manager_operations.MCase op_case = res_case.op_case in
+    case (Tag op_case.tag)
+      (merge_objs
+         (obj3
+            (req "kind" (constant op_case.name))
+            (req "source" Contract.encoding)
+            (req "nonce" uint16))
+         (merge_objs
+            op_case.encoding
+            (obj1 (req "result" res_case.t))))
+      (fun op ->
+         match res_case.iselect op with
+         | Some (op, res) ->
+             Some (((), op.source, op.nonce),
+                   (op_case.proj op.operation, res))
+         | None -> None)
+      (fun (((), source, nonce), (op, res)) ->
+         let op = { source ; operation = op_case.inj op ; nonce } in
+         Internal_operation_result (op, res)) in
+  def "operation.alpha.internal_operation_result" @@
+  union [
+    make Manager_result.reveal_case ;
+    make Manager_result.transaction_case ;
+    make Manager_result.origination_case ;
+    make Manager_result.delegation_case ;
+  ]
+
+type 'kind contents_result =
+  | Endorsements_result :
+      Signature.Public_key_hash.t * int list -> Kind.endorsements contents_result
+  | Seed_nonce_revelation_result :
+      balance_updates -> Kind.seed_nonce_revelation contents_result
+  | Double_endorsement_evidence_result :
+      balance_updates -> Kind.double_endorsement_evidence contents_result
+  | Double_baking_evidence_result :
+      balance_updates -> Kind.double_baking_evidence contents_result
+  | Activate_account_result :
+      balance_updates -> Kind.activate_account contents_result
+  | Proposals_result : Kind.proposals contents_result
+  | Ballot_result : Kind.ballot contents_result
+  | Manager_operation_result :
+      { balance_updates : balance_updates ;
+        operation_result : 'kind manager_operation_result ;
+        internal_operation_results : packed_internal_operation_result list ;
+      } -> 'kind Kind.manager contents_result
+  | Activate_protocol_result :
+      Kind.activate_protocol contents_result
+  | Activate_test_protocol_result :
+      Kind.activate_test_protocol contents_result
+
+type packed_contents_result =
+  | Contents_result : 'kind contents_result -> packed_contents_result
+
+type packed_contents_and_result =
+  | Contents_and_result :
+      'kind Operation.contents * 'kind contents_result -> packed_contents_and_result
+
+module Encoding = struct
+
+  type 'kind case =
+      Case : { op_case: 'kind Operation.Encoding.case ;
+               encoding: 'a Data_encoding.t ;
+               select: packed_contents_result -> 'kind contents_result option ;
+               mselect: packed_contents_and_result -> ('kind contents * 'kind contents_result) option ;
+               proj: 'kind contents_result -> 'a ;
+               inj: 'a -> 'kind contents_result ;
+             } -> 'kind case
+
+  let tagged_case tag name args proj inj =
+    let open Data_encoding in
+    case tag
+      (merge_objs
+         (obj1 (req "kind" (constant name)))
+         args)
+      (fun x -> match proj x with None -> None | Some x -> Some ((), x))
+      (fun ((), x) -> inj x)
+
+  let endorsement_case =
+    Case {
+      op_case = Operation.Encoding.endorsement_case ;
+      encoding =
+        (obj2
+           (req "delegate" Signature.Public_key_hash.encoding)
+           (req "slots" (list uint8))) ;
+      select =
+        (function
+          | Contents_result (Endorsements_result _ as op) -> Some op
+          | _ -> None) ;
+      mselect =
+        (function
+          | Contents_and_result (Endorsements _ as op, res) -> Some (op, res)
+          | _ -> None) ;
+      proj =
+        (function
+          | Endorsements_result (d, s) -> (d, s)) ;
+      inj =
+        (fun (d, s) -> Endorsements_result (d, s))
+    }
+
+  let seed_nonce_revelation_case =
+    Case {
+      op_case = Operation.Encoding.seed_nonce_revelation_case ;
+      encoding =
+        (obj1
+           (req "balance_updates" balance_updates_encoding)) ;
+      select =
+        (function
+          | Contents_result (Seed_nonce_revelation_result _ as op) -> Some op
+          | _ -> None) ;
+      mselect =
+        (function
+          | Contents_and_result (Seed_nonce_revelation _ as op, res) -> Some (op, res)
+          | _ -> None) ;
+      proj = (fun (Seed_nonce_revelation_result bus) -> bus) ;
+      inj = (fun bus -> Seed_nonce_revelation_result bus) ;
+    }
+
+  let double_endorsement_evidence_case =
+    Case {
+      op_case = Operation.Encoding.double_endorsement_evidence_case ;
+      encoding =
+        (obj1
+           (req "balance_updates" balance_updates_encoding)) ;
+      select =
+        (function
+          | Contents_result (Double_endorsement_evidence_result _ as op) -> Some op
+          | _ -> None) ;
+      mselect =
+        (function
+          | Contents_and_result (Double_endorsement_evidence _ as op, res) -> Some (op, res)
+          | _ -> None) ;
+      proj =
+        (fun (Double_endorsement_evidence_result bus) -> bus) ;
+      inj = (fun bus -> Double_endorsement_evidence_result bus)
+    }
+
+  let double_baking_evidence_case =
+    Case {
+      op_case = Operation.Encoding.double_baking_evidence_case ;
+      encoding =
+        (obj1
+           (req "balance_updates" balance_updates_encoding)) ;
+      select =
+        (function
+          | Contents_result (Double_baking_evidence_result _ as op) -> Some op
+          | _ -> None) ;
+      mselect =
+        (function
+          | Contents_and_result (Double_baking_evidence _ as op, res) -> Some (op, res)
+          | _ -> None) ;
+      proj =
+        (fun (Double_baking_evidence_result bus) -> bus) ;
+      inj = (fun bus -> Double_baking_evidence_result bus) ;
+    }
+
+  let activate_account_case =
+    Case {
+      op_case = Operation.Encoding.activate_account_case ;
+      encoding =
+        (obj1
+           (req "balance_updates" balance_updates_encoding)) ;
+      select =
+        (function
+          | Contents_result (Activate_account_result _ as op) -> Some op
+          | _ -> None) ;
+      mselect =
+        (function
+          | Contents_and_result (Activate_account _ as op, res) -> Some (op, res)
+          | _ -> None) ;
+      proj = (fun (Activate_account_result bus) -> bus) ;
+      inj = (fun bus -> Activate_account_result bus) ;
+    }
+
+  let proposals_case =
+    Case {
+      op_case = Operation.Encoding.proposals_case ;
+      encoding = Data_encoding.empty ;
+      select =
+        (function
+          | Contents_result (Proposals_result as op) -> Some op
+          | _ -> None) ;
+      mselect =
+        (function
+          | Contents_and_result (Proposals _ as op, res) -> Some (op, res)
+          | _ -> None) ;
+      proj = (fun Proposals_result -> ()) ;
+      inj = (fun () -> Proposals_result) ;
+    }
+
+  let ballot_case =
+    Case {
+      op_case = Operation.Encoding.ballot_case ;
+      encoding = Data_encoding.empty ;
+      select =
+        (function
+          | Contents_result (Ballot_result as op) -> Some op
+          | _ -> None) ;
+      mselect =
+        (function
+          | Contents_and_result (Ballot _ as op, res) -> Some (op, res)
+          | _ -> None) ;
+      proj = (fun Ballot_result -> ()) ;
+      inj = (fun () -> Ballot_result) ;
+    }
+
+  let make_manager_case
+      (type kind)
+      (Operation.Encoding.Case op_case : kind Kind.manager Operation.Encoding.case)
+      (Manager_result.MCase res_case : kind Manager_result.case)
+      mselect =
+    Case {
+      op_case = Operation.Encoding.Case op_case ;
+      encoding =
+        (obj3
+           (req "balance_updates" balance_updates_encoding)
+           (req "operation_result" res_case.t)
+           (dft "internal_operation_results"
+              (list internal_operation_result_encoding) [])) ;
+      select =
+        (function
+          | Contents_result
+              (Manager_operation_result
+                 ({ operation_result = Applied res ; _ } as op)) -> begin
+              match res_case.select (Successful_manager_result res) with
+              | Some res ->
+                  Some (Manager_operation_result
+                          { op with operation_result = Applied res })
+              | None -> None
+            end
+          | _ -> None) ;
+      mselect ;
+      proj =
+        (fun (Manager_operation_result
+                { balance_updates = bus ; operation_result = r ;
+                  internal_operation_results = rs }) ->
+          (bus, r, rs)) ;
+      inj =
+        (fun (bus, r, rs) ->
+           Manager_operation_result
+             { balance_updates = bus ; operation_result = r ;
+               internal_operation_results = rs }) ;
+    }
+
+  let reveal_case =
+    make_manager_case
+      Operation.Encoding.reveal_case
+      Manager_result.reveal_case
+      (function
+        | Contents_and_result
+            (Manager_operation
+               { operation = Reveal _ ; _ } as op, res) ->
+            Some (op, res)
+        | _ -> None)
+
+  let transaction_case =
+    make_manager_case
+      Operation.Encoding.transaction_case
+      Manager_result.transaction_case
+      (function
+        | Contents_and_result
+            (Manager_operation
+               { operation = Transaction _ ; _ } as op, res) ->
+            Some (op, res)
+        | _ -> None)
+
+  let origination_case =
+    make_manager_case
+      Operation.Encoding.origination_case
+      Manager_result.origination_case
+      (function
+        | Contents_and_result
+            (Manager_operation
+               { operation = Origination _ ; _ } as op, res) ->
+            Some (op, res)
+        | _ -> None)
+
+  let delegation_case =
+    make_manager_case
+      Operation.Encoding.delegation_case
+      Manager_result.delegation_case
+      (function
+        | Contents_and_result
+            (Manager_operation
+               { operation = Delegation _ ; _ } as op, res) ->
+            Some (op, res)
+        | _ -> None)
+
+  let activate_protocol_case =
+    Case {
+      op_case = Operation.Encoding.activate_protocol_case ;
+      encoding = Data_encoding.empty ;
+      select =
+        (function
+          | Contents_result (Activate_protocol_result as op) -> Some op
+          | _ -> None) ;
+      mselect =
+        (function
+          | Contents_and_result (Activate_protocol _ as op, res) -> Some (op, res)
+          | _ -> None) ;
+      proj = (fun Activate_protocol_result -> ()) ;
+      inj = (fun () -> Activate_protocol_result) ;
+    }
+
+  let activate_test_protocol_case =
+    Case {
+      op_case = Operation.Encoding.activate_test_protocol_case ;
+      encoding = Data_encoding.empty ;
+      select =
+        (function
+          | Contents_result (Activate_test_protocol_result as op) -> Some op
+          | _ -> None) ;
+      mselect =
+        (function
+          | Contents_and_result (Activate_test_protocol _ as op, res) -> Some (op, res)
+          | _ -> None) ;
+      proj = (fun Activate_test_protocol_result -> ()) ;
+      inj = (fun () -> Activate_test_protocol_result) ;
+    }
+
+end
+
+let contents_result_encoding =
+  let open Encoding in
+  let make (Case { op_case = Operation.Encoding.Case { tag ; name ; _ } ;
+                   encoding ; mselect = _ ; select ; proj ; inj }) =
+    let proj x =
+      match select x with
+      | None -> None
+      | Some x -> Some (proj x) in
+    let inj x = Contents_result (inj x) in
+    tagged_case (Tag tag) name encoding proj inj in
+  def "operation.alpha.contents_result" @@
+  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 ;
+    make activate_protocol_case ;
+    make activate_test_protocol_case ;
+  ]
+
+let contents_and_result_encoding =
+  let open Encoding in
+  let make
+      (Case { op_case = Operation.Encoding.Case { tag ; name ; encoding ; proj ; inj ; _ } ;
+              mselect ; encoding = meta_encoding ; proj = meta_proj ; inj = meta_inj ; _ }) =
+    let proj c =
+      match mselect c with
+      | Some (op, res) -> Some (proj op, meta_proj res)
+      | _ -> None in
+    let inj (op, res) = Contents_and_result (inj op, meta_inj res) in
+    let encoding =
+      merge_objs
+        encoding
+        (obj1
+           (req "metadata" meta_encoding)) in
+    tagged_case (Tag tag) name encoding proj inj in
+  def "operation.alpha.operation_contents_and_result" @@
+  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 ;
+    make activate_protocol_case ;
+    make activate_test_protocol_case ;
+  ]
+
+type 'kind contents_result_list =
+  | Single_result : 'kind contents_result -> 'kind contents_result_list
+  | Cons_result :
+      'kind Kind.manager contents_result * 'rest Kind.manager contents_result_list ->
+    (('kind * 'rest) Kind.manager ) contents_result_list
+
+type packed_contents_result_list =
+    Contents_result_list : 'kind contents_result_list -> packed_contents_result_list
+
+let contents_result_list_encoding =
+  let rec to_list = function
+    | Contents_result_list (Single_result o) -> [Contents_result o]
+    | Contents_result_list (Cons_result (o, os)) ->
+        Contents_result o :: to_list (Contents_result_list os) in
+  let rec of_list = function
+    | [] -> assert false
+    | [Contents_result o] -> Contents_result_list (Single_result o)
+    | (Contents_result o) :: os ->
+        let Contents_result_list os = of_list os in
+        match o, os with
+        | Manager_operation_result _, Single_result (Manager_operation_result _) ->
+            Contents_result_list (Cons_result (o, os))
+        | Manager_operation_result _, Cons_result _ ->
+            Contents_result_list (Cons_result (o, os))
+        | _ -> Pervasives.failwith "...FIXME..." in
+  def "operation.alpha.contents_list_result" @@
+  conv to_list of_list (list contents_result_encoding)
+
+type 'kind contents_and_result_list =
+  | Single_and_result : 'kind Alpha_context.contents * 'kind contents_result -> 'kind contents_and_result_list
+  | Cons_and_result : 'kind Kind.manager Alpha_context.contents * 'kind Kind.manager contents_result * 'rest Kind.manager contents_and_result_list -> ('kind * 'rest) Kind.manager contents_and_result_list
+
+type packed_contents_and_result_list =
+  | Contents_and_result_list : 'kind contents_and_result_list -> packed_contents_and_result_list
+
+let contents_and_result_list_encoding =
+  let rec to_list = function
+    | Contents_and_result_list (Single_and_result (op, res)) ->
+        [Contents_and_result (op, res)]
+    | Contents_and_result_list (Cons_and_result (op, res, rest)) ->
+        Contents_and_result (op, res) ::
+        to_list (Contents_and_result_list rest) in
+  let rec of_list = function
+    | [] -> assert false (* FIXME error message *)
+    | [Contents_and_result (op, res)] ->
+        Contents_and_result_list (Single_and_result (op, res))
+    | (Contents_and_result (op, res)) :: rest ->
+        let Contents_and_result_list rest = of_list rest in
+        match op, rest with
+        | Manager_operation _, Single_and_result (Manager_operation _, _) ->
+            Contents_and_result_list (Cons_and_result (op, res, rest))
+        | Manager_operation _, Cons_and_result (_, _, _) ->
+            Contents_and_result_list (Cons_and_result (op, res, rest))
+        | _ -> Pervasives.failwith "...FIXME..." in
+  conv to_list of_list (list contents_and_result_encoding)
+
+type 'kind operation_metadata = {
+  contents: 'kind contents_result_list ;
+}
+
+type packed_operation_metadata =
+  | Operation_metadata : 'kind operation_metadata -> packed_operation_metadata
+
+let operation_metadata_encoding =
+  def "operation.alpha.result" @@
+  conv
+    (fun (Operation_metadata { contents }) -> Contents_result_list contents)
+    (fun (Contents_result_list contents) -> Operation_metadata { contents })
+    contents_result_list_encoding
+
+type ('a, 'b) eq = Eq : ('a, 'a) eq
+
+let kind_equal
+  : type kind kind2. kind contents -> kind2 contents_result -> (kind, kind2) eq option =
+  fun op res ->
+    match op, res with
+    | Endorsements _, Endorsements_result _ -> Some Eq
+    | Endorsements _, _ -> None
+    | Seed_nonce_revelation _, Seed_nonce_revelation_result _ -> Some Eq
+    | Seed_nonce_revelation _, _ -> None
+    | Double_endorsement_evidence _, Double_endorsement_evidence_result _ -> Some Eq
+    | Double_endorsement_evidence _, _ -> None
+    | Double_baking_evidence _, Double_baking_evidence_result _ -> Some Eq
+    | Double_baking_evidence _, _ -> None
+    | Activate_account _, Activate_account_result _ -> Some Eq
+    | Activate_account _, _ -> None
+    | Proposals _, Proposals_result -> Some Eq
+    | Proposals _, _ -> None
+    | Ballot _, Ballot_result -> Some Eq
+    | Ballot _, _ -> None
+    | Activate_protocol _, Activate_protocol_result -> Some Eq
+    | Activate_protocol _, _ -> None
+    | Activate_test_protocol _, Activate_test_protocol_result -> Some Eq
+    | Activate_test_protocol _, _ -> None
+    | Manager_operation
+        { operation = Reveal _ ; _ },
+      Manager_operation_result
+        { operation_result = Applied Reveal_result ; _ } -> Some Eq
+    | Manager_operation
+        { operation = Reveal _ ; _ },
+      Manager_operation_result
+        { operation_result =
+            Failed (Alpha_context.Kind.Reveal_manager_kind, _); _ } -> Some Eq
+    | Manager_operation
+        { operation = Reveal _ ; _ },
+      Manager_operation_result
+        { operation_result =
+            Skipped (Alpha_context.Kind.Reveal_manager_kind); _ } -> Some Eq
+    | Manager_operation { operation = Reveal _ ; _ }, _ -> None
+    | Manager_operation
+        { operation = Transaction _ ; _ },
+      Manager_operation_result
+        { operation_result = Applied (Transaction_result _); _ } -> Some Eq
+    | Manager_operation
+        { operation = Transaction _ ; _ },
+      Manager_operation_result
+        { operation_result =
+            Failed (Alpha_context.Kind.Transaction_manager_kind, _); _ } -> Some Eq
+    | Manager_operation
+        { operation = Transaction _ ; _ },
+      Manager_operation_result
+        { operation_result =
+            Skipped (Alpha_context.Kind.Transaction_manager_kind); _ } -> Some Eq
+    | Manager_operation { operation = Transaction _ ; _ }, _ -> None
+    | Manager_operation
+        { operation = Origination _ ; _ },
+      Manager_operation_result
+        { operation_result = Applied (Origination_result _); _ } -> Some Eq
+    | Manager_operation
+        { operation = Origination _ ; _ },
+      Manager_operation_result
+        { operation_result =
+            Failed (Alpha_context.Kind.Origination_manager_kind, _); _ } -> Some Eq
+    | Manager_operation
+        { operation = Origination _ ; _ },
+      Manager_operation_result
+        { operation_result =
+            Skipped (Alpha_context.Kind.Origination_manager_kind); _ } -> Some Eq
+    | Manager_operation { operation = Origination _ ; _ }, _ -> None
+    | Manager_operation
+        { operation = Delegation _ ; _ },
+      Manager_operation_result
+        { operation_result = Applied Delegation_result ; _ } -> Some Eq
+    | Manager_operation
+        { operation = Delegation _ ; _ },
+      Manager_operation_result
+        { operation_result =
+            Failed (Alpha_context.Kind.Delegation_manager_kind, _); _ } -> Some Eq
+    | Manager_operation
+        { operation = Delegation _ ; _ },
+      Manager_operation_result
+        { operation_result =
+            Skipped (Alpha_context.Kind.Delegation_manager_kind); _ } -> Some Eq
+    | Manager_operation { operation = Delegation _ ; _ }, _ -> None
+
+let rec kind_equal_list
+  : type kind kind2. kind contents_list -> kind2 contents_result_list -> (kind, kind2) eq option =
+  fun contents res ->
+    match contents, res with
+    | Single op, Single_result res -> begin
+        match kind_equal op res with
+        | None -> None
+        | Some Eq -> Some Eq
+      end
+    | Cons (op, ops), Cons_result (res, ress) -> begin
+        match kind_equal op res with
+        | None -> None
+        | Some Eq ->
+            match kind_equal_list ops ress with
+            | None -> None
+            | Some Eq -> Some Eq
+      end
+    | _ -> None
+
+let rec pack_contents_list :
+  type kind. kind contents_list -> kind contents_result_list -> kind contents_and_result_list =
+  fun contents res -> begin
+      match contents, res with
+      | Single op, Single_result res -> Single_and_result (op, res)
+      | Cons (op, ops), Cons_result (res, ress) ->
+          Cons_and_result (op, res, pack_contents_list ops ress)
+      | Single (Manager_operation _),
+        Cons_result (Manager_operation_result _, Single_result _) -> .
+      | Cons (_, _),
+        Single_result (Manager_operation_result
+                         { operation_result = Failed _ ; _}) -> .
+      | Cons (_, _),
+        Single_result (Manager_operation_result
+                         { operation_result = Skipped _ ; _}) -> .
+      | Cons (_, _),
+        Single_result (Manager_operation_result
+                         { operation_result = Applied _ ; _}) -> .
+      | Single _, Cons_result _ -> .
+    end
+
+let rec unpack_contents_list :
+  type kind. kind contents_and_result_list ->
+  (kind contents_list * kind contents_result_list) =
+  function
+  | Single_and_result (op, res) -> Single op, Single_result res
+  | Cons_and_result (op, res, rest) ->
+      let ops, ress = unpack_contents_list rest in
+      Cons (op, ops), Cons_result (res, ress)
+
+let operation_data_and_metadata_encoding =
+  def "operation.alpha.operation_with_metadata" @@
+  conv
+    (fun (Operation_data op, Operation_metadata res) ->
+       match kind_equal_list op.contents res.contents with
+       | None -> assert false (* FIXME *)
+       | Some Eq ->
+           (Contents_and_result_list
+              (pack_contents_list op.contents res.contents),
+            op.signature))
+    (fun (Contents_and_result_list contents, signature) ->
+       let op_contents, res_contents = unpack_contents_list contents in
+       (Operation_data { contents = op_contents ; signature },
+        Operation_metadata { contents = res_contents }))
+    (obj2
+       (req "contents" contents_and_result_list_encoding)
+       (varopt "signature" Signature.encoding))

src/proto_alpha/lib_protocol/src/apply_operation_result.mli

@@ -29,67 +29,112 @@ type balance_update =
 (** A list of balance updates. Duplicates may happen. *)
 type balance_updates = (balance * balance_update) list
 
-(** Result of applying a {!proto_operation}. Follows the same structure. *)
+(** Result of applying a {!Operation.t}. Follows the same structure. *)
-type operation_result =
+type 'kind operation_metadata = {
-  | Anonymous_operations_result of anonymous_operation_result list
+  contents: 'kind contents_result_list ;
-  | Sourced_operation_result of sourced_operation_result
+}
 
-(** Result of applying an {!anonymous_operation}. Follows the same structure. *)
+and packed_operation_metadata =
-and anonymous_operation_result =
+  | Operation_metadata : 'kind operation_metadata -> packed_operation_metadata
-  | Seed_nonce_revelation_result of balance_updates
-  | Double_endorsement_evidence_result of balance_updates
-  | Double_baking_evidence_result of balance_updates
-  | Activation_result of balance_updates
 
-(** Result of applying a {!sourced_operation}.
+(** Result of applying a {!Operation.contents_list}. Follows the same structure. *)
-    Follows the same structure, except for [Manager_operations_result]
+and 'kind contents_result_list =
-    which includes the results of internal operations, in execution order. *)
+  | Single_result : 'kind contents_result -> 'kind contents_result_list
-and sourced_operation_result =
+  | Cons_result :
-  | Consensus_operation_result of consensus_operation_result
+      'kind Kind.manager contents_result * 'rest Kind.manager contents_result_list ->
-  | Amendment_operation_result
+    (('kind * 'rest) Kind.manager ) contents_result_list
-  | Manager_operations_result of
+
+and packed_contents_result_list =
+  | Contents_result_list : 'kind contents_result_list -> packed_contents_result_list
+
+(** Result of applying an {!Operation.contents}. Follows the same structure. *)
+and 'kind contents_result =
+  | Endorsements_result :
+      Signature.Public_key_hash.t * int list -> Kind.endorsements contents_result
+  | Seed_nonce_revelation_result :
+      balance_updates -> Kind.seed_nonce_revelation contents_result
+  | Double_endorsement_evidence_result :
+      balance_updates -> Kind.double_endorsement_evidence contents_result
+  | Double_baking_evidence_result :
+      balance_updates -> Kind.double_baking_evidence contents_result
+  | Activate_account_result :
+      balance_updates -> Kind.activate_account contents_result
+  | Proposals_result : Kind.proposals contents_result
+  | Ballot_result : Kind.ballot contents_result
+  | Manager_operation_result :
       { balance_updates : balance_updates ;
-        operation_results : (manager_operation_kind * manager_operation_result) list }
+        operation_result : 'kind manager_operation_result ;
-  | Dictator_operation_result
+        internal_operation_results : packed_internal_operation_result list ;
+      } -> 'kind Kind.manager contents_result
+  | Activate_protocol_result :
+      Kind.activate_protocol contents_result
+  | Activate_test_protocol_result :
+      Kind.activate_test_protocol contents_result
 
-(** Result of applying a {!consensus_operation}. Follows the same structure. *)
+and packed_contents_result =
-and consensus_operation_result =
+  | Contents_result : 'kind contents_result -> packed_contents_result
-  | Endorsements_result of Signature.Public_key_hash.t * int list
-
-(** An operation descriptor in the queue of emitted manager
-    operations. [External] points to a {!manager_operation_content} in
-    the toplevel {!manager_operation}. The operations are executed in a
-    queue, so the n-th [External] corresponds to the [n-th]
-    {!manager_operation_content}. [Internal] points to an operation
-    emitted by a contract, whose contents is given verbatim. *)
-and manager_operation_kind =
-  | External
-  | Internal of internal_operation
 
 (** The result of an operation in the queue. [Skipped] ones should
     always be at the tail, and after a single [Failed]. *)
-and manager_operation_result =
+and 'kind manager_operation_result =
-  | Applied of successful_manager_operation_result
+  | Applied of 'kind successful_manager_operation_result
-  | Failed of error list
+  | Failed : 'kind Kind.manager * error list -> 'kind manager_operation_result
-  | Skipped
+  | Skipped : 'kind Kind.manager -> 'kind manager_operation_result
 
 (** Result of applying a {!manager_operation_content}, either internal
     or external. *)
-and successful_manager_operation_result =
+and _ successful_manager_operation_result =
-  | Reveal_result
+  | Reveal_result : Kind.reveal successful_manager_operation_result
-  | Transaction_result of
+  | Transaction_result :
-      { operations : internal_operation list ;
+      { storage : Script.expr option ;
-        storage : Script.expr option ;
         balance_updates : balance_updates ;
         originated_contracts : Contract.t list ;
         consumed_gas : Z.t ;
-        storage_size_diff : Int64.t }
+        storage_size_diff : Int64.t ;
-  | Origination_result of
+      } -> Kind.transaction successful_manager_operation_result
+  | Origination_result :
       { balance_updates : balance_updates ;
         originated_contracts : Contract.t list ;
         consumed_gas : Z.t ;
-        storage_size_diff : Int64.t }
+        storage_size_diff : Int64.t ;
-  | Delegation_result
+      } -> Kind.origination successful_manager_operation_result
+  | Delegation_result : Kind.delegation successful_manager_operation_result
 
-(** Serializer for {!proto_operation_result}. *)
+and packed_successful_manager_operation_result =
-val encoding : operation_result Data_encoding.t
+  | Successful_manager_result :
+      'kind successful_manager_operation_result -> packed_successful_manager_operation_result
+
+and packed_internal_operation_result =
+  | Internal_operation_result :
+      'kind internal_operation * 'kind manager_operation_result ->
+    packed_internal_operation_result
+
+(** Serializer for {!packed_operation_result}. *)
+val operation_metadata_encoding : packed_operation_metadata Data_encoding.t
+
+val operation_data_and_metadata_encoding
+  : (Operation.packed_protocol_data * packed_operation_metadata) Data_encoding.t
+
+
+
+type 'kind contents_and_result_list =
+  | Single_and_result : 'kind Alpha_context.contents * 'kind contents_result -> 'kind contents_and_result_list
+  | Cons_and_result : 'kind Kind.manager Alpha_context.contents * 'kind Kind.manager contents_result * 'rest Kind.manager contents_and_result_list -> ('kind * 'rest) Kind.manager contents_and_result_list
+
+type packed_contents_and_result_list =
+  | Contents_and_result_list : 'kind contents_and_result_list -> packed_contents_and_result_list
+
+val contents_and_result_list_encoding :
+  packed_contents_and_result_list Data_encoding.t
+
+val pack_contents_list :
+  'kind contents_list -> 'kind contents_result_list ->
+  'kind contents_and_result_list
+
+val unpack_contents_list :
+  'kind contents_and_result_list ->
+  'kind contents_list * 'kind contents_result_list
+
+type ('a, 'b) eq = Eq : ('a, 'a) eq
+val kind_equal_list :
+  'kind contents_list -> 'kind2 contents_result_list -> ('kind, 'kind2) eq option

src/proto_alpha/lib_protocol/src/blinded_public_key_hash.ml

@@ -35,6 +35,10 @@ module Index = struct
   type nonrec t = t
   let path_length = 2
 
+  let rpc_arg = rpc_arg
+  let compare = compare
+  let encoding = encoding
+
   let to_path bpkh l =
     let `Hex h =  MBytes.to_hex (to_bytes bpkh) in
     String.sub h 0 2 :: String.sub h 2 (size - 2) :: l

src/proto_alpha/lib_protocol/src/helpers_services.ml

@@ -255,22 +255,28 @@ module Forge = struct
       Contract_services.manager_key ctxt block source >>= function
       | Error _ as e -> Lwt.return e
       | Ok (_, revealed) ->
-          let operations =
-            match revealed with
-            | Some _ -> operations
-            | None ->
-                match sourcePubKey with
-                | None -> operations
-                | Some pk -> Reveal pk :: operations in
           let ops =
-            Manager_operations { source ;
+            List.map
-                                 counter ; operations ; fee ;
+              (fun (Manager operation) ->
-                                 gas_limit ; storage_limit } in
+                 Contents
-          (RPC_context.make_call0 S.operations ctxt block
+                   (Manager_operation { source ;
-             () ({ branch }, Sourced_operation ops))
+                                        counter ; operation ; fee ;
+                                        gas_limit ; storage_limit }))
+              operations in
+          let ops =
+            match sourcePubKey, revealed with
+            | None, _ | _, Some _ ->  ops
+            | Some pk, None ->
+                let operation = Reveal pk in
+                Contents
+                  (Manager_operation { source ;
+                                       counter ; operation ; fee ;
+                                       gas_limit ; storage_limit }) :: ops in
+          RPC_context.make_call0 S.operations ctxt block
+            () ({ branch }, Operation.of_list ops)
 
     let reveal ctxt
-        block ~branch ~source ~sourcePubKey ~counter ~fee ()=
+        block ~branch ~source ~sourcePubKey ~counter ~fee () =
       operations ctxt block ~branch ~source ~sourcePubKey ~counter ~fee
         ~gas_limit:Z.zero ~storage_limit:0L []
 
@@ -281,7 +287,7 @@ module Forge = struct
       let parameters = Option.map ~f:Script.lazy_expr parameters in
       operations ctxt block ~branch ~source ?sourcePubKey ~counter
         ~fee ~gas_limit ~storage_limit
-        Alpha_context.[Transaction { amount ; parameters ; destination }]
+        [Manager (Transaction { amount ; parameters ; destination })]
 
     let origination ctxt
         block ~branch
@@ -293,89 +299,53 @@ module Forge = struct
         ~gas_limit ~storage_limit ~fee () =
       operations ctxt block ~branch ~source ?sourcePubKey ~counter
         ~fee ~gas_limit ~storage_limit
-        Alpha_context.[
+        [Manager (Origination { manager = managerPubKey ;
-          Origination { manager = managerPubKey ;
                                 delegate = delegatePubKey ;
                                 script ;
                                 spendable ;
                                 delegatable ;
                                 credit = balance ;
-                        preorigination = None }
+                                preorigination = None })]
-        ]
 
     let delegation ctxt
         block ~branch ~source ?sourcePubKey ~counter ~fee delegate =
       operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee
         ~gas_limit:Z.zero ~storage_limit:0L
-        Alpha_context.[Delegation delegate]
+        [Manager (Delegation delegate)]
 
   end
 
-  module Consensus = struct
+  let operation ctxt
-
-    let operations ctxt
       block ~branch operation =
-      let ops = Consensus_operation operation in
+    RPC_context.make_call0 S.operations ctxt block
-      (RPC_context.make_call0 S.operations ctxt block
+      () ({ branch }, Contents_list (Single operation))
-         () ({ branch }, Sourced_operation ops))
 
   let endorsement ctxt
       b ~branch ~block ~level ~slots () =
-      operations ctxt b ~branch
+    operation ctxt b ~branch
-        Alpha_context.(Endorsements { block ; level ; slots })
+      (Endorsements { block ; level ; slots })
-
-
-  end
-
-  module Amendment = struct
-
-    let operation ctxt
-        block ~branch ~source operation =
-      let ops = Amendment_operation { source ; operation } in
-      (RPC_context.make_call0 S.operations ctxt block
-         () ({ branch }, Sourced_operation ops))
 
   let proposals ctxt
       b ~branch ~source ~period ~proposals () =
-      operation ctxt b ~branch ~source
+    operation ctxt b ~branch
-        Alpha_context.(Proposals { period ; proposals })
+      (Proposals { source ; period ; proposals })
 
   let ballot ctxt
       b ~branch ~source ~period ~proposal ~ballot () =
-      operation ctxt b ~branch ~source
+    operation ctxt b ~branch
-        Alpha_context.(Ballot { period ; proposal ; ballot })
+      (Ballot { source ; period ; proposal ; ballot })
 
-  end
+  let activate_protocol ctxt
-
-  module Dictator = struct
-
-    let operation ctxt
-        block ~branch operation =
-      let op = Dictator_operation operation in
-      (RPC_context.make_call0 S.operations ctxt block
-         () ({ branch }, Sourced_operation op))
-
-    let activate ctxt
       b ~branch hash =
-      operation ctxt b ~branch (Activate hash)
+    operation ctxt b ~branch (Activate_protocol hash)
 
-    let activate_testchain ctxt
+  let activate_test_protocol ctxt
       b ~branch hash =
-      operation ctxt b ~branch (Activate_testchain hash)
+    operation ctxt b ~branch (Activate_test_protocol hash)
-
-  end
-
-  module Anonymous = struct
-
-    let operations ctxt block ~branch operations =
-      (RPC_context.make_call0 S.operations ctxt block
-         () ({ branch }, Anonymous_operations operations))
 
   let seed_nonce_revelation ctxt
       block ~branch ~level ~nonce () =
-      operations ctxt block ~branch [Seed_nonce_revelation { level ; nonce }]
+    operation ctxt block ~branch (Seed_nonce_revelation { level ; nonce })
-
-  end
 
   let empty_proof_of_work_nonce =
     MBytes.of_string
@@ -420,42 +390,6 @@ module Parse = struct
 
   end
 
-  module I = struct
-
-    let check_signature ctxt signature shell contents =
-      match contents with
-      | Anonymous_operations _ -> return ()
-      | Sourced_operation (Manager_operations op) ->
-          let public_key =
-            List.fold_left (fun acc op ->
-                match op with
-                | Reveal pk -> Some pk
-                | _ -> acc) None op.operations in
-          begin
-            match public_key with
-            | Some key -> return key
-            | None ->
-                Contract.get_manager ctxt op.source >>=? fun manager ->
-                Roll.delegate_pubkey ctxt manager
-          end >>=? fun public_key ->
-          Operation.check_signature public_key
-            { shell ; protocol_data = { contents ; signature } }
-      | Sourced_operation (Consensus_operation (Endorsements { level ; slots ; _ })) ->
-          let level = Level.from_raw ctxt level in
-          Baking.check_endorsements_rights ctxt level slots >>=? fun public_key ->
-          Operation.check_signature public_key
-            { shell ; protocol_data = { contents ; signature } }
-      | Sourced_operation (Amendment_operation { source ; _ }) ->
-          Roll.delegate_pubkey ctxt source >>=? fun source ->
-          Operation.check_signature source
-            { shell ; protocol_data = { contents ; signature } }
-      | Sourced_operation (Dictator_operation _) ->
-          let key = Constants.dictator_pubkey ctxt in
-          Operation.check_signature key
-            { shell ; protocol_data = { contents ; signature } }
-
-  end
-
   let parse_protocol_data protocol_data =
     match
       Data_encoding.Binary.of_bytes
@@ -467,13 +401,14 @@ module Parse = struct
 
   let () =
     let open Services_registration in
-    register0 S.operations begin fun ctxt () (operations, check) ->
+    register0 S.operations begin fun _ctxt () (operations, check) ->
       map_s begin fun raw ->
         Lwt.return (parse_operation raw) >>=? fun op ->
         begin match check with
           | Some true ->
-              I.check_signature ctxt
+              return () (* FIXME *)
-                op.protocol_data.signature op.shell op.protocol_data.contents
+          (* I.check_signature ctxt *)
+          (* op.protocol_data.signature op.shell op.protocol_data.contents *)
           | Some false | None -> return ()
         end >>|? fun () -> op
       end operations

src/proto_alpha/lib_protocol/src/helpers_services.mli

@@ -25,10 +25,9 @@ module Scripts : sig
 
   val run_code:
     'a #RPC_context.simple ->
-    'a -> Script.expr ->
+    'a -> Script.expr -> (Script.expr * Script.expr * Tez.t * Contract.t) ->
-    (Script.expr * Script.expr * Tez.t * Contract.t) ->
     (Script.expr *
-     internal_operation list *
+     packed_internal_operation list *
      Contract.big_map_diff option) shell_tzresult Lwt.t
 
   val trace_code:
@@ -36,7 +35,7 @@ module Scripts : sig
     'a -> Script.expr ->
     (Script.expr * Script.expr * Tez.t * Contract.t) ->
     (Script.expr *
-     internal_operation list *
+     packed_internal_operation list *
      Script_interpreter.execution_trace *
      Contract.big_map_diff option) shell_tzresult Lwt.t
 
@@ -69,7 +68,7 @@ module Forge : sig
       fee:Tez.t ->
       gas_limit:Z.t ->
       storage_limit:Int64.t ->
-      manager_operation list -> MBytes.t shell_tzresult Lwt.t
+      packed_manager_operation list -> MBytes.t shell_tzresult Lwt.t
 
     val reveal:
       'a #RPC_context.simple -> 'a ->
@@ -123,27 +122,16 @@ module Forge : sig
 
   end
 
-  module Dictator : sig
+  val activate_protocol:
-
-    val operation:
-      'a #RPC_context.simple -> 'a ->
-      branch:Block_hash.t ->
-      dictator_operation -> MBytes.t shell_tzresult Lwt.t
-
-    val activate:
     'a #RPC_context.simple -> 'a ->
     branch:Block_hash.t ->
     Protocol_hash.t -> MBytes.t shell_tzresult Lwt.t
 
-    val activate_testchain:
+  val activate_test_protocol:
     'a #RPC_context.simple -> 'a ->
     branch:Block_hash.t ->
     Protocol_hash.t -> MBytes.t shell_tzresult Lwt.t
 
-  end
-
-  module Consensus : sig
-
   val endorsement:
     'a #RPC_context.simple -> 'a ->
     branch:Block_hash.t ->
@@ -152,10 +140,6 @@ module Forge : sig
     slots:int list ->
     unit -> MBytes.t shell_tzresult Lwt.t
 
-  end
-
-  module Amendment : sig
-
   val proposals:
     'a #RPC_context.simple -> 'a ->
     branch:Block_hash.t ->
@@ -173,15 +157,6 @@ module Forge : sig
     ballot:Vote.ballot ->
     unit -> MBytes.t shell_tzresult Lwt.t
 
-  end
-
-  module Anonymous : sig
-
-    val operations:
-      'a #RPC_context.simple -> 'a ->
-      branch:Block_hash.t ->
-      anonymous_operation list -> MBytes.t shell_tzresult Lwt.t
-
   val seed_nonce_revelation:
     'a #RPC_context.simple -> 'a ->
     branch:Block_hash.t ->
@@ -189,8 +164,6 @@ module Forge : sig
     nonce:Nonce.t ->
     unit -> MBytes.t shell_tzresult Lwt.t
 
-  end
-
   val protocol_data:
     'a #RPC_context.simple -> 'a ->
     priority: int ->
@@ -205,7 +178,7 @@ module Parse : sig
   val operations:
     'a #RPC_context.simple -> 'a ->
     ?check:bool -> Operation.raw list ->
-    Operation.t list shell_tzresult Lwt.t
+    Operation.packed list shell_tzresult Lwt.t
 
   val block:
     'a #RPC_context.simple -> 'a ->

src/proto_alpha/lib_protocol/src/main.ml

@@ -20,17 +20,23 @@ let block_header_data_encoding = Alpha_context.Block_header.protocol_data_encodi
 type block_header_metadata = Alpha_context.Block_header.metadata
 let block_header_metadata_encoding = Alpha_context.Block_header.metadata_encoding
 
-type operation_data = Alpha_context.Operation.protocol_data
+type operation_data = Alpha_context.packed_protocol_data =
-type operation = Alpha_context.Operation.t = {
+  | Operation_data : 'kind Alpha_context.Operation.protocol_data -> operation_data
+let operation_data_encoding = Alpha_context.Operation.protocol_data_encoding
+
+type operation_receipt = Apply_operation_result.packed_operation_metadata =
+  | Operation_metadata : 'kind Apply_operation_result.operation_metadata -> operation_receipt
+let operation_receipt_encoding =
+  Apply_operation_result.operation_metadata_encoding
+
+let operation_data_and_receipt_encoding =
+  Apply_operation_result.operation_data_and_metadata_encoding
+
+type operation = Alpha_context.packed_operation = {
   shell: Operation.shell_header ;
   protocol_data: operation_data ;
 }
 
-let operation_data_encoding = Alpha_context.Operation.protocol_data_encoding
-
-type operation_metadata = Apply_operation_result.operation_result
-let operation_metadata_encoding =
-  Data_encoding.(obj1 (req "metadata" Apply_operation_result.encoding))
 
 let acceptable_passes = Alpha_context.Operation.acceptable_passes
 
@@ -120,7 +126,11 @@ let begin_construction
   end >>=? fun (mode, ctxt, deposit) ->
   return { mode ; ctxt ; op_count = 0 ; deposit }
 
-let apply_operation ({ mode ; ctxt ; op_count ; _ } as data) operation =
+let apply_operation
+    ({ mode ; ctxt ; op_count ; _ } as data)
+    (operation : Alpha_context.packed_operation) =
+  let { shell ; protocol_data = Operation_data protocol_data } = operation in
+  let operation : _ Alpha_context.operation = { shell ; protocol_data } in
   let predecessor =
     match mode with
     | Partial_construction { predecessor }
@@ -129,9 +139,10 @@ let apply_operation ({ mode ; ctxt ; op_count ; _ } as data) operation =
     | Full_construction { predecessor ; _ } ->
         predecessor in
   Apply.apply_operation ctxt Optimized predecessor
-    (Alpha_context.Operation.hash operation) operation >>=? fun (ctxt, result) ->
+    (Alpha_context.Operation.hash operation)
+    operation >>=? fun (ctxt, result) ->
   let op_count = op_count + 1 in
-  return ({ data with ctxt ; op_count }, result)
+  return ({ data with ctxt ; op_count }, Operation_metadata result)
 
 let finalize_block { mode ; ctxt ; op_count ; deposit = _ } =
   match mode with
@@ -158,8 +169,7 @@ let finalize_block { mode ; ctxt ; op_count ; deposit = _ } =
       let ctxt = Alpha_context.finalize ~commit_message ctxt in
       return (ctxt, { Alpha_context.Block_header.baker ; level ; voting_period_kind })
 
-let compare_operations op1 op2 =
+let compare_operations = Apply.compare_operations
-  Apply.compare_operations op1 op2
 
 let init ctxt block_header =
   let level = block_header.Block_header.level in

src/proto_alpha/lib_protocol/src/main.mli

@@ -30,10 +30,18 @@ type validation_state =
     deposit : Alpha_context.Tez.t ;
   }
 
-include Updater.PROTOCOL with type block_header_data = Alpha_context.Block_header.protocol_data
+type operation_data = Alpha_context.packed_protocol_data
+
+type operation = Alpha_context.packed_operation = {
+  shell: Operation.shell_header ;
+  protocol_data: operation_data ;
+}
+
+include Updater.PROTOCOL
+  with type block_header_data = Alpha_context.Block_header.protocol_data
    and type block_header_metadata = Alpha_context.Block_header.metadata
    and type block_header = Alpha_context.Block_header.t
-                          and type operation_data = Alpha_context.Operation.protocol_data
+   and type operation_data := operation_data
-                          and type operation_metadata = Apply_operation_result.operation_result
+   and type operation_receipt = Apply_operation_result.packed_operation_metadata
-                          and type operation = Alpha_context.operation
+   and type operation := operation
    and type validation_state := validation_state

src/proto_alpha/lib_protocol/src/operation_repr.mli

@@ -9,6 +9,28 @@
 
 (* Tezos Protocol Implementation - Low level Repr. of Operations *)
 
+module Kind : sig
+  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 endorsements = Endorsements_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
+  type activate_protocol = Activate_protocol_kind
+  type activate_test_protocol = Activate_test_protocol_kind
+
+end
+
 type raw = Operation.t = {
   shell: Operation.shell_header ;
   proto: MBytes.t ;
@@ -16,80 +38,75 @@ type raw = Operation.t = {
 
 val raw_encoding: raw Data_encoding.t
 
-type operation = {
+type 'kind operation = {
   shell: Operation.shell_header ;
-  protocol_data: protocol_data ;
+  protocol_data: 'kind protocol_data ;
 }
 
-and protocol_data = {
+and 'kind protocol_data = {
-  contents: contents ;
+  contents: 'kind contents_list ;
   signature: Signature.t option ;
 }
 
-and contents =
+and _ contents_list =
-  | Anonymous_operations of anonymous_operation list
+  | Single : 'kind contents -> 'kind contents_list
-  | Sourced_operation of sourced_operation
+  | Cons : 'kind Kind.manager contents * 'rest Kind.manager contents_list ->
+    (('kind * 'rest) Kind.manager ) contents_list
 
-and anonymous_operation =
+and _ contents =
-  | Seed_nonce_revelation of {
+  | Endorsements : {
-      level: Raw_level_repr.t ;
-      nonce: Seed_repr.nonce ;
-    }
-  | Double_endorsement_evidence of {
-      op1: operation ;
-      op2: operation ;
-    }
-  | Double_baking_evidence of {
-      bh1: Block_header_repr.t ;
-      bh2: Block_header_repr.t ;
-    }
-  | Activation of {
-      id: Ed25519.Public_key_hash.t ;
-      activation_code: Blinded_public_key_hash.activation_code ;
-    }
-
-and sourced_operation =
-  | Consensus_operation of consensus_operation
-  | Amendment_operation of {
-      source: Signature.Public_key_hash.t ;
-      operation: amendment_operation ;
-    }
-  | Manager_operations of {
-      source: Contract_repr.contract ;
-      fee: Tez_repr.tez ;
-      counter: counter ;
-      operations: manager_operation list ;
-      gas_limit: Z.t ;
-      storage_limit: Int64.t;
-    }
-  | Dictator_operation of dictator_operation
-
-and consensus_operation =
-  | Endorsements of {
       block: Block_hash.t ;
       level: Raw_level_repr.t ;
       slots: int list ;
-    }
+    } -> Kind.endorsements contents
-
+  | Seed_nonce_revelation : {
-and amendment_operation =
+      level: Raw_level_repr.t ;
-  | Proposals of {
+      nonce: Seed_repr.nonce ;
+    } -> Kind.seed_nonce_revelation contents
+  | Double_endorsement_evidence : {
+      op1: Kind.endorsements operation ;
+      op2: Kind.endorsements 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 of {
+  | 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: Contract_repr.contract ;
+      fee: Tez_repr.tez ;
+      counter: counter ;
+      operation: 'kind manager_operation ;
+      gas_limit: Z.t;
+      storage_limit: Int64.t;
+    } -> 'kind Kind.manager contents
+  | Activate_protocol :
+      Protocol_hash.t -> Kind.activate_protocol contents
+  | Activate_test_protocol :
+      Protocol_hash.t -> Kind.activate_test_protocol contents
 
-and manager_operation =
+and _ manager_operation =
-  | Reveal of Signature.Public_key.t
+  | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation
-  | Transaction of {
+  | Transaction : {
       amount: Tez_repr.tez ;
       parameters: Script_repr.lazy_expr option ;
       destination: Contract_repr.contract ;
-    }
+    } -> Kind.transaction manager_operation
-  | Origination of {
+  | Origination : {
       manager: Signature.Public_key_hash.t ;
       delegate: Signature.Public_key_hash.t option ;
       script: Script_repr.t option ;
@@ -97,39 +114,108 @@ and manager_operation =
       delegatable: bool ;
       credit: Tez_repr.tez ;
       preorigination: Contract_repr.t option ;
-    }
+    } -> Kind.origination manager_operation
-  | Delegation of Signature.Public_key_hash.t option
+  | Delegation :
-
+      Signature.Public_key_hash.t option -> Kind.delegation manager_operation
-and dictator_operation =
-  | Activate of Protocol_hash.t
-  | Activate_testchain of Protocol_hash.t
 
 and counter = Int32.t
 
-val encoding: operation Data_encoding.t
+type 'kind internal_operation = {
-val contents_encoding: contents Data_encoding.t
+  source: Contract_repr.contract ;
-val protocol_data_encoding: protocol_data Data_encoding.t
+  operation: 'kind manager_operation ;
-val unsigned_operation_encoding: (Operation.shell_header * contents) Data_encoding.t
+  nonce: int ;
+}
 
-val raw: operation -> raw
+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
+
+val of_list: packed_contents list -> packed_contents_list
+val to_list: packed_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 ;
+}
+
+val pack: 'kind operation -> packed_operation
+
+type packed_internal_operation =
+  | Internal_operation : 'kind internal_operation -> packed_internal_operation
+
+val manager_kind: 'kind manager_operation -> 'kind Kind.manager
+
+val encoding: packed_operation Data_encoding.t
+val contents_encoding: packed_contents Data_encoding.t
+val protocol_data_encoding: packed_protocol_data Data_encoding.t
+val unsigned_operation_encoding: (Operation.shell_header * packed_contents_list) Data_encoding.t
+
+val raw: _ operation -> raw
 
 val hash_raw: raw -> Operation_hash.t
-val hash: operation -> Operation_hash.t
+val hash: _ operation -> Operation_hash.t
 
-val acceptable_passes: operation -> int list
+val acceptable_passes: packed_operation -> int list
 
 type error += Missing_signature (* `Permanent *)
 type error += Invalid_signature (* `Permanent *)
 
-
 val check_signature:
-  Signature.Public_key.t -> operation -> unit tzresult Lwt.t
+  Signature.Public_key.t -> _ operation -> unit tzresult Lwt.t
-
-type internal_operation = {
-  source: Contract_repr.contract ;
-  operation: manager_operation ;
-  nonce: int ;
-}
 
 val internal_operation_encoding:
-  internal_operation Data_encoding.t
+  packed_internal_operation Data_encoding.t
+
+type ('a, 'b) eq = Eq : ('a, 'a) eq
+val equal: 'a operation -> 'b operation -> ('a, 'b) eq option
+
+module Encoding : sig
+
+  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
+
+  val endorsement_case: Kind.endorsements case
+  val seed_nonce_revelation_case: Kind.seed_nonce_revelation case
+  val double_endorsement_evidence_case: Kind.double_endorsement_evidence case
+  val double_baking_evidence_case: Kind.double_baking_evidence case
+  val activate_account_case: Kind.activate_account case
+  val proposals_case: Kind.proposals case
+  val ballot_case: Kind.ballot case
+  val reveal_case: Kind.reveal Kind.manager case
+  val transaction_case: Kind.transaction Kind.manager case
+  val origination_case: Kind.origination Kind.manager case
+  val delegation_case: Kind.delegation Kind.manager case
+  val activate_protocol_case: Kind.activate_protocol case
+  val activate_test_protocol_case: Kind.activate_test_protocol case
+
+  module Manager_operations : sig
+
+    type 'b 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
+
+    val reveal_case: Kind.reveal case
+    val transaction_case: Kind.transaction case
+    val origination_case: Kind.origination case
+    val delegation_case: Kind.delegation case
+
+  end
+
+end

src/proto_alpha/lib_protocol/src/script_interpreter.ml

@@ -595,7 +595,7 @@ let rec interp
                 { amount ; destination ;
                   parameters = Some (Script.lazy_expr (Micheline.strip_locations p)) } in
             Lwt.return (fresh_internal_nonce ctxt) >>=? fun (ctxt, nonce) ->
-            logged_return (Item ({ source = self ; operation ; nonce }, rest), ctxt)
+            logged_return (Item (Internal_operation { 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 ->
@@ -605,7 +605,7 @@ let rec interp
                 { credit ; manager ; delegate ; preorigination = Some contract ;
                   delegatable ; script = None ; spendable = true } in
             Lwt.return (fresh_internal_nonce ctxt) >>=? fun (ctxt, nonce) ->
-            logged_return (Item ({ source = self ; operation ; nonce },
+            logged_return (Item (Internal_operation { source = self ; operation ; nonce },
                                  Item (contract, rest)), ctxt)
         | Implicit_account, Item (key, rest) ->
             Lwt.return (Gas.consume ctxt Interp_costs.implicit_account) >>=? fun ctxt ->
@@ -636,14 +636,14 @@ let rec interp
                                   storage = Script.lazy_expr storage } } in
             Lwt.return (fresh_internal_nonce ctxt) >>=? fun (ctxt, nonce) ->
             logged_return
-              (Item ({ source = self ; operation ; nonce },
+              (Item (Internal_operation { 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
             Lwt.return (fresh_internal_nonce ctxt) >>=? fun (ctxt, nonce) ->
-            logged_return (Item ({ source = self ; operation ; nonce }, rest), ctxt)
+            logged_return (Item (Internal_operation { 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 ->
@@ -693,7 +693,7 @@ let rec interp
 (* ---- contract handling ---------------------------------------------------*)
 
 and execute ?log ctxt mode ~source ~payer ~self script amount arg :
-  (Script.expr * internal_operation list * context *
+  (Script.expr * packed_internal_operation list * context *
    Script_typed_ir.ex_big_map option) tzresult Lwt.t =
   parse_script ctxt script
   >>=? fun ((Ex_script { code ; arg_type ; storage ; storage_type }), ctxt) ->
@@ -711,7 +711,7 @@ type execution_result =
   { ctxt : context ;
     storage : Script.expr ;
     big_map_diff : Contract.big_map_diff option ;
-    operations : internal_operation list }
+    operations : packed_internal_operation list }
 
 let trace ctxt mode ~source ~payer ~self:(self, script) ~parameter ~amount =
   let log = ref [] in

src/proto_alpha/lib_protocol/src/script_interpreter.mli

@@ -17,7 +17,7 @@ type execution_result =
   { ctxt : context ;
     storage : Script.expr ;
     big_map_diff : Contract.big_map_diff option ;
-    operations : internal_operation list }
+    operations : packed_internal_operation list }
 
 val execute:
   Alpha_context.t ->

src/proto_alpha/lib_protocol/src/script_typed_ir.ml

@@ -45,7 +45,7 @@ type ('key, 'value) map = (module Boxed_map with type key = 'key and type value
 type annot = string option
 
 type ('arg, 'storage) script =
-  { code : (('arg, 'storage) pair, (internal_operation list, 'storage) pair) lambda ;
+  { code : (('arg, 'storage) pair, (packed_internal_operation list, 'storage) pair) lambda ;
     arg_type : 'arg ty ;
     storage : 'storage ;
     storage_type : 'storage ty }
@@ -83,7 +83,7 @@ and 'ty ty =
   | Map_t : 'k comparable_ty * 'v ty -> ('k, 'v) map ty
   | Big_map_t : 'k comparable_ty * 'v ty -> ('k, 'v) big_map ty
   | Contract_t : 'arg ty -> 'arg typed_contract ty
-  | Operation_t : internal_operation ty
+  | Operation_t : packed_internal_operation ty
 
 and 'ty stack_ty =
   | Item_t : 'ty ty * 'rest stack_ty * annot -> ('ty * 'rest) stack_ty
@@ -316,17 +316,17 @@ and ('bef, 'aft) instr =
   | Address_manager :
       (Contract.t * 'rest, public_key_hash option * 'rest) instr
   | Transfer_tokens :
-      ('arg * (Tez.t * ('arg typed_contract * 'rest)), internal_operation * 'rest) instr
+      ('arg * (Tez.t * ('arg typed_contract * 'rest)), packed_internal_operation * 'rest) instr
   | Create_account :
       (public_key_hash * (public_key_hash option * (bool * (Tez.t * 'rest))),
-       internal_operation * (Contract.t * 'rest)) instr
+       packed_internal_operation * (Contract.t * 'rest)) instr
   | Implicit_account :
       (public_key_hash * 'rest, unit typed_contract * 'rest) instr
-  | Create_contract : 'g ty * 'p ty * ('p * 'g, internal_operation list * 'g) lambda  ->
+  | Create_contract : 'g ty * 'p ty * ('p * 'g, packed_internal_operation list * 'g) lambda  ->
     (public_key_hash * (public_key_hash option * (bool * (bool * (Tez.t * ('g * 'rest))))),
-     internal_operation * (Contract.t * 'rest)) instr
+     packed_internal_operation * (Contract.t * 'rest)) instr
   | Set_delegate :
-      (public_key_hash option * 'rest, internal_operation * 'rest) instr
+      (public_key_hash option * 'rest, packed_internal_operation * 'rest) instr
   | Now :
       ('rest, Script_timestamp.t * 'rest) instr
   | Balance :

src/proto_alpha/lib_protocol/test/jbuild

@@ -17,10 +17,10 @@
                     -open Tezos_alpha_test_helpers
 ))))
 
-(alias
+;;(alias
- ((name buildtest)
+;; ((name buildtest)
-  (package tezos-protocol-alpha)
+;;  (package tezos-protocol-alpha)
-  (deps (main.exe))))
+;;  (deps (main.exe))))
 
 ; runs only the `Quick tests
 (alias
@@ -34,10 +34,10 @@
   (package tezos-protocol-alpha)
   (action (chdir ${ROOT} (run ${exe:main.exe} -v)))))
 
-(alias
+;;(alias
- ((name runtest)
+;; ((name runtest)
-  (package tezos-protocol-alpha)
+;;  (package tezos-protocol-alpha)
-  (deps ((alias runtest_proto_alpha)))))
+;;  (deps ((alias runtest_proto_alpha)))))
 
 (alias
  ((name runtest_indent)

src/proto_demo/lib_protocol/src/main.ml

@@ -21,13 +21,21 @@ type block_header_metadata = unit
 let block_header_metadata_encoding = Data_encoding.unit
 
 type operation_data = unit
-type operation = {
-  shell : Operation.shell_header ;
-  protocol_data : operation_data ;
-}
 let operation_data_encoding = Data_encoding.unit
-type operation_metadata = unit
+
-let operation_metadata_encoding = Data_encoding.unit
+type operation_receipt = unit
+let operation_receipt_encoding = Data_encoding.unit
+
+let operation_data_and_receipt_encoding =
+  Data_encoding.conv
+    (function ((), ()) -> ())
+    (fun () -> ((), ()))
+    Data_encoding.unit
+
+type operation = {
+  shell: Operation.shell_header ;
+  protocol_data: operation_data ;
+}
 
 let max_operation_data_length = 42
 

src/proto_genesis/lib_protocol/src/main.ml

@@ -33,16 +33,22 @@ let () =
     (fun () -> Invalid_signature)
 
 type operation_data = unit
+let operation_data_encoding = Data_encoding.unit
+
+type operation_receipt = unit
+let operation_receipt_encoding = Data_encoding.unit
+
+let operation_data_and_receipt_encoding =
+  Data_encoding.conv
+    (function ((), ()) -> ())
+    (fun () -> ((), ()))
+    Data_encoding.unit
+
 type operation = {
   shell: Operation.shell_header ;
   protocol_data: operation_data ;
 }
 
-let operation_data_encoding = Data_encoding.unit
-
-type operation_metadata = unit
-let operation_metadata_encoding = Data_encoding.unit
-
 let acceptable_passes _op = []
 let compare_operations _ _ = 0
 let validation_passes = []