Genesis protocol

.gitignore

@@ -21,6 +21,7 @@
 /src/client/embedded/**/_tzbuild
 
 /src/client/embedded/demo/.depend
+/src/client/embedded/genesis/.depend
 
 /src/client/embedded/alpha/.depend
 /src/client/embedded/alpha/concrete_lexer.ml

src/client/embedded/genesis/.merlin

@@ -0,0 +1,9 @@
+REC
+S .
+B .
+S ../../../proto
+B ../../../proto
+S ../../../proto/genesis
+B _tzbuild
+FLG -open Client_embedded_proto_genesis
+FLG -open Register_client_embedded_proto_genesis

src/client/embedded/genesis/Makefile

@@ -0,0 +1,10 @@
+
+PROTO_VERSION = genesis
+
+CLIENT_IMPLS = \
+  client_proto_main.ml
+
+CLIENT_INTFS = \
+  client_proto_main.mli
+
+include ../Makefile.shared

src/client/embedded/genesis/client_proto_main.ml

@@ -0,0 +1,88 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+let protocol =
+  Protocol_hash.of_b58check
+    "ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im"
+
+let call_service1 cctxt s block a1 =
+  Client_node_rpcs.call_service1 cctxt
+    (s Node_rpc_services.Blocks.proto_path) block a1
+
+let call_error_service1 cctxt s block a1 =
+  call_service1 cctxt s block a1 >|= wrap_error
+
+let forge_block cctxt command block net_id pred_blk hash fitness =
+  call_service1 cctxt
+    Services.Forge.block block
+    (net_id, pred_blk, (Time.now ()),
+     { Types.Block.command ; hash ; fitness })
+
+let mine cctxt command proto_hash fitness seckey =
+  let block =
+    match Client_config.block () with
+    | `Prevalidation -> `Head 0
+    | `Test_prevalidation -> `Test_head 0
+    | b -> b in
+  Client_node_rpcs.Blocks.info cctxt block >>= fun bi ->
+  forge_block
+    cctxt command block bi.net bi.hash proto_hash fitness >>= fun blk ->
+  let signed_blk = Environment.Ed25519.append_signature seckey blk in
+  Client_node_rpcs.inject_block cctxt ~wait:true signed_blk >>=? fun hash ->
+  cctxt.answer "Injected %a" Block_hash.pp_short hash >>= fun () ->
+  return ()
+
+let handle_error cctxt = function
+  | Ok res ->
+      Lwt.return res
+  | Error exns ->
+      pp_print_error Format.err_formatter exns ;
+      cctxt.Client_commands.error "%s" "cannot continue"
+
+let commands () =
+  let open Cli_entries in
+  [
+    command ~desc: "Activate a protocol" begin
+      prefixes [ "activate" ; "protocol" ] @@
+      param ~name:"version" ~desc:"Protocol version (b58check)"
+        (fun _ p -> Lwt.return @@ Protocol_hash.of_b58check p) @@
+      prefixes [ "with" ; "fitness" ] @@
+      param ~name:"fitness"
+        ~desc:"Hardcoded fitness of the first block (integer)"
+        (fun _ p -> Lwt.return (Int64.of_string p)) @@
+      prefixes [ "and" ; "key" ] @@
+      param ~name:"password" ~desc:"Dictator's key"
+        (fun _ key ->
+           Lwt.return (Environment.Ed25519.secret_key_of_b58check key))
+        stop
+    end
+      (fun hash fitness seckey cctxt ->
+         mine cctxt Activate hash fitness seckey >>= handle_error cctxt)
+    ;
+    command ~desc: "Fork a test protocol" begin
+      prefixes [ "fork" ; "test" ; "protocol" ] @@
+      param ~name:"version" ~desc:"Protocol version (b58check)"
+        (fun _ p -> Lwt.return (Protocol_hash.of_b58check p)) @@
+      prefixes [ "with" ; "fitness" ] @@
+      param ~name:"fitness"
+        ~desc:"Hardcoded fitness of the first block (integer)"
+        (fun _ p -> Lwt.return (Int64.of_string p)) @@
+      prefixes [ "and" ; "key" ] @@
+      param ~name:"password" ~desc:"Dictator's key"
+        (fun _ key ->
+           Lwt.return (Environment.Ed25519.secret_key_of_b58check key))
+        stop
+    end
+      (fun hash fitness seckey cctxt ->
+         mine cctxt Activate_testnet hash fitness seckey >>= handle_error cctxt) ;
+  ]
+
+let () =
+  Client_commands.register protocol @@
+  commands ()

src/client/embedded/genesis/client_proto_main.mli

@@ -0,0 +1,9 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+

src/node/main/node_run_command.ml

