balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Client: minor stylistic issue.

Browse Source
This commit is contained in:
Grégoire Henry 2017-02-15 17:20:10 +01:00
parent c66db98bfa
commit 285427bcba
3 changed files with 63 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
src/client/embedded/alpha/baker/client_mining_daemon.ml
View File

@ -13,21 +13,25 @@ let run cctxt ?max_priority ~delay ?min_date delegates =
(* TODO really detach... *) (* TODO really detach... *)
let endorsement = let endorsement =
if Client_proto_args.Daemon.(!all || !endorsement) then if Client_proto_args.Daemon.(!all || !endorsement) then
Client_mining_blocks.monitor cctxt ?min_date ~min_heads:1 () >>= fun block_stream -> Client_mining_blocks.monitor
cctxt ?min_date ~min_heads:1 () >>= fun block_stream ->
Client_mining_endorsement.create cctxt ~delay delegates block_stream Client_mining_endorsement.create cctxt ~delay delegates block_stream
else else
Lwt.return_unit Lwt.return_unit
in in
let denunciation = let denunciation =
if Client_proto_args.Daemon.(!all || !denunciation) then if Client_proto_args.Daemon.(!all || !denunciation) then
Client_mining_operations.monitor_endorsement cctxt >>= fun endorsement_stream -> Client_mining_operations.monitor_endorsement
cctxt >>= fun endorsement_stream ->
Client_mining_denunciation.create cctxt endorsement_stream Client_mining_denunciation.create cctxt endorsement_stream
else else
Lwt.return_unit Lwt.return_unit
in in
let forge = let forge =
Client_mining_blocks.monitor cctxt ?min_date ~min_heads:1 () >>= fun block_stream -> Client_mining_blocks.monitor
Client_mining_operations.monitor_endorsement cctxt >>= fun endorsement_stream -> cctxt ?min_date ~min_heads:1 () >>= fun block_stream ->
Client_mining_operations.monitor_endorsement
cctxt >>= fun endorsement_stream ->
if Client_proto_args.Daemon.(!all || !mining) then if Client_proto_args.Daemon.(!all || !mining) then
Client_mining_forge.create cctxt Client_mining_forge.create cctxt
?max_priority delegates block_stream endorsement_stream ?max_priority delegates block_stream endorsement_stream

36
src/client/embedded/alpha/baker/client_mining_endorsement.ml
View File

