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

Proto: unit testing for the genesis protocol

Browse Source 
- Let the `sandbox` change the public key
- Adapt `test_basic.ml` and `test_basic.sh`
- Do not duplicate the fitness in the block header

Client:
- allow the `bootstrap` command to lookup keys in the `head` rather than
  in `genesis`.
This commit is contained in:
Grégoire Henry 2017-02-25 18:10:29 +01:00
parent 639b4c0c5c
commit 3c035da25c
14 changed files with 345 additions and 248 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/client/embedded/alpha/client_proto_context.ml
View File

@ -155,7 +155,8 @@ let commands () =
command ~group ~desc: "get the bootstrap keys and bootstrap contract handle"
(fixed [ "bootstrap" ])
(fun cctxt ->
Client_proto_rpcs.Constants.bootstrap cctxt `Genesis >>= fun accounts ->
let block = Client_config.block () in
Client_proto_rpcs.Constants.bootstrap cctxt block >>= fun accounts ->
let cpt = ref 0 in
Lwt_list.iter_s
(fun { Bootstrap.public_key_hash = pkh ;

25
src/client/embedded/genesis/client_proto_main.ml
View File

@ -18,21 +18,16 @@ let call_service1 cctxt s 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 =
let forge_block
cctxt block net_id ?(timestamp = Time.now ()) command fitness =
Client_blocks.get_block_hash cctxt block >>= fun pred ->
call_service1 cctxt
Services.Forge.block block
(net_id, pred_blk, (Time.now ()),
{ Types.Block.command ; hash ; fitness })
((net_id, pred, timestamp, fitness), command)
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 mine cctxt block command fitness seckey =
Client_blocks.get_block_info cctxt block >>= fun bi ->
forge_block cctxt block bi.net command 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 () ->
@ -63,7 +58,8 @@ let commands () =
stop
end
(fun hash fitness seckey cctxt ->
mine cctxt Activate hash fitness seckey >>= handle_error cctxt)
let block = Client_config.block () in
mine cctxt block (Activate hash) fitness seckey >>= handle_error cctxt)
;
command ~desc: "Fork a test protocol" begin
prefixes [ "fork" ; "test" ; "protocol" ] @@
@ -80,7 +76,8 @@ let commands () =
stop
end
(fun hash fitness seckey cctxt ->
mine cctxt Activate_testnet hash fitness seckey >>= handle_error cctxt) ;
let block = Client_config.block () in
mine cctxt block (Activate_testnet hash) fitness seckey >>= handle_error cctxt) ;
]
let () =

6
src/client/embedded/genesis/client_proto_main.mli
View File

@ -7,3 +7,9 @@
(* *)
(**************************************************************************)
val mine:
Client_commands.context ->
Client_node_rpcs.Blocks.block ->
Data.Command.t ->
int64 -> Sodium.secret Sodium.Sign.key -> unit tzresult Lwt.t

57
src/proto/alpha/constants_repr.ml
View File

@ -96,24 +96,22 @@ let constants_encoding =
opt Compare.Int64.(=)
default.proof_of_work_threshold c.proof_of_work_threshold
in
( cycle_length,
voting_period_length,
time_before_reward,
slot_durations,
first_free_mining_slot,
max_signing_slot,
instructions_per_transaction,
proof_of_work_threshold
) )
(fun ( cycle_length,
voting_period_length,
time_before_reward,
slot_durations,
first_free_mining_slot,
max_signing_slot,
instructions_per_transaction,
proof_of_work_threshold
) ->
(( cycle_length,
voting_period_length,
time_before_reward,
slot_durations,
first_free_mining_slot,
max_signing_slot,
instructions_per_transaction,
proof_of_work_threshold ), ()) )
(fun (( cycle_length,
voting_period_length,
time_before_reward,
slot_durations,
first_free_mining_slot,
max_signing_slot,
instructions_per_transaction,
proof_of_work_threshold ), ()) ->
{ cycle_length =
unopt default.cycle_length cycle_length ;
voting_period_length =
@ -133,17 +131,18 @@ let constants_encoding =
proof_of_work_threshold =
unopt default.proof_of_work_threshold proof_of_work_threshold ;
} )
Data_encoding.(
obj8
(opt "cycle_length" int32)
(opt "voting_period_length" int32)
(opt "time_before_reward" int64)
(opt "slot_durations" (list Period_repr.encoding))
(opt "first_free_mining_slot" int32)
(opt "max_signing_slot" int31)
(opt "instructions_per_transaction" int31)
(opt "proof_of_work_threshold" int64)
)
Data_encoding.(
merge_objs
(obj8
(opt "cycle_length" int32)
(opt "voting_period_length" int32)
(opt "time_before_reward" int64)
(opt "slot_durations" (list Period_repr.encoding))
(opt "first_free_mining_slot" int32)
(opt "max_signing_slot" int31)
(opt "instructions_per_transaction" int31)
(opt "proof_of_work_threshold" int64))
unit)
type error += Constant_read of exn

10
src/proto/alpha/init_storage.ml
View File

@ -19,10 +19,12 @@ let initialize ~from_genesis (ctxt:Context.t) =
Storage.prepare ctxt >>=? fun store ->
Storage.get_genesis_time store >>= fun time ->
Storage.Current_timestamp.init_set store time >>=? fun store ->
(if from_genesis then
return store
else
Fitness_storage.init store) >>=? fun store ->
begin
if from_genesis then
return store
else
Fitness_storage.init store
end >>=? fun store ->
Level_storage.init store >>=? fun store ->
Roll_storage.init store >>=? fun store ->
Nonce_storage.init store >>=? fun store ->

2
src/proto/genesis/TEZOS_PROTOCOL
View File

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

196
src/proto/genesis/data.ml Normal file
View File

@ -0,0 +1,196 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
module Command = struct
type t =
(* Activate a protocol *)
| Activate of Protocol_hash.t
(* Activate a protocol as a testnet *)
| Activate_testnet of Protocol_hash.t
let mk_case name args =
let open Data_encoding in
conv
(fun o -> ((), o))
(fun ((), o) -> o)
(merge_objs
(obj1 (req "network" (constant name)))
args)
let encoding =
let open Data_encoding in
union ~tag_size:`Uint8 [
case ~tag:0
(mk_case "activate"
(obj1 (req "hash" Protocol_hash.encoding)))
(function (Activate hash) -> Some hash | _ -> None)
(fun hash -> Activate hash) ;
case ~tag:1
(mk_case "activate_testnet"
(obj1 (req "hash" Protocol_hash.encoding)))
(function (Activate_testnet hash) -> Some hash | _ -> None)
(fun hash -> Activate_testnet hash) ;
]
let signed_encoding =
let open Data_encoding in
obj2
(req "content" encoding)
(req "signature" Ed25519.signature_encoding)
let forge shell command =
Data_encoding.Binary.to_bytes
(Data_encoding.tup2 Updater.shell_block_encoding encoding)
(shell, command)
end
module Fitness = struct
let fitness_key = ["v1";"store";"fitness"]
let get 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 ctxt v =
Context.set ctxt fitness_key @@
Data_encoding.Binary.to_bytes Data_encoding.int64 v
type error += Invalid_fitness
let int64_to_bytes i =
let b = MBytes.create 8 in
MBytes.set_int64 b 0 i;
b
let int64_of_bytes b =
if Compare.Int.(MBytes.length b <> 8) then
Error [Invalid_fitness]
else
Ok (MBytes.get_int64 b 0)
let version_number = "\000"
let from_int64 fitness =
[ MBytes.of_string version_number ;
int64_to_bytes fitness ]
let to_int64 = function
| [ version ;
fitness ]
when Compare.String.
(MBytes.to_string version = version_number) ->
int64_of_bytes fitness
| _ -> Error [Invalid_fitness]
end
module Pubkey = struct
let pubkey_key = ["genesis_key"]
let default =
let pubkey =
"4d5373455738070434f214826d301a1c206780d7f789fcbf94c2149b2e0718cc" in
Ed25519.public_key_of_bytes
(Bytes.of_string (Hex_encode.hex_decode pubkey))
let get_pubkey ctxt =
Context.get ctxt pubkey_key >>= function
| None -> Lwt.return default
| Some b ->
match Data_encoding.Binary.of_bytes Ed25519.public_key_encoding b with
| None -> Lwt.return default
| Some pk -> Lwt.return pk
let set_pubkey ctxt v =
Context.set ctxt pubkey_key @@
Data_encoding.Binary.to_bytes Ed25519.public_key_encoding v
let sandbox_encoding =
let open Data_encoding in
merge_objs
(obj1 (req "genesis_pubkey" Ed25519.public_key_encoding))
Data_encoding.unit
let may_change_default ctxt json =
match Data_encoding.Json.destruct sandbox_encoding json with
| exception _ ->
Lwt.return ctxt
| (pubkey, ()) ->
set_pubkey ctxt pubkey >>= fun ctxt ->
Lwt.return ctxt
end
module Init = struct
type error +=
| Incompatible_protocol_version
| Decreasing_fitness
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"
let may_initialize ctxt =
Context.get ctxt version_key >>= function
| None ->
Context.set
ctxt version_key (MBytes.of_string version_value) >>= fun ctxt ->
return ctxt
| Some bytes ->
let s = MBytes.to_string bytes in
fail_unless Compare.String.(s = version_value)
Incompatible_protocol_version >>=? fun () ->
return ctxt
let sandboxed_key = [ "v1" ; "sandboxed" ]
let set_sandboxed ctxt json =
Context.set ctxt sandboxed_key
(Data_encoding.Binary.to_bytes Data_encoding.json json)
let get_sandboxed ctxt =
Context.get ctxt sandboxed_key >>= fun b ->
match b with
| None -> return None
| Some b ->
return (Data_encoding.Binary.of_bytes Data_encoding.json b)
type error += Unimplemented_sandbox_migration
let configure_sandbox ctxt json =
let json =
match json with
| None -> `O []
| Some json -> json in
Context.get ctxt version_key >>= function
| None ->
set_sandboxed ctxt json >>= fun ctxt ->
Pubkey.may_change_default ctxt json >>= fun ctxt ->
return ctxt
| Some _ ->
get_sandboxed ctxt >>=? function
| None ->
fail Unimplemented_sandbox_migration
| Some _ ->
(* FIXME GRGR fail if parameter changed! *)
(* failwith "Changing sandbox parameter is not yet implemented" *)
return ctxt
end

40
src/proto/genesis/error.ml
View File

@ -1,40 +0,0 @@
(**************************************************************************)
(* *)
(* 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

137
src/proto/genesis/main.ml
View File

@ -7,88 +7,75 @@
(* *)
(**************************************************************************)
open Types
type error += Parsing_error
type error += Invalid_signature
module Init = struct
let () =
register_error_kind
`Permanent
~id:"parsing_error"
~title:"Parsing error"
~description:"Raised when a block header has not been parsed correctly"
~pp:(fun ppf () -> Format.fprintf ppf "Block header parsing error")
Data_encoding.empty
(function Parsing_error -> Some () | _ -> None)
(fun () -> Parsing_error)
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
let () =
register_error_kind
`Permanent
~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)
type operation = ()
let max_operation_data_length = 0
type block = Block.t
let max_block_length = 1024
let parse_operation _h _op = Error []
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
type block = {
shell: Updater.shell_block ;
fitness: Int64.t ;
command: Data.Command.t ;
signature: Ed25519.signature ;
}
let parse_operation _h _op = Ok ()
let max_block_length =
match Data_encoding.Binary.fixed_length Data.Command.signed_encoding with
| None -> assert false
| Some len -> len
let fitness _ctxt = Lwt.return_nil
let parse_block { Updater.shell ; proto } : block tzresult =
match Data_encoding.Binary.of_bytes Data.Command.signed_encoding proto with
| None -> Error [Parsing_error]
| Some (command, signature) ->
Data.Fitness.to_int64 shell.fitness >>? fun fitness ->
Ok { shell ; fitness ; command ; signature }
let apply ctxt { Block.command ; hash ; fitness } _ops =
Init.may_initialize ctxt fitness >>=? fun ctxt ->
match command with
| Activate ->
let check_signature ctxt { shell ; command ; signature } =
let bytes = Data.Command.forge shell command in
Data.Pubkey.get_pubkey ctxt >>= fun public_key ->
fail_unless
(Ed25519.check_signature public_key signature bytes)
Invalid_signature
let fitness ctxt =
Data.Fitness.get ctxt >>= fun fitness ->
Lwt.return (Data.Fitness.from_int64 fitness)
let apply ctxt header _ops =
check_signature ctxt header >>=? fun () ->
Data.Init.may_initialize ctxt >>=? fun ctxt ->
Data.Fitness.set ctxt header.fitness >>= fun ctxt ->
match header.command with
| Activate hash ->
Updater.activate ctxt hash >>= fun ctxt ->
return ctxt
| Activate_testnet ->
| Activate_testnet hash ->
Updater.set_test_protocol ctxt hash >>= fun ctxt ->
Updater.fork_test_network ctxt >>= fun ctxt ->
return ctxt
@ -96,11 +83,11 @@ let apply ctxt { Block.command ; hash ; fitness } _ops =
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 ;
})
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)
let configure_sandbox = Data.Init.configure_sandbox

25
src/proto/genesis/services.ml
View File

@ -7,8 +7,6 @@
(* *)
(**************************************************************************)
open Types
let error_encoding =
let open Data_encoding in
describe
@ -39,11 +37,13 @@ module Forge = struct
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))
(merge_objs
(obj4
(req "net_id" Updater.Net_id.encoding)
(req "predecessor" Block_hash.encoding)
(req "timestamp" Time.encoding)
(req "fitness" Data_encoding.int64))
Data.Command.encoding)
~output: (obj1 (req "payload" bytes))
RPC.Path.(custom_root / "helpers" / "forge" / "block")
end
@ -54,13 +54,10 @@ let rpc_services : Context.t RPC.directory =
RPC.register
dir
(Forge.block RPC.Path.root)
(fun _ctxt (net_id, predecessor, timestamp, block) ->
let fitness = Fitness.header_fitness block.fitness in
(fun _ctxt ((net_id, predecessor, timestamp, fitness), command) ->
let fitness = Data.Fitness.from_int64 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
let bytes = Data.Command.forge shell command in
RPC.Answer.return bytes) in
dir

67
src/proto/genesis/types.ml
View File

@ -1,67 +0,0 @@
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

2
test/sandbox.json
View File

@ -1,4 +1,6 @@
{
"genesis_pubkey":
"edpkuSLWfVU1Vq7Jg9FucPyKmma6otcMHac9zG4oU1KMHSTBpJuGQ2",
"slot_durations" : [ 10 ; 5 ],
"cycle_length" : 128,
"first_free_mining_slot" : 4

6
test/test-basic.sh
View File

@ -24,6 +24,12 @@ NODE_PID="$!"
sleep 3
${CLIENT} list versions
${CLIENT} activate \
protocol ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK \
with fitness 1 \
and key edskRhxswacLW6jF6ULavDdzwqnKJVS4UcDTNiCyiH6H8ZNnn2pmNviL7pRNz9kRxxaWQFzEQEcZExGHKbwmuaAcoMegj5T99z
${CLIENT} bootstrap
KEY1=foo

17
test/test_basic.ml
View File

@ -14,7 +14,8 @@ open Error_monad
open Hash
let () =
Random.self_init ()
Random.self_init () ;
Unix.chdir (Filename.dirname Sys.executable_name)
let cctxt =
let log channel msg = match channel with
@ -76,8 +77,17 @@ type account = {
contract : Contract.t ;
}
let genesis_sk =
Environment.Ed25519.secret_key_of_b58check
"edskRhxswacLW6jF6ULavDdzwqnKJVS4UcDTNiCyiH6H8ZNnn2pmNviL7pRNz9kRxxaWQFzEQEcZExGHKbwmuaAcoMegj5T99z"
let switch_protocol () =
Client_genesis.Client_proto_main.mine cctxt `Genesis
(Activate Client_alpha.Client_proto_main.protocol)
0L genesis_sk
let bootstrap_accounts () =
Client_proto_rpcs.Constants.bootstrap cctxt `Genesis
Client_proto_rpcs.Constants.bootstrap cctxt (`Head 0)
>>= fun accounts ->
let cpt = ref 0 in
Lwt.return
@ -133,12 +143,13 @@ let mine contract =
return ()
let ecoproto_error f = function
| Register_client_embedded_proto_bootstrap.Ecoproto_error errors ->
| Register_client_embedded_proto_alpha.Ecoproto_error errors ->
List.exists f errors
| _ -> false
let main () =
fork_node () ;
switch_protocol () >>=? fun () ->
bootstrap_accounts () >>= fun bootstrap_accounts ->
let bootstrap = List.hd bootstrap_accounts in
create_account "foo" >>= fun foo ->