Source file registerer.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
module Source = struct
let hash =
Some (Tezos_crypto.Hashed.Protocol_hash.of_b58check_exn "Ps9mPmXaRzmzk35gbAYNCAw6UXdE2qoABTHbN2oEEc1qM7CwT9P")
let sources = Tezos_base.Protocol.
{ expected_env = V0 ;
components = [{ name = "Data" ;
interface = None ;
implementation = "(*****************************************************************************)\n(* *)\n(* Open Source License *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)\n(* *)\n(* Permission is hereby granted, free of charge, to any person obtaining a *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)\n(* and/or sell copies of the Software, and to permit persons to whom the *)\n(* Software is furnished to do so, subject to the following conditions: *)\n(* *)\n(* The above copyright notice and this permission notice shall be included *)\n(* in all copies or substantial portions of the Software. *)\n(* *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)\n(* DEALINGS IN THE SOFTWARE. *)\n(* *)\n(*****************************************************************************)\n\nmodule Command = struct\n\n type t =\n (* Activate a protocol *)\n | Activate of {\n protocol: Protocol_hash.t ;\n fitness: Fitness.t ;\n protocol_parameters : MBytes.t ;\n }\n\n (* Activate a protocol as a testchain *)\n | Activate_testchain of {\n protocol: Protocol_hash.t ;\n delay: Int64.t ;\n }\n\n let mk_case name args =\n let open Data_encoding in\n conv\n (fun o -> ((), o))\n (fun ((), o) -> o)\n (merge_objs\n (obj1 (req \"command\" (constant name)))\n args)\n\n let encoding =\n let open Data_encoding in\n union ~tag_size:`Uint8 [\n case (Tag 0)\n ~title:\"Activate\"\n (mk_case \"activate\"\n (obj3\n (req \"hash\" Protocol_hash.encoding)\n (req \"fitness\" Fitness.encoding)\n (req \"protocol_parameters\" Variable.bytes)\n ))\n (function\n | Activate { protocol ; fitness ; protocol_parameters} ->\n Some (protocol, fitness, protocol_parameters)\n | _ -> None)\n (fun (protocol, fitness, protocol_parameters) ->\n Activate { protocol ; fitness ; protocol_parameters }) ;\n case (Tag 1)\n ~title:\"Activate_testchain\"\n (mk_case \"activate_testchain\"\n (obj2\n (req \"hash\" Protocol_hash.encoding)\n (req \"validity_time\" int64)))\n (function\n | Activate_testchain { protocol ; delay } ->\n Some (protocol, delay)\n | _ -> None)\n (fun (protocol, delay) ->\n Activate_testchain { protocol ; delay }) ;\n ]\n\n let signed_encoding =\n let open Data_encoding in\n obj2\n (req \"content\" encoding)\n (req \"signature\" Signature.encoding)\n\n let forge shell command =\n Data_encoding.Binary.to_bytes_exn\n (Data_encoding.tup2 Block_header.shell_header_encoding encoding)\n (shell, command)\n\nend\n\nmodule Pubkey = struct\n\n let pubkey_key = [\"genesis_key\"]\n\n let default =\n Signature.Public_key.of_b58check_exn\n \"edpkvVCdQtDJHPnkmfRZuuHWKzFetH9N9nGP8F7zkwM2BJpjbvAU1N\"\n\n let get_pubkey ctxt =\n Context.get ctxt pubkey_key >>= function\n | None -> Lwt.return default\n | Some b ->\n match Data_encoding.Binary.of_bytes Signature.Public_key.encoding b with\n | None -> Lwt.return default\n | Some pk -> Lwt.return pk\n\n let set_pubkey ctxt v =\n Context.set ctxt pubkey_key @@\n Data_encoding.Binary.to_bytes_exn Signature.Public_key.encoding v\n\n let sandbox_encoding =\n let open Data_encoding in\n merge_objs\n (obj1 (req \"genesis_pubkey\" Signature.Public_key.encoding))\n Data_encoding.unit\n\n let may_change_default ctxt json =\n match Data_encoding.Json.destruct sandbox_encoding json with\n | exception _ ->\n Lwt.return ctxt\n | (pubkey, ()) ->\n set_pubkey ctxt pubkey >>= fun ctxt ->\n Lwt.return ctxt\n\nend\n\nmodule Init = struct\n\n type error += Incompatible_protocol_version\n\n let version_key = [\"version\"]\n\n (* This key should always be populated for every version of the\n protocol. It's absence meaning that the context is empty. *)\n let version_value = \"genesis\"\n\n let check_inited ctxt =\n Context.get ctxt version_key >>= function\n | None -> failwith \"Internal error: uninitialized context.\"\n | Some version ->\n if Compare.String.(version_value <> MBytes.to_string version) then\n failwith \"Internal error: incompatible protocol version\" ;\n return_unit\n\n let tag_first_block ctxt =\n Context.get ctxt version_key >>= function\n | None ->\n Context.set\n ctxt version_key (MBytes.of_string version_value) >>= fun ctxt ->\n return ctxt\n | Some _version ->\n failwith \"Internal error: previously initialized context.\" ;\n\nend\n" ;
} ;
{ name = "Services" ;
interface = None ;
implementation = "(*****************************************************************************)\n(* *)\n(* Open Source License *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)\n(* *)\n(* Permission is hereby granted, free of charge, to any person obtaining a *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)\n(* and/or sell copies of the Software, and to permit persons to whom the *)\n(* Software is furnished to do so, subject to the following conditions: *)\n(* *)\n(* The above copyright notice and this permission notice shall be included *)\n(* in all copies or substantial portions of the Software. *)\n(* *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)\n(* DEALINGS IN THE SOFTWARE. *)\n(* *)\n(*****************************************************************************)\n\nmodule Forge = struct\n let block custom_root =\n let open Data_encoding in\n RPC_service.post_service\n ~description: \"Forge a block\"\n ~query: RPC_query.empty\n ~input:\n (merge_objs\n (obj6\n (req \"level\" int32)\n (req \"proto_level\" uint8)\n (req \"predecessor\" Block_hash.encoding)\n (req \"timestamp\" Time.encoding)\n (req \"fitness\" Fitness.encoding)\n (req \"context\" Context_hash.encoding))\n Data.Command.encoding)\n ~output: (obj1 (req \"payload\" bytes))\n RPC_path.(custom_root / \"helpers\" / \"forge\" / \"block\")\nend\n\nlet int64_to_bytes i =\n let b = MBytes.create 8 in\n MBytes.set_int64 b 0 i;\n b\n\nlet operations_hash =\n Operation_list_list_hash.compute []\n\nlet rpc_services : Updater.rpc_context RPC_directory.t =\n let dir = RPC_directory.empty in\n let dir =\n RPC_directory.register\n dir\n (Forge.block RPC_path.open_root)\n (fun _ctxt () ((level, proto_level, predecessor,\n timestamp, fitness, context), command) ->\n let shell = { Block_header.level ; proto_level ; predecessor ;\n timestamp ; fitness ; validation_passes = 0 ;\n operations_hash ; context } in\n let bytes = Data.Command.forge shell command in\n return bytes) in\n dir\n" ;
} ;
{ name = "Main" ;
interface = Some "(*****************************************************************************)\n(* *)\n(* Open Source License *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)\n(* *)\n(* Permission is hereby granted, free of charge, to any person obtaining a *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)\n(* and/or sell copies of the Software, and to permit persons to whom the *)\n(* Software is furnished to do so, subject to the following conditions: *)\n(* *)\n(* The above copyright notice and this permission notice shall be included *)\n(* in all copies or substantial portions of the Software. *)\n(* *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)\n(* DEALINGS IN THE SOFTWARE. *)\n(* *)\n(*****************************************************************************)\n\n(** Tezos Protocol Implementation - Protocol Signature Instance *)\n\ntype block_header_data = {\n command: Data.Command.t ;\n signature: Signature.t ;\n}\n\ninclude Updater.PROTOCOL with type block_header_data := block_header_data\n" ;
implementation = "(*****************************************************************************)\n(* *)\n(* Open Source License *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)\n(* *)\n(* Permission is hereby granted, free of charge, to any person obtaining a *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)\n(* and/or sell copies of the Software, and to permit persons to whom the *)\n(* Software is furnished to do so, subject to the following conditions: *)\n(* *)\n(* The above copyright notice and this permission notice shall be included *)\n(* in all copies or substantial portions of the Software. *)\n(* *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)\n(* DEALINGS IN THE SOFTWARE. *)\n(* *)\n(*****************************************************************************)\n\ntype error += Parsing_error\ntype error += Invalid_signature\n\nlet () =\n register_error_kind\n `Permanent\n ~id:\"parsing_error\"\n ~title:\"Parsing error\"\n ~description:\"Raised when a block header has not been parsed correctly\"\n ~pp:(fun ppf () -> Format.fprintf ppf \"Block header parsing error\")\n Data_encoding.empty\n (function Parsing_error -> Some () | _ -> None)\n (fun () -> Parsing_error)\n\nlet () =\n register_error_kind\n `Permanent\n ~id:\"invalid_signature\"\n ~title:\"Invalid signature\"\n ~description:\"Raised when the provided signature is invalid\"\n ~pp:(fun ppf () -> Format.fprintf ppf \"Invalid signature\")\n Data_encoding.empty\n (function Invalid_signature -> Some () | _ -> None)\n (fun () -> Invalid_signature)\n\ntype operation_data = unit\nlet operation_data_encoding = Data_encoding.unit\n\ntype operation_receipt = unit\nlet operation_receipt_encoding = Data_encoding.unit\n\nlet operation_data_and_receipt_encoding =\n Data_encoding.conv\n (function ((), ()) -> ())\n (fun () -> ((), ()))\n Data_encoding.unit\n\ntype operation = {\n shell: Operation.shell_header ;\n protocol_data: operation_data ;\n}\n\nlet acceptable_passes _op = []\nlet compare_operations _ _ = 0\nlet validation_passes = []\n\ntype block_header_data = {\n command: Data.Command.t ;\n signature: Signature.t ;\n}\ntype block_header = {\n shell: Block_header.shell_header ;\n protocol_data: block_header_data ;\n}\n\nlet block_header_data_encoding =\n Data_encoding.conv\n (fun { command ; signature } -> (command, signature))\n (fun (command, signature) -> { command ; signature })\n Data.Command.signed_encoding\n\ntype block_header_metadata = unit\nlet block_header_metadata_encoding = Data_encoding.unit\n\nlet max_block_length =\n Data_encoding.Binary.length\n Data.Command.encoding\n (Activate_testchain { protocol = Protocol_hash.zero ;\n delay = 0L })\n + Signature.size\n\nlet max_operation_data_length = 0\n\nlet check_signature ctxt ~chain_id { shell ; protocol_data = { command ; signature } } =\n let bytes = Data.Command.forge shell command in\n Data.Pubkey.get_pubkey ctxt >>= fun public_key ->\n fail_unless\n (Signature.check ~watermark:(Block_header chain_id) public_key signature bytes)\n Invalid_signature\n\ntype validation_state = Updater.validation_result\n\nlet current_context ({ context ; _ } : validation_state) =\n return context\n\n(* temporary hardcoded key to be removed... *)\nlet protocol_parameters_key = [ \"protocol_parameters\" ]\n\nlet prepare_application ctxt command level timestamp fitness =\n match command with\n | Data.Command.Activate { protocol = hash ; fitness ; protocol_parameters } ->\n let message =\n Some (Format.asprintf \"activate %a\" Protocol_hash.pp_short hash) in\n Context.set ctxt protocol_parameters_key protocol_parameters >>= fun ctxt ->\n Updater.activate ctxt hash >>= fun ctxt ->\n return { Updater.message ; context = ctxt ;\n fitness ; max_operations_ttl = 0 ;\n last_allowed_fork_level = level ;\n }\n | Activate_testchain { protocol = hash ; delay } ->\n let message =\n Some (Format.asprintf \"activate testchain %a\" Protocol_hash.pp_short hash) in\n let expiration = Time.add timestamp delay in\n Updater.fork_test_chain ctxt ~protocol:hash ~expiration >>= fun ctxt ->\n return { Updater.message ; context = ctxt ; fitness ;\n max_operations_ttl = 0 ;\n last_allowed_fork_level = Int32.succ level ;\n }\n\nlet begin_application\n ~chain_id\n ~predecessor_context:ctxt\n ~predecessor_timestamp:_\n ~predecessor_fitness:_\n block_header =\n Data.Init.check_inited ctxt >>=? fun () ->\n check_signature ctxt ~chain_id block_header >>=? fun () ->\n prepare_application ctxt block_header.protocol_data.command\n block_header.shell.level block_header.shell.timestamp block_header.shell.fitness\n\nlet begin_partial_application\n ~chain_id\n ~ancestor_context\n ~predecessor_timestamp\n ~predecessor_fitness\n block_header =\n begin_application\n ~chain_id\n ~predecessor_context:ancestor_context\n ~predecessor_timestamp\n ~predecessor_fitness\n block_header\n\nlet begin_construction\n ~chain_id:_\n ~predecessor_context:ctxt\n ~predecessor_timestamp:_\n ~predecessor_level:level\n ~predecessor_fitness:fitness\n ~predecessor:_\n ~timestamp\n ?protocol_data\n () =\n match protocol_data with\n | None ->\n (* Dummy result. *)\n return { Updater.message = None ; context = ctxt ;\n fitness ; max_operations_ttl = 0 ;\n last_allowed_fork_level = 0l ;\n }\n | Some { command ; _ }->\n Data.Init.check_inited ctxt >>=? fun () ->\n prepare_application ctxt command level timestamp fitness\n\nlet apply_operation _vctxt _ =\n Lwt.return (Error []) (* absurd *)\n\nlet finalize_block state = return (state, ())\n\nlet rpc_services = Services.rpc_services\n\n(* temporary hardcoded key to be removed... *)\nlet sandbox_param_key = [ \"sandbox_parameter\" ]\nlet get_sandbox_param ctxt =\n Context.get ctxt sandbox_param_key >>= function\n | None -> return_none\n | Some bytes ->\n match Data_encoding.Binary.of_bytes Data_encoding.json bytes with\n | None ->\n failwith \"Internal error: failed to parse the sandbox parameter.\"\n | Some json -> return_some json\n\nlet init ctxt block_header =\n Data.Init.tag_first_block ctxt >>=? fun ctxt ->\n get_sandbox_param ctxt >>=? fun sandbox_param ->\n begin\n match sandbox_param with\n | None -> return ctxt\n | Some json ->\n Data.Pubkey.may_change_default ctxt json >>= fun ctxt ->\n return ctxt\n end >>=? fun ctxt ->\n return { Updater.message = None ; context = ctxt ;\n fitness = block_header.Block_header.fitness ;\n max_operations_ttl = 0 ;\n last_allowed_fork_level = block_header.level ;\n }\n" ;
}] ;
}
end
module Registered =
Tezos_protocol_updater.Registered_protocol.Register_embedded_V0
(Tezos_protocol_000_Ps9mPmXa.Environment)
(Tezos_protocol_000_Ps9mPmXa.Protocol.Main)
(Source)