@ -35,7 +35,10 @@ end = struct
let open Data_encoding in let open Data_encoding in
conv conv
(fun x -> LevelMap.bindings x) (fun x -> LevelMap.bindings x)
(fun l -> List.fold_left (fun x (y, z) -> LevelMap.add y z x) LevelMap.empty l) (fun l ->
List.fold_left
(fun x (y, z) -> LevelMap.add y z x)
LevelMap.empty l)
(list (obj2 (list (obj2
(req "level" Raw_level.encoding) (req "level" Raw_level.encoding)
(req "endorsement" (req "endorsement"
@ -52,11 +55,13 @@ end = struct
if not (Sys.file_exists filename) then return LevelMap.empty else if not (Sys.file_exists filename) then return LevelMap.empty else
Data_encoding_ezjsonm.read_file filename >>= function Data_encoding_ezjsonm.read_file filename >>= function
| Error _ -> | Error _ ->
cctxt.Client_commands.error "couldn't to read the endorsement file" cctxt.Client_commands.error
"couldn't to read the endorsement file"
| Ok json -> | Ok json ->
match Data_encoding.Json.destruct encoding json with match Data_encoding.Json.destruct encoding json with
| exception _ -> (* TODO print_error *) | exception _ -> (* TODO print_error *)
cctxt.Client_commands.error "didn't understand the endorsement file" cctxt.Client_commands.error
"didn't understand the endorsement file"
| map -> | map ->
return map return map
@ -72,7 +77,8 @@ end = struct
| Error _ -> failwith "Json.write_file" | Error _ -> failwith "Json.write_file"
| Ok () -> return ()) | Ok () -> return ())
(fun exn -> (fun exn ->
cctxt.Client_commands.error "could not write the endorsement file: %s." cctxt.Client_commands.error
"could not write the endorsement file: %s."
(Printexc.to_string exn)) (Printexc.to_string exn))
let lock = Lwt_mutex.create () let lock = Lwt_mutex.create ()
@ -122,7 +128,8 @@ let inject_endorsement cctxt
~slot:slot ~slot:slot
() >>=? fun bytes -> () >>=? fun bytes ->
let signed_bytes = Ed25519.append_signature src_sk bytes in let signed_bytes = Ed25519.append_signature src_sk bytes in
Client_node_rpcs.inject_operation cctxt ?force ?wait signed_bytes >>=? fun oph -> Client_node_rpcs.inject_operation
cctxt ?force ?wait signed_bytes >>=? fun oph ->
State.record_endorsement cctxt level block_hash slot oph >>=? fun () -> State.record_endorsement cctxt level block_hash slot oph >>=? fun () ->
return oph return oph
@ -151,11 +158,15 @@ let forge_endorsement cctxt
match slot with match slot with
| Some slot -> return slot | Some slot -> return slot
| None -> | None ->
get_signing_slots cctxt ?max_priority block src_pkh level >>=? function get_signing_slots
cctxt ?max_priority block src_pkh level >>=? function
| slot::_ -> return slot | slot::_ -> return slot
| [] -> cctxt.error "No slot found at level %a" Raw_level.pp level | [] -> cctxt.error "No slot found at level %a" Raw_level.pp level
end >>=? fun slot -> end >>=? fun slot ->
(if force then return () else check_endorsement cctxt level slot) >>=? fun () -> begin
if force then return ()
else check_endorsement cctxt level slot
end >>=? fun () ->
inject_endorsement cctxt inject_endorsement cctxt
block level ~wait:true ~force block level ~wait:true ~force
src_sk src_pk slot src_sk src_pk slot
@ -210,7 +221,8 @@ let schedule_endorsements cctxt state bis =
let same_slot e = let same_slot e =
e.block.level = block.level && e.slot = slot in e.block.level = block.level && e.slot = slot in
let old = List.find same_slot state.to_endorse in let old = List.find same_slot state.to_endorse in
if Fitness.compare old.block.fitness block.fitness < 0 then begin if Fitness.compare old.block.fitness block.fitness < 0
then begin
lwt_log_info lwt_log_info
"Schedule endorsement for block %a \ "Schedule endorsement for block %a \
\ (level %a, slot %d, time %a) (replace block %a)" \ (level %a, slot %d, time %a) (replace block %a)"
@ -223,10 +235,14 @@ let schedule_endorsements cctxt state bis =
state.to_endorse <- state.to_endorse <-
insert insert
{ time ; delegate ; block ; slot } { time ; delegate ; block ; slot }
(List.filter (fun e -> not (same_slot e)) state.to_endorse) ; (List.filter
(fun e -> not (same_slot e))
state.to_endorse) ;
return () return ()
end else begin end else begin
lwt_debug "slot %d: better pending endorsement" slot >>= fun () -> lwt_debug
"slot %d: better pending endorsement"
slot >>= fun () ->
return () return ()
end end
with Not_found -> with Not_found ->

43
src/client/embedded/alpha/baker/client_mining_forge.ml
View File

@ -19,8 +19,10 @@ let generate_seed_nonce () =
| Error _ -> assert false | Error _ -> assert false
| Ok nonce -> nonce | Ok nonce -> nonce
let rec compute_stamp cctxt block delegate_sk shell mining_slot seed_nonce_hash = let rec compute_stamp
Client_proto_rpcs.Constants.stamp_threshold cctxt block >>=? fun stamp_threshold -> cctxt block delegate_sk shell mining_slot seed_nonce_hash =
Client_proto_rpcs.Constants.stamp_threshold
cctxt block >>=? fun stamp_threshold ->
let rec loop () = let rec loop () =
let proof_of_work_nonce = generate_proof_of_work_nonce () in let proof_of_work_nonce = generate_proof_of_work_nonce () in
let unsigned_header = let unsigned_header =
@ -81,7 +83,8 @@ let forge_block cctxt block
begin begin
match operations with match operations with
| None -> | None ->
Client_node_rpcs.Blocks.pending_operations cctxt block >|= fun (ops, pendings) -> Client_node_rpcs.Blocks.pending_operations
cctxt block >|= fun (ops, pendings) ->
Operation_hash.Set.elements @@ Operation_hash.Set.elements @@
Operation_hash.Set.union (Updater.operations ops) pendings Operation_hash.Set.union (Updater.operations ops) pendings
| Some operations -> Lwt.return operations | Some operations -> Lwt.return operations
@ -89,7 +92,8 @@ let forge_block cctxt block
begin begin
match priority with match priority with
| Some prio -> begin | Some prio -> begin
Client_proto_rpcs.Helpers.minimal_time cctxt block ~prio () >>=? fun time -> Client_proto_rpcs.Helpers.minimal_time
cctxt block ~prio () >>=? fun time ->
return (prio, Some time) return (prio, Some time)
end end
| None -> | None ->
@ -121,7 +125,8 @@ let forge_block cctxt block
return (Some timestamp) return (Some timestamp)
end >>=? fun timestamp -> end >>=? fun timestamp ->
let request = List.length operations in let request = List.length operations in
Client_node_rpcs.Blocks.preapply cctxt block ?timestamp ~sort operations >>=? Client_node_rpcs.Blocks.preapply
cctxt block ?timestamp ~sort operations >>=?
fun { operations ; fitness ; timestamp } -> fun { operations ; fitness ; timestamp } ->
let valid = List.length operations.applied in let valid = List.length operations.applied in
lwt_log_info "Found %d valid operations (%d refused) for timestamp %a" lwt_log_info "Found %d valid operations (%d refused) for timestamp %a"
@ -159,7 +164,10 @@ end = struct
let open Data_encoding in let open Data_encoding in
conv conv
(fun x -> LevelMap.bindings x) (fun x -> LevelMap.bindings x)
(fun l -> List.fold_left (fun x (y, z) -> LevelMap.add y z x) LevelMap.empty l) (fun l ->
List.fold_left
(fun x (y, z) -> LevelMap.add y z x)
LevelMap.empty l)
(list (obj2 (list (obj2
(req "level" Raw_level.encoding) (req "level" Raw_level.encoding)
(req "blocks" (list Block_hash.encoding)))) (req "blocks" (list Block_hash.encoding))))
@ -243,14 +251,17 @@ let get_mining_slot cctxt
Lwt.return (Some (Utils.filter_map convert slots))) Lwt.return (Some (Utils.filter_map convert slots)))
delegates >>= fun slots -> delegates >>= fun slots ->
let sorted_slots = let sorted_slots =
List.sort (fun (t1,_) (t2,_) -> Time.compare t1 t2) (List.flatten slots) in List.sort
(fun (t1,_) (t2,_) -> Time.compare t1 t2)
(List.flatten slots) in
match sorted_slots with match sorted_slots with
| [] -> Lwt.return None | [] -> Lwt.return None
| slot :: _ -> Lwt.return (Some slot) | slot :: _ -> Lwt.return (Some slot)
let rec insert_mining_slot slot = function let rec insert_mining_slot slot = function
| [] -> [slot] | [] -> [slot]
| ((timestamp,_) :: _) as slots when Time.(fst slot < timestamp) -> slot :: slots | ((timestamp,_) :: _) as slots when Time.(fst slot < timestamp) ->
slot :: slots
| slot' :: slots -> slot' :: insert_mining_slot slot slots | slot' :: slots -> slot' :: insert_mining_slot slot slots
type state = { type state = {
@ -271,7 +282,7 @@ let create_state genesis delegates best =
let drop_old_slots ~before state = let drop_old_slots ~before state =
state.future_slots <- state.future_slots <-
List.filter List.filter
(fun (t, slot) -> Time.compare t before < 0) (fun (t, _slot) -> Time.compare t before < 0)
state.future_slots state.future_slots
let compute_timeout { future_slots } = let compute_timeout { future_slots } =
@ -341,7 +352,8 @@ let insert_block
name name
Block_hash.pp_short bi.hash >>= fun () -> Block_hash.pp_short bi.hash >>= fun () ->
if Time.compare bi.timestamp state.best.timestamp = 0 then if Time.compare bi.timestamp state.best.timestamp = 0 then
drop_old_slots ~before: (Time.add state.best.timestamp (-1800L)) state ; drop_old_slots
~before:(Time.add state.best.timestamp (-1800L)) state ;
state.future_slots <- insert_mining_slot slot state.future_slots ; state.future_slots <- insert_mining_slot slot state.future_slots ;
Lwt.return_unit Lwt.return_unit
@ -431,13 +443,16 @@ let mine cctxt state =
lwt_debug "No valid candidates." >>= fun () -> lwt_debug "No valid candidates." >>= fun () ->
return () return ()
let create cctxt ?max_priority delegates let create
(block_stream: Client_mining_blocks.block_info list Lwt_stream.t) cctxt ?max_priority delegates
(endorsement_stream: Client_mining_operations.valid_endorsement Lwt_stream.t) = (block_stream:
Client_mining_blocks.block_info list Lwt_stream.t)
(endorsement_stream:
Client_mining_operations.valid_endorsement Lwt_stream.t) =
Lwt_stream.get block_stream >>= function Lwt_stream.get block_stream >>= function
| None | Some [] -> | None | Some [] ->
cctxt.Client_commands.error "Can't fetch the current block head." cctxt.Client_commands.error "Can't fetch the current block head."
| Some ({ Client_mining_blocks.fitness } as bi :: _ as initial_heads) -> | Some (bi :: _ as initial_heads) ->
Client_node_rpcs.Blocks.hash cctxt `Genesis >>= fun genesis_hash -> Client_node_rpcs.Blocks.hash cctxt `Genesis >>= fun genesis_hash ->
let last_get_block = ref None in let last_get_block = ref None in
let get_block () = let get_block () =