@@ -17,7 +17,7 @@ let genesis : State.Net.genesis = {
       "BLockGenesisGenesisGenesisGenesisGenesisGeneskvg68z" ;
   protocol =
     Protocol_hash.of_b58check
-      "ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK" ;
+      "ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im" ;
 }
 
 let (//) = Filename.concat

src/node/updater/environment.ml

@@ -76,6 +76,28 @@ module Ed25519 = struct
       ~of_raw:(fun s -> Some (MBytes.of_string s))
       ~wrap:(fun x -> Signature x)
 
+  let public_key_of_b58check s =
+    match Base58.simple_decode b58check_public_key_encoding s with
+    | Some x -> x
+    | None -> Pervasives.failwith "Unexpected hash (ed25519 public key)"
+  let b58check_of_public_key s = Base58.simple_encode b58check_public_key_encoding s
+
+  let secret_key_of_b58check s =
+    match Base58.simple_decode b58check_secret_key_encoding s with
+    | Some x -> x
+    | None -> Pervasives.failwith "Unexpected hash (ed25519 secret key)"
+  let b58check_of_secret_key s = Base58.simple_encode b58check_secret_key_encoding s
+
+  let signature_of_b58check s =
+    match Base58.simple_decode b58check_signature_encoding s with
+    | Some x -> x
+    | None -> Pervasives.failwith "Unexpected hash (ed25519 signature)"
+  let b58check_of_signature s = Base58.simple_encode b58check_signature_encoding s
+
+  let public_key_of_bytes s = Sodium.Sign.Bytes.to_public_key s
+  let secret_key_of_bytes s = Sodium.Sign.Bytes.to_secret_key s
+  let signature_of_bytes s = Sodium.Sign.Bytes.to_signature s
+
   let () =
     Base58.check_encoded_prefix b58check_public_key_encoding "edpk" 54 ;
     Base58.check_encoded_prefix b58check_secret_key_encoding "edsk" 98 ;

src/proto/alpha/init_storage.ml

@@ -8,17 +8,21 @@
 (**************************************************************************)
 
 let version_key = ["version"]
+
 (* This key should always be populated for every version of the
    protocol.  It's absence meaning that the context is empty. *)
 let version_value = "alpha"
 
 (* This is the genesis protocol: initialise the state *)
-let initialize (ctxt:Context.t) =
+let initialize ~from_genesis (ctxt:Context.t) =
   Context.set ctxt version_key (MBytes.of_string version_value) >>= fun ctxt ->
   Storage.prepare ctxt >>=? fun store ->
   Storage.get_genesis_time store >>= fun time ->
   Storage.Current_timestamp.init_set store time >>=? fun store ->
-  Fitness_storage.init store >>=? fun store ->
+  (if from_genesis then
+     return store
+   else
+     Fitness_storage.init store) >>=? fun store ->
   Level_storage.init store >>=? fun store ->
   Roll_storage.init store >>=? fun store ->
   Nonce_storage.init store >>=? fun store ->
@@ -42,11 +46,13 @@ let may_initialize ctxt =
   | None ->
       (* This is the genesis protocol: The only acceptable preceding
          version is an empty context *)
-      initialize ctxt
+      initialize ~from_genesis:false ctxt
   | Some bytes ->
       let s = MBytes.to_string bytes in
       if Compare.String.(s = version_value)
       then Storage.prepare ctxt
+      else if Compare.String.(s = "genesis") then
+        initialize ~from_genesis:true ctxt
       else fail Incompatiple_protocol_version
 
 let configure_sandbox ctxt json =
@@ -57,7 +63,7 @@ let configure_sandbox ctxt json =
   Context.get ctxt version_key >>= function
   | None ->
       Storage.set_sandboxed ctxt json >>= fun ctxt ->
-      initialize ctxt >>=? fun ctxt ->
+      initialize ~from_genesis:false ctxt >>=? fun ctxt ->
       return (Storage.recover ctxt)
   | Some _ ->
       Storage.get_sandboxed ctxt >>=? function

src/proto/environment/ed25519.mli

@@ -32,3 +32,5 @@ val public_key_encoding : public_key Data_encoding.t
 val secret_key_encoding : secret_key Data_encoding.t
 
 val signature_encoding : signature Data_encoding.t
+
+val public_key_of_bytes : Bytes.t -> public_key

src/proto/genesis/.merlin

@@ -0,0 +1,9 @@
+B ../../node/updater/
+B _tzbuild
+FLG -nopervasives
+FLG -open Local_environment
+FLG -open Environment
+FLG -open Hash
+FLG -open Error_monad
+FLG -open Logging
+FLG -w -40

src/proto/genesis/TEZOS_PROTOCOL

@@ -0,0 +1,4 @@
+{
+    "hash": "ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im",
+    "modules": ["Error", "Types", "Services", "Main"]
+}

src/proto/genesis/error.ml

@@ -0,0 +1,40 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Error_monad
+
+type error += Parsing_error
+type error += Invalid_signature
+
+let () =
+  register_error_kind
+    `Temporary
+    ~id:"parsing_error"
+    ~title:"Parsing error"
+    ~description:"Raised when an operation has not been parsed correctly"
+    ~pp:(fun ppf () -> Format.fprintf ppf "Operation parsing error")
+    Data_encoding.empty
+    (function Parsing_error -> Some () | _ -> None)
+    (fun () -> Parsing_error)
+
+let () =
+  register_error_kind
+    `Temporary
+    ~id:"invalid_signature"
+    ~title:"Invalid signature"
+    ~description:"Raised when the provided signature is invalid"
+    ~pp:(fun ppf () -> Format.fprintf ppf "Invalid signature")
+    Data_encoding.empty
+    (function Invalid_signature -> Some () | _ -> None)
+    (fun () -> Invalid_signature)
+
+let parsing_error = error Parsing_error
+let fail_parsing_error = fail Parsing_error
+let invalid_signature = error Invalid_signature
+let fail_invalid_signature = fail Invalid_signature

src/proto/genesis/main.ml

@@ -0,0 +1,106 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Types
+
+module Init = struct
+
+  let version_key = ["version"]
+  (* This key should always be populated for every version of the
+     protocol.  It's absence meaning that the context is empty. *)
+  let version_value = "genesis"
+
+  (* This is the genesis protocol: initialise the state *)
+  let initialize (ctxt:Context.t) =
+    Context.set ctxt version_key (MBytes.of_string version_value) >>= fun ctxt ->
+    Fitness.set_fitness ctxt 0L >>= fun ctxt ->
+    return ctxt
+
+  type error +=
+    | Incompatiple_protocol_version
+    | Decreasing_fitness
+
+  let may_initialize ctxt init_fitness =
+    Context.get ctxt version_key >>= function
+    | None ->
+        Context.set ctxt version_key (MBytes.of_string version_value) >>= fun ctxt ->
+        Fitness.set_fitness ctxt init_fitness >>= fun ctxt ->
+        return ctxt
+    | Some bytes ->
+        let s = MBytes.to_string bytes in
+        if Compare.String.(s = version_value) then
+          Fitness.get_fitness ctxt >>= fun prev_fitness ->
+          if Compare.Int64.(prev_fitness >= init_fitness) then
+            fail Decreasing_fitness
+          else
+            Fitness.set_fitness ctxt init_fitness >>= fun ctxt ->
+            return ctxt
+        else
+          fail Incompatiple_protocol_version
+end
+
+let pubkey = "4d5373455738070434f214826d301a1c206780d7f789fcbf94c2149b2e0718cc"
+
+let public_key =
+  Ed25519.public_key_of_bytes
+    (Bytes.of_string (Hex_encode.hex_decode pubkey))
+
+let validate shell proto signature =
+  let header_bytes =
+    Data_encoding.Binary.to_bytes
+      (Data_encoding.tup2 Updater.shell_block_encoding Block.encoding)
+      (shell, proto) in
+  Ed25519.check_signature public_key signature header_bytes
+
+type operation = ()
+let max_operation_data_length = 0
+
+type block = Block.t
+let max_block_length = 1024
+
+let max_number_of_operations = 0
+
+let parse_block { Updater.shell ; proto } =
+  match Data_encoding.Binary.of_bytes Block.signed_encoding proto with
+  | Some (({ command = Activate ; hash ; fitness } as proto), signature) ->
+      if validate shell proto signature then
+        ok ({ Block.command = Activate ; hash ; fitness })
+      else Error.invalid_signature
+  | Some (({ command = Activate_testnet ; hash ; fitness } as proto), signature) ->
+      if validate shell proto signature then
+        ok ({ Block.command = Activate_testnet ; hash ; fitness })
+      else Error.invalid_signature
+  | None -> Error.parsing_error
+
+let parse_operation _h _op = Ok ()
+
+let fitness _ctxt = Lwt.return_nil
+
+let apply ctxt { Block.command ; hash ; fitness } _ops =
+  Init.may_initialize ctxt fitness >>=? fun ctxt ->
+  match command with
+  | Activate ->
+      Updater.activate ctxt hash >>= fun ctxt ->
+      return ctxt
+  | Activate_testnet ->
+      Updater.set_test_protocol ctxt hash >>= fun ctxt ->
+      Updater.fork_test_network ctxt >>= fun ctxt ->
+      return ctxt
+
+let preapply ctxt _block_pred _timestamp _sort _ops =
+  return ( ctxt,
+           { Updater.applied = [] ;
+             refused = Operation_hash_map.empty ;
+             branch_refused = Operation_hash_map.empty ;
+             branch_delayed = Operation_hash_map.empty ;
+           })
+
+let rpc_services = Services.rpc_services
+
+let configure_sandbox ctxt _ = Lwt.return (Ok ctxt)

src/proto/genesis/services.ml

@@ -0,0 +1,66 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Types
+
+let error_encoding =
+  let open Data_encoding in
+  describe
+    ~description:
+      "The full list of error is available with \
+       the global RPC `/errors`"
+    (conv
+       (fun exn -> `A (List.map json_of_error exn))
+       (function `A exns -> List.map error_of_json exns | _ -> [])
+       json)
+
+let wrap_tzerror encoding =
+  let open Data_encoding in
+  union [
+    case
+      (obj1 (req "ok" encoding))
+      (function Ok x -> Some x | _ -> None)
+      (fun x -> Ok x) ;
+    case
+      (obj1 (req "error" error_encoding))
+      (function Error x -> Some x | _ -> None)
+      (fun x -> Error x) ;
+  ]
+
+module Forge = struct
+  let block custom_root =
+    let open Data_encoding in
+    RPC.service
+      ~description: "Forge a block"
+      ~input:
+        (obj4
+           (req "net_id" Updater.net_id_encoding)
+           (req "predecessor" Block_hash.encoding)
+           (req "timestamp" Time.encoding)
+           (req "block" Block.encoding))
+      ~output: (obj1 (req "payload" bytes))
+      RPC.Path.(custom_root / "helpers" / "forge" / "block")
+end
+
+let rpc_services : Context.t RPC.directory =
+  let dir = RPC.empty in
+  let dir =
+    RPC.register
+      dir
+      (Forge.block RPC.Path.root)
+      (fun _ctxt (net_id, predecessor, timestamp, block) ->
+         let fitness = Fitness.header_fitness block.fitness in
+         let shell = { Updater.net_id ; predecessor ; timestamp ;
+                       fitness ; operations = [] } in
+         RPC.Answer.return
+           (Data_encoding.Binary.to_bytes
+              (Data_encoding.tup2 Updater.shell_block_encoding Block.encoding)
+              (shell, block)))
+  in
+  dir

src/proto/genesis/types.ml

@@ -0,0 +1,67 @@
+module Block = struct
+  type command =
+    (* Activate a protocol *)
+    | Activate
+
+    (* Activate a protocol as a testnet *)
+    | Activate_testnet
+
+  type t = {
+    command : command ;
+    hash : Protocol_hash.t ;
+    fitness : Int64.t ;
+  }
+
+  let mk_encoding name =
+    let open Data_encoding in
+    conv (fun (x, y) -> (), x, y) (fun ((), x, y) -> x, y)
+      (obj3
+         (req "network" (constant name))
+         (req "hash" Protocol_hash.encoding)
+         (req "fitness" int64))
+
+  let encoding =
+    let open Data_encoding in
+    union ~tag_size:`Uint8 [
+      case ~tag:0 (mk_encoding "main")
+        (function { command = Activate ; hash ; fitness } ->
+           Some (hash, fitness) | _ -> None)
+        (fun (hash, fitness) -> { command = Activate ; hash ; fitness })
+      ;
+      case ~tag:1 (mk_encoding "test")
+        (function { command = Activate_testnet ; hash ; fitness } ->
+           Some (hash, fitness) | _ -> None)
+        (fun (hash, fitness) -> { command = Activate_testnet ; hash ; fitness })
+      ;
+    ]
+
+  let signed_encoding =
+    let open Data_encoding in
+    obj2
+      (req "content" encoding)
+      (req "signature" Ed25519.signature_encoding)
+end
+
+module Fitness = struct
+  let fitness_key = ["v1";"store";"fitness"]
+
+  let get_fitness ctxt =
+    Context.get ctxt fitness_key >>= function
+    | None -> Lwt.return 0L
+    | Some b ->
+        match Data_encoding.Binary.of_bytes Data_encoding.int64 b with
+        | None -> Lwt.return 0L
+        | Some v -> Lwt.return v
+
+  let set_fitness ctxt v =
+    Context.set ctxt fitness_key @@
+    Data_encoding.Binary.to_bytes Data_encoding.int64 v
+
+  let int64_to_bytes i =
+    let b = MBytes.create 8 in
+    MBytes.set_int64 b 0 i;
+    b
+
+  let header_fitness v =
+    [ MBytes.of_string "\000" ; int64_to_bytes v ]
+end