diff --git a/buildkite/src/Constants/ContainerImages.dhall b/buildkite/src/Constants/ContainerImages.dhall index 4ef6acd6a59..bfca4e42267 100644 --- a/buildkite/src/Constants/ContainerImages.dhall +++ b/buildkite/src/Constants/ContainerImages.dhall @@ -2,10 +2,10 @@ -- NOTE: minaToolchainStretch is also used for building Ubuntu Bionic packages in CI { toolchainBase = "codaprotocol/ci-toolchain-base:v3", - minaToolchainBullseye = "gcr.io/o1labs-192920/mina-toolchain@sha256:88bc6b7fdae563998c88849f8c5133f3dec51dd800f5ea7c6002bc92f7081510", - minaToolchainBuster = "gcr.io/o1labs-192920/mina-toolchain@sha256:c40016dc90b2293b5ec12e24aeea38e19806844bbf5c25661dcdb4049ccb71f7", - minaToolchainStretch = "gcr.io/o1labs-192920/mina-toolchain@sha256:8ce948d43b35ec5559cd0a389ed7e602b8bfc88c598b97b68fca16d586bc93c2", - minaToolchainFocal = "gcr.io/o1labs-192920/mina-toolchain@sha256:0ab44a74ff4331aeb84a352b5d5f4ab7fcc10ebfeb1eba9259201435b1cc7860", + minaToolchainBullseye = "gcr.io/o1labs-192920/mina-toolchain@sha256:1b901f35d726af1e30fba4a1492b11f8bab87c8627f8f56e264fd119d7840425", + minaToolchainBuster = "gcr.io/o1labs-192920/mina-toolchain@sha256:d4a56f985616507ff85ce93779c7b24c4927ae963ac1133e5248065c5d742870", + minaToolchainStretch = "gcr.io/o1labs-192920/mina-toolchain@sha256:c10913d9a48ad9b3c729fb4a53874e5583bf9c17b0d9a34510cbd2526b81f12c", + minaToolchainFocal = "gcr.io/o1labs-192920/mina-toolchain@sha256:e3bf51b67b00b0e4d700ae95492437790e4f8651b7077dd244115bf9312f9561", delegationBackendToolchain = "gcr.io/o1labs-192920/delegation-backend-production@sha256:8ca5880845514ef56a36bf766a0f9de96e6200d61b51f80d9f684a0ec9c031f4", elixirToolchain = "elixir:1.10-alpine", nodeToolchain = "node:14.13.1-stretch-slim", diff --git a/docs/access-testnet-nodes-graphql.md b/docs/access-testnet-nodes-graphql.md new file mode 100644 index 00000000000..ac5ca2801f7 --- /dev/null +++ b/docs/access-testnet-nodes-graphql.md @@ -0,0 +1,44 @@ +# Local access to testnet nodes via GraphQL + +# Prerequisites +* Install [`gcloud` SDK](https://cloud.google.com/sdk/docs/install-sdk). +* Install `kubectl` by running `gcloud components install kubectl`. +* Log-in using the [`gcloud auth + login`](https://cloud.google.com/sdk/gcloud/reference/auth/login) command + with your O(1) Labs email. + +# Get the credentials for the region running the nodes + +Retrieve the credentials for the region that the nodes are running in, using +[`gcloud container +clusters`](https://cloud.google.com/sdk/gcloud/reference/container/clusters/get-credentials). +For example: +``` +gcloud container clusters get-credentials coda-infra-central1 --region us-central1 --project o1labs-192920 +``` + +# Discover nodes in the testnet's namespace + +If you do not have a particular node in mind, you can list all of the available +nodes in a namespace using `kubectl get pods`. For example, to list the nodes +on the berkeley QA net: +``` +kubectl -n berkeley get pods +``` + +# Forward a local port to a node + +Use the `kubectl port-forward` command to forward a local port. For example, +``` +kubectl port-forward -n berkeley seed-1-XXXXXXXXX-XXXXX 4040:3085 +``` +will forward http://localhost:4040 to port 3085 on `seed-1-XXXXXXXXX-XXXXX` in +the berkeley namespace. + +# Running a bash command on the node + +Use the `kubectl exec` command to run a command on the testnet node. For example, +``` +kubectl exec seed-1-XXXXXXXXX-XXXXX --namespace berkeley -c mina -- ls +``` +will run `ls` on `seed-1-XXXXXXXXX-XXXXX` in the berkeley namespace. diff --git a/dune-project b/dune-project index 45acd3f0884..cda95fed59f 100644 --- a/dune-project +++ b/dune-project @@ -1 +1 @@ -(lang dune 2.7) +(lang dune 3.1) diff --git a/src/.ocamlformat b/src/.ocamlformat index 9a9f9a6031c..1b2264a8390 100644 --- a/src/.ocamlformat +++ b/src/.ocamlformat @@ -4,9 +4,7 @@ max-iters=10 comment-check=true wrap-fun-args=true wrap-comments=false -type-decl-indent=2 type-decl=compact -stritem-extension-indent=0 space-around-variants=true space-around-records=true space-around-lists=true @@ -15,52 +13,34 @@ single-case=compact sequence-style=separator sequence-blank-line=preserve-one parse-docstrings=false -parens-tuple-patterns=multi-line-only parens-tuple=always parens-ite=false ocp-indent-compat=false -nested-match=wrap module-item-spacing=sparse max-indent=68 -match-indent-nested=never -match-indent=0 margin=80 -let-open=preserve let-module=compact let-binding-spacing=compact -let-binding-indent=2 let-and=compact leading-nested-match-parens=false infix-precedence=indent indicate-nested-or-patterns=space indicate-multiline-delimiters=space -indent-after-in=0 if-then-else=compact -function-indent-nested=never -function-indent=2 field-space=loose -extension-indent=2 exp-grouping=parens dock-collection-brackets=false doc-comments-tag-only=default doc-comments-padding=2 doc-comments=before -disambiguate-non-breaking-match=false disable=false cases-matching-exp-indent=normal cases-exp-indent=4 -break-struct=force -break-string-literals=auto break-sequences=false break-separators=before break-infix-before-func=true break-infix=wrap break-fun-sig=wrap break-fun-decl=wrap -break-collection-expressions=fit-or-vertical break-cases=nested -break-before-in=fit-or-vertical assignment-operator=end-line -align-variants-decl=false -align-constructors-decl=false -align-cases=false diff --git a/src/app/archive/archive_lib/diff.ml b/src/app/archive/archive_lib/diff.ml index 2a350cbe36f..e0908afa46c 100644 --- a/src/app/archive/archive_lib/diff.ml +++ b/src/app/archive/archive_lib/diff.ml @@ -54,7 +54,7 @@ module Builder = struct let senders = commands |> List.map ~f:(fun { data; _ } -> - User_command.(fee_payer (forget_check data))) + User_command.(fee_payer (forget_check data)) ) |> Account_id.Set.of_list in Set.to_list senders @@ -67,7 +67,7 @@ module Builder = struct let%map { receipt_chain_hash; _ } = Mina_ledger.Ledger.get ledger ledger_location in - (sender, receipt_chain_hash))) + (sender, receipt_chain_hash)) ) in let block_with_hash = Mina_block.Validated.forget validated_block in let block = With_hash.data block_with_hash in @@ -77,10 +77,10 @@ module Builder = struct (* an accessed account may not be the ledger *) let%bind.Option index = Option.try_with (fun () -> - Mina_ledger.Ledger.index_of_account_exn ledger acct_id) + Mina_ledger.Ledger.index_of_account_exn ledger acct_id ) in let account = Mina_ledger.Ledger.get_at_index_exn ledger index in - Some (index, account)) + Some (index, account) ) in let accounts_created = let account_creation_fee = @@ -92,8 +92,8 @@ module Builder = struct in List.map (Staged_ledger.latest_block_accounts_created staged_ledger - ~previous_block_state_hash) ~f:(fun acct_id -> - (acct_id, account_creation_fee)) + ~previous_block_state_hash ) ~f:(fun acct_id -> + (acct_id, account_creation_fee) ) in Transition_frontier.Breadcrumb_added { block = With_hash.map ~f:External_transition.compose block_with_hash diff --git a/src/app/archive/archive_lib/load_data.ml b/src/app/archive/archive_lib/load_data.ml index c105bcbb6c4..8da778b590c 100644 --- a/src/app/archive/archive_lib/load_data.ml +++ b/src/app/archive/archive_lib/load_data.ml @@ -7,7 +7,7 @@ open Mina_base let pk_of_id pool pk_id = let%map pk_str = Mina_caqti.query pool ~f:(fun db -> - Processor.Public_key.find_by_id db pk_id) + Processor.Public_key.find_by_id db pk_id ) in Signature_lib.Public_key.Compressed.of_base58_check_exn pk_str @@ -20,7 +20,7 @@ let token_of_id pool token_id = let account_identifier_of_id pool account_identifier_id = let%bind { public_key_id; token_id } = Mina_caqti.query pool ~f:(fun db -> - Processor.Account_identifiers.load db account_identifier_id) + Processor.Account_identifiers.load db account_identifier_id ) in let%bind pk = pk_of_id pool public_key_id in let%map token = token_of_id pool token_id in @@ -34,7 +34,7 @@ let get_amount_bounds pool amount_id = let%map amount = query_db ~f:(fun db -> Processor.Zkapp_amount_bounds.load db id) in - Some amount) + Some amount ) in let amount_opt = Option.map amount_db_opt @@ -48,7 +48,7 @@ let get_amount_bounds pool amount_id = |> Currency.Amount.of_uint64 in ( { lower; upper } - : Currency.Amount.t Zkapp_precondition.Closed_interval.t )) + : Currency.Amount.t Zkapp_precondition.Closed_interval.t ) ) in Or_ignore.of_option amount_opt @@ -66,7 +66,7 @@ let get_global_slot_bounds pool id = in let lower = slot_of_int64 bounds.global_slot_lower_bound in let upper = slot_of_int64 bounds.global_slot_upper_bound in - Some ({ lower; upper } : _ Zkapp_precondition.Closed_interval.t)) + Some ({ lower; upper } : _ Zkapp_precondition.Closed_interval.t) ) in Or_ignore.of_option bounds_opt @@ -78,14 +78,14 @@ let get_length_bounds pool id = let%map ts = query_db ~f:(fun db -> Processor.Zkapp_length_bounds.load db id) in - Some ts) + Some ts ) in let bl_opt = Option.map bl_db_opt ~f:(fun { length_lower_bound; length_upper_bound } -> let lower = Unsigned.UInt32.of_int64 length_lower_bound in let upper = Unsigned.UInt32.of_int64 length_upper_bound in ( { lower; upper } - : Unsigned.UInt32.t Zkapp_precondition.Closed_interval.t )) + : Unsigned.UInt32.t Zkapp_precondition.Closed_interval.t ) ) in Or_ignore.of_option bl_opt @@ -120,12 +120,12 @@ let update_of_id pool update_id = let%map field = query_db ~f:(fun db -> Processor.Zkapp_state_data.load db id) in - Some field)) + Some field ) ) in let fields = List.map field_strs ~f:(fun str_opt -> Option.value_map str_opt ~default:Set_or_keep.Keep ~f:(fun str -> - Set_or_keep.Set (F.of_string str))) + Set_or_keep.Set (F.of_string str) ) ) in Zkapp_state.V.of_list_exn fields in @@ -143,7 +143,7 @@ let update_of_id pool update_id = let%map vk = query_db ~f:(fun db -> Processor.Zkapp_verification_keys.load db id) in - Some vk) + Some vk ) in Set_or_keep.of_option (Option.map vk_opt ~f:(fun { verification_key; hash } -> @@ -157,7 +157,8 @@ let update_of_id pool update_id = let hash = Pickles.Backend.Tick.Field.of_string hash in { With_hash.data; hash } | Error (`Msg err) -> - failwithf "Could not Base64-decode verification key: %s" err ())) + failwithf "Could not Base64-decode verification key: %s" err () ) + ) in let%bind permissions = let%map perms_opt = @@ -190,7 +191,7 @@ let update_of_id pool update_id = ; increment_nonce ; set_voting_for } - : Permissions.t )) + : Permissions.t ) ) in Set_or_keep.of_option perms_opt in @@ -240,7 +241,7 @@ let update_of_id pool update_id = ; vesting_period ; vesting_increment } - : Party.Update.Timing_info.t )) + : Party.Update.Timing_info.t ) ) in Set_or_keep.of_option tm_opt in @@ -279,7 +280,7 @@ let staking_data_of_id pool id = let%bind ledger = let%bind { hash_id; total_currency_id } = query_db ~f:(fun db -> - Processor.Zkapp_epoch_ledger.load db epoch_ledger_id) + Processor.Zkapp_epoch_ledger.load db epoch_ledger_id ) in let%bind hash = let%map hash_opt = @@ -287,7 +288,7 @@ let staking_data_of_id pool id = let%map hash_str = query_db ~f:(fun db -> Processor.Snarked_ledger_hash.load db id) in - Some (Frozen_ledger_hash.of_base58_check_exn hash_str)) + Some (Frozen_ledger_hash.of_base58_check_exn hash_str) ) in Or_ignore.of_option hash_opt in @@ -327,9 +328,9 @@ let protocol_state_precondition_of_id pool id = ; staking_epoch_data_id ; next_epoch_data_id } - : Processor.Zkapp_protocol_state_precondition.t) = + : Processor.Zkapp_protocol_state_precondition.t ) = query_db ~f:(fun db -> - Processor.Zkapp_protocol_state_precondition.load db id) + Processor.Zkapp_protocol_state_precondition.load db id ) in let%bind snarked_ledger_hash = let%map hash_opt = @@ -338,7 +339,7 @@ let protocol_state_precondition_of_id pool id = let%map hash = query_db ~f:(fun db -> Processor.Snarked_ledger_hash.load db id) in - Some (Frozen_ledger_hash.of_base58_check_exn hash)) + Some (Frozen_ledger_hash.of_base58_check_exn hash) ) in Or_ignore.of_option hash_opt in @@ -348,14 +349,14 @@ let protocol_state_precondition_of_id pool id = let%map ts = query_db ~f:(fun db -> Processor.Zkapp_timestamp_bounds.load db id) in - Some ts) + Some ts ) in let ts_opt = Option.map ts_db_opt ~f:(fun { timestamp_lower_bound; timestamp_upper_bound } -> let lower = Block_time.of_int64 timestamp_lower_bound in let upper = Block_time.of_int64 timestamp_upper_bound in - ({ lower; upper } : Block_time.t Zkapp_precondition.Closed_interval.t)) + ({ lower; upper } : Block_time.t Zkapp_precondition.Closed_interval.t) ) in Or_ignore.of_option ts_opt in @@ -393,14 +394,14 @@ let load_events pool id = Deferred.List.map (Array.to_list field_array_ids) ~f:(fun array_id -> let%bind field_ids = query_db ~f:(fun db -> - Processor.Zkapp_state_data_array.load db array_id) + Processor.Zkapp_state_data_array.load db array_id ) in Deferred.List.map (Array.to_list field_ids) ~f:(fun field_id -> let%map field_str = query_db ~f:(fun db -> - Processor.Zkapp_state_data.load db field_id) + Processor.Zkapp_state_data.load db field_id ) in - Zkapp_basic.F.of_string field_str)) + Zkapp_basic.F.of_string field_str ) ) in List.map fields_list ~f:Array.of_list @@ -487,10 +488,10 @@ let get_other_party_body ~pool body_id = in let%bind account_precondition = let%bind ({ kind; precondition_account_id; nonce } - : Processor.Zkapp_account_precondition.t) = + : Processor.Zkapp_account_precondition.t ) = query_db ~f:(fun db -> Processor.Zkapp_account_precondition.load db - zkapp_account_precondition_id) + zkapp_account_precondition_id ) in match kind with | Nonce -> @@ -514,14 +515,14 @@ let get_other_party_body ~pool body_id = } = query_db ~f:(fun db -> Processor.Zkapp_precondition_account.load db - (Option.value_exn precondition_account_id)) + (Option.value_exn precondition_account_id) ) in let%bind balance = let%map balance_opt = Option.value_map balance_id ~default:(return None) ~f:(fun id -> let%map { balance_lower_bound; balance_upper_bound } = query_db ~f:(fun db -> - Processor.Zkapp_balance_bounds.load db id) + Processor.Zkapp_balance_bounds.load db id ) in let balance_of_int64 int64 = int64 |> Unsigned.UInt64.of_int64 @@ -529,7 +530,7 @@ let get_other_party_body ~pool body_id = in let lower = balance_of_int64 balance_lower_bound in let upper = balance_of_int64 balance_upper_bound in - Some ({ lower; upper } : _ Zkapp_precondition.Closed_interval.t)) + Some ({ lower; upper } : _ Zkapp_precondition.Closed_interval.t) ) in Or_ignore.of_option balance_opt in @@ -538,7 +539,7 @@ let get_other_party_body ~pool body_id = Option.value_map nonce_id ~default:(return None) ~f:(fun id -> let%map { nonce_lower_bound; nonce_upper_bound } = query_db ~f:(fun db -> - Processor.Zkapp_nonce_bounds.load db id) + Processor.Zkapp_nonce_bounds.load db id ) in let balance_of_int64 int64 = int64 |> Unsigned.UInt32.of_int64 @@ -546,7 +547,7 @@ let get_other_party_body ~pool body_id = in let lower = balance_of_int64 nonce_lower_bound in let upper = balance_of_int64 nonce_upper_bound in - Some ({ lower; upper } : _ Zkapp_precondition.Closed_interval.t)) + Some ({ lower; upper } : _ Zkapp_precondition.Closed_interval.t) ) in Or_ignore.of_option nonce_opt in @@ -559,7 +560,7 @@ let get_other_party_body ~pool body_id = let%map pk_opt = Option.value_map id ~default:(return None) ~f:(fun id -> let%map pk = pk_of_id id in - Some pk) + Some pk ) in Or_ignore.of_option pk_opt in @@ -573,9 +574,9 @@ let get_other_party_body ~pool body_id = Option.value_map id_opt ~default:(return None) ~f:(fun id -> let%map field_str = query_db ~f:(fun db -> - Processor.Zkapp_state_data.load db id) + Processor.Zkapp_state_data.load db id ) in - Some (Zkapp_basic.F.of_string field_str))) + Some (Zkapp_basic.F.of_string field_str) ) ) in List.map fields ~f:Or_ignore.of_option |> Zkapp_state.V.of_list_exn in @@ -586,7 +587,7 @@ let get_other_party_body ~pool body_id = let%map field_str = query_db ~f:(fun db -> Processor.Zkapp_state_data.load db id) in - Some (Zkapp_basic.F.of_string field_str)) + Some (Zkapp_basic.F.of_string field_str) ) in Or_ignore.of_option sequence_state_opt in @@ -600,7 +601,7 @@ let get_other_party_body ~pool body_id = ; state ; sequence_state ; proved_state - }) + } ) in let caller = Party.Call_type.of_string caller in return @@ -644,12 +645,12 @@ let get_account_accessed ~pool (account : Processor.Accounts_accessed.t) : ; permissions_id ; zkapp_id } - : Processor.Accounts_accessed.t) = + : Processor.Accounts_accessed.t ) = account in let%bind ({ public_key_id; token_id } : Processor.Account_identifiers.t) = query_db ~f:(fun db -> - Processor.Account_identifiers.load db account_identifier_id) + Processor.Account_identifiers.load db account_identifier_id ) in let%bind public_key = pk_of_id public_key_id in let%bind token_id = token_of_id token_id in @@ -691,7 +692,7 @@ let get_account_accessed ~pool (account : Processor.Accounts_accessed.t) : ; vesting_increment ; _ } - : Processor.Timing_info.t) = + : Processor.Timing_info.t ) = timing in if @@ -787,7 +788,7 @@ let get_account_accessed ~pool (account : Processor.Accounts_accessed.t) : let%map field_strs = Deferred.List.init (Array.length app_state_ints) ~f:(fun ndx -> let id = Option.value_exn app_state_ints.(ndx) in - query_db ~f:(fun db -> Processor.Zkapp_state_data.load db id)) + query_db ~f:(fun db -> Processor.Zkapp_state_data.load db id) ) in let fields = List.map field_strs ~f:Zkapp_basic.F.of_string in Zkapp_state.V.of_list_exn fields @@ -797,7 +798,7 @@ let get_account_accessed ~pool (account : Processor.Accounts_accessed.t) : ~f:(fun id -> let%map { verification_key; hash } = query_db ~f:(fun db -> - Processor.Zkapp_verification_keys.load db id) + Processor.Zkapp_verification_keys.load db id ) in let data = match Base64.decode verification_key with @@ -810,7 +811,7 @@ let get_account_accessed ~pool (account : Processor.Accounts_accessed.t) : () in let hash = Zkapp_basic.F.of_string hash in - Some ({ data; hash } : _ With_hash.t)) + Some ({ data; hash } : _ With_hash.t) ) in let zkapp_version = zkapp_version |> Unsigned.UInt32.of_int64 @@ -818,13 +819,13 @@ let get_account_accessed ~pool (account : Processor.Accounts_accessed.t) : in let%bind sequence_state_ints = query_db ~f:(fun db -> - Processor.Zkapp_sequence_states.load db sequence_state_id) + Processor.Zkapp_sequence_states.load db sequence_state_id ) in let%map sequence_state = let%map field_strs = Deferred.List.init (Array.length sequence_state_ints) ~f:(fun ndx -> let id = Option.value_exn app_state_ints.(ndx) in - query_db ~f:(fun db -> Processor.Zkapp_state_data.load db id)) + query_db ~f:(fun db -> Processor.Zkapp_state_data.load db id) ) in let fields = List.map field_strs ~f:Zkapp_basic.F.of_string in Pickles_types.Vector.Vector_5.of_list_exn fields @@ -841,13 +842,13 @@ let get_account_accessed ~pool (account : Processor.Accounts_accessed.t) : ; last_sequence_slot ; proved_state } - : Mina_base.Zkapp_account.t )) + : Mina_base.Zkapp_account.t ) ) in (* TODO: the URI will be moved to the zkApp, no longer in the account *) let%bind zkapp_uri = Option.value_map zkapp_db ~default:(return "https://dummy.com") ~f:(fun zkapp -> - query_db ~f:(fun db -> Processor.Zkapp_uri.load db zkapp.zkapp_uri_id)) + query_db ~f:(fun db -> Processor.Zkapp_uri.load db zkapp.zkapp_uri_id) ) in (* TODO: token permissions is going away *) let account = diff --git a/src/app/archive/archive_lib/metrics.ml b/src/app/archive/archive_lib/metrics.ml index e4b62a086ea..c69e1805d1d 100644 --- a/src/app/archive/archive_lib/metrics.ml +++ b/src/app/archive/archive_lib/metrics.ml @@ -24,7 +24,7 @@ module Max_block_height = struct Mina_metrics.( Gauge.set (Archive.max_block_height metric_server) - (Float.of_int max_height))) + (Float.of_int max_height)) ) end module Missing_blocks = struct @@ -38,7 +38,7 @@ module Missing_blocks = struct LEFT JOIN blocks b ON h = b.height WHERE b.height IS NULL) as v |sql} - missing_blocks_width) + missing_blocks_width ) let update ~missing_blocks_width (module Conn : Caqti_async.CONNECTION) metric_server = @@ -48,7 +48,7 @@ module Missing_blocks = struct Mina_metrics.( Gauge.set (Archive.missing_blocks metric_server) - (Float.of_int missing_blocks))) + (Float.of_int missing_blocks)) ) end module Unparented_blocks = struct @@ -68,19 +68,19 @@ module Unparented_blocks = struct Mina_metrics.( Gauge.set (Archive.unparented_blocks metric_server) - (Float.of_int unparented_block_count))) + (Float.of_int unparented_block_count)) ) end let log_error ~logger pool metric_server (f : (module Caqti_async.CONNECTION) -> Mina_metrics.Archive.t - -> (unit, [> Caqti_error.call_or_retrieve ]) Deferred.Result.t) = + -> (unit, [> Caqti_error.call_or_retrieve ]) Deferred.Result.t ) = let open Deferred.Let_syntax in match%map Caqti_async.Pool.use (fun (module Conn : Caqti_async.CONNECTION) -> - f (module Conn) metric_server) + f (module Conn) metric_server ) pool with | Ok () -> @@ -96,4 +96,4 @@ let update ~logger ~missing_blocks_width pool metric_server = [ Max_block_height.update ; Unparented_blocks.update ; Missing_blocks.update ~missing_blocks_width - ]) + ] ) diff --git a/src/app/archive/archive_lib/processor.ml b/src/app/archive/archive_lib/processor.ml index 39ec6636478..c35048c8e6a 100644 --- a/src/app/archive/archive_lib/processor.ml +++ b/src/app/archive/archive_lib/processor.ml @@ -21,20 +21,20 @@ module Public_key = struct let public_key = Public_key.Compressed.to_base58_check t in Conn.find (Caqti_request.find Caqti_type.string Caqti_type.int - "SELECT id FROM public_keys WHERE value = ?") + "SELECT id FROM public_keys WHERE value = ?" ) public_key let find_opt (module Conn : CONNECTION) (t : Public_key.Compressed.t) = let public_key = Public_key.Compressed.to_base58_check t in Conn.find_opt (Caqti_request.find_opt Caqti_type.string Caqti_type.int - "SELECT id FROM public_keys WHERE value = ?") + "SELECT id FROM public_keys WHERE value = ?" ) public_key let find_by_id (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int Caqti_type.string - "SELECT value FROM public_keys WHERE id = ?") + "SELECT value FROM public_keys WHERE id = ?" ) id let add_if_doesn't_exist (module Conn : CONNECTION) @@ -47,7 +47,7 @@ module Public_key = struct let public_key = Public_key.Compressed.to_base58_check t in Conn.find (Caqti_request.find Caqti_type.string Caqti_type.int - "INSERT INTO public_keys (value) VALUES (?) RETURNING id") + "INSERT INTO public_keys (value) VALUES (?) RETURNING id" ) public_key end @@ -68,13 +68,13 @@ module Token = struct let find_by_id (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id let make_finder conn_finder req_finder token_id = conn_finder (req_finder Caqti_type.string Caqti_type.int - (Mina_caqti.select_cols ~table_name ~select:"id" ~cols:[ "value" ] ())) + (Mina_caqti.select_cols ~table_name ~select:"id" ~cols:[ "value" ] ()) ) (Token_id.to_string token_id) let find (module Conn : CONNECTION) = make_finder Conn.find Caqti_request.find @@ -132,7 +132,7 @@ module Voting_for = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int Caqti_type.string - (Mina_caqti.select_cols_from_id ~table_name ~cols:[ "value" ])) + (Mina_caqti.select_cols_from_id ~table_name ~cols:[ "value" ]) ) id end @@ -153,7 +153,7 @@ module Token_symbols = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int Caqti_type.string - (Mina_caqti.select_cols_from_id ~table_name ~cols:[ "value" ])) + (Mina_caqti.select_cols_from_id ~table_name ~cols:[ "value" ]) ) id end @@ -198,7 +198,7 @@ module Account_identifiers = struct Caqti_type.(tup2 int int) Caqti_type.int (Mina_caqti.select_cols ~select:"id" ~table_name - ~cols:Fields.names ())) + ~cols:Fields.names () ) ) (pk_id, tok_id) ) let find (module Conn : CONNECTION) account_id = @@ -211,13 +211,13 @@ module Account_identifiers = struct (Caqti_request.find Caqti_type.(tup2 int int) Caqti_type.int - (Mina_caqti.select_cols ~select:"id" ~table_name ~cols:Fields.names ())) + (Mina_caqti.select_cols ~select:"id" ~table_name ~cols:Fields.names ()) ) (public_key_id, token_id) let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id end @@ -235,7 +235,7 @@ module Zkapp_state_data = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int Caqti_type.string - (Mina_caqti.select_cols_from_id ~table_name ~cols:[ "field" ])) + (Mina_caqti.select_cols_from_id ~table_name ~cols:[ "field" ]) ) id end @@ -260,7 +260,7 @@ module Zkapp_state_data_array = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int Mina_caqti.array_int_typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:[ "element_ids" ])) + (Mina_caqti.select_cols_from_id ~table_name ~cols:[ "element_ids" ]) ) id end @@ -287,7 +287,7 @@ module Zkapp_states = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int Mina_caqti.array_nullable_int_typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:[ "element_ids" ])) + (Mina_caqti.select_cols_from_id ~table_name ~cols:[ "element_ids" ]) ) id end @@ -299,7 +299,7 @@ module Zkapp_sequence_states = struct let open Deferred.Result.Let_syntax in let%bind (element_ids : int array) = Mina_caqti.deferred_result_list_map (Vector.to_list fps) ~f:(fun field -> - Zkapp_state_data.add_if_doesn't_exist (module Conn) field) + Zkapp_state_data.add_if_doesn't_exist (module Conn) field ) >>| Array.of_list in Mina_caqti.select_insert_into_cols ~select:("id", Caqti_type.int) @@ -312,7 +312,7 @@ module Zkapp_sequence_states = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int Mina_caqti.array_int_typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:[ "element_ids" ])) + (Mina_caqti.select_cols_from_id ~table_name ~cols:[ "element_ids" ]) ) id end @@ -330,7 +330,7 @@ module Zkapp_verification_keys = struct (vk : ( Pickles.Side_loaded.Verification_key.t , Pickles.Backend.Tick.Field.t ) - With_hash.t) = + With_hash.t ) = let verification_key = Binable.to_string (module Pickles.Side_loaded.Verification_key.Stable.Latest) @@ -347,7 +347,7 @@ module Zkapp_verification_keys = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id end @@ -436,7 +436,7 @@ module Zkapp_permissions = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id end @@ -490,7 +490,7 @@ module Zkapp_timing_info = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id end @@ -511,7 +511,7 @@ module Zkapp_uri = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int Caqti_type.string - (Mina_caqti.select_cols_from_id ~table_name ~cols:[ "value" ])) + (Mina_caqti.select_cols_from_id ~table_name ~cols:[ "value" ]) ) id end @@ -604,7 +604,7 @@ module Zkapp_updates = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id end @@ -620,7 +620,7 @@ module Zkapp_balance_bounds = struct let add_if_doesn't_exist (module Conn : CONNECTION) (balance_bounds : - Currency.Balance.t Mina_base.Zkapp_precondition.Closed_interval.t) = + Currency.Balance.t Mina_base.Zkapp_precondition.Closed_interval.t ) = let balance_lower_bound = balance_bounds.lower |> Currency.Balance.to_uint64 |> Unsigned.UInt64.to_int64 @@ -638,7 +638,7 @@ module Zkapp_balance_bounds = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id end @@ -655,7 +655,7 @@ module Zkapp_nonce_bounds = struct let add_if_doesn't_exist (module Conn : CONNECTION) (nonce_bounds : Mina_numbers.Account_nonce.t - Mina_base.Zkapp_precondition.Closed_interval.t) = + Mina_base.Zkapp_precondition.Closed_interval.t ) = let nonce_lower_bound = Unsigned.UInt32.to_int64 nonce_bounds.lower in let nonce_upper_bound = Unsigned.UInt32.to_int64 nonce_bounds.upper in let value = { nonce_lower_bound; nonce_upper_bound } in @@ -667,7 +667,7 @@ module Zkapp_nonce_bounds = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id end @@ -747,7 +747,7 @@ module Zkapp_precondition_account = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id end @@ -814,7 +814,7 @@ module Zkapp_account_precondition = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id end @@ -830,7 +830,7 @@ module Zkapp_token_id_bounds = struct let add_if_doesn't_exist (module Conn : CONNECTION) (token_id_bounds : - Token_id.t Mina_base.Zkapp_precondition.Closed_interval.t) = + Token_id.t Mina_base.Zkapp_precondition.Closed_interval.t ) = let token_id_lower_bound = token_id_bounds.lower |> Token_id.to_string in let token_id_upper_bound = token_id_bounds.upper |> Token_id.to_string in let value = { token_id_lower_bound; token_id_upper_bound } in @@ -842,7 +842,7 @@ module Zkapp_token_id_bounds = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id end @@ -858,7 +858,7 @@ module Zkapp_timestamp_bounds = struct let add_if_doesn't_exist (module Conn : CONNECTION) (timestamp_bounds : - Block_time.t Mina_base.Zkapp_precondition.Closed_interval.t) = + Block_time.t Mina_base.Zkapp_precondition.Closed_interval.t ) = let timestamp_lower_bound = Block_time.to_int64 timestamp_bounds.lower in let timestamp_upper_bound = Block_time.to_int64 timestamp_bounds.upper in let value = { timestamp_lower_bound; timestamp_upper_bound } in @@ -870,7 +870,7 @@ module Zkapp_timestamp_bounds = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id end @@ -886,7 +886,7 @@ module Zkapp_length_bounds = struct let add_if_doesn't_exist (module Conn : CONNECTION) (length_bounds : - Unsigned.uint32 Mina_base.Zkapp_precondition.Closed_interval.t) = + Unsigned.uint32 Mina_base.Zkapp_precondition.Closed_interval.t ) = let length_lower_bound = Unsigned.UInt32.to_int64 length_bounds.lower in let length_upper_bound = Unsigned.UInt32.to_int64 length_bounds.upper in let value = { length_lower_bound; length_upper_bound } in @@ -898,7 +898,7 @@ module Zkapp_length_bounds = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id end @@ -914,7 +914,7 @@ module Zkapp_amount_bounds = struct let add_if_doesn't_exist (module Conn : CONNECTION) (amount_bounds : - Currency.Amount.t Mina_base.Zkapp_precondition.Closed_interval.t) = + Currency.Amount.t Mina_base.Zkapp_precondition.Closed_interval.t ) = let amount_lower_bound = Currency.Amount.to_uint64 amount_bounds.lower |> Unsigned.UInt64.to_int64 in @@ -930,7 +930,7 @@ module Zkapp_amount_bounds = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id end @@ -947,7 +947,7 @@ module Zkapp_global_slot_bounds = struct let add_if_doesn't_exist (module Conn : CONNECTION) (global_slot_bounds : Mina_numbers.Global_slot.t - Mina_base.Zkapp_precondition.Closed_interval.t) = + Mina_base.Zkapp_precondition.Closed_interval.t ) = let global_slot_lower_bound = Mina_numbers.Global_slot.to_uint32 global_slot_bounds.lower |> Unsigned.UInt32.to_int64 @@ -965,7 +965,7 @@ module Zkapp_global_slot_bounds = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id end @@ -999,7 +999,7 @@ module Timing_info = struct vesting_period, vesting_increment FROM timing_info WHERE account_identifier_id = ? - |sql}) + |sql} ) account_identifier_id let find_by_account_identifier_id_opt (module Conn : CONNECTION) @@ -1011,7 +1011,7 @@ module Timing_info = struct vesting_period, vesting_increment FROM timing_info WHERE account_identifier_id = ? - |sql}) + |sql} ) account_identifier_id let add_if_doesn't_exist (module Conn : CONNECTION) account_identifier_id @@ -1027,7 +1027,7 @@ module Timing_info = struct match%bind Conn.find_opt (Caqti_request.find_opt Caqti_type.int Caqti_type.int - "SELECT id FROM timing_info WHERE account_identifier_id = ?") + "SELECT id FROM timing_info WHERE account_identifier_id = ?" ) account_identifier_id with | Some id -> @@ -1061,19 +1061,19 @@ module Timing_info = struct cliff_time, cliff_amount, vesting_period, vesting_increment) VALUES (?, ?, ?, ?, ?, ?) RETURNING id - |sql}) + |sql} ) values let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id let load_opt (module Conn : CONNECTION) id = Conn.find_opt (Caqti_request.find_opt Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id end @@ -1082,13 +1082,13 @@ module Snarked_ledger_hash = struct let hash = Frozen_ledger_hash.to_base58_check t in Conn.find (Caqti_request.find Caqti_type.string Caqti_type.int - "SELECT id FROM snarked_ledger_hashes WHERE value = ?") + "SELECT id FROM snarked_ledger_hashes WHERE value = ?" ) hash let find_by_id (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int Caqti_type.string - "SELECT value FROM snarked_ledger_hashes WHERE id = ?") + "SELECT value FROM snarked_ledger_hashes WHERE id = ?" ) id let add_if_doesn't_exist (module Conn : CONNECTION) (t : Frozen_ledger_hash.t) @@ -1098,7 +1098,7 @@ module Snarked_ledger_hash = struct match%bind Conn.find_opt (Caqti_request.find_opt Caqti_type.string Caqti_type.int - "SELECT id FROM snarked_ledger_hashes WHERE value = ?") + "SELECT id FROM snarked_ledger_hashes WHERE value = ?" ) hash with | Some id -> @@ -1106,13 +1106,13 @@ module Snarked_ledger_hash = struct | None -> Conn.find (Caqti_request.find Caqti_type.string Caqti_type.int - "INSERT INTO snarked_ledger_hashes (value) VALUES (?) RETURNING id") + "INSERT INTO snarked_ledger_hashes (value) VALUES (?) RETURNING id" ) hash let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int Caqti_type.string - "SELECT value FROM snarked_ledger_hashes WHERE id = ?") + "SELECT value FROM snarked_ledger_hashes WHERE id = ?" ) id end @@ -1148,7 +1148,7 @@ module Zkapp_epoch_ledger = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id end @@ -1208,7 +1208,7 @@ module Zkapp_epoch_data = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id end @@ -1306,7 +1306,7 @@ module Zkapp_protocol_state_precondition = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id end @@ -1335,7 +1335,7 @@ module Zkapp_events = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int Mina_caqti.array_int_typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:[ "element_ids" ])) + (Mina_caqti.select_cols_from_id ~table_name ~cols:[ "element_ids" ]) ) id end @@ -1433,14 +1433,14 @@ module Zkapp_other_party_body = struct | "caller" -> Some "call_type_type" | _ -> - None) + None ) (module Conn) value let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id end @@ -1490,7 +1490,7 @@ module Zkapp_other_party = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id end @@ -1555,14 +1555,14 @@ module Zkapp_fee_payer_body = struct Mina_caqti.select_insert_into_cols ~select:("id", Caqti_type.int) ~table_name ~cols:(Fields.names, typ) ~tannot:(function - | "events_ids" | "sequence_events_ids" -> Some "int[]" | _ -> None) + | "events_ids" | "sequence_events_ids" -> Some "int[]" | _ -> None ) (module Conn) value let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id end @@ -1616,7 +1616,7 @@ module Epoch_data = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id end @@ -1657,13 +1657,13 @@ module User_command = struct = Conn.find_opt (Caqti_request.find_opt Caqti_type.string Caqti_type.int - (Mina_caqti.select_cols ~select:"id" ~table_name ~cols:[ "hash" ] ())) + (Mina_caqti.select_cols ~select:"id" ~table_name ~cols:[ "hash" ] ()) ) (Transaction_hash.to_base58_check transaction_hash) let load (module Conn : CONNECTION) ~(id : int) = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id type balance_public_key_ids = @@ -1726,8 +1726,8 @@ module User_command = struct (Caqti_request.find typ Caqti_type.int (Mina_caqti.insert_into_cols ~returning:"id" ~table_name ~tannot:(function - | "typ" -> Some "user_command_type" | _ -> None) - ~cols:Fields.names ())) + | "typ" -> Some "user_command_type" | _ -> None ) + ~cols:Fields.names () ) ) { typ = ( match via with | `Ident -> @@ -1741,7 +1741,7 @@ module User_command = struct ; amount = Signed_command.amount t |> Core.Option.map ~f:(fun amt -> - Currency.Amount.to_uint64 amt |> Unsigned.UInt64.to_int64) + Currency.Amount.to_uint64 amt |> Unsigned.UInt64.to_int64 ) ; fee = ( Signed_command.fee t |> fun amt -> @@ -1784,8 +1784,8 @@ module User_command = struct (Caqti_request.find typ Caqti_type.int (Mina_caqti.insert_into_cols ~returning:"id" ~table_name ~tannot:(function - | "typ" -> Some "user_command_type" | _ -> None) - ~cols:Fields.names ())) + | "typ" -> Some "user_command_type" | _ -> None ) + ~cols:Fields.names () ) ) { typ = user_cmd.typ ; fee_payer_id ; source_id @@ -1799,7 +1799,7 @@ module User_command = struct Option.map user_cmd.valid_until ~f: (Fn.compose Unsigned.UInt32.to_int64 - Mina_numbers.Global_slot.to_uint32) + Mina_numbers.Global_slot.to_uint32 ) ; memo = user_cmd.memo |> Signed_command_memo.to_base58_check ; hash = user_cmd.hash |> Transaction_hash.to_base58_check } @@ -1855,7 +1855,7 @@ module User_command = struct Mina_caqti.select_insert_into_cols ~select:("id", Caqti_type.int) ~table_name:"zkapp_commands" ~cols:(Fields.names, typ) ~tannot:(function - | "zkapp_other_parties_ids" -> Some "int[]" | _ -> None) + | "zkapp_other_parties_ids" -> Some "int[]" | _ -> None ) (module Conn) { zkapp_fee_payer_body_id; zkapp_other_parties_ids; memo; hash } end @@ -1911,14 +1911,14 @@ module Internal_command = struct Caqti_type.int (Mina_caqti.select_cols ~select:"id" ~table_name ~tannot:(function - | "typ" -> Some "internal_command_type" | _ -> None) - ~cols:[ "hash"; "typ" ] ())) + | "typ" -> Some "internal_command_type" | _ -> None ) + ~cols:[ "hash"; "typ" ] () ) ) (Transaction_hash.to_base58_check transaction_hash, typ) let load (module Conn : CONNECTION) ~(id : int) = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id let add_extensional_if_doesn't_exist (module Conn : CONNECTION) @@ -1941,8 +1941,8 @@ module Internal_command = struct (Caqti_request.find typ Caqti_type.int (Mina_caqti.insert_into_cols ~returning:"id" ~table_name ~tannot:(function - | "typ" -> Some "internal_command_type" | _ -> None) - ~cols:Fields.names ())) + | "typ" -> Some "internal_command_type" | _ -> None ) + ~cols:Fields.names () ) ) { typ = internal_cmd.typ ; receiver_id ; fee = @@ -2014,7 +2014,7 @@ module Fee_transfer = struct (typ, receiver_id, fee, hash) VALUES (?::internal_command_type, ?, ?, ?) RETURNING id - |sql}) + |sql} ) { kind ; receiver_id ; fee = @@ -2062,7 +2062,7 @@ module Coinbase = struct (typ, receiver_id, fee, hash) VALUES (?::internal_command_type, ?, ?, ?) RETURNING id - |sql}) + |sql} ) { receiver_id ; amount = Coinbase.amount t |> Currency.Amount.to_uint64 @@ -2091,7 +2091,7 @@ module Block_and_internal_command = struct {sql| INSERT INTO blocks_internal_commands (block_id, internal_command_id, sequence_no, secondary_sequence_no) VALUES (?, ?, ?, ?) - |sql}) + |sql} ) { block_id; internal_command_id; sequence_no; secondary_sequence_no } let find (module Conn : CONNECTION) ~block_id ~internal_command_id @@ -2105,7 +2105,7 @@ module Block_and_internal_command = struct AND internal_command_id = $2 AND sequence_no = $3 AND secondary_sequence_no = $4 - |sql}) + |sql} ) (block_id, internal_command_id, sequence_no, secondary_sequence_no) let add_if_doesn't_exist (module Conn : CONNECTION) ~block_id @@ -2152,7 +2152,7 @@ module Block_and_signed_command = struct status, failure_reason) VALUES (?, ?, ?, ?::user_command_status, ?) - |sql}) + |sql} ) { block_id; user_command_id; sequence_no; status; failure_reason } let add_with_status (module Conn : CONNECTION) ~block_id ~user_command_id @@ -2181,7 +2181,7 @@ module Block_and_signed_command = struct WHERE block_id = $1 AND user_command_id = $2 AND sequence_no = $3 - |sql}) + |sql} ) (block_id, user_command_id, sequence_no) with | Some _ -> @@ -2203,7 +2203,7 @@ module Block_and_signed_command = struct AND user_command_id = $2 AND sequence_no = $3 |sql} - comma_cols)) + comma_cols ) ) (block_id, user_command_id, sequence_no) end @@ -2231,7 +2231,7 @@ module Zkapp_party_failures = struct Conn.find (Caqti_request.find Caqti_type.int typ (Mina_caqti.select_cols_from_id ~table_name - ~cols:[ "index"; "failures" ])) + ~cols:[ "index"; "failures" ] ) ) id end @@ -2266,7 +2266,7 @@ module Block_and_zkapp_command = struct ~f:(fun (ndx, failure_reasons) -> Zkapp_party_failures.add_if_doesn't_exist (module Conn) - ndx failure_reasons) + ndx failure_reasons ) in Some (Array.of_list failure_reasons_ids_list) in @@ -2289,7 +2289,7 @@ module Block_and_zkapp_command = struct | "failure_reasons_ids" -> Some "int[]" | _ -> - None) + None ) (module Conn) { block_id; zkapp_command_id; sequence_no; status; failure_reasons_ids } @@ -2301,7 +2301,7 @@ module Block_and_zkapp_command = struct typ (Mina_caqti.select_cols ~table_name ~select:comma_cols ~cols:[ "block_id"; "zkapp_command_id"; "sequence_no" ] - ())) + () ) ) (block_id, zkapp_command_id, sequence_no) end @@ -2333,7 +2333,7 @@ module Zkapp_account = struct ; last_sequence_slot ; proved_state } - : Mina_base.Zkapp_account.t) = + : Mina_base.Zkapp_account.t ) = zkapp_account in let app_state = Vector.map app_state ~f:(fun field -> Some field) in @@ -2345,7 +2345,7 @@ module Zkapp_account = struct let%map id = Zkapp_verification_keys.add_if_doesn't_exist (module Conn) vk in - Some id) + Some id ) in let zkapp_version = zkapp_version |> Unsigned.UInt32.to_int64 in let%bind sequence_state_id = @@ -2373,7 +2373,7 @@ module Zkapp_account = struct let load (module Conn : CONNECTION) id = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name ~cols:Fields.names) ) id end @@ -2425,7 +2425,7 @@ module Accounts_accessed = struct WHERE block_id = $1 AND account_identifier_id = $2 |sql} - comma_cols table_name)) + comma_cols table_name ) ) (block_id, account_identifier_id) let add_if_doesn't_exist (module Conn : CONNECTION) block_id @@ -2504,7 +2504,7 @@ module Accounts_accessed = struct (accounts : (int * Account.t) list) = let%map results = Deferred.List.map accounts ~f:(fun account -> - add_if_doesn't_exist (module Conn) block_id account) + add_if_doesn't_exist (module Conn) block_id account ) in Result.all results @@ -2513,7 +2513,7 @@ module Accounts_accessed = struct Conn.collect_list (Caqti_request.collect Caqti_type.int typ (Mina_caqti.select_cols ~select:comma_cols ~table_name - ~cols:[ "block_id" ] ())) + ~cols:[ "block_id" ] () ) ) block_id end @@ -2549,7 +2549,7 @@ module Accounts_created = struct accounts_created = let%map results = Deferred.List.map accounts_created ~f:(fun (pk, creation_fee) -> - add_if_doesn't_exist (module Conn) block_id pk creation_fee) + add_if_doesn't_exist (module Conn) block_id pk creation_fee ) in Result.all results @@ -2559,7 +2559,7 @@ module Accounts_created = struct {sql| SELECT block_id, account_identifier_id, creation_fee FROM accounts_created WHERE block_id = ? - |sql}) + |sql} ) block_id end @@ -2610,7 +2610,7 @@ module Block = struct let make_finder conn_finder req_finder ~state_hash = conn_finder (req_finder Caqti_type.string Caqti_type.int - "SELECT id FROM blocks WHERE state_hash = ?") + "SELECT id FROM blocks WHERE state_hash = ?" ) (State_hash.to_base58_check state_hash) let find (module Conn : CONNECTION) = make_finder Conn.find Caqti_request.find @@ -2621,8 +2621,7 @@ module Block = struct let load (module Conn : CONNECTION) ~id = Conn.find (Caqti_request.find Caqti_type.int typ - (Mina_caqti.select_cols_from_id ~table_name:"blocks" - ~cols:Fields.names)) + (Mina_caqti.select_cols_from_id ~table_name:"blocks" ~cols:Fields.names) ) id let add_parts_if_doesn't_exist (module Conn : CONNECTION) @@ -2699,8 +2698,8 @@ module Block = struct (Caqti_request.find typ Caqti_type.int (Mina_caqti.insert_into_cols ~returning:"id" ~table_name ~tannot:(function - | "chain_status" -> Some "chain_status_type" | _ -> None) - ~cols:Fields.names ())) + | "chain_status" -> Some "chain_status_type" | _ -> None ) + ~cols:Fields.names () ) ) { state_hash = hash |> State_hash.to_base58_check ; parent_id ; parent_hash = @@ -2796,7 +2795,7 @@ module Block = struct , secondary_sequence_no , fee_transfer.fee , fee_transfer.receiver_pk ) - :: acc) + :: acc ) in let fee_transfer_infos_with_balances = match fee_transfer_infos with @@ -2818,7 +2817,7 @@ module Block = struct (module Conn) ~block_id ~internal_command_id:fee_transfer_id ~sequence_no ~secondary_sequence_no - >>| ignore) + >>| ignore ) in sequence_no + 1 | { data = Coinbase coinbase; _ } -> @@ -2851,13 +2850,13 @@ module Block = struct ~secondary_sequence_no:0 >>| ignore in - sequence_no + 1) + sequence_no + 1 ) in return block_id let add_if_doesn't_exist conn ~constraint_constants ({ data = t; hash = { state_hash = hash; _ } } : - Mina_block.t State_hash.With_state_hashes.t) = + Mina_block.t State_hash.With_state_hashes.t ) = add_parts_if_doesn't_exist conn ~constraint_constants ~protocol_state:(Header.protocol_state @@ Mina_block.header t) ~staged_ledger_diff:(Body.staged_ledger_diff @@ Mina_block.body t) @@ -2910,7 +2909,7 @@ module Block = struct global_slot_since_genesis, timestamp, chain_status) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?::chain_status_type) RETURNING id - |sql}) + |sql} ) { state_hash = block.state_hash |> State_hash.to_base58_check ; parent_id ; parent_hash = block.parent_hash |> State_hash.to_base58_check @@ -2945,7 +2944,7 @@ module Block = struct (module Conn) user_cmd in - cmd_id :: acc) + cmd_id :: acc ) in List.zip_exn block.user_cmds (List.rev user_cmd_ids_rev) in @@ -2957,7 +2956,7 @@ module Block = struct (module Conn) ~block_id ~user_command_id ~sequence_no:user_command.sequence_no ~status:user_command.status - ~failure_reason:user_command.failure_reason) + ~failure_reason:user_command.failure_reason ) in (* add internal commands *) let%bind internal_cmds_ids_and_seq_nos = @@ -2969,11 +2968,11 @@ module Block = struct (module Conn) internal_cmd in - (internal_cmd, cmd_id) :: acc) + (internal_cmd, cmd_id) :: acc ) in let sequence_nos = List.map block.internal_cmds ~f:(fun internal_cmd -> - (internal_cmd.sequence_no, internal_cmd.secondary_sequence_no)) + (internal_cmd.sequence_no, internal_cmd.secondary_sequence_no) ) in List.zip_exn (List.rev internal_cmds_and_ids_rev) sequence_nos in @@ -2988,7 +2987,7 @@ module Block = struct -> Block_and_internal_command.add_if_doesn't_exist (module Conn) - ~block_id ~internal_command_id ~sequence_no ~secondary_sequence_no) + ~block_id ~internal_command_id ~sequence_no ~secondary_sequence_no ) in (* add zkApp commands *) let%bind zkapp_cmds_ids_and_seq_nos = @@ -3002,14 +3001,14 @@ module Block = struct let (other_parties : Party.Wire.t list) = List.map other_parties ~f:(fun (body : Party.Body.Wire.t) : Party.Wire.t -> - { body; authorization = None_given }) + { body; authorization = None_given } ) in let%map cmd_id = User_command.Zkapp_command.add_if_doesn't_exist (module Conn) (Parties.of_wire { fee_payer; other_parties; memo }) in - (zkapp_cmd, cmd_id) :: acc) + (zkapp_cmd, cmd_id) :: acc ) in let sequence_nos = List.map block.zkapp_cmds ~f:(fun { sequence_no; _ } -> sequence_no) @@ -3027,7 +3026,7 @@ module Block = struct ~status:zkapp_command.status ~failure_reasons:zkapp_command.failure_reasons in - ()) + () ) in (* add accounts accessed *) let%bind _block_and_account_ids = @@ -3051,7 +3050,7 @@ module Block = struct {sql| UPDATE blocks SET parent_id = ? WHERE parent_hash = ? AND parent_id IS NULL - |sql}) + |sql} ) (parent_id, State_hash.to_base58_check parent_hash) let get_subchain (module Conn : CONNECTION) ~start_block_id ~end_block_id = @@ -3089,7 +3088,7 @@ module Block = struct global_slot_since_hard_fork,global_slot_since_genesis, timestamp,chain_status FROM chain ORDER BY height ASC - |sql}) + |sql} ) (end_block_id, start_block_id) let get_highest_canonical_block_opt (module Conn : CONNECTION) = @@ -3097,14 +3096,14 @@ module Block = struct (Caqti_request.find_opt Caqti_type.unit Caqti_type.(tup2 int int64) "SELECT id,height FROM blocks WHERE chain_status='canonical' ORDER BY \ - height DESC LIMIT 1") + height DESC LIMIT 1" ) let get_nearest_canonical_block_above (module Conn : CONNECTION) height = Conn.find (Caqti_request.find Caqti_type.int64 Caqti_type.(tup2 int int64) "SELECT id,height FROM blocks WHERE chain_status='canonical' AND \ - height > ? ORDER BY height ASC LIMIT 1") + height > ? ORDER BY height ASC LIMIT 1" ) height let get_nearest_canonical_block_below (module Conn : CONNECTION) height = @@ -3112,13 +3111,13 @@ module Block = struct (Caqti_request.find Caqti_type.int64 Caqti_type.(tup2 int int64) "SELECT id,height FROM blocks WHERE chain_status='canonical' AND \ - height < ? ORDER BY height DESC LIMIT 1") + height < ? ORDER BY height DESC LIMIT 1" ) height let mark_as_canonical (module Conn : CONNECTION) ~state_hash = Conn.exec (Caqti_request.exec Caqti_type.string - "UPDATE blocks SET chain_status='canonical' WHERE state_hash = ?") + "UPDATE blocks SET chain_status='canonical' WHERE state_hash = ?" ) state_hash let mark_as_orphaned (module Conn : CONNECTION) ~state_hash ~height = @@ -3128,7 +3127,7 @@ module Block = struct {sql| UPDATE blocks SET chain_status='orphaned' WHERE height = $2 AND state_hash <> $1 - |sql}) + |sql} ) (state_hash, height) (* update chain_status for blocks now known to be canonical or orphaned *) @@ -3155,7 +3154,7 @@ module Block = struct (* mark canonical, orphaned blocks in subchain at least k behind the new block *) let canonical_blocks = List.filter subchain_blocks ~f:(fun subchain_block -> - Int64.( <= ) subchain_block.height block_height_less_k_int64) + Int64.( <= ) subchain_block.height block_height_less_k_int64 ) in Mina_caqti.deferred_result_list_fold canonical_blocks ~init:() ~f:(fun () block -> @@ -3164,7 +3163,7 @@ module Block = struct in mark_as_orphaned (module Conn) - ~state_hash:block.state_hash ~height:block.height) + ~state_hash:block.state_hash ~height:block.height ) else if Int64.( < ) block.height greatest_canonical_height then (* a missing block added in the middle of canonical chain *) let%bind canonical_block_above_id, _above_height = @@ -3188,7 +3187,7 @@ module Block = struct in mark_as_orphaned (module Conn) - ~state_hash:block.state_hash ~height:block.height) + ~state_hash:block.state_hash ~height:block.height ) else (* a block at or above highest canonical block, not high enough to mark any blocks as canonical *) Deferred.Result.return () @@ -3204,7 +3203,7 @@ module Block = struct match%map Conn.find_opt (Caqti_request.find_opt Caqti_type.unit Caqti_type.int - "SELECT MAX(height) FROM blocks") + "SELECT MAX(height) FROM blocks" ) () with | Some max_block_height -> @@ -3225,7 +3224,7 @@ module Block = struct WHERE id IN\n\ (SELECT user_command_id FROM blocks_user_commands\n\ INNER JOIN blocks ON blocks.id = block_id\n\ - WHERE (blocks.height < ? OR blocks.timestamp < ?))") + WHERE (blocks.height < ? OR blocks.timestamp < ?))" ) (height, timestamp) in let%bind () = @@ -3234,7 +3233,7 @@ module Block = struct (Caqti_request.exec Caqti_type.(tup2 int int64) "DELETE FROM blocks WHERE blocks.height < ? OR blocks.timestamp < \ - ?") + ?" ) (height, timestamp) in let%bind () = @@ -3245,7 +3244,7 @@ module Block = struct WHERE id NOT IN\n\ (SELECT internal_commands.id FROM internal_commands\n\ INNER JOIN blocks_internal_commands ON\n\ - internal_command_id = internal_commands.id)") + internal_command_id = internal_commands.id)" ) () in let%bind () = @@ -3254,7 +3253,7 @@ module Block = struct (Caqti_request.exec Caqti_type.unit "DELETE FROM snarked_ledger_hashes\n\ WHERE id NOT IN\n\ - (SELECT snarked_ledger_hash_id FROM blocks)") + (SELECT snarked_ledger_hash_id FROM blocks)" ) () in let%bind () = @@ -3266,7 +3265,7 @@ module Block = struct AND id NOT IN (SELECT source_id FROM user_commands)\n\ AND id NOT IN (SELECT receiver_id FROM user_commands)\n\ AND id NOT IN (SELECT receiver_id FROM internal_commands)\n\ - AND id NOT IN (SELECT creator_id FROM blocks)") + AND id NOT IN (SELECT creator_id FROM blocks)" ) () in return () @@ -3364,7 +3363,7 @@ let add_block_aux ?(retries = 3) ~logger ~pool ~add_block ~hash (fun (module Conn : CONNECTION) -> Accounts_accessed.add_accounts_if_don't_exist (module Conn) - block_id accounts_accessed) + block_id accounts_accessed ) pool with | Error err -> @@ -3390,7 +3389,7 @@ let add_block_aux ?(retries = 3) ~logger ~pool ~add_block ~hash (fun (module Conn : CONNECTION) -> Accounts_created.add_accounts_created_if_don't_exist (module Conn) - block_id accounts_created) + block_id accounts_created ) pool with | Ok _block_and_public_key_ids -> @@ -3413,7 +3412,7 @@ let add_block_aux ?(retries = 3) ~logger ~pool ~add_block ~hash ; ("error", `String (Caqti_error.show err)) ] ; - Conn.rollback () ) ) )) + Conn.rollback () ) ) ) ) pool in retry ~f:add ~logger ~error_str:"add_block_aux" retries @@ -3423,7 +3422,7 @@ let add_block_aux_precomputed ~constraint_constants ~logger ?retries ~pool add_block_aux ~logger ?retries ~pool ~delete_older_than ~add_block:(Block.add_from_precomputed ~constraint_constants) ~hash:(fun block -> - (block.Precomputed.protocol_state |> Protocol_state.hashes).state_hash) + (block.Precomputed.protocol_state |> Protocol_state.hashes).state_hash ) ~accounts_accessed:block.Precomputed.accounts_accessed ~accounts_created:block.Precomputed.accounts_created block @@ -3479,12 +3478,12 @@ let run pool reader ~constraint_constants ~logger ~delete_older_than : , Mina_base.User_command.to_yojson command ) ] "Failed to archive user command $command from \ - transaction pool: see $error") + transaction pool: see $error" ) in - Ok ()) + Ok () ) pool in - ()) + () ) let add_genesis_accounts ~logger ~(runtime_config_opt : Runtime_config.t option) pool = @@ -3629,9 +3628,9 @@ let add_genesis_accounts ~logger ~(runtime_config_opt : Runtime_config.t option) [ ("account_id", Account_id.to_yojson acct_id) ; ("error", `String (Caqti_error.show err)) ] ; - failwith "Could not add add genesis account" )) + failwith "Could not add add genesis account" ) ) in - Conn.commit ()) + Conn.commit () ) pool in match%map @@ -3684,13 +3683,13 @@ let setup_server ~metrics_server_port ~constraint_constants ~logger in let implementations = [ Async.Rpc.Rpc.implement Archive_rpc.t (fun () archive_diff -> - Strict_pipe.Writer.write writer archive_diff) + Strict_pipe.Writer.write writer archive_diff ) ; Async.Rpc.Rpc.implement Archive_rpc.precomputed_block (fun () precomputed_block -> - Strict_pipe.Writer.write precomputed_block_writer precomputed_block) + Strict_pipe.Writer.write precomputed_block_writer precomputed_block ) ; Async.Rpc.Rpc.implement Archive_rpc.extensional_block (fun () extensional_block -> - Strict_pipe.Writer.write extensional_block_writer extensional_block) + Strict_pipe.Writer.write extensional_block_writer extensional_block ) ] in match Caqti_async.connect_pool ~max_size:30 postgres_address with @@ -3726,7 +3725,7 @@ let setup_server ~metrics_server_port ~constraint_constants ~logger ; ("error", `String (Caqti_error.show e)) ] | Ok _block_id -> - ()) + () ) |> don't_wait_for ; Strict_pipe.Reader.iter extensional_block_reader ~f:(fun extensional_block -> @@ -3743,7 +3742,7 @@ let setup_server ~metrics_server_port ~constraint_constants ~logger ; ("error", `String (Caqti_error.show e)) ] | Ok _block_id -> - ()) + () ) |> don't_wait_for ; Deferred.ignore_m @@ Tcp.Server.create @@ -3755,14 +3754,14 @@ let setup_server ~metrics_server_port ~constraint_constants ~logger ~metadata: [ ("error", `String (Core.Exn.to_string_mach exn)) ; ("context", `String "rpc_tcp_server") - ])) + ] ) ) where_to_listen (fun address reader writer -> let address = Socket.Address.Inet.addr address in Async.Rpc.Connection.server_with_close reader writer ~implementations: (Async.Rpc.Implementations.create_exn ~implementations - ~on_unknown_rpc:`Raise) + ~on_unknown_rpc:`Raise ) ~connection_state:(fun _ -> ()) ~on_handshake_error: (`Call @@ -3776,7 +3775,7 @@ let setup_server ~metrics_server_port ~constraint_constants ~logger ; ( "address" , `String (Unix.Inet_addr.to_string address) ) ] ; - Deferred.unit))) + Deferred.unit ) ) ) |> don't_wait_for ; (*Update archive metrics*) create_metrics_server ~logger ~metrics_server_port ~missing_blocks_width diff --git a/src/app/archive/archive_lib/test.ml b/src/app/archive/archive_lib/test.ml index 55b07ddb0c0..ad567928690 100644 --- a/src/app/archive/archive_lib/test.ml +++ b/src/app/archive/archive_lib/test.ml @@ -20,7 +20,7 @@ let%test_module "Archive node unit tests" = Async.Thread_safe.block_on_async_exn (fun () -> Verifier.create ~logger ~proof_level ~constraint_constants ~conf_dir:None - ~pids:(Child_processes.Termination.create_pid_table ())) + ~pids:(Child_processes.Termination.create_pid_table ()) ) module Genesis_ledger = (val Genesis_ledger.for_unit_tests) @@ -28,7 +28,7 @@ let%test_module "Archive node unit tests" = Uri.of_string (Option.value (Sys.getenv "MINA_TEST_POSTGRES") - ~default:"postgres://admin:codarules@localhost:5432/archiver") + ~default:"postgres://admin:codarules@localhost:5432/archiver" ) let conn_lazy = lazy @@ -68,7 +68,7 @@ let%test_module "Archive node unit tests" = let fee_payer_keypair = keys.(fee_payer_key_index) in let keymap = Array.map keys ~f:(fun { public_key; private_key } -> - (Public_key.compress public_key, private_key)) + (Public_key.compress public_key, private_key) ) |> Array.to_list |> Public_key.Compressed.Map.of_alist_exn in let ledger = Mina_ledger.Ledger.create ~depth:10 () in @@ -95,7 +95,7 @@ let%test_module "Archive node unit tests" = Coinbase.Gen.with_random_receivers ~keys ~min_amount:20 ~max_amount:100 ~fee_transfer: (Coinbase.Fee_transfer.Gen.with_random_receivers ~keys - ~min_fee:Currency.Fee.zero) + ~min_fee:Currency.Fee.zero ) let%test_unit "User_command: read and write signed command" = let conn = Lazy.force conn_lazy in @@ -123,7 +123,7 @@ let%test_module "Archive node unit tests" = | Ok () -> () | Error e -> - failwith @@ Caqti_error.show e) + failwith @@ Caqti_error.show e ) let%test_unit "User_command: read and write zkapp command" = let conn = Lazy.force conn_lazy in @@ -151,7 +151,7 @@ let%test_module "Archive node unit tests" = | Ok () -> () | Error e -> - failwith @@ Caqti_error.show e) + failwith @@ Caqti_error.show e ) let%test_unit "Fee_transfer: read and write" = let kind_gen = @@ -185,7 +185,7 @@ let%test_module "Archive node unit tests" = | Ok () -> () | Error e -> - failwith @@ Caqti_error.show e) + failwith @@ Caqti_error.show e ) let%test_unit "Coinbase: read and write" = let conn = Lazy.force conn_lazy in @@ -208,7 +208,7 @@ let%test_module "Archive node unit tests" = | Ok () -> () | Error e -> - failwith @@ Caqti_error.show e) + failwith @@ Caqti_error.show e ) let%test_unit "Block: read and write" = let pool = Lazy.force conn_pool_lazy in @@ -216,10 +216,10 @@ let%test_module "Archive node unit tests" = ( Quickcheck.Generator.with_size ~size:10 @@ Quickcheck_lib.gen_imperative_list (Transition_frontier.For_tests.gen_genesis_breadcrumb - ~precomputed_values ~verifier ()) + ~precomputed_values ~verifier () ) (Transition_frontier.Breadcrumb.For_tests.gen_non_deferred ?logger:None ~precomputed_values ~verifier ?trust_system:None - ~accounts_with_secret_keys:(Lazy.force Genesis_ledger.accounts)) + ~accounts_with_secret_keys:(Lazy.force Genesis_ledger.accounts) ) ) ~f:(fun breadcrumbs -> Thread_safe.block_on_async_exn @@ -237,7 +237,8 @@ let%test_module "Archive node unit tests" = List.map ~f:(fun breadcrumb -> Diff.Transition_frontier - (Diff.Builder.breadcrumb_added ~precomputed_values breadcrumb)) + (Diff.Builder.breadcrumb_added ~precomputed_values breadcrumb) + ) breadcrumbs in List.iter diffs ~f:(Strict_pipe.Writer.write writer) ; @@ -269,17 +270,17 @@ let%test_module "Archive node unit tests" = Processor.For_test.assert_parent_exist ~parent_id ~parent_hash: (Transition_frontier.Breadcrumb.parent_hash - breadcrumb) + breadcrumb ) conn else Deferred.Result.return () | None -> - failwith "Failed to find saved block in database") - pool) + failwith "Failed to find saved block in database" ) + pool ) with | Ok () -> () | Error e -> - failwith @@ Caqti_error.show e) + failwith @@ Caqti_error.show e ) (* let%test_unit "Block: read and write with pruning" = diff --git a/src/app/archive/cli/archive_cli.ml b/src/app/archive/cli/archive_cli.ml index 97e1e053211..0868f63e377 100644 --- a/src/app/archive/cli/archive_cli.ml +++ b/src/app/archive/cli/archive_cli.ml @@ -25,7 +25,7 @@ let command_run = database is h and missing-blocks-width is n, then \ Coda_Archive_missing_blocks will report missing blocks between \ heights max(1, h-n) and h (default %d)" - Archive_lib.Metrics.default_missing_blocks_width) + Archive_lib.Metrics.default_missing_blocks_width ) (optional int) and postgres = Flag.Uri.Archive.postgres and runtime_config_file = @@ -41,7 +41,7 @@ let command_run = let runtime_config_opt = Option.map runtime_config_file ~f:(fun file -> Yojson.Safe.from_file file |> Runtime_config.of_yojson - |> Result.ok_or_failwith) + |> Result.ok_or_failwith ) in fun () -> let logger = Logger.create () in @@ -51,7 +51,7 @@ let command_run = ~postgres_address:postgres.value ~server_port: (Option.value server_port.value ~default:server_port.default) - ~delete_older_than ~runtime_config_opt ~missing_blocks_width) + ~delete_older_than ~runtime_config_opt ~missing_blocks_width ) let time_arg = (* Same timezone as Genesis_constants.genesis_state_timestamp. *) @@ -108,7 +108,7 @@ let command_prune = [ Option.map height ~f:(fun v -> ("height", `Int v)) ; Option.map num_blocks ~f:(fun v -> ("num_blocks", `Int v)) ; Option.map timestamp ~f:(fun v -> - ("timestamp", `String (Int64.to_string v))) + ("timestamp", `String (Int64.to_string v)) ) ] in match%map.Async.Deferred go () with @@ -117,6 +117,6 @@ let command_prune = | Error err -> [%log error] "Failed to purge blocks" ~metadata: - (("error", `String (Caqti_error.show err)) :: cmd_metadata)) + (("error", `String (Caqti_error.show err)) :: cmd_metadata) ) let commands = [ ("run", command_run); ("prune", command_prune) ] diff --git a/src/app/archive_blocks/archive_blocks.ml b/src/app/archive_blocks/archive_blocks.ml index 09d21af0bac..4bfdaf9f665 100644 --- a/src/app/archive_blocks/archive_blocks.ml +++ b/src/app/archive_blocks/archive_blocks.ml @@ -53,12 +53,12 @@ let main ~archive_uri ~precomputed ~extensional ~success_file ~failure_file (Processor.add_block_aux_precomputed ~constraint_constants: Genesis_constants.Constraint_constants.compiled ~pool - ~delete_older_than:None ~logger) + ~delete_older_than:None ~logger ) in let add_extensional_block = make_add_block Archive_lib.Extensional.Block.of_yojson (Processor.add_block_aux_extensional ~logger ~pool - ~delete_older_than:None) + ~delete_older_than:None ) in Deferred.List.iter files ~f:(fun file -> In_channel.with_file file ~f:(fun in_channel -> @@ -79,7 +79,7 @@ let main ~archive_uri ~precomputed ~extensional ~success_file ~failure_file [ ("file", `String file) ; ("error", `String (Exn.to_string exn)) ] ; - return (add_to_failure_file file))) + return (add_to_failure_file file) ) ) let () = Command.( @@ -115,4 +115,4 @@ let () = (Flag.optional_with_default true Param.bool) and files = Param.anon Anons.(sequence ("FILES" %: Param.string)) in main ~archive_uri ~precomputed ~extensional ~success_file ~failure_file - ~log_successes ~files))) + ~log_successes ~files ))) diff --git a/src/app/batch_txn_tool/batch_txn_tool.ml b/src/app/batch_txn_tool/batch_txn_tool.ml index b767a107795..1e876aa5e6d 100644 --- a/src/app/batch_txn_tool/batch_txn_tool.ml +++ b/src/app/batch_txn_tool/batch_txn_tool.ml @@ -21,7 +21,7 @@ let output_keys = in fun () -> List.iter (gen_keys count) ~f:(fun pk -> - Format.printf "%s@." (Public_key.Compressed.to_base58_check pk))) + Format.printf "%s@." (Public_key.Compressed.to_base58_check pk) ) ) let output_cmds = let open Command.Let_syntax in @@ -87,11 +87,11 @@ let output_cmds = Format.printf "sleep %f@." Float.(of_int rate_limit_interval /. 1000.) ; batch_count := 0 ) - else incr batch_count) ; + else incr batch_count ) ; Format.printf "mina client send-payment --amount 1 --receiver %s --sender %s@." (Public_key.Compressed.to_base58_check pk) - sender_key)) + sender_key ) ) let pk_to_str pk = pk |> Public_key.compress |> Public_key.Compressed.to_base58_check @@ -124,7 +124,7 @@ let there_and_back_again ~num_txn_per_acct ~txns_per_block ~slot_time ~fill_rate (Format.printf "txn burst tool: rate limiting, pausing for %d milliseconds... \ @." - rate_limit_interval) + rate_limit_interval ) in let%bind () = Async.after (Time.Span.create ~ms:rate_limit_interval ()) @@ -143,7 +143,7 @@ let there_and_back_again ~num_txn_per_acct ~txns_per_block ~slot_time ~fill_rate (Option.value_exn (Currency.Amount.scale (Currency.Amount.of_fee Mina_base.Signed_command.minimum_fee) - 10)) + 10 ) ) | Some f -> Currency.Amount.to_fee (Currency.Amount.of_formatted_string f) in @@ -157,7 +157,7 @@ let there_and_back_again ~num_txn_per_acct ~txns_per_block ~slot_time ~fill_rate Option.value_exn (Currency.Amount.scale (Currency.Amount.of_fee fee_amount) - num_txn_per_acct) + num_txn_per_acct ) in (* let total_acct_creation_fee = Option.value_exn @@ -244,7 +244,7 @@ let there_and_back_again ~num_txn_per_acct ~txns_per_block ~slot_time ~fill_rate | Error e -> return (Format.printf "txn burst tool: txn failed with error %s@." - (Error.to_string_hum e)) + (Error.to_string_hum e) ) in limit () in @@ -255,7 +255,7 @@ let there_and_back_again ~num_txn_per_acct ~txns_per_block ~slot_time ~fill_rate Deferred.List.iter [ returner_keypair ] ~f:(fun kp -> let%bind origin_nonce = get_nonce origin_keypair.public_key in (* we could also get the origin nonce outside the iter and then just increment by 1 every iter *) - do_txn ~sender_kp:origin_keypair ~receiver_kp:kp ~nonce:origin_nonce) + do_txn ~sender_kp:origin_keypair ~receiver_kp:kp ~nonce:origin_nonce ) in (* and back again... *) @@ -272,7 +272,7 @@ let there_and_back_again ~num_txn_per_acct ~txns_per_block ~slot_time ~fill_rate in if n > 1 then do_command (n - 1) else return () in - do_command num_txn_per_acct) + do_command num_txn_per_acct ) in return () @@ -366,7 +366,7 @@ let output_there_and_back_cmds = ~slot_time ~fill_rate ~rate_limit ~rate_limit_level ~rate_limit_interval ~origin_sender_secret_key_path ~origin_sender_secret_key_pw_option ~returner_secret_key_path ~returner_secret_key_pw_option - ~graphql_target_node_option) + ~graphql_target_node_option ) let () = Command.run @@ -375,4 +375,4 @@ let () = [ ("gen-keys", output_keys) ; ("gen-txns", output_cmds) ; ("gen-there-and-back-txns", output_there_and_back_cmds) - ]) + ] ) diff --git a/src/app/best_tip_merger/best_tip_merger.ml b/src/app/best_tip_merger/best_tip_merger.ml index 526ace99f86..a83611705e7 100644 --- a/src/app/best_tip_merger/best_tip_merger.ml +++ b/src/app/best_tip_merger/best_tip_merger.ml @@ -45,7 +45,7 @@ module Input = struct Option.map msg.event_id ~f:(fun e -> Structured_log_events.equal_id e Transition_frontier.Extensions.Best_tip_diff.Log_event - .new_best_tip_event_structured_events_id) + .new_best_tip_event_structured_events_id ) in match tf_event_id with | Some true -> @@ -88,7 +88,7 @@ module Input = struct | Some node -> { state = node.state ; peer_ids = Set.add node.peer_ids peer_id - }) ; + } ) ; seen_state_hashes in Hashtbl.update t.all_states parent_hash ~f:(function @@ -104,8 +104,8 @@ module Input = struct ~data: { state ; peer_ids = Set.add peer_ids peer_id - } )) ; - { acc'' with seen_state_hashes }) + } ) ) ; + { acc'' with seen_state_hashes } ) in (* remove any previous roots for which there are ancestors now*) List.iter (Hashtbl.keys acc'.init_states) ~f:(fun root -> @@ -115,7 +115,7 @@ module Input = struct in if State_hash.Set.mem acc'.seen_state_hashes parent then (* no longer a root because a node for its parent was seen*) - Hashtbl.remove acc'.init_states root) ; + Hashtbl.remove acc'.init_states root ) ; { acc' with peers } | None | Some false -> [%log error] @@ -126,7 +126,7 @@ module Input = struct | Error err -> [%log error] "Could not process log line $line: $error" ~metadata:[ ("line", `String line); ("error", `String err) ] ; - acc) + acc ) in [%log info] "Finished processing log file: %s" log_file ; res @@ -146,11 +146,11 @@ module Output = struct ~f:(fun map root_state -> Map.update map (Mina_state.Protocol_state.previous_state_hash - root_state.state.protocol_state) ~f:(function + root_state.state.protocol_state ) ~f:(function | Some peer_ids -> Set.union peer_ids root_state.peer_ids | None -> - root_state.peer_ids)) + root_state.peer_ids ) ) in List.fold ~init:[] (Map.to_alist roots) ~f:(fun acc_trees (root, peer_ids) -> @@ -163,18 +163,18 @@ module Output = struct let successors_with_min_peers = if min_peers > 1 then List.filter successors ~f:(fun s -> - Set.length s.peer_ids >= min_peers) + Set.length s.peer_ids >= min_peers ) else successors in List.map successors_with_min_peers ~f:(fun s -> Rose_tree.T ( Node { state = s.state; peer_ids = s.peer_ids } - , go s.state.state_hash )) + , go s.state.state_hash ) ) in let root_node = Rose_tree.T (Root { state = root; peer_ids }, go root) in - root_node :: acc_trees) + root_node :: acc_trees ) end module type Graph_node_intf = sig @@ -211,7 +211,7 @@ module Display = struct | Root s -> { state = Root s.state; peers = Set.length s.peer_ids } | Node s -> - { state = Node s.state; peers = Set.length s.peer_ids })) + { state = Node s.state; peers = Set.length s.peer_ids } ) ) end module Compact_display = struct @@ -250,7 +250,7 @@ module Compact_display = struct |> Consensus.Data.Consensus_state.curr_global_slot } in - { state; peers = Set.length t.peer_ids })) + { state; peers = Set.length t.peer_ids } ) ) end module Graph_node = struct @@ -316,7 +316,7 @@ module Visualization = struct List.fold ~init:graph_with_node subtrees ~f:(fun gr (T (child_node, _) as child_tree) -> let gr' = add_edge gr node (to_graph_node child_node) in - go child_tree gr') + go child_tree gr' ) in go t empty @@ -325,7 +325,7 @@ module Visualization = struct let filename = output_dir ^/ "tree_" ^ Int.to_string i ^ ".dot" in Out_channel.with_file filename ~f:(fun output_channel -> let graph = to_graph tree in - output_graph output_channel graph)) + output_graph output_channel graph ) ) end let main ~input_dir ~output_dir ~output_format ~min_peers () = @@ -333,7 +333,7 @@ let main ~input_dir ~output_dir ~output_format ~min_peers () = Sys.ls_dir input_dir >>| List.filter_map ~f:(fun n -> if Filename.check_suffix n ".log" then Some (input_dir ^/ n) - else None) + else None ) in let t : Input.t = { Input.all_states = Hashtbl.create (module State_hash) @@ -349,11 +349,11 @@ let main ~input_dir ~output_dir ~output_format ~min_peers () = ~transport: (Logger_file_system.dumb_logrotate ~directory:output_dir ~log_filename:"mina-best-tip-merger.log" ~max_size:logrotate_max_size - ~num_rotate) ; + ~num_rotate ) ; let logger = Logger.create () in let t' = List.fold ~init:t files ~f:(fun t log_file -> - Input.of_logs ~logger ~log_file t) + Input.of_logs ~logger ~log_file t ) in [%log info] "Consolidating best-tip history.." ; let output = Output.of_input t' ~min_peers in @@ -417,7 +417,7 @@ let () = (sprintf "Invalid value %s for output-format. Currently supported \ formats are Full or Compact" - x) + x ) in let min_peers = match min_peers with @@ -429,4 +429,4 @@ let () = failwith "Invalid value for min-peers" in Cli_lib.Stdout_log.setup log_json log_level ; - main ~input_dir ~output_dir ~output_format ~min_peers))) + main ~input_dir ~output_dir ~output_format ~min_peers ))) diff --git a/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml b/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml index a90637d9fa4..e84242b3ac4 100644 --- a/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml +++ b/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml @@ -141,7 +141,7 @@ let setup_daemon logger = ~doc: (sprintf "INTERVAL in mins for collecting GC stats for metrics (Default: %f)" - !Mina_metrics.Runtime.gc_stat_interval_mins) + !Mina_metrics.Runtime.gc_stat_interval_mins ) and libp2p_metrics_port = flag "--libp2p-metrics-port" ~aliases:[ "libp2p-metrics-port" ] ~doc: @@ -179,7 +179,7 @@ let setup_daemon logger = (sprintf "FEE Amount a worker wants to get compensated for generating a \ snark proof (default: %d)" - (Currency.Fee.to_int Mina_compile_config.default_snark_worker_fee)) + (Currency.Fee.to_int Mina_compile_config.default_snark_worker_fee) ) (optional txn_fee) and work_reassignment_wait = flag "--work-reassignment-wait" @@ -188,7 +188,7 @@ let setup_daemon logger = ~doc: (sprintf "WAIT-TIME in ms before a snark-work is reassigned (default: %dms)" - Cli_lib.Default.work_reassignment_wait) + Cli_lib.Default.work_reassignment_wait ) and enable_tracing = flag "--tracing" ~aliases:[ "tracing" ] no_arg ~doc:"Trace into $config-directory/trace/$pid.trace" @@ -262,7 +262,7 @@ let setup_daemon logger = (Printf.sprintf "NN min number of connections that this peer will have to neighbors \ in the gossip network (default: %d)" - Cli_lib.Default.min_connections) + Cli_lib.Default.min_connections ) (optional int) and max_connections = flag "--max-connections" ~aliases:[ "max-connections" ] @@ -272,7 +272,7 @@ let setup_daemon logger = in the gossip network. Tuning this higher will strengthen your \ connection to the network in exchange for using more RAM (default: \ %d)" - Cli_lib.Default.max_connections) + Cli_lib.Default.max_connections ) (optional int) and validation_queue_size = flag "--validation-queue-size" @@ -286,7 +286,7 @@ let setup_daemon logger = net. If this queue is too small, we will drop messages without \ validating them. If it is too large, we are susceptible to DoS \ attacks on memory. (default: %d)" - Cli_lib.Default.validation_queue_size) + Cli_lib.Default.validation_queue_size ) (optional int) and direct_peers_raw = flag "--direct-peer" ~aliases:[ "direct-peer" ] @@ -378,7 +378,7 @@ let setup_daemon logger = "UPTIME in hours after which the daemon stops itself (only if there \ were no slots won within an hour after the stop time) (Default: \ %d)" - Cli_lib.Default.stop_time) + Cli_lib.Default.stop_time ) and upload_blocks_to_gcloud = flag "--upload-blocks-to-gcloud" ~aliases:[ "upload-blocks-to-gcloud" ] @@ -411,7 +411,7 @@ let setup_daemon logger = if String.length s < 200 then Some s else Mina_user_error.raisef - "The length of contact info exceeds 200 characters:\n %s" s)) + "The length of contact info exceeds 200 characters:\n %s" s ) ) and uptime_url_string = flag "--uptime-url" ~aliases:[ "uptime-url" ] (optional string) ~doc:"URL URL of the uptime service of the Mina delegation program" @@ -468,21 +468,21 @@ let setup_daemon logger = ~transport: (Logger_file_system.dumb_logrotate ~directory:conf_dir ~log_filename:"mina.log" ~max_size:logrotate_max_size - ~num_rotate:logrotate_num_rotate) ; + ~num_rotate:logrotate_num_rotate ) ; let best_tip_diff_log_size = 1024 * 1024 * 5 in Logger.Consumer_registry.register ~id:Logger.Logger_id.best_tip_diff ~processor:(Logger.Processor.raw ()) ~transport: (Logger_file_system.dumb_logrotate ~directory:conf_dir ~log_filename:"mina-best-tip.log" - ~max_size:best_tip_diff_log_size ~num_rotate:1) ; + ~max_size:best_tip_diff_log_size ~num_rotate:1 ) ; let rejected_blocks_log_size = 1024 * 1024 * 5 in Logger.Consumer_registry.register ~id:Logger.Logger_id.rejected_blocks ~processor:(Logger.Processor.raw ()) ~transport: (Logger_file_system.dumb_logrotate ~directory:conf_dir ~log_filename:"mina-rejected-blocks.log" - ~max_size:rejected_blocks_log_size ~num_rotate:50) ; + ~max_size:rejected_blocks_log_size ~num_rotate:50 ) ; let version_metadata = [ ("commit", `String Mina_version.commit_id) ; ("branch", `String Mina_version.branch) @@ -509,7 +509,7 @@ let setup_daemon logger = Clock.run_at tm (fun () -> [%log info] "Daemon has expired, shutting down" ; - Core.exit 0) + Core.exit 0 ) () ) ; [%log info] "Booting may take several seconds, please wait" ; let wallets_disk_location = conf_dir ^/ "wallets" in @@ -530,7 +530,7 @@ let setup_daemon logger = [%log warn] "I think -discovery-keypair is in the old format, but \ I failed to parse it! Using it as a path..." ; - None) + None ) in match libp2p_keypair_old_format with | Some kp -> @@ -564,7 +564,7 @@ let setup_daemon logger = Or_error.errorf "commit not found in version file %s" version_filename ) | _ -> - Or_error.errorf "Unexpected value in %s" version_filename) + Or_error.errorf "Unexpected value in %s" version_filename ) with | Ok c -> if String.equal c Mina_version.commit_id then return () @@ -615,7 +615,7 @@ let setup_daemon logger = | `Yes -> Stop (Some f) | _ -> - Continue None) + Continue None ) ~finish:Fn.id in match config_file_installed with @@ -638,12 +638,12 @@ let setup_daemon logger = Option.to_list config_file_installed @ (config_file_configdir :: Option.to_list config_file_envvar) @ List.map config_files ~f:(fun config_file -> - (config_file, `Must_exist)) + (config_file, `Must_exist) ) in let%bind config_jsons = let config_files_paths = List.map config_files ~f:(fun (config_file, _) -> - `String config_file) + `String config_file ) in [%log info] "Reading configuration files $config_files" ~metadata:[ ("config_files", `List config_files_paths) ] ; @@ -672,7 +672,7 @@ let setup_daemon logger = [ ("config_file", `String config_file) ; ("error", Error_json.error_to_yojson err) ] ; - return None )) + return None ) ) in let config = List.fold ~init:Runtime_config.default config_jsons @@ -688,7 +688,7 @@ let setup_daemon logger = ; ("config_json", config_json) ; ("error", `String err) ] ; - failwithf "Could not parse configuration file: %s" err ()) + failwithf "Could not parse configuration file: %s" err () ) in let genesis_dir = Option.value ~default:(conf_dir ^/ "genesis") genesis_dir @@ -715,7 +715,7 @@ let setup_daemon logger = Option.map YJ.Util.( to_option Fn.id (YJ.Util.member "daemon" config_json)) - ~f:(fun daemon_config -> (config_file, daemon_config))) + ~f:(fun daemon_config -> (config_file, daemon_config)) ) in let maybe_from_config (type a) (f : YJ.t -> a option) (keyname : string) (actual_value : a option) : a option = @@ -736,7 +736,7 @@ let setup_daemon logger = to_option Fn.id (member keyname daemon_config) in let%map data = f json_val in - (config_file, data)) + (config_file, data) ) in [%log debug] "Key $key being used from config file $config_file" ~metadata: @@ -791,7 +791,7 @@ let setup_daemon logger = let work_selection_method = or_from_config (Fn.compose Option.return - (Fn.compose work_selection_method_val YJ.Util.to_string)) + (Fn.compose work_selection_method_val YJ.Util.to_string) ) "work-selection" ~default:Cli_lib.Arg_type.Work_selection_method.Random work_selection_method_flag @@ -836,7 +836,7 @@ let setup_daemon logger = | Error _e -> Mina_user_error.raisef ~where:"decoding a public key" "The %s public key %s could not be decoded." which - pk_str) + pk_str ) in let run_snark_worker_flag = maybe_from_config @@ -893,7 +893,7 @@ let setup_daemon logger = on command-line or daemon.json. Using value from $envkey" ~metadata:[ ("envkey", `String Secrets.Keypair.env) ] | _ -> - Unix.putenv ~key:Secrets.Keypair.env ~data:password) + Unix.putenv ~key:Secrets.Keypair.env ~data:password ) block_production_password ; let%bind block_production_keypair = match (block_production_key, block_production_pubkey) with @@ -916,7 +916,7 @@ let setup_daemon logger = ~which:"block producer keypair" ~read_from_env_exn: (Secrets.Keypair.Terminal_stdin.read_exn - ~should_prompt_user:false ~should_reask:false) + ~should_prompt_user:false ~should_reask:false ) ~conf_dir tracked_pubkey in Some kp @@ -938,7 +938,7 @@ let setup_daemon logger = [%log warn] "Could not parse address $address in %s" env_var ~metadata:[ ("address", `String str) ] ; - None) + None ) in Some (List.append cidrs (Option.value ~default:[] client_trustlist)) @@ -951,7 +951,7 @@ let setup_daemon logger = in Stream.iter (Async_kernel.Async_kernel_scheduler.long_cycles_with_context - ~at_least:(sec 0.5 |> Time_ns.Span.of_span_float_round_nearest)) + ~at_least:(sec 0.5 |> Time_ns.Span.of_span_float_round_nearest) ) ~f:(fun (span, context) -> let secs = Time_ns.Span.to_sec span in let rec get_monitors accum monitor = @@ -965,7 +965,7 @@ let setup_daemon logger = let monitor_infos = List.map monitors ~f:(fun monitor -> Async_kernel.Monitor.sexp_of_t monitor - |> Error_json.sexp_to_yojson) + |> Error_json.sexp_to_yojson ) in [%log debug] ~metadata: @@ -975,7 +975,7 @@ let setup_daemon logger = "Long async cycle, $long_async_cycle seconds" ; Mina_metrics.( Runtime.Long_async_histogram.observe Runtime.long_async_cycle - secs)) ; + secs) ) ; Stream.iter Async_kernel.Async_kernel_scheduler.long_jobs_with_context ~f:(fun (context, span) -> let secs = Time_ns.Span.to_sec span in @@ -988,11 +988,11 @@ let setup_daemon logger = (List.map ~f:Backtrace.to_string (List.take (Execution_context.backtrace_history context) - 2))) ) + 2 ) ) ) ) ] "Long async job, $long_async_job seconds" ; Mina_metrics.( - Runtime.Long_job_histogram.observe Runtime.long_async_job secs)) ; + Runtime.Long_job_histogram.observe Runtime.long_async_job secs) ) ; let trace_database_initialization typ location = (* can't use %log ppx here, because we're using the passed-in location *) Logger.trace logger ~module_:__MODULE__ "Creating %s at %s" @@ -1013,7 +1013,7 @@ let setup_daemon logger = let block_production_keypairs = block_production_keypair |> Option.map ~f:(fun kp -> - (kp, Public_key.compress kp.Keypair.public_key)) + (kp, Public_key.compress kp.Keypair.public_key) ) |> Option.to_list |> Keypair.And_compressed_pk.Set.of_list in let epoch_ledger_location = conf_dir ^/ "epoch_ledger" in @@ -1025,7 +1025,7 @@ let setup_daemon logger = ~epoch_ledger_location ( Option.map block_production_keypair ~f:(fun keypair -> let open Keypair in - Public_key.compress keypair.public_key) + Public_key.compress keypair.public_key ) |> Option.to_list |> Public_key.Compressed.Set.of_list ) ~ledger_depth:precomputed_values.constraint_constants.ledger_depth ~genesis_state_hash: @@ -1040,7 +1040,7 @@ let setup_daemon logger = | Some file -> ( match%bind Monitor.try_with_or_error ~here:[%here] (fun () -> - Reader.file_contents file) + Reader.file_contents file ) with | Ok contents -> return (Mina_net2.Multiaddr.of_file_contents contents) @@ -1058,7 +1058,7 @@ let setup_daemon logger = Mina_user_error.raisef ~where:"decoding peer as a multiaddress" "The given peer \"%s\" is not a valid multiaddress (ex: \ /ip4/IPADDR/tcp/PORT/p2p/PEERID)" - raw_peer) ; + raw_peer ) ; let initial_peers = List.concat [ List.map ~f:Mina_net2.Multiaddr.of_string libp2p_peers_raw @@ -1066,7 +1066,7 @@ let setup_daemon logger = ; List.map ~f:Mina_net2.Multiaddr.of_string @@ or_from_config (Fn.compose Option.some - (YJ.Util.convert_each YJ.Util.to_string)) + (YJ.Util.convert_each YJ.Util.to_string) ) "peers" None ~default:[] ] in @@ -1106,7 +1106,7 @@ let setup_daemon logger = ~default: (Option.bind config.daemon ~f:(fun { Runtime_config.Daemon.peer_list_url; _ } -> - peer_list_url)) + peer_list_url ) ) in if is_seed then [%log info] "Starting node as a seed node" else if demo_mode then [%log info] "Starting node in demo mode" @@ -1209,7 +1209,7 @@ Pass one of -peer, -peer-list-file, -seed, -peer-list-url.|} ; | Error err -> Mina_user_error.raisef "Invalid public key %s for uptime submitter, %s" s - (Error.to_string_hum err) ()) + (Error.to_string_hum err) () ) in let%bind uptime_submitter_keypair = match (uptime_submitter_key, uptime_submitter_opt) with @@ -1221,7 +1221,7 @@ Pass one of -peer, -peer-list-file, -seed, -peer-list-url.|} ; ~which:"uptime submitter keypair" ~read_from_env_exn: (Secrets.Uptime_keypair.Terminal_stdin.read_exn - ~should_prompt_user:false ~should_reask:false) + ~should_prompt_user:false ~should_reask:false ) ~conf_dir pk in Some kp @@ -1249,7 +1249,7 @@ Pass one of -peer, -peer-list-file, -seed, -peer-list-url.|} ; ~proposed_protocol_version_opt ~work_selection_method: (Cli_lib.Arg_type.work_selection_method_to_module - work_selection_method) + work_selection_method ) ~snark_worker_config: { Mina_lib.Config.Snark_worker_config .initial_snark_worker_key = run_snark_worker_flag @@ -1268,7 +1268,7 @@ Pass one of -peer, -peer-list-file, -seed, -peer-list-url.|} ; ~log_block_creation ~precomputed_values ~start_time ?precomputed_blocks_path ~log_precomputed_blocks ~upload_blocks_to_gcloud ~block_reward_threshold ~uptime_url - ~uptime_submitter_keypair ~stop_time ~node_status_url ()) + ~uptime_submitter_keypair ~stop_time ~node_status_url () ) in { Coda_initialization.coda ; client_trustlist @@ -1295,7 +1295,7 @@ Pass one of -peer, -peer-list-file, -seed, -peer-list-url.|} ; don't_wait_for (Pipe_lib.Strict_pipe.Reader.iter_without_pushback (Mina_lib.validated_transitions coda) - ~f:ignore) ; + ~f:ignore ) ; Coda_run.setup_local_server ?client_trustlist ~rest_server_port ~insecure_rest_server ~open_limited_graphql_port ?limited_graphql_port coda ; @@ -1304,16 +1304,16 @@ Pass one of -peer, -peer-list-file, -seed, -peer-list-url.|} ; let forward_uri = Option.map libp2p_metrics_port ~f:(fun port -> Uri.with_uri ~scheme:(Some "http") ~host:(Some "127.0.0.1") - ~port:(Some port) ~path:(Some "/metrics") Uri.empty) + ~port:(Some port) ~path:(Some "/metrics") Uri.empty ) in Mina_metrics.Runtime.( gc_stat_interval_mins := Option.value ~default:!gc_stat_interval_mins gc_stat_interval) ; - Mina_metrics.server ?forward_uri ~port ~logger () >>| ignore) + Mina_metrics.server ?forward_uri ~port ~logger () >>| ignore ) |> Option.value ~default:Deferred.unit in let () = Mina_plugins.init_plugins ~logger coda plugins in - return coda) + return coda ) let daemon logger = Command.async ~summary:"Mina daemon" @@ -1323,7 +1323,7 @@ let daemon logger = let%bind coda = setup_daemon () in let%bind () = Mina_lib.start coda in [%log info] "Daemon ready. Clients can now connect" ; - Async.never ())) + Async.never () ) ) let replay_blocks logger = let replay_flag = @@ -1367,13 +1367,13 @@ let replay_blocks logger = Some (read_block_line line, blocks_file) | None -> In_channel.close blocks_file ; - None) + None ) in let%bind coda = setup_daemon () in let%bind () = Mina_lib.start_with_precomputed_blocks coda blocks in [%log info] "Daemon ready, replayed precomputed blocks. Clients can now connect" ; - Async.never ())) + Async.never () ) ) [%%if force_updates] @@ -1389,7 +1389,7 @@ let rec ensure_testnet_id_still_good logger = let soon_minutes = Int.of_float (60.0 *. recheck_soon) in match%bind Monitor.try_with_or_error ~here:[%here] (fun () -> - Client.get (Uri.of_string "http://updates.o1test.net/testnet_id")) + Client.get (Uri.of_string "http://updates.o1test.net/testnet_id") ) with | Error e -> [%log error] @@ -1438,7 +1438,7 @@ let rec ensure_testnet_id_still_good logger = | Some sha -> if List.exists valid_ids ~f:(fun remote_id -> - Git_sha.equal sha remote_id) + Git_sha.equal sha remote_id ) then ( try_later recheck_later ; Deferred.unit ) else finish commit_id body_string ) @@ -1466,7 +1466,7 @@ let snark_hashes = (* Throw away the constraint system ID to avoid changing the format of the output here. *) - Md5.to_hex digest) + Md5.to_hex digest ) | None -> [] in @@ -1495,7 +1495,7 @@ let internal_commands logger = in Prover.prove_from_input_sexp prover sexp >>| ignore | `Eof -> - failwith "early EOF while reading sexp")) ) + failwith "early EOF while reading sexp" ) ) ) ; ( "run-verifier" , Command.async ~summary:"Run verifier on a proof provided on a single line of stdin" @@ -1550,12 +1550,12 @@ let internal_commands logger = `Transaction (List.t_of_sexp (Tuple2.t_of_sexp Ledger_proof.t_of_sexp - Sok_message.t_of_sexp) - input_sexp) + Sok_message.t_of_sexp ) + input_sexp ) | `Blockchain -> `Blockchain (List.t_of_sexp Blockchain_snark.Blockchain.t_of_sexp - input_sexp) ) + input_sexp ) ) | `Json -> ( let%map input_line = match%map Reader.read_line (Lazy.force Reader.stdin) with @@ -1735,7 +1735,7 @@ let () = | _ -> Command.run (Command.group ~summary:"Mina" ~preserve_subcommand_order:() - (mina_commands logger))) ; + (mina_commands logger) ) ) ; Core.exit 0 let linkme = () diff --git a/src/app/cli/src/init/.ocamlformat b/src/app/cli/src/init/.ocamlformat index 9a9f9a6031c..1b2264a8390 100644 --- a/src/app/cli/src/init/.ocamlformat +++ b/src/app/cli/src/init/.ocamlformat @@ -4,9 +4,7 @@ max-iters=10 comment-check=true wrap-fun-args=true wrap-comments=false -type-decl-indent=2 type-decl=compact -stritem-extension-indent=0 space-around-variants=true space-around-records=true space-around-lists=true @@ -15,52 +13,34 @@ single-case=compact sequence-style=separator sequence-blank-line=preserve-one parse-docstrings=false -parens-tuple-patterns=multi-line-only parens-tuple=always parens-ite=false ocp-indent-compat=false -nested-match=wrap module-item-spacing=sparse max-indent=68 -match-indent-nested=never -match-indent=0 margin=80 -let-open=preserve let-module=compact let-binding-spacing=compact -let-binding-indent=2 let-and=compact leading-nested-match-parens=false infix-precedence=indent indicate-nested-or-patterns=space indicate-multiline-delimiters=space -indent-after-in=0 if-then-else=compact -function-indent-nested=never -function-indent=2 field-space=loose -extension-indent=2 exp-grouping=parens dock-collection-brackets=false doc-comments-tag-only=default doc-comments-padding=2 doc-comments=before -disambiguate-non-breaking-match=false disable=false cases-matching-exp-indent=normal cases-exp-indent=4 -break-struct=force -break-string-literals=auto break-sequences=false break-separators=before break-infix-before-func=true break-infix=wrap break-fun-sig=wrap break-fun-decl=wrap -break-collection-expressions=fit-or-vertical break-cases=nested -break-before-in=fit-or-vertical assignment-operator=end-line -align-variants-decl=false -align-constructors-decl=false -align-cases=false diff --git a/src/app/cli/src/init/client.ml b/src/app/cli/src/init/client.ml index 7a635aa5ebb..4825d61fb27 100644 --- a/src/app/cli/src/init/client.ml +++ b/src/app/cli/src/init/client.ml @@ -49,7 +49,7 @@ let stop_daemon = printf "%s" (or_error_str res ~f_ok:(fun _ -> "Daemon stopping\n") - ~error:"Daemon likely stopped"))) + ~error:"Daemon likely stopped" ) ) ) let get_balance_graphql = let open Command.Param in @@ -71,7 +71,7 @@ let get_balance_graphql = (Graphql_queries.Get_tracked_account.make ~public_key:(Graphql_lib.Encoders.public_key public_key) ~token:(Graphql_lib.Encoders.token token) - ()) + () ) graphql_endpoint in match response#account with @@ -83,7 +83,7 @@ let get_balance_graphql = printf "Balance: %s tokens\n" (Currency.Balance.to_formatted_string account#balance#total) | None -> - printf "There are no funds in this account\n")) + printf "There are no funds in this account\n" ) ) let get_tokens_graphql = let open Command.Param in @@ -99,12 +99,12 @@ let get_tokens_graphql = Graphql_client.query_exn (Graphql_queries.Get_all_accounts.make ~public_key:(Graphql_lib.Encoders.public_key public_key) - ()) + () ) graphql_endpoint in printf "Accounts are held for token IDs:\n" ; Array.iter response#accounts ~f:(fun account -> - printf "%s " (Token_id.to_string account#token)))) + printf "%s " (Token_id.to_string account#token) ) ) ) let get_time_offset_graphql = Command.async @@ -126,7 +126,7 @@ let get_time_offset_graphql = MINA_TIME_OFFSET environment variable in the shell before \ executing them:\n\ export MINA_TIME_OFFSET=%i\n" - time_offset time_offset)) + time_offset time_offset ) ) let print_trust_statuses statuses json = if json then @@ -138,8 +138,8 @@ let print_trust_statuses statuses json = `List [ Network_peer.Peer.to_yojson peer ; Trust_system.Peer_status.to_yojson status - ]) - statuses))) + ] ) + statuses ) ) ) else let ban_status status = match status.Trust_system.Peer_status.banned with @@ -152,7 +152,7 @@ let print_trust_statuses statuses json = ~f:(fun () (peer, status) -> printf "%s, %0.04f, %s\n" (Network_peer.Peer.to_multiaddr_string peer) - status.trust (ban_status status)) + status.trust (ban_status status) ) statuses let round_trust_score trust_status = @@ -182,10 +182,11 @@ let get_trust_status = print_trust_statuses (List.map ~f:(fun (peer, status) -> (peer, round_trust_score status)) - statuses) + statuses ) json | Error e -> - printf "Failed to get trust status %s\n" (Error.to_string_hum e))) + printf "Failed to get trust status %s\n" (Error.to_string_hum e) ) + ) let ip_trust_statuses_to_yojson ip_trust_statuses = let items = @@ -193,7 +194,7 @@ let ip_trust_statuses_to_yojson ip_trust_statuses = `Assoc [ ("ip", `String (Unix.Inet_addr.to_string ip_addr)) ; ("status", Trust_system.Peer_status.to_yojson status) - ]) + ] ) in `List items @@ -217,18 +218,19 @@ let get_trust_status_all = (* always round the trust scores for display *) let ip_rounded_trust_statuses = List.map ip_trust_statuses ~f:(fun (ip_addr, status) -> - (ip_addr, round_trust_score status)) + (ip_addr, round_trust_score status) ) in let filtered_ip_trust_statuses = if nonzero then List.filter ip_rounded_trust_statuses ~f:(fun (_ip_addr, status) -> - not Float.(equal status.trust zero)) + not Float.(equal status.trust zero) ) else ip_rounded_trust_statuses in print_trust_statuses filtered_ip_trust_statuses json | Error e -> - printf "Failed to get trust statuses %s\n" (Error.to_string_hum e))) + printf "Failed to get trust statuses %s\n" (Error.to_string_hum e) ) + ) let reset_trust_status = let open Command.Param in @@ -251,7 +253,8 @@ let reset_trust_status = | Ok status -> print_trust_statuses status json | Error e -> - printf "Failed to reset trust status %s\n" (Error.to_string_hum e))) + printf "Failed to reset trust status %s\n" (Error.to_string_hum e) ) + ) let get_public_keys = let open Daemon_rpcs in @@ -274,13 +277,13 @@ let get_public_keys = Daemon_rpcs.Client.dispatch_pretty_message ~json ~join_error:Or_error.join ~error_ctx (module Cli_lib.Render.String_list_formatter) - Get_public_keys.rpc () port)) + Get_public_keys.rpc () port ) ) let read_json filepath ~flag = let%map res = Deferred.Or_error.try_with ~here:[%here] (fun () -> let%map json_contents = Reader.file_contents filepath in - Ok (Yojson.Safe.from_string json_contents)) + Ok (Yojson.Safe.from_string json_contents) ) in match res with | Ok c -> @@ -327,7 +330,7 @@ let verify_receipt = let%bind proof_json = read_json proof_path ~flag:"proof-path" in let to_deferred_or_error result ~error = Result.map_error result ~f:(fun s -> - Error.of_string (sprintf "%s: %s" error s)) + Error.of_string (sprintf "%s: %s" error s) ) |> Deferred.return in let%bind payment = @@ -335,7 +338,7 @@ let verify_receipt = |> to_deferred_or_error ~error: (sprintf "Payment file %s has invalid json format" - payment_path) + payment_path ) and proof = [%of_yojson: Receipt.Chain_hash.t * User_command.t list] proof_json |> to_deferred_or_error @@ -350,7 +353,8 @@ let verify_receipt = | Ok (Ok ()) -> printf "Payment is valid on the existing blockchain!\n" | Error e | Ok (Error e) -> - eprintf "Error verifying the receipt: %s\n" (Error.to_string_hum e))) + eprintf "Error verifying the receipt: %s\n" (Error.to_string_hum e) ) + ) let get_nonce : rpc:(Account_id.t, Account.Nonce.t option Or_error.t) Rpc.Rpc.t @@ -393,7 +397,7 @@ let get_nonce_cmd = exit 2 | Ok nonce -> printf "%s\n" (Account.Nonce.to_string nonce) ; - exit 0)) + exit 0 ) ) let status = let open Daemon_rpcs in @@ -405,7 +409,7 @@ let status = (module Daemon_rpcs.Types.Status) Get_status.rpc (if performance then `Performance else `None) - port)) + port ) ) let status_clear_hist = let open Daemon_rpcs in @@ -417,7 +421,7 @@ let status_clear_hist = (module Daemon_rpcs.Types.Status) Clear_hist_status.rpc (if performance then `Performance else `None) - port)) + port ) ) let get_nonce_exn ~rpc public_key port = match%bind get_nonce ~rpc public_key port with @@ -464,7 +468,7 @@ let batch_send_payments = %s\n" (Sexp.to_string_hum ([%sexp_of: Payment_info.t list] - (List.init 3 ~f:(fun _ -> sample_info ())))) ; + (List.init 3 ~f:(fun _ -> sample_info ())) ) ) ; exit 5 in let main port (privkey_path, payments_path) = @@ -481,19 +485,19 @@ let batch_send_payments = User_command_input.create ~signer:signer_pk ~fee ~fee_payer_pk:signer_pk ~memo:Signed_command_memo.empty ~valid_until ~body:(Payment { source_pk = signer_pk; receiver_pk; amount }) - ~sign_choice:(User_command_input.Sign_choice.Keypair keypair) ()) + ~sign_choice:(User_command_input.Sign_choice.Keypair keypair) () ) in Daemon_rpcs.Client.dispatch_with_message Daemon_rpcs.Send_user_commands.rpc ts port ~success:(fun _ -> "Successfully enqueued payments in pool") ~error:(fun e -> - sprintf "Failed to send payments %s" (Error.to_string_hum e)) + sprintf "Failed to send payments %s" (Error.to_string_hum e) ) ~join_error:Or_error.join in Command.async ~summary:"Send multiple payments from a file" (Cli_lib.Background_daemon.rpc_init (Args.zip2 Cli_lib.Flag.privkey_read_path payment_path_flag) - ~f:main) + ~f:main ) let send_payment_graphql = let open Command.Param in @@ -530,11 +534,11 @@ let send_payment_graphql = ~amount:(Encoders.amount amount) ~fee:(Encoders.fee fee) ?token:(Option.map ~f:Encoders.token token) ?nonce:(Option.map nonce ~f:Encoders.nonce) - ?memo ()) + ?memo () ) graphql_endpoint in printf "Dispatched payment with ID %s\n" - (response#sendPayment#payment |> unwrap_user_command)#id)) + (response#sendPayment#payment |> unwrap_user_command)#id ) ) let delegate_stake_graphql = let open Command.Param in @@ -559,11 +563,11 @@ let delegate_stake_graphql = ~sender:(Encoders.public_key sender) ~fee:(Encoders.fee fee) ?nonce:(Option.map nonce ~f:Encoders.nonce) - ?memo ()) + ?memo () ) graphql_endpoint in printf "Dispatched stake delegation with ID %s\n" - (response#sendDelegation#delegation |> unwrap_user_command)#id)) + (response#sendDelegation#delegation |> unwrap_user_command)#id ) ) let cancel_transaction_graphql = let txn_id_flag = @@ -600,14 +604,14 @@ let cancel_transaction_graphql = ~nonce: (uint32 (Mina_numbers.Account_nonce.to_uint32 - (Signed_command.nonce user_command))) + (Signed_command.nonce user_command) ) ) () in let%map cancel_response = Graphql_client.query_exn cancel_query graphql_endpoint in printf "🛑 Cancelled transaction! Cancel ID: %s\n" - (cancel_response#sendPayment#payment |> unwrap_user_command)#id)) + (cancel_response#sendPayment#payment |> unwrap_user_command)#id ) ) let send_rosetta_transactions_graphql = Command.async @@ -627,7 +631,7 @@ let send_rosetta_transactions_graphql = let%map response = Graphql_client.query_exn (Graphql_queries.Send_rosetta_transaction.make - ~transaction:transaction_json ()) + ~transaction:transaction_json () ) graphql_endpoint in let (`UserCommand user_command) = @@ -636,14 +640,14 @@ let send_rosetta_transactions_graphql = printf "Dispatched command with TRANSACTION_ID %s\n" user_command#id ; `Repeat () - with Yojson.End_of_input -> return (`Finished ()))) + with Yojson.End_of_input -> return (`Finished ()) ) ) with | Ok () -> Deferred.return () | Error err -> Format.eprintf "Error:@.%s@.@." (Yojson.Safe.pretty_to_string (Error_json.error_to_yojson err)) ; - Core_kernel.exit 1)) + Core_kernel.exit 1 ) ) module Export_logs = struct let pp_export_result tarfile = printf "Exported logs to %s\n%!" tarfile @@ -663,7 +667,7 @@ module Export_logs = struct (Graphql_queries.Export_logs.make ?basename ()) graphql_endpoint in - pp_export_result response#exportLogs#exportLogs#tarfile)) + pp_export_result response#exportLogs#exportLogs#tarfile ) ) let export_locally = let run ~tarfile ~conf_dir = @@ -681,7 +685,7 @@ module Export_logs = struct let open Command.Let_syntax in Command.async ~summary:"Export local logs (no daemon) to tar archive" (let%map tarfile = tarfile_flag and conf_dir = Cli_lib.Flag.conf_dir in - run ~tarfile ~conf_dir) + run ~tarfile ~conf_dir ) end let get_transaction_status = @@ -695,14 +699,14 @@ let get_transaction_status = Daemon_rpcs.Get_transaction_status.rpc user_command port ~success:(fun status -> sprintf !"Transaction status : %s\n" - @@ Transaction_inclusion_status.State.to_string status) + @@ Transaction_inclusion_status.State.to_string status ) ~error:(fun e -> sprintf "Failed to get transaction status : %s" - (Error.to_string_hum e)) + (Error.to_string_hum e) ) ~join_error:Or_error.join | Error _e -> eprintf "Could not deserialize user command" ; - exit 16)) + exit 16 ) ) let wrap_key = Command.async ~summary:"Wrap a private key into a private key file" @@ -745,7 +749,7 @@ let handle_export_ledger_response ~json = function Yojson.Safe.pretty_print Format.std_formatter (Runtime_config.Accounts.to_yojson (List.map accounts ~f:(fun a -> - Genesis_ledger_helper.Accounts.Single.of_account a None))) ; + Genesis_ledger_helper.Accounts.Single.of_account a None ) ) ) ; printf "\n" ) else printf !"%{sexp:Account.t list}\n" accounts ; return () @@ -817,7 +821,7 @@ let export_ledger = (* unreachable *) failwithf "Unknown ledger kind: %s" ledger_kind () in - response >>= handle_export_ledger_response ~json:(not plaintext))) + response >>= handle_export_ledger_response ~json:(not plaintext) ) ) let hash_ledger = let open Command.Let_syntax in @@ -852,9 +856,9 @@ let hash_ledger = lazy (List.map ([%of_sexp: Account.t list] sexp) - ~f:(fun acct -> (None, acct))) + ~f:(fun acct -> (None, acct)) ) in - process_accounts accounts) + process_accounts accounts ) else let json = Yojson.Safe.from_file ledger_file in match Runtime_config.Accounts.of_yojson json with @@ -866,7 +870,7 @@ let hash_ledger = | Error err -> Format.eprintf "Could not parse JSON in file %s: %s@" ledger_file err ; - ignore (exit 1 : 'a Deferred.t)) + ignore (exit 1 : 'a Deferred.t) ) let currency_in_ledger = let open Command.Let_syntax in @@ -896,7 +900,7 @@ let currency_in_ledger = Token_id.Table.add_exn currency_tbl ~key:token_id ~data:balance | Some total -> let new_total = Unsigned.UInt64.add total balance in - Token_id.Table.set currency_tbl ~key:token_id ~data:new_total) ; + Token_id.Table.set currency_tbl ~key:token_id ~data:new_total ) ; let tokens = Token_id.Table.keys currency_tbl |> List.dedup_and_sort ~compare:Token_id.compare @@ -910,7 +914,7 @@ let currency_in_ledger = if Token_id.equal token Token_id.default then Format.printf "MINA: %s@." total else - Format.printf "TOKEN %s: %s@." (Token_id.to_string token) total) + Format.printf "TOKEN %s: %s@." (Token_id.to_string token) total ) in Deferred.return @@ @@ -918,7 +922,7 @@ let currency_in_ledger = In_channel.with_file ledger_file ~f:(fun in_channel -> let sexp = In_channel.input_all in_channel |> Sexp.of_string in let accounts = [%of_sexp: Account.t list] sexp in - process_accounts accounts) + process_accounts accounts ) else let json = Yojson.Safe.from_file ledger_file in match Runtime_config.Accounts.of_yojson json with @@ -931,7 +935,7 @@ let currency_in_ledger = | Error err -> Format.eprintf "Could not parse JSON in file %s: %s@" ledger_file err ; - ignore (exit 1 : 'a Deferred.t)) + ignore (exit 1 : 'a Deferred.t) ) let constraint_system_digests = Command.async ~summary:"Print MD5 digest of each SNARK constraint" @@ -950,7 +954,7 @@ let constraint_system_digests = List.sort ~compare:(fun (k1, _) (k2, _) -> String.compare k1 k2) all in List.iter all ~f:(fun (k, v) -> printf "%s\t%s\n" k (Md5.to_hex v)) ; - Deferred.unit)) + Deferred.unit ) ) let snark_job_list = let open Deferred.Let_syntax in @@ -967,7 +971,7 @@ let snark_job_list = | Ok str -> printf "%s" str | Error e -> - Daemon_rpcs.Client.print_rpc_error e)) + Daemon_rpcs.Client.print_rpc_error e ) ) let snark_pool_list = let open Command.Param in @@ -977,7 +981,7 @@ let snark_pool_list = Deferred.map (Graphql_client.query_exn (Graphql_queries.Snark_pool.make ()) - graphql_endpoint) + graphql_endpoint ) ~f:(fun response -> let lst = [%to_yojson: Cli_lib.Graphql_types.Completed_works.t] @@ -988,10 +992,10 @@ let snark_pool_list = Array.to_list w#work_ids ; fee = Currency.Fee.of_uint64 w#fee ; prover = w#prover - }) - response#snarkPool)) + } ) + response#snarkPool ) ) in - print_string (Yojson.Safe.to_string lst)))) + print_string (Yojson.Safe.to_string lst) ) ) ) let pooled_user_commands = let public_key_flag = @@ -1016,10 +1020,10 @@ let pooled_user_commands = ~f: (Fn.compose Graphql_client.Signed_command.to_yojson (Fn.compose Graphql_client.Signed_command.of_obj - unwrap_user_command)) + unwrap_user_command ) ) @@ Array.to_list response#pooledUserCommands ) in - print_string (Yojson.Safe.to_string json_response))) + print_string (Yojson.Safe.to_string json_response) ) ) let pooled_zkapp_commands = let public_key_flag = @@ -1048,7 +1052,7 @@ let pooled_zkapp_commands = eprintf "Failed to read result of pooled zkApp commands" ; exit 1 in - print_string (Yojson.Safe.to_string json_response))) + print_string (Yojson.Safe.to_string json_response) ) ) let to_signed_fee_exn sign magnitude = let sgn = match sign with `PLUS -> Sgn.Pos | `MINUS -> Neg in @@ -1066,7 +1070,7 @@ let pending_snark_work = Deferred.map (Graphql_client.query_exn (Graphql_queries.Pending_snark_work.make ()) - graphql_endpoint) + graphql_endpoint ) ~f:(fun response -> let lst = [%to_yojson: Cli_lib.Graphql_types.Pending_snark_work.t] @@ -1087,10 +1091,10 @@ let pending_snark_work = hash_of_string w#source_ledger_hash ; target_ledger_hash = hash_of_string w#target_ledger_hash - })) - response#pendingSnarkWork) + } ) ) + response#pendingSnarkWork ) in - print_string (Yojson.Safe.to_string lst)))) + print_string (Yojson.Safe.to_string lst) ) ) ) let start_tracing = let open Deferred.Let_syntax in @@ -1104,7 +1108,7 @@ let start_tracing = | Ok () -> printf "Daemon started tracing!" | Error e -> - Daemon_rpcs.Client.print_rpc_error e)) + Daemon_rpcs.Client.print_rpc_error e ) ) let stop_tracing = let open Deferred.Let_syntax in @@ -1117,7 +1121,7 @@ let stop_tracing = | Ok () -> printf "Daemon stopped printing!" | Error e -> - Daemon_rpcs.Client.print_rpc_error e)) + Daemon_rpcs.Client.print_rpc_error e ) ) let set_coinbase_receiver_graphql = let open Command.Param in @@ -1148,14 +1152,14 @@ let set_coinbase_receiver_graphql = (Graphql_queries.Set_coinbase_receiver.make ~public_key: (Option.value_map ~f:Encoders.public_key public_key_opt - ~default:`Null) - ()) + ~default:`Null ) + () ) graphql_endpoint in printf "Was sending coinbases to the %a\nNow sending coinbases to the %a\n" print_pk_opt result#setCoinbaseReceiver#lastCoinbaseReceiver - print_pk_opt result#setCoinbaseReceiver#currentCoinbaseReceiver)) + print_pk_opt result#setCoinbaseReceiver#currentCoinbaseReceiver ) ) let set_snark_worker = let open Command.Param in @@ -1187,7 +1191,8 @@ let set_snark_worker = printf "Will stop doing snark work\n" ) ; printf "Previous snark worker public key : %s\n" (Option.value_map response#setSnarkWorker#lastSnarkWorker - ~default:"None" ~f:Public_key.Compressed.to_base58_check)))) + ~default:"None" ~f:Public_key.Compressed.to_base58_check ) ) ) + ) let set_snark_work_fee = Command.async ~summary:"Set fee reward for doing transaction snark work" @@ -1204,7 +1209,7 @@ let set_snark_work_fee = printf !"Updated snark work fee: %i\nOld snark work fee: %i\n" (Currency.Fee.to_int fee) - (Unsigned.UInt64.to_int response#setSnarkWorkFee#lastFee))) + (Unsigned.UInt64.to_int response#setSnarkWorkFee#lastFee) ) ) let import_key = Command.async @@ -1330,7 +1335,7 @@ let import_key = Importing to local directory %s%s\n" Bash_colors.orange conf_dir Bash_colors.none ; let%map res = do_local conf_dir in - print_result res )) + print_result res ) ) let export_key = let privkey_path = Cli_lib.Flag.privkey_write_path in @@ -1365,7 +1370,7 @@ let export_key = let password = lazy (Secrets.Password.hidden_line_or_env - "Password for exported account: " ~env:Secrets.Keypair.env) + "Password for exported account: " ~env:Secrets.Keypair.env ) in let%bind account = let open Deferred.Result.Let_syntax in @@ -1383,26 +1388,26 @@ let export_key = (sprintf !"account is an HD account (hardware wallet), the \ associated index is %{Unsigned.UInt32}" - i) + i ) | Error `Bad_password -> Error (sprintf !"wrong password provided for account \ %{Public_key.Compressed.to_base58_check}" - pk) + pk ) | Error (`Key_read_error e) -> Error (sprintf !"Error reading the secret key file for account \ %{Public_key.Compressed.to_base58_check}: %s" pk - (Secrets.Privkey_error.to_string e)) + (Secrets.Privkey_error.to_string e) ) | Error `Not_found -> Error (sprintf !"account not found corresponding to account \ %{Public_key.Compressed.to_base58_check}" - pk) + pk ) in match kp with | Ok kp -> @@ -1417,7 +1422,7 @@ let export_key = Deferred.unit | Error e -> printf "❌ Export failed -- %s\n" e ; - Deferred.unit)) + Deferred.unit ) ) let list_accounts = Command.async ~summary:"List all owned accounts" @@ -1454,7 +1459,7 @@ let list_accounts = (i + 1) (Public_key.Compressed.to_base58_check w#public_key) (Currency.Balance.to_formatted_string w#balance#total) - (Option.value ~default:true w#locked)) ; + (Option.value ~default:true w#locked) ) ; Ok () ) | Error (`Failed_request _ as err) -> Error err @@ -1476,7 +1481,7 @@ let list_accounts = | accounts -> List.iteri accounts ~f:(fun i public_key -> printf "Account #%d:\n Public key: %s\n" (i + 1) - (Public_key.Compressed.to_base58_check public_key)) + (Public_key.Compressed.to_base58_check public_key) ) in match access_method with | `GraphQL graphql_endpoint -> ( @@ -1500,7 +1505,7 @@ let list_accounts = "%sWarning: Could not connect to a running daemon.\n\ Listing from local directory %s%s\n" Bash_colors.orange conf_dir Bash_colors.none ; - do_local conf_dir )) + do_local conf_dir ) ) let create_account = let open Command.Param in @@ -1514,14 +1519,14 @@ let create_account = let%map response = Graphql_client.query_exn (Graphql_queries.Create_account.make - ~password:(Bytes.to_string password) ()) + ~password:(Bytes.to_string password) () ) graphql_endpoint in let pk_string = Public_key.Compressed.to_base58_check response#createAccount#public_key in - printf "\n😄 Added new account!\nPublic key: %s\n" pk_string)) + printf "\n😄 Added new account!\nPublic key: %s\n" pk_string ) ) let create_hd_account = Command.async ~summary:Secrets.Hardware_wallets.create_hd_account_summary @@ -1532,7 +1537,7 @@ let create_hd_account = query_exn (Graphql_queries.Create_hd_account.make ~hd_index:(Graphql_lib.Encoders.uint32 hd_index) - ())) + () )) graphql_endpoint in let pk_string = @@ -1541,7 +1546,7 @@ let create_hd_account = in printf "\n😄 created HD account with HD-index %s!\nPublic key: %s\n" (Mina_numbers.Hd_index.to_string hd_index) - pk_string)) + pk_string ) ) let unlock_account = let open Command.Param in @@ -1556,7 +1561,7 @@ let unlock_account = let password = Deferred.map ~f:Or_error.return (Secrets.Password.hidden_line_or_env "Password to unlock account: " - ~env:Secrets.Keypair.env) + ~env:Secrets.Keypair.env ) in match%bind password with | Ok password_bytes -> @@ -1565,7 +1570,7 @@ let unlock_account = (Graphql_queries.Unlock_account.make ~public_key:(Graphql_lib.Encoders.public_key pk_str) ~password:(Bytes.to_string password_bytes) - ()) + () ) graphql_endpoint in let pk_string = @@ -1575,8 +1580,8 @@ let unlock_account = printf "\n🔓 Unlocked account!\nPublic key: %s\n" pk_string | Error e -> Deferred.return - (printf "❌ Error unlocking account: %s\n" - (Error.to_string_hum e)))) + (printf "❌ Error unlocking account: %s\n" (Error.to_string_hum e)) ) + ) let lock_account = let open Command.Param in @@ -1592,13 +1597,13 @@ let lock_account = Graphql_client.query_exn (Graphql_queries.Lock_account.make ~public_key:(Graphql_lib.Encoders.public_key pk) - ()) + () ) graphql_endpoint in let pk_string = Public_key.Compressed.to_base58_check response#lockAccount#public_key in - printf "🔒 Locked account!\nPublic key: %s\n" pk_string)) + printf "🔒 Locked account!\nPublic key: %s\n" pk_string ) ) let generate_libp2p_keypair = Command.async @@ -1628,7 +1633,7 @@ let generate_libp2p_keypair = | Error e -> [%log fatal] "failed to generate libp2p keypair: $error" ~metadata:[ ("error", Error_json.error_to_yojson e) ] ; - exit 20))) + exit 20 ))) let trustlist_ip_flag = Command.Param.( @@ -1651,7 +1656,7 @@ let trustlist_add = trustlist_ip_string (Error.to_string_hum e) | Error e -> eprintf "Unknown error doing daemon RPC: %s" - (Error.to_string_hum e))) + (Error.to_string_hum e) ) ) let trustlist_remove = let open Deferred.Let_syntax in @@ -1668,7 +1673,7 @@ let trustlist_remove = trustlist_ip_string (Error.to_string_hum e) | Error e -> eprintf "Unknown error doing daemon RPC: %s" - (Error.to_string_hum e))) + (Error.to_string_hum e) ) ) let trustlist_list = let open Deferred.Let_syntax in @@ -1684,7 +1689,7 @@ let trustlist_list = List.iter ips ~f:(fun ip -> printf "%s\n" (Unix.Cidr.to_string ip)) | Error e -> eprintf "Unknown error doing daemon RPC: %s" - (Error.to_string_hum e))) + (Error.to_string_hum e) ) ) let get_peers_graphql = Command.async ~summary:"List the peers currently connected to the daemon" @@ -1702,7 +1707,7 @@ let get_peers_graphql = { host = Unix.Inet_addr.of_string peer#host ; libp2p_port = peer#libp2pPort ; peer_id = peer#peerId - })))) + } ) ) ) ) let add_peers_graphql = let open Command in @@ -1744,7 +1749,7 @@ let add_peers_graphql = "Could not parse %s as a peer address. It should use the \ format /ip4/IPADDR/tcp/PORT/p2p/PEERID" peer ; - Core.exit 1) + Core.exit 1 ) in let seed = Option.value ~default:true seed in let%map response = @@ -1759,7 +1764,7 @@ let add_peers_graphql = { host = Unix.Inet_addr.of_string peer#host ; libp2p_port = peer#libp2pPort ; peer_id = peer#peerId - })))) + } ) ) ) ) let compile_time_constants = Command.async @@ -1800,7 +1805,7 @@ let compile_time_constants = ; ( "coinbase" , `String (Currency.Amount.to_formatted_string - precomputed_values.constraint_constants.coinbase_amount) + precomputed_values.constraint_constants.coinbase_amount ) ) ; ( "block_window_duration_ms" , `Int @@ -1810,11 +1815,11 @@ let compile_time_constants = ; ( "sub_windows_per_window" , `Int (Unsigned.UInt32.to_int - consensus_constants.sub_windows_per_window) ) + consensus_constants.sub_windows_per_window ) ) ; ( "slots_per_sub_window" , `Int (Unsigned.UInt32.to_int - consensus_constants.slots_per_sub_window) ) + consensus_constants.slots_per_sub_window ) ) ; ( "slots_per_window" , `Int (Unsigned.UInt32.to_int consensus_constants.slots_per_window) @@ -1825,7 +1830,7 @@ let compile_time_constants = ) ] in - Core_kernel.printf "%s\n%!" (Yojson.Safe.to_string all_constants))) + Core_kernel.printf "%s\n%!" (Yojson.Safe.to_string all_constants) ) ) let node_status = let open Command.Param in @@ -1856,7 +1861,7 @@ let node_status = don't_wait_for (exit 33) ) ; let peer_ids_opt = Option.map peers ~f:(fun peers -> - List.map peers ~f:Mina_net2.Multiaddr.of_string) + List.map peers ~f:Mina_net2.Multiaddr.of_string ) in match%map Daemon_rpcs.Client.dispatch Daemon_rpcs.Get_node_status.rpc @@ -1867,16 +1872,16 @@ let node_status = if show_errors then all_status_data else List.filter all_status_data ~f:(fun td -> - match td with Ok _ -> true | Error _ -> false) + match td with Ok _ -> true | Error _ -> false ) in List.iter all_status_data ~f:(fun peer_status_data -> printf "%s\n%!" ( Yojson.Safe.to_string @@ Mina_networking.Rpcs.Get_node_status.response_to_yojson - peer_status_data )) + peer_status_data ) ) | Error err -> printf "Failed to get node status: %s\n%!" - (Error.to_string_hum err))) + (Error.to_string_hum err) ) ) let object_lifetime_statistics = let open Daemon_rpcs in @@ -1890,7 +1895,7 @@ let object_lifetime_statistics = print_endline stats | Error err -> printf "Failed to get object lifetime statistics: %s\n%!" - (Error.to_string_hum err))) + (Error.to_string_hum err) ) ) let archive_blocks = let params = @@ -1977,9 +1982,9 @@ let archive_blocks = ; Atom graphql_endpoint.name ] ; List [ Atom "error_message"; Atom e ] - ]) + ] ) | `Graphql_error e -> - Error.createf "GraphQL error: %s" e) + Error.createf "GraphQL error: %s" e ) in () in @@ -2012,10 +2017,10 @@ let archive_blocks = let%bind.Deferred.Or_error block_json = Or_error.try_with (fun () -> In_channel.with_file path ~f:(fun in_channel -> - Yojson.Safe.from_channel in_channel)) + Yojson.Safe.from_channel in_channel ) ) |> Result.map_error ~f:(fun err -> Error.tag_arg err "Could not parse JSON from file" path - String.sexp_of_t) + String.sexp_of_t ) |> Deferred.return in let open Deferred.Or_error.Let_syntax in @@ -2026,7 +2031,7 @@ let archive_blocks = Error.tag_arg (Error.of_string err) "Could not parse JSON as a precomputed block from \ file" - path String.sexp_of_t) + path String.sexp_of_t ) |> Deferred.return in send_precomputed_block precomputed_block @@ -2037,7 +2042,7 @@ let archive_blocks = Error.tag_arg (Error.of_string err) "Could not parse JSON as an extensional block from \ file" - path String.sexp_of_t) + path String.sexp_of_t ) |> Deferred.return in send_extensional_block extensional_block @@ -2054,7 +2059,7 @@ let archive_blocks = Format.eprintf "Failed to send block to archive node from %s. Error:@.%s@." path (Error.to_string_hum err) ; - add_to_failure_file path))) + add_to_failure_file path ) ) ) let receipt_chain_hash = let open Command.Let_syntax in @@ -2083,7 +2088,7 @@ let receipt_chain_hash = Receipt.Chain_hash.cons (Signed_command transaction.payload) previous_hash in - printf "%s\n" (Receipt.Chain_hash.to_base58_check hash)) + printf "%s\n" (Receipt.Chain_hash.to_base58_check hash) ) let chain_id_inputs = let open Deferred.Let_syntax in @@ -2112,7 +2117,7 @@ let chain_id_inputs = List.iter snark_keys ~f:(printf " %s@.") | Error err -> Format.eprintf "Could not get chain id inputs: %s@." - (Error.to_string_hum err))) + (Error.to_string_hum err) ) ) let hash_transaction = let open Command.Let_syntax in @@ -2129,7 +2134,7 @@ let hash_transaction = let hash = Transaction_hash.hash_command (Signed_command signed_command) in - printf "%s\n" (Transaction_hash.to_base58_check hash)) + printf "%s\n" (Transaction_hash.to_base58_check hash) ) let humanize_graphql_error ~(graphql_endpoint : Uri.t Cli_lib.Flag.Types.with_name) = function @@ -2139,7 +2144,7 @@ let humanize_graphql_error [ List [ Atom "uri"; Atom (Uri.to_string graphql_endpoint.value) ] ; List [ Atom "uri_flag"; Atom graphql_endpoint.name ] ; List [ Atom "error_message"; Atom e ] - ]) + ] ) | `Graphql_error e -> Error.createf "GraphQL error: %s" e @@ -2161,8 +2166,8 @@ let runtime_config = Format.eprintf "Failed to retrieve runtime configuration. Error:@.%s@." (Error.to_string_hum - (humanize_graphql_error ~graphql_endpoint err)) ; - exit 1)) + (humanize_graphql_error ~graphql_endpoint err) ) ; + exit 1 ) ) let thread_graph = Command.async @@ -2183,8 +2188,8 @@ let thread_graph = Format.eprintf "Failed to retrieve runtime configuration. Error:@.%s@." (Error.to_string_hum - (humanize_graphql_error ~graphql_endpoint e)) ; - exit 1)) + (humanize_graphql_error ~graphql_endpoint e) ) ; + exit 1 ) ) module Visualization = struct let create_command (type rpc_response) ~name ~f @@ -2202,7 +2207,7 @@ module Visualization = struct | Error e -> sprintf "Could not save file: %s\n" (Error.to_string_hum e) in - print_string message)) + print_string message ) ) module Frontier = struct let name = "transition-frontier" @@ -2213,7 +2218,7 @@ module Visualization = struct | `Active () -> Visualization_message.success name filename | `Bootstrapping -> - Visualization_message.bootstrap name) + Visualization_message.bootstrap name ) end module Registered_masks = struct diff --git a/src/app/cli/src/init/coda_run.ml b/src/app/cli/src/init/coda_run.ml index d276dcace3a..0bf83a396f8 100644 --- a/src/app/cli/src/init/coda_run.ml +++ b/src/app/cli/src/init/coda_run.ml @@ -197,7 +197,7 @@ let coda_status coda_ref = (Deferred.return (`String "Shutdown before Coda instance was created")) ~f:(fun t -> Mina_commands.get_status ~flag:`Performance t - >>| Daemon_rpcs.Types.Status.to_yojson) + >>| Daemon_rpcs.Types.Status.to_yojson ) let make_report exn_json ~conf_dir ~top_logger coda_ref = (* TEMP MAKE REPORT TRACE *) @@ -228,7 +228,7 @@ let make_report exn_json ~conf_dir ~top_logger coda_ref = let len = In_channel.length in_chan in In_channel.seek in_chan Int64.(max 0L (Int64.( + ) len (Int64.neg log_size))) ; - In_channel.input_all in_chan) + In_channel.input_all in_chan ) in Out_channel.write_all coda_short_log ~data:log | _ -> @@ -257,7 +257,7 @@ let make_report exn_json ~conf_dir ~top_logger coda_ref = ; "daemon.json" ] |> List.filter ~f:(fun f -> - eq (Core.Sys.file_exists (temp_config ^/ f)) `Yes) + eq (Core.Sys.file_exists (temp_config ^/ f)) `Yes ) in let files = tmp_files |> String.concat ~sep:" " in let tar_command = @@ -277,12 +277,12 @@ let setup_local_server ?(client_trustlist = []) ?rest_server_port ref (Unix.Cidr.Set.of_list ( Unix.Cidr.create ~base_address:Unix.Inet_addr.localhost ~bits:8 - :: client_trustlist )) + :: client_trustlist ) ) in (* Setup RPC server for client interactions *) let implement rpc f = Rpc.Rpc.implement rpc (fun () input -> - O1trace.thread ("serve_" ^ Rpc.Rpc.name rpc) (fun () -> f () input)) + O1trace.thread ("serve_" ^ Rpc.Rpc.name rpc) (fun () -> f () input) ) in let implement_notrace = Rpc.Rpc.implement in let logger = @@ -295,51 +295,51 @@ let setup_local_server ?(client_trustlist = []) ?rest_server_port Deferred.map ( Mina_commands.setup_and_submit_user_commands coda ts |> Participating_state.to_deferred_or_error ) - ~f:Or_error.join) + ~f:Or_error.join ) ; implement Daemon_rpcs.Get_balance.rpc (fun () aid -> return ( Mina_commands.get_balance coda aid - |> Participating_state.active_error )) + |> Participating_state.active_error ) ) ; implement Daemon_rpcs.Get_trust_status.rpc (fun () ip_address -> - return (Mina_commands.get_trust_status coda ip_address)) + return (Mina_commands.get_trust_status coda ip_address) ) ; implement Daemon_rpcs.Get_trust_status_all.rpc (fun () () -> - return (Mina_commands.get_trust_status_all coda)) + return (Mina_commands.get_trust_status_all coda) ) ; implement Daemon_rpcs.Reset_trust_status.rpc (fun () ip_address -> - return (Mina_commands.reset_trust_status coda ip_address)) + return (Mina_commands.reset_trust_status coda ip_address) ) ; implement Daemon_rpcs.Chain_id_inputs.rpc (fun () () -> - return (Mina_commands.chain_id_inputs coda)) + return (Mina_commands.chain_id_inputs coda) ) ; implement Daemon_rpcs.Verify_proof.rpc (fun () (aid, tx, proof) -> return ( Mina_commands.verify_payment coda aid tx proof - |> Participating_state.active_error |> Or_error.join )) + |> Participating_state.active_error |> Or_error.join ) ) ; implement Daemon_rpcs.Get_public_keys_with_details.rpc (fun () () -> return ( Mina_commands.get_keys_with_details coda - |> Participating_state.active_error )) + |> Participating_state.active_error ) ) ; implement Daemon_rpcs.Get_public_keys.rpc (fun () () -> return ( Mina_commands.get_public_keys coda - |> Participating_state.active_error )) + |> Participating_state.active_error ) ) ; implement Daemon_rpcs.Get_nonce.rpc (fun () aid -> return ( Mina_commands.get_nonce coda aid - |> Participating_state.active_error )) + |> Participating_state.active_error ) ) ; implement Daemon_rpcs.Get_inferred_nonce.rpc (fun () aid -> return ( Mina_lib.get_inferred_nonce_from_transaction_pool_and_ledger coda aid - |> Participating_state.active_error )) + |> Participating_state.active_error ) ) ; implement_notrace Daemon_rpcs.Get_status.rpc (fun () flag -> - Mina_commands.get_status ~flag coda) + Mina_commands.get_status ~flag coda ) ; implement Daemon_rpcs.Clear_hist_status.rpc (fun () flag -> - Mina_commands.clear_hist_status ~flag coda) + Mina_commands.clear_hist_status ~flag coda ) ; implement Daemon_rpcs.Get_ledger.rpc (fun () lh -> (* getting the ledger may take more time than a heartbeat timeout run in thread to allow RPC heartbeats to proceed *) - Async.In_thread.run (fun () -> Mina_lib.get_ledger coda lh)) + Async.In_thread.run (fun () -> Mina_lib.get_ledger coda lh) ) ; implement Daemon_rpcs.Get_snarked_ledger.rpc (fun () lh -> - Mina_lib.get_snarked_ledger coda lh |> return) + Mina_lib.get_snarked_ledger coda lh |> return ) ; implement Daemon_rpcs.Get_staking_ledger.rpc (fun () which -> ( match which with | Next -> @@ -351,7 +351,7 @@ let setup_local_server ?(client_trustlist = []) ?rest_server_port Ok ledger | `Notfinalized -> Or_error.error_string - "next staking ledger is not finalized yet") + "next staking ledger is not finalized yet" ) | Current -> Option.value_map (Mina_lib.staking_ledger coda) @@ -362,25 +362,25 @@ let setup_local_server ?(client_trustlist = []) ?rest_server_port | Genesis_epoch_ledger l -> Mina_ledger.Ledger.to_list l | Ledger_db db -> - Mina_ledger.Ledger.Db.to_list db) - |> Deferred.return) + Mina_ledger.Ledger.Db.to_list db ) + |> Deferred.return ) ; implement Daemon_rpcs.Stop_daemon.rpc (fun () () -> Scheduler.yield () >>= (fun () -> exit 0) |> don't_wait_for ; - Deferred.unit) + Deferred.unit ) ; implement Daemon_rpcs.Snark_job_list.rpc (fun () () -> - return (snark_job_list_json coda |> Participating_state.active_error)) + return (snark_job_list_json coda |> Participating_state.active_error) ) ; implement Daemon_rpcs.Snark_pool_list.rpc (fun () () -> - return (snark_pool_list coda)) + return (snark_pool_list coda) ) ; implement Daemon_rpcs.Start_tracing.rpc (fun () () -> let open Mina_lib.Config in - Coda_tracing.start (Mina_lib.config coda).conf_dir) + Coda_tracing.start (Mina_lib.config coda).conf_dir ) ; implement Daemon_rpcs.Stop_tracing.rpc (fun () () -> - Coda_tracing.stop () ; Deferred.unit) + Coda_tracing.stop () ; Deferred.unit ) ; implement Daemon_rpcs.Visualization.Frontier.rpc (fun () filename -> - return (Mina_lib.visualize_frontier ~filename coda)) + return (Mina_lib.visualize_frontier ~filename coda) ) ; implement Daemon_rpcs.Visualization.Registered_masks.rpc (fun () filename -> - return (Mina_ledger.Ledger.Debug.visualize ~filename)) + return (Mina_ledger.Ledger.Debug.visualize ~filename) ) ; implement Daemon_rpcs.Add_trustlist.rpc (fun () cidr -> return (let cidr_str = Unix.Cidr.to_string cidr in @@ -388,7 +388,7 @@ let setup_local_server ?(client_trustlist = []) ?rest_server_port Or_error.errorf "%s already present in trustlist" cidr_str else ( client_trustlist := Unix.Cidr.Set.add !client_trustlist cidr ; - Ok () ))) + Ok () ) ) ) ; implement Daemon_rpcs.Remove_trustlist.rpc (fun () cidr -> return (let cidr_str = Unix.Cidr.to_string cidr in @@ -396,14 +396,14 @@ let setup_local_server ?(client_trustlist = []) ?rest_server_port Or_error.errorf "%s not present in trustlist" cidr_str else ( client_trustlist := Unix.Cidr.Set.remove !client_trustlist cidr ; - Ok () ))) + Ok () ) ) ) ; implement Daemon_rpcs.Get_trustlist.rpc (fun () () -> - return (Set.to_list !client_trustlist)) + return (Set.to_list !client_trustlist) ) ; implement Daemon_rpcs.Get_node_status.rpc (fun () peers -> - Node_status.get_node_status_from_peers (Mina_lib.net coda) peers) + Node_status.get_node_status_from_peers (Mina_lib.net coda) peers ) ; implement Daemon_rpcs.Get_object_lifetime_statistics.rpc (fun () () -> return - (Yojson.Safe.pretty_to_string @@ Allocation_functor.Table.dump ())) + (Yojson.Safe.pretty_to_string @@ Allocation_functor.Table.dump ()) ) ] in let snark_worker_impls = @@ -421,7 +421,7 @@ let setup_local_server ?(client_trustlist = []) ?rest_server_port ~metadata:[ ("work_spec", Snark_worker.Work.Spec.to_yojson r) ] "responding to a Get_work request with some new work" ; Mina_metrics.(Counter.inc_one Snark_work.snark_work_assigned_rpc) ; - (r, key))) + (r, key)) ) ; implement Snark_worker.Rpcs_versioned.Submit_work.Latest.rpc (fun () (work : Snark_worker.Work.Result.t) -> Mina_metrics.( @@ -435,8 +435,8 @@ let setup_local_server ?(client_trustlist = []) ?rest_server_port Perf_histograms.add_span ~name:"snark_worker_merge_time" total | `Transition -> Perf_histograms.add_span ~name:"snark_worker_transition_time" - total) ; - Deferred.return @@ Mina_lib.add_work coda work) + total ) ; + Deferred.return @@ Mina_lib.add_work coda work ) ] in let create_graphql_server ~bind_to_address ~schema ~server_description port = @@ -453,7 +453,7 @@ let setup_local_server ?(client_trustlist = []) ?rest_server_port ~metadata: [ ("error", `String (Exn.to_string_mach exn)) ; ("context", `String "rest_server") - ])) + ] ) ) (Tcp.Where_to_listen.bind_to bind_to_address (On_port port)) (fun ~body _sock req -> let uri = Cohttp.Request.uri req in @@ -484,11 +484,11 @@ let setup_local_server ?(client_trustlist = []) ?rest_server_port status `Performance >>| lift | _ -> Server.respond_string ~status:`Not_found "Route not found" - >>| lift)) + >>| lift )) |> Deferred.map ~f:(fun _ -> [%log info] !"Created %s at: http://localhost:%i/graphql" - server_description port) + server_description port ) in Option.iter rest_server_port ~f:(fun rest_server_port -> O1trace.background_thread "serve_graphql" (fun () -> @@ -497,7 +497,7 @@ let setup_local_server ?(client_trustlist = []) ?rest_server_port Tcp.Bind_to_address.( if insecure_rest_server then All_addresses else Localhost) ~schema:Mina_graphql.schema ~server_description:"GraphQL server" - rest_server_port)) ; + rest_server_port ) ) ; (*Second graphql server with limited queries exposed*) Option.iter limited_graphql_port ~f:(fun rest_server_port -> O1trace.background_thread "serve_limited_graphql" (fun () -> @@ -507,7 +507,7 @@ let setup_local_server ?(client_trustlist = []) ?rest_server_port if open_limited_graphql_port then All_addresses else Localhost) ~schema:Mina_graphql.schema_limited ~server_description:"GraphQL server with limited queries" - rest_server_port)) ; + rest_server_port ) ) ; let where_to_listen = Tcp.Where_to_listen.bind_to All_addresses (On_port (Mina_lib.client_port coda)) @@ -523,14 +523,14 @@ let setup_local_server ?(client_trustlist = []) ?rest_server_port ~metadata: [ ("error", `String (Exn.to_string_mach exn)) ; ("context", `String "rpc_tcp_server") - ])) + ] ) ) where_to_listen (fun address reader writer -> let address = Socket.Address.Inet.addr address in if not (Set.exists !client_trustlist ~f:(fun cidr -> - Unix.Cidr.does_match cidr address)) + Unix.Cidr.does_match cidr address ) ) then ( [%log error] !"Rejecting client connection from $address, it is not \ @@ -542,21 +542,21 @@ let setup_local_server ?(client_trustlist = []) ?rest_server_port Rpc.Connection.server_with_close ~handshake_timeout: (Time.Span.of_sec - Mina_compile_config.rpc_handshake_timeout_sec) + Mina_compile_config.rpc_handshake_timeout_sec ) ~heartbeat_config: (Rpc.Connection.Heartbeat_config.create ~timeout: (Time_ns.Span.of_sec - Mina_compile_config.rpc_heartbeat_timeout_sec) + Mina_compile_config.rpc_heartbeat_timeout_sec ) ~send_every: (Time_ns.Span.of_sec - Mina_compile_config.rpc_heartbeat_send_every_sec) - ()) + Mina_compile_config.rpc_heartbeat_send_every_sec ) + () ) reader writer ~implementations: (Rpc.Implementations.create_exn ~implementations:(client_impls @ snark_worker_impls) - ~on_unknown_rpc:`Raise) + ~on_unknown_rpc:`Raise ) ~connection_state:(fun _ -> ()) ~on_handshake_error: (`Call @@ -570,7 +570,7 @@ let setup_local_server ?(client_trustlist = []) ?rest_server_port ; ( "address" , `String (Unix.Inet_addr.to_string address) ) ] ; - Deferred.unit))))) + Deferred.unit ) ) ) ) ) let coda_crash_message ~log_issue ~action ~error = let followup = @@ -610,7 +610,7 @@ let handle_crash e ~time_controller ~conf_dir ~child_pids ~top_logger coda_ref = (* this circumvents using Child_processes.kill, and instead sends SIGKILL to all children *) Hashtbl.keys child_pids |> List.iter ~f:(fun pid -> - ignore (Signal.send Signal.kill (`Pid pid) : [ `No_such_process | `Ok ])) ; + ignore (Signal.send Signal.kill (`Pid pid) : [ `No_such_process | `Ok ]) ) ; let exn_json = Error_json.error_to_yojson (Error.of_exn ~backtrace:`Get e) in [%log' fatal top_logger] "Unhandled top-level exception: $exn\nGenerating crash report" @@ -709,7 +709,7 @@ let handle_shutdown ~monitor ~time_controller ~conf_dir ~child_pids ~top_logger handle_crash exn ~time_controller ~conf_dir ~child_pids ~top_logger coda_ref in - Stdlib.exit 1)) ; + Stdlib.exit 1 ) ) ; Async_unix.Signal.( handle terminating ~f:(fun signal -> log_shutdown ~conf_dir ~top_logger coda_ref ; @@ -721,4 +721,4 @@ let handle_shutdown ~monitor ~time_controller ~conf_dir ~child_pids ~top_logger !"Mina process was interrupted by $signal" ~metadata:[ ("signal", `String (to_string signal)) ] ; (* causes async shutdown and at_exit handlers to run *) - Async.shutdown 130)) + Async.shutdown 130 )) diff --git a/src/app/cli/src/init/find_ip.ml b/src/app/cli/src/init/find_ip.ml index bfa5c218733..56d3daba72d 100644 --- a/src/app/cli/src/init/find_ip.ml +++ b/src/app/cli/src/init/find_ip.ml @@ -18,7 +18,7 @@ let ip_service_result { uri; body_handler } ~logger = Monitor.try_with ~here:[%here] (fun () -> let%bind resp, body = Client.get (Uri.of_string uri) in let%map body = Body.to_string body in - match resp.status with `OK -> Some (body_handler body) | _ -> None) + match resp.status with `OK -> Some (body_handler body) | _ -> None ) with | Ok v -> v diff --git a/src/app/cli/src/init/transaction_snark_profiler.ml b/src/app/cli/src/init/transaction_snark_profiler.ml index 45883522c7a..7f81b481321 100644 --- a/src/app/cli/src/init/transaction_snark_profiler.ml +++ b/src/app/cli/src/init/transaction_snark_profiler.ml @@ -25,7 +25,7 @@ let create_ledger_and_transactions num_transitions = let public_key = Public_key.compress k.public_key in let account_id = Account_id.create public_key Token_id.default in Mina_ledger.Ledger.create_new_account_exn ledger account_id - (Account.create account_id (Currency.Balance.of_int 10_000))) ; + (Account.create account_id (Currency.Balance.of_int 10_000)) ) ; let txn (from_kp : Signature_lib.Keypair.t) (to_kp : Signature_lib.Keypair.t) amount fee nonce = let to_pk = Public_key.compress to_kp.public_key in @@ -40,7 +40,7 @@ let create_ledger_and_transactions num_transitions = let nonces = Public_key.Compressed.Table.of_alist_exn (List.map (Array.to_list keys) ~f:(fun k -> - (Public_key.compress k.public_key, Account.Nonce.zero))) + (Public_key.compress k.public_key, Account.Nonce.zero) ) ) in let random_transaction () : Signed_command.With_valid_signature.t = let sender_idx = Random.int num_accounts in @@ -57,8 +57,7 @@ let create_ledger_and_transactions num_transitions = | `Count n -> let num_transactions = n - 2 in let transactions = - List.rev - (List.init num_transactions ~f:(fun _ -> random_transaction ())) + List.rev (List.init num_transactions ~f:(fun _ -> random_transaction ())) in let fee_transfer = let open Currency.Fee in @@ -66,7 +65,7 @@ let create_ledger_and_transactions num_transitions = List.fold transactions ~init:zero ~f:(fun acc t -> Option.value_exn (add acc - (Signed_command.Payload.fee (t :> Signed_command.t).payload))) + (Signed_command.Payload.fee (t :> Signed_command.t).payload) ) ) in Fee_transfer.create_single ~receiver_pk:(Public_key.compress keys.(0).public_key) @@ -80,7 +79,7 @@ let create_ledger_and_transactions num_transitions = in let transitions = List.map transactions ~f:(fun t -> - Transaction.Command (User_command.Signed_command t)) + Transaction.Command (User_command.Signed_command t) ) @ [ Coinbase coinbase; Fee_transfer fee_transfer ] in (ledger, transitions) @@ -117,7 +116,7 @@ let precomputed_values = Precomputed_values.compiled_inputs let state_body = Mina_state.( Lazy.map precomputed_values ~f:(fun values -> - values.protocol_state_with_hashes.data |> Protocol_state.body)) + values.protocol_state_with_hashes.data |> Protocol_state.body )) let curr_state_view = Lazy.map state_body ~f:Mina_state.Protocol_state.Body.view @@ -181,10 +180,10 @@ let profile (module T : Transaction_snark.S) sparse_ledger0 { Transaction_protocol_state.Poly.transaction = t ; block_data = Lazy.force state_body } - (unstage (Sparse_ledger.handler sparse_ledger)))) + (unstage (Sparse_ledger.handler sparse_ledger)) ) ) in ( (Time.Span.max span max_span, sparse_ledger', coinbase_stack_target) - , proof )) + , proof ) ) in let rec merge_all serial_time proofs = match proofs with @@ -197,10 +196,10 @@ let profile (module T : Transaction_snark.S) sparse_ledger0 let pair_time, proof = time (fun () -> Async.Thread_safe.block_on_async_exn (fun () -> - T.merge ~sok_digest:Sok_message.Digest.default x y) - |> Or_error.ok_exn) + T.merge ~sok_digest:Sok_message.Digest.default x y ) + |> Or_error.ok_exn ) in - (Time.Span.max max_time pair_time, proof)) + (Time.Span.max max_time pair_time, proof) ) in merge_all (Time.Span.( + ) serial_time layer_time) new_proofs in @@ -244,7 +243,7 @@ let check_base_snarks sparse_ledger0 (transitions : Transaction.Valid.t list) } (unstage (Sparse_ledger.handler sparse_ledger)) in - sparse_ledger') + sparse_ledger' ) : Sparse_ledger.t ) ; "Base constraint system satisfied" @@ -285,7 +284,7 @@ let generate_base_snarks_witness sparse_ledger0 } (unstage (Sparse_ledger.handler sparse_ledger)) in - sparse_ledger') + sparse_ledger' ) : Sparse_ledger.t ) ; "Base constraint system satisfied" @@ -296,7 +295,7 @@ let run profiler num_transactions repeats preeval = (List.fold ~init:[] transactions ~f:(fun participants t -> List.rev_append (Transaction.accounts_accessed (Transaction.forget t)) - participants)) + participants ) ) in for i = 1 to repeats do let message = profiler sparse_ledger transactions preeval in @@ -312,15 +311,15 @@ let main num_transactions repeats preeval () = let proof_level = Genesis_constants.Proof_level.Full end) in - run (profile (module T)) num_transactions repeats preeval) + run (profile (module T)) num_transactions repeats preeval ) let dry num_transactions repeats preeval () = Test_util.with_randomness 123456789 (fun () -> - run check_base_snarks num_transactions repeats preeval) + run check_base_snarks num_transactions repeats preeval ) let witness num_transactions repeats preeval () = Test_util.with_randomness 123456789 (fun () -> - run generate_base_snarks_witness num_transactions repeats preeval) + run generate_base_snarks_witness num_transactions repeats preeval ) let command = let open Command.Let_syntax in @@ -354,4 +353,4 @@ let command = let repeats = Option.value repeats ~default:1 in if witness_only then witness num_transactions repeats preeval else if check_only then dry num_transactions repeats preeval - else main num_transactions repeats preeval) + else main num_transactions repeats preeval ) diff --git a/src/app/cli/src/tests/coda_archive_processor_test.ml b/src/app/cli/src/tests/coda_archive_processor_test.ml index 9b19fe389f3..8e5bc8296ba 100644 --- a/src/app/cli/src/tests/coda_archive_processor_test.ml +++ b/src/app/cli/src/tests/coda_archive_processor_test.ml @@ -49,7 +49,7 @@ let main () = let%bind _, observed_transitions = Pipe.fold new_block_pipe ~init:(0, []) ~f:(fun (i, acc) transition -> if i >= num_blocks_to_wait then Pipe.close_read new_block_pipe ; - Deferred.return (i + 1, transition :: acc)) + Deferred.return (i + 1, transition :: acc) ) in let%bind () = after (Time.Span.of_sec 10.) in Deferred.List.iter observed_transitions @@ -73,7 +73,7 @@ let main () = | Ok () -> () | Error e -> - failwith @@ Caqti_error.show e) + failwith @@ Caqti_error.show e ) let command = Command.async diff --git a/src/app/cli/src/tests/coda_bootstrap_test.ml b/src/app/cli/src/tests/coda_bootstrap_test.ml index cc0ca502d61..3c8d7c85164 100644 --- a/src/app/cli/src/tests/coda_bootstrap_test.ml +++ b/src/app/cli/src/tests/coda_bootstrap_test.ml @@ -35,7 +35,7 @@ let main () = ~metadata:[ ("status", Sync_status.to_yojson sync_status) ] "Bootstrap node received status: $status" ; Hash_set.add previous_status sync_status ; - Deferred.unit)) + Deferred.unit ) ) |> don't_wait_for ; let%bind () = Coda_worker_testnet.Restarts.trigger_bootstrap testnet ~logger diff --git a/src/app/cli/src/tests/coda_change_snark_worker_test.ml b/src/app/cli/src/tests/coda_change_snark_worker_test.ml index 1ffec05787e..dcedade3947 100644 --- a/src/app/cli/src/tests/coda_change_snark_worker_test.ml +++ b/src/app/cli/src/tests/coda_change_snark_worker_test.ml @@ -51,14 +51,14 @@ let main () = ~f:(fun { Transaction_snark_work.prover; _ } -> [%log trace] "Prover of completed work" ~metadata:[ ("Prover", Public_key.Compressed.to_yojson prover) ] ; - Public_key.Compressed.equal prover public_key) + Public_key.Compressed.equal prover public_key ) then ( [%log trace] "Found snark prover ivar filled" ~metadata: [ ("public key", Public_key.Compressed.to_yojson public_key) ] ; Ivar.fill_if_empty found_snark_prover_ivar () ) else () ; - Deferred.unit) + Deferred.unit ) |> don't_wait_for ; Ivar.read found_snark_prover_ivar in diff --git a/src/app/cli/src/tests/coda_delegation_test.ml b/src/app/cli/src/tests/coda_delegation_test.ml index 7081d77bab2..f0a873f7dcb 100644 --- a/src/app/cli/src/tests/coda_delegation_test.ml +++ b/src/app/cli/src/tests/coda_delegation_test.ml @@ -49,7 +49,7 @@ let main () = ( Public_key.Compressed.to_base58_check @@ Account.public_key acct ) ) ; ("balance", `Int (Currency.Balance.to_int acct.balance)) - ]) ; + ] ) ; (* second account is delegator; see genesis_ledger/test_delegation_ledger.ml *) let ((_, delegator_account) as delegator) = List.nth_exn accounts 2 in let delegator_pubkey = Account.public_key delegator_account in @@ -86,7 +86,7 @@ let main () = incr delegator_production_count ; if Int.equal !delegator_production_count delegator_production_goal then Ivar.fill delegator_ivar () ) ; - return ())) ; + return () ) ) ; [%log info] "Started delegator transition reader" ; let%bind delegatee_transition_reader = Coda_process.new_block_exn worker delegatee_pubkey @@ -110,7 +110,7 @@ let main () = incr delegatee_production_count ; if Int.equal !delegatee_production_count delegatee_production_goal then Ivar.fill delegatee_ivar () ) ; - return ())) ; + return () ) ) ; [%log info] "Started delegatee transition reader" ; (* wait for delegator to produce some blocks *) let%bind () = Ivar.read delegator_ivar in diff --git a/src/app/cli/src/tests/coda_long_fork.ml b/src/app/cli/src/tests/coda_long_fork.ml index 54403085796..af6eecd15c3 100644 --- a/src/app/cli/src/tests/coda_long_fork.ml +++ b/src/app/cli/src/tests/coda_long_fork.ml @@ -47,4 +47,4 @@ let command = ~doc:"the waiting time after the nodes coming back alive" (optional_with_default 120 int) in - main num_block_producers waiting_time) + main num_block_producers waiting_time ) diff --git a/src/app/cli/src/tests/coda_peers_test.ml b/src/app/cli/src/tests/coda_peers_test.ml index b6b5444dbbb..a01146caa88 100644 --- a/src/app/cli/src/tests/coda_peers_test.ml +++ b/src/app/cli/src/tests/coda_peers_test.ml @@ -58,8 +58,8 @@ let main () = ~of_: (S.of_list ( peers - |> List.map ~f:(fun p -> p.Network_peer.Peer.libp2p_port) )) - (S.of_list expected_peer_ports) ))) + |> List.map ~f:(fun p -> p.Network_peer.Peer.libp2p_port) ) ) + (S.of_list expected_peer_ports) ) ) ) in Deferred.List.iter workers ~f:(Coda_process.disconnect ~logger) diff --git a/src/app/cli/src/tests/coda_process.ml b/src/app/cli/src/tests/coda_process.ml index 37237cb6e9e..8bfc4350ab5 100644 --- a/src/app/cli/src/tests/coda_process.ml +++ b/src/app/cli/src/tests/coda_process.ml @@ -61,7 +61,7 @@ let local_config ?block_production_interval:_ ~is_seed ~peers ~addrs_and_ports ~f: (Fn.compose (function [ a; b ] -> Some (a, b) | _ -> None) - (String.split ~on:'=')) ) + (String.split ~on:'=') ) ) ; block_production_key ; snark_worker_key ; work_selection_method diff --git a/src/app/cli/src/tests/coda_processes.ml b/src/app/cli/src/tests/coda_processes.ml index 2bd45cf353f..0401b08c003 100644 --- a/src/app/cli/src/tests/coda_processes.ml +++ b/src/app/cli/src/tests/coda_processes.ml @@ -19,7 +19,7 @@ let net_configs n = let net = Or_error.ok_exn net in let ips = List.init n ~f:(fun i -> - Unix.Inet_addr.of_string @@ sprintf "127.0.0.1%i" i) + Unix.Inet_addr.of_string @@ sprintf "127.0.0.1%i" i ) in let%bind addrs_and_ports_list = Deferred.List.mapi ips ~f:(fun i ip -> @@ -32,19 +32,19 @@ let net_configs n = ; peer = Some (Network_peer.Peer.create ip ~libp2p_port - ~peer_id:(Mina_net2.Keypair.to_peer_id key)) + ~peer_id:(Mina_net2.Keypair.to_peer_id key) ) ; libp2p_port ; client_port } - , key )) + , key ) ) in let all_peers = addrs_and_ports_list in let peers = List.init n ~f:(fun i -> - List.take all_peers i @ List.drop all_peers (i + 1)) + List.take all_peers i @ List.drop all_peers (i + 1) ) in let%map () = Mina_net2.shutdown net in - (addrs_and_ports_list, List.map ~f:(List.map ~f:fst) peers)) + (addrs_and_ports_list, List.map ~f:(List.map ~f:fst) peers) ) let offset (consensus_constants : Consensus.Constants.t) = Core.Time.( @@ -79,7 +79,7 @@ let local_configs ?block_production_interval List.mapi args ~f:(fun i ((addrs_and_ports, libp2p_keypair), peers) -> let public_key = Option.bind snark_worker_public_keys ~f:(fun keys -> - List.nth_exn keys i) + List.nth_exn keys i ) in let addrs_and_ports = Node_addrs_and_ports.to_display addrs_and_ports in let peers = List.map ~f:Node_addrs_and_ports.to_multiaddr_exn peers in @@ -89,7 +89,7 @@ let local_configs ?block_production_interval ~block_production_key:(block_production_keys i) ~work_selection_method ~trace_dir ~is_archive_rocksdb:(is_archive_rocksdb i) ~archive_process_location:(archive_process_location i) - ~offset ~max_concurrent_connections ~runtime_config ()) + ~offset ~max_concurrent_connections ~runtime_config () ) in configs diff --git a/src/app/cli/src/tests/coda_restarts_and_txns_holy_grail.ml b/src/app/cli/src/tests/coda_restarts_and_txns_holy_grail.ml index 59da3847369..7227150a05b 100644 --- a/src/app/cli/src/tests/coda_restarts_and_txns_holy_grail.ml +++ b/src/app/cli/src/tests/coda_restarts_and_txns_holy_grail.ml @@ -64,4 +64,4 @@ let command = flag "--num-block-producers" ~aliases:[ "num-block-producers" ] ~doc:"NUM number of block producers to have" (required int) in - main num_block_producers) + main num_block_producers ) diff --git a/src/app/cli/src/tests/coda_shared_prefix_multiproducer_test.ml b/src/app/cli/src/tests/coda_shared_prefix_multiproducer_test.ml index 1628b7cff1b..b45a4201c7a 100644 --- a/src/app/cli/src/tests/coda_shared_prefix_multiproducer_test.ml +++ b/src/app/cli/src/tests/coda_shared_prefix_multiproducer_test.ml @@ -39,4 +39,4 @@ let command = flag "--payments" ~aliases:[ "payments" ] no_arg ~doc:"enable the payment check" in - main num_block_producers enable_payments) + main num_block_producers enable_payments ) diff --git a/src/app/cli/src/tests/coda_shared_prefix_test.ml b/src/app/cli/src/tests/coda_shared_prefix_test.ml index ee1cbeea04b..32b9561b1df 100644 --- a/src/app/cli/src/tests/coda_shared_prefix_test.ml +++ b/src/app/cli/src/tests/coda_shared_prefix_test.ml @@ -30,4 +30,4 @@ let command = flag "--who-produces" ~aliases:[ "who-produces" ] ~doc:"ID node number which will be producing blocks" (required int) in - main who_produces) + main who_produces ) diff --git a/src/app/cli/src/tests/coda_transitive_peers_test.ml b/src/app/cli/src/tests/coda_transitive_peers_test.ml index 9526f823294..b7407fdb653 100644 --- a/src/app/cli/src/tests/coda_transitive_peers_test.ml +++ b/src/app/cli/src/tests/coda_transitive_peers_test.ml @@ -42,7 +42,7 @@ let main () = let new_node_addrs_and_ports_list, _ = new_node_net_config in let expected_peers_addrs_keypairs = List.map configs ~f:(fun c -> - (Node_addrs_and_ports.of_display c.addrs_and_ports, c.libp2p_keypair)) + (Node_addrs_and_ports.of_display c.addrs_and_ports, c.libp2p_keypair) ) in let expected_peers_addr, expected_peers = List.fold ~init:([], []) expected_peers_addrs_keypairs @@ -50,7 +50,7 @@ let main () = ( Node_addrs_and_ports.to_multiaddr_exn p :: peer_addrs , Network_peer.Peer.create p.external_ip ~libp2p_port:p.libp2p_port ~peer_id:(Mina_net2.Keypair.to_peer_id k) - :: peers )) + :: peers ) ) in let addrs_and_ports, libp2p_keypair = let addr_and_ports, k = List.nth_exn new_node_addrs_and_ports_list n in diff --git a/src/app/cli/src/tests/coda_worker.ml b/src/app/cli/src/tests/coda_worker.ml index a14d5a45825..fb45b8809dc 100644 --- a/src/app/cli/src/tests/coda_worker.ml +++ b/src/app/cli/src/tests/coda_worker.ml @@ -368,7 +368,7 @@ module T = struct Option.value_map trace_dir ~f:(fun d -> let%bind () = Async.Unix.mkdir ~p:() d in - Coda_tracing.start d) + Coda_tracing.start d ) ~default:Deferred.unit in let%bind () = File_system.create_dir conf_dir in @@ -387,12 +387,12 @@ module T = struct let block_production_keypair = Option.map block_production_key ~f:(fun i -> List.nth_exn (Lazy.force Genesis_ledger.accounts) i - |> Genesis_ledger.keypair_of_account_record_exn) + |> Genesis_ledger.keypair_of_account_record_exn ) in let block_production_keypairs = block_production_keypair |> Option.map ~f:(fun kp -> - (kp, Public_key.compress kp.Keypair.public_key)) + (kp, Public_key.compress kp.Keypair.public_key) ) |> Option.to_list |> Keypair.And_compressed_pk.Set.of_list in let block_production_pubkeys = @@ -474,7 +474,7 @@ module T = struct ~proposed_protocol_version_opt:None ~work_selection_method: (Cli_lib.Arg_type.work_selection_method_to_module - work_selection_method) + work_selection_method ) ~snark_worker_config: Mina_lib.Config.Snark_worker_config. { initial_snark_worker_key = snark_worker_key @@ -493,8 +493,8 @@ module T = struct ~archive_process_location: (Option.map archive_process_location ~f:(fun host_and_port -> Cli_lib.Flag.Types. - { name = "dummy"; value = host_and_port })) - ~log_precomputed_blocks:false ~stop_time:48 ()) + { name = "dummy"; value = host_and_port } ) ) + ~log_precomputed_blocks:false ~stop_time:48 () ) in let coda_ref : Mina_lib.t option ref = ref None in Coda_run.handle_shutdown ~monitor ~time_controller ~conf_dir @@ -507,7 +507,7 @@ module T = struct coda_ref := Some coda ; [%log info] "Setting up snark worker " ; Coda_run.setup_local_server coda ; - coda) + coda ) () in [%log info] "Worker finish setting up coda" ; @@ -537,7 +537,7 @@ module T = struct ~body:(Payment { source_pk = sender_pk; receiver_pk; amount }) ~sign_choice: (User_command_input.Sign_choice.Keypair - (Keypair.of_private_key_exn sender_sk)) + (Keypair.of_private_key_exn sender_sk) ) () in let payment_input = build_user_command_input amount sk pk fee in @@ -594,7 +594,7 @@ module T = struct reader end? dropping this write..." ; Linear_pipe.write_without_pushback_if_open w (prev_state_hash, state_hash) ; - Deferred.unit)) ; + Deferred.unit ) ) ; return r.pipe in let coda_validated_transitions_keyswaptest () = @@ -608,7 +608,7 @@ module T = struct [%log error] "[coda_root_diff] why is this w pipe closed? did \ someone close the reader end? dropping this write..." ; - Linear_pipe.write_if_open w diff)) ; + Linear_pipe.write_if_open w diff ) ) ; return r.pipe in let coda_initialization_finish_signal () = @@ -649,7 +649,7 @@ module T = struct | Error json -> failwith (sprintf "Receiving sync status error: %s" - (Yojson.Basic.to_string json))) + (Yojson.Basic.to_string json) ) ) | _ -> failwith "Expected to get a stream of sync updates" ) | Error e -> @@ -682,7 +682,7 @@ module T = struct ; coda_replace_snark_worker_key = with_monitor coda_replace_snark_worker_key ; coda_stop_snark_worker = with_monitor coda_stop_snark_worker - }) + } ) let init_connection_state ~connection:_ ~worker_state:_ = return end diff --git a/src/app/cli/src/tests/coda_worker_testnet.ml b/src/app/cli/src/tests/coda_worker_testnet.ml index f8355109a3c..af93f25ca32 100644 --- a/src/app/cli/src/tests/coda_worker_testnet.ml +++ b/src/app/cli/src/tests/coda_worker_testnet.ml @@ -36,11 +36,11 @@ module Api = struct let user_cmds_under_inspection = Hashtbl.create (module User_command) in - `On (`Synced user_cmds_under_inspection)) + `On (`Synced user_cmds_under_inspection) ) in let locks = Array.init (Array.length workers) ~f:(fun _ -> - (ref 0, Condition.create ())) + (ref 0, Condition.create ()) ) in let root_lengths = Array.init (Array.length workers) ~f:(fun _ -> 0) in let restart_signals = @@ -114,7 +114,7 @@ module Api = struct ( match t.status.(i) with | `On (`Synced user_cmds_under_inspection) -> Hashtbl.iter user_cmds_under_inspection ~f:(fun { passed_root; _ } -> - Ivar.fill passed_root ()) + Ivar.fill passed_root () ) | _ -> () ) ; t.status.(i) <- `Off ; @@ -135,7 +135,7 @@ module Api = struct ~memo ~valid_until ~body ~sign_choice: (User_command_input.Sign_choice.Keypair - (Keypair.of_private_key_exn sk)) + (Keypair.of_private_key_exn sk) ) () in let%map user_cmd = @@ -153,7 +153,7 @@ module Api = struct t i delegator_sk fee valid_until ~body: (Stake_delegation - (Set_delegate { delegator; new_delegate = delegate_pk })) + (Set_delegate { delegator; new_delegate = delegate_pk }) ) let send_payment t i sender_sk receiver_pk amount fee valid_until = let source_pk = @@ -177,7 +177,7 @@ module Api = struct let validated_transitions_keyswaptest t i = run_online_worker ~f:(fun worker -> - Coda_process.validated_transitions_keyswaptest_exn worker) + Coda_process.validated_transitions_keyswaptest_exn worker ) t i let new_user_command_and_subscribe t i key = @@ -186,7 +186,7 @@ module Api = struct let teardown t ~logger = Deferred.Array.iteri ~how:`Parallel t.workers ~f:(fun i _ -> - stop t i ~logger) + stop t i ~logger ) let setup_bootstrap_signal t i = let signal = Ivar.create () in @@ -209,7 +209,7 @@ let start_prefix_check logger workers events testnet ~acceptable_delay = let all_transitions_r, all_transitions_w = Linear_pipe.create () in let%map chains = Deferred.Array.init (Array.length workers) ~f:(fun i -> - Coda_process.best_path workers.(i)) + Coda_process.best_path workers.(i) ) in let check_chains (chains : State_hash.Stable.Latest.t list array) = let online_chains = @@ -227,7 +227,7 @@ let start_prefix_check logger workers events testnet ~acceptable_delay = *) false | _ -> - Api.synced testnet i) + Api.synced testnet i ) in let chain_sets = Array.map online_chains @@ -237,7 +237,7 @@ let start_prefix_check logger workers events testnet ~acceptable_delay = `List ( Array.to_list online_chains |> List.map ~f:(fun chain -> - `List (List.map ~f:State_hash.Stable.Latest.to_yojson chain)) ) + `List (List.map ~f:State_hash.Stable.Latest.to_yojson chain) ) ) in match Array.fold ~init:None @@ -246,7 +246,7 @@ let start_prefix_check logger workers events testnet ~acceptable_delay = | None -> Some chain | Some acc -> - Some (Hash_set.inter acc chain)) + Some (Hash_set.inter acc chain) ) chain_sets with | Some hashes_in_common -> @@ -260,7 +260,7 @@ let start_prefix_check logger workers events testnet ~acceptable_delay = [ ("chains", chains_json ()) ; ("tf_vizs", `List (List.map ~f:(fun s -> `String s) tfs)) ] ; - exit 7) + exit 7 ) |> don't_wait_for else [%log info] "Chains are OK, they have hashes $hashes in common" @@ -305,7 +305,7 @@ let start_prefix_check logger workers events testnet ~acceptable_delay = let%bind () = after (Time.Span.of_sec 1.0) in go () in - go ()) ; + go () ) ; don't_wait_for (Deferred.ignore_m (Linear_pipe.fold ~init:chains all_transitions_r @@ -315,10 +315,10 @@ let start_prefix_check logger workers events testnet ~acceptable_delay = chains.(i) <- path ; last_time := Time.now () ; check_chains chains ; - chains)))) ; + chains ) ) ) ) ; don't_wait_for (Linear_pipe.iter events ~f:(function `Transition (i, (prev, curr)) -> - Linear_pipe.write all_transitions_w (prev, curr, i))) + Linear_pipe.write all_transitions_w (prev, curr, i) ) ) type user_cmd_status = { snapshots : int option array @@ -362,12 +362,12 @@ let start_payment_check logger root_pipe (testnet : Api.t) = [%log info] "Filled catchup ivar" ; Ivar.fill signal () ; testnet.restart_signals.(i) <- None ) - else ()) ; + else () ) ; let earliest_user_cmd = List.min_elt (Hashtbl.to_alist user_cmds_under_inspection) ~compare:(fun (_user_cmd1, status1) (_user_cmd2, status2) -> Int.compare status1.expected_deadline - status2.expected_deadline) + status2.expected_deadline ) in Option.iter earliest_user_cmd ~f:(fun (user_cmd, { expected_deadline; _ }) -> @@ -380,7 +380,7 @@ let start_payment_check logger root_pipe (testnet : Api.t) = "Transaction $user_cmd took too long to get into the root \ of node $worker_id. Length expected: %d got: %d" expected_deadline root_length ; - exit 9 |> ignore )) ; + exit 9 |> ignore ) ) ; List.iter commands ~f:(fun user_cmd -> Hashtbl.change user_cmds_under_inspection user_cmd.data ~f:(function @@ -396,10 +396,10 @@ let start_payment_check logger root_pipe (testnet : Api.t) = node $worker_id, when root length is $length" ; None | None -> - None)) ; + None ) ) ; Deferred.unit | _ -> - Deferred.unit ))) + Deferred.unit ) ) ) let events ~(precomputed_values : Genesis_proof.Inputs.t) workers start_reader = let event_r, event_w = Linear_pipe.create () in @@ -433,9 +433,9 @@ let events ~(precomputed_values : Genesis_proof.Inputs.t) workers start_reader = |> Float.of_int in let%map () = after (Time.Span.of_ms ms_to_sync) in - synced ()) ; - connect_worker i worker) ; - Deferred.unit)) ; + synced () ) ; + connect_worker i worker ) ; + Deferred.unit ) ) ; Array.iteri workers ~f:(fun i w -> don't_wait_for (connect_worker i w)) ; (event_r, root_r) @@ -446,13 +446,13 @@ let start_checks logger (workers : Coda_process.t array) start_reader in let%bind initialization_finish_signals = Deferred.Array.map workers ~f:(fun worker -> - Coda_process.initialization_finish_signal_exn worker) + Coda_process.initialization_finish_signal_exn worker ) in [%log info] "downloaded initialization signal" ; let%map () = Deferred.all_unit (List.map (Array.to_list initialization_finish_signals) ~f:(fun p -> - Linear_pipe.read p >>| ignore)) + Linear_pipe.read p >>| ignore ) ) in [%log info] "initialization finishes, start check" ; don't_wait_for @@ -537,7 +537,7 @@ end = struct } ; Option.return passed_root | _ -> - return None) + return None ) >>| Option.return in Deferred.List.iter all_passed_root ~f:Ivar.read @@ -608,18 +608,18 @@ end = struct .k + delay ; passed_root - }) ; + } ) ; Option.return passed_root | _ -> - return None) + return None ) >>| Option.return in - all_passed_root) + all_passed_root ) |> Deferred.Option.all in Deferred.map (Deferred.List.iter (List.concat all_passed_root's) ~f:Ivar.read) - ~f:(Fn.const (Some ()))) + ~f:(Fn.const (Some ())) ) in Deferred.unit @@ -634,7 +634,7 @@ end = struct Deferred.List.init (Array.length testnet.workers) ~f:(fun i -> let pk = Public_key.(compress @@ of_private_key_exn sender) in let%map pipe = Api.new_user_command_and_subscribe testnet i pk in - Option.value_exn pipe) + Option.value_exn pipe ) in Deferred.List.init ~how:`Sequential n ~f:(fun _i -> let receiver_keypair = List.random_element_exn keypairs in @@ -661,7 +661,7 @@ end = struct Deferred.List.for_all new_payment_readers ~f:read_until_match in assert result ; - user_command) + user_command ) end module Restarts : sig diff --git a/src/app/cli/src/tests/full_test.ml b/src/app/cli/src/tests/full_test.ml index ebde1c300cd..8d4df9d520d 100644 --- a/src/app/cli/src/tests/full_test.ml +++ b/src/app/cli/src/tests/full_test.ml @@ -110,7 +110,7 @@ let run_test () : unit Deferred.t = ~genesis_epoch_data:precomputed_values.genesis_epoch_data ~epoch_ledger_location (Public_key.Compressed.Set.singleton - (Public_key.compress keypair.public_key)) + (Public_key.compress keypair.public_key) ) ~ledger_depth:constraint_constants.ledger_depth ~genesis_state_hash: precomputed_values.protocol_state_with_hashes.hash.state_hash @@ -202,7 +202,7 @@ let run_test () : unit Deferred.t = (module Work_selector.Selection_methods.Sequence) ~block_production_keypairs: (Keypair.And_compressed_pk.Set.singleton - (keypair, Public_key.compress keypair.public_key)) + (keypair, Public_key.compress keypair.public_key) ) ~snark_worker_config: Mina_lib.Config.Snark_worker_config. { initial_snark_worker_key = @@ -218,12 +218,12 @@ let run_test () : unit Deferred.t = ~epoch_ledger_location ~time_controller ~snark_work_fee ~consensus_local_state ~work_reassignment_wait:420000 ~precomputed_values ~start_time ~log_precomputed_blocks:false - ~upload_blocks_to_gcloud:false ~stop_time:48 ()) + ~upload_blocks_to_gcloud:false ~stop_time:48 () ) in don't_wait_for (Strict_pipe.Reader.iter_without_pushback (Mina_lib.validated_transitions coda) - ~f:ignore) ; + ~f:ignore ) ; let%bind () = Ivar.read @@ Mina_lib.initialization_finish_signal coda in let wait_until_cond ~(f : Mina_lib.t -> bool) ~(timeout_min : Float.t) = let rec go () = @@ -287,8 +287,8 @@ let run_test () : unit Deferred.t = ~body:(Payment { source_pk = signer; receiver_pk; amount }) ~sign_choice: (User_command_input.Sign_choice.Keypair - (Keypair.of_private_key_exn sender_sk)) - ()) + (Keypair.of_private_key_exn sender_sk) ) + () ) in let assert_ok x = ignore (Or_error.ok_exn x) in let send_payment (payment : User_command_input.t) = @@ -333,12 +333,12 @@ let run_test () : unit Deferred.t = in assert_balance receiver_id (Option.value_exn - (Currency.Balance.( + ) prev_receiver_balance send_amount)) ; + (Currency.Balance.( + ) prev_receiver_balance send_amount) ) ; assert_balance sender_id (Option.value_exn (Currency.Balance.( - ) prev_sender_balance (Option.value_exn - (Currency.Amount.add_fee send_amount transaction_fee)))) + (Currency.Amount.add_fee send_amount transaction_fee) ) ) ) in let send_payment_update_balance_sheet sender_sk sender_pk receiver_pk amount balance_sheet fee = @@ -347,19 +347,19 @@ let run_test () : unit Deferred.t = Map.update balance_sheet sender_pk ~f:(fun v -> Option.value_exn (Currency.Balance.sub_amount (Option.value_exn v) - (Option.value_exn (Currency.Amount.add_fee amount fee)))) + (Option.value_exn (Currency.Amount.add_fee amount fee)) ) ) in let new_balance_sheet' = Map.update new_balance_sheet receiver_pk ~f:(fun v -> Option.value_exn - (Currency.Balance.add_amount (Option.value_exn v) amount)) + (Currency.Balance.add_amount (Option.value_exn v) amount) ) in let%map p_res = send_payment payment in assert_ok p_res ; new_balance_sheet' in let pks accounts = List.map accounts ~f:(fun ((keypair : Signature_lib.Keypair.t), _) -> - Public_key.compress keypair.public_key) + Public_key.compress keypair.public_key ) in let send_payments accounts ~txn_count balance_sheet f_amount = let pks = pks accounts in @@ -369,11 +369,11 @@ let run_test () : unit Deferred.t = let receiver = List.random_element_exn (List.filter pks ~f:(fun pk -> - not (Public_key.Compressed.equal pk sender_pk))) + not (Public_key.Compressed.equal pk sender_pk) ) ) in send_payment_update_balance_sheet keypair.private_key sender_pk receiver (f_amount i) acc - Mina_compile_config.minimum_user_command_fee) + Mina_compile_config.minimum_user_command_fee ) in let blockchain_length t = Mina_lib.best_protocol_state t @@ -390,18 +390,18 @@ let run_test () : unit Deferred.t = (List.map accounts ~f:(fun ((keypair : Signature_lib.Keypair.t), account) -> ( Public_key.compress keypair.public_key - , account.Account.Poly.balance ))) + , account.Account.Poly.balance ) ) ) in let%bind updated_balance_sheet = send_payments accounts ~txn_count balance_sheet (fun i -> - Currency.Amount.of_int ((i + 1) * 10)) + Currency.Amount.of_int ((i + 1) * 10) ) in (*After mining a few blocks and emitting a ledger_proof (by the parallel scan), check if the balances match *) let%map () = wait_for_proof_or_timeout timeout_min () in assert (Option.is_some @@ Mina_lib.staged_ledger_ledger_proof coda) ; Map.fold updated_balance_sheet ~init:() ~f:(fun ~key ~data () -> let account_id = Account_id.create key Token_id.default in - assert_balance account_id data) ; + assert_balance account_id data ) ; blockchain_length coda in let test_duplicate_payments (sender_keypair : Signature_lib.Keypair.t) @@ -440,10 +440,11 @@ let run_test () : unit Deferred.t = not (List.exists reserved_public_keys ~f:(fun pk -> Public_key.equal pk - (Public_key.decompress_exn @@ Account.public_key account)))) + (Public_key.decompress_exn @@ Account.public_key account) ) + ) ) |> List.map ~f:(fun (sk, account) -> ( Genesis_ledger.keypair_of_account_record_exn (sk, account) - , account )) + , account ) ) in let timeout_mins = if (with_snark || with_check) && medium_curves then 90. @@ -469,7 +470,7 @@ let run_test () : unit Deferred.t = ~f:(fun t -> Length.( blockchain_length t - > Length.add blockchain_length' wait_till_length)) + > Length.add blockchain_length' wait_till_length) ) ~timeout_min: ( (Length.to_int consensus_constants.delta + 1 + 8) * ( ( Block_time.Span.to_ms @@ -498,7 +499,7 @@ let run_test () : unit Deferred.t = in test_duplicate_payments sender_keypair receiver_keypair in - heartbeat_flag := false) + heartbeat_flag := false ) let command = let open Async in diff --git a/src/app/client_sdk/client_sdk.ml b/src/app/client_sdk/client_sdk.ml index d49fabdedb9..9e6f5ef42cd 100644 --- a/src/app/client_sdk/client_sdk.ml +++ b/src/app/client_sdk/client_sdk.ml @@ -377,7 +377,7 @@ let _ = let bits_to_bytes bits = let byte_of_bits bs = List.foldi bs ~init:0 ~f:(fun i acc b -> - if b then acc lor (1 lsl i) else acc) + if b then acc lor (1 lsl i) else acc ) |> Char.of_int_exn in List.map @@ -390,9 +390,9 @@ let _ = Bigint.( equal (shift_right Snark_params.Tick.Field.size i land one) - one))) + one) ) ) in Hex.encode @@ field_order_bytes method runUnitTests () : bool Js.t = Coding.run_unit_tests () ; Js._true - end) + end ) diff --git a/src/app/client_sdk/js_util.ml b/src/app/client_sdk/js_util.ml index 0fa20000a11..6c94c3d396c 100644 --- a/src/app/client_sdk/js_util.ml +++ b/src/app/client_sdk/js_util.ml @@ -172,4 +172,4 @@ let signature_kind_of_string_js network_js fname : Mina_signature_kind.t = | s -> raise_js_error (Core_kernel.sprintf - "%s: expected network to be mainnet or testnet, got: %s" fname s) + "%s: expected network to be mainnet or testnet, got: %s" fname s ) diff --git a/src/app/client_sdk/poseidon_hash.ml b/src/app/client_sdk/poseidon_hash.ml index ce378257424..66ba3e07c06 100644 --- a/src/app/client_sdk/poseidon_hash.ml +++ b/src/app/client_sdk/poseidon_hash.ml @@ -28,7 +28,7 @@ module Field = struct let bits_to_bytes bits = let byte_of_bits bs = List.foldi bs ~init:0 ~f:(fun i acc b -> - if b then acc lor (1 lsl i) else acc) + if b then acc lor (1 lsl i) else acc ) |> Char.of_int_exn in List.map diff --git a/src/app/client_sdk/tests/dune b/src/app/client_sdk/tests/dune index 4bdc200d3b8..9cbc9739d1a 100644 --- a/src/app/client_sdk/tests/dune +++ b/src/app/client_sdk/tests/dune @@ -25,7 +25,7 @@ (preprocessor_deps ../../../config.mlh) (instrumentation (backend bisect_ppx)) (preprocess (pps ppx_version ppx_optcomp ppx_custom_printf)) - (flags -short-paths -g -w @a-4-29-40-41-42-44-45-48-58-59-60)) + (flags -short-paths -g -w @a-4-29-34-40-41-42-44-45-48-58-59-60)) (executable (package client_sdk) @@ -51,4 +51,4 @@ (preprocessor_deps ../../../config.mlh) (instrumentation (backend bisect_ppx)) (preprocess (pps ppx_version ppx_optcomp ppx_custom_printf)) - (flags -short-paths -g -w @a-4-29-40-41-42-44-45-48-58-59-60)) + (flags -short-paths -g -w @a-4-29-34-40-41-42-44-45-48-58-59-60)) diff --git a/src/app/client_sdk/tests/test_signatures.ml b/src/app/client_sdk/tests/test_signatures.ml index 3bc6f19217e..43ccd7b990c 100644 --- a/src/app/client_sdk/tests/test_signatures.ml +++ b/src/app/client_sdk/tests/test_signatures.ml @@ -1,6 +1,6 @@ (* test_signatures.ml -- generate signatures for some transactions, for comparison against signatures generated in client SDK - *) +*) open Core_kernel open Snark_params.Tick @@ -121,26 +121,26 @@ let main () = Signed_command.t}\n\ %!" i signature ; - exit 1 )) ; + exit 1 ) ) ; List.iteri string_signatures ~f:(fun i signature -> if not (String_sign.verify ~signature_kind signature keypair.public_key - (List.nth_exn strings i)) + (List.nth_exn strings i) ) then ( eprintf !"Signature (%d) failed to verify for string: %s\n%!" i (List.nth_exn strings i) ; - exit 1 )) ; + exit 1 ) ) ; printf "[\n" ; List.iter txn_signatures ~f:(fun signature -> let Signed_command.Poly.{ signature = field, scalar; _ } = (signature :> Signed_command.t) in - print_signature field scalar) ; + print_signature field scalar ) ; List.iter string_signatures ~f:(fun signature -> let field, scalar = signature in - print_signature field scalar) ; - printf "]\n") + print_signature field scalar ) ; + printf "]\n" ) let _ = main () diff --git a/src/app/delegation_compliance/delegation_compliance.ml b/src/app/delegation_compliance/delegation_compliance.ml index e8f4c4a6357..85b7bff0010 100644 --- a/src/app/delegation_compliance/delegation_compliance.ml +++ b/src/app/delegation_compliance/delegation_compliance.ml @@ -189,7 +189,7 @@ let compute_delegated_stake staking_ledger delegatee = failwith "Error summing delegated stake" else accum | None -> - accum) + accum ) let account_balance ledger pk = let account_id = Account_id.create pk Token_id.default in @@ -229,7 +229,7 @@ let block_ids_in_epoch pool delegatee_id epoch = query_db pool ~f:(fun db -> Sql.Block.get_block_ids_for_creator_in_slot_bounds db - ~creator:delegatee_id ~low_slot ~high_slot) + ~creator:delegatee_id ~low_slot ~high_slot ) ~item:"block ids for delegatee in epoch" let write_csv_header ~csv_out_channel = @@ -304,7 +304,7 @@ let main ~input_file ~csv_file ~preliminary_csv_file_opt ~archive_uri | Error msg -> failwith (sprintf "Could not parse JSON in input file \"%s\": %s" input_file - msg) + msg ) in ( match preliminary_csv_file_opt with | None -> @@ -331,7 +331,7 @@ let main ~input_file ~csv_file ~preliminary_csv_file_opt ~archive_uri List.iter csv_datas ~f:(fun ({ payout_addr; delegatee; payout_received; deficit; _ } : - csv_data) + csv_data ) -> let key : Delegatee_payout_address.t = { delegatee; payout_addr } in let data : previous_epoch_status = { payout_received; deficit } in @@ -339,7 +339,7 @@ let main ~input_file ~csv_file ~preliminary_csv_file_opt ~archive_uri | `Ok -> () | `Duplicate -> - failwith "Duplicate deficit table entry") ; + failwith "Duplicate deficit table entry" ) ; csv_datas in let archive_uri = Uri.of_string archive_uri in @@ -473,7 +473,7 @@ let main ~input_file ~csv_file ~preliminary_csv_file_opt ~archive_uri let relevant_block_infos = List.filter block_infos ~f:(fun { global_slot; _ } -> Int64.( >= ) global_slot min_slot_int64 - && Int64.( <= ) global_slot max_slot_int64) + && Int64.( <= ) global_slot max_slot_int64 ) in let ids = List.map relevant_block_infos ~f:(fun { id; _ } -> id) in (* build mapping from global slots to state and ledger hashes *) @@ -482,7 +482,7 @@ let main ~input_file ~csv_file ~preliminary_csv_file_opt ~archive_uri Hashtbl.add_exn global_slot_hashes_tbl ~key:global_slot ~data: ( State_hash.of_base58_check_exn state_hash - , Ledger_hash.of_base58_check_exn ledger_hash )) ; + , Ledger_hash.of_base58_check_exn ledger_hash ) ) ; Int.Set.of_list ids in (* check that genesis block is in chain to target hash @@ -511,7 +511,7 @@ let main ~input_file ~csv_file ~preliminary_csv_file_opt ~archive_uri | `Ok -> () | `Duplicate -> - failwith "Duplicate account in initial staking ledger"))) ; + failwith "Duplicate account in initial staking ledger" ) ) ) ; let slot_3500 = (input.epoch * slots_per_epoch) + 3500 |> Int64.of_int in [%log info] "Computing delegation information for payout addresses" ; let%bind payout_infos = @@ -548,7 +548,7 @@ let main ~input_file ~csv_file ~preliminary_csv_file_opt ~archive_uri query_db pool ~f:(fun db -> Sql.User_command.run_payments_by_source_and_receiver db - ~source_id:delegatee_id ~receiver_id:payout_id) + ~source_id:delegatee_id ~receiver_id:payout_id ) ~item:"payments from delegatee" in let compare_by_global_slot p1 p2 = @@ -562,7 +562,7 @@ let main ~input_file ~csv_file ~preliminary_csv_file_opt ~archive_uri let payments_from_delegatee = List.filter payments_from_delegatee_raw ~f:(fun payment -> Int.Set.mem block_ids payment.block_id - && Int64.( >= ) payment.global_slot min_payment_slot) + && Int64.( >= ) payment.global_slot min_payment_slot ) |> List.sort ~compare:compare_by_global_slot in let payment_amount_and_slot (user_cmd : Sql.User_command.t) = @@ -572,7 +572,7 @@ let main ~input_file ~csv_file ~preliminary_csv_file_opt ~archive_uri ~f:(fun amt -> `String ( Int64.to_string amt |> Currency.Amount.of_string - |> Currency.Amount.to_formatted_string )) ) + |> Currency.Amount.to_formatted_string ) ) ) ; ("global_slot", `String (Int64.to_string user_cmd.global_slot)) ] in @@ -586,7 +586,7 @@ let main ~input_file ~csv_file ~preliminary_csv_file_opt ~archive_uri ~f:(fun amt -> `String ( Int64.to_string amt |> Currency.Amount.of_string - |> Currency.Amount.to_formatted_string )) ) + |> Currency.Amount.to_formatted_string ) ) ) ; ("global_slot", `String (Int64.to_string user_cmd.global_slot)) ] in @@ -599,14 +599,14 @@ let main ~input_file ~csv_file ~preliminary_csv_file_opt ~archive_uri ; ( "payments" , `List (List.map payments_from_delegatee - ~f:payment_amount_and_slot) ) + ~f:payment_amount_and_slot ) ) ] ; let%bind coinbase_receiver_ids = match%map Caqti_async.Pool.use (fun db -> Sql.Coinbase_receivers_for_block_creator.run db - ~block_creator_id:delegatee_id) + ~block_creator_id:delegatee_id ) pool with | Ok ids -> @@ -629,21 +629,21 @@ let main ~input_file ~csv_file ~preliminary_csv_file_opt ~archive_uri ~f:(fun db -> Sql.User_command.run_payments_by_source_and_receiver db ~source_id:coinbase_receiver_id - ~receiver_id:payout_id) + ~receiver_id:payout_id ) ~item: (sprintf "Payments from coinbase receiver with id %d to \ payment address" - coinbase_receiver_id) + coinbase_receiver_id ) in let payments = (* only payments in canonical chain *) List.filter payments_raw ~f:(fun payment -> Int.Set.mem block_ids payment.block_id - && Int64.( >= ) payment.global_slot min_payment_slot) + && Int64.( >= ) payment.global_slot min_payment_slot ) |> List.sort ~compare:compare_by_global_slot in - Ok ((cb_receiver_pk, payments) :: accum)) + Ok ((cb_receiver_pk, payments) :: accum) ) with | Ok payments -> payments @@ -669,8 +669,8 @@ let main ~input_file ~csv_file ~preliminary_csv_file_opt ~archive_uri ; ( "payments" , `List (List.map payments - ~f:payment_amount_and_slot) ) - ])) ) + ~f:payment_amount_and_slot ) ) + ] ) ) ) ] ; let payments_from_coinbase_receivers = (* to check compliance, don't need to know the payment source *) @@ -685,7 +685,7 @@ let main ~input_file ~csv_file ~preliminary_csv_file_opt ~archive_uri query_db pool ~f:(fun db -> Sql.User_command.run_payments_by_receiver db - ~receiver_id:payout_id) + ~receiver_id:payout_id ) ~item:"Payments to payment address" in (* only payments in canonical chain @@ -696,13 +696,13 @@ let main ~input_file ~csv_file ~preliminary_csv_file_opt ~archive_uri && Int64.( >= ) payment.global_slot min_payment_slot && not (List.mem payments_from_known_senders payment - ~equal:Sql.User_command.equal)) + ~equal:Sql.User_command.equal ) ) |> List.sort ~compare:compare_by_global_slot in let%map senders_and_payments_from_anyone = Deferred.List.map payments_from_anyone ~f:(fun payment -> let%map sender_pk = pk_of_pk_id pool payment.source_id in - (sender_pk, payment)) + (sender_pk, payment) ) in if not (List.is_empty senders_and_payments_from_anyone) then [%log info] @@ -717,12 +717,12 @@ let main ~input_file ~csv_file ~preliminary_csv_file_opt ~archive_uri ~f:(fun (sender_pk, payment) -> ( "payment" , payment_sender_amount_and_slot sender_pk payment - ))) ) + ) ) ) ) ] ; let payments = payments_from_known_senders @ payments_from_anyone in let payments_to_slot_3500, payments_past_slot_3500 = List.partition_tf payments ~f:(fun payment -> - Int64.( <= ) payment.global_slot slot_3500) + Int64.( <= ) payment.global_slot slot_3500 ) in { payout_pk ; payout_id @@ -732,7 +732,7 @@ let main ~input_file ~csv_file ~preliminary_csv_file_opt ~archive_uri ; payments ; payments_to_slot_3500 ; payments_past_slot_3500 - }) + } ) in let epoch_uint32 = input.epoch |> Unsigned.UInt32.of_int in let%bind () = @@ -827,7 +827,7 @@ let main ~input_file ~csv_file ~preliminary_csv_file_opt ~archive_uri ; ( "remaining_deficit" , `String (Currency.Amount.to_formatted_string - remaining_deficit) ) + remaining_deficit ) ) ] else [%log info] @@ -892,7 +892,7 @@ let main ~input_file ~csv_file ~preliminary_csv_file_opt ~archive_uri let payment_total_in_epoch = Int64.( + ) to_slot_3500_available_for_this_epoch (List.fold payout_info.payments_past_slot_3500 ~init:0L - ~f:add_payment) + ~f:add_payment ) in [%log info] "In epoch %d, delegatee %s made payments totaling %sto payout \ @@ -912,7 +912,7 @@ let main ~input_file ~csv_file ~preliminary_csv_file_opt ~archive_uri (Float.( / ) ( Currency.Amount.to_string delegated_amount |> Float.of_string ) - (Currency.Amount.to_string delegated_stake |> Float.of_string)) + (Currency.Amount.to_string delegated_stake |> Float.of_string) ) in let coinbase_amount = Float.( * ) 0.95 720.0 in [%log info] @@ -979,7 +979,7 @@ let main ~input_file ~csv_file ~preliminary_csv_file_opt ~archive_uri ~blocks_won:num_blocks_produced ~payout_obligation:total_payout_obligation ~payout_received:payment_total_as_amount ) ; - return ()) + return () ) in ( match preliminary_csv_file_opt with | None -> @@ -1004,7 +1004,7 @@ let main ~input_file ~csv_file ~preliminary_csv_file_opt ~archive_uri payout_received ; deficit ; check = current_check - }) + } ) in write_csv_header ~csv_out_channel ; List.iter updated_csv_datas @@ -1044,4 +1044,4 @@ let () = Param.anon Anons.(sequence ("PAYOUT ADDRESSES" %: Param.string)) in main ~input_file ~csv_file ~preliminary_csv_file_opt ~archive_uri - ~payout_addresses))) + ~payout_addresses ))) diff --git a/src/app/dhall_types/dump_dhall_types.ml b/src/app/dhall_types/dump_dhall_types.ml index 6f61a65dd2a..8efdf2011c3 100644 --- a/src/app/dhall_types/dump_dhall_types.ml +++ b/src/app/dhall_types/dump_dhall_types.ml @@ -15,7 +15,7 @@ let print_dhall_type (ty, nm) = Caml.close_out oc ; ignore (Unix.create_process ~prog:"dhall" - ~args:[ "format"; "--inplace"; dhall_file ]) + ~args:[ "format"; "--inplace"; dhall_file ] ) let main ~output_dir () = let output_dir = @@ -36,4 +36,4 @@ let () = current directory)" Param.(optional string) in - main ~output_dir))) + main ~output_dir ))) diff --git a/src/app/extract_blocks/extract_blocks.ml b/src/app/extract_blocks/extract_blocks.ml index 8ac9f18402f..2e4f7bf1194 100644 --- a/src/app/extract_blocks/extract_blocks.ml +++ b/src/app/extract_blocks/extract_blocks.ml @@ -13,7 +13,7 @@ let epoch_data_of_raw_epoch_data ~pool (raw_epoch_data : Processor.Epoch_data.t) let%bind hash_str = query_db ~f:(fun db -> Processor.Snarked_ledger_hash.find_by_id db - raw_epoch_data.ledger_hash_id) + raw_epoch_data.ledger_hash_id ) in let hash = Frozen_ledger_hash.of_base58_check_exn hash_str in let total_currency = @@ -52,28 +52,28 @@ let fill_in_block pool (block : Archive_lib.Processor.Block.t) : let creator = Public_key.Compressed.of_base58_check_exn creator_str in let%bind block_winner_str = query_db ~f:(fun db -> - Processor.Public_key.find_by_id db block.block_winner_id) + Processor.Public_key.find_by_id db block.block_winner_id ) in let block_winner = Public_key.Compressed.of_base58_check_exn block_winner_str in let%bind snarked_ledger_hash_str = query_db ~f:(fun db -> - Processor.Snarked_ledger_hash.find_by_id db block.snarked_ledger_hash_id) + Processor.Snarked_ledger_hash.find_by_id db block.snarked_ledger_hash_id ) in let snarked_ledger_hash = Frozen_ledger_hash.of_base58_check_exn snarked_ledger_hash_str in let%bind staking_epoch_data_raw = query_db ~f:(fun db -> - Processor.Epoch_data.load db block.staking_epoch_data_id) + Processor.Epoch_data.load db block.staking_epoch_data_id ) in let%bind staking_epoch_data = epoch_data_of_raw_epoch_data ~pool staking_epoch_data_raw in let%bind next_epoch_data_raw = query_db ~f:(fun db -> - Processor.Epoch_data.load db block.next_epoch_data_id) + Processor.Epoch_data.load db block.next_epoch_data_id ) in let%bind next_epoch_data = epoch_data_of_raw_epoch_data ~pool next_epoch_data_raw @@ -127,7 +127,7 @@ let fill_in_accounts_accessed pool block_state_hash = in let%bind accounts_accessed = query_db ~f:(fun db -> - Processor.Accounts_accessed.all_from_block db block_id) + Processor.Accounts_accessed.all_from_block db block_id ) in Deferred.List.map accounts_accessed ~f:(Load_data.get_account_accessed ~pool) @@ -139,22 +139,22 @@ let fill_in_accounts_created pool block_state_hash = in let%bind accounts_created = query_db ~f:(fun db -> - Processor.Accounts_created.all_from_block db block_id) + Processor.Accounts_created.all_from_block db block_id ) in Deferred.List.map accounts_created ~f:(fun acct_created -> let ({ block_id = _; account_identifier_id; creation_fee } - : Processor.Accounts_created.t) = + : Processor.Accounts_created.t ) = acct_created in - let%bind ({ public_key_id; token_id; _ } - : Processor.Account_identifiers.t) = + let%bind ({ public_key_id; token_id; _ } : Processor.Account_identifiers.t) + = query_db ~f:(fun db -> - Processor.Account_identifiers.load db account_identifier_id) + Processor.Account_identifiers.load db account_identifier_id ) in let%bind pk = let%map pk_str = query_db ~f:(fun db -> - Processor.Public_key.find_by_id db public_key_id) + Processor.Public_key.find_by_id db public_key_id ) in Public_key.Compressed.of_base58_check_exn pk_str in @@ -168,7 +168,7 @@ let fill_in_accounts_created pool block_state_hash = let fee = creation_fee |> Unsigned.UInt64.of_int64 |> Currency.Fee.of_uint64 in - return (account_id, fee)) + return (account_id, fee) ) let fill_in_user_commands pool block_state_hash = let query_db = Mina_caqti.query pool in @@ -185,7 +185,7 @@ let fill_in_user_commands pool block_state_hash = ~f:(fun (user_command_id, sequence_no) -> let%bind user_cmd = query_db ~f:(fun db -> - Processor.User_command.Signed_command.load db ~id:user_command_id) + Processor.User_command.Signed_command.load db ~id:user_command_id ) in let typ = user_cmd.typ in let%bind fee_payer = account_identifier_of_id user_cmd.fee_payer_id in @@ -196,21 +196,21 @@ let fill_in_user_commands pool block_state_hash = in let amount = Option.map user_cmd.amount ~f:(fun amt -> - Unsigned.UInt64.of_int64 amt |> Currency.Amount.of_uint64) + Unsigned.UInt64.of_int64 amt |> Currency.Amount.of_uint64 ) in let fee = user_cmd.fee |> Unsigned.UInt64.of_int64 |> Currency.Fee.of_uint64 in let valid_until = Option.map user_cmd.valid_until ~f:(fun valid -> - Unsigned.UInt32.of_int64 valid |> Mina_numbers.Global_slot.of_uint32) + Unsigned.UInt32.of_int64 valid |> Mina_numbers.Global_slot.of_uint32 ) in let memo = user_cmd.memo |> Signed_command_memo.of_base58_check_exn in let hash = user_cmd.hash |> Transaction_hash.of_base58_check_exn in let%bind block_user_cmd = query_db ~f:(fun db -> Processor.Block_and_signed_command.load db ~block_id - ~user_command_id ~sequence_no) + ~user_command_id ~sequence_no ) in let status = block_user_cmd.status in let failure_reason = @@ -220,7 +220,7 @@ let fill_in_user_commands pool block_state_hash = s | Error err -> failwithf "Not a transaction status failure: %s, error: %s" s - err ()) + err () ) in return { Extensional.User_command.sequence_no @@ -236,7 +236,7 @@ let fill_in_user_commands pool block_state_hash = ; hash ; status ; failure_reason - }) + } ) let fill_in_internal_commands pool block_state_hash = let query_db = Mina_caqti.query pool in @@ -253,7 +253,7 @@ let fill_in_internal_commands pool block_state_hash = (* pieces from the internal_commands table *) let%bind internal_cmd = query_db ~f:(fun db -> - Processor.Internal_command.load db ~id:internal_command_id) + Processor.Internal_command.load db ~id:internal_command_id ) in let typ = internal_cmd.typ in let%bind receiver = account_identifier_of_id internal_cmd.receiver_id in @@ -270,7 +270,7 @@ let fill_in_internal_commands pool block_state_hash = ; hash } in - return cmd) + return cmd ) let fill_in_zkapp_commands pool block_state_hash = let query_db = Mina_caqti.query pool in @@ -286,7 +286,7 @@ let fill_in_zkapp_commands pool block_state_hash = ~f:(fun (zkapp_command_id, sequence_no) -> let%bind zkapp_cmd = query_db ~f:(fun db -> - Processor.User_command.Zkapp_command.load db zkapp_command_id) + Processor.User_command.Zkapp_command.load db zkapp_command_id ) in let%bind fee_payer = Load_data.get_fee_payer_body ~pool zkapp_cmd.zkapp_fee_payer_body_id @@ -301,7 +301,7 @@ let fill_in_zkapp_commands pool block_state_hash = let%bind block_zkapp_cmd = query_db ~f:(fun db -> Processor.Block_and_zkapp_command.load db ~block_id - ~zkapp_command_id ~sequence_no) + ~zkapp_command_id ~sequence_no ) in let status = block_zkapp_cmd.status in @@ -312,7 +312,7 @@ let fill_in_zkapp_commands pool block_state_hash = Deferred.List.map (Array.to_list ids) ~f:(fun id -> let%map { index; failures } = query_db ~f:(fun db -> - Processor.Zkapp_party_failures.load db id) + Processor.Zkapp_party_failures.load db id ) in ( index , List.map (Array.to_list failures) ~f:(fun s -> @@ -322,9 +322,9 @@ let fill_in_zkapp_commands pool block_state_hash = | Error err -> failwithf "Invalid party transaction status, error: %s" err - ()) )) + () ) ) ) in - Some display) + Some display ) in return @@ -335,7 +335,7 @@ let fill_in_zkapp_commands pool block_state_hash = ; hash ; status ; failure_reasons - }) + } ) let check_state_hash ~logger state_hash_opt = match state_hash_opt with @@ -388,11 +388,11 @@ let main ~archive_uri ~start_state_hash_opt ~end_state_hash_opt ~all_blocks () = "Querying for subchain to end block with given state hash" ; let%map blocks = query_db ~f:(fun db -> - Sql.Subchain.start_from_unparented db ~end_state_hash) + Sql.Subchain.start_from_unparented db ~end_state_hash ) in let end_block_found = List.exists blocks ~f:(fun block -> - String.equal block.state_hash end_state_hash) + String.equal block.state_hash end_state_hash ) in if not end_block_found then ( [%log error] @@ -407,15 +407,15 @@ let main ~archive_uri ~start_state_hash_opt ~end_state_hash_opt ~all_blocks () = let%map blocks = query_db ~f:(fun db -> Sql.Subchain.start_from_specified db ~start_state_hash - ~end_state_hash) + ~end_state_hash ) in let start_block_found = List.exists blocks ~f:(fun block -> - String.equal block.state_hash start_state_hash) + String.equal block.state_hash start_state_hash ) in let end_block_found = List.exists blocks ~f:(fun block -> - String.equal block.state_hash end_state_hash) + String.equal block.state_hash end_state_hash ) in if not (start_block_found && end_block_found) then ( [%log error] @@ -445,9 +445,9 @@ let main ~archive_uri ~start_state_hash_opt ~end_state_hash_opt ~all_blocks () = let user_cmds = List.sort unsorted_user_cmds ~compare:(fun (cmd1 : Extensional.User_command.t) cmd2 -> - Int.compare cmd1.sequence_no cmd2.sequence_no) + Int.compare cmd1.sequence_no cmd2.sequence_no ) in - { block with user_cmds }) + { block with user_cmds } ) in [%log info] "Querying for internal commands in blocks" ; let%bind blocks_with_internal_cmds = @@ -461,9 +461,9 @@ let main ~archive_uri ~start_state_hash_opt ~end_state_hash_opt ~all_blocks () = ~compare:(fun (cmd1 : Extensional.Internal_command.t) cmd2 -> [%compare: int * int] (cmd1.sequence_no, cmd1.secondary_sequence_no) - (cmd2.sequence_no, cmd2.secondary_sequence_no)) + (cmd2.sequence_no, cmd2.secondary_sequence_no) ) in - { block with internal_cmds }) + { block with internal_cmds } ) in [%log info] "Querying for zkapp commands in blocks" ; let%bind blocks_with_zkapp_cmds = @@ -475,9 +475,9 @@ let main ~archive_uri ~start_state_hash_opt ~end_state_hash_opt ~all_blocks () = let zkapp_cmds = List.sort unsorted_zkapp_cmds ~compare:(fun (cmd1 : Extensional.Zkapp_command.t) cmd2 -> - Int.compare cmd1.sequence_no cmd2.sequence_no) + Int.compare cmd1.sequence_no cmd2.sequence_no ) in - { block with zkapp_cmds }) + { block with zkapp_cmds } ) in [%log info] "Querying for accounts accessed in blocks" ; let%bind blocks_with_accounts_accessed = @@ -485,7 +485,7 @@ let main ~archive_uri ~start_state_hash_opt ~end_state_hash_opt ~all_blocks () = let%map accounts_accessed = fill_in_accounts_accessed pool block.state_hash in - { block with accounts_accessed }) + { block with accounts_accessed } ) in [%log info] "Querying for accounts created in blocks" ; let%bind blocks_with_accounts_created = @@ -493,7 +493,7 @@ let main ~archive_uri ~start_state_hash_opt ~end_state_hash_opt ~all_blocks () = let%map accounts_created = fill_in_accounts_created pool block.state_hash in - { block with accounts_created }) + { block with accounts_created } ) in [%log info] "Writing blocks" ; let%map () = @@ -508,7 +508,7 @@ let main ~archive_uri ~start_state_hash_opt ~end_state_hash_opt ~all_blocks () = return (Async.fprintf writer "%s\n%!" ( Extensional.Block.to_yojson block - |> Yojson.Safe.pretty_to_string )))) + |> Yojson.Safe.pretty_to_string ) ) ) ) in () @@ -541,4 +541,5 @@ let () = Param.flag "--all-blocks" Param.no_arg ~doc:"Extract all blocks in the archive database" in - main ~archive_uri ~start_state_hash_opt ~end_state_hash_opt ~all_blocks))) + main ~archive_uri ~start_state_hash_opt ~end_state_hash_opt ~all_blocks + ))) diff --git a/src/app/extract_blocks/sql.ml b/src/app/extract_blocks/sql.ml index b57a6d23cbe..0e386140db9 100644 --- a/src/app/extract_blocks/sql.ml +++ b/src/app/extract_blocks/sql.ml @@ -37,7 +37,7 @@ module Subchain = struct (make_sql ~join_condition: "b.id = chain.parent_id AND (chain.state_hash <> $2 OR b.state_hash \ - = $2)") + = $2)" ) let start_from_unparented (module Conn : Caqti_async.CONNECTION) ~end_state_hash = diff --git a/src/app/genesis_ledger_from_tsv/genesis_ledger_from_tsv.ml b/src/app/genesis_ledger_from_tsv/genesis_ledger_from_tsv.ml index 5c11bf02d96..f2a16a17135 100644 --- a/src/app/genesis_ledger_from_tsv/genesis_ledger_from_tsv.ml +++ b/src/app/genesis_ledger_from_tsv/genesis_ledger_from_tsv.ml @@ -2,8 +2,7 @@ (* columns in spreadsheet: - Wallet Address (Public Key)|Amount (MINA)|Initial Minimum Balance|(MINA) Cliff Time (Months)|Cliff Unlock Amount (MINA)|Unlock Frequency (0: per slot, 1: per month)|Unlock Amount (MINA)|Delegate (Public Key) [Optional] - + Wallet Address (Public Key)|Amount (MINA)|Initial Minimum Balance|(MINA) Cliff Time (Months)|Cliff Unlock Amount (MINA)|Unlock Frequency (0: per slot, 1: per month)|Unlock Amount (MINA)|Delegate (Public Key) [Optional] *) open Core_kernel @@ -86,7 +85,7 @@ let generate_missing_delegate_accounts ~logger = let delegates = String.Table.keys delegates_tbl in let missing_delegates = List.filter delegates ~f:(fun delegate -> - not (String.Table.mem accounts_tbl delegate)) + not (String.Table.mem accounts_tbl delegate) ) in let delegate_accounts = List.map missing_delegates ~f:(generate_delegate_account ~logger) @@ -167,7 +166,7 @@ let account_of_tsv ~logger tsv = Some (runtime_config_account ~logger ~wallet_pk ~amount ~initial_min_balance ~cliff_time_months ~cliff_amount ~unlock_frequency ~unlock_amount - ~delegatee_pk) + ~delegatee_pk ) | _ -> (* should not occur, we've already validated the record *) failwithf "TSV line does not contain expected number of fields: %s" tsv () @@ -231,7 +230,7 @@ let validate_fields ~wallet_pk ~amount ~initial_min_balance ~cliff_time_months let valid_str = "VALID" in let invalid_fields = List.map valid_field_descs ~f:(fun (field, valid) -> - if valid then valid_str else field) + if valid then valid_str else field ) |> List.filter ~f:(fun field -> not (String.equal field valid_str)) |> String.concat ~sep:"," in @@ -288,7 +287,7 @@ let main ~tsv_file ~output_file () = in (* skip first line *) let _headers = In_channel.input_line in_channel in - go 0 false) + go 0 false ) in if validation_errors then ( [%log fatal] "Input has validation errors, exiting" ; @@ -313,7 +312,7 @@ let main ~tsv_file ~output_file () = in (* skip first line *) let _headers = In_channel.input_line in_channel in - go [] 0) + go [] 0 ) in [%log info] "Processed %d records" num_accounts ; let generated_accounts, num_generated = @@ -329,7 +328,7 @@ let main ~tsv_file ~output_file () = List.iter jsons ~f:(fun json -> Out_channel.output_string out_channel (Yojson.Safe.pretty_to_string json) ; - Out_channel.newline out_channel)) ; + Out_channel.newline out_channel ) ) ; return () let () = @@ -350,4 +349,4 @@ let () = format" Param.(required string) in - main ~tsv_file ~output_file))) + main ~tsv_file ~output_file ))) diff --git a/src/app/graphql_schema_dump/graphql_schema_dump.ml b/src/app/graphql_schema_dump/graphql_schema_dump.ml index decbd20dd37..69f4b5d04b2 100644 --- a/src/app/graphql_schema_dump/graphql_schema_dump.ml +++ b/src/app/graphql_schema_dump/graphql_schema_dump.ml @@ -102,7 +102,7 @@ let () = let res = Async.Thread_safe.block_on_async_exn (fun () -> Graphql_async.Schema.execute Mina_graphql.schema fake_mina_lib - introspection_query) + introspection_query ) in let response = match res with diff --git a/src/app/migrate-balances-table/migrate_balances_table.ml b/src/app/migrate-balances-table/migrate_balances_table.ml index 1b3f8f415ec..76d0549c2ac 100644 --- a/src/app/migrate-balances-table/migrate_balances_table.ml +++ b/src/app/migrate-balances-table/migrate_balances_table.ml @@ -44,14 +44,15 @@ let main ~archive_uri () = query_db pool ~f:(fun db -> Sql.find_balance_entry db ~public_key_id ~balance ~block_id - ~block_height ~block_sequence_no ~block_secondary_sequence_no) + ~block_height ~block_sequence_no ~block_secondary_sequence_no ) ~item:"find balance entry" with | None -> query_db pool ~f:(fun db -> Sql.insert_balance_entry db ~public_key_id ~balance ~block_id - ~block_height ~block_sequence_no ~block_secondary_sequence_no) + ~block_height ~block_sequence_no ~block_secondary_sequence_no + ) ~item:"insert balance entry" | Some id -> return id @@ -106,14 +107,14 @@ let main ~archive_uri () = in query_db pool ~f:(fun db -> Sql.create_temp_table_index db table col ()) - ~item:"balances index") + ~item:"balances index" ) in let%bind () = query_db pool ~f:(fun db -> Sql.create_temp_table_named_index db "balances" "block_height,block_sequence_no,block_secondary_sequence_no" - "height_seq_nos" ()) + "height_seq_nos" () ) ~item:"balances index" in [%log info] "Creating temporary blocks internal commands table" ; @@ -136,7 +137,7 @@ let main ~archive_uri () = in query_db pool ~f:(fun db -> Sql.create_temp_table_index db table col ()) - ~item:"create blocks internal commands index") + ~item:"create blocks internal commands index" ) in [%log info] "Creating temporary blocks user commands table" ; let%bind () = mk_temp_table "blocks_user_commands" in @@ -152,7 +153,7 @@ let main ~archive_uri () = in query_db pool ~f:(fun db -> Sql.create_temp_table_index db table col ()) - ~item:"blocks user commands index") + ~item:"blocks user commands index" ) in let internal_cmds_cursor_name = "internal_cmds" in let fee_payer_cursor_name = "fee_payer" in @@ -181,7 +182,7 @@ let main ~archive_uri () = ~f:(fun db -> Sql.initialize_cursor db cursor ()) ~item:(sprintf "Initialize cursor %s" cursor) | Some _ -> - return ()) + return () ) in [%log info] "Getting internal commands" ; let%bind internal_commands = @@ -218,14 +219,14 @@ let main ~archive_uri () = ~f:(fun db -> Sql.update_internal_command_receiver_balance db ~new_balance_id ~block_id ~internal_command_id - ~block_sequence_no ~block_secondary_sequence_no) + ~block_sequence_no ~block_secondary_sequence_no ) ~item:"update internal command receiver balance" in (* update cursor only periodically, otherwise too slow *) if ndx % 1000 = 0 then ( [%log info] "Updated internal command receiver balance: %d" ndx ; update_cursor internal_cmds_cursor_name ndx ) - else return ()) + else return () ) in [%log info] "Getting user command fee payer balance information" ; let%bind user_command_fee_payers = @@ -257,13 +258,13 @@ let main ~archive_uri () = query_db pool ~f:(fun db -> Sql.update_user_command_fee_payer_balance db ~new_balance_id - ~block_id ~user_command_id ~block_sequence_no) + ~block_id ~user_command_id ~block_sequence_no ) ~item:"update user command fee payer balance" in if ndx % 1000 = 0 then ( [%log info] "Updated user command fee payer balance: %d" ndx ; update_cursor fee_payer_cursor_name ndx ) - else return ()) + else return () ) in [%log info] "Getting user command source balance information" ; let%bind user_command_sources = @@ -295,13 +296,13 @@ let main ~archive_uri () = query_db pool ~f:(fun db -> Sql.update_user_command_source_balance db ~new_balance_id - ~block_id ~user_command_id ~block_sequence_no) + ~block_id ~user_command_id ~block_sequence_no ) ~item:"update user command source balance" in if ndx % 1000 = 0 then ( [%log info] "Updated user command source balance: %d" ndx ; update_cursor source_cursor_name ndx ) - else return ()) + else return () ) in [%log info] "Getting user command receiver balance information" ; let%bind user_command_receivers = @@ -333,13 +334,13 @@ let main ~archive_uri () = query_db pool ~f:(fun db -> Sql.update_user_command_receiver_balance db ~new_balance_id - ~block_id ~user_command_id ~block_sequence_no) + ~block_id ~user_command_id ~block_sequence_no ) ~item:"update user command receiver balance" in if ndx % 1000 = 0 then ( [%log info] "Updated user command receiver balance: %d" ndx ; update_cursor receiver_cursor_name ndx ) - else return ()) + else return () ) in [%log info] "DROP original blocks_internal_command table, overwrite with temp table" ; @@ -355,7 +356,7 @@ let main ~archive_uri () = ~f:(fun db -> Sql.add_balances_foreign_key_constraint db "blocks_internal_commands" "receiver_balance" - "blocks_internal_commands_receiver_balance_fkey" ()) + "blocks_internal_commands_receiver_balance_fkey" () ) ~item: "Blocks_internal_commands receiver balance foreign key constraint" in @@ -364,42 +365,43 @@ let main ~archive_uri () = ~f:(fun db -> Sql.add_balances_foreign_key_constraint db "blocks_user_commands" "fee_payer_balance" "blocks_user_commands_fee_payer_balance_fkey" - ()) + () ) ~item:"Blocks_user_commands fee payer balance foreign key constraint" in let%bind () = query_db pool ~f:(fun db -> Sql.add_balances_foreign_key_constraint db "blocks_user_commands" - "source_balance" "blocks_user_commands_source_balance_fkey" ()) + "source_balance" "blocks_user_commands_source_balance_fkey" () ) ~item:"Blocks_user_commands source balance foreign key constraint" in let%bind () = query_db pool ~f:(fun db -> Sql.add_balances_foreign_key_constraint db "blocks_user_commands" - "receiver_balance" "blocks_user_commands_receiver_balance_fkey" ()) + "receiver_balance" "blocks_user_commands_receiver_balance_fkey" () + ) ~item:"Blocks_user_commands receiver balance foreign key constraint" in let%bind () = query_db pool ~f:(fun db -> Sql.add_blocks_foreign_key_constraint db "blocks_internal_commands" - "block_id" "blocks_internal_commands_block_id_fkey" ()) + "block_id" "blocks_internal_commands_block_id_fkey" () ) ~item:"Blocks_internal_commands block id foreign key constraint" in let%bind () = query_db pool ~f:(fun db -> Sql.add_blocks_foreign_key_constraint db "blocks_user_commands" - "block_id" "blocks_user_commands_block_id_fkey" ()) + "block_id" "blocks_user_commands_block_id_fkey" () ) ~item:"Blocks_user_commands block id foreign key constraint" in let%bind () = query_db pool ~f:(fun db -> Sql.add_blocks_foreign_key_constraint db "balances" "block_id" - "balances_block_id_fkey" ()) + "balances_block_id_fkey" () ) ~item:"Balances block id foreign key constraint" in [%log info] "Migration successful" ; @@ -417,4 +419,4 @@ let () = postgres://$USER@localhost:5432/archiver)" Param.(required string) in - main ~archive_uri))) + main ~archive_uri ))) diff --git a/src/app/migrate-balances-table/sql.ml b/src/app/migrate-balances-table/sql.ml index 5349c0b1b81..4c0a8c86dd1 100644 --- a/src/app/migrate-balances-table/sql.ml +++ b/src/app/migrate-balances-table/sql.ml @@ -15,7 +15,7 @@ let create_temp_balances_table (module Conn : Caqti_async.CONNECTION) = , block_secondary_sequence_no int NOT NULL , UNIQUE (public_key_id,balance,block_id,block_height,block_sequence_no,block_secondary_sequence_no) ) - |sql}) + |sql} ) let copy_table_to_temp_table (module Conn : Caqti_async.CONNECTION) table = Conn.exec @@ -23,7 +23,7 @@ let copy_table_to_temp_table (module Conn : Caqti_async.CONNECTION) table = (sprintf {sql| CREATE TABLE IF NOT EXISTS %s_temp AS (SELECT * FROM %s) |sql} - table table)) + table table ) ) let create_table_index (module Conn : Caqti_async.CONNECTION) table col = Conn.exec @@ -31,7 +31,7 @@ let create_table_index (module Conn : Caqti_async.CONNECTION) table col = (sprintf {sql| CREATE INDEX IF NOT EXISTS idx_%s_%s ON %s(%s) |sql} - table col table col)) + table col table col ) ) let create_temp_table_index (module Conn : Caqti_async.CONNECTION) table col = create_table_index (module Conn) (sprintf "%s_temp" table) col @@ -43,7 +43,7 @@ let create_table_named_index (module Conn : Caqti_async.CONNECTION) table col (sprintf {sql| CREATE INDEX IF NOT EXISTS idx_%s_%s ON %s(%s) |sql} - table name table col)) + table name table col ) ) let create_temp_table_named_index (module Conn : Caqti_async.CONNECTION) table col name = @@ -53,7 +53,7 @@ let drop_table_index (module Conn : Caqti_async.CONNECTION) table col = Conn.exec (Caqti_request.exec Caqti_type.unit (sprintf {sql| DROP INDEX IF EXISTS idx_%s_%s - |sql} table col)) + |sql} table col ) ) let drop_temp_table_index (module Conn : Caqti_async.CONNECTION) table col = drop_table_index (module Conn) (sprintf "%s_temp" table) col @@ -65,7 +65,7 @@ let create_cursor (module Conn : Caqti_async.CONNECTION) name = {sql| CREATE TABLE IF NOT EXISTS %s_cursor ( value int NOT NULL) |sql} - name)) + name ) ) let initialize_cursor (module Conn : Caqti_async.CONNECTION) name = Conn.exec @@ -73,13 +73,13 @@ let initialize_cursor (module Conn : Caqti_async.CONNECTION) name = (sprintf {sql| INSERT INTO %s_cursor (value) VALUES (0) |sql} - name)) + name ) ) let current_cursor (module Conn : Caqti_async.CONNECTION) name = Conn.find_opt (Caqti_request.find_opt Caqti_type.unit Caqti_type.int (sprintf {sql| SELECT value FROM %s_cursor - |sql} name)) + |sql} name ) ) let update_cursor (module Conn : Caqti_async.CONNECTION) name ndx = Conn.exec @@ -87,7 +87,7 @@ let update_cursor (module Conn : Caqti_async.CONNECTION) name ndx = (sprintf {sql| UPDATE %s_cursor SET value = $1 |sql} - name)) + name ) ) ndx let drop_foreign_key_constraint (module Conn : Caqti_async.CONNECTION) table @@ -142,7 +142,7 @@ let find_balance_entry (module Conn : Caqti_async.CONNECTION) ~public_key_id AND block_height = $4 AND block_sequence_no = $5 AND block_secondary_sequence_no = $6 - |sql}) + |sql} ) ( public_key_id , balance , (block_id, block_height, block_sequence_no, block_secondary_sequence_no) @@ -170,7 +170,7 @@ let insert_balance_entry (module Conn : Caqti_async.CONNECTION) ~public_key_id , $5 , $6) RETURNING id - |sql}) + |sql} ) ( public_key_id , balance , (block_id, block_height, block_sequence_no, block_secondary_sequence_no) @@ -187,7 +187,7 @@ let get_internal_commands (module Conn : Caqti_async.CONNECTION) = INNER JOIN balances bal ON bal.id = receiver_balance ORDER BY (bal.public_key_id,bal.balance,bic.block_id,blocks.height,bic.sequence_no,bic.secondary_sequence_no, internal_command_id) - |sql}) + |sql} ) let update_internal_command_receiver_balance (module Conn : Caqti_async.CONNECTION) ~new_balance_id ~block_id @@ -200,7 +200,7 @@ let update_internal_command_receiver_balance AND internal_command_id = $3 AND sequence_no = $4 AND secondary_sequence_no = $5 - |sql}) + |sql} ) ( new_balance_id , ( block_id , internal_command_id @@ -218,7 +218,7 @@ let get_user_command_fee_payers (module Conn : Caqti_async.CONNECTION) = INNER JOIN balances bal_fee_payer ON bal_fee_payer.id = fee_payer_balance ORDER BY (buc.block_id,blocks.height,buc.sequence_no,user_command_id, bal_fee_payer.public_key_id,bal_fee_payer.balance) - |sql}) + |sql} ) let get_user_command_sources (module Conn : Caqti_async.CONNECTION) = Conn.collect_list @@ -232,7 +232,7 @@ let get_user_command_sources (module Conn : Caqti_async.CONNECTION) = WHERE source_balance IS NOT NULL ORDER BY (buc.block_id,blocks.height,buc.sequence_no,user_command_id, bal_source.public_key_id,bal_source.balance) - |sql}) + |sql} ) let get_user_command_receivers (module Conn : Caqti_async.CONNECTION) = Conn.collect_list @@ -246,7 +246,7 @@ let get_user_command_receivers (module Conn : Caqti_async.CONNECTION) = WHERE receiver_balance IS NOT NULL ORDER BY (buc.block_id,blocks.height,buc.sequence_no,user_command_id, bal_receiver.public_key_id,bal_receiver.balance) - |sql}) + |sql} ) let update_user_command_fee_payer_balance (module Conn : Caqti_async.CONNECTION) ~new_balance_id ~block_id ~user_command_id ~block_sequence_no = @@ -257,7 +257,7 @@ let update_user_command_fee_payer_balance (module Conn : Caqti_async.CONNECTION) WHERE block_id = $2 AND user_command_id = $3 AND sequence_no = $4 - |sql}) + |sql} ) (new_balance_id, (block_id, user_command_id, block_sequence_no)) let update_user_command_source_balance (module Conn : Caqti_async.CONNECTION) @@ -270,7 +270,7 @@ let update_user_command_source_balance (module Conn : Caqti_async.CONNECTION) AND user_command_id = $3 AND sequence_no = $4 AND source_balance IS NOT NULL - |sql}) + |sql} ) (new_balance_id, (block_id, user_command_id, block_sequence_no)) let update_user_command_receiver_balance (module Conn : Caqti_async.CONNECTION) @@ -283,14 +283,14 @@ let update_user_command_receiver_balance (module Conn : Caqti_async.CONNECTION) AND user_command_id = $3 AND sequence_no = $4 AND receiver_balance IS NOT NULL - |sql}) + |sql} ) (new_balance_id, (block_id, user_command_id, block_sequence_no)) let drop_table (module Conn : Caqti_async.CONNECTION) table = Conn.exec (Caqti_request.exec Caqti_type.unit (sprintf {sql| DROP TABLE %s - |sql} table)) + |sql} table ) ) let rename_temp_table (module Conn : Caqti_async.CONNECTION) table = Conn.exec @@ -299,12 +299,12 @@ let rename_temp_table (module Conn : Caqti_async.CONNECTION) table = {sql| ALTER TABLE %s_temp RENAME TO %s |sql} - table table)) + table table ) ) let get_column_count (module Conn : Caqti_async.CONNECTION) table = Conn.find (Caqti_request.find Caqti_type.string Caqti_type.int {sql| SELECT COUNT(*) FROM information_schema.columns WHERE table_name=$1 - |sql}) + |sql} ) table diff --git a/src/app/missing_blocks_auditor/missing_blocks_auditor.ml b/src/app/missing_blocks_auditor/missing_blocks_auditor.ml index d7a76f02473..5bce995ea28 100644 --- a/src/app/missing_blocks_auditor/missing_blocks_auditor.ml +++ b/src/app/missing_blocks_auditor/missing_blocks_auditor.ml @@ -71,7 +71,7 @@ let main ~archive_uri () = | Error msg -> [%log error] "Error getting missing blocks gap" ~metadata:[ ("error", `String (Caqti_error.show msg)) ] ; - Core_kernel.exit 1) ) + Core_kernel.exit 1 ) ) in [%log info] "Querying for gaps in chain statuses" ; let%bind highest_canonical = @@ -91,7 +91,7 @@ let main ~archive_uri () = match%bind Caqti_async.Pool.use (fun db -> - Sql.Chain_status.run_count_pending_below db highest_canonical) + Sql.Chain_status.run_count_pending_below db highest_canonical ) pool with | Ok count -> @@ -119,8 +119,7 @@ let main ~archive_uri () = let%bind canonical_chain = match%bind Caqti_async.Pool.use - (fun db -> - Sql.Chain_status.run_canonical_chain db highest_canonical) + (fun db -> Sql.Chain_status.run_canonical_chain db highest_canonical) pool with | Ok chain -> @@ -140,7 +139,7 @@ let main ~archive_uri () = let invalid_chain = List.filter canonical_chain ~f:(fun (_block_id, _state_hash, chain_status) -> - not (String.equal chain_status "canonical")) + not (String.equal chain_status "canonical") ) in if List.is_empty invalid_chain then [%log info] @@ -153,7 +152,7 @@ let main ~archive_uri () = [ ("block_id", `Int block_id) ; ("state_hash", `String state_hash) ; ("chain_status", `String chain_status) - ]) ; + ] ) ; Core.exit (get_exit_code ()) let () = @@ -169,4 +168,4 @@ let () = postgres://$USER@localhost:5432/archiver)" Param.(required string) in - main ~archive_uri))) + main ~archive_uri ))) diff --git a/src/app/patch_archive_test/patch_archive_test.ml b/src/app/patch_archive_test/patch_archive_test.ml index 804e6c5b949..1fbc9e3104b 100644 --- a/src/app/patch_archive_test/patch_archive_test.ml +++ b/src/app/patch_archive_test/patch_archive_test.ml @@ -57,7 +57,7 @@ let compare_blocks ~logger ~original_blocks_dir ~copy_blocks_dir = block | Error err -> failwithf "Could not parse extensional block in file %s, error: %s" - fn err ()) + fn err () ) in let%bind original_blocks = blocks_in_dir original_blocks_dir in let%bind copy_blocks = blocks_in_dir copy_blocks_dir in @@ -86,7 +86,7 @@ let compare_blocks ~logger ~original_blocks_dir ~copy_blocks_dir = then ( [%log error] "Original, copied blocks differ in file %s" block_file ; true ) - else acc) + else acc ) in if found_difference then ( [%log fatal] @@ -177,7 +177,7 @@ let main ~archive_uri ~num_blocks_to_patch ~archive_blocks_path let indexes_to_delete = Quickcheck.random_value (Quickcheck.Generator.list_with_length num_blocks_to_patch - (Int.gen_uniform_incl 0 (Array.length state_hash_array - 1))) + (Int.gen_uniform_incl 0 (Array.length state_hash_array - 1)) ) in let%bind () = Deferred.List.iter indexes_to_delete ~f:(fun ndx -> @@ -204,7 +204,7 @@ let main ~archive_uri ~num_blocks_to_patch ~archive_blocks_path ~metadata:[ ("state_hash", `String state_hash) ] ; query_db pool ~f:(fun db -> Sql.Block.run_delete db ~state_hash) - ~item:"state hash of block to delete") + ~item:"state hash of block to delete" ) in (* patch the copy with precomputed or extensional blocks, using the archive_blocks tool *) [%log info] "Patching the copy with supplied blocks" ; @@ -281,4 +281,4 @@ let () = ~doc:"Blocks are in extensional format" and files = Param.anon Anons.(sequence ("FILES" %: Param.string)) in main ~archive_uri ~num_blocks_to_patch ~archive_blocks_path - ~extract_blocks_path ~precomputed ~extensional ~files))) + ~extract_blocks_path ~precomputed ~extensional ~files ))) diff --git a/src/app/replayer/dune b/src/app/replayer/dune index eb32e524eee..2f9ed999d39 100644 --- a/src/app/replayer/dune +++ b/src/app/replayer/dune @@ -1,6 +1,7 @@ (executable (package replayer) (name replayer) + (flags -w -32-34) (public_name replayer) (libraries ;; opam libraries diff --git a/src/app/replayer/replayer.ml b/src/app/replayer/replayer.ml index e83281d3591..0d784a1541c 100644 --- a/src/app/replayer/replayer.ml +++ b/src/app/replayer/replayer.ml @@ -23,7 +23,6 @@ module Load_data = Archive_lib.Load_data when all commands from a block have been replayed, we verify that the Merkle root of the replay ledger matches the stored ledger hash in the archive database - *) type input = @@ -69,7 +68,7 @@ let json_ledger_hash_of_ledger ledger = let create_ledger_as_list ledger = List.map (Ledger.to_list ledger) ~f:(fun acc -> - Genesis_ledger_helper.Accounts.Single.of_account acc None) + Genesis_ledger_helper.Accounts.Single.of_account acc None ) let create_output ~target_fork_state_hash ~target_epoch_ledgers_state_hash ~ledger ~staking_epoch_ledger ~staking_seed ~next_epoch_ledger ~next_seed @@ -228,7 +227,7 @@ let update_epoch_ledger ~logger ~name ~ledger ~epoch_ledger epoch_ledger_hash = [%sexp_of: (string * Signature_lib.Public_key.Compressed.t) * (string * Token_id.t)] - |> Error.raise) ; + |> Error.raise ) ; epoch_ledger ) else epoch_ledger @@ -240,7 +239,7 @@ let update_staking_epoch_data ~logger pool ~ledger ~last_block_id in let%bind staking_epoch_id = query_db ~f:(fun db -> - Sql.Epoch_data.get_staking_epoch_data_id db state_hash) + Sql.Epoch_data.get_staking_epoch_data_id db state_hash ) in let%map { epoch_ledger_hash; epoch_data_seed } = query_db ~f:(fun db -> Sql.Epoch_data.get_epoch_data db staking_epoch_id) @@ -431,7 +430,7 @@ let apply_combined_fee_transfer ~logger ~pool ~ledger module User_command_helpers = struct let body_of_sql_user_cmd pool ({ typ; source_id; receiver_id; amount; global_slot_since_genesis; _ } : - Sql.User_command.t) : Signed_command_payload.Body.t Deferred.t = + Sql.User_command.t ) : Signed_command_payload.Body.t Deferred.t = let open Signed_command_payload.Body in let open Deferred.Let_syntax in let account_identifier_of_id = Load_data.account_identifier_of_id pool in @@ -454,7 +453,7 @@ module User_command_helpers = struct | "delegation" -> Stake_delegation (Stake_delegation.Set_delegate - { delegator = source_pk; new_delegate = receiver_pk }) + { delegator = source_pk; new_delegate = receiver_pk } ) | _ -> failwithf "Invalid user command type: %s" typ () end @@ -471,7 +470,7 @@ let run_user_command ~logger ~pool ~ledger (cmd : Sql.User_command.t) = let memo = Signed_command_memo.of_base58_check_exn cmd.memo in let valid_until = Option.map cmd.valid_until ~f:(fun slot -> - Mina_numbers.Global_slot.of_uint32 @@ Unsigned.UInt32.of_int64 slot) + Mina_numbers.Global_slot.of_uint32 @@ Unsigned.UInt32.of_int64 slot ) in let payload = Signed_command_payload.create @@ -539,7 +538,7 @@ module Zkapp_helpers = struct let%bind snarked_ledger_hash_str = query_db ~f:(fun db -> Sql.Snarked_ledger_hashes.run db - parent_block.snarked_ledger_hash_id) + parent_block.snarked_ledger_hash_id ) in let snarked_ledger_hash = Frozen_ledger_hash.of_base58_check_exn snarked_ledger_hash_str @@ -572,7 +571,7 @@ module Zkapp_helpers = struct Mina_base.Epoch_data.Value.t Deferred.t = let%bind hash_str = query_db ~f:(fun db -> - Sql.Snarked_ledger_hashes.run db raw_epoch_data.ledger_hash_id) + Sql.Snarked_ledger_hashes.run db raw_epoch_data.ledger_hash_id ) in let hash = Frozen_ledger_hash.of_base58_check_exn hash_str in let total_currency = @@ -601,14 +600,14 @@ module Zkapp_helpers = struct in let%bind staking_epoch_raw = query_db ~f:(fun db -> - Processor.Epoch_data.load db parent_block.staking_epoch_data_id) + Processor.Epoch_data.load db parent_block.staking_epoch_data_id ) in let%bind (staking_epoch_data : Mina_base.Epoch_data.Value.t) = epoch_data_of_raw_epoch_data staking_epoch_raw in let%bind next_epoch_raw = query_db ~f:(fun db -> - Processor.Epoch_data.load db parent_block.staking_epoch_data_id) + Processor.Epoch_data.load db parent_block.staking_epoch_data_id ) in let%bind next_epoch_data = epoch_data_of_raw_epoch_data next_epoch_raw @@ -657,7 +656,7 @@ let parties_of_zkapp_command ~pool (cmd : Sql.Zkapp_command.t) : | None_given -> None_given in - ({ body; authorization } : Party.Wire.t)) + ({ body; authorization } : Party.Wire.t) ) in let memo = Signed_command_memo.of_base58_check_exn cmd.memo in let parties = Parties.of_wire { fee_payer; other_parties; memo } in @@ -740,7 +739,7 @@ let main ~input_file ~output_file_opt ~archive_uri ~continue_on_error () = | Error msg -> failwith (sprintf "Could not parse JSON in input file \"%s\": %s" input_file - msg) + msg ) in let archive_uri = Uri.of_string archive_uri in match Caqti_async.connect_pool ~max_size:128 archive_uri with @@ -783,7 +782,7 @@ let main ~input_file ~output_file_opt ~archive_uri ~continue_on_error () = [%log info] "Retrieving fork block state_hash" ; query_db ~f:(fun db -> Sql.Parent_block.get_parent_state_hash db - epoch_ledgers_state_hash) + epoch_ledgers_state_hash ) | None -> [%log info] "Searching for block with greatest height on canonical chain" ; @@ -807,8 +806,8 @@ let main ~input_file ~output_file_opt ~archive_uri ~continue_on_error () = ~key:global_slot_since_genesis ~data: ( State_hash.of_base58_check_exn state_hash - , Ledger_hash.of_base58_check_exn ledger_hash )) ; - return (Int.Set.of_list ids)) + , Ledger_hash.of_base58_check_exn ledger_hash ) ) ; + return (Int.Set.of_list ids) ) in (* check that genesis block is in chain to target hash assumption: genesis block occupies global slot 0 @@ -828,7 +827,7 @@ let main ~input_file ~output_file_opt ~archive_uri ~continue_on_error () = Caqti_async.Pool.use (fun db -> Command_ids.run db ~state_hash:target_state_hash - ~start_slot:input.start_slot_since_genesis) + ~start_slot:input.start_slot_since_genesis ) pool with | Ok ids -> @@ -873,13 +872,13 @@ let main ~input_file ~output_file_opt ~archive_uri ~continue_on_error () = | Error msg -> failwithf "Error querying for internal commands with id %d, error %s" id - (Caqti_error.show msg) ()) + (Caqti_error.show msg) () ) in let unsorted_internal_cmds = List.concat unsorted_internal_cmds_list in (* filter out internal commands in blocks not along chain from target state hash *) let filtered_internal_cmds = List.filter unsorted_internal_cmds ~f:(fun cmd -> - Int.Set.mem block_ids cmd.block_id) + Int.Set.mem block_ids cmd.block_id ) in [%log info] "Will replay %d internal commands" (List.length filtered_internal_cmds) ; @@ -902,7 +901,7 @@ let main ~input_file ~output_file_opt ~archive_uri ~continue_on_error () = "Two internal commands have the same global slot since \ genesis %Ld, sequence no %d, and secondary sequence no \ %d, but are not a coinbase and fee transfer via coinbase" - else cmp) + else cmp ) in (* populate cache of fee transfer via coinbase items *) [%log info] "Populating fee transfer via coinbase cache" ; @@ -924,13 +923,13 @@ let main ~input_file ~output_file_opt ~archive_uri ~continue_on_error () = | Error msg -> failwithf "Error querying for user commands with id %d, error %s" id - (Caqti_error.show msg) ()) + (Caqti_error.show msg) () ) in let unsorted_user_cmds = List.concat unsorted_user_cmds_list in (* filter out user commands in blocks not along chain from target state hash *) let filtered_user_cmds = List.filter unsorted_user_cmds ~f:(fun cmd -> - Int.Set.mem block_ids cmd.block_id) + Int.Set.mem block_ids cmd.block_id ) in [%log info] "Will replay %d user commands" (List.length filtered_user_cmds) ; @@ -939,7 +938,7 @@ let main ~input_file ~output_file_opt ~archive_uri ~continue_on_error () = let tuple (uc : Sql.User_command.t) = (uc.global_slot_since_genesis, uc.sequence_no) in - [%compare: int64 * int] (tuple uc1) (tuple uc2)) + [%compare: int64 * int] (tuple uc1) (tuple uc2) ) in [%log info] "Loading zkApp commands" ; let%bind unsorted_zkapp_cmds_list = @@ -955,14 +954,14 @@ let main ~input_file ~output_file_opt ~archive_uri ~continue_on_error () = | Error msg -> failwithf "Error querying for zkApp commands with id %d, error %s" id - (Caqti_error.show msg) ()) + (Caqti_error.show msg) () ) in let unsorted_zkapp_cmds = List.concat unsorted_zkapp_cmds_list in let filtered_zkapp_cmds = List.filter unsorted_zkapp_cmds ~f:(fun (cmd : Sql.Zkapp_command.t) -> Int64.( >= ) cmd.global_slot_since_genesis input.start_slot_since_genesis - && Int.Set.mem block_ids cmd.block_id) + && Int.Set.mem block_ids cmd.block_id ) in [%log info] "Will replay %d zkApp commands" (List.length filtered_zkapp_cmds) ; @@ -971,7 +970,7 @@ let main ~input_file ~output_file_opt ~archive_uri ~continue_on_error () = let tuple (sc : Sql.Zkapp_command.t) = (sc.global_slot_since_genesis, sc.sequence_no) in - [%compare: int64 * int] (tuple sc1) (tuple sc2)) + [%compare: int64 * int] (tuple sc1) (tuple sc2) ) in (* apply commands in global slot, sequence order *) let rec apply_commands (internal_cmds : Sql.Internal_command.t list) @@ -1015,11 +1014,11 @@ let main ~input_file ~output_file_opt ~archive_uri ~continue_on_error () = ~metadata:[ ("block_id", `Int last_block_id) ] ; let%bind accounts_accessed_db = query_db ~f:(fun db -> - Processor.Accounts_accessed.all_from_block db last_block_id) + Processor.Accounts_accessed.all_from_block db last_block_id ) in let%bind accounts_created_db = query_db ~f:(fun db -> - Processor.Accounts_created.all_from_block db last_block_id) + Processor.Accounts_created.all_from_block db last_block_id ) in [%log info] "Verifying that accounts created are also deemed accessed in block \ @@ -1032,7 +1031,7 @@ let main ~input_file ~output_file_opt ~archive_uri ~continue_on_error () = Option.is_none (List.find accounts_accessed_db ~f:(fun { account_identifier_id = acct_id_accessed; _ } -> - acct_id_accessed = acct_id_created)) + acct_id_accessed = acct_id_created ) ) then ( [%log error] "Created account not present in accessed accounts" ~metadata: @@ -1040,7 +1039,7 @@ let main ~input_file ~output_file_opt ~archive_uri ~continue_on_error () = ; ("block_id", `Int last_block_id) ] ; if continue_on_error then incr error_count - else Core_kernel.exit 1 )) ; + else Core_kernel.exit 1 ) ) ; [%log info] "Verifying balances and nonces for accounts accessed in block with \ global slot since genesis %Ld" @@ -1111,7 +1110,7 @@ let main ~input_file ~output_file_opt ~archive_uri ~continue_on_error () = , Mina_numbers.Account_nonce.to_yojson nonce ) ] ; if continue_on_error then incr error_count - else Core_kernel.exit 1 )) + else Core_kernel.exit 1 ) ) in let log_state_hash_on_next_slot curr_global_slot_since_genesis = let state_hash, _ledger_hash = @@ -1296,7 +1295,7 @@ let main ~input_file ~output_file_opt ~archive_uri ~continue_on_error () = let%bind start_slot_since_genesis = let%map slot_opt = query_db ~f:(fun db -> - Sql.Block.get_next_slot db input.start_slot_since_genesis) + Sql.Block.get_next_slot db input.start_slot_since_genesis ) in match slot_opt with | Some slot -> @@ -1349,7 +1348,7 @@ let main ~input_file ~output_file_opt ~archive_uri ~continue_on_error () = ~metadata:[ ("checkpoint_file", `String checkpoint_file) ] ; return @@ Out_channel.with_file checkpoint_file ~f:(fun oc -> - Out_channel.output_string oc replayer_checkpoint) + Out_channel.output_string oc replayer_checkpoint ) | Some target_epoch_ledgers_state_hash -> ( match output_file_opt with | None -> @@ -1369,7 +1368,7 @@ let main ~input_file ~output_file_opt ~archive_uri ~continue_on_error () = in return @@ Out_channel.with_file output_file ~f:(fun oc -> - Out_channel.output_string oc output) ) + Out_channel.output_string oc output ) ) else ( [%log error] "There were %d errors, not writing output" !error_count ; @@ -1398,4 +1397,4 @@ let () = Param.flag "--continue-on-error" ~doc:"Continue processing after errors" Param.no_arg in - main ~input_file ~output_file_opt ~archive_uri ~continue_on_error))) + main ~input_file ~output_file_opt ~archive_uri ~continue_on_error ))) diff --git a/src/app/swap_bad_balances/sql.ml b/src/app/swap_bad_balances/sql.ml index 099575e12c7..82ec136a101 100644 --- a/src/app/swap_bad_balances/sql.ml +++ b/src/app/swap_bad_balances/sql.ml @@ -33,7 +33,7 @@ module Receiver_balances = struct WHERE public_key_id = $1 AND balance = $2 LIMIT 1 - |sql}) + |sql} ) (pk, balance) with | Some id -> @@ -44,7 +44,7 @@ module Receiver_balances = struct Caqti_type.(tup2 int int64) Caqti_type.int "INSERT INTO balances (public_key_id,balance) VALUES ($1,$2) \ - RETURNING id") + RETURNING id" ) (pk, balance) let load (module Conn : Caqti_async.CONNECTION) id = @@ -55,7 +55,7 @@ module Receiver_balances = struct {sql| SELECT public_key_id,balance FROM balances WHERE id = $1 - |sql}) + |sql} ) id let query_swap_in_new_balance = diff --git a/src/app/swap_bad_balances/swap_bad_balances.ml b/src/app/swap_bad_balances/swap_bad_balances.ml index adfa03f8dfa..65c00a845fd 100644 --- a/src/app/swap_bad_balances/swap_bad_balances.ml +++ b/src/app/swap_bad_balances/swap_bad_balances.ml @@ -27,7 +27,7 @@ let main ~archive_uri ~state_hash ~sequence_no () = query_db ~f:(fun db -> Sql.Receiver_balances.run_ids_from_fee_transfer db state_hash - sequence_no) + sequence_no ) ~item:"receiver balance ids" in if List.length receiver_balance_ids <> 2 then ( @@ -71,14 +71,14 @@ let main ~archive_uri ~state_hash ~sequence_no () = let%bind new_balance_id_1 = query_db ~f:(fun db -> - Sql.Receiver_balances.add_if_doesn't_exist db balance_1_swapped) + Sql.Receiver_balances.add_if_doesn't_exist db balance_1_swapped ) ~item:"receiver balance 1 swapped" in [%log info] "New balance id for balance 1: %d" new_balance_id_1 ; let%bind new_balance_id_2 = query_db ~f:(fun db -> - Sql.Receiver_balances.add_if_doesn't_exist db balance_2_swapped) + Sql.Receiver_balances.add_if_doesn't_exist db balance_2_swapped ) ~item:"receiver balance 2 swapped" in [%log info] "New balance id for balance 2: %d" new_balance_id_2 ; @@ -87,7 +87,7 @@ let main ~archive_uri ~state_hash ~sequence_no () = query_db ~f:(fun db -> Sql.Receiver_balances.swap_in_new_balance db state_hash sequence_no - balance_1_id new_balance_id_1) + balance_1_id new_balance_id_1 ) ~item:"balance 1 swap" in [%log info] "Swapping in new balance 2" ; @@ -95,7 +95,7 @@ let main ~archive_uri ~state_hash ~sequence_no () = query_db ~f:(fun db -> Sql.Receiver_balances.swap_in_new_balance db state_hash sequence_no - balance_2_id new_balance_id_2) + balance_2_id new_balance_id_2 ) ~item:"balance 2 swap" in Deferred.unit @@ -122,4 +122,4 @@ let () = ~doc:"NN Sequence number of the two fee transfers" Param.(required int) in - main ~archive_uri ~state_hash ~sequence_no))) + main ~archive_uri ~state_hash ~sequence_no ))) diff --git a/src/app/test_executive/block_production_priority.ml b/src/app/test_executive/block_production_priority.ml index 401c2f56add..fcbf779e8f8 100644 --- a/src/app/test_executive/block_production_priority.ml +++ b/src/app/test_executive/block_production_priority.ml @@ -57,7 +57,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct let%bind () = Malleable_error.List.iter senders ~f:(fun s -> let%map pk = Util.pub_key_of_node s in - [%log info] "sender: %s" (pk_to_string pk)) + [%log info] "sender: %s" (pk_to_string pk) ) in let window_ms = (Network.constraint_constants network).block_window_duration_ms @@ -68,7 +68,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct ( Network.seeds network @ Network.block_producers network @ Network.snark_coordinators network ) - ~f:(Fn.compose (wait_for t) Wait_condition.node_to_initialize)) + ~f:(Fn.compose (wait_for t) Wait_condition.node_to_initialize) ) in let%bind () = section_hard "wait for 3 blocks to be produced (warm-up)" @@ -103,8 +103,8 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct let keys0, rest = List.split_n keys keys_per_sender in Network.Node.must_send_test_payments ~repeat_count ~repeat_delay_ms ~logger ~senders:keys0 ~receiver_pub_key ~amount ~fee node - >>| const rest) - >>| const ()) + >>| const rest ) + >>| const () ) in let%bind () = section "wait for payments to be processed" @@ -146,10 +146,10 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct [ `String b.state_hash ; `Int b.command_transaction_count ; `String b.creator_pk - ])) ) + ] ) ) ) ] ; (* TODO Use protocol constants to derive 125 *) - ok_if_true "blocks are not full (median test)" (tx_counts_med = 125)) + ok_if_true "blocks are not full (median test)" (tx_counts_med = 125) ) in let get_metrics node = Async_kernel.Deferred.bind @@ -165,7 +165,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct List.fold ~init:0 ~f:( + ) @@ List.drop rcv_delay 1 in (* First two slots might be delayed because of test's bootstrap, so we have 2 as a threshold *) - ok_if_true "block production was delayed" (rcv_delay_rest <= 2)) + ok_if_true "block production was delayed" (rcv_delay_rest <= 2) ) in section "retrieve metrics of tx sender nodes" (* We omit the result because we just want to query senders to see some useful @@ -173,5 +173,5 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct (Malleable_error.List.iter senders ~f: (Fn.compose Malleable_error.soften_error - (Fn.compose Malleable_error.ignore_m get_metrics))) + (Fn.compose Malleable_error.ignore_m get_metrics) ) ) end diff --git a/src/app/test_executive/chain_reliability_test.ml b/src/app/test_executive/chain_reliability_test.ml index dd1a9e38486..1873a8e0e1c 100644 --- a/src/app/test_executive/chain_reliability_test.ml +++ b/src/app/test_executive/chain_reliability_test.ml @@ -56,24 +56,24 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct ~soft_timeout:(Network_time_span.Slots 3) ~hard_timeout: (Network_time_span.Literal - (Time.Span.of_ms (15. *. 60. *. 1000.))) )) + (Time.Span.of_ms (15. *. 60. *. 1000.)) ) ) ) in let print_chains (labeled_chain_list : (string * string list) list) = List.iter labeled_chain_list ~f:(fun labeled_chain -> let label, chain = labeled_chain in let chain_str = String.concat ~sep:"\n" chain in - [%log info] "\nchain of %s:\n %s" label chain_str) + [%log info] "\nchain of %s:\n %s" label chain_str ) in section "common prefix of all nodes is no farther back than 1 block" (* the common prefix test relies on at least 4 blocks having been produced. previous sections altogether have already produced 4, so no further block production is needed. if previous sections change, then this may need to be re-adjusted*) (let%bind (labeled_chains : (string * string list) list) = Malleable_error.List.map all_nodes ~f:(fun node -> let%map chain = Network.Node.must_get_best_chain ~logger node in - (Node.id node, List.map ~f:(fun b -> b.state_hash) chain)) + (Node.id node, List.map ~f:(fun b -> b.state_hash) chain) ) in let (chains : string list list) = List.map labeled_chains ~f:(fun (_, chain) -> chain) in print_chains labeled_chains ; - Util.check_common_prefixes chains ~tolerance:1 ~logger) + Util.check_common_prefixes chains ~tolerance:1 ~logger ) end diff --git a/src/app/test_executive/delegation_test.ml b/src/app/test_executive/delegation_test.ml index 41c43445364..fa38416c901 100644 --- a/src/app/test_executive/delegation_test.ml +++ b/src/app/test_executive/delegation_test.ml @@ -55,12 +55,12 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct in wait_for t (Wait_condition.signed_command_to_be_included_in_frontier - ~txn_hash:hash ~node_included_in:`Any_node)) + ~txn_hash:hash ~node_included_in:`Any_node ) ) in section_hard "Running replayer" (let%bind logs = Network.Node.run_replayer ~logger (List.hd_exn @@ Network.archive_nodes network) in - check_replayer_logs ~logger logs) + check_replayer_logs ~logger logs ) end diff --git a/src/app/test_executive/gossip_consistency.ml b/src/app/test_executive/gossip_consistency.ml index b2ba5d821df..47975111586 100644 --- a/src/app/test_executive/gossip_consistency.ml +++ b/src/app/test_executive/gossip_consistency.ml @@ -23,7 +23,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct requires_graphql = true ; block_producers = List.init n ~f:(fun _ -> - { Wallet.balance = block_producer_balance; timing = Untimed }) + { Wallet.balance = block_producer_balance; timing = Untimed } ) } let send_payments ~logger ~sender_pub_key ~receiver_pub_key ~amount ~fee ~node @@ -57,7 +57,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct let%map () = wait_for dsl (Wait_condition.signed_command_to_be_included_in_frontier - ~txn_hash:hash ~node_included_in:`Any_node) + ~txn_hash:hash ~node_included_in:`Any_node ) in [%log info] "gossip_consistency test: payment #%d with hash %s successfully \ @@ -117,7 +117,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct (Printf.sprintf "transactions seen = %d, which is less than (numpayments = %d) \ - 1" - num_transactions_seen num_payments) + num_transactions_seen num_payments ) in [%log error] "gossip_consistency test: TEST FAILURE. transactions seen = %d, \ @@ -146,7 +146,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct Malleable_error.soft_error_string ~value:() (Printf.sprintf "consistency ratio = %f, which is less than threshold = %f" ratio - threshold) + threshold ) in [%log error] "gossip_consistency test: TEST FAILURE. consistency ratio = %f, \ diff --git a/src/app/test_executive/payments_test.ml b/src/app/test_executive/payments_test.ml index de36cc22b68..68f4d2a4591 100644 --- a/src/app/test_executive/payments_test.ml +++ b/src/app/test_executive/payments_test.ml @@ -86,7 +86,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct (List.to_string (Network.extra_genesis_keypairs network) ~f:(fun { Signature_lib.Keypair.public_key; _ } -> public_key |> Signature_lib.Public_key.to_bigstring - |> Bigstring.to_string)) ; + |> Bigstring.to_string ) ) ; let[@warning "-8"] [ fish1; fish2 ] = Network.extra_genesis_keypairs network in @@ -132,15 +132,14 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct ] ; let%bind txn_signed = User_command_input.to_user_command - ~get_current_nonce:(fun _ -> - failwith "get_current_nonce, don't call me") + ~get_current_nonce:(fun _ -> failwith "get_current_nonce, don't call me") ~nonce_map: (Account_id.Map.of_alist_exn [ ( Account_id.create sender_pub_key Account_id.Digest.default , (sender_current_nonce, sender_current_nonce) ) - ]) + ] ) ~get_account:(fun _ : Account.t option Participating_state.t -> - `Bootstrapping) + `Bootstrapping ) ~constraint_constants:test_constants ~logger user_command_input |> Deferred.bind ~f:Malleable_error.or_hard_error in @@ -158,8 +157,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct ~sender_pub_key: (Signed_command_payload.Body.source_pk signed_cmmd.payload.body) ~receiver_pub_key: - (Signed_command_payload.Body.receiver_pk - signed_cmmd.payload.body) + (Signed_command_payload.Body.receiver_pk signed_cmmd.payload.body) ~amount: ( Signed_command_payload.amount signed_cmmd.payload |> Option.value_exn ) @@ -167,7 +165,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct ~nonce:signed_cmmd.payload.common.nonce ~memo: (Signed_command_memo.to_raw_bytes_exn - signed_cmmd.payload.common.memo) + signed_cmmd.payload.common.memo ) ~token:(Signed_command_payload.token signed_cmmd.payload) ~valid_until:signed_cmmd.payload.common.valid_until ~raw_signature: @@ -175,7 +173,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct in wait_for t (Wait_condition.signed_command_to_be_included_in_frontier - ~txn_hash:hash ~node_included_in:(`Node untimed_node_b))) + ~txn_hash:hash ~node_included_in:(`Node untimed_node_b) ) ) in let%bind () = section @@ -237,7 +235,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct (Currency.Amount.to_int receiver_expected) (Currency.Balance.to_int sender_balance) (Currency.Amount.to_int sender_expected) - (Currency.Amount.to_int amount)) + (Currency.Amount.to_int amount) ) in let%bind () = section @@ -257,7 +255,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct ~nonce:signed_cmmd.payload.common.nonce ~memo: (Signed_command_memo.to_raw_bytes_exn - signed_cmmd.payload.common.memo) + signed_cmmd.payload.common.memo ) ~token:(Signed_command_payload.token signed_cmmd.payload) ~valid_until:signed_cmmd.payload.common.valid_until ~raw_signature: @@ -306,7 +304,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct (Mina_numbers.Account_nonce.succ signed_cmmd.payload.common.nonce) ~memo: (Signed_command_memo.to_raw_bytes_exn - signed_cmmd.payload.common.memo) + signed_cmmd.payload.common.memo ) ~token:(Signed_command_payload.token signed_cmmd.payload) ~valid_until:signed_cmmd.payload.common.valid_until ~raw_signature: @@ -357,11 +355,11 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct [%log info] "timed_node_c liquid balance: %s" (Currency.Balance.to_formatted_string ( timed_node_c_liquid_opt - |> Option.value ~default:Currency.Balance.zero )) ; + |> Option.value ~default:Currency.Balance.zero ) ) ; [%log info] "timed_node_c liquid locked: %s" (Currency.Balance.to_formatted_string ( timed_node_c_locked_opt - |> Option.value ~default:Currency.Balance.zero )) ; + |> Option.value ~default:Currency.Balance.zero ) ) ; [%log info] "Attempting to send txn from timed_node_c to untimed_node_a for \ amount of %s" @@ -372,7 +370,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct in wait_for t (Wait_condition.signed_command_to_be_included_in_frontier - ~txn_hash:hash ~node_included_in:(`Node timed_node_c))) + ~txn_hash:hash ~node_included_in:(`Node timed_node_c) ) ) in let%bind () = section "unable to send payment from timed account using illiquid tokens" @@ -419,7 +417,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct "Payment failed in GraphQL, but for unexpected reason: %s" err_str ; Malleable_error.soft_error_format ~value:() - "Payment failed for unexpected reason: %s" err_str )) + "Payment failed for unexpected reason: %s" err_str ) ) in let%bind () = section_hard @@ -448,15 +446,15 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct repeat_seq ~n:10 ~f:(fun () -> Network.Node.must_send_payment ~logger sender ~sender_pub_key ~receiver_pub_key ~amount:Currency.Amount.one ~fee - >>| ignore) + >>| ignore ) in wait_for t - (Wait_condition.ledger_proofs_emitted_since_genesis ~num_proofs:1)) + (Wait_condition.ledger_proofs_emitted_since_genesis ~num_proofs:1) ) in section_hard "running replayer" (let%bind logs = Network.Node.run_replayer ~logger (List.hd_exn @@ Network.archive_nodes network) in - check_replayer_logs ~logger logs) + check_replayer_logs ~logger logs ) end diff --git a/src/app/test_executive/peers_reliability_test.ml b/src/app/test_executive/peers_reliability_test.ml index ddeea41c90d..cb2b8e67e27 100644 --- a/src/app/test_executive/peers_reliability_test.ml +++ b/src/app/test_executive/peers_reliability_test.ml @@ -52,7 +52,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct "network can't be paritioned if 2 nodes are hypothetically taken \ offline" (Util.assert_peers_cant_be_partitioned ~max_disconnections:2 - initial_connectivity_data) + initial_connectivity_data ) in let%bind _ = section "blocks are produced" @@ -81,12 +81,12 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct |> Wait_condition.with_timeouts ~hard_timeout: (Network_time_span.Literal - (Time.Span.of_ms (15. *. 60. *. 1000.))) )) + (Time.Span.of_ms (15. *. 60. *. 1000.)) ) ) ) in section "network is fully connected after one node was restarted" (let%bind () = Malleable_error.lift (after (Time.Span.of_sec 240.0)) in let%bind final_connectivity_data = Util.fetch_connectivity_data ~logger all_nodes in - Util.assert_peers_completely_connected final_connectivity_data) + Util.assert_peers_completely_connected final_connectivity_data ) end diff --git a/src/app/test_executive/snarkyjs.ml b/src/app/test_executive/snarkyjs.ml index d4ccd5d24d5..553cd5072fa 100644 --- a/src/app/test_executive/snarkyjs.ml +++ b/src/app/test_executive/snarkyjs.ml @@ -68,7 +68,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct Mina_base.Account_id.create my_pk Mina_base.Token_id.default in let ({ private_key = zkapp_sk; public_key = zkapp_pk } - : Signature_lib.Keypair.t) = + : Signature_lib.Keypair.t ) = Signature_lib.Keypair.create () in let zkapp_pk = Signature_lib.Public_key.compress zkapp_pk in @@ -100,7 +100,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct ] () in - wait_and_stdout ~logger process) + wait_and_stdout ~logger process ) (wait_for t (Wait_condition.node_to_initialize node)) in let parties_contract = @@ -163,7 +163,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct ] ; Malleable_error.hard_error (Error.of_string - "State update not witnessed from smart contract execution") + "State update not witnessed from smart contract execution" ) in if Currency.Balance.(equal zkapp_balance zkapp_target_balance) then ( [%log info] "Ledger sees balance change from zkapp execution" ; @@ -177,7 +177,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct ] ; Malleable_error.hard_error (Error.of_string - "Balance changes not witnessed from smart contract execution") + "Balance changes not witnessed from smart contract execution" ) ) ) in return () diff --git a/src/app/test_executive/test_common.ml b/src/app/test_executive/test_common.ml index 4f17c557919..42563ad9c22 100644 --- a/src/app/test_executive/test_common.ml +++ b/src/app/test_executive/test_common.ml @@ -102,7 +102,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct Pickles_types.Vector.Vector_8.to_list ledger_update.app_state in List.for_all2_exn fs_requested fs_ledger ~f:(fun req ledg -> - compatible_item req ledg ~equal:Pickles.Backend.Tick.Field.equal) + compatible_item req ledg ~equal:Pickles.Backend.Tick.Field.equal ) in let delegates_compat = compatible_item requested_update.delegate ledger_update.delegate @@ -160,18 +160,18 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct split_logs |> List.filter ~f:(fun log -> String.is_substring log ~substring:error_log_substring - || String.is_substring log ~substring:fatal_log_substring) + || String.is_substring log ~substring:fatal_log_substring ) in let info_logs = split_logs |> List.filter ~f:(fun log -> - String.is_substring log ~substring:info_log_substring) + String.is_substring log ~substring:info_log_substring ) in let num_info_logs = List.length info_logs in if num_info_logs < 25 then Malleable_error.hard_error_string (sprintf "Replayer output contains suspiciously few (%d) Info logs" - num_info_logs) + num_info_logs ) else if List.is_empty error_logs then ( [%log info] "The replayer encountered no errors" ; Malleable_error.return () ) diff --git a/src/app/test_executive/test_executive.ml b/src/app/test_executive/test_executive.ml index eca44ed741d..10be6605dec 100644 --- a/src/app/test_executive/test_executive.ml +++ b/src/app/test_executive/test_executive.ml @@ -11,7 +11,7 @@ type engine = string * (module Intf.Engine.S) module Make_test_inputs (Engine : Intf.Engine.S) () : Intf.Test.Inputs_intf with type Engine.Network_config.Cli_inputs.t = - Engine.Network_config.Cli_inputs.t = struct + Engine.Network_config.Cli_inputs.t = struct module Engine = Engine module Dsl = Dsl.Make (Engine) () @@ -20,7 +20,7 @@ end type test_inputs_with_cli_inputs = | Test_inputs_with_cli_inputs : (module Intf.Test.Inputs_intf - with type Engine.Network_config.Cli_inputs.t = 'cli_inputs) + with type Engine.Network_config.Cli_inputs.t = 'cli_inputs ) * 'cli_inputs -> test_inputs_with_cli_inputs @@ -82,7 +82,7 @@ let report_test_errors ~log_error_set ~internal_error_set = (color_eprintf (color_of_severity severity) "%s %s\n" - (category_prefix_of_severity severity)) + (category_prefix_of_severity severity) ) in let max_sev a b = match (a, b) with @@ -117,8 +117,8 @@ let report_test_errors ~log_error_set ~internal_error_set = (color_of_severity severity) " [%s] %s\n" (Time.to_string error_message.timestamp) - (Yojson.Safe.to_string (Logger.Message.to_yojson error_message))) ; - Print.eprintf "\n") + (Yojson.Safe.to_string (Logger.Message.to_yojson error_message)) ) ; + Print.eprintf "\n" ) in (* check invariants *) if List.length log_errors.from_current_context > 0 then @@ -143,7 +143,7 @@ let report_test_errors ~log_error_set ~internal_error_set = (color_of_severity severity) " [%s] %s\n" (Time.to_string occurrence_time) - (Error.to_string_hum error))) ; + (Error.to_string_hum error) ) ) ; (* report non-contextualized internal errors *) List.iter internal_errors.from_current_context ~f:(fun (severity, { occurrence_time; error }) -> @@ -151,7 +151,7 @@ let report_test_errors ~log_error_set ~internal_error_set = (color_of_severity severity) "[%s] %s\n" (Time.to_string occurrence_time) - (Error.to_string_hum error)) ; + (Error.to_string_hum error) ) ; (* determine if test is passed/failed and exit accordingly *) let test_failed = match (log_errors_severity, internal_errors_severity) with @@ -288,7 +288,7 @@ let main inputs = in don't_wait_for (f_dispatch_cleanup ~exit_reason:"signal received" - ~test_result:(Malleable_error.hard_error error))) ; + ~test_result:(Malleable_error.hard_error error) ) ) ; let%bind monitor_test_result = let on_fatal_error message = don't_wait_for @@ -296,8 +296,8 @@ let main inputs = ~exit_reason: (sprintf !"log engine fatal error: %s" - (Yojson.Safe.to_string (Logger.Message.to_yojson message))) - ~test_result:(Malleable_error.hard_error_string "fatal error")) + (Yojson.Safe.to_string (Logger.Message.to_yojson message)) ) + ~test_result:(Malleable_error.hard_error_string "fatal error") ) in Monitor.try_with ~here:[%here] ~extract_exn:false (fun () -> let init_result = @@ -357,7 +357,7 @@ let main inputs = let%bind () = Malleable_error.List.iter non_seed_pods ~f:start_print in [%log info] "Daemons started" ; [%log trace] "executing test" ; - T.run network dsl) + T.run network dsl ) in let exit_reason, test_result = match monitor_test_result with diff --git a/src/app/test_executive/zkapps.ml b/src/app/test_executive/zkapps.ml index 3affd656164..4972003a5c1 100644 --- a/src/app/test_executive/zkapps.ml +++ b/src/app/test_executive/zkapps.ml @@ -65,7 +65,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct repeat_seq ~n ~f:(fun () -> Network.Node.must_send_payment ~logger sender ~sender_pub_key ~receiver_pub_key ~amount:Currency.Amount.one ~fee - >>| ignore) + >>| ignore ) let run network t = let open Malleable_error.Let_syntax in @@ -77,7 +77,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct (wait_for t (Wait_condition.nodes_to_initialize ( Network.seeds network @ block_producer_nodes - @ Network.snark_coordinators network ))) + @ Network.snark_coordinators network ) ) ) in let node = List.hd_exn block_producer_nodes in let constraint_constants = @@ -94,7 +94,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct List.map zkapp_keypairs ~f:(fun zkapp_keypair -> Account_id.create (zkapp_keypair.public_key |> Signature_lib.Public_key.compress) - Token_id.default) + Token_id.default ) in let%bind parties_create_account = (* construct a Parties.t, similar to zkapp_test_transaction create-snapp-account *) @@ -188,7 +188,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct let fields = Quickcheck.random_value (Quickcheck.Generator.list_with_length len - Snark_params.Tick.Field.gen) + Snark_params.Tick.Field.gen ) in List.map fields ~f:(fun field -> Zkapp_basic.Set_or_keep.Set field) |> Zkapp_state.V.of_list_exn @@ -291,7 +291,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct Control.Proof Mina_base.Proof.blockchain_dummy } | _ -> - other_p) + other_p ) } in let%bind.Deferred parties_nonexistent_fee_payer = @@ -355,7 +355,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct Pickles_types.Vector.Vector_8.to_list ledger_update.app_state in List.for_all2_exn fs_requested fs_ledger ~f:(fun req ledg -> - compatible req ledg ~equal:Pickles.Backend.Tick.Field.equal) + compatible req ledg ~equal:Pickles.Backend.Tick.Field.equal ) in let delegates_compat = compatible requested_update.delegate ledger_update.delegate @@ -461,12 +461,13 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct ] ; Malleable_error.hard_error (Error.of_string - "Ledger permissions do not match update permissions") ))) + "Ledger permissions do not match update permissions" ) ) ) + ) in let%bind () = section_hard "Send a zkapp with an insufficient fee" (send_invalid_zkapp ~logger node parties_insufficient_fee - "at least one user command had an insufficient fee") + "at least one user command had an insufficient fee" ) in (*Won't be accepted until the previous transactions are applied*) let%bind () = @@ -476,12 +477,12 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct let%bind () = section_hard "Send a zkapp with an invalid proof" (send_invalid_zkapp ~logger node parties_invalid_proof - "Verification_failed") + "Verification_failed" ) in let%bind () = section_hard "Send a zkapp with an insufficient replace fee" (send_invalid_zkapp ~logger node parties_insufficient_replace_fee - "Insufficient_replace_fee") + "Insufficient_replace_fee" ) in let%bind () = section_hard @@ -496,12 +497,12 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct let%bind () = section_hard "Send a zkApp transaction with an invalid signature" (send_invalid_zkapp ~logger node parties_invalid_signature - "Verification_failed") + "Verification_failed" ) in let%bind () = section_hard "Send a zkApp transaction with a nonexistent fee payer" (send_invalid_zkapp ~logger node parties_nonexistent_fee_payer - "Fee_payer_account_not_found") + "Fee_payer_account_not_found" ) in let%bind () = section_hard "Verify zkApp transaction updates in ledger" @@ -527,17 +528,18 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct ] ; Malleable_error.hard_error (Error.of_string - "Ledger update and requested update are incompatible") ))) + "Ledger update and requested update are incompatible" ) ) ) + ) in let%bind () = section_hard "Wait for proof to be emitted" (wait_for t - (Wait_condition.ledger_proofs_emitted_since_genesis ~num_proofs:1)) + (Wait_condition.ledger_proofs_emitted_since_genesis ~num_proofs:1) ) in section_hard "Running replayer" (let%bind logs = Network.Node.run_replayer ~logger (List.hd_exn @@ Network.archive_nodes network) in - check_replayer_logs ~logger logs) + check_replayer_logs ~logger logs ) end diff --git a/src/app/test_executive/zkapps_timing.ml b/src/app/test_executive/zkapps_timing.ml index 0da47a2c7b1..1f8aef9aea4 100644 --- a/src/app/test_executive/zkapps_timing.ml +++ b/src/app/test_executive/zkapps_timing.ml @@ -81,7 +81,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct } : Party.Update.Timing_info.value ) in - { Party.Update.dummy with timing }) + { Party.Update.dummy with timing } ) ; current_auth = Permissions.Auth_required.Signature ; call_data = Snark_params.Tick.Field.zero ; events = [] @@ -258,7 +258,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct Malleable_error.hard_error (Error.of_string "Ledger update and requested update with timing are \ - incompatible") )) + incompatible" ) ) ) in let%bind { total_balance = before_balance; _ } = Network.Node.must_get_account_data ~logger node @@ -292,7 +292,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct | None -> Malleable_error.hard_error (Error.of_string - "Unexpected underflow when taking balance difference") + "Unexpected underflow when taking balance difference" ) | Some diff -> let sender_party = (List.hd_exn parties_transfer_from_timed_account.other_parties) @@ -321,7 +321,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct (Currency.Amount.to_string total_debited) (Currency.Amount.to_string amount_to_send) (Currency.Amount.to_string fee) - (Currency.Amount.to_string diff)) ) + (Currency.Amount.to_string diff) ) ) in let%bind () = section @@ -329,7 +329,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct balance" (let sender_party = (List.hd_exn - parties_invalid_transfer_from_timed_account.other_parties) + parties_invalid_transfer_from_timed_account.other_parties ) .elt .party in @@ -367,14 +367,14 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct assert ( Currency.Amount.( < ) proposed_balance (Option.value_exn locked_balance |> Currency.Balance.to_amount) ) ; - send_zkapp ~logger node parties_invalid_transfer_from_timed_account) + send_zkapp ~logger node parties_invalid_transfer_from_timed_account ) in let%bind () = section "Waiting for snapp with transfer from timed account that fails due to \ min balance" (wait_for_snapp ~has_failures:true - parties_invalid_transfer_from_timed_account) + parties_invalid_transfer_from_timed_account ) in (* TODO: use transaction status to see that the transaction failed as things are, we examine the balance of the sender to see that no funds were transferred @@ -396,7 +396,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct (Currency.Balance.to_amount after_balance) (Currency.Amount.of_fee (Mina_base.Parties.fee - parties_invalid_transfer_from_timed_account)) + parties_invalid_transfer_from_timed_account ) ) |> Option.value_exn in (* the invalid transfer should result in a fee deduction only *) @@ -412,7 +412,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct expected a balance of %s" (Currency.Balance.to_string after_invalid_balance) (Currency.Amount.to_string - expected_after_invalid_balance_as_amount))) + expected_after_invalid_balance_as_amount ) ) ) in let%bind () = section "Send a snapp with invalid timing update" @@ -440,12 +440,12 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct "Ledger update contains new timing, which should not have been \ applied" ; Malleable_error.hard_error - (Error.of_string "Ledger update contains a timing update") )) + (Error.of_string "Ledger update contains a timing update") ) ) in section_hard "Running replayer" (let%bind logs = Network.Node.run_replayer ~logger (List.hd_exn @@ Network.archive_nodes network) in - check_replayer_logs ~logger logs) + check_replayer_logs ~logger logs ) end diff --git a/src/app/zkapp_test_transaction/lib/commands.ml b/src/app/zkapp_test_transaction/lib/commands.ml index 3d349ac3e15..cb88803fe81 100644 --- a/src/app/zkapp_test_transaction/lib/commands.ml +++ b/src/app/zkapp_test_transaction/lib/commands.ml @@ -55,7 +55,7 @@ let gen_proof ?(zkapp_account = None) (parties : Parties.t) = ; zkapp = Some { Zkapp_account.default with verification_key = Some vk } } - |> Or_error.ok_exn |> ignore) + |> Or_error.ok_exn |> ignore ) in let consensus_constants = Consensus.Constants.create ~constraint_constants @@ -105,11 +105,11 @@ let gen_proof ?(zkapp_account = None) (parties : Parties.t) = Transaction_snark.Parties_segment.Basic.t * \ Transaction_snark.Statement.With_sok.t * (int * \ Zkapp_statement.t)option) }%!" - w) ; + w ) ; let%map _ = T.of_parties_segment_exn ~snapp_statement ~statement ~witness ~spec in - ((), ())) + ((), ()) ) in () @@ -161,7 +161,7 @@ let generate_zkapp_txn (keypair : Signature_lib.Keypair.t) (ledger : Ledger.t) List.iter (Ledger.to_list ledger) ~f:(fun acc -> printf "Account: %s\n%!" ( Genesis_ledger_helper_lib.Accounts.Single.of_account acc None - |> Runtime_config.Accounts.Single.to_yojson |> Yojson.Safe.to_string )) ; + |> Runtime_config.Accounts.Single.to_yojson |> Yojson.Safe.to_string ) ) ; let state_body = compile_time_genesis.data |> Mina_state.Protocol_state.body in @@ -199,11 +199,11 @@ let generate_zkapp_txn (keypair : Signature_lib.Keypair.t) (ledger : Ledger.t) Transaction_snark.Parties_segment.Basic.t * \ Transaction_snark.Statement.With_sok.t * (int * \ Zkapp_statement.t)option) }%!" - w) ; + w ) ; let%map _ = T.of_parties_segment_exn ~snapp_statement ~statement ~witness ~spec in - ((), ())) + ((), ()) ) in () @@ -216,7 +216,7 @@ module App_state = struct Zkapp_basic.Set_or_keep.Keep | _ -> parse_field_element_or_hash_string str ~f:(fun result -> - Zkapp_basic.Set_or_keep.Set result) + Zkapp_basic.Set_or_keep.Set result ) end module Events = struct @@ -228,7 +228,7 @@ module Events = struct | "" -> Snark_params.Tick.Field.zero | _ -> - parse_field_element_or_hash_string s ~f:Fn.id) + parse_field_element_or_hash_string s ~f:Fn.id ) end module Util = struct @@ -247,14 +247,14 @@ module Util = struct let memo = Option.value_map ~default:Signed_command_memo.empty ~f:(fun m -> - Signed_command_memo.create_from_string_exn m) + Signed_command_memo.create_from_string_exn m ) let app_state_of_list lst = let app_state = List.map ~f:App_state.of_string lst in List.append app_state (List.init (8 - List.length app_state) - ~f:(fun _ -> Zkapp_basic.Set_or_keep.Keep)) + ~f:(fun _ -> Zkapp_basic.Set_or_keep.Keep) ) |> Zkapp_state.V.of_list_exn let sequence_state_of_list array_lst : Snark_params.Tick.Field.t array list = @@ -370,8 +370,8 @@ let upgrade_zkapp ~debug ~keyfile ~fee ~nonce ~memo ~zkapp_keyfile gen_proof parties ~zkapp_account: (Some - (Signature_lib.Public_key.compress - zkapp_account_keypair.public_key)) + (Signature_lib.Public_key.compress zkapp_account_keypair.public_key) + ) else return () in parties @@ -381,7 +381,7 @@ let transfer_funds ~debug ~keyfile ~fee ~nonce ~memo ~receivers = let%bind receivers = receivers in let amount = List.fold ~init:Currency.Amount.zero receivers ~f:(fun acc (_, a) -> - Option.value_exn (Currency.Amount.add acc a)) + Option.value_exn (Currency.Amount.add acc a) ) in let%bind keypair = Util.keypair_of_file keyfile in let spec = @@ -477,8 +477,8 @@ let update_zkapp_uri ~debug ~keyfile ~fee ~nonce ~memo ~snapp_keyfile ~zkapp_uri gen_proof parties ~zkapp_account: (Some - (Signature_lib.Public_key.compress - zkapp_account_keypair.public_key)) + (Signature_lib.Public_key.compress zkapp_account_keypair.public_key) + ) else return () in parties @@ -553,8 +553,8 @@ let update_token_symbol ~debug ~keyfile ~fee ~nonce ~memo ~snapp_keyfile gen_proof parties ~zkapp_account: (Some - (Signature_lib.Public_key.compress - zkapp_account_keypair.public_key)) + (Signature_lib.Public_key.compress zkapp_account_keypair.public_key) + ) else return () in parties @@ -702,10 +702,10 @@ let%test_module "ZkApps test transaction" = , print_diff_yojson ~path:[ string_of_int i; "other_parties" ] (Party.to_yojson expected) (Party.to_yojson got) - && ok )) + && ok ) ) in if ok_fee_payer && ok_other_parties then return (Ok "Passed") - else return (Error "invalid snapp transaction generated"))) + else return (Error "invalid snapp transaction generated") )) in let schema = Graphql_async.Schema.( @@ -742,7 +742,7 @@ let%test_module "ZkApps test transaction" = q (Parties.to_yojson p |> Yojson.Safe.to_string) e ; - failwith "Invalid graphql query") + failwith "Invalid graphql query" ) | Signed_command _ -> - failwith "Expected a Parties command") + failwith "Expected a Parties command" ) end ) diff --git a/src/app/zkapp_test_transaction/zkapp_test_transaction.ml b/src/app/zkapp_test_transaction/zkapp_test_transaction.ml index c042066c2ee..7f627e512d2 100644 --- a/src/app/zkapp_test_transaction/zkapp_test_transaction.ml +++ b/src/app/zkapp_test_transaction/zkapp_test_transaction.ml @@ -22,7 +22,7 @@ module Flags = struct "FEE Amount you are willing to pay to process the transaction \ (default: %s) (minimum: %s)" (Currency.Fee.to_formatted_string default_fee) - (Currency.Fee.to_formatted_string min_fee)) + (Currency.Fee.to_formatted_string min_fee) ) (Param.optional txn_fee) let amount = @@ -77,8 +77,9 @@ let create_zkapp_account = if Currency.Fee.(fee < Flags.min_fee) then failwith (sprintf "Fee must at least be %s" - (Currency.Fee.to_formatted_string Flags.min_fee)) ; - create_command ~debug ~keyfile ~fee ~zkapp_keyfile ~amount ~nonce ~memo)) + (Currency.Fee.to_formatted_string Flags.min_fee) ) ; + create_command ~debug ~keyfile ~fee ~zkapp_keyfile ~amount ~nonce ~memo + )) let upgrade_zkapp = let create_command ~debug ~keyfile ~fee ~nonce ~memo ~zkapp_keyfile @@ -119,10 +120,10 @@ let upgrade_zkapp = if Currency.Fee.(fee < Flags.min_fee) then failwith (sprintf "Fee must at least be %s" - (Currency.Fee.to_formatted_string Flags.min_fee)) ; + (Currency.Fee.to_formatted_string Flags.min_fee) ) ; let zkapp_uri = Zkapp_basic.Set_or_keep.of_option zkapp_uri_str in create_command ~debug ~keyfile ~fee ~nonce ~memo ~zkapp_keyfile - ~verification_key ~zkapp_uri ~auth)) + ~verification_key ~zkapp_uri ~auth )) let transfer_funds = let create_command ~debug ~keyfile ~fee ~nonce ~memo ~receivers () = @@ -187,7 +188,7 @@ let transfer_funds = () ; let max_keys = 10 in let receivers = read_key_and_amount max_keys in - create_command ~debug ~keyfile ~fee ~nonce ~memo ~receivers)) + create_command ~debug ~keyfile ~fee ~nonce ~memo ~receivers )) let update_state = let create_command ~debug ~keyfile ~fee ~nonce ~memo ~zkapp_keyfile ~app_state @@ -219,9 +220,9 @@ let update_state = if Currency.Fee.(fee < Flags.min_fee) then failwith (sprintf "Fee must at least be %s" - (Currency.Fee.to_formatted_string Flags.min_fee)) ; + (Currency.Fee.to_formatted_string Flags.min_fee) ) ; create_command ~debug ~keyfile ~fee ~nonce ~memo ~zkapp_keyfile - ~app_state)) + ~app_state )) let update_zkapp_uri = let create_command ~debug ~keyfile ~fee ~nonce ~memo ~snapp_keyfile ~zkapp_uri @@ -259,9 +260,9 @@ let update_zkapp_uri = if Currency.Fee.(fee < Flags.min_fee) then failwith (sprintf "Fee must at least be %s" - (Currency.Fee.to_formatted_string Flags.min_fee)) ; + (Currency.Fee.to_formatted_string Flags.min_fee) ) ; create_command ~debug ~keyfile ~fee ~nonce ~memo ~snapp_keyfile - ~zkapp_uri ~auth)) + ~zkapp_uri ~auth )) let update_sequence_state = let create_command ~debug ~keyfile ~fee ~nonce ~memo ~zkapp_keyfile @@ -289,34 +290,33 @@ let update_sequence_state = Param.( required (Arg_type.comma_separated ~allow_empty:false - ~strip_whitespace:true string)) + ~strip_whitespace:true string )) and sequence_state1 = Param.flag "--sequence-state1" ~doc:"String(hash)|Integer(field element) a list of elements" Param.( optional_with_default [] (Arg_type.comma_separated ~allow_empty:false - ~strip_whitespace:true string)) + ~strip_whitespace:true string )) and sequence_state2 = Param.flag "--sequence-state2" ~doc:"String(hash)|Integer(field element) a list of elements" Param.( optional_with_default [] (Arg_type.comma_separated ~allow_empty:false - ~strip_whitespace:true string)) + ~strip_whitespace:true string )) and sequence_state3 = Param.flag "--sequence-state3" ~doc:"String(hash)|Integer(field element) a list of elements" Param.( optional_with_default [] (Arg_type.comma_separated ~allow_empty:false - ~strip_whitespace:true string)) + ~strip_whitespace:true string )) in let fee = Option.value ~default:Flags.default_fee fee in let sequence_state = List.filter_map - ~f:(fun s -> - if List.is_empty s then None else Some (Array.of_list s)) + ~f:(fun s -> if List.is_empty s then None else Some (Array.of_list s)) [ sequence_state0 ; sequence_state1 ; sequence_state2 @@ -326,9 +326,9 @@ let update_sequence_state = if Currency.Fee.(fee < Flags.min_fee) then failwith (sprintf "Fee must at least be %s" - (Currency.Fee.to_formatted_string Flags.min_fee)) ; + (Currency.Fee.to_formatted_string Flags.min_fee) ) ; create_command ~debug ~keyfile ~fee ~nonce ~memo ~zkapp_keyfile - ~sequence_state)) + ~sequence_state )) let update_token_symbol = let create_command ~debug ~keyfile ~fee ~nonce ~memo ~snapp_keyfile @@ -366,9 +366,9 @@ let update_token_symbol = if Currency.Fee.(fee < Flags.min_fee) then failwith (sprintf "Fee must at least be %s" - (Currency.Fee.to_formatted_string Flags.min_fee)) ; + (Currency.Fee.to_formatted_string Flags.min_fee) ) ; create_command ~debug ~keyfile ~fee ~nonce ~memo ~snapp_keyfile - ~token_symbol ~auth)) + ~token_symbol ~auth )) let update_permissions = let create_command ~debug ~keyfile ~fee ~nonce ~memo ~zkapp_keyfile @@ -451,10 +451,10 @@ let update_permissions = if Currency.Fee.(fee < Flags.min_fee) then failwith (sprintf "Fee must at least be %s" - (Currency.Fee.to_formatted_string Flags.min_fee)) ; + (Currency.Fee.to_formatted_string Flags.min_fee) ) ; create_command ~debug ~keyfile ~fee ~nonce ~memo ~zkapp_keyfile ~permissions - ~current_auth:(Util.auth_of_string current_auth))) + ~current_auth:(Util.auth_of_string current_auth) )) let test_zkapp_with_genesis_ledger = Command.( @@ -479,7 +479,7 @@ let test_zkapp_with_genesis_ledger = "PATH path to a configuration file consisting the genesis ledger" Param.(required string) in - test_zkapp_with_genesis_ledger_main keyfile zkapp_keyfile config_file)) + test_zkapp_with_genesis_ledger_main keyfile zkapp_keyfile config_file )) let txn_commands = [ ("create-zkapp-account", create_zkapp_account) @@ -496,4 +496,4 @@ let txn_commands = let () = Command.run (Command.group ~summary:"ZkApp test transaction" - ~preserve_subcommand_order:() txn_commands) + ~preserve_subcommand_order:() txn_commands ) diff --git a/src/dune-project b/src/dune-project index ce8dd0ed17f..85d577b5415 100644 --- a/src/dune-project +++ b/src/dune-project @@ -1,2 +1,2 @@ -(lang dune 2.7) +(lang dune 3.1) (implicit_transitive_deps false) diff --git a/src/lib/allocation_functor/table.ml b/src/lib/allocation_functor/table.ml index 0c0ce321ca4..20ad8ee0fd9 100644 --- a/src/lib/allocation_functor/table.ml +++ b/src/lib/allocation_functor/table.ml @@ -69,7 +69,7 @@ module Allocation_data = struct in let sum = List.fold_left indices ~init:0.0 ~f:(fun acc i -> - acc +. get_lifetime_ms (count - 1 - (i + offset))) + acc +. get_lifetime_ms (count - 1 - (i + offset)) ) in sum /. Int.to_float (List.length indices) in @@ -115,7 +115,7 @@ module Allocation_data = struct { allocation_times = Queue.of_list @@ List.map (List.rev time_offsets) ~f:(fun offset -> - (0, Time.sub now (Time.Span.of_ms offset))) + (0, Time.sub now (Time.Span.of_ms offset)) ) ; next_allocation_id = 0 } in @@ -202,6 +202,6 @@ let dump () = let entries = String.Table.to_alist table |> List.Assoc.map ~f:(fun { statistics; _ } -> - Allocation_statistics.to_yojson statistics) + Allocation_statistics.to_yojson statistics ) in `Assoc entries diff --git a/src/lib/base58_check/base58_check.ml b/src/lib/base58_check/base58_check.ml index 8ef68633ba8..9ccceff8214 100644 --- a/src/lib/base58_check/base58_check.ml +++ b/src/lib/base58_check/base58_check.ml @@ -89,7 +89,7 @@ struct let len_prefixed_encoded_chunks = List.map chunks ~f:(fun chunk -> let encoded = encode_unchunked chunk in - sprintf "%04X%s" (String.length encoded) encoded) + sprintf "%04X%s" (String.length encoded) encoded ) in String.concat (String.of_char chunk_marker :: len_prefixed_encoded_chunks) @@ -180,8 +180,8 @@ struct Or_error.error_string (error_str (sprintf "version byte \\x%02X, expected \\x%02X" (Char.to_int ch) - (Char.to_int version_byte)) - str) + (Char.to_int version_byte) ) + str ) end module Version_bytes = Version_bytes diff --git a/src/lib/best_tip_prover/best_tip_prover.ml b/src/lib/best_tip_prover/best_tip_prover.ml index 37457183c82..99f83c88dcc 100644 --- a/src/lib/best_tip_prover/best_tip_prover.ml +++ b/src/lib/best_tip_prover/best_tip_prover.ml @@ -39,7 +39,7 @@ module Make (Inputs : Inputs_intf) : let hash acc body_hash = (Protocol_state.hashes_abstract ~hash_body:Fn.id - { previous_state_hash = acc; body = body_hash }) + { previous_state_hash = acc; body = body_hash } ) .state_hash end) @@ -136,7 +136,7 @@ module Make (Inputs : Inputs_intf) : @@ sprintf !"Peer should have given a proof of length %d but got %d" max_length merkle_list_length ) - (Int.equal max_length merkle_list_length || root_is_genesis)) + (Int.equal max_length merkle_list_length || root_is_genesis) ) in let best_tip_with_hash = With_hash.of_data best_tip ~hash_data:state_hashes @@ -150,13 +150,13 @@ module Make (Inputs : Inputs_intf) : (Merkle_list_verifier.verify ~init: (State_hash.With_state_hashes.state_hash - root_transition_with_hash) + root_transition_with_hash ) merkle_list - (State_hash.With_state_hashes.state_hash best_tip_with_hash)) + (State_hash.With_state_hashes.state_hash best_tip_with_hash) ) ~error: (Error.of_string "Peer should have given a valid merkle list proof for their \ - best tip")) + best tip" ) ) in let%map root, best_tip = Deferred.Or_error.both diff --git a/src/lib/bignum_bigint/bignum_bigint.ml b/src/lib/bignum_bigint/bignum_bigint.ml index e460ac70b33..d5c07844865 100644 --- a/src/lib/bignum_bigint/bignum_bigint.ml +++ b/src/lib/bignum_bigint/bignum_bigint.ml @@ -5,9 +5,9 @@ let of_bool (b : bool) : t = if b then one else zero let of_bit_fold_lsb ({ fold } : bool Fold_lib.Fold.t) : t = fold ~init:(0, zero) ~f:(fun (i, acc) b -> - (Int.(i + 1), bit_or (shift_left (of_bool b) i) acc)) + (Int.(i + 1), bit_or (shift_left (of_bool b) i) acc) ) |> snd let of_bits_lsb : bool list -> t = List.foldi ~init:zero ~f:(fun i acc b -> - bit_or (shift_left (of_bool b) i) acc) + bit_or (shift_left (of_bool b) i) acc ) diff --git a/src/lib/blake2/blake2.ml b/src/lib/blake2/blake2.ml index 9ec2c0c333d..557d1a3020a 100644 --- a/src/lib/blake2/blake2.ml +++ b/src/lib/blake2/blake2.ml @@ -69,14 +69,14 @@ module Make () = struct ~f:(fun i -> let c = Char.to_int s.[i / 8] in let j = i mod 8 in - Int.((c lsr j) land 1 = 1)) + Int.((c lsr j) land 1 = 1) ) end include Make () (* values come from external library digestif, and serialization relies on raw string functions in that library, so check serialization is stable - *) +*) let%test "serialization test V1" = let blake2s = T0.digest_string "serialization test V1" in let known_good_digest = "562733d10582c5832e541fb60e38e7c8" in @@ -91,4 +91,4 @@ let%test_unit "bits_to_string" = let%test_unit "string to bits" = Quickcheck.test ~trials:5 String.quickcheck_generator ~f:(fun s -> - [%test_eq: string] s (bits_to_string (string_to_bits s))) + [%test_eq: string] s (bits_to_string (string_to_bits s)) ) diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index e776db3c00c..c6be339d199 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -59,7 +59,7 @@ let lift_sync f = (Deferred.create (fun ivar -> if Ivar.is_full ivar then [%log' error (Logger.create ())] "Ivar.fill bug is here!" ; - Ivar.fill ivar (f ()))) + Ivar.fill ivar (f ()) ) ) module Singleton_scheduler : sig type t @@ -104,7 +104,7 @@ end = struct let timeout = Block_time.Timeout.create t.time_controller wait_span ~f:(fun _ -> t.timeout <- None ; - f ()) + f () ) in t.timeout <- Some timeout end @@ -119,7 +119,7 @@ let generate_next_state ~constraint_constants ~previous_protocol_state in let previous_protocol_state_hash = (Protocol_state.hashes_with_body - ~body_hash:previous_protocol_state_body_hash previous_protocol_state) + ~body_hash:previous_protocol_state_body_hash previous_protocol_state ) .state_hash in let previous_state_view = @@ -147,7 +147,7 @@ let generate_next_state ~constraint_constants ~previous_protocol_state ~transactions_by_fee:transactions ~get_completed_work ~log_block_creation ~supercharge_coinbase |> Result.map_error ~f:(fun err -> - Staged_ledger.Staged_ledger_error.Pre_diff err) + Staged_ledger.Staged_ledger_error.Pre_diff err ) in match (diff, block_reward_threshold) with | Ok d, Some threshold -> @@ -155,7 +155,7 @@ let generate_next_state ~constraint_constants ~previous_protocol_state Option.value ~default:Currency.Amount.zero (Staged_ledger_diff.net_return ~constraint_constants ~supercharge_coinbase - (Staged_ledger_diff.forget d)) + (Staged_ledger_diff.forget d) ) in if Currency.Amount.(net_return >= threshold) then diff else ( @@ -253,7 +253,7 @@ let generate_next_state ~constraint_constants ~previous_protocol_state let supply_increase = Option.value_map ledger_proof_opt ~f:(fun (proof, _) -> - (Ledger_proof.statement proof).supply_increase) + (Ledger_proof.statement proof).supply_increase ) ~default:Currency.Amount.zero in let blockchain_state = @@ -278,7 +278,7 @@ let generate_next_state ~constraint_constants ~previous_protocol_state ~previous_protocol_state ~blockchain_state ~current_time ~block_data ~supercharge_coinbase ~snarked_ledger_hash:previous_ledger_hash ~genesis_ledger_hash - ~supply_increase ~logger ~constraint_constants)) + ~supply_increase ~logger ~constraint_constants ) ) in lift_sync (fun () -> let snark_transition = @@ -287,7 +287,7 @@ let generate_next_state ~constraint_constants ~previous_protocol_state ~blockchain_state: (Protocol_state.blockchain_state protocol_state) ~consensus_transition:consensus_transition_data - ~pending_coinbase_update ()) + ~pending_coinbase_update () ) in let internal_transition = O1trace.sync_thread "generate_internal_transition" (fun () -> @@ -296,7 +296,7 @@ let generate_next_state ~constraint_constants ~previous_protocol_state (Consensus.Data.Block_data.prover_state block_data) ~staged_ledger_diff:(Staged_ledger_diff.forget diff) ~ledger_proof: - (Option.map ledger_proof_opt ~f:(fun (proof, _) -> proof))) + (Option.map ledger_proof_opt ~f:(fun (proof, _) -> proof)) ) in let witness = { Pending_coinbase_witness.pending_coinbases = @@ -304,7 +304,7 @@ let generate_next_state ~constraint_constants ~previous_protocol_state ; is_new_stack } in - Some (protocol_state, internal_transition, witness)) + Some (protocol_state, internal_transition, witness) ) module Precomputed = struct type t = Precomputed.t = @@ -348,7 +348,7 @@ let handle_block_production_errors ~logger ~rejected_blocks_logger ( err , ( previous_protocol_state_proof , internal_transition - , pending_coinbase_witness ) )) -> + , pending_coinbase_witness ) ) ) -> let msg : (_, unit, string, unit) format4 = "Prover failed to prove freshly generated transition: $error" in @@ -470,7 +470,7 @@ module Vrf_evaluation_state = struct let poll_vrf_evaluator ~logger vrf_evaluator = let f () = O1trace.thread "query_vrf_evaluator" (fun () -> - Vrf_evaluator.slots_won_so_far vrf_evaluator) + Vrf_evaluator.slots_won_so_far vrf_evaluator ) in retry ~logger ~error_message:"Error fetching slots from the VRF evaluator" f @@ -498,7 +498,7 @@ module Vrf_evaluation_state = struct let%bind () = Async.after (Time.Span.of_ms - (Mina_compile_config.vrf_poll_interval_ms |> Int.to_float)) + (Mina_compile_config.vrf_poll_interval_ms |> Int.to_float) ) in poll_vrf_evaluator vrf_evaluator ~logger | _ -> @@ -512,14 +512,14 @@ module Vrf_evaluation_state = struct [ ( "slots" , `List (List.map vrf_result.slots_won ~f:(fun s -> - Mina_numbers.Global_slot.to_yojson s.global_slot)) ) + Mina_numbers.Global_slot.to_yojson s.global_slot ) ) ) ] let update_epoch_data ~vrf_evaluator ~logger ~epoch_data_for_vrf t = let set_epoch_data () = let f () = O1trace.thread "set_vrf_evaluator_epoch_state" (fun () -> - Vrf_evaluator.set_new_epoch_state vrf_evaluator ~epoch_data_for_vrf) + Vrf_evaluator.set_new_epoch_state vrf_evaluator ~epoch_data_for_vrf ) in retry ~logger ~error_message:"Error setting epoch state of the VRF evaluator" f @@ -683,8 +683,8 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system (Consensus.Hooks.select ~constants:consensus_constants ~existing: (With_hash.map ~f:Mina_block.consensus_state - previous_transition) - ~candidate:consensus_state_with_hashes ~logger) + previous_transition ) + ~candidate:consensus_state_with_hashes ~logger ) ~expect:`Take ~message: "newly generated consensus states should be selected \ @@ -697,11 +697,11 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system (Consensus.Hooks.select ~existing:root_consensus_state_with_hashes ~constants:consensus_constants - ~candidate:consensus_state_with_hashes ~logger) + ~candidate:consensus_state_with_hashes ~logger ) ~expect:`Take ~message: "newly generated consensus states should be selected \ - over the tf root") ; + over the tf root" ) ; Interruptible.uninterruptible (let open Deferred.Let_syntax in let emit_breadcrumb () = @@ -714,13 +714,13 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system ~prev_state:previous_protocol_state ~prev_state_proof:previous_protocol_state_proof ~next_state:protocol_state internal_transition - pending_coinbase_witness) + pending_coinbase_witness ) |> Deferred.Result.map_error ~f:(fun err -> `Prover_error ( err , ( previous_protocol_state_proof , internal_transition - , pending_coinbase_witness ) ))) + , pending_coinbase_witness ) ) ) ) in let staged_ledger_diff = Internal_transition.staged_ledger_diff internal_transition @@ -747,7 +747,7 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system ~body_reference: (Body_reference.of_body body) ~protocol_state ~protocol_state_proof - ~delta_block_chain_proof ())) + ~delta_block_chain_proof () ) ) } |> Validation.skip_time_received_validation `This_block_was_not_received_via_gossip @@ -757,7 +757,7 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system ~genesis_state_hash: (Protocol_state.genesis_state_hash ~state_hash:(Some previous_state_hash) - previous_protocol_state) + previous_protocol_state ) >>| Validation.skip_proof_validation `This_block_was_generated_internally >>| Validation.skip_delta_block_chain_validation @@ -770,7 +770,7 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system ~get_block_by_hash: (Fn.compose (Option.map ~f:Breadcrumb.block_with_hash) - (Transition_frontier.find frontier)) + (Transition_frontier.find frontier) ) |> Deferred.return in let transition_receipt_time = Some (Time.now ()) in @@ -781,7 +781,7 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system ~trust_system ~parent:crumb ~transition ~sender:None (* Consider skipping `All here *) ~skip_staged_ledger_verification:`Proofs - ~transition_receipt_time ()) + ~transition_receipt_time () ) |> Deferred.Result.map_error ~f:(function | `Invalid_staged_ledger_diff e -> `Invalid_staged_ledger_diff @@ -792,7 +792,7 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system | `Not_selected_over_frontier_root | `Parent_missing_from_frontier | `Prover_error _ ) as err -> - err) + err ) in [%str_log info] ~metadata: @@ -824,7 +824,7 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system Deferred.choose [ Deferred.choice (Transition_registry.register transition_registry - protocol_state_hashes.state_hash) + protocol_state_hashes.state_hash ) (Fn.const (Ok `Transition_accepted)) ; Deferred.choice ( Block_time.Timeout.create time_controller @@ -898,7 +898,7 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system Broadcast_pipe.Reader.iter_until frontier_reader ~f:(Fn.compose Deferred.return Option.is_some) in - check_next_block_timing slot i ()) + check_next_block_timing slot i () ) | Some transition_frontier -> let consensus_state = Transition_frontier.best_tip transition_frontier @@ -910,7 +910,7 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system Consensus.Hooks.get_epoch_data_for_vrf ~constants:consensus_constants (time_to_ms now) consensus_state ~local_state:consensus_local_state - ~logger) + ~logger ) in let i' = Mina_numbers.Length.succ epoch_data_for_vrf.epoch in let new_global_slot = epoch_data_for_vrf.global_slot in @@ -962,7 +962,7 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system Async.after (Time.Span.of_ms ( Mina_compile_config.vrf_poll_interval_ms - |> Int.to_float )) + |> Int.to_float ) ) in let%map () = Vrf_evaluation_state.poll ~vrf_evaluator ~logger @@ -988,7 +988,7 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system return (Singleton_scheduler.schedule scheduler epoch_end_time - ~f:(check_next_block_timing new_global_slot i')) + ~f:(check_next_block_timing new_global_slot i') ) | At last_slot -> set_next_producer_timing (`Evaluating_vrf last_slot) consensus_state ; @@ -1038,7 +1038,7 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system ignore ( Interruptible.finally (Singleton_supervisor.dispatch - production_supervisor (now, data, winner_pk)) + production_supervisor (now, data, winner_pk) ) ~f:(check_next_block_timing new_global_slot i') : (_, _) Interruptible.t ) ) else @@ -1073,7 +1073,7 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system start_time ~constants:consensus_constants (of_global_slot ~constants:consensus_constants - winning_global_slot)) + winning_global_slot )) |> Block_time.to_span_since_epoch |> Block_time.Span.to_ms in @@ -1106,19 +1106,19 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system |> Block_time.Span.to_time_span in let%bind () = after span_till_time in - generate_genesis_proof_if_needed ()) ; + generate_genesis_proof_if_needed () ) ; Singleton_scheduler.schedule scheduler scheduled_time ~f:(fun () -> ignore ( Interruptible.finally (Singleton_supervisor.dispatch production_supervisor - (scheduled_time, data, winner_pk)) + (scheduled_time, data, winner_pk) ) ~f: (check_next_block_timing - new_global_slot i') - : (_, _) Interruptible.t )) ; - Deferred.return () ))) + new_global_slot i' ) + : (_, _) Interruptible.t ) ) ; + Deferred.return () ) ) ) in let start () = check_next_block_timing Mina_numbers.Global_slot.zero @@ -1144,7 +1144,7 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system ignore ( Block_time.Timeout.create time_controller time_till_genesis ~f:(fun _ -> start ()) - : unit Block_time.Timeout.t )) + : unit Block_time.Timeout.t ) ) let run_precomputed ~logger ~verifier ~trust_system ~time_controller ~frontier_reader ~transition_writer ~precomputed_blocks @@ -1201,8 +1201,8 @@ let run_precomputed ~logger ~verifier ~trust_system ~time_controller (Consensus.Hooks.select ~constants:consensus_constants ~existing: (With_hash.map ~f:Mina_block.consensus_state - previous_transition) - ~candidate:consensus_state_with_hashes ~logger) + previous_transition ) + ~candidate:consensus_state_with_hashes ~logger ) ~expect:`Take ~message: "newly generated consensus states should be selected over \ @@ -1214,11 +1214,11 @@ let run_precomputed ~logger ~verifier ~trust_system ~time_controller [%test_result: [ `Take | `Keep ]] (Consensus.Hooks.select ~existing:root_consensus_state_with_hashes ~constants:consensus_constants - ~candidate:consensus_state_with_hashes ~logger) + ~candidate:consensus_state_with_hashes ~logger ) ~expect:`Take ~message: "newly generated consensus states should be selected over the \ - tf root") ; + tf root" ) ; let emit_breadcrumb () = let open Deferred.Result.Let_syntax in let previous_protocol_state_hash = @@ -1235,7 +1235,7 @@ let run_precomputed ~logger ~verifier ~trust_system ~time_controller (Header.create ~body_reference:(Body_reference.of_body body) ~protocol_state ~protocol_state_proof - ~delta_block_chain_proof ())) + ~delta_block_chain_proof () ) ) } |> Validation.skip_time_received_validation `This_block_was_not_received_via_gossip @@ -1249,7 +1249,7 @@ let run_precomputed ~logger ~verifier ~trust_system ~time_controller ~genesis_state_hash: (Protocol_state.genesis_state_hash ~state_hash:(Some previous_protocol_state_hash) - previous_protocol_state) + previous_protocol_state ) >>= Validation.validate_frontier_dependencies ~logger ~consensus_constants ~root_block: @@ -1258,7 +1258,7 @@ let run_precomputed ~logger ~verifier ~trust_system ~time_controller ~get_block_by_hash: (Fn.compose (Option.map ~f:Breadcrumb.block_with_hash) - (Transition_frontier.find frontier)) + (Transition_frontier.find frontier) ) |> Deferred.return in let transition_receipt_time = None in @@ -1277,7 +1277,7 @@ let run_precomputed ~logger ~verifier ~trust_system ~time_controller | `Invalid_staged_ledger_hash _ | `Not_selected_over_frontier_root | `Parent_missing_from_frontier ) as err -> - err)) + err ) ) in [%str_log trace] ~metadata:[ ("breadcrumb", Breadcrumb.to_yojson breadcrumb) ] @@ -1300,7 +1300,7 @@ let run_precomputed ~logger ~verifier ~trust_system ~time_controller Deferred.choose [ Deferred.choice (Transition_registry.register transition_registry - protocol_state_hashes.state_hash) + protocol_state_hashes.state_hash ) (Fn.const (Ok `Transition_accepted)) ; Deferred.choice ( Block_time.Timeout.create time_controller @@ -1346,8 +1346,7 @@ let run_precomputed ~logger ~verifier ~trust_system ~time_controller | Some (precomputed_block, precomputed_blocks) -> let new_time_offset = Time.diff (Time.now ()) - (Block_time.to_time - precomputed_block.Precomputed.scheduled_time) + (Block_time.to_time precomputed_block.Precomputed.scheduled_time) in [%log info] "Changing time offset from $old_time_offset to $new_time_offset" @@ -1355,7 +1354,7 @@ let run_precomputed ~logger ~verifier ~trust_system ~time_controller [ ( "old_time_offset" , `String (Time.Span.to_string_hum - (Block_time.Controller.get_time_offset ~logger)) ) + (Block_time.Controller.get_time_offset ~logger) ) ) ; ( "new_time_offset" , `String (Time.Span.to_string_hum new_time_offset) ) ] ; diff --git a/src/lib/blockchain_snark/blockchain.ml b/src/lib/blockchain_snark/blockchain.ml index 63626c67e55..378e352a989 100644 --- a/src/lib/blockchain_snark/blockchain.ml +++ b/src/lib/blockchain_snark/blockchain.ml @@ -30,7 +30,7 @@ module Stable = struct Allocation_functor.Intf.Output.Bin_io_and_sexp_intf with type t := T.t and type 'a creator := - state:Protocol_state.Value.t -> proof:Proof.t -> 'a ) + state:Protocol_state.Value.t -> proof:Proof.t -> 'a ) end end] diff --git a/src/lib/blockchain_snark/blockchain_snark_state.ml b/src/lib/blockchain_snark/blockchain_snark_state.ml index 21868eb58cc..4822f412628 100644 --- a/src/lib/blockchain_snark/blockchain_snark_state.ml +++ b/src/lib/blockchain_snark/blockchain_snark_state.ml @@ -37,7 +37,7 @@ let wrap_handler h w = | None -> blockchain_handler (fun (Snarky_backendless.Request.With { respond; _ }) -> - respond Unhandled) + respond Unhandled ) w | Some h -> (* TODO: Clean up the handler composition interface. *) @@ -58,10 +58,10 @@ let non_pc_registers_equal_var t1 t2 = ~ledger:(f !Frozen_ledger_hash.equal_var) ~pending_coinbase_stack:(fun acc f -> let () = F.get f t1 and () = F.get f t2 in - acc) + acc ) ~local_state:(fun acc f -> - Local_state.Checked.equal' (F.get f t1) (F.get f t2) @ acc) - |> Impl.Boolean.all) + Local_state.Checked.equal' (F.get f t1) (F.get f t2) @ acc ) + |> Impl.Boolean.all ) let non_pc_registers_equal t1 t2 = let module F = Core_kernel.Field in @@ -106,7 +106,7 @@ let%snarkydef step ~(logger : Logger.t) with_label __LOC__ (exists (Protocol_state.typ ~constraint_constants) - ~request:(As_prover.return Prev_state)) + ~request:(As_prover.return Prev_state) ) in let%bind h, body = Protocol_state.hash_checked t in let%map () = @@ -118,7 +118,7 @@ let%snarkydef step ~(logger : Logger.t) with_label __LOC__ (Consensus_state_hooks.next_state_checked ~constraint_constants ~prev_state:previous_state ~prev_state_hash:previous_state_hash - transition txn_snark.supply_increase) + transition txn_snark.supply_increase ) in let supercharge_coinbase = Consensus.Data.Consensus_state.supercharge_coinbase_var consensus_state @@ -188,7 +188,7 @@ let%snarkydef step ~(logger : Logger.t) (Pending_coinbase.Checked.add_coinbase ~constraint_constants root_after_delete (Snark_transition.pending_coinbase_update transition) - ~coinbase_receiver ~supercharge_coinbase previous_state_body_hash) + ~coinbase_receiver ~supercharge_coinbase previous_state_body_hash ) in (new_root, deleted_stack, no_coinbases_popped) in @@ -257,8 +257,8 @@ let%snarkydef step ~(logger : Logger.t) "blockchain snark update success: $result = \ (transaction_snark_input_correct=$transaction_snark_input_correct \ ∨ nothing_changed \ - (no_coinbases_popped=$no_coinbases_popped)=$nothing_changed) \ - ∧ updated_consensus_state=$updated_consensus_state ∧ \ + (no_coinbases_popped=$no_coinbases_popped)=$nothing_changed) ∧ \ + updated_consensus_state=$updated_consensus_state ∧ \ correct_coinbase_status=$correct_coinbase_status" ~metadata: [ ( "transaction_snark_input_correct" @@ -305,7 +305,7 @@ let check w ?handler ~proof_level ~constraint_constants txn_snark new_state_hash ~compute:(As_prover.return txn_snark) in step ~proof_level ~constraint_constants ~logger:(Logger.create ()) - [ prev; txn_snark ] curr)) + [ prev; txn_snark ] curr ) ) let rule ~proof_level ~constraint_constants transaction_snark self : _ Pickles.Inductive_rule.t = @@ -316,9 +316,9 @@ let rule ~proof_level ~constraint_constants transaction_snark self : let b1, b2 = Run.run_checked (step ~proof_level ~constraint_constants ~logger:(Logger.create ()) - [ x1; x2 ] x) + [ x1; x2 ] x ) in - [ b1; b2 ]) + [ b1; b2 ] ) ; main_value = (fun [ prev; (txn : Transaction_snark.Statement.With_sok.t) ] curr -> let registers (t : Protocol_state.Value.t) = @@ -326,7 +326,7 @@ let rule ~proof_level ~constraint_constants transaction_snark self : in [ not (Consensus.Data.Consensus_state.is_genesis_state - (Protocol_state.consensus_state curr)) + (Protocol_state.consensus_state curr) ) ; List.for_all ~f:Fn.id [ non_pc_registers_equal (registers prev) (registers curr) ; Currency.Amount.(equal zero) @@ -335,7 +335,7 @@ let rule ~proof_level ~constraint_constants transaction_snark self : txn.target.pending_coinbase_stack ] |> not - ]) + ] ) } module Statement = struct @@ -402,7 +402,7 @@ let constraint_system_digests ~proof_level ~constraint_constants () = Tick.constraint_system ~exposing:[ Mina_base.State_hash.typ ] ~return_typ:(Snarky_backendless.Typ.unit ()) - main) ) + main ) ) ] module Make (T : sig @@ -424,9 +424,9 @@ end) : S = struct ~name:"blockchain-snark" ~constraint_constants: (Genesis_constants.Constraint_constants.to_snark_keys_header - constraint_constants) + constraint_constants ) ~choices:(fun ~self -> - [ rule ~proof_level ~constraint_constants T.tag self ]) + [ rule ~proof_level ~constraint_constants T.tag self ] ) let step = with_handler step diff --git a/src/lib/blockchain_snark/blockchain_snark_state.mli b/src/lib/blockchain_snark/blockchain_snark_state.mli index 5ad045e29a2..2343f8baa59 100644 --- a/src/lib/blockchain_snark/blockchain_snark_state.mli +++ b/src/lib/blockchain_snark/blockchain_snark_state.mli @@ -22,7 +22,7 @@ val check : Witness.t -> ?handler: ( Snarky_backendless.Request.request - -> Snarky_backendless.Request.response) + -> Snarky_backendless.Request.response ) -> proof_level:Genesis_constants.Proof_level.t -> constraint_constants:Genesis_constants.Constraint_constants.t -> Transaction_snark.Statement.With_sok.t diff --git a/src/lib/bootstrap_controller/bootstrap_controller.ml b/src/lib/bootstrap_controller/bootstrap_controller.ml index 9353aac71dd..907387bcdf8 100644 --- a/src/lib/bootstrap_controller/bootstrap_controller.ml +++ b/src/lib/bootstrap_controller/bootstrap_controller.ml @@ -59,7 +59,7 @@ let worth_getting_root t candidate = (Logger.extend t.logger [ ( "selection_context" , `String "Bootstrap_controller.worth_getting_root" ) - ]) + ] ) ~existing: ( t.best_seen_transition |> Mina_block.Validation.block_with_hash |> With_hash.map ~f:Mina_block.consensus_state ) @@ -132,7 +132,7 @@ let on_transition t ~sender ~root_sync_ledger ~genesis_constants match%bind Mina_networking.get_ancestry t.network sender.Peer.peer_id (With_hash.map_hash candidate_consensus_state - ~f:State_hash.State_hashes.state_hash) + ~f:State_hash.State_hashes.state_hash ) with | Error e -> [%log' error t.logger] @@ -189,7 +189,7 @@ let sync_ledger t ~preferred ~root_sync_ledger ~transition_graph Deferred.ignore_m @@ on_transition t ~sender ~root_sync_ledger ~genesis_constants transition ) - else Deferred.unit) + else Deferred.unit ) let external_transition_compare consensus_constants = Comparable.lift @@ -205,7 +205,7 @@ let external_transition_compare consensus_constants = @@ Consensus.Hooks.select ~constants:consensus_constants ~existing ~candidate ~logger:(Logger.null ()) then -1 - else 1) + else 1 ) ~f:(With_hash.map ~f:Mina_block.consensus_state) (* We conditionally ask other peers for their best tip. This is for testing @@ -231,7 +231,7 @@ let run ~logger ~trust_system ~verifier ~network ~consensus_local_state (fun ( `Block (block : Mina_block.Validation.initial_valid_with_block - Envelope.Incoming.t) + Envelope.Incoming.t ) , `Valid_cb valid_cb ) -> Mina_metrics.( Counter.inc_one @@ -240,11 +240,11 @@ let run ~logger ~trust_system ~verifier ~network ~consensus_local_state ( With_hash.hash @@ Mina_block.Validation.block_with_hash @@ Envelope.Incoming.data block ) - ~pipe_name:sync_ledger_pipe ~logger)) )) + ~pipe_name:sync_ledger_pipe ~logger ) ) ) ) in don't_wait_for (transfer_while_writer_alive transition_reader sync_ledger_writer - ~f:Fn.id) ; + ~f:Fn.id ) ; let initial_root_transition = initial_root_transition |> Mina_block.Validated.remember |> Mina_block.Validation.reset_frontier_dependencies_validation @@ -286,15 +286,15 @@ let run ~logger ~trust_system ~verifier ~network ~consensus_local_state | Local -> None | Remote r -> - Some r) ) + Some r ) ) ~root_sync_ledger ~transition_graph ~sync_ledger_reader - ~genesis_constants) ; + ~genesis_constants ) ; (* We ignore the resulting ledger returned here since it will always * be the same as the ledger we started with because we are syncing * a db ledger. *) let%map _, data = Sync_ledger.Db.valid_tree root_sync_ledger in Sync_ledger.Db.destroy root_sync_ledger ; - data) + data ) in let%bind ( staged_ledger_data_download_time , staged_ledger_construction_time @@ -304,7 +304,7 @@ let run ~logger ~trust_system ~verifier ~network ~consensus_local_state time_deferred (Mina_networking .get_staged_ledger_aux_and_pending_coinbases_at_hash t.network - sender.peer_id hash) + sender.peer_id hash ) in match staged_ledger_data_download_result with | Error err -> @@ -338,9 +338,9 @@ let run ~logger ~trust_system ~verifier ~network ~consensus_local_state `This_block_belongs_to_a_detached_subtree |> Mina_block.Validation.validate_staged_ledger_hash (`Staged_ledger_already_materialized - received_staged_ledger_hash) + received_staged_ledger_hash ) |> Result.map_error ~f:(fun _ -> - Error.of_string "received faulty scan state from peer") + Error.of_string "received faulty scan state from peer" ) |> Deferred.return in let protocol_states = @@ -355,7 +355,7 @@ let run ~logger ~trust_system ~verifier ~network ~consensus_local_state let protocol_states_map = protocol_states |> List.map ~f:(fun ps -> - (State_hash.With_state_hashes.state_hash ps, ps)) + (State_hash.With_state_hashes.state_hash ps, ps) ) |> State_hash.Map.of_alist_exn in let get_state hash = @@ -417,7 +417,7 @@ let run ~logger ~trust_system ~verifier ~network ~consensus_local_state ( scan_state , pending_coinbases , new_root - , protocol_states ))) + , protocol_states ) )) in Ok (staged_ledger_construction_time, construction_result) in @@ -509,13 +509,13 @@ let run ~logger ~trust_system ~verifier ~network ~consensus_local_state let%map peers = Mina_networking.random_peers t.network n in - sender :: peers) + sender :: peers ) ~query_peer: { Consensus.Hooks.Rpcs.query = (fun peer rpc query -> Mina_networking.( query_peer t.network peer.peer_id - (Rpcs.Consensus_rpc rpc) query)) + (Rpcs.Consensus_rpc rpc) query) ) } ~ledger_depth: precomputed_values.constraint_constants.ledger_depth @@ -554,14 +554,14 @@ let run ~logger ~trust_system ~verifier ~network ~consensus_local_state persistent_frontier ~root_data:new_root_data ~genesis_state_hash: (State_hash.With_state_hashes.state_hash - precomputed_values.protocol_state_with_hashes) + precomputed_values.protocol_state_with_hashes ) in (* TODO: lazy load db in persistent root to avoid unecessary opens like this *) Transition_frontier.Persistent_root.( with_instance_exn persistent_root ~f:(fun instance -> Instance.set_root_state_hash instance @@ Mina_block.Validated.state_hash - @@ Mina_block.Validated.lift new_root)) ; + @@ Mina_block.Validated.lift new_root )) ; let%map new_frontier = let fail msg = failwith @@ -613,8 +613,8 @@ let run ~logger ~trust_system ~verifier ~network ~consensus_local_state ~existing:root_consensus_state ~candidate: (With_hash.map ~f:Mina_block.consensus_state - transition) - ~logger) + transition ) + ~logger ) in [%log debug] "Sorting filtered transitions by consensus state" ~metadata:[] ; @@ -624,8 +624,8 @@ let run ~logger ~trust_system ~verifier ~network ~consensus_local_state (Comparable.lift ~f: (Fn.compose Mina_block.Validation.block_with_hash - Envelope.Incoming.data) - (external_transition_compare t.consensus_constants)) + Envelope.Incoming.data ) + (external_transition_compare t.consensus_constants) ) in let this_cycle = { cycle_result = "success" @@ -649,7 +649,7 @@ let run ~logger ~trust_system ~verifier ~network ~consensus_local_state Mina_metrics.( Gauge.set Bootstrap.bootstrap_time_ms Core.Time.(Span.to_ms @@ time_elapsed)) ; - result) + result ) let%test_module "Bootstrap_controller tests" = ( module struct @@ -672,7 +672,7 @@ let%test_module "Bootstrap_controller tests" = Async.Thread_safe.block_on_async_exn (fun () -> Verifier.create ~logger ~proof_level ~constraint_constants ~conf_dir:None - ~pids:(Child_processes.Termination.create_pid_table ())) + ~pids:(Child_processes.Termination.create_pid_table ()) ) module Genesis_ledger = (val precomputed_values.genesis_ledger) @@ -726,7 +726,7 @@ let%test_module "Bootstrap_controller tests" = let [ me; _ ] = fake_network.peer_networks in let branch = Async.Thread_safe.block_on_async_exn (fun () -> - make_branch (Transition_frontier.root me.state.frontier)) + make_branch (Transition_frontier.root me.state.frontier) ) in (fake_network, branch)) ~f:(fun (fake_network, branch) -> @@ -759,23 +759,23 @@ let%test_module "Bootstrap_controller tests" = Strict_pipe.Writer.write sync_ledger_writer ( `Block (downcast_breadcrumb ~sender:other.peer breadcrumb) - , `Vallid_cb None )) + , `Vallid_cb None ) ) in Strict_pipe.Writer.close sync_ledger_writer ; - sync_deferred) ; + sync_deferred ) ; let expected_transitions = List.map branch ~f: (Fn.compose Mina_block.Validation.block_with_hash (Fn.compose Mina_block.Validated.remember - Transition_frontier.Breadcrumb.validated_transition)) + Transition_frontier.Breadcrumb.validated_transition ) ) in let saved_transitions = Transition_cache.data transition_graph |> List.map ~f: (Fn.compose Mina_block.Validation.block_with_hash - Envelope.Incoming.data) + Envelope.Incoming.data ) in let module E = struct module T = struct @@ -791,7 +791,7 @@ let%test_module "Bootstrap_controller tests" = end in [%test_result: E.Set.t] (E.Set.of_list saved_transitions) - ~expect:(E.Set.of_list expected_transitions)) + ~expect:(E.Set.of_list expected_transitions) ) let run_bootstrap ~timeout_duration ~my_net ~transition_reader = let open Fake_network in @@ -815,11 +815,11 @@ let%test_module "Bootstrap_controller tests" = ~best_seen_transition:None ~consensus_local_state:my_net.state.consensus_local_state ~transition_reader ~persistent_root ~persistent_frontier - ~catchup_mode:`Normal ~initial_root_transition ~precomputed_values) + ~catchup_mode:`Normal ~initial_root_transition ~precomputed_values ) let assert_transitions_increasingly_sorted ~root (incoming_transitions : - Mina_block.initial_valid_block Envelope.Incoming.t list) = + Mina_block.initial_valid_block Envelope.Incoming.t list ) = let root = With_hash.data @@ fst @@ Transition_frontier.Breadcrumb.validated_transition root @@ -838,9 +838,9 @@ let%test_module "Bootstrap_controller tests" = <= Mina_block.blockchain_length transition) ~error: (Error.of_string - "The blocks are not sorted in increasing order") + "The blocks are not sorted in increasing order" ) in - transition) + transition ) |> Or_error.ok_exn : Mina_block.t ) @@ -875,7 +875,7 @@ let%test_module "Bootstrap_controller tests" = Async.Thread_safe.block_on_async_exn (fun () -> run_bootstrap ~timeout_duration:(Block_time.Span.of_ms 30_000L) - ~my_net ~transition_reader) + ~my_net ~transition_reader ) in assert_transitions_increasingly_sorted ~root:(Transition_frontier.root new_frontier) @@ -886,13 +886,13 @@ let%test_module "Bootstrap_controller tests" = ~expect: ( Ledger.Db.merkle_root @@ Transition_frontier.root_snarked_ledger peer_net.state.frontier - )) + ) ) let%test_unit "reconstruct staged_ledgers using \ of_scan_state_and_snarked_ledger" = Quickcheck.test ~trials:1 (Transition_frontier.For_tests.gen ~precomputed_values ~verifier - ~max_length:max_frontier_length ~size:max_frontier_length ()) + ~max_length:max_frontier_length ~size:max_frontier_length () ) ~f:(fun frontier -> Thread_safe.block_on_async_exn @@ fun () -> @@ -938,7 +938,7 @@ let%test_module "Bootstrap_controller tests" = assert ( Staged_ledger_hash.equal (Staged_ledger.hash staged_ledger) - (Staged_ledger.hash actual_staged_ledger) ))) + (Staged_ledger.hash actual_staged_ledger) ) ) ) (* let%test_unit "if we see a new transition that is better than the \ diff --git a/src/lib/bootstrap_controller/transition_cache.ml b/src/lib/bootstrap_controller/transition_cache.ml index 0c2fee3ca9a..2606f4bcdfe 100644 --- a/src/lib/bootstrap_controller/transition_cache.ml +++ b/src/lib/bootstrap_controller/transition_cache.ml @@ -22,9 +22,9 @@ let add (t : t) ~parent new_child = |> Mina_block.Validation.block_with_hash |> State_hash.With_state_hashes.state_hash in - State_hash.equal (state_hash e1) (state_hash e2)) + State_hash.equal (state_hash e1) (state_hash e2) ) then children - else new_child :: children) + else new_child :: children ) let data t = let collected_transitions = State_hash.Table.data t |> List.concat in diff --git a/src/lib/bowe_gabizon_hash/bowe_gabizon_hash.ml b/src/lib/bowe_gabizon_hash/bowe_gabizon_hash.ml index 456212afa6c..9d9fa915ff8 100644 --- a/src/lib/bowe_gabizon_hash/bowe_gabizon_hash.ml +++ b/src/lib/bowe_gabizon_hash/bowe_gabizon_hash.ml @@ -19,6 +19,6 @@ module Make (Inputs : Inputs_intf.S) = struct ; g1 c ; g2 delta_prime ; Option.value ~default:[||] message - ]) + ] ) |> group_map |> G1.of_affine end diff --git a/src/lib/cache_dir/native/cache_dir.ml b/src/lib/cache_dir/native/cache_dir.ml index 46b26ed891c..a446b9c915a 100644 --- a/src/lib/cache_dir/native/cache_dir.ml +++ b/src/lib/cache_dir/native/cache_dir.ml @@ -78,5 +78,5 @@ let load_from_s3 s3_bucket_prefix s3_install_path ~logger = in Deferred.List.map ~f:each_uri (List.zip_exn s3_bucket_prefix s3_install_path) - |> Deferred.map ~f:Result.all_unit) + |> Deferred.map ~f:Result.all_unit ) |> Deferred.Result.map_error ~f:Error.of_exn diff --git a/src/lib/cache_lib/impl.ml b/src/lib/cache_lib/impl.ml index 317432d2c31..ce2f9faad4f 100644 --- a/src/lib/cache_lib/impl.ml +++ b/src/lib/cache_lib/impl.ml @@ -164,7 +164,7 @@ module Make (Inputs : Inputs_intf) : Intf.Main.S = struct let cache = cache t in Cache.remove cache `Unconsumed (original t) ; Inputs.handle_unconsumed_cache_item ~logger:(Cache.logger cache) - ~cache_name:(Cache.name cache) )) ; + ~cache_name:(Cache.name cache) ) ) ; t let create cache data final_state = @@ -175,14 +175,14 @@ module Make (Inputs : Inputs_intf) : Intf.Main.S = struct if was_consumed t then raise (createf "%s: %s" msg - (Cache.element_to_string (cache t) (original t))) + (Cache.element_to_string (cache t) (original t)) ) let assert_not_finalized t msg = let open Error in if was_finalized t then raise (createf "%s: %s" msg - (Cache.element_to_string (cache t) (original t))) + (Cache.element_to_string (cache t) (original t)) ) let peek (type a b) (t : (a, b) t) : a = assert_not_finalized t "cannot peek at finalized Cached.t" ; @@ -206,7 +206,7 @@ module Make (Inputs : Inputs_intf) : Intf.Main.S = struct ; cache = cache t ; transformed = false ; final_state = final_state t - }) + } ) let invalidate_with_failure (type a b) (t : (a, b) t) : a = assert_not_finalized t "Cached item has already been finalized" ; @@ -304,9 +304,9 @@ let%test_module "cache_lib test instance" = with_cache ~logger ~f:(fun cache -> with_item ~f:(fun data -> let x = Cache.register_exn cache data in - ignore (Cached.invalidate_with_success x : string)) ; + ignore (Cached.invalidate_with_success x : string) ) ; Gc.full_major () ; - assert (!dropped_cache_items = 0)) + assert (!dropped_cache_items = 0) ) let%test_unit "cached objects are garbage collected independently of caches" = @@ -314,18 +314,18 @@ let%test_module "cache_lib test instance" = let logger = Logger.null () in with_cache ~logger ~f:(fun cache -> with_item ~f:(fun data -> - ignore (Cache.register_exn cache data : (string, string) Cached.t)) ; + ignore (Cache.register_exn cache data : (string, string) Cached.t) ) ; Gc.full_major () ; - assert (!dropped_cache_items = 1)) + assert (!dropped_cache_items = 1) ) let%test_unit "cached objects are garbage collected independently of data" = setup () ; let logger = Logger.null () in with_item ~f:(fun data -> with_cache ~logger ~f:(fun cache -> - ignore (Cache.register_exn cache data : (string, string) Cached.t)) ; + ignore (Cache.register_exn cache data : (string, string) Cached.t) ) ; Gc.full_major () ; - assert (!dropped_cache_items = 1)) + assert (!dropped_cache_items = 1) ) let%test_unit "cached objects are not unexpectedly garbage collected" = setup () ; @@ -335,7 +335,7 @@ let%test_module "cache_lib test instance" = let cached = Cache.register_exn cache data in Gc.full_major () ; assert (!dropped_cache_items = 0) ; - ignore (Cached.invalidate_with_success cached : string))) ; + ignore (Cached.invalidate_with_success cached : string) ) ) ; Gc.full_major () ; assert (!dropped_cache_items = 0) @@ -349,9 +349,9 @@ let%test_module "cache_lib test instance" = ( Cache.register_exn cache data |> Cached.transform ~f:(Fn.const 5) |> Cached.transform ~f:(Fn.const ()) - : (unit, string) Cached.t )) ; + : (unit, string) Cached.t ) ) ; Gc.full_major () ; - assert (!dropped_cache_items = 1)) + assert (!dropped_cache_items = 1) ) let%test_unit "properly invalidated derived cached objects do not trigger \ any unconsumption handler calls" = @@ -362,9 +362,9 @@ let%test_module "cache_lib test instance" = Cache.register_exn cache data |> Cached.transform ~f:(Fn.const 5) |> Cached.transform ~f:(Fn.const ()) - |> Cached.invalidate_with_success) ; + |> Cached.invalidate_with_success ) ; Gc.full_major () ; - assert (!dropped_cache_items = 0)) + assert (!dropped_cache_items = 0) ) let%test_unit "invalidate original cached object would also remove the \ derived cached object" = @@ -378,9 +378,9 @@ let%test_module "cache_lib test instance" = |> Cached.transform ~f:(Fn.const 5) |> Cached.transform ~f:(Fn.const ()) in - ignore (Cached.invalidate_with_success src : string)) ; + ignore (Cached.invalidate_with_success src : string) ) ; Gc.full_major () ; - assert (!dropped_cache_items = 0)) + assert (!dropped_cache_items = 0) ) let%test_unit "deriving a cached object inhabits its parent's final_state" = setup () ; @@ -390,5 +390,5 @@ let%test_module "cache_lib test instance" = let der = Cached.transform src ~f:(Fn.const 5) in let src_final_state = Cached.final_state src in let der_final_state = Cached.final_state der in - assert (Ivar.equal src_final_state der_final_state))) + assert (Ivar.equal src_final_state der_final_state) ) ) end ) diff --git a/src/lib/child_processes/child_processes.ml b/src/lib/child_processes/child_processes.ml index 290ce3de543..36c96e77ef0 100644 --- a/src/lib/child_processes/child_processes.ml +++ b/src/lib/child_processes/child_processes.ml @@ -93,8 +93,7 @@ let get_mina_binary () = (Result.ok_if_true (ns_get_executable_path buf count = 0) ~error: - (Error.of_string - "call to _NSGetExecutablePath failed unexpectedly")) + (Error.of_string "call to _NSGetExecutablePath failed unexpectedly") ) in let s = string_from_ptr buf ~length:(!@count |> Unsigned.UInt32.to_int) in List.hd_exn @@ String.split s ~on:(Char.of_int 0 |> Option.value_exn) @@ -201,7 +200,7 @@ let start_custom : Deferred.Or_error.return () | _ -> Deferred.Or_error.errorf "Config directory %s does not exist" - conf_dir) + conf_dir ) in let lock_path = conf_dir ^/ name ^ ".lock" in let%bind () = @@ -227,7 +226,7 @@ let start_custom : ; Some (Filename.dirname mina_binary_path ^/ name) ; Some ("mina-" ^ name) ; Some ("coda-" ^ name) - ]) + ] ) ~f:(fun prog -> Process.create ~stdin:"" ~prog ~args ()) in [%log info] "Custom child process $name started with pid $pid" @@ -266,7 +265,7 @@ let start_custom : (let%bind () = after (Time.Span.of_sec 1.) in let%bind () = Writer.close @@ Process.stdin process in let%bind () = Reader.close @@ Process.stdout process in - Reader.close @@ Process.stderr process) ; + Reader.close @@ Process.stderr process ) ; let%bind () = Sys.remove lock_path in Ivar.fill terminated_ivar termination_status ; let log_bad_termination () = @@ -331,7 +330,7 @@ let%test_module _ = Async.Thread_safe.block_on_async_exn (fun () -> File_system.with_temp_dir (Filename.temp_dir_name ^/ "child-processes") - ~f) + ~f ) let name = "tester.sh" @@ -351,15 +350,14 @@ let%test_module _ = let%bind () = Strict_pipe.Reader.iter (stdout process) ~f:(fun line -> [%test_eq: string] "hello\n" line ; - Deferred.unit) + Deferred.unit ) in (* Pipe will be closed before the ivar is filled, so we need to wait a bit. *) let%bind () = after process_wait_timeout in - [%test_eq: Unix.Exit_or_signal.t Or_error.t option] - (Some (Ok (Ok ()))) + [%test_eq: Unix.Exit_or_signal.t Or_error.t option] (Some (Ok (Ok ()))) (termination_status process) ; - Deferred.unit) + Deferred.unit ) let%test_unit "killing works" = async_with_temp_dir (fun conf_dir -> @@ -401,7 +399,7 @@ let%test_module _ = [%test_eq: Unix.Exit_or_signal.t] exit_or_signal (Error (`Signal Signal.term)) ; assert (Option.is_some @@ termination_status process) ; - Deferred.unit) + Deferred.unit ) let%test_unit "if you spawn two processes it kills the earlier one" = async_with_temp_dir (fun conf_dir -> @@ -425,5 +423,5 @@ let%test_module _ = (termination_status process2) None ; let%bind _ = kill process2 in - Deferred.unit) + Deferred.unit ) end ) diff --git a/src/lib/child_processes/termination.ml b/src/lib/child_processes/termination.ml index e9f8c1b688d..ad1565fc73d 100644 --- a/src/lib/child_processes/termination.ml +++ b/src/lib/child_processes/termination.ml @@ -31,8 +31,9 @@ let get_signal_cause_opt = List.iter [ (kill, "Process killed because out of memory") ; (int, "Process interrupted by user or other program") - ] ~f:(fun (signal, msg) -> - Base.ignore (Table.add signal_causes_tbl ~key:signal ~data:msg)) ; + ] + ~f:(fun (signal, msg) -> + Base.ignore (Table.add signal_causes_tbl ~key:signal ~data:msg) ) ; fun signal -> Signal.Table.find signal_causes_tbl signal (** wait for a [process], which may resolve immediately or in a Deferred.t, @@ -56,7 +57,7 @@ let wait_for_process_log_errors ~logger process ~module_ ~location ~here = let err = Error.of_exn exn in Logger.error logger ~module_ ~location "Saw a deferred exception $exn after waiting for process" - ~metadata:[ ("exn", Error_json.error_to_yojson err) ])) + ~metadata:[ ("exn", Error_json.error_to_yojson err) ] ) ) (fun () -> Process.wait process) in don't_wait_for @@ -67,7 +68,7 @@ let wait_for_process_log_errors ~logger process ~module_ ~location ~here = let err = Error.of_exn exn in Logger.error logger ~module_ ~location "Saw a deferred exception $exn while waiting for process" - ~metadata:[ ("exn", Error_json.error_to_yojson err) ] )) + ~metadata:[ ("exn", Error_json.error_to_yojson err) ] ) ) with | Ok _ -> () @@ -107,10 +108,11 @@ let wait_safe ~logger process ~module_ ~location ~here = Logger.warn logger ~module_ ~location "Saw an error from Process.wait in wait_safe: $err" ~metadata: - [ ("err", Error_json.error_to_yojson (Error.of_exn exn)) ])) + [ ("err", Error_json.error_to_yojson (Error.of_exn exn)) ] + ) ) (fun () -> Process.wait process) in - Deferred.Result.map_error ~f:Error.of_exn deferred_wait) + Deferred.Result.map_error ~f:Error.of_exn deferred_wait ) with | Ok x -> x diff --git a/src/lib/cli_lib/arg_type.ml b/src/lib/cli_lib/arg_type.ml index 417bc85d3c1..f693706a923 100644 --- a/src/lib/cli_lib/arg_type.ml +++ b/src/lib/cli_lib/arg_type.ml @@ -22,7 +22,7 @@ let pubsub_topic_mode = N | _ -> eprintf "Invalid pubsub topic mode: %s" s ; - exit 1) + exit 1 ) let pubsub_topic_mode_to_string mode = let open Gossip_net.Libp2p in @@ -42,7 +42,7 @@ let public_key_compressed = exit 1 in try Public_key.of_base58_check_decompress_exn s - with e -> error_string (Error.of_exn e)) + with e -> error_string (Error.of_exn e) ) (* Hack to allow us to deprecate a value without needing to add an mli * just for this. We only want to have one "kind" of public key in the @@ -55,7 +55,7 @@ include ( | None -> failwith "Invalid key" | Some pk' -> - pk') + pk' ) end : sig val public_key : Public_key.t Command.Arg_type.t @@ -107,14 +107,14 @@ let log_level = |> String.concat ~sep:", " ) ; exit 14 | Ok ll -> - ll) + ll ) let user_command = Command.Arg_type.create (fun s -> try Mina_base.Signed_command.of_base58_check_exn s with e -> Error.tag (Error.of_exn e) ~tag:"Couldn't decode transaction id" - |> Error.raise) + |> Error.raise ) module Work_selection_method = struct [%%versioned diff --git a/src/lib/cli_lib/commands.ml b/src/lib/cli_lib/commands.ml index 38f417ff42e..9fbe3a285f2 100644 --- a/src/lib/cli_lib/commands.ml +++ b/src/lib/cli_lib/commands.ml @@ -41,7 +41,7 @@ let validate_keypair = exit 1 ) | None -> eprintf "No public key found in file %s\n" pubkey_path ; - exit 1) + exit 1 ) with exn -> eprintf "Could not read public key file %s, error: %s\n" pubkey_path (Exn.to_string exn) ; @@ -122,8 +122,8 @@ let validate_transaction = error:%s@." (Yojson.Safe.pretty_to_string transaction_json) (Yojson.Safe.pretty_to_string - (Error_json.error_to_yojson err))) - jsons) + (Error_json.error_to_yojson err) ) ) + jsons ) with | Ok () -> () @@ -277,15 +277,15 @@ module Vrf = struct (Yojson.Safe.pretty_print ?std:None) (Evaluation.to_yojson evaluation) ; Deferred.return (`Repeat ()) - with Yojson.End_of_input -> return (`Finished ())) + with Yojson.End_of_input -> return (`Finished ()) ) >>| function | Ok x -> x | Error err -> Format.eprintf "Error:@.%s@.@." (Yojson.Safe.pretty_to_string - (Error_json.error_to_yojson err)) ; - `Repeat ()) + (Error_json.error_to_yojson err) ) ; + `Repeat () ) | Error err -> eprintf "Could not read the specified keypair: %s\n" (Secrets.Privkey_error.to_string err) ; @@ -331,15 +331,15 @@ module Vrf = struct (Yojson.Safe.pretty_print ?std:None) (Evaluation.to_yojson evaluation) ; Deferred.return (`Repeat ()) - with Yojson.End_of_input -> return (`Finished ())) + with Yojson.End_of_input -> return (`Finished ()) ) >>| function | Ok x -> x | Error err -> Format.eprintf "Error:@.%s@.@." (Yojson.Safe.pretty_to_string - (Error_json.error_to_yojson err)) ; - `Repeat ()) + (Error_json.error_to_yojson err) ) ; + `Repeat () ) in exit 0 ) diff --git a/src/lib/cli_lib/flag.ml b/src/lib/cli_lib/flag.ml index 32e28af9e3d..c8bc5785939 100644 --- a/src/lib/cli_lib/flag.ml +++ b/src/lib/cli_lib/flag.ml @@ -182,7 +182,7 @@ module Host = struct let is_localhost host = Option.value_map ~default:false (Unix.Host.getbyname host) ~f:(fun host -> - Core.Unix.Host.have_address_in_common host localhost) + Core.Unix.Host.have_address_in_common host localhost ) end let example_host = "154.97.53.97" @@ -216,13 +216,13 @@ module Host_and_port = struct ~examples:(create_examples example_port) "HOST:PORT/LOCALHOST-PORT" (sprintf "%s. If HOST is omitted, then localhost is assumed to be HOST." - description) + description ) module Client = struct let daemon = create ~name:"--daemon-port" ~aliases:[ "daemon-port" ] ~arg_type (make_doc_builder "Client to local daemon communication" - Port.default_client) + Port.default_client ) (Resolve_with_default (Port.to_host_and_port Port.default_client)) end @@ -230,7 +230,7 @@ module Host_and_port = struct let archive = create ~name:"--archive-address" ~aliases:[ "archive-address" ] ~arg_type (make_doc_builder "Daemon to archive process communication" - Port.default_archive) + Port.default_archive ) Optional end end @@ -294,7 +294,8 @@ module Uri = struct ~arg_type:(Command.Arg_type.map Command.Param.string ~f:Uri.of_string) doc_builder (Resolve_with_default - (Uri.of_string "postgres://admin:codarules@postgres:5432/archiver")) + (Uri.of_string "postgres://admin:codarules@postgres:5432/archiver") + ) end end @@ -346,9 +347,9 @@ let signed_command_common : signed_command_common Command.Param.t = "FEE Amount you are willing to pay to process the transaction \ (default: %s) (minimum: %s)" (Currency.Fee.to_formatted_string - Mina_compile_config.default_transaction_fee) + Mina_compile_config.default_transaction_fee ) (Currency.Fee.to_formatted_string - Mina_base.Signed_command.minimum_fee)) + Mina_base.Signed_command.minimum_fee ) ) (optional txn_fee) and nonce = flag "--nonce" ~aliases:[ "nonce" ] @@ -394,9 +395,9 @@ module Signed_command = struct "FEE Amount you are willing to pay to process the transaction \ (default: %s) (minimum: %s)" (Currency.Fee.to_formatted_string - Mina_compile_config.default_transaction_fee) + Mina_compile_config.default_transaction_fee ) (Currency.Fee.to_formatted_string - Mina_base.Signed_command.minimum_fee)) + Mina_base.Signed_command.minimum_fee ) ) (optional txn_fee) let valid_until = @@ -424,6 +425,6 @@ module Signed_command = struct ~doc: (sprintf "STRING Memo accompanying the transaction (up to %d characters)" - Mina_base.Signed_command_memo.max_input_length) + Mina_base.Signed_command_memo.max_input_length ) (optional string) end diff --git a/src/lib/cli_lib/render.ml b/src/lib/cli_lib/render.ml index 53ff8741ce2..e1b9d777bbe 100644 --- a/src/lib/cli_lib/render.ml +++ b/src/lib/cli_lib/render.ml @@ -26,7 +26,7 @@ module String_list_formatter = struct List.mapi pks ~f:(fun i pk -> let i = i + 1 in let padding = String.init (max_padding - log10 i) ~f:(fun _ -> ' ') in - sprintf "%s%i, %s" padding i pk) + sprintf "%s%i, %s" padding i pk ) |> String.concat ~sep:"\n" end @@ -58,6 +58,6 @@ module Public_key_with_details = struct let to_text account = List.map account ~f:(fun (public_key, balance, nonce) -> - sprintf !"%s, %d, %d" public_key balance nonce) + sprintf !"%s, %d, %d" public_key balance nonce ) |> String.concat ~sep:"\n" end diff --git a/src/lib/coda_plugins/examples/toplevel/plugin_toplevel.ml b/src/lib/coda_plugins/examples/toplevel/plugin_toplevel.ml index 4652af447d2..1ce89a379a8 100644 --- a/src/lib/coda_plugins/examples/toplevel/plugin_toplevel.ml +++ b/src/lib/coda_plugins/examples/toplevel/plugin_toplevel.ml @@ -20,7 +20,7 @@ let read_input = Writer.write stdout prompt ; Thread_safe.block_on_async_exn (fun () -> let%bind () = Writer.flushed stdout in - go buffer len 0) + go buffer len 0 ) let () = let config = Coda_lib.config coda in diff --git a/src/lib/command_line_tests/command_line_tests.ml b/src/lib/command_line_tests/command_line_tests.ml index 95800c712a2..7a2944630d4 100644 --- a/src/lib/command_line_tests/command_line_tests.ml +++ b/src/lib/command_line_tests/command_line_tests.ml @@ -88,7 +88,7 @@ let%test_module "Command line tests" = Core.Printf.printf !"**** DAEMON CRASHED (OUTPUT BELOW) ****\n%s\n************\n%!" contents ) ; - remove_config_directory config_dir genesis_ledger_dir) + remove_config_directory config_dir genesis_ledger_dir ) (fun () -> match%map let open Deferred.Or_error.Let_syntax in @@ -122,7 +122,7 @@ let%test_module "Command line tests" = true | Error err -> test_failed := true ; - Error.raise err) + Error.raise err ) let%test "The mina daemon works in background mode" = match Core.Sys.is_file coda_exe with diff --git a/src/lib/consensus/consensus.mli b/src/lib/consensus/consensus.mli index 31c7f2ce925..abd853aa639 100644 --- a/src/lib/consensus/consensus.mli +++ b/src/lib/consensus/consensus.mli @@ -9,7 +9,7 @@ include with module Exported := Proof_of_stake.Exported and type Data.Block_data.t = Proof_of_stake.Data.Block_data.t and type Data.Consensus_state.Value.Stable.V1.t = - Proof_of_stake.Data.Consensus_state.Value.Stable.V1.t + Proof_of_stake.Data.Consensus_state.Value.Stable.V1.t [%%else] diff --git a/src/lib/consensus/constants.ml b/src/lib/consensus/constants.ml index 3c2099edbfd..bdf302c8e8f 100644 --- a/src/lib/consensus/constants.ml +++ b/src/lib/consensus/constants.ml @@ -181,7 +181,7 @@ let create' (type a b c) (module M : M_intf with type length = a and type time = b - and type timespan = c) + and type timespan = c ) ~(constraint_constants : Genesis_constants.Constraint_constants.t) ~(protocol_constants : (a, a, b) Genesis_constants.Protocol.Poly.t) : (a, b, c) Poly.t = @@ -291,7 +291,7 @@ let for_unit_tests = (create ~constraint_constants: Genesis_constants.Constraint_constants.for_unit_tests - ~protocol_constants:Genesis_constants.for_unit_tests.protocol) + ~protocol_constants:Genesis_constants.for_unit_tests.protocol ) let to_protocol_constants ({ k @@ -301,7 +301,7 @@ let to_protocol_constants ; slots_per_epoch ; _ } : - _ Poly.t) = + _ Poly.t ) = { Mina_base.Protocol_constants_checked.Poly.k ; delta ; genesis_state_timestamp @@ -353,7 +353,7 @@ let to_input (t : t) = ; t.delta_duration |] ; [| Block_time.to_input t.genesis_state_timestamp |] - ]) + ] ) let gc_parameters (constants : t) = let open Unsigned.UInt32 in @@ -392,7 +392,7 @@ module Checked = struct ; t.delta_duration |] ; [| Block_time.Checked.to_input t.genesis_state_timestamp |] - ]) + ] ) let create ~(constraint_constants : Genesis_constants.Constraint_constants.t) ~(protocol_constants : Mina_base.Protocol_constants_checked.var) : @@ -401,7 +401,7 @@ module Checked = struct make_checked (fun () -> create' (module Constants_checked) - ~constraint_constants ~protocol_constants) + ~constraint_constants ~protocol_constants ) in let%map checkpoint_window_slots_per_year, checkpoint_window_size_in_slots = let constant c = @@ -441,11 +441,11 @@ let%test_unit "checked = unchecked" = let test = Test_util.test_equal Protocol_constants_checked.typ typ (fun protocol_constants -> - Checked.create ~constraint_constants ~protocol_constants) + Checked.create ~constraint_constants ~protocol_constants ) (fun protocol_constants -> create ~constraint_constants ~protocol_constants: - (Protocol_constants_checked.t_of_value protocol_constants)) + (Protocol_constants_checked.t_of_value protocol_constants) ) in Quickcheck.test ~trials:100 Protocol_constants_checked.Value.gen ~examples:[ Protocol_constants_checked.value_of_t for_unit_tests ] diff --git a/src/lib/consensus/epoch.ml b/src/lib/consensus/epoch.ml index e6f1392e082..8236a0361e3 100644 --- a/src/lib/consensus/epoch.ml +++ b/src/lib/consensus/epoch.ml @@ -11,7 +11,7 @@ let of_time_exn ~(constants : Constants.t) t : t = if Time.(t < constants.genesis_state_timestamp) then raise (Invalid_argument - "Epoch.of_time: time is earlier than genesis block timestamp") ; + "Epoch.of_time: time is earlier than genesis block timestamp" ) ; let time_since_genesis = Time.diff t constants.genesis_state_timestamp in uint32_of_int64 Int64.Infix.( @@ -35,7 +35,7 @@ let slot_start_time ~(constants : Constants.t) (epoch : t) (slot : Slot.t) = (start_time epoch ~constants) (Block_time.Span.of_ms Int64.Infix.( - int64_of_uint32 slot * Time.Span.to_ms constants.slot_duration_ms)) + int64_of_uint32 slot * Time.Span.to_ms constants.slot_duration_ms) ) let slot_end_time ~(constants : Constants.t) (epoch : t) (slot : Slot.t) = Time.add (slot_start_time epoch slot ~constants) constants.slot_duration_ms diff --git a/src/lib/consensus/intf.ml b/src/lib/consensus/intf.ml index 44c0fb075c2..71ff2346d50 100644 --- a/src/lib/consensus/intf.ml +++ b/src/lib/consensus/intf.ml @@ -216,7 +216,7 @@ module type State_hooks = sig -> snarked_ledger_hash:Mina_base.Frozen_ledger_hash.t -> coinbase_receiver:Public_key.Compressed.t -> supercharge_coinbase:bool - -> consensus_state) + -> consensus_state ) Quickcheck.Generator.t end end @@ -335,7 +335,7 @@ module type S = sig -> logger:Logger.t -> get_delegators: ( Public_key.Compressed.t - -> Mina_base.Account.t Mina_base.Account.Index.Table.t option) + -> Mina_base.Account.t Mina_base.Account.Index.Table.t option ) -> ( ( [ `Vrf_eval of string ] * [> `Vrf_output of Consensus_vrf.Output_hash.t ] * [> `Delegator of @@ -617,7 +617,10 @@ module type S = sig type query = { query : - 'q 'r. Network_peer.Peer.t -> ('q, 'r) rpc -> 'q + 'q 'r. + Network_peer.Peer.t + -> ('q, 'r) rpc + -> 'q -> 'r Network_peer.Rpc_intf.rpc_response Deferred.t } end @@ -726,16 +729,16 @@ module type S = sig (Blockchain_state : Blockchain_state) (Protocol_state : Protocol_state with type blockchain_state := - Blockchain_state.Value.t + Blockchain_state.Value.t and type blockchain_state_var := - Blockchain_state.var + Blockchain_state.var and type consensus_state := Consensus_state.Value.t and type consensus_state_var := Consensus_state.var) (Snark_transition : Snark_transition with type blockchain_state_var := - Blockchain_state.var + Blockchain_state.var and type consensus_transition_var := - Consensus_transition.var) : + Consensus_transition.var) : State_hooks with type blockchain_state := Blockchain_state.Value.t and type protocol_state := Protocol_state.Value.t diff --git a/src/lib/consensus/proof_of_stake.ml b/src/lib/consensus/proof_of_stake.ml index f0ee34cf844..d3b44048f89 100644 --- a/src/lib/consensus/proof_of_stake.ml +++ b/src/lib/consensus/proof_of_stake.ml @@ -24,7 +24,7 @@ let genesis_ledger_total_currency ~ledger = Amount.add sum (Balance.to_amount @@ account.balance) |> Option.value_exn ?here:None ?error:None ~message:"failed to calculate total currency in genesis ledger" - else sum) + else sum ) let genesis_ledger_hash ~ledger = Mina_ledger.Ledger.merkle_root (Lazy.force ledger) @@ -46,7 +46,7 @@ let compute_delegatee_table keys ~iter_accounts = Account.Index.Table.of_alist_exn [ (i, acct) ] | Some table -> Account.Index.Table.add_exn table ~key:i ~data:acct ; - table)) ; + table ) ) ; (* TODO: this metric tracking currently assumes that the result of compute_delegatee_table is called with the full set of block production keypairs every time the set changes, which is true right now, but this @@ -63,15 +63,15 @@ let compute_delegatee_table keys ~iter_accounts = let compute_delegatee_table_sparse_ledger keys ledger = compute_delegatee_table keys ~iter_accounts:(fun f -> - Mina_ledger.Sparse_ledger.iteri ledger ~f:(fun i acct -> f i acct)) + Mina_ledger.Sparse_ledger.iteri ledger ~f:(fun i acct -> f i acct) ) let compute_delegatee_table_ledger_db keys ledger = compute_delegatee_table keys ~iter_accounts:(fun f -> - Mina_ledger.Ledger.Db.iteri ledger ~f:(fun i acct -> f i acct)) + Mina_ledger.Ledger.Db.iteri ledger ~f:(fun i acct -> f i acct) ) let compute_delegatee_table_genesis_ledger keys ledger = compute_delegatee_table keys ~iter_accounts:(fun f -> - Mina_ledger.Ledger.iteri ledger ~f:(fun i acct -> f i acct)) + Mina_ledger.Ledger.iteri ledger ~f:(fun i acct -> f i acct) ) module Segment_id = Mina_numbers.Nat.Make32 () @@ -134,7 +134,7 @@ module Data = struct make_checked (fun () -> hash ~init:Hash_prefix_states.epoch_seed [| var_to_hash_packed seed; vrf_result |] - |> var_of_hash_packed) + |> var_of_hash_packed ) end module Epoch_and_slot = struct @@ -306,7 +306,7 @@ module Data = struct ( Hashtbl.to_alist delegators |> List.map ~f:(fun (addr, account) -> ( Int.to_string addr - , Mina_base.Account.to_yojson account )) ) )) + , Mina_base.Account.to_yojson account ) ) ) ) ) ) ) ] @@ -346,7 +346,7 @@ module Data = struct t.last_checked_slot_and_epoch |> List.map ~f:(fun (key, epoch_and_slot) -> ( Public_key.Compressed.to_string key - , [%to_yojson: Epoch.t * Slot.t] epoch_and_slot )) ) ) + , [%to_yojson: Epoch.t * Slot.t] epoch_and_slot ) ) ) ) ] end @@ -375,7 +375,7 @@ module Data = struct let last_checked_slot_and_epoch = Table.create () in Set.iter new_keys ~f:(fun pk -> let data = Option.value (Table.find old_table pk) ~default in - Table.add_exn last_checked_slot_and_epoch ~key:pk ~data) ; + Table.add_exn last_checked_slot_and_epoch ~key:pk ~data ) ; last_checked_slot_and_epoch let epoch_ledger_uuids_to_yojson Data.{ staking; next; genesis_state_hash } @@ -412,7 +412,7 @@ module Data = struct "Loading epoch ledger from disk: $location" ; Snapshot.Ledger_snapshot.Ledger_db (Mina_ledger.Ledger.Db.create ~directory_name:location - ~depth:ledger_depth ()) ) + ~depth:ledger_depth () ) ) else Genesis_epoch_ledger (Lazy.force genesis_epoch_ledger) let create block_producer_pubkeys ~genesis_ledger ~genesis_epoch_data @@ -424,7 +424,7 @@ module Data = struct ~f:(fun { Genesis_epoch_data.staking; next } -> ( staking.ledger , Option.value_map next ~default:staking.ledger ~f:(fun next -> - next.ledger) )) + next.ledger ) ) ) in let epoch_ledger_uuids_location = epoch_ledger_location ^ ".json" in let logger = Logger.create () in @@ -545,7 +545,7 @@ module Data = struct let epoch, slot = Epoch_and_slot.of_time_exn now ~constants in ( epoch , UInt32.(if compare slot zero > 0 then sub slot one else slot) - )) + ) ) ; last_epoch_delegatee_table = None ; epoch_ledger_uuids = old.epoch_ledger_uuids ; epoch_ledger_location = old.epoch_ledger_location @@ -631,7 +631,7 @@ module Data = struct else ( Table.set !t.last_checked_slot_and_epoch ~key:pk ~data:(epoch, slot) ; - Some pk )) + Some pk ) ) in match unseens with | [] -> @@ -655,13 +655,13 @@ module Data = struct [ field "hash" ~typ:(non_null string) ~args:Arg.[] ~resolve:(fun _ { Poly.hash; _ } -> - Mina_base.Frozen_ledger_hash.to_base58_check hash) + Mina_base.Frozen_ledger_hash.to_base58_check hash ) ; field "totalCurrency" ~typ:(non_null @@ Graphql_base_types.uint64 ()) ~args:Arg.[] ~resolve:(fun _ { Poly.total_currency; _ } -> - Amount.to_uint64 total_currency) - ]) + Amount.to_uint64 total_currency ) + ] ) end module Vrf = struct @@ -688,24 +688,24 @@ module Data = struct let%bind account = with_label __LOC__ (Frozen_ledger_hash.get ~depth:constraint_constants.ledger_depth - ledger staker_addr) + ledger staker_addr ) in let%bind () = [%with_label "Account is for the default token"] (make_checked (fun () -> Token_id.( Checked.Assert.equal account.token_id - (Checked.constant default)))) + (Checked.constant default)) ) ) in let%bind () = [%with_label "Block stake winner matches account pk"] (Public_key.Compressed.Checked.Assert.equal block_stake_winner - account.public_key) + account.public_key ) in let%bind () = [%with_label "Block creator matches delegate pk"] (Public_key.Compressed.Checked.Assert.equal block_creator - account.delegate) + account.delegate ) in let%bind delegate = [%with_label "Decompress delegate pk"] @@ -714,7 +714,7 @@ module Data = struct let%map evaluation = with_label __LOC__ (T.Checked.eval_and_check_public_key shifted ~private_key - ~public_key:delegate message) + ~public_key:delegate message ) in (evaluation, account) @@ -727,7 +727,7 @@ module Data = struct let%bind winner_addr = request_witness (Mina_base.Account.Index.Unpacked.typ - ~ledger_depth:constraint_constants.ledger_depth) + ~ledger_depth:constraint_constants.ledger_depth ) (As_prover.return Winner_address) in let%bind result, winner_account = @@ -791,7 +791,7 @@ module Data = struct unstage (Mina_base.Pending_coinbase.handler ~depth:constraint_constants.pending_coinbase_depth - empty_pending_coinbase ~is_new_stack:true) + empty_pending_coinbase ~is_new_stack:true ) in let handlers = Snarky_backendless.Request.Handler.( @@ -816,14 +816,14 @@ module Data = struct (Provide (Snarky_backendless.Request.Handler.run handlers [ "Ledger Handler"; "Pending Coinbase Handler" ] - request)) + request ) ) end let check ~constraint_constants ~global_slot ~seed ~producer_private_key ~producer_public_key ~total_stake ~logger ~(get_delegators : Public_key.Compressed.t - -> Mina_base.Account.t Mina_base.Account.Index.Table.t option) = + -> Mina_base.Account.t Mina_base.Account.Index.Table.t option ) = let open Message in let open Interruptible.Let_syntax in let delegators = @@ -870,7 +870,7 @@ module Data = struct (Some ( `Vrf_eval vrf_eval , `Vrf_output vrf_result - , `Delegator (account.public_key, delegator) )) + , `Delegator (account.public_key, delegator) ) ) delegators in match acc with @@ -955,26 +955,26 @@ module Data = struct ; field "seed" ~typ:(non_null string) ~args:Arg.[] ~resolve:(fun _ { Poly.seed; _ } -> - Epoch_seed.to_base58_check seed) + Epoch_seed.to_base58_check seed ) ; field "startCheckpoint" ~typ:(non_null string) ~args:Arg.[] ~resolve:(fun _ { Poly.start_checkpoint; _ } -> - Mina_base.State_hash.to_base58_check start_checkpoint) + Mina_base.State_hash.to_base58_check start_checkpoint ) ; field "lockCheckpoint" ~typ:(Lock_checkpoint.graphql_type ()) ~args:Arg.[] ~resolve:(fun _ { Poly.lock_checkpoint; _ } -> - Lock_checkpoint.resolve lock_checkpoint) + Lock_checkpoint.resolve lock_checkpoint ) ; field "epochLength" ~typ:(non_null @@ Graphql_base_types.uint32 ()) ~args:Arg.[] ~resolve:(fun _ { Poly.epoch_length; _ } -> - Mina_numbers.Length.to_uint32 epoch_length) - ]) + Mina_numbers.Length.to_uint32 epoch_length ) + ] ) let to_input ({ ledger; seed; start_checkpoint; lock_checkpoint; epoch_length } : - Value.t) = + Value.t ) = let open Random_oracle.Input.Chunked in List.reduce_exn ~f:append [ field (seed :> Tick.Field.t) @@ -986,7 +986,7 @@ module Data = struct let var_to_input ({ ledger; seed; start_checkpoint; lock_checkpoint; epoch_length } : - var) = + var ) = let open Random_oracle.Input.Chunked in List.reduce_exn ~f:append [ field (Epoch_seed.var_to_hash_packed seed) @@ -1262,7 +1262,7 @@ module Data = struct in if same_sub_window then density else if overlapping_window && not within_range then density - else Length.zero) + else Length.zero ) in let current_window_density = List.fold current_sub_window_densities ~init:Length.zero ~f:Length.add @@ -1289,7 +1289,7 @@ module Data = struct if is_next_sub_window then let f = if incr_window then Length.succ else Fn.id in if same_sub_window then f density else f Length.zero - else density) + else density ) in (* Final result is the min window density and window for the new (or virtual) block *) @@ -1357,7 +1357,7 @@ module Data = struct (if_ Boolean.(overlapping_window && not within_range) ~then_:(Checked.return density) - ~else_:(Checked.return Length.Checked.zero))) + ~else_:(Checked.return Length.Checked.zero) ) ) in let%bind current_window_density = Checked.List.fold current_sub_window_densities @@ -1368,14 +1368,13 @@ module Data = struct Global_slot.Checked.( < ) next_global_slot (Global_slot.Checked.of_slot_number ~constants (Mina_numbers.Global_slot.Checked.Unsafe.of_field - (Length.Checked.to_field constants.grace_period_end))) + (Length.Checked.to_field constants.grace_period_end) ) ) in if_ Boolean.(same_sub_window || in_grace_period) ~then_:(Checked.return prev_min_window_density) ~else_: - (Length.Checked.min current_window_density - prev_min_window_density) + (Length.Checked.min current_window_density prev_min_window_density) in let%bind next_sub_window_densities = Checked.List.mapi current_sub_window_densities ~f:(fun i density -> @@ -1389,8 +1388,8 @@ module Data = struct (if_ (Checked.return same_sub_window) ~then_:Length.Checked.(succ density) - ~else_:Length.Checked.(succ zero)) - ~else_:(Checked.return density)) + ~else_:Length.Checked.(succ zero) ) + ~else_:(Checked.return density) ) in return (min_window_density, next_sub_window_densities) end @@ -1424,7 +1423,7 @@ module Data = struct Array.init n ~f:(fun i -> if i + sub_window_diff < n then prev_sub_window_densities.(i + sub_window_diff) - else Length.zero) + else Length.zero ) in let current_window_density = Array.fold current_sub_window_densities ~init:Length.zero @@ -1479,7 +1478,7 @@ module Data = struct ( 1.0 /. (Float.of_int (i + 1) ** 2.) , Core.Int.gen_incl (i * to_int constants.slots_per_sub_window) - ((i + 1) * to_int constants.slots_per_sub_window) )) + ((i + 1) * to_int constants.slots_per_sub_window) ) ) let num_global_slots_to_test = 1 @@ -1500,12 +1499,12 @@ module Data = struct List.fold slot_diffs ~init:(prev_global_slot, []) ~f:(fun (prev_global_slot, acc) slot_diff -> let next_global_slot = prev_global_slot + slot_diff in - (next_global_slot, next_global_slot :: acc)) + (next_global_slot, next_global_slot :: acc) ) in return ( Global_slot.of_slot_number ~constants (GS.of_int prev_global_slot) , List.map global_slots ~f:(fun s -> - Global_slot.of_slot_number ~constants (GS.of_int s)) + Global_slot.of_slot_number ~constants (GS.of_int s) ) |> List.rev ) let gen_length = @@ -1549,7 +1548,7 @@ module Data = struct f ~constants ~prev_global_slot ~next_global_slot ~prev_sub_window_densities ~prev_min_window_density in - (next_global_slot, sub_window_densities, min_window_density)) + (next_global_slot, sub_window_densities, min_window_density) ) let update_several_times_checked ~f ~prev_global_slot ~next_global_slots ~prev_sub_window_densities ~prev_min_window_density ~constants = @@ -1570,7 +1569,7 @@ module Data = struct f ~constants ~prev_global_slot ~next_global_slot ~prev_sub_window_densities ~prev_min_window_density in - return (next_global_slot, sub_window_densities, min_window_density)) + return (next_global_slot, sub_window_densities, min_window_density) ) let%test_unit "the actual implementation is equivalent to the \ reference implementation" = @@ -1591,10 +1590,10 @@ module Data = struct ~prev_global_slot ~next_global_slots ~prev_sub_window_densities: (actual_to_reference ~prev_global_slot - ~prev_sub_window_densities) + ~prev_sub_window_densities ) ~prev_min_window_density ~constants in - assert (Length.(equal min_window_density1 min_window_density2))) + assert (Length.(equal min_window_density1 min_window_density2)) ) let%test_unit "Inside snark computation is equivalent to outside snark \ computation" = @@ -1603,26 +1602,25 @@ module Data = struct Test_util.test_equal (Typ.tuple3 (Typ.tuple2 Global_slot.typ - (Typ.list ~length:num_global_slots_to_test - Global_slot.typ)) + (Typ.list ~length:num_global_slots_to_test Global_slot.typ) ) (Typ.tuple2 Length.typ (Typ.list ~length: (Length.to_int constants.sub_windows_per_window) - Length.typ)) - Constants.typ) + Length.typ ) ) + Constants.typ ) (Typ.tuple3 Global_slot.typ (Typ.list ~length:(Length.to_int constants.sub_windows_per_window) - Length.typ) - Length.typ) + Length.typ ) + Length.typ ) (fun ( (prev_global_slot, next_global_slots) , (prev_min_window_density, prev_sub_window_densities) , constants ) -> update_several_times_checked ~f:Checked.update_min_window_density ~prev_global_slot ~next_global_slots ~prev_sub_window_densities - ~prev_min_window_density ~constants) + ~prev_min_window_density ~constants ) (fun ( (prev_global_slot, next_global_slots) , (prev_min_window_density, prev_sub_window_densities) , constants ) -> @@ -1630,8 +1628,8 @@ module Data = struct ~f:(update_min_window_density ~incr_window:true) ~prev_global_slot ~next_global_slots ~prev_sub_window_densities ~prev_min_window_density - ~constants) - (slots, min_window_densities, constants)) + ~constants ) + (slots, min_window_densities, constants) ) end ) end @@ -1793,7 +1791,7 @@ module Data = struct ; coinbase_receiver ; supercharge_coinbase } : - Value.t) = + Value.t ) = let open Random_oracle.Input.Chunked in List.reduce_exn ~f:append [ Length.to_input blockchain_length @@ -1833,7 +1831,7 @@ module Data = struct ; coinbase_receiver ; supercharge_coinbase } : - var) = + var ) = let open Random_oracle.Input.Chunked in List.reduce_exn ~f:append [ Length.Checked.to_input blockchain_length @@ -1895,7 +1893,7 @@ module Data = struct (Or_error.errorf !"Next global slot %{sexp: Global_slot.t} smaller than \ current global slot %{sexp: Global_slot.t}" - next_global_slot previous_consensus_state.curr_global_slot) + next_global_slot previous_consensus_state.curr_global_slot ) ~f:(fun diff -> Ok diff) in let%map total_currency = @@ -1968,7 +1966,7 @@ module Data = struct let%bind _q1, r1 = Slot.Checked.div_mod slot1 (Slot.Checked.Unsafe.of_field - (Length.Checked.to_field checkpoint_window_size_in_slots)) + (Length.Checked.to_field checkpoint_window_size_in_slots) ) in let next_window_start = Run.Field.( @@ -2004,7 +2002,7 @@ module Data = struct let genesis_epoch_data_staking, genesis_epoch_data_next = Option.value_map genesis_epoch_data ~default:(default_epoch_data, default_epoch_data) ~f:(fun data -> - (data.staking, Option.value ~default:data.staking data.next)) + (data.staking, Option.value ~default:data.staking data.next) ) in let genesis_winner_pk = fst Vrf.Precomputed.genesis_winner in { Poly.blockchain_length @@ -2059,13 +2057,13 @@ module Data = struct (update ~constants ~producer_vrf_result ~previous_consensus_state: (negative_one ~genesis_ledger ~genesis_epoch_data ~constants - ~constraint_constants) + ~constraint_constants ) ~previous_protocol_state_hash:negative_one_protocol_state_hash ~consensus_transition ~supply_increase:Currency.Amount.zero ~snarked_ledger_hash ~genesis_ledger_hash:snarked_ledger_hash ~block_stake_winner:genesis_winner_pk ~block_creator:genesis_winner_pk ~coinbase_receiver:genesis_winner_pk - ~supercharge_coinbase:true) + ~supercharge_coinbase:true ) let create_genesis ~negative_one_protocol_state_hash ~genesis_ledger ~genesis_epoch_data ~constraint_constants ~constants : Value.t = @@ -2105,7 +2103,7 @@ module Data = struct (previous_protocol_state_hash : Mina_base.State_hash.var) ~(supply_increase : Currency.Amount.var) ~(previous_blockchain_state_ledger_hash : - Mina_base.Frozen_ledger_hash.var) ~genesis_ledger_hash + Mina_base.Frozen_ledger_hash.var ) ~genesis_ledger_hash ~constraint_constants ~(protocol_constants : Mina_base.Protocol_constants_checked.var) = let open Snark_params.Tick in @@ -2358,66 +2356,63 @@ module Data = struct ~deprecated:(Deprecated (Some "use blockHeight instead")) ~args:Arg.[] ~resolve:(fun _ { Poly.blockchain_length; _ } -> - Mina_numbers.Length.to_uint32 blockchain_length) + Mina_numbers.Length.to_uint32 blockchain_length ) ; field "blockHeight" ~typ:(non_null uint32) ~doc:"Height of the blockchain at this block" ~args:Arg.[] ~resolve:(fun _ { Poly.blockchain_length; _ } -> - Mina_numbers.Length.to_uint32 blockchain_length) + Mina_numbers.Length.to_uint32 blockchain_length ) ; field "epochCount" ~typ:(non_null uint32) ~args:Arg.[] ~resolve:(fun _ { Poly.epoch_count; _ } -> - Mina_numbers.Length.to_uint32 epoch_count) + Mina_numbers.Length.to_uint32 epoch_count ) ; field "minWindowDensity" ~typ:(non_null uint32) ~args:Arg.[] ~resolve:(fun _ { Poly.min_window_density; _ } -> - Mina_numbers.Length.to_uint32 min_window_density) + Mina_numbers.Length.to_uint32 min_window_density ) ; field "lastVrfOutput" ~typ:(non_null string) ~args:Arg.[] - ~resolve: - (fun (_ : 'ctx resolve_info) { Poly.last_vrf_output; _ } -> - Vrf.Output.Truncated.to_base58_check last_vrf_output) + ~resolve:(fun (_ : 'ctx resolve_info) { Poly.last_vrf_output; _ } -> + Vrf.Output.Truncated.to_base58_check last_vrf_output ) ; field "totalCurrency" ~doc:"Total currency in circulation at this block" ~typ:(non_null uint64) ~args:Arg.[] ~resolve:(fun _ { Poly.total_currency; _ } -> - Amount.to_uint64 total_currency) + Amount.to_uint64 total_currency ) ; field "stakingEpochData" ~typ: (non_null @@ Epoch_data.Staking.graphql_type "StakingEpochData") ~args:Arg.[] - ~resolve: - (fun (_ : 'ctx resolve_info) { Poly.staking_epoch_data; _ } -> - staking_epoch_data) + ~resolve:(fun (_ : 'ctx resolve_info) + { Poly.staking_epoch_data; _ } -> staking_epoch_data + ) ; field "nextEpochData" ~typ:(non_null @@ Epoch_data.Next.graphql_type "NextEpochData") ~args:Arg.[] - ~resolve: - (fun (_ : 'ctx resolve_info) { Poly.next_epoch_data; _ } -> - next_epoch_data) + ~resolve:(fun (_ : 'ctx resolve_info) { Poly.next_epoch_data; _ } -> + next_epoch_data ) ; field "hasAncestorInSameCheckpointWindow" ~typ:(non_null bool) ~args:Arg.[] - ~resolve: - (fun _ { Poly.has_ancestor_in_same_checkpoint_window; _ } -> - has_ancestor_in_same_checkpoint_window) + ~resolve:(fun _ { Poly.has_ancestor_in_same_checkpoint_window; _ } -> + has_ancestor_in_same_checkpoint_window ) ; field "slot" ~doc:"Slot in which this block was created" ~typ:(non_null uint32) ~args:Arg.[] ~resolve:(fun _ { Poly.curr_global_slot; _ } -> - Global_slot.slot curr_global_slot) + Global_slot.slot curr_global_slot ) ; field "slotSinceGenesis" ~doc:"Slot since genesis (across all hard-forks)" ~typ:(non_null uint32) ~args:Arg.[] ~resolve:(fun _ { Poly.global_slot_since_genesis; _ } -> - global_slot_since_genesis) + global_slot_since_genesis ) ; field "epoch" ~doc:"Epoch in which this block was created" ~typ:(non_null uint32) ~args:Arg.[] ~resolve:(fun _ { Poly.curr_global_slot; _ } -> - Global_slot.epoch curr_global_slot) - ]) + Global_slot.epoch curr_global_slot ) + ] ) end module Prover_state = struct @@ -2443,7 +2438,7 @@ module Data = struct unstage (Mina_base.Pending_coinbase.handler ~depth:constraint_constants.pending_coinbase_depth - pending_coinbases ~is_new_stack) + pending_coinbases ~is_new_stack ) in let handlers = Snarky_backendless.Request.Handler.( @@ -2468,7 +2463,7 @@ module Data = struct (Provide (Snarky_backendless.Request.Handler.run handlers [ "Ledger Handler"; "Pending Coinbase Handler" ] - request)) + request ) ) let ledger_depth { ledger; _ } = ledger.depth end @@ -2587,10 +2582,9 @@ module Hooks = struct if Ledger_hash.equal ledger_hash (Mina_ledger.Ledger.merkle_root - genesis_epoch_ledger) + genesis_epoch_ledger ) then - Some - (Error "refusing to serve genesis epoch ledger") + Some (Error "refusing to serve genesis epoch ledger") else None | Ledger_db ledger -> if @@ -2602,8 +2596,8 @@ module Hooks = struct ( Mina_ledger.Sparse_ledger.of_any_ledger @@ Mina_ledger.Ledger.Any_ledger.cast (module Mina_ledger.Ledger.Db) - ledger )) - else None) + ledger ) ) + else None ) in Option.value res ~default:(Error "epoch ledger not found") in @@ -2617,9 +2611,9 @@ module Hooks = struct , Mina_base.Ledger_hash.to_yojson ledger_hash ) ] "Failed to serve epoch ledger query with hash $ledger_hash \ - from $peer: $error") ; + from $peer: $error" ) ; if Ivar.is_full ivar then [%log error] "Ivar.fill bug is here!" ; - Ivar.fill ivar response) + Ivar.fill ivar response ) end open Network_peer.Rpc_intf @@ -2639,7 +2633,10 @@ module Hooks = struct type query = { query : - 'q 'r. Network_peer.Peer.t -> ('q, 'r) rpc -> 'q + 'q 'r. + Network_peer.Peer.t + -> ('q, 'r) rpc + -> 'q -> 'r Network_peer.Rpc_intf.rpc_response Deferred.t } @@ -2774,14 +2771,15 @@ module Hooks = struct (Ledger_hash.equal (Frozen_ledger_hash.to_ledger_hash expected_root) (Local_state.Snapshot.Ledger_snapshot.merkle_root - (Local_state.get_snapshot local_state snapshot_id).ledger))) + (Local_state.get_snapshot local_state snapshot_id).ledger ) ) ) { snapshot_id; expected_root } in match source with | `Curr -> Option.map (required_snapshot_sync Next_epoch_snapshot - consensus_state.staking_epoch_data.ledger.hash) ~f:(fun s -> One s) + consensus_state.staking_epoch_data.ledger.hash ) ~f:(fun s -> + One s ) | `Last -> ( match ( required_snapshot_sync Next_epoch_snapshot @@ -2796,8 +2794,8 @@ module Hooks = struct | Some next, Some staking -> Some (Both - { next = next.expected_root; staking = staking.expected_root }) - ) + { next = next.expected_root; staking = staking.expected_root } + ) ) let sync_local_state ~logger ~trust_system ~local_state ~random_peers ~(query_peer : Rpcs.query) ~ledger_depth requested_syncs = @@ -2820,7 +2818,7 @@ module Hooks = struct Ledger_hash.equal (Frozen_ledger_hash.to_ledger_hash target_ledger_hash) (Local_state.Snapshot.Ledger_snapshot.merkle_root - !local_state.next_epoch_snapshot.ledger)) + !local_state.next_epoch_snapshot.ledger )) then ( Local_state.Snapshot.Ledger_snapshot.remove !local_state.staking_epoch_snapshot.ledger @@ -2854,7 +2852,7 @@ module Hooks = struct match%bind query_peer.query peer Rpcs.Get_epoch_ledger (Mina_base.Frozen_ledger_hash.to_ledger_hash - target_ledger_hash) + target_ledger_hash ) with | Connected { data = Ok (Ok sparse_ledger); _ } -> ( match @@ -2904,7 +2902,7 @@ module Hooks = struct ] "Failed to connect to $peer to retrieve epoch ledger: \ $error" ; - return (Error err) )) + return (Error err) ) ) in match requested_syncs with | One required_sync -> @@ -3195,7 +3193,7 @@ module Hooks = struct not (Epoch.equal (Consensus_state.curr_epoch prev) - (Consensus_state.curr_epoch next)) + (Consensus_state.curr_epoch next) ) then ( !local_state.last_epoch_delegatee_table <- Some !local_state.staking_epoch_snapshot.delegatee_table ; @@ -3207,7 +3205,7 @@ module Hooks = struct if not (Mina_base.Frozen_ledger_hash.equal snarked_ledger_hash - genesis_ledger_hash) + genesis_ledger_hash ) then ( let epoch_ledger_uuids = Local_state.Data. @@ -3228,7 +3226,7 @@ module Hooks = struct ~directory_name: ( !local_state.epoch_ledger_location ^ Uuid.to_string epoch_ledger_uuids.next ) - ()) + () ) ; delegatee_table = compute_delegatee_table_ledger_db (Local_state.current_block_production_keys local_state) @@ -3319,7 +3317,7 @@ module Hooks = struct not ( received_at_valid_time ~constants consensus_state ~time_received:(to_unix_timestamp time) - |> Result.is_ok )) + |> Result.is_ok ) ) module type State_hooks_intf = Intf.State_hooks @@ -3337,9 +3335,9 @@ module Hooks = struct and type consensus_state_var := Consensus_state.var) (Snark_transition : Intf.Snark_transition with type blockchain_state_var := - Blockchain_state.var + Blockchain_state.var and type consensus_transition_var := - Consensus_transition.var) : + Consensus_transition.var) : State_hooks_intf with type blockchain_state := Blockchain_state.Value.t and type protocol_state := Protocol_state.Value.t @@ -3355,7 +3353,7 @@ module Hooks = struct not (Mina_numbers.Global_slot.equal (Global_slot.slot_number global_slot) - block_data.global_slot) + block_data.global_slot ) then [%log error] !"VRF was evaluated at (epoch, slot) %{sexp:Epoch_and_slot.t} but \ @@ -3363,7 +3361,7 @@ module Hooks = struct %{sexp:Epoch_and_slot.t}. This means that generating the block \ took more time than expected." (Global_slot.to_epoch_and_slot - (Global_slot.of_slot_number ~constants block_data.global_slot)) + (Global_slot.of_slot_number ~constants block_data.global_slot) ) (Global_slot.to_epoch_and_slot global_slot) let generate_transition ~(previous_protocol_state : Protocol_state.Value.t) @@ -3384,7 +3382,7 @@ module Hooks = struct Global_slot.of_epoch_and_slot ~constants (Epoch_and_slot.of_time_exn ~constants time) in - check_block_data ~constants ~logger block_data actual_global_slot) ; + check_block_data ~constants ~logger block_data actual_global_slot ) ; let consensus_transition = block_data.global_slot in let previous_protocol_state_hash = Protocol_state.hash previous_protocol_state @@ -3402,7 +3400,7 @@ module Hooks = struct ~block_stake_winner:block_data.stake_proof.delegator_pk ~block_creator ~coinbase_receiver:block_data.stake_proof.coinbase_receiver_pk - ~supercharge_coinbase) + ~supercharge_coinbase ) in let genesis_state_hash = Protocol_state.genesis_state_hash @@ -3444,7 +3442,7 @@ module Hooks = struct -> snarked_ledger_hash:Mina_base.Frozen_ledger_hash.t -> coinbase_receiver:Public_key.Compressed.t -> supercharge_coinbase:bool - -> Consensus_state.Value.t) + -> Consensus_state.Value.t ) Quickcheck.Generator.t = let open Consensus_state in let genesis_ledger_hash = @@ -3456,8 +3454,8 @@ module Hooks = struct let%bind slot_advancement = gen_slot_advancement in let%map producer_vrf_result = Vrf.Output.gen in fun ~(previous_protocol_state : - Protocol_state.Value.t Mina_base.State_hash.With_state_hashes.t) - ~(snarked_ledger_hash : Mina_base.Frozen_ledger_hash.t) + Protocol_state.Value.t Mina_base.State_hash.With_state_hashes.t + ) ~(snarked_ledger_hash : Mina_base.Frozen_ledger_hash.t) ~coinbase_receiver ~supercharge_coinbase -> let prev = Protocol_state.consensus_state @@ -3477,7 +3475,7 @@ module Hooks = struct let total_currency = Option.value_exn (Amount.add prev.total_currency - constraint_constants.coinbase_amount) + constraint_constants.coinbase_amount ) in let prev_epoch, prev_slot = Consensus_state.curr_epoch_and_slot prev @@ -3489,7 +3487,7 @@ module Hooks = struct ~next_slot:curr_slot ~prev_protocol_state_hash: (Mina_base.State_hash.With_state_hashes.state_hash - previous_protocol_state) + previous_protocol_state ) ~producer_vrf_result ~snarked_ledger_hash ~genesis_ledger_hash ~total_currency in @@ -3513,10 +3511,8 @@ module Hooks = struct ; next_epoch_data ; has_ancestor_in_same_checkpoint_window = same_checkpoint_window_unchecked ~constants - (Global_slot.create ~constants ~epoch:prev_epoch - ~slot:prev_slot) - (Global_slot.create ~constants ~epoch:curr_epoch - ~slot:curr_slot) + (Global_slot.create ~constants ~epoch:prev_epoch ~slot:prev_slot) + (Global_slot.create ~constants ~epoch:curr_epoch ~slot:curr_slot) ; block_stake_winner = genesis_winner_pk ; block_creator = genesis_winner_pk ; coinbase_receiver @@ -3679,7 +3675,7 @@ let%test_module "Proof of stake tests" = ~compute: (As_prover.return (Mina_base.Protocol_constants_checked.value_of_t - Genesis_constants.for_unit_tests.protocol)) + Genesis_constants.for_unit_tests.protocol ) ) in let result = update_var previous_state transition_data previous_protocol_state_hash @@ -3690,7 +3686,7 @@ let%test_module "Proof of stake tests" = (* setup handler *) let indices = Ledger.Any_ledger.M.foldi ~init:[] ledger ~f:(fun i accum _acct -> - Ledger.Any_ledger.M.Addr.to_int i :: accum) + Ledger.Any_ledger.M.Addr.to_int i :: accum ) in let sparse_ledger = Sparse_ledger.of_ledger_index_subset_exn ledger indices @@ -3729,8 +3725,8 @@ let%test_module "Proof of stake tests" = (Sexp_diff_kernel.Display.display_with_ansi_colors ~display_options: (Sexp_diff_kernel.Display.Display_options.create - ~collapse_threshold:1000 ()) - diff) ; + ~collapse_threshold:1000 () ) + diff ) ; failwith "Test failed" ) let%test_unit "update, update_var agree starting from same genesis state" = @@ -3745,7 +3741,7 @@ let%test_module "Proof of stake tests" = Result.ok_or_failwith (State_hash.of_yojson (`String - "3NL3bc213VQEFx6XTLbc3HxHqHH9ANbhHxRxSnBcRzXcKgeFA6TY")) + "3NL3bc213VQEFx6XTLbc3HxHqHH9ANbhHxRxSnBcRzXcKgeFA6TY" ) ) ; previous_length = Mina_numbers.Length.of_int 100 ; previous_global_slot = Mina_numbers.Global_slot.of_int 200 } @@ -3800,7 +3796,7 @@ let%test_module "Proof of stake tests" = (Vrf.check ~constraint_constants ~global_slot ~seed ~producer_private_key:private_key ~producer_public_key:public_key_compressed ~total_stake ~logger - ~get_delegators:(Local_state.Snapshot.delegators epoch_snapshot)) + ~get_delegators:(Local_state.Snapshot.delegators epoch_snapshot) ) in match Result.ok_exn result with Some _ -> 1 | None -> 0 in @@ -3889,7 +3885,7 @@ let%test_module "Proof of stake tests" = let min_window_density = List.fold ~init:Length.zero ~f:Length.add (List.take sub_window_densities - (List.length sub_window_densities - 1)) + (List.length sub_window_densities - 1) ) in (min_window_density, sub_window_densities) @@ -4378,11 +4374,11 @@ let%test_module "Proof of stake tests" = let assert_hashed_consensus_state_pair = assert_consensus_state_set ~project:(fun (a, b) -> - [ With_hash.data a; With_hash.data b ]) + [ With_hash.data a; With_hash.data b ] ) let assert_hashed_consensus_state_triple = assert_consensus_state_set ~project:(fun (a, b, c) -> - [ With_hash.data a; With_hash.data b; With_hash.data c ]) + [ With_hash.data a; With_hash.data b; With_hash.data c ] ) let is_selected ?(log = false) (a, b) = let logger = if log then Logger.create () else Logger.null () in @@ -4410,7 +4406,7 @@ let%test_module "Proof of stake tests" = Quickcheck.test (gen_spot ()) ~f:(fun state -> assert_consensus_state_pair (state, state) ~assertion:"within long range" ~f:(fun (a, b) -> - Hooks.is_short_range a b ~constants)) + Hooks.is_short_range a b ~constants ) ) let%test_unit "generator sanity check: gen_spot_pair_short_aligned always \ generates pairs of states in short fork range" = @@ -4419,7 +4415,7 @@ let%test_module "Proof of stake tests" = assert_consensus_state_pair (With_hash.data a, With_hash.data b) ~assertion:"within short range" - ~f:(fun (a, b) -> Hooks.is_short_range a b ~constants)) + ~f:(fun (a, b) -> Hooks.is_short_range a b ~constants) ) let%test_unit "generator sanity check: gen_spot_pair_short_misaligned \ always generates pairs of states in short fork range" = @@ -4428,7 +4424,7 @@ let%test_module "Proof of stake tests" = assert_consensus_state_pair (With_hash.data a, With_hash.data b) ~assertion:"within short range" - ~f:(fun (a, b) -> Hooks.is_short_range a b ~constants)) + ~f:(fun (a, b) -> Hooks.is_short_range a b ~constants) ) let%test_unit "generator sanity check: gen_spot_pair_long always generates \ pairs of states in long fork range" = @@ -4437,7 +4433,7 @@ let%test_module "Proof of stake tests" = assert_consensus_state_pair (With_hash.data a, With_hash.data b) ~assertion:"within long range" - ~f:(fun (a, b) -> not (Hooks.is_short_range ~constants a b))) + ~f:(fun (a, b) -> not (Hooks.is_short_range ~constants a b)) ) let%test_unit "selection case: equal states" = Quickcheck.test @@ -4451,37 +4447,36 @@ let%test_module "Proof of stake tests" = } } in - assert_not_selected (hashed_state, hashed_state)) + assert_not_selected (hashed_state, hashed_state) ) let%test_unit "selection case: aligned checkpoints & different lengths" = Quickcheck.test - (gen_spot_pair_short_aligned ~blockchain_length_relativity:`Ascending - ()) + (gen_spot_pair_short_aligned ~blockchain_length_relativity:`Ascending ()) ~f:assert_selected let%test_unit "selection case: aligned checkpoints & equal lengths & \ different vrfs" = Quickcheck.test (gen_spot_pair_short_aligned ~blockchain_length_relativity:`Equal - ~vrf_output_relativity:`Ascending ()) + ~vrf_output_relativity:`Ascending () ) ~f:assert_selected let%test_unit "selection case: aligned checkpoints & equal lengths & equal \ vrfs & different hashes" = Quickcheck.test (gen_spot_pair_short_aligned ~blockchain_length_relativity:`Equal - ~vrf_output_relativity:`Equal ()) + ~vrf_output_relativity:`Equal () ) ~f:(fun (a, b) -> if State_hash.( With_state_hashes.state_hash b > With_state_hashes.state_hash a) then assert_selected (a, b) - else assert_selected (b, a)) + else assert_selected (b, a) ) let%test_unit "selection case: misaligned checkpoints & different lengths" = Quickcheck.test (gen_spot_pair_short_misaligned ~blockchain_length_relativity:`Ascending - ()) + () ) ~f:assert_selected (* TODO: This test always succeeds, but this could be a false positive as the blockchain length equality constraint @@ -4491,7 +4486,7 @@ let%test_module "Proof of stake tests" = different vrfs" = Quickcheck.test (gen_spot_pair_short_misaligned ~blockchain_length_relativity:`Equal - ~vrf_output_relativity:`Ascending ()) + ~vrf_output_relativity:`Ascending () ) ~f:assert_selected (* TODO: This test fails because the blockchain length equality constraint is broken for misaligned short forks. @@ -4534,7 +4529,7 @@ let%test_module "Proof of stake tests" = not ([%equal: Hooks.select_status * Hooks.select_status] (select a b, select b a) - (`Take, `Take)))) + (`Take, `Take) ) ) ) (* We define a homogeneous binary relation for consensus states by adapting the binary chain * selection rule and extending it to consider equality of chains. From this, we can test @@ -4583,7 +4578,7 @@ let%test_module "Proof of stake tests" = ~f: (assert_hashed_consensus_state_triple ~assertion:"chains hold partial order transitivity" - ~f:chains_hold_transitivity) + ~f:chains_hold_transitivity ) end ) module Exported = struct diff --git a/src/lib/consensus/proof_of_stake_fuzzer.ml b/src/lib/consensus/proof_of_stake_fuzzer.ml index 244b4d08689..930bccd028b 100644 --- a/src/lib/consensus/proof_of_stake_fuzzer.ml +++ b/src/lib/consensus/proof_of_stake_fuzzer.ml @@ -78,7 +78,7 @@ module Vrf_distribution = struct | None -> Public_key.Compressed.Map.of_alist_exn [ (pk, proposal_data) ] | Some map -> - Map.add_exn map ~key:pk ~data:proposal_data) + Map.add_exn map ~key:pk ~data:proposal_data ) in List.iter stakers ~f:(fun staker -> ignore @@ -94,8 +94,7 @@ module Vrf_distribution = struct |> Block_time.Span.to_ms ) dummy_consensus_state ~local_state:staker.local_state ~keypairs: - (Keypair.And_compressed_pk.Set.of_list - [ staker.keypair ]) + (Keypair.And_compressed_pk.Set.of_list [ staker.keypair ]) ~logger:(Logger.null ()) with | `Check_again _ -> @@ -117,7 +116,7 @@ module Vrf_distribution = struct < Global_slot.( epoch (of_slot_number ~constants - (Block_data.global_slot proposal_data))) + (Block_data.global_slot proposal_data) )) in let new_global_slot = Global_slot.of_slot_number ~constants @@ -127,7 +126,7 @@ module Vrf_distribution = struct Consensus_state.Unsafe.dummy_advance dummy_consensus_state ~increase_epoch_count ~new_global_slot in - (next_dummy_consensus_state, proposal_time))) ; + (next_dummy_consensus_state, proposal_time) ) ) ; { start_slot; term_slot; proposal_table } (** Picks a single chain of proposals from a distribution. Does not attempt @@ -160,7 +159,7 @@ module Vrf_distribution = struct in extend_proposal_chain (proposal :: acc_chain) (Global_slot.of_slot_number ~constants - (UInt32.succ @@ Block_data.global_slot proposal_data)) + (UInt32.succ @@ Block_data.global_slot proposal_data) ) in extend_proposal_chain [] dist.start_slot |> List.rev @@ -314,12 +313,12 @@ let prove_blockchain ~logger (module Keys : Keys_lib.Keys.S) in { Blockchain.state = next_state ; proof = wrap next_state_top_hash prev_proof - }) + } ) in Or_error.iter_error res ~f:(fun e -> [%log error] ~metadata:[ ("error", Error_json.error_to_yojson e) ] - "Prover threw an error while extending block: $error") ; + "Prover threw an error while extending block: $error" ) ; res [%%elif proof_level = "check"] @@ -345,16 +344,16 @@ let prove_blockchain ~logger (module Keys : Keys_lib.Keys.S) Or_error.map (Tick.check (main @@ Tick.Field.Var.constant next_state_top_hash) - prover_state) + prover_state ) ~f:(fun () -> { Blockchain.state = next_state ; proof = precomputed_values.genesis_proof - }) + } ) in Or_error.iter_error res ~f:(fun e -> [%log error] ~metadata:[ ("error", Error_json.error_to_yojson e) ] - "Prover threw an error while extending block: $error") ; + "Prover threw an error while extending block: $error" ) ; res [%%elif proof_level = "none"] @@ -418,7 +417,7 @@ let propose_block_onto_chain ~logger ~keys let next_ledger_hash = Option.value_map ledger_proof_opt ~f:(fun (proof, _) -> - Ledger_proof.statement proof |> Ledger_proof.statement_target) + Ledger_proof.statement proof |> Ledger_proof.statement_target ) ~default:previous_ledger_hash in let blockchain_state = @@ -447,14 +446,14 @@ let propose_block_onto_chain ~logger ~keys Snark_transition.create_value ?sok_digest: (Option.map ledger_proof_opt ~f:(fun (proof, _) -> - Ledger_proof.sok_digest proof)) + Ledger_proof.sok_digest proof ) ) ?ledger_proof: (Option.map ledger_proof_opt ~f:(fun (proof, _) -> - Ledger_proof.underlying_proof proof)) + Ledger_proof.underlying_proof proof ) ) ~supply_increase: (Option.value_map ~default:Currency.Amount.zero ~f:(fun (proof, _) -> (Ledger_proof.statement proof).supply_increase) - ledger_proof_opt) + ledger_proof_opt ) ~blockchain_state:(Protocol_state.blockchain_state protocol_state) ~consensus_transition ~pending_coinbase_update () in @@ -472,7 +471,7 @@ let propose_block_onto_chain ~logger ~keys let { Blockchain.proof = protocol_state_proof; _ } = prove_blockchain ~logger keys (Blockchain.create ~proof:previous_protocol_state_proof - ~state:previous_protocol_state) + ~state:previous_protocol_state ) protocol_state (Internal_transition.snark_transition internal_transition) (Internal_transition.prover_state internal_transition) @@ -497,7 +496,7 @@ let main () = (Transport_file_system.dumb_logrotate ~directory:"fuzz_logs" ~log_filename:"log" ~max_size:(500 * 1024 * 1024) - ~num_rotate:1)) ; + ~num_rotate:1 )) ; don't_wait_for (let%bind genesis_transition, genesis_staged_ledger = create_genesis_data () @@ -515,7 +514,7 @@ let main () = (Public_key.Compressed.Set.of_list [ compressed_pk ]) ~genesis_ledger:Genesis_ledger.t in - Staker.{ keypair; local_state }) + Staker.{ keypair; local_state } ) in let rec loop epoch (base_transition, base_staged_ledger) = let dist = @@ -544,11 +543,11 @@ let main () = @@ Global_slot.( slot (of_slot_number ~constants:consensus_constants - (Block_data.global_slot block_data))) ) ; - propose_block_onto_chain ~logger ~keys previous_chain proposal) + (Block_data.global_slot block_data) )) ) ; + propose_block_onto_chain ~logger ~keys previous_chain proposal ) in loop (UInt32.succ epoch) final_chain in - loop UInt32.zero (genesis_transition, genesis_staged_ledger)) + loop UInt32.zero (genesis_transition, genesis_staged_ledger) ) let _ = Async.Scheduler.go_main ~main () diff --git a/src/lib/consensus/vrf/consensus_vrf.ml b/src/lib/consensus/vrf/consensus_vrf.ml index 25c7b68114e..d02749dbb1f 100644 --- a/src/lib/consensus/vrf/consensus_vrf.ml +++ b/src/lib/consensus/vrf/consensus_vrf.ml @@ -136,7 +136,7 @@ module Message = struct Tick.make_checked (fun () -> Random_oracle.Checked.hash ~init:Mina_base.Hash_prefix.vrf_message (Random_oracle.Checked.pack_input input) - |> Group_map.Checked.to_group) + |> Group_map.Checked.to_group ) end let gen ~(constraint_constants : Genesis_constants.Constraint_constants.t) = @@ -177,7 +177,7 @@ module Output = struct sprintf "Error decoding vrf output in \ Vrf.Output.Truncated.Stable.V1.of_yojson: %s" - err) + err ) | _ -> Error "Vrf.Output.Truncated.Stable.V1.of_yojson: Expected a string" @@ -204,7 +204,7 @@ module Output = struct Typ.array ~length:length_in_bits Boolean.typ |> Typ.transport ~there:(fun s -> - Array.sub (Blake2.string_to_bits s) ~pos:0 ~len:length_in_bits) + Array.sub (Blake2.string_to_bits s) ~pos:0 ~len:length_in_bits ) ~back:Blake2.bits_to_string let dummy = @@ -259,7 +259,7 @@ module Output = struct Tick.make_checked (fun () -> Random_oracle.Checked.Digest.to_bits ~length:Truncated.length_in_bits x - |> Array.of_list) + |> Array.of_list ) let hash msg (x, y) = let msg = Message.Checked.to_input msg in @@ -268,7 +268,7 @@ module Output = struct in make_checked (fun () -> let open Random_oracle.Checked in - hash ~init:Hash_prefix_states.vrf_output (pack_input input)) + hash ~init:Hash_prefix_states.vrf_output (pack_input input) ) end let%test_unit "hash unchecked vs. checked equality" = @@ -294,7 +294,7 @@ module Output = struct * Snark_params.Tick.Inner_curve.typ) typ (fun (msg, g) -> Checked.hash msg g) - (fun (msg, g) -> hash ~constraint_constants msg g)) + (fun (msg, g) -> hash ~constraint_constants msg g) ) end module Threshold = struct @@ -357,19 +357,19 @@ module Threshold = struct ~top: (Integer.create ~value:(Balance.pack_var my_stake) - ~upper_bound:balance_upper_bound) + ~upper_bound:balance_upper_bound ) ~bottom: (Integer.create ~value:(Amount.pack_var total_stake) - ~upper_bound:amount_upper_bound) - ~top_is_less_than_bottom:()) + ~upper_bound:amount_upper_bound ) + ~top_is_less_than_bottom:() ) in let vrf_output = Array.to_list (vrf_output :> Boolean.var array) in let lhs = c_bias vrf_output in Floating_point.( le ~m (of_bits ~m lhs ~precision:Output.Truncated.length_in_bits) - rhs)) + rhs) ) end end @@ -412,7 +412,7 @@ module Evaluation_hash = struct Tick.make_checked (fun () -> Random_oracle.Checked.hash ~init:Mina_base.Hash_prefix.vrf_evaluation - (Random_oracle.Checked.pack_input input)) + (Random_oracle.Checked.pack_input input) ) in (* This isn't great cryptographic practice.. *) Tick.Field.Checked.unpack_full tick_output @@ -456,24 +456,25 @@ end) = struct open Constraint_constants - include Vrf_lib.Standalone.Make (Tick) (Tick.Inner_curve.Scalar) (Group) - (struct - include Message + include + Vrf_lib.Standalone.Make (Tick) (Tick.Inner_curve.Scalar) (Group) + (struct + include Message - let typ = typ ~constraint_constants + let typ = typ ~constraint_constants - let hash_to_group = hash_to_group ~constraint_constants - end) - (struct - include Output_hash + let hash_to_group = hash_to_group ~constraint_constants + end) + (struct + include Output_hash - let hash = hash ~constraint_constants - end) - (struct - include Evaluation_hash + let hash = hash ~constraint_constants + end) + (struct + include Evaluation_hash - let hash_for_proof = hash_for_proof ~constraint_constants - end) + let hash_for_proof = hash_for_proof ~constraint_constants + end) end type evaluation = @@ -646,4 +647,4 @@ let%test_unit "Standalone and integrates vrfs are consistent" = let standalone_vrf = Standalone.Evaluation.verified_output standalone_eval context in - [%test_eq: Output_hash.t option] (Some integrated_vrf) standalone_vrf) + [%test_eq: Output_hash.t option] (Some integrated_vrf) standalone_vrf ) diff --git a/src/lib/crypto/kimchi_backend/common/bigint.ml b/src/lib/crypto/kimchi_backend/common/bigint.ml index 4e6cdae41b8..b869d28b88f 100644 --- a/src/lib/crypto/kimchi_backend/common/bigint.ml +++ b/src/lib/crypto/kimchi_backend/common/bigint.ml @@ -84,7 +84,7 @@ module Make let bin_shape_t = Bin_prot.Shape.basetype (Bin_prot.Shape.Uuid.of_string - (sprintf "kimchi_backend_bigint_%d" M.length_in_bytes)) + (sprintf "kimchi_backend_bigint_%d" M.length_in_bytes) ) [] let __bin_read_t__ _buf ~pos_ref _vint = diff --git a/src/lib/crypto/kimchi_backend/common/curve.ml b/src/lib/crypto/kimchi_backend/common/curve.ml index 23b0601b8f0..c7440480aa0 100644 --- a/src/lib/crypto/kimchi_backend/common/curve.ml +++ b/src/lib/crypto/kimchi_backend/common/curve.ml @@ -105,21 +105,21 @@ struct exception Invalid_curve_point of t - include Binable.Of_binable - (T) - (struct - let on_curve (x, y) = - BaseField.Stable.Latest.equal (y_squared x) - (BaseField.square y) + include + Binable.Of_binable + (T) + (struct + let on_curve (x, y) = + BaseField.Stable.Latest.equal (y_squared x) (BaseField.square y) - type t = T.t + type t = T.t - let to_binable = Fn.id + let to_binable = Fn.id - let of_binable t = - if not (on_curve t) then raise (Invalid_curve_point t) ; - t - end) + let of_binable t = + if not (on_curve t) then raise (Invalid_curve_point t) ; + t + end) end module Latest = V1 @@ -182,15 +182,16 @@ struct let of_affine (x, y) = C.of_affine_coordinates x y - include Binable.Of_binable - (Affine) - (struct - type nonrec t = t + include + Binable.Of_binable + (Affine) + (struct + type nonrec t = t - let to_binable = to_affine_exn + let to_binable = to_affine_exn - let of_binable = of_affine - end) + let of_binable = of_affine + end) let ( + ) = add diff --git a/src/lib/crypto/kimchi_backend/common/dlog_plonk_based_keypair.ml b/src/lib/crypto/kimchi_backend/common/dlog_plonk_based_keypair.ml index 1d3a6d1f572..c21297f965e 100644 --- a/src/lib/crypto/kimchi_backend/common/dlog_plonk_based_keypair.ml +++ b/src/lib/crypto/kimchi_backend/common/dlog_plonk_based_keypair.ml @@ -127,9 +127,9 @@ module Make (Inputs : Inputs_intf) = struct | None -> Or_error.errorf "Could not read the URS from disk; its format did \ - not match the expected format")) + not match the expected format" ) ) (fun _ urs path -> - Or_error.try_with (fun () -> Inputs.Urs.write None urs path)) + Or_error.try_with (fun () -> Inputs.Urs.write None urs path) ) in let u = match Key_cache.Sync.read specs store () with @@ -143,7 +143,7 @@ module Make (Inputs : Inputs_intf) = struct | On_disk _ -> true | S3 _ -> - false)) + false ) ) store () urs in urs diff --git a/src/lib/crypto/kimchi_backend/common/dlog_urs.ml b/src/lib/crypto/kimchi_backend/common/dlog_urs.ml index 7e5733f6c23..4c03b09ae2c 100644 --- a/src/lib/crypto/kimchi_backend/common/dlog_urs.ml +++ b/src/lib/crypto/kimchi_backend/common/dlog_urs.ml @@ -48,7 +48,7 @@ module Make (Inputs : Inputs_intf) = struct (fun () -> name) (fun () ~path -> Or_error.try_with (fun () -> Urs.read path)) (fun _ urs path -> - Or_error.try_with (fun () -> Urs.write urs path)) + Or_error.try_with (fun () -> Urs.write urs path) ) in let u = match Key_cache.Sync.read specs store () with @@ -62,7 +62,7 @@ module Make (Inputs : Inputs_intf) = struct | On_disk _ -> true | S3 _ -> - false)) + false ) ) store () urs in urs diff --git a/src/lib/crypto/kimchi_backend/common/field.ml b/src/lib/crypto/kimchi_backend/common/field.ml index 74e7d616c09..aa4c04acb59 100644 --- a/src/lib/crypto/kimchi_backend/common/field.ml +++ b/src/lib/crypto/kimchi_backend/common/field.ml @@ -147,25 +147,27 @@ module Make (F : Input_intf) : module V1 = struct type t = F.t [@@deriving version { asserted }] - include Binable.Of_binable - (Bigint) - (struct - type nonrec t = t + include + Binable.Of_binable + (Bigint) + (struct + type nonrec t = t - let to_binable = to_bigint + let to_binable = to_bigint - let of_binable = of_bigint - end) + let of_binable = of_bigint + end) - include Sexpable.Of_sexpable - (Bigint) - (struct - type nonrec t = t + include + Sexpable.Of_sexpable + (Bigint) + (struct + type nonrec t = t - let to_sexpable = to_bigint + let to_sexpable = to_bigint - let of_sexpable = of_bigint - end) + let of_sexpable = of_bigint + end) let to_bignum_bigint n = let rec go i two_to_the_i acc = @@ -224,7 +226,7 @@ module Make (F : Input_intf) : let of_bits bs = List.fold (List.rev bs) ~init:zero ~f:(fun acc b -> let acc = add acc acc in - if b then add acc one else acc) + if b then add acc one else acc ) let%test_unit "sexp round trip" = let t = random () in @@ -235,7 +237,7 @@ module Make (F : Input_intf) : [%test_eq: Stable.Latest.t] t (Binable.of_string (module Stable.Latest) - (Binable.to_string (module Stable.Latest) t)) + (Binable.to_string (module Stable.Latest) t) ) let ( + ) = add @@ -273,7 +275,7 @@ module Make (F : Input_intf) : Quickcheck.test (Quickcheck.Generator.list_with_length Int.(size_in_bits - 1) - Bool.quickcheck_generator) + Bool.quickcheck_generator ) ~f:(fun bs -> - [%test_eq: bool list] (bs @ [ false ]) (to_bits (of_bits bs))) + [%test_eq: bool list] (bs @ [ false ]) (to_bits (of_bits bs)) ) end diff --git a/src/lib/crypto/kimchi_backend/common/plonk_constraint_system.ml b/src/lib/crypto/kimchi_backend/common/plonk_constraint_system.ml index 836bd950714..83c4e7a40be 100644 --- a/src/lib/crypto/kimchi_backend/common/plonk_constraint_system.ml +++ b/src/lib/crypto/kimchi_backend/common/plonk_constraint_system.ml @@ -339,13 +339,13 @@ struct Relative_position.Hash_set.of_list data | Some ps -> List.iter ~f:(Hash_set.add ps) data ; - ps)) ; + ps ) ) ; let res = Relative_position.Table.create () in Hashtbl.iter equivalence_classes ~f:(fun ps -> let rotate_left = function [] -> [] | x :: xs -> xs @ [ x ] in let ps = Hash_set.to_list ps in List.iter2_exn ps (rotate_left ps) ~f:(fun input output -> - Hashtbl.add_exn res ~key:input ~data:output)) ; + Hashtbl.add_exn res ~key:input ~data:output ) ) ; res (** Compute the witness, given the constraint system `sys` @@ -360,7 +360,7 @@ struct let num_rows = public_input_size + sys.next_row in let res = Array.init Constants.columns ~f:(fun _ -> - Array.create ~len:num_rows Fp.zero) + Array.create ~len:num_rows Fp.zero ) in (* Public input *) for i = 0 to public_input_size - 1 do @@ -383,7 +383,7 @@ struct | Internal x -> find internal_values x in - Fp.(acc + (s * x))) + Fp.(acc + (s * x)) ) in (* Update the witness table with the value of the variables from each row. *) List.iteri (List.rev sys.rows_rev) ~f:(fun i_after_input cols -> @@ -398,13 +398,13 @@ struct let lc = find sys.internal_vars var in let value = compute lc in res.(col_idx).(row_idx) <- value ; - Hashtbl.set internal_values ~key:var ~data:value)) ; + Hashtbl.set internal_values ~key:var ~data:value ) ) ; (* Return the witness. *) res let union_find sys v = Hashtbl.find_or_add sys.union_finds v ~default:(fun () -> - Union_find.create v) + Union_find.create v ) (** Creates an internal variable and assigns it the value lc and constant. *) let create_internal ?constant sys lc : V.t = @@ -469,7 +469,7 @@ struct let num_vars = min Constants.permutation_cols (Array.length vars) in let vars_for_perm = Array.slice vars 0 num_vars in Array.iteri vars_for_perm ~f:(fun col x -> - Option.iter x ~f:(fun x -> wire sys x sys.next_row col)) ; + Option.iter x ~f:(fun x -> wire sys x sys.next_row col) ) ; (* Add to gates. *) let open Position in sys.gates <- Unfinalized_rev ({ kind; wired_to = [||]; coeffs } :: gates) ; @@ -522,7 +522,7 @@ struct { gate with wired_to = Array.init Constants.permutation_cols ~f:(fun col -> - permutation { row; col }) + permutation { row; col } ) } in @@ -531,7 +531,7 @@ struct let public_gates = List.mapi public_gates ~f:(fun absolute_row gate -> update_gate_with_permutation_info (Row.Public_input absolute_row) - gate) + gate ) in (* construct all the other gates (except zero-knowledge rows) *) @@ -539,7 +539,7 @@ struct let gates = List.mapi gates ~f:(fun relative_row gate -> update_gate_with_permutation_info - (Row.After_public_input relative_row) gate) + (Row.After_public_input relative_row) gate ) in (* concatenate and convert to absolute rows *) @@ -551,7 +551,7 @@ struct let add_gates gates = List.iter gates ~f:(fun g -> let g = to_absolute_row g in - Gates.add rust_gates (Gate_spec.to_rust_gate g)) + Gates.add rust_gates (Gate_spec.to_rust_gate g) ) in add_gates public_gates ; add_gates gates ; @@ -590,7 +590,7 @@ struct List.fold terms ~init:Int.Map.empty ~f:(fun acc (x, i) -> Map.change acc i ~f:(fun y -> let res = match y with None -> x | Some y -> Fp.add x y in - if Fp.(equal zero res) then None else Some res)) + if Fp.(equal zero res) then None else Some res ) ) (** Converts a [Cvar.t] to a `(terms, terms_length, has_constant)`. if `has_constant` is set, then terms start with a constant term in the form of (c, 0). @@ -610,7 +610,7 @@ struct let terms = accumulate_terms terms in let terms_list = Map.fold_right ~init:[] terms ~f:(fun ~key ~data acc -> - (data, key) :: acc) + (data, key) :: acc ) in Some (terms_list, Map.length terms, has_constant_term) @@ -677,7 +677,7 @@ struct let terms = accumulate_terms terms in let terms_list = Map.fold_right ~init:[] terms ~f:(fun ~key ~data acc -> - (data, key) :: acc) + (data, key) :: acc ) in match (constant, Map.is_empty terms) with | Some c, true -> @@ -725,7 +725,7 @@ struct (constr : ( Fp.t Snarky_backendless.Cvar.t , Fp.t ) - Snarky_backendless.Constraint.basic) = + Snarky_backendless.Constraint.basic ) = let red = reduce_lincom sys in (* reduce any [Cvar.t] to a single internal variable *) let reduce_to_v (x : Fp.t Snarky_backendless.Cvar.t) : V.t = @@ -1165,7 +1165,7 @@ struct Array.iter state ~f: (Fn.compose add_endoscale_scalar_round - (Endoscale_scalar_round.map ~f:reduce_to_v)) + (Endoscale_scalar_round.map ~f:reduce_to_v) ) | constr -> failwithf "Unhandled constraint %s" Obj.(Extension_constructor.name (Extension_constructor.of_val constr)) diff --git a/src/lib/crypto/kimchi_backend/common/plonk_dlog_proof.ml b/src/lib/crypto/kimchi_backend/common/plonk_dlog_proof.ml index 82741587ff3..ea055f4c90d 100644 --- a/src/lib/crypto/kimchi_backend/common/plonk_dlog_proof.ml +++ b/src/lib/crypto/kimchi_backend/common/plonk_dlog_proof.ml @@ -241,7 +241,7 @@ module Make (Inputs : Inputs_intf) = struct ; s = tuple6_to_vec e.s ; generic_selector = e.generic_selector ; poseidon_selector = e.poseidon_selector - }) + } ) in let wo x : Inputs.Curve.Affine.t array = match Poly_comm.of_backend_without_degree_bound x with @@ -288,7 +288,7 @@ module Make (Inputs : Inputs_intf) = struct ; ft_eval1 } } : - t) : Backend.t = + t ) : Backend.t = let g x = G.Affine.to_backend (Pickles_types.Or_infinity.Finite x) in let pcwo t = Poly_comm.to_backend (`Without_degree_bound t) in let lr = Array.map lr ~f:(fun (x, y) -> (g x, g y)) in @@ -313,7 +313,7 @@ module Make (Inputs : Inputs_intf) = struct ( challenges , { Kimchi_types.shifted = None ; unshifted = [| Kimchi_types.Finite (x, y) |] - } )) + } ) ) } let to_backend chal_polys primary_input t = @@ -325,13 +325,13 @@ module Make (Inputs : Inputs_intf) = struct in let challenges = List.map chal_polys ~f:(fun { Challenge_polynomial.challenges; _ } -> - challenges) + challenges ) |> Array.concat in let commitments = Array.of_list_map chal_polys ~f:(fun { Challenge_polynomial.commitment; _ } -> - G.Affine.to_backend (Finite commitment)) + G.Affine.to_backend (Finite commitment) ) in let res = Backend.create pk primary auxiliary challenges commitments in of_backend res @@ -342,13 +342,13 @@ module Make (Inputs : Inputs_intf) = struct in let challenges = List.map chal_polys ~f:(fun { Challenge_polynomial.challenges; _ } -> - challenges) + challenges ) |> Array.concat in let commitments = Array.of_list_map chal_polys ~f:(fun { Challenge_polynomial.commitment; _ } -> - G.Affine.to_backend (Finite commitment)) + G.Affine.to_backend (Finite commitment) ) in let%map.Promise res = Backend.create_async pk primary auxiliary challenges commitments @@ -360,7 +360,7 @@ module Make (Inputs : Inputs_intf) = struct let vks_and_v = Array.of_list_map ts ~f:(fun (vk, t, xs, m) -> let p = to_backend' (Option.value ~default:[] m) (conv xs) t in - (vk, p)) + (vk, p) ) in Backend.batch_verify (Array.map ~f:fst vks_and_v) @@ -373,5 +373,5 @@ module Make (Inputs : Inputs_intf) = struct (to_backend' (Option.value ~default:[] message) (vec_to_array (module Scalar_field.Vector) xs) - t) + t ) end diff --git a/src/lib/crypto/kimchi_backend/common/poly_comm.ml b/src/lib/crypto/kimchi_backend/common/poly_comm.ml index fb4970a2bf3..326dbbafce6 100644 --- a/src/lib/crypto/kimchi_backend/common/poly_comm.ml +++ b/src/lib/crypto/kimchi_backend/common/poly_comm.ml @@ -73,7 +73,7 @@ module Make (Inputs : Inputs_intf) = struct let with_degree_bound_to_backend (commitment : (Base_field.t * Base_field.t) Pickles_types.Or_infinity.t - Pickles_types.Plonk_types.Poly_comm.With_degree_bound.t) : Backend.t = + Pickles_types.Plonk_types.Poly_comm.With_degree_bound.t ) : Backend.t = Backend.make (Array.map ~f:or_infinity_to_backend commitment.unshifted) (Some (or_infinity_to_backend commitment.shifted)) @@ -81,7 +81,7 @@ module Make (Inputs : Inputs_intf) = struct let without_degree_bound_to_backend (commitment : (Base_field.t * Base_field.t) - Pickles_types.Plonk_types.Poly_comm.Without_degree_bound.t) : Backend.t + Pickles_types.Plonk_types.Poly_comm.Without_degree_bound.t ) : Backend.t = Backend.make (Array.map ~f:(fun x -> Kimchi_types.Finite (fst x, snd x)) commitment) @@ -130,7 +130,7 @@ module Make (Inputs : Inputs_intf) = struct | Infinity -> assert false | Finite (x, y) -> - (x, y))) + (x, y) ) ) | _ -> assert false end diff --git a/src/lib/crypto/kimchi_backend/common/scale_round.ml b/src/lib/crypto/kimchi_backend/common/scale_round.ml index 3d3ce2065ce..1435ac02513 100644 --- a/src/lib/crypto/kimchi_backend/common/scale_round.ml +++ b/src/lib/crypto/kimchi_backend/common/scale_round.ml @@ -27,7 +27,7 @@ let map { accs; bits; ss; base; n_prev; n_next } ~f = let map2 t1 t2 ~f = { accs = Array.map (Array.zip_exn t1.accs t2.accs) ~f:(fun ((x1, y1), (x2, y2)) -> - (f x1 x2, f y1 y2)) + (f x1 x2, f y1 y2) ) ; bits = Array.map (Array.zip_exn t1.bits t2.bits) ~f:(fun (x1, x2) -> f x1 x2) ; ss = Array.map (Array.zip_exn t1.ss t2.ss) ~f:(fun (x1, x2) -> f x1 x2) diff --git a/src/lib/crypto/kimchi_backend/pasta/pallas_based_plonk.ml b/src/lib/crypto/kimchi_backend/pasta/pallas_based_plonk.ml index 7dc5c12213a..6c56d46a22c 100644 --- a/src/lib/crypto/kimchi_backend/pasta/pallas_based_plonk.ml +++ b/src/lib/crypto/kimchi_backend/pasta/pallas_based_plonk.ml @@ -41,7 +41,7 @@ module R1CS_constraint_system = let params = Sponge.Params.( map pasta_q_kimchi ~f:(fun x -> - Field.of_bigint (Bigint256.of_decimal_string x))) + Field.of_bigint (Bigint256.of_decimal_string x) )) end) module Var = Var @@ -55,7 +55,7 @@ let lagrange : int -> _ Kimchi_types.poly_comm array = { Kimchi_types.unshifted = Array.map unshifted ~f:(fun (x, y) -> Kimchi_types.Finite (x, y)) ; shifted = None - })) + } ) ) let with_lagrange f (vk : Verification_key.t) = f (lagrange vk.domain.log_size_of_group) vk @@ -123,7 +123,7 @@ module Proof = Plonk_dlog_proof.Make (struct for row = 0 to num_rows - 1 do Field.Vector.emplace_back witness computed_witness.(col).(row) done ; - witness) + witness ) in create pk.index witness_cols prev_chals prev_comms @@ -131,7 +131,7 @@ module Proof = Plonk_dlog_proof.Make (struct create_aux pk primary auxiliary prev_chals prev_comms ~f:(fun pk auxiliary_input prev_challenges prev_sgs -> Promise.run_in_thread (fun () -> - create pk auxiliary_input prev_challenges prev_sgs)) + create pk auxiliary_input prev_challenges prev_sgs ) ) let create (pk : Keypair.t) primary auxiliary prev_chals prev_comms = create_aux pk primary auxiliary prev_chals prev_comms ~f:create @@ -155,15 +155,16 @@ end) module Proving_key = struct type t = Keypair.t - include Core_kernel.Binable.Of_binable - (Core_kernel.Unit) - (struct - type nonrec t = t + include + Core_kernel.Binable.Of_binable + (Core_kernel.Unit) + (struct + type nonrec t = t - let to_binable _ = () + let to_binable _ = () - let of_binable () = failwith "TODO" - end) + let of_binable () = failwith "TODO" + end) let is_initialized _ = `Yes diff --git a/src/lib/crypto/kimchi_backend/pasta/precomputed.ml b/src/lib/crypto/kimchi_backend/pasta/precomputed.ml index 2f8c73a1be7..e52af0389e2 100644 --- a/src/lib/crypto/kimchi_backend/pasta/precomputed.ml +++ b/src/lib/crypto/kimchi_backend/pasta/precomputed.ml @@ -19,7 +19,7 @@ let g s = | i -> let i = i - 2 in let byte = i / 2 in - s.[2 + (2 * (num_bytes - 1 - byte)) + (i mod 2)]) + s.[2 + (2 * (num_bytes - 1 - byte)) + (i mod 2)] ) module Lagrange_precomputations = struct let index_of_domain_log2 d = d - 1 diff --git a/src/lib/crypto/kimchi_backend/pasta/vesta_based_plonk.ml b/src/lib/crypto/kimchi_backend/pasta/vesta_based_plonk.ml index c12b4a8de5b..d1bb8ed5ac8 100644 --- a/src/lib/crypto/kimchi_backend/pasta/vesta_based_plonk.ml +++ b/src/lib/crypto/kimchi_backend/pasta/vesta_based_plonk.ml @@ -40,7 +40,7 @@ module R1CS_constraint_system = let params = Sponge.Params.( map pasta_p_kimchi ~f:(fun x -> - Field.of_bigint (Bigint256.of_decimal_string x))) + Field.of_bigint (Bigint256.of_decimal_string x) )) end) module Var = Var @@ -54,7 +54,7 @@ let lagrange : int -> _ Kimchi_types.poly_comm array = { Kimchi_types.unshifted = Array.map unshifted ~f:(fun (x, y) -> Kimchi_types.Finite (x, y)) ; shifted = None - })) + } ) ) let with_lagrange f (vk : Verification_key.t) = f (lagrange vk.domain.log_size_of_group) vk @@ -122,7 +122,7 @@ module Proof = Plonk_dlog_proof.Make (struct for row = 0 to num_rows - 1 do Field.Vector.emplace_back witness computed_witness.(col).(row) done ; - witness) + witness ) in create pk.index witness_cols prev_chals prev_comms @@ -130,7 +130,7 @@ module Proof = Plonk_dlog_proof.Make (struct create_aux pk primary auxiliary prev_chals prev_comms ~f:(fun pk auxiliary_input prev_challenges prev_sgs -> Promise.run_in_thread (fun () -> - create pk auxiliary_input prev_challenges prev_sgs)) + create pk auxiliary_input prev_challenges prev_sgs ) ) let create (pk : Keypair.t) primary auxiliary prev_chals prev_comms = create_aux pk primary auxiliary prev_chals prev_comms ~f:create @@ -154,15 +154,16 @@ end) module Proving_key = struct type t = Keypair.t - include Core_kernel.Binable.Of_binable - (Core_kernel.Unit) - (struct - type nonrec t = t + include + Core_kernel.Binable.Of_binable + (Core_kernel.Unit) + (struct + type nonrec t = t - let to_binable _ = () + let to_binable _ = () - let of_binable () = failwith "TODO" - end) + let of_binable () = failwith "TODO" + end) let is_initialized _ = `Yes diff --git a/src/lib/crypto/kimchi_backend/tests.ml b/src/lib/crypto/kimchi_backend/tests.ml index 9574b80e5f9..48d7bade721 100644 --- a/src/lib/crypto/kimchi_backend/tests.ml +++ b/src/lib/crypto/kimchi_backend/tests.ml @@ -5,12 +5,12 @@ module Setup_test (Backend : Snarky_backendless.Backend_intf.S) = struct let main x () = let y = exists Field.typ ~compute:(fun () -> - Field.Constant.sqrt (As_prover.read_var x)) + Field.Constant.sqrt (As_prover.read_var x) ) in assert_r1cs y y x ; let z = exists Field.typ ~compute:(fun () -> - Field.Constant.square (As_prover.read_var x)) + Field.Constant.square (As_prover.read_var x) ) in assert_r1cs x x z end diff --git a/src/lib/crypto/kimchi_bindings/js/test/bindings_js_test.ml b/src/lib/crypto/kimchi_bindings/js/test/bindings_js_test.ml index 97741e5721e..ab2fc277e0f 100644 --- a/src/lib/crypto/kimchi_bindings/js/test/bindings_js_test.ml +++ b/src/lib/crypto/kimchi_bindings/js/test/bindings_js_test.ml @@ -15,7 +15,7 @@ module Pasta_fp_verifier_index = Protocol.VerifierIndex.Fp module Pasta_fq_verifier_index = Protocol.VerifierIndex.Fq (* NOTE: For nodejs, we need to manually add the following line to the javascript bindings, after imports['env'] has been declared. -imports['env']['memory'] = new WebAssembly.Memory({initial: 18, maximum: 16384, shared: true}); + imports['env']['memory'] = new WebAssembly.Memory({initial: 18, maximum: 16384, shared: true}); *) type a = { a : int; b : bool; c : int option option } @@ -71,7 +71,7 @@ let _ = method bytesOfJsString x = Js.to_string x |> Bytes.of_string method bytesToJsString x = Bytes.to_string x |> Js.string - end) + end ) let _ = let open Bigint_256 in @@ -100,7 +100,7 @@ let _ = method ofBytes x = of_bytes x method deepCopy x = deep_copy x - end) + end ) let _ = let open Pasta_fp in @@ -165,7 +165,7 @@ let _ = method ofBytes x = of_bytes x method deepCopy x = deep_copy x - end) + end ) let _ = let open Pasta_fq in @@ -230,7 +230,7 @@ let _ = method ofBytes x = of_bytes x method deepCopy x = deep_copy x - end) + end ) let _ = let open Bigint_256 in @@ -258,7 +258,7 @@ let _ = let ten_bytes = to_bytes ten in assert (compare (of_bytes ten_bytes) ten = 0) ; assert (compare (deep_copy six) six = 0) - end) + end ) let _ = let open Pasta_fp in @@ -271,8 +271,7 @@ let _ = assert ( String.equal (Bigint_256.to_string size) - "28948022309329048855892746252171976963363056481941560715954676764349967630337" - ) ; + "28948022309329048855892746252171976963363056481941560715954676764349967630337" ) ; let one = of_int 1 in let two = of_string "2" in let rand1 = random () in @@ -317,7 +316,7 @@ let _ = let gen = domain_generator 2 in assert (equal (of_bytes (to_bytes gen)) gen) ; assert (equal (deep_copy rand2) rand2) - end) + end ) let _ = let open Pasta_fq in @@ -330,8 +329,7 @@ let _ = assert ( String.equal (Bigint_256.to_string size) - "28948022309329048855892746252171976963363056481941647379679742748393362948097" - ) ; + "28948022309329048855892746252171976963363056481941647379679742748393362948097" ) ; let one = of_int 1 in let two = of_string "2" in let rand1 = random () in @@ -376,7 +374,7 @@ let _ = let gen = domain_generator 2 in assert (equal (of_bytes (to_bytes gen)) gen) ; assert (equal (deep_copy rand2) rand2) - end) + end ) let _ = let open Pasta_fp_vector in @@ -404,7 +402,7 @@ let _ = assert (Pasta_fp.equal (Pasta_fp.of_int 10) (get first 1)) ; assert (Pasta_fp.equal (Pasta_fp.of_int 30) (get first 2)) ; assert (Pasta_fp.equal (Pasta_fp.of_int 1) (get second 0)) - end) + end ) let _ = let open Pasta_fq_vector in @@ -432,7 +430,7 @@ let _ = assert (Pasta_fq.equal (Pasta_fq.of_int 10) (get first 1)) ; assert (Pasta_fq.equal (Pasta_fq.of_int 30) (get first 2)) ; assert (Pasta_fq.equal (Pasta_fq.of_int 1) (get second 0)) - end) + end ) let eq_affine ~field_equal x y = match (x, y) with @@ -506,14 +504,12 @@ let _ = assert ( String.equal (Pasta_fp.to_string endo_base) - "20444556541222657078399132219657928148671392403212669005631716460534733845831" - ) ; + "20444556541222657078399132219657928148671392403212669005631716460534733845831" ) ; let endo_scalar = endo_scalar () in assert ( String.equal (Pasta_fq.to_string endo_scalar) - "26005156700822196841419187675678338661165322343552424574062261873906994770353" - ) ; + "26005156700822196841419187675678338661165322343552424574062261873906994770353" ) ; let one_copied = deep_copy affine_one in assert (eq affine_one one_copied) ; let infinity_copied = deep_copy affine_infinity in @@ -521,7 +517,7 @@ let _ = assert (eq affine_infinity Infinity) ; let infinity_copied_ = deep_copy Infinity in assert (eq infinity_copied_ Infinity) - end) + end ) let _ = let open Pasta_vesta in @@ -586,14 +582,12 @@ let _ = assert ( String.equal (Pasta_fq.to_string endo_base) - "2942865608506852014473558576493638302197734138389222805617480874486368177743" - ) ; + "2942865608506852014473558576493638302197734138389222805617480874486368177743" ) ; let endo_scalar = endo_scalar () in assert ( String.equal (Pasta_fp.to_string endo_scalar) - "8503465768106391777493614032514048814691664078728891710322960303815233784505" - ) ; + "8503465768106391777493614032514048814691664078728891710322960303815233784505" ) ; let one_copied = deep_copy affine_one in assert (eq affine_one one_copied) ; let infinity_copied = deep_copy affine_infinity in @@ -601,7 +595,7 @@ let _ = assert (eq affine_infinity Infinity) ; let infinity_copied_ = deep_copy Foundations.Infinity in assert (eq infinity_copied_ Infinity) - end) + end ) let eq_poly_comm ~field_equal (x : _ Protocol.poly_comm) (y : _ Protocol.poly_comm) = @@ -628,7 +622,7 @@ let _ = let stop = new%js Js_of_ocaml.Js.date_now in log (Core_kernel.ksprintf Js.string "%s: %f seconds" label - ((stop##getTime -. start##getTime) /. 1000.)) ; + ((stop##getTime -. start##getTime) /. 1000.) ) ; x in let open Impl in @@ -642,11 +636,11 @@ let _ = let input = Data_spec.[ Typ.field ] in let _pk = time "generate_keypair" (fun () -> - constraint_system ~exposing:input main |> Backend.Keypair.create) + constraint_system ~exposing:input main |> Backend.Keypair.create ) in let pk = time "generate_keypair2" (fun () -> - constraint_system ~exposing:input main |> Backend.Keypair.create) + constraint_system ~exposing:input main |> Backend.Keypair.create ) in let x = Backend.Field.of_int 2 in let pi = @@ -655,14 +649,14 @@ let _ = ~f:(fun { Proof_inputs.auxiliary_inputs; public_inputs } -> time "create proof" (fun () -> Backend.Proof.create pk ~auxiliary:auxiliary_inputs - ~primary:public_inputs)) - () x) + ~primary:public_inputs ) ) + () x ) in let vk = Backend.Keypair.vk pk in let vec = Backend.Field.Vector.create () in Backend.Field.Vector.emplace_back vec x ; assert (time "verify proof" (fun () -> Backend.Proof.verify pi vk vec)) - end) + end ) let _ = let open Pasta_fp_urs in @@ -676,7 +670,7 @@ let _ = let log x = (Js.Unsafe.js_expr "console.log" : _ -> unit) x in log (Core_kernel.ksprintf Js.string "%s: %f seconds" label - ((stop##getTime -. start##getTime) /. 1000.)) ; + ((stop##getTime -. start##getTime) /. 1000.) ) ; x in let n = 131072 in @@ -690,7 +684,7 @@ let _ = let xs = Array.init log_n (fun _ -> Pasta_fp.random ()) in time "b_poly" (fun () -> b_poly_commitment urs xs) in - ()) ; + () ) ; let eq_affine x y = eq_affine ~field_equal:Pasta_fq.equal x y in let eq = eq_poly_comm ~field_equal:Pasta_fq.equal in let first = create 10 in @@ -706,7 +700,7 @@ let _ = let affines = Array.init 16 (fun i -> try lcomm1.unshifted.(i) - with _ -> Pasta_vesta.random () |> Pasta_vesta.to_affine) + with _ -> Pasta_vesta.random () |> Pasta_vesta.to_affine ) in let res = batch_accumulator_check second affines inputs2 in assert (res || not res) ; @@ -716,7 +710,7 @@ let _ = let h_second_again = Pasta_vesta.deep_copy h_second in assert (eq_affine h_first h_first_again) ; assert (eq_affine h_second h_second_again) - end) + end ) let _ = let open Pasta_fq_urs in @@ -738,7 +732,7 @@ let _ = let affines = Array.init 16 (fun i -> try lcomm1.unshifted.(i) - with _ -> Pasta_pallas.random () |> Pasta_pallas.to_affine) + with _ -> Pasta_pallas.random () |> Pasta_pallas.to_affine ) in let res = batch_accumulator_check second affines inputs2 in assert (res || not res) ; @@ -748,7 +742,7 @@ let _ = let h_second_again = Pasta_pallas.deep_copy h_second in assert (eq_affine h_first h_first_again) ; assert (eq_affine h_second h_second_again) - end) + end ) let mk_wires typ i (r1, c1) (r2, c2) (r3, c3) coeffs : _ Protocol.circuit_gate = { typ @@ -848,7 +842,7 @@ let _ = (mk_wires Zero 0 (0, 1) (0, 1) (0, 0) zero.coeffs) in test_vec vec1 ; test_vec vec2 - end) + end ) let _ = let open Protocol.Gates.Vector.Fq in @@ -912,15 +906,13 @@ let _ = let l, r, o, _, _, _, _ = zero.wires in wrap vec l r ; assert ( - eq (get vec 0) (mk_wires Zero 0 (0, 1) (0, 1) (0, 2) zero.coeffs) - ) ; + eq (get vec 0) (mk_wires Zero 0 (0, 1) (0, 1) (0, 2) zero.coeffs) ) ; wrap vec o l ; assert ( - eq (get vec 0) (mk_wires Zero 0 (0, 1) (0, 1) (0, 0) zero.coeffs) - ) + eq (get vec 0) (mk_wires Zero 0 (0, 1) (0, 1) (0, 0) zero.coeffs) ) in test_vec vec1 ; test_vec vec2 - end) + end ) let _ = let open Pasta_fp_index in @@ -964,7 +956,7 @@ let _ = assert (domain_d4_size index2 = 64) ; assert (domain_d8_size index0 = 128) ; assert (domain_d8_size index2 = 128) - end) + end ) let _ = let open Pasta_fq_index in @@ -1036,7 +1028,7 @@ let _ = assert (domain_d4_size index2 = 64) ; assert (domain_d8_size index0 = 128) ; assert (domain_d8_size index2 = 128) - end) + end ) let eq_verification_shifts ~field_equal l r = Array.for_all2 field_equal l r @@ -1131,7 +1123,7 @@ let _ = List.iter (fun x -> assert (eq (deep_copy x) x)) [ vindex0_0; vindex2_0; dummy0 ] - end) + end ) let _ = let open Pasta_fq_verifier_index in @@ -1181,6 +1173,6 @@ let _ = List.iter (fun x -> assert (eq (deep_copy x) x)) [ vindex0_0; vindex2_0; dummy0 ] - end) + end ) let linkme = () diff --git a/src/lib/crypto_params/gen/gen.ml b/src/lib/crypto_params/gen/gen.ml index 0a37652dc59..433dfaf7fa2 100644 --- a/src/lib/crypto_params/gen/gen.ml +++ b/src/lib/crypto_params/gen/gen.ml @@ -33,7 +33,8 @@ let group_map_params_structure ~loc = Core_kernel.Binable.of_string (module T) [%e - estring (Core_kernel.Binable.to_string (module T) group_map_params)])] + estring (Core_kernel.Binable.to_string (module T) group_map_params)] + )] let generate_ml_file filename structure = let fmt = Format.formatter_of_out_channel (Out_channel.create filename) in diff --git a/src/lib/currency/currency.ml b/src/lib/currency/currency.ml index d7b39fe6483..76c17e22825 100644 --- a/src/lib/currency/currency.ml +++ b/src/lib/currency/currency.ml @@ -193,7 +193,7 @@ end = struct Pickles.Scalar_challenge.to_field_checked' ~num_bits:length_in_bits m (Kimchi_backend_common.Scalar_challenge.create t) in - actual_packed) + actual_packed ) (** [range_check t] asserts that [0 <= t < 2^length_in_bits]. @@ -413,7 +413,7 @@ end = struct let gen = Quickcheck.Generator.map2 gen Sgn.gen ~f:(fun magnitude sgn -> if Unsigned.(equal zero magnitude) then zero - else create ~magnitude ~sgn) + else create ~magnitude ~sgn ) let sgn_to_bool = function Sgn.Pos -> true | Neg -> false @@ -542,7 +542,7 @@ end = struct { value = Option.map t.value ~f:Field.Var.negate ; repr = (let { magnitude; sgn } = t.repr in - { magnitude; sgn = Sgn.Checked.negate sgn }) + { magnitude; sgn = Sgn.Checked.negate sgn } ) } let if_repr cond ~then_ ~else_ = @@ -745,7 +745,7 @@ end = struct if Unsigned.equal i Unsigned.zero then None else let n = Unsigned.div i (Unsigned.of_int 10) in - Some (n, n))) + Some (n, n) ) ) (* TODO: When we do something to make snarks run fast for tests, increase the trials *) let qc_test_fast = Quickcheck.test ~trials:100 @@ -760,7 +760,7 @@ end = struct qc_test_fast generator ~f:(fun (lo, hi) -> expect_success (sprintf !"subtraction: lo=%{Unsigned} hi=%{Unsigned}" lo hi) - (var_of_t lo - var_of_t hi)) + (var_of_t lo - var_of_t hi) ) let%test_unit "subtraction_soundness" = let generator = @@ -772,7 +772,7 @@ end = struct qc_test_fast generator ~f:(fun (lo, hi) -> expect_failure (sprintf !"underflow: lo=%{Unsigned} hi=%{Unsigned}" lo hi) - (var_of_t lo - var_of_t hi)) + (var_of_t lo - var_of_t hi) ) let%test_unit "addition_completeness" = let generator = @@ -784,7 +784,7 @@ end = struct qc_test_fast generator ~f:(fun (x, y) -> expect_success (sprintf !"overflow: x=%{Unsigned} y=%{Unsigned}" x y) - (var_of_t x + var_of_t y)) + (var_of_t x + var_of_t y) ) let%test_unit "addition_soundness" = let generator = @@ -798,7 +798,7 @@ end = struct qc_test_fast generator ~f:(fun (x, y) -> expect_failure (sprintf !"overflow: x=%{Unsigned} y=%{Unsigned}" x y) - (var_of_t x + var_of_t y)) + (var_of_t x + var_of_t y) ) let%test_unit "formatting_roundtrip" = let generator = gen_incl Unsigned.zero Unsigned.max_int in @@ -813,14 +813,14 @@ end = struct (sprintf !"formatting: num=%{Unsigned} middle=%{String} \ after=%{Unsigned}" - num (to_formatted_string num) after_format))) + num (to_formatted_string num) after_format ) )) | exception e -> let err = Error.of_exn e in Error.( raise (tag ~tag:(sprintf !"formatting: num=%{Unsigned}" num) - err))) + err )) ) let%test_unit "formatting_trailing_zeros" = let generator = gen_incl Unsigned.zero Unsigned.max_int in @@ -834,7 +834,7 @@ end = struct (of_string (sprintf !"formatting: num=%{Unsigned} formatted=%{String}" - num (to_formatted_string num))))) + num (to_formatted_string num) ) )) ) end ) end @@ -1134,7 +1134,7 @@ let%test_module "sub_flagged module" = let m, u = sub_flagged_unchecked p in let m_checked, u_checked = sub_flagged_checked p in assert (Bool.equal u u_checked) ; - if not u then [%test_eq: M.magnitude] m m_checked) + if not u then [%test_eq: M.magnitude] m m_checked ) let%test_unit "fee sub_flagged" = run_test (module Fee) diff --git a/src/lib/daemon_rpcs/client.ml b/src/lib/daemon_rpcs/client.ml index c445932fbd6..218a2983a0c 100644 --- a/src/lib/daemon_rpcs/client.ml +++ b/src/lib/daemon_rpcs/client.ml @@ -19,11 +19,11 @@ let dispatch rpc query (host_and_port : Host_and_port.t) = (Rpc.Connection.Heartbeat_config.create ~timeout: (Time_ns.Span.of_sec - Mina_compile_config.rpc_heartbeat_timeout_sec) + Mina_compile_config.rpc_heartbeat_timeout_sec ) ~send_every: (Time_ns.Span.of_sec - Mina_compile_config.rpc_heartbeat_send_every_sec) - ()) + Mina_compile_config.rpc_heartbeat_send_every_sec ) + () ) r w ~connection_state:(fun _ -> ()) with @@ -32,9 +32,9 @@ let dispatch rpc query (host_and_port : Host_and_port.t) = (Or_error.errorf !"Error connecting to the daemon on %{sexp:Host_and_port.t} \ using the RPC call, %s,: %s" - host_and_port (Rpc.Rpc.name rpc) (Exn.to_string exn)) + host_and_port (Rpc.Rpc.name rpc) (Exn.to_string exn) ) | Ok conn -> - Rpc.Rpc.dispatch rpc conn query)) + Rpc.Rpc.dispatch rpc conn query ) ) let dispatch_join_errors rpc query port = let open Deferred.Let_syntax in diff --git a/src/lib/daemon_rpcs/types.ml b/src/lib/daemon_rpcs/types.ml index 124031de49f..5dca7f13d0e 100644 --- a/src/lib/daemon_rpcs/types.ml +++ b/src/lib/daemon_rpcs/types.ml @@ -30,7 +30,7 @@ module Status = struct let padding = String.init (max_key_length - String.length s) ~f:(fun _ -> ' ') in - sprintf "%s: %s %s" s padding x) + sprintf "%s: %s %s" s padding x ) |> String.concat ~sep:"\n" in title ^ "\n" ^ output ^ "\n" @@ -47,13 +47,13 @@ module Status = struct List.map best ~f:(fun (v, (lo, hi)) -> Printf.sprintf !"(%{sexp: Time.Span.t}, %{sexp: Time.Span.t}): %d" - lo hi v) + lo hi v ) in let total = List.sum (module Int) values ~f:Fn.id in List.fold msgs ~init: (Printf.sprintf "\n\tTotal: %d (overflow:%d) (underflow:%d)\n\t" total - overflow underflow) ~f:(fun acc x -> acc ^ "\n\t" ^ x) + overflow underflow ) ~f:(fun acc x -> acc ^ "\n\t" ^ x) ^ "\n\t..." module Rpc_timings = struct @@ -91,14 +91,14 @@ module Status = struct let f x = Field.get x s in Fields.fold ~init:[] ~get_staged_ledger_aux:(fun acc x -> - add_rpcs ~name:"Get Staged Ledger Aux" (f x) acc) + add_rpcs ~name:"Get Staged Ledger Aux" (f x) acc ) ~answer_sync_ledger_query:(fun acc x -> - add_rpcs ~name:"Answer Sync Ledger Query" (f x) acc) + add_rpcs ~name:"Answer Sync Ledger Query" (f x) acc ) ~get_ancestry:(fun acc x -> add_rpcs ~name:"Get Ancestry" (f x) acc) ~get_transition_chain_proof:(fun acc x -> - add_rpcs ~name:"Get transition chain proof" (f x) acc) + add_rpcs ~name:"Get transition chain proof" (f x) acc ) ~get_transition_chain:(fun acc x -> - add_rpcs ~name:"Get transition chain" (f x) acc) + add_rpcs ~name:"Get transition chain" (f x) acc ) |> List.rev in digest_entries ~title:"RPCs" entries @@ -120,13 +120,13 @@ module Status = struct let f x = Field.get x s in Fields.fold ~init:[] ~rpc_timings:(fun acc x -> - ("RPC Timings", Rpc_timings.to_text (f x)) :: acc) + ("RPC Timings", Rpc_timings.to_text (f x)) :: acc ) ~external_transition_latency:(fun acc x -> match f x with | None -> acc | Some report -> - ("Block Latencies (hist.)", summarize_report report) :: acc) + ("Block Latencies (hist.)", summarize_report report) :: acc ) ~accepted_transition_local_latency:(fun acc x -> match f x with | None -> @@ -134,7 +134,7 @@ module Status = struct | Some report -> ( "Accepted local block Latencies (hist.)" , summarize_report report ) - :: acc) + :: acc ) ~accepted_transition_remote_latency:(fun acc x -> match f x with | None -> @@ -142,19 +142,20 @@ module Status = struct | Some report -> ( "Accepted remote block Latencies (hist.)" , summarize_report report ) - :: acc) + :: acc ) ~snark_worker_transition_time:(fun acc x -> match f x with | None -> acc | Some report -> - ("Snark Worker a->b (hist.)", summarize_report report) :: acc) + ("Snark Worker a->b (hist.)", summarize_report report) :: acc ) ~snark_worker_merge_time:(fun acc x -> match f x with | None -> acc | Some report -> - ("Snark Worker Merge (hist.)", summarize_report report) :: acc) + ("Snark Worker Merge (hist.)", summarize_report report) :: acc + ) in digest_entries ~title:"Performance Histograms" entries end @@ -236,7 +237,7 @@ module Status = struct let uptime_secs = map_entry "Local uptime" ~f:(fun secs -> - Time.Span.to_string (Time.Span.of_int_sec secs)) + Time.Span.to_string (Time.Span.of_int_sec secs) ) let ledger_merkle_root = string_option_entry "Ledger Merkle root" @@ -270,7 +271,7 @@ module Status = struct | None -> "Block producer" | Some pk -> - pk) + pk ) let histograms = option_entry "Histograms" ~f:Histograms.to_text @@ -293,8 +294,7 @@ module Status = struct let slot_str (slot : Next_producer_timing.slot) = sprintf "slot: %s slot-since-genesis: %s" (Mina_numbers.Global_slot.to_string slot.slot) - (Mina_numbers.Global_slot.to_string - slot.global_slot_since_genesis) + (Mina_numbers.Global_slot.to_string slot.global_slot_since_genesis) in let generated_from = sprintf "Generated from consensus at %s" @@ -312,7 +312,7 @@ module Status = struct sprintf "%s for %s (%s)" (str time) (slot_str for_slot) generated_from | Produce_now { for_slot; _ } -> - sprintf "Now (for %s %s)" (slot_str for_slot) generated_from) + sprintf "Now (for %s %s)" (slot_str for_slot) generated_from ) let consensus_time_best_tip = option_entry "Best tip consensus time" @@ -364,7 +364,7 @@ module Status = struct | Some peer -> [ ("Libp2p PeerID", peer.peer_id) ] | None -> - []) + [] ) |> List.concat |> List.map ~f:(fun (s, v) -> ("\t" ^ s, v)) |> digest_entries ~title:"" @@ -395,7 +395,7 @@ module Status = struct | Wait_for_parent -> "Waiting for parent to finish" in - ("\t" ^ s, Int.to_string n)) + ("\t" ^ s, Int.to_string n) ) |> digest_entries ~title:"" in option_entry "Catchup status" ~f:render diff --git a/src/lib/data_hash_lib/data_hash.ml b/src/lib/data_hash_lib/data_hash.ml index 557a92bb08f..b708e16f076 100644 --- a/src/lib/data_hash_lib/data_hash.ml +++ b/src/lib/data_hash_lib/data_hash.ml @@ -57,7 +57,7 @@ struct Some (Bitstring.Lsb_first.of_list (List.init M.length_in_bits ~f:(fun i -> - Boolean.var_of_value (Bigint.test_bit n i)))) + Boolean.var_of_value (Bigint.test_bit n i) ) ) ) } open Let_syntax diff --git a/src/lib/data_hash_lib/state_hash.mli b/src/lib/data_hash_lib/state_hash.mli index 5d3fa10dfeb..a8b84e5cfaa 100644 --- a/src/lib/data_hash_lib/state_hash.mli +++ b/src/lib/data_hash_lib/state_hash.mli @@ -45,7 +45,7 @@ val deriver : ; map : (Yojson.Safe.t -> t) ref ; nullable_graphql_arg : ( unit - -> Yojson.Safe.t option Fields_derivers_graphql.Schema.Arg.arg_typ) + -> Yojson.Safe.t option Fields_derivers_graphql.Schema.Arg.arg_typ ) ref ; nullable_graphql_fields : Yojson.Safe.t option Fields_derivers_zkapps.Graphql.Fields.Input.T.t @@ -54,7 +54,7 @@ val deriver : ; to_json : (Yojson.Safe.t -> Yojson.Safe.t) ref ; .. > as - 'a) + 'a ) Fields_derivers_zkapps.Unified_input.t Fields_derivers_zkapps.Unified_input.t Fields_derivers_zkapps.Unified_input.t diff --git a/src/lib/direction/direction.ml b/src/lib/direction/direction.ml index 534a2dafb5b..5421ab40f2d 100644 --- a/src/lib/direction/direction.ml +++ b/src/lib/direction/direction.ml @@ -33,4 +33,4 @@ let shrinker = | Left -> None | Right -> - Some (Left, Left))) + Some (Left, Left) ) ) diff --git a/src/lib/distributed_dsl/distributed_dsl.ml b/src/lib/distributed_dsl/distributed_dsl.ml index 5715ab7be57..6e3ab56d1c3 100644 --- a/src/lib/distributed_dsl/distributed_dsl.ml +++ b/src/lib/distributed_dsl/distributed_dsl.ml @@ -28,7 +28,7 @@ module Time_queue = struct let handle_in_future t ~after action = Option.iter t.on_new_action ~f:(fun ivar -> Ivar.fill_if_empty ivar () ; - t.on_new_action <- None) ; + t.on_new_action <- None ) ; Pairing_heap.add t.pending_actions (action, Time.Span.(after + t.curr_time)) let create ~now = @@ -82,7 +82,7 @@ module Time_queue = struct let%test_unit "time_queue_empty_returns" = Async.Thread_safe.block_on_async_exn (fun () -> let t = create ~now:Time.Span.zero in - tick_forwards t ~f:(fun _ -> return (assert false))) + tick_forwards t ~f:(fun _ -> return (assert false)) ) let%test_unit "time_queue_handles_in_order" = Async.Thread_safe.block_on_async_exn (fun () -> @@ -91,7 +91,7 @@ module Time_queue = struct let%map () = tick_forwards t ~f:(fun next -> Char.Table.add_exn table ~key:next ~data:() ; - return ()) + return () ) in if Char.Table.length table <> List.length actions then failwithf @@ -109,7 +109,7 @@ module Time_queue = struct handle_in_future t ~after:(Time.Span.of_int_sec 10) 'c' ; handle_in_future t ~after:(Time.Span.of_int_sec 10) 'd' ; let%bind () = tick_assert_sees t [ 'c'; 'd' ] in - tick_assert_sees t [ 'a' ]) + tick_assert_sees t [ 'a' ] ) end module type Temporal_intf = sig @@ -189,7 +189,7 @@ struct () | Some (r, w) -> Linear_pipe.write_or_exn ~capacity:1024 w r m ; - Linear_pipe.values_available r >>| Fn.const () )) + Linear_pipe.values_available r >>| Fn.const () ) ) let wait t ts = let tok = Ident.next () in @@ -213,7 +213,7 @@ struct return (Or_error.error_string (Printf.sprintf "Unknown recipient %s" - (Peer.sexp_of_t recipient |> Sexp.to_string_hum))) + (Peer.sexp_of_t recipient |> Sexp.to_string_hum) ) ) | Some (_r, _w) -> Time_queue.handle_in_future t.q ~after:(Message_delay.delay message) @@ -351,7 +351,7 @@ struct | Delete ident -> Identifier.Table.remove t.nodes ident | Add n -> - Identifier.Table.add_exn t.nodes ~key:(MyNode.ident n) ~data:n) + Identifier.Table.add_exn t.nodes ~key:(MyNode.ident n) ~data:n ) let rec loop t ~stop ~max_iters = match max_iters with @@ -395,7 +395,7 @@ struct let any_ready : MyNode.t Deferred.t = Deferred.any (List.map (Identifier.Table.data t.nodes) ~f:(fun n -> - MyNode.next_ready n >>| Fn.const n)) + MyNode.next_ready n >>| Fn.const n ) ) in any_ready >>| fun n -> @@ -408,7 +408,7 @@ struct | None, x when MyNode.is_ready x -> Some x | None, _ -> - acc) + acc ) in Option.value maybe_real ~default:n in @@ -445,16 +445,16 @@ struct let messages = Timer_transport.listen timer ~me:i in let msg_commands, handle_commands = cmds_per_node i in MyNode.make_node ~logger:(Logger.create ()) ~transport:timer ~me:i - ~messages ~initial_state ~timer msg_commands handle_commands) + ~messages ~initial_state ~timer msg_commands handle_commands ) in (* Schedule cleanup *) don't_wait_for (let%map () = stop in List.iter nodes ~f:(fun n -> - Timer_transport.stop_listening timer ~me:(MyNode.ident n))) ; + Timer_transport.stop_listening timer ~me:(MyNode.ident n) ) ) ; (* Fill table *) List.iter nodes ~f:(fun n -> - Identifier.Table.add_exn table ~key:(MyNode.ident n) ~data:n) ; + Identifier.Table.add_exn table ~key:(MyNode.ident n) ~data:n ) ; { nodes = table; timer } end @@ -466,7 +466,7 @@ let%test_module "Distributed_dsl" = | `Success -> () | `Failure s -> - failwith s) + failwith s ) module State = struct type t = Start | Wait_msg | Sent_msg | Got_msg of int | Timeout @@ -542,16 +542,20 @@ let%test_module "Distributed_dsl" = (List.init (count - 1) ~f:(fun i -> i + 1)) (Msg 10) in - Sent_msg) ; - return Wait_msg) + Sent_msg ) ; + return Wait_msg ) ] ) in let specRest = let open Machine.MyNode in ( [ msg Send_msg (Fn.const (Fn.const true)) - ~f:(fun _t (Msg i) -> function Wait_msg -> return (Got_msg i) - | m -> return m) + ~f: + (fun _t (Msg i) -> function + | Wait_msg -> + return (Got_msg i) + | m -> + return m ) ] , [ on Init (function Start -> true | _ -> false) @@ -561,8 +565,8 @@ let%test_module "Distributed_dsl" = ~f:(fun t state -> timeout' t Timeout_message (Time.Span.of_sec 20.) ~f:(fun _t -> function - | Got_msg _ as m -> return m | _ -> return Timeout) ; - return state) + | Got_msg _ as m -> return m | _ -> return Timeout ) ; + return state ) ; on Failure_case (function | Timeout -> @@ -570,17 +574,17 @@ let%test_module "Distributed_dsl" = | Got_msg i when i <= 5 -> true | _ -> - false) + false ) ~f:(fun _ _ -> failwith "All nodes should have received a message containing a \ - number more than five") + number more than five" ) ; on Bigger_than_five (function Got_msg i -> i > 5 | _ -> false) ~f:(fun t state -> cancel t Timeout_message ; Ivar.fill_if_empty finish_ivar `Success ; - return state) + return state ) ] ) in let machine = @@ -593,5 +597,5 @@ let%test_module "Distributed_dsl" = ~max_iters:(Some 10000) in Ivar.fill_if_empty finish_ivar - (`Failure "Stopped looping without getting to success state"))) + (`Failure "Stopped looping without getting to success state") ) ) end ) diff --git a/src/lib/distributed_dsl/node.ml b/src/lib/distributed_dsl/node.ml index 7c9031367e4..5b9c8a2714b 100644 --- a/src/lib/distributed_dsl/node.ml +++ b/src/lib/distributed_dsl/node.ml @@ -222,7 +222,7 @@ struct | None -> `Fst tok' | Some tok -> - if Timer.equal_tok tok tok' then `Fst tok' else `Snd tok') + if Timer.equal_tok tok tok' then `Fst tok' else `Snd tok' ) in List.iter to_cancel ~f:(fun tok' -> Timer.cancel t.timer tok') ; add_back_timers t ~key:label ~data:to_put_back @@ -277,7 +277,7 @@ struct (Condition_label.sexp_of_label l |> Sexp.to_string_hum) () | `Ok -> - ()) ; + () ) ; let message_handlers = Message_label.Table.create () in List.iter message_conditions ~f:(fun (l, c, h) -> match Message_label.Table.add message_handlers ~key:l ~data:(c, h) with @@ -286,7 +286,7 @@ struct (Message_label.sexp_of_label l |> Sexp.to_string_hum) () | `Ok -> - ()) ; + () ) ; let timers = Timer_label.Table.create () in let triggered_timers_r, triggered_timers_w = Linear_pipe.create () in let t = @@ -395,8 +395,7 @@ struct Error.tag e ~tag:"Send failed" |> Error.raise let send_multi t ~recipients msg = - Deferred.List.all - (List.map recipients ~f:(fun r -> send t ~recipient:r msg)) + Deferred.List.all (List.map recipients ~f:(fun r -> send t ~recipient:r msg)) let send_multi_exn t ~recipients msg = Deferred.List.all diff --git a/src/lib/downloader/downloader.ml b/src/lib/downloader/downloader.ml index d530c80eb1f..08d84589715 100644 --- a/src/lib/downloader/downloader.ml +++ b/src/lib/downloader/downloader.ml @@ -117,7 +117,7 @@ end = struct ; ( "attempts" , `Assoc (List.map (Map.to_alist attempts) ~f:(fun (p, a) -> - (Peer.to_multiaddr_string p, Attempt.to_yojson a))) ) + (Peer.to_multiaddr_string p, Attempt.to_yojson a) ) ) ) ] let result = Job.result @@ -137,7 +137,7 @@ end = struct let dequeue t = Option.map (Doubly_linked.remove_first t.queue) ~f:(fun { key; value } -> - Hashtbl.remove t.table key ; value) + Hashtbl.remove t.table key ; value ) let enqueue t (e : _ J.t) = if Hashtbl.mem t.table e.key then `Key_already_present @@ -146,7 +146,7 @@ end = struct let elt = match Doubly_linked.find_elt t.queue ~f:(fun { value; _ } -> - Key.compare e.key value.J.key < 0) + Key.compare e.key value.J.key < 0 ) with | None -> (* e is >= everything. Put it at the back. *) @@ -159,7 +159,7 @@ end = struct let lookup t k = Option.map (Hashtbl.find t.table k) ~f:(fun x -> - (Doubly_linked.Elt.value x).value) + (Doubly_linked.Elt.value x).value ) let remove t k = match Hashtbl.find_and_remove t.table k with @@ -235,7 +235,7 @@ end = struct let add t (p, time) = Option.iter (Hashtbl.find t.table p) ~f:(fun elt -> - Pairing_heap.remove t.heap elt) ; + Pairing_heap.remove t.heap elt ) ; Hashtbl.set t.table ~key:p ~data:(Pairing_heap.add_removable t.heap (p, time)) @@ -270,7 +270,7 @@ end = struct , Strict_pipe.drop_head Strict_pipe.buffered , unit ) Strict_pipe.Writer.t - [@sexp.opaque]) + [@sexp.opaque] ) } [@@deriving sexp_of] @@ -279,10 +279,10 @@ end = struct Preferred_heap.clear t.all_preferred ; Hashtbl.filter_mapi_inplace t.knowledge ~f:(fun ~key:p ~data:k -> Hash_set.clear k.tried_and_failed ; - if Set.mem all_peers p then Some { k with claimed = None } else None) ; + if Set.mem all_peers p then Some { k with claimed = None } else None ) ; Set.iter all_peers ~f:(fun p -> if not (Hashtbl.mem t.knowledge p) then - Hashtbl.add_exn t.knowledge ~key:p ~data:(Knowledge.create ())) ; + Hashtbl.add_exn t.knowledge ~key:p ~data:(Knowledge.create ()) ) ; Strict_pipe.Writer.write t.w () let to_yojson @@ -302,11 +302,11 @@ end = struct [ ( "all" , `Assoc (List.map (Hashtbl.to_alist knowledge) ~f:(fun (p, s) -> - (Peer.to_multiaddr_string p, f s))) ) + (Peer.to_multiaddr_string p, f s) ) ) ) ; ( "preferred" , `List (List.map (Preferred_heap.to_list all_preferred) ~f:(fun p -> - `String (Peer.to_multiaddr_string p))) ) + `String (Peer.to_multiaddr_string p) ) ) ) ; ( "temporary_ignores" , list (List.map ~f:Peer.to_yojson (Hashtbl.keys temporary_ignores)) ) @@ -317,14 +317,14 @@ end = struct ; ( "knowledge_requesting_peers" , list (List.map ~f:Peer.to_yojson - (Hash_set.to_list knowledge_requesting_peers)) ) + (Hash_set.to_list knowledge_requesting_peers) ) ) ] let create ~preferred ~all_peers = let knowledge = Peer.Table.of_alist_exn (List.map (List.dedup_and_sort ~compare:Peer.compare all_peers) - ~f:(fun p -> (p, Knowledge.create ()))) + ~f:(fun p -> (p, Knowledge.create ())) ) in let r, w = Strict_pipe.create ~name:"useful_peers-available" ~warn_on_drop:false @@ -349,7 +349,7 @@ end = struct ; all_preferred } = Hashtbl.iter temporary_ignores ~f:(fun e -> - Clock.Event.abort_if_possible e ()) ; + Clock.Event.abort_if_possible e () ) ; Hashtbl.clear temporary_ignores ; Hash_set.clear downloading_peers ; Hash_set.clear knowledge_requesting_peers ; @@ -375,8 +375,8 @@ end = struct [ x ] | best :: _ -> let c = compare best x in - if c = 0 then x :: acc else if c < 0 then [ x ] else acc) - |> List.rev) + if c = 0 then x :: acc else if c < 0 then [ x ] else acc ) + |> List.rev ) let useful_peer t ~pending_jobs = O1trace.sync_thread "compute_downloader_useful_peers" (fun () -> @@ -387,11 +387,11 @@ end = struct | None -> acc | Some k -> - (p, k) :: acc)) + (p, k) :: acc ) ) @ Hashtbl.fold t.knowledge ~init:[] ~f:(fun ~key:p ~data:k acc -> if not (Preferred_heap.mem t.all_preferred p) then (p, k) :: acc - else acc) + else acc ) in (* Algorithm: @@ -412,7 +412,7 @@ end = struct | `Claims_to -> Some ((p, k), `Claims_to) | `No_information -> - Some ((p, k), `No_information)) + Some ((p, k), `No_information) ) |> maxes ~compare:(fun (_, c1) (_, c2) -> match (c1, c2) with | `Claims_to, `Claims_to @@ -421,7 +421,7 @@ end = struct | `Claims_to, `No_information -> 1 | `No_information, `Claims_to -> - -1) + -1 ) |> List.map ~f:fst in let ts = @@ -453,9 +453,9 @@ end = struct | `No_information -> (no_information, j :: js) in - (Field.map field acc ~f:(( + ) 1), js)) + (Field.map field acc ~f:(( + ) 1), js) ) in - ((p, List.rev js), Knowledge_summary.score summary)) + ((p, List.rev js), Knowledge_summary.score summary) ) in let useful_exists = List.exists knowledge ~f:(fun (_, s) -> Float.(s > 0.)) @@ -465,14 +465,14 @@ end = struct (List.filter knowledge ~f:(fun ((p, _), _) -> (not (Hashtbl.mem t.temporary_ignores p)) && (not (Hash_set.mem t.downloading_peers p)) - && not (Hash_set.mem t.knowledge_requesting_peers p))) + && not (Hash_set.mem t.knowledge_requesting_peers p) ) ) ~compare:(fun (_, s1) (_, s2) -> Float.compare s1 s2) in match best with | None -> if useful_exists then `Useful_but_busy else `No_peers | Some ((p, k), score) -> - if Float.(score <= 0.) then `Stalled else `Useful (p, k)) + if Float.(score <= 0.) then `Stalled else `Useful (p, k) ) type update = | Refreshed_peers of { all_peers : Peer.Set.t } @@ -494,7 +494,7 @@ end = struct let jobs_no_longer_needed t ks = Hashtbl.iter t.knowledge ~f:(fun s -> - List.iter ks ~f:(Hash_set.remove s.tried_and_failed)) + List.iter ks ~f:(Hash_set.remove s.tried_and_failed) ) let ignore_period = Time.Span.of_min 2. @@ -517,14 +517,14 @@ end = struct | Some (`Some claimed') -> `Some (List.dedup_and_sort ~compare:Key.compare - (claimed' @ claimed)) + (claimed' @ claimed) ) | Some `All -> `All | Some (`Call f) -> let s = Key.Hash_set.of_list claimed in `Call (fun key -> f key || Hash_set.mem s key) in - { k with claimed = Some claimed }) + { k with claimed = Some claimed } ) | Knowledge_request_starting peer -> Hash_set.add t.knowledge_requesting_peers peer | Knowledge { peer; claimed; active_jobs; out_of_band } -> @@ -544,7 +544,7 @@ end = struct () | Some a -> if not (Attempt.worth_retrying a) then - Hash_set.add s j.key) ; + Hash_set.add s j.key ) ; s in Hashtbl.set t.knowledge ~key:peer @@ -552,7 +552,7 @@ end = struct | Job_cancelled h -> jobs_no_longer_needed t [ h ] ; Hashtbl.iter t.knowledge ~f:(fun s -> - Hash_set.remove s.tried_and_failed h) + Hash_set.remove s.tried_and_failed h ) | Download_starting peer -> Hash_set.add t.downloading_peers peer | Download_finished (peer0, `Successful succs, `Unsuccessful unsuccs) @@ -567,11 +567,11 @@ end = struct (fun () -> Hashtbl.remove t.temporary_ignores peer0 ; if not (Strict_pipe.Writer.is_closed t.w) then - Strict_pipe.Writer.write t.w ()) - ()) + Strict_pipe.Writer.write t.w () ) + () ) else ( Hashtbl.find_and_remove t.temporary_ignores peer0 |> cancel ; - Preferred_heap.add t.all_preferred (peer0, Time.now ()) )) ; + Preferred_heap.add t.all_preferred (peer0, Time.now ()) ) ) ; Hash_set.remove t.downloading_peers peer0 ; jobs_no_longer_needed t succs ; match Hashtbl.find t.knowledge peer0 with @@ -587,7 +587,7 @@ end = struct ~data: { Knowledge.claimed = None ; tried_and_failed = Key.Hash_set.create () - })) + } ) ) let update t u : unit = update t u ; @@ -637,7 +637,7 @@ end = struct |> List.map ~f:(fun j -> j.key) |> Key.Set.of_list ; Key.Set.of_hashtbl_keys t.downloading - ]) + ] ) |> [%test_eq: int] (total_jobs t) let check_invariant_r = ref check_invariant @@ -663,8 +663,8 @@ end = struct (* <-- TODO: pretty sure this is a bug (this can infinitely delay flushes *) (fun () -> if not (Strict_pipe.Writer.is_closed t.flush_w) then - Strict_pipe.Writer.write t.flush_w ()) - ()) + Strict_pipe.Writer.write t.flush_w () ) + () ) let cancel t h = let job = @@ -708,8 +708,8 @@ end = struct (not (Set.is_empty new_peers)) && not (Strict_pipe.Writer.is_closed t.got_new_peers_w) then Strict_pipe.Writer.write t.got_new_peers_w () ; - t.all_peers <- Peer.Set.of_list peers) ; - Deferred.unit) + t.all_peers <- Peer.Set.of_list peers ) ; + Deferred.unit ) |> don't_wait_for let tear_down @@ -770,11 +770,11 @@ end = struct enqueue_exn t { x with attempts = Map.set x.attempts ~key:peer ~data:Attempt.download - }) ; + } ) ; flush_soon t in List.iter xs ~f:(fun x -> - Hashtbl.set t.downloading ~key:x.key ~data:(peer, x, Time.now ())) ; + Hashtbl.set t.downloading ~key:x.key ~data:(peer, x, Time.now ()) ) ; jobs_added t ; Useful_peers.update t.useful_peers (Download_starting peer) ; let download_deferred = t.get peer keys in @@ -788,13 +788,14 @@ end = struct let succ = List.filter_map rs ~f:(fun r -> let k = Result.key r in - if Hash_set.mem all k then Some k else None) + if Hash_set.mem all k then Some k else None ) in List.iter succ ~f:(Hash_set.remove all) ; (succ, Hash_set.to_list all) in Useful_peers.update t.useful_peers - (Download_finished (peer, `Successful succs, `Unsuccessful unsuccs))) ; + (Download_finished (peer, `Successful succs, `Unsuccessful unsuccs) + ) ) ; let%map res = Deferred.choose [ Deferred.choice download_deferred (fun x -> `Not_stopped x) @@ -839,7 +840,7 @@ end = struct ; received_at ; sender = Remote peer } - , j.attempts ))) ; + , j.attempts ) ) ) ; (* Anything left in jobs, we did not get results for :( *) Hashtbl.iter jobs ~f:(fun x -> Hashtbl.remove t.downloading x.J.key ; @@ -847,8 +848,8 @@ end = struct { x with attempts = Map.set x.attempts ~key:peer ~data:Attempt.download - }) ; - flush_soon t )) + } ) ; + flush_soon t ) ) let to_yojson t : Yojson.Safe.t = check_invariant t ; @@ -872,7 +873,7 @@ end = struct , `String (Time.Span.to_string_hum (Time.diff now start)) ) ; ("peer", `String (Peer.to_multiaddr_string p)) - ])) ) + ] ) ) ) ] let post_stall_retry_delay = Time.Span.of_min 1. @@ -944,7 +945,7 @@ end = struct let update_knowledge t peer claimed = Useful_peers.update t.useful_peers (Knowledge - { peer; claimed; active_jobs = active_jobs t; out_of_band = true }) + { peer; claimed; active_jobs = active_jobs t; out_of_band = true } ) let mark_preferred t peer ~now = Useful_peers.Preferred_heap.add t.useful_peers.all_preferred (peer, now) @@ -983,7 +984,7 @@ end = struct peers () >>= fun ps -> try Broadcast_pipe.Writer.write w ps - with Broadcast_pipe.Already_closed _ -> Deferred.unit) ; + with Broadcast_pipe.Already_closed _ -> Deferred.unit ) ; r in let rec jobs_to_download stop = @@ -999,7 +1000,7 @@ end = struct | `Eof -> return `Finished | `Ok -> - jobs_to_download stop) + jobs_to_download stop ) in let request_r, request_w = Strict_pipe.create ~name:"knowledge-requests" Strict_pipe.Synchronous @@ -1013,7 +1014,7 @@ end = struct | `Ok -> if not (Strict_pipe.Writer.is_closed request_w) then Strict_pipe.Writer.write request_w peer - else Deferred.unit) + else Deferred.unit ) in let ps : unit Ivar.t Peer.Table.t = Peer.Table.create () in Broadcast_pipe.Reader.iter peers ~f:(fun peers -> @@ -1022,13 +1023,13 @@ end = struct Hashtbl.filteri_inplace ps ~f:(fun ~key:p ~data:finished -> let keep = Hash_set.mem peers p in if not keep then Ivar.fill_if_empty finished () ; - keep) ; + keep ) ; Hash_set.iter peers ~f:(fun p -> if not (Hashtbl.mem ps p) then ( let finished = Ivar.create () in refresh_knowledge (Ivar.read finished) p ; - Hashtbl.add_exn ps ~key:p ~data:finished ))) ; - Deferred.unit) + Hashtbl.add_exn ps ~key:p ~data:finished ) ) ) ; + Deferred.unit ) |> don't_wait_for ; let throttle = Throttle.create ~continue_on_error:true ~max_concurrent_jobs:8 @@ -1043,8 +1044,8 @@ end = struct Ivar.fill_if_empty finished () ; let finished = Ivar.create () in refresh_knowledge (Ivar.read finished) p ; - finished)) ; - Deferred.unit)) ; + finished ) ) ; + Deferred.unit ) ) ; O1trace.background_thread "dispatch_downloader_requests" (fun () -> Strict_pipe.Reader.iter request_r ~f:(fun peer -> (* TODO: The pipe/clock logic is not quite right, but it is good enough. *) @@ -1063,13 +1064,13 @@ end = struct ; peer ; claimed = k ; active_jobs = active_jobs t - })))) ; + } ) ) ) ) ; O1trace.background_thread "execute_downlader_node_fstm" (fun () -> step t) ; upon stop (fun () -> tear_down t) ; every ~stop (Time.Span.of_sec 30.) (fun () -> [%log' debug t.logger] ~metadata:[ ("jobs", to_yojson t) ] - "Downloader jobs") ; + "Downloader jobs" ) ; refresh_peers t peers ; t diff --git a/src/lib/empty_hashes/empty_hashes.ml b/src/lib/empty_hashes/empty_hashes.ml index a93534c328a..810e7a04004 100644 --- a/src/lib/empty_hashes/empty_hashes.ml +++ b/src/lib/empty_hashes/empty_hashes.ml @@ -17,7 +17,7 @@ let cache hash_mod ~init_hash depth = if Int.equal i 0 then !last_hash else ( last_hash := merge_hash hash_mod (i - 1) !last_hash ; - !last_hash )) + !last_hash ) ) let extensible_cache hash_mod ~init_hash = let empty_hashes = ref [| init_hash |] in @@ -31,5 +31,5 @@ let extensible_cache hash_mod ~init_hash = Array.append prev (Array.init deficit ~f:(fun i -> last_hash := merge_hash hash_mod (i + height) !last_hash ; - !last_hash)) ) ; + !last_hash ) ) ) ; !empty_hashes.(i) diff --git a/src/lib/error_json/error_json.ml b/src/lib/error_json/error_json.ml index 83916212fed..f21f6da0525 100644 --- a/src/lib/error_json/error_json.ml +++ b/src/lib/error_json/error_json.ml @@ -19,7 +19,7 @@ let rec sexp_of_yojson (json : Yojson.Safe.t) : (Sexp.t, string) Result.t = | Ok sexp -> Continue (sexp :: sexps) | Error str -> - Stop (Error str)) + Stop (Error str) ) in Result.map ~f:(fun l -> Sexp.List (List.rev l)) rev_sexps | _ -> diff --git a/src/lib/fake_network/fake_network.ml b/src/lib/fake_network/fake_network.ml index d5a819e7b52..cf3da121243 100644 --- a/src/lib/fake_network/fake_network.ml +++ b/src/lib/fake_network/fake_network.ml @@ -90,9 +90,9 @@ let setup (type n) ~logger ?(trust_system = Trust_system.null ()) ~libp2p_port ~peer_id: (Peer.Id.unsafe_of_string - (sprintf "fake peer at port %d" libp2p_port)) + (sprintf "fake peer at port %d" libp2p_port) ) in - ((Int32.( + ) Int32.one ip, libp2p_port + 1), peer)) + ((Int32.( + ) Int32.one ip, libp2p_port + 1), peer) ) in let fake_gossip_network = Gossip_net.Fake.create_network (Vect.to_list peers) @@ -140,9 +140,9 @@ let setup (type n) ~logger ?(trust_system = Trust_system.null ()) ~get_node_status:state.get_node_status ~get_transition_knowledge:state.get_transition_knowledge ~get_transition_chain_proof:state.get_transition_chain_proof - ~get_transition_chain:state.get_transition_chain) + ~get_transition_chain:state.get_transition_chain ) in - { peer; state; network }) + { peer; state; network } ) in { fake_gossip_network; peer_networks } @@ -221,7 +221,7 @@ module Generator = struct (Error.createf !"%s for ledger_hash: %{sexp:Ledger_hash.t}" Mina_networking.refused_answer_query_string - ledger_hash)) ) + ledger_hash ) ) ) ; get_ancestry = ( match get_ancestry with | Some f -> @@ -236,7 +236,7 @@ module Generator = struct |> With_hash.map_hash ~f:(fun state_hash -> { State_hash.State_hashes.state_hash ; state_body_hash = None - }) )) ) + } ) ) ) ) ; get_best_tip = ( match get_best_tip with | Some f -> @@ -264,7 +264,7 @@ module Generator = struct fun query_env -> Deferred.return (Transition_chain_prover.prove ~frontier - (Envelope.Incoming.data query_env)) ) + (Envelope.Incoming.data query_env) ) ) ; get_transition_chain = ( match get_transition_chain with | Some f -> @@ -273,7 +273,7 @@ module Generator = struct fun query_env -> Deferred.return (Sync_handler.get_transition_chain ~frontier - (Envelope.Incoming.data query_env)) ) + (Envelope.Incoming.data query_env) ) ) } let fresh_peer_custom_rpc ?get_staged_ledger_aux_and_pending_coinbases_at_hash @@ -344,7 +344,7 @@ module Generator = struct in Async.Thread_safe.block_on_async_exn (fun () -> Deferred.List.iter branch - ~f:(Transition_frontier.add_breadcrumb_exn frontier)) ; + ~f:(Transition_frontier.add_breadcrumb_exn frontier) ) ; make_peer_state ~frontier ~consensus_local_state ~precomputed_values ~logger ?get_staged_ledger_aux_and_pending_coinbases_at_hash @@ -369,7 +369,7 @@ module Generator = struct let%map states = Vect.Quickcheck_generator.map configs ~f:(fun (config : peer_config) -> config ~logger ~precomputed_values ~verifier ~max_frontier_length - ~use_super_catchup) + ~use_super_catchup ) in setup ~precomputed_values ~logger states end diff --git a/src/lib/fake_network/fake_network.mli b/src/lib/fake_network/fake_network.mli index 730b41c76ca..03639996276 100644 --- a/src/lib/fake_network/fake_network.mli +++ b/src/lib/fake_network/fake_network.mli @@ -93,12 +93,12 @@ module Generator : sig * Pending_coinbase.t * Mina_state.Protocol_state.value list ) option - Deferred.t) + Deferred.t ) -> ?get_some_initial_peers: (unit Envelope.Incoming.t -> Peer.t list Deferred.t) -> ?answer_sync_ledger_query: ( (Pasta_bindings.Fp.t * Sync_ledger.Query.t) Envelope.Incoming.t - -> (Sync_ledger.Answer.t, Error.t) result Deferred.t) + -> (Sync_ledger.Answer.t, Error.t) result Deferred.t ) -> ?get_ancestry: ( ( Consensus.Data.Consensus_state.Value.t , Pasta_bindings.Fp.t ) @@ -108,28 +108,29 @@ module Generator : sig , State_body_hash.t list * Mina_block.t ) Proof_carrying_data.t option - Deferred.t) + Deferred.t ) -> ?get_best_tip: ( unit Envelope.Incoming.t -> ( Mina_block.t , Pasta_bindings.Fp.t list * Mina_block.t ) Proof_carrying_data.t option - Deferred.t) + Deferred.t ) -> ?get_node_status: ( unit Envelope.Incoming.t -> ( Mina_networking.Rpcs.Get_node_status.Node_status.t , Error.t ) result - Deferred.t) + Deferred.t ) -> ?get_transition_knowledge: (unit Envelope.Incoming.t -> Pasta_bindings.Fp.t list Deferred.t) -> ?get_transition_chain_proof: ( Pasta_bindings.Fp.t Envelope.Incoming.t - -> (Pasta_bindings.Fp.t * Pasta_bindings.Fp.t list) option Deferred.t) + -> (Pasta_bindings.Fp.t * Pasta_bindings.Fp.t list) option Deferred.t + ) -> ?get_transition_chain: ( Pasta_bindings.Fp.t list Envelope.Incoming.t - -> Mina_block.t list option Deferred.t) + -> Mina_block.t list option Deferred.t ) -> peer_config val fresh_peer : peer_config @@ -143,12 +144,12 @@ module Generator : sig * Pending_coinbase.t * Mina_state.Protocol_state.value list ) option - Deferred.t) + Deferred.t ) -> ?get_some_initial_peers: (unit Envelope.Incoming.t -> Peer.t list Deferred.t) -> ?answer_sync_ledger_query: ( (Pasta_bindings.Fp.t * Sync_ledger.Query.t) Envelope.Incoming.t - -> (Sync_ledger.Answer.t, Error.t) result Deferred.t) + -> (Sync_ledger.Answer.t, Error.t) result Deferred.t ) -> ?get_ancestry: ( ( Consensus.Data.Consensus_state.Value.t , Pasta_bindings.Fp.t ) @@ -158,28 +159,29 @@ module Generator : sig , State_body_hash.t list * Mina_block.t ) Proof_carrying_data.t option - Deferred.t) + Deferred.t ) -> ?get_best_tip: ( unit Envelope.Incoming.t -> ( Mina_block.t , Pasta_bindings.Fp.t list * Mina_block.t ) Proof_carrying_data.t option - Deferred.t) + Deferred.t ) -> ?get_node_status: ( unit Envelope.Incoming.t -> ( Mina_networking.Rpcs.Get_node_status.Node_status.t , Error.t ) result - Deferred.t) + Deferred.t ) -> ?get_transition_knowledge: (unit Envelope.Incoming.t -> Pasta_bindings.Fp.t list Deferred.t) -> ?get_transition_chain_proof: ( Pasta_bindings.Fp.t Envelope.Incoming.t - -> (Pasta_bindings.Fp.t * Pasta_bindings.Fp.t list) option Deferred.t) + -> (Pasta_bindings.Fp.t * Pasta_bindings.Fp.t list) option Deferred.t + ) -> ?get_transition_chain: ( Pasta_bindings.Fp.t list Envelope.Incoming.t - -> Mina_block.t list option Deferred.t) + -> Mina_block.t list option Deferred.t ) -> peer_config val peer_with_branch : frontier_branch_size:int -> peer_config diff --git a/src/lib/fields_derivers_graphql/fields_derivers_graphql.ml b/src/lib/fields_derivers_graphql/fields_derivers_graphql.ml index b84773488db..506c5e1b51d 100644 --- a/src/lib/fields_derivers_graphql/fields_derivers_graphql.ml +++ b/src/lib/fields_derivers_graphql/fields_derivers_graphql.ml @@ -78,7 +78,7 @@ module Graphql_raw = struct { graphql_arg_coerce = (fun x -> ref_as_pipe := Some x ; - !(acc#graphql_creator) acc) + !(acc#graphql_creator) acc ) ; graphql_arg_fields = [ arg ] } | Acc { graphql_arg_fields; graphql_arg_coerce } -> ( @@ -89,7 +89,7 @@ module Graphql_raw = struct { graphql_arg_coerce = (fun x -> ref_as_pipe := Some x ; - !(acc#graphql_creator) acc) + !(acc#graphql_creator) acc ) ; graphql_arg_fields = [ arg ] } | _ -> @@ -98,7 +98,7 @@ module Graphql_raw = struct { graphql_arg_coerce = (fun x -> ref_as_pipe := Some x ; - graphql_arg_coerce) + graphql_arg_coerce ) ; graphql_arg_fields = arg :: graphql_arg_fields } ) in @@ -113,7 +113,7 @@ module Graphql_raw = struct failwith "If you are skipping a field but intend on building this \ field, you must provide skip_data to add_field!" - else Option.value_exn !ref_as_pipe) + else Option.value_exn !ref_as_pipe ) , acc ) let finish name ~t_toplevel_annots (type ty result nullable) : @@ -138,7 +138,7 @@ module Graphql_raw = struct obj ?doc:annotations.doc (annotations.name ^ "Input") ~fields:graphql_arg_fields ~coerce:graphql_arg_coerce - |> non_null)) ; + |> non_null) ) ; (acc#nullable_graphql_arg := fun () -> match !(acc#graphql_arg_accumulator) with @@ -150,19 +150,20 @@ module Graphql_raw = struct @@ Schema.Arg.( obj ?doc:annotations.doc (annotations.name ^ "Input") - ~fields:graphql_arg_fields ~coerce:graphql_arg_coerce)) ; + ~fields:graphql_arg_fields ~coerce:graphql_arg_coerce) + ) ; acc let skip obj = obj#skip := true ; (obj#graphql_arg := fun () -> - failwith "Unexpected: This obj#graphql_arg should be skipped") ; + failwith "Unexpected: This obj#graphql_arg should be skipped" ) ; obj#map := Fn.id ; obj#graphql_arg_accumulator := !(obj#graphql_arg_accumulator) ; (obj#nullable_graphql_arg := fun () -> - failwith "Unexpected: This obj#graphql_arg should be skipped") ; + failwith "Unexpected: This obj#graphql_arg should be skipped" ) ; obj let int obj = @@ -188,11 +189,11 @@ module Graphql_raw = struct let list x obj : (_, 'result list, 'input_type list, _) Input.t = (obj#graphql_arg := - fun () -> Schema.Arg.(non_null (list (!(x#graphql_arg) ())))) ; + fun () -> Schema.Arg.(non_null (list (!(x#graphql_arg) ()))) ) ; obj#map := List.map ~f:!(x#map) ; obj#graphql_arg_accumulator := !(x#graphql_arg_accumulator) ; (obj#nullable_graphql_arg := - fun () -> Schema.Arg.(list (!(x#graphql_arg) ()))) ; + fun () -> Schema.Arg.(list (!(x#graphql_arg) ())) ) ; obj let option (x : (_, 'result, 'input_type, _) Input.t) obj = @@ -260,23 +261,23 @@ module Graphql_raw = struct else Schema.field (Option.value annotations.name - ~default:(Fields_derivers.name_under_to_camel field)) + ~default:(Fields_derivers.name_under_to_camel field) ) ~args:Schema.Arg.[] ?doc:annotations.doc ~deprecated: ( Option.map annotations.deprecated ~f:(fun msg -> - Schema.Deprecated (Some msg)) + Schema.Deprecated (Some msg) ) |> Option.value ~default:Schema.NotDeprecated ) ~typ:(!(t_field#graphql_fields).Input.T.run ()) ~resolve:(fun _ x -> - !(t_field#contramap) (Field.get field x)) - |> Option.return) + !(t_field#contramap) (Field.get field x) ) + |> Option.return ) } :: rest ; ((fun _ -> failwith "Unused"), acc) - let finish name ~t_toplevel_annots - ((_creator, obj) : 'u * _ Accumulator.t) : _ Input.t = + let finish name ~t_toplevel_annots ((_creator, obj) : 'u * _ Accumulator.t) + : _ Input.t = let annotations = Fields_derivers.Annotations.Top.of_annots ~name t_toplevel_annots in @@ -288,8 +289,8 @@ module Graphql_raw = struct ~fields:(fun _ -> List.rev @@ List.filter_map graphql_fields_accumulator ~f:(fun g -> - g.Accumulator.T.run ())) - |> Schema.non_null) + g.Accumulator.T.run () ) ) + |> Schema.non_null ) } in let nullable_graphql_fields = @@ -299,7 +300,7 @@ module Graphql_raw = struct ~fields:(fun _ -> List.rev @@ List.filter_map graphql_fields_accumulator ~f:(fun g -> - g.Accumulator.T.run ()))) + g.Accumulator.T.run () ) ) ) } in obj#graphql_fields := graphql_fields ; @@ -313,8 +314,8 @@ module Graphql_raw = struct { run = (fun () -> failwith - "Unexpected: This obj#graphql_fields should be skipped") - }) ; + "Unexpected: This obj#graphql_fields should be skipped" ) + } ) ; obj#contramap := Fn.id ; obj#graphql_fields_accumulator := !(obj#graphql_fields_accumulator) ; (obj#nullable_graphql_fields := @@ -323,13 +324,13 @@ module Graphql_raw = struct (fun () -> failwith "Unexpected: This obj#nullable_graphql_fields should be \ - skipped") - }) ; + skipped" ) + } ) ; obj let int obj = (obj#graphql_fields := - Input.T.{ run = (fun () -> Schema.(non_null int)) }) ; + Input.T.{ run = (fun () -> Schema.(non_null int)) } ) ; obj#contramap := Fn.id ; obj#graphql_fields_accumulator := !(obj#graphql_fields_accumulator) ; (obj#nullable_graphql_fields := Input.T.{ run = (fun () -> Schema.int) }) ; @@ -337,20 +338,20 @@ module Graphql_raw = struct let string obj = (obj#graphql_fields := - Input.T.{ run = (fun () -> Schema.(non_null string)) }) ; + Input.T.{ run = (fun () -> Schema.(non_null string)) } ) ; obj#contramap := Fn.id ; obj#graphql_fields_accumulator := !(obj#graphql_fields_accumulator) ; (obj#nullable_graphql_fields := - Input.T.{ run = (fun () -> Schema.string) }) ; + Input.T.{ run = (fun () -> Schema.string) } ) ; obj let bool obj = (obj#graphql_fields := - Input.T.{ run = (fun () -> Schema.(non_null bool)) }) ; + Input.T.{ run = (fun () -> Schema.(non_null bool)) } ) ; obj#contramap := Fn.id ; obj#graphql_fields_accumulator := !(obj#graphql_fields_accumulator) ; (obj#nullable_graphql_fields := - Input.T.{ run = (fun () -> Schema.bool) }) ; + Input.T.{ run = (fun () -> Schema.bool) } ) ; obj let list x obj : ('input_type list, _, _, _) Input.t = @@ -358,13 +359,13 @@ module Graphql_raw = struct Input.T. { run = (fun () -> - Schema.(non_null (list (!(x#graphql_fields).run ())))) - }) ; + Schema.(non_null (list (!(x#graphql_fields).run ()))) ) + } ) ; obj#contramap := List.map ~f:!(x#contramap) ; obj#graphql_fields_accumulator := !(x#graphql_fields_accumulator) ; (obj#nullable_graphql_fields := Input.T. - { run = (fun () -> Schema.(list (!(x#graphql_fields).run ()))) }) ; + { run = (fun () -> Schema.(list (!(x#graphql_fields).run ()))) } ) ; obj let option (x : ('input_type, 'b, 'c, 'nullable) Input.t) obj : @@ -451,8 +452,9 @@ module Graphql_query = struct ( List.filter_map graphql_query_accumulator ~f: (Option.map ~f:(fun (k, v) -> - match v with None -> k | Some v -> sprintf "%s %s" k v)) - |> List.rev |> String.concat ~sep:"\n" )) ; + match v with None -> k | Some v -> sprintf "%s %s" k v ) + ) + |> List.rev |> String.concat ~sep:"\n" ) ) ; obj let scalar obj = @@ -490,7 +492,7 @@ module IO = struct let map t f = Async_kernel.Pipe.map' t ~f:(fun q -> - Async_kernel.Deferred.Queue.map q ~f) + Async_kernel.Deferred.Queue.map q ~f ) let iter t f = Async_kernel.Pipe.iter t ~f @@ -652,7 +654,7 @@ let%test_module "Test" = ~args:Arg.[] ~typ:(non_null (list (non_null string))) ~resolve:(fun _ t -> t.bar) - ])) + ] )) let derived init = let open Graphql_fields in @@ -743,7 +745,7 @@ let%test_module "Test" = ~args:Arg.[] ~typ:T1.manual_typ ~resolve:(fun _ t -> Or_ignore_test.to_option t.foo) - ])) + ] )) let derived init = let open Graphql_fields in @@ -756,8 +758,8 @@ let%test_module "Test" = let manual_typ = Schema.Arg.( obj "T2Input" ?doc:None - ~fields:[ arg "foo" ~typ:T1.Args.manual_typ ] ~coerce:(fun foo -> - Or_ignore_test.of_option foo)) + ~fields:[ arg "foo" ~typ:T1.Args.manual_typ ] + ~coerce:(fun foo -> Or_ignore_test.of_option foo)) let derived init = let open Graphql_args in diff --git a/src/lib/fields_derivers_json/fields_derivers_json.ml b/src/lib/fields_derivers_json/fields_derivers_json.ml index a2c23898839..f822ea8d614 100644 --- a/src/lib/fields_derivers_json/fields_derivers_json.ml +++ b/src/lib/fields_derivers_json/fields_derivers_json.ml @@ -47,14 +47,14 @@ module To_yojson = struct `Assoc ( List.filter_map to_json_accumulator ~f:(Option.map ~f:(fun (name, f) -> (name, f t))) - |> List.rev )) ; + |> List.rev ) ) ; obj let skip obj = obj#skip := true ; obj#contramap := Fn.id ; (obj#to_json := - fun _ -> failwith "Unexpected: This obj#to_json should be skipped") ; + fun _ -> failwith "Unexpected: This obj#to_json should be skipped" ) ; obj let int obj = @@ -80,7 +80,7 @@ module To_yojson = struct let option x obj = obj#contramap := Option.map ~f:!(x#contramap) ; (obj#to_json := - fun a_opt -> match a_opt with Some a -> !(x#to_json) a | None -> `Null) ; + fun a_opt -> match a_opt with Some a -> !(x#to_json) a | None -> `Null ) ; obj let contramap ~f x obj = @@ -136,7 +136,7 @@ module Of_yojson = struct | None -> raise (Field_not_found name) | Some x -> - x) ) + x ) ) in (creator, acc_obj) @@ -160,24 +160,24 @@ module Of_yojson = struct let skip obj = obj#contramap := Fn.id ; (obj#of_json := - fun _ -> failwith "Unexpected: This obj#of_json should be skipped") ; + fun _ -> failwith "Unexpected: This obj#of_json should be skipped" ) ; obj let int obj = (obj#of_json := - function `Int x -> x | _ -> raise (Invalid_json_scalar `Int)) ; + function `Int x -> x | _ -> raise (Invalid_json_scalar `Int) ) ; obj#map := Fn.id ; obj let string obj = (obj#of_json := - function `String x -> x | _ -> raise (Invalid_json_scalar `String)) ; + function `String x -> x | _ -> raise (Invalid_json_scalar `String) ) ; obj#map := Fn.id ; obj let bool obj = (obj#of_json := - function `Bool x -> x | _ -> raise (Invalid_json_scalar `Bool)) ; + function `Bool x -> x | _ -> raise (Invalid_json_scalar `Bool) ) ; obj#map := Fn.id ; obj @@ -187,13 +187,13 @@ module Of_yojson = struct | `List xs -> List.map xs ~f:!(x#of_json) | _ -> - raise (Invalid_json_scalar `List)) ; + raise (Invalid_json_scalar `List) ) ; obj#map := List.map ~f:!(x#map) ; obj let option x obj = (obj#of_json := - function `Null -> None | other -> Some (!(x#of_json) other)) ; + function `Null -> None | other -> Some (!(x#of_json) other) ) ; obj#map := Option.map ~f:!(x#map) ; obj diff --git a/src/lib/fields_derivers_zkapps/fields_derivers_zkapps.ml b/src/lib/fields_derivers_zkapps/fields_derivers_zkapps.ml index d53cd60d93f..634ebc96c6b 100644 --- a/src/lib/fields_derivers_zkapps/fields_derivers_zkapps.ml +++ b/src/lib/fields_derivers_zkapps/fields_derivers_zkapps.ml @@ -82,21 +82,21 @@ module Make (Schema : Graphql_intf.Schema) = struct Graphql.Fields.Input.T. { run = (fun () -> - scalar name ?doc ~coerce:Yojson.Safe.to_basic |> non_null) - }) ; + scalar name ?doc ~coerce:Yojson.Safe.to_basic |> non_null ) + } ) ; (obj#nullable_graphql_fields := let open Schema in Graphql.Fields.Input.T. - { run = (fun () -> scalar name ?doc ~coerce:Yojson.Safe.to_basic) }) ; + { run = (fun () -> scalar name ?doc ~coerce:Yojson.Safe.to_basic) } ) ; (obj#graphql_arg := fun () -> Schema.Arg.scalar name ?doc ~coerce:Graphql.arg_to_yojson - |> Schema.Arg.non_null) ; + |> Schema.Arg.non_null ) ; (obj#nullable_graphql_arg := - fun () -> Schema.Arg.scalar name ?doc ~coerce:Graphql.arg_to_yojson) ; + fun () -> Schema.Arg.scalar name ?doc ~coerce:Graphql.arg_to_yojson ) ; obj#to_json := Fn.id ; @@ -129,7 +129,8 @@ module Make (Schema : Graphql_intf.Schema) = struct | `String x -> of_string x | _ -> - raise (Fields_derivers_json.Of_yojson.Invalid_json_scalar `String)) + raise (Fields_derivers_json.Of_yojson.Invalid_json_scalar `String) + ) ~contramap:(fun x -> `String (to_string x)) let uint64 obj : _ Unified_input.t = @@ -155,7 +156,7 @@ module Make (Schema : Graphql_intf.Schema) = struct ~to_string:Signature_lib.Public_key.Compressed.to_string ~of_string: (except ~f:Signature_lib.Public_key.Compressed.of_base58_check_exn - `Public_key) + `Public_key ) let skip obj : _ Unified_input.t = let _a = Graphql.Fields.skip obj in @@ -319,7 +320,7 @@ module Make (Schema : Graphql_intf.Schema) = struct | Ok (`Response data) -> data |> Yojson.Basic.to_string |> printf "%s" |> return | _ -> - failwith "Unexpected response") + failwith "Unexpected response" ) module Loop = struct let rec json_to_string_gql : Yojson.Safe.t -> string = function @@ -328,7 +329,7 @@ module Make (Schema : Graphql_intf.Schema) = struct ( List.map kv ~f:(fun (k, v) -> sprintf "%s: %s" (Fields_derivers.under_to_camel k) - (json_to_string_gql v)) + (json_to_string_gql v) ) |> String.concat ~sep:",\n" ) | `List xs -> sprintf "[\n%s\n]" @@ -363,7 +364,7 @@ module Make (Schema : Graphql_intf.Schema) = struct ~doc:"sample args query" ~resolve:(fun { ctx; _ } () (input : 'a) -> ctx := Some input ; - 0)) + 0 )) in let out_schema : ('a option ref, unit) Schema.field = Schema.( diff --git a/src/lib/file_system/file_system.ml b/src/lib/file_system/file_system.ml index 9fb79b82c5c..fce8cfd380b 100644 --- a/src/lib/file_system/file_system.ml +++ b/src/lib/file_system/file_system.ml @@ -11,7 +11,7 @@ let dir_exists dir = let remove_dir dir = let%bind _ = Monitor.try_with ~here:[%here] (fun () -> - Process.run_exn ~prog:"rm" ~args:[ "-rf"; dir ] ()) + Process.run_exn ~prog:"rm" ~args:[ "-rf"; dir ] () ) in Deferred.unit @@ -25,8 +25,8 @@ let rec rmrf path = if [%equal: [ `Yes | `No | `Unknown ]] (Core.Sys.file_exists path) `Yes then Core.Sys.remove path -let try_finally ~(f : unit -> 'a Deferred.t) - ~(finally : unit -> unit Deferred.t) = +let try_finally ~(f : unit -> 'a Deferred.t) ~(finally : unit -> unit Deferred.t) + = try_with f >>= function | Ok x -> diff --git a/src/lib/filtered_external_transition/filtered_external_transition.ml b/src/lib/filtered_external_transition/filtered_external_transition.ml index e6aabc21d4f..7832617991b 100644 --- a/src/lib/filtered_external_transition/filtered_external_transition.ml +++ b/src/lib/filtered_external_transition/filtered_external_transition.ml @@ -74,16 +74,16 @@ let participants let user_command_set = List.fold commands ~init:empty ~f:(fun set user_command -> union set - (of_list @@ User_command.accounts_accessed user_command.data.data)) + (of_list @@ User_command.accounts_accessed user_command.data.data) ) in let fee_transfer_participants = List.fold fee_transfers ~init:empty ~f:(fun set (ft, _) -> - add set (Fee_transfer.Single.receiver ft)) + add set (Fee_transfer.Single.receiver ft) ) in add (add (union user_command_set fee_transfer_participants) - (Account_id.create creator Token_id.default)) + (Account_id.create creator Token_id.default) ) (Account_id.create winner Token_id.default) let participant_pks @@ -93,11 +93,11 @@ let participant_pks List.fold commands ~init:empty ~f:(fun set user_command -> union set @@ of_list @@ List.map ~f:Account_id.public_key - @@ User_command.accounts_accessed user_command.data.data) + @@ User_command.accounts_accessed user_command.data.data ) in let fee_transfer_participants = List.fold fee_transfers ~init:empty ~f:(fun set (ft, _) -> - add set ft.receiver_pk) + add set ft.receiver_pk ) in add (add (union user_command_set fee_transfer_participants) creator) winner @@ -153,7 +153,7 @@ let of_transition block tracked_participants List.exists (User_command.accounts_accessed command) ~f:(fun account_id -> Public_key.Compressed.Set.mem participants - (Account_id.public_key account_id)) + (Account_id.public_key account_id) ) in match tracked_participants with | `Some interested_participants @@ -176,7 +176,7 @@ let of_transition block tracked_participants | { data = Fee_transfer fee_transfer; _ } -> let fee_transfer_list = List.map (Mina_base.Fee_transfer.to_list fee_transfer) ~f:(fun f -> - (f, Fee_transfer_type.Fee_transfer)) + (f, Fee_transfer_type.Fee_transfer) ) in let fee_transfers = match tracked_participants with @@ -185,7 +185,7 @@ let of_transition block tracked_participants | `Some interested_participants -> List.filter ~f:(fun ({ receiver_pk = pk; _ }, _) -> - Public_key.Compressed.Set.mem interested_participants pk) + Public_key.Compressed.Set.mem interested_participants pk ) fee_transfer_list in { acc_transactions with @@ -196,7 +196,7 @@ let of_transition block tracked_participants Option.map ~f:(fun ft -> ( Coinbase_fee_transfer.to_fee_transfer ft - , Fee_transfer_type.Fee_transfer_via_coinbase )) + , Fee_transfer_type.Fee_transfer_via_coinbase ) ) fee_transfer in let fee_transfers = @@ -210,7 +210,7 @@ let of_transition block tracked_participants ; coinbase = Currency.Amount.( Option.value_exn (add amount acc_transactions.coinbase)) - }) + } ) in let snark_jobs = staged_ledger_diff |> Staged_ledger_diff.completed_works diff --git a/src/lib/generated_graphql_queries/gen/gen.ml b/src/lib/generated_graphql_queries/gen/gen.ml index bf53a1f8f22..113abf295a4 100644 --- a/src/lib/generated_graphql_queries/gen/gen.ml +++ b/src/lib/generated_graphql_queries/gen/gen.ml @@ -61,6 +61,6 @@ let structure ~loc = let main () = Out_channel.with_file "generated_graphql_queries.ml" ~f:(fun ml_file -> let fmt = Format.formatter_of_out_channel ml_file in - Pprintast.top_phrase fmt (Ptop_def (structure ~loc:Ppxlib.Location.none))) + Pprintast.top_phrase fmt (Ptop_def (structure ~loc:Ppxlib.Location.none)) ) let () = main () diff --git a/src/lib/genesis_constants/genesis_constants.ml b/src/lib/genesis_constants/genesis_constants.ml index 6f7e72a034f..9b6a7ac23a3 100644 --- a/src/lib/genesis_constants/genesis_constants.ml +++ b/src/lib/genesis_constants/genesis_constants.ml @@ -200,8 +200,8 @@ module Constraint_constants = struct end (*Constants that can be specified for generating the base proof (that are not required for key-generation) in runtime_genesis_ledger.exe and that can be configured at runtime. -The types are defined such that this module doesn't depend on any of the coda libraries (except blake2 and module_version) to avoid dependency cycles. -TODO: #4659 move key generation to runtime_genesis_ledger.exe to include scan_state constants, consensus constants (c and block_window_duration) and ledger depth here*) + The types are defined such that this module doesn't depend on any of the coda libraries (except blake2 and module_version) to avoid dependency cycles. + TODO: #4659 move key generation to runtime_genesis_ledger.exe to include scan_state constants, consensus constants (c and block_window_duration) and ledger depth here*) let genesis_timestamp_of_string str = let default_zone = Time.Zone.of_utc_offset ~hours:(-8) in @@ -216,7 +216,7 @@ let validate_time time_str = match Result.try_with (fun () -> Option.value_map ~default:(Time.now ()) ~f:genesis_timestamp_of_string - time_str) + time_str ) with | Ok time -> Ok (of_time time) @@ -267,8 +267,8 @@ module Protocol = struct (Time.to_string_abs (Time.of_span_since_epoch (Time.Span.of_ms - (Int64.to_float t.genesis_state_timestamp))) - ~zone:Time.Zone.utc) ) + (Int64.to_float t.genesis_state_timestamp) ) ) + ~zone:Time.Zone.utc ) ) ] let of_yojson = function @@ -307,7 +307,7 @@ module Protocol = struct ; genesis_state_timestamp = Time.to_string_abs (Time.of_span_since_epoch - (Time.Span.of_ms (Int64.to_float t.genesis_state_timestamp))) + (Time.Span.of_ms (Int64.to_float t.genesis_state_timestamp)) ) ~zone:Time.Zone.utc } in @@ -364,7 +364,7 @@ module T = struct ^ Time.to_string_abs ~zone:Time.Zone.utc (Time.of_span_since_epoch (Time.Span.of_ms - (Int64.to_float t.protocol.genesis_state_timestamp))) + (Int64.to_float t.protocol.genesis_state_timestamp) ) ) in Blake2.digest_string str |> Blake2.to_hex end diff --git a/src/lib/genesis_ledger/genesis_ledger.ml b/src/lib/genesis_ledger/genesis_ledger.ml index 5986f4800a2..05ba5068ed6 100644 --- a/src/lib/genesis_ledger/genesis_ledger.ml +++ b/src/lib/genesis_ledger/genesis_ledger.ml @@ -30,7 +30,7 @@ module Private_accounts (Accounts : Intf.Private_accounts.S) = struct List.map accounts ~f:(fun { pk; sk; balance; timing } -> let account_id = Account_id.create pk Token_id.default in let balance = Balance.of_formatted_string (Int.to_string balance) in - (Some sk, account_with_timing account_id balance timing)) + (Some sk, account_with_timing account_id balance timing) ) end module Public_accounts (Accounts : Intf.Public_accounts.S) = struct @@ -43,7 +43,7 @@ module Public_accounts (Accounts : Intf.Public_accounts.S) = struct let account_id = Account_id.create pk Token_id.default in let balance = Balance.of_int balance in let base_acct = account_with_timing account_id balance timing in - (None, { base_acct with delegate = Option.value ~default:pk delegate })) + (None, { base_acct with delegate = Option.value ~default:pk delegate }) ) end (** Generate a ledger using the sample keypairs from [Mina_base] with the given @@ -64,7 +64,7 @@ module Balances (Balances : Intf.Named_balances_intf) = struct ; pk = fst keypairs.(i) ; sk = snd keypairs.(i) ; timing = Untimed - }) + } ) end) end @@ -95,7 +95,7 @@ module Utils = struct find_account_record_exn accounts ~f:(fun new_account -> not (List.mem ~equal:Public_key.Compressed.equal old_account_pks - (Account.public_key new_account))) + (Account.public_key new_account) ) ) let find_new_account_record_exn accounts old_account_pks = find_new_account_record_exn_ accounts @@ -123,7 +123,7 @@ module Make (Inputs : Intf.Ledger_input_intf) : Intf.S = struct List.iter (Lazy.force accounts) ~f:(fun (_, account) -> Ledger.create_new_account_exn ledger (Account.identifier account) - account) ; + account ) ; ledger include Utils @@ -144,8 +144,8 @@ module Make (Inputs : Intf.Ledger_input_intf) : Intf.S = struct in Memo.unit (fun () -> List.max_elt (Lazy.force accounts) ~compare:(fun (_, a) (_, b) -> - Balance.compare a.balance b.balance) - |> Option.value_exn ?here:None ?error:None ~message:error_msg) + Balance.compare a.balance b.balance ) + |> Option.value_exn ?here:None ?error:None ~message:error_msg ) let largest_account_id_exn = Memo.unit (fun () -> largest_account_exn () |> id_of_account_record) @@ -213,8 +213,8 @@ end) : Intf.S = struct in Memo.unit (fun () -> List.max_elt (Lazy.force accounts) ~compare:(fun (_, a) (_, b) -> - Balance.compare a.Account.Poly.balance b.Account.Poly.balance) - |> Option.value_exn ?here:None ?error:None ~message:error_msg) + Balance.compare a.Account.Poly.balance b.Account.Poly.balance ) + |> Option.value_exn ?here:None ?error:None ~message:error_msg ) let largest_account_id_exn = Memo.unit (fun () -> largest_account_exn () |> id_of_account_record) @@ -252,7 +252,7 @@ module Testnet_postake_many_producers = Register (Balances (struct lazy (let high_balances = List.init 50 ~f:(Fn.const 5_000_000) in let low_balances = List.init 10 ~f:(Fn.const 1_000) in - high_balances @ low_balances) + high_balances @ low_balances ) end)) module Test = Register (Balances (Test_ledger)) @@ -291,7 +291,7 @@ module Integration_tests = struct lazy (let high_balances = List.init 2 ~f:(Fn.const 5_000_000) in let low_balances = List.init 16 ~f:(Fn.const 1_000) in - high_balances @ low_balances) + high_balances @ low_balances ) end)) module Three_even_stakes = Register (Balances (struct diff --git a/src/lib/genesis_ledger/release_ledger.ml b/src/lib/genesis_ledger/release_ledger.ml index 89dfa4f80a7..6ac1c210091 100644 --- a/src/lib/genesis_ledger/release_ledger.ml +++ b/src/lib/genesis_ledger/release_ledger.ml @@ -7,4 +7,4 @@ let balances = lazy (let high_balances = List.init 1 ~f:(Fn.const 10_000_000) in let low_balances = List.init 17 ~f:(Fn.const 1_000) in - high_balances @ low_balances) + high_balances @ low_balances ) diff --git a/src/lib/genesis_ledger_helper/genesis_ledger_helper.ml b/src/lib/genesis_ledger_helper/genesis_ledger_helper.ml index b597224e712..40850b06fcc 100644 --- a/src/lib/genesis_ledger_helper/genesis_ledger_helper.ml +++ b/src/lib/genesis_ledger_helper/genesis_ledger_helper.ml @@ -82,7 +82,7 @@ module Ledger = struct [ Int.to_string constraint_constants.ledger_depth ; Int.to_string (Option.value ~default:0 num_accounts) ; List.to_string balances ~f:(fun (i, balance) -> - sprintf "%i %s" i (Currency.Balance.to_string balance)) + sprintf "%i %s" i (Currency.Balance.to_string balance) ) ; (* Distinguish ledgers when the hash function is different. *) Snark_params.Tick.Field.to_string Mina_base.Account.empty_digest ; (* Distinguish ledgers when the account record layout has changed. *) @@ -209,7 +209,7 @@ module Ledger = struct let t = lazy (Mina_ledger.Ledger.create ~directory_name:dirname - ~depth:constraint_constants.ledger_depth ()) + ~depth:constraint_constants.ledger_depth () ) let depth = constraint_constants.ledger_depth end) ) @@ -296,12 +296,12 @@ module Ledger = struct Option.map accounts_opt ~f: (Lazy.map - ~f:(Accounts.pad_with_rev_balances (List.rev config.balances))) + ~f:(Accounts.pad_with_rev_balances (List.rev config.balances)) ) in Option.map padded_accounts_with_balances_opt ~f: (Lazy.map - ~f:(Accounts.pad_to (Option.value ~default:0 config.num_accounts))) + ~f:(Accounts.pad_to (Option.value ~default:0 config.num_accounts)) ) let packed_genesis_ledger_of_accounts ~depth accounts : Genesis_ledger.Packed.t = @@ -314,8 +314,8 @@ module Ledger = struct end) ) let load ~proof_level ~genesis_dir ~logger ~constraint_constants - ?(ledger_name_prefix = "genesis_ledger") - (config : Runtime_config.Ledger.t) = + ?(ledger_name_prefix = "genesis_ledger") (config : Runtime_config.Ledger.t) + = Monitor.try_with_join_or_error ~here:[%here] (fun () -> let padded_accounts_opt = padded_accounts_from_runtime_config_opt ~logger ~proof_level @@ -415,7 +415,7 @@ module Ledger = struct (* Delete the file if it already exists. *) let%bind () = Deferred.Or_error.try_with ~here:[%here] (fun () -> - Sys.remove link_name) + Sys.remove link_name ) |> Deferred.ignore_m in (* Add a symlink from the named path to the hash path. *) @@ -444,7 +444,7 @@ module Ledger = struct ; ("path", `String tar_path) ; ("error", Error_json.error_to_yojson err) ] ; - return (Error err) ) )) + return (Error err) ) ) ) end module Epoch_data = struct @@ -606,13 +606,13 @@ module Genesis_proof = struct Monitor.try_with_or_error ~here:[%here] ~extract_exn:true (fun () -> let%bind wr = Writer.open_file filename in Writer.write wr (Proof.Stable.V2.sexp_of_t proof |> Sexp.to_string) ; - Writer.close wr) + Writer.close wr ) let load filename = (* TODO: Use [Reader.load_bin_prot]. *) Monitor.try_with_or_error ~here:[%here] ~extract_exn:true (fun () -> Reader.file_contents filename - >>| Sexp.of_string >>| Proof.Stable.V2.t_of_sexp) + >>| Sexp.of_string >>| Proof.Stable.V2.t_of_sexp ) let id_to_json x = `String (Sexp.to_string (Pickles.Verification_key.Id.sexp_of_t x)) @@ -637,7 +637,7 @@ module Genesis_proof = struct Base_hash.create ~id ~state_hash: (State_hash.With_state_hashes.state_hash - inputs.protocol_state_with_hashes) + inputs.protocol_state_with_hashes ) in let use_precomputed_values base_hash = match Precomputed_values.compiled with @@ -651,7 +651,7 @@ module Genesis_proof = struct Base_hash.create ~id:proof_data.blockchain_proof_system_id ~state_hash: (State_hash.With_state_hashes.state_hash - compiled.protocol_state_with_hashes) + compiled.protocol_state_with_hashes ) in Base_hash.equal base_hash compiled_base_hash | None -> @@ -679,7 +679,8 @@ module Genesis_proof = struct | None -> lazy (let (module T), (module B) = Lazy.force b in - Lazy.force @@ Genesis_proof.digests (module T) (module B)) + Lazy.force @@ Genesis_proof.digests (module T) (module B) + ) in let blockchain_proof_system_id = match inputs.blockchain_proof_system_id with @@ -726,7 +727,7 @@ module Genesis_proof = struct Base_hash.create ~id:proof_data.blockchain_proof_system_id ~state_hash: (State_hash.With_state_hashes.state_hash - compiled.protocol_state_with_hashes) + compiled.protocol_state_with_hashes ) in [%log info] "Base hash $computed_hash matches compile-time $compiled_hash, using \ @@ -796,7 +797,7 @@ end let load_config_json filename = Monitor.try_with_or_error ~here:[%here] (fun () -> let%map json = Reader.file_contents filename in - Yojson.Safe.from_string json) + Yojson.Safe.from_string json ) let load_config_file filename = let open Deferred.Or_error.Let_syntax in @@ -806,7 +807,7 @@ let load_config_file filename = | Ok config -> Ok config | Error err -> - Or_error.error_string err) + Or_error.error_string err ) let inputs_from_config_file ?(genesis_dir = Cache_dir.autogen_path) ~logger ~proof_level (config : Runtime_config.t) = @@ -892,7 +893,7 @@ let inputs_from_config_file ?(genesis_dir = Cache_dir.autogen_path) ~logger ; hash = None ; name = None ; add_genesis_winner = None - }) + } ) in [%log info] "Loaded genesis ledger from $ledger_file" ~metadata:[ ("ledger_file", `String ledger_file) ] ; @@ -967,7 +968,7 @@ let upgrade_old_config ~logger filename json = if String.equal key "daemon" then ( found_daemon := true ; false ) - else List.mem ~equal:String.equal old_fields key) + else List.mem ~equal:String.equal old_fields key ) in if List.is_empty old_fields then return json else if !found_daemon then ( @@ -995,7 +996,7 @@ let upgrade_old_config ~logger filename json = Deferred.Or_error.try_with ~here:[%here] (fun () -> Writer.with_file filename ~f:(fun w -> Deferred.return - @@ Writer.write w (Yojson.Safe.pretty_to_string upgraded_json))) + @@ Writer.write w (Yojson.Safe.pretty_to_string upgraded_json) ) ) |> Deferred.ignore_m in upgraded_json ) @@ -1013,5 +1014,5 @@ let%test_module "Account config test" = let acc' = Accounts.Single.to_account_with_pk acc_config |> Or_error.ok_exn in - [%test_eq: Account.t] acc acc') + [%test_eq: Account.t] acc acc' ) end ) diff --git a/src/lib/genesis_ledger_helper/lib/genesis_ledger_helper_lib.ml b/src/lib/genesis_ledger_helper/lib/genesis_ledger_helper_lib.ml index 54eaff2aa11..86957766a09 100644 --- a/src/lib/genesis_ledger_helper/lib/genesis_ledger_helper_lib.ml +++ b/src/lib/genesis_ledger_helper/lib/genesis_ledger_helper_lib.ml @@ -93,7 +93,7 @@ module Accounts = struct ~f:(fun { token_owned; disable_new_accounts; account_disabled } -> if token_owned then Mina_base.Token_permissions.Token_owned { disable_new_accounts } - else Not_owned { account_disabled }) + else Not_owned { account_disabled } ) in let%bind token_symbol = try @@ -284,12 +284,12 @@ module Accounts = struct ; sequence_state ; last_sequence_slot ; proved_state - }) + } ) in { pk = Some (Signature_lib.Public_key.Compressed.to_base58_check - account.public_key) + account.public_key ) ; sk = Option.map ~f:Signature_lib.Private_key.to_base58_check sk ; balance = account.balance ; delegate = @@ -302,7 +302,7 @@ module Accounts = struct ; receipt_chain_hash = Some (Mina_base.Receipt.Chain_hash.to_base58_check - account.receipt_chain_hash) + account.receipt_chain_hash ) ; voting_for = Some (Mina_base.State_hash.to_base58_check account.voting_for) ; zkapp @@ -336,14 +336,14 @@ module Accounts = struct (Quickcheck.random_value ~seed: (`Deterministic - ("fake pk for genesis ledger " ^ string_of_int i)) - Public_key.Compressed.gen) + ("fake pk for genesis ledger " ^ string_of_int i) ) + Public_key.Compressed.gen ) in let account = Single.to_account_with_pk { account_config with pk = Some pk } |> Or_error.ok_exn in - (sk, account)) + (sk, account) ) let gen_with_balance balance : (Private_key.t option * Account.t) Quickcheck.Generator.t = @@ -388,7 +388,7 @@ module Accounts = struct | (n, balance) :: balances_tl -> gen_balances_rev n balance balances_tl accounts in - gen_balances_rev n balance balances_tl []) + gen_balances_rev n balance balances_tl [] ) let pad_with_rev_balances balances accounts = let balances_accounts = @@ -416,7 +416,7 @@ module Accounts = struct List.fold ~init:([], 0) accounts ~f:(fun (acc, count) account -> let count = count + 1 in if count >= n then raise Stop ; - (account :: acc, count + 1)) + (account :: acc, count + 1) ) in (* [rev_append] is tail-recursive, and we've already reversed the list, so we can avoid calling [append] which may internally reverse the @@ -526,7 +526,7 @@ let runtime_config_of_constraint_constants ; previous_length = Mina_numbers.Length.to_int previous_length ; previous_global_slot = Mina_numbers.Global_slot.to_int previous_global_slot - }) + } ) } let make_genesis_constants ~logger ~(default : Genesis_constants.t) @@ -582,8 +582,8 @@ let make_genesis_constants ~logger ~(default : Genesis_constants.t) ~f:(fun num_accounts -> Some num_accounts) } -let runtime_config_of_genesis_constants - (genesis_constants : Genesis_constants.t) : Runtime_config.Genesis.t = +let runtime_config_of_genesis_constants (genesis_constants : Genesis_constants.t) + : Runtime_config.Genesis.t = { k = Some genesis_constants.protocol.k ; delta = Some genesis_constants.protocol.delta ; slots_per_epoch = Some genesis_constants.protocol.slots_per_epoch @@ -591,7 +591,7 @@ let runtime_config_of_genesis_constants ; genesis_state_timestamp = Some (Genesis_constants.genesis_timestamp_to_string - genesis_constants.protocol.genesis_state_timestamp) + genesis_constants.protocol.genesis_state_timestamp ) } let runtime_config_of_precomputed_values (precomputed_values : Genesis_proof.t) @@ -608,12 +608,12 @@ let runtime_config_of_precomputed_values (precomputed_values : Genesis_proof.t) ; genesis = Some (runtime_config_of_genesis_constants - precomputed_values.genesis_constants) + precomputed_values.genesis_constants ) ; proof = Some (runtime_config_of_constraint_constants ~proof_level:precomputed_values.proof_level - precomputed_values.constraint_constants) + precomputed_values.constraint_constants ) ; ledger = None ; epoch_data = None } diff --git a/src/lib/genesis_proof/genesis_proof.ml b/src/lib/genesis_proof/genesis_proof.ml index befc7319243..2e14a7a3d67 100644 --- a/src/lib/genesis_proof/genesis_proof.ml +++ b/src/lib/genesis_proof/genesis_proof.ml @@ -183,7 +183,7 @@ let base_proof (module B : Blockchain_snark.Blockchain_snark_state.S) B.step ~handler: (Consensus.Data.Prover_state.precomputed_handler ~constraint_constants - ~genesis_epoch_ledger) + ~genesis_epoch_ledger ) { transition = Snark_transition.genesis ~constraint_constants ~consensus_constants ~genesis_ledger @@ -231,7 +231,7 @@ let create_values txn b (t : Inputs.t) = Some { blockchain_proof_system_id = (let (module B) = b in - Lazy.force B.Proof.id) + Lazy.force B.Proof.id ) ; genesis_proof } } @@ -248,7 +248,7 @@ let create_values_no_proof (t : Inputs.t) = ; constraint_system_digests = lazy (let txn, b = blockchain_snark_state t in - Lazy.force (digests txn b)) + Lazy.force (digests txn b) ) ; proof_data = None } diff --git a/src/lib/gossip_net/fake.ml b/src/lib/gossip_net/fake.ml index e3f403a54b1..ec7df90fc79 100644 --- a/src/lib/gossip_net/fake.ml +++ b/src/lib/gossip_net/fake.ml @@ -29,7 +29,10 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : module Network = struct type rpc_hook = { hook : - 'q 'r. Peer.Id.t -> ('q, 'r) rpc -> 'q + 'q 'r. + Peer.Id.t + -> ('q, 'r) rpc + -> 'q -> 'r Network_peer.Rpc_intf.rpc_response Deferred.t } @@ -43,14 +46,14 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : let nodes = Hashtbl.create (module Peer.Id) in List.iter peers ~f:(fun peer -> Hashtbl.add_multi nodes ~key:peer.Peer.peer_id - ~data:{ peer; interface = None }) ; + ~data:{ peer; interface = None } ) ; { nodes } let get_initial_peers { nodes } local_ip = Hashtbl.data nodes |> List.concat |> List.filter_map ~f:(fun node -> if Unix.Inet_addr.equal node.peer.host local_ip then None - else Some node.peer) + else Some node.peer ) let lookup_node t peer = let error = Error.of_string "peer does not exist" in @@ -91,8 +94,8 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : send_f intf.sinks ( msg , Mina_net2.Validation_callback.create_without_expiration - () )) - ~init:Deferred.unit)) + () ) ) + ~init:Deferred.unit ) ) let call_rpc : type q r. @@ -151,7 +154,7 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : match List.find_map rpc_handlers ~f:(fun handler -> match_handler handler rpc ~do_:(fun f -> - f sender ~version:latest_version query)) + f sender ~version:latest_version query ) ) with | None -> failwith "fake gossip net error: rpc not implemented" @@ -166,7 +169,7 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : let initial_peers = Network.get_initial_peers network me.Peer.host in let peer_table = Hashtbl.create (module Peer.Id) in List.iter initial_peers ~f:(fun peer -> - Hashtbl.add_exn peer_table ~key:peer.peer_id ~data:peer) ; + Hashtbl.add_exn peer_table ~key:peer.peer_id ~data:peer ) ; let ban_notification_reader, ban_notification_writer = Linear_pipe.create () in @@ -246,7 +249,7 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : | Connected x -> x.data | Failed_to_connect e -> - return (Network_peer.Rpc_intf.Failed_to_connect e)) + return (Network_peer.Rpc_intf.Failed_to_connect e) ) |> Or_error.all in let sender = @@ -254,7 +257,7 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : (Hashtbl.find t.peer_table peer) ~error:(Error.createf "failed to find peer %s in peer_table" peer) in - Connected (Envelope.Incoming.wrap_peer ~data ~sender)) + Connected (Envelope.Incoming.wrap_peer ~data ~sender) ) let query_random_peers _ = failwith "TODO stub" @@ -265,21 +268,21 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : let time = Block_time.now t.time_controller in let module M = (val sinksM) in M.Block_sink.push sink_block - (`Transition env, `Time_received time, `Valid_cb vc)) + (`Transition env, `Time_received time, `Valid_cb vc) ) let broadcast_snark_pool_diff ?origin_topic t diff = ignore origin_topic ; Network.broadcast t.network ~sender:t.me diff (fun (Any_sinks (sinksM, (_, _, sink_snark_work))) -> let module M = (val sinksM) in - M.Snark_sink.push sink_snark_work) + M.Snark_sink.push sink_snark_work ) let broadcast_transaction_pool_diff ?origin_topic t diff = ignore origin_topic ; Network.broadcast t.network ~sender:t.me diff (fun (Any_sinks (sinksM, (_, sink_tx, _))) -> let module M = (val sinksM) in - M.Tx_sink.push sink_tx) + M.Tx_sink.push sink_tx ) let connection_gating t = Deferred.return !(t.connection_gating) diff --git a/src/lib/gossip_net/libp2p.ml b/src/lib/gossip_net/libp2p.ml index cf574294322..0a80ece6650 100644 --- a/src/lib/gossip_net/libp2p.ml +++ b/src/lib/gossip_net/libp2p.ml @@ -146,7 +146,7 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : [%log' debug logger] ~metadata: [ ("rate_limiter", Network_pool.Rate_limiter.summary rl) ] - !"%s $rate_limiter" Impl.name) + !"%s $rate_limiter" Impl.name ) in let rl = Network_pool.Rate_limiter.create ~capacity:budget in log_rate_limiter_occasionally rl ; @@ -165,7 +165,7 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : () | `Within_capacity -> O1trace.thread (Printf.sprintf "handle_rpc_%s" Impl.name) (fun () -> - handler peer ~version q) + handler peer ~version q ) in Impl.implement_multi handler @@ -184,7 +184,7 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : don't_wait_for (Pipe.iter underlying_r ~f:(fun msg -> Pipe.write_without_pushback_if_open read_w msg ; - Deferred.unit)) ; + Deferred.unit ) ) ; let transport = Async_rpc_kernel.Pipe_transport.(create Kind.string read_r underlying_w) in @@ -238,7 +238,7 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : ~all_peers_seen_metric:config.all_peers_seen_metric ~on_peer_connected:(fun _ -> record_peer_connection ()) ~on_peer_disconnected:ignore ~logger:config.logger ~conf_dir - ~pids)) + ~pids ) ) with | Ok (Ok net2) -> ( let open Mina_net2 in @@ -267,7 +267,7 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : Some (Peer.create config.addrs_and_ports.bind_ip ~libp2p_port:config.addrs_and_ports.libp2p_port - ~peer_id:my_peer_id) ) ; + ~peer_id:my_peer_id ) ) ; [%log' info config.logger] "libp2p peer ID this session is $peer_id" ~metadata:[ ("peer_id", `String my_peer_id) ] ; let initializing_libp2p_result : _ Deferred.Or_error.t = @@ -281,9 +281,9 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : ; List.map ~f: (Fn.compose Mina_net2.Multiaddr.of_string - Peer.to_multiaddr_string) + Peer.to_multiaddr_string ) (Hash_set.to_list added_seeds) - ]) + ] ) in let%bind () = configure net2 ~me ~metrics_port:config.metrics_port @@ -291,15 +291,15 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : [ Multiaddr.of_string (sprintf "/ip4/0.0.0.0/tcp/%d" (Option.value_exn config.addrs_and_ports.peer) - .libp2p_port) + .libp2p_port ) ] ~external_maddr: (Multiaddr.of_string (sprintf "/ip4/%s/tcp/%d" (Unix.Inet_addr.to_string - config.addrs_and_ports.external_ip) + config.addrs_and_ports.external_ip ) (Option.value_exn config.addrs_and_ports.peer) - .libp2p_port)) + .libp2p_port ) ) ~network_id:config.chain_id ~unsafe_no_trust_ip:config.unsafe_no_trust_ip ~seed_peers ~direct_peers:config.direct_peers @@ -319,7 +319,7 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : | Banned_until _ -> Some peer | _ -> - None) + None ) ; trusted_peers = List.filter_map ~f:Mina_net2.Multiaddr.to_peer config.initial_peers @@ -361,7 +361,7 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : ~connection_state:(Fn.const peer) ~description: (Info.of_thunk (fun () -> - sprintf "stream from %s" peer.peer_id)) + sprintf "stream from %s" peer.peer_id ) ) transport with | Error handshake_error -> @@ -398,7 +398,7 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : ~metadata: [ ("error", Error_json.error_to_yojson e) ] | Ok () -> - () ))) + () ) ) ) in let subscribe ~fn topic bin_prot = Mina_net2.Pubsub.subscribe_encode net2 @@ -447,9 +447,9 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : Sinks.Block_sink.push sink_block ( `Transition (Envelope.Incoming.map - ~f:Mina_block.External_transition.decompose env) + ~f:Mina_block.External_transition.decompose env ) , `Time_received (Block_time.now config.time_controller) - , `Valid_cb vc )) + , `Valid_cb vc ) ) block_bin_prot v1_topic_block >>| Fn.flip Fn.compose Mina_block.External_transition.compose in @@ -472,8 +472,9 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : ( `Transition (Envelope.Incoming.map ~f:(fun _ -> - Mina_block.External_transition.decompose state) - env) + Mina_block.External_transition.decompose state + ) + env ) , `Time_received (Block_time.now config.time_controller) , `Valid_cb vc ) | Message.Latest.T.Transaction_pool_diff diff -> @@ -481,7 +482,7 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : (Envelope.Incoming.map ~f:(fun _ -> diff) env, vc) | Message.Latest.T.Snark_pool_diff diff -> Sinks.Snark_sink.push sink_snark_work - (Envelope.Incoming.map ~f:(fun _ -> diff) env, vc)) + (Envelope.Incoming.map ~f:(fun _ -> diff) env, vc) ) v0_topic Message.Latest.T.bin_msg in let%bind publish_v0 = @@ -502,13 +503,13 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : (sprintf "/ip4/%s/tcp/%d" ( config.addrs_and_ports.bind_ip |> Unix.Inet_addr.to_string ) - (Option.value_exn config.addrs_and_ports.peer).libp2p_port)) + (Option.value_exn config.addrs_and_ports.peer).libp2p_port ) ) in let add_many xs ~is_seed = Deferred.map (Deferred.List.iter ~how:`Parallel xs ~f:(fun x -> let open Deferred.Let_syntax in - Mina_net2.add_peer ~is_seed net2 x >>| ignore)) + Mina_net2.add_peer ~is_seed net2 x >>| ignore ) ) ~f:(fun () -> Ok ()) in don't_wait_for @@ -521,17 +522,18 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : in add_many ~is_seed:false (List.filter !peers_snapshot ~f:(fun p -> - not (Hash_set.mem seeds (Multiaddr.to_string p)))) + not (Hash_set.mem seeds (Multiaddr.to_string p)) ) ) in let%bind () = Mina_net2.begin_advertising net2 in - return ()) + return () ) ~f:(function | Ok () -> () | Error e -> [%log' warn config.logger] "starting libp2p up failed: $error" - ~metadata:[ ("error", Error_json.error_to_yojson e) ])) ; + ~metadata:[ ("error", Error_json.error_to_yojson e) ] + ) ) ; { publish_v0 ; publish_v1_block ; publish_v1_tx @@ -560,7 +562,7 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : let restarts_r, restarts_w = Strict_pipe.create ~name:"libp2p-restarts" (Strict_pipe.Buffered - (`Capacity 0, `Overflow (Strict_pipe.Drop_head ignore))) + (`Capacity 0, `Overflow (Strict_pipe.Drop_head ignore)) ) in let added_seeds = Peer.Hash_set.create () in let%bind () = @@ -579,7 +581,7 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : let delta = Option.value_map ~f:Float.of_string (Sys.getenv - "MINA_LIBP2P_HELPER_RESTART_INTERVAL_DELTA") + "MINA_LIBP2P_HELPER_RESTART_INTERVAL_DELTA" ) ~default:2.5 |> Float.min (base_time /. 2.) in @@ -590,7 +592,7 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : >>= fun () -> Mina_net2.shutdown n >>| restart_libp2p ) | None -> () ) ; - n) ; + n ) ; let pf_impl f msg = let%bind _, pf, _ = res in f pf msg @@ -606,7 +608,7 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : (* This is a hack so that we keep the same keypair across restarts. *) config.keypair <- Some me ; let logger = config.logger in - [%log trace] ~metadata:[] "Successfully restarted libp2p") + [%log trace] ~metadata:[] "Successfully restarted libp2p" ) and start_libp2p () = let libp2p = create_libp2p config rpc_handlers first_peer_ivar @@ -619,7 +621,7 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : (Strict_pipe.Reader.iter restarts_r ~f:(fun () -> let%bind n = !net2_ref in let%bind () = Mina_net2.shutdown n in - restart_libp2p () ; !net2_ref >>| ignore)) ; + restart_libp2p () ; !net2_ref >>| ignore ) ) ; start_libp2p () in let ban_configuration = @@ -635,7 +637,7 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : { !ban_configuration with banned_peers = List.filter !ban_configuration.banned_peers ~f:(fun p -> - not (Peer.equal p banned_peer)) + not (Peer.equal p banned_peer) ) } ; Mina_net2.set_connection_gating_config net2 !ban_configuration |> Deferred.ignore_m ) ; @@ -644,8 +646,8 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : { !ban_configuration with banned_peers = banned_peer :: !ban_configuration.banned_peers } ; - Mina_net2.set_connection_gating_config net2 !ban_configuration) - |> Deferred.ignore_m) + Mina_net2.set_connection_gating_config net2 !ban_configuration ) + |> Deferred.ignore_m ) in let%map () = Deferred.List.iter (Trust_system.peer_statuses config.trust_system) @@ -655,7 +657,7 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : ) -> do_ban (addr, expiration) | _ -> - Deferred.unit) + Deferred.unit ) in let ban_reader, ban_writer = Linear_pipe.create () in don't_wait_for @@ -664,7 +666,7 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : (Trust_system.ban_pipe config.trust_system) ~f:do_ban in - Linear_pipe.close ban_writer) ; + Linear_pipe.close ban_writer ) ; let t = { config ; added_seeds @@ -685,7 +687,7 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : List.map peers ~f: (Fn.compose Mina_net2.Multiaddr.of_string - Peer.to_multiaddr_string))) ; + Peer.to_multiaddr_string ) ) ) ; t let set_node_status t data = @@ -742,8 +744,8 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : ~send_every:(Time_ns.Span.of_sec 10.) ~timeout: (Option.value ~default:(Time_ns.Span.of_sec 120.) - heartbeat_timeout) - ()) + heartbeat_timeout ) + () ) ~connection_state:(Fn.const ()) ~dispatch_queries:(fun conn -> Versioned_rpc.Connection_with_menu.create conn @@ -759,8 +761,8 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : Deferred.choose [ Deferred.choice d Fn.id ; choice (after timeout) (fun () -> - Or_error.error_string "rpc timed out") - ]) + Or_error.error_string "rpc timed out" ) + ] ) transport ~on_handshake_error: (`Call @@ -774,7 +776,7 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : ( "Handshake error: $exn" , [ ("exn", `String (Exn.to_string exn)) ] ) )) in - Or_error.error_string "handshake error"))) + Or_error.error_string "handshake error" ) ) ) >>= function | Ok (Ok result) -> (* call succeeded, result is valid *) @@ -894,7 +896,7 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : t peer transport (fun conn qs -> Deferred.Or_error.List.map ?how qs ~f:(fun q -> - Impl.dispatch_multi conn q)) + Impl.dispatch_multi conn q ) ) qs >>| fun data -> Connected (Envelope.Incoming.wrap_peer ~data ~sender:peer) @@ -920,8 +922,7 @@ module Make (Rpc_intf : Network_peer.Rpc_intf.Rpc_interface_intf) : let%bind () = guard_topic ?origin_topic v1_topic_block pfs.publish_v1_block state in - guard_topic ?origin_topic v0_topic pfs.publish_v0 - (Message.New_state state) + guard_topic ?origin_topic v0_topic pfs.publish_v0 (Message.New_state state) let broadcast_transaction_pool_diff ?origin_topic t diff = let pfs = !(t.publish_functions) in diff --git a/src/lib/gossip_net/message.ml b/src/lib/gossip_net/message.ml index 8affbcdb1ee..3dad5370171 100644 --- a/src/lib/gossip_net/message.ml +++ b/src/lib/gossip_net/message.ml @@ -104,6 +104,6 @@ type ('sink_block, 'sink_tx, 'sink_snark) sinks_impl = (module Sinks_intf with type Block_sink.t = 'sink_block and type Snark_sink.t = 'sink_snark - and type Tx_sink.t = 'sink_tx) + and type Tx_sink.t = 'sink_tx ) type sinks = Any_sinks : ('a, 'b, 'c) sinks_impl * ('a * 'b * 'c) -> sinks diff --git a/src/lib/graph_algorithms/graph_algorithms.ml b/src/lib/graph_algorithms/graph_algorithms.ml index 3f13d9a3080..f51c459e326 100644 --- a/src/lib/graph_algorithms/graph_algorithms.ml +++ b/src/lib/graph_algorithms/graph_algorithms.ml @@ -25,7 +25,7 @@ module Make (V : Comparable.S) = struct let choose (g : G.t) : V.t option = with_return (fun { return } -> Map.iteri g ~f:(fun ~key ~data:_ -> return (Some key)) ; - None) + None ) let connected (g : G.t) : bool = match choose g with @@ -65,7 +65,7 @@ module Make (V : Comparable.S) = struct ( lazy (Nat.min (List.map (Map.keys g) ~f:(fun v -> - connectivity (remove_vertex g v)))) ) ) + connectivity (remove_vertex g v) ) ) ) ) ) end let connectivity (type a) (module V : Comparable.S with type t = a) diff --git a/src/lib/graph_algorithms/nat.ml b/src/lib/graph_algorithms/nat.ml index 348d264bb84..9751f196fde 100644 --- a/src/lib/graph_algorithms/nat.ml +++ b/src/lib/graph_algorithms/nat.ml @@ -40,7 +40,7 @@ let rec min (xs : t list) : tt = with_return (fun { return } -> `S (List.map xs ~f:(fun x -> - match Lazy.force x with Z -> return `Z | S n -> n))) + match Lazy.force x with Z -> return `Z | S n -> n ) ) ) with | `Z -> Z diff --git a/src/lib/graphql_lib/base_types.ml b/src/lib/graphql_lib/base_types.ml index 94caacd0d01..bc45f599beb 100644 --- a/src/lib/graphql_lib/base_types.ml +++ b/src/lib/graphql_lib/base_types.ml @@ -11,7 +11,7 @@ let unsigned_scalar_scalar ~to_string typ_name = ~doc: (Core.sprintf !"String representing a %s number in base 10" - (String.lowercase typ_name)) + (String.lowercase typ_name) ) ~coerce:(fun num -> `String (to_string num)) let public_key () = @@ -30,4 +30,4 @@ let token_id () = let epoch_seed () = scalar "EpochSeed" ~doc:"Base58Check-encoded epoch seed" ~coerce:(fun seed -> - `String (Mina_base.Epoch_seed.to_base58_check seed)) + `String (Mina_base.Epoch_seed.to_base58_check seed) ) diff --git a/src/lib/graphql_lib/client.ml b/src/lib/graphql_lib/client.ml index 2fe4f8f3217..d5696592a8f 100644 --- a/src/lib/graphql_lib/client.ml +++ b/src/lib/graphql_lib/client.ml @@ -52,8 +52,7 @@ module Connection_error = struct let ok_exn = function | `Failed_request e -> - eprintf "❌ Error connecting to graphql server. Error message: %s\n%!" - e ; + eprintf "❌ Error connecting to graphql server. Error message: %s\n%!" e ; exit 17 | `Graphql_error e -> eprintf "❌ Error: %s\n" e ; @@ -83,15 +82,15 @@ module Make (Config : Config_intf) = struct ( ("Accept", "application/json") :: ("Content-Type", "application/json") :: Map.to_alist Config.headers ) ~f:(fun header (key, value) -> - Cohttp.Header.add header key value) + Cohttp.Header.add header key value ) in let%bind response, body = Deferred.Or_error.try_with ~here:[%here] ~extract_exn:true (fun () -> Cohttp_async.Client.post ~headers ~body:(Cohttp_async.Body.of_string body_string) - uri) + uri ) |> Deferred.Result.map_error ~f:(fun e -> - `Failed_request (Error.to_string_hum e)) + `Failed_request (Error.to_string_hum e) ) in let%bind body_str = Cohttp_async.Body.to_string body |> Deferred.map ~f:Result.return @@ -106,7 +105,7 @@ module Make (Config : Config_intf) = struct Deferred.return (Error (`Failed_request - (Printf.sprintf "Status code %d -- %s" code body_str))) + (Printf.sprintf "Status code %d -- %s" code body_str) ) ) in let open Yojson.Basic.Util in ( match (member "errors" body_json, member "data" body_json) with @@ -131,7 +130,7 @@ module Make (Config : Config_intf) = struct `Graphql_error (Printf.sprintf "Problem parsing graphql response\nError message: %s" - (Exn.to_string e))) + (Exn.to_string e) ) ) |> Deferred.return let query_exn' ~f query_obj port = diff --git a/src/lib/hex/hex.ml b/src/lib/hex/hex.ml index dedbd4c5ef1..71d64330ac6 100644 --- a/src/lib/hex/hex.ml +++ b/src/lib/hex/hex.ml @@ -141,7 +141,7 @@ module Sequence_be = struct assert (n = k + k) ; init k ~f:(fun i -> Char.of_int_exn - ((16 * Digit.to_int t.(2 * i)) + Digit.to_int t.((2 * i) + 1))) + ((16 * Digit.to_int t.(2 * i)) + Digit.to_int t.((2 * i) + 1)) ) let to_string = to_bytes_like ~init:String.init @@ -157,7 +157,7 @@ let decode ?(reverse = false) ?(pos = 0) ~init t = let h j = Digit.(to_int (of_char_exn t.[pos + j])) in init k ~f:(fun i -> let i = if reverse then k - 1 - i else i in - Char.of_int_exn ((16 * h (2 * i)) + h ((2 * i) + 1))) + Char.of_int_exn ((16 * h (2 * i)) + h ((2 * i) + 1)) ) let encode ?(reverse = false) t = let n = String.length t in @@ -169,7 +169,7 @@ let encode ?(reverse = false) t = let c = if i mod 2 = 0 then (* hi *) c lsr 4 else (* lo *) c in - hex_char_of_int_exn (c land 15)) + hex_char_of_int_exn (c land 15) ) let%test_unit "decode" = let t = String.init 100 ~f:(fun _ -> Char.of_int_exn (Random.int 256)) in @@ -197,7 +197,7 @@ module Safe = struct in let high = charify @@ ((Char.to_int c land 0xF0) lsr 4) in let lo = charify (Char.to_int c land 0x0F) in - String.of_char_list [ high; lo ]) + String.of_char_list [ high; lo ] ) |> String.concat let%test_unit "to_hex sane" = @@ -229,7 +229,7 @@ module Safe = struct Or_error.return @@ (Char.((to_u4 a lsl 4) lor to_u4 b |> of_int_exn) :: acc) | _ -> - Or_error.error_string "invalid hex") + Or_error.error_string "invalid hex" ) |> Or_error.ok |> Option.map ~f:(Fn.compose String.of_char_list List.rev) @@ -244,5 +244,5 @@ module Safe = struct else failwithf !"expected: %s ; hexified: %s ; actual: %s" - expected hexified actual ()) + expected hexified actual () ) end diff --git a/src/lib/integration_test_cloud_engine/kubernetes_network.ml b/src/lib/integration_test_cloud_engine/kubernetes_network.ml index 1ddbc8c35dd..8ee2704e89c 100644 --- a/src/lib/integration_test_cloud_engine/kubernetes_network.ml +++ b/src/lib/integration_test_cloud_engine/kubernetes_network.ml @@ -408,7 +408,7 @@ module Node = struct pk | _ -> "unknown" ) - }) + } ) (Array.to_list chain) let must_get_best_chain ?max_length ~logger t = @@ -538,7 +538,7 @@ module Node = struct let fields = Array.to_list strs |> Base.List.map ~f:(fun s -> - Set (Pickles.Backend.Tick.Field.of_string s)) + Set (Pickles.Backend.Tick.Field.of_string s) ) in return (Mina_base.Zkapp_state.V.of_list_exn fields) | None -> @@ -548,7 +548,7 @@ module Node = struct "Expected zkApp account with an app state for public key \ %s" (Signature_lib.Public_key.Compressed.to_base58_check - (Mina_base.Account_id.public_key account_id)))) + (Mina_base.Account_id.public_key account_id) ) ) ) in let%bind delegate = match account#delegate with @@ -559,7 +559,7 @@ module Node = struct fail (Error.of_string (sprintf "Expected string encoding of delegate, got %s" - (Yojson.Basic.to_string json))) + (Yojson.Basic.to_string json) ) ) | None -> fail (Error.of_string "Expected delegate in account") in @@ -579,7 +579,7 @@ module Node = struct "Expected zkApp account with a verification key for \ public_key %s" (Signature_lib.Public_key.Compressed.to_base58_check - (Mina_base.Account_id.public_key account_id)))) + (Mina_base.Account_id.public_key account_id) ) ) ) in let%bind permissions = match account#permissions with @@ -626,7 +626,7 @@ module Node = struct | _ -> fail (Error.of_string - "Expected string for cliff amount in account timing") + "Expected string for cliff amount in account timing" ) in let%bind cliff_time = match tm with @@ -635,7 +635,7 @@ module Node = struct | _ -> fail (Error.of_string - "Expected string for cliff time in account timing") + "Expected string for cliff time in account timing" ) in let%bind vesting_period = match period with @@ -644,7 +644,7 @@ module Node = struct | _ -> fail (Error.of_string - "Expected string for vesting period in account timing") + "Expected string for vesting period in account timing" ) in let%bind vesting_increment = match incr with @@ -654,7 +654,7 @@ module Node = struct fail (Error.of_string "Expected string for vesting increment in account \ - timing") + timing" ) in let%bind initial_minimum_balance = match bal with @@ -664,7 +664,7 @@ module Node = struct fail (Error.of_string "Expected string for vesting increment in account \ - timing") + timing" ) in return (Set @@ -674,7 +674,7 @@ module Node = struct ; vesting_period ; vesting_increment } - : Mina_base.Party.Update.Timing_info.t )) + : Mina_base.Party.Update.Timing_info.t ) ) | _ -> fail (Error.of_string "Some pieces of account timing are missing") in @@ -790,10 +790,10 @@ module Node = struct , Array.map ~f:(fun s -> Mina_base.Transaction_status.Failure.of_string s - |> Result.ok_or_failwith) + |> Result.ok_or_failwith ) f#failures |> Array.to_list |> List.rev ) - :: acc) + :: acc ) |> Mina_base.Transaction_status.Failure.Collection.display_to_yojson |> Yojson.Safe.to_string ) in @@ -908,7 +908,7 @@ module Node = struct Graphql.Send_test_payments.make ~senders: (Array.of_list - (List.map ~f:Signature_lib.Private_key.to_yojson senders)) + (List.map ~f:Signature_lib.Private_key.to_yojson senders) ) ~receiver:(Graphql_lib.Encoders.public_key receiver_pub_key) ~amount:(Graphql_lib.Encoders.amount amount) ~fee:(Graphql_lib.Encoders.fee fee) @@ -945,11 +945,11 @@ module Node = struct ; "--create" ; "--no-owner" ; "postgres://postgres:foobar@archive-1-postgresql:5432/archive" - ]) + ] ) in [%log info] "Dumping archive data to file %s" data_file ; Out_channel.with_file data_file ~f:(fun out_ch -> - Out_channel.output_string out_ch data) + Out_channel.output_string out_ch data ) let run_replayer ~logger (t : t) = [%log info] "Running replayer on archived data (node: %s, container: %s)" @@ -958,7 +958,7 @@ module Node = struct let%bind accounts = Deferred.bind ~f:Malleable_error.return (run_in_container t - ~cmd:[ "jq"; "-c"; ".ledger.accounts"; "/config/daemon.json" ]) + ~cmd:[ "jq"; "-c"; ".ledger.accounts"; "/config/daemon.json" ] ) in let replayer_input = sprintf @@ -969,7 +969,7 @@ module Node = struct let%bind _res = Deferred.bind ~f:Malleable_error.return (cp_string_to_container_file t ~container_id:mina_archive_container_id - ~str:replayer_input ~dest) + ~str:replayer_input ~dest ) in Deferred.bind ~f:Malleable_error.return (run_in_container t ~container_id:mina_archive_container_id @@ -982,7 +982,7 @@ module Node = struct ; "--output-file" ; "/dev/null" ; "--continue-on-error" - ]) + ] ) let dump_mina_logs ~logger (t : t) ~log_file = let open Malleable_error.Let_syntax in @@ -993,7 +993,7 @@ module Node = struct in [%log info] "Dumping container log to file %s" log_file ; Out_channel.with_file log_file ~f:(fun out_ch -> - Out_channel.output_string out_ch logs) + Out_channel.output_string out_ch logs ) let dump_precomputed_blocks ~logger (t : t) = let open Malleable_error.Let_syntax in @@ -1023,7 +1023,7 @@ module Node = struct | other -> failwithf "Expected log line to be a JSON record, got: %s" (Yojson.Safe.to_string other) - ()) + () ) in let state_hash_and_blocks = List.fold metadata_jsons ~init:[] ~f:(fun acc json -> @@ -1047,7 +1047,7 @@ module Node = struct | other -> failwithf "Expected log line to be a JSON record, got: %s" (Yojson.Safe.to_string other) - ()) + () ) in let%bind.Deferred () = Deferred.List.iter state_hash_and_blocks @@ -1071,7 +1071,7 @@ module Node = struct "Dumping precomputed block with state hash %s to file %s" state_hash filename ; Out_channel.with_file filename ~f:(fun out_ch -> - Out_channel.output_string out_ch block)) + Out_channel.output_string out_ch block ) ) in Malleable_error.return () @@ -1236,7 +1236,7 @@ let initialize_infra ~logger network = |> List.map ~f:(fun line -> let parts = String.split line ~on:':' in assert (List.length parts = 2) ; - (List.nth_exn parts 0, List.nth_exn parts 1)) + (List.nth_exn parts 0, List.nth_exn parts 1) ) |> List.filter ~f:(fun (pod_name, _) -> String.Set.mem all_pods pod_name) |> String.Map.of_alist_exn in @@ -1260,7 +1260,7 @@ let initialize_infra ~logger network = let pod_statuses = parse_pod_statuses str in let all_pods_are_present = List.for_all (String.Set.elements all_pods) ~f:(fun pod_id -> - String.Map.mem pod_statuses pod_id) + String.Map.mem pod_statuses pod_id ) in let any_pods_are_not_running = List.exists diff --git a/src/lib/integration_test_cloud_engine/mina_automation.ml b/src/lib/integration_test_cloud_engine/mina_automation.ml index a5fc1316e90..bb6fd65a8e7 100644 --- a/src/lib/integration_test_cloud_engine/mina_automation.ml +++ b/src/lib/integration_test_cloud_engine/mina_automation.ml @@ -111,7 +111,7 @@ module Network_config = struct (* the first keypair is the genesis winner and is assumed to be untimed. Therefore dropping it, and not assigning it to any block producer *) (List.drop (Array.to_list (Lazy.force Key_gen.Sample_keypairs.keypairs)) - 1) + 1 ) num_block_producers in if List.length bp_keypairs < num_block_producers then @@ -151,7 +151,7 @@ module Network_config = struct (* delegation currently unsupported *) ; delegate = None ; timing - }) + } ) in let bp_accounts = List.map (List.zip_exn block_producers bp_keypairs) @@ -173,8 +173,8 @@ module Network_config = struct (* an account may be used for snapp transactions, so add permissions *) - let (permissions - : Runtime_config.Accounts.Single.Permissions.t option) = + let (permissions : Runtime_config.Accounts.Single.Permissions.t option) + = Some { edit_state = None ; send = None @@ -199,7 +199,7 @@ module Network_config = struct ; delegate = None ; timing ; permissions - }) + } ) in (* DAEMON CONFIG *) let constraint_constants = @@ -238,7 +238,7 @@ module Network_config = struct let genesis_constants = Or_error.ok_exn (Genesis_ledger_helper.make_genesis_constants ~logger - ~default:Genesis_constants.compiled runtime_config) + ~default:Genesis_constants.compiled runtime_config ) in let constants : Test_config.constants = { constraints = constraint_constants; genesis = genesis_constants } @@ -405,7 +405,7 @@ module Network_manager = struct Deferred.return ([%log info] "Existing namespace of same name detected; removing to start \ - clean") + clean" ) in Util.run_cmd_exn "/" "kubectl" [ "delete"; "namespace"; network_config.terraform.testnet_name ] @@ -435,7 +435,7 @@ module Network_manager = struct ~f:(fun ch -> Network_config.to_terraform network_config |> Terraform.to_string - |> Out_channel.output_string ch) ; + |> Out_channel.output_string ch ) ; let testnet_log_filter = Network_config.testnet_log_filter network_config in let cons_workload workload_id node_info : Kubernetes_network.Workload.t = { workload_id; node_info } @@ -451,7 +451,7 @@ module Network_manager = struct (String.sub network_config.terraform.snark_worker_public_key ~pos: (String.length network_config.terraform.snark_worker_public_key - 6) - ~len:6) + ~len:6 ) in let snark_coordinator_workloads = if network_config.terraform.snark_worker_replicas > 0 then @@ -466,7 +466,7 @@ module Network_manager = struct [ cons_workload ("snark-worker-" ^ snark_coordinator_id) (List.init network_config.terraform.snark_worker_replicas - ~f:(fun _i -> cons_node_info "worker")) + ~f:(fun _i -> cons_node_info "worker") ) ] else [] in @@ -474,13 +474,13 @@ module Network_manager = struct List.map network_config.terraform.block_producer_configs ~f:(fun bp_config -> cons_workload bp_config.name - [ cons_node_info ~network_keypair:bp_config.keypair "mina" ]) + [ cons_node_info ~network_keypair:bp_config.keypair "mina" ] ) in let archive_workloads = List.init network_config.terraform.archive_node_count ~f:(fun i -> cons_workload (sprintf "archive-%d" (i + 1)) - [ cons_node_info ~has_archive_container:true "mina" ]) + [ cons_node_info ~has_archive_container:true "mina" ] ) in let workloads_by_id = let all_workloads = diff --git a/src/lib/integration_test_cloud_engine/stack_driver_log_engine.ml b/src/lib/integration_test_cloud_engine/stack_driver_log_engine.ml index 177529a7d5b..11f27522f11 100644 --- a/src/lib/integration_test_cloud_engine/stack_driver_log_engine.ml +++ b/src/lib/integration_test_cloud_engine/stack_driver_log_engine.ml @@ -22,13 +22,13 @@ let or_error_list_fold ls ~init ~f = let open Or_error.Let_syntax in List.fold ls ~init:(return init) ~f:(fun acc_or_error el -> let%bind acc = acc_or_error in - f acc el) + f acc el ) let or_error_list_map ls ~f = let open Or_error.Let_syntax in or_error_list_fold ls ~init:[] ~f:(fun t el -> let%map h = f el in - h :: t) + h :: t ) let log_filter_of_event_type ev_existential = let open Event_type in @@ -59,7 +59,7 @@ let all_event_types_log_filter = let disjunction = event_filters |> List.map ~f:(fun filter -> - nest (filter |> List.map ~f:nest |> String.concat ~sep:" AND ")) + nest (filter |> List.map ~f:nest |> String.concat ~sep:" AND ") ) |> String.concat ~sep:" OR " in [ disjunction ] @@ -265,7 +265,7 @@ let parse_event_from_log_entry ~logger ~network log_entry = (Or_error.errorf "failed to find node by pod id \"%s\"; known pod ids = [%s]" pod_id - (Kubernetes_network.all_pod_ids network |> String.concat ~sep:"; ")) + (Kubernetes_network.all_pod_ids network |> String.concat ~sep:"; ") ) in let%bind payload = find json log_entry [ "jsonPayload" ] in let%map event = @@ -286,7 +286,7 @@ let parse_event_from_log_entry ~logger ~network log_entry = [%log spam] "parsing daemon structured event, event_id = %s" (Option.value (Option.( >>| ) msg.event_id Structured_log_events.string_of_id) - ~default:"") ; + ~default:"" ) ; match msg.event_id with | Some _ -> Event_type.parse_daemon_event msg @@ -314,7 +314,7 @@ let rec pull_subscription_in_background ~logger ~network ~event_writer | Error e -> [%log warn] "Error parsing log $error" ~metadata:[ ("error", `String (Error.to_string_hum e)) ] ) ; - Deferred.unit) + Deferred.unit ) in let%bind () = after (Time.Span.of_ms 10000.0) in pull_subscription_in_background ~logger ~network ~event_writer ~subscription diff --git a/src/lib/integration_test_cloud_engine/terraform.ml b/src/lib/integration_test_cloud_engine/terraform.ml index 91fa49530ef..9cfc32ff6f2 100644 --- a/src/lib/integration_test_cloud_engine/terraform.ml +++ b/src/lib/integration_test_cloud_engine/terraform.ml @@ -49,7 +49,7 @@ module Block = struct ; zone >>| field "zone" ] in - `Assoc (List.filter_map fields ~f:Fn.id)) + `Assoc (List.filter_map fields ~f:Fn.id) ) end module Module = struct @@ -68,7 +68,7 @@ module Block = struct ; ("source", `String source) ] in - `Assoc (const_fields @ args)) + `Assoc (const_fields @ args) ) end module Data = struct diff --git a/src/lib/integration_test_lib/dsl.ml b/src/lib/integration_test_lib/dsl.ml index 3f97d8979b4..2a9f63b53b0 100644 --- a/src/lib/integration_test_lib/dsl.ml +++ b/src/lib/integration_test_lib/dsl.ml @@ -19,7 +19,7 @@ let broadcast_pipe_fold_until_with_timeout reader ~timeout_duration true | `Continue x -> acc := x ; - false )) + false ) ) in match%map Timeout.await () ~timeout_duration read_deferred with | `Ok () -> @@ -146,7 +146,7 @@ module Make (Engine : Intf.Engine.S) () : [ Error.createf "wait_for hit an error waiting for %s" condition.description ; error - ]) + ] ) | `Success -> let soft_timeout_was_met = Time.(add start_time soft_timeout >= now ()) @@ -204,7 +204,7 @@ module Make (Engine : Intf.Engine.S) () : [%log fatal] "Error occured $error" ~metadata:[ ("error", Logger.Message.to_yojson message) ] ; on_fatal_error message ) ; - Deferred.return `Continue) + Deferred.return `Continue ) : 'a Event_router.event_subscription ) ; log_error_accumulator @@ -213,13 +213,13 @@ module Make (Engine : Intf.Engine.S) () : let lift error_array = DynArray.to_list error_array |> List.map ~f:(fun (node, message) -> - { node_id = Node.id node; error_message = message }) + { node_id = Node.id node; error_message = message } ) in let time_of_error { error_message; _ } = error_message.timestamp in let accumulate_errors = List.fold ~init:Error_accumulator.empty ~f:(fun acc error -> Error_accumulator.add_to_context acc error.node_id error - ~time_of_error) + ~time_of_error ) in let soft_errors = accumulate_errors (lift warn @ lift faulty_peer) in let hard_errors = accumulate_errors (lift error @ lift fatal) in diff --git a/src/lib/integration_test_lib/event_router.ml b/src/lib/integration_test_lib/event_router.ml index 7d9ffb54432..d7fbf3202bc 100644 --- a/src/lib/integration_test_lib/event_router.ml +++ b/src/lib/integration_test_lib/event_router.ml @@ -32,7 +32,7 @@ module Make (Engine : Intf.Engine.S) () : Event_type.Map.update !handlers event_type ~f:(fun registered_handlers -> registered_handlers |> Option.value ~default:[] |> List.filter ~f:(fun (Event_handler (registered_id, _, _, _)) -> - not (List.mem ids registered_id ~equal:Event_handler_id.equal))) + not (List.mem ids registered_id ~equal:Event_handler_id.equal) ) ) let dispatch_event handlers node event = let open Event_type in @@ -49,7 +49,7 @@ module Make (Engine : Intf.Engine.S) () : ( handler_id , handler_finished_ivar , handler_type - , handler_callback )) = + , handler_callback ) ) = handler in match%map @@ -60,7 +60,7 @@ module Make (Engine : Intf.Engine.S) () : None | `Stop result -> Ivar.fill handler_finished_ivar result ; - Some handler_id) + Some handler_id ) in unregister_event_handlers_by_id handlers (Event_type.type_of_event event) @@ -75,7 +75,7 @@ module Make (Engine : Intf.Engine.S) () : [ ("event", Event_type.event_to_yojson event) ; ("node", `String (Node.id node)) ] ; - dispatch_event handlers node event)) ; + dispatch_event handlers node event ) ) ; { logger; handlers } let on t event_type ~f = diff --git a/src/lib/integration_test_lib/event_type.ml b/src/lib/integration_test_lib/event_type.ml index 1943d76a93e..6b8dbe34fcd 100644 --- a/src/lib/integration_test_lib/event_type.ml +++ b/src/lib/integration_test_lib/event_type.ml @@ -8,7 +8,7 @@ let or_error_list_fold ls ~init ~f = let open Or_error.Let_syntax in List.fold ls ~init:(return init) ~f:(fun acc_or_error el -> let%bind acc = acc_or_error in - f acc el) + f acc el ) let get_metadata (message : Logger.Message.t) key = match String.Map.find message.metadata key with @@ -19,7 +19,7 @@ let get_metadata (message : Logger.Message.t) key = let parse id (m : Logger.Message.t) = Or_error.try_with (fun () -> - Structured_log_events.parse_exn id (Map.to_alist m.metadata)) + Structured_log_events.parse_exn id (Map.to_alist m.metadata) ) let bad_parse = Or_error.error_string "bad parse" @@ -127,7 +127,7 @@ module Transition_frontier_diff_application = struct Or_error.error_string "unexpected transition frontier diff name" ) | _ -> - Or_error.error_string "unexpected transition frontier diff format") + Or_error.error_string "unexpected transition frontier diff format" ) let parse = From_daemon_log (structured_event_id, parse_func) end @@ -462,7 +462,7 @@ let structured_events_table = all_event_types |> List.filter_map ~f:(fun t -> let%map event_id = to_structured_event_id t in - (Structured_log_events.string_of_id event_id, t)) + (Structured_log_events.string_of_id event_id, t) ) |> String.Table.of_alist_exn let of_structured_event_id id = @@ -479,7 +479,7 @@ let puppeteer_events_table = all_event_types |> List.filter_map ~f:(fun t -> let%map event_id = to_puppeteer_event_string t in - (event_id, t)) + (event_id, t) ) |> String.Table.of_alist_exn let of_puppeteer_event_string id = String.Table.find puppeteer_events_table id @@ -540,7 +540,7 @@ let parse_puppeteer_event (message : Puppeteer_message.t) = "the events emitting from the puppeteer script are either not \ formatted correctly, or are trying to emit an event_type which is \ not actually recognized by the integration test framework. this \ - should not happen and is a programmer error") + should not happen and is a programmer error" ) let dispatch_exn : type a b c. a t -> a -> b t -> (b -> c) -> c = fun t1 e t2 h -> diff --git a/src/lib/integration_test_lib/gossip_state.ml b/src/lib/integration_test_lib/gossip_state.ml index e6e84926102..04478e4242a 100644 --- a/src/lib/integration_test_lib/gossip_state.ml +++ b/src/lib/integration_test_lib/gossip_state.ml @@ -113,9 +113,9 @@ let stats (type a) List.filter_map gossip_states ~f:(fun gos_state -> if List.exists exclusion_list ~f:(fun id -> - String.equal id gos_state.node_id) + String.equal id gos_state.node_id ) then None - else Some gos_state) + else Some gos_state ) in let event_type_gossip_states = List.map gossip_states_filtered ~f:(fun gos_state -> @@ -123,7 +123,7 @@ let stats (type a) Set.union [ event_type_gossip_state_by_direction.sent ; event_type_gossip_state_by_direction.received - ]) + ] ) in ( `Seen_by_all (Set.size (Set.inter event_type_gossip_states)) , `Seen_by_some (Set.size (Set.union event_type_gossip_states)) ) diff --git a/src/lib/integration_test_lib/json_parsing.ml b/src/lib/integration_test_lib/json_parsing.ml index 1ecd714e729..762d5015b0f 100644 --- a/src/lib/integration_test_lib/json_parsing.ml +++ b/src/lib/integration_test_lib/json_parsing.ml @@ -44,7 +44,7 @@ let valid_commands_with_statuses : List.map cmds ~f: (Mina_base.With_status.of_yojson - Mina_base.User_command.Valid.of_yojson) + Mina_base.User_command.Valid.of_yojson ) in List.fold cmd_or_errors ~init:[] ~f:(fun accum cmd_or_err -> match (accum, cmd_or_err) with @@ -58,7 +58,7 @@ let valid_commands_with_statuses : "valid_commands_with_statuses: unable to parse JSON for user \ command" | cmds, Ok cmd -> - cmd :: cmds) + cmd :: cmds ) | _ -> failwith "valid_commands_with_statuses: expected `List" @@ -78,7 +78,7 @@ let rec find (parser : 'a parser) (json : Yojson.Safe.t) (path : string list) : "failed to find path using key '%s' in json object { %s }" key (String.concat ~sep:", " (List.map assoc ~f:(fun (s, json) -> - sprintf "\"%s\":%s" s (Yojson.Safe.to_string json)))) + sprintf "\"%s\":%s" s (Yojson.Safe.to_string json) ) ) ) in find parser entry path' | _ -> diff --git a/src/lib/integration_test_lib/malleable_error.ml b/src/lib/integration_test_lib/malleable_error.ml index fc82beea055..0a97073180a 100644 --- a/src/lib/integration_test_lib/malleable_error.ml +++ b/src/lib/integration_test_lib/malleable_error.ml @@ -124,7 +124,7 @@ let soften_error m = | Error { Hard_fail.soft_errors; hard_errors } -> Ok (Result_accumulator.create () - (Error_accumulator.merge soft_errors hard_errors)) + (Error_accumulator.merge soft_errors hard_errors) ) let is_ok = function Ok acc -> Result_accumulator.is_ok acc | _ -> false @@ -164,7 +164,7 @@ let combine_errors (malleable_errors : 'a t list) : 'a list t = List.fold_left malleable_errors ~init:(return []) ~f:(fun acc el -> let%bind t = acc in let%map h = el in - h :: t) + h :: t ) in List.rev values @@ -249,7 +249,7 @@ module List = struct let%map _ = fold ls ~init:0 ~f:(fun i x -> let%map () = f i x in - i + 1) + i + 1 ) in () @@ -299,7 +299,7 @@ let%test_module "malleable error unit tests" = f (f (f (f (f (return 0))))) in let%map expected = T.return 5 in - [%test_eq: int inner] ~equal:(equal_inner Int.equal) actual expected) + [%test_eq: int inner] ~equal:(equal_inner Int.equal) actual expected ) let%test_unit "malleable error test 2: completes string computation when \ no errors" = @@ -312,7 +312,7 @@ let%test_module "malleable error unit tests" = in let%map expected = T.return "123" in [%test_eq: string inner] ~equal:(equal_inner String.equal) actual - expected) + expected ) let%test_unit "malleable error test 3: ok result that accumulates soft \ errors" = @@ -335,7 +335,7 @@ let%test_module "malleable error unit tests" = } in [%test_eq: string inner] ~equal:(equal_inner String.equal) actual - expected) + expected ) let%test_unit "malleable error test 4: do a basic hard error" = Async.Thread_safe.block_on_async_exn (fun () -> @@ -354,7 +354,7 @@ let%test_module "malleable error unit tests" = } in [%test_eq: string inner] ~equal:(equal_inner String.equal) actual - expected) + expected ) let%test_unit "malleable error test 5: hard error that accumulates a soft \ error" = @@ -377,7 +377,7 @@ let%test_module "malleable error unit tests" = } in [%test_eq: string inner] ~equal:(equal_inner String.equal) actual - expected) + expected ) let%test_unit "malleable error test 6: hard error with multiple soft \ errors accumulating" = @@ -404,5 +404,5 @@ let%test_module "malleable error unit tests" = } in [%test_eq: string inner] ~equal:(equal_inner String.equal) actual - expected) + expected ) end ) diff --git a/src/lib/integration_test_lib/network_state.ml b/src/lib/integration_test_lib/network_state.ml index 5124fc0585e..0a1550ed8a0 100644 --- a/src/lib/integration_test_lib/network_state.ml +++ b/src/lib/integration_test_lib/network_state.ml @@ -31,7 +31,7 @@ module Make ; node_initialization : bool String.Map.t [@to_yojson map_to_yojson ~f_key_to_string:ident ~f_value_to_yojson:(fun b -> - `Bool b)] + `Bool b )] ; gossip_received : Gossip_state.t String.Map.t [@to_yojson map_to_yojson ~f_key_to_string:ident @@ -43,12 +43,12 @@ module Make ; blocks_produced_by_node : State_hash.t list String.Map.t [@to_yojson map_to_yojson ~f_key_to_string:ident ~f_value_to_yojson:(fun ls -> - `List (List.map State_hash.to_yojson ls))] + `List (List.map State_hash.to_yojson ls) )] ; blocks_seen_by_node : State_hash.Set.t String.Map.t [@to_yojson map_to_yojson ~f_key_to_string:ident ~f_value_to_yojson:(fun set -> `List - (State_hash.Set.to_list set |> List.map State_hash.to_yojson))] + (State_hash.Set.to_list set |> List.map State_hash.to_yojson) )] ; blocks_including_txn : State_hash.Set.t Transaction_hash.Map.t [@to_yojson map_to_yojson ~f_key_to_string:Transaction_hash.to_base58_check @@ -99,7 +99,7 @@ module Make | None -> [ block_produced.state_hash ] | Some ls -> - List.cons block_produced.state_hash ls) + List.cons block_produced.state_hash ls ) in { state with epoch = block_produced.global_slot @@ -111,7 +111,7 @@ module Make + snarked_ledgers_generated ; blocks_produced_by_node = blocks_produced_by_node_map } - else state)) + else state ) ) : _ Event_router.event_subscription ) ; (* handle_update_best_tips *) ignore @@ -130,7 +130,7 @@ module Make String.Map.set state.best_tips_by_node ~key:(Node.id node) ~data:new_best_tip in - { state with best_tips_by_node = best_tips_by_node' }))) + { state with best_tips_by_node = best_tips_by_node' } ) ) ) : _ Event_router.event_subscription ) ; let handle_gossip_received event_type = ignore @@ -155,12 +155,12 @@ module Make [ ( "event" , Event_type.event_to_yojson (Event_type.Event - (event_type, gossip_with_direction)) ) + (event_type, gossip_with_direction) ) ) ] ; Gossip_state.add gossip_state event_type gossip_with_direction ; - gossip_state) - })) + gossip_state ) + } ) ) : _ Event_router.event_subscription ) in handle_gossip_received Block_gossip ; @@ -178,7 +178,7 @@ module Make String.Map.set state.node_initialization ~key:(Node.id node) ~data:true in - { state with node_initialization = node_initialization' })) + { state with node_initialization = node_initialization' } ) ) : _ Event_router.event_subscription ) ; (* handle_node_offline *) ignore @@ -197,7 +197,7 @@ module Make { state with node_initialization = node_initialization' ; best_tips_by_node = best_tips_by_node' - })) + } ) ) : _ Event_router.event_subscription ) ; (* handle_breadcrumb_added *) ignore @@ -212,13 +212,13 @@ module Make ~f:(fun block_set -> State_hash.Set.add (Option.value block_set ~default:State_hash.Set.empty) - breadcrumb.state_hash) + breadcrumb.state_hash ) in let txn_hash_list = List.map breadcrumb.user_commands ~f:(fun cmd_with_status -> cmd_with_status.With_status.data |> User_command.forget_check - |> Transaction_hash.hash_command) + |> Transaction_hash.hash_command ) in let blocks_including_txn' = List.fold txn_hash_list ~init:state.blocks_including_txn @@ -233,12 +233,12 @@ module Make "adding or updating txn_hash %s to \ state.blocks_including_txn" (Transaction_hash.to_base58_check hash) ; - Transaction_hash.Map.set accum ~key:hash ~data:block_set') + Transaction_hash.Map.set accum ~key:hash ~data:block_set' ) in { state with blocks_seen_by_node = blocks_seen_by_node' ; blocks_including_txn = blocks_including_txn' - })) + } ) ) : _ Event_router.event_subscription ) ; (r, w) end diff --git a/src/lib/integration_test_lib/test_config.ml b/src/lib/integration_test_lib/test_config.ml index 9b0d2d26431..ef03c4659bb 100644 --- a/src/lib/integration_test_lib/test_config.ml +++ b/src/lib/integration_test_lib/test_config.ml @@ -64,6 +64,6 @@ let default = ; snark_worker_fee = "0.025" ; snark_worker_public_key = (let pk, _ = (Lazy.force Key_gen.Sample_keypairs.keypairs).(0) in - Signature_lib.Public_key.Compressed.to_string pk) + Signature_lib.Public_key.Compressed.to_string pk ) ; proof_config = proof_config_default } diff --git a/src/lib/integration_test_lib/test_error.ml b/src/lib/integration_test_lib/test_error.ml index 7bac719ba89..11f705dfaff 100644 --- a/src/lib/integration_test_lib/test_error.ml +++ b/src/lib/integration_test_lib/test_error.ml @@ -47,15 +47,15 @@ module Error_accumulator = struct in let errors_by_time = List.fold new_errors ~init:errors.errors_by_time ~f:(fun acc error -> - Time.Map.add_multi acc ~key:(time_of_error error) ~data:error) + Time.Map.add_multi acc ~key:(time_of_error error) ~data:error ) in - { errors with errors_by_time }) + { errors with errors_by_time } ) let error_count { from_current_context; contextualized_errors } = let num_current_context = List.length from_current_context in let num_contextualized = String.Map.fold contextualized_errors ~init:0 ~f:(fun ~key:_ ~data sum -> - Time.Map.length data.errors_by_time + sum) + Time.Map.length data.errors_by_time + sum ) in num_current_context + num_contextualized @@ -63,7 +63,7 @@ module Error_accumulator = struct let context_errors = String.Map.data contextualized_errors |> List.bind ~f:(fun { errors_by_time; _ } -> - Time.Map.data errors_by_time) + Time.Map.data errors_by_time ) |> List.concat in from_current_context @ context_errors @@ -107,7 +107,7 @@ module Error_accumulator = struct { errors with errors_by_time = Time.Map.map errors.errors_by_time ~f:(List.map ~f) - }) + } ) } (* This only iterates over contextualized errors. You must check errors in the current context manually *) @@ -115,12 +115,12 @@ module Error_accumulator = struct let contexts_by_time = contextualized_errors |> String.Map.to_alist |> List.map ~f:(fun (ctx, errors) -> - (errors.introduction_time, (ctx, errors))) + (errors.introduction_time, (ctx, errors)) ) |> Time.Map.of_alist_multi in let f = List.iter ~f:(fun (context, { errors_by_time; _ }) -> - errors_by_time |> Time.Map.data |> List.concat |> f context) + errors_by_time |> Time.Map.data |> List.concat |> f context ) in Time.Map.iter contexts_by_time ~f @@ -139,7 +139,7 @@ module Error_accumulator = struct | None -> data | Some data' -> - resolve_conflict data' data)) + resolve_conflict data' data ) ) in let merge_contextualized_errors a_errors b_errors = { introduction_time = @@ -168,7 +168,7 @@ module Error_accumulator = struct ~init:(Map.empty cmp, Map.empty cmp) ~f:(fun ~key ~data (left, right) -> let l, r = f data in - (Map.add_exn left ~key ~data:l, Map.add_exn right ~key ~data:r)) + (Map.add_exn left ~key ~data:l, Map.add_exn right ~key ~data:r) ) in partition_map (module String) @@ -180,7 +180,7 @@ module Error_accumulator = struct ctx_errors.errors_by_time ~f:(List.partition_tf ~f) in ( { ctx_errors with errors_by_time = l } - , { ctx_errors with errors_by_time = r } )) + , { ctx_errors with errors_by_time = r } ) ) in let a = { from_current_context = from_current_context_a diff --git a/src/lib/integration_test_lib/util.ml b/src/lib/integration_test_lib/util.ml index adfd62b105c..b8293467d5a 100644 --- a/src/lib/integration_test_lib/util.ml +++ b/src/lib/integration_test_lib/util.ml @@ -24,7 +24,7 @@ let check_cmd_output ~prog ~args output = (indent ( prog ^ " " ^ String.concat ~sep:" " - (List.map args ~f:(fun arg -> "\"" ^ arg ^ "\"")) )) ; + (List.map args ~f:(fun arg -> "\"" ^ arg ^ "\"")) ) ) ; print_endline "=== STDOUT ===" ; print_endline (indent output.stdout) ; print_endline "=== STDERR ===" ; @@ -100,7 +100,7 @@ module Make (Engine : Intf.Engine.S) = struct let pub_key_of_node = make_get_key ~f:(fun nk -> - nk.keypair.public_key |> Signature_lib.Public_key.compress) + nk.keypair.public_key |> Signature_lib.Public_key.compress ) let priv_key_of_node = make_get_key ~f:(fun nk -> nk.keypair.private_key) @@ -150,13 +150,13 @@ module Make (Engine : Intf.Engine.S) = struct let acc = G.add_vertex acc x in List.fold xs ~init:acc ~f:(fun acc y -> let acc = G.add_vertex acc y in - G.add_edge acc x y)) + G.add_edge acc x y ) ) let fetch_connectivity_data ~logger nodes = let open Malleable_error.Let_syntax in Malleable_error.List.map nodes ~f:(fun node -> let%map response = Engine.Network.Node.must_get_peer_id ~logger node in - (node, response)) + (node, response) ) let assert_peers_completely_connected nodes_and_responses = (* this check checks if every single peer in the network is connected to every other peer, in graph theory this network would be a complete graph. this property will only hold true on small networks *) @@ -177,7 +177,7 @@ module Make (Engine : Intf.Engine.S) = struct in Malleable_error.ok_if_true (List.mem connected_peers p ~equal:String.equal) - ~error_type:`Hard ~error) + ~error_type:`Hard ~error ) in let nodes_by_peer_id = @@ -188,7 +188,7 @@ module Make (Engine : Intf.Engine.S) = struct Malleable_error.List.iter nodes_and_responses ~f:(fun (_, (peer_id, connected_peers)) -> check_peer_connected_to_all_others ~nodes_by_peer_id ~peer_id - ~connected_peers) + ~connected_peers ) let assert_peers_cant_be_partitioned ~max_disconnections nodes_and_responses = (* this check checks that the network does NOT become partitioned into isolated subgraphs, even if n nodes are hypothetically removed from the network.*) @@ -196,7 +196,7 @@ module Make (Engine : Intf.Engine.S) = struct let open Graph_algorithms in let () = Out_channel.with_file "/tmp/network-graph.dot" ~f:(fun c -> - G.output_graph c (graph_of_adjacency_list responses)) + G.output_graph c (graph_of_adjacency_list responses) ) in (* Check that the network cannot be disconnected by removing up to max_disconnections number of nodes. *) match diff --git a/src/lib/integration_test_lib/wait_condition.ml b/src/lib/integration_test_lib/wait_condition.ml index 5f01f60f2e0..ea5900ad0ff 100644 --- a/src/lib/integration_test_lib/wait_condition.ml +++ b/src/lib/integration_test_lib/wait_condition.ml @@ -4,7 +4,7 @@ open Mina_transaction let all_equal ~equal ~compare ls = Option.value_map (List.hd ls) ~default:true ~f:(fun h -> - List.equal equal [ h ] (List.find_all_dups ~compare ls)) + List.equal equal [ h ] (List.find_all_dups ~compare ls) ) module Make (Engine : Intf.Engine.S) @@ -63,7 +63,7 @@ struct ~f:(fun (state : Network_state.t) -> List.for_all nodes ~f:(fun node -> String.Map.find state.node_initialization (Node.id node) - |> Option.value ~default:false)) + |> Option.value ~default:false ) ) |> with_timeouts ~soft_timeout:(Literal (Time.Span.of_min 10.0)) ~hard_timeout:(Literal (Time.Span.of_min 15.0)) @@ -101,7 +101,7 @@ struct in let best_tips = List.map nodes ~f:(fun node -> - String.Map.find state.best_tips_by_node (Node.id node)) + String.Map.find state.best_tips_by_node (Node.id node) ) in if List.for_all best_tips ~f:Option.is_some @@ -185,7 +185,7 @@ struct let snapp_opt = List.find breadcrumb_added.user_commands ~f:(fun cmd_with_status -> cmd_with_status.With_status.data |> User_command.forget_check - |> command_matches_parties) + |> command_matches_parties ) in match snapp_opt with | Some cmd_with_status -> @@ -202,7 +202,7 @@ struct Predicate_failure (Error.createf "Unexpected status in matching payment: %s" ( Transaction_status.to_yojson actual_status - |> Yojson.Safe.to_string )) + |> Yojson.Safe.to_string ) ) | None -> Predicate_continuation () in @@ -211,7 +211,7 @@ struct { description = sprintf "snapp with fee payer %s and other parties (%s)" (Signature_lib.Public_key.Compressed.to_base58_check - parties.fee_payer.body.public_key) + parties.fee_payer.body.public_key ) (Parties.Call_forest.Tree.fold_forest ~init:"" parties.other_parties ~f:(fun acc party -> let str = @@ -221,7 +221,7 @@ struct if !is_first then ( is_first := false ; str ) - else acc ^ ", " ^ str)) + else acc ^ ", " ^ str ) ) ; predicate = Event_predicate (Event_type.Breadcrumb_added, (), check) ; soft_timeout = Slots soft_timeout_in_slots ; hard_timeout = Slots (soft_timeout_in_slots * 2) diff --git a/src/lib/interruptible/interruptible.ml b/src/lib/interruptible/interruptible.ml index 1ff6f0ecb18..5baba942404 100644 --- a/src/lib/interruptible/interruptible.ml +++ b/src/lib/interruptible/interruptible.ml @@ -13,7 +13,7 @@ module T = struct | None -> let interruption_signal = Ivar.create () in Deferred.upon (Ivar.read t.interruption_signal) (fun signal -> - Ivar.fill_if_empty interruption_signal (f signal)) ; + Ivar.fill_if_empty interruption_signal (f signal) ) ; interruption_signal in { interruption_signal; d = Deferred.Result.map_error ~f t.d } @@ -58,7 +58,7 @@ module T = struct | Ok t' -> Ivar.fill_if_empty t'.interruption_signal signal | Error _ -> - ())) ; + () ) ) ; let interruption_signal = match Ivar.peek t.interruption_signal with | Some interruption_signal -> @@ -72,7 +72,7 @@ module T = struct (Ivar.fill_if_empty interruption_signal) | Error signal -> (* [t] was interrupted by [signal], [f] was not run. *) - Ivar.fill_if_empty interruption_signal signal) ; + Ivar.fill_if_empty interruption_signal signal ) ; interruption_signal in Deferred.upon (Ivar.read interruption_signal) (fun signal -> @@ -88,7 +88,7 @@ module T = struct () | None -> (* The computation we bound hasn't resolved, interrupt it. *) - Ivar.fill_if_empty t.interruption_signal signal) ; + Ivar.fill_if_empty t.interruption_signal signal ) ; { interruption_signal; d = Deferred.Result.bind t.d ~f:(fun t' -> t'.d) } let return a = @@ -179,7 +179,7 @@ let%test_unit "monad gets interrupted" = let%bind () = wait 130. in Ivar.fill ivar () ; let%map () = wait 100. in - assert (!r = 1)) + assert (!r = 1) ) let%test_unit "monad gets interrupted within nested binds" = Run_in_thread.block_on_async_exn (fun () -> @@ -199,7 +199,7 @@ let%test_unit "monad gets interrupted within nested binds" = let%bind () = wait 130. in Ivar.fill ivar () ; let%map () = wait 100. in - assert (!r = 1)) + assert (!r = 1) ) let%test_unit "interruptions still run finally blocks" = Run_in_thread.block_on_async_exn (fun () -> @@ -219,7 +219,7 @@ let%test_unit "interruptions still run finally blocks" = let%bind () = wait 130. in Ivar.fill ivar () ; let%map () = wait 100. in - assert (!r = 2)) + assert (!r = 2) ) let%test_unit "interruptions branches do not cancel each other" = Run_in_thread.block_on_async_exn (fun () -> @@ -252,4 +252,4 @@ let%test_unit "interruptions branches do not cancel each other" = Ivar.fill ivar_s () ; let%map () = wait 100. in assert (!r = 1) ; - assert (!s = 2)) + assert (!s = 2) ) diff --git a/src/lib/key_cache/async/key_cache_async.ml b/src/lib/key_cache/async/key_cache_async.ml index eecde3eb7be..c3121e1783e 100644 --- a/src/lib/key_cache/async/key_cache_async.ml +++ b/src/lib/key_cache/async/key_cache_async.ml @@ -19,7 +19,7 @@ let on_disk to_string read write prefix = | `No | `Unknown -> return (Or_error.errorf "directory %s does not exist or cannot be read" - prefix) + prefix ) | `Yes -> write key v (path key) in @@ -53,7 +53,7 @@ let s3 to_string read ~bucket_prefix ~install_path = [ ("url", `String uri_string) ; ("local_file_path", `String file_path) ] ; - err)) + err ) ) in [%log trace] "Downloaded key to key cache" ~metadata: @@ -97,7 +97,7 @@ let read spec { Disk_storable.to_string; read = r; write = w } k = | S3 { bucket_prefix; install_path } -> let%bind.Deferred () = Unix.mkdir ~p:() install_path in let%map res = (s3 to_string r ~bucket_prefix ~install_path).read k in - (res, `Cache_hit)) + (res, `Cache_hit) ) let write spec { Disk_storable.to_string; read = r; write = w } k v = let%map errs = @@ -112,6 +112,6 @@ let write spec { Disk_storable.to_string; read = r; write = w } k v = | S3 { bucket_prefix = _; install_path = _ } -> Deferred.Or_error.return () in - match%map res with Error e -> Some e | Ok () -> None) + match%map res with Error e -> Some e | Ok () -> None ) in match errs with [] -> Ok () | errs -> Error (Error.of_list errs) diff --git a/src/lib/key_cache/sync/key_cache_sync.ml b/src/lib/key_cache/sync/key_cache_sync.ml index 34c6bc05e14..df58c5b8fdd 100644 --- a/src/lib/key_cache/sync/key_cache_sync.ml +++ b/src/lib/key_cache/sync/key_cache_sync.ml @@ -35,19 +35,19 @@ let s3 to_string read ~bucket_prefix ~install_path = Result.map_error (ksprintf Unix.system "curl --fail --silent --show-error -o \"%s\" \"%s\"" file_path - uri_string) ~f:(function + uri_string ) ~f:(function | `Exit_non_zero _ as e -> Error.of_string (Unix.Exit.to_string_hum (Error e)) | `Signal s -> Error.createf "died after receiving %s (signal number %d)" - (Signal.to_string s) (Signal.to_system_int s)) + (Signal.to_string s) (Signal.to_system_int s) ) |> Result.map_error ~f:(fun err -> [%log trace] "Could not download key to key cache" ~metadata: [ ("url", `String uri_string) ; ("local_file_path", `String file_path) ] ; - err) + err ) in [%log trace] "Downloaded key to key cache" ~metadata: @@ -64,11 +64,11 @@ module Disk_storable = struct (* TODO: Make more efficient *) let read _ ~path = Or_error.try_with (fun () -> - Binable.of_string m (In_channel.read_all path)) + Binable.of_string m (In_channel.read_all path) ) in let write _k t path = Or_error.try_with (fun () -> - Out_channel.write_all path ~data:(Binable.to_string m t)) + Out_channel.write_all path ~data:(Binable.to_string m t) ) in { to_string; read; write } @@ -93,7 +93,7 @@ let read spec { Disk_storable.to_string; read = r; write = w } k = ((s3 to_string r ~bucket_prefix ~install_path).read k, `Cache_hit) in let%map.Or_error res = res in - (res, cache_hit)) + (res, cache_hit) ) let write spec { Disk_storable.to_string; read = r; write = w } k v = let errs = @@ -108,6 +108,6 @@ let write spec { Disk_storable.to_string; read = r; write = w } k v = | S3 { bucket_prefix = _; install_path = _ } -> Or_error.return () in - match res with Error e -> Some e | Ok () -> None) + match res with Error e -> Some e | Ok () -> None ) in match errs with [] -> Ok () | errs -> Error (Error.of_list errs) diff --git a/src/lib/key_gen/gen/gen.ml b/src/lib/key_gen/gen/gen.ml index 97e941378b6..74282318b4a 100644 --- a/src/lib/key_gen/gen/gen.ml +++ b/src/lib/key_gen/gen/gen.ml @@ -20,7 +20,7 @@ let keypairs = (* This key is also at the start of all the release ledgers. It's needed to generate a valid genesis transition *) (Keypair.of_private_key_exn (Private_key.of_base58_check_exn - "EKFKgDtU3rcuFTVSEpmpXSkukjmX4cKefYREi6Sdsk7E7wsT7KRw")) + "EKFKgDtU3rcuFTVSEpmpXSkukjmX4cKefYREi6Sdsk7E7wsT7KRw" ) ) generated_keypairs let expr ~loc = @@ -35,12 +35,12 @@ let expr ~loc = [ estring (Binable.to_string (module Public_key.Compressed.Stable.Latest) - (Public_key.compress public_key)) + (Public_key.compress public_key) ) ; estring (Binable.to_string (module Private_key.Stable.Latest) - private_key) - ])) + private_key ) + ] ) ) in let%expr conv (pk, sk) = ( Core_kernel.Binable.of_string @@ -69,14 +69,14 @@ let json = Compressed.to_base58_check (compress kp.public_key)) ) ; ( "private_key" , `String (Private_key.to_base58_check kp.private_key) ) - ])) + ] ) ) let main () = Out_channel.with_file "sample_keypairs.ml" ~f:(fun ml_file -> let fmt = Format.formatter_of_out_channel ml_file in - Pprintast.top_phrase fmt (Ptop_def (structure ~loc:Ppxlib.Location.none))) ; + Pprintast.top_phrase fmt (Ptop_def (structure ~loc:Ppxlib.Location.none)) ) ; Out_channel.with_file "sample_keypairs.json" ~f:(fun json_file -> - Yojson.pretty_to_channel json_file json) ; + Yojson.pretty_to_channel json_file json ) ; exit 0 let () = main () diff --git a/src/lib/key_value_database/key_value_database.ml b/src/lib/key_value_database/key_value_database.ml index e4562e3d30c..2abb29381e3 100644 --- a/src/lib/key_value_database/key_value_database.ml +++ b/src/lib/key_value_database/key_value_database.ml @@ -90,7 +90,7 @@ module Make_mock let to_sexp t ~key_sexp ~value_sexp = Key.Table.to_alist t |> List.map ~f:(fun (key, value) -> - [%sexp_of: Sexp.t * Sexp.t] (key_sexp key, value_sexp value)) + [%sexp_of: Sexp.t * Sexp.t] (key_sexp key, value_sexp value) ) |> [%sexp_of: Sexp.t list] let create _ = Key.Table.create () diff --git a/src/lib/ledger_catchup/normal_catchup.ml b/src/lib/ledger_catchup/normal_catchup.ml index e1d0122c4d5..25324310bf2 100644 --- a/src/lib/ledger_catchup/normal_catchup.ml +++ b/src/lib/ledger_catchup/normal_catchup.ml @@ -158,8 +158,8 @@ let verify_transition ~logger ~consensus_constants ~trust_system ~frontier let rec fold_until ~(init : 'accum) ~(f : - 'accum -> 'a -> ('accum, 'final) Continue_or_stop.t Deferred.Or_error.t) - ~(finish : 'accum -> 'final Deferred.Or_error.t) : + 'accum -> 'a -> ('accum, 'final) Continue_or_stop.t Deferred.Or_error.t + ) ~(finish : 'accum -> 'final Deferred.Or_error.t) : 'a list -> 'final Deferred.Or_error.t = function | [] -> finish init @@ -182,7 +182,7 @@ let find_map_ok l ~f = | Error current_error -> `Repeat (tl, current_error :: errors) | Ok result -> - `Finished (Ok result))) + `Finished (Ok result) ) ) type download_state_hashes_error = [ `Peer_moves_too_fast of Error.t @@ -273,7 +273,7 @@ let download_state_hashes ~logger ~trust_system ~network ~frontier ~peers (Ok (peer, Frontier_base.Breadcrumb.state_hash final, acc)) | None -> Continue_or_stop.Continue - (Unsigned.UInt32.pred blockchain_length, hash :: acc)) + (Unsigned.UInt32.pred blockchain_length, hash :: acc) ) ~finish:(fun (blockchain_length, acc) -> let module T = struct type t = State_hash.t list [@@deriving to_yojson] @@ -299,17 +299,17 @@ let download_state_hashes ~logger ~trust_system ~network ~frontier ~peers @@ `No_common_ancestor (Error.of_string "Requested block doesn't have a path to the root of our \ - frontier") + frontier" ) else let err_msg = sprintf !"Peer %{sexp:Network_peer.Peer.t} moves too fast" peer in - Result.fail @@ `Peer_moves_too_fast (Error.of_string err_msg))) + Result.fail @@ `Peer_moves_too_fast (Error.of_string err_msg) ) ) >>| fun (peer, final, hashes) -> let (_ : State_hash.t) = List.fold hashes ~init:final ~f:(fun parent h -> Transition_frontier.Catchup_hash_tree.add hash_tree h ~parent ~job ; - h) + h ) in (peer, hashes) @@ -318,7 +318,7 @@ let verify_against_hashes transitions hashes = && List.for_all2_exn transitions hashes ~f:(fun transition hash -> State_hash.equal (State_hash.With_state_hashes.state_hash transition) - hash) + hash ) let rec partition size = function | [] -> @@ -373,7 +373,7 @@ let download_transitions ~target_hash ~logger ~trust_system ~network let busy = Peer.Hash_set.create () in Deferred.Or_error.List.concat_map (partition Transition_frontier.max_catchup_chunk_length - hashes_of_missing_transitions) ~how:`Parallel ~f:(fun hashes -> + hashes_of_missing_transitions ) ~how:`Parallel ~f:(fun hashes -> let%bind.Async.Deferred peers = Mina_networking.peers network in let peers = Peers_pool.create ~busy ~preferred:[ preferred_peer ] @@ -434,7 +434,7 @@ let download_transitions ~target_hash ~logger ~trust_system ~network ~hash_data: (Fn.compose Mina_state.Protocol_state.hashes (Fn.compose Header.protocol_state - Mina_block.header))) + Mina_block.header ) ) ) in if not @@ verify_against_hashes hashed_transitions hashes then ( let error_msg = @@ -451,7 +451,7 @@ let download_transitions ~target_hash ~logger ~trust_system ~network else Deferred.Or_error.return @@ List.map hashed_transitions ~f:(fun data -> - Envelope.Incoming.wrap_peer ~data ~sender:peer)) + Envelope.Incoming.wrap_peer ~data ~sender:peer ) ) in Hash_set.remove busy peer ; match res with @@ -460,7 +460,7 @@ let download_transitions ~target_hash ~logger ~trust_system ~network | Error e -> go (e :: errs) ) in - go []) + go [] ) let verify_transitions_and_build_breadcrumbs ~logger ~(precomputed_values : Precomputed_values.t) ~trust_system ~verifier @@ -478,14 +478,14 @@ let verify_transitions_and_build_breadcrumbs ~logger match%bind Validation.validate_proofs ~verifier ~genesis_state_hash (List.map transitions ~f:(fun t -> - Validation.wrap (Envelope.Incoming.data t))) + Validation.wrap (Envelope.Incoming.data t) ) ) with | Ok tvs -> return (Ok (List.map2_exn transitions tvs ~f:(fun e data -> (* this does not update the envelope timestamps *) - { e with data }))) + { e with data } ) ) ) | Error (`Verifier_error error) -> [%log warn] ~metadata:[ ("error", Error_json.error_to_yojson error) ] @@ -529,7 +529,7 @@ let verify_transitions_and_build_breadcrumbs ~logger | Ok (`Building_path transition_with_initial_validation) -> Deferred.Or_error.return @@ Continue_or_stop.Continue - (transition_with_initial_validation :: acc)) + (transition_with_initial_validation :: acc) ) ~finish:(fun acc -> let validation_end_time = Core.Time.now () in [%log debug] @@ -553,13 +553,13 @@ let verify_transitions_and_build_breadcrumbs ~logger |> Header.protocol_state |> Mina_state.Protocol_state.previous_state_hash in - Deferred.Or_error.return (acc, initial_state_hash)) + Deferred.Or_error.return (acc, initial_state_hash) ) in let build_start_time = Core.Time.now () in let trees_of_transitions = Option.fold (Non_empty_list.of_list_opt transitions_with_initial_validation) ~init:subtrees ~f:(fun _ transitions -> - [ Rose_tree.of_non_empty_list ~subtrees transitions ]) + [ Rose_tree.of_non_empty_list ~subtrees transitions ] ) in let open Deferred.Let_syntax in match%bind @@ -602,7 +602,7 @@ let garbage_collect_subtrees ~logger ~subtrees = List.iter subtrees ~f:(fun subtree -> ignore ( Rose_tree.map subtree ~f:Cached.invalidate_with_failure - : 'a Rose_tree.t )) ; + : 'a Rose_tree.t ) ) ; [%log trace] "garbage collected failed cached transitions" let run ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier @@ -613,7 +613,7 @@ let run ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier * [ `Ledger_catchup of unit Ivar.t | `Catchup_scheduler ] , Strict_pipe.crash Strict_pipe.buffered , unit ) - Strict_pipe.Writer.t) ~unprocessed_transition_cache : unit = + Strict_pipe.Writer.t ) ~unprocessed_transition_cache : unit = let hash_tree = match Transition_frontier.catchup_tree frontier with | Hash t -> @@ -655,9 +655,9 @@ let run ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier | Local -> acc_inner | Remote peer -> - peer :: acc_inner) + peer :: acc_inner ) in - cached_peers @ acc_outer) + cached_peers @ acc_outer ) |> List.dedup_and_sort ~compare:Peer.compare in match%bind @@ -680,7 +680,7 @@ let run ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier [ ( "errors" , `List (List.map errors ~f:(fun err -> - `String (display_error err))) ) + `String (display_error err) ) ) ) ] ; let%bind random_peers = Mina_networking.peers network >>| List.permute @@ -699,7 +699,7 @@ let run ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier [ ( "errors" , `List (List.map errors ~f:(fun err -> - `String (display_error err))) ) + `String (display_error err) ) ) ) ] ; if contains_no_common_ancestor errors then List.iter subtrees ~f:(fun subtree -> @@ -718,14 +718,14 @@ let run ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier Cached.peek cached_transition |> Envelope.Incoming.data |> Validation.block_with_hash - |> State_hash.With_state_hashes.state_hash) + |> State_hash.With_state_hashes.state_hash ) in [%log error] ~metadata: [ ( "state_hashes_of_children" , `List (List.map children_state_hashes - ~f:State_hash.to_yojson) ) + ~f:State_hash.to_yojson ) ) ; ( "state_hash" , State_hash.to_yojson ( transition @@ -749,7 +749,7 @@ let run ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier Mina_metrics.( Counter.inc Rejected_blocks.no_common_ancestor ( Float.of_int - @@ (1 + List.length children_transitions) ))) ; + @@ (1 + List.length children_transitions) )) ) ; return (Error (Error.of_list @@ List.map errors ~f:to_error)) ) @@ -762,7 +762,7 @@ let run ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier [ ( "hashes_of_missing_transitions" , `List (List.map hashes_of_missing_transitions - ~f:State_hash.to_yojson) ) + ~f:State_hash.to_yojson ) ) ] !"Number of missing transitions is %d" num_of_missing_transitions ; @@ -791,8 +791,8 @@ let run ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier (fun breadcrumb -> Cached.peek breadcrumb |> Transition_frontier.Breadcrumb.state_hash - |> State_hash.to_yojson) - tree)) ) + |> State_hash.to_yojson ) + tree ) ) ) ] "about to write to the catchup breadcrumbs pipe" ; if Strict_pipe.Writer.is_closed catchup_breadcrumbs_writer then ( @@ -826,7 +826,7 @@ let run ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier Mina_metrics.( Gauge.set Transition_frontier_controller.catchup_time_ms Core.Time.(Span.to_ms @@ diff (now ()) start_time)) ; - Catchup_jobs.decr ()))) + Catchup_jobs.decr () ) ) ) (* Unit tests *) @@ -856,7 +856,7 @@ let%test_module "Ledger_catchup tests" = Async.Thread_safe.block_on_async_exn (fun () -> Verifier.create ~logger ~proof_level ~constraint_constants ~conf_dir:None - ~pids:(Child_processes.Termination.create_pid_table ())) + ~pids:(Child_processes.Termination.create_pid_table ()) ) let downcast_transition transition = let transition = @@ -956,9 +956,9 @@ let%test_module "Ledger_catchup tests" = catchup_breadcrumbs ~f:(fun breadcrumb_tree1 breadcrumb_tree2 -> Mina_block.Validated.equal (Transition_frontier.Breadcrumb.validated_transition - breadcrumb_tree1) + breadcrumb_tree1 ) (Transition_frontier.Breadcrumb.validated_transition - breadcrumb_tree2)) + breadcrumb_tree2 ) ) in if not catchup_breadcrumbs_are_best_tip_path then failwith @@ -987,7 +987,7 @@ let%test_module "Ledger_catchup tests" = (best_tip peer_net.state.frontier)) in Thread_safe.block_on_async_exn (fun () -> - test_successful_catchup ~my_net ~target_best_tip_path)) + test_successful_catchup ~my_net ~target_best_tip_path ) ) let%test_unit "catchup succeeds even if the parent transition is already \ in the frontier" = @@ -1003,7 +1003,7 @@ let%test_module "Ledger_catchup tests" = [ Transition_frontier.best_tip peer_net.state.frontier ] in Thread_safe.block_on_async_exn (fun () -> - test_successful_catchup ~my_net ~target_best_tip_path)) + test_successful_catchup ~my_net ~target_best_tip_path ) ) let%test_unit "catchup fails if one of the parent transitions fail" = Quickcheck.test ~trials:1 @@ -1054,7 +1054,8 @@ let%test_module "Ledger_catchup tests" = (Ivar.read (Cache_lib.Cached.final_state cached_transition)) in if not ([%equal: [ `Failed | `Success of _ ]] result `Failed) then - failwith "expected ledger catchup to fail, but it succeeded")) + failwith "expected ledger catchup to fail, but it succeeded" ) + ) (* TODO: fix and re-enable *) (* diff --git a/src/lib/ledger_catchup/super_catchup.ml b/src/lib/ledger_catchup/super_catchup.ml index 3ec8fe9bed2..cce060ce38a 100644 --- a/src/lib/ledger_catchup/super_catchup.ml +++ b/src/lib/ledger_catchup/super_catchup.ml @@ -72,7 +72,7 @@ module G = Graph.Graphviz.Dot (struct | None -> () | Some parent -> - f { child; parent }) + f { child; parent } ) let graph_attributes (_ : t) = [ `Rankdir `LeftToRight ] @@ -285,9 +285,9 @@ let find_map_ok ?how xs ~f = | `Ok (Ok x) -> Ivar.fill_if_empty res (Ok x) | `Ok (Error e) -> - errs := e :: !errs) + errs := e :: !errs ) in - Ivar.fill_if_empty res (Error !errs)) ; + Ivar.fill_if_empty res (Error !errs) ) ; Ivar.read res type download_state_hashes_error = @@ -328,14 +328,14 @@ let try_to_connect_hash_chain t hashes ~frontier | None, Some b -> f (`Breadcrumb b) | None, None -> - Continue (Unsigned.UInt32.pred blockchain_length, hash :: acc)) + Continue (Unsigned.UInt32.pred blockchain_length, hash :: acc) ) ~finish:(fun (blockchain_length, acc) -> let module T = struct type t = State_hash.t list [@@deriving to_yojson] end in let all_hashes = List.map (Transition_frontier.all_breadcrumbs frontier) ~f:(fun b -> - Frontier_base.Breadcrumb.state_hash b) + Frontier_base.Breadcrumb.state_hash b ) in [%log debug] ~metadata: @@ -347,7 +347,7 @@ let try_to_connect_hash_chain t hashes ~frontier if Unsigned.UInt32.compare blockchain_length blockchain_length_of_root <= 0 then Result.fail `No_common_ancestor - else Result.fail `Peer_moves_too_fast) + else Result.fail `Peer_moves_too_fast ) module Downloader = struct module Key = struct @@ -363,35 +363,36 @@ module Downloader = struct include Comparable.Make (T) end - include Downloader.Make - (Key) - (struct - include Attempt_history.Attempt - - let download : t = { failure_reason = `Download } - - let worth_retrying (t : t) = - match t.failure_reason with `Download -> true | _ -> false - end) - (struct - type t = Mina_block.t - - let key (t : t) = - ( ( Mina_block.header t |> Header.protocol_state - |> Mina_state.Protocol_state.hashes ) - .state_hash - , Mina_block.blockchain_length t ) - end) - (struct - type t = (State_hash.t * Length.t) option - end) + include + Downloader.Make + (Key) + (struct + include Attempt_history.Attempt + + let download : t = { failure_reason = `Download } + + let worth_retrying (t : t) = + match t.failure_reason with `Download -> true | _ -> false + end) + (struct + type t = Mina_block.t + + let key (t : t) = + ( ( Mina_block.header t |> Header.protocol_state + |> Mina_state.Protocol_state.hashes ) + .state_hash + , Mina_block.blockchain_length t ) + end) + (struct + type t = (State_hash.t * Length.t) option + end) end let with_lengths hs ~target_length = List.filter_mapi (Non_empty_list.to_list hs) ~f:(fun i x -> let open Option.Let_syntax in let%map x_len = Length.sub target_length (Length.of_int i) in - (x, x_len)) + (x, x_len) ) (* returns a list of state-hashes with the older ones at the front *) let download_state_hashes t ~logger ~trust_system ~network ~frontier @@ -452,7 +453,7 @@ let download_state_hashes t ~logger ~trust_system ~network ~frontier Downloader.mark_preferred downloader peer ~now ; Ok x | Error e -> - Error e )) + Error e ) ) let get_state_hashes = () @@ -468,7 +469,7 @@ module Initial_validate_batcher = struct ~logger: (Logger.create ~metadata:[ ("name", `String "initial_validate_batcher") ] - ()) + () ) ~how_to_add:`Insert ~max_weight_per_call:1000 ~weight:(fun _ -> 1) ~compare_init:(fun e1 e2 -> @@ -477,7 +478,7 @@ module Initial_validate_batcher = struct | 0 -> compare_envelope e1 e2 | c -> - c) + c ) (fun xs -> let input = function `Partially_validated x | `Init x -> x in let genesis_state_hash = @@ -489,8 +490,8 @@ module Initial_validate_batcher = struct |> With_hash.map_hash ~f:(fun state_hash -> { State_hash.State_hashes.state_hash ; state_body_hash = None - }) - |> Validation.wrap) + } ) + |> Validation.wrap ) |> Validation.validate_proofs ~verifier ~genesis_state_hash >>| function | Ok tvs -> @@ -498,7 +499,7 @@ module Initial_validate_batcher = struct | Error `Invalid_proof -> Ok (List.map xs ~f:(fun x -> `Potentially_invalid (input x))) | Error (`Verifier_error e) -> - Error e) + Error e ) let verify (t : _ t) = verify t end @@ -521,7 +522,7 @@ module Verify_work_batcher = struct (Logger.create ~metadata:[ ("name", `String "verify_work_batcher") ] ()) ~weight:(fun (x : input) -> List.fold ~init:0 (works x) ~f:(fun acc { proofs; _ } -> - acc + One_or_two.length proofs)) + acc + One_or_two.length proofs ) ) ~max_weight_per_call:1000 ~how_to_add:`Insert ~compare_init:(fun e1 e2 -> let len (x : input) = @@ -531,7 +532,7 @@ module Verify_work_batcher = struct | 0 -> compare_envelope e1 e2 | c -> - c) + c ) (fun xs -> let input : _ -> input = function | `Partially_validated x | `Init x -> @@ -542,7 +543,7 @@ module Verify_work_batcher = struct |> List.concat_map ~f:(fun { fee; prover; proofs } -> let msg = Sok_message.create ~fee ~prover in One_or_two.to_list - (One_or_two.map proofs ~f:(fun p -> (p, msg))))) + (One_or_two.map proofs ~f:(fun p -> (p, msg))) ) ) |> Verifier.verify_transaction_snarks verifier >>| function | Ok true -> @@ -550,7 +551,7 @@ module Verify_work_batcher = struct | Ok false -> Ok (List.map xs ~f:(fun x -> `Potentially_invalid (input x))) | Error e -> - Error e) + Error e ) let verify (t : _ t) = verify t end @@ -620,7 +621,7 @@ let check_invariant ~downloader t = [%test_eq: int] (Downloader.total_jobs downloader) (Hashtbl.count t.nodes ~f:(fun node -> - Node.State.Enum.equal (Node.State.enum node.state) To_download)) + Node.State.Enum.equal (Node.State.enum node.state) To_download ) ) let download s d ~key ~attempts = let logger = Logger.create () in @@ -662,7 +663,7 @@ let create_node ~downloader t x = { Node.state; state_hash = h; blockchain_length; attempts; parent; result } in upon (Ivar.read node.result) (fun _ -> - Downloader.cancel downloader (h, blockchain_length)) ; + Downloader.cancel downloader (h, blockchain_length) ) ; Transition_frontier.Full_catchup_tree.add_state t.states node ; Hashtbl.set t.nodes ~key:h ~data:node ; ( try check_invariant ~downloader t @@ -690,7 +691,7 @@ let pick ~constants let forest_pick forest = with_return (fun { return } -> List.iter forest ~f:(Rose_tree.iter ~f:return) ; - assert false) + assert false ) let setup_state_machine_runner ~t ~verifier ~downloader ~logger ~precomputed_values ~trust_system ~frontier ~unprocessed_transition_cache @@ -711,7 +712,7 @@ let setup_state_machine_runner ~t ~verifier ~downloader ~logger | `Invalid_staged_ledger_hash of Error.t | `Fatal_error of exn ] ) Result.t - Deferred.t) = + Deferred.t ) = (* setup_state_machine_runner returns a fully configured lambda function, which is the state machine runner *) let initial_validation_batcher = Initial_validate_batcher.create ~verifier ~precomputed_values @@ -732,7 +733,7 @@ let setup_state_machine_runner ~t ~verifier ~downloader ~logger ~metadata: [ ( "error" , Option.value_map ~default:`Null error ~f:(fun e -> - `String (Error.to_string_hum e)) ) + `String (Error.to_string_hum e) ) ) ; ("reason", Attempt_history.Attempt.reason_to_yojson failure_reason) ] ; node.attempts <- @@ -745,7 +746,7 @@ let setup_state_machine_runner ~t ~verifier ~downloader ~logger (To_download (download "failed" downloader ~key:(state_hash, node.blockchain_length) - ~attempts:node.attempts)) ; + ~attempts:node.attempts ) ) ; run_node node in let step d : (_, [ `Finished ]) Deferred.Result.t = @@ -775,15 +776,15 @@ let setup_state_machine_runner ~t ~verifier ~downloader ~logger (Hashtbl.count t.nodes ~f:(fun node -> Node.State.Enum.equal (Node.State.enum node.state) - To_download)) ) + To_download ) ) ) ; ("total_nodes", `Int (Hashtbl.length t.nodes)) ; ( "node_states" , let s = Node.State.Enum.Table.create () in Hashtbl.iter t.nodes ~f:(fun node -> - Hashtbl.incr s (Node.State.enum node.state)) ; + Hashtbl.incr s (Node.State.enum node.state) ) ; `List (List.map (Hashtbl.to_alist s) ~f:(fun (k, v) -> - `List [ Node.State.Enum.to_yojson k; `Int v ])) ) + `List [ Node.State.Enum.to_yojson k; `Int v ] ) ) ) ; ("total_jobs", `Int (Downloader.total_jobs downloader)) ; ("downloader", Downloader.to_yojson downloader) ] @@ -886,7 +887,7 @@ let setup_state_machine_runner ~t ~verifier ~downloader ~logger ( Cached.invalidate_with_failure av : Mina_block.almost_valid_block Envelope.Incoming.t ) ; finish t node (Error ()) ; - Error `Finished) + Error `Finished ) in set_state t node (To_build_breadcrumb (`Parent parent, av)) ; run_node node @@ -930,7 +931,7 @@ let setup_state_machine_runner ~t ~verifier ~downloader ~logger Error.tag (Error.of_string (sprintf "Parent breadcrumb with state_hash %s not found" - (State_hash.to_base58_check parent_hash))) + (State_hash.to_base58_check parent_hash) ) ) ~tag:"parent breadcrumb not found" in failed ~error:e ~sender:av.sender `Build_breadcrumb @@ -963,14 +964,14 @@ let run_catchup ~logger ~trust_system ~verifier ~network ~frontier ~build_func Cached.t Rose_tree.t list ) - Strict_pipe.Reader.t) ~precomputed_values ~unprocessed_transition_cache + Strict_pipe.Reader.t ) ~precomputed_values ~unprocessed_transition_cache ~(catchup_breadcrumbs_writer : ( (Transition_frontier.Breadcrumb.t, State_hash.t) Cached.t Rose_tree.t list * [ `Ledger_catchup of unit Ivar.t | `Catchup_scheduler ] , Strict_pipe.crash Strict_pipe.buffered , unit ) - Strict_pipe.Writer.t) = + Strict_pipe.Writer.t ) = let t = match Transition_frontier.catchup_tree frontier with | Full t -> @@ -986,19 +987,20 @@ let run_catchup ~logger ~trust_system ~verifier ~network ~frontier ~build_func Option.merge ~f: (pick - ~constants:precomputed_values.Precomputed_values.consensus_constants) + ~constants:precomputed_values.Precomputed_values.consensus_constants ) in let pre_context (trees : (Mina_block.initial_valid_block Envelope.Incoming.t, _) Cached.t Rose_tree.t - list) = + list ) = let f tree = let best = ref None in Rose_tree.iter tree ~f:(fun (x : - (Mina_block.initial_valid_block Envelope.Incoming.t, _) Cached.t) + (Mina_block.initial_valid_block Envelope.Incoming.t, _) Cached.t + ) -> let x, _ = (Cached.peek x).data in best := @@ -1006,7 +1008,7 @@ let run_catchup ~logger ~trust_system ~verifier ~network ~frontier ~build_func (Some (With_hash.map ~f:(Fn.compose Header.protocol_state Mina_block.header) - x))) ; + x ) ) ) ; !best in List.map trees ~f |> List.reduce ~f:combine |> Option.join @@ -1048,7 +1050,7 @@ let run_catchup ~logger ~trust_system ~verifier ~network ~frontier ~build_func in Mina_networking.get_transition_chain ~heartbeat_timeout:(Time_ns.Span.of_sec sec) - ~timeout:(Time.Span.of_sec sec) network peer (List.map hs ~f:fst)) + ~timeout:(Time.Span.of_sec sec) network peer (List.map hs ~f:fst) ) ~peers:(fun () -> Mina_networking.peers network) ~knowledge_context: (Broadcast_pipe.map best_tip_r @@ -1056,18 +1058,18 @@ let run_catchup ~logger ~trust_system ~verifier ~network ~frontier ~build_func (Option.map ~f:(fun x -> ( State_hash.With_state_hashes.state_hash x , Mina_state.Protocol_state.consensus_state x.data - |> Consensus.Data.Consensus_state.blockchain_length )))) + |> Consensus.Data.Consensus_state.blockchain_length ) ) ) ) ~knowledge in check_invariant ~downloader t ; let () = Downloader.set_check_invariant (fun downloader -> - check_invariant ~downloader t) + check_invariant ~downloader t ) in every ~stop (Time.Span.of_sec 10.) (fun () -> [%log debug] ~metadata:[ ("states", to_yojson t) ] - "Catchup states $states") ; + "Catchup states $states" ) ; let run_state_machine = setup_state_machine_runner ~t ~verifier ~downloader ~logger ~precomputed_values ~trust_system ~frontier ~unprocessed_transition_cache @@ -1087,7 +1089,7 @@ let run_catchup ~logger ~trust_system ~verifier ~network ~frontier ~build_func Option.equal State_hash.equal (f x) (f y) in if eq prev_ctx ctx then Deferred.unit - else Broadcast_pipe.Writer.write best_tip_w ctx) ; + else Broadcast_pipe.Writer.write best_tip_w ctx ) ; don't_wait_for ( (* primary super_catchup business logic begins here, in this second `don't_wait_for` *) [%log debug] @@ -1143,7 +1145,7 @@ let run_catchup ~logger ~trust_system ~verifier ~network ~frontier ~build_func in Result.ok (try_to_connect_hash_chain t p ~frontier - ~blockchain_length_of_target_hash)) + ~blockchain_length_of_target_hash ) ) with | None -> (* if the target_parent_hash's own parent is not a part of the transition frontier, then the entire chain of blocks connecting some node in the @@ -1155,7 +1157,7 @@ let run_catchup ~logger ~trust_system ~verifier ~network ~frontier ~build_func | Local -> acc | Remote peer -> - Peer.Set.add acc peer) + Peer.Set.add acc peer ) in download_state_hashes t ~logger ~trust_system ~network ~frontier ~downloader ~target_length @@ -1189,14 +1191,14 @@ let run_catchup ~logger ~trust_system ~verifier ~network ~frontier ~build_func Cached.peek cached_transition |> Envelope.Incoming.data |> Validation.block_with_hash - |> State_hash.With_state_hashes.state_hash) + |> State_hash.With_state_hashes.state_hash ) in [%log error] ~metadata: [ ( "state_hashes_of_children" , `List (List.map children_state_hashes - ~f:State_hash.to_yojson) ) + ~f:State_hash.to_yojson ) ) ; ( "state_hash" , State_hash.to_yojson ( Validation.block_with_hash transition @@ -1217,13 +1219,13 @@ let run_catchup ~logger ~trust_system ~verifier ~network ~frontier ~build_func Mina_metrics.( Counter.inc Rejected_blocks.no_common_ancestor ( Float.of_int - @@ (1 + List.length children_transitions) ))) ; + @@ (1 + List.length children_transitions) )) ) ; List.iter forest ~f:(fun subtree -> Rose_tree.iter subtree ~f:(fun cached -> ( Cached.invalidate_with_failure cached : Mina_block.initial_valid_block Envelope.Incoming.t ) - |> ignore)) + |> ignore ) ) | Ok (root, state_hashes) -> [%log' debug t.logger] ~metadata: @@ -1231,11 +1233,11 @@ let run_catchup ~logger ~trust_system ~verifier ~network ~frontier ~build_func ; ( "node_states" , let s = Node.State.Enum.Table.create () in Hashtbl.iter t.nodes ~f:(fun node -> - Hashtbl.incr s (Node.State.enum node.state)) ; + Hashtbl.incr s (Node.State.enum node.state) ) ; `List (List.map (Hashtbl.to_alist s) ~f:(fun (k, v) -> - `List [ Node.State.Enum.to_yojson k; `Int v ])) - ) + `List [ Node.State.Enum.to_yojson k; `Int v ] ) + ) ) ] "before entering state machine. node_states: $node_states" ; let root = @@ -1261,7 +1263,7 @@ let run_catchup ~logger ~trust_system ~verifier ~network ~frontier ~build_func in ignore ( run_state_machine node - : (unit, [ `Finished ]) Deferred.Result.t ))) ; + : (unit, [ `Finished ]) Deferred.Result.t ) ) ) ; ignore ( List.fold state_hashes ~init:(root.state_hash, root.blockchain_length) @@ -1273,8 +1275,8 @@ let run_catchup ~logger ~trust_system ~verifier ~network ~frontier ~build_func in don't_wait_for (run_state_machine node >>| ignore) ) ; - (h, l)) - : State_hash.t * Length.t ) ))) + (h, l) ) + : State_hash.t * Length.t ) ) ) ) let run ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier ~catchup_job_reader ~catchup_breadcrumbs_writer @@ -1283,17 +1285,17 @@ let run ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier run_catchup ~logger ~trust_system ~verifier ~network ~frontier ~catchup_job_reader ~precomputed_values ~unprocessed_transition_cache ~catchup_breadcrumbs_writer - ~build_func:Transition_frontier.Breadcrumb.build) + ~build_func:Transition_frontier.Breadcrumb.build ) (* Unit tests *) (* let run_test_only ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier - ~catchup_job_reader ~catchup_breadcrumbs_writer - ~unprocessed_transition_cache : unit = - run_catchup ~logger ~trust_system ~verifier ~network ~frontier ~catchup_job_reader - ~precomputed_values ~unprocessed_transition_cache - ~catchup_breadcrumbs_writer ~build_func:(Transition_frontier.Breadcrumb.For_tests.build_fail) - |> don't_wait_for *) + ~catchup_job_reader ~catchup_breadcrumbs_writer + ~unprocessed_transition_cache : unit = + run_catchup ~logger ~trust_system ~verifier ~network ~frontier ~catchup_job_reader + ~precomputed_values ~unprocessed_transition_cache + ~catchup_breadcrumbs_writer ~build_func:(Transition_frontier.Breadcrumb.For_tests.build_fail) + |> don't_wait_for *) let%test_module "Ledger_catchup tests" = ( module struct @@ -1321,7 +1323,7 @@ let%test_module "Ledger_catchup tests" = Async.Thread_safe.block_on_async_exn (fun () -> Verifier.create ~logger ~proof_level ~constraint_constants ~conf_dir:None - ~pids:(Child_processes.Termination.create_pid_table ())) + ~pids:(Child_processes.Termination.create_pid_table ()) ) (* let mock_verifier = Async.Thread_safe.block_on_async_exn (fun () -> @@ -1427,7 +1429,7 @@ let%test_module "Ledger_catchup tests" = (String.concat [ "read of breadcrumbs_reader pipe timed out, n= " ; string_of_int n - ]) + ] ) | `Result res -> ( match res with | `Eof -> @@ -1478,7 +1480,7 @@ let%test_module "Ledger_catchup tests" = (* We force evaluation of state body hash for both blocks for further equality check *) let _hash1 = Mina_block.Validated.state_body_hash b1 in let _hash2 = Mina_block.Validated.state_body_hash b2 in - Mina_block.Validated.equal b1 b2) + Mina_block.Validated.equal b1 b2 ) in if not catchup_breadcrumbs_are_best_tip_path then failwith @@ -1506,7 +1508,7 @@ let%test_module "Ledger_catchup tests" = (best_tip peer_net.state.frontier)) in Thread_safe.block_on_async_exn (fun () -> - test_successful_catchup ~my_net ~target_best_tip_path)) + test_successful_catchup ~my_net ~target_best_tip_path ) ) let%test_unit "catchup succeeds even if the parent transition is already \ in the frontier" = @@ -1522,7 +1524,7 @@ let%test_module "Ledger_catchup tests" = [ Transition_frontier.best_tip peer_net.state.frontier ] in Thread_safe.block_on_async_exn (fun () -> - test_successful_catchup ~my_net ~target_best_tip_path)) + test_successful_catchup ~my_net ~target_best_tip_path ) ) let%test_unit "catchup succeeds even if the parent transition is already \ in the frontier" = @@ -1538,7 +1540,7 @@ let%test_module "Ledger_catchup tests" = [ Transition_frontier.best_tip peer_net.state.frontier ] in Thread_safe.block_on_async_exn (fun () -> - test_successful_catchup ~my_net ~target_best_tip_path)) + test_successful_catchup ~my_net ~target_best_tip_path ) ) let%test_unit "when catchup fails to download state hashes, catchup will \ properly clear the unprocessed_transition_cache of the \ @@ -1605,7 +1607,7 @@ let%test_module "Ledger_catchup tests" = failwith "target transition should've been invalidated with a \ - failure")) + failure" ) ) let%test_unit "when catchup fails to download a block, catchup will retry \ and attempt again" = @@ -1724,7 +1726,7 @@ let%test_module "Ledger_catchup tests" = (List.length catchup_tree_node_list) in failwith failstring - else () ))) + else () ) ) ) (* let%test_unit "when initial validation of a blocks fails (except for the \ verifier_unreachable case), then catchup will cancel the \ diff --git a/src/lib/linked_tree/linked_tree.ml b/src/lib/linked_tree/linked_tree.ml index c059b0903b7..6b496b27582 100644 --- a/src/lib/linked_tree/linked_tree.ml +++ b/src/lib/linked_tree/linked_tree.ml @@ -85,7 +85,7 @@ module Make (Key : Key) : S with module Key = Key = struct Hashtbl.remove t.table node.key ; List.iter node.children ~f:(fun child -> child.parent <- `Key node.key ; - go child) ) + go child ) ) in List.iter t.roots ~f:go diff --git a/src/lib/logger/impl.ml b/src/lib/logger/impl.ml index d0cdb3fdc8b..826d10288dd 100644 --- a/src/lib/logger/impl.ml +++ b/src/lib/logger/impl.ml @@ -72,17 +72,18 @@ module Metadata = struct | _ -> Error "Unexpected object" - include Binable.Of_binable - (Core_kernel.String.Stable.V1) - (struct - type nonrec t = t - - let to_binable t = to_yojson t |> Yojson.Safe.to_string - - let of_binable (t : string) : t = - Yojson.Safe.from_string t |> of_yojson |> Result.ok - |> Option.value_exn - end) + include + Binable.Of_binable + (Core_kernel.String.Stable.V1) + (struct + type nonrec t = t + + let to_binable t = to_yojson t |> Yojson.Safe.to_string + + let of_binable (t : string) : t = + Yojson.Safe.from_string t |> of_yojson |> Result.ok + |> Option.value_exn + end) end end] @@ -98,7 +99,7 @@ module Metadata = struct let extend (t : t) alist = List.fold_left alist ~init:t ~f:(fun acc (key, data) -> - String.Map.set acc ~key ~data) + String.Map.set acc ~key ~data ) let merge (a : t) (b : t) = extend a (String.Map.to_alist b) end @@ -129,7 +130,7 @@ module Message = struct | `Interpolate item -> Metadata.mem t.metadata item | `Raw _ -> - true) + true ) end module Processor = struct @@ -156,7 +157,7 @@ module Processor = struct if Level.compare msg.level Level.Spam = 0 then `Assoc (List.filter msg_json_fields ~f:(fun (k, _) -> - not (String.equal k "source"))) + not (String.equal k "source") ) ) else `Assoc msg_json_fields in Some (Yojson.Safe.to_string json) @@ -179,7 +180,7 @@ module Processor = struct | Error err -> Option.iter msg.source ~f:(fun source -> printf "logproc interpolation error in %s: %s\n" source.location - err) ; + err ) ; None | Ok (str, extra) -> let formatted_extra = @@ -247,7 +248,7 @@ module Consumer_registry = struct | Some str -> Transport.transport transport str | None -> - ())) + () ) ) ~if_not_found:(fun _ -> let (Processor.T ((module Processor), processor)) = Processor.raw () in let (Transport.T ((module Transport), transport)) = @@ -257,7 +258,7 @@ module Consumer_registry = struct | Some str -> Transport.transport transport str | None -> - ()) + () ) end [%%versioned @@ -328,7 +329,7 @@ let raw ({ id; _ } as t) msg = let add_tags_to_metadata metadata tags = Option.value_map tags ~default:metadata ~f:(fun tags -> let tags_item = ("tags", `List (List.map tags ~f:Tags.to_yojson)) in - tags_item :: metadata) + tags_item :: metadata ) let log t ~level ~module_ ~location ?tags ?(metadata = []) ?event_id fmt = let metadata = add_tags_to_metadata metadata tags in diff --git a/src/lib/logger/test/logger_test.ml b/src/lib/logger/test/logger_test.ml index 49a97fbfa09..700ec699f82 100644 --- a/src/lib/logger/test/logger_test.ml +++ b/src/lib/logger/test/logger_test.ml @@ -32,7 +32,7 @@ let%test_unit "Logger.Dumb_logrotate rotates logs when expected" = ~processor:(Logger.Processor.raw ()) ~transport: (Logger_file_system.dumb_logrotate ~directory ~log_filename ~max_size - ~num_rotate) ; + ~num_rotate ) ; run_test ~last_size:0 ~rotations:0 ~rotation_expected:false with exn -> ignore (Unix.system ("rm -rf " ^ directory) : Unix.Exit_or_signal.t) ; diff --git a/src/lib/logproc_lib/filter.ml b/src/lib/logproc_lib/filter.ml index eaa7a03bb09..1ac4ef06b60 100644 --- a/src/lib/logproc_lib/filter.ml +++ b/src/lib/logproc_lib/filter.ml @@ -195,7 +195,7 @@ module Parser = struct | Some base -> access base <|> return base | None -> - access Ast.value_this) + access Ast.value_this ) "value_exp" let cmp_exp = @@ -206,7 +206,7 @@ module Parser = struct [ lift2 List.cons (string {|\/|}) inner ; char '/' *> return [] ; lift2 List.cons (take 1) inner - ]) + ] ) >>| String.concat ~sep:"" in char '/' *> commit *> inner @@ -220,7 +220,7 @@ module Parser = struct ; pad ws (stringc "!=") *> value_exp >>| Fn.flip Ast.cmp_neq ; pad ws (stringc "in") *> value_exp >>| Fn.flip Ast.cmp_in ; pad ws (stringc "match") *> regex >>| Fn.flip Ast.cmp_match - ]) + ] ) <* commit "cmp_exp" let bool_exp = @@ -239,7 +239,7 @@ module Parser = struct ; stringc "||" *> return Ast.bool_or ] in - infix main (pad ws infix_op)) + infix main (pad ws infix_op) ) "bool_exp" let parser = ws *> bool_exp <* ws <* end_of_input @@ -253,7 +253,7 @@ module Parser = struct | _ -> err in - sprintf "invalid syntax (%s)" msg) + sprintf "invalid syntax (%s)" msg ) end module Interpreter = struct @@ -319,11 +319,11 @@ module Interpreter = struct | `List items -> List.exists items ~f:(Yojson.Safe.equal scalar) | _ -> - (* TODO: filter warnings *) false) + (* TODO: filter warnings *) false ) |> Option.value ~default:false | Cmp_match (x, regex) -> Option.map (interpret_value_exp json x) ~f:(fun value -> - match value with `String str -> Re2.matches regex str | _ -> false) + match value with `String str -> Re2.matches regex str | _ -> false ) |> Option.value ~default:false let rec interpret_bool_exp json = function diff --git a/src/lib/logproc_lib/interpolator.ml b/src/lib/logproc_lib/interpolator.ml index 94090583d45..528fd86441c 100644 --- a/src/lib/logproc_lib/interpolator.ml +++ b/src/lib/logproc_lib/interpolator.ml @@ -38,7 +38,7 @@ let parser = (choice [ (take_while1 (not_f (Char.equal '$')) >>| fun x -> `Raw x) ; (interpolation >>| fun x -> `Interpolate x) - ]) + ] ) in message <* end_of_input @@ -60,7 +60,7 @@ let render ~max_interpolation_length ~format_json metadata items = let str = format_json json in if String.length str > max_interpolation_length then (msg_acc ^ "$" ^ id, (id, str) :: extra_acc) - else (msg_acc ^ str, extra_acc)) + else (msg_acc ^ str, extra_acc) ) in (msg, List.rev extra) @@ -80,4 +80,4 @@ let interpolate { mode; max_interpolation_length; pretty_print } msg metadata = Ok ( msg , List.map (String.Map.to_alist metadata) ~f:(fun (k, v) -> - (k, format_json v)) ) + (k, format_json v) ) ) diff --git a/src/lib/memory_stats/memory_stats.ml b/src/lib/memory_stats/memory_stats.ml index 580604aecff..b087e610648 100644 --- a/src/lib/memory_stats/memory_stats.ml +++ b/src/lib/memory_stats/memory_stats.ml @@ -74,4 +74,4 @@ let log_memory_stats logger ~process = let%bind () = after interval in loop () in - loop ()) + loop () ) diff --git a/src/lib/merkle_address/merkle_address.ml b/src/lib/merkle_address/merkle_address.ml index 86127b4c5ae..8adde08a18b 100644 --- a/src/lib/merkle_address/merkle_address.ml +++ b/src/lib/merkle_address/merkle_address.ml @@ -59,15 +59,16 @@ module Stable = struct let to_latest = Fn.id - include Binable.Of_binable - (Binable_arg.Stable.V1) - (struct - type nonrec t = t + include + Binable.Of_binable + (Binable_arg.Stable.V1) + (struct + type nonrec t = t - let to_binable = to_tuple + let to_binable = to_tuple - let of_binable = of_tuple - end) + let of_binable = of_tuple + end) let sexp_of_t = Fn.compose sexp_of_string to_string @@ -136,7 +137,7 @@ let to_int (path : t) : int = Sequence.range 0 (depth path) |> Sequence.fold ~init:0 ~f:(fun acc i -> let index = depth path - 1 - i in - acc + ((if get path index <> 0 then 1 else 0) lsl i)) + acc + ((if get path index <> 0 then 1 else 0) lsl i) ) let of_int_exn ~ledger_depth index = if index >= 1 lsl ledger_depth then failwith "Index is too large" @@ -147,7 +148,7 @@ let of_int_exn ~ledger_depth index = (ledger_depth - 1) 0 |> Sequence.fold ~init:index ~f:(fun i pos -> Bitstring.put buf pos (i % 2) ; - i / 2) + i / 2 ) : int ) ; buf @@ -256,7 +257,7 @@ module Range = struct Some (current_node, (current_node, `Stop)) else Option.map (next current_node) ~f:(fun next_node -> - (current_node, (next_node, `Don't_stop)))) + (current_node, (next_node, `Don't_stop)) ) ) end let%test "Bitstring bin_io serialization does not change" = @@ -282,32 +283,32 @@ struct Quickcheck.test ~sexp_of:[%sexp_of: Direction.t List.t * Direction.t] (Quickcheck.Generator.tuple2 (Direction.gen_var_length_list Input.depth) - Direction.gen) + Direction.gen ) ~f:(fun (path, direction) -> let address = of_directions path in [%test_eq: t] (parent_exn (child_exn ~ledger_depth:Input.depth address direction)) - address) + address ) let%test_unit "to_index(of_index_exn(i)) = i" = Quickcheck.test ~sexp_of:[%sexp_of: int] (Int.gen_incl 0 ((1 lsl Input.depth) - 1)) ~f:(fun index -> [%test_result: int] ~expect:index - (to_int @@ of_int_exn ~ledger_depth:Input.depth index)) + (to_int @@ of_int_exn ~ledger_depth:Input.depth index) ) let%test_unit "of_index_exn(to_index(addr)) = addr" = Quickcheck.test ~sexp_of:[%sexp_of: Direction.t list] (Direction.gen_list Input.depth) ~f:(fun directions -> let address = of_directions directions in [%test_result: t] ~expect:address - (of_int_exn ~ledger_depth:Input.depth @@ to_int address)) + (of_int_exn ~ledger_depth:Input.depth @@ to_int address) ) let%test_unit "nonempty(addr): sibling(sibling(addr)) = addr" = Quickcheck.test ~sexp_of:[%sexp_of: Direction.t list] (Direction.gen_var_length_list ~start:1 Input.depth) ~f:(fun directions -> let address = of_directions directions in - [%test_result: t] ~expect:address (sibling @@ sibling address)) + [%test_result: t] ~expect:address (sibling @@ sibling address) ) let%test_unit "prev(next(addr)) = addr" = Quickcheck.test ~sexp_of:[%sexp_of: Direction.t list] @@ -317,7 +318,7 @@ struct | None -> () | Some addr' -> - [%test_result: t option] ~expect:(Some address) (prev addr')) + [%test_result: t option] ~expect:(Some address) (prev addr') ) end let%test_module "Address" = diff --git a/src/lib/merkle_ledger/database.ml b/src/lib/merkle_ledger/database.ml index ee1c6c96ec8..2d4881739aa 100644 --- a/src/lib/merkle_ledger/database.ml +++ b/src/lib/merkle_ledger/database.ml @@ -164,10 +164,10 @@ module Make (Inputs : Inputs_intf) : let locations_accounts_bin = List.filter all_keys_values ~f:(fun (loc, _v) -> let ch = Bigstring.get_uint8 loc ~pos:0 in - Int.equal ch account_location_prefix) + Int.equal ch account_location_prefix ) in List.map locations_accounts_bin ~f:(fun (_location_bin, account_bin) -> - account_bin_read account_bin ~pos_ref:(ref 0)) + account_bin_read account_bin ~pos_ref:(ref 0) ) let to_list mdb = account_list_bin mdb Account.bin_read_t @@ -229,7 +229,7 @@ module Make (Inputs : Inputs_intf) : ^ Format.sprintf !"%{sexp: Key.t}!%{sexp: Token_id.t}" (Account_id.public_key account_id) - (Account_id.token_id account_id) )) + (Account_id.token_id account_id) ) ) let serialize_kv ~ledger_depth (aid, location) = ( Location.serialize ~ledger_depth @@ build_location aid @@ -299,12 +299,12 @@ module Make (Inputs : Inputs_intf) : |> Result.map ~f:(fun next_account_location -> set_raw mdb location (Location.serialize ~ledger_depth next_account_location) ; - next_account_location) ) + next_account_location ) ) let allocate mdb key = let location_result = increment_last_account_location mdb in Result.map location_result ~f:(fun location -> - set mdb key location ; location) + set mdb key location ; location ) let last_location_address mdb = match @@ -354,7 +354,7 @@ module Make (Inputs : Inputs_intf) : let build_location token_id = Location.build_generic (Bigstring.of_string - (Format.sprintf !"$tid!%{sexp: Token_id.t}" token_id)) + (Format.sprintf !"$tid!%{sexp: Token_id.t}" token_id) ) let serialize_kv ~ledger_depth ((tid : Token_id.t), (aid : Account_id.t)) = @@ -384,17 +384,17 @@ module Make (Inputs : Inputs_intf) : ~f:(fun (seen : Token_id.Set.t) (a : Account.t) -> let token = Account.token a in let already_seen = Token_id.Set.mem seen token in - (Set.add seen token, (already_seen, token))) + (Set.add seen token, (already_seen, token)) ) |> Sequence.filter_map ~f:(fun (already_seen, token) -> - if already_seen then None else Some token) + if already_seen then None else Some token ) in Sequence.filter_map deduped_tokens ~f:(fun token -> - Option.map (get t token) ~f:(fun owner -> (token, owner))) + Option.map (get t token) ~f:(fun owner -> (token, owner)) ) let foldi (type a) (t : t) ~(init : a) ~(f : key:Token_id.t -> data:Account_id.t -> a -> a) : a = Sequence.fold (all_owners t) ~init ~f:(fun acc (key, data) -> - f ~key ~data acc) + f ~key ~data acc ) let _iteri t ~f = foldi t ~init:() ~f:(fun ~key ~data () -> f ~key ~data) end @@ -436,13 +436,13 @@ module Make (Inputs : Inputs_intf) : let update mdb pk ~f = change_opt mdb pk ~f:(fun x -> - to_opt @@ f (Option.value ~default:Token_id.Set.empty x)) + to_opt @@ f (Option.value ~default:Token_id.Set.empty x) ) let add mdb pk tid = update mdb pk ~f:(fun tids -> Set.add tids tid) let _add_several mdb pk new_tids = update mdb pk ~f:(fun tids -> - Set.union tids (Token_id.Set.of_list new_tids)) + Set.union tids (Token_id.Set.of_list new_tids) ) let add_account (mdb : t) (aid : Account_id.t) : unit = let token = Account_id.token_id aid in @@ -456,7 +456,7 @@ module Make (Inputs : Inputs_intf) : let _remove_several mdb pk rem_tids = update mdb pk ~f:(fun tids -> - Set.diff tids (Token_id.Set.of_list rem_tids)) + Set.diff tids (Token_id.Set.of_list rem_tids) ) let remove_account (mdb : t) (aid : Account_id.t) : unit = let token = Account_id.token_id aid in @@ -468,7 +468,7 @@ module Make (Inputs : Inputs_intf) : let add_batch_create mdb pks_to_tokens = let pks_to_all_tokens = Map.filter_mapi pks_to_tokens ~f:(fun ~key:pk ~data:tokens_to_add -> - to_opt (Set.union (get mdb pk) tokens_to_add)) + to_opt (Set.union (get mdb pk) tokens_to_add) ) in Map.to_alist pks_to_all_tokens |> List.map ~f:(serialize_kv ~ledger_depth:mdb.depth) @@ -493,7 +493,7 @@ module Make (Inputs : Inputs_intf) : let token_owners (t : t) : Account_id.Set.t = Tokens.Owner.all_owners t |> Sequence.fold ~init:Account_id.Set.empty ~f:(fun acc (_, owner) -> - Set.add acc owner) + Set.add acc owner ) let token_owner = Tokens.Owner.get @@ -540,7 +540,7 @@ module Make (Inputs : Inputs_intf) : | Some set -> Set.add set (Account_id.token_id aid) | None -> - Token_id.Set.singleton (Account_id.token_id aid))) + Token_id.Set.singleton (Account_id.token_id aid) ) ) in let batched_changes = Account_location.serialize_last_account_kv ~ledger_depth:mdb.depth @@ -561,8 +561,8 @@ module Make (Inputs : Inputs_intf) : let aid = Account.identifier account in Some (Tokens.Owner.serialize_kv ~ledger_depth:mdb.depth - (Account_id.token_id aid, aid)) - else None) + (Account_id.token_id aid, aid) ) + else None ) in Kvdb.set_batch mdb.kvdb ~remove_keys:[] ~key_data_pairs:token_owner_changes @@ -636,7 +636,7 @@ module Make (Inputs : Inputs_intf) : let ignored_indices = Int.Set.map ignored_accounts ~f:(fun account_id -> try index_of_account_exn t account_id with _ -> -1 - (* dummy index for accounts not in database *)) + (* dummy index for accounts not in database *) ) in let last = Addr.to_int last_addr in Sequence.range ~stop:`inclusive 0 last @@ -692,7 +692,7 @@ module Make (Inputs : Inputs_intf) : (* recalculate hashes for each removed account *) List.iter locations ~f:(fun loc -> let hash_loc = Location.Hash (Location.to_path_exn loc) in - set_hash t hash_loc Hash.empty_account) + set_hash t hash_loc Hash.empty_account ) let merkle_path mdb location = let location = diff --git a/src/lib/merkle_ledger/graphviz.ml b/src/lib/merkle_ledger/graphviz.ml index 5afca85d124..95204555772 100644 --- a/src/lib/merkle_ledger/graphviz.ml +++ b/src/lib/merkle_ledger/graphviz.ml @@ -147,7 +147,7 @@ struct (Queue.of_list [ Addr.child_exn ~ledger_depth initial_address Direction.Left ; Addr.child_exn ~ledger_depth initial_address Direction.Right - ]) + ] ) in let edges = List.folding_map edges ~init:(0, 0) @@ -176,7 +176,7 @@ struct ( (new_empty_account_counter, empty_hash_counter) , { source ; target = Pretty_empty_account new_empty_account_counter - } )) + } ) ) in edges @@ -203,7 +203,7 @@ struct | Pretty_empty_hash count -> write_empty_entry ~id:"HASH" source count | Pretty_empty_account count -> - write_empty_entry ~id:"ACCOUNT" source count) + write_empty_entry ~id:"ACCOUNT" source count ) |> List.concat |> String.concat ~sep:"\n" in let code = wrapper ~name body in diff --git a/src/lib/merkle_ledger/merkle_path.ml b/src/lib/merkle_ledger/merkle_path.ml index eb0b11eab36..a2a5acd294d 100644 --- a/src/lib/merkle_ledger/merkle_path.ml +++ b/src/lib/merkle_ledger/merkle_path.ml @@ -36,7 +36,7 @@ end) : S with type hash := Hash.t = struct | `Right h -> Hash.merge ~height h acc in - (acc, height + 1)) + (acc, height + 1) ) |> fst let check_path t leaf_hash root_hash = diff --git a/src/lib/merkle_ledger/null_ledger.ml b/src/lib/merkle_ledger/null_ledger.ml index 923550d2cd0..b9b760c7fa2 100644 --- a/src/lib/merkle_ledger/null_ledger.ml +++ b/src/lib/merkle_ledger/null_ledger.ml @@ -133,10 +133,10 @@ end = struct zip_exn (map ~f:(Addr.of_int_exn ~ledger_depth:t.depth) - (range first_index last_index)) + (range first_index last_index) ) (init (1 lsl Addr.height ~ledger_depth:t.depth addr) - ~f:(Fn.const Account.empty))) + ~f:(Fn.const Account.empty) )) let set_all_accounts_rooted_at_exn _t = failwith "set_all_accounts_rooted_at_exn: null ledgers cannot be mutated" diff --git a/src/lib/merkle_ledger/util.ml b/src/lib/merkle_ledger/util.ml index aa0fe1ee615..b3406f2e7d6 100644 --- a/src/lib/merkle_ledger/util.ml +++ b/src/lib/merkle_ledger/util.ml @@ -72,17 +72,17 @@ end = struct let result = Location.Addr.Range.fold (Location.Addr.Range.subtree_range ~ledger_depth:(Inputs.ledger_depth t) - address) + address ) ~init:[] ~f:(fun bit_index acc -> let account = Base.get t (location_of_account_addr bit_index) in - (bit_index, account) :: acc) + (bit_index, account) :: acc ) in List.rev_filter_map result ~f:(function | _, None -> None | addr, Some account -> - Some (addr, account)) + Some (addr, account) ) let rec compute_affected_locations_and_hashes t locations_and_hashes acc = let ledger_depth = Inputs.ledger_depth t in @@ -118,7 +118,7 @@ end = struct (* This is the first child of its parent that we have encountered. *) - `One_side (location, hash))) + `One_side (location, hash) ) ) in let rev_parent_locations_and_hashes = Map.fold parents_to_children ~init:[] ~f:(fun ~key ~data acc -> @@ -138,7 +138,7 @@ end = struct (key, parent_hash) :: acc | `Hash parent_hash -> (* We have already computed the hash above. *) - (key, parent_hash) :: acc) + (key, parent_hash) :: acc ) in compute_affected_locations_and_hashes t rev_parent_locations_and_hashes (List.rev_append rev_parent_locations_and_hashes acc) @@ -148,7 +148,7 @@ end = struct let set_hash_batch t locations_and_hashes = Inputs.set_raw_hash_batch t (compute_affected_locations_and_hashes t locations_and_hashes - locations_and_hashes) + locations_and_hashes ) let compute_last_index addresses = Non_empty_list.map addresses @@ -162,7 +162,7 @@ end = struct let key_locations = Non_empty_list.map nonempty_addresses_and_accounts ~f:(fun (address, account) -> - (Inputs.Account.identifier account, address)) + (Inputs.Account.identifier account, address) ) in let new_last_location = let current_last_index = @@ -183,7 +183,7 @@ end = struct Account (Addr.of_int_exn ~ledger_depth max_index_in_all_accounts)) in let last_location = new_last_location in - Inputs.set_location_batch ~last_location t key_locations) + Inputs.set_location_batch ~last_location t key_locations ) (* TODO: When we do batch on a database, we should add accounts, locations and hashes simulatenously for full atomicity. *) @@ -193,12 +193,12 @@ end = struct set_hash_batch t @@ List.map locations_and_accounts ~f:(fun (location, account) -> ( Inputs.location_of_hash_addr (Inputs.Location.to_path_exn location) - , Inputs.Hash.hash_account account )) + , Inputs.Hash.hash_account account ) ) let set_batch_accounts t addresses_and_accounts = set_batch t @@ List.map addresses_and_accounts ~f:(fun (addr, account) -> - (Inputs.location_of_account_addr addr, account)) + (Inputs.location_of_account_addr addr, account) ) let set_all_accounts_rooted_at_exn t address accounts = let addresses = diff --git a/src/lib/merkle_ledger_tests/test.ml b/src/lib/merkle_ledger_tests/test.ml index e14f2e99d7f..5e8b8517bfc 100644 --- a/src/lib/merkle_ledger_tests/test.ml +++ b/src/lib/merkle_ledger_tests/test.ml @@ -56,11 +56,11 @@ let%test_module "Database integration test" = |> Sequence.fold ~init:[ [] ] ~f:(fun acc _ -> acc @ List.map acc ~f:(List.cons Direction.Left) - @ List.map acc ~f:(List.cons Direction.Right)) + @ List.map acc ~f:(List.cons Direction.Right) ) in List.iter accounts ~f:(fun account -> let account_id = Account.identifier account in - ignore @@ DB.get_or_create_account db account_id account) ; + ignore @@ DB.get_or_create_account db account_id account ) ; let binary_tree = Binary_tree.set_accounts accounts in Sequence.iter (enumerate_dir_combinations Depth.depth |> Sequence.of_list) @@ -72,5 +72,5 @@ let%test_module "Database integration test" = let binary_hash = Binary_tree.get_inner_hash_at_addr_exn binary_tree dirs in - assert (Hash.equal binary_hash db_hash)))) + assert (Hash.equal binary_hash db_hash) ) ) ) end ) diff --git a/src/lib/merkle_ledger_tests/test_database.ml b/src/lib/merkle_ledger_tests/test_database.ml index 283053a02a7..b4467258dcc 100644 --- a/src/lib/merkle_ledger_tests/test_database.ml +++ b/src/lib/merkle_ledger_tests/test_database.ml @@ -35,7 +35,7 @@ let%test_module "test functor on in memory databases" = Test.with_instance (fun mdb -> Quickcheck.test (MT.For_tests.gen_account_location ~ledger_depth:(MT.depth mdb)) - ~f:(fun location -> assert (Option.is_none (MT.get mdb location)))) + ~f:(fun location -> assert (Option.is_none (MT.get mdb location))) ) let create_new_account_exn mdb account = let public_key = Account.identifier account in @@ -52,7 +52,7 @@ let%test_module "test functor on in memory databases" = Test.with_instance (fun mdb -> let account = Quickcheck.random_value Account.gen in let location = create_new_account_exn mdb account in - Account.equal (Option.value_exn (MT.get mdb location)) account) + Account.equal (Option.value_exn (MT.get mdb location)) account ) let%test "accounts are atomic" = Test.with_instance (fun mdb -> @@ -69,13 +69,13 @@ let%test_module "test functor on in memory databases" = | Some acct, Some acct' -> Account.equal acct acct' | _, _ -> - false) + false ) let dedup_accounts accounts = List.dedup_and_sort accounts ~compare:(fun account1 account2 -> Account_id.compare (Account.identifier account1) - (Account.identifier account2)) + (Account.identifier account2) ) let%test_unit "length" = Test.with_instance (fun mdb -> @@ -95,9 +95,9 @@ let%test_module "test functor on in memory databases" = in let num_initial_accounts = List.length accounts in List.iter accounts ~f:(fun account -> - ignore @@ create_new_account_exn mdb account) ; + ignore @@ create_new_account_exn mdb account ) ; let result = MT.num_accounts mdb in - [%test_eq: int] result num_initial_accounts) + [%test_eq: int] result num_initial_accounts ) let%test "get_or_create_acount does not update an account if key already \ exists" = @@ -123,7 +123,7 @@ let%test_module "test functor on in memory databases" = && not (Mina_base.Account.equal (Option.value_exn (MT.get mdb location)) - account')) + account' ) ) let%test_unit "get_or_create_account t account = location_of_account \ account.key" = @@ -145,7 +145,7 @@ let%test_module "test functor on in memory databases" = let location' = MT.location_of_account mdb account_id |> Option.value_exn in - assert ([%equal: Test.Location.t] location location'))) + assert ([%equal: Test.Location.t] location location') ) ) let%test_unit "set_inner_hash_at_addr_exn(address,hash); \ get_inner_hash_at_addr_exn(address) = hash" = @@ -160,7 +160,7 @@ let%test_module "test functor on in memory databases" = let address = MT.Addr.of_directions direction in MT.set_inner_hash_at_addr_exn mdb address random_hash ; let result = MT.get_inner_hash_at_addr_exn mdb address in - assert (Hash.equal result random_hash))) + assert (Hash.equal result random_hash) ) ) let random_accounts max_height = let num_accounts = 1 lsl max_height in @@ -180,7 +180,7 @@ let%test_module "test functor on in memory databases" = | `Added -> () | `Existed -> - MT.set mdb location account) + MT.set mdb location account ) let%test_unit "If the entire database is full, let \ addresses_and_accounts = \ @@ -204,7 +204,7 @@ let%test_module "test functor on in memory databases" = in MT.set_batch_accounts mdb addresses_and_accounts ; let new_merkle_root = MT.merkle_root mdb in - assert (Hash.equal old_merkle_root new_merkle_root))) + assert (Hash.equal old_merkle_root new_merkle_root) ) ) let%test_unit "set_batch_accounts would change the merkle root" = Test.with_instance (fun mdb -> @@ -223,15 +223,15 @@ let%test_module "test functor on in memory databases" = let accounts = Quickcheck.random_value (Quickcheck.Generator.list_with_length num_accounts - Account.gen) + Account.gen ) in if not @@ List.is_empty accounts then let addresses = List.rev @@ MT.Addr.Range.fold (MT.Addr.Range.subtree_range ~ledger_depth:depth - address) ~init:[] ~f:(fun address addresses -> - address :: addresses) + address ) ~init:[] ~f:(fun address addresses -> + address :: addresses ) in let new_addresses_and_accounts = List.zip_exn addresses accounts @@ -246,13 +246,13 @@ let%test_module "test functor on in memory databases" = @@ List.equal (fun (addr1, account1) (addr2, account2) -> MT.Addr.equal addr1 addr2 - && Account.equal account1 account2) + && Account.equal account1 account2 ) old_addresses_and_accounts new_addresses_and_accounts then ( let old_merkle_root = MT.merkle_root mdb in MT.set_batch_accounts mdb new_addresses_and_accounts ; let new_merkle_root = MT.merkle_root mdb in - assert (not @@ Hash.equal old_merkle_root new_merkle_root) ))) + assert (not @@ Hash.equal old_merkle_root new_merkle_root) ) ) ) let%test_unit "We can retrieve accounts by their by key after using \ set_batch_accounts" = @@ -270,7 +270,7 @@ let%test_module "test functor on in memory databases" = let location = Test.Location.next prev_location |> Option.value_exn in - (location, (location |> Test.Location.to_path_exn, account))) + (location, (location |> Test.Location.to_path_exn, account)) ) in MT.set_batch_accounts mdb accounts_with_addresses ; List.iter accounts ~f:(fun account -> @@ -279,7 +279,7 @@ let%test_module "test functor on in memory databases" = MT.location_of_account mdb aid |> Option.value_exn in let queried_account = MT.get mdb location |> Option.value_exn in - assert (Account.equal queried_account account)) ; + assert (Account.equal queried_account account) ) ; let to_int = Fn.compose MT.Location.Addr.to_int MT.Location.to_path_exn in @@ -294,7 +294,7 @@ let%test_module "test functor on in memory databases" = actual_last_location ~message: (sprintf "(expected_location: %i) (actual_location: %i)" - expected_last_location actual_last_location)) + expected_last_location actual_last_location ) ) let%test_unit "If the entire database is full, \ set_all_accounts_rooted_at_exn(address,accounts);get_all_accounts_rooted_at_exn(address) \ @@ -316,14 +316,14 @@ let%test_module "test functor on in memory databases" = let accounts = Quickcheck.random_value (Quickcheck.Generator.list_with_length num_accounts - Account.gen) + Account.gen ) in MT.set_all_accounts_rooted_at_exn mdb address accounts ; let result = List.map ~f:snd @@ MT.get_all_accounts_rooted_at_exn mdb address in - assert (List.equal Account.equal accounts result))) + assert (List.equal Account.equal accounts result) ) ) let%test_unit "create_empty doesn't modify the hash" = Test.with_instance (fun ledger -> @@ -337,7 +337,7 @@ let%test_module "test functor on in memory databases" = failwith "create_empty with empty ledger somehow already has that key?" | `Added, _ -> - [%test_eq: Hash.t] start_hash (merkle_root ledger)) + [%test_eq: Hash.t] start_hash (merkle_root ledger) ) let%test "get_at_index_exn t (index_of_account_exn t public_key) = \ account" = @@ -345,14 +345,14 @@ let%test_module "test functor on in memory databases" = let max_height = Int.min (MT.depth mdb) 5 in let accounts = random_accounts max_height |> dedup_accounts in List.iter accounts ~f:(fun account -> - ignore @@ create_new_account_exn mdb account) ; + ignore @@ create_new_account_exn mdb account ) ; Sequence.of_list accounts |> Sequence.for_all ~f:(fun account -> let indexed_account = MT.index_of_account_exn mdb (Account.identifier account) |> MT.get_at_index_exn mdb in - Account.equal account indexed_account)) + Account.equal account indexed_account ) ) let test_subtree_range mdb ~f max_height = populate_db mdb max_height ; @@ -366,7 +366,7 @@ let%test_module "test functor on in memory databases" = let account = Quickcheck.random_value Account.gen in MT.set_at_index_exn mdb index account ; let result = MT.get_at_index_exn mdb index in - assert (Account.equal account result))) + assert (Account.equal account result) ) ) let%test_unit "implied_root(account) = root_hash" = Test.with_instance (fun mdb -> @@ -383,7 +383,7 @@ let%test_module "test functor on in memory databases" = let path = MT.merkle_path_at_addr_exn mdb address in let leaf_hash = MT.get_inner_hash_at_addr_exn mdb address in let root_hash = MT.merkle_root mdb in - assert (MT.Path.check_path path leaf_hash root_hash))) + assert (MT.Path.check_path path leaf_hash root_hash) ) ) let%test_unit "implied_root(index) = root_hash" = Test.with_instance (fun mdb -> @@ -396,15 +396,15 @@ let%test_module "test functor on in memory databases" = (MT.Addr.of_int_exn ~ledger_depth:depth index) in let root_hash = MT.merkle_root mdb in - assert (MT.Path.check_path path leaf_hash root_hash))) + assert (MT.Path.check_path path leaf_hash root_hash) ) ) let%test_unit "iter" = Test.with_instance (fun mdb -> let max_height = Int.min (MT.depth mdb) 5 in let accounts = random_accounts max_height |> dedup_accounts in List.iter accounts ~f:(fun account -> - ignore (create_new_account_exn mdb account : Test.Location.t)) ; - [%test_result: Account.t list] accounts ~expect:(MT.to_list mdb)) + ignore (create_new_account_exn mdb account : Test.Location.t) ) ; + [%test_result: Account.t list] accounts ~expect:(MT.to_list mdb) ) let%test_unit "Add 2^d accounts (for testing, d is small)" = if Test.depth <= 8 then @@ -414,19 +414,19 @@ let%test_module "test functor on in memory databases" = let balances = Quickcheck.random_value (Quickcheck.Generator.list_with_length num_accounts - Balance.gen) + Balance.gen ) in let accounts = List.map2_exn account_ids balances ~f:Account.create in List.iter accounts ~f:(fun account -> - ignore @@ create_new_account_exn mdb account) ; + ignore @@ create_new_account_exn mdb account ) ; let retrieved_accounts = List.map ~f:snd @@ MT.get_all_accounts_rooted_at_exn mdb (MT.Addr.root ()) in assert (List.length accounts = List.length retrieved_accounts) ; - assert (List.equal Account.equal accounts retrieved_accounts)) + assert (List.equal Account.equal accounts retrieved_accounts) ) let%test_unit "removing accounts restores Merkle root" = Test.with_instance (fun mdb -> @@ -441,14 +441,14 @@ let%test_module "test functor on in memory databases" = in let merkle_root0 = MT.merkle_root mdb in List.iter accounts ~f:(fun account -> - ignore @@ create_new_account_exn mdb account) ; + ignore @@ create_new_account_exn mdb account ) ; let merkle_root1 = MT.merkle_root mdb in (* adding accounts should change the Merkle root *) assert (not (Hash.equal merkle_root0 merkle_root1)) ; MT.remove_accounts_exn mdb account_ids ; (* should see original Merkle root after removing the accounts *) let merkle_root2 = MT.merkle_root mdb in - assert (Hash.equal merkle_root2 merkle_root0)) + assert (Hash.equal merkle_root2 merkle_root0) ) let%test_unit "fold over account balances" = Test.with_instance (fun mdb -> @@ -460,18 +460,18 @@ let%test_module "test functor on in memory databases" = in let total = List.fold balances ~init:0 ~f:(fun accum balance -> - Balance.to_int balance + accum) + Balance.to_int balance + accum ) in let accounts = List.map2_exn account_ids balances ~f:Account.create in List.iter accounts ~f:(fun account -> - ignore @@ create_new_account_exn mdb account) ; + ignore @@ create_new_account_exn mdb account ) ; let retrieved_total = MT.foldi mdb ~init:0 ~f:(fun _addr total account -> - Balance.to_int (Account.balance account) + total) + Balance.to_int (Account.balance account) + total ) in - assert (Int.equal retrieved_total total)) + assert (Int.equal retrieved_total total) ) let%test_unit "fold_until over account balances" = Test.with_instance (fun mdb -> @@ -487,13 +487,13 @@ let%test_module "test functor on in memory databases" = let some_balances = List.take balances some_num in let total = List.fold some_balances ~init:0 ~f:(fun accum balance -> - Balance.to_int balance + accum) + Balance.to_int balance + accum ) in let accounts = List.map2_exn account_ids balances ~f:Account.create in List.iter accounts ~f:(fun account -> - ignore @@ create_new_account_exn mdb account) ; + ignore @@ create_new_account_exn mdb account ) ; (* stop folding on last_account_id, sum of balances in accounts should be same as some_balances *) let retrieved_total = MT.fold_until mdb ~init:0 @@ -503,10 +503,10 @@ let%test_module "test functor on in memory databases" = let new_total = Balance.to_int current_balance + total in if Account_id.equal current_account_id last_account_id then Stop new_total - else Continue new_total) + else Continue new_total ) ~finish:(fun total -> total) in - assert (Int.equal retrieved_total total)) + assert (Int.equal retrieved_total total) ) end module Make_db (Depth : sig diff --git a/src/lib/merkle_ledger_tests/test_mask.ml b/src/lib/merkle_ledger_tests/test_mask.ml index 16554d4e815..170fe5399ec 100644 --- a/src/lib/merkle_ledger_tests/test_mask.ml +++ b/src/lib/merkle_ledger_tests/test_mask.ml @@ -61,7 +61,7 @@ module type Test_intf = sig -> mask:Mask.Attached.t -> mask_as_base:Base.t -> mask2:Mask.Attached.t - -> 'a) + -> 'a ) -> 'a end @@ -133,7 +133,7 @@ module Make (Test : Test_intf) = struct && let maskable_account = Option.value_exn maskable_result in let mask_account = Option.value_exn mask_result in - Account.equal maskable_account mask_account) + Account.equal maskable_account mask_account ) let compare_maskable_mask_hashes ?(check_hash_in_mask = false) maskable mask addr = @@ -166,7 +166,7 @@ module Make (Test : Test_intf) = struct && let maskable_account = Option.value_exn maskable_result in let mask_account = Option.value_exn mask_result in - Account.equal maskable_account mask_account) + Account.equal maskable_account mask_account ) let%test "parent, mask agree on hashes; set in both mask and parent" = Test.with_instances (fun maskable mask -> @@ -176,7 +176,7 @@ module Make (Test : Test_intf) = struct Mask.Attached.set attached_mask dummy_location dummy_account ; (* verify all hashes to root are same in mask and parent *) compare_maskable_mask_hashes ~check_hash_in_mask:true maskable - attached_mask dummy_address) + attached_mask dummy_address ) let%test "parent, mask agree on hashes; set only in parent" = Test.with_instances (fun maskable mask -> @@ -184,7 +184,7 @@ module Make (Test : Test_intf) = struct (* set only in parent *) Maskable.set maskable dummy_location dummy_account ; (* verify all hashes to root are same in mask and parent *) - compare_maskable_mask_hashes maskable attached_mask dummy_address) + compare_maskable_mask_hashes maskable attached_mask dummy_address ) let%test "mask delegates to parent" = Test.with_instances (fun maskable mask -> @@ -195,7 +195,7 @@ module Make (Test : Test_intf) = struct Option.is_some mask_result && let mask_account = Option.value_exn mask_result in - Account.equal dummy_account mask_account) + Account.equal dummy_account mask_account ) let%test "mask prune after parent notification" = Test.with_instances (fun maskable mask -> @@ -211,8 +211,8 @@ module Make (Test : Test_intf) = struct (* verify account pruned from mask *) not (Mask.Attached.For_testing.location_in_mask attached_mask - dummy_location) ) - else false) + dummy_location ) ) + else false ) let%test "commit puts mask contents in parent, flushes mask" = Test.with_instances (fun maskable mask -> @@ -228,9 +228,9 @@ module Make (Test : Test_intf) = struct (* verify account no longer in mask but is in parent *) (not (Mask.Attached.For_testing.location_in_mask attached_mask - dummy_location)) + dummy_location ) ) && Option.is_some (Maskable.get maskable dummy_location) ) - else false) + else false ) let%test_unit "commit at layer2, dumps to layer1, not in base" = Test.with_chain (fun base ~mask:level1 ~mask_as_base:_ ~mask2:level2 -> @@ -240,12 +240,11 @@ module Make (Test : Test_intf) = struct Mask.Attached.commit level2 ; (* account is no longer in layer2 *) assert ( - not (Mask.Attached.For_testing.location_in_mask level2 dummy_location) - ) ; + not (Mask.Attached.For_testing.location_in_mask level2 dummy_location) ) ; (* account is still not in base *) assert (Option.is_none @@ Maskable.get base dummy_location) ; (* account is present in layer1 *) - assert (Mask.Attached.For_testing.location_in_mask level1 dummy_location)) + assert (Mask.Attached.For_testing.location_in_mask level1 dummy_location) ) let%test "register and unregister mask" = Test.with_instances (fun maskable mask -> @@ -257,7 +256,7 @@ module Make (Test : Test_intf) = struct Maskable.unregister_mask_exn ~loc:__LOC__ attached_mask in true - with Failure _ -> false) + with Failure _ -> false ) let%test_unit "root hash invariant if interior changes but not accounts" = if Test.depth <= 8 then @@ -274,10 +273,10 @@ module Make (Test : Test_intf) = struct let balances = gen_values Balance.gen in let accounts = List.map2_exn account_ids balances ~f:(fun public_key balance -> - Account.create public_key balance) + Account.create public_key balance ) in List.iter accounts ~f:(fun account -> - ignore @@ create_new_account_exn attached_mask account) ; + ignore @@ create_new_account_exn attached_mask account ) ; (* Set some inner hashes *) let reset_hash_of_parent_of_index i = let a1 = List.nth_exn accounts i in @@ -297,7 +296,7 @@ module Make (Test : Test_intf) = struct reset_hash_of_parent_of_index 0 ; reset_hash_of_parent_of_index 3 ; let root_hash' = Mask.Attached.merkle_root attached_mask in - assert (Hash.equal root_hash root_hash')) + assert (Hash.equal root_hash root_hash') ) let%test "mask and parent agree on Merkle path" = Test.with_instances (fun maskable mask -> @@ -317,14 +316,14 @@ module Make (Test : Test_intf) = struct let maskable_merkle_path = Maskable.merkle_path_at_addr_exn maskable address in - [%equal: Mask.Attached.Path.t] mask_merkle_path maskable_merkle_path) + [%equal: Mask.Attached.Path.t] mask_merkle_path maskable_merkle_path ) let%test "mask and parent agree on Merkle root before set" = Test.with_instances (fun maskable mask -> let attached_mask = Maskable.register_mask maskable mask in let mask_merkle_root = Mask.Attached.merkle_root attached_mask in let maskable_merkle_root = Maskable.merkle_root maskable in - Hash.equal mask_merkle_root maskable_merkle_root) + Hash.equal mask_merkle_root maskable_merkle_root ) let%test "mask and parent agree on Merkle root after set" = Test.with_instances (fun maskable mask -> @@ -340,7 +339,7 @@ module Make (Test : Test_intf) = struct (* verify root address in mask *) Mask.Attached.For_testing.address_in_mask attached_mask (Mask.Addr.root ()) - && Hash.equal mask_merkle_root maskable_merkle_root) + && Hash.equal mask_merkle_root maskable_merkle_root ) let%test_unit "add and retrieve a block of accounts" = (* see similar test in test_database *) @@ -356,17 +355,17 @@ module Make (Test : Test_intf) = struct let balances = gen_values Balance.gen in let accounts = List.map2_exn account_ids balances ~f:(fun public_key balance -> - Account.create public_key balance) + Account.create public_key balance ) in List.iter accounts ~f:(fun account -> - ignore @@ create_new_account_exn attached_mask account) ; + ignore @@ create_new_account_exn attached_mask account ) ; let retrieved_accounts = List.map ~f:snd @@ Mask.Attached.get_all_accounts_rooted_at_exn attached_mask (Mask.Addr.root ()) in assert (List.length accounts = List.length retrieved_accounts) ; - assert (List.equal Account.equal accounts retrieved_accounts)) + assert (List.equal Account.equal accounts retrieved_accounts) ) let%test_unit "get_all_accounts should preserve the ordering of accounts by \ location with noncontiguous updates of accounts on the mask" = @@ -382,17 +381,17 @@ module Make (Test : Test_intf) = struct let balances = gen_values Balance.gen num_accounts in let base_accounts = List.map2_exn account_ids balances ~f:(fun public_key balance -> - Account.create public_key balance) + Account.create public_key balance ) in List.iter base_accounts ~f:(fun account -> - ignore @@ create_new_account_exn mask1 account) ; + ignore @@ create_new_account_exn mask1 account ) ; let num_subset = Quickcheck.random_value (Int.gen_incl 3 num_accounts) in let subset_indices, subset_accounts = List.permute (List.mapi base_accounts ~f:(fun index account -> - (index, account))) + (index, account) ) ) |> (Fn.flip List.take) num_subset |> List.unzip in @@ -404,7 +403,7 @@ module Make (Test : Test_intf) = struct ignore ( create_existing_account_exn mask2 updated_account : Test.Location.t ) ; - updated_account) + updated_account ) in let updated_accounts_map = Int.Map.of_alist_exn @@ -414,7 +413,7 @@ module Make (Test : Test_intf) = struct List.mapi base_accounts ~f:(fun index base_account -> Option.value (Map.find updated_accounts_map index) - ~default:base_account) + ~default:base_account ) in let retrieved_accounts = List.map ~f:snd @@ -425,7 +424,7 @@ module Make (Test : Test_intf) = struct Int.equal (List.length base_accounts) (List.length retrieved_accounts) ) ; - assert (List.equal Account.equal expected_accounts retrieved_accounts)) + assert (List.equal Account.equal expected_accounts retrieved_accounts) ) let%test_unit "removing accounts from mask restores Merkle root" = Test.with_instances (fun maskable mask -> @@ -439,14 +438,14 @@ module Make (Test : Test_intf) = struct let accounts = List.map2_exn account_ids balances ~f:Account.create in let merkle_root0 = Mask.Attached.merkle_root attached_mask in List.iter accounts ~f:(fun account -> - ignore @@ create_new_account_exn attached_mask account) ; + ignore @@ create_new_account_exn attached_mask account ) ; let merkle_root1 = Mask.Attached.merkle_root attached_mask in (* adding accounts should change the Merkle root *) assert (not (Hash.equal merkle_root0 merkle_root1)) ; Mask.Attached.remove_accounts_exn attached_mask account_ids ; (* should see original Merkle root after removing the accounts *) let merkle_root2 = Mask.Attached.merkle_root attached_mask in - assert (Hash.equal merkle_root2 merkle_root0)) + assert (Hash.equal merkle_root2 merkle_root0) ) let%test_unit "removing accounts from parent restores Merkle root" = Test.with_instances (fun maskable mask -> @@ -461,7 +460,7 @@ module Make (Test : Test_intf) = struct let merkle_root0 = Mask.Attached.merkle_root attached_mask in (* add accounts to parent *) List.iter accounts ~f:(fun account -> - ignore @@ parent_create_new_account_exn maskable account) ; + ignore @@ parent_create_new_account_exn maskable account ) ; (* observe Merkle root in mask *) let merkle_root1 = Mask.Attached.merkle_root attached_mask in (* adding accounts should change the Merkle root *) @@ -469,7 +468,7 @@ module Make (Test : Test_intf) = struct Mask.Attached.remove_accounts_exn attached_mask account_ids ; (* should see original Merkle root after removing the accounts *) let merkle_root2 = Mask.Attached.merkle_root attached_mask in - assert (Hash.equal merkle_root2 merkle_root0)) + assert (Hash.equal merkle_root2 merkle_root0) ) let%test_unit "removing accounts from parent and mask restores Merkle root" = Test.with_instances (fun maskable mask -> @@ -489,10 +488,10 @@ module Make (Test : Test_intf) = struct let merkle_root0 = Mask.Attached.merkle_root attached_mask in (* add accounts to parent *) List.iter parent_accounts ~f:(fun account -> - ignore @@ parent_create_new_account_exn maskable account) ; + ignore @@ parent_create_new_account_exn maskable account ) ; (* add accounts to mask *) List.iter mask_accounts ~f:(fun account -> - ignore @@ create_new_account_exn attached_mask account) ; + ignore @@ create_new_account_exn attached_mask account ) ; (* observe Merkle root in mask *) let merkle_root1 = Mask.Attached.merkle_root attached_mask in (* adding accounts should change the Merkle root *) @@ -501,7 +500,7 @@ module Make (Test : Test_intf) = struct Mask.Attached.remove_accounts_exn attached_mask account_ids ; (* should see original Merkle root after removing the accounts *) let merkle_root2 = Mask.Attached.merkle_root attached_mask in - assert (Hash.equal merkle_root2 merkle_root0)) + assert (Hash.equal merkle_root2 merkle_root0) ) let%test_unit "fold of addition over account balances in parent and mask" = Test.with_instances (fun maskable mask -> @@ -517,24 +516,24 @@ module Make (Test : Test_intf) = struct let accounts = List.map2_exn account_ids balances ~f:Account.create in let total = List.fold balances ~init:0 ~f:(fun accum balance -> - Balance.to_int balance + accum) + Balance.to_int balance + accum ) in let parent_accounts, mask_accounts = List.split_n accounts num_accounts_parent in (* add accounts to parent *) List.iter parent_accounts ~f:(fun account -> - ignore @@ parent_create_new_account_exn maskable account) ; + ignore @@ parent_create_new_account_exn maskable account ) ; (* add accounts to mask *) List.iter mask_accounts ~f:(fun account -> - ignore @@ create_new_account_exn attached_mask account) ; + ignore @@ create_new_account_exn attached_mask account ) ; (* folding over mask also folds over maskable *) let retrieved_total = Mask.Attached.foldi attached_mask ~init:0 ~f:(fun _addr total account -> - Balance.to_int (Account.balance account) + total) + Balance.to_int (Account.balance account) + total ) in - assert (Int.equal retrieved_total total)) + assert (Int.equal retrieved_total total) ) let%test_unit "masking in to_list" = Test.with_instances (fun maskable mask -> @@ -550,7 +549,7 @@ module Make (Test : Test_intf) = struct in (* add accounts to parent *) List.iter parent_accounts ~f:(fun account -> - ignore @@ parent_create_new_account_exn maskable account) ; + ignore @@ parent_create_new_account_exn maskable account ) ; (* all accounts in parent to_list *) let parent_list = Maskable.to_list maskable in let zero_balance account = @@ -559,7 +558,7 @@ module Make (Test : Test_intf) = struct (* put same accounts in mask, but with zero balance *) let mask_accounts = List.map parent_accounts ~f:zero_balance in List.iter mask_accounts ~f:(fun account -> - ignore @@ create_existing_account_exn attached_mask account) ; + ignore @@ create_existing_account_exn attached_mask account ) ; let mask_list = Mask.Attached.to_list attached_mask in (* same number of accounts after adding them to mask *) assert (Int.equal (List.length parent_list) (List.length mask_list)) ; @@ -569,12 +568,12 @@ module Make (Test : Test_intf) = struct ~f:(fun parent_account mask_account -> Account_id.equal (Account.identifier parent_account) - (Account.identifier mask_account)) + (Account.identifier mask_account) ) in assert is_in_same_order ; assert ( List.for_all mask_list ~f:(fun account -> - Balance.equal (Account.balance account) Balance.zero) )) + Balance.equal (Account.balance account) Balance.zero ) ) ) let%test_unit "masking in foldi" = Test.with_instances (fun maskable mask -> @@ -590,7 +589,7 @@ module Make (Test : Test_intf) = struct in (* add accounts to parent *) List.iter parent_accounts ~f:(fun account -> - ignore @@ parent_create_new_account_exn maskable account) ; + ignore @@ parent_create_new_account_exn maskable account ) ; let balance_summer _addr accum acct = accum + Balance.to_int (Account.balance acct) in @@ -603,12 +602,12 @@ module Make (Test : Test_intf) = struct (* put same accounts in mask, but with zero balance *) let mask_accounts = List.map parent_accounts ~f:zero_balance in List.iter mask_accounts ~f:(fun account -> - ignore @@ create_existing_account_exn attached_mask account) ; + ignore @@ create_existing_account_exn attached_mask account ) ; let mask_sum = Mask.Attached.foldi attached_mask ~init:0 ~f:balance_summer in (* sum should not include any parent balances *) - assert (Int.equal mask_sum 0)) + assert (Int.equal mask_sum 0) ) let%test_unit "create_empty doesn't modify the hash" = Test.with_instances (fun maskable mask -> @@ -623,7 +622,7 @@ module Make (Test : Test_intf) = struct failwith "create_empty with empty ledger somehow already has that key?" | `Added, _new_loc -> - [%test_eq: Hash.t] start_hash (merkle_root ledger)) + [%test_eq: Hash.t] start_hash (merkle_root ledger) ) let%test_unit "reuse of locations for removed accounts" = Test.with_instances (fun maskable mask -> @@ -640,7 +639,7 @@ module Make (Test : Test_intf) = struct (Mask.Attached.For_testing.current_location attached_mask) ) ; (* add accounts to mask *) List.iter accounts ~f:(fun account -> - ignore @@ create_new_account_exn attached_mask account) ; + ignore @@ create_new_account_exn attached_mask account ) ; assert ( Option.is_some (Mask.Attached.For_testing.current_location attached_mask) ) ; @@ -648,7 +647,7 @@ module Make (Test : Test_intf) = struct Mask.Attached.remove_accounts_exn attached_mask account_ids ; assert ( Option.is_none - (Mask.Attached.For_testing.current_location attached_mask) )) + (Mask.Attached.For_testing.current_location attached_mask) ) ) let%test_unit "num_accounts for unique keys in mask and parent" = Test.with_instances (fun maskable mask -> @@ -662,13 +661,13 @@ module Make (Test : Test_intf) = struct let accounts = List.map2_exn account_ids balances ~f:Account.create in (* add accounts to mask *) List.iter accounts ~f:(fun account -> - ignore @@ create_new_account_exn attached_mask account) ; + ignore @@ create_new_account_exn attached_mask account ) ; let mask_num_accounts_before = Mask.Attached.num_accounts attached_mask in (* add same accounts to parent *) List.iter accounts ~f:(fun account -> - ignore @@ parent_create_new_account_exn maskable account) ; + ignore @@ parent_create_new_account_exn maskable account ) ; let parent_num_accounts = Maskable.num_accounts maskable in (* should not change number of accounts in mask, since they have the same keys *) let mask_num_accounts_after = @@ -678,7 +677,7 @@ module Make (Test : Test_intf) = struct assert ( Int.equal parent_num_accounts (List.length accounts) && Int.equal parent_num_accounts mask_num_accounts_before - && Int.equal parent_num_accounts mask_num_accounts_after )) + && Int.equal parent_num_accounts mask_num_accounts_after ) ) let%test_unit "Mask reparenting works" = Test.with_chain (fun base ~mask:m1 ~mask_as_base ~mask2:m2 -> @@ -699,7 +698,7 @@ module Make (Test : Test_intf) = struct List.iter locs ~f:(fun (loc, a) -> [%test_result: Account.t option] ~message:"All accounts are accessible from m2" - ~expect:(Some a) (Mask.Attached.get m2 loc)) ; + ~expect:(Some a) (Mask.Attached.get m2 loc) ) ; [%test_result: Account.t option] ~message:"a1 is in base" ~expect:(Some a1) (Test.Base.get base loc1) ; Mask.Attached.commit m1 ; @@ -714,9 +713,9 @@ module Make (Test : Test_intf) = struct List.iter locs ~f:(fun (loc, a) -> [%test_result: Account.t option] ~message:"All accounts are accessible from m2" - ~expect:(Some a) (Mask.Attached.get m2 loc)) + ~expect:(Some a) (Mask.Attached.get m2 loc) ) | _ -> - failwith "unexpected") + failwith "unexpected" ) let%test_unit "setting an account in the parent doesn't remove the masked \ copy if the mask is still dirty for that account" = @@ -732,7 +731,7 @@ module Make (Test : Test_intf) = struct Maskable.set maskable loc acct2 ; [%test_result: Account.t] ~message:"account in mask should be unchanged" ~expect:acct1 - (Mask.Attached.get attached_mask loc |> Option.value_exn)) + (Mask.Attached.get attached_mask loc |> Option.value_exn) ) end module type Depth_S = sig @@ -847,7 +846,7 @@ module Make_maskable_and_mask_with_depth (Depth : Depth_S) = struct let mask2 = Mask.create ~depth:Depth.depth () in let attached2 = Maskable.register_mask attached1_as_base mask2 in f maskable ~mask:attached1 ~mask_as_base:attached1_as_base - ~mask2:attached2) + ~mask2:attached2 ) end module Make_maskable_and_mask (Depth : Depth_S) = diff --git a/src/lib/merkle_ledger_tests/test_stubs.ml b/src/lib/merkle_ledger_tests/test_stubs.ml index a2c8f0fda8a..0fa1a209793 100644 --- a/src/lib/merkle_ledger_tests/test_stubs.ml +++ b/src/lib/merkle_ledger_tests/test_stubs.ml @@ -127,7 +127,7 @@ struct let set_batch t ?(remove_keys = []) ~key_data_pairs = List.iter key_data_pairs ~f:(fun (key, data) -> set t ~key ~data) ; List.iter remove_keys ~f:(fun key -> - Bigstring_frozen.Table.remove t.table key) + Bigstring_frozen.Table.remove t.table key ) let remove t ~key = Bigstring_frozen.Table.remove t.table key diff --git a/src/lib/merkle_list_verifier/merkle_list_verifier.ml b/src/lib/merkle_list_verifier/merkle_list_verifier.ml index d7f2b3c2320..642aa3d24c2 100644 --- a/src/lib/merkle_list_verifier/merkle_list_verifier.ml +++ b/src/lib/merkle_list_verifier/merkle_list_verifier.ml @@ -25,7 +25,7 @@ module Make (Input : Inputs_intf) : Make_intf(Input).S = struct let hashes = List.fold merkle_list ~init:(Non_empty_list.singleton init) ~f:(fun acc proof_elem -> - Non_empty_list.cons (hash (Non_empty_list.head acc) proof_elem) acc) + Non_empty_list.cons (hash (Non_empty_list.head acc) proof_elem) acc ) in if equal_hash target_hash (Non_empty_list.head hashes) then Some hashes else None diff --git a/src/lib/merkle_mask/maskable_merkle_tree.ml b/src/lib/merkle_mask/maskable_merkle_tree.ml index 9ca02b32807..a251d6d67ba 100644 --- a/src/lib/merkle_mask/maskable_merkle_tree.ml +++ b/src/lib/merkle_mask/maskable_merkle_tree.ml @@ -55,7 +55,7 @@ module Make (Inputs : Inputs_intf) = struct (* only default token matters for total currency *) if Token_id.equal (Account.token account) Token_id.default then total_currency + (Balance.to_int @@ Account.balance account) - else total_currency) + else total_currency ) in let uuid = format_uuid mask in { hash = @@ -98,13 +98,13 @@ module Make (Inputs : Inputs_intf) = struct |> Option.value_map ~default:graph_with_mask ~f:(fun children_masks -> List.fold ~init:graph_with_mask children_masks ~f:(fun graph_with_mask_and_child -> - add_edge graph_with_mask_and_child mask))) + add_edge graph_with_mask_and_child mask ) ) ) module Debug = struct let visualize ~filename = Out_channel.with_file filename ~f:(fun output_channel -> let graph = to_graph () in - Graphviz.output_graph output_channel graph) + Graphviz.output_graph output_channel graph ) end module Visualize = struct @@ -149,7 +149,7 @@ module Make (Inputs : Inputs_intf) = struct ~message: "We've already registered a mask with this UUID; you have a bug" ~expect:false - (Uuid.equal (Mask.Attached.get_uuid m) (Mask.get_uuid mask)))) ; + (Uuid.equal (Mask.Attached.get_uuid m) (Mask.get_uuid mask)) ) ) ; (* handles cases where no entries for t, or where there are existing entries *) Uuid.Table.add_multi registered_masks ~key:(get_uuid t) ~data:attached_mask ; attached_mask @@ -192,7 +192,8 @@ module Make (Inputs : Inputs_intf) = struct |> Option.value ~default:[] ) ~f:(fun child_mask -> ignore - @@ unregister_mask_exn ~loc ~grandchildren:`Recursive child_mask) ) ; + @@ unregister_mask_exn ~loc ~grandchildren:`Recursive child_mask ) + ) ; match Uuid.Table.find registered_masks parent_uuid with | None -> failwith @@ error_msg "parent not in registered_masks" @@ -223,7 +224,7 @@ module Make (Inputs : Inputs_intf) = struct () | Some masks -> List.iter masks ~f:(fun mask -> - Mask.Attached.parent_set_notify mask account) + Mask.Attached.parent_set_notify mask account ) let remove_and_reparent_exn t t_as_mask = let parent = Mask.Attached.get_parent t_as_mask in @@ -236,11 +237,11 @@ module Make (Inputs : Inputs_intf) = struct let dangling_masks = List.map children ~f:(fun c -> unregister_mask_exn ~loc:__LOC__ - ~grandchildren:`I_promise_I_am_reparenting_this_mask c) + ~grandchildren:`I_promise_I_am_reparenting_this_mask c ) in ignore (unregister_mask_exn ~loc:__LOC__ t_as_mask : Mask.unattached) ; List.iter dangling_masks ~f:(fun m -> - ignore (register_mask parent m : Mask.Attached.t)) + ignore (register_mask parent m : Mask.Attached.t) ) let batch_notify_mask_children t accounts = match Uuid.Table.find registered_masks (get_uuid t) with @@ -249,7 +250,7 @@ module Make (Inputs : Inputs_intf) = struct | Some masks -> List.iter masks ~f:(fun mask -> List.iter accounts ~f:(fun account -> - Mask.Attached.parent_set_notify mask account)) + Mask.Attached.parent_set_notify mask account ) ) let set_batch t locations_and_accounts = Base.set_batch t locations_and_accounts ; diff --git a/src/lib/merkle_mask/masking_merkle_tree.ml b/src/lib/merkle_mask/masking_merkle_tree.ml index a0c28057273..70fdf84ceef 100644 --- a/src/lib/merkle_mask/masking_merkle_tree.ml +++ b/src/lib/merkle_mask/masking_merkle_tree.ml @@ -185,7 +185,7 @@ module Make (Inputs : Inputs_intf.S) = struct | Some account -> `Fst (location, Some account) | None -> - `Snd location) + `Snd location ) in found_accounts @ Base.get_batch (get_parent t) leftover_locations @@ -287,7 +287,7 @@ module Make (Inputs : Inputs_intf.S) = struct | Some prev_loc -> t.current_location <- Some prev_loc | None -> - t.current_location <- None) ; + t.current_location <- None ) ; (* update hashes *) let account_address = Location.to_path_exn location in let account_hash = Hash.empty_account in @@ -297,7 +297,7 @@ module Make (Inputs : Inputs_intf.S) = struct account_hash in List.iter addresses_and_hashes ~f:(fun (addr, hash) -> - self_set_hash t addr hash) + self_set_hash t addr hash ) (* a write writes only to the mask, parent is not involved need to update both account and hash pieces of the mask *) @@ -318,7 +318,7 @@ module Make (Inputs : Inputs_intf.S) = struct account_hash in List.iter addresses_and_hashes ~f:(fun (addr, hash) -> - self_set_hash t addr hash) + self_set_hash t addr hash ) (* if the mask's parent sets an account, we can prune an entry in the mask if the account in the parent is the same in the mask *) @@ -364,7 +364,7 @@ module Make (Inputs : Inputs_intf.S) = struct Some account | None -> ( try Some (Base.get_inner_hash_at_addr_exn (get_parent t) addr) - with _ -> None )) + with _ -> None ) ) (* transfer state from mask to parent; flush local state *) let commit t = @@ -384,7 +384,7 @@ module Make (Inputs : Inputs_intf.S) = struct [%test_result: Hash.t] ~message:"Merkle root of the mask should delegate to the parent now" ~expect:(merkle_root t) - (Base.merkle_root (get_parent t))) + (Base.merkle_root (get_parent t)) ) (* copy tables in t; use same parent *) let copy t = @@ -420,7 +420,7 @@ module Make (Inputs : Inputs_intf.S) = struct | _ -> failwith "last_filled: expected account locations for the parent \ - and mask" )) + and mask" ) ) include Merkle_ledger.Util.Make (struct module Location = Location @@ -451,12 +451,12 @@ module Make (Inputs : Inputs_intf.S) = struct let set_raw_hash_batch t locations_and_hashes = List.iter locations_and_hashes ~f:(fun (location, hash) -> - self_set_hash t (Location.to_path_exn location) hash) + self_set_hash t (Location.to_path_exn location) hash ) let set_location_batch ~last_location t account_to_location_list = t.current_location <- Some last_location ; Non_empty_list.iter account_to_location_list ~f:(fun (key, data) -> - Account_id.Table.set t.location_tbl ~key ~data) + Account_id.Table.set t.location_tbl ~key ~data ) let set_raw_account_batch t locations_and_accounts = List.iter locations_and_accounts ~f:(fun (location, account) -> @@ -464,7 +464,7 @@ module Make (Inputs : Inputs_intf.S) = struct Token_id.Table.set t.token_owners ~key:(Account_id.derive_token_id ~owner:account_id) ~data:account_id ; - self_set_account t location account) + self_set_account t location account ) end) let set_batch_accounts t addresses_and_accounts = @@ -510,7 +510,7 @@ module Make (Inputs : Inputs_intf.S) = struct |> List.filter_map ~f:(fun aid -> if Key.equal pk (Account_id.public_key aid) then Some (Account_id.token_id aid) - else None) + else None ) |> Token_id.Set.of_list in Set.union mask_tokens (Base.tokens (get_parent t) pk) @@ -545,7 +545,7 @@ module Make (Inputs : Inputs_intf.S) = struct | Some location -> `Fst (account_id, Some location) | None -> - `Snd account_id) + `Snd account_id ) in found_locations @ Base.location_of_account_batch (get_parent t) leftover_account_ids @@ -587,7 +587,7 @@ module Make (Inputs : Inputs_intf.S) = struct List.sort mask_locations ~compare:(fun loc1 loc2 -> let loc1 = Location.to_path_exn loc1 in let loc2 = Location.to_path_exn loc2 in - Location.Addr.compare loc2 loc1) + Location.Addr.compare loc2 loc1 ) in List.iter rev_sorted_mask_locations ~f:(remove_account_and_update_hashes t) @@ -626,9 +626,9 @@ module Make (Inputs : Inputs_intf.S) = struct | Account addr -> (Addr.to_int addr, get t location |> Option.value_exn) | location -> - raise (Location_is_not_account location)) + raise (Location_is_not_account location) ) |> List.sort ~compare:(fun (addr1, _) (addr2, _) -> - Int.compare addr1 addr2) + Int.compare addr1 addr2 ) |> List.map ~f:(fun (_, account) -> account) let iteri t ~f = @@ -643,7 +643,7 @@ module Make (Inputs : Inputs_intf.S) = struct !"iter: index_of_account_exn failed, mask uuid: %{sexp: \ Uuid.t} account id: %{sexp: Account_id.t}, exception: \ %s" - (get_uuid t) acct_id (Exn.to_string exn)) + (get_uuid t) acct_id (Exn.to_string exn) ) in match location_of_account t acct_id with | None -> @@ -651,7 +651,7 @@ module Make (Inputs : Inputs_intf.S) = struct (sprintf !"iter: location_of_account returned None, mask uuid: \ %{sexp: Uuid.t} account id: %{sexp: Account_id.t}" - (get_uuid t) acct_id) + (get_uuid t) acct_id ) | Some loc -> ( match get t loc with | None -> @@ -659,9 +659,9 @@ module Make (Inputs : Inputs_intf.S) = struct (sprintf !"iter: get returned None, mask uuid: %{sexp: Uuid.t} \ account id: %{sexp: Account_id.t}" - (get_uuid t) acct_id) + (get_uuid t) acct_id ) | Some acct -> - (idx, acct) )) + (idx, acct) ) ) in (* in case iteration order matters *) let idx_account_pairs = @@ -678,7 +678,7 @@ module Make (Inputs : Inputs_intf.S) = struct (* parent should ignore accounts in this mask *) let mask_accounts = List.map locations_and_accounts ~f:(fun (_loc, acct) -> - Account.identifier acct) + Account.identifier acct ) in let mask_ignored_accounts = Account_id.Set.of_list mask_accounts in let all_ignored_accounts = diff --git a/src/lib/mina_base/account.ml b/src/lib/mina_base/account.ml index f02f8bdc1ba..64e2271f836 100644 --- a/src/lib/mina_base/account.ml +++ b/src/lib/mina_base/account.ml @@ -57,7 +57,7 @@ module Index = struct let rec go acc i = if i = ledger_depth then acc else go (f acc (Vector.get t i)) (i + 1) in - go init 0) + go init 0 ) } let fold ~ledger_depth t = @@ -108,20 +108,21 @@ module Token_symbol = struct Result.try_with (fun () -> check res) |> Result.map ~f:(Fn.const res) |> Result.map_error - ~f:(Fn.const "Token_symbol.of_yojson: symbol is too long")) + ~f:(Fn.const "Token_symbol.of_yojson: symbol is too long") ) end include T - include Binable.Of_binable - (Core_kernel.String.Stable.V1) - (struct - type t = string + include + Binable.Of_binable + (Core_kernel.String.Stable.V1) + (struct + type t = string - let to_binable = Fn.id + let to_binable = Fn.id - let of_binable x = check x ; x - end) + let of_binable x = check x ; x + end) end end] @@ -142,13 +143,13 @@ module Token_symbol = struct if byte_index < String.length x then let c = x.[byte_index] |> Char.to_int in c land (1 lsl (i mod 8)) <> 0 - else false) + else false ) let of_bits x : t = let c, j, chars = Pickles_types.Vector.fold x ~init:(0, 0, []) ~f:(fun (c, j, chars) x -> let c = c lor ((if x then 1 else 0) lsl j) in - if j = 7 then (0, 0, Char.of_int_exn c :: chars) else (c, j + 1, chars)) + if j = 7 then (0, 0, Char.of_int_exn c :: chars) else (c, j + 1, chars) ) in assert (c = 0) ; assert (j = 0) ; @@ -159,13 +160,13 @@ module Token_symbol = struct Quickcheck.test ~trials:30 ~seed:(`Deterministic "") (Quickcheck.Generator.list_with_length (Pickles_types.Nat.to_int Num_bits.n) - Quickcheck.Generator.bool) + Quickcheck.Generator.bool ) ~f:(fun x -> let v = Pickles_types.Vector.of_list_and_length_exn x Num_bits.n in Pickles_types.Vector.iter2 (to_bits (of_bits v)) v - ~f:(fun x y -> assert (Bool.equal x y))) + ~f:(fun x y -> assert (Bool.equal x y)) ) let%test_unit "of_bits to_bits roundtrip" = Quickcheck.test ~trials:30 ~seed:(`Deterministic "") @@ -192,7 +193,7 @@ module Token_symbol = struct Pickles.Scalar_challenge.to_field_checked' ~num_bits m (Kimchi_backend_common.Scalar_challenge.create t) in - actual_packed) + actual_packed ) in Field.Checked.Assert.equal t actual @@ -203,7 +204,7 @@ module Token_symbol = struct of_bits (Pickles_types.Vector.of_list_and_length_exn (List.take (Field.unpack x) num_bits) - Num_bits.n) + Num_bits.n ) let typ : (var, t) Typ.t = let (Typ typ) = Field.typ in @@ -363,15 +364,16 @@ module Stable = struct type t = Binable_arg.Stable.V2.t [@@deriving sexp, equal, hash, compare, yojson] - include Binable.Of_binable - (Binable_arg.Stable.V2) - (struct - type nonrec t = t + include + Binable.Of_binable + (Binable_arg.Stable.V2) + (struct + type nonrec t = t - let to_binable = check + let to_binable = check - let of_binable = check - end) + let of_binable = check + end) let to_latest = Fn.id @@ -452,7 +454,7 @@ let hash_zkapp_uri_opt (zkapp_uri_opt : string option) = for j = 0 to 7 do (* [Int.test_bit c j] *) bits.((i * 8) + j) <- Int.bit_and c (1 lsl j) <> 0 - done) ; + done ) ; Random_oracle_input.Chunked.packeds (Array.map ~f:(fun b -> (field_of_bool b, 1)) bits) | None -> @@ -522,7 +524,7 @@ let typ' zkapp = ; Typ.transport Public_key.Compressed.typ ~there:delegate_opt ~back:(fun delegate -> if Public_key.Compressed.(equal empty) delegate then None - else Some delegate) + else Some delegate ) ; State_hash.typ ; Timing.typ ; Permissions.typ @@ -562,7 +564,7 @@ let var_of_t ; zkapp ; zkapp_uri } : - value) = + value ) = { Poly.public_key = Public_key.Compressed.var_of_t public_key ; token_id = Token_id.Checked.constant token_id ; token_permissions = Token_permissions.var_of_t token_permissions @@ -600,7 +602,7 @@ module Checked = struct typ' (Typ.transport Zkapp_account.typ ~there:(fun t -> Option.value t ~default:Zkapp_account.default) - ~back:(fun t -> Some t)) + ~back:(fun t -> Some t) ) end let to_input (t : var) = @@ -618,12 +620,12 @@ module Checked = struct ~receipt_chain_hash:(f Receipt.Chain_hash.var_to_input) ~delegate:(f Public_key.Compressed.Checked.to_input) ~voting_for:(f State_hash.var_to_input) - ~timing:(f Timing.var_to_input) ~zkapp_uri:(f Data_as_hash.to_input)) + ~timing:(f Timing.var_to_input) ~zkapp_uri:(f Data_as_hash.to_input) ) let digest t = make_checked (fun () -> Random_oracle.Checked.( - hash ~init:crypto_hash_prefix (pack_input (to_input t)))) + hash ~init:crypto_hash_prefix (pack_input (to_input t))) ) let balance_upper_bound = Bignum_bigint.(one lsl Balance.length_in_bits) @@ -642,7 +644,7 @@ module Checked = struct let min_balance_less_cliff_decrement, _ = Tick.Run.run_checked (Balance.Checked.sub_amount_flagged initial_minimum_balance - cliff_decrement) + cliff_decrement ) in let num_periods, _ = Tick.Run.run_checked @@ -656,9 +658,9 @@ module Checked = struct let min_balance_less_cliff_and_vesting_decrements = Tick.Run.run_checked (Balance.Checked.sub_or_zero min_balance_less_cliff_decrement - (Balance.Checked.Unsafe.of_field vesting_decrement)) + (Balance.Checked.Unsafe.of_field vesting_decrement) ) in - min_balance_less_cliff_and_vesting_decrements) + min_balance_less_cliff_and_vesting_decrements ) in Balance.Checked.if_ before_cliff ~then_:initial_minimum_balance ~else_:else_branch diff --git a/src/lib/mina_base/coinbase.ml b/src/lib/mina_base/coinbase.ml index 4362f7a190d..d508578de3e 100644 --- a/src/lib/mina_base/coinbase.ml +++ b/src/lib/mina_base/coinbase.ml @@ -58,8 +58,8 @@ let create ~amount ~receiver ~fee_transfer = Option.some_if (not (Public_key.Compressed.equal receiver - (Fee_transfer.receiver_pk fee_transfer))) - fee_transfer) + (Fee_transfer.receiver_pk fee_transfer) ) ) + fee_transfer ) in Ok { t with fee_transfer = adjusted_fee_transfer } else Or_error.error_string "Coinbase.create: invalid coinbase" @@ -94,7 +94,7 @@ module Gen = struct if supercharged_coinbase then Option.value_exn (Currency.Amount.scale amount - constraint_constants.supercharged_coinbase_factor) + constraint_constants.supercharged_coinbase_factor ) else amount in (* keep account-creation fee for the coinbase-receiver *) @@ -102,7 +102,7 @@ module Gen = struct Option.value_exn (Currency.Fee.sub (Currency.Amount.to_fee amount) - constraint_constants.account_creation_fee) + constraint_constants.account_creation_fee ) in let min_fee = constraint_constants.account_creation_fee in let%map fee_transfer = diff --git a/src/lib/mina_base/coinbase.mli b/src/lib/mina_base/coinbase.mli index 8fb922470d2..7b0c639fc5a 100644 --- a/src/lib/mina_base/coinbase.mli +++ b/src/lib/mina_base/coinbase.mli @@ -59,6 +59,6 @@ module Gen : sig -> max_amount:int -> fee_transfer: ( coinbase_amount:Currency.Amount.t - -> Fee_transfer.t Quickcheck.Generator.t) + -> Fee_transfer.t Quickcheck.Generator.t ) -> t Quickcheck.Generator.t end diff --git a/src/lib/mina_base/control.ml b/src/lib/mina_base/control.ml index 6c7c2cba07e..f69c98f4cec 100644 --- a/src/lib/mina_base/control.ml +++ b/src/lib/mina_base/control.ml @@ -28,7 +28,7 @@ let gen_with_dummies : t Quickcheck.Generator.t Lazy.t = Proof proof in let dummy_signature = Signature Signature.dummy in - [ dummy_proof; dummy_signature; None_given ])) + [ dummy_proof; dummy_signature; None_given ] ) ) [%%else] diff --git a/src/lib/mina_base/data_as_hash.ml b/src/lib/mina_base/data_as_hash.ml index 9c41052ff3a..7e433d2e3a8 100644 --- a/src/lib/mina_base/data_as_hash.ml +++ b/src/lib/mina_base/data_as_hash.ml @@ -17,7 +17,7 @@ let optional_typ ~hash ~non_preimage ~dummy_value = Typ.transport Typ.(Field.typ * Internal.ref ()) ~there:(function - | None -> (non_preimage, dummy_value) | Some s -> (hash s, s)) + | None -> (non_preimage, dummy_value) | Some s -> (hash s, s) ) ~back:(fun (_, s) -> Some s) let to_input (x, _) = Random_oracle_input.Chunked.field x diff --git a/src/lib/mina_base/fee_excess.ml b/src/lib/mina_base/fee_excess.ml index e016de648ed..69999110768 100644 --- a/src/lib/mina_base/fee_excess.ml +++ b/src/lib/mina_base/fee_excess.ml @@ -181,12 +181,12 @@ let assert_equal_checked (t1 : var) (t2 : var) = Checked.all_unit [ [%with_label "fee_token_l"] (make_checked (fun () -> - Token_id.Checked.Assert.equal t1.fee_token_l t2.fee_token_l)) + Token_id.Checked.Assert.equal t1.fee_token_l t2.fee_token_l ) ) ; [%with_label "fee_excess_l"] (Fee.Signed.Checked.assert_equal t1.fee_excess_l t2.fee_excess_l) ; [%with_label "fee_token_r"] (make_checked (fun () -> - Token_id.Checked.Assert.equal t1.fee_token_r t2.fee_token_r)) + Token_id.Checked.Assert.equal t1.fee_token_r t2.fee_token_r ) ) ; [%with_label "fee_excess_r"] (Fee.Signed.Checked.assert_equal t1.fee_excess_r t2.fee_excess_r) ] @@ -260,7 +260,7 @@ let%snarkydef eliminate_fee_excess_checked (fee_token_l, fee_excess_l) let%bind fee_token = make_checked (fun () -> Token_id.Checked.if_ fee_excess_zero ~then_:fee_token_m - ~else_:fee_token) + ~else_:fee_token ) in let%map fee_excess_to_move = Field.Checked.if_ may_move ~then_:fee_excess_m @@ -338,7 +338,7 @@ let rebalance_checked { fee_token_l; fee_excess_l; fee_token_r; fee_excess_r } = in make_checked (fun () -> Token_id.Checked.if_ excess_is_zero ~then_:fee_token_r - ~else_:fee_token_l) + ~else_:fee_token_l ) in (* Rebalancing. *) let%bind fee_excess_l, fee_excess_r = @@ -360,7 +360,7 @@ let rebalance_checked { fee_token_l; fee_excess_l; fee_token_r; fee_excess_r } = make_checked (fun () -> Token_id.Checked.if_ excess_is_zero ~then_:Token_id.(Checked.constant default) - ~else_:fee_token_l) + ~else_:fee_token_l ) in let%map fee_token_r = let%bind excess_is_zero = @@ -369,7 +369,7 @@ let rebalance_checked { fee_token_l; fee_excess_l; fee_token_r; fee_excess_r } = make_checked (fun () -> Token_id.Checked.if_ excess_is_zero ~then_:Token_id.(Checked.constant default) - ~else_:fee_token_r) + ~else_:fee_token_r ) in { fee_token_l; fee_excess_l; fee_token_r; fee_excess_r } @@ -437,7 +437,7 @@ let%snarkydef combine_checked (eliminate_fee_excess_checked (fee_token1_l, fee_excess1_l) (fee_token1_r, fee_excess1_r) - (fee_token2_l, fee_excess2_l)) + (fee_token2_l, fee_excess2_l) ) in let%bind (fee_token1_l, fee_excess1_l), (fee_token2_r, fee_excess2_r) = (* [1l; 2l; 2r] -> [1l; 2r] *) @@ -445,7 +445,7 @@ let%snarkydef combine_checked (eliminate_fee_excess_checked (fee_token1_l, fee_excess1_l) (fee_token2_l, fee_excess2_l) - (fee_token2_r, fee_excess2_r)) + (fee_token2_r, fee_excess2_r) ) in let%bind { fee_token_l; fee_excess_l; fee_token_r; fee_excess_r } = rebalance_checked @@ -582,7 +582,7 @@ let%test_unit "Checked and unchecked behaviour is consistent" = Typ.(typ * typ) typ (fun (fe1, fe2) -> combine_checked fe1 fe2) - (fe1, fe2)) + (fe1, fe2) ) in match (fe, fe_checked) with | Ok fe, Ok fe_checked -> @@ -590,7 +590,7 @@ let%test_unit "Checked and unchecked behaviour is consistent" = | Error _, Error _ -> () | _ -> - [%test_eq: t Or_error.t] fe fe_checked) + [%test_eq: t Or_error.t] fe fe_checked ) let%test_unit "Combine succeeds when the middle excess is zero" = Quickcheck.test @@ -600,7 +600,7 @@ let%test_unit "Combine succeeds when the middle excess is zero" = (* The tokens before and after should be distinct. Especially in this scenario, we may get an overflow error otherwise. *) - not (Token_id.equal fe1.fee_token_l tid))) + not (Token_id.equal fe1.fee_token_l tid) )) ~f:(fun (fe1, tid, excess) -> let fe2 = if Fee.Signed.(equal zero) fe1.fee_excess_r then of_single (tid, excess) @@ -609,7 +609,7 @@ let%test_unit "Combine succeeds when the middle excess is zero" = of_one_or_two (`Two ( (fe1.fee_token_r, Fee.Signed.negate fe1.fee_excess_r) - , (tid, excess) )) + , (tid, excess) ) ) with | Ok fe2 -> fe2 @@ -617,6 +617,6 @@ let%test_unit "Combine succeeds when the middle excess is zero" = (* The token is the same, and rebalancing causes an overflow. *) of_single (fe1.fee_token_r, Fee.Signed.negate fe1.fee_excess_r) in - ignore @@ Or_error.ok_exn (combine fe1 fe2)) + ignore @@ Or_error.ok_exn (combine fe1 fe2) ) [%%endif] diff --git a/src/lib/mina_base/fee_transfer.ml b/src/lib/mina_base/fee_transfer.ml index 87602acd5aa..51feaaeb90d 100644 --- a/src/lib/mina_base/fee_transfer.ml +++ b/src/lib/mina_base/fee_transfer.ml @@ -98,7 +98,7 @@ include Comparable.Make (Stable.Latest) let fee_excess ft = ft |> One_or_two.map ~f:(fun { fee_token; fee; _ } -> - (fee_token, Currency.Fee.Signed.(negate (of_unsigned fee)))) + (fee_token, Currency.Fee.Signed.(negate (of_unsigned fee))) ) |> Fee_excess.of_one_or_two let receiver_pks t = One_or_two.to_list (One_or_two.map ~f:Single.receiver_pk t) diff --git a/src/lib/mina_base/hack_snarky_tests.ml b/src/lib/mina_base/hack_snarky_tests.ml index fb323be1ba4..ed01120174b 100644 --- a/src/lib/mina_base/hack_snarky_tests.ml +++ b/src/lib/mina_base/hack_snarky_tests.ml @@ -8,7 +8,7 @@ let%test_module "merkle_tree" = let hash = Option.value_map ~default:Free_hash.Hash_empty ~f:(fun x -> - Free_hash.Hash_value x) + Free_hash.Hash_value x ) let create_tree n = let tree = create ~hash ~merge 0 in diff --git a/src/lib/mina_base/ledger_hash.ml b/src/lib/mina_base/ledger_hash.ml index 2670e1d71c4..baf4500a14b 100644 --- a/src/lib/mina_base/ledger_hash.ml +++ b/src/lib/mina_base/ledger_hash.ml @@ -92,7 +92,7 @@ let%snarkydef modify_account ~depth t aid (Merkle_tree.modify_req ~depth (var_to_hash_packed t) addr ~f:(fun account -> let%bind x = filter account in - f x account)) + f x account ) ) reraise_merkle_requests >>| var_of_hash_packed @@ -121,9 +121,9 @@ let%snarkydef modify_account_send ~depth t aid ~is_writeable ~f = let%bind () = [%with_label "account is either present or empty and writeable"] (Boolean.Assert.any - [ account_already_there; not_there_but_writeable ]) + [ account_already_there; not_there_but_writeable ] ) in - return not_there_but_writeable)) + return not_there_but_writeable ) ) ~f:(fun is_empty_and_writeable x -> f ~is_empty_and_writeable x) (* @@ -149,5 +149,5 @@ let%snarkydef modify_account_recv ~depth t aid ~f = [%with_label "account is either present or empty"] (Boolean.Assert.any [ account_already_there; account_not_there ]) in - return account_not_there)) + return account_not_there ) ) ~f:(fun is_empty_and_writeable x -> f ~is_empty_and_writeable x) diff --git a/src/lib/mina_base/ledger_hash_intf.ml b/src/lib/mina_base/ledger_hash_intf.ml index c44588441b8..72bd3f4f4d6 100644 --- a/src/lib/mina_base/ledger_hash_intf.ml +++ b/src/lib/mina_base/ledger_hash_intf.ml @@ -43,7 +43,7 @@ module type S = sig -> f: ( is_empty_and_writeable:Boolean.var -> Account.var - -> Account.var Checked.t) + -> Account.var Checked.t ) -> var Checked.t val modify_account_recv : @@ -53,6 +53,6 @@ module type S = sig -> f: ( is_empty_and_writeable:Boolean.var -> Account.var - -> Account.var Checked.t) + -> Account.var Checked.t ) -> var Checked.t end diff --git a/src/lib/mina_base/parties.ml b/src/lib/mina_base/parties.ml index 048fa883dcf..17b101ff2ee 100644 --- a/src/lib/mina_base/parties.ml +++ b/src/lib/mina_base/parties.ml @@ -43,7 +43,7 @@ module Call_forest = struct let rec fold_forest (ts : (_ t, _) With_stack_hash.t list) ~f ~init = List.fold ts ~init ~f:(fun acc { elt; stack_hash = _ } -> - fold elt ~init:acc ~f) + fold elt ~init:acc ~f ) and fold { party; calls; party_digest = _ } ~f ~init = fold_forest calls ~f ~init:(f init party) @@ -55,7 +55,7 @@ module Call_forest = struct acc { elt = elt1; stack_hash = _ } { elt = elt2; stack_hash = _ } - -> fold2_exn elt1 elt2 ~init:acc ~f) + -> fold2_exn elt1 elt2 ~init:acc ~f ) and fold2_exn { party = party1; calls = calls1; party_digest = _ } { party = party2; calls = calls2; party_digest = _ } ~f ~init = @@ -451,12 +451,12 @@ module Call_forest = struct ~add_caller ~null_id:Token_id.default ~party_id:(fun p -> Account_id.( - derive_token_id ~owner:(create p.body.public_key p.body.token_id))) + derive_token_id ~owner:(create p.body.public_key p.body.token_id)) ) let remove_callers (type party_with_caller party_without_sender h1 h2 id) (ps : (party_with_caller, h1, h2) t) ~(equal_id : id -> id -> bool) ~(add_call_type : - party_with_caller -> Party.Call_type.t -> party_without_sender) + party_with_caller -> Party.Call_type.t -> party_without_sender ) ~(null_id : id) ~(party_caller : party_with_caller -> id) : (party_without_sender, h1, h2) t = let rec go ~top_level_party parent_caller ps = @@ -508,7 +508,7 @@ module Call_forest = struct ; party_digest = () ; calls = List.map calls ~f:(fun elt -> - { With_stack_hash.elt; stack_hash = () }) + { With_stack_hash.elt; stack_hash = () } ) } in let t : With_call_type.t = @@ -546,13 +546,13 @@ module Call_forest = struct ~call_type:(fun p -> p.caller) ~add_caller:(fun p caller : int P.t -> { p with caller }) ~null_id - ~party_id:(fun p -> p.id)) + ~party_id:(fun p -> p.id) ) expected_output ; [%test_eq: With_call_type.t] (remove_callers expected_output ~equal_id:Int.equal ~add_call_type:(fun p call_type -> { p with caller = call_type }) ~null_id - ~party_caller:(fun p -> p.caller)) + ~party_caller:(fun p -> p.caller) ) t module With_hashes = struct @@ -583,11 +583,12 @@ module Call_forest = struct |> add_callers ~call_type:(fun ((p : Party.Wire.t), _) -> p.body.caller) ~add_caller:(fun (p, vk) (caller : Token_id.t) -> - ((add_caller p caller : Party.t), vk)) + ((add_caller p caller : Party.t), vk) ) ~null_id:Token_id.default ~party_id:(fun (p, _) -> Account_id.( - derive_token_id ~owner:(create p.body.public_key p.body.token_id))) + derive_token_id ~owner:(create p.body.public_key p.body.token_id)) + ) |> accumulate_hashes let to_parties_list (x : _ t) = to_parties_list x @@ -608,7 +609,7 @@ module Call_forest = struct let exists (type p) (t : (p, _, _) t) ~(f : p -> bool) : bool = with_return (fun { return } -> fold t ~init:() ~f:(fun () p -> if f p then return true else ()) ; - false) + false ) end module Wire = struct @@ -638,7 +639,7 @@ module Wire = struct List.fold ~init:0 t.other_parties ~f:(fun depth party -> let new_depth = party.body.call_depth in if new_depth >= 0 && new_depth <= depth + 1 then new_depth - else assert false) + else assert false ) in true with _ -> false @@ -674,16 +675,16 @@ module Stable = struct ; other_parties = w.other_parties |> Call_forest.of_parties_list ~party_depth:(fun (p : Party.Wire.t) -> - p.body.call_depth) + p.body.call_depth ) |> Call_forest.add_callers ~call_type:(fun (p : Party.Wire.t) -> p.body.caller) ~add_caller ~null_id:Token_id.default ~party_id:(fun (p : Party.Wire.t) -> Account_id.( derive_token_id - ~owner:(create p.body.public_key p.body.token_id))) + ~owner:(create p.body.public_key p.body.token_id)) ) |> Call_forest.accumulate_hashes ~hash_party:(fun (p : Party.t) -> - Digest.Party.create p) + Digest.Party.create p ) } let to_wire (t : t) : Wire.t = @@ -694,18 +695,19 @@ module Stable = struct (Call_forest.remove_callers ~equal_id:Token_id.equal ~add_call_type:Party.to_wire ~null_id:Token_id.default ~party_caller:(fun p -> p.body.caller) - t.other_parties) + t.other_parties ) } - include Binable.Of_binable - (Wire.Stable.V1) - (struct - type nonrec t = t + include + Binable.Of_binable + (Wire.Stable.V1) + (struct + type nonrec t = t - let of_binable = of_wire + let of_binable = of_wire - let to_binable = to_wire - end) + let to_binable = to_wire + end) end end] @@ -744,8 +746,9 @@ let fee_excess (t : t) = Fee_excess.of_single (fee_token t, Currency.Fee.Signed.of_unsigned (fee t)) let accounts_accessed (t : t) = - Call_forest.fold t.other_parties ~init:[ fee_payer t ] ~f:(fun acc p -> - Party.account_id p :: acc) + Call_forest.fold t.other_parties + ~init:[ fee_payer t ] + ~f:(fun acc p -> Party.account_id p :: acc) |> List.rev |> List.stable_dedup let fee_payer_pk (t : t) = t.fee_payer.body.public_key @@ -920,7 +923,7 @@ type other_parties = (Party.t, Digest.Party.t, Digest.Forest.t) Call_forest.t let other_parties_deriver obj = let of_parties_with_depth (ps : Party.t list) : other_parties = Call_forest.of_parties_list ps ~party_depth:(fun (p : Party.t) -> - p.body.call_depth) + p.body.call_depth ) |> Call_forest.accumulate_hashes' and to_parties_with_depth (ps : other_parties) : Party.t list = Call_forest.to_list ps @@ -971,7 +974,7 @@ let dummy = let inner_query = lazy (Option.value_exn ~message:"Invariant: All projectable derivers are Some" - Fields_derivers_zkapps.(inner_query (deriver @@ Derivers.o ()))) + Fields_derivers_zkapps.(inner_query (deriver @@ Derivers.o ())) ) let%test_module "Test" = ( module struct diff --git a/src/lib/mina_base/party.ml b/src/lib/mina_base/party.ml index 6ee5e50abab..24ea1d4fe0a 100644 --- a/src/lib/mina_base/party.ml +++ b/src/lib/mina_base/party.ml @@ -52,7 +52,7 @@ module Call_type = struct | false -> Call | true -> - Delegate_call) + Delegate_call ) end module Update = struct @@ -162,7 +162,7 @@ module Update = struct ; vesting_period ; vesting_increment } : - t) = + t ) = List.reduce_exn ~f:Random_oracle_input.Chunked.append [ Balance.var_to_input initial_minimum_balance ; Global_slot.Checked.to_input cliff_time @@ -255,7 +255,7 @@ module Update = struct (Quickcheck.Generator.return (let data = Pickles.Side_loaded.Verification_key.dummy in let hash = Zkapp_account.digest_vk data in - { With_hash.data; hash })) + { With_hash.data; hash } ) ) else return Set_or_keep.Keep in let%bind permissions = @@ -333,7 +333,7 @@ module Update = struct ; timing ; voting_for } : - t) = + t ) = let open Random_oracle_input.Chunked in List.reduce_exn ~f:append [ Zkapp_state.to_input app_state @@ -341,7 +341,7 @@ module Update = struct ; Set_or_keep.Checked.to_input delegate ~f:Public_key.Compressed.Checked.to_input ; Set_or_keep.Checked.to_input verification_key ~f:(fun x -> - field (Data_as_hash.hash x.data)) + field (Data_as_hash.hash x.data) ) ; Set_or_keep.Checked.to_input permissions ~f:Permissions.Checked.to_input ; Set_or_keep.Checked.to_input zkapp_uri ~f:Data_as_hash.to_input @@ -376,7 +376,7 @@ module Update = struct ; timing ; voting_for } : - t) = + t ) = let open Random_oracle_input.Chunked in List.reduce_exn ~f:append [ Zkapp_state.to_input app_state @@ -413,26 +413,26 @@ module Update = struct | { With_hash.data = Some data; hash } -> Some { With_hash.data; hash } | { With_hash.data = None; _ } -> - None) + None ) ~of_option:(function | Some { With_hash.data; hash } -> { With_hash.data = Some data; hash } | None -> - { With_hash.data = None; hash = Field.Constant.zero }) + { With_hash.data = None; hash = Field.Constant.zero } ) |> Typ.transport_var ~there: (Set_or_keep.Checked.map - ~f:(fun { Zkapp_basic.Flagged_option.data; _ } -> data)) + ~f:(fun { Zkapp_basic.Flagged_option.data; _ } -> data) ) ~back:(fun x -> Set_or_keep.Checked.map x ~f:(fun data -> { Zkapp_basic.Flagged_option.data ; is_some = Set_or_keep.Checked.is_set x - })) + } ) ) ; Set_or_keep.typ ~dummy:Permissions.user_default Permissions.typ ; Set_or_keep.optional_typ (Data_as_hash.optional_typ ~hash:Account.hash_zkapp_uri ~non_preimage:(Account.hash_zkapp_uri_opt None) - ~dummy_value:"") + ~dummy_value:"" ) ~to_option:Fn.id ~of_option:Fn.id ; Set_or_keep.typ ~dummy:Account.Token_symbol.default Account.Token_symbol.typ @@ -470,7 +470,7 @@ module Update = struct dummy |> to_base58_check |> of_base58_check_exn) in let hash = Zkapp_account.digest_vk data in - { With_hash.data; hash }) + { With_hash.data; hash } ) in let update : t = { app_state @@ -868,7 +868,7 @@ module Body = struct ; use_full_commitment ; caller } : - t) = + t ) = List.reduce_exn ~f:Random_oracle_input.Chunked.append [ Public_key.Compressed.Checked.to_input public_key ; Update.Checked.to_input update @@ -995,7 +995,7 @@ module Body = struct ; use_full_commitment ; caller } : - t) = + t ) = List.reduce_exn ~f:Random_oracle_input.Chunked.append [ Public_key.Compressed.to_input public_key ; Update.to_input update diff --git a/src/lib/mina_base/pending_coinbase.ml b/src/lib/mina_base/pending_coinbase.ml index 7e72d43f682..a7e585a1cf6 100644 --- a/src/lib/mina_base/pending_coinbase.ml +++ b/src/lib/mina_base/pending_coinbase.ml @@ -16,7 +16,7 @@ open Currency which is the oldest, and which is the newest stack. The name "stack" here is a misnomer: see issue #3226 - *) +*) module Coinbase_data = struct [%%versioned @@ -56,9 +56,9 @@ module Coinbase_data = struct [ Public_key.Compressed.typ; Amount.typ ] in let of_hlist - : 'public_key 'amount. ( unit - , 'public_key -> 'amount -> unit ) - H_list.t -> 'public_key * 'amount = + : 'public_key 'amount. + (unit, 'public_key -> 'amount -> unit) H_list.t + -> 'public_key * 'amount = let open H_list in fun [ public_key; amount ] -> (public_key, amount) in @@ -169,7 +169,7 @@ module Coinbase_stack = struct let open Random_oracle in hash ~init:Hash_prefix.coinbase_stack (pack_input - (Input.Chunked.append (Coinbase_data.to_input coinbase) (to_input h))) + (Input.Chunked.append (Coinbase_data.to_input coinbase) (to_input h)) ) |> of_hash let empty = Random_oracle.salt "CoinbaseStack" |> Random_oracle.digest @@ -184,8 +184,8 @@ module Coinbase_stack = struct (pack_input (Random_oracle.Input.Chunked.append (Coinbase_data.Checked.to_input cb) - (var_to_input h))) - |> var_of_hash_packed) + (var_to_input h) ) ) + |> var_of_hash_packed ) let check_merge (_, t1) (s2, _) = equal_var t1 s2 @@ -324,7 +324,7 @@ module State_stack = struct |] |> Stack_hash.var_of_hash_packed in - { t with curr }) + { t with curr } ) let check_merge (s1, t1) (s2, t2) = (*state stacks are updated for every transaction in transaction snark but @@ -482,7 +482,7 @@ end arguments. Therefore, for modules with a bin_io type passed to the functor, that type cannot be in a version module hierarchy. We build the required modules for Hash and Stack. - *) +*) module Stack_versioned = struct module Poly = struct @@ -586,7 +586,7 @@ module T = struct make_checked (fun () -> Random_oracle.Checked.( hash ~init:Hash_prefix_states.coinbase_stack - (pack_input (var_to_input t)))) + (pack_input (var_to_input t))) ) let var_of_t t = { Poly.data = Coinbase_stack.var_of_t t.Poly.data @@ -652,7 +652,7 @@ module T = struct || Stack_hash.equal second.state.init second.state.curr || Stack_hash.equal first.state.curr second.state.curr || Option.value_map prev ~default:true ~f:(fun prev -> - Stack_hash.equal prev.state.curr second.state.curr) + Stack_hash.equal prev.state.curr second.state.curr ) in coinbase_stack_connected && state_stack_connected @@ -764,7 +764,7 @@ module T = struct Tick.make_checked (fun () -> Random_oracle.Checked.hash ~init:(Hash_prefix.coinbase_merkle_tree height) - [| h1; h2 |]) + [| h1; h2 |] ) let assert_equal h1 h2 = Field.Checked.Assert.equal h1 h2 @@ -823,7 +823,7 @@ module T = struct Typ.(Address.typ ~depth * Address.typ ~depth) As_prover.( map (read Update.Action.typ action) ~f:(fun act -> - Find_index_of_newest_stacks act)) + Find_index_of_newest_stacks act )) in let equal_to_zero x = Amount.(equal_var x (var_of_t zero)) in let%bind no_update = Update.Action.Checked.no_update action in @@ -850,7 +850,7 @@ module T = struct let amt = Option.value_exn (Currency.Amount.scale constraint_constants.coinbase_amount - constraint_constants.supercharged_coinbase_factor) + constraint_constants.supercharged_coinbase_factor ) in Currency.Amount.var_of_t amt in @@ -869,7 +869,7 @@ module T = struct let%bind () = with_label __LOC__ (let%bind check = Boolean.equal no_update amount1_equal_to_zero in - Boolean.Assert.is_true check) + Boolean.Assert.is_true check ) in let%bind no_coinbase = Boolean.(no_update ||| no_coinbase_in_this_stack) @@ -886,7 +886,7 @@ module T = struct chain Stack.if_ no_coinbase ~then_:(return stack) ~else_: (Stack.if_ amount2_equal_to_zero ~then_:stack_with_amount1 - ~else_:stack_with_amount2) + ~else_:stack_with_amount2 ) in (*This is for the second stack for when transactions in a block occupy two trees of the scan state; the second tree will carry-forward the state @@ -921,14 +921,14 @@ module T = struct handle (Merkle_tree.fetch_and_update_req ~depth (Hash.var_to_hash_packed t) - addr1 ~f:update_stack1) + addr1 ~f:update_stack1 ) reraise_merkle_requests in (*update the second stack*) let%map root, _, _ = handle (Merkle_tree.fetch_and_update_req ~depth root' addr2 - ~f:(update_stack2 prev)) + ~f:(update_stack2 prev) ) reraise_merkle_requests in Hash.var_of_hash_packed root @@ -996,7 +996,7 @@ module T = struct ~f:(fun i -> cur_hash := Hash.merge ~height:(i + len - 1) !cur_hash !cur_hash ; - !cur_hash)) ) ; + !cur_hash ) ) ) ; !cached.(i) let create_exn' ~depth () = @@ -1071,7 +1071,7 @@ module T = struct let prev_stack_id = Option.value ~default:Stack_id.zero (curr_stack_id t) in Or_error.try_with (fun () -> let index = Merkle_tree.find_index_exn t.tree prev_stack_id in - Merkle_tree.get_exn t.tree index) + Merkle_tree.get_exn t.tree index ) let latest_stack (t : t) ~is_new_stack = let open Or_error.Let_syntax in @@ -1079,7 +1079,7 @@ module T = struct let%bind res = Or_error.try_with (fun () -> let index = Merkle_tree.find_index_exn t.tree key in - Merkle_tree.get_exn t.tree index) + Merkle_tree.get_exn t.tree index ) in if is_new_stack then let%map prev_stack = current_stack t in @@ -1211,7 +1211,7 @@ module T = struct in respond (Provide prev_state) | _ -> - unhandled) + unhandled ) end include T @@ -1266,14 +1266,14 @@ let%test_unit "add stack + remove stack = initial tree " = |> Or_error.ok_exn in is_new_stack := false ; - t) + t ) in let _, after_del = remove_coinbase_stack ~depth after_adding |> Or_error.ok_exn in pending_coinbases := after_del ; assert (Hash.equal (merkle_root after_del) init) ; - Async_kernel.Deferred.return ())) + Async_kernel.Deferred.return () ) ) module type Pending_coinbase_intf = sig type t [@@deriving sexp] @@ -1296,7 +1296,7 @@ let add_coinbase_with_zero_checks (type t) if supercharged_coinbase then Option.value_exn (Currency.Amount.scale constraint_constants.coinbase_amount - constraint_constants.supercharged_coinbase_factor) + constraint_constants.supercharged_coinbase_factor ) else constraint_constants.coinbase_amount in let coinbase' = @@ -1340,7 +1340,7 @@ let%test_unit "Checked_stack = Unchecked_stack" = in Or_error.ok_exn (run_and_check comp) in - assert (Stack.equal unchecked checked)) + assert (Stack.equal unchecked checked) ) let%test_unit "Checked_tree = Unchecked_tree" = let open Quickcheck in @@ -1352,10 +1352,9 @@ let%test_unit "Checked_tree = Unchecked_tree" = test ~trials:20 (Generator.tuple2 (Coinbase.Gen.gen ~constraint_constants) - State_body_hash.gen) - ~f: - (fun ( (coinbase, `Supercharged_coinbase supercharged_coinbase) - , state_body_hash ) -> + State_body_hash.gen ) + ~f:(fun ( (coinbase, `Supercharged_coinbase supercharged_coinbase) + , state_body_hash ) -> let amount = coinbase.amount in let is_new_stack, action = Currency.Amount.( @@ -1391,14 +1390,14 @@ let%test_unit "Checked_tree = Unchecked_tree" = } ~coinbase_receiver:coinbase_receiver_var ~supercharge_coinbase:supercharge_coinbase_var - state_body_hash_var) + state_body_hash_var ) (unstage (handler ~depth pending_coinbases ~is_new_stack)) in As_prover.read Hash.typ result in Or_error.ok_exn (run_and_check comp) in - assert (Hash.equal (merkle_root unchecked) checked_merkle_root)) + assert (Hash.equal (merkle_root unchecked) checked_merkle_root) ) let%test_unit "Checked_tree = Unchecked_tree after pop" = let open Quickcheck in @@ -1409,10 +1408,9 @@ let%test_unit "Checked_tree = Unchecked_tree after pop" = test ~trials:20 (Generator.tuple2 (Coinbase.Gen.gen ~constraint_constants) - State_body_hash.gen) - ~f: - (fun ( (coinbase, `Supercharged_coinbase supercharged_coinbase) - , state_body_hash ) -> + State_body_hash.gen ) + ~f:(fun ( (coinbase, `Supercharged_coinbase supercharged_coinbase) + , state_body_hash ) -> let pending_coinbases = create ~depth () |> Or_error.ok_exn in let amount = coinbase.amount in let action = @@ -1450,7 +1448,7 @@ let%test_unit "Checked_tree = Unchecked_tree after pop" = } ~coinbase_receiver:coinbase_receiver_var ~supercharge_coinbase:supercharge_coinbase_var - state_body_hash_var) + state_body_hash_var ) (unstage (handler ~depth pending_coinbases ~is_new_stack:true)) in As_prover.read Hash.typ result @@ -1471,7 +1469,7 @@ let%test_unit "Checked_tree = Unchecked_tree after pop" = let%map current, _previous = handle (f_pop_coinbase ~proof_emitted:Boolean.true_ - (Hash.var_of_t checked_merkle_root)) + (Hash.var_of_t checked_merkle_root) ) (unstage (handler ~depth unchecked ~is_new_stack:false)) in As_prover.read Hash.typ current @@ -1481,7 +1479,7 @@ let%test_unit "Checked_tree = Unchecked_tree after pop" = assert ( Hash.equal (merkle_root unchecked_after_pop) - checked_merkle_root_after_pop )) + checked_merkle_root_after_pop ) ) let%test_unit "push and pop multiple stacks" = let open Quickcheck in @@ -1518,7 +1516,7 @@ let%test_unit "push and pop multiple stacks" = add_coinbase_with_zero_checks ~constraint_constants (module Pending_coinbase) pending_coinbases ~coinbase ~is_new_stack:false ~state_body_hash - ~supercharged_coinbase) + ~supercharged_coinbase ) in let new_stack = Or_error.ok_exn @@ -1531,7 +1529,7 @@ let%test_unit "push and pop multiple stacks" = List.fold ~init:([], pending_coinbases) coinbase_lists ~f:(fun (stacks, pc) coinbases -> let new_stack, pc = t_of_coinbases pc coinbases in - (new_stack :: stacks, pc)) + (new_stack :: stacks, pc) ) in (* remove the oldest stack and check if that's the expected one *) let remove_check t expected_stack = @@ -1570,6 +1568,6 @@ let%test_unit "push and pop multiple stacks" = (list (Generator.tuple2 (Coinbase.Gen.gen ~constraint_constants) - State_body_hash.gen))) + State_body_hash.gen ) )) in test ~trials:100 coinbase_lists_gen ~f:add_remove_check diff --git a/src/lib/mina_base/permissions.ml b/src/lib/mina_base/permissions.ml index fab08451cb4..c47dc9c28a0 100644 --- a/src/lib/mina_base/permissions.ml +++ b/src/lib/mina_base/permissions.ml @@ -45,7 +45,7 @@ module Ledger_hash = Ledger_hash0 "Making sense" can be captured by the idea that these are the *increasing* boolean functions on the type { has_valid_signature: bool; has_valid_proof: bool }. - *) +*) module Auth_required = struct [%%versioned module Stable = struct @@ -209,7 +209,7 @@ module Auth_required = struct let%test_unit "decode encode" = List.iter [ Impossible; Proof; Signature; Either ] ~f:(fun t -> - [%test_eq: t] t (decode (encode t))) + [%test_eq: t] t (decode (encode t)) ) [%%ifdef consensus_mechanism] @@ -220,7 +220,7 @@ module Auth_required = struct let to_input : t -> _ = Encoding.to_input ~field_of_bool:(fun (b : Boolean.var) -> - (b :> Field.Var.t)) + (b :> Field.Var.t) ) let constant t = Encoding.map (encode t) ~f:Boolean.var_of_value diff --git a/src/lib/mina_base/permissions.mli b/src/lib/mina_base/permissions.mli index 89657080a16..6011d22fc13 100644 --- a/src/lib/mina_base/permissions.mli +++ b/src/lib/mina_base/permissions.mli @@ -102,7 +102,8 @@ val deriver : (< contramap : (Auth_required.t Poly.t -> Auth_required.t Poly.t) ref ; graphql_arg : ( unit - -> Auth_required.t Poly.t Fields_derivers_graphql.Schema.Arg.arg_typ) + -> Auth_required.t Poly.t Fields_derivers_graphql.Schema.Arg.arg_typ + ) ref ; graphql_arg_accumulator : Auth_required.t Poly.t Fields_derivers_zkapps.Graphql.Args.Acc.T.t ref @@ -126,17 +127,17 @@ val deriver : ref ; of_json : ( [> `Assoc of (string * Yojson.Safe.t) list ] - -> Auth_required.t Poly.t) + -> Auth_required.t Poly.t ) ref ; of_json_creator : Yojson.Safe.t Core_kernel.String.Map.t ref ; to_json : ( Auth_required.t Poly.t - -> [> `Assoc of (string * Yojson.Safe.t) list ]) + -> [> `Assoc of (string * Yojson.Safe.t) list ] ) ref ; to_json_accumulator : (string * (Auth_required.t Poly.t -> Yojson.Safe.t)) option list ref ; skip : bool ref ; .. > as - 'a) + 'a ) -> 'a diff --git a/src/lib/mina_base/protocol_constants_checked.ml b/src/lib/mina_base/protocol_constants_checked.ml index bd2550afac7..4a36d0c6a66 100644 --- a/src/lib/mina_base/protocol_constants_checked.ml +++ b/src/lib/mina_base/protocol_constants_checked.ml @@ -6,12 +6,12 @@ module T = Mina_numbers.Length (*constants actually required for blockchain snark*) (* k - ,c - ,slots_per_epoch - ,slots_per_sub_window - ,sub_windows_per_window - ,checkpoint_window_size_in_slots - ,block_window_duration_ms*) + ,c + ,slots_per_epoch + ,slots_per_sub_window + ,sub_windows_per_window + ,checkpoint_window_size_in_slots + ,block_window_duration_ms*) module Poly = Genesis_constants.Protocol.Poly @@ -122,7 +122,8 @@ let%test_unit "value = var" = [%test_eq: Value.t] protocol_constants (t_of_value protocol_constants |> value_of_t) in - Quickcheck.test ~trials:100 Value.gen ~examples:[ value_of_t compiled ] + Quickcheck.test ~trials:100 Value.gen + ~examples:[ value_of_t compiled ] ~f:test [%%endif] diff --git a/src/lib/mina_base/receipt.ml b/src/lib/mina_base/receipt.ml index 0663852acab..675ad9d5364 100644 --- a/src/lib/mina_base/receipt.ml +++ b/src/lib/mina_base/receipt.ml @@ -92,7 +92,7 @@ module Chain_hash = struct make_checked (fun () -> hash ~init:Hash_prefix.receipt_chain_user_command (pack_input Input.(append x (field (var_to_hash_packed t)))) - |> var_of_hash_packed) + |> var_of_hash_packed ) end let%test_unit "checked-unchecked equivalence" = @@ -114,11 +114,11 @@ module Chain_hash = struct in Or_error.ok_exn (run_and_check comp) in - assert (equal unchecked checked)) + assert (equal unchecked checked) ) let%test_unit "json" = Quickcheck.test ~trials:20 gen ~sexp_of:sexp_of_t ~f:(fun t -> - assert (Codable.For_tests.check_encoding (module Stable.V1) ~equal t)) + assert (Codable.For_tests.check_encoding (module Stable.V1) ~equal t) ) [%%endif] end diff --git a/src/lib/mina_base/side_loaded_verification_key.ml b/src/lib/mina_base/side_loaded_verification_key.ml index 6d0623890d9..0d00c790fc4 100644 --- a/src/lib/mina_base/side_loaded_verification_key.ml +++ b/src/lib/mina_base/side_loaded_verification_key.ml @@ -54,15 +54,16 @@ module Stable = struct let of_repr { Repr.Stable.V2.step_data; max_width; wrap_index = c } = { Poly.step_data; max_width; wrap_index = c; wrap_vk = Some () } - include Binable.Of_binable - (R.Stable.V2) - (struct - type nonrec t = t + include + Binable.Of_binable + (R.Stable.V2) + (struct + type nonrec t = t - let to_binable = to_repr + let to_binable = to_repr - let of_binable = of_repr - end) + let of_binable = of_repr + end) let sexp_of_t t = R.sexp_of_t (to_repr t) @@ -97,7 +98,7 @@ let dummy : t = ; mul_comm = g ; emul_comm = g ; endomul_scalar_comm = g - }) + } ) ; wrap_vk = None } diff --git a/src/lib/mina_base/signature.ml b/src/lib/mina_base/signature.ml index 85960d5eb19..367ca7f8b8b 100644 --- a/src/lib/mina_base/signature.ml +++ b/src/lib/mina_base/signature.ml @@ -65,7 +65,7 @@ module Raw = struct let%test_unit "partial isomorphism" = Quickcheck.test ~trials:300 Stable.Latest.gen ~f:(fun signature -> - [%test_eq: t option] (Some signature) (encode signature |> decode)) + [%test_eq: t option] (Some signature) (encode signature |> decode) ) end [%%ifdef consensus_mechanism] diff --git a/src/lib/mina_base/signed_command.ml b/src/lib/mina_base/signed_command.ml index a22dfbea64b..1894448f302 100644 --- a/src/lib/mina_base/signed_command.ml +++ b/src/lib/mina_base/signed_command.ml @@ -168,7 +168,7 @@ module Gen = struct let gen_with_random_participants ?sign_type ~keys ?nonce ?min_amount ~max_amount ~fee_range = with_random_participants ~keys ~gen:(fun ~key_gen -> - gen ?sign_type ~key_gen ?nonce ?min_amount ~max_amount ~fee_range) + gen ?sign_type ~key_gen ?nonce ?min_amount ~max_amount ~fee_range ) end module Stake_delegation = struct @@ -180,7 +180,7 @@ module Gen = struct (Set_delegate { delegator = Public_key.compress signer ; new_delegate = Public_key.compress new_delegate - })) + } ) ) let gen_with_random_participants ~keys ?nonce ~fee_range = with_random_participants ~keys ~gen:(gen ?nonce ~fee_range) @@ -223,7 +223,7 @@ module Gen = struct let%bind command_senders = Quickcheck_lib.shuffle @@ List.concat_mapi command_splits ~f:(fun idx cmds -> - List.init cmds ~f:(Fn.const idx)) + List.init cmds ~f:(Fn.const idx) ) in (* within the accounts, how will the currency be split into separate payments? *) @@ -237,10 +237,10 @@ module Gen = struct else Currency.Amount.of_int (Currency.Amount.to_int balance / 2) in Quickcheck_lib.gen_division_currency amount_to_spend - command_splits'.(i)) + command_splits'.(i) ) n_accounts in - return (command_senders, currency_splits)) + return (command_senders, currency_splits) ) |> (* We need to ensure each command has enough currency for a fee of 2 or more, so it'll be enough to buy the requisite transaction snarks. It's important that the backtracking from filter goes and @@ -250,7 +250,7 @@ module Gen = struct Quickcheck.Generator.filter ~f:(fun (_, splits) -> Array.for_all splits ~f:(fun split -> List.for_all split ~f:(fun amt -> - Currency.Amount.(amt >= of_int 2_000_000_000)))) + Currency.Amount.(amt >= of_int 2_000_000_000) ) ) ) in let account_nonces = Array.map ~f:(fun (_, _, nonce, _) -> nonce) account_info @@ -274,7 +274,7 @@ module Gen = struct Currency.Fee.( gen_incl (of_string "6000000000") (min (of_string "10000000000") - (Currency.Amount.to_fee this_split))) + (Currency.Amount.to_fee this_split) )) in let amount = Option.value_exn Currency.Amount.(this_split - of_fee fee) @@ -282,7 +282,7 @@ module Gen = struct let%bind receiver = map ~f:(fun idx -> let kp, _, _, _ = account_info.(idx) in - Public_key.compress kp.public_key) + Public_key.compress kp.public_key ) @@ Int.gen_uniform_incl 0 (n_accounts - 1) in let memo = Signed_command_memo.dummy in @@ -292,12 +292,12 @@ module Gen = struct ~memo ~body: (Payment - { source_pk = sender_pk; receiver_pk = receiver; amount }) + { source_pk = sender_pk; receiver_pk = receiver; amount } ) in let sign' = match sign_type with `Fake -> For_tests.fake_sign | `Real -> sign in - return @@ sign' sender_pk payload) + return @@ sign' sender_pk payload ) end module With_valid_signature = struct @@ -341,7 +341,7 @@ let public_keys t = let check_valid_keys t = List.for_all (public_keys t) ~f:(fun pk -> - Option.is_some (Public_key.decompress pk)) + Option.is_some (Public_key.decompress pk) ) let create_with_signature_checked ?signature_kind signature signer payload = let open Option.Let_syntax in @@ -362,7 +362,7 @@ let%test_unit "completeness" = let%test_unit "json" = Quickcheck.test ~trials:20 ~sexp_of:sexp_of_t gen_test ~f:(fun t -> - assert (Codable.For_tests.check_encoding (module Stable.Latest) ~equal t)) + assert (Codable.For_tests.check_encoding (module Stable.Latest) ~equal t) ) (* return type is `t option` here, interface coerces that to `With_valid_signature.t option` *) let check t = Option.some_if (check_signature t && check_valid_keys t) t @@ -379,4 +379,4 @@ let filter_by_participant user_commands public_key = ~f: (Fn.compose (Public_key.Compressed.equal public_key) - Account_id.public_key)) + Account_id.public_key ) ) diff --git a/src/lib/mina_base/signed_command_memo.ml b/src/lib/mina_base/signed_command_memo.ml index 644504627cb..fe248e69291 100644 --- a/src/lib/mina_base/signed_command_memo.ml +++ b/src/lib/mina_base/signed_command_memo.ml @@ -97,7 +97,7 @@ let create_by_digesting_string_exn s = String.init memo_length ~f:(fun ndx -> if Int.(ndx = tag_index) then digest_tag else if Int.(ndx = length_index) then digest_length_byte - else digest.[ndx - 2]) + else digest.[ndx - 2] ) let create_by_digesting_string (s : string) = try Ok (create_by_digesting_string_exn s) @@ -120,7 +120,7 @@ let create_from_value_exn (type t) (module M : Memoable with type t = t) if Int.(ndx = tag_index) then bytes_tag else if Int.(ndx = length_index) then Char.of_int_exn len else if Int.(ndx < len + 2) then M.get value (ndx - 2) - else '\x00') + else '\x00' ) let create_from_bytes_exn bytes = create_from_value_exn (module Bytes) bytes @@ -175,7 +175,7 @@ let fold_bits t = let b = (Char.to_int t.[i / 8] lsr (i mod 8)) land 1 = 1 in go (f acc b) (i + 1) in - go init 0) + go init 0 ) } let to_bits t = Fold_lib.Fold.to_list (fold_bits t) @@ -187,7 +187,7 @@ let gen = let hash memo = Random_oracle.hash ~init:Hash_prefix.zkapp_memo (Random_oracle.Legacy.pack_input - (Random_oracle_input.Legacy.bitstring (to_bits memo))) + (Random_oracle_input.Legacy.bitstring (to_bits memo)) ) let to_plaintext (memo : t) : string Or_error.t = if is_bytes memo then Ok (String.sub memo ~pos:2 ~len:(length memo)) @@ -289,13 +289,12 @@ let%test_module "user_command_memo" = memo |> typ.value_to_fields |> (fun (arr, aux) -> ( Array.map arr ~f:(fun x -> Snarky_backendless.Cvar.Constant x) - , aux )) + , aux ) ) |> typ.var_of_fields in let memo_read = memo_var |> typ.var_to_fields - |> (fun (arr, aux) -> - (Array.map arr ~f:(fun x -> read_constant x), aux)) + |> (fun (arr, aux) -> (Array.map arr ~f:(fun x -> read_constant x), aux)) |> typ.value_of_fields in [%test_eq: string] memo memo_read diff --git a/src/lib/mina_base/signed_command_memo.mli b/src/lib/mina_base/signed_command_memo.mli index 5dce92e8f60..930a61222d2 100644 --- a/src/lib/mina_base/signed_command_memo.mli +++ b/src/lib/mina_base/signed_command_memo.mli @@ -114,7 +114,7 @@ val deriver : ; map : (Yojson.Safe.t -> t) ref ; nullable_graphql_arg : ( unit - -> Yojson.Safe.t option Fields_derivers_graphql.Schema.Arg.arg_typ) + -> Yojson.Safe.t option Fields_derivers_graphql.Schema.Arg.arg_typ ) ref ; nullable_graphql_fields : Yojson.Safe.t option Fields_derivers_zkapps.Graphql.Fields.Input.T.t @@ -123,7 +123,7 @@ val deriver : ; to_json : (Yojson.Safe.t -> Yojson.Safe.t) ref ; .. > as - 'a) + 'a ) Fields_derivers_zkapps.Unified_input.t Fields_derivers_zkapps.Unified_input.t Fields_derivers_zkapps.Unified_input.t diff --git a/src/lib/mina_base/signed_command_payload.ml b/src/lib/mina_base/signed_command_payload.ml index 9ead4aa9cec..e18016b7d6c 100644 --- a/src/lib/mina_base/signed_command_payload.ml +++ b/src/lib/mina_base/signed_command_payload.ml @@ -197,7 +197,7 @@ module Body = struct map (variant2 (Payment_payload.gen ?source_pk ~max_amount) - stake_delegation_gen) + stake_delegation_gen ) ~f:(function `A p -> Payment p | `B d -> Stake_delegation d) let source_pk (t : t) = diff --git a/src/lib/mina_base/sok_message.ml b/src/lib/mina_base/sok_message.ml index e861e03956d..7b1f8b54ba1 100644 --- a/src/lib/mina_base/sok_message.ml +++ b/src/lib/mina_base/sok_message.ml @@ -27,17 +27,18 @@ module Digest = struct let to_latest = Fn.id - include Binable.Of_binable - (Core_kernel.String.Stable.V1) - (struct - type nonrec t = t + include + Binable.Of_binable + (Core_kernel.String.Stable.V1) + (struct + type nonrec t = t - let to_binable = Fn.id + let to_binable = Fn.id - let of_binable s = - assert (String.length s = length_in_bytes) ; - s - end) + let of_binable s = + assert (String.length s = length_in_bytes) ; + s + end) open Snark_params.Tick @@ -45,7 +46,7 @@ module Digest = struct Random_oracle.Input.Chunked.packeds (Array.of_list_map Fold_lib.Fold.(to_list (string_bits t)) - ~f:(fun b -> (field_of_bool b, 1))) + ~f:(fun b -> (field_of_bool b, 1)) ) let typ = Typ.array ~length:Blake2.digest_size_in_bits Boolean.typ diff --git a/src/lib/mina_base/sparse_ledger_base.ml b/src/lib/mina_base/sparse_ledger_base.ml index af08aed9bc9..5366eab4b5f 100644 --- a/src/lib/mina_base/sparse_ledger_base.ml +++ b/src/lib/mina_base/sparse_ledger_base.ml @@ -59,7 +59,7 @@ module L = struct Option.try_with (fun () -> let account = M.get_exn !t loc in if Public_key.Compressed.(equal empty account.public_key) then None - else Some account) + else Some account ) |> Option.bind ~f:Fn.id let location_of_account : t -> Account_id.t -> location option = @@ -97,7 +97,7 @@ module L = struct if Public_key.Compressed.(equal empty a.public_key) then ( set t loc to_set ; (`Added, loc) ) - else (`Existed, loc)) + else (`Existed, loc) ) let create_new_account t id to_set = get_or_create_account t id to_set |> Or_error.map ~f:ignore @@ -197,4 +197,4 @@ let handler t = let index = find_index_exn !ledger pk in respond (Provide index) | _ -> - unhandled) + unhandled ) diff --git a/src/lib/mina_base/stack_frame.ml b/src/lib/mina_base/stack_frame.ml index 0a3add80494..7b737012027 100644 --- a/src/lib/mina_base/stack_frame.ml +++ b/src/lib/mina_base/stack_frame.ml @@ -70,7 +70,7 @@ end = struct , Parties.Digest.Party.t , Parties.Digest.Forest.t ) Parties.Call_forest.t ) - frame) = + frame ) = List.reduce_exn ~f:Random_oracle.Input.Chunked.append [ Token_id.to_input caller ; Token_id.to_input caller_caller diff --git a/src/lib/mina_base/staged_ledger_hash.ml b/src/lib/mina_base/staged_ledger_hash.ml index ef16a5eef64..713e246b131 100644 --- a/src/lib/mina_base/staged_ledger_hash.ml +++ b/src/lib/mina_base/staged_ledger_hash.ml @@ -32,7 +32,7 @@ module Aux_hash = struct | Error e -> Error (sprintf "Aux_hash.of_yojson, bad Base58Check:%s" - (Error.to_string_hum e)) + (Error.to_string_hum e) ) | Ok x -> Ok x ) | _ -> @@ -78,7 +78,7 @@ module Pending_coinbase_aux = struct | Error e -> Error (sprintf "Pending_coinbase_aux.of_yojson, bad Base58Check:%s" - (Error.to_string_hum e)) ) + (Error.to_string_hum e) ) ) | _ -> Error "Pending_coinbase_aux.of_yojson expected `String" end @@ -137,7 +137,7 @@ module Non_snark = struct Array.reduce_exn ~f:append (Array.of_list_map (Fold.to_list (fold t)) - ~f:(fun b -> packed (field_of_bool b, 1))) + ~f:(fun b -> packed (field_of_bool b, 1)) ) let ledger_hash ({ ledger_hash; _ } : t) = ledger_hash @@ -173,7 +173,7 @@ module Non_snark = struct * anything that uses staged-ledger-hashes from within Checked * computations. It's useful when debugging to dump the protocol state * and so we can just lie here instead. *) - warn_improper_transport () ; Lazy.force dummy) + warn_improper_transport () ; Lazy.force dummy ) end module Poly = struct diff --git a/src/lib/mina_base/stake_delegation.ml b/src/lib/mina_base/stake_delegation.ml index 8e08ff78545..6c8fd54ebaa 100644 --- a/src/lib/mina_base/stake_delegation.ml +++ b/src/lib/mina_base/stake_delegation.ml @@ -31,7 +31,7 @@ let source = function let gen_with_delegator delegator = Quickcheck.Generator.map Public_key.Compressed.gen ~f:(fun k -> - Set_delegate { delegator; new_delegate = k }) + Set_delegate { delegator; new_delegate = k } ) let gen = Quickcheck.Generator.bind ~f:gen_with_delegator Public_key.Compressed.gen diff --git a/src/lib/mina_base/state_hash.ml b/src/lib/mina_base/state_hash.ml index acaf745b310..a3387f8461b 100644 --- a/src/lib/mina_base/state_hash.ml +++ b/src/lib/mina_base/state_hash.ml @@ -58,5 +58,5 @@ module With_state_hashes = struct let state_body_hash { hash; data } ~compute_hashes = State_hashes.state_body_hash hash ~compute_hashes:(fun () -> - compute_hashes data) + compute_hashes data ) end diff --git a/src/lib/mina_base/token_permissions.ml b/src/lib/mina_base/token_permissions.ml index ea017a26fea..070c82312c2 100644 --- a/src/lib/mina_base/token_permissions.ml +++ b/src/lib/mina_base/token_permissions.ml @@ -54,10 +54,10 @@ let typ : (var, t) Typ.t = | Token_owned { disable_new_accounts } -> (true, disable_new_accounts) | Not_owned { account_disabled } -> - (false, account_disabled)) + (false, account_disabled) ) ~back:(fun (token_owner, token_locked) -> if token_owner then Token_owned { disable_new_accounts = token_locked } - else Not_owned { account_disabled = token_locked }) + else Not_owned { account_disabled = token_locked } ) let var_to_input { token_owner; token_locked } = let bs = [ token_owner; token_locked ] in diff --git a/src/lib/mina_base/transaction_status.ml b/src/lib/mina_base/transaction_status.ml index ac936d14645..bb6bf08520a 100644 --- a/src/lib/mina_base/transaction_status.ml +++ b/src/lib/mina_base/transaction_status.ml @@ -68,7 +68,7 @@ module Failure = struct let _, display = List.fold_right t ~init:(0, []) ~f:(fun bucket (index, acc) -> if List.is_empty bucket then (index + 1, acc) - else (index + 1, (index, bucket) :: acc)) + else (index + 1, (index, bucket) :: acc) ) in display diff --git a/src/lib/mina_base/transaction_union_payload.ml b/src/lib/mina_base/transaction_union_payload.ml index 8ac440578e9..17a12bcb2c9 100644 --- a/src/lib/mina_base/transaction_union_payload.ml +++ b/src/lib/mina_base/transaction_union_payload.ml @@ -149,7 +149,7 @@ module Body = struct and () = make_checked (fun () -> Token_id.Checked.Assert.equal token_id - (Token_id.Checked.constant Token_id.default)) + (Token_id.Checked.constant Token_id.default) ) in let token_id = Signed_command_payload.Legacy_token_id.default_checked in Array.reduce_exn ~f:Random_oracle.Input.Legacy.append @@ -258,7 +258,7 @@ type payload = t [@@deriving sexp] let of_user_command_payload ({ common = { memo; fee; fee_payer_pk; nonce; valid_until }; body } : - Signed_command_payload.t) : t = + Signed_command_payload.t ) : t = { common = { fee ; fee_token = Token_id.default @@ -311,7 +311,7 @@ end let to_input_legacy ({ common; body } : t) = Random_oracle.Input.Legacy.append (Signed_command_payload.Common.to_input_legacy - (Payload_common.to_signed_command_payload_common common)) + (Payload_common.to_signed_command_payload_common common) ) (Body.to_input_legacy body) let excess (payload : t) : Amount.Signed.t = diff --git a/src/lib/mina_base/transaction_union_tag.ml b/src/lib/mina_base/transaction_union_tag.ml index 63c3f2e922b..cf8047d652d 100644 --- a/src/lib/mina_base/transaction_union_tag.ml +++ b/src/lib/mina_base/transaction_union_tag.ml @@ -39,7 +39,7 @@ let to_string = function let gen = Quickcheck.Generator.map (Int.gen_incl min max) ~f:(fun i -> - Option.value_exn (of_enum i)) + Option.value_exn (of_enum i) ) module Bits = struct type t = bool * bool * bool [@@deriving equal] @@ -178,7 +178,7 @@ module Unpacked = struct ; is_coinbase ; is_user_command = _ } : - var) = + var ) = (* For each bit, compute the sum of all the tags for which that bit is true in its bit representation. @@ -200,7 +200,8 @@ module Unpacked = struct let add_if_true bit acc = if bit then Field.Var.add acc (bool_var :> Field.Var.t) else acc in - (add_if_true bit1 acc1, add_if_true bit2 acc2, add_if_true bit3 acc3)) + (add_if_true bit1 acc1, add_if_true bit2 acc2, add_if_true bit3 acc3) + ) in Boolean.Unsafe.(of_cvar b1, of_cvar b2, of_cvar b3) @@ -228,11 +229,11 @@ module Unpacked = struct ; is_mint_tokens ; is_fee_transfer ; is_coinbase - ]) + ] ) in [%with_label "User command flag is correctly set"] (Boolean.Assert.exactly_one - [ is_user_command; is_fee_transfer; is_coinbase ])) + [ is_user_command; is_fee_transfer; is_coinbase ] ) ) } let constant @@ -244,7 +245,7 @@ module Unpacked = struct ; is_coinbase ; is_user_command } : - t) : var = + t ) : var = { is_payment = Boolean.var_of_value is_payment ; is_stake_delegation = Boolean.var_of_value is_stake_delegation ; is_create_account = Boolean.var_of_value is_create_account diff --git a/src/lib/mina_base/user_command.ml b/src/lib/mina_base/user_command.ml index baa82aa3e35..5fa5b3147da 100644 --- a/src/lib/mina_base/user_command.ml +++ b/src/lib/mina_base/user_command.ml @@ -41,7 +41,7 @@ module Gen_make (C : Signed_command_intf.Gen_intf) = struct ~fee_range () = to_signed_command (payment_with_random_participants ?sign_type ~keys ?nonce ~max_amount - ~fee_range ()) + ~fee_range () ) let stake_delegation ~key_gen ?nonce ~fee_range () = to_signed_command (stake_delegation ~key_gen ?nonce ~fee_range ()) @@ -146,7 +146,7 @@ let to_verifiable (t : t) ~ledger ~get ~location_of_account : Verifiable.t = let account : Account.t = !(get ledger !(location_of_account ledger id)) in - !(!(account.zkapp).verification_key).data) + !(!(account.zkapp).verification_key).data ) in match t with | Signed_command c -> @@ -248,7 +248,7 @@ let filter_by_participant (commands : t list) public_key = ~f: (Fn.compose (Signature_lib.Public_key.Compressed.equal public_key) - Account_id.public_key)) + Account_id.public_key ) ) (* A metric on user commands that should correspond roughly to resource costs for validation/application *) diff --git a/src/lib/mina_base/zkapp_account.ml b/src/lib/mina_base/zkapp_account.ml index fbc254aff28..d01d56f9f4f 100644 --- a/src/lib/mina_base/zkapp_account.ml +++ b/src/lib/mina_base/zkapp_account.ml @@ -56,11 +56,11 @@ module Events = struct | [] -> failwith "Attempted to pop an empty stack" | event :: events -> - (event, events)) + (event, events) ) in Field.Assert.equal (Random_oracle.Checked.hash ~init:Hash_prefix_states.zkapp_events - [| Data_as_hash.hash tl; Data_as_hash.hash hd |]) + [| Data_as_hash.hash tl; Data_as_hash.hash hd |] ) (Data_as_hash.hash events) ; (hd, tl) @@ -72,11 +72,11 @@ module Events = struct let hd = As_prover.read (Typ.array ~length:(Array.length e) Field.typ) e in - hd :: tl) + hd :: tl ) in Field.Assert.equal (Random_oracle.Checked.hash ~init:Hash_prefix_states.zkapp_events - [| Data_as_hash.hash events; Event.hash_var e |]) + [| Data_as_hash.hash events; Event.hash_var e |] ) (Data_as_hash.hash res) ; res @@ -203,14 +203,13 @@ module Checked = struct in Poly.Fields.fold ~init:[] ~app_state:(f app_state) ~verification_key:(f (fun x -> field x)) - ~zkapp_version: - (f (fun x -> Mina_numbers.Zkapp_version.Checked.to_input x)) + ~zkapp_version:(f (fun x -> Mina_numbers.Zkapp_version.Checked.to_input x)) ~sequence_state:(f app_state) ~last_sequence_slot: (f (fun x -> Mina_numbers.Global_slot.Checked.to_input x)) ~proved_state: (f (fun (b : Boolean.var) -> - Random_oracle.Input.Chunked.packed ((b :> Field.Var.t), 1))) + Random_oracle.Input.Chunked.packed ((b :> Field.Var.t), 1) ) ) |> List.reduce_exn ~f:append let to_input (t : t) = @@ -262,7 +261,7 @@ let to_input (t : t) = ~verification_key: (f (Fn.compose field - (Option.value_map ~default:(dummy_vk_hash ()) ~f:With_hash.hash))) + (Option.value_map ~default:(dummy_vk_hash ()) ~f:With_hash.hash) ) ) ~zkapp_version:(f Mina_numbers.Zkapp_version.to_input) ~sequence_state:(f app_state) ~last_sequence_slot:(f Mina_numbers.Global_slot.to_input) @@ -277,7 +276,7 @@ let default : _ Poly.t = ; zkapp_version = Mina_numbers.Zkapp_version.zero ; sequence_state = (let empty = Lazy.force Sequence_events.empty_hash in - [ empty; empty; empty; empty; empty ]) + [ empty; empty; empty; empty; empty ] ) ; last_sequence_slot = Mina_numbers.Global_slot.zero ; proved_state = false } diff --git a/src/lib/mina_base/zkapp_basic.ml b/src/lib/mina_base/zkapp_basic.ml index d763834b26b..6e15a67954a 100644 --- a/src/lib/mina_base/zkapp_basic.ml +++ b/src/lib/mina_base/zkapp_basic.ml @@ -194,17 +194,17 @@ module Set_or_keep = struct | Set x -> { Flagged_option.is_some = true; data = of_option (Some x) } | Keep -> - { Flagged_option.is_some = false; data = of_option None }) + { Flagged_option.is_some = false; data = of_option None } ) ~back:(function | { Flagged_option.is_some = true; data = x } -> Set (Option.value_exn (to_option x)) | { Flagged_option.is_some = false; data = x } -> assert (Option.is_none (to_option x)) ; - Keep) + Keep ) let to_input (t : _ t) ~f = Flagged_option.to_input' t ~f ~field_of_bool:(fun (b : Boolean.var) -> - (b :> Field.Var.t)) + (b :> Field.Var.t) ) let make_unsafe is_keep data = { Flagged_option.is_some = is_keep; data } @@ -293,7 +293,7 @@ module Or_ignore = struct f x | Explicit t -> Flagged_option.to_input' t ~f ~field_of_bool:(fun (b : Boolean.var) -> - (b :> Field.Var.t)) + (b :> Field.Var.t) ) let check t ~f = match t with @@ -390,7 +390,7 @@ module Account_state = struct let to_input (t : t) = Encoding.to_input t ~field_of_bool:(fun (b : Boolean.var) -> - (b :> Field.t)) + (b :> Field.t) ) let check (t : t) ~is_empty = Boolean.( diff --git a/src/lib/mina_base/zkapp_precondition.ml b/src/lib/mina_base/zkapp_precondition.ml index 0a94abb4e17..f5ca59c0471 100644 --- a/src/lib/mina_base/zkapp_precondition.ml +++ b/src/lib/mina_base/zkapp_precondition.ml @@ -262,7 +262,7 @@ module Numeric = struct let check { lte_checked = ( <= ); _ } (t : 'a t) (x : 'a) = Or_ignore.Checked.check t ~f:(fun { lower; upper } -> - Boolean.all [ lower <= x; x <= upper ]) + Boolean.all [ lower <= x; x <= upper ] ) let is_constant { eq_checked = ( = ); _ } (t : 'a t) = let is_constant ({ lower; upper } : _ Closed_interval.t) = @@ -270,7 +270,7 @@ module Numeric = struct in Or_ignore.Checked.map t ~f_implicit:is_constant ~f_explicit:(fun { is_some; data } -> - Boolean.( &&& ) is_some (is_constant data)) + Boolean.( &&& ) is_some (is_constant data) ) end let typ { equal = eq; zero; max_value; typ; _ } = @@ -533,7 +533,7 @@ module Account = struct ; delegate ; state } : - t) : V2.t = + t ) : V2.t = { balance ; nonce ; receipt_chain_hash @@ -621,7 +621,7 @@ module Account = struct ; sequence_state ; proved_state } : - t) = + t ) = let open Random_oracle_input.Chunked in List.reduce_exn ~f:append [ Numeric.(to_input Tc.balance balance) @@ -661,7 +661,7 @@ module Account = struct ; sequence_state ; proved_state } : - t) = + t ) = let open Random_oracle_input.Chunked in List.reduce_exn ~f:append [ Numeric.(Checked.to_input Tc.balance balance) @@ -686,7 +686,7 @@ module Account = struct ; sequence_state = _ ; proved_state = _ } : - t) (a : Account.Checked.Unhashed.t) = + t ) (a : Account.Checked.Unhashed.t) = [ Numeric.(Checked.check Tc.balance balance a.balance) ; Numeric.(Checked.check Tc.nonce nonce a.nonce) ; Eq_data.( @@ -706,14 +706,14 @@ module Account = struct ; sequence_state ; proved_state } : - t) (snapp : Zkapp_account.Checked.t) = + t ) (snapp : Zkapp_account.Checked.t) = Boolean.any Vector.( to_list (map snapp.sequence_state ~f: Eq_data.( - check_checked (Lazy.force Tc.sequence_state) sequence_state))) + check_checked (Lazy.force Tc.sequence_state) sequence_state) )) :: Eq_data.(check_checked Tc.boolean proved_state snapp.proved_state) :: Vector.( to_list @@ -753,7 +753,7 @@ module Account = struct ; sequence_state ; proved_state } : - t) (a : Account.t) = + t ) (a : Account.t) = let open Or_error.Let_syntax in let%bind () = Numeric.(check ~label:"balance" Tc.balance balance a.balance) @@ -782,7 +782,7 @@ module Account = struct let%map () = Eq_data.(check Tc.field ~label:(sprintf "state[%d]" i) c v) in - i + 1) + i + 1 ) in let%bind () = Eq_data.( @@ -796,7 +796,7 @@ module Account = struct check (Lazy.force Tc.sequence_state) ~label:"" sequence_state state) - |> Or_error.is_ok) + |> Or_error.is_ok ) then Ok () else Or_error.errorf "Equality check failed: sequence_state" in @@ -888,7 +888,7 @@ module Protocol_state = struct Numeric.gen (Length.gen_incl (Length.of_int min_epoch_length) - (Length.of_int max_epoch_length)) + (Length.of_int max_epoch_length) ) Length.compare in { Poly.ledger; seed; start_checkpoint; lock_checkpoint; epoch_length } @@ -900,7 +900,7 @@ module Protocol_state = struct ; lock_checkpoint ; epoch_length } : - t) = + t ) = let open Random_oracle.Input.Chunked in List.reduce_exn ~f:append [ Hash.(to_input Tc.frozen_ledger_hash hash) @@ -929,7 +929,7 @@ module Protocol_state = struct ; lock_checkpoint ; epoch_length } : - t) = + t ) = let open Random_oracle.Input.Chunked in List.reduce_exn ~f:append [ Hash.(to_input_checked Tc.frozen_ledger_hash hash) @@ -1073,7 +1073,7 @@ module Protocol_state = struct ; staking_epoch_data ; next_epoch_data } : - t) = + t ) = let open Random_oracle.Input.Chunked in let () = last_vrf_output in let length = Numeric.(to_input Tc.length) in @@ -1161,7 +1161,7 @@ module Protocol_state = struct ; staking_epoch_data ; next_epoch_data } : - t) = + t ) = let open Random_oracle.Input.Chunked in let () = last_vrf_output in let length = Numeric.(Checked.to_input Tc.length) in @@ -1195,7 +1195,7 @@ module Protocol_state = struct ; staking_epoch_data ; next_epoch_data } : - t) (s : View.Checked.t) = + t ) (s : View.Checked.t) = let open Impl in let epoch_ledger ({ hash; total_currency } : _ Epoch_ledger.Poly.t) (t : Epoch_ledger.var) = @@ -1205,7 +1205,7 @@ module Protocol_state = struct in let epoch_data ({ ledger; seed; start_checkpoint; lock_checkpoint; epoch_length } : - _ Epoch_data.Poly.t) (t : _ Epoch_data.Poly.t) = + _ Epoch_data.Poly.t ) (t : _ Epoch_data.Poly.t) = ignore seed ; epoch_ledger ledger t.ledger @ [ Hash.(check_checked Tc.state_hash) @@ -1324,7 +1324,7 @@ module Protocol_state = struct ; staking_epoch_data ; next_epoch_data } : - t) (s : View.t) = + t ) (s : View.t) = let open Or_error.Let_syntax in let epoch_ledger ({ hash; total_currency } : _ Epoch_ledger.Poly.t) (t : Epoch_ledger.Value.t) = @@ -1340,7 +1340,7 @@ module Protocol_state = struct in let epoch_data label ({ ledger; seed; start_checkpoint; lock_checkpoint; epoch_length } : - _ Epoch_data.Poly.t) (t : _ Epoch_data.Poly.t) = + _ Epoch_data.Poly.t ) (t : _ Epoch_data.Poly.t) = let l s = sprintf "%s_%s" label s in let%bind () = epoch_ledger ledger t.ledger in ignore seed ; @@ -1458,7 +1458,7 @@ module Account_type = struct let open Random_oracle_input.Chunked in Array.reduce_exn ~f:append (Array.map [| user; zkapp |] ~f:(fun b -> - packed ((b :> Field.Var.t), 1))) + packed ((b :> Field.Var.t), 1) ) ) let constant = let open Boolean in @@ -1491,7 +1491,7 @@ module Account_type = struct | None -> [ false; false ] | Any -> - [ true; true ]) + [ true; true ] ) ~value_of_hlist:(fun [ user; zkapp ] -> match (user, zkapp) with | true, false -> @@ -1501,7 +1501,7 @@ module Account_type = struct | false, false -> None | true, true -> - Any) + Any ) end module Other = struct @@ -1645,8 +1645,8 @@ end] module Digested = F -let to_input - ({ self_predicate; other; fee_payer; protocol_state_predicate } : t) = +let to_input ({ self_predicate; other; fee_payer; protocol_state_predicate } : t) + = let open Random_oracle_input.Chunked in List.reduce_exn ~f:append [ Account.to_input self_predicate @@ -1692,7 +1692,7 @@ let check ({ self_predicate; other; fee_payer; protocol_state_predicate } : t) Hash.(check ~label:"other_account_vk" Tc.field) other.account_vk (Option.value_map ~f:With_hash.hash zkapp.verification_key - ~default:Field.zero) ) + ~default:Field.zero ) ) in return () diff --git a/src/lib/mina_block/block.ml b/src/lib/mina_block/block.ml index 8acff90205a..a53e2b3466d 100644 --- a/src/lib/mina_block/block.ml +++ b/src/lib/mina_block/block.ml @@ -18,12 +18,12 @@ module Stable = struct ; ( "current_protocol_version" , `String (Protocol_version.to_string - (Header.current_protocol_version t.header)) ) + (Header.current_protocol_version t.header) ) ) ; ( "proposed_protocol_version" , `String (Option.value_map (Header.proposed_protocol_version_opt t.header) - ~default:"" ~f:Protocol_version.to_string) ) + ~default:"" ~f:Protocol_version.to_string ) ) ] let to_latest = Fn.id @@ -99,13 +99,13 @@ let payments block = } -> Some { With_status.data = c; status } | _ -> - None) + None ) let equal = Comparable.lift Consensus.Data.Consensus_state.Value.equal ~f: (Fn.compose Mina_state.Protocol_state.consensus_state - (Fn.compose Header.protocol_state header)) + (Fn.compose Header.protocol_state header) ) let account_ids_accessed t = let transactions = @@ -113,6 +113,6 @@ let account_ids_accessed t = ~constraint_constants:Genesis_constants.Constraint_constants.compiled t in List.map transactions ~f:(fun { data = txn; _ } -> - Mina_transaction.Transaction.accounts_accessed txn) + Mina_transaction.Transaction.accounts_accessed txn ) |> List.concat |> List.dedup_and_sort ~compare:Account_id.compare diff --git a/src/lib/mina_block/external_transition.ml b/src/lib/mina_block/external_transition.ml index f1585be855e..4fc3e48dc1d 100644 --- a/src/lib/mina_block/external_transition.ml +++ b/src/lib/mina_block/external_transition.ml @@ -84,8 +84,7 @@ module Raw = struct ?proposed_protocol_version_opt () = f (c ~protocol_state ~protocol_state_proof ~staged_ledger_diff - ~delta_transition_chain_proof ?proposed_protocol_version_opt - ()) + ~delta_transition_chain_proof ?proposed_protocol_version_opt () ) end) : sig val create : @@ -152,7 +151,7 @@ let raw_v1_to_yojson t = ; ( "proposed_protocol_version" , `String (Option.value_map t.proposed_protocol_version_opt ~default:"" - ~f:Protocol_version.to_string) ) + ~f:Protocol_version.to_string ) ) ] module Validated = struct diff --git a/src/lib/mina_block/header.ml b/src/lib/mina_block/header.ml index f69fd29dc77..df3557af462 100644 --- a/src/lib/mina_block/header.ml +++ b/src/lib/mina_block/header.ml @@ -50,7 +50,7 @@ module Stable = struct f (c ~protocol_state ~protocol_state_proof ~delta_block_chain_proof ~body_reference ?proposed_protocol_version_opt - ?current_protocol_version ()) + ?current_protocol_version () ) let create ~protocol_state ~protocol_state_proof ~delta_block_chain_proof ~body_reference ?proposed_protocol_version_opt diff --git a/src/lib/mina_block/precomputed_block.ml b/src/lib/mina_block/precomputed_block.ml index e6f8365ba26..63f27ca909e 100644 --- a/src/lib/mina_block/precomputed_block.ml +++ b/src/lib/mina_block/precomputed_block.ml @@ -37,7 +37,7 @@ module Proof = struct Or_error.try_with (fun () -> of_bin_string str) |> Result.map_error ~f:(fun err -> sprintf "Precomputed_block.Proof.of_yojson: %s" - (Error.to_string_hum err)) + (Error.to_string_hum err) ) | json -> Proof.of_yojson json end @@ -104,7 +104,7 @@ let of_block ~logger [ ("account_id", Account_id.to_yojson acct_id) ; ("exception", `String (Exn.to_string exn)) ] ; - None) + None ) in let header = Block.header block in let accounts_created = @@ -115,8 +115,8 @@ let of_block ~logger in List.map (Staged_ledger.latest_block_accounts_created staged_ledger - ~previous_block_state_hash) ~f:(fun acct_id -> - (acct_id, account_creation_fee)) + ~previous_block_state_hash ) ~f:(fun acct_id -> + (acct_id, account_creation_fee) ) in { scheduled_time ; protocol_state = Header.protocol_state header diff --git a/src/lib/mina_block/validated_block.ml b/src/lib/mina_block/validated_block.ml index 74dd1887627..a91c322d275 100644 --- a/src/lib/mina_block/validated_block.ml +++ b/src/lib/mina_block/validated_block.ml @@ -36,7 +36,7 @@ let valid_commands (block, _) = let (`If_this_is_used_it_should_have_a_comment_justifying_it data) = User_command.to_valid_unsafe cmd.data in - { cmd with data }) + { cmd with data } ) let unsafe_of_trusted_block ~delta_block_chain_proof (`This_block_is_trusted_to_be_safe b) = @@ -48,7 +48,7 @@ let state_body_hash (t, _) = State_hash.With_state_hashes.state_body_hash t ~compute_hashes: (Fn.compose Mina_state.Protocol_state.hashes - (Fn.compose Header.protocol_state Block.header)) + (Fn.compose Header.protocol_state Block.header) ) let header t = t |> forget |> With_hash.data |> Block.header diff --git a/src/lib/mina_block/validation.ml b/src/lib/mina_block/validation.ml index 949422eeb82..e14489d4be8 100644 --- a/src/lib/mina_block/validation.ml +++ b/src/lib/mina_block/validation.ml @@ -323,7 +323,7 @@ let validate_proofs ~verifier ~genesis_state_hash tvs = Some (Blockchain_snark.Blockchain.create ~state:(Header.protocol_state header) - ~proof:(Header.protocol_state_proof header))) + ~proof:(Header.protocol_state_proof header) ) ) in match%map match to_verify with @@ -337,7 +337,7 @@ let validate_proofs ~verifier ~genesis_state_hash tvs = if verified then Ok (List.map tvs ~f:(fun (t, validation) -> - (t, Unsafe.set_valid_proof validation))) + (t, Unsafe.set_valid_proof validation) ) ) else Error `Invalid_proof | Error e -> Error (`Verifier_error e) @@ -407,7 +407,7 @@ let validate_frontier_dependencies ~logger ~consensus_constants ~root_block [ ( "selection_context" , `String "Mina_block.Validation.validate_frontier_dependencies" ) - ]) + ] ) ~existing:(With_hash.map ~f:consensus_state root_block) ~candidate:(With_hash.map ~f:consensus_state t) ) ~error:`Not_selected_over_frontier_root @@ -422,7 +422,7 @@ let validate_frontier_dependencies ~logger ~consensus_constants ~root_block let skip_frontier_dependencies_validation (_ : [ `This_block_belongs_to_a_detached_subtree - | `This_block_was_loaded_from_persistence ]) (t, validation) = + | `This_block_was_loaded_from_persistence ] ) (t, validation) = (t, Unsafe.set_valid_frontier_dependencies validation) let reset_frontier_dependencies_validation (transition_with_hash, validation) = @@ -475,12 +475,12 @@ let validate_staged_ledger_diff ?skip_staged_ledger_verification ~logger in ( (Protocol_state.hashes_with_body parent_protocol_state ~body_hash) .state_hash - , body_hash )) + , body_hash ) ) ~coinbase_receiver:(Consensus_state.coinbase_receiver consensus_state) ~supercharge_coinbase: (Consensus_state.supercharge_coinbase consensus_state) |> Deferred.Result.map_error ~f:(fun e -> - `Staged_ledger_application_failed e) + `Staged_ledger_application_failed e ) in [%log debug] ~metadata: @@ -506,12 +506,12 @@ let validate_staged_ledger_diff ?skip_staged_ledger_verification ~logger [ Option.some_if (not (Staged_ledger_hash.equal staged_ledger_hash - (Blockchain_state.staged_ledger_hash blockchain_state))) + (Blockchain_state.staged_ledger_hash blockchain_state) ) ) `Incorrect_target_staged_ledger_hash ; Option.some_if (not (Frozen_ledger_hash.equal target_ledger_hash - (Blockchain_state.snarked_ledger_hash blockchain_state))) + (Blockchain_state.snarked_ledger_hash blockchain_state) ) ) `Incorrect_target_snarked_ledger_hash ] in diff --git a/src/lib/mina_caqti/mina_caqti.ml b/src/lib/mina_caqti/mina_caqti.ml index e0ddf923752..ede67c72fdb 100644 --- a/src/lib/mina_caqti/mina_caqti.ml +++ b/src/lib/mina_caqti/mina_caqti.ml @@ -25,8 +25,8 @@ module Type_spec = struct Caqti_type.tup2 rep (to_rep spec) let rec hlist_to_tuple : - 'hlist 'tuple. ('hlist, 'tuple) t -> (unit, 'hlist) H_list.t - -> 'tuple = + 'hlist 'tuple. + ('hlist, 'tuple) t -> (unit, 'hlist) H_list.t -> 'tuple = fun (type hlist tuple) (spec : (hlist, tuple) t) (l : (unit, hlist) H_list.t) -> match (spec, l) with @@ -36,8 +36,8 @@ module Type_spec = struct ((x, hlist_to_tuple spec l) : tuple) let rec tuple_to_hlist : - 'hlist 'tuple. ('hlist, 'tuple) t -> 'tuple - -> (unit, 'hlist) H_list.t = + 'hlist 'tuple. + ('hlist, 'tuple) t -> 'tuple -> (unit, 'hlist) H_list.t = fun (type hlist tuple) (spec : (hlist, tuple) t) (t : tuple) -> match (spec, t) with | [], () -> @@ -123,7 +123,7 @@ let () = define_coding Array_nullable_string { get_coding } (* this type may require type annotations in queries, eg. - `SELECT id FROM zkapp_states WHERE element_ids = ?::int[]` + `SELECT id FROM zkapp_states WHERE element_ids = ?::int[]` *) let array_nullable_int_typ : int option array Caqti_type.t = Caqti_type.field Array_nullable_int @@ -140,7 +140,7 @@ let array_int_typ : int array Caqti_type.t = Caqti_type.custom array_nullable_int_typ ~encode ~decode (* this type may require type annotations in queries, e.g. - `SELECT id FROM zkapp_states WHERE element_ids = ?::string[]` + `SELECT id FROM zkapp_states WHERE element_ids = ?::string[]` *) let array_nullable_string_typ : string option array Caqti_type.t = Caqti_type.field Array_nullable_string @@ -175,7 +175,7 @@ let deferred_result_list_mapi ~f xs = let open Deferred.Result.Let_syntax in deferred_result_list_fold xs ~init:(0, []) ~f:(fun (index, acc) x -> let%map res = f index x in - (Int.succ index, res :: acc)) + (Int.succ index, res :: acc) ) >>| snd >>| List.rev let deferred_result_list_map ~f = deferred_result_list_mapi ~f:(Fn.const f) @@ -213,7 +213,7 @@ let select_cols ~(select : string) ~(table_name : string) match tannot col with None -> "" | Some tannot -> "::" ^ tannot in sprintf "(%s = $%d%s OR (%s IS NULL AND $%d IS NULL))" col param annot col - param) + param ) |> String.concat ~sep:" AND " |> sprintf "SELECT %s FROM %s WHERE %s" select table_name @@ -235,7 +235,7 @@ let insert_into_cols ~(returning : string) ~(table_name : string) : string = let values = List.map cols ~f:(fun col -> - match tannot col with None -> "?" | Some tannot -> "?::" ^ tannot) + match tannot col with None -> "?" | Some tannot -> "?::" ^ tannot ) |> String.concat ~sep:", " in sprintf "INSERT INTO %s (%s) VALUES (%s) RETURNING %s" table_name @@ -278,7 +278,7 @@ let make_get_opt ~of_option ~f item_opt = | Ok v -> Some v | Error msg -> - failwithf "Error querying db, error: %s" (Caqti_error.show msg) ()) + failwithf "Error querying db, error: %s" (Caqti_error.show msg) () ) in of_option res_opt diff --git a/src/lib/mina_commands/mina_commands.ml b/src/lib/mina_commands/mina_commands.ml index ed1df074819..6ee627af42d 100644 --- a/src/lib/mina_commands/mina_commands.ml +++ b/src/lib/mina_commands/mina_commands.ml @@ -33,7 +33,7 @@ let get_keys_with_details t = List.map accounts ~f:(fun account -> ( string_of_public_key account , account.Account.Poly.balance |> Currency.Balance.to_int - , account.Account.Poly.nonce |> Account.Nonce.to_int )) + , account.Account.Poly.nonce |> Account.Nonce.to_int ) ) let get_nonce t (addr : Account_id.t) = let open Participating_state.Option.Let_syntax in @@ -75,7 +75,7 @@ let setup_and_submit_user_command t (user_command_input : User_command_input.t) (sprintf !"%s" ( Network_pool.Transaction_pool.Resource_pool.Diff.Diff_error .to_yojson (snd failed_txn) - |> Yojson.Safe.to_string ))) + |> Yojson.Safe.to_string ) ) ) | Ok ([ Signed_command txn ], []) -> [%log' info (Mina_lib.top_level_logger t)] ~metadata:[ ("command", User_command.to_yojson (Signed_command txn)) ] @@ -93,8 +93,8 @@ let setup_and_submit_user_command t (user_command_input : User_command_input.t) (Fn.compose Network_pool.Transaction_pool.Resource_pool.Diff .Diff_error - .to_yojson snd) - invalid_commands) ) + .to_yojson snd ) + invalid_commands ) ) ] "Invalid result from scheduling a user command" ; Error (Error.of_string "Internal error while scheduling a user command") @@ -124,7 +124,7 @@ let setup_and_submit_snapp_command t (snapp_parties : Parties.t) = (sprintf !"%s" ( Network_pool.Transaction_pool.Resource_pool.Diff.Diff_error .to_yojson (snd failed_txn) - |> Yojson.Safe.to_string ))) + |> Yojson.Safe.to_string ) ) ) | Ok ([ User_command.Parties txn ], []) -> [%log' info (Mina_lib.top_level_logger t)] ~metadata:[ ("snapp_command", Parties.to_yojson txn) ] @@ -142,8 +142,8 @@ let setup_and_submit_snapp_command t (snapp_parties : Parties.t) = (Fn.compose Network_pool.Transaction_pool.Resource_pool.Diff .Diff_error - .to_yojson snd) - invalid_commands) ) + .to_yojson snd ) + invalid_commands ) ) ] "Invalid result from scheduling a Snapp transaction" ; Error @@ -401,7 +401,7 @@ let get_status ~flag t = | Full full -> Some (List.map (Hashtbl.to_alist full.states) ~f:(fun (state, hashes) -> - (state, State_hash.Set.length hashes))) + (state, State_hash.Set.length hashes) ) ) | _ -> None in diff --git a/src/lib/mina_generators/parties_generators.ml b/src/lib/mina_generators/parties_generators.ml index 06be7498147..4a87254f317 100644 --- a/src/lib/mina_generators/parties_generators.ml +++ b/src/lib/mina_generators/parties_generators.ml @@ -87,7 +87,7 @@ let gen_account_precondition_from_account ?(succeed = true) account = | Some { Zkapp_account.app_state; sequence_state; proved_state; _ } -> let state = Zkapp_state.V.map app_state ~f:(fun field -> - Quickcheck.random_value (Or_ignore.gen (return field))) + Quickcheck.random_value (Or_ignore.gen (return field)) ) in let%bind sequence_state = (* choose a value from account sequence state *) @@ -213,7 +213,7 @@ let gen_account_precondition_from ?(succeed = true) ~account_id ~ledger () = "gen_account_precondition_from: account id with public key %s and \ token id %s not in ledger" (Signature_lib.Public_key.Compressed.to_base58_check - (Account_id.public_key account_id)) + (Account_id.public_key account_id) ) (Account_id.token_id account_id |> Token_id.to_string) () else @@ -302,7 +302,7 @@ let gen_epoch_data_predicate , State_hash.Stable.V1.t , State_hash.Stable.V1.t , Mina_numbers.Length.Stable.V1.t ) - Zkapp_precondition.Protocol_state.Epoch_data.Poly.t) : + Zkapp_precondition.Protocol_state.Epoch_data.Poly.t ) : Zkapp_precondition.Protocol_state.Epoch_data.t Base_quickcheck.Generator.t = let open Quickcheck.Let_syntax in let%bind ledger = @@ -562,7 +562,7 @@ let gen_party_body_components (type a b c d) ?account_id ?balances_tbl "gen_party_body: could not find account location for passed \ account id with public key %s and token_id %s" (Signature_lib.Public_key.Compressed.to_base58_check - (Account_id.public_key account_id)) + (Account_id.public_key account_id) ) (Account_id.token_id account_id |> Token_id.to_string) () | Some location -> ( @@ -573,7 +573,7 @@ let gen_party_body_components (type a b c d) ?account_id ?balances_tbl "gen_party_body: could not find account for passed account \ id with public key %s and token id %s" (Signature_lib.Public_key.Compressed.to_base58_check - (Account_id.public_key account_id)) + (Account_id.public_key account_id) ) (Account_id.token_id account_id |> Token_id.to_string) () | Some acct -> @@ -625,7 +625,7 @@ let gen_party_body_components (type a b c d) ?account_id ?balances_tbl Some (add_balance_and_balance_change account.balance balance_change) | Some balance -> (* update entry in table *) - Some (add_balance_and_balance_change balance balance_change)) ) ; + Some (add_balance_and_balance_change balance balance_change) ) ) ; let field_array_list_gen ~max_array_len ~max_list_len = let array_gen = let%bind array_len = Int.gen_uniform_incl 0 max_array_len in @@ -697,7 +697,7 @@ let gen_party_from ?(succeed = true) ?(new_account = false) ~gen_balance_change:(gen_balance_change ?permissions_auth ~balances_tbl) ~f_balance_change:Fn.id () ~f_token_id:Fn.id ~f_account_predcondition:(fun account_id ledger -> - gen_account_precondition_from ~succeed ~account_id ~ledger) + gen_account_precondition_from ~succeed ~account_id ~ledger ) ~gen_use_full_commitment:(gen_use_full_commitment ~increment_nonce ()) in let body = Party_body_components.to_typical_party body_components in @@ -731,7 +731,7 @@ let gen_party_body_fee_payer ?permissions_auth ~account_id ~ledger which is represented by the unit value in the body *) assert (Token_id.equal token_id Token_id.default) ; - ()) + () ) ~f_account_predcondition:account_precondition_gen ~gen_use_full_commitment:(return ()) ~ledger ?protocol_state_view () in @@ -763,7 +763,7 @@ let max_other_parties = 2 let gen_parties_from ?(succeed = true) ~(fee_payer_keypair : Signature_lib.Keypair.t) ~(keymap : - Signature_lib.Private_key.t Signature_lib.Public_key.Compressed.Map.t) + Signature_lib.Private_key.t Signature_lib.Public_key.Compressed.Map.t ) ~ledger ?protocol_state_view () = let open Quickcheck.Let_syntax in let fee_payer_pk = @@ -778,7 +778,7 @@ let gen_parties_from ?(succeed = true) then failwithf "gen_parties_from: public key %s is in ledger, but not keymap" (Signature_lib.Public_key.Compressed.to_base58_check pk) - ()) ; + () ) ; (* table of public keys not in the ledger, to be used for new parties we have the corresponding private keys, so we can create signatures for those new parties *) @@ -787,7 +787,7 @@ let gen_parties_from ?(succeed = true) Signature_lib.Public_key.Compressed.Map.iter_keys keymap ~f:(fun pk -> let account_id = Account_id.create pk Token_id.default in if not (Account_id.Set.mem ledger_accounts account_id) then - Signature_lib.Public_key.Compressed.Table.add_exn tbl ~key:pk ~data:()) ; + Signature_lib.Public_key.Compressed.Table.add_exn tbl ~key:pk ~data:() ) ; tbl in let%bind fee_payer = @@ -885,7 +885,7 @@ let gen_parties_from ?(succeed = true) | Some sum -> sum | None -> - failwith "Overflow adding other parties balances") + failwith "Overflow adding other parties balances" ) in (* create a party with balance change to yield a zero sum @@ -928,7 +928,7 @@ let gen_parties_from ?(succeed = true) (Random_oracle.Input.Chunked.field ( Parties.commitment parties_dummy_signatures |> Parties.Transaction_commitment.create_complete ~memo_hash - ~fee_payer_hash )) + ~fee_payer_hash ) ) in let fee_payer_with_valid_signature = { parties_dummy_signatures.fee_payer with @@ -979,7 +979,7 @@ let gen_parties_from ?(succeed = true) | Proof _ | None_given -> authorization in - { Party.body; authorization = authorization_with_valid_signature }) + { Party.body; authorization = authorization_with_valid_signature } ) in return { parties_dummy_signatures with diff --git a/src/lib/mina_generators/user_command_generators.ml b/src/lib/mina_generators/user_command_generators.ml index 462f2570a07..ab288380193 100644 --- a/src/lib/mina_generators/user_command_generators.ml +++ b/src/lib/mina_generators/user_command_generators.ml @@ -28,13 +28,13 @@ let parties_with_ledger () = List.fold keypairs ~init:Public_key.Compressed.Map.empty ~f:(fun map { public_key; private_key } -> let key = Public_key.compress public_key in - Public_key.Compressed.Map.add_exn map ~key ~data:private_key) + Public_key.Compressed.Map.add_exn map ~key ~data:private_key ) in let num_keypairs_in_ledger = Parties_generators.max_other_parties + 1 in let keypairs_in_ledger = List.take keypairs num_keypairs_in_ledger in let account_ids = List.map keypairs_in_ledger ~f:(fun { public_key; _ } -> - Account_id.create (Public_key.compress public_key) Token_id.default) + Account_id.create (Public_key.compress public_key) Token_id.default ) in let%bind balances = let min_cmd_fee = Mina_compile_config.minimum_user_command_fee in @@ -87,7 +87,7 @@ let parties_with_ledger () = let accounts = List.mapi account_ids_and_balances ~f:(fun ndx (account_id, balance) -> let account = Account.create account_id balance in - if ndx mod 2 = 0 then account else snappify_account account) + if ndx mod 2 = 0 then account else snappify_account account ) in let fee_payer_keypair = List.hd_exn keypairs in let ledger = Ledger.create ~depth:ledger_depth () in @@ -103,7 +103,7 @@ let parties_with_ledger () = (Account_id.to_yojson acct_id |> Yojson.Safe.to_string) () | Ok (`Added, _) -> - ()) ; + () ) ; let%bind parties = Parties_generators.gen_parties_from ~fee_payer_keypair ~keymap ~ledger () in @@ -130,7 +130,7 @@ let sequence_parties_with_ledger ?length () = failwith "Account already existed in target ledger" | Error err -> failwithf "Could not add account to target ledger: %s" - (Error.to_string_hum err) ()) + (Error.to_string_hum err) () ) in let init_ledger = Ledger.create ~depth:ledger_depth () in let rec go parties_and_fee_payer_keypairs n = diff --git a/src/lib/mina_graphql/mina_graphql.ml b/src/lib/mina_graphql/mina_graphql.ml index d9a26f8dd53..bbecd15ad6c 100644 --- a/src/lib/mina_graphql/mina_graphql.ml +++ b/src/lib/mina_graphql/mina_graphql.ml @@ -53,21 +53,21 @@ let result_of_or_error ?error v = | None -> str_error | Some error -> - sprintf "%s (%s)" error str_error) + sprintf "%s (%s)" error str_error ) let result_field_no_inputs ~resolve = Schema.io_field ~resolve:(fun resolve_info src -> - Deferred.return @@ resolve resolve_info src) + Deferred.return @@ resolve resolve_info src ) (* one input *) let result_field ~resolve = Schema.io_field ~resolve:(fun resolve_info src inputs -> - Deferred.return @@ resolve resolve_info src inputs) + Deferred.return @@ resolve resolve_info src inputs ) (* two inputs *) let result_field2 ~resolve = Schema.io_field ~resolve:(fun resolve_info src input1 input2 -> - Deferred.return @@ resolve resolve_info src input1 input2) + Deferred.return @@ resolve resolve_info src input1 input2 ) module Doc = struct let date ?(extra = "") s = @@ -86,7 +86,7 @@ module Reflection = struct let underToCamel s = Re2.replace_exn (Lazy.force regex) s ~f:(fun m -> let s = Re2.Match.get_exn ~sub:(`Index 1) m in - String.capitalize s) + String.capitalize s ) (** When Fields.folding, create graphql fields via reflection *) let reflect f ~typ acc x = @@ -142,7 +142,7 @@ module Reflection = struct | To_build_breadcrumb, _ -> "to_build_breadcrumb" | Root, _ -> - "root"))) + "root" ) ) ) ~typ:(list (non_null string)) a x @@ -180,7 +180,7 @@ module Types = struct ; field "tokenId" ~typ:(non_null token_id) ~args:Arg.[] ~resolve:(fun _ id -> Mina_base.Account_id.token_id id) - ]) + ] ) let json : ('context, Yojson.Basic.t option) typ = scalar "JSON" ~doc:"Arbitrary JSON" ~coerce:Fn.id @@ -193,7 +193,7 @@ module Types = struct (List.map Sync_status.all ~f:(fun status -> enum_value (String.map ~f:Char.uppercase @@ Sync_status.to_string status) - ~value:status)) + ~value:status ) ) let transaction_status : ('context, Transaction_inclusion_status.State.t option) typ = @@ -224,22 +224,22 @@ module Types = struct ; field "globalSlot" ~typ:(non_null uint32) ~args:Arg.[] ~resolve:(fun _ (global_slot : Consensus.Data.Consensus_time.t) -> - C.to_uint32 global_slot) + C.to_uint32 global_slot ) ; field "startTime" ~typ:(non_null string) ~args:Arg.[] ~resolve:(fun { ctx = coda; _ } global_slot -> let constants = (Mina_lib.config coda).precomputed_values.consensus_constants in - Block_time.to_string @@ C.start_time ~constants global_slot) + Block_time.to_string @@ C.start_time ~constants global_slot ) ; field "endTime" ~typ:(non_null string) ~args:Arg.[] ~resolve:(fun { ctx = coda; _ } global_slot -> let constants = (Mina_lib.config coda).precomputed_values.consensus_constants in - Block_time.to_string @@ C.end_time ~constants global_slot) - ]) + Block_time.to_string @@ C.end_time ~constants global_slot ) + ] ) let consensus_time_with_global_slot_since_genesis = obj "ConsensusTimeGlobalSlot" @@ -255,7 +255,7 @@ module Types = struct ~args:Arg.[] ~typ:(non_null uint32) ~resolve:(fun _ (_, slot) -> slot) - ]) + ] ) let block_producer_timing : (_, Daemon_rpcs.Types.Status.Next_producer_timing.t option) typ = @@ -268,9 +268,10 @@ module Types = struct ~typ:(non_null @@ list @@ non_null consensus_time) ~doc:"Next block production time" ~args:Arg.[] - ~resolve: - (fun { ctx = coda; _ } - { Daemon_rpcs.Types.Status.Next_producer_timing.timing; _ } -> + ~resolve:(fun { ctx = coda; _ } + { Daemon_rpcs.Types.Status.Next_producer_timing.timing + ; _ + } -> let consensus_constants = (Mina_lib.config coda).precomputed_values.consensus_constants in @@ -282,13 +283,15 @@ module Types = struct | Produce info -> [ of_time info.time ~consensus_constants ] | Produce_now info -> - [ of_time ~consensus_constants info.time ]) + [ of_time ~consensus_constants info.time ] ) ; field "globalSlotSinceGenesis" ~typ:(non_null @@ list @@ non_null uint32) ~doc:"Next block production global-slot-since-genesis " ~args:Arg.[] - ~resolve: - (fun _ { Daemon_rpcs.Types.Status.Next_producer_timing.timing; _ } -> + ~resolve:(fun _ + { Daemon_rpcs.Types.Status.Next_producer_timing.timing + ; _ + } -> match timing with | Daemon_rpcs.Types.Status.Next_producer_timing.Check_again _ -> [] @@ -297,27 +300,26 @@ module Types = struct | Produce info -> [ info.for_slot.global_slot_since_genesis ] | Produce_now info -> - [ info.for_slot.global_slot_since_genesis ]) + [ info.for_slot.global_slot_since_genesis ] ) ; field "generatedFromConsensusAt" ~typ:(non_null consensus_time_with_global_slot_since_genesis) ~doc: "Consensus time of the block that was used to determine the next \ block production time" ~args:Arg.[] - ~resolve: - (fun { ctx = coda; _ } - { Daemon_rpcs.Types.Status.Next_producer_timing - .generated_from_consensus_at = - { slot; global_slot_since_genesis } - ; _ - } -> + ~resolve:(fun { ctx = coda; _ } + { Daemon_rpcs.Types.Status.Next_producer_timing + .generated_from_consensus_at = + { slot; global_slot_since_genesis } + ; _ + } -> let consensus_constants = (Mina_lib.config coda).precomputed_values.consensus_constants in ( Consensus.Data.Consensus_time.of_global_slot ~constants:consensus_constants slot - , global_slot_since_genesis )) - ]) + , global_slot_since_genesis ) ) + ] ) let merkle_path_element : (_, [ `Left of Zkapp_basic.F.t | `Right of Zkapp_basic.F.t ] option) typ = @@ -325,12 +327,12 @@ module Types = struct [ field "isRightBranch" ~typ:(non_null bool) ~args:Arg.[] ~resolve:(fun _ x -> - match x with `Left _ -> false | `Right _ -> true) + match x with `Left _ -> false | `Right _ -> true ) ; field "otherHash" ~typ:(non_null string) ~args:Arg.[] ~resolve:(fun _ x -> - match x with `Left h | `Right h -> Zkapp_basic.F.to_string h) - ]) + match x with `Left h | `Right h -> Zkapp_basic.F.to_string h ) + ] ) module DaemonStatus = struct type t = Daemon_rpcs.Types.Status.t @@ -340,12 +342,12 @@ module Types = struct [ field "start" ~typ:(non_null string) ~args:Arg.[] ~resolve:(fun _ (start, _) -> - Time.Span.to_ms start |> Int64.of_float |> Int64.to_string) + Time.Span.to_ms start |> Int64.of_float |> Int64.to_string ) ; field "stop" ~typ:(non_null string) ~args:Arg.[] ~resolve:(fun _ (_, end_) -> - Time.Span.to_ms end_ |> Int64.of_float |> Int64.to_string) - ]) + Time.Span.to_ms end_ |> Int64.of_float |> Int64.to_string ) + ] ) let histogram : (_, Perf_histograms.Report.t option) typ = obj "Histogram" ~fields:(fun _ -> @@ -354,7 +356,7 @@ module Types = struct @@ Perf_histograms.Report.Fields.fold ~init:[] ~values:(id ~typ:Schema.(non_null (list (non_null int)))) ~intervals:(id ~typ:(non_null (list (non_null interval)))) - ~underflow:nn_int ~overflow:nn_int) + ~underflow:nn_int ~overflow:nn_int ) module Rpc_timings = Daemon_rpcs.Types.Status.Rpc_timings module Rpc_pair = Rpc_timings.Rpc_pair @@ -362,7 +364,7 @@ module Types = struct let rpc_pair : (_, Perf_histograms.Report.t option Rpc_pair.t option) typ = let h = Reflection.Shorthand.id ~typ:histogram in obj "RpcPair" ~fields:(fun _ -> - List.rev @@ Rpc_pair.Fields.fold ~init:[] ~dispatch:h ~impl:h) + List.rev @@ Rpc_pair.Fields.fold ~init:[] ~dispatch:h ~impl:h ) let rpc_timings : (_, Rpc_timings.t option) typ = let fd = Reflection.Shorthand.id ~typ:(non_null rpc_pair) in @@ -370,7 +372,7 @@ module Types = struct List.rev @@ Rpc_timings.Fields.fold ~init:[] ~get_staged_ledger_aux:fd ~answer_sync_ledger_query:fd ~get_ancestry:fd - ~get_transition_chain_proof:fd ~get_transition_chain:fd) + ~get_transition_chain_proof:fd ~get_transition_chain:fd ) module Histograms = Daemon_rpcs.Types.Status.Histograms @@ -384,7 +386,7 @@ module Types = struct ~external_transition_latency:h ~accepted_transition_local_latency:h ~accepted_transition_remote_latency:h - ~snark_worker_transition_time:h ~snark_worker_merge_time:h) + ~snark_worker_transition_time:h ~snark_worker_merge_time:h ) let consensus_configuration : (_, Consensus.Configuration.t option) typ = obj "ConsensusConfiguration" ~fields:(fun _ -> @@ -393,14 +395,14 @@ module Types = struct @@ Consensus.Configuration.Fields.fold ~init:[] ~delta:nn_int ~k:nn_int ~slots_per_epoch:nn_int ~slot_duration:nn_int ~epoch_duration:nn_int ~acceptable_network_delay:nn_int - ~genesis_state_timestamp:nn_time) + ~genesis_state_timestamp:nn_time ) let peer : (_, Network_peer.Peer.Display.t option) typ = obj "Peer" ~fields:(fun _ -> let open Reflection.Shorthand in List.rev @@ Network_peer.Peer.Display.Fields.fold ~init:[] ~host:nn_string - ~libp2p_port:nn_int ~peer_id:nn_string) + ~libp2p_port:nn_int ~peer_id:nn_string ) let addrs_and_ports : (_, Node_addrs_and_ports.Display.t option) typ = obj "AddrsAndPorts" ~fields:(fun _ -> @@ -408,7 +410,7 @@ module Types = struct List.rev @@ Node_addrs_and_ports.Display.Fields.fold ~init:[] ~external_ip:nn_string ~bind_ip:nn_string ~client_port:nn_int - ~libp2p_port:nn_int ~peer:(id ~typ:peer)) + ~libp2p_port:nn_int ~peer:(id ~typ:peer) ) let metrics : (_, Daemon_rpcs.Types.Status.Metrics.t option) typ = obj "Metrics" ~fields:(fun _ -> @@ -418,7 +420,7 @@ module Types = struct ~block_production_delay:nn_int_list ~transaction_pool_diff_received:nn_int ~transaction_pool_diff_broadcasted:nn_int - ~transactions_added_to_pool:nn_int ~transaction_pool_size:nn_int) + ~transactions_added_to_pool:nn_int ~transaction_pool_size:nn_int ) let t : (_, Daemon_rpcs.Types.Status.t option) typ = obj "DaemonStatus" ~fields:(fun _ -> @@ -447,7 +449,7 @@ module Types = struct (id ~typ:(non_null consensus_configuration)) ~highest_block_length_received:nn_int ~highest_unvalidated_block_length_received:nn_int - ~metrics:(id ~typ:(non_null metrics))) + ~metrics:(id ~typ:(non_null metrics)) ) end let fee_transfer = @@ -461,7 +463,7 @@ module Types = struct ~args:Arg.[] ~doc:"Amount that the recipient is paid in this fee transfer" ~resolve:(fun _ ({ Fee_transfer.fee; _ }, _) -> - Currency.Fee.to_uint64 fee) + Currency.Fee.to_uint64 fee ) ; field "type" ~typ:(non_null string) ~args:Arg.[] ~doc: @@ -475,8 +477,8 @@ module Types = struct .Fee_transfer_via_coinbase -> "Fee_transfer_via_coinbase" | Fee_transfer -> - "Fee_transfer") - ]) + "Fee_transfer" ) + ] ) let account_timing : (Mina_lib.t, Account_timing.t option) typ = obj "AccountTiming" ~fields:(fun _ -> @@ -488,7 +490,8 @@ module Types = struct | Account_timing.Untimed -> None | Timed timing_info -> - Some (Balance.to_uint64 timing_info.initial_minimum_balance)) + Some (Balance.to_uint64 timing_info.initial_minimum_balance) + ) ; field "cliffTime" ~typ:uint32 ~doc:"The cliff time for a time-locked account" ~args:Arg.[] @@ -497,7 +500,7 @@ module Types = struct | Account_timing.Untimed -> None | Timed timing_info -> - Some timing_info.cliff_time) + Some timing_info.cliff_time ) ; field "cliffAmount" ~typ:uint64 ~doc:"The cliff amount for a time-locked account" ~args:Arg.[] @@ -506,7 +509,7 @@ module Types = struct | Account_timing.Untimed -> None | Timed timing_info -> - Some (Currency.Amount.to_uint64 timing_info.cliff_amount)) + Some (Currency.Amount.to_uint64 timing_info.cliff_amount) ) ; field "vestingPeriod" ~typ:uint32 ~doc:"The vesting period for a time-locked account" ~args:Arg.[] @@ -515,7 +518,7 @@ module Types = struct | Account_timing.Untimed -> None | Timed timing_info -> - Some timing_info.vesting_period) + Some timing_info.vesting_period ) ; field "vestingIncrement" ~typ:uint64 ~doc:"The vesting increment for a time-locked account" ~args:Arg.[] @@ -524,8 +527,9 @@ module Types = struct | Account_timing.Untimed -> None | Timed timing_info -> - Some (Currency.Amount.to_uint64 timing_info.vesting_increment)) - ]) + Some (Currency.Amount.to_uint64 timing_info.vesting_increment) + ) + ] ) let completed_work = obj "CompletedWork" ~doc:"Completed snark works" ~fields:(fun _ -> @@ -537,13 +541,13 @@ module Types = struct ~args:Arg.[] ~doc:"Amount the prover is paid for the snark work" ~resolve:(fun _ { Transaction_snark_work.Info.fee; _ } -> - Currency.Fee.to_uint64 fee) + Currency.Fee.to_uint64 fee ) ; field "workIds" ~doc:"Unique identifier for the snark work purchased" ~typ:(non_null @@ list @@ non_null int) ~args:Arg.[] ~resolve:(fun _ { Transaction_snark_work.Info.work_ids; _ } -> - One_or_two.to_list work_ids) - ]) + One_or_two.to_list work_ids ) + ] ) let sign = enum "sign" @@ -558,8 +562,8 @@ module Types = struct ; field "feeMagnitude" ~typ:(non_null uint64) ~doc:"Fee" ~args:Arg.[] ~resolve:(fun _ fee -> - Currency.Amount.(to_uint64 (Signed.magnitude fee))) - ]) + Currency.Amount.(to_uint64 (Signed.magnitude fee)) ) + ] ) let work_statement = let `Needs_some_work_for_zkapps_on_mainnet = Mina_base.Util.todo_zkapps in @@ -571,36 +575,36 @@ module Types = struct ~doc:"Base58Check-encoded hash of the source ledger" ~args:Arg.[] ~resolve:(fun _ { Transaction_snark.Statement.source; _ } -> - Frozen_ledger_hash.to_base58_check source.ledger) + Frozen_ledger_hash.to_base58_check source.ledger ) ; field "targetLedgerHash" ~typ:(non_null string) ~doc:"Base58Check-encoded hash of the target ledger" ~args:Arg.[] ~resolve:(fun _ { Transaction_snark.Statement.target; _ } -> - Frozen_ledger_hash.to_base58_check target.ledger) + Frozen_ledger_hash.to_base58_check target.ledger ) ; field "feeExcess" ~typ:(non_null signed_fee) ~doc: "Total transaction fee that is not accounted for in the \ transition from source ledger to target ledger" ~args:Arg.[] - ~resolve: - (fun _ - ({ fee_excess = { fee_excess_l; _ }; _ } : - Transaction_snark.Statement.t) -> + ~resolve:(fun _ + ({ fee_excess = { fee_excess_l; _ }; _ } : + Transaction_snark.Statement.t ) -> (* TODO: Expose full fee excess data. *) { fee_excess_l with magnitude = Currency.Amount.of_fee fee_excess_l.magnitude - }) + } ) ; field "supplyIncrease" ~typ:(non_null uint64) ~doc:"Increase in total coinbase reward " ~args:Arg.[] - ~resolve: - (fun _ ({ supply_increase; _ } : Transaction_snark.Statement.t) -> - Currency.Amount.to_uint64 supply_increase) + ~resolve:(fun _ + ({ supply_increase; _ } : + Transaction_snark.Statement.t ) -> + Currency.Amount.to_uint64 supply_increase ) ; field "workId" ~doc:"Unique identifier for a snark work" ~typ:(non_null int) ~args:Arg.[] ~resolve:(fun _ w -> Transaction_snark.Statement.hash w) - ]) + ] ) let pending_work = obj "PendingSnarkWork" @@ -611,7 +615,7 @@ module Types = struct ~doc:"Work bundle with one or two snark work" ~typ:(non_null @@ list @@ non_null work_statement) ~resolve:(fun _ w -> One_or_two.to_list w) - ]) + ] ) let blockchain_state : ( 'context @@ -625,14 +629,14 @@ module Types = struct let timestamp = Mina_state.Blockchain_state.timestamp blockchain_state in - Block_time.to_string timestamp) + Block_time.to_string timestamp ) ; field "utcDate" ~typ:(non_null string) ~doc: (Doc.date ~extra: ". Time offsets are adjusted to reflect true wall-clock \ time instead of genesis time." - "utcDate") + "utcDate" ) ~args:Arg.[] ~resolve:(fun { ctx = coda; _ } t -> let blockchain_state, _ = t in @@ -641,7 +645,7 @@ module Types = struct in Block_time.to_string_system_time (Mina_lib.time_controller coda) - timestamp) + timestamp ) ; field "snarkedLedgerHash" ~typ:(non_null string) ~doc:"Base58Check-encoded hash of the snarked ledger" ~args:Arg.[] @@ -650,7 +654,7 @@ module Types = struct let snarked_ledger_hash = Mina_state.Blockchain_state.snarked_ledger_hash blockchain_state in - Frozen_ledger_hash.to_base58_check snarked_ledger_hash) + Frozen_ledger_hash.to_base58_check snarked_ledger_hash ) ; field "stagedLedgerHash" ~typ:(non_null string) ~doc:"Base58Check-encoded hash of the staged ledger" ~args:Arg.[] @@ -660,7 +664,7 @@ module Types = struct Mina_state.Blockchain_state.staged_ledger_hash blockchain_state in Mina_base.Ledger_hash.to_base58_check - @@ Staged_ledger_hash.ledger_hash staged_ledger_hash) + @@ Staged_ledger_hash.ledger_hash staged_ledger_hash ) ; field "stagedLedgerProofEmitted" ~typ:bool ~doc: "Block finished a staged ledger, and a proof was emitted from it \ @@ -678,8 +682,9 @@ module Types = struct | None -> None | Some b -> - Some (Transition_frontier.Breadcrumb.just_emitted_a_proof b)) - ]) + Some (Transition_frontier.Breadcrumb.just_emitted_a_proof b) + ) + ] ) let protocol_state : ( 'context @@ -693,14 +698,14 @@ module Types = struct ~args:Arg.[] ~resolve:(fun _ t -> let protocol_state, _ = t in - State_hash.to_base58_check protocol_state.previous_state_hash) + State_hash.to_base58_check protocol_state.previous_state_hash ) ; field "blockchainState" ~doc:"State which is agnostic of a particular consensus algorithm" ~typ:(non_null blockchain_state) ~args:Arg.[] ~resolve:(fun _ t -> let protocol_state, state_hash = t in - (protocol_state.blockchain_state, state_hash)) + (protocol_state.blockchain_state, state_hash) ) ; field "consensusState" ~doc: "State specific to the Codaboros Proof of Stake consensus \ @@ -709,8 +714,8 @@ module Types = struct ~args:Arg.[] ~resolve:(fun _ t -> let protocol_state, _ = t in - protocol_state.consensus_state) - ]) + protocol_state.consensus_state ) + ] ) let chain_reorganization_status : ('contxt, [ `Changed ] option) typ = enum "ChainReorganizationStatus" @@ -724,15 +729,15 @@ module Types = struct ~args:Arg.[] ~resolve:(fun { ctx = coda; _ } () -> (Mina_lib.config coda).precomputed_values.constraint_constants - .account_creation_fee |> Currency.Fee.to_uint64) + .account_creation_fee |> Currency.Fee.to_uint64 ) ; field "coinbase" ~typ:(non_null uint64) ~doc: "The amount received as a coinbase reward for producing a block" ~args:Arg.[] ~resolve:(fun { ctx = coda; _ } () -> (Mina_lib.config coda).precomputed_values.constraint_constants - .coinbase_amount |> Currency.Amount.to_uint64) - ]) + .coinbase_amount |> Currency.Amount.to_uint64 ) + ] ) module AccountObj = struct module AnnotatedBalance = struct @@ -763,7 +768,7 @@ module Types = struct ~cliff_amount:timing_info.cliff_amount ~vesting_period:timing_info.vesting_period ~vesting_increment:timing_info.vesting_increment - ~initial_minimum_balance:timing_info.initial_minimum_balance) + ~initial_minimum_balance:timing_info.initial_minimum_balance ) let obj = obj "AnnotatedBalance" @@ -796,7 +801,7 @@ module Types = struct Unsigned.UInt64.compare total_balance min_balance_uint64 > 0 then Unsigned.UInt64.sub total_balance min_balance_uint64 - else Unsigned.UInt64.zero)) + else Unsigned.UInt64.zero ) ) ; field "locked" ~typ:uint64 ~doc: "The amount of MINA owned by the account which is currently \ @@ -804,7 +809,7 @@ module Types = struct ~deprecated:(Deprecated None) ~args:Arg.[] ~resolve:(fun _ (b : t) -> - Option.map (min_balance b) ~f:Balance.to_uint64) + Option.map (min_balance b) ~f:Balance.to_uint64 ) ; field "blockHeight" ~typ:(non_null uint32) ~doc:"Block height at which balance was measured" ~args:Arg.[] @@ -814,7 +819,7 @@ module Types = struct Unsigned.UInt32.zero | Some crumb -> Transition_frontier.Breadcrumb.consensus_state crumb - |> Consensus.Data.Consensus_state.blockchain_length) + |> Consensus.Data.Consensus_state.blockchain_length ) (* TODO: Mutually recurse with "block" instead -- #5396 *) ; field "stateHash" ~typ:string ~doc: @@ -826,8 +831,8 @@ module Types = struct ~resolve:(fun _ (b : t) -> Option.map b.breadcrumb ~f:(fun crumb -> State_hash.to_base58_check - @@ Transition_frontier.Breadcrumb.state_hash crumb)) - ]) + @@ Transition_frontier.Breadcrumb.state_hash crumb ) ) + ] ) end module Partial_account = struct @@ -918,7 +923,7 @@ module Types = struct in Ledger.location_of_account ledger account_id |> Option.bind ~f:(Ledger.get ledger) - |> Option.map ~f:(fun account -> (account, tip))) + |> Option.map ~f:(fun account -> (account, tip)) ) in match account with | Some (account, breadcrumb) -> @@ -988,7 +993,7 @@ module Types = struct | `Active ledger -> Option.try_with (fun () -> Ledger.index_of_account_exn ledger - (Account_id.create account.public_key account.token_id)) + (Account_id.create account.public_key account.token_id) ) | _ -> None ) } @@ -1021,7 +1026,7 @@ module Types = struct ~doc:"Authorization required to edit zkApp state" ~args:Arg.[] ~resolve:(fun _ permission -> - permission.Permissions.Poly.edit_state) + permission.Permissions.Poly.edit_state ) ; field "send" ~typ:(non_null auth_required) ~doc:"Authorization required to send tokens" ~args:Arg.[] @@ -1034,49 +1039,49 @@ module Types = struct ~doc:"Authorization required to set the delegate" ~args:Arg.[] ~resolve:(fun _ permission -> - permission.Permissions.Poly.set_delegate) + permission.Permissions.Poly.set_delegate ) ; field "setPermissions" ~typ:(non_null auth_required) ~doc:"Authorization required to change permissions" ~args:Arg.[] ~resolve:(fun _ permission -> - permission.Permissions.Poly.set_permissions) + permission.Permissions.Poly.set_permissions ) ; field "setVerificationKey" ~typ:(non_null auth_required) ~doc: "Authorization required to set the verification key of the \ zkApp associated with the account" ~args:Arg.[] ~resolve:(fun _ permission -> - permission.Permissions.Poly.set_verification_key) + permission.Permissions.Poly.set_verification_key ) ; field "setZkappUri" ~typ:(non_null auth_required) ~doc: "Authorization required to change the URI of the zkApp \ associated with the account " ~args:Arg.[] ~resolve:(fun _ permission -> - permission.Permissions.Poly.set_zkapp_uri) + permission.Permissions.Poly.set_zkapp_uri ) ; field "editSequenceState" ~typ:(non_null auth_required) ~doc:"Authorization required to edit the sequence state" ~args:Arg.[] ~resolve:(fun _ permission -> - permission.Permissions.Poly.edit_sequence_state) + permission.Permissions.Poly.edit_sequence_state ) ; field "setTokenSymbol" ~typ:(non_null auth_required) ~doc:"Authorization required to set the token symbol" ~args:Arg.[] ~resolve:(fun _ permission -> - permission.Permissions.Poly.set_token_symbol) + permission.Permissions.Poly.set_token_symbol ) ; field "incrementNonce" ~typ:(non_null auth_required) ~doc:"Authorization required to increment the nonce" ~args:Arg.[] ~resolve:(fun _ permission -> - permission.Permissions.Poly.increment_nonce) + permission.Permissions.Poly.increment_nonce ) ; field "setVotingFor" ~typ:(non_null auth_required) ~doc: "Authorization required to set the state hash the account is \ voting for" ~args:Arg.[] ~resolve:(fun _ permission -> - permission.Permissions.Poly.set_voting_for) - ]) + permission.Permissions.Poly.set_voting_for ) + ] ) let account_vk = obj "AccountVerificationKeyWithHash" ~doc:"Verification key with hash" @@ -1086,12 +1091,12 @@ module Types = struct ~typ:(non_null string) ~args:Arg.[] ~resolve:(fun _ (vk : _ With_hash.t) -> - Pickles.Side_loaded.Verification_key.to_base58_check vk.data) + Pickles.Side_loaded.Verification_key.to_base58_check vk.data ) ; field "hash" ~doc:"Hash of verification key" ~typ:(non_null string) ~args:Arg.[] ~resolve:(fun _ (vk : _ With_hash.t) -> - Pickles.Backend.Tick.Field.to_string vk.hash) - ]) + Pickles.Backend.Tick.Field.to_string vk.hash ) + ] ) let rec account = lazy @@ -1101,12 +1106,11 @@ module Types = struct ~doc:"The public identity of the account" ~args:Arg.[] ~resolve:(fun _ { account; _ } -> - account.Account.Poly.public_key) + account.Account.Poly.public_key ) ; field "token" ~typ:(non_null token_id) ~doc:"The token associated with this account" ~args:Arg.[] - ~resolve:(fun _ { account; _ } -> - account.Account.Poly.token_id) + ~resolve:(fun _ { account; _ } -> account.Account.Poly.token_id) ; field "timing" ~typ:(non_null account_timing) ~doc:"The timing associated with this account" ~args:Arg.[] @@ -1123,7 +1127,7 @@ module Types = struct ~args:Arg.[] ~resolve:(fun _ { account; _ } -> Option.map ~f:Account.Nonce.to_string - account.Account.Poly.nonce) + account.Account.Poly.nonce ) ; field "inferredNonce" ~typ:string ~doc: "Like the `nonce` field, except it includes the scheduled \ @@ -1140,7 +1144,7 @@ module Types = struct | `Active (Some nonce) -> Some (Account.Nonce.to_string nonce) | `Active None | `Bootstrapping -> - None) + None ) ; field "epochDelegateAccount" ~typ:(Lazy.force account) ~doc: "The account that you delegated on the staking ledger of \ @@ -1183,13 +1187,13 @@ module Types = struct "Could not retrieve delegate account from sparse \ ledger. The account may not be in the ledger: \ $error" ; - None )) + None ) ) ; field "receiptChainHash" ~typ:string ~doc:"Top hash of the receipt chain merkle-list" ~args:Arg.[] ~resolve:(fun _ { account; _ } -> Option.map ~f:Receipt.Chain_hash.to_base58_check - account.Account.Poly.receipt_chain_hash) + account.Account.Poly.receipt_chain_hash ) ; field "delegate" ~typ:public_key ~doc: "The public key to which you are delegating - if you are \ @@ -1197,8 +1201,7 @@ module Types = struct key" ~args:Arg.[] ~deprecated:(Deprecated (Some "use delegateAccount instead")) - ~resolve:(fun _ { account; _ } -> - account.Account.Poly.delegate) + ~resolve:(fun _ { account; _ } -> account.Account.Poly.delegate) ; field "delegateAccount" ~typ:(Lazy.force account) ~doc: "The account to which you are delegating - if you are not \ @@ -1207,7 +1210,7 @@ module Types = struct ~resolve:(fun { ctx = coda; _ } { account; _ } -> Option.map ~f:(get_best_ledger_account_pk coda) - account.Account.Poly.delegate) + account.Account.Poly.delegate ) ; field "delegators" ~typ:(list @@ non_null @@ Lazy.force account) ~doc: @@ -1233,11 +1236,11 @@ module Types = struct | `Active ledger -> Option.try_with (fun () -> Ledger.index_of_account_exn ledger - (Account.identifier a)) + (Account.identifier a) ) | _ -> None ) - }) - delegators) + } ) + delegators ) ; field "lastEpochDelegators" ~typ:(list @@ non_null @@ Lazy.force account) ~doc: @@ -1264,11 +1267,11 @@ module Types = struct | `Active ledger -> Option.try_with (fun () -> Ledger.index_of_account_exn ledger - (Account.identifier a)) + (Account.identifier a) ) | _ -> None ) - }) - delegators) + } ) + delegators ) ; field "votingFor" ~typ:string ~doc: "The previous epoch lock hash of the chain which you are \ @@ -1276,7 +1279,7 @@ module Types = struct ~args:Arg.[] ~resolve:(fun _ { account; _ } -> Option.map ~f:Mina_base.State_hash.to_base58_check - account.Account.Poly.voting_for) + account.Account.Poly.voting_for ) ; field "stakingActive" ~typ:(non_null bool) ~doc: "True if you are actively staking with this account on the \ @@ -1284,7 +1287,7 @@ module Types = struct staking key was changed recently" ~args:Arg.[] ~resolve:(fun _ { is_actively_staking; _ } -> - is_actively_staking) + is_actively_staking ) ; field "privateKeyPath" ~typ:(non_null string) ~doc:"Path of the private key file for this account" ~args:Arg.[] @@ -1303,7 +1306,7 @@ module Types = struct | Token_owned _ -> true | Not_owned _ -> - false) + false ) ; field "isDisabled" ~typ:bool ~doc: "True if this account has been disabled by the owner of the \ @@ -1314,7 +1317,7 @@ module Types = struct | Token_owned _ -> false | Not_owned { account_disabled } -> - account_disabled) + account_disabled ) ; field "index" ~typ:int ~doc: "The index of this account in the ledger, or null if this \ @@ -1328,7 +1331,7 @@ module Types = struct the zkApp source code" ~args:Arg.[] ~resolve:(fun _ { account; _ } -> - account.Account.Poly.zkapp_uri) + account.Account.Poly.zkapp_uri ) ; field "zkappState" ~typ:(list @@ non_null string) ~doc: @@ -1339,23 +1342,23 @@ module Types = struct account.Account.Poly.zkapp |> Option.map ~f:(fun zkapp_account -> zkapp_account.app_state |> Zkapp_state.V.to_list - |> List.map ~f:Zkapp_basic.F.to_string)) + |> List.map ~f:Zkapp_basic.F.to_string ) ) ; field "permissions" ~typ:account_permissions ~doc:"Permissions for updating certain fields of this account" ~args:Arg.[] ~resolve:(fun _ { account; _ } -> - account.Account.Poly.permissions) + account.Account.Poly.permissions ) ; field "tokenSymbol" ~typ:string ~doc:"The token symbol associated with this account" ~args:Arg.[] ~resolve:(fun _ { account; _ } -> - account.Account.Poly.token_symbol) + account.Account.Poly.token_symbol ) ; field "verificationKey" ~typ:account_vk ~doc:"Verification key associated with this account" ~args:Arg.[] ~resolve:(fun _ { account; _ } -> Option.value_map account.Account.Poly.zkapp ~default:None - ~f:(fun zkapp_account -> zkapp_account.verification_key)) + ~f:(fun zkapp_account -> zkapp_account.verification_key) ) ; field "sequenceEvents" ~doc:"Sequence events associated with this account" ~typ:(list (non_null string)) @@ -1365,8 +1368,8 @@ module Types = struct ~f:(fun zkapp_account -> List.map ~f:Snark_params.Tick.Field.to_string (Pickles_types.Vector.to_list - zkapp_account.sequence_state))) - ])) + zkapp_account.sequence_state ) ) ) + ] ) ) let account = Lazy.force account end @@ -1386,8 +1389,8 @@ module Types = struct ~typ:(non_null @@ list @@ non_null @@ string) ~args:[] ~doc:"Failure reason for the party or any nested parties" ~resolve:(fun _ (_, failures) -> - List.map failures ~f:Transaction_status.Failure.to_string) - ]) + List.map failures ~f:Transaction_status.Failure.to_string ) + ] ) end module User_command = struct @@ -1396,7 +1399,7 @@ module Types = struct | `Payment -> `String "PAYMENT" | `Stake_delegation -> - `String "STAKE_DELEGATION") + `String "STAKE_DELEGATION" ) let to_kind (t : Signed_command.t) = match Signed_command.payload t |> Signed_command_payload.body with @@ -1468,7 +1471,7 @@ module Types = struct ~deprecated:(Deprecated (Some "use receiver field instead")) ; abstract_field "failureReason" ~typ:string ~args:[] ~doc:"null is no failure, reason for failure otherwise." - ]) + ] ) module With_status = struct type 'a t = { data : 'a; status : Command_status.t } @@ -1478,7 +1481,7 @@ module Types = struct let field_no_status ?doc ?deprecated lab ~typ ~args ~resolve = field ?doc ?deprecated lab ~typ ~args ~resolve:(fun c uc -> - resolve c uc.With_status.data) + resolve c uc.With_status.data ) let user_command_shared_fields : ( Mina_lib.t @@ -1487,10 +1490,10 @@ module Types = struct list = [ field_no_status "id" ~typ:(non_null guid) ~args:[] ~resolve:(fun _ user_command -> - Signed_command.to_base58_check user_command.With_hash.data) + Signed_command.to_base58_check user_command.With_hash.data ) ; field_no_status "hash" ~typ:(non_null string) ~args:[] ~resolve:(fun _ user_command -> - Transaction_hash.to_base58_check user_command.With_hash.hash) + Transaction_hash.to_base58_check user_command.With_hash.hash ) ; field_no_status "kind" ~typ:(non_null kind) ~args:[] ~doc:"String describing the kind of user command" ~resolve:(fun _ cmd -> to_kind cmd.With_hash.data) @@ -1499,30 +1502,30 @@ module Types = struct ~resolve:(fun _ payment -> Signed_command_payload.nonce @@ Signed_command.payload payment.With_hash.data - |> Account.Nonce.to_int) + |> Account.Nonce.to_int ) ; field_no_status "source" ~typ:(non_null AccountObj.account) ~args:[] ~doc:"Account that the command is sent from" ~resolve:(fun { ctx = coda; _ } cmd -> AccountObj.get_best_ledger_account coda - (Signed_command.source cmd.With_hash.data)) + (Signed_command.source cmd.With_hash.data) ) ; field_no_status "receiver" ~typ:(non_null AccountObj.account) ~args:[] ~doc:"Account that the command applies to" ~resolve:(fun { ctx = coda; _ } cmd -> AccountObj.get_best_ledger_account coda - (Signed_command.receiver cmd.With_hash.data)) + (Signed_command.receiver cmd.With_hash.data) ) ; field_no_status "feePayer" ~typ:(non_null AccountObj.account) ~args:[] ~doc:"Account that pays the fees for the command" ~resolve:(fun { ctx = coda; _ } cmd -> AccountObj.get_best_ledger_account coda - (Signed_command.fee_payer cmd.With_hash.data)) + (Signed_command.fee_payer cmd.With_hash.data) ) ; field_no_status "validUntil" ~typ:(non_null uint32) ~args:[] ~doc: "The global slot number after which this transaction cannot be \ applied" ~resolve:(fun _ cmd -> - Signed_command.valid_until cmd.With_hash.data) + Signed_command.valid_until cmd.With_hash.data ) ; field_no_status "token" ~typ:(non_null token_id) ~args:[] ~doc:"Token used for the transaction" ~resolve:(fun _ cmd -> - Signed_command.token cmd.With_hash.data) + Signed_command.token cmd.With_hash.data ) ; field_no_status "amount" ~typ:(non_null uint64) ~args:[] ~doc: "Amount that the source is sending to receiver; 0 for commands \ @@ -1531,26 +1534,26 @@ module Types = struct | Some amount -> Currency.Amount.to_uint64 amount | None -> - Unsigned.UInt64.zero) + Unsigned.UInt64.zero ) ; field_no_status "feeToken" ~typ:(non_null token_id) ~args:[] ~doc:"Token used to pay the fee" ~resolve:(fun _ cmd -> - Signed_command.fee_token cmd.With_hash.data) + Signed_command.fee_token cmd.With_hash.data ) ; field_no_status "fee" ~typ:(non_null uint64) ~args:[] ~doc: "Fee that the fee-payer is willing to pay for making the \ transaction" ~resolve:(fun _ cmd -> - Signed_command.fee cmd.With_hash.data |> Currency.Fee.to_uint64) + Signed_command.fee cmd.With_hash.data |> Currency.Fee.to_uint64 ) ; field_no_status "memo" ~typ:(non_null string) ~args:[] ~doc: (sprintf "A short message from the sender, encoded with Base58Check, \ version byte=0x%02X; byte 2 of the decoding is the message \ length" - (Char.to_int Base58_check.Version_bytes.user_command_memo)) + (Char.to_int Base58_check.Version_bytes.user_command_memo) ) ~resolve:(fun _ payment -> Signed_command_payload.memo @@ Signed_command.payload payment.With_hash.data - |> Signed_command_memo.to_base58_check) + |> Signed_command_memo.to_base58_check ) ; field_no_status "isDelegation" ~typ:(non_null bool) ~args:[] ~doc:"If true, this command represents a delegation of stake" ~deprecated:(Deprecated (Some "use kind field instead")) @@ -1562,7 +1565,7 @@ module Types = struct | Stake_delegation _ -> true | _ -> - false) + false ) ; field_no_status "from" ~typ:(non_null public_key) ~args:[] ~doc:"Public key of the sender" ~deprecated:(Deprecated (Some "use feePayer field instead")) @@ -1572,7 +1575,7 @@ module Types = struct ~deprecated:(Deprecated (Some "use feePayer field instead")) ~resolve:(fun { ctx = coda; _ } payment -> AccountObj.get_best_ledger_account coda - @@ Signed_command.fee_payer payment.With_hash.data) + @@ Signed_command.fee_payer payment.With_hash.data ) ; field_no_status "to" ~typ:(non_null public_key) ~args:[] ~doc:"Public key of the receiver" ~deprecated:(Deprecated (Some "use receiver field instead")) @@ -1584,7 +1587,7 @@ module Types = struct ~args:Arg.[] ~resolve:(fun { ctx = coda; _ } cmd -> AccountObj.get_best_ledger_account coda - @@ Signed_command.receiver cmd.With_hash.data) + @@ Signed_command.receiver cmd.With_hash.data ) ; field "failureReason" ~typ:string ~args:[] ~doc: "null is no failure or status unknown, reason for failure \ @@ -1594,7 +1597,7 @@ module Types = struct None | Included_but_failed failures -> List.concat failures |> List.hd - |> Option.map ~f:Transaction_status.Failure.to_string) + |> Option.map ~f:Transaction_status.Failure.to_string ) ] let payment = @@ -1607,12 +1610,12 @@ module Types = struct field_no_status "delegator" ~typ:(non_null AccountObj.account) ~args:[] ~resolve:(fun { ctx = coda; _ } cmd -> AccountObj.get_best_ledger_account coda - (Signed_command.source cmd.With_hash.data)) + (Signed_command.source cmd.With_hash.data) ) :: field_no_status "delegatee" ~typ:(non_null AccountObj.account) ~args:[] ~resolve:(fun { ctx = coda; _ } cmd -> AccountObj.get_best_ledger_account coda - (Signed_command.receiver cmd.With_hash.data)) - :: user_command_shared_fields) + (Signed_command.receiver cmd.With_hash.data) ) + :: user_command_shared_fields ) let mk_stake_delegation = add_type user_command_interface stake_delegation @@ -1639,7 +1642,7 @@ module Types = struct let field_no_status ?doc ?deprecated lab ~typ ~args ~resolve = field ?doc ?deprecated lab ~typ ~args ~resolve:(fun c cmd -> - resolve c cmd.With_status.data) + resolve c cmd.With_status.data ) let zkapp_command = let conv (x : (Mina_lib.t, Parties.t) Fields_derivers_graphql.Schema.typ) @@ -1650,11 +1653,11 @@ module Types = struct [ field_no_status "id" ~doc:"A Base58Check string representing the command" ~typ:(non_null guid) ~args:[] ~resolve:(fun _ parties -> - Parties.to_base58_check parties.With_hash.data) + Parties.to_base58_check parties.With_hash.data ) ; field_no_status "hash" ~doc:"A cryptographic hash of the zkApp command" ~typ:(non_null string) ~args:[] ~resolve:(fun _ parties -> - Transaction_hash.to_base58_check parties.With_hash.hash) + Transaction_hash.to_base58_check parties.With_hash.hash ) ; field_no_status "parties" ~typ:(Parties.typ () |> conv) ~args:Arg.[] @@ -1672,8 +1675,8 @@ module Types = struct Some (List.map (Transaction_status.Failure.Collection.to_display - failures) ~f:(fun f -> Some f))) - ]) + failures ) ~f:(fun f -> Some f) ) ) + ] ) end let transactions = @@ -1699,9 +1702,9 @@ module Types = struct in Some (User_command.mk_user_command - { status; data = { t.data with data = c } }) + { status; data = { t.data with data = c } } ) | Parties _ -> - None)) + None ) ) ; field "zkappCommands" ~doc:"List of zkApp commands included in this block" ~typ:(non_null @@ list @@ non_null Zkapp_command.zkapp_command) @@ -1722,7 +1725,7 @@ module Types = struct Some { Zkapp_command.With_status.status ; data = { t.data with data = parties } - })) + } ) ) ; field "feeTransfer" ~doc:"List of fee transfers included in this block" ~typ:(non_null @@ list @@ non_null fee_transfer) @@ -1732,15 +1735,15 @@ module Types = struct ~doc:"Amount of MINA granted to the producer of this block" ~args:Arg.[] ~resolve:(fun _ { coinbase; _ } -> - Currency.Amount.to_uint64 coinbase) + Currency.Amount.to_uint64 coinbase ) ; field "coinbaseReceiverAccount" ~typ:AccountObj.account ~doc:"Account to which the coinbase for this block was granted" ~args:Arg.[] ~resolve:(fun { ctx = coda; _ } { coinbase_receiver; _ } -> Option.map ~f:(AccountObj.get_best_ledger_account_pk coda) - coinbase_receiver) - ]) + coinbase_receiver ) + ] ) let protocol_state_proof : (Mina_lib.t, Proof.t option) typ = obj "protocolStateProof" ~fields:(fun _ -> @@ -1748,12 +1751,12 @@ module Types = struct ~args:Arg.[] ~resolve:(fun _ proof -> (* Use the precomputed block proof encoding, for consistency. *) - Some (Mina_block.Precomputed.Proof.to_bin_string proof)) + Some (Mina_block.Precomputed.Proof.to_bin_string proof) ) ; field "json" ~typ:json ~doc:"JSON-encoded proof" ~args:Arg.[] ~resolve:(fun _ proof -> - Some (Yojson.Safe.to_basic (Proof.to_yojson_full proof))) - ]) + Some (Yojson.Safe.to_basic (Proof.to_yojson_full proof)) ) + ] ) let block : ( Mina_lib.t @@ -1771,28 +1774,28 @@ module Types = struct ~doc:"Account that produced this block" ~args:Arg.[] ~resolve:(fun { ctx = coda; _ } { With_hash.data; _ } -> - AccountObj.get_best_ledger_account_pk coda data.creator) + AccountObj.get_best_ledger_account_pk coda data.creator ) ; field "winnerAccount" ~typ:(non_null AccountObj.account) ~doc:"Account that won the slot (Delegator/Staker)" ~args:Arg.[] ~resolve:(fun { ctx = coda; _ } { With_hash.data; _ } -> - AccountObj.get_best_ledger_account_pk coda data.winner) + AccountObj.get_best_ledger_account_pk coda data.winner ) ; field "stateHash" ~typ:(non_null string) ~doc:"Base58Check-encoded hash of the state after this block" ~args:Arg.[] ~resolve:(fun _ { With_hash.hash; _ } -> - State_hash.to_base58_check hash) + State_hash.to_base58_check hash ) ; field "stateHashField" ~typ:(non_null string) ~doc: "Experimental: Bigint field-element representation of stateHash" ~args:Arg.[] ~resolve:(fun _ { With_hash.hash; _ } -> - State_hash.to_decimal_string hash) + State_hash.to_decimal_string hash ) ; field "protocolState" ~typ:(non_null protocol_state) ~args:Arg.[] ~resolve:(fun _ { With_hash.data; With_hash.hash; _ } -> - (data.protocol_state, hash)) + (data.protocol_state, hash) ) ; field "protocolStateProof" ~typ:(non_null protocol_state_proof) ~doc:"Snark proof of blockchain state" @@ -1805,12 +1808,12 @@ module Types = struct ~doc:"Count of user command transactions in the block" ~args:Arg.[] ~resolve:(fun _ { With_hash.data; _ } -> - List.length data.transactions.commands) + List.length data.transactions.commands ) ; field "snarkJobs" ~typ:(non_null @@ list @@ non_null completed_work) ~args:Arg.[] ~resolve:(fun _ { With_hash.data; _ } -> data.snark_jobs) - ]) + ] ) let snark_worker = obj "SnarkWorker" ~fields:(fun _ -> @@ -1824,13 +1827,13 @@ module Types = struct ~doc:"Account of the current snark worker" ~args:Arg.[] ~resolve:(fun { ctx = coda; _ } (key, _) -> - AccountObj.get_best_ledger_account_pk coda key) + AccountObj.get_best_ledger_account_pk coda key ) ; field "fee" ~typ:(non_null uint64) ~doc:"Fee that snark worker is charging to generate a snark proof" ~args:Arg.[] ~resolve:(fun (_ : Mina_lib.t resolve_info) (_, fee) -> - Currency.Fee.to_uint64 fee) - ]) + Currency.Fee.to_uint64 fee ) + ] ) module Payload = struct let peer : ('context, Network_peer.Peer.t option) typ = @@ -1842,11 +1845,11 @@ module Types = struct ~typ:(non_null string) ~args:Arg.[] ~resolve:(fun _ peer -> - Unix.Inet_addr.to_string peer.Network_peer.Peer.host) + Unix.Inet_addr.to_string peer.Network_peer.Peer.host ) ; field "libp2pPort" ~typ:(non_null int) ~args:Arg.[] ~resolve:(fun _ peer -> peer.Network_peer.Peer.libp2p_port) - ]) + ] ) let create_account : (Mina_lib.t, Account.key option) typ = obj "AddAccountPayload" ~fields:(fun _ -> @@ -1860,8 +1863,8 @@ module Types = struct ~doc:"Details of created account" ~args:Arg.[] ~resolve:(fun { ctx = coda; _ } key -> - AccountObj.get_best_ledger_account_pk coda key) - ]) + AccountObj.get_best_ledger_account_pk coda key ) + ] ) let unlock_account : (Mina_lib.t, Account.key option) typ = obj "UnlockPayload" ~fields:(fun _ -> @@ -1875,8 +1878,8 @@ module Types = struct ~doc:"Details of unlocked account" ~args:Arg.[] ~resolve:(fun { ctx = coda; _ } key -> - AccountObj.get_best_ledger_account_pk coda key) - ]) + AccountObj.get_best_ledger_account_pk coda key ) + ] ) let lock_account : (Mina_lib.t, Account.key option) typ = obj "LockPayload" ~fields:(fun _ -> @@ -1889,8 +1892,8 @@ module Types = struct ~doc:"Details of locked account" ~args:Arg.[] ~resolve:(fun { ctx = coda; _ } key -> - AccountObj.get_best_ledger_account_pk coda key) - ]) + AccountObj.get_best_ledger_account_pk coda key ) + ] ) let delete_account = obj "DeleteAccountPayload" ~fields:(fun _ -> @@ -1898,7 +1901,7 @@ module Types = struct ~doc:"Public key of the deleted account" ~args:Arg.[] ~resolve:(fun _ -> Fn.id) - ]) + ] ) let reload_accounts = obj "ReloadAccountsPayload" ~fields:(fun _ -> @@ -1906,7 +1909,7 @@ module Types = struct ~doc:"True when the reload was successful" ~args:Arg.[] ~resolve:(fun _ -> Fn.id) - ]) + ] ) let import_account = obj "ImportAccountPayload" ~fields:(fun _ -> @@ -1922,7 +1925,7 @@ module Types = struct ; field "success" ~typ:(non_null bool) ~args:Arg.[] ~resolve:(fun _ _ -> true) - ]) + ] ) let string_of_banned_status = function | Trust_system.Banned_status.Unbanned -> @@ -1936,7 +1939,7 @@ module Types = struct [ field "ipAddr" ~typ:(non_null string) ~doc:"IP address" ~args:Arg.[] ~resolve:(fun _ (peer, _) -> - Unix.Inet_addr.to_string peer.Network_peer.Peer.host) + Unix.Inet_addr.to_string peer.Network_peer.Peer.host ) ; field "peerId" ~typ:(non_null string) ~doc:"libp2p Peer ID" ~args:Arg.[] ~resolve:(fun _ (peer, __) -> peer.Network_peer.Peer.peer_id) @@ -1946,8 +1949,8 @@ module Types = struct ; field "bannedStatus" ~typ:string ~doc:"Banned status" ~args:Arg.[] ~resolve:(fun _ (_, { banned; _ }) -> - string_of_banned_status banned) - ]) + string_of_banned_status banned ) + ] ) let send_payment = obj "SendPaymentPayload" ~fields:(fun _ -> @@ -1956,7 +1959,7 @@ module Types = struct ~doc:"Payment that was sent" ~args:Arg.[] ~resolve:(fun _ -> Fn.id) - ]) + ] ) let send_delegation = obj "SendDelegationPayload" ~fields:(fun _ -> @@ -1965,7 +1968,7 @@ module Types = struct ~doc:"Delegation change that was sent" ~args:Arg.[] ~resolve:(fun _ -> Fn.id) - ]) + ] ) let send_zkapp = obj "SendZkappPayload" ~fields:(fun _ -> @@ -1974,7 +1977,7 @@ module Types = struct ~doc:"zkApp transaction that was sent" ~args:Arg.[] ~resolve:(fun _ -> Fn.id) - ]) + ] ) let send_rosetta_transaction = obj "SendRosettaTransactionPayload" ~fields:(fun _ -> @@ -1983,7 +1986,7 @@ module Types = struct ~doc:"Command that was sent" ~args:Arg.[] ~resolve:(fun _ -> Fn.id) - ]) + ] ) let export_logs = obj "ExportLogsPayload" ~fields:(fun _ -> @@ -1993,11 +1996,11 @@ module Types = struct (obj "TarFile" ~fields:(fun _ -> [ field "tarfile" ~typ:(non_null string) ~args:[] ~resolve:(fun _ basename -> basename) - ]))) + ] ) ) ) ~doc:"Tar archive containing logs" ~args:Arg.[] ~resolve:(fun _ -> Fn.id) - ]) + ] ) let add_payment_receipt = obj "AddPaymentReceiptPayload" ~fields:(fun _ -> @@ -2005,7 +2008,7 @@ module Types = struct ~typ:(non_null User_command.user_command) ~args:Arg.[] ~resolve:(fun _ -> Fn.id) - ]) + ] ) let set_coinbase_receiver = obj "SetCoinbaseReceiverPayload" ~fields:(fun _ -> @@ -2023,7 +2026,7 @@ module Types = struct ~typ:public_key ~args:Arg.[] ~resolve:(fun _ (_, current_receiver) -> current_receiver) - ]) + ] ) let set_snark_work_fee = obj "SetSnarkWorkFeePayload" ~fields:(fun _ -> @@ -2031,7 +2034,7 @@ module Types = struct ~typ:(non_null uint64) ~args:Arg.[] ~resolve:(fun _ -> Fn.id) - ]) + ] ) let set_snark_worker = obj "SetSnarkWorkerPayload" ~fields:(fun _ -> @@ -2041,7 +2044,7 @@ module Types = struct ~typ:public_key ~args:Arg.[] ~resolve:(fun _ -> Fn.id) - ]) + ] ) let set_connection_gating_config = obj "SetConnectionGatingConfigPayload" ~fields:(fun _ -> @@ -2063,7 +2066,7 @@ module Types = struct a trusted peer" ~args:Arg.[] ~resolve:(fun _ config -> config.Mina_net2.isolate) - ]) + ] ) end module Arguments = struct @@ -2083,7 +2086,7 @@ module Types = struct Ok Network_peer.Peer. { peer_id; host = Unix.Inet_addr.of_string host; libp2p_port } - with _ -> Error "Invalid format for NetworkPeer.host") + with _ -> Error "Invalid format for NetworkPeer.host" ) ~fields: [ arg "peerId" ~doc:"base58-encoded peer ID" ~typ:(non_null string) ; arg "host" ~doc:"IP address of the remote host" @@ -2100,7 +2103,7 @@ module Types = struct (Public_key.Compressed.of_base58_check s) ~f:Error.to_string_hum | _ -> - Error "Expected public key as a string in Base58Check format") + Error "Expected public key as a string in Base58Check format" ) let private_key_arg = scalar "PrivateKey" ~doc:"Base58Check-encoded private key" @@ -2115,7 +2118,7 @@ module Types = struct Ok (Token_id.of_string token) | _ -> Error "Invalid format for token." - with _ -> Error "Invalid format for token.") + with _ -> Error "Invalid format for token." ) let sign = enum "Sign" @@ -2130,7 +2133,7 @@ module Types = struct | `String s -> Ok (Snark_params.Tick.Field.of_string s) | _ -> - Error "Expected a string representing a field element") + Error "Expected a string representing a field element" ) let nonce = scalar "Nonce" ~coerce:(fun nonce -> @@ -2142,7 +2145,7 @@ module Types = struct Ok (Mina_base.Account.Nonce.of_string s) | _ -> Error "Expected string for nonce" - with exn -> Error (Exn.to_string exn)) + with exn -> Error (Exn.to_string exn) ) let snarked_ledger_hash = scalar "SnarkedLedgerHash" ~coerce:(fun hash -> @@ -2152,7 +2155,7 @@ module Types = struct (Frozen_ledger_hash.of_base58_check s) ~f:Error.to_string_hum | _ -> - Error "Expected snarked ledger hash in Base58Check format") + Error "Expected snarked ledger hash in Base58Check format" ) let block_time = scalar "BlockTime" ~coerce:(fun block_time -> @@ -2164,7 +2167,7 @@ module Types = struct Ok (Block_time.of_string_exn s) with exn -> Error (Exn.to_string exn) ) | _ -> - Error "Expected string for block time") + Error "Expected string for block time" ) let length = scalar "Length" ~coerce:(fun length -> @@ -2176,7 +2179,7 @@ module Types = struct Ok (Mina_numbers.Length.of_string s) with exn -> Error (Exn.to_string exn) ) | _ -> - Error "Expected string for length") + Error "Expected string for length" ) let currency_amount = scalar "CurrencyAmount" ~coerce:(fun amt -> @@ -2185,7 +2188,7 @@ module Types = struct try Ok (Currency.Amount.of_string s) with exn -> Error (Exn.to_string exn) ) | _ -> - Error "Expected string for currency amount") + Error "Expected string for currency amount" ) let fee = scalar "Fee" ~coerce:(fun fee -> @@ -2194,26 +2197,26 @@ module Types = struct try Ok (Currency.Fee.of_string s) with exn -> Error (Exn.to_string exn) ) | _ -> - Error "Expected string for fee") + Error "Expected string for fee" ) let internal_send_zkapp = scalar "SendTestZkappInput" ~doc:"Parties for a test zkApp" ~coerce:(fun json -> let json = to_yojson json in Result.try_with (fun () -> Mina_base.Parties.of_json json) - |> Result.map_error ~f:(fun ex -> Exn.to_string ex)) + |> Result.map_error ~f:(fun ex -> Exn.to_string ex) ) let precomputed_block = scalar "PrecomputedBlock" ~doc:"Block encoded in precomputed block format" ~coerce:(fun json -> let json = to_yojson json in - Mina_block.Precomputed.of_yojson json) + Mina_block.Precomputed.of_yojson json ) let extensional_block = scalar "ExtensionalBlock" ~doc:"Block encoded in extensional block format" ~coerce:(fun json -> let json = to_yojson json in - Archive_lib.Extensional.Block.of_yojson json) + Archive_lib.Extensional.Block.of_yojson json ) module type Numeric_type = sig type t @@ -2234,7 +2237,7 @@ module Types = struct (sprintf "String or Integer representation of a %s number. If the input is \ a string, it must represent the number in base 10" - lower_name) ~coerce:(fun key -> + lower_name ) ~coerce:(fun key -> match key with | `String s -> ( try @@ -2272,11 +2275,10 @@ module Types = struct | `Int n -> if n < 0 then Error - (sprintf "Could not convert negative number to %s." - lower_name) + (sprintf "Could not convert negative number to %s." lower_name) else Ok (Numeric.of_int n) | _ -> - Error (sprintf "Invalid format for %s type." lower_name)) + Error (sprintf "Invalid format for %s type." lower_name) ) let uint64_arg = make_numeric_arg ~name:"UInt64" (module Unsigned.UInt64) @@ -2296,7 +2298,8 @@ module Types = struct | Some field, Some scalar -> Ok (Field.of_string field, Inner_curve.Scalar.of_string scalar) | _ -> - Error "Either field+scalar or rawSignature must by non-null" )) + Error "Either field+scalar or rawSignature must by non-null" ) + ) ~doc: "A cryptographic signature -- you must provide either field+scalar \ or rawSignature" @@ -2312,7 +2315,7 @@ module Types = struct { Consensus_vrf.Layout.Message.global_slot ; epoch_seed = Mina_base.Epoch_seed.of_base58_check_exn epoch_seed ; delegator_index - }) + } ) ~fields: [ arg "globalSlot" ~typ:(non_null uint32_arg) ; arg "epochSeed" ~doc:"Formatted with base58check" @@ -2331,7 +2334,7 @@ module Types = struct { Consensus_vrf.Layout.Threshold.delegated_stake = Currency.Balance.of_uint64 delegated_stake ; total_stake = Currency.Amount.of_uint64 total_stake - }) + } ) ~fields: [ arg "delegatedStake" ~doc: @@ -2360,7 +2363,7 @@ module Types = struct ; vrf_output = None ; vrf_output_fractional = None ; threshold_met = None - }) + } ) ~fields: [ arg "message" ~typ:(non_null vrf_message) ; arg "publicKey" ~typ:(non_null public_key_arg) @@ -2433,7 +2436,7 @@ module Types = struct let open Fields in obj "SendPaymentInput" ~coerce:(fun from to_ amount fee valid_until memo nonce -> - (from, to_, amount, fee, valid_until, memo, nonce)) + (from, to_, amount, fee, valid_until, memo, nonce) ) ~fields: [ from ~doc:"Public key of sender of payment" ; to_ ~doc:"Public key of recipient of payment" @@ -2459,7 +2462,7 @@ module Types = struct let open Fields in obj "SendDelegationInput" ~coerce:(fun from to_ fee valid_until memo nonce -> - (from, to_, fee, valid_until, memo, nonce)) + (from, to_, fee, valid_until, memo, nonce) ) ~fields: [ from ~doc:"Public key of sender of a stake delegation" ; to_ ~doc:"Public key of the account being delegated to" @@ -2474,7 +2477,7 @@ module Types = struct ~doc:"A transaction encoded in the Rosetta format" ~coerce:(fun graphql_json -> Rosetta_lib.Transaction.to_mina_signed (to_yojson graphql_json) - |> Result.map_error ~f:Error.to_string_hum) + |> Result.map_error ~f:Error.to_string_hum ) let create_account = obj "AddAccountInput" ~coerce:Fn.id @@ -2578,7 +2581,7 @@ module Types = struct ~doc: (Doc.date "Time that a payment gets added to another clients \ - transaction database") + transaction database" ) ] end @@ -2588,7 +2591,7 @@ module Types = struct let open Result.Let_syntax in let%bind trusted_peers = Result.all trusted_peers in let%map banned_peers = Result.all banned_peers in - Mina_net2.{ isolate; trusted_peers; banned_peers }) + Mina_net2.{ isolate; trusted_peers; banned_peers } ) ~fields: Arg. [ arg "trustedPeers" @@ -2620,7 +2623,7 @@ module Types = struct ~typ:(non_null int) ~args:Arg.[] ~resolve:(fun _ { delegator_index; _ } -> delegator_index) - ]) + ] ) let vrf_threshold = obj "VrfThreshold" @@ -2636,14 +2639,14 @@ module Types = struct ~resolve:(fun _ { Consensus_vrf.Layout.Threshold.delegated_stake; _ } - -> Currency.Balance.to_uint64 delegated_stake) + -> Currency.Balance.to_uint64 delegated_stake ) ; field "totalStake" ~doc: "The total amount of stake across all accounts in the epoch's \ staking ledger." ~args:[] ~typ:(non_null uint64) ~resolve:(fun _ { Consensus_vrf.Layout.Threshold.total_stake; _ } -> - Currency.Amount.to_uint64 total_stake) - ]) + Currency.Amount.to_uint64 total_stake ) + ] ) let vrf_evaluation : ('context, Consensus_vrf.Layout.Evaluation.t option) typ = @@ -2668,7 +2671,7 @@ module Types = struct ~doc:"A group element represented as 2 field elements" ~args:Arg.[] ~resolve:(fun _ { scaled_message_hash; _ } -> - Consensus_vrf.Group.to_string_list_exn scaled_message_hash) + Consensus_vrf.Group.to_string_list_exn scaled_message_hash ) ; field "vrfThreshold" ~typ:vrf_threshold ~args:Arg.[] ~resolve:(fun _ { vrf_threshold; _ } -> vrf_threshold) @@ -2691,7 +2694,7 @@ module Types = struct |> Option.map ~f:Consensus_vrf.Output.truncate in Option.map ~f:Consensus_vrf.Output.Truncated.to_base58_check - vrf_opt) + vrf_opt ) ; field "vrfOutputFractional" ~typ:float ~doc: "The vrf output derived from the evaluation witness, as a \ @@ -2719,8 +2722,8 @@ module Types = struct Option.map ~f:(fun vrf -> Consensus_vrf.Output.Truncated.to_fraction vrf - |> Bignum.to_float) - vrf_opt) + |> Bignum.to_float ) + vrf_opt ) ; field "thresholdMet" ~typ:bool ~doc: "Whether the threshold to produce a block was met, if specified" @@ -2737,11 +2740,11 @@ module Types = struct .constraint_constants in (Consensus_vrf.Layout.Evaluation.compute_vrf - ~constraint_constants t ~delegated_stake ~total_stake) + ~constraint_constants t ~delegated_stake ~total_stake ) .threshold_met | None -> - t.threshold_met) - ]) + t.threshold_met ) + ] ) end module Subscriptions = struct @@ -2755,7 +2758,7 @@ module Subscriptions = struct ~args:Arg.[] ~resolve:(fun { ctx = coda; _ } -> Mina_lib.sync_status coda |> Mina_incremental.Status.to_pipe - |> Deferred.Result.return) + |> Deferred.Result.return ) let new_block = subscription_field "newBlock" @@ -2772,7 +2775,7 @@ module Subscriptions = struct ] ~resolve:(fun { ctx = coda; _ } public_key -> Deferred.Result.return - @@ Mina_commands.Subscriptions.new_block coda public_key) + @@ Mina_commands.Subscriptions.new_block coda public_key ) let chain_reorganization = subscription_field "chainReorganization" @@ -2783,7 +2786,7 @@ module Subscriptions = struct ~args:Arg.[] ~resolve:(fun { ctx = coda; _ } -> Deferred.Result.return - @@ Mina_commands.Subscriptions.reorganization coda) + @@ Mina_commands.Subscriptions.reorganization coda ) let commands = [ new_sync_update; new_block; chain_reorganization ] end @@ -2822,7 +2825,7 @@ module Mutations = struct ~typ:(non_null Types.Payload.create_account) ~args:Arg.[ arg "input" ~typ:(non_null Types.Input.create_hd_account) ] ~resolve:(fun { ctx = coda; _ } () hd_index -> - Mina_lib.wallets coda |> Secrets.Wallets.create_hd_account ~hd_index) + Mina_lib.wallets coda |> Secrets.Wallets.create_hd_account ~hd_index ) let unlock_account_resolver { ctx = t; _ } () (password, pk) = let password = lazy (return (Bytes.of_string password)) in @@ -2836,7 +2839,7 @@ module Mutations = struct | Error (`Key_read_error e) -> Error (sprintf "Error reading the secret key file: %s" - (Secrets.Privkey_error.to_string e)) + (Secrets.Privkey_error.to_string e) ) | Ok () -> Ok pk @@ -2879,8 +2882,7 @@ module Mutations = struct let wallets = Mina_lib.wallets coda in let%map () = Deferred.Result.map_error - ~f:(fun `Not_found -> - "Could not find account with specified public key") + ~f:(fun `Not_found -> "Could not find account with specified public key") (Secrets.Wallets.delete wallets public_key) in public_key @@ -2956,7 +2958,7 @@ module Mutations = struct Secrets.Wallets.import_keypair wallets keypair ~password:saved_password in - Ok (pk, false)) + Ok (pk, false) ) let reset_trust_status = io_field "resetTrustStatus" @@ -2969,7 +2971,7 @@ module Mutations = struct Deferred.return @@ Types.Arguments.ip_address ~name:"ip_address" ip_address_input in - Some (Mina_commands.reset_trust_status coda ip_address)) + Some (Mina_commands.reset_trust_status coda ip_address) ) let send_user_command coda user_command_input = match @@ -3003,13 +3005,13 @@ module Mutations = struct Types.Zkapp_command.With_status.map cmd ~f:(fun cmd -> { With_hash.data = cmd ; hash = Transaction_hash.hash_command (Parties cmd) - }) + } ) in Ok cmd_with_hash | Error e -> Error - (sprintf "Couldn't send zkApp command: %s" - (Error.to_string_hum e)) ) + (sprintf "Couldn't send zkApp command: %s" (Error.to_string_hum e)) + ) | `Bootstrapping -> return (Error "Daemon is bootstrapping") @@ -3060,7 +3062,7 @@ module Mutations = struct [%sexp_of: (string * Signature_lib.Public_key.Compressed.t) * (string * Token_id.t)] - |> Error.raise) ; + |> Error.raise ) ; match Pipe_lib.Broadcast_pipe.Reader.peek (Mina_lib.transition_frontier mina) @@ -3107,7 +3109,7 @@ module Mutations = struct Included_but_failed failure in ( { data = with_hash; status } - : _ Types.Zkapp_command.With_status.t )) + : _ Types.Zkapp_command.With_status.t ) ) in return @@ Result.map_error applied_ok ~f:Error.to_string_hum ) ) | `Bootstrapping -> @@ -3140,13 +3142,13 @@ module Mutations = struct (sprintf !"Invalid user command. Fee %s is less than the minimum fee, %s." (Currency.Fee.to_formatted_string fee) - (Currency.Fee.to_formatted_string Signed_command.minimum_fee)) + (Currency.Fee.to_formatted_string Signed_command.minimum_fee) ) in let%map memo = Option.value_map memo ~default:(Ok Signed_command_memo.empty) ~f:(fun memo -> result_of_exn Signed_command_memo.create_from_string_exn memo - ~error:"Invalid `memo` provided.") + ~error:"Invalid `memo` provided." ) in User_command_input.create ~signer ~fee ~fee_payer_pk ?nonce:nonce_opt ~valid_until ~memo ~body ~sign_choice () @@ -3174,7 +3176,7 @@ module Mutations = struct Types.User_command.With_status.map cmd ~f:(fun cmd -> { With_hash.data = cmd ; hash = Transaction_hash.hash_command (Signed_command cmd) - }) + } ) let send_unsigned_user_command ~coda ~nonce_opt ~signer ~memo ~fee ~fee_payer_pk ~valid_until ~body = @@ -3196,7 +3198,7 @@ module Mutations = struct Types.User_command.With_status.map cmd ~f:(fun cmd -> { With_hash.data = cmd ; hash = Transaction_hash.hash_command (Signed_command cmd) - }) + } ) let export_logs ~coda basename_opt = let open Mina_lib in @@ -3212,9 +3214,8 @@ module Mutations = struct [ arg "input" ~typ:(non_null Types.Input.send_delegation) ; Types.Input.Fields.signature ] - ~resolve: - (fun { ctx = coda; _ } () (from, to_, fee, valid_until, memo, nonce_opt) - signature -> + ~resolve:(fun { ctx = coda; _ } () + (from, to_, fee, valid_until, memo, nonce_opt) signature -> let body = Signed_command_payload.Body.Stake_delegation (Set_delegate { delegator = from; new_delegate = to_ }) @@ -3228,7 +3229,7 @@ module Mutations = struct let%bind signature = signature |> Deferred.return in send_signed_user_command ~coda ~nonce_opt ~signer:from ~memo ~fee ~fee_payer_pk:from ~valid_until ~body ~signature - |> Deferred.Result.map ~f:Types.User_command.mk_user_command) + |> Deferred.Result.map ~f:Types.User_command.mk_user_command ) let send_payment = io_field "sendPayment" ~doc:"Send a payment" @@ -3238,9 +3239,9 @@ module Mutations = struct [ arg "input" ~typ:(non_null Types.Input.send_payment) ; Types.Input.Fields.signature ] - ~resolve: - (fun { ctx = coda; _ } () - (from, to_, amount, fee, valid_until, memo, nonce_opt) signature -> + ~resolve:(fun { ctx = coda; _ } () + (from, to_, amount, fee, valid_until, memo, nonce_opt) + signature -> let body = Signed_command_payload.Body.Payment { source_pk = from @@ -3256,14 +3257,14 @@ module Mutations = struct | Some signature -> send_signed_user_command ~coda ~nonce_opt ~signer:from ~memo ~fee ~fee_payer_pk:from ~valid_until ~body ~signature - |> Deferred.Result.map ~f:Types.User_command.mk_user_command) + |> Deferred.Result.map ~f:Types.User_command.mk_user_command ) let make_zkapp_endpoint ~name ~doc ~f = io_field name ~doc ~typ:(non_null Types.Payload.send_zkapp) ~args:Arg.[ arg "input" ~typ:(non_null Types.Input.send_zkapp) ] ~resolve:(fun { ctx = coda; _ } () parties -> - f coda parties (* TODO: error handling? *)) + f coda parties (* TODO: error handling? *) ) let send_zkapp = make_zkapp_endpoint ~name:"sendZkapp" ~doc:"Send a zkApp transaction" @@ -3281,7 +3282,7 @@ module Mutations = struct Arg.[ arg "parties" ~typ:(non_null Types.Input.internal_send_zkapp) ] ~typ:(non_null Types.Payload.send_zkapp) ~resolve:(fun { ctx = mina; _ } () parties -> - send_zkapp_command mina parties) + send_zkapp_command mina parties ) let send_test_payments = io_field "sendTestPayments" ~doc:"Send a series of test payments" @@ -3295,9 +3296,8 @@ module Mutations = struct ; repeat_count ; repeat_delay_ms ] - ~resolve: - (fun { ctx = coda; _ } () senders_list receiver_pk amount fee - repeat_count repeat_delay_ms -> + ~resolve:(fun { ctx = coda; _ } () senders_list receiver_pk amount fee + repeat_count repeat_delay_ms -> let dumb_password = lazy (return (Bytes.of_string "dumb")) in let senders = Array.of_list senders_list in let repeat_delay = @@ -3347,7 +3347,7 @@ module Mutations = struct don't_wait_for (do_ i) done ; (* don't_wait_for (Deferred.for_ 2 ~to_:repeat_count ~do_) ; *) - send_tx 1) + send_tx 1 ) let send_rosetta_transaction = io_field "sendRosettaTransaction" @@ -3368,7 +3368,7 @@ module Mutations = struct { With_hash.data = signed_command ; hash = Transaction_hash.hash_command transaction } - }) + } ) | Error err -> Error (Error.to_string_hum err) | Ok ([], [ (_, diff_error) ]) -> @@ -3378,9 +3378,10 @@ module Mutations = struct in Error (sprintf "Transaction could not be entered into the pool: %s" - diff_error) + diff_error ) | Ok _ -> - Error "Internal error: response from transaction pool was malformed") + Error "Internal error: response from transaction pool was malformed" + ) let export_logs = io_field "exportLogs" ~doc:"Export daemon logs to tar archive" @@ -3389,7 +3390,7 @@ module Mutations = struct ~resolve:(fun { ctx = coda; _ } () basename_opt -> let%map result = export_logs ~coda basename_opt in Result.map_error result - ~f:(Fn.compose Yojson.Safe.to_string Error_json.error_to_yojson)) + ~f:(Fn.compose Yojson.Safe.to_string Error_json.error_to_yojson) ) let set_coinbase_receiver = field "setCoinbaseReceiver" ~doc:"Set the key to receive coinbases" @@ -3412,7 +3413,7 @@ module Mutations = struct `Other pk in Mina_lib.replace_coinbase_receiver mina coinbase_receiver_full ; - (old_coinbase_receiver, coinbase_receiver)) + (old_coinbase_receiver, coinbase_receiver) ) let set_snark_worker = io_field "setSnarkWorker" @@ -3422,7 +3423,7 @@ module Mutations = struct ~resolve:(fun { ctx = coda; _ } () pk -> let old_snark_worker_key = Mina_lib.snark_worker_key coda in let%map () = Mina_lib.replace_snark_worker_key coda pk in - Ok old_snark_worker_key) + Ok old_snark_worker_key ) let set_snark_work_fee = result_field "setSnarkWorkFee" @@ -3437,7 +3438,7 @@ module Mutations = struct in let last_fee = Mina_lib.snark_work_fee coda in Mina_lib.set_snark_work_fee coda fee ; - Currency.Fee.to_uint64 last_fee) + Currency.Fee.to_uint64 last_fee ) let set_connection_gating_config = io_field "setConnectionGatingConfig" @@ -3454,7 +3455,7 @@ module Mutations = struct let%bind config = Deferred.return config in let open Deferred.Let_syntax in Mina_networking.set_connection_gating_config (Mina_lib.net coda) config - >>| Result.return) + >>| Result.return ) let add_peer = io_field "addPeers" @@ -3470,7 +3471,7 @@ module Mutations = struct let%bind peers = Result.combine_errors peers |> Result.map_error ~f:(fun errs -> - Option.value ~default:"Empty peers list" (List.hd errs)) + Option.value ~default:"Empty peers list" (List.hd errs) ) |> Deferred.return in let net = Mina_lib.net coda in @@ -3484,7 +3485,7 @@ module Mutations = struct | Ok () -> None | Error err -> - Some (Error (Error.to_string_hum err))) + Some (Error (Error.to_string_hum err)) ) in let%map () = match maybe_failure with @@ -3493,7 +3494,7 @@ module Mutations = struct | Some err -> Deferred.return err in - List.map ~f:Network_peer.Peer.to_display peers) + List.map ~f:Network_peer.Peer.to_display peers ) let archive_precomputed_block = io_field "archivePrecomputedBlock" @@ -3508,7 +3509,7 @@ module Mutations = struct [ field "applied" ~typ:(non_null bool) ~args:Arg.[] ~resolve:(fun _ _ -> true) - ]))) + ] ) ) ) ~resolve:(fun { ctx = coda; _ } () block -> let open Deferred.Result.Let_syntax in let%bind archive_location = @@ -3524,7 +3525,7 @@ module Mutations = struct block |> Deferred.Result.map_error ~f:Error.to_string_hum in - ()) + () ) let archive_extensional_block = io_field "archiveExtensionalBlock" @@ -3539,7 +3540,7 @@ module Mutations = struct [ field "applied" ~typ:(non_null bool) ~args:Arg.[] ~resolve:(fun _ _ -> true) - ]))) + ] ) ) ) ~resolve:(fun { ctx = coda; _ } () block -> let open Deferred.Result.Let_syntax in let%bind archive_location = @@ -3555,7 +3556,7 @@ module Mutations = struct block |> Deferred.Result.map_error ~f:Error.to_string_hum in - ()) + () ) let commands = [ add_wallet @@ -3610,7 +3611,7 @@ module Queries = struct |> Option.bind ~f: (Network_pool.Transaction_pool.Resource_pool - .find_by_hash resource_pool)) + .find_by_hash resource_pool ) ) | None -> [] in @@ -3630,13 +3631,13 @@ module Queries = struct branches above. *) let (`If_this_is_used_it_should_have_a_comment_justifying_it - cmd) = + cmd ) = User_command.to_valid_unsafe (Signed_command signed_command) in Transaction_hash.User_command_with_valid_signature - .create cmd) - |> Result.ok) + .create cmd ) + |> Result.ok ) | None -> [] in @@ -3650,7 +3651,7 @@ module Queries = struct txn |> Transaction_hash.User_command_with_valid_signature.command |> User_command.fee_payer |> Account_id.public_key - |> Public_key.Compressed.equal pk) ) + |> Public_key.Compressed.equal pk ) ) let pooled_user_commands = field "pooledUserCommands" @@ -3686,9 +3687,9 @@ module Queries = struct (Types.User_command.mk_user_command { status = Enqueued ; data = { cmd_with_hash with data = user_cmd } - }) + } ) | Parties _ -> - None)) + None ) ) let pooled_zkapp_commands = field "pooledZkappCommands" @@ -3725,7 +3726,7 @@ module Queries = struct Some { Types.Zkapp_command.With_status.status = Enqueued ; data = { cmd_with_hash with data = zkapp_cmd } - })) + } ) ) let sync_status = io_field "syncStatus" ~doc:"Network sync status" ~args:[] @@ -3737,12 +3738,12 @@ module Queries = struct let%map { sync_status; _ } = Mina_commands.get_status ~flag:`Performance coda in - Ok sync_status) + Ok sync_status ) let daemon_status = io_field "daemonStatus" ~doc:"Get running daemon status" ~args:[] ~typ:(non_null Types.DaemonStatus.t) ~resolve:(fun { ctx = coda; _ } () -> - Mina_commands.get_status ~flag:`Performance coda >>| Result.return) + Mina_commands.get_status ~flag:`Performance coda >>| Result.return ) let trust_status = field "trustStatus" @@ -3754,7 +3755,7 @@ module Queries = struct | Ok ip_addr -> Some (Mina_commands.get_trust_status coda ip_addr) | Error _ -> - None) + None ) let trust_status_all = field "trustStatusAll" @@ -3762,7 +3763,7 @@ module Queries = struct ~args:Arg.[] ~doc:"IP address and trust status for all peers" ~resolve:(fun { ctx = coda; _ } () -> - Mina_commands.get_trust_status_all coda) + Mina_commands.get_trust_status_all coda ) let version = field "version" ~typ:string @@ -3787,10 +3788,10 @@ module Queries = struct | `Active ledger -> Option.try_with (fun () -> Ledger.index_of_account_exn ledger - (Account_id.create pk Token_id.default)) + (Account_id.create pk Token_id.default) ) | _ -> None ) - }) + } ) let owned_wallets = field "ownedWallets" @@ -3810,7 +3811,7 @@ module Queries = struct let account_resolver { ctx = coda; _ } () pk = Some (Types.AccountObj.lift coda pk - (Types.AccountObj.Partial_account.of_pk coda pk)) + (Types.AccountObj.Partial_account.of_pk coda pk) ) let wallet = field "wallet" ~doc:"Find any wallet via a public key" @@ -3828,7 +3829,7 @@ module Queries = struct |> Option.map ~f:(fun tip -> ( Transition_frontier.Breadcrumb.staged_ledger tip |> Staged_ledger.ledger - , tip )) + , tip ) ) let account = field "account" ~doc:"Find any account via a public key and token" @@ -3850,7 +3851,7 @@ module Queries = struct in let%map account = Ledger.get ledger location in Types.AccountObj.Partial_account.of_full_account ~breadcrumb account - |> Types.AccountObj.lift coda pk)) + |> Types.AccountObj.lift coda pk ) ) let account_merkle_path = field "accountMerklePath" ~doc:"Get the merkle path for an account" @@ -3869,7 +3870,7 @@ module Queries = struct let%map location = Ledger.location_of_account ledger (Account_id.create pk token) in - Ledger.merkle_path ledger location) + Ledger.merkle_path ledger location ) let accounts_for_pk = field "accounts" ~doc:"Find all accounts for a public key" @@ -3891,9 +3892,9 @@ module Queries = struct let%map account = Ledger.get ledger location in Types.AccountObj.Partial_account.of_full_account ~breadcrumb account - |> Types.AccountObj.lift coda pk) + |> Types.AccountObj.lift coda pk ) | None -> - []) + [] ) let token_accounts = field "tokenAccounts" ~doc:"Find all accounts for a token ID" @@ -3912,9 +3913,9 @@ module Queries = struct Option.some_if (Token_id.equal token_id acc.token_id) () in Types.AccountObj.Partial_account.of_full_account ~breadcrumb acc - |> Types.AccountObj.lift coda acc.public_key) + |> Types.AccountObj.lift coda acc.public_key ) | None -> - []) + [] ) let token_owner = field "tokenOwner" ~doc:"Find the account ID that owns a given token" @@ -3931,7 +3932,7 @@ module Queries = struct Transition_frontier.Breadcrumb.staged_ledger tip |> Staged_ledger.ledger in - Ledger.token_owner ledger token)) + Ledger.token_owner ledger token ) ) let transaction_status = result_field2 "transactionStatus" ~doc:"Get the status of a transaction" @@ -3941,9 +3942,8 @@ module Queries = struct [ arg "payment" ~typ:guid ~doc:"Id of a Payment" ; arg "zkappTransaction" ~typ:guid ~doc:"Id of a zkApp transaction" ] - ~resolve: - (fun { ctx = coda; _ } () (serialized_payment : string option) - (serialized_zkapp : string option) -> + ~resolve:(fun { ctx = coda; _ } () (serialized_payment : string option) + (serialized_zkapp : string option) -> let open Result.Let_syntax in let deserialize_txn serialized_txn = let res = @@ -3960,7 +3960,7 @@ module Queries = struct |> Result.map ~f:(fun cmd -> { With_hash.data = cmd ; hash = Transaction_hash.hash_command cmd - }) + } ) in let%bind txn = match (serialized_payment, serialized_zkapp) with @@ -3977,8 +3977,8 @@ module Queries = struct let transaction_pool = Mina_lib.transaction_pool coda in Result.map_error (Transaction_inclusion_status.get_status ~frontier_broadcast_pipe - ~transaction_pool txn.data) - ~f:Error.to_string_hum) + ~transaction_pool txn.data ) + ~f:Error.to_string_hum ) let current_snark_worker = field "currentSnarkWorker" ~typ:Types.snark_worker @@ -3986,7 +3986,7 @@ module Queries = struct ~doc:"Get information about the current snark worker" ~resolve:(fun { ctx = coda; _ } _ -> Option.map (Mina_lib.snark_worker_key coda) ~f:(fun k -> - (k, Mina_lib.snark_work_fee coda))) + (k, Mina_lib.snark_work_fee coda) ) ) let genesis_block = field "genesisBlock" ~typ:(non_null Types.block) ~args:[] @@ -4041,7 +4041,7 @@ module Queries = struct Proof.blockchain_dummy ) } ; hash - }) + } ) (* used by best_chain, block below *) let block_of_breadcrumb coda breadcrumb = @@ -4077,12 +4077,12 @@ module Queries = struct | Some best_chain -> let%map blocks = Deferred.List.map best_chain ~f:(fun bc -> - Deferred.return @@ block_of_breadcrumb coda bc) + Deferred.return @@ block_of_breadcrumb coda bc ) in Ok (Some blocks) | None -> return - @@ Error "Could not obtain best chain from transition frontier") + @@ Error "Could not obtain best chain from transition frontier" ) let block = result_field2 "block" @@ -4097,9 +4097,8 @@ module Queries = struct ; arg "height" ~doc:"The height of the desired block in the best chain" ~typ:int ] - ~resolve: - (fun { ctx = coda; _ } () (state_hash_base58_opt : string option) - (height_opt : int option) -> + ~resolve:(fun { ctx = coda; _ } () (state_hash_base58_opt : string option) + (height_opt : int option) -> let open Result.Let_syntax in let get_transition_frontier () = let transition_frontier_pipe = Mina_lib.transition_frontier coda in @@ -4119,7 +4118,7 @@ module Queries = struct (sprintf "Block with state hash %s not found in transition \ frontier" - state_hash_base58) + state_hash_base58 ) in block_of_breadcrumb coda breadcrumb in @@ -4146,13 +4145,13 @@ module Queries = struct blockchain_length @@ With_hash.data @@ Validated.forget validated_transition) in - Unsigned.UInt32.equal block_height height_uint32) + Unsigned.UInt32.equal block_height height_uint32 ) |> Result.of_option ~error: (sprintf "Could not find block in transition frontier with height \ %d" - height) + height ) in block_of_breadcrumb coda desired_breadcrumb in @@ -4162,7 +4161,7 @@ module Queries = struct | None, Some height -> block_from_height height | None, None | Some _, Some _ -> - Error "Must provide exactly one of state hash, height") + Error "Must provide exactly one of state hash, height" ) let initial_peers = field "initialPeers" @@ -4170,7 +4169,8 @@ module Queries = struct ~args:Arg.[] ~typ:(non_null @@ list @@ non_null string) ~resolve:(fun { ctx = coda; _ } () -> - List.map (Mina_lib.initial_peers coda) ~f:Mina_net2.Multiaddr.to_string) + List.map (Mina_lib.initial_peers coda) ~f:Mina_net2.Multiaddr.to_string + ) let get_peers = io_field "getPeers" @@ -4179,7 +4179,7 @@ module Queries = struct ~typ:(non_null @@ list @@ non_null Types.DaemonStatus.peer) ~resolve:(fun { ctx = coda; _ } () -> let%map peers = Mina_networking.peers (Mina_lib.net coda) in - Ok (List.map ~f:Network_peer.Peer.to_display peers)) + Ok (List.map ~f:Network_peer.Peer.to_display peers) ) let snark_pool = field "snarkPool" @@ -4188,7 +4188,7 @@ module Queries = struct ~typ:(non_null @@ list @@ non_null Types.completed_work) ~resolve:(fun { ctx = coda; _ } () -> Mina_lib.snark_pool coda |> Network_pool.Snark_pool.resource_pool - |> Network_pool.Snark_pool.Resource_pool.all_completed_work) + |> Network_pool.Snark_pool.Resource_pool.all_completed_work ) let pending_snark_work = field "pendingSnarkWork" ~doc:"List of snark works that are yet to be done" @@ -4202,7 +4202,7 @@ module Queries = struct Option.map (snark_worker_key coda) ~f:(fun _ -> snark_work_fee coda)) in let (module S) = Mina_lib.work_selection_method coda in - S.pending_work_statements ~snark_pool ~fee_opt snark_job_state) + S.pending_work_statements ~snark_pool ~fee_opt snark_job_state ) let genesis_constants = field "genesisConstants" @@ -4223,7 +4223,7 @@ module Queries = struct ~resolve:(fun { ctx = coda; _ } () -> Block_time.Controller.get_time_offset ~logger:(Mina_lib.config coda).logger - |> Time.Span.to_sec |> Float.to_int) + |> Time.Span.to_sec |> Float.to_int ) let connection_gating_config = io_field "connectionGatingConfig" @@ -4235,7 +4235,7 @@ module Queries = struct ~resolve:(fun { ctx = coda; _ } _ -> let net = Mina_lib.net coda in let%map config = Mina_networking.connection_gating_config net in - Ok config) + Ok config ) let validate_payment = io_field "validatePayment" @@ -4245,9 +4245,9 @@ module Queries = struct [ arg "input" ~typ:(non_null Types.Input.send_payment) ; Types.Input.Fields.signature ] - ~resolve: - (fun { ctx = mina; _ } () - (from, to_, amount, fee, valid_until, memo, nonce_opt) signature -> + ~resolve:(fun { ctx = mina; _ } () + (from, to_, amount, fee, valid_until, memo, nonce_opt) + signature -> let open Deferred.Result.Let_syntax in let body = Signed_command_payload.Body.Payment @@ -4277,7 +4277,7 @@ module Queries = struct user_command_input |> Deferred.Result.map_error ~f:Error.to_string_hum in - Signed_command.check_signature user_command) + Signed_command.check_signature user_command ) let runtime_config = field "runtimeConfig" @@ -4286,7 +4286,7 @@ module Queries = struct ~args:Arg.[] ~resolve:(fun { ctx = mina; _ } () -> Mina_lib.runtime_config mina - |> Runtime_config.to_yojson |> Yojson.Safe.to_basic) + |> Runtime_config.to_yojson |> Yojson.Safe.to_basic ) let thread_graph = field "threadGraph" @@ -4298,7 +4298,7 @@ module Queries = struct ~resolve:(fun _ () -> Bytes.unsafe_to_string ~no_mutation_while_string_reachable: - (O1trace.Thread.dump_thread_graph ())) + (O1trace.Thread.dump_thread_graph ()) ) let evaluate_vrf = io_field "evaluateVrf" @@ -4331,7 +4331,7 @@ module Queries = struct in let t = { (Consensus_vrf.Layout.Evaluation.of_message_and_sk - ~constraint_constants message sk) + ~constraint_constants message sk ) with vrf_threshold } @@ -4340,7 +4340,7 @@ module Queries = struct | Some _ -> Consensus_vrf.Layout.Evaluation.compute_vrf ~constraint_constants t | None -> - t) + t ) let check_vrf = field "checkVrf" @@ -4355,7 +4355,7 @@ module Queries = struct (Mina_lib.config mina).precomputed_values.constraint_constants in Consensus_vrf.Layout.Evaluation.compute_vrf ~constraint_constants - evaluation) + evaluation ) let blockchain_verification_key = io_field "blockchainVerificationKey" @@ -4366,7 +4366,7 @@ module Queries = struct let open Deferred.Result.Let_syntax in Mina_lib.verifier mina |> Verifier.get_blockchain_verification_key |> Deferred.Result.map_error ~f:Error.to_string_hum - >>| Pickles.Verification_key.to_yojson >>| Yojson.Safe.to_basic) + >>| Pickles.Verification_key.to_yojson >>| Yojson.Safe.to_basic ) let commands = [ sync_status diff --git a/src/lib/mina_incremental/mina_incremental.ml b/src/lib/mina_incremental/mina_incremental.ml index ed2bc849c0b..7329266bea2 100644 --- a/src/lib/mina_incremental/mina_incremental.ml +++ b/src/lib/mina_incremental/mina_incremental.ml @@ -27,14 +27,14 @@ struct | Changed (_, value) -> Strict_pipe.Writer.write writer value | Invalidated -> - ()) ; + () ) ; (Strict_pipe.Reader.to_linear_pipe reader).Linear_pipe.Reader.pipe let of_broadcast_pipe pipe = let init = Broadcast_pipe.Reader.peek pipe in let var = Var.create init in Broadcast_pipe.Reader.iter pipe ~f:(fun value -> - Var.set var value ; stabilize () ; Deferred.unit) + Var.set var value ; stabilize () ; Deferred.unit ) |> don't_wait_for ; var @@ -43,7 +43,7 @@ struct don't_wait_for (Deferred.map deferred ~f:(fun () -> Var.set var `Filled ; - stabilize ())) ; + stabilize () ) ) ; var let of_ivar (ivar : unit Ivar.t) = of_deferred (Ivar.read ivar) diff --git a/src/lib/mina_ledger/ledger.ml b/src/lib/mina_ledger/ledger.ml index 7df3bf3947f..084fcc00e8c 100644 --- a/src/lib/mina_ledger/ledger.ml +++ b/src/lib/mina_ledger/ledger.ml @@ -299,7 +299,7 @@ module Ledger_inner = struct (sprintf !"Could not create a new account with pk \ %{sexp:Public_key.Compressed.t}: Account already exists" - (Account_id.public_key account_id)) + (Account_id.public_key account_id) ) let create_new_account t account_id account = Or_error.try_with (fun () -> create_new_account_exn t account_id account) @@ -317,7 +317,7 @@ module Ledger_inner = struct Result.of_option (get ledger loc) ~error: (Error.of_string - "get_or_create: Account was not found in the ledger after creation") + "get_or_create: Account was not found in the ledger after creation" ) in (action, account, loc) @@ -330,7 +330,7 @@ module Ledger_inner = struct failwith "create_empty for a key already present" | `Added, new_loc -> Debug_assert.debug_assert (fun () -> - [%test_eq: Ledger_hash.t] start_hash (merkle_root ledger)) ; + [%test_eq: Ledger_hash.t] start_hash (merkle_root ledger) ) ; (merkle_path ledger new_loc, Account.empty) let _handler t = @@ -340,7 +340,7 @@ module Ledger_inner = struct | `Left h -> h | `Right h -> - h) + h ) in stage (fun (With { request; respond }) -> match request with @@ -358,7 +358,7 @@ module Ledger_inner = struct let index = index_of_account_exn t pk in respond (Provide index) | _ -> - unhandled) + unhandled ) end include Ledger_inner @@ -366,7 +366,7 @@ include Mina_transaction_logic.Make (Ledger_inner) let apply_transaction ~constraint_constants ~txn_state_view l t = O1trace.sync_thread "apply_transaction" (fun () -> - apply_transaction ~constraint_constants ~txn_state_view l t) + apply_transaction ~constraint_constants ~txn_state_view l t ) type init_state = ( Signature_lib.Keypair.t @@ -417,7 +417,7 @@ let apply_initial_ledger_state : t -> init_state -> unit = ; timing } in - create_new_account_exn t account_id account') + create_new_account_exn t account_id account' ) let%test_unit "tokens test" = let open Mina_transaction_logic.For_tests in @@ -463,7 +463,7 @@ let%test_unit "tokens test" = other_parties |> Parties.Call_forest.map ~f:(fun (p : Party.Body.Wire.t) : Party.Wire.t -> - { body = p; authorization = Signature Signature.dummy }) + { body = p; authorization = Signature Signature.dummy } ) |> Parties.Call_forest.add_callers' |> Parties.Call_forest.accumulate_hashes_predicated } @@ -518,7 +518,7 @@ let%test_unit "tokens test" = forest [ node (party Call token_funder Token_id.default - (-(4 * account_creation_fee))) + (-(4 * account_creation_fee)) ) [] ; node (party Call token_owner Token_id.default (3 * account_creation_fee)) @@ -530,7 +530,7 @@ let%test_unit "tokens test" = ~owner: (Account_id.create (Public_key.compress token_owner.public_key) - Token_id.default) + Token_id.default ) in let token_minting = forest @@ -569,7 +569,7 @@ let%test_unit "tokens test" = (module Ledger_inner) [| keypairs.(0); keypairs.(1) |] ledger ; - main ledger) + main ledger ) let%test_unit "parties payment test" = let open Mina_transaction_logic.For_tests in @@ -586,7 +586,7 @@ let%test_unit "parties payment test" = let use_full_commitment = Quickcheck.random_value Bool.quickcheck_generator in - party_send ~constraint_constants ~use_full_commitment s) + party_send ~constraint_constants ~use_full_commitment s ) in L.with_ledger ~depth ~f:(fun l1 -> L.with_ledger ~depth ~f:(fun l2 -> @@ -596,12 +596,12 @@ let%test_unit "parties payment test" = let%bind () = iter_err ts1 ~f:(fun t -> apply_user_command_unchecked l1 t ~constraint_constants - ~txn_global_slot) + ~txn_global_slot ) in let%bind () = iter_err ts2 ~f:(fun t -> apply_parties_unchecked l2 t ~constraint_constants - ~state_view:view) + ~state_view:view ) in let accounts = List.concat_map ~f:Parties.accounts_accessed ts2 in (* TODO: Hack. The nonces are inconsistent between the 2 @@ -615,6 +615,6 @@ let%test_unit "parties payment test" = account.nonce |> Mina_numbers.Account_nonce.to_uint32 |> Unsigned.UInt32.(mul (of_int 2)) |> Mina_numbers.Account_nonce.to_uint32 - }) ; - test_eq (module L) accounts l1 l2)) - |> Or_error.ok_exn) + } ) ; + test_eq (module L) accounts l1 l2 ) ) + |> Or_error.ok_exn ) diff --git a/src/lib/mina_ledger/ledger_transfer.ml b/src/lib/mina_ledger/ledger_transfer.ml index 7754d8b377d..22efdb917a8 100644 --- a/src/lib/mina_ledger/ledger_transfer.ml +++ b/src/lib/mina_ledger/ledger_transfer.ml @@ -20,7 +20,7 @@ end = struct let transfer_accounts ~src ~dest = let accounts = Source.foldi src ~init:[] ~f:(fun addr acc account -> - (addr, account) :: acc) + (addr, account) :: acc ) in Dest.set_batch_accounts dest accounts ; let src_hash = Source.merkle_root src in @@ -46,7 +46,7 @@ end = struct let id = Account.identifier account in ignore ( Dest.get_or_create_account dest id account |> Or_error.ok_exn - : [ `Added | `Existed ] * Dest.Location.t ))) + : [ `Added | `Existed ] * Dest.Location.t ) ) ) in let src_hash = Sparse_ledger.merkle_root src in let dest_hash = Dest.merkle_root dest in diff --git a/src/lib/mina_ledger/sparse_ledger.ml b/src/lib/mina_ledger/sparse_ledger.ml index 02a30fab725..65e84728527 100644 --- a/src/lib/mina_ledger/sparse_ledger.ml +++ b/src/lib/mina_ledger/sparse_ledger.ml @@ -11,17 +11,17 @@ let of_any_ledger (ledger : Ledger.Any_ledger.witness) = ~init: (of_root ~depth:(Ledger.Any_ledger.M.depth ledger) - (Ledger.Any_ledger.M.merkle_root ledger)) + (Ledger.Any_ledger.M.merkle_root ledger) ) ~f:(fun _addr sparse_ledger account -> let loc = Option.value_exn (Ledger.Any_ledger.M.location_of_account ledger - (Account.identifier account)) + (Account.identifier account) ) in add_path sparse_ledger (Ledger.Any_ledger.M.merkle_path ledger loc) (Account.identifier account) - (Option.value_exn (Ledger.Any_ledger.M.get ledger loc))) + (Option.value_exn (Ledger.Any_ledger.M.get ledger loc)) ) let of_ledger_subset_exn (oledger : Ledger.t) keys = let ledger = Ledger.copy oledger in @@ -38,13 +38,13 @@ let of_ledger_subset_exn (oledger : Ledger.t) keys = |> Option.value_exn ?here:None ?error:None ?message:None ) ) | None -> let path, acct = Ledger.create_empty_exn ledger key in - (key :: new_keys, add_path sl path key acct)) + (key :: new_keys, add_path sl path key acct) ) ~init:([], of_ledger_root ledger) in Debug_assert.debug_assert (fun () -> [%test_eq: Ledger_hash.t] (Ledger.merkle_root ledger) - ((merkle_root sparse :> Random_oracle.Digest.t) |> Ledger_hash.of_hash)) ; + ((merkle_root sparse :> Random_oracle.Digest.t) |> Ledger_hash.of_hash) ) ; sparse let of_ledger_index_subset_exn (ledger : Ledger.Any_ledger.witness) indexes = @@ -52,13 +52,13 @@ let of_ledger_index_subset_exn (ledger : Ledger.Any_ledger.witness) indexes = ~init: (of_root ~depth:(Ledger.Any_ledger.M.depth ledger) - (Ledger.Any_ledger.M.merkle_root ledger)) + (Ledger.Any_ledger.M.merkle_root ledger) ) ~f:(fun acc i -> let account = Ledger.Any_ledger.M.get_at_index_exn ledger i in add_path acc (Ledger.Any_ledger.M.merkle_path_at_index_exn ledger i) (Account.identifier account) - account) + account ) let%test_unit "of_ledger_subset_exn with keys that don't exist works" = let keygen () = @@ -77,7 +77,7 @@ let%test_unit "of_ledger_subset_exn with keys that don't exist works" = let sl = of_ledger_subset_exn ledger [ aid1; aid2 ] in [%test_eq: Ledger_hash.t] (Ledger.merkle_root ledger) - ((merkle_root sl :> Random_oracle.Digest.t) |> Ledger_hash.of_hash)) + ((merkle_root sl :> Random_oracle.Digest.t) |> Ledger_hash.of_hash) ) module T = Mina_transaction_logic.Make (L) @@ -89,12 +89,12 @@ let apply_parties_unchecked_with_states ~constraint_constants ~state_view ~f:(fun acc ({ ledger; fee_excess; protocol_state }, local_state) -> ( { GS.ledger = !ledger; fee_excess; protocol_state } , { local_state with ledger = !(local_state.ledger) } ) - :: acc) + :: acc ) |> Result.map ~f:(fun (party_applied, states) -> (* We perform a [List.rev] here to ensure that the states are in order wrt. the parties that generated the states. *) - (party_applied, List.rev states)) + (party_applied, List.rev states) ) let apply_transaction_logic f t x = let open Or_error.Let_syntax in @@ -108,7 +108,7 @@ let apply_user_command ~constraint_constants ~txn_global_slot = let apply_transaction' ~constraint_constants ~txn_state_view l t = O1trace.sync_thread "apply_transaction" (fun () -> - T.apply_transaction ~constraint_constants ~txn_state_view l t) + T.apply_transaction ~constraint_constants ~txn_state_view l t ) let apply_transaction ~constraint_constants ~txn_state_view = apply_transaction_logic diff --git a/src/lib/mina_lib/archive_client.ml b/src/lib/mina_lib/archive_client.ml index 73ac8c357be..956372811c2 100644 --- a/src/lib/mina_lib/archive_client.ml +++ b/src/lib/mina_lib/archive_client.ml @@ -14,10 +14,10 @@ let dispatch ?(max_tries = 5) "Could not send archive diff data to archive process after %d \ tries. The process may not be running, please check the \ daemon-argument" - max_tries) + max_tries ) ( ("host_and_port", archive_location.value) , ("daemon-argument", archive_location.name) ) - [%sexp_of: (string * Host_and_port.t) * (string * string)])) + [%sexp_of: (string * Host_and_port.t) * (string * string)] ) ) else match%bind Daemon_rpcs.Client.dispatch Archive_lib.Rpc.t diff @@ -42,10 +42,10 @@ let make_dispatch_block rpc ?(max_tries = 5) "Could not send block data to archive process after %d tries. \ The process may not be running, please check the \ daemon-argument" - max_tries) + max_tries ) ( ("host_and_port", archive_location.value) , ("daemon-argument", archive_location.name) ) - [%sexp_of: (string * Host_and_port.t) * (string * string)])) + [%sexp_of: (string * Host_and_port.t) * (string * string)] ) ) else match%bind Daemon_rpcs.Client.dispatch rpc block archive_location.value @@ -66,7 +66,7 @@ let dispatch_extensional_block = let transfer ~logger ~precomputed_values ~archive_location (breadcrumb_reader : Transition_frontier.Extensions.New_breadcrumbs.view - Broadcast_pipe.Reader.t) = + Broadcast_pipe.Reader.t ) = Broadcast_pipe.Reader.iter breadcrumb_reader ~f:(fun breadcrumbs -> Deferred.List.iter breadcrumbs ~f:(fun breadcrumb -> let diff = @@ -83,11 +83,11 @@ let transfer ~logger ~precomputed_values ~archive_location ; ( "breadcrumb" , Transition_frontier.Breadcrumb.to_yojson breadcrumb ) ] - "Could not send breadcrumb to archive: $error")) + "Could not send breadcrumb to archive: $error" ) ) let run ~logger ~precomputed_values ~(frontier_broadcast_pipe : - Transition_frontier.t option Broadcast_pipe.Reader.t) archive_location = + Transition_frontier.t option Broadcast_pipe.Reader.t ) archive_location = O1trace.background_thread "send_diffs_to_archiver" (fun () -> Broadcast_pipe.Reader.iter frontier_broadcast_pipe ~f: @@ -101,4 +101,4 @@ let run ~logger ~precomputed_values Transition_frontier.Extensions.New_breadcrumbs in transfer ~logger ~precomputed_values ~archive_location - breadcrumb_reader))) + breadcrumb_reader ) ) ) diff --git a/src/lib/mina_lib/conf_dir.ml b/src/lib/mina_lib/conf_dir.ml index 515cd22f109..5966337ae73 100644 --- a/src/lib/mina_lib/conf_dir.ml +++ b/src/lib/mina_lib/conf_dir.ml @@ -15,7 +15,7 @@ let check_and_set_lockfile ~logger conf_dir = Monitor.try_with ~here:[%here] ~extract_exn:true (fun () -> Writer.with_file ~exclusive:true lockfile ~f:(fun writer -> let pid = Unix.getpid () in - return (Writer.writef writer "%d\n" (Pid.to_int pid)))) + return (Writer.writef writer "%d\n" (Pid.to_int pid)) ) ) with | Ok () -> [%log info] "Created daemon lockfile $lockfile" @@ -26,7 +26,7 @@ let check_and_set_lockfile ~logger conf_dir = | `Yes -> Unix.unlink lockfile | _ -> - return ()) + return () ) | Error exn -> Error.tag_arg (Error.of_exn exn) "Could not create the daemon lockfile" ("lockfile", lockfile) @@ -72,7 +72,7 @@ let check_and_set_lockfile ~logger conf_dir = [ ("lockfile", `String lockfile) ; ("pid", `Int (Pid.to_int pid)) ] ; - Unix.unlink lockfile ))) + Unix.unlink lockfile ) ) ) with | Ok () -> () @@ -118,7 +118,7 @@ let get_hw_info () = | Error err -> [ sprintf "Error: %s" (Error.to_string_hum err) ] in - return ((header :: output) @ [ "" ])) + return ((header :: output) @ [ "" ]) ) in Some (Option.value_exn linux_info :: List.concat outputs) else (* TODO: Mac, other Unixes *) @@ -157,7 +157,7 @@ let export_logs_to_tar ?basename ~conf_dir = Monitor.try_with ~here:[%here] ~extract_exn:true (fun () -> Writer.with_file ~exclusive:true hw_info_file ~f:(fun writer -> Deferred.List.map (Option.value_exn hw_info_opt) ~f:(fun line -> - return (Writer.write_line writer line)))) + return (Writer.write_line writer line) ) ) ) with | Ok _units -> Some hw_info @@ -169,7 +169,7 @@ let export_logs_to_tar ?basename ~conf_dir = let base_files = "mina.version" :: log_files in let files = Option.value_map hw_file_opt ~default:base_files ~f:(fun hw_file -> - hw_file :: base_files) + hw_file :: base_files ) in let tmp_dir = Filename.temp_dir ~in_dir:"/tmp" ("mina-logs_" ^ basename) "" in let files_in_dir dir = List.map files ~f:(fun file -> dir ^/ file) in diff --git a/src/lib/mina_lib/mina_lib.ml b/src/lib/mina_lib/mina_lib.ml index a9743f70a67..74534a302a5 100644 --- a/src/lib/mina_lib/mina_lib.ml +++ b/src/lib/mina_lib/mina_lib.ml @@ -85,11 +85,11 @@ type pipes = * ( ( Network_pool.Transaction_pool.Resource_pool.Diff.t * Network_pool.Transaction_pool.Resource_pool.Diff.Rejected.t ) Or_error.t - -> unit) + -> unit ) * ( Account_id.t -> ( [ `Min of Mina_base.Account.Nonce.t ] * Mina_base.Account.Nonce.t , string ) - Result.t) + Result.t ) * (Account_id.t -> Account.t option Participating_state.T.t) , Strict_pipe.synchronous , unit Deferred.t ) @@ -127,7 +127,7 @@ let peek_frontier frontier_broadcast_pipe = |> Result.of_option ~error: (Error.of_string - "Cannot retrieve transition frontier now. Bootstrapping right now.") + "Cannot retrieve transition frontier now. Bootstrapping right now." ) let client_port t = let { Node_addrs_and_ports.client_port; _ } = @@ -200,7 +200,7 @@ module Snark_worker = struct don't_wait_for ( match%bind Monitor.try_with ~here:[%here] (fun () -> - Process.wait snark_worker_process) + Process.wait snark_worker_process ) with | Ok signal_or_error -> ( let%bind () = close_stdin () in @@ -375,7 +375,7 @@ let active_or_bootstrapping = compose_of_option (fun t -> Option.bind (Broadcast_pipe.Reader.peek t.components.transition_frontier) - ~f:(Fn.const (Some ()))) + ~f:(Fn.const (Some ())) ) (* This is a hack put in place to deal with nodes getting stuck in Offline states, that is, not receiving blocks for an extended period. @@ -419,10 +419,10 @@ let create_sync_status_observer ~logger ~is_seed ~demo_mode ~net (Async.Clock.Event.run_after offline_shutdown_delay (fun () -> raise Offline_shutdown) - ()) + () ) | Some _ -> - ()) - ()) + () ) + () ) | Some _ -> () ) ; let is_empty = function `Empty -> true | _ -> false in @@ -435,10 +435,10 @@ let create_sync_status_observer ~logger ~is_seed ~demo_mode ~net else `Offline | `Online -> ( Option.iter !next_helper_restart ~f:(fun e -> - Async.Clock.Event.abort_if_possible e ()) ; + Async.Clock.Event.abort_if_possible e () ) ; next_helper_restart := None ; Option.iter !offline_shutdown ~f:(fun e -> - Async.Clock.Event.abort_if_possible e ()) ; + Async.Clock.Event.abort_if_possible e () ) ; offline_shutdown := None ; match active_status with | None -> @@ -452,7 +452,7 @@ let create_sync_status_observer ~logger ~is_seed ~demo_mode ~net `Catchup ) else ( [%str_log info] Synced ; - `Synced ) )) + `Synced ) ) ) in let observer = observe incremental_status in (* monitor Mina status, issue a warning if offline for too long (unless we are a seed node) *) @@ -475,8 +475,7 @@ let create_sync_status_observer ~logger ~is_seed ~demo_mode ~net | None -> offline_timeout := Some - (Timeout.create () offline_timeout_duration - ~f:log_offline_warning) + (Timeout.create () offline_timeout_duration ~f:log_offline_warning) in let stop_offline_timeout () = match !offline_timeout with @@ -502,7 +501,7 @@ let create_sync_status_observer ~logger ~is_seed ~demo_mode ~net | Changed (_, value) -> handle_status_change value | Invalidated -> - ()) ) ; + () ) ) ; (* recompute Mina status on an interval *) let stabilize () = O1trace.sync_thread "stabilize_sync_status" stabilize in stabilize () ; @@ -583,7 +582,7 @@ let get_snarked_ledger t state_hash_opt = "No transactions corresponding to the emitted proof \ for state_hash:%s" (State_hash.to_base58_check - (Transition_frontier.Breadcrumb.state_hash b)))) + (Transition_frontier.Breadcrumb.state_hash b) ) ) ) | Some txns -> ( match List.fold_until ~init:(Ok ()) @@ -614,14 +613,14 @@ let get_snarked_ledger t state_hash_opt = Stop (Or_error.errorf !"Coudln't find protocol state with hash %s" - (State_hash.to_base58_check state_hash))) + (State_hash.to_base58_check state_hash) ) ) ~finish:Fn.id with | Ok _ -> Continue (Ok ()) | e -> Stop e ) - else Continue (Ok ())) + else Continue (Ok ()) ) ~finish:Fn.id in let snarked_ledger_hash = @@ -667,7 +666,7 @@ let get_inferred_nonce_from_transaction_pool_and_ledger t List.map pooled_transactions ~f: (Fn.compose User_command.nonce_exn - Transaction_hash.User_command_with_valid_signature.command) + Transaction_hash.User_command_with_valid_signature.command ) in (* The last nonce gives us the maximum nonce in the transaction pool *) List.last nonces @@ -793,11 +792,10 @@ let root_diff t = |> Mina_block.Validated.valid_commands |> List.map ~f: - (With_status.map - ~f:User_command.forget_check) + (With_status.map ~f:User_command.forget_check) ; root_length = length_of_breadcrumb new_root_breadcrumb } ; - Deferred.unit)))) ; + Deferred.unit ) ) ) ) ; root_diff_reader let dump_tf t = @@ -836,7 +834,7 @@ let request_work t = ~snark_pool:(snark_pool t) (snark_job_state t) in Option.map instances_opt ~f:(fun instances -> - { Snark_work_lib.Work.Spec.instances; fee }) + { Snark_work_lib.Work.Spec.instances; fee } ) let work_selection_method t = t.config.work_selection_method @@ -950,7 +948,7 @@ let next_epoch_ledger t = (*root is in the same epoch as the best tip and so the next epoch ledger in the local state will be updated by Proof_of_stake.frontier_root_transition. Next epoch ledger in genesis epoch is the genesis ledger*) `Finalized (Consensus.Data.Local_state.next_epoch_ledger - t.config.consensus_local_state) + t.config.consensus_local_state ) else (*No blocks in the new epoch is finalized yet, return nothing*) `Notfinalized @@ -1019,7 +1017,7 @@ let perform_compaction t = "Time between compactions %f should be greater than the expected \ time for compaction %f" (Time.Span.to_ms interval_configured) - expected_time_for_compaction) ) ; + expected_time_for_compaction ) ) ; let call_compact () = let start = Time.now () in Gc.compact () ; @@ -1042,7 +1040,7 @@ let perform_compaction t = perform (span slot_duration_ms ~incr:ms) else ( call_compact () ; - perform interval_configured )) + perform interval_configured ) ) in perform interval_configured @@ -1056,7 +1054,7 @@ let check_and_stop_daemon t ~wait = if uptime_mins <= wait then `Check_in (Block_time.Span.to_time_span - t.config.precomputed_values.consensus_constants.slot_duration_ms) + t.config.precomputed_values.consensus_constants.slot_duration_ms ) else match t.next_producer_timing with | None -> @@ -1072,7 +1070,7 @@ let check_and_stop_daemon t ~wait = Time.add tm (Block_time.Span.to_time_span t.config.precomputed_values.consensus_constants - .slot_duration_ms) + .slot_duration_ms ) in let wait_for = Time.(diff next_block (now ())) in if Time.Span.(wait_for > max_catchup_time) then `Now @@ -1080,7 +1078,7 @@ let check_and_stop_daemon t ~wait = | Evaluating_vrf _last_checked_slot -> `Check_in (Core.Time.Span.of_ms - (Mina_compile_config.vrf_poll_interval_ms * 2 |> Int.to_float)) + (Mina_compile_config.vrf_poll_interval_ms * 2 |> Int.to_float) ) ) let stop_long_running_daemon t = @@ -1106,7 +1104,7 @@ let stop_long_running_daemon t = | `Now -> stop_daemon () | `Check_in tm -> - go tm) + go tm ) in go (Time.Span.of_ms (wait_mins * 60 * 1000 |> Float.of_int)) @@ -1120,7 +1118,7 @@ let setup_timer ~constraint_constants time_controller sync_state_broadcaster = Block_time.Timeout.create time_controller (offline_time constraint_constants) ~f:(fun _ -> Broadcast_pipe.Writer.write sync_state_broadcaster `Offline - |> don't_wait_for) + |> don't_wait_for ) let online_broadcaster ~constraint_constants time_controller = let online_reader, online_writer = Broadcast_pipe.create `Offline in @@ -1187,7 +1185,7 @@ let start t = (info ( time |> Block_time.Span.of_ms |> Block_time.of_span_since_epoch ) - block_data) ) + block_data ) ) in ( status , { Daemon_rpcs.Types.Status.Next_producer_timing.timing @@ -1199,8 +1197,7 @@ let start t = in if not - (Keypair.And_compressed_pk.Set.is_empty - t.config.block_production_keypairs) + (Keypair.And_compressed_pk.Set.is_empty t.config.block_production_keypairs) then Block_producer.run ~logger:t.config.logger ~vrf_evaluator:t.processes.vrf_evaluator ~verifier:t.processes.verifier @@ -1208,7 +1205,7 @@ let start t = ~trust_system:t.config.trust_system ~transaction_resource_pool: (Network_pool.Transaction_pool.resource_pool - t.components.transaction_pool) + t.components.transaction_pool ) ~get_completed_work: (Network_pool.Snark_pool.get_completed_work t.components.snark_pool) ~time_controller:t.config.time_controller @@ -1232,7 +1229,7 @@ let start t = ~start_time:t.config.start_time ~slot_duration: (Block_time.Span.to_time_span - t.config.precomputed_values.consensus_constants.slot_duration_ms) + t.config.precomputed_values.consensus_constants.slot_duration_ms ) | None -> () in @@ -1311,13 +1308,13 @@ let create ?wallets (config : Config.t) = let err = Error.of_exn ~backtrace:`Get exn in [%log' warn config.logger] "unhandled exception from daemon-side prover server: $exn" - ~metadata:[ ("exn", Error_json.error_to_yojson err) ])) + ~metadata:[ ("exn", Error_json.error_to_yojson err) ] ) ) (fun () -> O1trace.thread "manage_prover_subprocess" (fun () -> Prover.create ~logger:config.logger ~proof_level:config.precomputed_values.proof_level ~constraint_constants ~pids:config.pids - ~conf_dir:config.conf_dir)) + ~conf_dir:config.conf_dir ) ) >>| Result.ok_exn in let%bind verifier = @@ -1329,14 +1326,14 @@ let create ?wallets (config : Config.t) = [%log' warn config.logger] "unhandled exception from daemon-side verifier server: \ $exn" - ~metadata:[ ("exn", Error_json.error_to_yojson err) ])) + ~metadata:[ ("exn", Error_json.error_to_yojson err) ] ) ) (fun () -> O1trace.thread "manage_verifier_subprocess" (fun () -> Verifier.create ~logger:config.logger ~proof_level:config.precomputed_values.proof_level ~constraint_constants: config.precomputed_values.constraint_constants - ~pids:config.pids ~conf_dir:(Some config.conf_dir))) + ~pids:config.pids ~conf_dir:(Some config.conf_dir) ) ) >>| Result.ok_exn in let%bind vrf_evaluator = @@ -1348,13 +1345,13 @@ let create ?wallets (config : Config.t) = [%log' warn config.logger] "unhandled exception from daemon-side vrf evaluator \ server: $exn" - ~metadata:[ ("exn", Error_json.error_to_yojson err) ])) + ~metadata:[ ("exn", Error_json.error_to_yojson err) ] ) ) (fun () -> O1trace.thread "manage_vrf_evaluator_subprocess" (fun () -> Vrf_evaluator.create ~constraint_constants ~pids:config.pids ~logger:config.logger ~conf_dir:config.conf_dir ~consensus_constants - ~keypairs:config.block_production_keypairs)) + ~keypairs:config.block_production_keypairs ) ) >>| Result.ok_exn in let snark_worker = @@ -1365,7 +1362,7 @@ let create ?wallets (config : Config.t) = ; process = Ivar.create () ; kill_ivar = Ivar.create () } - , config.snark_work_fee )) + , config.snark_work_fee ) ) in let%bind uptime_snark_worker_opt = (* if uptime URL provided, run uptime service SNARK worker *) @@ -1381,13 +1378,13 @@ let create ?wallets (config : Config.t) = worker: $exn, terminating daemon" ~metadata:[ ("exn", Error_json.error_to_yojson err) ] ; (* make sure Async shutdown handlers are called *) - don't_wait_for (Async.exit 1))) + don't_wait_for (Async.exit 1) ) ) (fun () -> O1trace.thread "manage_uptimer_snark_worker_subprocess" (fun () -> Uptime_service.Uptime_snark_worker.create - ~logger:config.logger ~pids:config.pids)) - >>| Result.ok) + ~logger:config.logger ~pids:config.pids ) ) + >>| Result.ok ) in log_snark_coordinator_warning config snark_worker ; Protocol_version.set_current config.initial_protocol_version ; @@ -1398,7 +1395,7 @@ let create ?wallets (config : Config.t) = [%log' debug config.logger] ~metadata: [ ("rate_limiter", Network_pool.Rate_limiter.summary rl) ] - !"%s $rate_limiter" label) + !"%s $rate_limiter" label ) in let producer_transition_reader, producer_transition_writer = Strict_pipe.create Synchronous @@ -1412,7 +1409,7 @@ let create ?wallets (config : Config.t) = | None -> Deferred.unit | Some frontier -> - Transition_frontier.close ~loc:__LOC__ frontier) ; + Transition_frontier.close ~loc:__LOC__ frontier ) ; let handle_request name ~f query_env = O1trace.thread ("handle_request_" ^ name) (fun () -> let input = Envelope.Incoming.data query_env in @@ -1422,7 +1419,7 @@ let create ?wallets (config : Config.t) = let%bind frontier = Broadcast_pipe.Reader.peek frontier_broadcast_pipe_r in - f ~frontier input) + f ~frontier input ) in (* knot-tying hacks so we can pass a get_node_status function before net, Mina_lib.t created *) let net_ref = ref None in @@ -1435,7 +1432,7 @@ let create ?wallets (config : Config.t) = let peer_opt = config.gossip_net_params.addrs_and_ports.peer in let node_peer_id = Option.value_map peer_opt ~default:"" ~f:(fun peer -> - peer.peer_id) + peer.peer_id ) in if config.disable_node_status then Deferred.return @@ -1444,7 +1441,7 @@ let create ?wallets (config : Config.t) = (sprintf !"Node with IP address=%{sexp: Unix.Inet_addr.t}, \ peer ID=%s, node status is disabled" - node_ip_addr node_peer_id)) + node_ip_addr node_peer_id ) ) else match !net_ref with | None -> @@ -1458,7 +1455,7 @@ let create ?wallets (config : Config.t) = !"Node with IP address=%{sexp: \ Unix.Inet_addr.t}, peer ID=%s, network not \ instantiated when node status requested" - node_ip_addr node_peer_id)) + node_ip_addr node_peer_id ) ) | Some net -> let ( protocol_state_hash , best_tip_opt @@ -1487,11 +1484,11 @@ let create ?wallets (config : Config.t) = ( Transition_frontier.Breadcrumb.state_hash bc , Option.value_map (Transition_frontier.Breadcrumb - .transition_receipt_time bc) + .transition_receipt_time bc ) ~default:"no timestamp available" ~f: (Time.to_string_iso8601_basic - ~zone:Time.Zone.utc) )) + ~zone:Time.Zone.utc ) ) ) in ( protocol_state_hash , Some tip @@ -1556,7 +1553,7 @@ let create ?wallets (config : Config.t) = ; git_commit ; uptime_minutes ; block_height_opt - }) + } ) in let get_some_initial_peers _ = O1trace.thread "handle_request_get_some_initial_peers" (fun () -> @@ -1567,7 +1564,7 @@ let create ?wallets (config : Config.t) = "Network not instantiated when initial peers requested" ; Deferred.return [] | Some net -> - Mina_networking.peers net) + Mina_networking.peers net ) in let txn_pool_config = Network_pool.Transaction_pool.Resource_pool.make_config ~verifier @@ -1602,7 +1599,7 @@ let create ?wallets (config : Config.t) = (Time_ns.Span.of_hr (Float.of_int config.precomputed_values.genesis_constants - .transaction_expiry_hr)) + .transaction_expiry_hr ) ) ~on_remote_push:notify_online ~log_gossip_heard: config.net_config.log_gossip_heard.transaction_pool_diff @@ -1621,7 +1618,7 @@ let create ?wallets (config : Config.t) = (Time_ns.Span.of_hr (Float.of_int config.precomputed_values.genesis_constants - .transaction_expiry_hr)) + .transaction_expiry_hr ) ) ~on_remote_push:notify_online ~log_gossip_heard: config.net_config.log_gossip_heard.snark_pool_diff @@ -1642,8 +1639,8 @@ let create ?wallets (config : Config.t) = O1trace.thread "mina_networking" (fun () -> Mina_networking.create config.net_config ~get_some_initial_peers ~sinks - ~get_staged_ledger_aux_and_pending_coinbases_at_hash: - (fun query_env -> + ~get_staged_ledger_aux_and_pending_coinbases_at_hash:(fun query_env + -> O1trace.thread "handle_request_get_staged_ledger_aux_and_pending_coinbases_at_hash" (fun () -> @@ -1677,7 +1674,7 @@ let create ?wallets (config : Config.t) = ( scan_state , expected_merkle_root , pending_coinbases - , protocol_states ))) + , protocol_states ) ) ) ~answer_sync_ledger_query:(fun query_env -> let open Deferred.Or_error.Let_syntax in O1trace.thread "handle_request_answer_sync_ledger_query" @@ -1700,16 +1697,17 @@ let create ?wallets (config : Config.t) = !"%s for ledger_hash: \ %{sexp:Ledger_hash.t}" Mina_networking - .refused_answer_query_string ledger_hash)))) + .refused_answer_query_string ledger_hash ) ) ) + ) ~get_ancestry: (handle_request "get_ancestry" ~f:(fun ~frontier s -> s |> With_hash.map_hash ~f:(fun state_hash -> { State_hash.State_hashes.state_hash ; state_body_hash = None - }) + } ) |> Sync_handler.Root.prove ~consensus_constants - ~logger:config.logger ~frontier)) + ~logger:config.logger ~frontier ) ) ~get_best_tip: (handle_request "get_best_tip" ~f:(fun ~frontier () -> let open Option.Let_syntax in @@ -1719,15 +1717,15 @@ let create ?wallets (config : Config.t) = in { proof_with_data with data = With_hash.data proof_with_data.data - })) + } ) ) ~get_node_status ~get_transition_chain_proof: (handle_request "get_transition_chain_proof" ~f:(fun ~frontier hash -> - Transition_chain_prover.prove ~frontier hash)) + Transition_chain_prover.prove ~frontier hash ) ) ~get_transition_chain: (handle_request "get_transition_chain" - ~f:Sync_handler.get_transition_chain) + ~f:Sync_handler.get_transition_chain ) ~get_transition_knowledge:(fun _q -> O1trace.thread "handle_request_get_transition_knowledge" (fun () -> @@ -1739,7 +1737,7 @@ let create ?wallets (config : Config.t) = | None -> [] | Some frontier -> - Sync_handler.best_tip_path ~frontier )))) + Sync_handler.best_tip_path ~frontier ) ) ) ) in (* tie the first knot *) net_ref := Some net ; @@ -1767,7 +1765,7 @@ let create ?wallets (config : Config.t) = Network_pool.Transaction_pool.Local_sink.push tx_local_sink ( List.map user_commands ~f:(fun c -> - User_command.Signed_command c) + User_command.Signed_command c ) , result_cb ) | Error e -> [%log' error config.logger] @@ -1782,8 +1780,8 @@ let create ?wallets (config : Config.t) = *) Network_pool.Transaction_pool.Local_sink.push tx_local_sink ( List.map snapp_txns ~f:(fun cmd -> - User_command.Parties cmd) - , result_cb )) + User_command.Parties cmd ) + , result_cb ) ) |> Deferred.don't_wait_for ; let ((most_recent_valid_block_reader, _) as most_recent_valid_block) = Broadcast_pipe.create @@ -1815,7 +1813,7 @@ let create ?wallets (config : Config.t) = Strict_pipe.Reader.( Fork.two (map downstream_pipe ~f:(fun (`Transition t, _, _) -> - External_transition.Validated.lift t))) + External_transition.Validated.lift t ) )) in (network_pipe, api_pipe, new_blocks_pipe) in @@ -1834,7 +1832,7 @@ let create ?wallets (config : Config.t) = Network_pool.Transaction_pool.Resource_pool.Diff .max_per_15_seconds x in - Mina_networking.broadcast_transaction_pool_diff net x)) ; + Mina_networking.broadcast_transaction_pool_diff net x ) ) ; O1trace.background_thread "broadcast_blocks" (fun () -> Strict_pipe.Reader.iter_without_pushback valid_transitions_for_network @@ -1874,18 +1872,18 @@ let create ?wallets (config : Config.t) = ~f: (Fn.flip Mina_net2.Validation_callback - .fire_if_not_already_fired `Accept) + .fire_if_not_already_fired `Accept ) valid_cb | `Internal -> (*Send callback to publish the new block. Don't log rebroadcast message if it is internally generated; There is a broadcast log*) don't_wait_for (Mina_networking.broadcast_state net - (Mina_block.Validated.forget transition)) ; + (Mina_block.Validated.forget transition) ) ; Option.iter ~f: (Fn.flip Mina_net2.Validation_callback - .fire_if_not_already_fired `Accept) + .fire_if_not_already_fired `Accept ) valid_cb | `Catchup -> (*Noop for directly downloaded transitions*) @@ -1893,7 +1891,7 @@ let create ?wallets (config : Config.t) = ~f: (Fn.flip Mina_net2.Validation_callback - .fire_if_not_already_fired `Accept) + .fire_if_not_already_fired `Accept ) valid_cb ) | Error reason -> ( let timing_error_json = @@ -1914,7 +1912,7 @@ let create ?wallets (config : Config.t) = ~f: (Fn.flip Mina_net2.Validation_callback - .fire_if_not_already_fired `Reject) + .fire_if_not_already_fired `Reject ) valid_cb ; match source with | `Catchup -> @@ -1927,7 +1925,7 @@ let create ?wallets (config : Config.t) = | `Gossip -> [%log' warn config.logger] ~metadata "Not rebroadcasting block $state_hash because it \ - was received $timing" ))) ; + was received $timing" ) ) ) ; (* FIXME #4093: augment ban_notifications with a Peer.ID so we can implement ban_notify trace_task "ban notification loop" (fun () -> Linear_pipe.iter (Mina_networking.ban_notification_reader net) @@ -1943,7 +1941,7 @@ let create ?wallets (config : Config.t) = don't_wait_for (Linear_pipe.iter (Mina_networking.ban_notification_reader net) - ~f:(Fn.const Deferred.unit)) ; + ~f:(Fn.const Deferred.unit) ) ; let snark_jobs_state = Work_selector.State.init ~reassignment_wait:config.work_reassignment_wait @@ -1971,7 +1969,7 @@ let create ?wallets (config : Config.t) = Network_pool.Snark_pool.Resource_pool.Diff .max_per_15_seconds x in - Mina_networking.broadcast_snark_pool_diff net x)) ; + Mina_networking.broadcast_snark_pool_diff net x ) ) ; Option.iter config.archive_process_location ~f:(fun archive_process_port -> [%log' info config.logger] @@ -1985,11 +1983,11 @@ let create ?wallets (config : Config.t) = Archive_client.run ~logger:config.logger ~precomputed_values:config.precomputed_values ~frontier_broadcast_pipe:frontier_broadcast_pipe_r - archive_process_port) ; + archive_process_port ) ; let precomputed_block_writer = ref ( Option.map config.precomputed_blocks_path ~f:(fun path -> - `Path path) + `Path path ) , if config.log_precomputed_blocks then Some `Log else None ) in let subscriptions = @@ -2061,7 +2059,7 @@ let create ?wallets (config : Config.t) = ; sync_status ; precomputed_block_writer ; block_production_status = ref `Free - })) + } ) ) let net { components = { net; _ }; _ } = net diff --git a/src/lib/mina_lib/mina_subscriptions.ml b/src/lib/mina_lib/mina_subscriptions.ml index c399b0d19ad..9563a45f428 100644 --- a/src/lib/mina_lib/mina_subscriptions.ml +++ b/src/lib/mina_lib/mina_subscriptions.ml @@ -47,13 +47,13 @@ let create ~logger ~constraint_constants ~wallets ~new_blocks Optional_public_key.Table.of_alist_multi @@ List.map (Secrets.Wallets.pks wallets) ~f:(fun wallet -> let reader, writer = Pipe.create () in - (Some wallet, (reader, writer))) + (Some wallet, (reader, writer)) ) in let subscribed_payment_users = Public_key.Compressed.Table.of_alist_exn @@ List.map (Secrets.Wallets.pks wallets) ~f:(fun wallet -> let reader, writer = Pipe.create () in - (wallet, (reader, writer))) + (wallet, (reader, writer)) ) in let update_payment_subscriptions filtered_external_transition participants = Set.iter participants ~f:(fun participant -> @@ -67,11 +67,11 @@ let create ~logger ~constraint_constants ~wallets ~new_blocks | User_command.Signed_command c -> Some c | Parties _ -> - None) + None ) |> Fn.flip Signed_command.filter_by_participant participant in List.iter user_commands ~f:(fun user_command -> - Pipe.write_without_pushback_if_open writer user_command))) + Pipe.write_without_pushback_if_open writer user_command ) ) ) in let update_block_subscriptions { With_hash.data = external_transition; hash } transactions participants = @@ -85,8 +85,8 @@ let create ~logger ~constraint_constants ~wallets ~new_blocks transactions in Pipe.write_without_pushback_if_open writer - { With_hash.data; hash })) - ~if_not_found:ignore) ; + { With_hash.data; hash } ) ) + ~if_not_found:ignore ) ; Hashtbl.find_and_call subscribed_block_users None ~if_found:(fun pipes -> List.iter pipes ~f:(fun (_, writer) -> @@ -95,7 +95,7 @@ let create ~logger ~constraint_constants ~wallets ~new_blocks `All transactions in if not (Pipe.is_closed writer) then - Pipe.write_without_pushback writer { With_hash.data; hash })) + Pipe.write_without_pushback writer { With_hash.data; hash } ) ) ~if_not_found:ignore in let gcloud_keyfile = @@ -112,7 +112,7 @@ let create ~logger ~constraint_constants ~wallets ~new_blocks ignore ( Core.Sys.command (sprintf "gcloud auth activate-service-account --key-file=%s" path) - : int )) ; + : int ) ) ; O1trace.background_thread "process_new_block_subscriptions" (fun () -> Strict_pipe.Reader.iter new_blocks ~f:(fun new_block_ext -> let new_block = @@ -160,7 +160,7 @@ let create ~logger ~constraint_constants ~wallets ~new_blocks ~constraint_constants ~staged_ledger ~scheduled_time block in - Mina_block.Precomputed.to_yojson precomputed_block) + Mina_block.Precomputed.to_yojson precomputed_block ) in if upload_blocks_to_gcloud then ( [%log info] "log" ; @@ -229,10 +229,10 @@ let create ~logger ~constraint_constants ~wallets ~new_blocks Async.Process.run () ~prog:"bash" ~args:[ "-c"; command ] |> Deferred.Result.map_error - ~f:(Error.tag ~tag:__LOC__)) + ~f:(Error.tag ~tag:__LOC__) ) |> Result.map_error ~f:(Error.tag ~tag:__LOC__) - |> Deferred.return |> Deferred.Or_error.join) + |> Deferred.return |> Deferred.Or_error.join ) in ( match output with | Ok _result -> @@ -258,7 +258,7 @@ let create ~logger ~constraint_constants ~wallets ~new_blocks Out_channel.output_lines out_channel [ Yojson.Safe.to_string (Lazy.force precomputed_block) - ])) ; + ] ) ) ; [%log info] "Saw block with state hash $state_hash" ~metadata: (let state_hash_data = @@ -270,7 +270,7 @@ let create ~logger ~constraint_constants ~wallets ~new_blocks state_hash_data @ [ ("precomputed_block", Lazy.force precomputed_block) ] - else state_hash_data) )) ; + else state_hash_data ) ) ) ; match Filtered_external_transition.validate_transactions ~constraint_constants new_block_no_hash @@ -279,7 +279,7 @@ let create ~logger ~constraint_constants ~wallets ~new_blocks let unfiltered_external_transition = lazy (Filtered_external_transition.of_transition new_block_no_hash - `All verified_transactions) + `All verified_transactions ) in let filtered_external_transition = if is_storing_all then Lazy.force unfiltered_external_transition @@ -288,7 +288,7 @@ let create ~logger ~constraint_constants ~wallets ~new_blocks (`Some ( Public_key.Compressed.Set.of_list @@ List.filter_opt (Hashtbl.keys subscribed_block_users) - )) + ) ) verified_transactions in let participants = @@ -310,7 +310,7 @@ let create ~logger ~constraint_constants ~wallets ~new_blocks ] "Staged ledger had error with transactions in block for state \ $state_hash: $error" ; - Deferred.unit)) ; + Deferred.unit ) ) ; let reorganization_subscription = [] in let reader, writer = Strict_pipe.create ~name:"Reorganization subscription" @@ -334,12 +334,12 @@ let create ~logger ~constraint_constants ~wallets ~new_blocks Broadcast_pipe.Reader.iter best_tip_diff_pipe ~f:(fun { reorg_best_tip; _ } -> if reorg_best_tip then Strict_pipe.Writer.write writer () ; - Deferred.unit))) ; + Deferred.unit ) ) ) ; Strict_pipe.Reader.iter reader ~f:(fun () -> List.iter t.reorganization_subscription ~f:(fun (_, writer) -> if not (Pipe.is_closed writer) then - Pipe.write_without_pushback writer `Changed) ; - Deferred.unit) + Pipe.write_without_pushback writer `Changed ) ; + Deferred.unit ) |> don't_wait_for ; t @@ -360,12 +360,12 @@ let add_block_subscriber t public_key = (* Intentionally using pointer equality *) not @@ Tuple2.equal ~eq1:Pipe.equal ~eq2:Pipe.equal rw_pair - rw_pair') + rw_pair' ) with | [] -> None | l -> - Some l )) ) ; + Some l ) ) ) ; block_reader let add_payment_subscriber t public_key = diff --git a/src/lib/mina_metrics/prometheus_metrics/metric_generators.ml b/src/lib/mina_metrics/prometheus_metrics/metric_generators.ml index 6ce738c34db..df675f6f018 100644 --- a/src/lib/mina_metrics/prometheus_metrics/metric_generators.ml +++ b/src/lib/mina_metrics/prometheus_metrics/metric_generators.ml @@ -71,7 +71,7 @@ module Moving_bucketed_average (Spec : Bucketed_average_spec_intf) () : Gauge.set v (render_average buckets_val) ; buckets := Some (empty_bucket_entry :: List.take buckets_val (num_buckets - 1)) ; - tick ()) + tick () ) in tick () end @@ -89,26 +89,26 @@ module Moving_time_average (Spec : Time_average_spec_intf) () : "invalid intervals provided to Moving_time_average -- the \ tick_interval does not evenly divide the rolling_interval" - include Moving_bucketed_average - (struct - include Spec - - let bucket_interval = tick_interval - - let num_buckets = - Float.to_int - ( Time.Span.to_ns rolling_interval - /. Time.Span.to_ns tick_interval ) - - let render_average buckets = - let total_sum, count_sum = - List.fold buckets ~init:(0.0, 0) - ~f:(fun (total_sum, count_sum) (total, count) -> - (total_sum +. total, count_sum + count)) - in - total_sum /. Float.of_int count_sum - end) - () + include + Moving_bucketed_average + (struct + include Spec + + let bucket_interval = tick_interval + + let num_buckets = + Float.to_int + (Time.Span.to_ns rolling_interval /. Time.Span.to_ns tick_interval) + + let render_average buckets = + let total_sum, count_sum = + List.fold buckets ~init:(0.0, 0) + ~f:(fun (total_sum, count_sum) (total, count) -> + (total_sum +. total, count_sum + count) ) + in + total_sum /. Float.of_int count_sum + end) + () let update span = update (Core.Time.Span.to_sec span) end diff --git a/src/lib/mina_metrics/prometheus_metrics/mina_metrics.ml b/src/lib/mina_metrics/prometheus_metrics/mina_metrics.ml index 76f6f2532e8..30967717443 100644 --- a/src/lib/mina_metrics/prometheus_metrics/mina_metrics.ml +++ b/src/lib/mina_metrics/prometheus_metrics/mina_metrics.ml @@ -97,7 +97,7 @@ module TextFormat_0_0_4 = struct Fmt.pf f "#HELP %a %a@.#TYPE %a %a@.%a" MetricName.pp name output_unquoted help MetricName.pp name output_metric_type metric_type (LabelSetMap.pp ~sep:Fmt.nop (output_metric ~name ~label_names)) - samples) + samples ) end module type Histogram = sig @@ -251,7 +251,7 @@ module Runtime = struct let process_uptime_ms_total = simple_metric ~metric_type:Counter "process_uptime_ms_total" (fun () -> - Core.Time.Span.to_ms (Core.Time.diff (Core.Time.now ()) start_time)) + Core.Time.Span.to_ms (Core.Time.diff (Core.Time.now ()) start_time) ) ~help:"Total time the process has been running for in milliseconds." let metrics = @@ -278,7 +278,7 @@ module Runtime = struct let () = let open CollectorRegistry in List.iter metrics ~f:(fun (info, collector) -> - register default info collector) + register default info collector ) end module Cryptography = struct @@ -1330,7 +1330,7 @@ module Block_latency = struct let total_sum, count_sum = List.fold buckets ~init:(0.0, 0) ~f:(fun (total_sum, count_sum) (total, count) -> - (total_sum +. total, count_sum + count)) + (total_sum +. total, count_sum + count) ) in total_sum /. Float.of_int count_sum end) @@ -1505,7 +1505,7 @@ module Execution_times = struct O1trace.Thread.iter_threads ~f:(fun thread -> let name = O1trace.Thread.name thread in if not (Hashtbl.mem tracked_metrics name) then - Hashtbl.add_exn tracked_metrics ~key:name ~data:(create_metric thread)) + Hashtbl.add_exn tracked_metrics ~key:name ~data:(create_metric thread) ) let () = CollectorRegistry.(register_pre_collect default sync_metrics) end @@ -1567,7 +1567,7 @@ let server ?forward_uri ~port ~logger () = O1trace.background_thread "collect_gc_metrics" Runtime.gc_stat ; O1trace.thread "serve_metrics" (generic_server ?forward_uri ~port ~logger - ~registry:CollectorRegistry.default) + ~registry:CollectorRegistry.default ) module Archive = struct type t = diff --git a/src/lib/mina_net2/bitswap_block.ml b/src/lib/mina_net2/bitswap_block.ml index 647b46a98de..1baa11a0e46 100644 --- a/src/lib/mina_net2/bitswap_block.ml +++ b/src/lib/mina_net2/bitswap_block.ml @@ -113,7 +113,7 @@ let blocks_of_data ~max_block_size data = let link_buf = Bigstring.of_string (Blake2.to_raw_string link) in Bigstring.blit ~src:link_buf ~src_pos:0 ~dst:block ~dst_pos:(2 + (i * link_size)) - ~len:link_size) ; + ~len:link_size ) ; Bigstring.blit ~src:chunk ~src_pos:0 ~dst:block ~dst_pos:(2 + (num_links * link_size)) ~len:chunk_size ; @@ -166,7 +166,7 @@ let parse_block block = List.init num_links ~f:(fun i -> block |> Bigstring.sub_shared ~pos:(2 + (i * link_size)) ~len:link_size - |> Bigstring.to_string |> Blake2.of_raw_string) + |> Bigstring.to_string |> Blake2.of_raw_string ) in let data = Bigstring.sub_shared block ~pos:(2 + (num_links * link_size)) @@ -197,7 +197,7 @@ let data_of_blocks blocks root_hash = List.iter successive_links ~f:(Queue.enqueue links) ; Queue.enqueue chunks chunk done ; - Ok ()) + Ok () ) in let total_data_size = Queue.sum (module Int) chunks ~f:Bigstring.length in let data = Bigstring.create total_data_size in @@ -205,7 +205,7 @@ let data_of_blocks blocks root_hash = ( Queue.fold chunks ~init:0 ~f:(fun dst_pos chunk -> Bigstring.blit ~src:chunk ~src_pos:0 ~dst:data ~dst_pos ~len:(Bigstring.length chunk) ; - dst_pos + Bigstring.length chunk) + dst_pos + Bigstring.length chunk ) : int ) ; data @@ -264,7 +264,7 @@ let%test_module "bitswap blocks" = let result = Or_error.ok_exn (data_of_blocks blocks root_block_hash) in - [%test_eq: Bigstring.t] data result) + [%test_eq: Bigstring.t] data result ) let%test_unit "forall x: schema_of_blocks (blocks_of_data x) = \ create_schema x" = @@ -272,7 +272,7 @@ let%test_module "bitswap blocks" = let schema = create_schema ~max_block_size (Bigstring.length data) in let blocks, root_block_hash = blocks_of_data ~max_block_size data in [%test_eq: schema] schema - (schema_of_blocks ~max_block_size blocks root_block_hash)) + (schema_of_blocks ~max_block_size blocks root_block_hash) ) let%test_unit "when x is aligned (has no partial branch block): \ data_of_blocks (blocks_of_data x) = x" = @@ -305,7 +305,7 @@ let%test_module "bitswap blocks" = (fun () -> f helper) ~finally:(fun () -> let%bind () = Libp2p_helper.shutdown helper in - File_system.remove_dir conf_dir)) + File_system.remove_dir conf_dir ) ) let%test_unit "forall x: libp2p_helper#decode (daemon#encode x) = x" = Quickcheck.test gen ~trials:100 ~f:(fun (max_block_size, data) -> @@ -321,13 +321,13 @@ let%test_module "bitswap blocks" = in Libp2p_helper.do_rpc helper (module TestDecodeBitswapBlocks) - request) + request ) |> Or_error.ok_exn |> Libp2p_ipc.Reader.Libp2pHelperInterface.TestDecodeBitswapBlocks .Response .decoded_data_get |> Bigstring.of_string in - [%test_eq: Bigstring.t] data result) + [%test_eq: Bigstring.t] data result ) let%test_unit "forall x: daemon#decode (libp2p_helper#encode x) = x" = Quickcheck.test gen ~trials:100 ~f:(fun (max_block_size, data) -> @@ -341,7 +341,7 @@ let%test_module "bitswap blocks" = in Libp2p_helper.do_rpc helper (module TestEncodeBitswapBlocks) - request) + request ) |> Or_error.ok_exn in let open Libp2p_ipc.Reader in @@ -356,7 +356,7 @@ let%test_module "bitswap blocks" = let block = Bigstring.of_string @@ BlockWithId.block_get block_with_id in - (hash, block)) + (hash, block) ) in let root_block_hash = Blake2.of_raw_string @@ RootBlockId.blake2b_hash_get @@ -367,5 +367,5 @@ let%test_module "bitswap blocks" = let result = Or_error.ok_exn (data_of_blocks blocks root_block_hash) in - [%test_eq: Bigstring.t] data result) + [%test_eq: Bigstring.t] data result ) end ) diff --git a/src/lib/mina_net2/libp2p_helper.ml b/src/lib/mina_net2/libp2p_helper.ml index 98e54dc8574..8b0af91972c 100644 --- a/src/lib/mina_net2/libp2p_helper.ml +++ b/src/lib/mina_net2/libp2p_helper.ml @@ -48,7 +48,7 @@ module Go_log = struct | Error err -> Error (Printf.sprintf "%sCould not parse field '%s': %s" prefix key - err) ) + err ) ) | None -> Error (Printf.sprintf "%sField '%s' is required" prefix key) in @@ -61,7 +61,7 @@ module Go_log = struct | `Duplicate -> Error (Printf.sprintf "%sField '%s' should not already exist" prefix - good_key) ) + good_key ) ) | None -> Ok map in @@ -85,7 +85,7 @@ module Go_log = struct Some (Logger.Source.create ~module_:(sprintf "Libp2p_helper.Go.%s" r.module_) - ~location:"(not tracked)") + ~location:"(not tracked)" ) ; message = String.concat [ "libp2p_helper: "; r.msg ] ; metadata = r.metadata ; event_id = None @@ -114,8 +114,8 @@ let%test "record_of_yojson 1" = true | Error _ -> false - with _ -> false) - lines) + with _ -> false ) + lines ) [ true; false ] type t = @@ -130,7 +130,7 @@ type t = let handle_libp2p_helper_termination t ~pids ~killed result = Hashtbl.iter t.outstanding_requests ~f:(fun iv -> Ivar.fill_if_empty iv - (Or_error.error_string "libp2p_helper process died before answering")) ; + (Or_error.error_string "libp2p_helper process died before answering") ) ; Hashtbl.clear t.outstanding_requests ; Child_processes.Termination.remove pids (Child_processes.pid t.process) ; if (not killed) && not t.finished then ( @@ -201,13 +201,13 @@ let handle_incoming_message t msg ~handle_push_message = | None -> [%log' error t.logger] "Attempted to fill outstanding libp2p_helper RPC request, but \ - not outstanding request was found") ; + not outstanding request was found" ) ; Deferred.unit | PushMessage push_msg -> O1trace.thread "handle_libp2p_ipc_push" (fun () -> let push_header = DaemonInterface.PushMessage.header_get push_msg in record_message_delay (PushMessageHeader.time_sent_get push_header) ; - handle_push_message t (DaemonInterface.PushMessage.get push_msg)) + handle_push_message t (DaemonInterface.PushMessage.get push_msg) ) | Undefined n -> Libp2p_ipc.undefined_union ~context:"DaemonInterface.Message" n ; Deferred.unit @@ -223,7 +223,7 @@ let spawn ~logger ~pids ~conf_dir ~handle_push_message = ~termination: (`Handler (fun ~killed _process result -> - !termination_handler ~killed result))) + !termination_handler ~killed result ) ) ) with | Error e -> Or_error.tag (Error e) @@ -265,7 +265,7 @@ let spawn ~logger ~pids ~conf_dir ~handle_push_message = "failed to parse record over libp2p_helper stderr: \ $error" ~metadata:[ ("error", `String error) ] ) ; - Deferred.unit)) ; + Deferred.unit ) ) ; O1trace.background_thread "handle_libp2p_ipc_incoming" (fun () -> Child_processes.stdout process |> Libp2p_ipc.read_incoming_messages @@ -281,7 +281,7 @@ let spawn ~logger ~pids ~conf_dir ~handle_push_message = $error" ~metadata: [ ("error", `String (Error.to_string_hum error)) ] ; - Deferred.unit)) ; + Deferred.unit ) ) ; Or_error.return t let shutdown t = diff --git a/src/lib/mina_net2/libp2p_helper.mli b/src/lib/mina_net2/libp2p_helper.mli index d7ce36c5309..77895e64844 100644 --- a/src/lib/mina_net2/libp2p_helper.mli +++ b/src/lib/mina_net2/libp2p_helper.mli @@ -11,7 +11,7 @@ val spawn : -> handle_push_message: ( t -> Libp2p_ipc.Reader.DaemonInterface.PushMessage.unnamed_union_t - -> unit Deferred.t) + -> unit Deferred.t ) -> t Deferred.Or_error.t val shutdown : t -> unit Deferred.t diff --git a/src/lib/mina_net2/libp2p_stream.ml b/src/lib/mina_net2/libp2p_stream.ml index 070fe13cf65..dd44cf75b40 100644 --- a/src/lib/mina_net2/libp2p_stream.ml +++ b/src/lib/mina_net2/libp2p_stream.ml @@ -155,7 +155,7 @@ let create_from_existing ~logger ~helper ~stream_id ~protocol ~peer [ ("idx", `String (Libp2p_ipc.stream_id_to_string stream_id)) ; ("error", Error_json.error_to_yojson e) ] ; - Pipe.close outgoing_w) + Pipe.close outgoing_w ) (* TODO implement proper stream closing *) (* >>= ( fun () -> match%map Libp2p_helper.do_rpc helper @@ -175,7 +175,7 @@ let create_from_existing ~logger ~helper ~stream_id ~protocol ~peer let (`Stream_should_be_released should_release) = stream_closed ~logger ~who_closed:Us t in - if should_release then release_stream t.id) ; + if should_release then release_stream t.id ) ; t (* TODO: should we really even be parsing the peer back from the client here? diff --git a/src/lib/mina_net2/mina_net2.ml b/src/lib/mina_net2/mina_net2.ml index 7187adfbd1e..db379a7315b 100644 --- a/src/lib/mina_net2/mina_net2.ml +++ b/src/lib/mina_net2/mina_net2.ml @@ -44,7 +44,7 @@ let gating_config_to_helper_format (config : connection_gating) = ~f:(fun p -> let p = Unix.Inet_addr.to_string p.host in (* Trusted peers cannot be banned. *) - if Set.mem trusted p then None else Some p) + if Set.mem trusted p then None else Some p ) config.banned_peers in let banned_peers = @@ -106,7 +106,7 @@ module Pubsub = struct let topic_subscription_already_exists = Hashtbl.data t.subscriptions |> List.exists ~f:(fun (Subscription.E sub') -> - String.equal (Subscription.topic sub') topic) + String.equal (Subscription.topic sub') topic ) in if topic_subscription_already_exists then Deferred.Or_error.errorf "already subscribed to topic %s" topic @@ -125,11 +125,11 @@ module Pubsub = struct ~decode:(fun msg_str -> let b = Bigstring.of_string msg_str in Bigstring.read_bin_prot b bin_prot.Bin_prot.Type_class.reader - |> Or_error.map ~f:fst) + |> Or_error.map ~f:fst ) ~encode:(fun msg -> Bin_prot.Utils.bin_dump ~header:true bin_prot.Bin_prot.Type_class.writer msg - |> Bigstring.to_string) + |> Bigstring.to_string ) ~handle_and_validate_incoming_message ~on_decode_failure t topic let subscribe = @@ -185,7 +185,7 @@ let bandwidth_info t = let input_bandwidth = input_bandwidth_get response and output_bandwidth = output_bandwidth_get response and cpu_usage = cpu_usage_get response in - (`Input input_bandwidth, `Output output_bandwidth, `Cpu_usage cpu_usage)) + (`Input input_bandwidth, `Output output_bandwidth, `Cpu_usage cpu_usage) ) @@ Libp2p_helper.do_rpc t.helper (module Libp2p_ipc.Rpcs.BandwidthInfo) (Libp2p_ipc.Rpcs.BandwidthInfo.create_request ()) @@ -230,7 +230,7 @@ let listen_on t iface = Libp2p_helper.do_rpc t.helper (module Libp2p_ipc.Rpcs.Listen) (Libp2p_ipc.Rpcs.Listen.create_request - ~iface:(Multiaddr.to_libp2p_ipc iface)) + ~iface:(Multiaddr.to_libp2p_ipc iface) ) in let open Libp2p_ipc.Reader.Libp2pHelperInterface.Listen.Response in result_get_list response |> List.map ~f:Multiaddr.of_libp2p_ipc @@ -279,7 +279,7 @@ let close_protocol ?(reset_existing_streams = false) t ~protocol = [%log' error t.logger] "failed to reset stream while closing protocol: $error" ~metadata:[ ("error", `String (Error.to_string_hum e)) ] ) ; - false )) ; + false ) ) ; match result with | Ok _ -> Hashtbl.remove t.protocol_handlers protocol @@ -326,7 +326,7 @@ let set_connection_gating_config t config = Libp2p_helper.do_rpc t.helper (module Libp2p_ipc.Rpcs.SetGatingConfig) (Libp2p_ipc.Rpcs.SetGatingConfig.create_request - ~gating_config:(gating_config_to_helper_format config)) + ~gating_config:(gating_config_to_helper_format config) ) with | Ok _ -> t.connection_gating <- config ; @@ -347,13 +347,13 @@ let handle_push_message t push_message = let peer_id = Libp2p_ipc.unsafe_parse_peer_id (PeerConnected.peer_id_get m) in - t.peer_connected_callback peer_id) + t.peer_connected_callback peer_id ) | PeerDisconnected m -> handle "handle_libp2p_helper_subprocess_push_peer_disconnected" (fun () -> let peer_id = Libp2p_ipc.unsafe_parse_peer_id (PeerDisconnected.peer_id_get m) in - t.peer_disconnected_callback peer_id) + t.peer_disconnected_callback peer_id ) | GossipReceived m -> handle "handle_libp2p_helper_subprocess_push_gossip_received" (fun () -> let open GossipReceived in @@ -369,7 +369,7 @@ let handle_push_message t push_message = upon (O1trace.thread "validate_libp2p_gossip" (fun () -> Subscription.handle_and_validate sub ~validation_expiration - ~sender ~data)) + ~sender ~data ) ) (function | `Validation_timeout -> [%log' warn t.logger] @@ -389,7 +389,7 @@ let handle_push_message t push_message = ~validation_result:ValidationResult.Reject | `Validation_result validation_result -> Libp2p_helper.send_validation t.helper ~validation_id - ~validation_result) + ~validation_result ) | None -> [%log' error t.logger] "asked to validate message for unregistered subscription id \ @@ -397,7 +397,7 @@ let handle_push_message t push_message = ~metadata: [ ( "subscription_id" , `String (Subscription.Id.to_string subscription_id) ) - ]) + ] ) (* A new inbound stream was opened *) | IncomingStream m -> handle "handle_libp2p_helper_subprocess_push_incoming_stream" (fun () -> @@ -412,7 +412,7 @@ let handle_push_message t push_message = t.all_peers_seen <- Some all_peers_seen ; Mina_metrics.( Gauge.set Network.all_peers - (Set.length all_peers_seen |> Int.to_float))) ; + (Set.length all_peers_seen |> Int.to_float)) ) ; let stream = Libp2p_stream.create_from_existing ~logger:t.logger ~helper:t.helper ~stream_id ~protocol ~peer ~release_stream:(release_stream t) @@ -452,11 +452,11 @@ let handle_push_message t push_message = Libp2p_helper.do_rpc t.helper (module Libp2p_ipc.Rpcs.RemoveStreamHandler) (Libp2p_ipc.Rpcs.RemoveStreamHandler - .create_request ~protocol) + .create_request ~protocol ) in if Or_error.is_ok result then - Hashtbl.remove t.protocol_handlers protocol) ; - raise handler_exn )) ) + Hashtbl.remove t.protocol_handlers protocol ) ; + raise handler_exn ) ) ) else (* silently ignore new streams for closed protocol handlers. these are buffered stream open RPCs that were enqueued before @@ -468,7 +468,7 @@ let handle_push_message t push_message = | None -> (* TODO: punish *) [%log' error t.logger] - "incoming stream for protocol we don't know about?") + "incoming stream for protocol we don't know about?" ) (* Received a message on some stream *) | StreamMessageReceived m -> handle "handle_libp2p_helper_subprocess_push_stream_message_received" @@ -485,7 +485,7 @@ let handle_push_message t push_message = Libp2p_stream.data_received stream data | None -> [%log' error t.logger] - "incoming stream message for stream we don't know about?") + "incoming stream message for stream we don't know about?" ) (* Stream was reset, either by the remote peer or an error on our end. *) | StreamLost m -> handle "handle_libp2p_helper_subprocess_push_stream_lost" (fun () -> @@ -507,7 +507,7 @@ let handle_push_message t push_message = ~metadata: [ ("error", `String reason) ; ("id", `String (Libp2p_ipc.stream_id_to_string stream_id)) - ]) + ] ) (* The remote peer closed its write end of one of our streams *) | StreamComplete m -> handle "handle_libp2p_helper_subprocess_push_stream_complete" (fun () -> @@ -524,7 +524,7 @@ let handle_push_message t push_message = | None -> [%log' error t.logger] "streamReadComplete for stream we don't know about $stream_id" - ~metadata:[ ("stream_id", `String stream_id_str) ]) + ~metadata:[ ("stream_id", `String stream_id_str) ] ) | ResourceUpdated _ -> [%log' error t.logger] "resourceUpdated upcall not supported yet" | Undefined n -> @@ -536,13 +536,13 @@ let create ~all_peers_seen_metric ~logger ~pids ~conf_dir ~on_peer_connected let push_message_handler = ref (fun _msg -> [%log error] - "received push message from libp2p_helper before handler was attached") + "received push message from libp2p_helper before handler was attached" ) in let%bind helper = O1trace.thread "manage_libp2p_helper_subprocess" (fun () -> Libp2p_helper.spawn ~logger ~pids ~conf_dir ~handle_push_message:(fun _helper msg -> - Deferred.return (!push_message_handler msg))) + Deferred.return (!push_message_handler msg) ) ) in let t = { helper @@ -574,7 +574,7 @@ let create ~all_peers_seen_metric ~logger ~pids ~conf_dir ~on_peer_connected ~f:(fun peer (num_batches, num_in_batch, batches, batch) -> if num_in_batch >= log_message_batch_size then (num_batches + 1, 1, batch :: batches, [ peer ]) - else (num_batches, num_in_batch + 1, batches, peer :: batch)) + else (num_batches, num_in_batch + 1, batches, peer :: batch) ) in let num_batches, batches = if num_in_batch > 0 then (num_batches + 1, batch :: batches) @@ -588,5 +588,5 @@ let create ~all_peers_seen_metric ~logger ~pids ~conf_dir ~on_peer_connected ; ("num_batches", `Int num_batches) ; ( "peers" , `List (List.map ~f:Peer_without_id.to_yojson batch) ) - ]))) ) ; + ] ) ) ) ) ; Deferred.Or_error.return t diff --git a/src/lib/mina_net2/mina_net2.mli b/src/lib/mina_net2/mina_net2.mli index 13927f8503f..c9fdbbacdb9 100644 --- a/src/lib/mina_net2/mina_net2.mli +++ b/src/lib/mina_net2/mina_net2.mli @@ -207,9 +207,7 @@ module Pubsub : sig t -> string -> handle_and_validate_incoming_message: - ( string Envelope.Incoming.t - -> Validation_callback.t - -> unit Deferred.t) + (string Envelope.Incoming.t -> Validation_callback.t -> unit Deferred.t) -> string subscription Deferred.Or_error.t (** Like [subscribe], but knows how to stringify/destringify diff --git a/src/lib/mina_net2/multiaddr.ml b/src/lib/mina_net2/multiaddr.ml index 8eea00ed009..d724754b308 100644 --- a/src/lib/mina_net2/multiaddr.ml +++ b/src/lib/mina_net2/multiaddr.ml @@ -40,4 +40,4 @@ let of_file_contents contents : t list = [%log' error (Logger.create ())] "Invalid peer $peer found in peers list" ~metadata:[ ("peer", `String s) ] ; - false )) + false ) ) diff --git a/src/lib/mina_net2/tests/all_ipc.ml b/src/lib/mina_net2/tests/all_ipc.ml index 6093e2ceaca..679776960be 100644 --- a/src/lib/mina_net2/tests/all_ipc.ml +++ b/src/lib/mina_net2/tests/all_ipc.ml @@ -1,22 +1,22 @@ (* Test all IPCs. -This test executes a simulation with 3 nodes: Alice, Bob and Carol. + This test executes a simulation with 3 nodes: Alice, Bob and Carol. -Topology of the network: - * Yota <--> Alice - * Yota <--> Bob - * Yota <--> Carol - * Alice <--> Bob - * Alice <--> Carol + Topology of the network: + * Yota <--> Alice + * Yota <--> Bob + * Yota <--> Carol + * Alice <--> Bob + * Alice <--> Carol -Additional libp2p helper Yota is launched to correctly setup routing on -Alice and Bob. Yota performs no active actions. Note, that there is no connection -between Bob and Carol (this is implemented by banning Carol's peer id in configuration -of Bob). + Additional libp2p helper Yota is launched to correctly setup routing on + Alice and Bob. Yota performs no active actions. Note, that there is no connection + between Bob and Carol (this is implemented by banning Carol's peer id in configuration + of Bob). -Each node runs its own sequence of actions. Some actions have an effect of -synchronizing nodes (see comments in the code). + Each node runs its own sequence of actions. Some actions have an effect of + synchronizing nodes (see comments in the code). -All upcalls and RPC request/response pairs are tested this way. *) + All upcalls and RPC request/response pairs are tested this way. *) open Core open Async @@ -178,7 +178,7 @@ let%test_module "all-ipc test" = | Connected -> true | _ -> - raise UnexpectedState) + raise UnexpectedState ) |> or_timeout ~msg:"Alice: connect to Bob" in (* Get addresses of Alice *) @@ -194,7 +194,7 @@ let%test_module "all-ipc test" = | Connected -> true | _ -> - raise UnexpectedState) + raise UnexpectedState ) |> or_timeout ~msg:"Alice: wait for Carol to connect" in (* Subscribe to topic "c" *) @@ -213,7 +213,7 @@ let%test_module "all-ipc test" = check_msg env cb topic_c_received_2 ad.b_peerid `Accept else raise UnexpectedState ; if !topic_c_received_1 && !topic_c_received_2 then - Ivar.fill_if_empty topic_c_received_ivar () )) + Ivar.fill_if_empty topic_c_received_ivar () ) ) in (* Subscribe to topic "a" *) let topic_a_received_1 = ref false in @@ -234,7 +234,7 @@ let%test_module "all-ipc test" = if !topic_a_received_1 && !topic_a_received_2 && !topic_a_received_3 - then Ivar.fill_if_empty topic_a_received_ivar () )) + then Ivar.fill_if_empty topic_a_received_ivar () ) ) >>| Or_error.ok_exn in (* Open stream 1 to Bob *) @@ -287,7 +287,7 @@ let%test_module "all-ipc test" = let s_in, _ = Libp2p_stream.pipes s in Pipe.read s_in >>| expectEof | _ -> - Deferred.unit) + Deferred.unit ) |> or_timeout ~msg:"Stream 3 opening to fail" in @@ -326,7 +326,7 @@ let%test_module "all-ipc test" = ~f:(fun b_acc pid -> b_acc && List.fold peers ~init:false ~f:(fun acc p -> - acc || String.equal p.peer_id pid)) ) ; + acc || String.equal p.peer_id pid ) ) ) ; (* Ban Carol in Alice's gating config *) let%bind _ = @@ -343,7 +343,7 @@ let%test_module "all-ipc test" = | Disconnected -> true | _ -> - raise UnexpectedState) + raise UnexpectedState ) |> or_timeout ~msg:"Alice: wait for Carol to disconnect" in @@ -356,7 +356,7 @@ let%test_module "all-ipc test" = | Connected -> false | _ -> - raise UnexpectedState) + raise UnexpectedState ) |> or_timeout ~msg:"Alice: wait for Bob to disconnect" let bob b ad (pc, _) msgs = @@ -368,7 +368,7 @@ let%test_module "all-ipc test" = let streams_r, streams_w = Pipe.create () in let%bind () = open_protocol ~protocol ~on_handler_error:`Raise b (fun stream -> - Pipe.write streams_w stream) + Pipe.write streams_w stream ) >>| Or_error.ok_exn in (* Await connection to succeed *) @@ -381,7 +381,7 @@ let%test_module "all-ipc test" = | Connected -> true | _ -> - raise UnexpectedState) + raise UnexpectedState ) |> or_timeout ~msg:"Bob: Alice connected" in (* Set Bob's node status *) @@ -396,7 +396,7 @@ let%test_module "all-ipc test" = ( if String.equal env.data msgs.topic_a_msg_1 then check_msg env cb topic_a_received_1 ad.a_peerid `Accept else raise UnexpectedState ; - Ivar.fill topic_a_received_ivar () )) + Ivar.fill topic_a_received_ivar () ) ) >>| Or_error.ok_exn in (* Subscribe to topic "c" *) @@ -405,7 +405,7 @@ let%test_module "all-ipc test" = ~on_decode_failure:(`Call (fun _ _ -> raise UnexpectedState)) ~bin_prot:bin_typed_msg ~handle_and_validate_incoming_message:(fun _ _ -> - raise UnexpectedState) + raise UnexpectedState ) >>| Or_error.ok_exn in (* Await for stream1 to open *) @@ -460,7 +460,7 @@ let%test_module "all-ipc test" = let streams_r, streams_w = Pipe.create () in let%bind () = open_protocol ~protocol ~on_handler_error:`Raise c (fun stream -> - Pipe.write streams_w stream) + Pipe.write streams_w stream ) >>| Or_error.ok_exn in (* Await connection to succeed *) @@ -473,7 +473,7 @@ let%test_module "all-ipc test" = | Connected -> true | _ -> - raise UnexpectedState) + raise UnexpectedState ) |> or_timeout ~msg:"Carol: Alice connected" in @@ -522,7 +522,7 @@ let%test_module "all-ipc test" = | Connected -> false | _ -> - raise UnexpectedState) + raise UnexpectedState ) |> or_timeout ~msg:"Carol: wait for Alice to disconnect" let def_gating_config = @@ -554,7 +554,8 @@ let%test_module "all-ipc test" = ~direct_peers:[] ~seed_peers ~flooding:false ~metrics_port:None ~unsafe_no_trust_ip:true ~min_connections:25 ~max_connections:50 ~validation_queue_size:150 ~initial_gating_config:gating_config - ~known_private_ip_nets:[] ~topic_config:[ [ topic_a; topic_c ] ] + ~known_private_ip_nets:[] + ~topic_config:[ [ topic_a; topic_c ] ] >>| Or_error.ok_exn in let%bind raw_seed_peers = listening_addrs node >>| Or_error.ok_exn in diff --git a/src/lib/mina_net2/tests/tests.ml b/src/lib/mina_net2/tests/tests.ml index 02ab019c7b1..185c1f97a31 100644 --- a/src/lib/mina_net2/tests/tests.ml +++ b/src/lib/mina_net2/tests/tests.ml @@ -135,14 +135,14 @@ let%test_module "coda network tests" = else failwith (Printf.sprintf "Unexpected string %s not matches %d" s - !j) + !j ) done ; go !j in go 1000 >>| fun () -> Pipe.close w ; - Ivar.fill handler_finished ()) + Ivar.fill handler_finished () ) >>| Or_error.ok_exn in let%bind stream = @@ -176,7 +176,7 @@ let%test_module "coda network tests" = let r, w = Libp2p_stream.pipes stream in let%map () = Pipe.transfer r w ~f:Fn.id in Pipe.close w ; - Ivar.fill_if_empty handler_finished ()) + Ivar.fill_if_empty handler_finished () ) |> Deferred.Or_error.ok_exn in let%bind stream = diff --git a/src/lib/mina_networking/mina_networking.ml b/src/lib/mina_networking/mina_networking.ml index 77423cb4f64..0476c6ceaf6 100644 --- a/src/lib/mina_networking/mina_networking.ml +++ b/src/lib/mina_networking/mina_networking.ml @@ -454,7 +454,7 @@ module Rpcs = struct let map_proof_caryying_data_option ~f = Option.map ~f:(fun { Proof_carrying_data.data; proof = hashes, block } -> - { Proof_carrying_data.data = f data; proof = (hashes, f block) }) + { Proof_carrying_data.data = f data; proof = (hashes, f block) } ) module Get_ancestry = struct module Master = struct @@ -1053,33 +1053,33 @@ let protocol_version_status t = let create (config : Config.t) ~sinks ~(get_some_initial_peers : Rpcs.Get_some_initial_peers.query Envelope.Incoming.t - -> Rpcs.Get_some_initial_peers.response Deferred.t) + -> Rpcs.Get_some_initial_peers.response Deferred.t ) ~(get_staged_ledger_aux_and_pending_coinbases_at_hash : Rpcs.Get_staged_ledger_aux_and_pending_coinbases_at_hash.query Envelope.Incoming.t -> Rpcs.Get_staged_ledger_aux_and_pending_coinbases_at_hash.response - Deferred.t) + Deferred.t ) ~(answer_sync_ledger_query : Rpcs.Answer_sync_ledger_query.query Envelope.Incoming.t - -> Rpcs.Answer_sync_ledger_query.response Deferred.t) + -> Rpcs.Answer_sync_ledger_query.response Deferred.t ) ~(get_ancestry : Rpcs.Get_ancestry.query Envelope.Incoming.t - -> Rpcs.Get_ancestry.response Deferred.t) + -> Rpcs.Get_ancestry.response Deferred.t ) ~(get_best_tip : Rpcs.Get_best_tip.query Envelope.Incoming.t - -> Rpcs.Get_best_tip.response Deferred.t) + -> Rpcs.Get_best_tip.response Deferred.t ) ~(get_node_status : Rpcs.Get_node_status.query Envelope.Incoming.t - -> Rpcs.Get_node_status.response Deferred.t) + -> Rpcs.Get_node_status.response Deferred.t ) ~(get_transition_chain_proof : Rpcs.Get_transition_chain_proof.query Envelope.Incoming.t - -> Rpcs.Get_transition_chain_proof.response Deferred.t) + -> Rpcs.Get_transition_chain_proof.response Deferred.t ) ~(get_transition_chain : Rpcs.Get_transition_chain.query Envelope.Incoming.t - -> Rpcs.Get_transition_chain.response Deferred.t) + -> Rpcs.Get_transition_chain.response Deferred.t ) ~(get_transition_knowledge : Rpcs.Get_transition_knowledge.query Envelope.Incoming.t - -> Rpcs.Get_transition_knowledge.response Deferred.t) = + -> Rpcs.Get_transition_knowledge.response Deferred.t ) = let logger = config.logger in let run_for_rpc_result conn data ~f action_msg msg_args = let data_in_envelope = wrap_rpc_data_in_envelope conn data in @@ -1123,7 +1123,7 @@ let create (config : Config.t) ~sinks , `String (Protocol_version.to_string (Header.current_protocol_version - (Mina_block.header external_transition))) ) + (Mina_block.header external_transition) ) ) ) ] ) ) in Trust_system.record_envelope_sender config.trust_system config.logger @@ -1143,7 +1143,7 @@ let create (config : Config.t) ~sinks (Protocol_version.to_string (Option.value_exn (Header.proposed_protocol_version_opt - (Mina_block.header external_transition)))) ) + (Mina_block.header external_transition) ) ) ) ) ] ) ) in Trust_system.record_envelope_sender config.trust_system config.logger @@ -1162,7 +1162,7 @@ let create (config : Config.t) ~sinks , `String (Protocol_version.to_string (Header.current_protocol_version - (Mina_block.header external_transition))) ) + (Mina_block.header external_transition) ) ) ) ; ( "daemon_current_protocol_version" , `String Protocol_version.(to_string @@ get_current ()) ) ] ) ) @@ -1320,7 +1320,7 @@ let create (config : Config.t) ~sinks Deferred.List.map ext_trans ~f: (validate_protocol_versions ~rpc_name:"Get_transition_chain" - sender) + sender ) in if List.for_all valid_protocol_versions ~f:(Bool.equal true) then result else None @@ -1401,14 +1401,14 @@ let create (config : Config.t) ~sinks (rpc_handlers ~logger:config.logger ~local_state:config.consensus_local_state ~genesis_ledger_hash: - (Frozen_ledger_hash.of_ledger_hash config.genesis_ledger_hash)) + (Frozen_ledger_hash.of_ledger_hash config.genesis_ledger_hash) ) ~f:(fun (Rpc_handler { rpc; f; cost; budget }) -> - Rpcs.(Rpc_handler { rpc = Consensus_rpc rpc; f; cost; budget }))) + Rpcs.(Rpc_handler { rpc = Consensus_rpc rpc; f; cost; budget }) )) in let%map gossip_net = O1trace.thread "gossip_net" (fun () -> Gossip_net.Any.create config.creatable_gossip_net rpc_handlers - (Gossip_net.Message.Any_sinks ((module Sinks), sinks))) + (Gossip_net.Message.Any_sinks ((module Sinks), sinks)) ) in (* The node status RPC is implemented directly in go, serving a string which is periodically updated. This is so that one can make this RPC on a node even @@ -1426,7 +1426,7 @@ let create (config : Config.t) ~sinks Gossip_net.Any.set_node_status gossip_net ( Rpcs.Get_node_status.Node_status.to_yojson data |> Yojson.Safe.to_string ) - >>| ignore)) ; + >>| ignore ) ) ; don't_wait_for (Gossip_net.Any.on_first_connect gossip_net ~f:(fun () -> (* After first_connect this list will only be empty if we filtered out all the peers due to mismatched chain id. *) @@ -1436,7 +1436,7 @@ let create (config : Config.t) ~sinks [%log fatal] "Failed to connect to any initial peers, possible chain id \ mismatch" ; - raise No_initial_peers )))) ; + raise No_initial_peers ) ) ) ) ; (* TODO: Think about buffering: I.e., what do we do when too many messages are coming in, or going out. For example, some things you really want to not drop (like your outgoing @@ -1464,7 +1464,7 @@ include struct | Ok x -> x | Error e -> - failwith e) + failwith e ) |> Deferred.return let add_peer = lift add_peer @@ -1505,7 +1505,7 @@ let broadcast_state t state = log_gossip t.logger (Gossip_net.Message.New_state msg) ~log_msg: (Gossip_new_state - { state_hash = State_hash.With_state_hashes.state_hash state }) ; + { state_hash = State_hash.With_state_hashes.state_hash state } ) ; Mina_metrics.(Gauge.inc_one Network.new_state_broadcasted) ; Gossip_net.Any.broadcast_state t.gossip_net msg @@ -1522,7 +1522,7 @@ let broadcast_snark_pool_diff t diff = (Gossip_snark_pool_diff { work = Option.value_exn (Snark_pool.Resource_pool.Diff.to_compact diff) - }) ; + } ) ; Gossip_net.Any.broadcast_snark_pool_diff t.gossip_net diff (* TODO: Don't copy and paste *) @@ -1537,7 +1537,7 @@ let find_map' xs ~f = (* TODO: Validation applicative here *) if List.for_all ds ~f:Or_error.is_error then return (Or_error.error_string "all none") - else Deferred.never ()) + else Deferred.never () ) in Deferred.any (none_worked :: List.map ~f:(filter ~f:Or_error.is_ok) ds) @@ -1580,7 +1580,7 @@ let try_non_preferred_peers (type b) t input peers ~rpc : if num_peers > max_current_peers then return (Or_error.error_string - "None of randomly-chosen peers can handle the request") + "None of randomly-chosen peers can handle the request" ) else let current_peers, remaining_peers = List.split_n peers num_peers in find_map' current_peers ~f:(fun peer -> @@ -1601,7 +1601,7 @@ let try_non_preferred_peers (type b) t input peers ~rpc : | Connected { data = Ok None; _ } -> loop remaining_peers (2 * num_peers) | _ -> - loop remaining_peers (2 * num_peers)) + loop remaining_peers (2 * num_peers) ) in loop peers 1 @@ -1679,24 +1679,24 @@ module Sl_downloader = struct include Hashable.Make (T) end - include Downloader.Make - (Key) - (struct - type t = unit [@@deriving to_yojson] + include + Downloader.Make + (Key) + (struct + type t = unit [@@deriving to_yojson] - let download : t = () + let download : t = () - let worth_retrying () = true - end) - (struct - type t = - (Mina_base.Ledger_hash.t * Sync_ledger.Query.t) - * Sync_ledger.Answer.t - [@@deriving to_yojson] + let worth_retrying () = true + end) + (struct + type t = + (Mina_base.Ledger_hash.t * Sync_ledger.Query.t) * Sync_ledger.Answer.t + [@@deriving to_yojson] - let key = fst - end) - (Ledger_hash) + let key = fst + end) + (Ledger_hash) end let glue_sync_ledger : @@ -1736,7 +1736,7 @@ let glue_sync_ledger : List.iter qs ~f:(fun (h, _) -> if not (Ledger_hash.equal h (Broadcast_pipe.Reader.peek root_hash_r)) - then don't_wait_for (Broadcast_pipe.Writer.write root_hash_w h)) ; + then don't_wait_for (Broadcast_pipe.Writer.write root_hash_w h) ) ; let%map rs = query_peer' ~how:`Parallel ~heartbeat_timeout ~timeout:(Time.Span.of_sec (Float.of_int (List.length qs) *. 2.)) @@ -1756,8 +1756,8 @@ let glue_sync_ledger : | Ok ps -> Ok (List.filter_map ps ~f:(fun (q, r) -> - match r with Ok r -> Some (q, r) | Error _ -> None)) - ) )) + match r with Ok r -> Some (q, r) | Error _ -> None ) + ) ) ) ) in don't_wait_for (let%bind downloader = downloader in @@ -1770,4 +1770,4 @@ let glue_sync_ledger : Deferred.unit | Ok (a, _) -> Linear_pipe.write_if_open response_writer - (fst q, snd q, { a with data = snd a.data }))) + (fst q, snd q, { a with data = snd a.data }) ) ) diff --git a/src/lib/mina_networking/mina_networking.mli b/src/lib/mina_networking/mina_networking.mli index cf53af9c3f6..b2d864d8f5b 100644 --- a/src/lib/mina_networking/mina_networking.mli +++ b/src/lib/mina_networking/mina_networking.mli @@ -283,31 +283,31 @@ val create : -> sinks:Sinks.t -> get_some_initial_peers: ( Rpcs.Get_some_initial_peers.query Envelope.Incoming.t - -> Rpcs.Get_some_initial_peers.response Deferred.t) + -> Rpcs.Get_some_initial_peers.response Deferred.t ) -> get_staged_ledger_aux_and_pending_coinbases_at_hash: ( Rpcs.Get_staged_ledger_aux_and_pending_coinbases_at_hash.query Envelope.Incoming.t -> Rpcs.Get_staged_ledger_aux_and_pending_coinbases_at_hash.response - Deferred.t) + Deferred.t ) -> answer_sync_ledger_query: ( Rpcs.Answer_sync_ledger_query.query Envelope.Incoming.t - -> Rpcs.Answer_sync_ledger_query.response Deferred.t) + -> Rpcs.Answer_sync_ledger_query.response Deferred.t ) -> get_ancestry: ( Rpcs.Get_ancestry.query Envelope.Incoming.t - -> Rpcs.Get_ancestry.response Deferred.t) + -> Rpcs.Get_ancestry.response Deferred.t ) -> get_best_tip: ( Rpcs.Get_best_tip.query Envelope.Incoming.t - -> Rpcs.Get_best_tip.response Deferred.t) + -> Rpcs.Get_best_tip.response Deferred.t ) -> get_node_status: ( Rpcs.Get_node_status.query Envelope.Incoming.t - -> Rpcs.Get_node_status.response Deferred.t) + -> Rpcs.Get_node_status.response Deferred.t ) -> get_transition_chain_proof: ( Rpcs.Get_transition_chain_proof.query Envelope.Incoming.t - -> Rpcs.Get_transition_chain_proof.response Deferred.t) + -> Rpcs.Get_transition_chain_proof.response Deferred.t ) -> get_transition_chain: ( Rpcs.Get_transition_chain.query Envelope.Incoming.t - -> Rpcs.Get_transition_chain.response Deferred.t) + -> Rpcs.Get_transition_chain.response Deferred.t ) -> get_transition_knowledge: ( Rpcs.Get_transition_knowledge.query Envelope.Incoming.t - -> Rpcs.Get_transition_knowledge.response Deferred.t) + -> Rpcs.Get_transition_knowledge.response Deferred.t ) -> t Deferred.t diff --git a/src/lib/mina_numbers/nat.ml b/src/lib/mina_numbers/nat.ml index fcd1fc2fa1f..5233f0bb948 100644 --- a/src/lib/mina_numbers/nat.ml +++ b/src/lib/mina_numbers/nat.ml @@ -28,7 +28,7 @@ struct (Field.Checked.choose_preimage_var t ~length:N.length_in_bits) in Checked.map (to_bits t) ~f:(fun bits -> - Random_oracle.Input.Legacy.bitstring bits) + Random_oracle.Input.Legacy.bitstring bits ) let constant n = Field.Var.constant @@ -56,7 +56,7 @@ struct let of_bits bs = (* TODO: Make this efficient *) List.foldi bs ~init:N.zero ~f:(fun i acc b -> - if b then N.(logor (shift_left one i) acc) else acc) + if b then N.(logor (shift_left one i) acc) else acc ) in of_bits (List.take (Field.unpack x) N.length_in_bits) @@ -111,7 +111,7 @@ struct let ( < ) a b = make_checked (fun () -> let open Pickles.Impls.Step in - Boolean.( &&& ) (gte b a) (Boolean.not (Field.equal b a))) + Boolean.( &&& ) (gte b a) (Boolean.not (Field.equal b a)) ) let ( > ) a b = b < a @@ -235,7 +235,7 @@ struct Quickcheck.Generator.map ~f:(fun n -> N.of_string (Bignum_bigint.to_string n)) (Bignum_bigint.gen_incl Bignum_bigint.zero - (Bignum_bigint.of_string N.(to_string max_int))) + (Bignum_bigint.of_string N.(to_string max_int)) ) let gen_incl min max = let open Quickcheck.Let_syntax in @@ -262,18 +262,19 @@ module Make32 () : UInt32 = struct end end] - include Make - (struct - include UInt32 + include + Make + (struct + include UInt32 - let random () = - let mask = if Random.bool () then one else zero in - let open UInt32.Infix in - logor (mask lsl 31) - ( Int32.max_value |> Random.int32 |> Int64.of_int32 - |> UInt32.of_int64 ) - end) - (Bits.UInt32) + let random () = + let mask = if Random.bool () then one else zero in + let open UInt32.Infix in + logor (mask lsl 31) + ( Int32.max_value |> Random.int32 |> Int64.of_int32 + |> UInt32.of_int64 ) + end) + (Bits.UInt32) let to_uint32 = Unsigned_extended.UInt32.to_uint32 @@ -295,17 +296,18 @@ module Make64 () : UInt64 = struct end end] - include Make - (struct - include UInt64 - - let random () = - let mask = if Random.bool () then one else zero in - let open UInt64.Infix in - logor (mask lsl 63) - (Int64.max_value |> Random.int64 |> UInt64.of_int64) - end) - (Bits.UInt64) + include + Make + (struct + include UInt64 + + let random () = + let mask = if Random.bool () then one else zero in + let open UInt64.Infix in + logor (mask lsl 63) + (Int64.max_value |> Random.int64 |> UInt64.of_int64) + end) + (Bits.UInt64) let to_uint64 = Unsigned_extended.UInt64.to_uint64 diff --git a/src/lib/mina_plugins/mina_plugins.ml b/src/lib/mina_plugins/mina_plugins.ml index e6cdb16ac91..de2ac1edcfa 100644 --- a/src/lib/mina_plugins/mina_plugins.ml +++ b/src/lib/mina_plugins/mina_plugins.ml @@ -23,5 +23,5 @@ let init_plugins ~logger coda plugin_paths = [ ("path", `String path) ; ("error", `String (Dynlink.error_message err)) ] ; - raise exn) ; + raise exn ) ; mina_lib' := None diff --git a/src/lib/mina_state/ancestor.ml b/src/lib/mina_state/ancestor.ml index 4d9fe6efa21..79d29d1901f 100644 --- a/src/lib/mina_state/ancestor.ml +++ b/src/lib/mina_state/ancestor.ml @@ -99,7 +99,7 @@ end = struct let h, to_add = go [] ancestor ancestor_length proof in let%map () = check (State_hash.equal h descendant) "Bad merkle proof" in List.iter to_add ~f:(fun (prev, h, length, body) -> - add t ~prev_hash:prev ~hash:h ~length ~body_hash:body) + add t ~prev_hash:prev ~hash:h ~length ~body_hash:body ) let prove (t : t) { Input.descendant; generations } : (Output.t * Proof.t) option = @@ -125,7 +125,7 @@ let%test_unit "completeness" = in Prover.add prover ~prev_hash:prev ~hash:hs.state_hash ~length ~body_hash:body ; - ((hs.state_hash, length), hs.state_hash)) + ((hs.state_hash, length), hs.state_hash) ) in List.iteri hashes ~f:(fun i h -> let input = { Input.generations = i + 1; descendant = h } in @@ -134,4 +134,4 @@ let%test_unit "completeness" = |> Option.value_exn ?here:None ?error:None ?message:None in [%test_eq: State_hash.t] a ancestor ; - assert (verify input a proof))) + assert (verify input a proof) ) ) diff --git a/src/lib/mina_state/blockchain_state.ml b/src/lib/mina_state/blockchain_state.ml index 6ad08cfc69b..5d068d876bc 100644 --- a/src/lib/mina_state/blockchain_state.ml +++ b/src/lib/mina_state/blockchain_state.ml @@ -94,8 +94,8 @@ let var_to_input ] let to_input - ({ staged_ledger_hash; genesis_ledger_hash; registers; timestamp } : - Value.t) = + ({ staged_ledger_hash; genesis_ledger_hash; registers; timestamp } : Value.t) + = let open Random_oracle.Input.Chunked in let registers = (* TODO: If this were the actual Registers itself (without the unit arg) @@ -142,7 +142,7 @@ let display ; registers = { ledger; pending_coinbase_stack = (); local_state } ; timestamp } : - Value.t) : display = + Value.t ) : display = { Poly.staged_ledger_hash = Visualization.display_prefix_of_string @@ Ledger_hash.to_base58_check @@ Staged_ledger_hash.ledger_hash staged_ledger_hash diff --git a/src/lib/mina_state/blockchain_state.mli b/src/lib/mina_state/blockchain_state.mli index a02ebcad9d2..7a3bb32052c 100644 --- a/src/lib/mina_state/blockchain_state.mli +++ b/src/lib/mina_state/blockchain_state.mli @@ -38,11 +38,11 @@ end include Snarkable.S with type var = - ( Staged_ledger_hash.var - , Frozen_ledger_hash.var - , Local_state.Checked.t - , Block_time.Checked.t ) - Poly.t + ( Staged_ledger_hash.var + , Frozen_ledger_hash.var + , Local_state.Checked.t + , Block_time.Checked.t ) + Poly.t and type value := Value.t val staged_ledger_hash : diff --git a/src/lib/mina_state/consensus_state_hooks.ml b/src/lib/mina_state/consensus_state_hooks.ml index 214fd640a5c..a3477998790 100644 --- a/src/lib/mina_state/consensus_state_hooks.ml +++ b/src/lib/mina_state/consensus_state_hooks.ml @@ -1,8 +1,9 @@ -include Consensus.Hooks.Make_state_hooks - (Blockchain_state) - (struct - include Protocol_state +include + Consensus.Hooks.Make_state_hooks + (Blockchain_state) + (struct + include Protocol_state - let hash t = (hashes t).state_hash - end) - (Snark_transition) + let hash t = (hashes t).state_hash + end) + (Snark_transition) diff --git a/src/lib/mina_state/genesis_protocol_state.ml b/src/lib/mina_state/genesis_protocol_state.ml index fb895d3ec58..540a64e49eb 100644 --- a/src/lib/mina_state/genesis_protocol_state.ml +++ b/src/lib/mina_state/genesis_protocol_state.ml @@ -12,7 +12,7 @@ let t ~genesis_ledger ~genesis_epoch_data ~constraint_constants Protocol_state.( hashes (negative_one ~genesis_ledger ~genesis_epoch_data ~constraint_constants - ~consensus_constants)) + ~consensus_constants )) .state_hash in let genesis_consensus_state = @@ -26,10 +26,10 @@ let t ~genesis_ledger ~genesis_epoch_data ~constraint_constants ~previous_state_hash: (Option.value_map constraint_constants.fork ~default:negative_one_protocol_state_hash - ~f:(fun { previous_state_hash; _ } -> previous_state_hash)) + ~f:(fun { previous_state_hash; _ } -> previous_state_hash) ) ~blockchain_state: (Blockchain_state.genesis ~constraint_constants ~consensus_constants - ~genesis_ledger_hash) + ~genesis_ledger_hash ) ~consensus_state:genesis_consensus_state ~constants:protocol_constants in With_hash.of_data ~hash_data:Protocol_state.hashes state diff --git a/src/lib/mina_state/local_state.ml b/src/lib/mina_state/local_state.ml index 18aac6f86a2..a780850da4a 100644 --- a/src/lib/mina_state/local_state.ml +++ b/src/lib/mina_state/local_state.ml @@ -28,7 +28,7 @@ let display ; success ; failure_status_tbl } : - t) : display = + t ) : display = let open Kimchi_backend.Pasta.Basic in let f x = Visualization.display_prefix_of_string @@ -64,7 +64,7 @@ let dummy : unit -> t = ; ledger = Frozen_ledger_hash.empty_hash ; success = true ; failure_status_tbl = [] - }) + } ) let empty = dummy @@ -106,7 +106,7 @@ let to_input ; success ; failure_status_tbl = _ } : - t) = + t ) = let open Random_oracle.Input.Chunked in let open Pickles.Impls.Step in Array.reduce_exn ~f:append @@ -129,7 +129,7 @@ module Checked = struct let ( ! ) f x y = Impl.run_checked (f x y) in let f eq f = Impl.with_label (Core_kernel.Field.name f) (fun () -> - Core_kernel.Field.(eq (get f t1) (get f t2))) + Core_kernel.Field.(eq (get f t1) (get f t2)) ) in Mina_transaction_logic.Parties_logic.Local_state.Fields.iter ~stack_frame:(f Stack_frame.Digest.Checked.Assert.equal) @@ -166,7 +166,7 @@ module Checked = struct ; success ; failure_status_tbl = _ } : - t) = + t ) = (* failure_status is the unit value, no need to represent it *) let open Random_oracle.Input.Chunked in let open Snark_params.Tick.Field.Var in diff --git a/src/lib/mina_state/protocol_state.ml b/src/lib/mina_state/protocol_state.ml index fa2e5d1f887..c920c86acbb 100644 --- a/src/lib/mina_state/protocol_state.ml +++ b/src/lib/mina_state/protocol_state.ml @@ -122,7 +122,7 @@ module Body = struct make_checked (fun () -> Random_oracle.Checked.( hash ~init:Hash_prefix.protocol_state_body (pack_input input) - |> State_body_hash.var_of_hash_packed)) + |> State_body_hash.var_of_hash_packed) ) let consensus_state { Poly.consensus_state; _ } = consensus_state @@ -248,7 +248,7 @@ let hash_checked ({ previous_state_hash; body } : var) = [| Hash.var_to_hash_packed previous_state_hash ; State_body_hash.var_to_hash_packed body |] - |> State_hash.var_of_hash_packed) + |> State_hash.var_of_hash_packed ) in (hash, body) diff --git a/src/lib/mina_state/registers.ml b/src/lib/mina_state/registers.ml index 62ed7d9c736..99a8c6740e3 100644 --- a/src/lib/mina_state/registers.ml +++ b/src/lib/mina_state/registers.ml @@ -69,6 +69,6 @@ module Checked = struct Fields.fold ~init:[] ~ledger:(f !Frozen_ledger_hash.equal_var) ~pending_coinbase_stack:(f !Pending_coinbase.Stack.equal_var) ~local_state:(fun acc f -> - Local_state.Checked.equal' (Field.get f t1) (Field.get f t2) @ acc) + Local_state.Checked.equal' (Field.get f t1) (Field.get f t2) @ acc ) |> Impl.Boolean.all end diff --git a/src/lib/mina_state/snark_transition.mli b/src/lib/mina_state/snark_transition.mli index f422bfd4ec5..f610aa92bfd 100644 --- a/src/lib/mina_state/snark_transition.mli +++ b/src/lib/mina_state/snark_transition.mli @@ -24,7 +24,7 @@ module Poly : sig , 'consensus_transition , 'pending_coinbase_update ) V1.t = - ('blockchain_state, 'consensus_transition, 'pending_coinbase_update) t + ('blockchain_state, 'consensus_transition, 'pending_coinbase_update) t end module Value : sig diff --git a/src/lib/mina_user_error/mina_user_error.ml b/src/lib/mina_user_error/mina_user_error.ml index 0c620c2b360..f765b9ffc89 100644 --- a/src/lib/mina_user_error/mina_user_error.ml +++ b/src/lib/mina_user_error/mina_user_error.ml @@ -23,7 +23,7 @@ FATAL ERROR ☠ Mina %s. %s -%!|err} - error message) +%!|err} error + message ) | _ -> - None) + None ) diff --git a/src/lib/network_peer/network_peer.ml b/src/lib/network_peer/network_peer.ml index 16a9f7de326..f2e37f142c3 100644 --- a/src/lib/network_peer/network_peer.ml +++ b/src/lib/network_peer/network_peer.ml @@ -4,9 +4,11 @@ module Rpc_intf = Rpc_intf type query_peer = { query : - 'r 'q. Peer.t + 'r 'q. + Peer.t -> ( Async_rpc_kernel.Versioned_rpc.Connection_with_menu.t -> 'q - -> 'r Async_kernel.Deferred.Or_error.t) -> 'q + -> 'r Async_kernel.Deferred.Or_error.t ) + -> 'q -> 'r Async_kernel.Deferred.Or_error.t } diff --git a/src/lib/network_peer/peer.ml b/src/lib/network_peer/peer.ml index 212843327e2..049fca3420b 100644 --- a/src/lib/network_peer/peer.ml +++ b/src/lib/network_peer/peer.ml @@ -66,7 +66,7 @@ module Stable = struct List.Assoc.find ls "libp2p_port" ~equal:String.equal >>= lift_int in let host = Unix.Inet_addr.of_string host_str in - { host; peer_id; libp2p_port }) + { host; peer_id; libp2p_port } ) | _ -> Error "expected object" end diff --git a/src/lib/network_peer/rpc_intf.ml b/src/lib/network_peer/rpc_intf.ml index 1598dee1b6a..d3e913c7695 100644 --- a/src/lib/network_peer/rpc_intf.ml +++ b/src/lib/network_peer/rpc_intf.ml @@ -41,7 +41,7 @@ end type ('query, 'response) rpc_implementation = (module Rpc_implementation_intf with type query = 'query - and type response = 'response) + and type response = 'response ) module type Rpc_interface_intf = sig type ('query, 'response) rpc diff --git a/src/lib/network_pool/batcher.ml b/src/lib/network_pool/batcher.ml index b63b0ec6863..eb1a1a3fd15 100644 --- a/src/lib/network_pool/batcher.ml +++ b/src/lib/network_pool/batcher.ml @@ -100,7 +100,7 @@ let rec determine_outcome : Ivar.fill elt.res (Ok (Error (`Missing_verification_key keys))) ; None | `Potentially_invalid new_hint -> - Some (elt, new_hint)) + Some (elt, new_hint) ) in let open Deferred.Or_error.Let_syntax in match potentially_invalid with @@ -119,7 +119,7 @@ let rec determine_outcome : let%bind res_xs = call_verifier v (List.map xs ~f:(fun (_e, new_hint) -> - `Partially_validated new_hint)) + `Partially_validated new_hint ) ) in determine_outcome (List.map xs ~f:fst) res_xs v in @@ -141,7 +141,7 @@ let order_proofs t = (* When new proofs come in put them in the queue. If state = Waiting, verify those proofs immediately. Whenever the verifier returns, if the queue is nonempty, flush it into the verifier. - *) +*) let rec start_verifier : type proof partial r. (proof, partial, r) t -> unit = fun t -> @@ -179,7 +179,7 @@ let rec start_verifier : type proof partial r. (proof, partial, r) t -> unit = , `List (List.map ~f:(fun { id; _ } -> `Int (Id.to_int_exn id)) - out_for_verification) ) + out_for_verification ) ) ] ; let res = match%bind @@ -198,8 +198,8 @@ let rec start_verifier : type proof partial r. (proof, partial, r) t -> unit = () | Error e -> List.iter out_for_verification ~f:(fun x -> - Ivar.fill_if_empty x.res (Error e)) ) ; - start_verifier t) ) + Ivar.fill_if_empty x.res (Error e) ) ) ; + start_verifier t ) ) let verify (type p r partial) (t : (p, partial, r) t) (proof : p) : (r, Verifier.invalid) Result.t Deferred.Or_error.t = @@ -274,14 +274,14 @@ module Transaction_pool = struct | `Valid c -> `Valid c | `Valid_assuming x -> - `Valid_assuming x))) + `Valid_assuming x ) ) ) let list_of_array_map a ~f = List.init (Array.length a) ~f:(fun i -> f a.(i)) let all_valid a = Option.all (Array.to_list - (Array.map a ~f:(function `Valid c -> Some c | _ -> None))) + (Array.map a ~f:(function `Valid c -> Some c | _ -> None)) ) let create verifier : t = let logger = Logger.create () in @@ -305,7 +305,7 @@ module Transaction_pool = struct None | `Valid_assuming (v, _) -> (* TODO: This rechecks the signatures on snapp transactions... oh well for now *) - Some ((i, j), v))) + Some ((i, j), v) ) ) in let%map res = (* Verify the unknowns *) @@ -349,7 +349,7 @@ module Transaction_pool = struct | `Missing_verification_key _ -> () | `In_progress a -> - a.(j) <- `Valid c )) ; + a.(j) <- `Valid c ) ) ; list_of_array_map result ~f:(function | `Invalid_keys keys -> `Invalid_keys keys @@ -373,7 +373,7 @@ module Transaction_pool = struct | `Valid c -> `Valid c | `Valid_assuming (v, xs) -> - `Valid_assuming (v, xs))) ))) + `Valid_assuming (v, xs) ) ) ) ) ) let verify (t : t) = verify t end @@ -400,7 +400,7 @@ module Snark_pool = struct *) ~max_weight_per_call: (Option.value_map ~default:1000 ~f:Int.of_string - (Sys.getenv_opt "MAX_VERIFIER_BATCH_SIZE")) + (Sys.getenv_opt "MAX_VERIFIER_BATCH_SIZE") ) ~compare_init:compare_envelope ~logger (fun ps0 -> [%log info] "Dispatching $num_proofs snark pool proofs to verifier" @@ -409,7 +409,7 @@ module Snark_pool = struct List.concat_map ps0 ~f:(function | `Partially_validated env | `Init env -> let ps, message = env.data in - One_or_two.map ps ~f:(fun p -> (p, message)) |> One_or_two.to_list) + One_or_two.map ps ~f:(fun p -> (p, message)) |> One_or_two.to_list ) in let open Deferred.Or_error.Let_syntax in let%map result = Verifier.verify_transaction_snarks verifier ps in @@ -418,7 +418,7 @@ module Snark_pool = struct List.map ps0 ~f:(fun _ -> `Valid ()) | false -> List.map ps0 ~f:(function `Partially_validated env | `Init env -> - `Potentially_invalid env)) + `Potentially_invalid env ) ) module Work_key = struct module T = struct @@ -430,7 +430,7 @@ module Snark_pool = struct let of_proof_envelope t = Envelope.Incoming.map t ~f:(fun (ps, message) -> - (One_or_two.map ~f:Ledger_proof.statement ps, message)) + (One_or_two.map ~f:Ledger_proof.statement ps, message) ) include T include Comparable.Make (T) @@ -440,7 +440,7 @@ module Snark_pool = struct let open Deferred.Or_error.Let_syntax in let%map invalid = Deferred.Or_error.List.filter_map ps ~f:(fun p -> - match%map verify t p with true -> None | false -> Some p) + match%map verify t p with true -> None | false -> Some p ) in `Invalid (Work_key.Set.of_list (List.map invalid ~f:Work_key.of_proof_envelope)) @@ -461,7 +461,7 @@ module Snark_pool = struct Async.Thread_safe.block_on_async_exn (fun () -> Verifier.create ~logger ~proof_level ~constraint_constants ~conf_dir:None - ~pids:(Child_processes.Termination.create_pid_table ())) + ~pids:(Child_processes.Termination.create_pid_table ()) ) let gen_proofs = let open Quickcheck.Generator.Let_syntax in @@ -493,7 +493,7 @@ module Snark_pool = struct let message = Mina_base.Sok_message.create ~fee ~prover in ( One_or_two.map statements ~f:(fun statement -> Ledger_proof.create ~statement ~sok_digest - ~proof:Proof.transaction_dummy) + ~proof:Proof.transaction_dummy ) , message ) in Envelope.Incoming.gen data_gen @@ -503,7 +503,7 @@ module Snark_pool = struct Deferred.List.iter proof_lists ~f:(fun (invalid_proofs, proof_list) -> let%map r = verify' batcher proof_list in let (`Invalid ps) = Or_error.ok_exn r in - assert (Work_key.Set.equal ps invalid_proofs)) + assert (Work_key.Set.equal ps invalid_proofs) ) let gen ~(valid_count : [ `Any | `Count of int ]) ~(invalid_count : [ `Any | `Count of int ]) = @@ -522,27 +522,27 @@ module Snark_pool = struct in List.map lst ~f:(fun (valid, invalid) -> ( Work_key.(Set.of_list (List.map ~f:of_proof_envelope invalid)) - , List.permute valid @ invalid )) + , List.permute valid @ invalid ) ) let%test_unit "all valid proofs" = Quickcheck.test ~trials:10 (gen ~valid_count:`Any ~invalid_count:(`Count 0)) ~f:(fun proof_lists -> Async.Thread_safe.block_on_async_exn (fun () -> - run_test proof_lists)) + run_test proof_lists ) ) let%test_unit "some invalid proofs" = Quickcheck.test ~trials:10 (gen ~valid_count:`Any ~invalid_count:`Any) ~f:(fun proof_lists -> Async.Thread_safe.block_on_async_exn (fun () -> - run_test proof_lists)) + run_test proof_lists ) ) let%test_unit "all invalid proofs" = Quickcheck.test ~trials:10 (gen ~valid_count:(`Count 0) ~invalid_count:`Any) ~f:(fun proof_lists -> Async.Thread_safe.block_on_async_exn (fun () -> - run_test proof_lists)) + run_test proof_lists ) ) end ) end diff --git a/src/lib/network_pool/batcher.mli b/src/lib/network_pool/batcher.mli index 20d2f7ee05d..602c57445d9 100644 --- a/src/lib/network_pool/batcher.mli +++ b/src/lib/network_pool/batcher.mli @@ -27,7 +27,7 @@ val create : | `Potentially_invalid of 'partially_validated | Verifier.invalid ] list - Deferred.Or_error.t) + Deferred.Or_error.t ) -> ('init, 'partially_validated, 'result) t val verify : diff --git a/src/lib/network_pool/f_sequence.ml b/src/lib/network_pool/f_sequence.ml index 7f892ed2c2f..de0d7d397d9 100644 --- a/src/lib/network_pool/f_sequence.ml +++ b/src/lib/network_pool/f_sequence.ml @@ -42,7 +42,7 @@ module Digit = struct 1 | Three (x1, x2, x3), Three (y1, y2, y3) -> fallthrough (cmp_e x1 y1) ~f:(fun () -> - fallthrough (cmp_e x2 y2) ~f:(fun () -> cmp_e x3 y3)) + fallthrough (cmp_e x2 y2) ~f:(fun () -> cmp_e x3 y3) ) | Three _, _ -> -1 | _, Three _ -> @@ -50,7 +50,7 @@ module Digit = struct | Four (x1, x2, x3, x4), Four (y1, y2, y3, y4) -> fallthrough (cmp_e x1 y1) ~f:(fun () -> fallthrough (cmp_e x2 y2) ~f:(fun () -> - fallthrough (cmp_e x3 y3) ~f:(fun () -> cmp_e x4 y4))) + fallthrough (cmp_e x3 y3) ~f:(fun () -> cmp_e x4 y4) ) ) | Four _, _ -> . | _, Four _ -> @@ -222,16 +222,16 @@ module Digit = struct in (Some (Mk_any_r cons_res'), m, rhs) | None, m, rhs -> - (Some (Mk_any_r (One head)), m, rhs)) + (Some (Mk_any_r (One head)), m, rhs) ) (fun (One a) -> if acc + measure' a >= target then (None, a, None) - else failwith "Digit.split index out of bounds") + else failwith "Digit.split index out of bounds" ) t in addable_elim (fun t' -> let lhs, m, rhs = split_addable acc t' in - (Option.map ~f:broaden_any_r lhs, m, Option.map ~f:broaden_any_r rhs)) + (Option.map ~f:broaden_any_r lhs, m, Option.map ~f:broaden_any_r rhs) ) (fun t' -> let head, Mk_any_r tail = uncons t' in if acc + measure' head >= target then (None, head, Some (Mk_any_ar tail)) @@ -243,7 +243,7 @@ module Digit = struct | Some (Mk_any_r lhs') -> ( Some (broaden_any_a (cons head lhs')) , m - , Option.map ~f:broaden_any_r rhs )) + , Option.map ~f:broaden_any_r rhs ) ) t let opt_to_list : 'a t_any_ar option -> 'a list = function @@ -261,7 +261,7 @@ module Digit = struct ~f:(fun (Mk_any_ar dig, target) -> let lhs_opt, m, rhs_opt = split Fn.id target 0 dig in let lhs', rhs' = (opt_to_list lhs_opt, opt_to_list rhs_opt) in - [%test_eq: int list] (lhs' @ [ m ] @ rhs') (to_list dig)) + [%test_eq: int list] (lhs' @ [ m ] @ rhs') (to_list dig) ) let%test_unit "Digit.split matches list implementation" = Quickcheck.test @@ -269,7 +269,7 @@ module Digit = struct Tuple2.sexp_of_t (List.sexp_of_t Int.sexp_of_t) Int.sexp_of_t - (to_list dig, idx)) + (to_list dig, idx) ) (let open Quickcheck.Generator.Let_syntax in let%bind (Mk_any_ar dig) = gen_any_ar in let%bind idx = Int.gen_incl 1 (List.length @@ to_list dig) in @@ -289,7 +289,7 @@ module Digit = struct [%test_eq: int] m_list m_fseq ; [%test_eq: int list] rhs_list rhs_fseq' ; [%test_eq: int] (List.length lhs_fseq') (idx - 1) ; - [%test_eq: int] (List.length rhs_fseq') (List.length as_list - idx)) + [%test_eq: int] (List.length rhs_fseq') (List.length as_list - idx) ) (* See comment below about measures for why index 0 is an edge case. *) let%test_unit "Digit.split with index 0 is trivial" = @@ -304,7 +304,7 @@ module Digit = struct | None -> [%test_eq: int list] [] (List.tl_exn as_list) | Some (Mk_any_ar rhs') -> - [%test_eq: int list] (to_list rhs') (List.tl_exn as_list)) + [%test_eq: int list] (to_list rhs') (List.tl_exn as_list) ) let%test _ = match split Fn.id 1 0 (One 1) with None, 1, None -> true | _ -> false @@ -477,12 +477,12 @@ let rec cons' : 'e. ('e -> int) -> 'e -> 'e t -> 'e t = Digit.addable_elim (fun prefix' -> let (Mk_any_a prefix'') = Digit.cons v prefix' in - deep measure' prefix'' (Lazy.force middle) suffix) + deep measure' prefix'' (Lazy.force middle) suffix ) (fun (Four (a, b, c, d)) -> deep measure' (Digit.Two (v, a)) (cons' Node.measure (Node.mk_3 measure' b c d) @@ Lazy.force middle) - suffix) + suffix ) prefix let cons : 'e -> 'e t -> 'e t = fun x xs -> cons' (Fn.const 1) x xs @@ -499,11 +499,11 @@ let rec snoc' : 'e. ('e -> int) -> 'e t -> 'e -> 'e t = Digit.addable_elim (fun digit -> let (Mk_any_a digit') = Digit.snoc digit v in - deep measure' prefix (Lazy.force middle) digit') + deep measure' prefix (Lazy.force middle) digit' ) (fun (Four (a, b, c, d)) -> deep measure' prefix (snoc' Node.measure (Lazy.force middle) @@ Node.mk_3 measure' a b c) - (Digit.Two (d, v))) + (Digit.Two (d, v)) ) suffix let snoc : 'e t -> 'e -> 'e t = fun xs x -> snoc' (Fn.const 1) xs x @@ -525,13 +525,13 @@ let rec uncons' : 'e. ('e -> int) -> 'e t -> ('e * 'e t) option = Digit.removable_elim (fun prefix' -> let head, Mk_any_r prefix_rest = Digit.uncons prefix' in - Some (head, deep measure' prefix_rest (force middle) suffix)) + Some (head, deep measure' prefix_rest (force middle) suffix) ) (fun (One e) -> match uncons' Node.measure (force middle) with | None -> Some (e, tree_of_digit measure' suffix) | Some (node, rest) -> - Some (e, deep measure' (Node.to_digit node) rest suffix)) + Some (e, deep measure' (Node.to_digit node) rest suffix) ) prefix (** Uncons for the top level trees. *) @@ -549,13 +549,13 @@ let rec unsnoc' : 'e. ('e -> int) -> 'e t -> ('e t * 'e) option = Digit.removable_elim (fun suffix' -> let Mk_any_r liat, deah = Digit.unsnoc suffix' in - Some (deep measure' prefix (force middle) liat, deah)) + Some (deep measure' prefix (force middle) liat, deah) ) (fun (One e) -> match unsnoc' Node.measure (force middle) with | None -> Some (tree_of_digit measure' prefix, e) | Some (rest, node) -> - Some (deep measure' prefix rest (Node.to_digit node), e)) + Some (deep measure' prefix rest (Node.to_digit node), e) ) suffix (** Mirror of uncons. *) @@ -762,14 +762,14 @@ let%test_unit "list isomorphism - cons" = let xs_fseq = List.fold_right xs ~f:cons ~init:empty in assert_measure (Fn.const 1) xs_fseq ; [%test_eq: int list] xs (to_list xs_fseq) ; - [%test_eq: int] (List.length xs) (length xs_fseq)) + [%test_eq: int] (List.length xs) (length xs_fseq) ) let%test_unit "list isomorphism - snoc" = Quickcheck.test (big_list Int.quickcheck_generator) ~f:(fun xs -> let xs_fseq = List.fold_left xs ~init:empty ~f:snoc in assert_measure (Fn.const 1) xs_fseq ; [%test_eq: int list] xs (to_list xs_fseq) ; - [%test_eq: int] (List.length xs) (length xs_fseq)) + [%test_eq: int] (List.length xs) (length xs_fseq) ) let%test_unit "alternating cons/snoc" = Quickcheck.test @@ -787,7 +787,7 @@ let%test_unit "alternating cons/snoc" = | `B x :: rest -> go (list @ [ x ]) (snoc fseq x) rest in - go [] empty cmds) + go [] empty cmds ) let%test_unit "split properties" = let gen = @@ -805,7 +805,7 @@ let%test_unit "split properties" = ( Sequence.range ~start:`inclusive ~stop:`inclusive 1 5 |> Sequence.filter_map ~f:(fun offset -> let res = idx - offset in - if res >= 0 then Some (xs, res) else None) )) + if res >= 0 then Some (xs, res) else None ) ) ) in Quickcheck.test gen ~shrink_attempts:`Exhaustive ~sexp_of:[%sexp_of: int list * int] ~shrinker ~f:(fun (xs, idx) -> @@ -824,7 +824,7 @@ let%test_unit "split properties" = [%test_eq: int list] split_r_list split_r_fseq' ; [%test_eq: int] (List.length split_l_fseq') (length split_l_fseq) ; [%test_eq: int] (List.length split_r_fseq') (length split_r_fseq) ; - [%test_eq: int] (length split_l_fseq + length split_r_fseq) len) + [%test_eq: int] (length split_l_fseq + length split_r_fseq) len ) (* Exercise all the functions that generate sequences, in random combinations. *) let%test_module "random sequence generation, with splits" = @@ -873,7 +873,7 @@ let%test_module "random sequence generation, with splits" = ; List.take acts (List.length acts - 1) ; List.map acts ~f:(function `Snoc x -> `Cons x | x -> x) ; List.map acts ~f:(function `Cons x -> `Snoc x | x -> x) - ]) + ] ) in Quickcheck.test gen ~trials:100_000 ~shrinker ~sexp_of:(List.sexp_of_t sexp_of_action) ~f:(fun acts -> @@ -894,5 +894,5 @@ let%test_module "random sequence generation, with splits" = | `Split_take_right idx :: acts_rest -> go (assert_m @@ Tuple2.get2 @@ split_at fseq idx) acts_rest in - go empty acts) + go empty acts ) end ) diff --git a/src/lib/network_pool/indexed_pool.ml b/src/lib/network_pool/indexed_pool.ml index 626a1fb187e..dcb80249445 100644 --- a/src/lib/network_pool/indexed_pool.ml +++ b/src/lib/network_pool/indexed_pool.ml @@ -168,7 +168,7 @@ module For_tests = struct Set.mem (Map.find_exn all_by_fee ( Transaction_hash.User_command_with_valid_signature.command tx - |> User_command.fee_per_wu )) + |> User_command.fee_per_wu ) ) tx then () else @@ -181,7 +181,7 @@ module For_tests = struct let assert_all_by_hash tx = [%test_eq: Transaction_hash.User_command_with_valid_signature.t] tx (Map.find_exn all_by_hash - (Transaction_hash.User_command_with_valid_signature.hash tx)) + (Transaction_hash.User_command_with_valid_signature.hash tx) ) in Map.iteri applicable_by_fee ~f:(fun ~key ~data -> Set.iter data ~f:(fun tx -> @@ -197,7 +197,7 @@ module For_tests = struct [%test_eq: Transaction_hash.User_command_with_valid_signature.t] tx tx' ; assert_all_by_fee tx ; - assert_all_by_hash tx)) ; + assert_all_by_hash tx ) ) ; Map.iteri all_by_sender ~f:(fun ~key:fee_payer ~data:(tx_seq, currency_reserved) -> assert (F_sequence.length tx_seq > 0) ; @@ -219,7 +219,7 @@ module For_tests = struct assert ( Set.mem (Map.find_exn applicable_by_fee - (User_command.fee_per_wu applicable_unchecked)) + (User_command.fee_per_wu applicable_unchecked) ) applicable ) ; let _last_nonce, currency_reserved' = F_sequence.foldl @@ -236,13 +236,13 @@ module For_tests = struct Currency.Amount.( Option.value_exn (currency_consumed ~constraint_constants tx) - + currency_acc) )) + + currency_acc) ) ) ( User_command.nonce_exn applicable_unchecked , Option.value_exn (currency_consumed ~constraint_constants applicable) ) inapplicables in - [%test_eq: Currency.Amount.t] currency_reserved currency_reserved') ; + [%test_eq: Currency.Amount.t] currency_reserved currency_reserved' ) ; let check_sender_applicable fee tx = let unchecked = Transaction_hash.User_command_with_valid_signature.command tx @@ -259,7 +259,7 @@ module For_tests = struct (Map.find_exn applicable_by_fee ( applicable |> Transaction_hash.User_command_with_valid_signature.command - |> User_command.fee_per_wu )) + |> User_command.fee_per_wu ) ) applicable ) ; let first_nonce = applicable |> Transaction_hash.User_command_with_valid_signature.command @@ -283,13 +283,13 @@ module For_tests = struct |> Currency.Fee_rate.to_uint64_exn |> Currency.Fee.of_uint64 in check_sender_applicable fee tx ; - assert_all_by_hash tx)) ; + assert_all_by_hash tx ) ) ; Map.iter all_by_hash ~f:(fun tx -> check_sender_applicable (User_command.fee - (Transaction_hash.User_command_with_valid_signature.command tx)) + (Transaction_hash.User_command_with_valid_signature.command tx) ) tx ; - assert_all_by_fee tx) ; + assert_all_by_fee tx ) ; [%test_eq: int] (Map.length all_by_hash) size end @@ -356,7 +356,7 @@ let check_expiry t (cmd : User_command.t) = Error (Command_error.Expired ( `Valid_until valid_until - , `Global_slot_since_genesis global_slot_since_genesis )) + , `Global_slot_since_genesis global_slot_since_genesis ) ) else Ok () (* a cmd is in the transactions_with_expiration map only if it has an expiry*) @@ -467,16 +467,17 @@ module Update = struct module F_seq = struct type 'a t = 'a F_sequence.t - include Sexpable.Of_sexpable1 - (List) - (struct - type 'a t = 'a F_sequence.t + include + Sexpable.Of_sexpable1 + (List) + (struct + type 'a t = 'a F_sequence.t - let to_sexpable = F_sequence.to_list + let to_sexpable = F_sequence.to_list - let of_sexpable xs = - List.fold xs ~init:F_sequence.empty ~f:F_sequence.snoc - end) + let of_sexpable xs = + List.fold xs ~init:F_sequence.empty ~f:F_sequence.snoc + end) end type single = @@ -552,7 +553,7 @@ let run : let res = Writer_result.run (a r) in Result.map res ~f:(fun (a, updates) -> let t = set_sender_local_state t !r in - (a, Update.apply updates t)) + (a, Update.apply updates t) ) (* Remove a given command from the pool, as well as any commands that depend on it. Called from revalidate and remove_lowest_fee, and when replacing @@ -589,7 +590,7 @@ let remove_with_dependents_exn : (* safe because we check for overflow when we add commands. *) (let open Option.Let_syntax in let%bind consumed = currency_consumed ~constraint_constants cmd' in - Currency.Amount.(consumed + acc))) + Currency.Amount.(consumed + acc)) ) Currency.Amount.zero drop_queue in let reserved_currency' = @@ -605,7 +606,7 @@ let remove_with_dependents_exn : then Writer_result.write (Update.Remove_from_applicable_by_fee - { fee_per_wu = User_command.fee_per_wu unchecked; command = cmd }) + { fee_per_wu = User_command.fee_per_wu unchecked; command = cmd } ) else Writer_result.return () in state := @@ -623,14 +624,14 @@ let run' t cmd x = run t ~sender: (User_command.fee_payer - (Transaction_hash.User_command_with_valid_signature.command cmd)) + (Transaction_hash.User_command_with_valid_signature.command cmd) ) x let remove_with_dependents_exn' t cmd = match run' t cmd (remove_with_dependents_exn - ~constraint_constants:t.config.constraint_constants cmd) + ~constraint_constants:t.config.constraint_constants cmd ) with | Ok x -> x @@ -702,7 +703,7 @@ let revalidate : Currency.Amount.( c - Option.value_exn - (currency_consumed ~constraint_constants cmd))) + (currency_consumed ~constraint_constants cmd)) ) currency_reserved drop_queue in let keep_queue', currency_reserved'', dropped_for_balance = @@ -722,7 +723,7 @@ let revalidate : ~init: (remove_all_by_fee_and_hash_and_expiration_exn (remove_applicable_exn t' head) - head) + head ) ~f:remove_all_by_fee_and_hash_and_expiration_exn in ( { t'' with @@ -730,7 +731,7 @@ let revalidate : Map.set t''.all_by_sender ~key:sender ~data:(keep_queue', currency_reserved'') } - , Sequence.append dropped_acc to_drop )) + , Sequence.append dropped_acc to_drop ) ) let expired_by_predicate (t : t) : Transaction_hash.User_command_with_valid_signature.t Sequence.t = @@ -743,7 +744,7 @@ let expired_by_predicate (t : t) : | User_command.Parties ps -> Some (cmd_hash, ps) | User_command.Signed_command _ -> - None) + None ) |> Sequence.filter ~f:(fun (_, ps) -> ps.other_parties |> Parties.Call_forest.exists ~f:(fun party -> @@ -756,7 +757,7 @@ let expired_by_predicate (t : t) : in Time_ns.(upper < expiry_time) | _ -> - false)) + false ) ) |> Sequence.map ~f:fst |> Sequence.map ~f:(Map.find_exn t.all_by_hash) @@ -790,7 +791,7 @@ let remove_expired t : if member t (Transaction_hash.User_command.of_checked cmd) then let removed, t' = remove_with_dependents_exn' t cmd in (Sequence.append dropped_acc removed, t') - else acc) + else acc ) let handle_committed_txn : t @@ -824,7 +825,7 @@ let handle_committed_txn : (`Queued_txns_by_sender ( "Tried to handle a committed transaction in the pool but its \ nonce doesn't match the head of the queue for that sender" - , F_sequence.to_seq cmds )) + , F_sequence.to_seq cmds ) ) else let first_cmd_consumed = (* safe since we checked this when we added it to the pool originally *) @@ -905,7 +906,7 @@ let get_highest_fee : ~f: (Fn.compose Transaction_hash.User_command_with_valid_signature.Set.min_elt_exn - Tuple2.get2) + Tuple2.get2 ) @@ Currency.Fee_rate.Map.max_elt t.applicable_by_fee (* Add a command that came in from gossip, or return an error. We need to check @@ -957,7 +958,7 @@ module Add_from_gossip_exn (M : Writer_result.S) = struct Time_ns.(upper > expiry_time) && Time_ns.(lower < add current_time expiry_ns) | _ -> - true) + true ) let rec add_from_gossip_exn : config:Config.t @@ -1011,7 +1012,7 @@ module Add_from_gossip_exn (M : Writer_result.S) = struct (Expired ( `Timestamp_predicate (Time_ns.Span.to_string_hum expiry_ns) , `Global_slot_since_genesis - (global_slot_since_genesis config) )) + (global_slot_since_genesis config) ) ) in let%bind () = check_expiry config unchecked in let%bind consumed = @@ -1050,7 +1051,7 @@ module Add_from_gossip_exn (M : Writer_result.S) = struct let%map () = M.write (Update.Add - { command = cmd; fee_per_wu; add_to_applicable_by_fee = true }) + { command = cmd; fee_per_wu; add_to_applicable_by_fee = true } ) in by_sender := { !by_sender with data = Some (F_sequence.singleton cmd, consumed) } ; @@ -1089,7 +1090,8 @@ module Add_from_gossip_exn (M : Writer_result.S) = struct let%map () = M.write (Update.Add - { command = cmd; fee_per_wu; add_to_applicable_by_fee = false }) + { command = cmd; fee_per_wu; add_to_applicable_by_fee = false } + ) in by_sender := { !by_sender with data = Some new_state } ; (cmd, Sequence.empty) ) @@ -1104,10 +1106,11 @@ module Add_from_gossip_exn (M : Writer_result.S) = struct let%bind () = Result.ok_if_true (Account_nonce.between ~low:first_queued_nonce - ~high:last_queued_nonce nonce) + ~high:last_queued_nonce nonce ) ~error: (Invalid_nonce - (`Between (first_queued_nonce, last_queued_nonce), nonce)) + (`Between (first_queued_nonce, last_queued_nonce), nonce) + ) |> M.of_result (* C1/C1b *) in @@ -1132,8 +1135,7 @@ module Add_from_gossip_exn (M : Writer_result.S) = struct let replace_fee = User_command.fee to_drop in Result.ok_if_true Currency.Fee.(fee >= replace_fee) - ~error: - (Insufficient_replace_fee (`Replace_fee replace_fee, fee)) + ~error:(Insufficient_replace_fee (`Replace_fee replace_fee, fee)) |> M.of_result (* C3 *) in @@ -1188,14 +1190,14 @@ module Add_from_gossip_exn (M : Writer_result.S) = struct | None -> Error (Insufficient_replace_fee - (`Replace_fee replace_fee, increment)) + (`Replace_fee replace_fee, increment) ) |> M.of_result ) | Some (cmd, dropped'), None -> let current_nonce = Account_nonce.succ current_nonce in let by_sender_pre = !by_sender in M.catch (add_from_gossip_exn ~config ~verify (`Checked cmd) - current_nonce balance by_sender) + current_nonce balance by_sender ) ~f:(function | Ok ((_v, dropped_), ups) -> assert (Sequence.is_empty dropped_) ; @@ -1206,7 +1208,8 @@ module Add_from_gossip_exn (M : Writer_result.S) = struct (* Re-evaluate with the same [dropped] to calculate the new fee increment. *) - go increment dropped (Some dropped') current_nonce) + go increment dropped (Some dropped') current_nonce + ) in go increment drop_tail None current_nonce in @@ -1214,7 +1217,8 @@ module Add_from_gossip_exn (M : Writer_result.S) = struct Result.ok_if_true Currency.Fee.(increment >= replace_fee) ~error: - (Insufficient_replace_fee (`Replace_fee replace_fee, increment)) + (Insufficient_replace_fee (`Replace_fee replace_fee, increment) + ) |> M.of_result (* C3 *) in @@ -1224,7 +1228,8 @@ module Add_from_gossip_exn (M : Writer_result.S) = struct M.of_result (Error (Invalid_nonce - (`Expected (Account_nonce.succ last_queued_nonce), nonce))) + (`Expected (Account_nonce.succ last_queued_nonce), nonce) ) + ) end module Add_from_gossip_exn0 = Add_from_gossip_exn (Writer_result) @@ -1239,7 +1244,7 @@ let add_from_gossip_exn t ~verify cmd0 nonce balance : Add_from_gossip_exn0.add_from_gossip_exn ~config:t.config ~verify:(fun c -> Result.of_option (verify c) ~error:Command_error.Verification_failed - |> Writer_result.of_result) + |> Writer_result.of_result ) cmd0 nonce balance in Result.map @@ -1265,11 +1270,11 @@ let add_from_gossip_exn_async ~config Writer_result.Deferred.Deferred (Deferred.map (verify c) ~f:(fun r -> Result.of_option r ~error:Command_error.Verification_failed - |> Writer_result.of_result))) + |> Writer_result.of_result ) ) ) cmd0 nonce balance r in Deferred.Result.map (Writer_result.Deferred.run x) ~f:(fun ((c, cs), us) -> - ((c, Sequence.to_list cs), !r, us)) + ((c, Sequence.to_list cs), !r, us) ) let add_from_backtrack : t @@ -1321,7 +1326,7 @@ let add_from_backtrack : (unchecked |> User_command.nonce_exn |> Account_nonce.succ) ( first_queued |> Transaction_hash.User_command_with_valid_signature.command - |> User_command.nonce_exn )) + |> User_command.nonce_exn ) ) then failwith @@ sprintf @@ -1387,8 +1392,7 @@ let%test_module _ = let expiry_ns = Time_ns.Span.of_hr - (Float.of_int - precomputed_values.genesis_constants.transaction_expiry_hr) + (Float.of_int precomputed_values.genesis_constants.transaction_expiry_hr) let empty = empty ~constraint_constants ~consensus_constants ~time_controller @@ -1430,7 +1434,7 @@ let%test_module _ = Sequence.t] dropped' (Sequence.singleton cmd) ; [%test_eq: t] ~equal pool pool'' | _ -> - failwith "should've succeeded") + failwith "should've succeeded" ) let%test_unit "age-based expiry" = Quickcheck.test ~trials:1 @@ -1454,7 +1458,7 @@ let%test_module _ = let dropped, _ = remove_expired pool' in assert (not @@ Sequence.is_empty dropped) | Error e -> - failwithf !"Error: %{sexp: Command_error.t}" e ()) + failwithf !"Error: %{sexp: Command_error.t}" e () ) let%test_unit "sequential adds (all valid)" = let gen : @@ -1474,7 +1478,7 @@ let%test_module _ = Quickcheck.Shrinker.t = Quickcheck.Shrinker.create (fun (init_state, cmds) -> Sequence.singleton - (init_state, List.take cmds (List.length cmds - 1))) + (init_state, List.take cmds (List.length cmds - 1)) ) in Quickcheck.test gen ~trials:1000 ~sexp_of: @@ -1490,7 +1494,7 @@ let%test_module _ = ~f:(fun (kp, balance, nonce, _) -> let compressed = Public_key.compress kp.public_key in Hashtbl.add_exn balances ~key:compressed ~data:balance ; - Hashtbl.add_exn nonces ~key:compressed ~data:nonce) ; + Hashtbl.add_exn nonces ~key:compressed ~data:nonce ) ; let pool = ref empty in let rec go cmds_acc = match cmds_acc with @@ -1552,8 +1556,8 @@ let%test_module _ = | Error (Expired ( `Valid_until valid_until - , `Global_slot_since_genesis global_slot_since_genesis )) - -> + , `Global_slot_since_genesis global_slot_since_genesis ) + ) -> failwithf !"Expired user command. Current global slot is \ %{sexp:Mina_numbers.Global_slot.t} but user command is \ @@ -1562,8 +1566,8 @@ let%test_module _ = | Error (Expired ( `Timestamp_predicate expiry_ns - , `Global_slot_since_genesis global_slot_since_genesis )) - -> + , `Global_slot_since_genesis global_slot_since_genesis ) + ) -> failwithf !"Expired zkapp. Current global slot is \ %{sexp:Mina_numbers.Global_slot.t}. Transaction \ @@ -1571,7 +1575,7 @@ let%test_module _ = current expiry duration of %s" global_slot_since_genesis expiry_ns () ) in - go cmds) + go cmds ) let%test_unit "replacement" = let modify_payment (c : User_command.t) ~sender ~common:fc ~body:fb = @@ -1665,7 +1669,7 @@ let%test_module _ = { c with fee = Currency.Fee.of_int ((10 + (5 * (size + 1))) * 1_000_000_000) - }) + } ) in (init_nonce, init_balance, setup_cmds, replace_cmd) in @@ -1694,7 +1698,7 @@ let%test_module _ = !"adding command %{sexp: \ Transaction_hash.User_command_with_valid_signature.t} \ failed" - cmd) + cmd ) in let replaced_idx = Account_nonce.to_int @@ -1715,7 +1719,7 @@ let%test_module _ = Option.( currency_consumed ~constraint_constants cmd >>= fun consumed -> - Currency.Amount.(consumed + consumed_so_far))) + Currency.Amount.(consumed + consumed_so_far)) ) in assert ( Currency.Amount.(currency_consumed_pre_replace <= init_balance) ) ; @@ -1752,7 +1756,7 @@ let%test_module _ = | Error (Insufficient_funds _) -> () | _ -> - failwith "should've returned insufficient_funds") + failwith "should've returned insufficient_funds" ) let%test_unit "remove_lowest_fee" = let cmds = diff --git a/src/lib/network_pool/indexed_pool.mli b/src/lib/network_pool/indexed_pool.mli index 2587d6325a4..08567965d88 100644 --- a/src/lib/network_pool/indexed_pool.mli +++ b/src/lib/network_pool/indexed_pool.mli @@ -126,7 +126,7 @@ val add_from_gossip_exn_async : -> sender_local_state:Sender_local_state.t -> verify: ( User_command.Verifiable.t - -> User_command.Valid.t option Async.Deferred.t) + -> User_command.Valid.t option Async.Deferred.t ) -> [ `Unchecked of Transaction_hash.User_command.t * User_command.Verifiable.t | `Checked of Transaction_hash.User_command_with_valid_signature.t ] -> Account_nonce.t diff --git a/src/lib/network_pool/intf.ml b/src/lib/network_pool/intf.ml index ef76b5d46e6..732612c703f 100644 --- a/src/lib/network_pool/intf.ml +++ b/src/lib/network_pool/intf.ml @@ -163,14 +163,13 @@ module type Network_pool_base_intf = sig module Local_sink : Mina_net2.Sink.S_with_void with type msg := - resource_pool_diff - * ((resource_pool_diff * rejected_diff) Or_error.t -> unit) + resource_pool_diff + * ((resource_pool_diff * rejected_diff) Or_error.t -> unit) module Remote_sink : Mina_net2.Sink.S_with_void with type msg := - resource_pool_diff Envelope.Incoming.t - * Mina_net2.Validation_callback.t + resource_pool_diff Envelope.Incoming.t * Mina_net2.Validation_callback.t module Broadcast_callback : Broadcast_callback diff --git a/src/lib/network_pool/map_set.ml b/src/lib/network_pool/map_set.ml index 6c3ac64ec46..9ddd0567b0e 100644 --- a/src/lib/network_pool/map_set.ml +++ b/src/lib/network_pool/map_set.ml @@ -26,4 +26,4 @@ let insert : | None -> Some (Set.singleton comparator v) | Some set -> - Some (Set.add set v)) + Some (Set.add set v) ) diff --git a/src/lib/network_pool/mocks.ml b/src/lib/network_pool/mocks.ml index 660e3aa7543..4b813c69526 100644 --- a/src/lib/network_pool/mocks.ml +++ b/src/lib/network_pool/mocks.ml @@ -67,7 +67,7 @@ module Transition_frontier = struct | None -> Some 1 | Some count -> - Some (count + 1))) + Some (count + 1) ) ) (*Create tf with some statements referenced to be able to add snark work for those statements to the pool*) let create _stmts : t = diff --git a/src/lib/network_pool/network_pool_base.ml b/src/lib/network_pool/network_pool_base.ml index d1df07c8e8a..4e644dce029 100644 --- a/src/lib/network_pool/network_pool_base.ml +++ b/src/lib/network_pool/network_pool_base.ml @@ -35,7 +35,7 @@ end) type t = | Local of ( (Resource_pool.Diff.t * Resource_pool.Diff.rejected) Or_error.t - -> unit) + -> unit ) | External of Mina_net2.Validation_callback.t let is_expired = function @@ -51,14 +51,14 @@ end) | Local f -> f (Error err) | External cb -> - fire_if_not_already_fired cb `Reject) + fire_if_not_already_fired cb `Reject ) let drop accepted rejected = Fn.compose Deferred.return (function | Local f -> f (Ok (accepted, rejected)) | External cb -> - fire_if_not_already_fired cb `Ignore) + fire_if_not_already_fired cb `Ignore ) let forward broadcast_pipe accepted rejected = function | Local f -> @@ -140,14 +140,14 @@ end) [%log' debug t.logger] "Refusing to rebroadcast. Pool diff apply feedback: $error" ~metadata:[ ("error", Error_json.error_to_yojson e) ] ; - Broadcast_callback.error e cb) + Broadcast_callback.error e cb ) let log_rate_limiter_occasionally t rl = let time = Time_ns.Span.of_min 1. in every time (fun () -> [%log' debug t.logger] ~metadata:[ ("rate_limiter", Rate_limiter.summary rl) ] - !"%s $rate_limiter" Resource_pool.label) + !"%s $rate_limiter" Resource_pool.label ) type wrapped_t = | Diff of @@ -169,14 +169,14 @@ end) Remote_sink.create ~log_gossip_heard ~on_push:on_remote_push ~wrap:(fun m -> Diff m) ~unwrap:(function - | Diff m -> m | _ -> failwith "unexpected message type") + | Diff m -> m | _ -> failwith "unexpected message type" ) ~trace_label:Resource_pool.label ~logger resource_pool in let local_r, local_w, _ = Local_sink.create ~wrap:(fun m -> Diff m) ~unwrap:(function - | Diff m -> m | _ -> failwith "unexpected message type") + | Diff m -> m | _ -> failwith "unexpected message type" ) ~trace_label:Resource_pool.label ~logger resource_pool in log_rate_limiter_occasionally network_pool remote_rl ; @@ -185,7 +185,7 @@ end) (O1trace.thread Resource_pool.label (fun () -> Strict_pipe.Reader.Merge.iter [ Strict_pipe.Reader.map tf_diffs ~f:(fun diff -> - Transition_frontier_extension diff) + Transition_frontier_extension diff ) ; remote_r ; local_r ] @@ -193,13 +193,13 @@ end) match diff_source with | Diff ((verified_diff, cb) : Remote_sink.unwrapped_t) -> O1trace.thread processing_diffs_thread_label (fun () -> - apply_and_broadcast network_pool verified_diff cb) + apply_and_broadcast network_pool verified_diff cb ) | Transition_frontier_extension diff -> O1trace.thread processing_transition_frontier_diffs_thread_label (fun () -> Resource_pool.handle_transition_frontier_diff diff - resource_pool)))) ; + resource_pool ) ) ) ) ; (network_pool, remote_w, local_w) (* Rebroadcast locally generated pool items every 10 minutes. Do so for 50 @@ -237,7 +237,7 @@ end) , `List (List.map ~f:(fun d -> `String (Resource_pool.Diff.summary d)) - rebroadcastable) ) + rebroadcastable ) ) ] ; let%bind () = Deferred.List.iter rebroadcastable @@ -260,11 +260,11 @@ end) of_resource_pool_and_diffs (Resource_pool.create ~constraint_constants ~consensus_constants ~time_controller ~expiry_ns ~config ~logger ~frontier_broadcast_pipe - ~tf_diff_writer) + ~tf_diff_writer ) ~constraint_constants ~logger ~tf_diffs:tf_diff_reader ~log_gossip_heard ~on_remote_push in O1trace.background_thread rebroadcast_loop_thread_label (fun () -> - rebroadcast_loop t logger) ; + rebroadcast_loop t logger ) ; (t, locals, remotes) end diff --git a/src/lib/network_pool/pool_sink.ml b/src/lib/network_pool/pool_sink.ml index beb44f27413..09ce2cc46dd 100644 --- a/src/lib/network_pool/pool_sink.ml +++ b/src/lib/network_pool/pool_sink.ml @@ -135,7 +135,7 @@ module Base , Envelope.Sender.to_yojson @@ Envelope.Incoming.sender verified_diff ) ] ; - Deferred.return (Some verified_diff))) + Deferred.return (Some verified_diff) ) ) let push t (msg, cb) = match t with @@ -180,7 +180,7 @@ module Base | Some verified_env -> let m' = wrap (verified_env, cb') in Option.value ~default:Deferred.unit - (Strict_pipe.Writer.write w m'))) ; + (Strict_pipe.Writer.write w m') ) ) ; Deferred.unit | Void -> Deferred.unit @@ -191,7 +191,7 @@ module Base Strict_pipe.create ~name:"verified network pool diffs" (Buffered ( `Capacity verified_pipe_capacity - , `Overflow (Call (on_overflow ~unwrap logger)) )) + , `Overflow (Call (on_overflow ~unwrap logger)) ) ) in let rate_limiter = @@ -227,8 +227,8 @@ module Local_sink with type pool := Diff.pool and type unwrapped_t = Diff.verified Envelope.Incoming.t * BC.t and type msg := - BC.resource_pool_diff - * ((BC.resource_pool_diff * BC.rejected_diff) Or_error.t -> unit) = + BC.resource_pool_diff + * ((BC.resource_pool_diff * BC.rejected_diff) Or_error.t -> unit) = Base (Diff) (BC) (struct type raw_msg = BC.resource_pool_diff @@ -250,8 +250,8 @@ module Remote_sink with type pool := Diff.pool and type unwrapped_t = Diff.verified Envelope.Incoming.t * BC.t and type msg := - BC.resource_pool_diff Envelope.Incoming.t - * Mina_net2.Validation_callback.t = + BC.resource_pool_diff Envelope.Incoming.t + * Mina_net2.Validation_callback.t = Base (Diff) (BC) (struct type raw_msg = BC.resource_pool_diff Envelope.Incoming.t diff --git a/src/lib/network_pool/rate_limiter.ml b/src/lib/network_pool/rate_limiter.ml index 9d16ba8e5e7..06b10e687de 100644 --- a/src/lib/network_pool/rate_limiter.ml +++ b/src/lib/network_pool/rate_limiter.ml @@ -171,12 +171,12 @@ let summary ({ by_ip; by_peer_id } : t) = ( Unix.Inet_addr.to_string key , { capacity_used = by_ip.initial_capacity - data.remaining_capacity } ) - :: acc) + :: acc ) ; by_peer_id = Peer_id.Hash_queue.foldi by_peer_id.table ~init:[] ~f:(fun acc ~key ~data -> ( Peer.Id.to_string key , { capacity_used = by_ip.initial_capacity - data.remaining_capacity } ) - :: acc) + :: acc ) } diff --git a/src/lib/network_pool/snark_pool.ml b/src/lib/network_pool/snark_pool.ml index 131193f6e94..c90aeec8737 100644 --- a/src/lib/network_pool/snark_pool.ml +++ b/src/lib/network_pool/snark_pool.ml @@ -51,13 +51,13 @@ module Snark_tables = struct | `Rebroadcastable time -> Some (x, time) | `Not_rebroadcastable -> - None) + None ) } let to_serializable (t : t) : Serializable.t = let res = Hashtbl.map t.all ~f:(fun x -> (x, `Not_rebroadcastable)) in Hashtbl.iteri t.rebroadcastable ~f:(fun ~key ~data:(x, r) -> - Hashtbl.set res ~key ~data:(x, `Rebroadcastable r)) ; + Hashtbl.set res ~key ~data:(x, `Rebroadcastable r) ) ; res end @@ -89,7 +89,7 @@ module type S = sig and type transition_frontier := transition_frontier and type config := Resource_pool.Config.t and type transition_frontier_diff := - Resource_pool.transition_frontier_diff + Resource_pool.transition_frontier_diff and type rejected_diff := Resource_pool.Diff.rejected val get_completed_work : @@ -202,7 +202,7 @@ struct ~f:(fun tf -> Transition_frontier.best_tip tf |> Transition_frontier.Breadcrumb.staged_ledger - |> Staged_ledger.ledger) + |> Staged_ledger.ledger ) let of_serializable tables ~constraint_constants ~frontier_broadcast_pipe ~config ~logger : t = @@ -234,7 +234,7 @@ struct , Signature_lib.Public_key.Compressed.Stable.V1.to_yojson prover ) ] - :: acc)) + :: acc ) ) let all_completed_work (t : t) : Transaction_snark_work.Info.t list = Statement_table.fold ~init:[] t.snark_tables.all @@ -245,7 +245,7 @@ struct ; fee ; prover } - :: acc) + :: acc ) (** false when there is no active transition_frontier or when the refcount for the given work is 0 *) @@ -279,11 +279,11 @@ struct t.snark_tables.all |> Statement_table.data |> List.map ~f:(fun { Priced_proof.fee = { prover; _ }; _ } -> - prover) + prover ) |> List.dedup_and_sort ~compare:Public_key.Compressed.compare |> List.map ~f:(fun prover -> - (prover, Account_id.create prover Token_id.default)) + (prover, Account_id.create prover Token_id.default) ) |> Public_key.Compressed.Map.of_alist_exn in Deferred.map (Scheduler.yield ()) ~f:(Fn.const account_ids) @@ -317,15 +317,15 @@ struct in if not keep then ( Hashtbl.remove t.snark_tables.all key ; - Hashtbl.remove t.snark_tables.rebroadcastable key )) + Hashtbl.remove t.snark_tables.rebroadcastable key ) ) in - ()) + () ) in - ()) + () ) let handle_new_refcount_table t ({ removed; refcount_table; best_tip_table } : - Extensions.Snark_pool_refcount.view) = + Extensions.Snark_pool_refcount.view ) = t.ref_table <- Some refcount_table ; t.best_tip_table <- Some best_tip_table ; t.removed_counter <- t.removed_counter + removed ; @@ -334,7 +334,7 @@ struct Statement_table.filter_keys_inplace t.snark_tables.all ~f:(fun k -> let keep = work_is_referenced t k in if not keep then Hashtbl.remove t.snark_tables.rebroadcastable k ; - keep) ; + keep ) ; Mina_metrics.( Gauge.set Snark_work.snark_pool_size (Float.of_int @@ Hashtbl.length t.snark_tables.all)) ) @@ -343,10 +343,10 @@ struct match u with | `New_best_tip ledger -> O1trace.thread "apply_new_best_tip_ledger_to_snark_pool" (fun () -> - handle_new_best_tip_ledger t ledger) + handle_new_best_tip_ledger t ledger ) | `New_refcount_table refcount_table -> O1trace.sync_thread "apply_refcount_table_to_snark_pool" (fun () -> - handle_new_refcount_table t refcount_table) ; + handle_new_refcount_table t refcount_table ) ; Deferred.unit (*TODO? add referenced statements from the transition frontier to ref_table here otherwise the work referenced in the root and not in any of the successor blocks will never be included. This may not be required because the chances of a new block from the root is very low (root's existing successor is 1 block away from finality)*) @@ -364,7 +364,7 @@ struct Broadcast_pipe.Reader.iter (Transition_frontier.snark_pool_refcount_pipe tf) ~f:(fun x -> Strict_pipe.Writer.write tf_diff_writer - (`New_refcount_table x)) + (`New_refcount_table x) ) |> Deferred.don't_wait_for ; Broadcast_pipe.Reader.iter (Transition_frontier.best_tip_diff_pipe tf) ~f:(fun _ -> @@ -372,13 +372,13 @@ struct (`New_best_tip ( Transition_frontier.best_tip tf |> Transition_frontier.Breadcrumb.staged_ledger - |> Staged_ledger.ledger ))) + |> Staged_ledger.ledger ) ) ) |> Deferred.don't_wait_for ; return () | None -> t.ref_table <- None ; t.best_tip_table <- None ; - return ()) + return () ) in Deferred.don't_wait_for tf_deferred @@ -451,7 +451,7 @@ struct , One_or_two.to_yojson Transaction_snark.Statement.to_yojson work ) ] ; - `Statement_not_referenced )) + `Statement_not_referenced ) ) let verify_and_act t ~work ~sender = let statements, priced_proof = work in @@ -501,7 +501,7 @@ struct %{sexp: Transaction_snark.Statement.t}" proof_statement s ; let%map () = log_and_punish s e in - Error e) + Error e ) in let work = One_or_two.map proofs ~f:snd in let prover_account_exists = @@ -513,7 +513,7 @@ struct then None else Account_id.create prover Token_id.default - |> Base_ledger.location_of_account ledger) + |> Base_ledger.location_of_account ledger ) in if not (fee_is_sufficient t ~fee ~account_exists:prover_account_exists) @@ -606,7 +606,7 @@ struct |> List.filter_map ~f:(fun (stmt, (snark, _time)) -> if in_best_tip_table stmt then Some (Diff.Add_solved_work (stmt, snark)) - else None) + else None ) let remove_solved_work t work = Statement_table.remove t.snark_tables.all work ; @@ -626,7 +626,7 @@ struct (Resource_pool.request_proof (resource_pool t) statement) ~f:(fun Priced_proof.{ proof; fee = { fee; prover } } -> Transaction_snark_work.Checked.create_unsafe - { Transaction_snark_work.fee; proofs = proof; prover }) + { Transaction_snark_work.fee; proofs = proof; prover } ) (* This causes a snark pool to never be GC'd. This is fine as it should live as long as the daemon lives. *) let store_periodically (t : Resource_pool.t) = @@ -642,7 +642,7 @@ struct Snark_work.Snark_pool_serialization_ms_histogram.observe Snark_work.snark_pool_serialization_ms elapsed) ; [%log' debug t.logger] "SNARK pool serialization took $time ms" - ~metadata:[ ("time", `Float elapsed) ]) + ~metadata:[ ("time", `Float elapsed) ] ) let loaded = ref false @@ -684,18 +684,19 @@ struct end (* TODO: defunctor or remove monkey patching (#3731) *) -include Make (Mina_ledger.Ledger) (Staged_ledger) - (struct - include Transition_frontier +include + Make (Mina_ledger.Ledger) (Staged_ledger) + (struct + include Transition_frontier - type best_tip_diff = Extensions.Best_tip_diff.view + type best_tip_diff = Extensions.Best_tip_diff.view - let best_tip_diff_pipe t = - Extensions.(get_view_pipe (extensions t) Best_tip_diff) + let best_tip_diff_pipe t = + Extensions.(get_view_pipe (extensions t) Best_tip_diff) - let snark_pool_refcount_pipe t = - Extensions.(get_view_pipe (extensions t) Snark_pool_refcount) - end) + let snark_pool_refcount_pipe t = + Extensions.(get_view_pipe (extensions t) Snark_pool_refcount) + end) module Diff_versioned = struct [%%versioned @@ -752,14 +753,13 @@ let%test_module "random set test" = let expiry_ns = Time_ns.Span.of_hr - (Float.of_int - precomputed_values.genesis_constants.transaction_expiry_hr) + (Float.of_int precomputed_values.genesis_constants.transaction_expiry_hr) let verifier = Async.Thread_safe.block_on_async_exn (fun () -> Verifier.create ~logger ~proof_level ~constraint_constants ~conf_dir:None - ~pids:(Child_processes.Termination.create_pid_table ())) + ~pids:(Child_processes.Termination.create_pid_table ()) ) module Mock_snark_pool = Make (Mocks.Base_ledger) (Mocks.Staged_ledger) (Mocks.Transition_frontier) @@ -818,14 +818,14 @@ let%test_module "random set test" = let%map () = Deferred.List.iter sample_solved_work ~f:(fun (work, fee) -> let%map res = apply_diff pool work fee in - assert (Result.is_ok res)) + assert (Result.is_ok res) ) in (pool, tf) let%test_unit "serialization" = let t, _tf = Async.Thread_safe.block_on_async_exn (fun () -> - Quickcheck.random_value (gen ~length:100 ())) + Quickcheck.random_value (gen ~length:100 ()) ) in let s0 = Mock_snark_pool.For_tests.snark_tables t in let s1 = @@ -854,15 +854,15 @@ let%test_module "random set test" = , One_or_two.map work ~f:(fun statement -> Ledger_proof.create ~statement ~sok_digest:invalid_sok_digest - ~proof:Proof.transaction_dummy) + ~proof:Proof.transaction_dummy ) , fee , some_other_pk ) - :: acc) + :: acc ) in Quickcheck.Generator.filter gen ~f:(fun ls -> List.for_all ls ~f:(fun (_, _, fee, mal_pk) -> not - @@ Signature_lib.Public_key.Compressed.equal mal_pk fee.prover)) + @@ Signature_lib.Public_key.Compressed.equal mal_pk fee.prover ) ) in Quickcheck.test ~trials:5 ~sexp_of: @@ -899,10 +899,10 @@ let%test_module "random set test" = let%map res = Mock_snark_pool.Resource_pool.Diff.verify t diff in - assert (Result.is_error res)) + assert (Result.is_error res) ) in [%test_eq: Transaction_snark_work.Info.t list] completed_works - (Mock_snark_pool.Resource_pool.all_completed_work t))) + (Mock_snark_pool.Resource_pool.all_completed_work t) ) ) let%test_unit "When two priced proofs of the same work are inserted into \ the snark pool, the fee of the work is at most the minimum \ @@ -917,7 +917,7 @@ let%test_module "random set test" = * Fee_with_prover.t] (Async.Quickcheck.Generator.tuple4 (gen ()) Mocks.Transaction_snark_work.Statement.gen Fee_with_prover.gen - Fee_with_prover.gen) + Fee_with_prover.gen ) ~f:(fun (t, work, fee_1, fee_2) -> Async.Thread_safe.block_on_async_exn (fun () -> let%bind t, tf = t in @@ -932,7 +932,7 @@ let%test_module "random set test" = Option.value_exn (Mock_snark_pool.Resource_pool.request_proof t work) in - assert (Currency.Fee.(fee <= fee_upper_bound)))) + assert (Currency.Fee.(fee <= fee_upper_bound)) ) ) let%test_unit "A priced proof of a work will replace an existing priced \ proof of the same work only if it's fee is smaller than the \ @@ -947,7 +947,7 @@ let%test_module "random set test" = * Fee_with_prover.t] (Quickcheck.Generator.tuple4 (gen ()) Mocks.Transaction_snark_work.Statement.gen Fee_with_prover.gen - Fee_with_prover.gen) + Fee_with_prover.gen ) ~f:(fun (t, work, fee_1, fee_2) -> Async.Thread_safe.block_on_async_exn (fun () -> let%bind t, tf = t in @@ -964,14 +964,14 @@ let%test_module "random set test" = assert ( Currency.Fee.equal cheap_fee.fee (Option.value_exn - (Mock_snark_pool.Resource_pool.request_proof t work)) + (Mock_snark_pool.Resource_pool.request_proof t work) ) .fee - .fee ))) + .fee ) ) ) let fake_work = `One (Quickcheck.random_value ~seed:(`Deterministic "worktest") - Transaction_snark.Statement.gen) + Transaction_snark.Statement.gen ) let%test_unit "Work that gets fed into apply_and_broadcast will be \ received in the pool's reader" = @@ -991,7 +991,7 @@ let%test_module "random set test" = (mk_dummy_proof (Quickcheck.random_value ~seed:(`Deterministic "test proof") - Transaction_snark.Statement.gen)) + Transaction_snark.Statement.gen ) ) ; fee = { fee = Currency.Fee.of_int 0 ; prover = Signature_lib.Public_key.Compressed.empty @@ -1015,10 +1015,10 @@ let%test_module "random set test" = priced_proof.proof ) | None -> failwith "There should have been a proof here" ) ; - Deferred.unit) ; + Deferred.unit ) ; Mock_snark_pool.apply_and_broadcast network_pool (Envelope.Incoming.local command) - (Mock_snark_pool.Broadcast_callback.Local (Fn.const ()))) + (Mock_snark_pool.Broadcast_callback.Local (Fn.const ())) ) let%test_unit "when creating a network, the incoming diffs and locally \ generated diffs in reader pipes will automatically get \ @@ -1060,15 +1060,15 @@ let%test_module "random set test" = |> List.map ~f:(fun work -> ( Envelope.Incoming.local work , Mina_net2.Validation_callback.create_without_expiration () - )) + ) ) |> List.iter ~f:(fun diff -> Mock_snark_pool.Remote_sink.push remote_sink diff - |> Deferred.don't_wait_for) ; + |> Deferred.don't_wait_for ) ; (* locally generated diffs *) List.map (List.drop works per_reader) ~f:create_work |> List.iter ~f:(fun diff -> Mock_snark_pool.Local_sink.push local_sink (diff, Fn.const ()) - |> Deferred.don't_wait_for) ; + |> Deferred.don't_wait_for ) ; don't_wait_for @@ Linear_pipe.iter (Mock_snark_pool.broadcasts network_pool) ~f:(fun work_command -> @@ -1084,10 +1084,10 @@ let%test_module "random set test" = List.mem works work ~equal: [%equal: Transaction_snark.Statement.t One_or_two.t] ) ; - Deferred.unit) ; + Deferred.unit ) ; Deferred.unit in - verify_unsolved_work ()) + verify_unsolved_work () ) let%test_unit "rebroadcast behavior" = let tf = Mocks.Transition_frontier.create [] in @@ -1097,7 +1097,7 @@ let%test_module "random set test" = Quickcheck.Generator.filter Mocks.Transaction_snark_work.Statement.gen ~f:(fun x -> List.for_all l ~f:(fun y -> - Mocks.Transaction_snark_work.Statement.compare x y <> 0)) + Mocks.Transaction_snark_work.Statement.compare x y <> 0 ) ) in let open Quickcheck.Generator.Let_syntax in Quickcheck.random_value ~seed:(`Deterministic "") @@ -1105,19 +1105,19 @@ let%test_module "random set test" = let%bind b = gen_not_any [ a ] in let%bind c = gen_not_any [ a; b ] in let%map d = gen_not_any [ a; b; c ] in - (a, b, c, d)) + (a, b, c, d) ) in let fee1, fee2, fee3, fee4 = Quickcheck.random_value ~seed:(`Deterministic "") (Quickcheck.Generator.tuple4 Fee_with_prover.gen Fee_with_prover.gen - Fee_with_prover.gen Fee_with_prover.gen) + Fee_with_prover.gen Fee_with_prover.gen ) in let fake_sender = Envelope.Sender.Remote (Peer.create (Unix.Inet_addr.of_string "1.2.3.4") ~peer_id:(Peer.Id.unsafe_of_string "contents should be irrelevant") - ~libp2p_port:8302) + ~libp2p_port:8302 ) in let compare_work (x : Mock_snark_pool.Resource_pool.Diff.t) (y : Mock_snark_pool.Resource_pool.Diff.t) = @@ -1224,5 +1224,5 @@ let%test_module "random set test" = [ Add_solved_work (stmt2, { proof = proof2; fee = fee2 }) ; Add_solved_work (stmt4, { proof = proof4; fee = fee4 }) ] ; - Deferred.unit) + Deferred.unit ) end ) diff --git a/src/lib/network_pool/snark_pool.mli b/src/lib/network_pool/snark_pool.mli index db9c5b815fa..7e344f3e6a0 100644 --- a/src/lib/network_pool/snark_pool.mli +++ b/src/lib/network_pool/snark_pool.mli @@ -30,7 +30,7 @@ module type S = sig and type transition_frontier := transition_frontier and type config := Resource_pool.Config.t and type transition_frontier_diff := - Resource_pool.transition_frontier_diff + Resource_pool.transition_frontier_diff and type rejected_diff := Resource_pool.Diff.rejected val get_completed_work : diff --git a/src/lib/network_pool/snark_pool_diff.ml b/src/lib/network_pool/snark_pool_diff.ml index 50a77df1560..adeaa206dbb 100644 --- a/src/lib/network_pool/snark_pool_diff.ml +++ b/src/lib/network_pool/snark_pool_diff.ml @@ -79,7 +79,7 @@ module Make (res : ( (_, _) Snark_work_lib.Work.Single.Spec.t Snark_work_lib.Work.Spec.t , Ledger_proof.t ) - Snark_work_lib.Work.Result.t) = + Snark_work_lib.Work.Result.t ) = Add_solved_work ( One_or_two.map res.spec.instances ~f:Snark_work_lib.Work.Single.Spec.statement @@ -168,7 +168,7 @@ module Make Option.iter (to_compact diff) ~f:(fun work -> [%str_log debug] (Snark_work_received - { work; sender = Envelope.Incoming.sender envelope }))) ; + { work; sender = Envelope.Incoming.sender envelope } ) ) ) ; Mina_metrics.(Counter.inc_one Network.Snark_work.received) ; Mina_net2.Validation_callback.set_message_type valid_cb `Snark_work end diff --git a/src/lib/network_pool/test.ml b/src/lib/network_pool/test.ml index 99f554de415..4ef1c590359 100644 --- a/src/lib/network_pool/test.ml +++ b/src/lib/network_pool/test.ml @@ -24,14 +24,13 @@ let%test_module "network pool test" = let expiry_ns = Time_ns.Span.of_hr - (Float.of_int - precomputed_values.genesis_constants.transaction_expiry_hr) + (Float.of_int precomputed_values.genesis_constants.transaction_expiry_hr) let verifier = Async.Thread_safe.block_on_async_exn (fun () -> Verifier.create ~logger ~proof_level ~constraint_constants ~conf_dir:None - ~pids:(Child_processes.Termination.create_pid_table ())) + ~pids:(Child_processes.Termination.create_pid_table ()) ) module Mock_snark_pool = Snark_pool.Make (Mocks.Base_ledger) (Mocks.Staged_ledger) @@ -48,7 +47,7 @@ let%test_module "network pool test" = let work = `One (Quickcheck.random_value ~seed:(`Deterministic "network_pool_test") - Transaction_snark.Statement.gen) + Transaction_snark.Statement.gen ) in let priced_proof = { Priced_proof.proof = @@ -76,7 +75,7 @@ let%test_module "network pool test" = don't_wait_for (Mock_snark_pool.apply_and_broadcast network_pool (Envelope.Incoming.local command) - (Mock_snark_pool.Broadcast_callback.Local (Fn.const ()))) ; + (Mock_snark_pool.Broadcast_callback.Local (Fn.const ())) ) ; let%map _ = Linear_pipe.read (Mock_snark_pool.broadcasts network_pool) in @@ -84,10 +83,9 @@ let%test_module "network pool test" = match Mock_snark_pool.Resource_pool.request_proof pool work with | Some { proof; fee = _ } -> assert ( - [%equal: Ledger_proof.t One_or_two.t] proof priced_proof.proof - ) + [%equal: Ledger_proof.t One_or_two.t] proof priced_proof.proof ) | None -> - failwith "There should have been a proof here") + failwith "There should have been a proof here" ) let%test_unit "when creating a network, the incoming diffs and local diffs \ in the reader pipes will automatically get process" = @@ -125,14 +123,14 @@ let%test_module "network pool test" = List.map (List.take works per_reader) ~f:create_work |> List.map ~f:(fun work -> ( Envelope.Incoming.local work - , Mina_net2.Validation_callback.create_without_expiration () )) + , Mina_net2.Validation_callback.create_without_expiration () ) ) |> List.iter ~f:(fun diff -> Mock_snark_pool.Remote_sink.push remote_sink diff - |> Deferred.don't_wait_for) ; + |> Deferred.don't_wait_for ) ; List.map (List.drop works per_reader) ~f:create_work |> List.iter ~f:(fun diff -> Mock_snark_pool.Local_sink.push local_sink (diff, Fn.const ()) - |> Deferred.don't_wait_for) ; + |> Deferred.don't_wait_for ) ; let%bind () = Mocks.Transition_frontier.refer_statements tf works in don't_wait_for @@ Linear_pipe.iter (Mock_snark_pool.broadcasts network_pool) @@ -148,7 +146,7 @@ let%test_module "network pool test" = assert ( List.mem works work ~equal:Transaction_snark_work.Statement.equal ) ; - Deferred.unit) ; + Deferred.unit ) ; Deferred.unit in verify_unsolved_work |> Async.Thread_safe.block_on_async_exn diff --git a/src/lib/network_pool/transaction_pool.ml b/src/lib/network_pool/transaction_pool.ml index 9d682f85644..95aec7e286b 100644 --- a/src/lib/network_pool/transaction_pool.ml +++ b/src/lib/network_pool/transaction_pool.ml @@ -236,7 +236,7 @@ module type S = sig and type resource_pool_diff_verified := Diff_versioned.verified and type config := Resource_pool.Config.t and type transition_frontier_diff := - Resource_pool.transition_frontier_diff + Resource_pool.transition_frontier_diff and type rejected_diff := Diff_versioned.rejected end @@ -385,11 +385,11 @@ struct ~f:(fun c -> Transaction_hash .User_command_with_valid_signature - .to_yojson c)) ) + .to_yojson c ) ) ) ] ; failwith error_str ) | None -> - None) + None ) let transactions ~logger t = transactions' ~logger t.pool @@ -506,12 +506,12 @@ struct (Currency.Balance.to_amount (Account.min_balance_at_slot ~global_slot ~cliff_time ~cliff_amount ~vesting_period ~vesting_increment - ~initial_minimum_balance)) + ~initial_minimum_balance ) ) |> Option.value ~default:Currency.Balance.zero let handle_transition_frontier_diff ( ({ new_commands; removed_commands; reorg_best_tip = _ } : - Transition_frontier.best_tip_diff) + Transition_frontier.best_tip_diff ) , best_tip_ledger ) t = (* This runs whenever the best tip changes. The simple case is when the new best tip is an extension of the old one. There, we just remove any @@ -547,11 +547,11 @@ struct [ ( "removed" , `List (List.map removed_commands - ~f:(With_status.to_yojson User_command.Valid.to_yojson)) ) + ~f:(With_status.to_yojson User_command.Valid.to_yojson) ) ) ; ( "added" , `List (List.map new_commands - ~f:(With_status.to_yojson User_command.Valid.to_yojson)) ) + ~f:(With_status.to_yojson User_command.Valid.to_yojson) ) ) ] "Diff: removed: $removed added: $added from best tip" ; let pool', dropped_backtrack = @@ -559,7 +559,7 @@ struct ( removed_commands |> List.rev |> Sequence.of_list |> Sequence.map ~f:(fun unchecked -> unchecked.data - |> Transaction_hash.User_command_with_valid_signature.create) + |> Transaction_hash.User_command_with_valid_signature.create ) ) ~init:(t.pool, Sequence.empty) ~f:(fun (pool, dropped_so_far) cmd -> @@ -580,7 +580,7 @@ struct | Ok indexed_pool -> drop_until_below_max_size ~pool_max_size indexed_pool in - (pool', Sequence.append dropped_so_far dropped_seq)) + (pool', Sequence.append dropped_so_far dropped_seq) ) in (* Track what locally generated commands were removed from the pool during backtracking due to the max size constraint. *) @@ -599,7 +599,7 @@ struct (List.map ~f: Transaction_hash.User_command_with_valid_signature - .to_yojson locally_generated_dropped) ) + .to_yojson locally_generated_dropped ) ) ] ; let pool'', dropped_commit_conflicts = List.fold new_commands ~init:(pool', Sequence.empty) @@ -661,16 +661,16 @@ struct ~f:(fun c -> Transaction_hash .User_command_with_valid_signature - .to_yojson c)) ) + .to_yojson c ) ) ) ] ; failwith error_str in - (p', Sequence.append dropped_so_far dropped)) + (p', Sequence.append dropped_so_far dropped) ) in let commit_conflicts_locally_generated = Sequence.filter dropped_commit_conflicts ~f:(fun cmd -> Hashtbl.find_and_remove t.locally_generated_uncommitted cmd - |> Option.is_some) + |> Option.is_some ) in if not @@ Sequence.is_empty commit_conflicts_locally_generated then [%log' info t.logger] @@ -683,7 +683,7 @@ struct (Sequence.map commit_conflicts_locally_generated ~f: Transaction_hash.User_command_with_valid_signature - .to_yojson)) ) + .to_yojson ) ) ) ] ; [%log' debug t.logger] !"Finished handling diff. Old pool size %i, new pool size %i. Dropped \ @@ -712,8 +712,8 @@ struct not (has_sufficient_fee t.pool (Transaction_hash.User_command_with_valid_signature.command - cmd) - ~pool_max_size) + cmd ) + ~pool_max_size ) then ( [%log' info t.logger] "Not re-adding locally generated command $cmd to pool, \ @@ -731,7 +731,7 @@ struct match Option.bind (Base_ledger.location_of_account best_tip_ledger - (User_command.fee_payer unchecked)) + (User_command.fee_payer unchecked) ) ~f:(Base_ledger.get best_tip_ledger) with | Some acct -> ( @@ -764,7 +764,7 @@ struct | None -> log_and_remove "Fee_payer_account not found" ~metadata: - [ ("user_command", User_command.to_yojson unchecked) ]) ; + [ ("user_command", User_command.to_yojson unchecked) ] ) ; (*Remove any expired user commands*) let expired_commands, pool = Indexed_pool.remove_expired t.pool in Sequence.iter expired_commands ~f:(fun cmd -> @@ -777,7 +777,7 @@ struct ] ; ignore ( Hashtbl.find_and_remove t.locally_generated_uncommitted cmd - : (Time.t * [ `Batch of int ]) option )) ; + : (Time.t * [ `Batch of int ]) option ) ) ; Mina_metrics.( Gauge.set Transaction_pool.pool_size (Float.of_int (Indexed_pool.size pool))) ; @@ -826,14 +826,14 @@ struct Deferred.any_unit [ (let%map () = hdl in t.best_tip_diff_relay <- None ; - is_finished := true) + is_finished := true ) ; (let%map () = Async.after (Time.Span.of_sec 5.) in if not !is_finished then ( [%log fatal] "Transition frontier closed without first \ closing best tip view pipe" ; assert false ) - else ()) + else () ) ] ) | Some frontier -> [%log debug] "Got frontier!" ; @@ -863,7 +863,7 @@ struct in ( acc.nonce , balance_of_account ~global_slot acc - |> Currency.Balance.to_amount )) + |> Currency.Balance.to_amount ) ) in let dropped_locally_generated = Sequence.filter dropped ~f:(fun cmd -> @@ -878,7 +878,7 @@ struct in (* Nothing should be in both tables. *) assert (not (dropped_committed && dropped_uncommitted)) ; - dropped_committed || dropped_uncommitted) + dropped_committed || dropped_uncommitted ) in (* In this situation we don't know whether the commands aren't valid against the new ledger because they were already @@ -896,7 +896,7 @@ struct ~f: Transaction_hash .User_command_with_valid_signature - .to_yojson) ) + .to_yojson ) ) ] ; [%log debug] !"Re-validated transaction pool after restart: dropped %i \ @@ -914,8 +914,8 @@ struct Strict_pipe.Writer.write tf_diff_writer (diff, get_best_tip_ledger frontier) |> Deferred.don't_wait_for ; - Deferred.unit)) ; - Deferred.unit)) ; + Deferred.unit ) ) ; + Deferred.unit ) ) ; t type pool = t @@ -971,12 +971,12 @@ struct @ List.concat_map diffs.accepted ~f:(fun (cmds, _, _) -> List.map cmds ~f:(fun (c, _) -> ( Transaction_hash.User_command_with_valid_signature.command c - , Diff_error.Overloaded ))) + , Diff_error.Overloaded ) ) ) let verified_accepted ({ accepted; _ } : verified) = List.concat_map accepted ~f:(fun (cs, _, _) -> List.map cs ~f:(fun (c, _) -> - Transaction_hash.User_command_with_valid_signature.command c)) + Transaction_hash.User_command_with_valid_signature.command c ) ) let verified_rejected ({ rejected; _ } : verified) : rejected = rejected @@ -1039,7 +1039,7 @@ struct | Unwanted_fee_token _ -> "unwanted fee token" | Expired _ -> - "expired") + "expired" ) in let open Async in let%map () = @@ -1089,7 +1089,7 @@ struct if is_sender_local then [%str_log' error t.logger] (Rejecting_command_for_reason - { command = tx; reason = diff_err; error_extra }) ; + { command = tx; reason = diff_err; error_extra } ) ; trust_record ( Trust_system.Actions.Sent_useless_gossip , Some @@ -1127,7 +1127,7 @@ struct ; ( "sender" , Envelope.(Sender.to_yojson (Incoming.sender diffs)) ) ] ; - is_valid) + is_valid ) in let h = Lru_cache.T.hash diffs.data in let (`Already_mem already_mem) = Lru_cache.add t.recently_seen h in @@ -1152,14 +1152,14 @@ struct List.map diffs.data ~f: (User_command.to_verifiable ~ledger ~get:Base_ledger.get - ~location_of_account:Base_ledger.location_of_account) + ~location_of_account:Base_ledger.location_of_account ) in let by_sender = List.fold data' ~init:Account_id.Map.empty ~f:(fun by_sender c -> Map.add_multi by_sender ~key:(User_command.Verifiable.fee_payer c) - ~data:c) + ~data:c ) |> Map.map ~f:List.rev |> Map.to_alist in let failures = ref (Ok ()) in @@ -1190,7 +1190,7 @@ struct in add_failure (Command_failure - Diff_error.Fee_payer_account_not_found) ; + Diff_error.Fee_payer_account_not_found ) ; Error `Invalid_command | Some account -> let signer_lock = @@ -1210,7 +1210,7 @@ struct ( List.rev acc , List.rev rejected , sender_local_state - , u_acc )) + , u_acc ) ) | c :: cs -> let uc = User_command.of_verifiable c in if Result.is_error !failures then ( @@ -1284,22 +1284,21 @@ struct , `String (Verifier .invalid_to_string - invalid) ) + invalid ) ) ] ; - add_failure - (Invalid_failure invalid) ; + add_failure (Invalid_failure invalid) ; None | Ok (Ok [ c ]) -> Some c | Ok (Ok _) -> - assert false) + assert false ) (`Unchecked ( Transaction_hash.User_command.create uc - , c )) + , c ) ) account.nonce (Currency.Balance.to_amount (balance_of_account ~global_slot - account)) + account ) ) with | Error e -> ( match%bind @@ -1310,7 +1309,7 @@ struct add_failure (Command_failure (diff_error_of_indexed_pool_error - e)) ; + e ) ) ; Mutex.release signer_lock ; return (Error `Invalid_command) | `Ignore -> @@ -1351,7 +1350,7 @@ struct in go (Indexed_pool.get_sender_local_state t.pool signer) - Indexed_pool.Update.empty [] [] cs) + Indexed_pool.Update.empty [] [] cs ) in match !failures with | Error errs when not allow_failures_for_tests -> @@ -1361,7 +1360,7 @@ struct | Command_failure cmd_err -> Yojson.Safe.to_string (Diff_error.to_yojson cmd_err) | Invalid_failure invalid -> - Verifier.invalid_to_string invalid) + Verifier.invalid_to_string invalid ) |> String.concat ~sep:", " in Or_error.errorf "Diff failed with verification failure(s): %s" @@ -1378,12 +1377,12 @@ struct (* We can just skip this set of commands *) None | Ok t -> - Some t) + Some t ) in let data : verified = { accepted = List.map data ~f:(fun (cs, _rej, local_state, u) -> - (cs, local_state, u)) + (cs, local_state, u) ) ; rejected = List.concat_map data ~f:(fun (_, rej, _, _) -> rej) } @@ -1416,7 +1415,7 @@ struct t.current_batch <- t.current_batch + 1 ; t.current_batch ) in - (Time.now (), `Batch batch_num)) + (Time.now (), `Batch batch_num) ) let apply t (env : verified Envelope.Incoming.t) = let module Cs = struct @@ -1431,7 +1430,7 @@ struct Sequence.filter dropped ~f:(fun tx_dropped -> Hashtbl.find_and_remove t.locally_generated_uncommitted tx_dropped - |> Option.is_some) + |> Option.is_some ) |> Sequence.to_list in if not (List.is_empty locally_generated_dropped) then @@ -1444,7 +1443,7 @@ struct (List.map ~f: Transaction_hash.User_command_with_valid_signature - .to_yojson locally_generated_dropped) ) + .to_yojson locally_generated_dropped ) ) ] in let pool, add_results = @@ -1455,7 +1454,7 @@ struct Option.iter (Hashtbl.find t.sender_mutex sender) ~f:Mutex.release ; if Sender_local_state.is_remove local_state then Hashtbl.remove t.sender_mutex sender ; - (set_sender_local_state acc local_state |> Update.apply u, cs)) + (set_sender_local_state acc local_state |> Update.apply u, cs) ) in let add_results = List.concat add_results in let pool, dropped_for_size = @@ -1520,7 +1519,7 @@ struct let signal = Deferred.map (Base_ledger.detached_signal ledger) ~f:(fun () -> Error.createf "Ledger was detached" - |> Error.tag ~tag:"Transaction_pool.apply") + |> Error.tag ~tag:"Transaction_pool.apply" ) in let%bind () = Interruptible.lift Deferred.unit signal in go add_results @@ -1542,7 +1541,7 @@ struct (let x = Time.(now () |> to_span_since_epoch |> Span.to_sec) in - x -. Mina_metrics.time_offset_sec)) ) ; + x -. Mina_metrics.time_offset_sec )) ) ; Ok (accepted, rejected) | Error e -> Error (`Other e) @@ -1560,7 +1559,7 @@ struct Option.iter gossip_heard_logger_option ~f:(fun logger -> [%str_log debug] (Transactions_received - { txns = diff; sender = Envelope.Incoming.sender envelope })) ; + { txns = diff; sender = Envelope.Incoming.sender envelope } ) ) ; Mina_net2.Validation_callback.set_message_type valid_cb `Transaction ; Mina_metrics.(Counter.inc_one Network.Transaction.received) end @@ -1585,7 +1584,7 @@ struct added_str ~metadata:(metadata ~key ~time) ; false | `Ok -> - true) ; + true ) ; Hashtbl.filteri_inplace t.locally_generated_committed ~f:(fun ~key ~data:(time, `Batch _) -> match has_timed_out time with @@ -1596,7 +1595,7 @@ struct added_str ~metadata:(metadata ~key ~time) ; false | `Ok -> - true) ; + true ) ; (* Important to maintain ordering here *) let rebroadcastable_txs = Hashtbl.to_alist t.locally_generated_uncommitted @@ -1618,15 +1617,15 @@ struct (get_nonce txn2) in if cmp <> 0 then cmp - else Transaction_hash.compare (get_hash txn1) (get_hash txn2)) + else Transaction_hash.compare (get_hash txn1) (get_hash txn2) ) |> List.group ~break:(fun (_, (_, `Batch batch1)) (_, (_, `Batch batch2)) -> - batch1 <> batch2) + batch1 <> batch2 ) |> List.map ~f: (List.map ~f:(fun (txn, _) -> Transaction_hash.User_command_with_valid_signature.command - txn)) + txn ) ) in rebroadcastable_txs end @@ -1646,20 +1645,21 @@ end) Make0 (Mina_ledger.Ledger) (Staged_ledger) (Transition_frontier) (* TODO: defunctor or remove monkey patching (#3731) *) -include Make - (Staged_ledger) - (struct - include Transition_frontier - - type best_tip_diff = Extensions.Best_tip_diff.view = - { new_commands : User_command.Valid.t With_status.t list - ; removed_commands : User_command.Valid.t With_status.t list - ; reorg_best_tip : bool - } +include + Make + (Staged_ledger) + (struct + include Transition_frontier - let best_tip_diff_pipe t = - Extensions.(get_view_pipe (extensions t) Best_tip_diff) - end) + type best_tip_diff = Extensions.Best_tip_diff.view = + { new_commands : User_command.Valid.t With_status.t list + ; removed_commands : User_command.Valid.t With_status.t list + ; reorg_best_tip : bool + } + + let best_tip_diff_pipe t = + Extensions.(get_view_pipe (extensions t) Best_tip_diff) + end) let%test_module _ = ( module struct @@ -1692,14 +1692,13 @@ let%test_module _ = let expiry_ns = Time_ns.Span.of_hr - (Float.of_int - precomputed_values.genesis_constants.transaction_expiry_hr) + (Float.of_int precomputed_values.genesis_constants.transaction_expiry_hr) let verifier = Async.Thread_safe.block_on_async_exn (fun () -> Verifier.create ~logger ~proof_level ~constraint_constants ~conf_dir:None - ~pids:(Child_processes.Termination.create_pid_table ())) + ~pids:(Child_processes.Termination.create_pid_table ()) ) module Mock_transition_frontier = struct module Breadcrumb = struct @@ -1728,7 +1727,7 @@ let%test_module _ = let account_id = Account_id.create compressed Token_id.default in ( account_id , Account.create account_id - @@ Currency.Balance.of_int 1_000_000_000_000 )) + @@ Currency.Balance.of_int 1_000_000_000_000 ) ) in let ledger = Account_id.Table.of_alist_exn accounts in ((pipe_r, ref ledger), pipe_w) @@ -1770,7 +1769,7 @@ let%test_module _ = assert ( Indexed_pool.member pool.pool (Transaction_hash.User_command.of_checked key) ) ; - Some cmd) + Some cmd ) : ( Transaction_hash.User_command_with_valid_signature.t , Time.t * [ `Batch of int ] ) Hashtbl.t ) @@ -1824,7 +1823,7 @@ let%test_module _ = ~f:Transaction_hash.User_command_with_valid_signature.command |> Sequence.to_list |> List.sort ~compare:User_command.compare ) - (List.sort ~compare:User_command.compare txs)) + (List.sort ~compare:User_command.compare txs) ) , pool , best_tip_diff_w , tf ) @@ -1838,7 +1837,7 @@ let%test_module _ = User_command.Valid.Gen.payment ~sign_type:`Real ~key_gen: (Quickcheck.Generator.tuple2 (return sender) - (Quickcheck_lib.of_array test_keys)) + (Quickcheck_lib.of_array test_keys) ) ~max_amount:100_000_000_000 ~fee_range:10_000_000_000 () in go (n + 1) (cmd :: cmds) @@ -1877,7 +1876,7 @@ let%test_module _ = (Account_id.to_yojson acct_id |> Yojson.Safe.to_string) () | Ok (`Added, _) -> - ()) ; + () ) ; ledger in let keymap = @@ -1885,7 +1884,7 @@ let%test_module _ = ~init:Public_key.Compressed.Map.empty ~f:(fun map { public_key; private_key } -> let key = Public_key.compress public_key in - Public_key.Compressed.Map.add_exn map ~key ~data:private_key) + Public_key.Compressed.Map.add_exn map ~key ~data:private_key ) in (* ledger that gets updated by the Snapp generators *) let ledger = mk_ledger () in @@ -1917,7 +1916,7 @@ let%test_module _ = in ignore ( Mock_base_ledger.add best_tip_ledger ~account_id ~account - : [ `Duplicate | `Ok ] )) ; + : [ `Duplicate | `Ok ] ) ) ; result let mk_parties_cmds' (pool : Test.Resource_pool.t) : User_command.t list = @@ -1984,7 +1983,7 @@ let%test_module _ = setup_test () in mk_linear_case_test assert_pool_txs pool best_tip_diff_w - independent_cmds') + independent_cmds' ) let%test_unit "transactions are removed in linear case (zkapps)" = Thread_safe.block_on_async_exn (fun () -> @@ -1992,7 +1991,7 @@ let%test_module _ = setup_test () in mk_linear_case_test assert_pool_txs pool best_tip_diff_w - (mk_parties_cmds' pool)) + (mk_parties_cmds' pool) ) let map_set_multi map pairs = let rec go pairs = @@ -2057,7 +2056,7 @@ let%test_module _ = setup_test () in mk_remove_and_add_test assert_pool_txs pool best_tip_diff_w - best_tip_ref independent_cmds) + best_tip_ref independent_cmds ) let%test_unit "Transactions are removed and added back in fork changes \ (zkapps)" = @@ -2066,7 +2065,7 @@ let%test_module _ = setup_test () in mk_remove_and_add_test assert_pool_txs pool best_tip_diff_w - best_tip_ref (mk_parties_cmds pool)) + best_tip_ref (mk_parties_cmds pool) ) let mk_invalid_test assert_pool_txs pool best_tip_diff_w best_tip_ref cmds' = @@ -2094,7 +2093,7 @@ let%test_module _ = setup_test () in mk_invalid_test assert_pool_txs pool best_tip_diff_w best_tip_ref - independent_cmds') + independent_cmds' ) let%test_unit "invalid transactions are not accepted (zkapps)" = Thread_safe.block_on_async_exn (fun () -> @@ -2102,7 +2101,7 @@ let%test_module _ = setup_test () in mk_invalid_test assert_pool_txs pool best_tip_diff_w best_tip_ref - (mk_parties_cmds' pool)) + (mk_parties_cmds' pool) ) let mk_payment' ?valid_until ~sender_idx ~receiver_idx ~fee ~nonce ~amount () = @@ -2117,7 +2116,7 @@ let%test_module _ = { source_pk = get_pk sender_idx ; receiver_pk = get_pk receiver_idx ; amount = Currency.Amount.of_int amount - })) + } ) ) let mk_parties ?valid_period ?fee_payer_idx ~sender_idx ~receiver_idx ~fee ~nonce ~amount () = @@ -2171,7 +2170,7 @@ let%test_module _ = = User_command.Signed_command (mk_payment' ?valid_until ~sender_idx ~fee ~nonce ~receiver_idx ~amount - ()) + () ) let current_global_slot () = let current_time = Block_time.now time_controller in @@ -2202,7 +2201,7 @@ let%test_module _ = Quickcheck.Generator.( tuple2 (return sender) (Quickcheck_lib.of_array test_keys)) ~nonce:(Account.Nonce.of_int 1) ~max_amount:100_000_000_000 - ~fee_range:10_000_000_000 ()) + ~fee_range:10_000_000_000 () ) in let%bind apply_res = verify_and_apply pool [ User_command.forget_check cmd1 ] @@ -2238,7 +2237,7 @@ let%test_module _ = setup_test () in mk_now_invalid_test assert_pool_txs pool best_tip_diff_w best_tip_ref - independent_cmds) + independent_cmds ) let%test_unit "Now-invalid transactions are removed from the pool on fork \ changes (zkapps)" = @@ -2247,7 +2246,7 @@ let%test_module _ = setup_test () in mk_now_invalid_test assert_pool_txs pool best_tip_diff_w best_tip_ref - (mk_parties_cmds pool)) + (mk_parties_cmds pool) ) let mk_expired_not_accepted_test assert_pool_txs pool ~padding cmds = assert_pool_txs [] ; @@ -2273,14 +2272,14 @@ let%test_module _ = let%bind () = after (Block_time.Span.to_time_span - consensus_constants.block_window_duration_ms) + consensus_constants.block_window_duration_ms ) in let all_valid_commands = cmds @ [ valid_command ] in let%bind apply_res = verify_and_apply pool (List.map (all_valid_commands @ expired_commands) - ~f:User_command.forget_check) + ~f:User_command.forget_check ) in let cmds_wo_check = List.map all_valid_commands ~f:User_command.forget_check @@ -2295,7 +2294,7 @@ let%test_module _ = setup_test () in mk_expired_not_accepted_test assert_pool_txs pool ~padding:10 - independent_cmds) + independent_cmds ) let%test_unit "expired transactions are not accepted (zkapps)" = Thread_safe.block_on_async_exn (fun () -> @@ -2303,7 +2302,7 @@ let%test_module _ = setup_test () in mk_expired_not_accepted_test assert_pool_txs pool ~padding:25 - (mk_parties_cmds pool)) + (mk_parties_cmds pool) ) let%test_unit "Expired transactions that are already in the pool are \ removed from the pool when best tip changes (user commands)" @@ -2338,9 +2337,7 @@ let%test_module _ = List.map valid_commands ~f:User_command.forget_check in let%bind apply_res = verify_and_apply pool cmds_wo_check in - [%test_eq: pool_apply] - (accepted_commands apply_res) - (Ok cmds_wo_check) ; + [%test_eq: pool_apply] (accepted_commands apply_res) (Ok cmds_wo_check) ; assert_pool_txs cmds_wo_check ; (* new commands from best tip diff should be removed from the pool *) (* update the nonce to be consistent with the commands in the block *) @@ -2425,7 +2422,7 @@ let%test_module _ = in let%bind () = Async.Scheduler.yield_until_no_jobs_remain () in assert_pool_txs cmds_wo_check ; - Deferred.unit) + Deferred.unit ) let%test_unit "Expired transactions that are already in the pool are \ removed from the pool when best tip changes (zkapps)" = @@ -2479,9 +2476,7 @@ let%test_module _ = List.map valid_commands ~f:User_command.forget_check in let%bind apply_res = verify_and_apply pool cmds_wo_check in - [%test_eq: pool_apply] - (accepted_commands apply_res) - (Ok cmds_wo_check) ; + [%test_eq: pool_apply] (accepted_commands apply_res) (Ok cmds_wo_check) ; assert_pool_txs cmds_wo_check ; (* new commands from best tip diff should be removed from the pool *) (* update the nonce to be consistent with the commands in the block *) @@ -2567,7 +2562,7 @@ let%test_module _ = in let%bind () = Async.Scheduler.yield_until_no_jobs_remain () in assert_pool_txs cmds_wo_check ; - Deferred.unit) + Deferred.unit ) let%test_unit "Aged-based expiry (zkapps)" = Thread_safe.block_on_async_exn (fun () -> @@ -2585,9 +2580,7 @@ let%test_module _ = List.map valid_commands ~f:User_command.forget_check in let%bind apply_res = verify_and_apply pool cmds_wo_check in - [%test_eq: pool_apply] - (accepted_commands apply_res) - (Ok cmds_wo_check) ; + [%test_eq: pool_apply] (accepted_commands apply_res) (Ok cmds_wo_check) ; assert_pool_txs cmds_wo_check ; let%bind () = after (Time.Span.of_sec 2.) in let%map _ = @@ -2598,7 +2591,7 @@ let%test_module _ = } : Mock_transition_frontier.best_tip_diff ) in - assert_pool_txs []) + assert_pool_txs [] ) let%test_unit "Now-invalid transactions are removed from the pool when the \ transition frontier is recreated (user cmds)" = @@ -2651,7 +2644,7 @@ let%test_module _ = Broadcast_pipe.Writer.write frontier_pipe_w (Some frontier2) in assert_pool_txs @@ List.drop independent_cmds' 3 ; - Deferred.unit) + Deferred.unit ) let%test_unit "transaction replacement works" = Thread_safe.block_on_async_exn @@ -2727,7 +2720,7 @@ let%test_module _ = in Currency.Balance.to_int account.balance - amount in - mk_payment ~sender_idx:3 ~fee ~nonce:1 ~receiver_idx:4 ~amount ()) + mk_payment ~sender_idx:3 ~fee ~nonce:1 ~receiver_idx:4 ~amount () ) ] in let replace_txs = List.map replace_txs ~f:User_command.forget_check in @@ -2806,7 +2799,7 @@ let%test_module _ = (Currency.Amount.to_uint64 balance) ; nonce ; timing - } )) + } ) ) |> Sequence.to_list ) in best_tip_ref := mock_ledger ; @@ -2834,7 +2827,7 @@ let%test_module _ = commands have higher fee than the lowest one already in the pool. *) - assert (Indexed_pool.size pool.pool <= pool_max_size))) + assert (Indexed_pool.size pool.pool <= pool_max_size) ) ) let assert_rebroadcastable pool cmds = let normalize = List.sort ~compare:User_command.compare in @@ -2852,7 +2845,7 @@ let%test_module _ = (Peer.create (Unix.Inet_addr.of_string "1.2.3.4") ~peer_id:(Peer.Id.unsafe_of_string "contents should be irrelevant") - ~libp2p_port:8302) + ~libp2p_port:8302 ) let mk_rebroadcastable_test assert_pool_txs pool best_tip_diff_w cmds = assert_pool_txs [] ; @@ -2962,7 +2955,7 @@ let%test_module _ = setup_test () in mk_rebroadcastable_test assert_pool_txs pool best_tip_diff_w - independent_cmds) + independent_cmds ) let%test_unit "rebroadcastable transaction behavior (zkapps)" = Thread_safe.block_on_async_exn (fun () -> @@ -2970,7 +2963,7 @@ let%test_module _ = setup_test () in mk_rebroadcastable_test assert_pool_txs pool best_tip_diff_w - (mk_parties_cmds pool)) + (mk_parties_cmds pool) ) let%test_unit "apply user cmds and zkapps" = Thread_safe.block_on_async_exn (fun () -> @@ -2991,5 +2984,5 @@ let%test_module _ = let%bind apply_res = verify_and_apply pool all_cmds in [%test_eq: pool_apply] (accepted_commands apply_res) (Ok all_cmds) ; assert_pool_txs all_cmds ; - Deferred.unit) + Deferred.unit ) end ) diff --git a/src/lib/network_pool/writer_result.ml b/src/lib/network_pool/writer_result.ml index 8744c42fe44..568d0c62a68 100644 --- a/src/lib/network_pool/writer_result.ml +++ b/src/lib/network_pool/writer_result.ml @@ -67,7 +67,7 @@ module T = struct let bind (type a b x e) (t : (a, x, e) t) ~(f : a -> (b, x, e) t) : (b, x, e) t = Result.bind t ~f:(fun (a, w1) -> - Result.map (f a) ~f:(fun (b, w2) -> (b, Tree.append w1 w2))) + Result.map (f a) ~f:(fun (b, w2) -> (b, Tree.append w1 w2)) ) end include T @@ -133,7 +133,7 @@ module Deferred = struct | Undeferred rb -> Deferred.return (Result.map rb ~f:(g w1)) | Deferred drb -> - Deferred.Result.map drb ~f:(g w1)) + Deferred.Result.map drb ~f:(g w1) ) let lift (type a x e) (t : (a, x, e) T.t) : (a, x, e) t = Undeferred t end @@ -149,7 +149,8 @@ module Deferred = struct | Deferred t -> Deferred (Async.Deferred.bind t ~f:(fun t -> - match f t with Undeferred t -> Async.return t | Deferred t -> t)) + match f t with Undeferred t -> Async.return t | Deferred t -> t ) + ) let write x = lift (write x) diff --git a/src/lib/node_addrs_and_ports/node_addrs_and_ports.ml b/src/lib/node_addrs_and_ports/node_addrs_and_ports.ml index b71d7ef3537..3735b28c84d 100644 --- a/src/lib/node_addrs_and_ports/node_addrs_and_ports.ml +++ b/src/lib/node_addrs_and_ports/node_addrs_and_ports.ml @@ -54,7 +54,7 @@ let to_multiaddr (t : t) = Some (sprintf "/ip4/%s/tcp/%d/p2p/%s" (Unix.Inet_addr.to_string t.external_ip) - t.libp2p_port peer.peer_id) + t.libp2p_port peer.peer_id ) | None -> None diff --git a/src/lib/node_error_service/node_error_service.ml b/src/lib/node_error_service/node_error_service.ml index db9a373dc05..2ca95cff5f4 100644 --- a/src/lib/node_error_service/node_error_service.ml +++ b/src/lib/node_error_service/node_error_service.ml @@ -46,7 +46,7 @@ let send_node_error_data ~logger ~url node_error_data = Async.try_with (fun () -> Cohttp_async.Client.post ~headers ~body:(Yojson.Safe.to_string json |> Cohttp_async.Body.of_string) - url) + url ) with | Ok ({ status; _ }, body) -> let metadata = @@ -111,7 +111,7 @@ let send_report ~logger ~node_error_url ~mina_ref ~error ~contact_info = | Full catchup_tree -> Some (Transition_frontier.Full_catchup_tree.to_node_status_report - catchup_tree) + catchup_tree ) | _ -> None ) in @@ -120,7 +120,7 @@ let send_report ~logger ~node_error_url ~mina_ref ~error ~contact_info = |> Participating_state.map ~f:(fun b -> Transition_frontier.Breadcrumb.consensus_state b |> Consensus.Data.Consensus_state.blockchain_length - |> Mina_numbers.Length.to_uint32) + |> Mina_numbers.Length.to_uint32 ) |> Participating_state.map ~f:Unsigned.UInt32.to_int |> Participating_state.active in @@ -156,5 +156,5 @@ let send_report ~logger ~node_error_url ~mina_ref ~error ~contact_info = Span.to_string_hum @@ Time.diff (now ()) (Time_ns.to_time_float_round_nearest_microsecond - Mina_lib.daemon_start_time)) + Mina_lib.daemon_start_time )) } diff --git a/src/lib/node_status/node_status.ml b/src/lib/node_status/node_status.ml index 132c79debb1..103e79b3c99 100644 --- a/src/lib/node_status/node_status.ml +++ b/src/lib/node_status/node_status.ml @@ -20,4 +20,4 @@ let get_node_status_from_peers (net : Mina_networking.t) Deferred.return (List.map peers ~f:(fun _ -> Or_error.error_string - "Could not parse peers in node status request")) ) + "Could not parse peers in node status request" ) ) ) diff --git a/src/lib/node_status_service/node_status_service.ml b/src/lib/node_status_service/node_status_service.ml index 4eeb50176af..90e604f616e 100644 --- a/src/lib/node_status_service/node_status_service.ml +++ b/src/lib/node_status_service/node_status_service.ml @@ -84,7 +84,7 @@ let send_node_status_data ~logger ~url node_status_data = Async.try_with (fun () -> Cohttp_async.Client.post ~headers ~body:(Yojson.Safe.to_string json |> Cohttp_async.Body.of_string) - url) + url ) with | Ok ({ status; _ }, body) -> let metadata = @@ -170,7 +170,7 @@ let start ~logger ~node_status_url ~transition_frontier ~sync_status ~network | Full catchup_tree -> Some (Transition_frontier.Full_catchup_tree.to_node_status_report - catchup_tree) + catchup_tree ) | _ -> None in @@ -339,7 +339,7 @@ let start ~logger ~node_status_url ~transition_frontier ~sync_status ~network Time.to_string (Block_time.to_time received_at) ; is_valid = false ; reason_for_rejection = Some reason_for_rejection - }) + } ) @ List.map (Queue.to_list Transition_frontier.validated_blocks) ~f:(fun (hash, sender, received_at) -> { hash @@ -348,7 +348,7 @@ let start ~logger ~node_status_url ~transition_frontier ~sync_status ~network Time.to_string (Block_time.to_time received_at) ; is_valid = true ; reason_for_rejection = None - }) + } ) } in reset_gauges () ; diff --git a/src/lib/non_empty_list/non_empty_list.ml b/src/lib/non_empty_list/non_empty_list.ml index 53df4f5d221..7f425a14553 100644 --- a/src/lib/non_empty_list/non_empty_list.ml +++ b/src/lib/non_empty_list/non_empty_list.ml @@ -60,11 +60,11 @@ let take (x, xs) = function let min_elt ~compare (x, xs) = Option.value_map ~default:x (List.min_elt ~compare xs) ~f:(fun mininum -> - if compare x mininum < 0 then x else mininum) + if compare x mininum < 0 then x else mininum ) let max_elt ~compare (x, xs) = Option.value_map ~default:x (List.max_elt ~compare xs) ~f:(fun maximum -> - if compare x maximum > 0 then x else maximum) + if compare x maximum > 0 then x else maximum ) let rec iter_deferred (x, xs) ~f = let open Async_kernel in diff --git a/src/lib/non_zero_curve_point/non_zero_curve_point.ml b/src/lib/non_zero_curve_point/non_zero_curve_point.ml index 2f3116680a0..03e9ea06ad0 100644 --- a/src/lib/non_zero_curve_point/non_zero_curve_point.ml +++ b/src/lib/non_zero_curve_point/non_zero_curve_point.ml @@ -17,7 +17,7 @@ let gen_uncompressed = Quickcheck.Generator.filter_map Field.gen_uniform ~f:(fun x -> let open Option.Let_syntax in let%map y = Inner_curve.find_y x in - (x, y)) + (x, y) ) module Compressed = struct open Compressed_poly @@ -180,7 +180,7 @@ module Uncompressed = struct Option.map (Inner_curve.find_y x) ~f:(fun y -> let y_parity = parity y in let y = if Bool.(is_odd = y_parity) then y else Field.negate y in - (x, y)) + (x, y) ) let decompress_exn t = match decompress t with @@ -189,7 +189,7 @@ module Uncompressed = struct | None -> failwith (sprintf "Compressed public key %s could not be decompressed" - (Yojson.Safe.to_string @@ Compressed.to_yojson t)) + (Yojson.Safe.to_string @@ Compressed.to_yojson t) ) let of_base58_check_decompress_exn pk_str = let pk = Compressed.of_base58_check_exn pk_str in @@ -205,15 +205,16 @@ module Uncompressed = struct let to_latest = Fn.id - include Binable.Of_binable - (Compressed.Stable.V1) - (struct - type nonrec t = t + include + Binable.Of_binable + (Compressed.Stable.V1) + (struct + type nonrec t = t - let of_binable = decompress_exn + let of_binable = decompress_exn - let to_binable = compress - end) + let to_binable = compress + end) let gen : t Quickcheck.Generator.t = gen_uncompressed @@ -266,7 +267,7 @@ module Uncompressed = struct let%test_unit "point-compression: decompress . compress = id" = Quickcheck.test gen ~f:(fun pk -> - assert (equal (decompress_exn (compress pk)) pk)) + assert (equal (decompress_exn (compress pk)) pk) ) [%%ifdef consensus_mechanism] diff --git a/src/lib/o1trace/o1trace.ml b/src/lib/o1trace/o1trace.ml index 3db6117f7b4..e2b5c834b09 100644 --- a/src/lib/o1trace/o1trace.ml +++ b/src/lib/o1trace/o1trace.ml @@ -9,18 +9,18 @@ let () = Plugins.enable_plugin (module Execution_timer) let on_job_enter' (fiber : Thread.Fiber.t) = Plugins.dispatch (fun (module Plugin : Plugins.Plugin_intf) -> - Plugin.on_job_enter fiber) + Plugin.on_job_enter fiber ) let on_job_exit' fiber elapsed_time = Plugins.dispatch (fun (module Plugin : Plugins.Plugin_intf) -> - Plugin.on_job_exit fiber elapsed_time) + Plugin.on_job_exit fiber elapsed_time ) let on_job_enter ctx = Option.iter (Thread.Fiber.of_context ctx) ~f:on_job_enter' let on_job_exit ctx elapsed_time = Option.iter (Thread.Fiber.of_context ctx) ~f:(fun thread -> - on_job_exit' thread elapsed_time) + on_job_exit' thread elapsed_time ) let current_sync_fiber = ref None @@ -55,7 +55,7 @@ let exec_thread ~exec_same_thread ~exec_new_thread name = let result = if Option.value_map parent ~default:false ~f:(fun p -> - String.equal p.thread.name name) + String.equal p.thread.name name ) then exec_same_thread () else let fiber = @@ -80,7 +80,7 @@ let thread name f = "timing task `%s` failed, exception reported to parent monitor" name () | Ok x -> - x) + x ) let background_thread name f = don't_wait_for (thread name f) @@ -93,7 +93,7 @@ let sync_thread name f = let result = f () in let elapsed_time = Time_ns.abs_diff (Time_ns.now ()) start_time in on_job_exit' fiber elapsed_time ; - result) + result ) let () = Stdlib.(Async_kernel.Tracing.fns := { on_job_enter; on_job_exit }) @@ -126,7 +126,7 @@ let%test_module "thread tests" = let s = Ivar.create () in f (Ivar.fill s) ; let%bind () = Ivar.read s in - Writer.(flushed (Lazy.force stdout))) + Writer.(flushed (Lazy.force stdout)) ) let test f = test' (fun s -> don't_wait_for (f s)) @@ -138,7 +138,7 @@ let%test_module "thread tests" = thread "c" (fun () -> assert (child_of "b") ; stop () ; - Deferred.unit)))) + Deferred.unit ) ) ) ) let%test_unit "thread > background_thread > thread" = test (fun stop -> @@ -148,23 +148,23 @@ let%test_module "thread tests" = thread "c" (fun () -> assert (child_of "b") ; stop () ; - Deferred.unit)) ; - Deferred.unit)) + Deferred.unit ) ) ; + Deferred.unit ) ) let%test_unit "thread > sync_thread" = test (fun stop -> thread "a" (fun () -> sync_thread "b" (fun () -> assert (child_of "a") ; - stop ()) ; - Deferred.unit)) + stop () ) ; + Deferred.unit ) ) let%test_unit "sync_thread > sync_thread" = test' (fun stop -> sync_thread "a" (fun () -> sync_thread "b" (fun () -> assert (child_of "a") ; - stop ()))) + stop () ) ) ) let%test_unit "sync_thread > background_thread" = test (fun stop -> @@ -172,8 +172,8 @@ let%test_module "thread tests" = background_thread "b" (fun () -> assert (child_of "a") ; stop () ; - Deferred.unit)) ; - Deferred.unit) + Deferred.unit ) ) ; + Deferred.unit ) let%test_unit "sync_thread > background_thread" = test' (fun stop -> @@ -181,7 +181,7 @@ let%test_module "thread tests" = background_thread "b" (fun () -> assert (child_of "a") ; stop () ; - Deferred.unit))) + Deferred.unit ) ) ) let%test_unit "sync_thread > background_thread > sync_thread > thread" = test' (fun stop -> @@ -194,8 +194,8 @@ let%test_module "thread tests" = (thread "d" (fun () -> assert (child_of "c") ; stop () ; - Deferred.unit))) ; - Deferred.unit))) + Deferred.unit ) ) ) ; + Deferred.unit ) ) ) (* TODO: recursion tests *) end ) diff --git a/src/lib/o1trace/thread.ml b/src/lib/o1trace/thread.ml index 4a9276258a1..6454e73e494 100644 --- a/src/lib/o1trace/thread.ml +++ b/src/lib/o1trace/thread.ml @@ -78,7 +78,7 @@ module Fiber = struct let rec fiber_key name parent = name :: Option.value_map parent ~default:[] ~f:(fun p -> - fiber_key p.thread.name p.parent) + fiber_key p.thread.name p.parent ) let register name parent = let key = fiber_key name parent in diff --git a/src/lib/o1trace/webkit_event/o1trace_webkit_event.ml b/src/lib/o1trace/webkit_event/o1trace_webkit_event.ml index 094d32c275b..fbc74b1df90 100644 --- a/src/lib/o1trace/webkit_event/o1trace_webkit_event.ml +++ b/src/lib/o1trace/webkit_event/o1trace_webkit_event.ml @@ -12,7 +12,7 @@ let emit_event = try Webkit_trace_event_binary_output.emit_event ~buf wr event with exn -> Writer.writef wr "failed to write o1trace event: %s\n" - (Exn.to_string exn)) + (Exn.to_string exn) ) let timestamp () = Time_stamp_counter.now () |> Time_stamp_counter.to_int63 |> Int63.to_int_exn @@ -86,15 +86,16 @@ let measure (name : string) (f : unit -> 'a) : 'a = *) module T = struct - include O1trace.Plugins.Register_plugin - (struct - type state = unit [@@deriving sexp_of] + include + O1trace.Plugins.Register_plugin + (struct + type state = unit [@@deriving sexp_of] - let name = "Webkit_event" + let name = "Webkit_event" - let init_state _ = () - end) - () + let init_state _ = () + end) + () let on_job_enter (fiber : O1trace.Thread.Fiber.t) = emit_event @@ -119,7 +120,7 @@ let start_tracing wr = emit_event (new_thread_event ~include_name:true (O1trace.Thread.name thread) - New_thread)) ; + New_thread ) ) ; O1trace.Plugins.enable_plugin (module T) ) let stop_tracing () = diff --git a/src/lib/one_or_two/one_or_two.ml b/src/lib/one_or_two/one_or_two.ml index 180ecbf31b2..f20633bd7d2 100644 --- a/src/lib/one_or_two/one_or_two.ml +++ b/src/lib/one_or_two/one_or_two.ml @@ -46,7 +46,7 @@ let group_sequence : 'a Sequence.t -> 'a t Sequence.t = | None -> Some (`One a, Sequence.empty) | Some (b, rest_2) -> - Some (`Two (a, b), rest_2) )) + Some (`Two (a, b), rest_2) ) ) let group_list : 'a list -> 'a t list = fun xs -> xs |> Sequence.of_list |> group_sequence |> Sequence.to_list diff --git a/src/lib/otp_lib/capped_supervisor.ml b/src/lib/otp_lib/capped_supervisor.ml index 366ebb48dfe..28bc9e8892a 100644 --- a/src/lib/otp_lib/capped_supervisor.ml +++ b/src/lib/otp_lib/capped_supervisor.ml @@ -20,7 +20,7 @@ let create ?(buffer_capacity = 30) ~job_capacity f = don't_wait_for (let%map () = f job in decr active_jobs ; - Bvar.broadcast job_finished_bvar ()) + Bvar.broadcast job_finished_bvar () ) in let rec start_jobs n = if n <= 0 then () @@ -42,7 +42,7 @@ let create ?(buffer_capacity = 30) ~job_capacity f = don't_wait_for (Reader.iter_without_pushback job_reader ~f:(fun job -> if !active_jobs < job_capacity then run_job job - else pending_jobs := !pending_jobs @ [ job ])) ; + else pending_jobs := !pending_jobs @ [ job ] ) ) ; { job_writer; f } let dispatch t data = Writer.write t.job_writer data diff --git a/src/lib/parallel_scan/parallel_scan.ml b/src/lib/parallel_scan/parallel_scan.ml index a1e84043edd..f2578a48fb6 100644 --- a/src/lib/parallel_scan/parallel_scan.ml +++ b/src/lib/parallel_scan/parallel_scan.ml @@ -9,7 +9,7 @@ open Pipe_lib 4. 'merge_t: 'merge Merge.t 5. 'base_job: Base.Job.t 6. 'merge_job: Merge.Job.t - *) +*) (*Note: Prefixing some of the general purpose functions that could be used in the future with an "_" to not cause "unused function" error*) @@ -322,13 +322,13 @@ module Tree = struct | Continue r -> f_merge i r y | x -> - M.return x) + M.return x ) ~f_base:(fun acc (x, y) -> match%bind f_base acc x with | Continue r -> f_base r y | x -> - M.return x) + M.return x ) ~init:acc' sub_tree | x -> M.return x ) @@ -424,15 +424,14 @@ module Tree = struct ~f_merge:(fun (b, b') i (x, y) -> let%bind left = f_merge b i x in let%map right = f_merge b' i y in - ((fst left, fst right), Option.both (snd left) (snd right))) + ((fst left, fst right), Option.both (snd left) (snd right)) ) ~f_base:(fun (b, b') (x, x') -> let%bind left = f_base b x in let%map right = f_base b' x' in - (left, right)) + (left, right) ) ~weight_merge:(fun (a, b) -> (weight_merge a, weight_merge b)) ~update_level - ~jobs_split:(fun (x, y) (a, b) -> - (jobs_split x a, jobs_split y b)) + ~jobs_split:(fun (x, y) (a, b) -> (jobs_split x a, jobs_split y b)) ~jobs:new_jobs_list sub_tree in (Node { depth; value = value'; sub_tree = sub }, scan_result) @@ -454,7 +453,7 @@ module Tree = struct let sub, counts = update_accumulate ~f_merge:(fun (b1, b2) (x, y) -> - transpose (f_merge b1 x, f_merge b2 y)) + transpose (f_merge b1 x, f_merge b2 y) ) ~f_base:(fun (x, y) -> transpose (f_base x, f_base y)) sub_tree in @@ -569,7 +568,7 @@ module Tree = struct ~jobs ~update_level ~jobs_split:(fun (w1, w2) a -> let l = weight_lens.get w1 in let r = weight_lens.get w2 in - (List.take a l, List.take (List.drop a l) r)) + (List.take a l, List.take (List.drop a l) r) ) let reset_weights : [ `Base | `Merge | `Both ] @@ -651,13 +650,13 @@ module Tree = struct | true, (_weight, Merge.Job.Full { left; right; status = Todo; _ }) -> Available_job.Merge (left, right) :: acc | _ -> - acc) + acc ) ~f_base:(fun acc d -> match (level = depth, d) with | true, (_weight, Base.Job.Full { job; status = Todo; _ }) -> Available_job.Base job :: acc | _ -> - acc) + acc ) tree |> List.rev @@ -670,13 +669,13 @@ module Tree = struct | _, Merge.Job.Full { status = Job_status.Done; _ } -> acc | _ -> - Job.Merge a :: acc) + Job.Merge a :: acc ) ~f_base:(fun acc d -> match d with | _, Base.Job.Full { status = Job_status.Done; _ } -> acc | _ -> - Job.Base d :: acc) + Job.Base d :: acc ) tree |> List.rev @@ -689,9 +688,9 @@ module Tree = struct | _weight, Merge.Job.Full x -> Job.Merge x :: acc | _ -> - acc) + acc ) ~f_base:(fun acc d -> - match d with _weight, Base.Job.Full j -> Job.Base j :: acc | _ -> acc) + match d with _weight, Base.Job.Full j -> Job.Base j :: acc | _ -> acc ) tree |> List.rev @@ -700,7 +699,7 @@ module Tree = struct fold_depth ~init:[] ~f_merge:(fun _ _ _ -> []) ~f_base:(fun acc d -> - match d with _, Base.Job.Full { job; _ } -> job :: acc | _ -> acc) + match d with _, Base.Job.Full { job; _ } -> job :: acc | _ -> acc ) tree |> List.rev @@ -714,13 +713,13 @@ module Tree = struct | Merge.Job.Full { status = Job_status.Todo; _ } -> (b, m + 1) | _ -> - (b, m)) + (b, m) ) ~f_base:(fun (b, m) (_, d) -> match d with | Base.Job.Full { status = Job_status.Todo; _ } -> (b + 1, m) | _ -> - (b, m)) + (b, m) ) tree let leaves : ('merge_t, 'base_t) t -> 'base_t list = @@ -728,7 +727,7 @@ module Tree = struct fold_depth ~init:[] ~f_merge:(fun _ _ _ -> []) ~f_base:(fun acc d -> - match d with _, Base.Job.Full _ -> d :: acc | _ -> acc) + match d with _, Base.Job.Full _ -> d :: acc | _ -> acc ) tree |> List.rev @@ -747,9 +746,9 @@ module Tree = struct let subtree = _view_tree sub_tree ~show_merge:(fun (x, y) -> - sprintf !"%s %s" (show_merge x) (show_merge y)) + sprintf !"%s %s" (show_merge x) (show_merge y) ) ~show_base:(fun (x, y) -> - sprintf !"%s %s" (show_base x) (show_base y)) + sprintf !"%s %s" (show_base x) (show_base y) ) in curr ^ subtree @@ -847,20 +846,21 @@ module T = struct | Merge.Job.Full { status = Job_status.Done; _ } -> (fst merge_node, Merge.Job.Empty) | _ -> - merge_node) - ~f_base:Fn.id) + merge_node ) + ~f_base:Fn.id ) in { t with trees } - include Binable.Of_binable2 - (Binable_arg.Stable.V1) - (struct - type nonrec ('merge, 'base) t = ('merge, 'base) t + include + Binable.Of_binable2 + (Binable_arg.Stable.V1) + (struct + type nonrec ('merge, 'base) t = ('merge, 'base) t - let to_binable = with_leaner_trees + let to_binable = with_leaner_trees - let of_binable = Fn.id - end) + let of_binable = Fn.id + end) end end] @@ -888,7 +888,7 @@ module T = struct let x = Int.pow 2 level / Int.pow 2 (d + 1) in (weight x 0, weight x 0) in - (weight, merge_job)) + (weight, merge_job) ) (base_weight, base_job) let create_tree ~depth = @@ -925,7 +925,7 @@ module State = struct ~f: (Tree.map_depth ~f_merge:(fun _ -> Merge.map ~f:f1) - ~f_base:(Base.map ~f:f2)) + ~f_base:(Base.map ~f:f2) ) ; acc = Option.map t.acc ~f:(fun (m, bs) -> (f1 m, List.map bs ~f:f2)) } @@ -938,7 +938,7 @@ module State = struct let () = let tree_hash tree f_merge f_base = List.iter (Tree.to_hashable_jobs tree) ~f:(fun job -> - match job with Job.Merge a -> f_merge a | Base d -> f_base d) + match job with Job.Merge a -> f_merge a | Base d -> f_base d ) in Non_empty_list.iter trees ~f:(fun tree -> let w_to_string { Weight.base = b; merge = m } = @@ -967,11 +967,11 @@ module State = struct ^ Job_status.to_string status ) ; add_string (f_base job) in - tree_hash tree f_merge f_base) + tree_hash tree f_merge f_base ) in let acc_string = Option.value_map acc ~default:"None" ~f:(fun (a, d_lst) -> - f_merge a ^ List.fold ~init:"" d_lst ~f:(fun acc d -> acc ^ f_base d)) + f_merge a ^ List.fold ~init:"" d_lst ~f:(fun acc d -> acc ^ f_base d) ) in add_string acc_string ; add_string (Int.to_string curr_job_seq_no) ; @@ -987,8 +987,7 @@ module State = struct -> init:'acc -> f_merge: ('acc -> 'merge Merge.t -> ('acc, 'final) Continue_or_stop.t M.t) - -> f_base: - ('acc -> 'base Base.t -> ('acc, 'final) Continue_or_stop.t M.t) + -> f_base:('acc -> 'base Base.t -> ('acc, 'final) Continue_or_stop.t M.t) -> finish:('acc -> 'final M.t) -> 'final M.t = fun t ~init ~f_merge ~f_base ~finish -> @@ -1045,7 +1044,7 @@ let work_to_do : fun trees ~max_base_jobs -> let depth = Int.ceil_log2 max_base_jobs in List.concat_mapi trees ~f:(fun i tree -> - Tree.jobs_on_level ~depth ~level:(depth - i) tree) + Tree.jobs_on_level ~depth ~level:(depth - i) tree ) let work : type merge base. @@ -1090,7 +1089,7 @@ let all_work : | [] -> (t', work_list) | work -> - (t', work :: work_list)) + (t', work :: work_list) ) in if List.is_empty set1 then List.rev other_sets else set1 :: List.rev other_sets @@ -1111,7 +1110,7 @@ let work_for_next_update : List.take (work (Non_empty_list.to_list t.trees) - ~max_base_jobs:t.max_base_jobs ~delay) + ~max_base_jobs:t.max_base_jobs ~delay ) ((count - current_tree_space) * 2) in List.filter ~f:(Fn.compose not List.is_empty) [ set1; set2 ] @@ -1126,11 +1125,11 @@ let free_space_on_current_tree t = let cons b bs = Option.value_map (Non_empty_list.of_list_opt bs) ~default:(Non_empty_list.singleton b) ~f:(fun bs -> - Non_empty_list.cons b bs) + Non_empty_list.cons b bs ) let append bs bs' = Option.value_map (Non_empty_list.of_list_opt bs') ~default:bs ~f:(fun bs' -> - Non_empty_list.append bs bs') + Non_empty_list.append bs bs' ) let add_merge_jobs : completed_jobs:'merge list -> ('base, 'merge, _) State_or_error.t = @@ -1150,7 +1149,7 @@ let add_merge_jobs : (sprintf !"More work than required: Required- %d got- %d" (List.length jobs_required) - (List.length merge_jobs)) + (List.length merge_jobs) ) in let curr_tree, to_be_updated_trees = (Non_empty_list.head state.trees, Non_empty_list.tail state.trees) @@ -1179,8 +1178,8 @@ let add_merge_jobs : | Error e -> Error (Error.tag_arg e "Error while adding merge jobs to tree" - ("tree_number", i) [%sexp_of: string * int]) - else Ok (tree :: trees, scan_result, jobs)) + ("tree_number", i) [%sexp_of: string * int] ) + else Ok (tree :: trees, scan_result, jobs) ) in match res with | Ok res -> @@ -1198,7 +1197,7 @@ let add_merge_jobs : ([], None) | t :: ts -> let tree_data = Tree.base_jobs t in - (List.rev ts, Some (res, tree_data))) + (List.rev ts, Some (res, tree_data)) ) in if Option.is_some result_opt @@ -1228,7 +1227,7 @@ let add_data : data:'base list -> (_, _, 'base) State_or_error.t = ~message: (sprintf !"Data count (%d) exceeded available space (%d)" - (List.length data) available_space) + (List.length data) available_space ) in let%bind tree, _ = match @@ -1290,7 +1289,7 @@ let reset_seq_no : type a b. (a, b) t -> (a, b) t = | _ -> max_seq in - (seq_no, tree' :: updated_trees)) + (seq_no, tree' :: updated_trees) ) in { state with curr_job_seq_no = next_seq_no @@ -1320,7 +1319,7 @@ let update_metrics t = (Int.to_float @@ base_job_count) ; Mina_metrics.( Gauge.set (Scan_state_metrics.scan_state_merge_snarks ~name)) - (Int.to_float @@ merge_job_count))) + (Int.to_float @@ merge_job_count) ) ) let update_helper : data:'base list @@ -1337,7 +1336,7 @@ let update_helper : ~message: (sprintf !"Data count (%d) exceeded maximum (%d)" - data_count t.max_base_jobs) + data_count t.max_base_jobs ) in let required_jobs = List.concat @@ work_for_next_update t ~data_count in let%bind () = @@ -1348,7 +1347,7 @@ let update_helper : ~message: (sprintf !"Insufficient jobs (Data count %d): Required- %d got- %d" - data_count required got) + data_count required got ) in let delay = t.delay + 1 in (*Increment the sequence number*) @@ -1384,7 +1383,7 @@ let update_helper : (sprintf !"Tree list length (%d) exceeded maximum (%d)" (Non_empty_list.length state.trees) - (max_trees state)) + (max_trees state) ) in result_opt @@ -1424,7 +1423,7 @@ let base_jobs_on_earlier_tree t ~index = | Some tree -> let jobs = Tree.jobs_on_level ~depth ~level:depth tree in List.filter_map jobs ~f:(fun job -> - match job with Base d -> Some d | Merge _ -> None) + match job with Base d -> Some d | Merge _ -> None ) let partition_if_overflowing : ('merge, 'base) t -> Space_partition.t = fun t -> @@ -1449,7 +1448,7 @@ let pending_data t = let view_jobs_with_position (state : ('merge, 'base) State.t) fa fd = List.fold ~init:[] (Non_empty_list.to_list state.trees) ~f:(fun acc tree -> - Tree.view_jobs_with_position tree fa fd :: acc) + Tree.view_jobs_with_position tree fa fd :: acc ) let job_count t = State.fold_chronological t ~init:(0., 0.) @@ -1465,7 +1464,7 @@ let job_count t = | Empty -> (0., 0.) in - (c +. count_todo, c' +. count_done)) + (c +. count_todo, c' +. count_done) ) ~f_base:(fun (c, c') base_node -> let count_todo, count_done = match snd base_node with @@ -1476,7 +1475,7 @@ let job_count t = | Full { status = Job_status.Done; _ } -> (0., 1.) in - (c +. count_todo, c' +. count_done)) + (c +. count_todo, c' +. count_done) ) let assert_job_count t t' ~completed_job_count ~base_job_count ~value_emitted = let todo_before, done_before = job_count t in @@ -1486,14 +1485,14 @@ let assert_job_count t t' ~completed_job_count ~base_job_count ~value_emitted = (*list of jobs*) let all_jobs_expected = List.fold ~init:[] (Non_empty_list.to_list t'.trees) ~f:(fun acc tree -> - Tree.jobs_records tree @ acc) + Tree.jobs_records tree @ acc ) |> List.filter ~f:(fun job -> match job with | Job.Base { status = Job_status.Todo; _ } | Job.Merge { status = Todo; _ } -> true | _ -> - false) + false ) in assert (List.length all_jobs = List.length all_jobs_expected) ; let expected_todo_after = @@ -1537,7 +1536,7 @@ let%test_module "test" = in let new_merges = List.map work ~f:(fun job -> - match job with Base i -> i | Merge (i, j) -> i + j) + match job with Base i -> i | Merge (i, j) -> i + j ) in let result_opt, t' = test_update ~data ~completed_jobs:new_merges t @@ -1550,13 +1549,13 @@ let%test_module "test" = | [] -> ((0, []), []) | x :: xs -> - ((List.sum (module Int) x ~f:Fn.id, x), List.rev xs)) + ((List.sum (module Int) x ~f:Fn.id, x), List.rev xs) ) in assert ( [%equal: int * int list] (Option.value ~default:expected_result result_opt) expected_result ) ; - (remaining_expected_results, t')) + (remaining_expected_results, t') ) in () @@ -1577,7 +1576,7 @@ let%test_module "test" = in let new_merges = List.map work ~f:(fun job -> - match job with Base i -> i | Merge (i, j) -> i + j) + match job with Base i -> i | Merge (i, j) -> i + j ) in let result_opt, t' = test_update ~data ~completed_jobs:new_merges t in let expected_result = @@ -1587,7 +1586,7 @@ let%test_module "test" = [%equal: int * int list] (Option.value ~default:expected_result result_opt) expected_result ) ; - state := t') + state := t' ) end ) let gen : @@ -1617,7 +1616,7 @@ let gen : in Option.value_map ~default:s res_opt ~f:(fun x -> let tuple = if Option.is_some old_tuple then old_tuple else s.acc in - { s with acc = f_acc tuple x })) + { s with acc = f_acc tuple x } ) ) let%test_module "scans" = ( module struct @@ -1636,7 +1635,7 @@ let%test_module "scans" = let tuple = if Option.is_some old_tuple then f_acc old_tuple x else state.acc in - { state with acc = tuple }) + { state with acc = tuple } ) in let%bind () = Linear_pipe.write w state.acc in let rem_ds = List.drop ds state.max_base_jobs in @@ -1659,11 +1658,11 @@ let%test_module "scans" = let scan ~data ~depth ~f ~f_acc = Linear_pipe.create_reader ~close_on_exception:true (fun w -> let s = ref (empty ~max_base_jobs:(Int.pow 2 depth) ~delay:1) in - do_steps ~state:s ~data ~f w ~f_acc) + do_steps ~state:s ~data ~f w ~f_acc ) let step_repeatedly ~state ~data ~f ~f_acc = Linear_pipe.create_reader ~close_on_exception:true (fun w -> - do_steps ~state ~data ~f w ~f_acc) + do_steps ~state ~data ~f w ~f_acc ) let%test_module "scan (+) over ints" = ( module struct @@ -1706,7 +1705,7 @@ let%test_module "scans" = if i > fst partition.first then tree_count_before + 1 else tree_count_before in - assert (tree_count_after = expected_tree_count)) + assert (tree_count_after = expected_tree_count) ) let%test_unit "sequence number reset" = (*create jobs with unique sequence numbers starting from 1. At any @@ -1737,23 +1736,23 @@ let%test_module "scans" = List.fold (List.init cur_levels ~f:Fn.id) ~init:0 ~f:(fun acc j -> let j = j + i in - acc + (Int.pow 2 j * (depth - j))) + acc + (Int.pow 2 j * (depth - j)) ) in let offset = i in let sum_of_all_seq_numbers = List.sum (module Int) - ~f: - (fun (job : - (int64 Merge.Record.t, int64 Base.Record.t) Job.t) -> + ~f:(fun (job : + (int64 Merge.Record.t, int64 Base.Record.t) Job.t + ) -> match job with | Job.Merge { seq_no; _ } -> seq_no - offset | Base { seq_no; _ } -> - seq_no - offset) + seq_no - offset ) jobs in - assert (sum_of_all_seq_numbers = seq_sum)) + assert (sum_of_all_seq_numbers = seq_sum) ) in let state = ref (State.empty ~max_base_jobs ~delay:0) in let counter = ref 0 in @@ -1769,7 +1768,7 @@ let%test_module "scans" = (*start the rest after enough jobs are created*) if !counter >= p + 1 then verify_sequence_number !state else counter := !counter + 1 - else ()) + else () ) let%test_unit "serialize, deserialize scan state" = Backtrace.elide := false ; @@ -1799,7 +1798,7 @@ let%test_module "scans" = let new_hash = State.hash deserialized Int64.to_string Int64.to_string in - assert (Hash.equal hash_s new_hash)) + assert (Hash.equal hash_s new_hash) ) let%test_unit "scan can be initialized from intermediate state" = Backtrace.elide := false ; @@ -1829,7 +1828,7 @@ let%test_module "scans" = let%bind () = Pipe.write w next in go () in - go ()) + go () ) in let pipe s = step_repeatedly ~state:s ~data:one_then_zeros ~f:job_done @@ -1847,7 +1846,7 @@ let%test_module "scans" = | `Ok (Some (v', _)) -> v' | `Ok None -> - v) + v ) in (* after we flush intermediate work *) let old_acc = @@ -1860,7 +1859,7 @@ let%test_module "scans" = (* eventually we'll emit the acc+1 element *) let%map _ = fill_some_zeros v s in let acc_plus_one = !s.acc |> Option.value_exn in - assert (Int64.(equal (fst acc_plus_one) (fst acc + one))))) + assert (Int64.(equal (fst acc_plus_one) (fst acc + one))) ) ) end ) let%test_module "scan (+) over ints, map from string" = @@ -1884,7 +1883,7 @@ let%test_module "scans" = let next = if count <= 0 then "0" else Int.to_string (x - count) in - return (Some (next, count - 1))) + return (Some (next, count - 1)) ) ; has_reader = false } in @@ -1905,14 +1904,14 @@ let%test_module "scans" = | `Ok (Some (v, _)) -> v | `Ok None -> - acc) + acc ) in let expected = List.fold (List.init n ~f:(fun i -> Int64.of_int i)) ~init:Int64.zero ~f:Int64.( + ) in - assert ([%equal: int64] after_3n expected)) + assert ([%equal: int64] after_3n expected) ) end ) let%test_module "scan (concat) over strings" = @@ -1934,7 +1933,7 @@ let%test_module "scans" = let next = if count <= 0 then "" else Int.to_string (x - count) ^ "," in - return (Some (next, count - 1))) + return (Some (next, count - 1)) ) ; has_reader = false } in @@ -1954,13 +1953,13 @@ let%test_module "scans" = | `Ok (Some (v, _)) -> v | `Ok None -> - acc) + acc ) in let expected = List.fold (List.init n ~f:(fun i -> Int.to_string i ^ ",")) ~init:"" ~f:String.( ^ ) in - assert (String.equal after_42n expected)) + assert (String.equal after_42n expected) ) end ) end ) diff --git a/src/lib/participating_state/participating_state.ml b/src/lib/participating_state/participating_state.ml index 91e09a8fccf..b51935b8d96 100644 --- a/src/lib/participating_state/participating_state.ml +++ b/src/lib/participating_state/participating_state.ml @@ -67,4 +67,4 @@ let rec sequence (list : 'a T.t List.t) : 'a List.t T.t = | participating_state :: participating_states -> bind participating_state ~f:(fun x -> map (sequence participating_states) ~f:(fun sub_result -> - x :: sub_result)) + x :: sub_result ) ) diff --git a/src/lib/perf_histograms/histogram.ml b/src/lib/perf_histograms/histogram.ml index e6c9847f9f4..b59593b2388 100644 --- a/src/lib/perf_histograms/histogram.ml +++ b/src/lib/perf_histograms/histogram.ml @@ -32,7 +32,7 @@ struct let params = Elem.Params.create ?min ?max ?buckets () in let intervals = List.init (Elem.Params.buckets params) ~f:(fun i -> - Elem.interval_of_bucket ~params i) + Elem.interval_of_bucket ~params i ) in { buckets = Array.init (Elem.Params.buckets params) ~f:(fun _ -> 0) ; intervals diff --git a/src/lib/perf_histograms/rpc.ml b/src/lib/perf_histograms/rpc.ml index 9df37bc6a77..66cb0bf084a 100644 --- a/src/lib/perf_histograms/rpc.ml +++ b/src/lib/perf_histograms/rpc.ml @@ -88,7 +88,7 @@ module Plain = struct ] in List.iter observations ~f:(fun (histogram, value) -> - Network.Rpc_size_histogram.observe histogram value) ; + Network.Rpc_size_histogram.observe histogram value ) ; response let bin_reader_response = @@ -110,7 +110,7 @@ module Plain = struct ] in List.iter observations ~f:(fun (histogram, value) -> - Network.Rpc_size_histogram.observe histogram value) ; + Network.Rpc_size_histogram.observe histogram value ) ; bin_write_response buf ~pos response let bin_writer_response = diff --git a/src/lib/pickles/cache.ml b/src/lib/pickles/cache.ml index ea0dc44d6f8..3a9b8834e27 100644 --- a/src/lib/pickles/cache.ml +++ b/src/lib/pickles/cache.ml @@ -35,7 +35,7 @@ module Step = struct Snark_keys_header.read_with_header ~read_data:(fun ~offset -> Kimchi_bindings.Protocol.Index.Fp.read (Some offset) - (Backend.Tick.Keypair.load_urs ())) + (Backend.Tick.Keypair.load_urs ()) ) path in [%test_eq: int] header.header_version header_read.header_version ; @@ -44,15 +44,15 @@ module Step = struct header.constraint_constants header_read.constraint_constants ; [%test_eq: string] header.constraint_system_hash header_read.constraint_system_hash ; - { Backend.Tick.Keypair.index; cs })) + { Backend.Tick.Keypair.index; cs } ) ) (fun (_, header, _, _) t path -> Or_error.try_with (fun () -> Snark_keys_header.write_with_header ~expected_max_size_log2:33 (* 8 GB should be enough *) ~append_data: (Kimchi_bindings.Protocol.Index.Fp.write (Some true) - t.Backend.Tick.Keypair.index) - header path)) + t.Backend.Tick.Keypair.index ) + header path ) ) let vk_storable = Key_cache.Sync.Disk_storable.simple Key.Verification.to_string @@ -64,7 +64,7 @@ module Step = struct ~read_data:(fun ~offset path -> Kimchi_bindings.Protocol.VerifierIndex.Fp.read (Some offset) (Backend.Tick.Keypair.load_urs ()) - path) + path ) path in [%test_eq: int] header.header_version header_read.header_version ; @@ -73,14 +73,14 @@ module Step = struct header.constraint_constants header_read.constraint_constants ; [%test_eq: string] header.constraint_system_hash header_read.constraint_system_hash ; - index)) + index ) ) (fun (_, header, _, _) x path -> Or_error.try_with (fun () -> Snark_keys_header.write_with_header ~expected_max_size_log2:33 (* 8 GB should be enough *) ~append_data: (Kimchi_bindings.Protocol.VerifierIndex.Fp.write (Some true) x) - header path)) + header path ) ) let read_or_generate cache k_p k_v typ return_typ main = let s_p = storable in @@ -90,16 +90,16 @@ module Step = struct lazy ( match Common.time "step keypair read" (fun () -> - Key_cache.Sync.read cache s_p (Lazy.force k_p)) + Key_cache.Sync.read cache s_p (Lazy.force k_p) ) with | Ok (pk, dirty) -> Common.time "step keypair create" (fun () -> - (Keypair.create ~pk ~vk:(Backend.Tick.Keypair.vk pk), dirty)) + (Keypair.create ~pk ~vk:(Backend.Tick.Keypair.vk pk), dirty) ) | Error _e -> let r = Common.time "stepkeygen" (fun () -> constraint_system ~exposing:[ typ ] ~return_typ main - |> Keypair.generate) + |> Keypair.generate ) in Timer.clock __LOC__ ; ignore @@ -112,7 +112,7 @@ module Step = struct (let k_v = Lazy.force k_v in match Common.time "step vk read" (fun () -> - Key_cache.Sync.read cache s_v k_v) + Key_cache.Sync.read cache s_v k_v ) with | Ok (vk, _) -> (vk, `Cache_hit) @@ -120,7 +120,7 @@ module Step = struct let pk, c = Lazy.force pk in let vk = Keypair.vk pk in ignore (Key_cache.Sync.write cache s_v k_v vk : unit Or_error.t) ; - (vk, c)) + (vk, c) ) in (pk, vk) end @@ -162,7 +162,7 @@ module Wrap = struct Snark_keys_header.read_with_header ~read_data:(fun ~offset -> Kimchi_bindings.Protocol.Index.Fq.read (Some offset) - (Backend.Tock.Keypair.load_urs ())) + (Backend.Tock.Keypair.load_urs ()) ) path in [%test_eq: int] header.header_version header_read.header_version ; @@ -171,14 +171,14 @@ module Wrap = struct header.constraint_constants header_read.constraint_constants ; [%test_eq: string] header.constraint_system_hash header_read.constraint_system_hash ; - { Backend.Tock.Keypair.index; cs })) + { Backend.Tock.Keypair.index; cs } ) ) (fun (_, header, _) t path -> Or_error.try_with (fun () -> Snark_keys_header.write_with_header ~expected_max_size_log2:33 (* 8 GB should be enough *) ~append_data: (Kimchi_bindings.Protocol.Index.Fq.write (Some true) t.index) - header path)) + header path ) ) let read_or_generate step_domains cache k_p k_v typ return_typ main = let module Vk = Verification_key in @@ -189,7 +189,7 @@ module Wrap = struct (let k = Lazy.force k_p in match Common.time "wrap key read" (fun () -> - Key_cache.Sync.read cache s_p k) + Key_cache.Sync.read cache s_p k ) with | Ok (pk, d) -> (Keypair.create ~pk ~vk:(Backend.Tock.Keypair.vk pk), d) @@ -197,12 +197,12 @@ module Wrap = struct let r = Common.time "wrapkeygen" (fun () -> constraint_system ~exposing:[ typ ] ~return_typ main - |> Keypair.generate) + |> Keypair.generate ) in ignore ( Key_cache.Sync.write cache s_p k (Keypair.pk r) : unit Or_error.t ) ; - (r, `Generated_something)) + (r, `Generated_something) ) in let vk = lazy @@ -217,7 +217,7 @@ module Wrap = struct ~read_data:(fun ~offset path -> Binable.of_string (module Vk.Stable.Latest) - (In_channel.read_all path)) + (In_channel.read_all path) ) path in [%test_eq: int] header.header_version @@ -229,7 +229,7 @@ module Wrap = struct header_read.constraint_constants ; [%test_eq: string] header.constraint_system_hash header_read.constraint_system_hash ; - index)) + index ) ) (fun (_, header, _) t path -> Or_error.try_with (fun () -> Snark_keys_header.write_with_header @@ -237,8 +237,9 @@ module Wrap = struct ~append_data:(fun path -> Out_channel.with_file ~append:true path ~f:(fun file -> Out_channel.output_string file - (Binable.to_string (module Vk.Stable.Latest) t))) - header path)) + (Binable.to_string (module Vk.Stable.Latest) t) ) + ) + header path ) ) in match Key_cache.Sync.read cache s_v k_v with | Ok (vk, d) -> @@ -259,7 +260,7 @@ module Wrap = struct in ignore (Key_cache.Sync.write cache s_v k_v vk : unit Or_error.t) ; let _vk = Key_cache.Sync.read cache s_v k_v in - (vk, `Generated_something)) + (vk, `Generated_something) ) in (pk, vk) end diff --git a/src/lib/pickles/common.ml b/src/lib/pickles/common.ml index 5d96e68c473..c4f3ca71cf0 100644 --- a/src/lib/pickles/common.ml +++ b/src/lib/pickles/common.ml @@ -17,7 +17,7 @@ let tick_shifts, tock_shifts = let mk g = let f = Memo.general ~cache_size_bound:20 ~hashable:Int.hashable (fun log2_size -> - g log2_size) + g log2_size ) in fun ~log2_size -> f log2_size in @@ -32,7 +32,7 @@ let wrap_domains ~proofs_verified = ; x = Pow_2_roots_of_unity (let (T (typ, _)) = Impls.Wrap.input () in - Int.ceil_log2 (Impls.Wrap.Data_spec.size [ typ ])) + Int.ceil_log2 (Impls.Wrap.Data_spec.size [ typ ]) ) } let hash_step_me_only ~app_state (t : _ Types.Step.Proof_state.Me_only.t) = @@ -41,18 +41,18 @@ let hash_step_me_only ~app_state (t : _ Types.Step.Proof_state.Me_only.t) = Tick_field_sponge.digest Tick_field_sponge.params (Types.Step.Proof_state.Me_only.to_field_elements t ~g ~comm:(fun (x : Tock.Curve.Affine.t) -> Array.of_list (g x)) - ~app_state) + ~app_state ) let hash_dlog_me_only (type n) (_max_proofs_verified : n Nat.t) - (t : - (Tick.Curve.Affine.t, (_, n) Vector.t) Types.Wrap.Proof_state.Me_only.t) = + (t : (Tick.Curve.Affine.t, (_, n) Vector.t) Types.Wrap.Proof_state.Me_only.t) + = Tock_field_sponge.digest Tock_field_sponge.params (Types.Wrap.Proof_state.Me_only.to_field_elements t - ~g1:(fun ((x, y) : Tick.Curve.Affine.t) -> [ x; y ])) + ~g1:(fun ((x, y) : Tick.Curve.Affine.t) -> [ x; y ]) ) let dlog_pcs_batch (type proofs_verified total) ((without_degree_bound, _pi) : - total Nat.t * (proofs_verified, Nat.N26.n, total) Nat.Adds.t) = + total Nat.t * (proofs_verified, Nat.N26.n, total) Nat.Adds.t ) = Pcs_batch.create ~without_degree_bound ~with_degree_bound:[] let when_profiling profiling default = @@ -69,7 +69,7 @@ let time lab f = let x = f () in let stop = Time.now () in printf "%s: %s\n%!" lab (Time.Span.to_string_hum (Time.diff stop start)) ; - x) + x ) f () let bits_random_oracle = @@ -78,13 +78,13 @@ let bits_random_oracle = Digestif.digest_string h s |> Digestif.to_raw_string h |> String.to_list |> List.concat_map ~f:(fun c -> let c = Char.to_int c in - List.init 8 ~f:(fun i -> (c lsr i) land 1 = 1)) + List.init 8 ~f:(fun i -> (c lsr i) land 1 = 1) ) |> fun a -> List.take a length let bits_to_bytes bits = let byte_of_bits bs = List.foldi bs ~init:0 ~f:(fun i acc b -> - if b then acc lor (1 lsl i) else acc) + if b then acc lor (1 lsl i) else acc ) |> Char.of_int_exn in List.map (List.groupi bits ~break:(fun i _ _ -> i mod 8 = 0)) ~f:byte_of_bits @@ -132,7 +132,7 @@ module Ipa = struct let compute_challenges ~endo_to_field field chals = Vector.map chals ~f:(fun { Bulletproof_challenge.prechallenge } -> - compute_challenge field ~endo_to_field prechallenge) + compute_challenge field ~endo_to_field prechallenge ) module Wrap = struct let field = @@ -178,13 +178,13 @@ module Ipa = struct in let comms = Array.of_list_map comm_chals ~f:(fun (comm, _) -> - Or_infinity.Finite comm) + Or_infinity.Finite comm ) in let urs = Backend.Tick.Keypair.load_urs () in Promise.run_in_thread (fun () -> Kimchi_bindings.Protocol.SRS.Fp.batch_accumulator_check urs (Array.map comms ~f:or_infinite_conv) - chals) + chals ) end end @@ -247,8 +247,8 @@ let ft_comm ~add:( + ) ~scale ~endoscale ~negate *) let generic = let coeffs = Vector.to_array m.coefficients_comm in - let (generic_selector - :: l1 :: r1 :: o1 :: m1 :: l2 :: r2 :: o2 :: m2 :: _) = + let (generic_selector :: l1 :: r1 :: o1 :: m1 :: l2 :: r2 :: o2 :: m2 :: _) + = plonk.generic in (* Second gate first, to multiply with a power of alpha. *) diff --git a/src/lib/pickles/composition_types/composition_types.ml b/src/lib/pickles/composition_types/composition_types.ml index 2d5c3610acd..e8b7eadea1b 100644 --- a/src/lib/pickles/composition_types/composition_types.ml +++ b/src/lib/pickles/composition_types/composition_types.ml @@ -407,7 +407,7 @@ module Wrap = struct ; app_state_to_field_elements app_state ; Array.of_list (List.concat_map ~f:g - (Vector.to_list challenge_polynomial_commitments)) + (Vector.to_list challenge_polynomial_commitments) ) ; Vector.to_array old_bulletproof_challenges |> Array.concat_map ~f:Vector.to_array ] @@ -422,7 +422,7 @@ module Wrap = struct [ app_state_to_field_elements app_state ; Array.of_list (List.concat_map ~f:g - (Vector.to_list challenge_polynomial_commitments)) + (Vector.to_list challenge_polynomial_commitments) ) ; Vector.to_array old_bulletproof_challenges |> Array.concat_map ~f:Vector.to_array ] @@ -447,7 +447,7 @@ module Wrap = struct ; challenge_polynomial_commitments ; old_bulletproof_challenges ] : - (unit, _) t) = + (unit, _) t ) = { app_state ; dlog_plonk_index ; challenge_polynomial_commitments @@ -603,7 +603,7 @@ module Wrap = struct ; pass_through (* pass_through is represented as a digest inside the circuit *) } : - _ t) = + _ t ) = let open Vector in let fp = combined_inner_product :: b :: zeta_to_srs_length @@ -643,7 +643,8 @@ module Wrap = struct :: poseidon_selector :: vbmul :: complete_add - :: endomul :: endomul_scalar :: perm :: generic) = + :: endomul :: endomul_scalar :: perm :: generic ) + = fp in let [ beta; gamma ] = challenge in @@ -868,7 +869,7 @@ module Step = struct ; should_finalize ; sponge_digest_before_evaluations } : - _ t) = + _ t ) = let open Vector in let fq = combined_inner_product :: b :: zeta_to_srs_length diff --git a/src/lib/pickles/composition_types/digest.ml b/src/lib/pickles/composition_types/digest.ml index 11eeef3b09e..468a1bd323d 100644 --- a/src/lib/pickles/composition_types/digest.ml +++ b/src/lib/pickles/composition_types/digest.ml @@ -51,7 +51,7 @@ module Make (Impl : Snarky_backendless.Snark_intf.Run) = struct ~compute:As_prover.(fun () -> Field.Constant.unpack (read_var x)) in Field.Assert.equal x (Field.project res) ; - res) + res ) end let () = assert (Field.size_in_bits < 64 * Nat.to_int Limbs.n) diff --git a/src/lib/pickles/composition_types/index.ml b/src/lib/pickles/composition_types/index.ml index 07fbd904814..f711461e99f 100644 --- a/src/lib/pickles/composition_types/index.ml +++ b/src/lib/pickles/composition_types/index.ml @@ -18,7 +18,7 @@ let of_int_exn = Char.of_int_exn let of_bits bits = List.foldi bits ~init:0 ~f:(fun i acc b -> - if b then acc lor (1 lsl i) else acc) + if b then acc lor (1 lsl i) else acc ) |> Char.of_int_exn module Checked (Impl : Snarky_backendless.Snark_intf.Run) = struct @@ -36,7 +36,7 @@ let typ bool : (('bvar, Nat.N8.n) Vector.t, t, 'f) Snarky_backendless.Typ.t = transport (Vector.typ bool Nat.N8.n) ~there:(fun (x : char) -> let x = Char.to_int x in - Vector.init Nat.N8.n ~f:(fun i -> (x lsr i) land 1 = 1)) + Vector.init Nat.N8.n ~f:(fun i -> (x lsr i) land 1 = 1) ) ~back:(fun bits -> of_bits (Vector.to_list bits)) let packed_typ (type f) diff --git a/src/lib/pickles/composition_types/spec.ml b/src/lib/pickles/composition_types/spec.ml index 4d7eca5e9bd..c6897595185 100644 --- a/src/lib/pickles/composition_types/spec.ml +++ b/src/lib/pickles/composition_types/spec.ml @@ -72,7 +72,8 @@ let rec pack : type ('f, 'env) typ = { typ : - 'var 'value. ('value, 'var, 'env) Basic.t + 'var 'value. + ('value, 'var, 'env) Basic.t -> ('var, 'value, 'f) Snarky_backendless.Typ.t } diff --git a/src/lib/pickles/dummy.ml b/src/lib/pickles/dummy.ml index 2c017c189e0..6dbca9f8bf7 100644 --- a/src/lib/pickles/dummy.ml +++ b/src/lib/pickles/dummy.ml @@ -10,7 +10,7 @@ let evals = let open Plonk_types in let e () = Evals.map (Evaluation_lengths.create ~of_int:Fn.id) ~f:(fun n -> - Array.create n (Ro.tock ())) + Array.create n (Ro.tock ()) ) in let ex () = { All_evals.With_public_input.evals = e (); public_input = Ro.tock () } @@ -26,11 +26,11 @@ module Ipa = struct let challenges = Vector.init Tock.Rounds.n ~f:(fun _ -> let prechallenge = Ro.scalar_chal () in - { Bulletproof_challenge.prechallenge }) + { Bulletproof_challenge.prechallenge } ) let challenges_computed = Vector.map challenges ~f:(fun { prechallenge } : Tock.Field.t -> - Ipa.Wrap.compute_challenge prechallenge) + Ipa.Wrap.compute_challenge prechallenge ) let sg = lazy @@ -41,11 +41,11 @@ module Ipa = struct let challenges = Vector.init Tick.Rounds.n ~f:(fun _ -> let prechallenge = Ro.scalar_chal () in - { Bulletproof_challenge.prechallenge }) + { Bulletproof_challenge.prechallenge } ) let challenges_computed = Vector.map challenges ~f:(fun { prechallenge } : Tick.Field.t -> - Ipa.Step.compute_challenge prechallenge) + Ipa.Step.compute_challenge prechallenge ) let sg = lazy diff --git a/src/lib/pickles/fix_domains.ml b/src/lib/pickles/fix_domains.ml index 9b9675b8412..f26c422c580 100644 --- a/src/lib/pickles/fix_domains.ml +++ b/src/lib/pickles/fix_domains.ml @@ -23,7 +23,7 @@ let domains (type field rust_gates) , rust_gates ) Kimchi_backend_common .Plonk_constraint_system - .t) (Spec.ETyp.T (typ, conv)) + .t ) (Spec.ETyp.T (typ, conv)) return_typ main = let main x () : unit = main (conv x) in domains (Impl.constraint_system ~exposing:[ typ ] ~return_typ main) diff --git a/src/lib/pickles/impls.ml b/src/lib/pickles/impls.ml index 58a7867c85c..3917a72c75e 100644 --- a/src/lib/pickles/impls.ml +++ b/src/lib/pickles/impls.ml @@ -88,7 +88,7 @@ module Step = struct in let str_list = List.map forbidden_shifted_values ~f:(fun (a, b) -> - (Tick.Field.to_string a, b)) + (Tick.Field.to_string a, b) ) in assert ([%equal: (string * bool) list] str_list expected_list) @@ -100,10 +100,10 @@ module Step = struct | [] -> assert false | low :: high -> - (Field.Constant.project high, low)) + (Field.Constant.project high, low) ) ~back:(fun (high, low) -> let high = Field.Constant.unpack high in - Tock.Field.of_bits (low :: high)) + Tock.Field.of_bits (low :: high) ) let check t = let open Internal_Basic in @@ -138,7 +138,7 @@ module Step = struct ( Shifted_value.Type2.typ Other_field.typ_unchecked , fun (Shifted_value.Type2.Shifted_value x as t) -> Impl.run_checked (Other_field.check x) ; - t )) + t ) ) spec in let typ = Typ.transport typ ~there:to_data ~back:of_data in @@ -234,7 +234,7 @@ module Wrap = struct ( Shifted_value.Type1.typ fp , fun (Shifted_value x as t) -> Impl.run_checked (Other_field.check x) ; - t )) + t ) ) In_circuit.spec in let typ = diff --git a/src/lib/pickles/intf.ml b/src/lib/pickles/intf.ml index 471c455a0c4..94ef03557e1 100644 --- a/src/lib/pickles/intf.ml +++ b/src/lib/pickles/intf.ml @@ -277,7 +277,7 @@ module Step_main_inputs = struct with module Field := Impl.Field and module State := Sponge_lib.State and type input := - [ `Field of Impl.Field.t | `Bits of Impl.Boolean.var list ] + [ `Field of Impl.Field.t | `Bits of Impl.Boolean.var list ] and type digest := Impl.Field.t and type t = Impl.Field.t Sponge_lib.t diff --git a/src/lib/pickles/limb_vector/constant.ml b/src/lib/pickles/limb_vector/constant.ml index a9b1bb1885c..bc72c1e2c87 100644 --- a/src/lib/pickles/limb_vector/constant.ml +++ b/src/lib/pickles/limb_vector/constant.ml @@ -7,7 +7,7 @@ let to_bits t = Vector.to_list t |> List.concat_map ~f:(fun n -> let test_bit i = Int64.(shift_right n i land one = one) in - List.init 64 ~f:test_bit) + List.init 64 ~f:test_bit ) module Hex64 = struct module T = struct @@ -43,7 +43,7 @@ module Hex64 = struct let%test_unit "int64 hex" = Quickcheck.test (Int64.gen_incl zero max_value) ~f:(fun x -> - assert (equal x (of_hex (to_hex x)))) + assert (equal x (of_hex (to_hex x))) ) let sexp_of_t = Fn.compose String.sexp_of_t to_hex @@ -82,7 +82,7 @@ module Make (N : Vector.Nat_intf) = struct let of_bits bits = let pack = List.foldi ~init:Int64.zero ~f:(fun i acc b -> - if b then Int64.(acc lor shift_left one i) else acc) + if b then Int64.(acc lor shift_left one i) else acc ) in let bits = List.groupi ~break:(fun i _ _ -> i mod 64 = 0) bits |> List.map ~f:pack diff --git a/src/lib/pickles/limb_vector/make.ml b/src/lib/pickles/limb_vector/make.ml index c1e698ab9af..bb1564e35dd 100644 --- a/src/lib/pickles/limb_vector/make.ml +++ b/src/lib/pickles/limb_vector/make.ml @@ -16,5 +16,5 @@ struct |> Typ.transport ~there:(fun x -> Field.Constant.project (Constant.to_bits x)) ~back:(fun x -> - Constant.of_bits (List.take (Field.Constant.unpack x) length)) + Constant.of_bits (List.take (Field.Constant.unpack x) length) ) end diff --git a/src/lib/pickles/make_sponge.ml b/src/lib/pickles/make_sponge.ml index 81e99f294d4..66f00a02d0b 100644 --- a/src/lib/pickles/make_sponge.ml +++ b/src/lib/pickles/make_sponge.ml @@ -98,10 +98,10 @@ struct S_checked.create (Sponge.Params.map ~f:Field.constant params) in Array.iter a ~f:(S_checked.absorb s) ; - S_checked.squeeze s)) + S_checked.squeeze s ) ) (fun a -> let s = S_constant.create params in Array.iter a ~f:(S_constant.absorb s) ; - S_constant.squeeze s) + S_constant.squeeze s ) a end diff --git a/src/lib/pickles/one_hot_vector/one_hot_vector.ml b/src/lib/pickles/one_hot_vector/one_hot_vector.ml index 9c09c1c4162..bb04545b190 100644 --- a/src/lib/pickles/one_hot_vector/one_hot_vector.ml +++ b/src/lib/pickles/one_hot_vector/one_hot_vector.ml @@ -30,7 +30,7 @@ module Make (Impl : Snarky_backendless.Snark_intf.Run) = struct (fun x -> Snarky_backendless.Checked.bind (typ.check x) ~f:(fun () -> make_checked (fun () -> - Boolean.Assert.exactly_one (Vector.to_list x)))) + Boolean.Assert.exactly_one (Vector.to_list x) ) ) ) } in Typ.transport typ @@ -39,5 +39,5 @@ module Make (Impl : Snarky_backendless.Snark_intf.Run) = struct let i, _ = List.findi (Vector.to_list v) ~f:(fun _ b -> b) |> Option.value_exn in - i) + i ) end diff --git a/src/lib/pickles/opt_sponge.ml b/src/lib/pickles/opt_sponge.ml index b1b3290922b..cf1f93790f1 100644 --- a/src/lib/pickles/opt_sponge.ml +++ b/src/lib/pickles/opt_sponge.ml @@ -102,7 +102,7 @@ struct else a_j) in assert_r1cs x (i_equals_j :> Field.t) Field.(a_j' - a.(j)) ; - a.(j) <- a_j') + a.(j) <- a_j' ) let consume ~needs_final_permute_if_empty ~params ~start_pos input state = assert (Array.length state = m) ; @@ -269,7 +269,7 @@ struct make_checked (fun () -> let s = init () in List.iter xs ~f:(S.absorb s) ; - S.squeeze s)) + S.squeeze s ) ) filtered in let opt_res = @@ -284,7 +284,7 @@ struct else of_sponge (init ()) in List.iter xs ~f:(absorb s) ; - squeeze s)) + squeeze s ) ) ps in if not (Field.Constant.equal filtered_res opt_res) then @@ -292,6 +292,6 @@ struct !"hash(%{sexp:Field.Constant.t list}) = %{sexp:Field.Constant.t}\n\ hash(%{sexp:(bool * Field.Constant.t) list}) = \ %{sexp:Field.Constant.t}" - filtered filtered_res ps opt_res ()) + filtered filtered_res ps opt_res () ) end ) end diff --git a/src/lib/pickles/per_proof_witness.ml b/src/lib/pickles/per_proof_witness.ml index e410f3a0007..426b84d2fe9 100644 --- a/src/lib/pickles/per_proof_witness.ml +++ b/src/lib/pickles/per_proof_witness.ml @@ -136,7 +136,8 @@ let typ (type n avar aval m) (statement : (avar, aval) Impls.Step.Typ.t) (Snarky_backendless.Typ.unit ()) Digest.typ index ; (let lengths = Evaluation_lengths.create ~of_int:Fn.id in - Plonk_types.All_evals.typ lengths Field.typ ~default:Field.Constant.zero) + Plonk_types.All_evals.typ lengths Field.typ ~default:Field.Constant.zero + ) ; Vector.typ (Vector.typ Field.typ Tick.Rounds.n) max_proofs_verified ; Vector.typ Inner_curve.typ max_proofs_verified ] diff --git a/src/lib/pickles/pickles.ml b/src/lib/pickles/pickles.ml index daa0d7642fd..2cb8003c82e 100644 --- a/src/lib/pickles/pickles.ml +++ b/src/lib/pickles/pickles.ml @@ -127,7 +127,7 @@ let pad_local_max_proofs_verifieds (max_proofs_verified : max_proofs_verified Nat.t) (length : (prev_varss, branches) Hlist.Length.t) (local_max_proofs_verifieds : - (prev_varss, prev_valuess, env) H2_1.T(H2_1.T(E03(Int))).t) : + (prev_varss, prev_valuess, env) H2_1.T(H2_1.T(E03(Int))).t ) : ((int, max_proofs_verified) Vector.t, branches) Vector.t = let module Vec = struct type t = (int, max_proofs_verified) Vector.t @@ -135,19 +135,17 @@ let pad_local_max_proofs_verifieds let module M = H2_1.Map (H2_1.T - (E03 - (Int))) - (E03 (Vec)) - (struct - module HI = H2_1.T (E03 (Int)) - - let f : type a b e. (a, b, e) H2_1.T(E03(Int)).t -> Vec.t = - fun xs -> - let (T (_proofs_verified, pi)) = HI.length xs in - let module V = H2_1.To_vector (Int) in - let v = V.f pi xs in - Vector.extend_exn v max_proofs_verified 0 - end) + (E03 (Int))) (E03 (Vec)) + (struct + module HI = H2_1.T (E03 (Int)) + + let f : type a b e. (a, b, e) H2_1.T(E03(Int)).t -> Vec.t = + fun xs -> + let (T (_proofs_verified, pi)) = HI.length xs in + let module V = H2_1.To_vector (Int) in + let v = V.f pi xs in + Vector.extend_exn v max_proofs_verified 0 + end) in let module V = H2_1.To_vector (Vec) in V.f length (M.f local_max_proofs_verifieds) @@ -170,10 +168,10 @@ end let pad_pass_throughs (type local_max_proofs_verifieds max_local_max_proofs_verifieds - max_proofs_verified) + max_proofs_verified ) (module M : Hlist.Maxes.S with type ns = max_local_max_proofs_verifieds - and type length = max_proofs_verified) + and type length = max_proofs_verified ) (pass_throughs : local_max_proofs_verifieds H1.T(Proof_.Me_only.Wrap).t) = let dummy_chals = Dummy.Ipa.Wrap.challenges in let rec go : @@ -242,7 +240,7 @@ module Verification_key = struct let load ~cache id = Key_cache.Sync.read cache (Key_cache.Sync.Disk_storable.of_binable Id.to_string - (module Verification_key.Stable.Latest)) + (module Verification_key.Stable.Latest) ) id |> Deferred.return end @@ -265,7 +263,7 @@ module Prover = struct type ('prev_values, 'local_widths, 'local_heights, 'a_value, 'proof) t = ?handler: ( Snarky_backendless.Request.request - -> Snarky_backendless.Request.response) + -> Snarky_backendless.Request.response ) -> ( 'prev_values , 'local_widths , 'local_heights ) @@ -312,17 +310,13 @@ module Make (A : Statement_var_intf) (A_value : Statement_value_intf) = struct type t = (int, Max_proofs_verified.n) Vector.t end in let module M = - H4.Map - (IR) - (E04 (Local_max_proofs_verifieds)) + H4.Map (IR) (E04 (Local_max_proofs_verifieds)) (struct module V = H4.To_vector (Int) module HT = H4.T (Tag) module M = - H4.Map - (Tag) - (E04 (Int)) + H4.Map (Tag) (E04 (Int)) (struct let f (type a b c d) (t : (a, b, c, d) Tag.t) : int = if Type_equal.Id.same t.id self then @@ -364,7 +358,7 @@ module Make (A : Statement_var_intf) (A_value : Statement_value_intf) = struct let prev = sys.next_row in List.iter c ~f:(fun { annotation; basic } -> Backend.Tick.R1CS_constraint_system.add_constraint sys - ?label:annotation basic) ; + ?label:annotation basic ) ; let next = sys.next_row in next - prev in @@ -372,7 +366,7 @@ module Make (A : Statement_var_intf) (A_value : Statement_value_intf) = struct Impls.Step.( make_checked (fun () : unit -> let x = with_label __LOC__ (fun () -> exists typ) in - main x ())) + main x () )) in if profile_constraints then Snarky_log.to_file @@ -387,7 +381,7 @@ module Make (A : Statement_var_intf) (A_value : Statement_value_intf) = struct let prev = sys.next_row in List.iter c ~f:(fun { annotation; basic } -> Backend.Tock.R1CS_constraint_system.add_constraint sys - ?label:annotation basic) ; + ?label:annotation basic ) ; let next = sys.next_row in next - prev in @@ -396,7 +390,7 @@ module Make (A : Statement_var_intf) (A_value : Statement_value_intf) = struct Impls.Wrap.( make_checked (fun () : unit -> let x = with_label __LOC__ (fun () -> exists typ) in - main x ())) + main x () )) in log in @@ -404,7 +398,7 @@ module Make (A : Statement_var_intf) (A_value : Statement_value_intf) = struct Snarky_log.to_file (sprintf !"wrap-%s-%{sexp:Type_equal.Id.Uid.t}.json" - name (Type_equal.Id.uid id)) + name (Type_equal.Id.uid id) ) log let compile : @@ -422,7 +416,7 @@ module Make (A : Statement_var_intf) (A_value : Statement_value_intf) = struct -> typ:(A.t, A_value.t) Impls.Step.Typ.t -> choices: ( self:(A.t, A_value.t, max_proofs_verified, branches) Tag.t - -> (prev_varss, prev_valuess, widthss, heightss) H4.T(IR).t) + -> (prev_varss, prev_valuess, widthss, heightss) H4.T(IR).t ) -> ( prev_valuess , widthss , heightss @@ -492,9 +486,7 @@ module Make (A : Statement_var_intf) (A_value : Statement_value_intf) = struct end in let proofs_verifieds = let module M = - H4.Map - (IR) - (E04 (Int)) + H4.Map (IR) (E04 (Int)) (struct module M = H4.T (Tag) @@ -523,7 +515,7 @@ module Make (A : Statement_var_intf) (A_value : Statement_value_intf) = struct ~max_proofs_verified:Max_proofs_verified.n ~branches:Branches.n ~self ~typ A.to_field_elements A_value.to_field_elements rule ~wrap_domains - ~proofs_verifieds) + ~proofs_verifieds ) in Timer.clock __LOC__ ; incr i ; res end) @@ -533,9 +525,7 @@ module Make (A : Statement_var_intf) (A_value : Statement_value_intf) = struct Timer.clock __LOC__ ; let step_domains = let module M = - H4.Map - (Branch_data) - (E04 (Domains)) + H4.Map (Branch_data) (E04 (Domains)) (struct let f (T b : _ Branch_data.t) = b.domains end) @@ -551,9 +541,7 @@ module Make (A : Statement_var_intf) (A_value : Statement_value_intf) = struct Option.map disk_keys ~f:(fun (xs, _) -> Vector.to_array xs) in let module M = - H4.Map - (Branch_data) - (E04 (Lazy_keys)) + H4.Map (Branch_data) (E04 (Lazy_keys)) (struct let etyp = Impls.Step.input ~proofs_verified:Max_proofs_verified.n @@ -585,7 +573,7 @@ module Make (A : Statement_var_intf) (A_value : Statement_value_intf) = struct } cs_hash , Index.to_int b.index - , cs )) + , cs ) ) in let k_v = match disk_keys with @@ -602,13 +590,13 @@ module Make (A : Statement_var_intf) (A_value : Statement_value_intf) = struct } (Md5.to_hex digest) , index - , digest )) + , digest ) ) in let ((pk, vk) as res) = Common.time "step read or generate" (fun () -> Cache.Step.read_or_generate cache k_p k_v typ (Snarky_backendless.Typ.unit ()) - main) + main ) in accum_dirty (Lazy.map pk ~f:snd) ; accum_dirty (Lazy.map vk ~f:snd) ; @@ -622,42 +610,37 @@ module Make (A : Statement_var_intf) (A_value : Statement_value_intf) = struct let module V = H4.To_vector (Lazy_keys) in lazy (Vector.map (V.f prev_varss_length step_keypairs) ~f:(fun (_, vk) -> - Tick.Keypair.vk_commitments (fst (Lazy.force vk)))) + Tick.Keypair.vk_commitments (fst (Lazy.force vk)) ) ) in Timer.clock __LOC__ ; let wrap_requests, wrap_main = Timer.clock __LOC__ ; let prev_wrap_domains = let module M = - H4.Map - (IR) - (H4.T - (E04 (Domains))) - (struct - let f : - type a b c d. - (a, b, c, d) IR.t -> (a, b, c, d) H4.T(E04(Domains)).t = - fun rule -> - let module M = - H4.Map - (Tag) - (E04 (Domains)) - (struct - let f (type a b c d) (t : (a, b, c, d) Tag.t) : - Domains.t = - Types_map.lookup_map t ~self:self.id - ~default:wrap_domains ~f:(function - | `Compiled d -> - d.wrap_domains - | `Side_loaded d -> - Common.wrap_domains - ~proofs_verified: - ( d.permanent.max_proofs_verified - |> Nat.Add.n |> Nat.to_int )) - end) - in - M.f rule.Inductive_rule.prevs - end) + H4.Map (IR) (H4.T (E04 (Domains))) + (struct + let f : + type a b c d. + (a, b, c, d) IR.t -> (a, b, c, d) H4.T(E04(Domains)).t = + fun rule -> + let module M = + H4.Map (Tag) (E04 (Domains)) + (struct + let f (type a b c d) (t : (a, b, c, d) Tag.t) : Domains.t + = + Types_map.lookup_map t ~self:self.id + ~default:wrap_domains ~f:(function + | `Compiled d -> + d.wrap_domains + | `Side_loaded d -> + Common.wrap_domains + ~proofs_verified: + ( d.permanent.max_proofs_verified |> Nat.Add.n + |> Nat.to_int ) ) + end) + in + M.f rule.Inductive_rule.prevs + end) in M.f choices in @@ -685,7 +668,7 @@ module Make (A : Statement_var_intf) (A_value : Statement_value_intf) = struct , snark_keys_header { type_ = "wrap-proving-key"; identifier = name } cs_hash - , cs )) + , cs ) ) in let disk_key_verifier = match disk_keys with @@ -697,7 +680,7 @@ module Make (A : Statement_var_intf) (A_value : Statement_value_intf) = struct , snark_keys_header { type_ = "wrap-verification-key"; identifier = name } (Md5.to_hex digest) - , digest )) + , digest ) ) | Some (_, (_id, header, digest)) -> Lazy.return (self_id, header, digest) in @@ -707,7 +690,7 @@ module Make (A : Statement_var_intf) (A_value : Statement_value_intf) = struct (Vector.to_array step_domains) cache disk_key_prover disk_key_verifier typ (Snarky_backendless.Typ.unit ()) - main) + main ) in (r, disk_key_verifier) in @@ -724,7 +707,7 @@ module Make (A : Statement_var_intf) (A_value : Statement_value_intf) = struct -> Lazy_keys.t -> ?handler: ( Snarky_backendless.Request.request - -> Snarky_backendless.Request.response) + -> Snarky_backendless.Request.response ) -> ( prev_values , local_widths , local_heights ) @@ -851,7 +834,7 @@ module Side_loaded = struct ; step_data = At_most.of_vector (Vector.map2 d.proofs_verifieds d.step_domains ~f:(fun width ds -> - ({ Domains.h = ds.h }, Width.of_int_exn width))) + ({ Domains.h = ds.h }, Width.of_int_exn width) ) ) (Nat.lte_exn (Vector.length d.step_domains) Max_branches.n) } @@ -903,7 +886,7 @@ module Side_loaded = struct { Domains.x = Pow_2_roots_of_unity (Int.ceil_log2 input_size) ; h = d.h - }) + } ) ; index = ( match vk.wrap_vk with | None -> @@ -915,8 +898,8 @@ module Side_loaded = struct { constraints = 0 } } in - Verify.Instance.T (max_proofs_verified, m, vk, x, p)) - |> Verify.verify_heterogenous) + Verify.Instance.T (max_proofs_verified, m, vk, x, p) ) + |> Verify.verify_heterogenous ) let verify ~value_to_field_elements ts = verify_promise ~value_to_field_elements ts |> Promise.to_deferred @@ -945,12 +928,12 @@ let compile_promise : , heightss , a_var , a_value ) - H4_2.T(Inductive_rule).t) + H4_2.T(Inductive_rule).t ) -> (a_var, a_value, max_proofs_verified, branches) Tag.t * Cache_handle.t * (module Proof_intf with type t = (max_proofs_verified, max_proofs_verified) Proof.t - and type statement = a_value) + and type statement = a_value ) * ( prev_valuess , widthss , heightss @@ -1020,7 +1003,7 @@ let compile ?self ?cache ?disk_keys a_var a_value ~typ ~branches [] | prover :: tl -> (fun ?handler stmt_with_proof public_input -> - Promise.to_deferred (prover ?handler stmt_with_proof public_input)) + Promise.to_deferred (prover ?handler stmt_with_proof public_input) ) :: adjust_provers tl in (self, cache_handle, proof_module, adjust_provers provers) @@ -1056,7 +1039,7 @@ let%test_module "test no side-loaded" = let x = exists Field.typ ~compute:(fun () -> Field.Constant.of_int 3) in let g = exists Step_main_inputs.Inner_curve.typ ~compute:(fun _ -> - Tick.Inner_curve.(to_affine_exn one)) + Tick.Inner_curve.(to_affine_exn one) ) in ignore ( SC.to_field_checked' @@ -1107,21 +1090,21 @@ let%test_module "test no side-loaded" = (fun [] self -> dummy_constraints () ; Field.Assert.equal self Field.zero ; - []) + [] ) ; main_value = (fun _ _self -> []) } - ])) + ] ) ) module Proof = (val p) let example = let b0 = Common.time "b0" (fun () -> - Promise.block_on_async_exn (fun () -> step [] Field.Constant.zero)) + Promise.block_on_async_exn (fun () -> step [] Field.Constant.zero) ) in assert ( Promise.block_on_async_exn (fun () -> - Proof.verify_promise [ (Field.Constant.zero, b0) ]) ) ; + Proof.verify_promise [ (Field.Constant.zero, b0) ] ) ) ; (Field.Constant.zero, b0) end @@ -1159,14 +1142,14 @@ let%test_module "test no side-loaded" = let proof_must_verify = Boolean.not is_base_case in let self_correct = Field.(equal (one + prev) self) in Boolean.Assert.any [ self_correct; is_base_case ] ; - [ proof_must_verify ]) + [ proof_must_verify ] ) ; main_value = (fun _ self -> let is_base_case = Field.Constant.(equal zero self) in let proof_must_verify = not is_base_case in - [ proof_must_verify ]) + [ proof_must_verify ] ) } - ])) + ] ) ) module Proof = (val p) @@ -1178,7 +1161,7 @@ let%test_module "test no side-loaded" = let b0 = Common.time "b0" (fun () -> Promise.block_on_async_exn (fun () -> - step [ (s_neg_one, b_neg_one) ] Field.Constant.zero)) + step [ (s_neg_one, b_neg_one) ] Field.Constant.zero ) ) in (* assert ( @@ -1188,11 +1171,11 @@ let%test_module "test no side-loaded" = let b1 = Common.time "b1" (fun () -> Promise.block_on_async_exn (fun () -> - step [ (Field.Constant.zero, b0) ] Field.Constant.one)) + step [ (Field.Constant.zero, b0) ] Field.Constant.one ) ) in assert ( Promise.block_on_async_exn (fun () -> - Proof.verify_promise [ (Field.Constant.one, b1) ]) ) ; + Proof.verify_promise [ (Field.Constant.one, b1) ] ) ) ; (Field.Constant.one, b1) end @@ -1228,14 +1211,14 @@ let%test_module "test no side-loaded" = let proof_must_verify = Boolean.not is_base_case in let self_correct = Field.(equal (one + prev) self) in Boolean.Assert.any [ self_correct; is_base_case ] ; - [ Boolean.true_; proof_must_verify ]) + [ Boolean.true_; proof_must_verify ] ) ; main_value = (fun _ self -> let is_base_case = Field.Constant.(equal zero self) in let proof_must_verify = not is_base_case in - [ true; proof_must_verify ]) + [ true; proof_must_verify ] ) } - ])) + ] ) ) module Proof = (val p) @@ -1249,17 +1232,17 @@ let%test_module "test no side-loaded" = Promise.block_on_async_exn (fun () -> step [ No_recursion.example; (s_neg_one, b_neg_one) ] - Field.Constant.zero)) + Field.Constant.zero ) ) in assert ( Promise.block_on_async_exn (fun () -> - Proof.verify_promise [ (Field.Constant.zero, b0) ]) ) ; + Proof.verify_promise [ (Field.Constant.zero, b0) ] ) ) ; let b1 = Common.time "tree b1" (fun () -> Promise.block_on_async_exn (fun () -> step [ No_recursion.example; (Field.Constant.zero, b0) ] - Field.Constant.one)) + Field.Constant.one ) ) in [ (Field.Constant.zero, b0); (Field.Constant.one, b1) ] end @@ -1267,7 +1250,7 @@ let%test_module "test no side-loaded" = let%test_unit "verify" = assert ( Promise.block_on_async_exn (fun () -> - Tree_proof.Proof.verify_promise Tree_proof.example) ) + Tree_proof.Proof.verify_promise Tree_proof.example ) ) end ) (* diff --git a/src/lib/pickles/pickles.mli b/src/lib/pickles/pickles.mli index c8429f813b8..e7654d539c8 100644 --- a/src/lib/pickles/pickles.mli +++ b/src/lib/pickles/pickles.mli @@ -116,7 +116,7 @@ module Prover : sig type ('prev_values, 'local_widths, 'local_heights, 'a_value, 'proof) t = ?handler: ( Snarky_backendless.Request.request - -> Snarky_backendless.Request.response) + -> Snarky_backendless.Request.response ) -> ( 'prev_values , 'local_widths , 'local_heights ) @@ -236,8 +236,7 @@ val compile_promise : -> (module Statement_value_intf with type t = 'a_value) -> typ:('a_var, 'a_value) Impls.Step.Typ.t -> branches:(module Nat.Intf with type n = 'branches) - -> max_proofs_verified: - (module Nat.Add.Intf with type n = 'max_proofs_verified) + -> max_proofs_verified:(module Nat.Add.Intf with type n = 'max_proofs_verified) -> name:string -> constraint_constants:Snark_keys_header.Constraint_constants.t -> choices: @@ -248,12 +247,12 @@ val compile_promise : , 'heightss , 'a_var , 'a_value ) - H4_2.T(Inductive_rule).t) + H4_2.T(Inductive_rule).t ) -> ('a_var, 'a_value, 'max_proofs_verified, 'branches) Tag.t * Cache_handle.t * (module Proof_intf with type t = ('max_proofs_verified, 'max_proofs_verified) Proof.t - and type statement = 'a_value) + and type statement = 'a_value ) * ( 'prev_valuess , 'widthss , 'heightss @@ -274,8 +273,7 @@ val compile : -> (module Statement_value_intf with type t = 'a_value) -> typ:('a_var, 'a_value) Impls.Step.Typ.t -> branches:(module Nat.Intf with type n = 'branches) - -> max_proofs_verified: - (module Nat.Add.Intf with type n = 'max_proofs_verified) + -> max_proofs_verified:(module Nat.Add.Intf with type n = 'max_proofs_verified) -> name:string -> constraint_constants:Snark_keys_header.Constraint_constants.t -> choices: @@ -286,12 +284,12 @@ val compile : , 'heightss , 'a_var , 'a_value ) - H4_2.T(Inductive_rule).t) + H4_2.T(Inductive_rule).t ) -> ('a_var, 'a_value, 'max_proofs_verified, 'branches) Tag.t * Cache_handle.t * (module Proof_intf with type t = ('max_proofs_verified, 'max_proofs_verified) Proof.t - and type statement = 'a_value) + and type statement = 'a_value ) * ( 'prev_valuess , 'widthss , 'heightss diff --git a/src/lib/pickles/plonk_checks/gen_scalars/gen_scalars.ml b/src/lib/pickles/plonk_checks/gen_scalars/gen_scalars.ml index 9b135fef383..44914c274b3 100644 --- a/src/lib/pickles/plonk_checks/gen_scalars/gen_scalars.ml +++ b/src/lib/pickles/plonk_checks/gen_scalars/gen_scalars.ml @@ -129,7 +129,7 @@ let () = output_string col ; output_string ", lazy (" ; output_string expr ; - output_string "))") + output_string "))" ) let () = output_string {ocaml| ] @@ -204,7 +204,7 @@ let () = output_string col ; output_string ", lazy (" ; output_string expr ; - output_string "))") + output_string "))" ) let () = output_string {ocaml| ] diff --git a/src/lib/pickles/plonk_checks/plonk_checks.ml b/src/lib/pickles/plonk_checks/plonk_checks.ml index 52667611863..659e1893461 100644 --- a/src/lib/pickles/plonk_checks/plonk_checks.ml +++ b/src/lib/pickles/plonk_checks/plonk_checks.ml @@ -195,7 +195,7 @@ module Make (Shifted_value : Shifted_value.S) (Sc : Scalars.S) = struct (* TODO: This shares some computation with the permutation scalar in derive_plonk. Could share between them. *) Vector.foldi e0.s ~init ~f:(fun i acc s -> - ((beta * s) + w0.(i) + gamma) * acc) + ((beta * s) + w0.(i) + gamma) * acc ) in let shifts = domain#shifts in let ft_eval0 = ft_eval0 - p_eval0 in @@ -233,7 +233,7 @@ module Make (Shifted_value : Shifted_value.S) (Sc : Scalars.S) = struct Vector.foldi e0.s ~init:(e1.z * beta * alpha_pow perm_alpha0 * zkp) ~f:(fun i acc s -> acc * (gamma + (beta * s) + w0.(i))) - |> negate) + |> negate ) in let generic = let open Vector in @@ -289,11 +289,11 @@ module Make (Shifted_value : Shifted_value.S) (Sc : Scalars.S) = struct Vector.to_list (with_label __LOC__ (fun () -> Vector.map2 plonk.generic actual.generic - ~f:(Shifted_value.equal Field.equal))) + ~f:(Shifted_value.equal Field.equal) ) ) @ with_label __LOC__ (fun () -> List.map ~f:(fun f -> - Shifted_value.equal Field.equal (f plonk) (f actual)) - [ poseidon_selector; vbmul; complete_add; endomul; perm ]) - |> Boolean.all) + Shifted_value.equal Field.equal (f plonk) (f actual) ) + [ poseidon_selector; vbmul; complete_add; endomul; perm ] ) + |> Boolean.all ) end diff --git a/src/lib/pickles/plonk_checks/scalars.ml b/src/lib/pickles/plonk_checks/scalars.ml index 97744fbae72..ce033e12f5d 100644 --- a/src/lib/pickles/plonk_checks/scalars.ml +++ b/src/lib/pickles/plonk_checks/scalars.ml @@ -74,7 +74,7 @@ module Tick : S = struct ; zeta_to_n_minus_1 = _ ; srs_length_log2 = _ } : - a Env.t) = + a Env.t ) = let x_0 = pow (cell (var (Witness 0, Curr)), 7) in let x_1 = pow (cell (var (Witness 1, Curr)), 7) in let x_2 = pow (cell (var (Witness 2, Curr)), 7) in @@ -155,7 +155,7 @@ module Tick : S = struct ; endo_coefficient ; srs_length_log2 = _ } : - a Env.t) = + a Env.t ) = Column.Table.of_alist_exn [ ( Index CompleteAdd , lazy @@ -200,7 +200,7 @@ module Tick : S = struct ) + alpha_pow 6 * ( (x_1 * cell (var (Witness 9, Curr))) - - cell (var (Witness 6, Curr)) )) ) + - cell (var (Witness 6, Curr)) ) ) ) ; ( Index VarBaseMul , lazy (let x_0 = @@ -467,7 +467,7 @@ module Tick : S = struct * ( (cell (var (Witness 1, Next)) + cell (var (Witness 14, Curr))) * x_13 - (cell (var (Witness 13, Curr)) - cell (var (Witness 0, Next))) - * x_14 )) ) + * x_14 ) ) ) ; ( Index EndoMul , lazy (let x_0 = @@ -556,7 +556,7 @@ module Tick : S = struct + cell (var (Witness 12, Curr)) ) + cell (var (Witness 13, Curr)) ) + cell (var (Witness 14, Curr)) - - cell (var (Witness 6, Next)) )) ) + - cell (var (Witness 6, Next)) ) ) ) ; ( Index EndoMulScalar , lazy (let x_0 = @@ -684,19 +684,19 @@ module Tick : S = struct ( Witness 0 , Curr - )))) + ) ) ) ) + cell (var ( Witness 6 - , Curr )) )) + , Curr ) ) ) ) + cell (var (Witness 7, Curr)) - )) - + cell (var (Witness 8, Curr)) )) - + cell (var (Witness 9, Curr)) )) - + cell (var (Witness 10, Curr)) )) - + cell (var (Witness 11, Curr)) )) - + cell (var (Witness 12, Curr)) )) + ) ) + + cell (var (Witness 8, Curr)) ) ) + + cell (var (Witness 9, Curr)) ) ) + + cell (var (Witness 10, Curr)) ) ) + + cell (var (Witness 11, Curr)) ) ) + + cell (var (Witness 12, Curr)) ) ) + cell (var (Witness 13, Curr)) - cell (var (Witness 1, Curr)) + alpha_pow 1 @@ -930,7 +930,7 @@ module Tick : S = struct + field "0x40000000000000000000000000000000224698FC094CF91B992D30ECFFFFFFFB" ) - * cell (var (Witness 13, Curr)) )) ) + * cell (var (Witness 13, Curr)) ) ) ) ; ( Coefficient 0 , lazy ( cell (var (Index Poseidon, Curr)) @@ -1057,7 +1057,7 @@ module Tock : S = struct ; zeta_to_n_minus_1 = _ ; srs_length_log2 = _ } : - a Env.t) = + a Env.t ) = let x_0 = pow (cell (var (Witness 0, Curr)), 7) in let x_1 = pow (cell (var (Witness 1, Curr)), 7) in let x_2 = pow (cell (var (Witness 2, Curr)), 7) in @@ -1138,7 +1138,7 @@ module Tock : S = struct ; endo_coefficient ; srs_length_log2 = _ } : - a Env.t) = + a Env.t ) = Column.Table.of_alist_exn [ ( Index CompleteAdd , lazy @@ -1183,7 +1183,7 @@ module Tock : S = struct ) + alpha_pow 6 * ( (x_1 * cell (var (Witness 9, Curr))) - - cell (var (Witness 6, Curr)) )) ) + - cell (var (Witness 6, Curr)) ) ) ) ; ( Index VarBaseMul , lazy (let x_0 = @@ -1450,7 +1450,7 @@ module Tock : S = struct * ( (cell (var (Witness 1, Next)) + cell (var (Witness 14, Curr))) * x_13 - (cell (var (Witness 13, Curr)) - cell (var (Witness 0, Next))) - * x_14 )) ) + * x_14 ) ) ) ; ( Index EndoMul , lazy (let x_0 = @@ -1539,7 +1539,7 @@ module Tock : S = struct + cell (var (Witness 12, Curr)) ) + cell (var (Witness 13, Curr)) ) + cell (var (Witness 14, Curr)) - - cell (var (Witness 6, Next)) )) ) + - cell (var (Witness 6, Next)) ) ) ) ; ( Index EndoMulScalar , lazy (let x_0 = @@ -1667,19 +1667,19 @@ module Tock : S = struct ( Witness 0 , Curr - )))) + ) ) ) ) + cell (var ( Witness 6 - , Curr )) )) + , Curr ) ) ) ) + cell (var (Witness 7, Curr)) - )) - + cell (var (Witness 8, Curr)) )) - + cell (var (Witness 9, Curr)) )) - + cell (var (Witness 10, Curr)) )) - + cell (var (Witness 11, Curr)) )) - + cell (var (Witness 12, Curr)) )) + ) ) + + cell (var (Witness 8, Curr)) ) ) + + cell (var (Witness 9, Curr)) ) ) + + cell (var (Witness 10, Curr)) ) ) + + cell (var (Witness 11, Curr)) ) ) + + cell (var (Witness 12, Curr)) ) ) + cell (var (Witness 13, Curr)) - cell (var (Witness 1, Curr)) + alpha_pow 1 @@ -1913,7 +1913,7 @@ module Tock : S = struct + field "0x40000000000000000000000000000000224698FC0994A8DD8C46EB20FFFFFFFB" ) - * cell (var (Witness 13, Curr)) )) ) + * cell (var (Witness 13, Curr)) ) ) ) ; ( Coefficient 0 , lazy ( cell (var (Index Poseidon, Curr)) diff --git a/src/lib/pickles/plonk_curve_ops.ml b/src/lib/pickles/plonk_curve_ops.ml index e9cc00e9ed9..9230bd3e933 100644 --- a/src/lib/pickles/plonk_curve_ops.ml +++ b/src/lib/pickles/plonk_curve_ops.ml @@ -27,7 +27,7 @@ let add_fast (type f) mk (fun () -> if eq y1 y2 then zero else if !same_x_bool then inv (!!y2 - !!y1) - else zero) + else zero ) in let x21_inv = mk (fun () -> if !same_x_bool then zero else inv (!!x2 - !!x1)) @@ -38,7 +38,7 @@ let add_fast (type f) let x1_squared = square !!x1 in let y1 = !!y1 in (x1_squared + x1_squared + x1_squared) / (y1 + y1) - else (!!y2 - !!y1) / (!!x2 - !!x1)) + else (!!y2 - !!y1) / (!!x2 - !!x1) ) in let x3 = mk (fun () -> square !!s - (!!x1 + !!x2)) in let y3 = mk (fun () -> (!!s * (!!x1 - !!x3)) - !!y1) in @@ -49,10 +49,10 @@ let add_fast (type f) ; basic = Kimchi_backend_common.Plonk_constraint_system.Plonk_constraint.T (EC_add_complete - { p1; p2; p3; inf; same_x; slope = s; inf_z; x21_inv }) + { p1; p2; p3; inf; same_x; slope = s; inf_z; x21_inv } ) } ] ; - p3) + p3 ) module Make (Impl : Snarky_backendless.Snark_intf.Run) @@ -72,7 +72,7 @@ struct let scale_fast_msb_bits base (Pickles_types.Shifted_value.Type1.Shifted_value - (bits_msb : Boolean.var array)) : Field.t * Field.t = + (bits_msb : Boolean.var array) ) : Field.t * Field.t = let ((x_base, y_base) as base) = seal base in let ( !! ) = As_prover.read_var in let mk f = exists Field.typ ~compute:f in @@ -88,29 +88,29 @@ struct let double x = x + x in let bs = Array.init bits_per_chunk ~f:(fun i -> - (bits_msb.(Int.((chunk * bits_per_chunk) + i)) :> Field.t)) + (bits_msb.(Int.((chunk * bits_per_chunk) + i)) :> Field.t) ) in let n_acc_prev = !n_acc in n_acc := mk (fun () -> - Array.fold bs ~init:!!n_acc_prev ~f:(fun acc b -> double acc + !!b)) ; + Array.fold bs ~init:!!n_acc_prev ~f:(fun acc b -> double acc + !!b) ) ; let accs, slopes = Array.fold_map bs ~init:!acc ~f:(fun (x_acc, y_acc) b -> let s1 = mk (fun () -> (!!y_acc - (!!y_base * (double !!b - one))) - / (!!x_acc - !!x_base)) + / (!!x_acc - !!x_base) ) in let s1_squared = mk (fun () -> square !!s1) in let s2 = mk (fun () -> (double !!y_acc / (double !!x_acc + !!x_base - !!s1_squared)) - - !!s1) + - !!s1 ) in let x_res = mk (fun () -> !!x_base + square !!s2 - !!s1_squared) in let y_res = mk (fun () -> ((!!x_acc - !!x_res) * !!s2) - !!y_acc) in let acc' = (x_res, y_res) in - (acc', (acc', s1))) + (acc', (acc', s1)) ) |> snd |> Array.unzip in let accs = Array.append [| !acc |] accs in @@ -154,7 +154,7 @@ struct exists (Typ.array ~length:num_bits Field.typ) ~compute:(fun () -> let open Field.Constant in unpack !!scalar |> Fn.flip List.take num_bits - |> Array.of_list_rev_map ~f:(fun b -> if b then one else zero)) + |> Array.of_list_rev_map ~f:(fun b -> if b then one else zero) ) in let acc = ref (add_fast base base) in let n_acc = ref Field.zero in @@ -164,29 +164,29 @@ struct let double x = x + x in let bs = Array.init bits_per_chunk ~f:(fun i -> - bits_msb.(Int.((chunk * bits_per_chunk) + i))) + bits_msb.(Int.((chunk * bits_per_chunk) + i)) ) in let n_acc_prev = !n_acc in n_acc := mk (fun () -> - Array.fold bs ~init:!!n_acc_prev ~f:(fun acc b -> double acc + !!b)) ; + Array.fold bs ~init:!!n_acc_prev ~f:(fun acc b -> double acc + !!b) ) ; let accs, slopes = Array.fold_map bs ~init:!acc ~f:(fun (x_acc, y_acc) b -> let s1 = mk (fun () -> (!!y_acc - (!!y_base * (double !!b - one))) - / (!!x_acc - !!x_base)) + / (!!x_acc - !!x_base) ) in let s1_squared = mk (fun () -> square !!s1) in let s2 = mk (fun () -> (double !!y_acc / (double !!x_acc + !!x_base - !!s1_squared)) - - !!s1) + - !!s1 ) in let x_res = mk (fun () -> !!x_base + square !!s2 - !!s1_squared) in let y_res = mk (fun () -> ((!!x_acc - !!x_res) * !!s2) - !!y_acc) in let acc' = (x_res, y_res) in - (acc', (acc', s1))) + (acc', (acc', s1)) ) |> snd |> Array.unzip in let accs = Array.append [| !acc |] accs in @@ -218,7 +218,7 @@ struct let scale_fast_unpack base scalar ~num_bits : (Field.t * Field.t) * Boolean.var array = with_label "scale_fast_unpack" (fun () -> - scale_fast_unpack base scalar ~num_bits) + scale_fast_unpack base scalar ~num_bits ) let scale_fast base s ~num_bits = let r, _bits = scale_fast_unpack base s ~num_bits in @@ -253,7 +253,7 @@ struct *) let scale_fast2 (g : G.t) (Pickles_types.Shifted_value.Type2.Shifted_value - ((s_div_2 : Field.t), (s_odd : Boolean.var))) ~(num_bits : int) : G.t = + ((s_div_2 : Field.t), (s_odd : Boolean.var)) ) ~(num_bits : int) : G.t = let s_div_2_bits = num_bits - 1 in (* The number of chunks need for scaling by s_div_2. *) let chunks_needed = chunks_needed ~num_bits:s_div_2_bits in @@ -265,13 +265,13 @@ struct with_label __LOC__ (fun () -> for i = s_div_2_bits to Array.length bits_lsb - 1 do Field.Assert.equal Field.zero (bits_lsb.(i) :> Field.t) - done) ; + done ) ; with_label __LOC__ (fun () -> - G.if_ s_odd ~then_:h ~else_:(add_fast h (G.negate g))) + G.if_ s_odd ~then_:h ~else_:(add_fast h (G.negate g)) ) let scale_fast2' (type scalar_field) (module Scalar_field : Scalar_field_intf - with type Constant.t = scalar_field) g (s : Scalar_field.t) ~num_bits = + with type Constant.t = scalar_field ) g (s : Scalar_field.t) ~num_bits = let ((s_div_2, s_odd) as s_parts) = with_label __LOC__ (fun () -> exists @@ -282,7 +282,7 @@ struct let s = read Scalar_field.typ s in let open Scalar_field.Constant in let s_odd = Bigint.test_bit (to_bigint s) 0 in - ((if s_odd then s - one else s) / of_int 2, s_odd))) + ((if s_odd then s - one else s) / of_int 2, s_odd)) ) in (* In this case, it's safe to use this field to compute @@ -291,7 +291,7 @@ struct in the other field. *) with_label __LOC__ (fun () -> - Field.Assert.equal Field.((of_int 2 * s_div_2) + (s_odd :> Field.t)) s) ; + Field.Assert.equal Field.((of_int 2 * s_div_2) + (s_odd :> Field.t)) s ) ; scale_fast2 g (Shifted_value s_parts) ~num_bits let scale_fast a b = with_label __LOC__ (fun () -> scale_fast a b) @@ -322,7 +322,7 @@ struct G.typ (fun (g, s) -> make_checked (fun () -> - scale_fast2 ~num_bits:n g (Shifted_value s))) + scale_fast2 ~num_bits:n g (Shifted_value s) ) ) (fun (g, _) -> let x = let chunks_needed = chunks_needed ~num_bits:(n - 1) in @@ -334,8 +334,8 @@ struct |> G.Constant.Scalar.( + ) (G.Constant.Scalar.project (Field.Constant.unpack s)) in - G.Constant.scale g x) - (random_point, input)) + G.Constant.scale g x ) + (random_point, input) ) let%test_unit "scale fast" = let open Pickles_types in @@ -345,7 +345,7 @@ struct Quickcheck.test ~trials:10 Quickcheck.Generator.( map (list_with_length n Bool.quickcheck_generator) ~f:(fun bs -> - Field.Constant.project bs |> Field.Constant.unpack)) + Field.Constant.project bs |> Field.Constant.unpack )) ~f:(fun xs -> try T.Test.test_equal ~equal:G.Constant.equal @@ -354,7 +354,8 @@ struct G.typ (fun (g, s) -> make_checked (fun () -> - scale_fast ~num_bits:n g (Shifted_value (Field.project s)))) + scale_fast ~num_bits:n g (Shifted_value (Field.project s)) ) + ) (fun (g, s) -> let open G.Constant.Scalar in let s = project s in @@ -363,10 +364,10 @@ struct (module G.Constant.Scalar) ~shift (Shifted_value s) in - G.Constant.scale g x) + G.Constant.scale g x ) (random_point, xs) with e -> eprintf !"Input %{sexp: bool list}\n%!" xs ; - raise e) + raise e ) end ) end diff --git a/src/lib/pickles/precomputed/gen_values/gen_values.ml b/src/lib/pickles/precomputed/gen_values/gen_values.ml index da87c99c228..38935b9f843 100644 --- a/src/lib/pickles/precomputed/gen_values/gen_values.ml +++ b/src/lib/pickles/precomputed/gen_values/gen_values.ml @@ -36,9 +36,9 @@ let vesta = ksprintf time "vesta %d" i (fun () -> Kimchi_bindings.Protocol.SRS.Fp.lagrange_commitment (Vesta_based_plonk.Keypair.load_urs ()) - domain_size i) + domain_size i ) |> Kimchi_pasta.Pasta.Fp_poly_comm.of_backend_without_degree_bound - |> unwrap)) + |> unwrap ) ) let pallas = let max_domain_log2 = Nat.to_int Pallas_based_plonk.Rounds.n in @@ -51,9 +51,9 @@ let pallas = ksprintf time "pallas %d" i (fun () -> Kimchi_bindings.Protocol.SRS.Fq.lagrange_commitment (Pallas_based_plonk.Keypair.load_urs ()) - domain_size i) + domain_size i ) |> Kimchi_pasta.Pasta.Fq_poly_comm.of_backend_without_degree_bound - |> unwrap)) + |> unwrap ) ) let mk xss ~f = let module E = Ppxlib.Ast_builder.Make (struct @@ -62,7 +62,7 @@ let mk xss ~f = let open E in pexp_array (List.map xss ~f:(fun xs -> - pexp_array (List.map xs ~f:(fun g -> pexp_array (List.map g ~f))))) + pexp_array (List.map xs ~f:(fun g -> pexp_array (List.map g ~f))) ) ) let structure = let loc = Ppxlib.Location.none in diff --git a/src/lib/pickles/proof.ml b/src/lib/pickles/proof.ml index 0bb4e866989..9cb3a12d4fd 100644 --- a/src/lib/pickles/proof.ml +++ b/src/lib/pickles/proof.ml @@ -113,8 +113,8 @@ end type ('max_width, 'mlmb) t = (unit, 'mlmb, 'max_width) With_data.t -let dummy (type w h r) (_w : w Nat.t) (h : h Nat.t) - (most_recent_width : r Nat.t) : (w, h) t = +let dummy (type w h r) (_w : w Nat.t) (h : h Nat.t) (most_recent_width : r Nat.t) + : (w, h) t = let open Ro in let g0 = Tock.Curve.(to_affine_exn one) in let g len = Array.create ~len g0 in @@ -149,11 +149,11 @@ let dummy (type w h r) (_w : w Nat.t) (h : h Nat.t) ; old_bulletproof_challenges = (* Not sure if this should be w or h honestly ...*) Vector.init most_recent_width ~f:(fun _ -> - Dummy.Ipa.Step.challenges) + Dummy.Ipa.Step.challenges ) (* TODO: Should this be wrap? *) ; challenge_polynomial_commitments = Vector.init most_recent_width ~f:(fun _ -> - Lazy.force Dummy.Ipa.Wrap.sg) + Lazy.force Dummy.Ipa.Wrap.sg ) } } ; proof = @@ -187,7 +187,7 @@ let dummy (type w h r) (_w : w Nat.t) (h : h Nat.t) ; evals = e () } in - { ft_eval1 = tick (); evals = (ex (), ex ()) }) + { ft_eval1 = tick (); evals = (ex (), ex ()) } ) } module Make (W : Nat.Intf) (MLMB : Nat.Intf) = struct @@ -214,8 +214,7 @@ module Make (W : Nat.Intf) (MLMB : Nat.Intf) = struct let to_repr (T t) : Repr.t = let lte = Nat.lte_exn - (Vector.length - t.statement.pass_through.challenge_polynomial_commitments) + (Vector.length t.statement.pass_through.challenge_polynomial_commitments) W.n in { t with @@ -266,15 +265,16 @@ module Make (W : Nat.Intf) (MLMB : Nat.Intf) = struct let hash t = Repr.hash (to_repr t) - include Sexpable.Of_sexpable - (Repr) - (struct - type nonrec t = t + include + Sexpable.Of_sexpable + (Repr) + (struct + type nonrec t = t - let to_sexpable = to_repr + let to_sexpable = to_repr - let of_sexpable = of_repr - end) + let of_sexpable = of_repr + end) let to_base64 t = (* assume call to Nat.lte_exn does not raise with a valid instance of t *) @@ -351,15 +351,16 @@ module Proofs_verified_2 = struct include (T : module type of T with type t := t with module Repr := T.Repr) - include Binable.Of_binable - (Repr.Stable.V2) - (struct - type nonrec t = t + include + Binable.Of_binable + (Repr.Stable.V2) + (struct + type nonrec t = t - let to_binable = to_repr + let to_binable = to_repr - let of_binable = of_repr - end) + let of_binable = of_repr + end) end end] @@ -420,15 +421,16 @@ module Proofs_verified_max = struct include (T : module type of T with type t := t with module Repr := T.Repr) - include Binable.Of_binable - (Repr.Stable.V2) - (struct - type nonrec t = t + include + Binable.Of_binable + (Repr.Stable.V2) + (struct + type nonrec t = t - let to_binable = to_repr + let to_binable = to_repr - let of_binable = of_repr - end) + let of_binable = of_repr + end) end end] diff --git a/src/lib/pickles/pseudo/pseudo.ml b/src/lib/pickles/pseudo/pseudo.ml index 0b1bb9caf3c..049b0d9d2fe 100644 --- a/src/lib/pickles/pseudo/pseudo.ml +++ b/src/lib/pickles/pseudo/pseudo.ml @@ -24,7 +24,7 @@ module Make (Impl : Snarky_backendless.Snark_intf.Run) = struct Vector.map (Vector.zip (bits :> (Boolean.var, n) Vector.t) xs) ~f:(fun (b, x) -> Field.((b :> t) * x)) - |> Vector.fold ~init:Field.zero ~f:Field.( + )) + |> Vector.fold ~init:Field.zero ~f:Field.( + ) ) let choose : type a n. (a, n) t -> f:(a -> Field.t) -> Field.t = fun (bits, xs) ~f -> mask bits (Vector.map xs ~f) @@ -36,7 +36,7 @@ module Make (Impl : Snarky_backendless.Snark_intf.Run) = struct let pow = Field.(Pcs_batch.pow ~one ~mul) in choose t ~f:(fun deg -> let d = deg mod crs_max_degree in - pow x (crs_max_degree - d)) + pow x (crs_max_degree - d) ) end module Domain = struct @@ -65,7 +65,7 @@ module Make (Impl : Snarky_backendless.Snark_intf.Run) = struct let max_log2 = let _, ds = t in List.fold (Vector.to_list ds) ~init:0 ~f:(fun acc d -> - Int.max acc (Domain.log2_size d)) + Int.max acc (Domain.log2_size d) ) in object method size = size diff --git a/src/lib/pickles/requests.ml b/src/lib/pickles/requests.ml index 90d2407f98a..771abf1ffe7 100644 --- a/src/lib/pickles/requests.ml +++ b/src/lib/pickles/requests.ml @@ -52,7 +52,7 @@ module Wrap = struct type ('mb, 'ml) t = (module S with type max_proofs_verified = 'mb - and type max_local_max_proofs_verifieds = 'ml) + and type max_local_max_proofs_verifieds = 'ml ) let create : type mb ml. unit -> (mb, ml) t = fun () -> @@ -129,7 +129,7 @@ module Step = struct and type local_branches = local_branches and type statement = statement and type prev_values = prev_values - and type max_proofs_verified = max_proofs_verified) = + and type max_proofs_verified = max_proofs_verified ) = fun () -> let module R = struct type nonrec max_proofs_verified = max_proofs_verified diff --git a/src/lib/pickles/scalar_challenge.ml b/src/lib/pickles/scalar_challenge.ml index eaa65e71f71..b5a0521c40a 100644 --- a/src/lib/pickles/scalar_challenge.ml +++ b/src/lib/pickles/scalar_challenge.ml @@ -57,7 +57,7 @@ let to_field_checked' (type f) ?(num_bits = num_bits) let bit = (bits_per_row * i) + (2 * j) in let b0 = (Lazy.force bits_msb).(bit + 1) in let b1 = (Lazy.force bits_msb).(bit) in - Bool.to_int b0 + (2 * Bool.to_int b1)))) + Bool.to_int b0 + (2 * Bool.to_int b1) ) ) ) in let two = Field.of_int 2 in let a = ref two in @@ -72,28 +72,28 @@ let to_field_checked' (type f) ?(num_bits = num_bits) let xs = Array.init nybbles_per_row ~f:(fun j -> mk (fun () -> - Field.Constant.of_int (Lazy.force nybbles_by_row).(i).(j))) + Field.Constant.of_int (Lazy.force nybbles_by_row).(i).(j) ) ) in let open Field.Constant in let double x = x + x in let n8 = mk (fun () -> Array.fold xs ~init:!!n0 ~f:(fun acc x -> - (acc |> double |> double) + !!x)) + (acc |> double |> double) + !!x ) ) in let a8 = mk (fun () -> Array.fold (Lazy.force nybbles_by_row).(i) ~init:!!a0 - ~f:(fun acc x -> (acc |> double) + a_func x)) + ~f:(fun acc x -> (acc |> double) + a_func x) ) in let b8 = mk (fun () -> Array.fold (Lazy.force nybbles_by_row).(i) ~init:!!b0 - ~f:(fun acc x -> (acc |> double) + b_func x)) + ~f:(fun acc x -> (acc |> double) + b_func x) ) in state := { Kimchi_backend_common.Endoscale_scalar_round.a0 @@ -124,7 +124,7 @@ let to_field_checked' (type f) ?(num_bits = num_bits) Kimchi_backend_common.Plonk_constraint_system.Plonk_constraint.( T (EC_endoscalar { state = Array.of_list_rev !state })) } - ]) ; + ] ) ; (!a, !b, !n) let to_field_checked (type f) ?num_bits @@ -170,16 +170,16 @@ let test (type f) to_field_checked (module Impl) ~endo - (SC.create (Impl.Field.pack s)))) + (SC.create (Impl.Field.pack s)) ) ) (fun s -> to_field_constant (module Field.Constant) ~endo - (SC.create (Challenge.Constant.of_bits s))) + (SC.create (Challenge.Constant.of_bits s)) ) xs with e -> eprintf !"Input %{sexp: bool list}\n%!" xs ; - raise e) + raise e ) module Make (Impl : Snarky_backendless.Snark_intf.Run) @@ -223,7 +223,7 @@ struct let acc = with_label __LOC__ (fun () -> let p = G.( + ) t (seal (Field.scale xt Endo.base), yt) in - ref G.(p + p)) + ref G.(p + p) ) in let n_acc = ref Field.zero in let mk f = exists Field.typ ~compute:f in @@ -244,7 +244,7 @@ struct let s1_squared = mk (fun () -> square !!s1) in let s2 = mk (fun () -> - (double !!yp / (double !!xp + !!xq1 - !!s1_squared)) - !!s1) + (double !!yp / (double !!xp + !!xq1 - !!s1_squared)) - !!s1 ) in let xr = mk (fun () -> !!xq1 + square !!s2 - !!s1_squared) in @@ -256,7 +256,7 @@ struct let s3_squared = mk (fun () -> square !!s3) in let s4 = mk (fun () -> - (double !!yr / (double !!xr + !!xq2 - !!s3_squared)) - !!s3) + (double !!yr / (double !!xr + !!xq2 - !!s3_squared)) - !!s3 ) in let xs = mk (fun () -> !!xq2 + square !!s4 - !!s3_squared) in @@ -265,7 +265,7 @@ struct n_acc := mk (fun () -> !!n_acc_prev |> double |> ( + ) !!b1 |> double |> ( + ) !!b2 - |> double |> ( + ) !!b3 |> double |> ( + ) !!b4) ; + |> double |> ( + ) !!b3 |> double |> ( + ) !!b4 ) ; rounds_rev := { Kimchi_backend_common.Endoscale_round.xt ; yt @@ -295,9 +295,9 @@ struct ; ys ; n_acc = !n_acc ; state = Array.of_list_rev !rounds_rev - })) + } )) } - ]) ; + ] ) ; with_label __LOC__ (fun () -> Field.Assert.equal !n_acc scalar) ; !acc @@ -323,16 +323,16 @@ struct (Typ.tuple2 G.typ (Typ.list ~length:n Boolean.typ)) G.typ (fun (g, s) -> - make_checked (fun () -> endo g (SC.create (Field.pack s)))) + make_checked (fun () -> endo g (SC.create (Field.pack s))) ) (fun (g, s) -> let x = Constant.to_field (SC.create (Challenge.Constant.of_bits s)) in - G.Constant.scale g x) + G.Constant.scale g x ) (random_point, xs) with e -> eprintf !"Input %{sexp: bool list}\n%!" xs ; - raise e) + raise e ) let endo_inv ((gx, gy) as g) chal = let res = diff --git a/src/lib/pickles/side_loaded_verification_key.ml b/src/lib/pickles/side_loaded_verification_key.ml index bfea727262a..b6c5e7b1d03 100644 --- a/src/lib/pickles/side_loaded_verification_key.ml +++ b/src/lib/pickles/side_loaded_verification_key.ml @@ -112,11 +112,11 @@ end = struct (Vector.typ Boolean.typ Length.n) ~there:(fun x -> let x = to_int x in - Vector.init Length.n ~f:(fun i -> (x lsr i) land 1 = 1)) + Vector.init Length.n ~f:(fun i -> (x lsr i) land 1 = 1) ) ~back:(fun v -> Vector.foldi v ~init:0 ~f:(fun i acc b -> - if b then acc lor (1 lsl i) else acc) - |> of_int_exn) + if b then acc lor (1 lsl i) else acc ) + |> of_int_exn ) end module Domain = struct @@ -133,7 +133,7 @@ module Domains = struct let dom = Typ.transport Typ.field ~there:(fun (Plonk_checks.Domain.Pow_2_roots_of_unity n) -> - Field.Constant.of_int n) + Field.Constant.of_int n ) ~back:(fun _ -> assert false) |> Typ.transport_var ~there:(fun (Domain.Pow_2_roots_of_unity n) -> n) @@ -154,7 +154,7 @@ let max_domains_with_x = Plonk_checks.Domain.Pow_2_roots_of_unity (Int.ceil_log2 (input_size ~of_int:Fn.id ~add:( + ) ~mul:( * ) - (Nat.to_int Width.Max.n))) + (Nat.to_int Width.Max.n) ) ) in { Ds.h = conv max_domains.h; x } @@ -204,7 +204,7 @@ module Stable = struct let of_repr ({ Repr.Stable.V2.step_data; max_width; wrap_index = c } : - R.Stable.V2.t) : t = + R.Stable.V2.t ) : t = let d = (Common.wrap_domains ~proofs_verified:(Width.to_int max_width)).h in @@ -239,10 +239,10 @@ module Stable = struct ; complete_add_comm = g c.complete_add_comm ; endomul_scalar_comm = g c.endomul_scalar_comm ; chacha_comm = None - }) + } ) ; shifts = Common.tock_shifts ~log2_size ; lookup_index = None - }) + } ) in { Poly.step_data; max_width; wrap_index = c; wrap_vk } @@ -260,15 +260,16 @@ module Stable = struct let compare x y = R.compare (to_repr x) (to_repr y) - include Binable.Of_binable - (R.Stable.V2) - (struct - type nonrec t = t + include + Binable.Of_binable + (R.Stable.V2) + (struct + type nonrec t = t - let to_binable r = to_repr r + let to_binable r = to_repr r - let of_binable r = of_repr r - end) + let of_binable r = of_repr r + end) end include T @@ -301,7 +302,7 @@ let dummy : t = ; mul_comm = g ; emul_comm = g ; endomul_scalar_comm = g - }) + } ) ; wrap_vk = None } @@ -337,7 +338,7 @@ module Checked = struct List.reduce_exn ~f:append [ map_reduce (Vector.to_array step_domains) ~f:(fun { Domains.h } -> map_reduce [| h |] ~f:(fun (Domain.Pow_2_roots_of_unity x) -> - packed (x, max_log2_degree))) + packed (x, max_log2_degree) ) ) ; Array.map (Vector.to_array step_widths) ~f:width |> packeds ; packed (width max_width) ; wrap_index_to_input @@ -360,7 +361,7 @@ let%test_unit "input_size" = Impls.Step.input ~proofs_verified:a ~wrap_rounds:Backend.Tock.Rounds.n in - Impls.Step.Data_spec.size [ typ ])) + Impls.Step.Data_spec.size [ typ ] ) ) let typ : (Checked.t, t) Impls.Step.Typ.t = let open Step_main_inputs in @@ -374,7 +375,7 @@ let typ : (Checked.t, t) Impls.Step.Typ.t = ] ~var_to_hlist:Checked.to_hlist ~var_of_hlist:Checked.of_hlist ~value_of_hlist:(fun _ -> - failwith "Side_loaded_verification_key: value_of_hlist") + failwith "Side_loaded_verification_key: value_of_hlist" ) ~value_to_hlist:(fun { Poly.step_data; wrap_index; max_width; _ } -> [ At_most.extend_to_vector (At_most.map step_data ~f:fst) @@ -385,5 +386,5 @@ let typ : (Checked.t, t) Impls.Step.Typ.t = ; max_width ; wrap_index ; (let n = At_most.length step_data in - Vector.init Max_branches.Log2.n ~f:(fun i -> (n lsr i) land 1 = 1)) - ]) + Vector.init Max_branches.Log2.n ~f:(fun i -> (n lsr i) land 1 = 1) ) + ] ) diff --git a/src/lib/pickles/sponge_inputs.ml b/src/lib/pickles/sponge_inputs.ml index e5c18351164..d5c6314720f 100644 --- a/src/lib/pickles/sponge_inputs.ml +++ b/src/lib/pickles/sponge_inputs.ml @@ -31,7 +31,7 @@ struct in let res = Array.init (rounds_full + 1) ~f:(fun _ -> - Array.create ~len:3 Impl.Field.Constant.zero) + Array.create ~len:3 Impl.Field.Constant.zero ) in res.(0) <- start ; for i = 0 to rounds_full - 1 do @@ -49,7 +49,7 @@ struct exists (Typ.array ~length:Int.(rounds_full + 1) - (Typ.array ~length:3 Field.typ)) + (Typ.array ~length:3 Field.typ) ) ~compute: As_prover.(fun () -> round_table (Array.map init ~f:read_var)) in @@ -60,8 +60,8 @@ struct [ { basic = T (Poseidon { state = t }) ; annotation = Some "plonk-poseidon" } - ])) ; - t.(Int.(Array.length t - 1))) + ] )) ; + t.(Int.(Array.length t - 1)) ) let add_assign ~state i x = state.(i) <- Util.seal (module Impl) (state.(i) + x) diff --git a/src/lib/pickles/step.ml b/src/lib/pickles/step.ml index 64e19fb44d9..e3bdc63bff9 100644 --- a/src/lib/pickles/step.ml +++ b/src/lib/pickles/step.ml @@ -43,7 +43,7 @@ struct a rule in proof system i. max_local_max_proof_verifieds is the max of the N_i. *) max_local_max_proof_verifieds self_branches prev_vars prev_values - local_widths local_heights prevs_length) ?handler + local_widths local_heights prevs_length ) ?handler (T branch_data : ( A.t , A_value.t @@ -53,15 +53,15 @@ struct , prev_values , local_widths , local_heights ) - Step_branch_data.t) (next_state : A_value.t) + Step_branch_data.t ) (next_state : A_value.t) ~maxes: (module Maxes : Pickles_types.Hlist.Maxes.S with type length = Max_proofs_verified.n - and type ns = max_local_max_proof_verifieds) + and type ns = max_local_max_proof_verifieds ) ~(prevs_length : (prev_vars, prevs_length) Length.t) ~self ~step_domains ~self_dlog_plonk_index pk self_dlog_vk (prev_with_proofs : - (prev_values, local_widths, local_heights) H3.T(P.With_data).t) : + (prev_values, local_widths, local_heights) H3.T(P.With_data).t ) : ( A_value.t , (_, Max_proofs_verified.n) Vector.t , (_, prevs_length) Vector.t @@ -177,18 +177,18 @@ struct ~endo:Endo.Step_inner_curve.base ~mds:Tick_field_sponge.params.mds ~field_of_hex:(fun s -> Kimchi_pasta.Pasta.Bigint256.of_hex_string s - |> Kimchi_pasta.Pasta.Fp.of_bigint) + |> Kimchi_pasta.Pasta.Fp.of_bigint ) ~domain: (Plonk_checks.domain (module Tick.Field) domain ~shifts:Common.tick_shifts - ~domain_generator:Backend.Tick.Field.domain_generator) + ~domain_generator:Backend.Tick.Field.domain_generator ) plonk_minimal combined_evals in time "plonk_checks" (fun () -> Plonk_checks.Type1.derive_plonk (module Tick.Field) - ~env ~shift:Shifts.tick1 plonk_minimal combined_evals) + ~env ~shift:Shifts.tick1 plonk_minimal combined_evals ) in let data = Types_map.lookup_basic tag in let (module Local_max_proofs_verified) = data.max_proofs_verified in @@ -214,7 +214,7 @@ struct (* TODO: Only do this hashing when necessary *) Common.hash_step_me_only (Reduced_me_only.Step.prepare ~dlog_plonk_index:dlog_index - statement.pass_through) + statement.pass_through ) ~app_state:data.value_to_field_elements ; proof_state = { statement.proof_state with @@ -249,13 +249,13 @@ struct (Vector.extend_exn statement.pass_through.challenge_polynomial_commitments Local_max_proofs_verified.n - (Lazy.force Dummy.Ipa.Wrap.sg)) + (Lazy.force Dummy.Ipa.Wrap.sg) ) (* This should indeed have length Max_proofs_verified... No! It should have type Max_proofs_verified_a. That is, the max_proofs_verified specific to a proof of this type...*) prev_challenges ~f:(fun commitment chals -> { Tock.Proof.Challenge_polynomial.commitment ; challenges = Vector.to_array chals - }) + } ) |> to_list) public_input t.proof in @@ -296,7 +296,7 @@ struct let new_bulletproof_challenges, b = let prechals = Array.map (O.opening_prechallenges o) ~f:(fun x -> - Scalar_challenge.map ~f:Challenge.Constant.of_tock_field x) + Scalar_challenge.map ~f:Challenge.Constant.of_tock_field x ) in let chals = Array.map prechals ~f:(fun x -> Ipa.Wrap.compute_challenge x) @@ -310,7 +310,7 @@ struct let prechals = Vector.of_list_and_length_exn ( Array.map prechals ~f:(fun x -> - { Bulletproof_challenge.prechallenge = x }) + { Bulletproof_challenge.prechallenge = x } ) |> Array.to_list ) Tock.Rounds.n in @@ -334,7 +334,7 @@ struct ; prev_challenges = Vector.extend_exn (Vector.map t.statement.pass_through.old_bulletproof_challenges - ~f:Ipa.Step.compute_challenges) + ~f:Ipa.Step.compute_challenges ) Local_max_proofs_verified.n Dummy.Ipa.Step.challenges_computed ; wrap_proof = { opening = @@ -366,7 +366,7 @@ struct ~domain:tock_domain ~srs_length_log2:Common.Max_degree.wrap_log2 ~field_of_hex:(fun s -> Kimchi_pasta.Pasta.Bigint256.of_hex_string s - |> Kimchi_pasta.Pasta.Fq.of_bigint) + |> Kimchi_pasta.Pasta.Fq.of_bigint ) ~endo:Endo.Wrap_inner_curve.base ~mds:Tock_field_sponge.params.mds tock_plonk_minimal tock_combined_evals in @@ -375,7 +375,7 @@ struct let b_polys = Vector.map ~f:(fun chals -> - unstage (challenge_polynomial (Vector.to_array chals))) + unstage (challenge_polynomial (Vector.to_array chals)) ) prev_challenges in let open As_field in @@ -395,7 +395,7 @@ struct ~evaluation_point:pt ~shifted_pow:(fun deg x -> Pcs_batch.pow ~one ~mul x - Int.(Max_degree.wrap - (deg mod Max_degree.wrap))) + Int.(Max_degree.wrap - (deg mod Max_degree.wrap)) ) v b in let ft_eval0 = @@ -497,9 +497,7 @@ struct Step_bp_vec.t end in let module M = - H3.Map - (P.With_data) - (E03 (VV)) + H3.Map (P.With_data) (E03 (VV)) (struct let f (T t : _ P.With_data.t) : VV.t = t.statement.proof_state.deferred_values.bulletproof_challenges @@ -560,7 +558,7 @@ struct { challenge_polynomial_commitment = Lazy.force Dummy.Ipa.Step.sg ; old_bulletproof_challenges = Vector.init Max_proofs_verified.n ~f:(fun _ -> - Dummy.Ipa.Wrap.challenges_computed) + Dummy.Ipa.Wrap.challenges_computed ) } in Common.hash_dlog_me_only Max_proofs_verified.n t :: pad [] ms n @@ -575,16 +573,14 @@ struct (* TODO: Use the same pad_pass_through function as in wrap *) pad (Vector.map statements_with_hashes ~f:(fun s -> - s.proof_state.me_only)) + s.proof_state.me_only ) ) Maxes.maxes Maxes.length } in let prev_challenge_polynomial_commitments = let to_fold_in = let module M = - H3.Map - (P.With_data) - (E03 (Tick.Curve.Affine)) + H3.Map (P.With_data) (E03 (Tick.Curve.Affine)) (struct let f (T t : _ P.With_data.t) = t.statement.proof_state.me_only.challenge_polynomial_commitment @@ -599,7 +595,7 @@ struct ~f:(fun commitment chals -> { Tick.Proof.Challenge_polynomial.commitment ; challenges = Vector.to_array chals - }) + } ) |> to_list) in let%map.Promise (next_proof : Tick.Proof.t) = @@ -616,25 +612,22 @@ struct (Index.to_int branch_data.index) (Domain.size h) (Domain.size x) (fun () -> Impls.Step.generate_witness_conv - ~f: - (fun { Impls.Step.Proof_inputs.auxiliary_inputs; public_inputs } - () -> + ~f:(fun { Impls.Step.Proof_inputs.auxiliary_inputs; public_inputs } + () -> Backend.Tick.Proof.create_async ~primary:public_inputs ~auxiliary:auxiliary_inputs - ~message:prev_challenge_polynomial_commitments pk) + ~message:prev_challenge_polynomial_commitments pk ) [ input ] ~return_typ:(Snarky_backendless.Typ.unit ()) (fun x () : unit -> Impls.Step.handle (fun () : unit -> branch_data.main ~step_domains (conv x)) - handler) - next_statement_hashed) + handler ) + next_statement_hashed ) in let prev_evals = let module M = - H3.Map - (P.With_data) - (E03 (E)) + H3.Map (P.With_data) (E03 (E)) (struct let f (T t : _ P.With_data.t) = (t.proof.openings.evals, t.proof.openings.ft_eval1) @@ -653,8 +646,8 @@ struct { ft_eval1 ; evals = Double.map2 es x_hat ~f:(fun es x_hat -> - { With_public_input.evals = es; public_input = x_hat }) - })) + { With_public_input.evals = es; public_input = x_hat } ) + } ) ) lte Max_proofs_verified.n Dummy.evals } end diff --git a/src/lib/pickles/step_branch_data.ml b/src/lib/pickles/step_branch_data.ml index a1a282a9b8a..04dd51fa113 100644 --- a/src/lib/pickles/step_branch_data.ml +++ b/src/lib/pickles/step_branch_data.ml @@ -41,7 +41,7 @@ type ( 'a_var and type max_proofs_verified = 'max_proofs_verified and type prev_values = 'prev_values and type local_signature = 'local_widths - and type local_branches = 'local_heights) + and type local_branches = 'local_heights ) } -> ( 'a_var , 'a_value @@ -56,7 +56,7 @@ type ( 'a_var (* Compile an inductive rule. *) let create (type branches max_proofs_verified local_signature local_branches a_var - a_value prev_vars prev_values) ~index + a_value prev_vars prev_values ) ~index ~(self : (a_var, a_value, max_proofs_verified, branches) Tag.t) ~wrap_domains ~(max_proofs_verified : max_proofs_verified Nat.t) ~(proofs_verifieds : (int, branches) Vector.t) ~(branches : branches Nat.t) diff --git a/src/lib/pickles/step_main.ml b/src/lib/pickles/step_main.ml index 8f679903102..31fc6044655 100644 --- a/src/lib/pickles/step_main.ml +++ b/src/lib/pickles/step_main.ml @@ -35,9 +35,9 @@ let verify_one ; prev_challenges ; prev_challenge_polynomial_commitments } : - _ Per_proof_witness.t) (d : _ Types_map.For_step.t) - (pass_through : Digest.t) (unfinalized : Unfinalized.t) - (should_verify : B.t) : _ Vector.t * B.t = + _ Per_proof_witness.t ) (d : _ Types_map.For_step.t) + (pass_through : Digest.t) (unfinalized : Unfinalized.t) (should_verify : B.t) + : _ Vector.t * B.t = Boolean.Assert.( = ) unfinalized.should_finalize should_verify ; let finalized, chals = with_label __LOC__ (fun () -> @@ -51,7 +51,7 @@ let verify_one (* TODO: Refactor args into an "unfinalized proof" struct *) finalize_other_proof d.max_proofs_verified ~max_width:d.max_width ~step_widths:d.proofs_verifieds ~step_domains:d.step_domains ~sponge - ~prev_challenges proof_state.deferred_values prev_proof_evals) + ~prev_challenges proof_state.deferred_values prev_proof_evals ) in let which_branch = proof_state.deferred_values.which_branch in let proof_state = @@ -63,7 +63,7 @@ let verify_one one_hot_vector_to_num proof_state.deferred_values.which_branch |> Types.Index.of_field (module Impl) } - }) + } ) in let statement = let prev_me_only = @@ -81,7 +81,7 @@ let verify_one ; challenge_polynomial_commitments = prev_challenge_polynomial_commitments ; old_bulletproof_challenges = prev_challenges - }) + } ) in { Types.Wrap.Statement.pass_through = prev_me_only ; proof_state = { proof_state with me_only = pass_through } @@ -93,7 +93,7 @@ let verify_one ~wrap_domain:d.wrap_domains.h ~is_base_case:(Boolean.not should_verify) ~sg_old:prev_challenge_polynomial_commitments ~proof:wrap_proof - ~wrap_verification_key:d.wrap_key statement unfinalized) + ~wrap_verification_key:d.wrap_key statement unfinalized ) in if debug then as_prover @@ -117,7 +117,7 @@ let step_main : and type local_branches = local_branches and type statement = a_value and type prev_values = prev_values - and type max_proofs_verified = max_proofs_verified) + and type max_proofs_verified = max_proofs_verified ) -> (module Nat.Add.Intf with type n = max_proofs_verified) -> self_branches:self_branches Nat.t (* How many branches does this proof system have *) @@ -149,7 +149,7 @@ let step_main : , Field.t , (Field.t, max_proofs_verified) Vector.t ) Types.Step.Statement.t - -> unit) + -> unit ) Staged.t = fun (module Req) (module Max_proofs_verified) ~self_branches ~local_signature ~local_signature_length ~local_branches ~local_branches_length @@ -192,7 +192,7 @@ let step_main : | None -> Types_map.typ d in - typ) + typ ) d in let t = Per_proof_witness.typ typ n1 n2 in @@ -224,7 +224,7 @@ let step_main : and app_state = exists basic.typ ~request:(fun () -> Req.App_state) and prevs = exists (Prev_typ.f prev_typs) ~request:(fun () -> - Req.Proof_with_datas) + Req.Proof_with_datas ) in let prev_statements = let module M = @@ -277,11 +277,11 @@ let step_main : let pass_throughs = with_label "pass_throughs" (fun () -> let module V = H1.Of_vector (Digest) in - V.f proofs_verified (Vector.trim stmt.pass_through lte)) + V.f proofs_verified (Vector.trim stmt.pass_through lte) ) and proofs_should_verify = (* Run the application logic of the rule on the predecessor statements *) with_label "rule_main" (fun () -> - rule.main prev_statements app_state) + rule.main prev_statements app_state ) and unfinalized_proofs = let module H = H1.Of_vector (Unfinalized) in H.f proofs_verified @@ -332,14 +332,12 @@ let step_main : go prevs datas pass_throughs unfinalized_proofs proofs_should_verify proofs_verified in - Boolean.Assert.all vs ; chalss) + Boolean.Assert.all vs ; chalss ) in let () = let challenge_polynomial_commitments = let module M = - H3.Map - (Per_proof_witness) - (E03 (Inner_curve)) + H3.Map (Per_proof_witness) (E03 (Inner_curve)) (struct let f : type a b c. (a, b, c) Per_proof_witness.t -> Inner_curve.t @@ -355,7 +353,7 @@ let step_main : let hash_me_only = unstage (hash_me_only ~index:dlog_plonk_index - basic.var_to_field_elements) + basic.var_to_field_elements ) in Field.Assert.equal stmt.proof_state.me_only (hash_me_only @@ -365,8 +363,8 @@ let step_main : ; old_bulletproof_challenges = (* Note: the bulletproof_challenges here are unpadded! *) bulletproof_challenges - })) + } ) ) in - ()) + () ) in stage main diff --git a/src/lib/pickles/step_main_inputs.ml b/src/lib/pickles/step_main_inputs.ml index 16bc1fbd787..abf4cd6af71 100644 --- a/src/lib/pickles/step_main_inputs.ml +++ b/src/lib/pickles/step_main_inputs.ml @@ -18,7 +18,7 @@ let unrelated_g = unstage (group_map (module Tick.Field) - ~a:Tick.Inner_curve.Params.a ~b:Tick.Inner_curve.Params.b) + ~a:Tick.Inner_curve.Params.a ~b:Tick.Inner_curve.Params.b ) and str = Fn.compose bits_to_bytes Tick.Field.to_bits in fun (x, y) -> group_map (tick_field_random_oracle (str x ^ str y)) @@ -88,11 +88,11 @@ module Input_domain = struct let v = (Kimchi_bindings.Protocol.SRS.Fq.lagrange_commitment (Backend.Tock.Keypair.load_urs ()) - domain_size i) + domain_size i ) .unshifted in assert (Array.length v = 1) ; - v.(0) |> Common.finite_exn))) + v.(0) |> Common.finite_exn ) ) ) end module Inner_curve = struct @@ -179,7 +179,7 @@ module Inner_curve = struct let scale t bs = with_label __LOC__ (fun () -> - T.scale t (Bitstring_lib.Bitstring.Lsb_first.of_list bs)) + T.scale t (Bitstring_lib.Bitstring.Lsb_first.of_list bs) ) let to_field_elements (x, y) = [ x; y ] @@ -195,7 +195,7 @@ module Inner_curve = struct C.scale (C.of_affine (read typ t)) (Tock.Field.inv - (Tock.Field.of_bits (List.map ~f:(read Boolean.typ) bs))) + (Tock.Field.of_bits (List.map ~f:(read Boolean.typ) bs)) ) |> C.to_affine_exn) in assert_equal t (scale res bs) ; @@ -231,7 +231,8 @@ let%test_unit "scale fast 2'" = (Typ.tuple2 G.typ Field.typ) G.typ (fun (g, s) -> - make_checked (fun () -> Ops.scale_fast2' ~num_bits:n (module F) g s)) + make_checked (fun () -> Ops.scale_fast2' ~num_bits:n (module F) g s) + ) (fun (g, _) -> let x = let chunks_needed = Ops.chunks_needed ~num_bits:(n - 1) in @@ -243,8 +244,8 @@ let%test_unit "scale fast 2'" = |> G.Constant.Scalar.( + ) (G.Constant.Scalar.project (Field.Constant.unpack s)) in - G.Constant.scale g x) - (G.Constant.random (), s)) + G.Constant.scale g x ) + (G.Constant.random (), s) ) let%test_unit "scale fast 2 small" = let open Impl in @@ -270,7 +271,8 @@ let%test_unit "scale fast 2 small" = (Typ.tuple2 G.typ Field.typ) G.typ (fun (g, s) -> - make_checked (fun () -> Ops.scale_fast2' ~num_bits:n (module F) g s)) + make_checked (fun () -> Ops.scale_fast2' ~num_bits:n (module F) g s) + ) (fun (g, _) -> let x = let chunks_needed = Ops.chunks_needed ~num_bits:(n - 1) in @@ -282,8 +284,8 @@ let%test_unit "scale fast 2 small" = |> G.Constant.Scalar.( + ) (G.Constant.Scalar.project (Field.Constant.unpack s)) in - G.Constant.scale g x) - (G.Constant.random (), s)) + G.Constant.scale g x ) + (G.Constant.random (), s) ) module Generators = struct let h = diff --git a/src/lib/pickles/step_verifier.ml b/src/lib/pickles/step_verifier.ml index 98fb194b22d..fc9c9d00837 100644 --- a/src/lib/pickles/step_verifier.ml +++ b/src/lib/pickles/step_verifier.ml @@ -62,7 +62,7 @@ struct let print_bool lab x = if debug then as_prover (fun () -> - printf "%s: %b\n%!" lab (As_prover.read Boolean.typ x)) + printf "%s: %b\n%!" lab (As_prover.read Boolean.typ x) ) let equal_g g1 g2 = List.map2_exn ~f:Field.equal @@ -76,9 +76,9 @@ struct ~g1_to_field_elements:Inner_curve.to_field_elements ~absorb_scalar:(fun (x, (b : Boolean.var)) -> Sponge.absorb sponge (`Field x) ; - Sponge.absorb sponge (`Bits [ b ])) + Sponge.absorb sponge (`Bits [ b ]) ) ~mask_g1_opt:(fun ((b : Boolean.var), (x, y)) -> - Field.((b :> t) * x, (b :> t) * y)) + Field.((b :> t) * x, (b :> t) * y) ) ty t let scalar_to_field s = @@ -106,7 +106,7 @@ struct (ts : ( [ `Field of Field.t | `Packed_bits of Field.t * int ] * Inner_curve.Constant.t ) - array) = + array ) = let rec pow2pow x i = if i = 0 then x else pow2pow Inner_curve.Constant.(x + x) (i - 1) in @@ -141,11 +141,11 @@ struct Ops.bits_per_chunk * Ops.chunks_needed ~num_bits:(n - 1) in let cc = pow2pow x n in - (cc, rr)) + (cc, rr) ) |> Array.reduce_exn ~f:(fun (a1, b1) (a2, b2) -> - (Inner_curve.Constant.( + ) a1 a2, Inner_curve.( + ) b1 b2)) + (Inner_curve.Constant.( + ) a1 a2, Inner_curve.( + ) b1 b2) ) in - Inner_curve.(acc + constant (Constant.negate correction))) + Inner_curve.(acc + constant (Constant.negate correction)) ) let squeeze_challenge sponge : Field.t = lowest_128_bits (Sponge.squeeze sponge) ~constrain_low_bits:true @@ -161,7 +161,7 @@ struct let prechallenges = Array.mapi gammas ~f:(fun i gammas_i -> absorb (PC :: PC) gammas_i ; - squeeze_scalar sponge) + squeeze_scalar sponge ) in let term_and_challenge (l, r) pre = let left_term = Scalar_challenge.endo_inv l pre in @@ -173,7 +173,7 @@ struct Array.map2_exn gammas prechallenges ~f:term_and_challenge |> Array.unzip in - (Array.reduce_exn terms ~f:Inner_curve.( + ), challenges)) + (Array.reduce_exn terms ~f:Inner_curve.( + ), challenges) ) let group_map = let f = @@ -195,18 +195,18 @@ struct Field.( (x * x * x) + (constant Inner_curve.Params.a * x) - + constant Inner_curve.Params.b)) - |> unstage) + + constant Inner_curve.Params.b) ) + |> unstage ) in fun x -> Lazy.force f x let scale_fast p s = with_label __LOC__ (fun () -> - Ops.scale_fast p s ~num_bits:Field.size_in_bits) + Ops.scale_fast p s ~num_bits:Field.size_in_bits ) let scale_fast2 p (s : Other_field.t Shifted_value.Type2.t) = with_label __LOC__ (fun () -> - Ops.scale_fast2 p s ~num_bits:Field.size_in_bits) + Ops.scale_fast2 p s ~num_bits:Field.size_in_bits ) let check_bulletproof ~pcs_batch ~(sponge : Sponge.t) ~xi ~(* Corresponds to y in figure 7 of WTS *) @@ -215,7 +215,7 @@ struct ~polynomials:(without_degree_bound, with_degree_bound) ~opening: ({ lr; delta; z_1; z_2; challenge_polynomial_commitment } : - (Inner_curve.t, Other_field.t Shifted_value.Type2.t) Bulletproof.t) = + (Inner_curve.t, Other_field.t Shifted_value.Type2.t) Bulletproof.t ) = with_label "check_bulletproof" (fun () -> absorb sponge Scalar ( match advice.combined_inner_product with @@ -232,10 +232,10 @@ struct let combined_polynomial (* Corresponds to xi in figure 7 of WTS *) = with_label "combined_polynomial" (fun () -> Pcs_batch.combine_split_commitments pcs_batch - ~scale_and_add: - (fun ~(acc : - [ `Maybe_finite of Boolean.var * Inner_curve.t - | `Finite of Inner_curve.t ]) ~xi p -> + ~scale_and_add:(fun ~(acc : + [ `Maybe_finite of + Boolean.var * Inner_curve.t + | `Finite of Inner_curve.t ] ) ~xi p -> match acc with | `Maybe_finite (acc_is_finite, (acc : Inner_curve.t)) -> ( match p with @@ -258,12 +258,14 @@ struct | `Finite p -> p + xi_acc | `Maybe_finite (p_is_finite, p) -> - if_ p_is_finite ~then_:(p + xi_acc) ~else_:xi_acc )) + if_ p_is_finite ~then_:(p + xi_acc) ~else_:xi_acc ) + ) ~xi ~init:(function - | `Finite x -> `Finite x | `Maybe_finite x -> `Maybe_finite x) + | `Finite x -> `Finite x | `Maybe_finite x -> `Maybe_finite x + ) (Vector.map without_degree_bound - ~f:(Array.map ~f:(fun x -> `Finite x))) + ~f:(Array.map ~f:(fun x -> `Finite x)) ) (Vector.map with_degree_bound ~f: (let open Plonk_types.Poly_comm.With_degree_bound in @@ -271,7 +273,7 @@ struct let f x = `Maybe_finite x in { unshifted = Array.map ~f unshifted ; shifted = f shifted - }))) + }) ) ) |> function `Finite x -> x | `Maybe_finite _ -> assert false in let lr_prod, challenges = bullet_reduce sponge lr in @@ -297,19 +299,19 @@ struct let z2_h = scale_fast2 (Inner_curve.constant (Lazy.force Generators.h)) z_2 in - z_1_g_plus_b_u + z2_h) + z_1_g_plus_b_u + z2_h ) in - (`Success (equal_g lhs rhs), challenges)) + (`Success (equal_g lhs rhs), challenges) ) let assert_eq_deferred_values (m1 : ( 'a , Inputs.Impl.Field.t Import.Scalar_challenge.t ) - Types.Step.Proof_state.Deferred_values.Plonk.Minimal.t) + Types.Step.Proof_state.Deferred_values.Plonk.Minimal.t ) (m2 : ( Inputs.Impl.Field.t , Inputs.Impl.Field.t Import.Scalar_challenge.t ) - Types.Step.Proof_state.Deferred_values.Plonk.Minimal.t) = + Types.Step.Proof_state.Deferred_values.Plonk.Minimal.t ) = let open Types.Wrap.Proof_state.Deferred_values.Plonk.Minimal in let chal c1 c2 = Field.Assert.equal c1 c2 in let scalar_chal ({ SC.SC.inner = t1 } : _ Import.Scalar_challenge.t) @@ -336,19 +338,19 @@ struct (module Proofs_verified : Nat.Add.Intf with type n = b) ~domain ~verification_key:(m : _ Plonk_verification_key_evals.t) ~xi ~sponge ~(public_input : - [ `Field of Field.t | `Packed_bits of Field.t * int ] array) + [ `Field of Field.t | `Packed_bits of Field.t * int ] array ) ~(sg_old : (_, Proofs_verified.n) Vector.t) ~advice ~proof:({ messages; opening } : Wrap_proof.Checked.t) ~(plonk : ( _ , _ , _ Shifted_value.Type2.t ) - Types.Wrap.Proof_state.Deferred_values.Plonk.In_circuit.t) = + Types.Wrap.Proof_state.Deferred_values.Plonk.In_circuit.t ) = with_label "incrementally_verify_proof" (fun () -> let receive ty f = with_label "receive" (fun () -> let x = f messages in - absorb sponge ty x ; x) + absorb sponge ty x ; x ) in let sample () = squeeze_challenge sponge in let sample_scalar () = squeeze_scalar sponge in @@ -357,8 +359,8 @@ struct with_label "x_hat" (fun () -> multiscale_known (Array.mapi public_input ~f:(fun i x -> - (x, lagrange_commitment ~domain i))) - |> Inner_curve.negate) + (x, lagrange_commitment ~domain i) ) ) + |> Inner_curve.negate ) in let without = Type.Without_degree_bound in let absorb_g gs = absorb sponge without gs in @@ -393,7 +395,7 @@ struct with_label __LOC__ (fun () -> Common.ft_comm ~add:Ops.add_fast ~scale:scale_fast2 ~negate:Inner_curve.negate ~endoscale:Scalar_challenge.endo - ~verification_key:m ~plonk ~alpha ~t_comm) + ~verification_key:m ~plonk ~alpha ~t_comm ) in let bulletproof_challenges = (* This sponge needs to be initialized with (some derivative of) @@ -420,9 +422,9 @@ struct check_bulletproof ~pcs_batch: (Common.dlog_pcs_batch - (Proofs_verified.add num_commitments_without_degree_bound)) + (Proofs_verified.add num_commitments_without_degree_bound) ) ~sponge:sponge_before_evaluations ~xi ~advice ~opening - ~polynomials:(without_degree_bound, [])) + ~polynomials:(without_degree_bound, []) ) in assert_eq_deferred_values { alpha = plonk.alpha @@ -431,12 +433,12 @@ struct ; zeta = plonk.zeta } { alpha; beta; gamma; zeta } ; - (sponge_digest_before_evaluations, bulletproof_challenges)) + (sponge_digest_before_evaluations, bulletproof_challenges) ) let compute_challenges ~scalar chals = with_label "compute_challenges" (fun () -> Vector.map chals ~f:(fun { Bulletproof_challenge.prechallenge } -> - scalar prechallenge)) + scalar prechallenge ) ) let challenge_polynomial = Field.(Wrap_verifier.challenge_polynomial ~add ~mul ~one) @@ -466,7 +468,7 @@ struct in go acc (i + 1) in - Field.sub (go x 0) Field.one) + Field.sub (go x 0) Field.one ) let shifts ~log2_size = Common.tick_shifts ~log2_size @@ -505,7 +507,7 @@ struct let size = lazy (Pseudo.choose (mask, domain_log2s) ~f:(fun x -> - Field.of_int (1 lsl x))) + Field.of_int (1 lsl x) ) ) in object method shifts = Lazy.force shifts @@ -535,7 +537,7 @@ struct Vector.map mask ~f:(fun b -> (* 0 -> 1 1 -> 2 *) - Field.((b :> t) + one)) + Field.((b :> t) + one) ) |> Vector.reduce_exn ~f:Field.( * ) in object @@ -562,7 +564,7 @@ struct let y = run_and_check (fun () -> let y = k () in - fun () -> As_prover.read_var y) + fun () -> As_prover.read_var y ) |> Or_error.ok_exn in y @@ -587,7 +589,8 @@ struct [%test_eq: Field.Constant.t] (d_unchecked#vanishing_polynomial pt) (run (fun () -> - (checked_domain ())#vanishing_polynomial (Field.constant pt)))) + (checked_domain ())#vanishing_polynomial (Field.constant pt) ) + ) ) let%test_unit "side loaded domains" = let module O = One_hot_vector.Make (Impl) in @@ -609,7 +612,7 @@ struct (Vector.map domains ~f: (Domains.map ~f:(fun x -> - Domain.Pow_2_roots_of_unity (Field.of_int x)))) + Domain.Pow_2_roots_of_unity (Field.of_int x) ) ) ) (O.of_index (Field.of_int i) ~length:branches) |> field2 in @@ -619,9 +622,9 @@ struct (d_unchecked#vanishing_polynomial pt) (run (fun () -> (checked_domain ())#vanishing_polynomial - (Field.constant pt))) + (Field.constant pt) ) ) in - check Domains.h Domains.h) + check Domains.h Domains.h ) end ) module Split_evaluations = struct @@ -642,7 +645,7 @@ struct let last = Array.reduce_exn ~f:(fun (b_acc, x_acc) (b, x) -> - (Boolean.(b_acc ||| b), Field.if_ b ~then_:x ~else_:x_acc)) + (Boolean.(b_acc ||| b), Field.if_ b ~then_:x ~else_:x_acc) ) let rec pow x bits_lsb = with_label "pow" (fun () -> @@ -655,7 +658,7 @@ struct let acc = Field.if_ b ~then_:Field.(x * acc) ~else_:acc in go acc bs in - go Field.one (List.rev bits_lsb)) + go Field.one (List.rev bits_lsb) ) let mod_max_degree = let k = Nat.to_int Backend.Tick.Rounds.n in @@ -667,7 +670,7 @@ struct Pcs_batch.combine_split_evaluations ~last ~mul:(fun (keep, x) (y : Field.t) -> (keep, Field.(y * x))) ~mul_and_add:(fun ~acc ~xi (keep, fx) -> - Field.if_ keep ~then_:Field.(fx + (xi * acc)) ~else_:acc) + Field.if_ keep ~then_:Field.(fx + (xi * acc)) ~else_:acc ) ~init:(fun (_, fx) -> fx) (Common.dlog_pcs_batch b_plus_26) ~shifted_pow: @@ -677,7 +680,7 @@ struct Pcs_batch.combine_split_evaluations ~last ~mul:(fun (keep, x) (y : Field.t) -> (keep, Field.(y * x))) ~mul_and_add:(fun ~acc ~xi (keep, fx) -> - Field.if_ keep ~then_:Field.(fx + (xi * acc)) ~else_:acc) + Field.if_ keep ~then_:Field.(fx + (xi * acc)) ~else_:acc ) ~init:(fun (_, fx) -> fx) (Common.dlog_pcs_batch b_plus_26) ~shifted_pow:(fun deg x -> pow x deg) @@ -686,7 +689,7 @@ struct (choice : n One_hot_vector.T(Impl).t) (e : Field.t array Evals.t) : (Boolean.var * Field.t) array Evals.t = Evals.map2 lengths e ~f:(fun lengths e -> - Array.zip_exn (mask ~lengths choice) e) + Array.zip_exn (mask ~lengths choice) e ) end let combined_evaluation (type b b_plus_26) b_plus_26 ~xi ~evaluation_point @@ -709,7 +712,7 @@ struct let rec go acc i = if i = 0 then acc else go (Field.square acc) (i - 1) in - go pt n) + go pt n ) let actual_evaluation (e : Field.t array) ~(pt_to_n : Field.t) : Field.t = with_label "actual_evaluation" (fun () -> @@ -717,7 +720,7 @@ struct | e :: es -> List.fold ~init:e es ~f:(fun acc fx -> Field.(fx + (pt_to_n * acc))) | [] -> - failwith "empty list") + failwith "empty list" ) open Plonk_types @@ -765,10 +768,10 @@ struct ( Field.t Side_loaded_verification_key.Domain.t Side_loaded_verification_key.Domains.t , branches ) - Vector.t ]) ~step_widths + Vector.t ] ) ~step_widths ~(* TODO: Add "actual proofs verified" so that proofs don't carry around dummy "old bulletproof challenges" *) - sponge ~(prev_challenges : (_, b) Vector.t) + sponge ~(prev_challenges : (_, b) Vector.t) ({ xi ; combined_inner_product ; bulletproof_challenges @@ -782,7 +785,7 @@ struct , _ , _ , _ ) - Types.Wrap.Proof_state.Deferred_values.In_circuit.t) + Types.Wrap.Proof_state.Deferred_values.In_circuit.t ) { Plonk_types.All_evals.ft_eval1 ; evals = ( { evals = evals1; public_input = x_hat1 } @@ -802,7 +805,7 @@ struct side_loaded_input_domain ~width: (Side_loaded_verification_key.Width.Checked.to_field - (Option.value_exn max_width)) )) + (Option.value_exn max_width) ) ) ) in let actual_width = Pseudo.choose (which_branch, step_widths) ~f:Fn.id in let T = Proofs_verified.eq in @@ -812,7 +815,7 @@ struct let xs, ys = Evals.to_vectors e in List.iter Vector.([| x_hat |] :: (to_list xs @ to_list ys)) - ~f:(Array.iter ~f:(fun x -> Sponge.absorb sponge (`Field x)))) + ~f:(Array.iter ~f:(fun x -> Sponge.absorb sponge (`Field x))) ) in (* A lot of hashing. *) absorb_evals x_hat1 evals1 ; @@ -859,8 +862,8 @@ struct ~mds:sponge_params.mds ~field_of_hex:(fun s -> Kimchi_pasta.Pasta.Bigint256.of_hex_string s - |> Kimchi_pasta.Pasta.Fp.of_bigint |> Field.constant) - ~domain plonk_minimal combined_evals) + |> Kimchi_pasta.Pasta.Fp.of_bigint |> Field.constant ) + ~domain plonk_minimal combined_evals ) in let open Field in let combined_inner_product_correct = @@ -868,7 +871,7 @@ struct with_label "ft_eval0" (fun () -> Plonk_checks.ft_eval0 (module Field) - ~env ~domain plonk_minimal combined_evals x_hat1) + ~env ~domain plonk_minimal combined_evals x_hat1 ) in print_fp "ft_eval0" ft_eval0 ; print_fp "ft_eval1" ft_eval1 ; @@ -877,7 +880,7 @@ struct let sg_olds = with_label "sg_olds" (fun () -> Vector.map prev_challenges ~f:(fun chals -> - unstage (challenge_polynomial (Vector.to_array chals)))) + unstage (challenge_polynomial (Vector.to_array chals)) ) ) in let combine ~ft pt x_hat e = let pi = Proofs_verified.add Nat.N26.n in @@ -886,7 +889,7 @@ struct Vector.map2 (ones_vector (module Impl) - ~first_zero:actual_width Proofs_verified.n) + ~first_zero:actual_width Proofs_verified.n ) sg_olds ~f:(fun keep f -> [| (keep, f pt) |]) in @@ -894,7 +897,7 @@ struct Vector.append sg_evals (Vector.map ([| x_hat |] :: [| ft |] :: a) - ~f:(Array.map ~f:(fun x -> (Boolean.true_, x)))) + ~f:(Array.map ~f:(fun x -> (Boolean.true_, x))) ) (snd pi) in match step_domains with @@ -907,7 +910,7 @@ struct in with_label "combine" (fun () -> combine ~ft:ft_eval0 plonk.zeta x_hat1 evals1 - + (r * combine ~ft:ft_eval1 zetaw x_hat2 evals2)) + + (r * combine ~ft:ft_eval1 zetaw x_hat2 evals2) ) in let expected = Shifted_value.Type1.to_field @@ -933,13 +936,13 @@ struct let b_used = Shifted_value.Type1.to_field (module Field) ~shift:shift1 b in - equal b_used b_actual) + equal b_used b_actual ) in let plonk_checks_passed = with_label "plonk_checks_passed" (fun () -> Plonk_checks.checked (module Impl) - ~env ~shift:shift1 plonk combined_evals) + ~env ~shift:shift1 plonk combined_evals ) in print_bool "xi_correct" xi_correct ; print_bool "combined_inner_product_correct" combined_inner_product_correct ; @@ -953,16 +956,16 @@ struct ] , bulletproof_challenges ) - let hash_me_only (type s) ~index - (state_to_field_elements : s -> Field.t array) = + let hash_me_only (type s) ~index (state_to_field_elements : s -> Field.t array) + = let open Types.Step.Proof_state.Me_only in let after_index = let sponge = Sponge.create sponge_params in Array.iter (Types.index_to_field_elements ~g:(fun (z : Inputs.Inner_curve.t) -> - List.to_array (Inner_curve.to_field_elements z)) - index) + List.to_array (Inner_curve.to_field_elements z) ) + index ) ~f:(fun x -> Sponge.absorb sponge (`Field x)) ; sponge in @@ -971,8 +974,8 @@ struct Array.iter ~f:(fun x -> Sponge.absorb sponge (`Field x)) (to_field_elements_without_index t ~app_state:state_to_field_elements - ~g:Inner_curve.to_field_elements) ; - Sponge.squeeze_field sponge) + ~g:Inner_curve.to_field_elements ) ; + Sponge.squeeze_field sponge ) let hash_me_only_opt (type s) ~index (state_to_field_elements : s -> Field.t array) = @@ -982,8 +985,8 @@ struct Array.iter (Types.index_to_field_elements ~g:(fun (z : Inputs.Inner_curve.t) -> - List.to_array (Inner_curve.to_field_elements z)) - index) + List.to_array (Inner_curve.to_field_elements z) ) + index ) ~f:(fun x -> Sponge.absorb sponge (`Field x)) ; sponge in @@ -999,10 +1002,10 @@ struct { t with old_bulletproof_challenges = Vector.map2 mask t.old_bulletproof_challenges ~f:(fun b v -> - Vector.map v ~f:(fun x -> `Opt (b, x))) + Vector.map v ~f:(fun x -> `Opt (b, x)) ) ; challenge_polynomial_commitments = Vector.map2 mask t.challenge_polynomial_commitments ~f:(fun b g -> - (b, g)) + (b, g) ) } in let not_opt x = `Not_opt x in @@ -1013,7 +1016,7 @@ struct ~g:(fun (b, g) -> List.map ~f:(fun x -> `Opt (b, x)) - (Inner_curve.to_field_elements g)) + (Inner_curve.to_field_elements g) ) in match Array.fold hash_inputs ~init:(`Not_opt sponge) ~f:(fun acc t -> @@ -1027,13 +1030,13 @@ struct | `Opt sponge, `Opt t -> Opt_sponge.absorb sponge t ; acc | `Opt _, `Not_opt _ -> - assert false) + assert false ) with | `Not_opt sponge -> (* This means there were no optional inputs. *) Sponge.squeeze_field sponge | `Opt sponge -> - Opt_sponge.squeeze sponge) + Opt_sponge.squeeze sponge ) let accumulation_verifier (accumulator_verification_key : _ Types_map.For_step.t) prev_accumulators @@ -1050,19 +1053,19 @@ struct , _ , _ , _ ) - Types.Step.Proof_state.Per_proof.In_circuit.t) = + Types.Step.Proof_state.Per_proof.In_circuit.t ) = let public_input : [ `Field of Field.t | `Packed_bits of Field.t * int ] array = with_label "pack_statement" (fun () -> Spec.pack (module Impl) Types.Wrap.Statement.In_circuit.spec - (Types.Wrap.Statement.In_circuit.to_data statement)) + (Types.Wrap.Statement.In_circuit.to_data statement) ) |> Array.map ~f:(function | `Field (Shifted_value.Type1.Shifted_value x) -> `Field x | `Packed_bits (x, n) -> - `Packed_bits (x, n)) + `Packed_bits (x, n) ) in let sponge = Sponge.create sponge_params in let { Types.Step.Proof_state.Deferred_values.xi; combined_inner_product; b } @@ -1079,7 +1082,7 @@ struct with_label __LOC__ (fun () -> with_label __LOC__ (fun () -> Field.Assert.equal unfinalized.sponge_digest_before_evaluations - sponge_digest_before_evaluations_actual) ; + sponge_digest_before_evaluations_actual ) ; Array.iteri (Vector.to_array unfinalized.deferred_values.bulletproof_challenges) ~f:(fun i c1 -> @@ -1092,7 +1095,7 @@ struct ~else_:(match c2.prechallenge with { inner = c2 } -> c2) in with_label (sprintf "%s:%d" __LOC__ i) (fun () -> - Field.Assert.equal c1 c2))) ; + Field.Assert.equal c1 c2 ) ) ) ; bulletproof_success end diff --git a/src/lib/pickles/tick_field_sponge.ml b/src/lib/pickles/tick_field_sponge.ml index 8933b8c4a8c..a0a5216196f 100644 --- a/src/lib/pickles/tick_field_sponge.ml +++ b/src/lib/pickles/tick_field_sponge.ml @@ -7,4 +7,4 @@ let params = map pasta_p_kimchi ~f:(fun s -> Backend.Tick.Field.of_bits (List.init Backend.Tick.Field.size_in_bits - (testbit (Bigint.of_string s))))) + (testbit (Bigint.of_string s)) ) )) diff --git a/src/lib/pickles/timer.ml b/src/lib/pickles/timer.ml index 2d2a0cb5a18..f71319c6e95 100644 --- a/src/lib/pickles/timer.ml +++ b/src/lib/pickles/timer.ml @@ -8,7 +8,7 @@ let start = Common.when_profiling (fun loc -> r := Time.now () ; - l := loc) + l := loc ) ignore let clock = @@ -18,5 +18,5 @@ let clock = printf "%s -> %s: %s\n%!" !l loc (Time.Span.to_string_hum (Time.diff t !r)) ; r := t ; - l := loc) + l := loc ) ignore diff --git a/src/lib/pickles/tock_field_sponge.ml b/src/lib/pickles/tock_field_sponge.ml index e2f680befba..35d8a3444e8 100644 --- a/src/lib/pickles/tock_field_sponge.ml +++ b/src/lib/pickles/tock_field_sponge.ml @@ -7,4 +7,4 @@ let params = map pasta_q_kimchi ~f:(fun s -> Backend.Tock.Field.of_bits (List.init Backend.Tock.Field.size_in_bits - (testbit (Bigint.of_string s))))) + (testbit (Bigint.of_string s)) ) )) diff --git a/src/lib/pickles/types_map.ml b/src/lib/pickles/types_map.ml index a689b86d3da..1fb789e5471 100644 --- a/src/lib/pickles/types_map.ml +++ b/src/lib/pickles/types_map.ml @@ -172,7 +172,7 @@ module For_step = struct ; var_to_field_elements } } : - (a, b, c, d) Side_loaded.t) : (a, b, c, d) t = + (a, b, c, d) Side_loaded.t ) : (a, b, c, d) t = let index = match ephemeral with | Some { index = `In_circuit i } -> @@ -208,7 +208,7 @@ module For_step = struct ; wrap_domains ; step_domains } : - _ Compiled.t) = + _ Compiled.t ) = { branches ; max_width = None ; max_proofs_verified @@ -276,7 +276,7 @@ let lookup_step_domains : At_most.to_array (At_most.map k.step_data ~f:(fun (ds, _) -> ds.h)) in Vector.init t.permanent.branches ~f:(fun i -> - try a.(i) with _ -> Domain.Pow_2_roots_of_unity 0) ) + try a.(i) with _ -> Domain.Pow_2_roots_of_unity 0 ) ) let max_proofs_verified : type n1. (_, _, n1, _) Tag.t -> (module Nat.Add.Intf with type n = n1) = @@ -309,7 +309,7 @@ let lookup_map (type a b c d) (t : (a, b, c, d) Tag.t) ~self ~default ~(f : [ `Compiled of (a, b, c, d) Compiled.t | `Side_loaded of (a, b, c, d) Side_loaded.t ] - -> _) = + -> _ ) = match Type_equal.Id.same_witness t.id self with | Some _ -> default @@ -338,7 +338,7 @@ let set_ephemeral { Tag.kind; id } eph = | None -> assert false | Some (T (id, d)) -> - T (id, { d with ephemeral = Some eph })) + T (id, { d with ephemeral = Some eph }) ) let add_exn (type a b c d) (tag : (a, b, c, d) Tag.t) (data : (a, b, c, d) Compiled.t) = diff --git a/src/lib/pickles/unfinalized.ml b/src/lib/pickles/unfinalized.ml index fbe123fd84c..14139d44315 100644 --- a/src/lib/pickles/unfinalized.ml +++ b/src/lib/pickles/unfinalized.ml @@ -64,19 +64,19 @@ module Constant = struct ~endo:Endo.Wrap_inner_curve.base ~mds:Tock_field_sponge.params.mds ~field_of_hex: (Core_kernel.Fn.compose Tock.Field.of_bigint - Kimchi_pasta.Pasta.Bigint256.of_hex_string) + Kimchi_pasta.Pasta.Bigint256.of_hex_string ) ~domain: (Plonk_checks.domain (module Tock.Field) (wrap_domains ~proofs_verified:2).h ~shifts:Common.tock_shifts - ~domain_generator:Tock.Field.domain_generator) + ~domain_generator:Tock.Field.domain_generator ) chals evals in { deferred_values = { plonk = { (Plonk_checks.derive_plonk (module Tock.Field) - ~env ~shift chals evals) + ~env ~shift chals evals ) with alpha ; beta diff --git a/src/lib/pickles/util.ml b/src/lib/pickles/util.ml index 235e859ba58..451862cb8a9 100644 --- a/src/lib/pickles/util.ml +++ b/src/lib/pickles/util.ml @@ -25,7 +25,7 @@ let rec absorb : | With_degree_bound -> Array.iter t.unshifted ~f:(fun t -> absorb ~absorb_field ~absorb_scalar ~g1_to_field_elements ~mask_g1_opt - PC (mask_g1_opt t)) ; + PC (mask_g1_opt t) ) ; absorb ~absorb_field ~absorb_scalar ~g1_to_field_elements ~mask_g1_opt PC (mask_g1_opt t.shifted) | ty1 :: ty2 -> @@ -105,7 +105,7 @@ let lowest_128_bits (type f) ~constrain_low_bits ~assert_128_bits Field.Constant.unpack (As_prover.read_var x) |> Fn.flip List.split_n 128 in - (Field.Constant.project lo, Field.Constant.project hi)) + (Field.Constant.project lo, Field.Constant.project hi) ) in assert_128_bits hi ; if constrain_low_bits then assert_128_bits lo ; diff --git a/src/lib/pickles/verification_key.ml b/src/lib/pickles/verification_key.ml index e7d27cb1833..110d0a6ea12 100644 --- a/src/lib/pickles/verification_key.ml +++ b/src/lib/pickles/verification_key.ml @@ -104,7 +104,7 @@ module Stable = struct (Impls.Wrap.Verification_key.t [@to_yojson Verifier_index_json.to_yojson Backend.Tock.Field.to_yojson - Backend.Tick.Field.to_yojson]) + Backend.Tick.Field.to_yojson] ) ; data : Data.t } [@@deriving fields, to_yojson] @@ -139,23 +139,24 @@ module Stable = struct ; complete_add_comm = g c.complete_add_comm ; endomul_scalar_comm = g c.endomul_scalar_comm ; chacha_comm = None - }) + } ) ; shifts = Common.tock_shifts ~log2_size ; lookup_index = None } in { commitments = c; step_domains; data = d; index = t } - include Binable.Of_binable - (Repr.Stable.V2) - (struct - type nonrec t = t + include + Binable.Of_binable + (Repr.Stable.V2) + (struct + type nonrec t = t - let to_binable { commitments; step_domains; data; index = _ } = - { Repr.commitments; data; step_domains } + let to_binable { commitments; step_domains; data; index = _ } = + { Repr.commitments; data; step_domains } - let of_binable r = of_repr (Backend.Tock.Keypair.load_urs ()) r - end) + let of_binable r = of_repr (Backend.Tock.Keypair.load_urs ()) r + end) end end] @@ -182,4 +183,4 @@ let dummy = ; step_domains = [||] ; data = { constraints = rows } } - |> Stable.Latest.of_repr (Kimchi_bindings.Protocol.SRS.Fq.create 1)) + |> Stable.Latest.of_repr (Kimchi_bindings.Protocol.SRS.Fq.create 1) ) diff --git a/src/lib/pickles/verify.ml b/src/lib/pickles/verify.ml index cfc285426ae..20bf5c2360f 100644 --- a/src/lib/pickles/verify.ml +++ b/src/lib/pickles/verify.ml @@ -40,7 +40,7 @@ let verify_heterogenous (ts : Instance.t list) = | _ -> Error (String.concat ~sep:"\n" - (List.map !r ~f:(fun lab -> Lazy.force lab))) + (List.map !r ~f:(fun lab -> Lazy.force lab)) ) in ((fun (lab, b) -> if not b then r := lab :: !r), result) in @@ -58,7 +58,7 @@ let verify_heterogenous (ts : Instance.t list) = ; prev_x_hat = (x_hat1, _) as prev_x_hat *) ; prev_evals = evals - } )) + } ) ) -> Timer.start __LOC__ ; let statement = @@ -113,7 +113,7 @@ let verify_heterogenous (ts : Instance.t list) = ~srs_length_log2:Common.Max_degree.step_log2 ~field_of_hex:(fun s -> Kimchi_pasta.Pasta.Bigint256.of_hex_string s - |> Kimchi_pasta.Pasta.Fp.of_bigint) + |> Kimchi_pasta.Pasta.Fp.of_bigint ) ~domain:tick_domain tick_plonk_minimal tick_combined_evals in let plonk = @@ -137,7 +137,7 @@ let verify_heterogenous (ts : Instance.t list) = let s = create Tick_field_sponge.params in absorb s (Digest.Constant.to_tick_field - statement.proof_state.sponge_digest_before_evaluations) ; + statement.proof_state.sponge_digest_before_evaluations ) ; s in let squeeze () = @@ -177,7 +177,7 @@ let verify_heterogenous (ts : Instance.t list) = ~x_hat:(Double.map evals.evals ~f:(fun e -> e.public_input)) ~old_bulletproof_challenges: (Vector.map ~f:Ipa.Step.compute_challenges - statement.pass_through.old_bulletproof_challenges) + statement.pass_through.old_bulletproof_challenges ) ~r:r_actual ~xi ~zeta ~zetaw ~step_branch_domains:step_domains in let check_eq lab x y = @@ -185,7 +185,7 @@ let verify_heterogenous (ts : Instance.t list) = ( lazy (sprintf !"%s: %{sexp:Tick_field.t} != %{sexp:Tick_field.t}" - lab x y) + lab x y ) , Tick_field.equal x y ) in Timer.clock __LOC__ ; @@ -201,7 +201,7 @@ let verify_heterogenous (ts : Instance.t list) = combined_inner_product ~shift:Shifts.tick1 , combined_inner_product_actual ) ] ; - plonk) + plonk ) in let open Backend.Tock.Proof in let open Promise.Let_syntax in @@ -210,22 +210,21 @@ let verify_heterogenous (ts : Instance.t list) = (List.map ts ~f:(fun (T (_, _, _, _, T t)) -> ( t.statement.proof_state.me_only.challenge_polynomial_commitment , Ipa.Step.compute_challenges - t.statement.proof_state.deferred_values.bulletproof_challenges ))) + t.statement.proof_state.deferred_values.bulletproof_challenges ) ) + ) in Common.time "batch_step_dlog_check" (fun () -> - check (lazy "batch_step_dlog_check", accumulator_check)) ; + check (lazy "batch_step_dlog_check", accumulator_check) ) ; let%map dlog_check = batch_verify (List.map2_exn ts in_circuit_plonks ~f:(fun (T - ( ( module - Max_proofs_verified ) - , ( module - A_value ) + ( (module Max_proofs_verified) + , (module A_value) , key , app_state - , T t )) + , T t ) ) plonk -> let prepared_statement : _ Types.Wrap.Statement.In_circuit.t = @@ -233,7 +232,7 @@ let verify_heterogenous (ts : Instance.t list) = Common.hash_step_me_only ~app_state:A_value.to_field_elements (Reduced_me_only.Step.prepare ~dlog_plonk_index:key.commitments - { t.statement.pass_through with app_state }) + { t.statement.pass_through with app_state } ) ; proof_state = { t.statement.proof_state with deferred_values = @@ -241,7 +240,7 @@ let verify_heterogenous (ts : Instance.t list) = ; me_only = Common.hash_dlog_me_only Max_proofs_verified.n (Reduced_me_only.Wrap.prepare - t.statement.proof_state.me_only) + t.statement.proof_state.me_only ) } } in @@ -258,14 +257,14 @@ let verify_heterogenous (ts : Instance.t list) = { Challenge_polynomial.challenges = Vector.to_array (Ipa.Wrap.compute_challenges cs) ; commitment = g - }) + } ) (Vector.extend_exn t.statement.pass_through .challenge_polynomial_commitments Max_proofs_verified.n - (Lazy.force Dummy.Ipa.Wrap.sg)) - t.statement.proof_state.me_only.old_bulletproof_challenges)) - ))) + (Lazy.force Dummy.Ipa.Wrap.sg) ) + t.statement.proof_state.me_only.old_bulletproof_challenges ) ) + ) ) ) in Common.time "dlog_check" (fun () -> check (lazy "dlog_check", dlog_check)) ; match result () with @@ -280,4 +279,4 @@ let verify (type a n) (max_proofs_verified : (module Nat.Intf with type n = n)) (key : Verification_key.t) (ts : (a * (n, n) Proof.t) list) = verify_heterogenous (List.map ts ~f:(fun (x, p) -> - Instance.T (max_proofs_verified, a_value, key, x, p))) + Instance.T (max_proofs_verified, a_value, key, x, p) ) ) diff --git a/src/lib/pickles/wrap.ml b/src/lib/pickles/wrap.ml index 9cc48274a38..b402aaa5501 100644 --- a/src/lib/pickles/wrap.ml +++ b/src/lib/pickles/wrap.ml @@ -71,7 +71,7 @@ let combined_inner_product (type actual_proofs_verified) ~env ~domain ~ft_eval1 ~last:Array.last ~evaluation_point:pt ~shifted_pow:(fun deg x -> Pcs_batch.pow ~one ~mul x - Int.(Max_degree.step - (deg mod Max_degree.step))) + Int.(Max_degree.step - (deg mod Max_degree.step)) ) v b in let open Tick.Field in @@ -83,14 +83,14 @@ module Step_acc = Tock.Inner_curve.Affine (* The prover for wrapping a proof *) let wrap (type actual_proofs_verified max_proofs_verified - max_local_max_proofs_verifieds) + max_local_max_proofs_verifieds ) ~(max_proofs_verified : max_proofs_verified Nat.t) (module Max_local_max_proof_verifieds : Hlist.Maxes.S with type ns = max_local_max_proofs_verifieds - and type length = max_proofs_verified) + and type length = max_proofs_verified ) (( module Req ) : - (max_proofs_verified, max_local_max_proofs_verifieds) Requests.Wrap.t) + (max_proofs_verified, max_local_max_proofs_verifieds) Requests.Wrap.t ) ~dlog_plonk_index wrap_main to_field_elements ~step_vk ~step_domains ~wrap_domains ~step_plonk_indices pk ({ statement = prev_statement; prev_evals; proof; index = which_index } : @@ -102,7 +102,7 @@ let wrap , ( (Tock.Field.t, Tock.Field.t array) Plonk_types.All_evals.t , max_proofs_verified ) Vector.t ) - P.Base.Step.t) = + P.Base.Step.t ) = let prev_me_only = let module M = H1.Map (P.Base.Me_only.Wrap) (P.Base.Me_only.Wrap.Prepared) @@ -121,13 +121,11 @@ let wrap might not be correct *) Common.hash_step_me_only ~app_state:to_field_elements (P.Base.Me_only.Step.prepare ~dlog_plonk_index - prev_statement.proof_state.me_only) + prev_statement.proof_state.me_only ) } ; pass_through = (let module M = - H1.Map - (P.Base.Me_only.Wrap.Prepared) - (E01 (Digest.Constant)) + H1.Map (P.Base.Me_only.Wrap.Prepared) (E01 (Digest.Constant)) (struct let f (type n) (m : n P.Base.Me_only.Wrap.Prepared.t) = Common.hash_dlog_me_only @@ -136,7 +134,7 @@ let wrap end) in let module V = H1.To_vector (Digest.Constant) in - V.f Max_local_max_proof_verifieds.length (M.f prev_me_only)) + V.f Max_local_max_proof_verifieds.length (M.f prev_me_only) ) } in let handler (Snarky_backendless.Request.With { request; respond }) = @@ -147,9 +145,7 @@ let wrap k prev_evals | Step_accs -> let module M = - H1.Map - (P.Base.Me_only.Wrap.Prepared) - (E01 (Step_acc)) + H1.Map (P.Base.Me_only.Wrap.Prepared) (E01 (Step_acc)) (struct let f : type a. a P.Base.Me_only.Wrap.Prepared.t -> Step_acc.t = fun t -> t.challenge_polynomial_commitment @@ -192,9 +188,7 @@ let wrap let o = let sgs = let module M = - H1.Map - (P.Base.Me_only.Wrap.Prepared) - (E01 (Tick.Curve.Affine)) + H1.Map (P.Base.Me_only.Wrap.Prepared) (E01 (Tick.Curve.Affine)) (struct let f : type n. n P.Base.Me_only.Wrap.Prepared.t -> _ = fun t -> t.challenge_polynomial_commitment @@ -208,7 +202,7 @@ let wrap map2 (Vector.trim sgs lte) prev_challenges ~f:(fun commitment cs -> { Tick.Proof.Challenge_polynomial.commitment ; challenges = Vector.to_array cs - }) + } ) |> to_list) public_input proof in @@ -270,7 +264,7 @@ let wrap ~srs_length_log2:Common.Max_degree.step_log2 ~field_of_hex:(fun s -> Kimchi_pasta.Pasta.Bigint256.of_hex_string s - |> Kimchi_pasta.Pasta.Fp.of_bigint) + |> Kimchi_pasta.Pasta.Fp.of_bigint ) ~domain:tick_domain tick_plonk_minimal tick_combined_evals in let combined_inner_product = @@ -288,14 +282,14 @@ let wrap proof.openings.proof.challenge_polynomial_commitment ; old_bulletproof_challenges = Vector.map prev_statement.proof_state.unfinalized_proofs ~f:(fun t -> - t.deferred_values.bulletproof_challenges) + t.deferred_values.bulletproof_challenges ) } in let chal = Challenge.Constant.of_tick_field in let new_bulletproof_challenges, b = let prechals = Array.map (O.opening_prechallenges o) ~f:(fun x -> - Scalar_challenge.map ~f:Challenge.Constant.of_tick_field x) + Scalar_challenge.map ~f:Challenge.Constant.of_tick_field x ) in let chals = Array.map prechals ~f:(fun x -> Ipa.Step.compute_challenge x) @@ -308,7 +302,7 @@ let wrap in let prechals = Array.map prechals ~f:(fun x -> - { Bulletproof_challenge.prechallenge = x }) + { Bulletproof_challenge.prechallenge = x } ) in (prechals, b) in @@ -351,8 +345,7 @@ let wrap let (T (input, conv)) = Impls.Wrap.input () in Common.time "wrap proof" (fun () -> Impls.Wrap.generate_witness_conv - ~f: - (fun { Impls.Wrap.Proof_inputs.auxiliary_inputs; public_inputs } () -> + ~f:(fun { Impls.Wrap.Proof_inputs.auxiliary_inputs; public_inputs } () -> Backend.Tock.Proof.create_async ~primary:public_inputs ~auxiliary:auxiliary_inputs pk ~message: @@ -360,24 +353,24 @@ let wrap (Vector.extend_exn prev_statement.proof_state.me_only .challenge_polynomial_commitments max_proofs_verified - (Lazy.force Dummy.Ipa.Wrap.sg)) + (Lazy.force Dummy.Ipa.Wrap.sg) ) me_only_prepared.old_bulletproof_challenges ~f:(fun sg chals -> { Tock.Proof.Challenge_polynomial.commitment = sg ; challenges = Vector.to_array chals - }) - |> Vector.to_list )) + } ) + |> Vector.to_list ) ) [ input ] ~return_typ:(Snarky_backendless.Typ.unit ()) (fun x () : unit -> - Impls.Wrap.handle (fun () : unit -> wrap_main (conv x)) handler) + Impls.Wrap.handle (fun () : unit -> wrap_main (conv x)) handler ) { pass_through = prev_statement_with_hashes.proof_state.me_only ; proof_state = { next_statement.proof_state with me_only = Common.hash_dlog_me_only max_proofs_verified me_only_prepared } - }) + } ) in ( { proof = next_proof ; statement = Types.Wrap.Statement.to_minimal next_statement @@ -386,7 +379,7 @@ let wrap Double.map2 x_hat proof.openings.evals ~f:(fun p e -> { Plonk_types.All_evals.With_public_input.public_input = p ; evals = e - }) + } ) ; ft_eval1 = proof.openings.ft_eval1 } } diff --git a/src/lib/pickles/wrap_domains.ml b/src/lib/pickles/wrap_domains.ml index d99081fd9d4..1c8a61b5fe3 100644 --- a/src/lib/pickles/wrap_domains.ml +++ b/src/lib/pickles/wrap_domains.ml @@ -10,9 +10,7 @@ module Make (A : T0) (A_value : T0) = struct let prev (type xs ys ws hs) ~self ~(choices : (xs, ys, ws, hs) H4.T(I).t) = let module M_inner = - H4.Map - (Tag) - (E04 (Domains)) + H4.Map (Tag) (E04 (Domains)) (struct let f : type a b c d. (a, b, c, d) Tag.t -> Domains.t = fun t -> @@ -24,24 +22,21 @@ module Make (A : T0) (A_value : T0) = struct Common.wrap_domains ~proofs_verified: (Nat.to_int - (Nat.Add.n d.permanent.max_proofs_verified)) + (Nat.Add.n d.permanent.max_proofs_verified) ) | `Compiled d -> - fun () -> d.wrap_domains) + fun () -> d.wrap_domains ) () end) in let module M = - H4.Map - (I) - (H4.T - (E04 (Domains))) - (struct - let f : - type vars values env widths heights. - (vars, values, widths, heights) I.t - -> (vars, values, widths, heights) H4.T(E04(Domains)).t = - fun rule -> M_inner.f rule.prevs - end) + H4.Map (I) (H4.T (E04 (Domains))) + (struct + let f : + type vars values env widths heights. + (vars, values, widths, heights) I.t + -> (vars, values, widths, heights) H4.T(E04(Domains)).t = + fun rule -> M_inner.f rule.prevs + end) in M.f choices @@ -53,13 +48,13 @@ module Make (A : T0) (A_value : T0) = struct in let dummy_step_widths = Vector.init num_choices ~f:(fun _ -> - Nat.to_int (Nat.Add.n max_proofs_verified)) + Nat.to_int (Nat.Add.n max_proofs_verified) ) in let dummy_step_keys = lazy (Vector.init num_choices ~f:(fun _ -> let g = Backend.Tock.Inner_curve.(to_affine_exn one) in - Verification_key.dummy_commitments g)) + Verification_key.dummy_commitments g ) ) in let prev_domains = prev ~self ~choices in Timer.clock __LOC__ ; diff --git a/src/lib/pickles/wrap_main.ml b/src/lib/pickles/wrap_main.ml index e186c284e87..31aa0e5c2fd 100644 --- a/src/lib/pickles/wrap_main.ml +++ b/src/lib/pickles/wrap_main.ml @@ -42,7 +42,7 @@ let pad_domains (type prev_varss prev_valuess branches max_proofs_verified) (module Max_proofs_verified : Nat.Intf with type n = max_proofs_verified) (pi_branches : (prev_varss, branches) Length.t) (prev_wrap_domains : - (prev_varss, prev_valuess, _, _) H4.T(H4.T(E04(Domains))).t) : + (prev_varss, prev_valuess, _, _) H4.T(H4.T(E04(Domains))).t ) : ((Domains.t, branches) Vector.t, max_proofs_verified) Vector.t = let module Ds = struct type t = (Domains.t, Max_proofs_verified.n) Vector.t @@ -56,20 +56,17 @@ let pad_domains (type prev_varss prev_valuess branches max_proofs_verified) let module M = H4.Map (H4.T - (E04 - (Domains))) - (E04 (Ds)) - (struct - module H = H4.T (E04 (Domains)) + (E04 (Domains))) (E04 (Ds)) + (struct + module H = H4.T (E04 (Domains)) - let f : type a b c d. (a, b, c, d) H4.T(E04(Domains)).t -> Ds.t - = - fun domains -> - let (T (len, pi)) = H.length domains in - let module V = H4.To_vector (Domains) in - Vector.extend_exn (V.f pi domains) Max_proofs_verified.n - dummy_domains - end) + let f : type a b c d. (a, b, c, d) H4.T(E04(Domains)).t -> Ds.t = + fun domains -> + let (T (len, pi)) = H.length domains in + let module V = H4.To_vector (Domains) in + Vector.extend_exn (V.f pi domains) Max_proofs_verified.n + dummy_domains + end) in M.f prev_wrap_domains in @@ -92,7 +89,7 @@ let pack_statement max_proofs_verified t = Spec.pack (module Impl) (Types.Step.Statement.spec max_proofs_verified Backend.Tock.Rounds.n) - (Types.Step.Statement.to_data t)) + (Types.Step.Statement.to_data t) ) let shifts ~log2_size = Common.tock_shifts ~log2_size |> Plonk_types.Shifts.map ~f:Impl.Field.constant @@ -107,11 +104,11 @@ let split_field_typ : (Field.t * Boolean.var, Field.Constant.t) Typ.t = let n = Bigint.of_field x in let is_odd = Bigint.test_bit n 0 in let y = Field.Constant.((if is_odd then x - one else x) / of_int 2) in - (y, is_odd)) + (y, is_odd) ) ~back:(fun (hi, is_odd) -> let open Field.Constant in let x = hi + hi in - if is_odd then x + one else x) + if is_odd then x + one else x ) (* Split a field element into its high bits (packed) and the low bit. @@ -127,7 +124,7 @@ let split_field (x : Field.t) : Field.t * Boolean.var = let n = Bigint.of_field x in let is_odd = Bigint.test_bit n 0 in let y = Field.Constant.((if is_odd then x - one else x) / of_int 2) in - (y, is_odd)) + (y, is_odd) ) in Field.(Assert.equal ((of_int 2 * y) + (is_odd :> t)) x) ; res @@ -135,18 +132,18 @@ let split_field (x : Field.t) : Field.t * Boolean.var = (* The SNARK function for wrapping any proof coming from the given set of keys *) let wrap_main (type max_proofs_verified branches prev_varss prev_valuess env - max_local_max_proofs_verifieds) + max_local_max_proofs_verifieds ) (full_signature : ( max_proofs_verified , branches , max_local_max_proofs_verifieds ) - Full_signature.t) (pi_branches : (prev_varss, branches) Hlist.Length.t) + Full_signature.t ) (pi_branches : (prev_varss, branches) Hlist.Length.t) (step_keys : - (Wrap_main_inputs.Inner_curve.Constant.t index, branches) Vector.t Lazy.t) - (step_widths : (int, branches) Vector.t) + (Wrap_main_inputs.Inner_curve.Constant.t index, branches) Vector.t Lazy.t + ) (step_widths : (int, branches) Vector.t) (step_domains : (Domains.t, branches) Vector.t) (prev_wrap_domains : - (prev_varss, prev_valuess, _, _) H4.T(H4.T(E04(Domains))).t) + (prev_varss, prev_valuess, _, _) H4.T(H4.T(E04(Domains))).t ) (module Max_proofs_verified : Nat.Add.Intf with type n = max_proofs_verified) : (max_proofs_verified, max_local_max_proofs_verifieds) Requests.Wrap.t @@ -160,7 +157,7 @@ let wrap_main , _ , _ ) Types.Wrap.Statement.In_circuit.t - -> unit) = + -> unit ) = Timer.clock __LOC__ ; let T = Max_proofs_verified.eq in let branches = Hlist.Length.to_nat pi_branches in @@ -198,7 +195,7 @@ let wrap_main , _ , _ , _ ) - Types.Wrap.Statement.In_circuit.t) = + Types.Wrap.Statement.In_circuit.t ) = with_label __LOC__ (fun () -> let which_branch = One_hot_vector.of_index which_branch ~length:branches @@ -212,18 +209,18 @@ let wrap_main Max_proofs_verified.n (Shifted_value.Type2.typ Field.typ) in - exists typ ~request:(fun () -> Req.Proof_state)) + exists typ ~request:(fun () -> Req.Proof_state) ) in let step_plonk_index = with_label __LOC__ (fun () -> choose_key which_branch (Vector.map (Lazy.force step_keys) - ~f:(Plonk_verification_key_evals.map ~f:Inner_curve.constant))) + ~f:(Plonk_verification_key_evals.map ~f:Inner_curve.constant) ) ) in let prev_step_accs = with_label __LOC__ (fun () -> exists (Vector.typ Inner_curve.typ Max_proofs_verified.n) - ~request:(fun () -> Req.Step_accs)) + ~request:(fun () -> Req.Step_accs) ) in let old_bp_chals = with_label __LOC__ (fun () -> @@ -245,23 +242,23 @@ let wrap_main H1.Map (H1.Tuple2 (Nat) (Challenges_vector)) (E01 (Old_bulletproof_chals)) - (struct - let f (type n) - ((n, v) : n H1.Tuple2(Nat)(Challenges_vector).t) = - Old_bulletproof_chals.T (n, v) - end) + (struct + let f (type n) + ((n, v) : n H1.Tuple2(Nat)(Challenges_vector).t) = + Old_bulletproof_chals.T (n, v) + end) in let module V = H1.To_vector (Old_bulletproof_chals) in Z.f Max_widths_by_slot.maxes (exists typ ~request:(fun () -> Req.Old_bulletproof_challenges)) |> M.f - |> V.f Max_widths_by_slot.length) + |> V.f Max_widths_by_slot.length ) in let domainses = with_label __LOC__ (fun () -> pad_domains (module Max_proofs_verified) - pi_branches prev_wrap_domains) + pi_branches prev_wrap_domains ) in let new_bulletproof_challenges = with_label __LOC__ (fun () -> @@ -290,20 +287,20 @@ let wrap_main Pseudo.Domain.to_domain ~shifts ~domain_generator ( which_branch , Vector.map ~f:(fun ds -> ds.h) possible_wrap_domains - )) + ) ) in let max_quot_sizes = Vector.map domainses ~f:(fun ds -> ( which_branch , Vector.map ds ~f:(fun d -> - Common.max_quot_size_int (Domain.size d.h)) )) + Common.max_quot_size_int (Domain.size d.h) ) ) ) in let actual_proofs_verifieds = padded |> Vector.map ~f:(fun proofs_verifieds_in_slot -> Pseudo.choose (which_branch, proofs_verifieds_in_slot) - ~f:Field.of_int) + ~f:Field.of_int ) in Vector.mapn [ (* This is padded to max_proofs_verified for the benefit of wrapping with dummy unfinalized proofs *) @@ -342,7 +339,7 @@ let wrap_main *) let (T ( max_local_max_proofs_verified - , old_bulletproof_challenges )) = + , old_bulletproof_challenges ) ) = old_bulletproof_challenges in let finalized, chals = @@ -352,12 +349,12 @@ let wrap_main ~max_quot_size ~actual_proofs_verified ~domain:(wrap_domain :> _ Plonk_checks.plonk_domain) ~sponge ~old_bulletproof_challenges deferred_values - evals) + evals ) in Boolean.(Assert.any [ finalized; not should_finalize ]) ; - chals) + chals ) in - chals) + chals ) in let prev_statement = let prev_me_onlys = @@ -366,7 +363,7 @@ let wrap_main hash_me_only max_local_max_proofs_verified { challenge_polynomial_commitment = sacc ; old_bulletproof_challenges = chals - }) + } ) in { Types.Step.Statement.pass_through = prev_me_onlys ; proof_state = prev_proof_state @@ -385,18 +382,18 @@ let wrap_main ~shift x with | Shifted_value x -> - x) + x ) ~back:(fun x -> Shifted_value.Type1.to_field (module Backend.Tick.Field) - ~shift (Shifted_value x)) + ~shift (Shifted_value x) ) (* When reading, unshift *) |> Typ.transport_var (* For the var, we just wrap the now shifted underlying value. *) ~there:(fun (Shifted_value.Type1.Shifted_value x) -> x) ~back:(fun x -> Shifted_value x) ) Inner_curve.typ - ~length:(Nat.to_int Backend.Tick.Rounds.n)) + ~length:(Nat.to_int Backend.Tick.Rounds.n) ) ~request:(fun () -> Req.Openings_proof) in let ( sponge_digest_before_evaluations_actual @@ -407,8 +404,8 @@ let wrap_main (Plonk_types.Messages.typ ~dummy:Inner_curve.Params.one Inner_curve.typ ~bool:Boolean.typ ~commitment_lengths: - (Commitment_lengths.create ~of_int:Fn.id)) - ~request:(fun () -> Req.Messages)) + (Commitment_lengths.create ~of_int:Fn.id) ) + ~request:(fun () -> Req.Messages) ) in let sponge = Opt.create sponge_params in with_label __LOC__ (fun () -> @@ -423,13 +420,13 @@ let wrap_main | `Field (Shifted_value x) -> `Field (split_field x) | `Packed_bits (x, n) -> - `Packed_bits (x, n))) + `Packed_bits (x, n) ) ) ~sg_old:prev_step_accs ~advice:{ b; combined_inner_product } - ~messages ~which_branch ~openings_proof ~plonk) + ~messages ~which_branch ~openings_proof ~plonk ) in with_label __LOC__ (fun () -> - Boolean.Assert.is_true bulletproof_success) ; + Boolean.Assert.is_true bulletproof_success ) ; with_label __LOC__ (fun () -> Field.Assert.equal me_only_digest (hash_me_only Max_proofs_verified.n @@ -437,18 +434,18 @@ let wrap_main .challenge_polynomial_commitment = openings_proof.challenge_polynomial_commitment ; old_bulletproof_challenges = new_bulletproof_challenges - })) ; + } ) ) ; with_label __LOC__ (fun () -> Field.Assert.equal sponge_digest_before_evaluations - sponge_digest_before_evaluations_actual) ; + sponge_digest_before_evaluations_actual ) ; Array.iter2_exn bulletproof_challenges_actual (Vector.to_array bulletproof_challenges) ~f:(fun { prechallenge = { inner = x1 } } ({ prechallenge = { inner = x2 } } : - _ SC.t Bulletproof_challenge.t) - -> with_label __LOC__ (fun () -> Field.Assert.equal x1 x2)) ; - ()) + _ SC.t Bulletproof_challenge.t ) + -> with_label __LOC__ (fun () -> Field.Assert.equal x1 x2) ) ; + () ) in Timer.clock __LOC__ ; ((module Req), main) diff --git a/src/lib/pickles/wrap_main_inputs.ml b/src/lib/pickles/wrap_main_inputs.ml index 63bfa7b79d6..99582bd14a4 100644 --- a/src/lib/pickles/wrap_main_inputs.ml +++ b/src/lib/pickles/wrap_main_inputs.ml @@ -20,7 +20,7 @@ let unrelated_g = unstage (group_map (module Me.Field) - ~a:Me.Inner_curve.Params.a ~b:Me.Inner_curve.Params.b) + ~a:Me.Inner_curve.Params.a ~b:Me.Inner_curve.Params.b ) and str = Fn.compose bits_to_bytes Me.Field.to_bits in fun (x, y) -> group_map (field_random_oracle (str x ^ str y)) @@ -78,9 +78,9 @@ module Input_domain = struct time "lagrange" (fun () -> Array.init domain_size ~f:(fun i -> (Kimchi_bindings.Protocol.SRS.Fp.lagrange_commitment - (Tick.Keypair.load_urs ()) domain_size i) + (Tick.Keypair.load_urs ()) domain_size i ) .unshifted.(0) - |> Common.finite_exn)) + |> Common.finite_exn ) ) let domain = Domain.Pow_2_roots_of_unity 7 end @@ -169,7 +169,7 @@ module Inner_curve = struct let scale t bs = with_label __LOC__ (fun () -> - T.scale t (Bitstring_lib.Bitstring.Lsb_first.of_list bs)) + T.scale t (Bitstring_lib.Bitstring.Lsb_first.of_list bs) ) let to_field_elements (x, y) = [ x; y ] @@ -185,7 +185,7 @@ module Inner_curve = struct C.scale (C.of_affine (read typ t)) (Other.Field.inv - (Other.Field.of_bits (List.map ~f:(read Boolean.typ) bs))) + (Other.Field.of_bits (List.map ~f:(read Boolean.typ) bs)) ) |> C.to_affine_exn) in assert_equal t (scale res bs) ; diff --git a/src/lib/pickles/wrap_proof.ml b/src/lib/pickles/wrap_proof.ml index 0a40c34de29..7f5b1a4c3e3 100644 --- a/src/lib/pickles/wrap_proof.ml +++ b/src/lib/pickles/wrap_proof.ml @@ -44,11 +44,11 @@ let typ : (Checked.t, Constant.t) Typ.t = Shifted_value.Type2.of_field (module Tock.Field) ~shift x with | Shifted_value x -> - x) + x ) ~back:(fun x -> Shifted_value.Type2.to_field (module Tock.Field) - ~shift (Shifted_value x)) + ~shift (Shifted_value x) ) (* When reading, unshift *) |> Typ.transport_var (* For the var, we just wrap the now shifted underlying value. *) diff --git a/src/lib/pickles/wrap_verifier.ml b/src/lib/pickles/wrap_verifier.ml index 62852fd3596..6aeb8442709 100644 --- a/src/lib/pickles/wrap_verifier.ml +++ b/src/lib/pickles/wrap_verifier.ml @@ -31,7 +31,7 @@ let challenge_polynomial ~one ~add ~mul chals = done ; !r in - prod (fun i -> one + (chals.(i) * pow_two_pows.(k - 1 - i)))) + prod (fun i -> one + (chals.(i) * pow_two_pows.(k - 1 - i))) ) module Make (Inputs : Inputs @@ -85,7 +85,7 @@ struct Array.iteri gs ~f:(fun i (fin, g) -> as_prover As_prover.(fun () -> printf "fin=%b %!" (read Boolean.typ fin)) ; - ksprintf print_g "%s[%d]" lab i g) + ksprintf print_g "%s[%d]" lab i g ) let print_chal lab x = if debug then @@ -100,7 +100,7 @@ struct let print_bool lab x = if debug then as_prover (fun () -> - printf "%s: %b\n%!" lab (As_prover.read Boolean.typ x)) + printf "%s: %b\n%!" lab (As_prover.read Boolean.typ x) ) module Challenge = Challenge.Make (Impl) module Digest = Digest.Make (Impl) @@ -142,7 +142,7 @@ struct let prechallenges = Array.map gammas ~f:(fun gammas_i -> absorb (PC :: PC) gammas_i ; - squeeze_scalar sponge) + squeeze_scalar sponge ) in let term_and_challenge (l, r) pre = let left_term = Scalar_challenge.endo_inv l pre in @@ -199,7 +199,7 @@ struct let g = Inner_curve.Constant.of_affine g in Inner_curve.constant g | _ -> - assert false) + assert false ) |> Vector.map2 (which_branch :> (Boolean.var, n) Vector.t) ~f:(fun b (x, y) -> Field.((b :> t) * x, (b :> t) * y)) @@ -240,15 +240,15 @@ struct base_and_correction d.h else Vector.map domains ~f:(fun (ds : Domains.t) -> - base_and_correction ds.h) + base_and_correction ds.h ) |> Vector.map2 (which_branch :> (Boolean.var, n) Vector.t) ~f:(fun b pr -> Double.map pr ~f:(fun (x, y) -> - Field.((b :> t) * x, (b :> t) * y))) + Field.((b :> t) * x, (b :> t) * y) ) ) |> Vector.reduce_exn ~f:(Double.map2 ~f:(Double.map2 ~f:Field.( + ))) - |> Double.map ~f:(Double.map ~f:(Util.seal (module Impl)))) + |> Double.map ~f:(Double.map ~f:(Util.seal (module Impl))) ) let h_precomp = Lazy.map ~f:Inner_curve.Scaling_precomputation.create Generators.h @@ -273,8 +273,8 @@ struct Field.( (x * x * x) + (constant Inner_curve.Params.a * x) - + constant Inner_curve.Params.b)) - |> unstage) + + constant Inner_curve.Params.b) ) + |> unstage ) in fun x -> Lazy.force f x @@ -323,16 +323,16 @@ struct ~else_: ((* In this branch, the accumulator was zero, so there is no harm in putting the potentially junk underlying point here. *) - Point.underlying p)) + Point.underlying p ) ) ~else_:acc.point) in let non_zero = Boolean.(keep &&& Point.finite p ||| acc.non_zero) in - { Curve_opt.non_zero; point }) + { Curve_opt.non_zero; point } ) ~xi ~init:(fun (keep, p) -> { non_zero = Boolean.(keep &&& Point.finite p) ; point = Point.underlying p - }) + } ) without_bound with_bound in Boolean.Assert.is_true non_zero ; @@ -345,13 +345,13 @@ struct ~(xi : Scalar_challenge.t) ~(advice : Other_field.Packed.t Shifted_value.Type1.t - Types.Step.Bulletproof.Advice.t) + Types.Step.Bulletproof.Advice.t ) ~polynomials:(without_degree_bound, with_degree_bound) ~openings_proof: ({ lr; delta; z_1; z_2; challenge_polynomial_commitment } : ( Inner_curve.t , Other_field.Packed.t Shifted_value.Type1.t ) - Openings.Bulletproof.t) = + Openings.Bulletproof.t ) = with_label __LOC__ (fun () -> Other_field.Packed.absorb_shifted sponge advice.combined_inner_product ; (* combined_inner_product should be equal to @@ -395,7 +395,7 @@ struct in z_1_g_plus_b_u + z2_h in - (`Success (equal_g lhs rhs), challenges)) + (`Success (equal_g lhs rhs), challenges) ) module Opt = struct include Opt_sponge.Make (Impl) (Wrap_main_inputs.Sponge.Permutation) @@ -414,7 +414,7 @@ struct ~g1_to_field_elements:(fun (b, (x, y)) -> [ (b, x); (b, y) ]) ~absorb_scalar:(fun x -> Opt.absorb sponge (Boolean.true_, x)) ~mask_g1_opt:(fun ((finite : Boolean.var), (x, y)) -> - (Boolean.true_, Field.((finite :> t) * x, (finite :> t) * y))) + (Boolean.true_, Field.((finite :> t) * x, (finite :> t) * y)) ) ty t module Pseudo = Pseudo.Make (Impl) @@ -453,9 +453,9 @@ struct (m2 : (_, Scalar_challenge.t) Plonk.Minimal.t) = iter2 m1 m2 ~chal:(fun c1 c2 -> Field.Assert.equal c1 c2) - ~scalar_chal: - (fun ({ inner = t1 } : _ Import.Scalar_challenge.t) - ({ inner = t2 } : Scalar_challenge.t) -> Field.Assert.equal t1 t2) + ~scalar_chal:(fun ({ inner = t1 } : _ Import.Scalar_challenge.t) + ({ inner = t2 } : Scalar_challenge.t) -> + Field.Assert.equal t1 t2 ) let incrementally_verify_proof (type b) (module Max_proofs_verified : Nat.Add.Intf with type n = b) ~step_widths @@ -463,7 +463,7 @@ struct ~sponge ~(public_input : [ `Field of Field.t * Boolean.var | `Packed_bits of Field.t * int ] - array) ~(sg_old : (_, Max_proofs_verified.n) Vector.t) ~advice + array ) ~(sg_old : (_, Max_proofs_verified.n) Vector.t) ~advice ~(messages : _ Messages.t) ~which_branch ~openings_proof ~(plonk : _ Types.Wrap.Proof_state.Deferred_values.Plonk.In_circuit.t) = let T = Max_proofs_verified.eq in @@ -472,7 +472,7 @@ struct | `Field (x, b) -> [| (x, Field.size_in_bits); ((b :> Field.t), 1) |] | `Packed_bits (x, n) -> - [| (x, n) |]) + [| (x, n) |] ) in let sg_old = with_label __LOC__ (fun () -> @@ -482,9 +482,9 @@ struct Vector.map2 (ones_vector (module Impl) - ~first_zero:actual_width Max_proofs_verified.n) + ~first_zero:actual_width Max_proofs_verified.n ) sg_old - ~f:(fun keep sg -> [| (keep, sg) |])) + ~f:(fun keep sg -> [| (keep, sg) |]) ) in with_label __LOC__ (fun () -> let sample () = Opt.challenge sponge in @@ -507,7 +507,7 @@ struct `Add_with_correction ( (x, n) , lagrange_with_correction ~input_length:n ~domain - i ))) + i ) ) ) in let correction = with_label __LOC__ (fun () -> @@ -516,8 +516,8 @@ struct | `Cond_add _ -> None | `Add_with_correction (_, (_, corr)) -> - Some corr)) - ~f:Ops.add_fast) + Some corr ) ) + ~f:Ops.add_fast ) in with_label __LOC__ (fun () -> Array.foldi terms ~init:correction ~f:(fun i acc term -> @@ -525,12 +525,12 @@ struct | `Cond_add (b, g) -> with_label __LOC__ (fun () -> Inner_curve.if_ b ~then_:(Ops.add_fast g acc) - ~else_:acc) + ~else_:acc ) | `Add_with_correction ((x, num_bits), (g, _)) -> Ops.add_fast acc (Ops.scale_fast2' (module Other_field.With_top_bit0) - g x ~num_bits)))) + g x ~num_bits ) ) ) ) |> Inner_curve.negate in let without = Type.Without_degree_bound in @@ -585,7 +585,7 @@ struct with_label __LOC__ (fun () -> Common.ft_comm ~add:Ops.add_fast ~scale:scale_fast ~negate:Inner_curve.negate ~endoscale:Scalar_challenge.endo - ~verification_key:m ~plonk ~alpha ~t_comm) + ~verification_key:m ~plonk ~alpha ~t_comm ) in let bulletproof_challenges = (* This sponge needs to be initialized with (some derivative of) @@ -615,12 +615,12 @@ struct (snd (Columns.add Permuts_minus_1.n)) |> Vector.map ~f:(Array.map ~f:(fun g -> (Boolean.true_, g))) ) (snd - (Max_proofs_verified.add num_commitments_without_degree_bound)) + (Max_proofs_verified.add num_commitments_without_degree_bound) ) in check_bulletproof ~pcs_batch: (Common.dlog_pcs_batch - (Max_proofs_verified.add num_commitments_without_degree_bound)) + (Max_proofs_verified.add num_commitments_without_degree_bound) ) ~sponge:sponge_before_evaluations ~xi ~advice ~openings_proof ~polynomials: ( Vector.map without_degree_bound @@ -634,25 +634,25 @@ struct ; zeta = plonk.zeta } { alpha; beta; gamma; zeta } ; - (sponge_digest_before_evaluations, bulletproof_challenges)) + (sponge_digest_before_evaluations, bulletproof_challenges) ) module Split_evaluations = struct let combine_split_evaluations' s = Pcs_batch.combine_split_evaluations s ~mul:(fun (keep, x) (y : Field.t) -> (keep, Field.(y * x))) ~mul_and_add:(fun ~acc ~xi (keep, fx) -> - Field.if_ keep ~then_:Field.(fx + (xi * acc)) ~else_:acc) + Field.if_ keep ~then_:Field.(fx + (xi * acc)) ~else_:acc ) ~init:(fun (_, fx) -> fx) ~shifted_pow: (Pseudo.Degree_bound.shifted_pow - ~crs_max_degree:Common.Max_degree.wrap) + ~crs_max_degree:Common.Max_degree.wrap ) end let mask_evals (type n) ~(lengths : (int, n) Vector.t Evals.t) (choice : n One_hot_vector.t) (e : Field.t array Evals.t) : (Boolean.var * Field.t) array Evals.t = Evals.map2 lengths e ~f:(fun lengths e -> - Array.zip_exn (mask lengths choice) e) + Array.zip_exn (mask lengths choice) e ) let combined_evaluation (type b b_plus_26) b_plus_26 ~xi ~evaluation_point ((without_degree_bound : (_, b_plus_26) Vector.t), with_degree_bound) @@ -663,14 +663,14 @@ struct ~mul_and_add:(fun ~acc ~xi fx -> fx + (xi * acc)) ~shifted_pow: (Pseudo.Degree_bound.shifted_pow - ~crs_max_degree:Common.Max_degree.wrap) + ~crs_max_degree:Common.Max_degree.wrap ) ~init:Fn.id ~evaluation_point ~xi (Common.dlog_pcs_batch b_plus_26) - without_degree_bound with_degree_bound) + without_degree_bound with_degree_bound ) let compute_challenges ~scalar chals = Vector.map chals ~f:(fun { Bulletproof_challenge.prechallenge } -> - scalar prechallenge) + scalar prechallenge ) let challenge_polynomial = Field.(challenge_polynomial ~add ~mul ~one) @@ -679,7 +679,7 @@ struct let rec go acc i = if i = 0 then acc else go (Field.square acc) (i - 1) in - go pt n) + go pt n ) let actual_evaluation (e : Field.t array) ~(pt_to_n : Field.t) : Field.t = with_label __LOC__ (fun () -> @@ -688,12 +688,12 @@ struct List.fold ~init:e es ~f:(fun acc y -> let acc' = exists Field.typ ~compute:(fun () -> - As_prover.read_var Field.(y + (pt_to_n * acc))) + As_prover.read_var Field.(y + (pt_to_n * acc)) ) in (* acc' = y + pt_n * acc *) let pt_n_acc = Field.(pt_to_n * acc) in - let open Kimchi_backend_common.Plonk_constraint_system - .Plonk_constraint in + let open + Kimchi_backend_common.Plonk_constraint_system.Plonk_constraint in (* 0 = - acc' + y + pt_n_acc *) let open Field.Constant in assert_ @@ -706,12 +706,12 @@ struct ; o = (negate one, acc') ; m = zero ; c = zero - }) + } ) } ] ; - acc') + acc' ) | [] -> - failwith "empty list") + failwith "empty list" ) let shift1 = Shifted_value.Type1.Shift.( @@ -754,7 +754,7 @@ struct , _ , _ Shifted_value.Type2.t , _ ) - Types.Step.Proof_state.Deferred_values.In_circuit.t) + Types.Step.Proof_state.Deferred_values.In_circuit.t ) { Plonk_types.All_evals.ft_eval1 ; evals = ( { evals = evals1; public_input = x_hat1 } @@ -769,7 +769,7 @@ struct let xs, ys = Evals.to_vectors e in List.iter Vector.([| x_hat |] :: (to_list xs @ to_list ys)) - ~f:(Array.iter ~f:(Sponge.absorb sponge))) + ~f:(Array.iter ~f:(Sponge.absorb sponge)) ) in (* A lot of hashing. *) absorb_evals x_hat1 evals1 ; @@ -782,7 +782,7 @@ struct let { SC.SC.inner = xi_actual } = xi_actual in let { SC.SC.inner = xi } = xi in (* Sample new sg challenge point here *) - Field.equal xi_actual xi) + Field.equal xi_actual xi ) in let xi = scalar_to_field xi in (* TODO: r actually does not need to be a scalar challenge. *) @@ -806,7 +806,7 @@ struct ~mds:sponge_params.mds ~field_of_hex:(fun s -> Kimchi_pasta.Pasta.Bigint256.of_hex_string s - |> Kimchi_pasta.Pasta.Fq.of_bigint |> Field.constant) + |> Kimchi_pasta.Pasta.Fq.of_bigint |> Field.constant ) ~domain (Plonk.to_minimal plonk) combined_evals in let combined_inner_product_correct = @@ -815,13 +815,13 @@ struct with_label __LOC__ (fun () -> Plonk_checks.ft_eval0 (module Field) - ~env ~domain plonk_minimal combined_evals x_hat1) + ~env ~domain plonk_minimal combined_evals x_hat1 ) in (* sum_i r^i sum_j xi^j f_j(beta_i) *) let actual_combined_inner_product = let sg_olds = Vector.map old_bulletproof_challenges ~f:(fun chals -> - unstage (challenge_polynomial (Vector.to_array chals))) + unstage (challenge_polynomial (Vector.to_array chals)) ) in let combine ~ft pt x_hat e = let pi = Proofs_verified.add Nat.N26.n in @@ -838,7 +838,7 @@ struct in with_label __LOC__ (fun () -> Vector.map2 mask sg_olds ~f:(fun b f -> - [| Field.((b :> t) * f pt) |])) + [| Field.((b :> t) * f pt) |] ) ) in let v = Vector.append sg_evals ([| x_hat |] :: [| ft |] :: a) (snd pi) @@ -853,12 +853,12 @@ struct equal (Shifted_value.Type2.to_field (module Field) - ~shift:shift2 combined_inner_product) - actual_combined_inner_product)) + ~shift:shift2 combined_inner_product ) + actual_combined_inner_product ) ) in let bulletproof_challenges = with_label __LOC__ (fun () -> - compute_challenges ~scalar:scalar_to_field bulletproof_challenges) + compute_challenges ~scalar:scalar_to_field bulletproof_challenges ) in let b_correct = with_label __LOC__ (fun () -> @@ -871,13 +871,13 @@ struct in equal (Shifted_value.Type2.to_field (module Field) ~shift:shift2 b) - b_actual) + b_actual ) in let plonk_checks_passed = with_label __LOC__ (fun () -> Plonk_checks.checked (module Impl) - ~env ~shift:shift2 plonk combined_evals) + ~env ~shift:shift2 plonk combined_evals ) in print_bool "xi_correct" xi_correct ; print_bool "combined_inner_product_correct" combined_inner_product_correct ; @@ -905,7 +905,7 @@ struct ; bulletproof_challenges = Vector.map bulletproof_challenges ~f:(fun (r : _ Bulletproof_challenge.t) -> - { Bulletproof_challenge.prechallenge = scalar r.prechallenge }) + { Bulletproof_challenge.prechallenge = scalar r.prechallenge } ) ; xi = scalar xi ; b } @@ -920,6 +920,6 @@ struct let sponge = Sponge.create sponge_params in Array.iter ~f:(Sponge.absorb sponge) (Types.Wrap.Proof_state.Me_only.to_field_elements - ~g1:Inner_curve.to_field_elements t) ; + ~g1:Inner_curve.to_field_elements t ) ; Sponge.squeeze_field sponge end diff --git a/src/lib/pickles_base/side_loaded_verification_key.ml b/src/lib/pickles_base/side_loaded_verification_key.ml index e775b04a88f..0be4af4ba76 100644 --- a/src/lib/pickles_base/side_loaded_verification_key.ml +++ b/src/lib/pickles_base/side_loaded_verification_key.ml @@ -215,7 +215,7 @@ let to_input (type a) ~(field_of_int : int -> a) : List.reduce_exn ~f:append [ map_reduce (Vector.to_array step_domains) ~f:(fun { Domains.h } -> map_reduce [| h |] ~f:(fun (Pow_2_roots_of_unity x) -> - packed (field_of_int x, max_log2_degree))) + packed (field_of_int x, max_log2_degree) ) ) ; Array.map (Vector.to_array step_widths) ~f:width |> packeds ; packed (width max_width) ; wrap_index_to_input diff --git a/src/lib/pickles_types/at_most.ml b/src/lib/pickles_types/at_most.ml index bd078ea07cc..90f9480ef72 100644 --- a/src/lib/pickles_types/at_most.ml +++ b/src/lib/pickles_types/at_most.ml @@ -105,15 +105,16 @@ module At_most_2 = struct module V1 = struct type 'a t = ('a, Nat.N2.n) at_most - include Binable.Of_binable1 - (Core_kernel.List.Stable.V1) - (struct - type nonrec 'a t = 'a t + include + Binable.Of_binable1 + (Core_kernel.List.Stable.V1) + (struct + type nonrec 'a t = 'a t - let to_binable = to_list + let to_binable = to_list - let of_binable xs = of_list_and_length_exn xs Nat.N2.n - end) + let of_binable xs = of_list_and_length_exn xs Nat.N2.n + end) include ( With_length @@ -133,15 +134,16 @@ module At_most_8 = struct module V1 = struct type 'a t = ('a, Nat.N8.n) at_most - include Binable.Of_binable1 - (Core_kernel.List.Stable.V1) - (struct - type nonrec 'a t = 'a t + include + Binable.Of_binable1 + (Core_kernel.List.Stable.V1) + (struct + type nonrec 'a t = 'a t - let to_binable = to_list + let to_binable = to_list - let of_binable xs = of_list_and_length_exn xs Nat.N8.n - end) + let of_binable xs = of_list_and_length_exn xs Nat.N8.n + end) include ( With_length diff --git a/src/lib/pickles_types/pcs_batch.ml b/src/lib/pickles_types/pcs_batch.ml index 2f1e4e4b2fd..25f9a846b73 100644 --- a/src/lib/pickles_types/pcs_batch.ml +++ b/src/lib/pickles_types/pcs_batch.ml @@ -19,7 +19,7 @@ let%test_unit "num_bits" = go 0 in Quickcheck.test (Int.gen_uniform_incl 0 Int.max_value) ~f:(fun n -> - [%test_eq: int] (num_bits n) (naive n)) + [%test_eq: int] (num_bits n) (naive n) ) let pow ~one ~mul x n = assert (n >= 0) ; @@ -59,7 +59,7 @@ let combine_evaluations' (type a n m) @ List.concat (Vector.to_list (Vector.map2 with_degree_bound evals1 ~f:(fun deg fx -> - [ fx; mul (shifted_pow deg evaluation_point) fx ]))) + [ fx; mul (shifted_pow deg evaluation_point) fx ] ) ) ) in List.fold_left evals ~init ~f:(fun acc fx -> add fx (mul acc xi)) @@ -87,14 +87,14 @@ let combine_split_commitments _t ~scale_and_add ~init:i ~xi (type n) List.concat_map (Vector.to_list without_degree_bound) ~f:Array.to_list @ List.concat_map (Vector.to_list with_degree_bound) ~f:(fun { With_degree_bound.unshifted; shifted } -> - Array.to_list unshifted @ [ shifted ]) + Array.to_list unshifted @ [ shifted ] ) in match List.rev flat with | [] -> failwith "combine_split_commitments: empty" | init :: comms -> List.fold_left comms ~init:(i init) ~f:(fun acc p -> - scale_and_add ~acc ~xi p) + scale_and_add ~acc ~xi p ) let combine_split_evaluations (type a n m f f') ({ without_degree_bound = _; with_degree_bound } : (a, n, m) t) @@ -109,11 +109,11 @@ let combine_split_evaluations (type a n m f f') (Vector.map2 with_degree_bound evals1 ~f:(fun deg unshifted -> let u = last unshifted in Array.to_list unshifted - @ [ mul u (shifted_pow deg evaluation_point) ]))) + @ [ mul u (shifted_pow deg evaluation_point) ] ) ) ) in match List.rev flat with | [] -> failwith "combine_split_evaluations: empty" | init :: es -> List.fold_left es ~init:(i init) ~f:(fun acc fx -> - mul_and_add ~acc ~xi fx) + mul_and_add ~acc ~xi fx ) diff --git a/src/lib/pickles_types/plonk_types.ml b/src/lib/pickles_types/plonk_types.ml index a783e536f91..7bbbbba9b80 100644 --- a/src/lib/pickles_types/plonk_types.ml +++ b/src/lib/pickles_types/plonk_types.ml @@ -6,7 +6,7 @@ let padded_array_typ ~length ~dummy elt = ~there:(fun a -> let n = Array.length a in if n > length then failwithf "Expected %d <= %d" n length () ; - Array.append a (Array.create ~len:(length - n) dummy)) + Array.append a (Array.create ~len:(length - n) dummy) ) ~back:Fn.id let hash_fold_array f s x = hash_fold_list f s (Array.to_list x) @@ -83,8 +83,8 @@ module Evals = struct |> Snarky_backendless.Typ.transport ~there:(fun arr -> Array.append arr - (Array.create ~len:(length - Array.length arr) default)) - ~back:Fn.id) + (Array.create ~len:(length - Array.length arr) default) ) + ~back:Fn.id ) in let t = let l1, l2 = to_vectors lengths in @@ -105,8 +105,8 @@ module All_evals = struct end end] - let map (type a1 a2 b1 b2) (t : (a1, a2) t) ~(f1 : a1 -> b1) - ~(f2 : a2 -> b2) : (b1, b2) t = + let map (type a1 a2 b1 b2) (t : (a1, a2) t) ~(f1 : a1 -> b1) ~(f2 : a2 -> b2) + : (b1, b2) t = { public_input = f1 t.public_input; evals = Evals.map ~f:f2 t.evals } let typ lengths (elt : ('a, 'b, 'f) Snarky_backendless.Typ.t) ~default = @@ -216,9 +216,9 @@ module Poly_comm = struct let a = Array.map a ~f:(fun x -> (true, x)) in let n = Array.length a in if n > length then failwithf "Expected %d <= %d" n length () ; - Array.append a (Array.create ~len:(length - n) (false, dummy))) + Array.append a (Array.create ~len:(length - n) (false, dummy)) ) ~back:(fun a -> - Array.filter_map a ~f:(fun (b, g) -> if b then Some g else None)) + Array.filter_map a ~f:(fun (b, g) -> if b then Some g else None) ) let typ (type f g g_var bool_var) (g : (g_var, g, f) Snarky_backendless.Typ.t) ~length @@ -232,7 +232,7 @@ module Poly_comm = struct | Or_infinity.Infinity -> (false, dummy_group_element) | Finite x -> - (true, x)) + (true, x) ) ~back:(fun (b, x) -> if b then Infinity else Finite x) in let arr = padded_array_typ0 ~length ~dummy:Or_infinity.Infinity g_inf in diff --git a/src/lib/pickles_types/vector.ml b/src/lib/pickles_types/vector.ml index fc70a9f12ae..45027c65bc6 100644 --- a/src/lib/pickles_types/vector.ml +++ b/src/lib/pickles_types/vector.ml @@ -120,7 +120,7 @@ let rec of_list : type a. a list -> a e = function let to_sequence : type a n. (a, n) t -> a Sequence.t = fun t -> Sequence.unfold ~init:(T t) ~f:(fun (T t) -> - match t with [] -> None | x :: xs -> Some (x, T xs)) + match t with [] -> None | x :: xs -> Some (x, T xs) ) let rec of_list_and_length_exn : type a n. a list -> n nat -> (a, n) t = fun xs n -> @@ -166,7 +166,7 @@ let for_all : type a n. (a, n) t -> f:(a -> bool) -> bool = fun v ~f -> with_return (fun { return } -> iter v ~f:(fun x -> if not (f x) then return false) ; - true) + true ) let foldi t ~f ~init = snd (fold t ~f:(fun (i, acc) x -> (i + 1, f i acc x)) ~init:(0, init)) diff --git a/src/lib/pipe_lib/broadcast_pipe.ml b/src/lib/pipe_lib/broadcast_pipe.ml index c49aa2af146..e4634a9fe88 100644 --- a/src/lib/pipe_lib/broadcast_pipe.ml +++ b/src/lib/pipe_lib/broadcast_pipe.ml @@ -22,7 +22,7 @@ let create a = Pipe.add_consumer root_r ~downstream_flushed:(fun () -> let%map () = Ivar.read !downstream_flushed_v in (* Sub-pipes are never closed without closing the master pipe. *) - `Ok) + `Ok ) in don't_wait_for (Pipe.iter ~flushed:(Consumer consumer) root_r ~f:(fun v -> @@ -30,17 +30,17 @@ let create a = let inner_pipes = Int.Table.data t.pipes in let%bind () = Deferred.List.iter ~how:`Parallel inner_pipes ~f:(fun p -> - Pipe.write p v) + Pipe.write p v ) in Pipe.Consumer.values_sent_downstream consumer ; let%bind () = Deferred.List.iter ~how:`Parallel inner_pipes ~f:(fun p -> - Deferred.ignore_m @@ Pipe.downstream_flushed p) + Deferred.ignore_m @@ Pipe.downstream_flushed p ) in if Ivar.is_full !downstream_flushed_v then [%log' error (Logger.create ())] "Ivar.fill bug is here!" ; Ivar.fill !downstream_flushed_v () ; - Deferred.unit)) ; + Deferred.unit ) ) ; (t, t) exception Already_closed of string @@ -73,7 +73,7 @@ module Reader = struct Int.Table.remove t.pipes reader_id ; b in - d) + d ) (* The sub-pipes have no downstream consumer, so the downstream flushed should always be determined and return `Ok. *) @@ -86,14 +86,14 @@ module Reader = struct Pipe.fold r ~init ~f:(fun acc v -> let%map res = f acc v in Pipe.Consumer.values_sent_downstream consumer ; - res)) + res ) ) let iter t ~f = prepare_pipe t ~default_value:() ~f:(fun r -> let consumer = add_trivial_consumer r in Pipe.iter ~flushed:(Consumer consumer) r ~f:(fun v -> let%map () = f v in - Pipe.Consumer.values_sent_downstream consumer)) + Pipe.Consumer.values_sent_downstream consumer ) ) let iter_until t ~f = let rec loop ~consumer reader = @@ -107,7 +107,7 @@ module Reader = struct in prepare_pipe t ~default_value:() ~f:(fun reader -> let consumer = add_trivial_consumer reader in - loop ~consumer reader) + loop ~consumer reader ) end module Writer = struct @@ -118,13 +118,13 @@ module Writer = struct t.cache <- x ; let%bind () = Pipe.write t.root_pipe x in let%bind _ = Pipe.downstream_flushed t.root_pipe in - Deferred.unit) + Deferred.unit ) let close t = guard_already_closed ~context:"Writer.close" t (fun () -> Pipe.close t.root_pipe ; Int.Table.iter t.pipes ~f:(fun w -> Pipe.close w) ; - Int.Table.clear t.pipes) + Int.Table.clear t.pipes ) end let map t ~f = @@ -171,7 +171,7 @@ let%test_unit "listeners properly receive updates" = ~expect:next_value (Reader.peek r) ; (*6*) Writer.close w ; - Deferred.both d1 d2 >>| Fn.ignore) + Deferred.both d1 d2 >>| Fn.ignore ) let%test_module _ = ( module struct @@ -201,7 +201,7 @@ let%test_module _ = counts.immediate_iterations <- counts.immediate_iterations + 1 ; let%map () = after @@ Time_ns.Span.of_sec 1. in - counts.deferred_iterations <- counts.deferred_iterations + 1) + counts.deferred_iterations <- counts.deferred_iterations + 1 ) in setup_reader counts1 ; (* The reader doesn't run until we yield. *) @@ -226,5 +226,5 @@ let%test_module _ = assert_immediate counts2 1 ; assert_deferred counts2 0 ; let%bind () = Writer.write pipe_w () in - assert_both counts1 3 ; assert_both counts2 2 ; Deferred.return true) + assert_both counts1 3 ; assert_both counts2 2 ; Deferred.return true ) end ) diff --git a/src/lib/pipe_lib/linear_pipe.ml b/src/lib/pipe_lib/linear_pipe.ml index 1dbe719a3c3..2836495380c 100644 --- a/src/lib/pipe_lib/linear_pipe.ml +++ b/src/lib/pipe_lib/linear_pipe.ml @@ -77,7 +77,8 @@ let iter_unordered ?consumer ~max_concurrency reader ~f = let%bind () = f v in run_reader () in - Deferred.all_unit (List.init max_concurrency ~f:(fun _ -> run_reader ()))) + Deferred.all_unit (List.init max_concurrency ~f:(fun _ -> run_reader ())) + ) let drain r = iter r ~f:(fun _ -> Deferred.unit) @@ -131,10 +132,10 @@ let transfer_id reader writer = let merge_unordered rs = let merged_reader, merged_writer = create () in List.iter rs ~f:(fun reader -> - don't_wait_for (iter reader ~f:(fun x -> Pipe.write merged_writer x))) ; + don't_wait_for (iter reader ~f:(fun x -> Pipe.write merged_writer x)) ) ; don't_wait_for (let%map () = Deferred.List.iter rs ~f:closed in - Pipe.close merged_writer) ; + Pipe.close merged_writer ) ; merged_reader (* TODO following are all more efficient with iter', @@ -148,10 +149,10 @@ let fork reader n = (iter reader ~f:(fun x -> Deferred.List.iter writers ~f:(fun writer -> if not (Pipe.is_closed writer) then Pipe.write writer x - else return ()))) ; + else return () ) ) ) ; don't_wait_for (let%map () = Deferred.List.iter readers ~f:closed in - close_read reader) ; + close_read reader ) ; readers let fork2 reader = @@ -185,10 +186,10 @@ let partition_map2 reader ~f = | `Fst x -> Pipe.write writer_a x | `Snd x -> - Pipe.write writer_b x)) ; + Pipe.write writer_b x ) ) ; don't_wait_for (let%map () = closed reader_a and () = closed reader_b in - close_read reader) ; + close_read reader ) ; (reader_a, reader_b) let partition_map3 reader ~f = @@ -203,22 +204,23 @@ let partition_map3 reader ~f = | `Snd x -> Pipe.write writer_b x | `Trd x -> - Pipe.write writer_c x)) ; + Pipe.write writer_c x ) ) ; don't_wait_for (let%map () = closed reader_a and () = closed reader_b and () = closed reader_c in - close_read reader) ; + close_read reader ) ; (reader_a, reader_b, reader_c) let filter_map_unordered ~max_concurrency t ~f = let reader, writer = create () in don't_wait_for (iter_unordered ~max_concurrency t ~f:(fun x -> - match%bind f x with Some y -> Pipe.write writer y | None -> return ())) ; + match%bind f x with Some y -> Pipe.write writer y | None -> return () ) + ) ; don't_wait_for (let%map () = closed reader in - close_read t) ; + close_read t ) ; reader let latest_ref t ~initial = diff --git a/src/lib/pipe_lib/strict_pipe.ml b/src/lib/pipe_lib/strict_pipe.ml index 536bef7416d..3e8511354ba 100644 --- a/src/lib/pipe_lib/strict_pipe.ml +++ b/src/lib/pipe_lib/strict_pipe.ml @@ -84,7 +84,7 @@ module Reader0 = struct let%bind b' = f b a in go b' in - go init) + go init ) let fold_until reader ~init ~f = enforce_single_reader reader @@ -100,7 +100,7 @@ module Reader0 = struct | `Continue b' -> go b' ) in - go init) + go init ) let fold_without_pushback ?consumer reader ~init ~f = Pipe.fold_without_pushback ?consumer reader.reader ~init ~f @@ -147,7 +147,7 @@ module Reader0 = struct Deferred.choose (List.map readers ~f:(fun r -> Deferred.choice (Pipe.values_available r.reader) - (fun _ -> ()))) + (fun _ -> ()) ) ) in List.find readers ~f:not_empty in @@ -186,10 +186,10 @@ module Reader0 = struct (Pipe.iter reader.reader ~f:(fun x -> Deferred.List.iter writers ~f:(fun writer -> if not (Pipe.is_closed writer) then Pipe.write writer x - else return ()))) ; + else return () ) ) ) ; don't_wait_for (let%map () = Deferred.List.iter readers ~f:Pipe.closed in - Pipe.close_read reader.reader) ; + Pipe.close_read reader.reader ) ; let strict_readers = List.map readers ~f:(wrap_reader ?name:reader.name) in @@ -277,7 +277,7 @@ module Writer = struct f head | _ -> () ) ; - Pipe.write_without_pushback writer.writer data) + Pipe.write_without_pushback writer.writer data ) ~normal_return:() | Buffered (`Capacity capacity, `Overflow (Call f)) -> handle_buffered_write writer data ~capacity @@ -339,12 +339,12 @@ module Reader = struct | `Snd x -> Writer.write writer_b x | `Trd x -> - Writer.write writer_c x)) ; + Writer.write writer_c x ) ) ; don't_wait_for (let%map () = Pipe.closed reader_a.reader and () = Pipe.closed reader_b.reader and () = Pipe.closed reader_c.reader in - Pipe.close_read reader.reader) ; + Pipe.close_read reader.reader ) ; reader.downstreams <- [ reader_a; reader_b; reader_c ] ; (reader_a, reader_b, reader_c) end @@ -365,7 +365,7 @@ let%test_module "Strict_pipe.Reader.Merge" = Writer.write writer2 2 ; Writer.close writer1 ; let%map () = after (Time_ns.Span.of_ms 5.) in - Writer.write writer2 3 ; ()) + Writer.write writer2 3 ; () ) end ) let%test_module "Strict_pipe.close" = diff --git a/src/lib/ppx_annot/ppx_annot.ml b/src/lib/ppx_annot/ppx_annot.ml index a05c0677a93..583b39f71fb 100644 --- a/src/lib/ppx_annot/ppx_annot.ml +++ b/src/lib/ppx_annot/ppx_annot.ml @@ -23,7 +23,7 @@ let extract_string_attrs (attributes : attributes) = | PStr [] -> Some (attr.attr_name.txt, None) | _ -> - None) + None ) let get_record_fields_exn (type_decl : type_declaration) = match type_decl.ptype_kind with @@ -49,7 +49,7 @@ let annot_str : Ppxlib.Ast_builder.Default.pexp_tuple ~loc [ Ppxlib.Ast_builder.Default.estring ~loc a ; lift_optional_string ~loc b - ]) + ] ) in let type_decl = expect_single_decl ~loc type_decls in let loc = type_decl.ptype_loc in @@ -65,7 +65,7 @@ let annot_str : ~guard:None ~rhs: (Ppxlib.Ast_builder.Default.elist ~loc - (lift_string_tuples string_attributes ~loc))) + (lift_string_tuples string_attributes ~loc) ) ) in let field_branches = field_branches @@ -76,12 +76,12 @@ let annot_str : in [%str let ([%p Ppxlib.Ast_builder.Default.pvar ~loc fields_name] : - string -> (string * string option) list) = + string -> (string * string option) list ) = fun str -> [%e Ppxlib.Ast_builder.Default.pexp_match ~loc [%expr str] field_branches] let ([%p Ppxlib.Ast_builder.Default.pvar ~loc toplevel_name] : - unit -> (string * string option) list) = + unit -> (string * string option) list ) = fun () -> [%e Ppxlib.Ast_builder.Default.elist ~loc @@ -100,11 +100,11 @@ let annot_sig : [ psig_value ~loc (value_description ~loc ~name:(Located.mk ~loc fields_name) - ~type_:[%type: string -> (string * string option) list] ~prim:[]) + ~type_:[%type: string -> (string * string option) list] ~prim:[] ) ; psig_value ~loc (value_description ~loc ~name:(Located.mk ~loc toplevel_name) - ~type_:[%type: unit -> (string * string option) list] ~prim:[]) + ~type_:[%type: unit -> (string * string option) list] ~prim:[] ) ] let ann = diff --git a/src/lib/ppx_coda/define_from_scope.ml b/src/lib/ppx_coda/define_from_scope.ml index fd2827acf25..4f9e7fb6928 100644 --- a/src/lib/ppx_coda/define_from_scope.ml +++ b/src/lib/ppx_coda/define_from_scope.ml @@ -20,7 +20,7 @@ open Asttypes module T = struct [%%define_from_scope x,y] end - *) +*) let name = "define_from_scope" diff --git a/src/lib/ppx_coda/define_locally.ml b/src/lib/ppx_coda/define_locally.ml index 5cdb4339cfd..78668346bc1 100644 --- a/src/lib/ppx_coda/define_locally.ml +++ b/src/lib/ppx_coda/define_locally.ml @@ -12,8 +12,7 @@ open Ast_helper expands to let x,y,z = M.(x,y,z) - - *) +*) let name = "define_locally" diff --git a/src/lib/ppx_coda/log.ml b/src/lib/ppx_coda/log.ml index db4b68df3b0..85acd8d3183 100644 --- a/src/lib/ppx_coda/log.ml +++ b/src/lib/ppx_coda/log.ml @@ -19,7 +19,6 @@ open Asttypes The variants `%str_log` and `%str_log'` generate the module `Logger.Structured` instead of `Logger`. - *) module type Ppxinfo = sig diff --git a/src/lib/ppx_coda/ppx_representatives/ppx_representatives.ml b/src/lib/ppx_coda/ppx_representatives/ppx_representatives.ml index 67b254574f1..f2147f245ea 100644 --- a/src/lib/ppx_coda/ppx_representatives/ppx_representatives.ml +++ b/src/lib/ppx_coda/ppx_representatives/ppx_representatives.ml @@ -40,7 +40,7 @@ let mk_builtin ~loc name = (Loc.make ~loc (Ldot ( Lident "Ppx_representatives_runtime" - , mangle ~suffix:deriver_name name ))) + , mangle ~suffix:deriver_name name ) ) ) (* The way that we expand representatives below makes it extremely easy to blow the stack if we're not tail-recursive. All generated list iterators should @@ -72,7 +72,7 @@ let rec core_type ~loc (typ : core_type) : expression = "%s: Illegal call to dummy functional value defined \ by %a" deriver_name Ocaml_common.Location.print_loc - typ.ptyp_loc)]]] + typ.ptyp_loc )]]] ]] | Ptyp_tuple typs -> let exprs = List.map ~f:(core_type ~loc) typs in @@ -97,7 +97,7 @@ let rec core_type ~loc (typ : core_type) : expression = Ppx_representatives_runtime.Util.rev_concat (Stdlib.List.rev_map (fun [%p pvar ~loc (mk_name i)] -> [%e expr]) - (Stdlib.Lazy.force [%e arg]))])]] + (Stdlib.Lazy.force [%e arg]) )] )]] | Ptyp_constr ({ txt = Lident name; _ }, []) when is_builtin name -> mk_builtin ~loc name | Ptyp_constr ({ txt = Lident name; _ }, [ _ ]) when is_builtin_with_arg name @@ -138,7 +138,8 @@ let rec core_type ~loc (typ : core_type) : expression = [%expr Stdlib.List.rev_map (fun e -> - [%e pexp_variant ~loc name.txt (Some [%expr e])]) + [%e pexp_variant ~loc name.txt (Some [%expr e])] + ) (Stdlib.Lazy.force [%e core_type ~loc typ])] | Rtag _ -> Location.raise_errorf ~loc:typ.ptyp_loc @@ -153,7 +154,7 @@ let rec core_type ~loc (typ : core_type) : expression = strict subtype. *) ( [%e core_type ~loc typ'] - :> [%t typ] list lazy_t ))]))])] + :> [%t typ] list lazy_t ) )] ) )] )] | Ptyp_poly (vars, typ) -> (* Inject dummy representatives into the environment so that they can resolve. @@ -166,7 +167,7 @@ let rec core_type ~loc (typ : core_type) : expression = let [%p pvar ~loc var.txt] = Stdlib.Lazy.from_fun (fun () -> failwith "Unknown type") in - [%e expr]])]] + [%e expr]] )]] | Ptyp_package _ -> Location.raise_errorf ~loc:typ.ptyp_loc "Cannot derive %s for packaged modules" deriver_name @@ -185,13 +186,14 @@ let record_decl ~loc (fields : label_declaration list) : expression = Ppx_representatives_runtime.Util.rev_concat (Stdlib.List.rev_map (fun [%p pvar ~loc field.pld_name.txt] -> [%e expr]) - (Lazy.force [%e core_type ~loc field.pld_type]))]) + (Lazy.force [%e core_type ~loc field.pld_type]) )] ) ~init: [%expr [ [%e pexp_record ~loc (List.map fields ~f:(fun field -> - (mk_lid field.pld_name, evar ~loc field.pld_name.txt))) + (mk_lid field.pld_name, evar ~loc field.pld_name.txt) ) + ) None] ]]]] @@ -203,8 +205,8 @@ let str_decl ~loc (decl : type_declaration) : structure_item = [%t List.fold_right decl.ptype_params ~f:(fun (param, _) typ -> - [%type: [%t param] list lazy_t -> [%t typ]]) - ~init:[%type: [%t constr_of_decl ~loc decl] list lazy_t]]) = + [%type: [%t param] list lazy_t -> [%t typ]] ) + ~init:[%type: [%t constr_of_decl ~loc decl] list lazy_t]] ) = [%e List.fold_right decl.ptype_params ~init:expr ~f:(fun (param, _) expr -> @@ -218,7 +220,7 @@ let str_decl ~loc (decl : type_declaration) : structure_item = Location.raise_errorf ~loc:param.ptyp_loc "Expected a type variable or _" in - [%expr fun [%p pat] -> [%e expr]])]] + [%expr fun [%p pat] -> [%e expr]] )]] in match decl with | { ptype_kind = Ptype_variant constrs; _ } -> @@ -253,8 +255,8 @@ let str_decl ~loc (decl : type_declaration) : structure_item = (fun x -> [%e pexp_construct ~loc (mk_lid constr.pcd_name) - (Some [%expr x])]) - (Stdlib.Lazy.force [%e arg])]))])] + (Some [%expr x])] ) + (Stdlib.Lazy.force [%e arg])] ) )] )] | { ptype_kind = Ptype_abstract; ptype_manifest = Some typ; _ } -> binding (core_type ~loc typ) | { ptype_kind = Ptype_record fields; _ } -> @@ -270,8 +272,8 @@ let sig_decl ~loc (decl : type_declaration) : signature_item = ~type_: (List.fold_right decl.ptype_params ~f:(fun (param, _) typ -> - [%type: [%t param] list lazy_t -> [%t typ]]) - ~init:[%type: [%t constr_of_decl ~loc decl] list lazy_t]) + [%type: [%t param] list lazy_t -> [%t typ]] ) + ~init:[%type: [%t constr_of_decl ~loc decl] list lazy_t] ) let str_type_decl ~loc ~path:_ (_rec_flag, decls) : structure = List.map ~f:(str_decl ~loc) decls diff --git a/src/lib/ppx_coda/ppx_to_enum/ppx_to_enum.ml b/src/lib/ppx_coda/ppx_to_enum/ppx_to_enum.ml index 06dbcff324e..90b961f2104 100644 --- a/src/lib/ppx_coda/ppx_to_enum/ppx_to_enum.ml +++ b/src/lib/ppx_coda/ppx_to_enum/ppx_to_enum.ml @@ -40,7 +40,7 @@ let str_decl ~loc (decl : type_declaration) : structure = (* [type t = A of int | B of bool | ...] *) [%str let ([%p pvar ~loc (mangle ~suffix:deriver_name name.txt)] : - [%t constr_of_decl ~loc decl] -> int) = + [%t constr_of_decl ~loc decl] -> int ) = [%e pexp_function ~loc (List.mapi constrs ~f:(fun i constr -> @@ -53,7 +53,7 @@ let str_decl ~loc (decl : type_declaration) : structure = Some (ppat_any ~loc) ) ; pc_guard = None ; pc_rhs = eint ~loc i - }))] + } ) )] let [%p pvar ~loc (mangle_prefix ~prefix:"min" name.txt)] = 0 @@ -67,7 +67,7 @@ let str_decl ~loc (decl : type_declaration) : structure = (* [type t = Foo.t] *) [%str let ([%p pvar ~loc (mangle ~suffix:deriver_name name.txt)] : - [%t constr_of_decl ~loc decl] -> int) = + [%t constr_of_decl ~loc decl] -> int ) = [%e pexp_ident ~loc (Located.map (mangle_lid ~suffix:deriver_name) lid)] @@ -86,7 +86,7 @@ let str_decl ~loc (decl : type_declaration) : structure = (* [type t = [ `A of int | `B of bool | ...]] *) [%str let ([%p pvar ~loc (mangle ~suffix:deriver_name name.txt)] : - [%t constr_of_decl ~loc decl] -> int) = + [%t constr_of_decl ~loc decl] -> int ) = [%e pexp_function ~loc (List.mapi constrs ~f:(fun i constr -> @@ -99,14 +99,13 @@ let str_decl ~loc (decl : type_declaration) : structure = ppat_variant ~loc label.txt None | false, _ :: _ -> (* [`A of int] *) - ppat_variant ~loc label.txt - (Some (ppat_any ~loc)) + ppat_variant ~loc label.txt (Some (ppat_any ~loc)) | true, _ :: _ -> (* [`A | `A of int] *) ppat_or ~loc (ppat_variant ~loc label.txt None) (ppat_variant ~loc label.txt - (Some (ppat_any ~loc))) ) + (Some (ppat_any ~loc)) ) ) ; pc_guard = None ; pc_rhs = eint ~loc i } @@ -114,7 +113,7 @@ let str_decl ~loc (decl : type_declaration) : structure = Location.raise_errorf ~loc:typ.ptyp_loc "Cannot derive %s for this type: inherited fields are \ not supported" - deriver_name))] + deriver_name ) )] let [%p pvar ~loc (mangle_prefix ~prefix:"min" name.txt)] = 0 diff --git a/src/lib/ppx_dhall_type/deriving.ml b/src/lib/ppx_dhall_type/deriving.ml index 2225c0ec50b..256017a4ce4 100644 --- a/src/lib/ppx_dhall_type/deriving.ml +++ b/src/lib/ppx_dhall_type/deriving.ml @@ -116,7 +116,7 @@ let generate_dhall_type type_decl = [%e elist (List.map ctor_decls - ~f:dhall_variant_from_constructor_declaration)]] + ~f:dhall_variant_from_constructor_declaration )]] | Ptype_record label_decls -> [%expr Ppx_dhall_type.Dhall_type.Record @@ -144,7 +144,7 @@ let generate_dhall_type type_decl = pvar a | _ -> Location.raise_errorf ~loc:type_decl.ptype_loc - "Type parameter not a type variable") + "Type parameter not a type variable" ) in let abs = eabstract args dhall_type in [%stri let [%p ty_name] = [%e abs]] diff --git a/src/lib/ppx_register_event/register_event.ml b/src/lib/ppx_register_event/register_event.ml index f5963b1fd24..c9fbac69b9e 100644 --- a/src/lib/ppx_register_event/register_event.ml +++ b/src/lib/ppx_register_event/register_event.ml @@ -28,7 +28,7 @@ let checked_interpolations_statically ~loc msg label_names = field in the record" interp | _ -> - ()) ; + () ) ; true ) | _ -> false @@ -81,7 +81,7 @@ let generate_loggers_and_parsers ~loc:_ ~path ty_ext msg_opt = Some (List.find_map_exn stris ~f:find_deriver) | _ -> failwith (sprintf "Expected structure payload for %s" deriver) - else None) + else None ) in let (module Ast_builder) = Ast_builder.make deriver_loc in let open Ast_builder in @@ -94,7 +94,7 @@ let generate_loggers_and_parsers ~loc:_ ~path ty_ext msg_opt = if has_record_arg then let fields = List.map label_names ~f:(fun label -> - sprintf "%s=$%s" label label) + sprintf "%s=$%s" label label ) in sprintf "%s {%s}" ctor (String.concat ~sep:"; " fields) else sprintf "%s" ctor @@ -124,7 +124,7 @@ let generate_loggers_and_parsers ~loc:_ ~path ty_ext msg_opt = if has_record_arg then let fields = List.map label_names ~f:(fun label -> - (Located.mk (Lident label), pvar label)) + (Located.mk (Lident label), pvar label) ) in Some (record fields Closed) else None @@ -137,7 +137,7 @@ let generate_loggers_and_parsers ~loc:_ ~path ty_ext msg_opt = if has_record_arg then let fields = List.map label_names ~f:(fun label -> - (Located.mk (Lident label), evar label)) + (Located.mk (Lident label), evar label) ) in Some (record fields None) else None @@ -147,11 +147,11 @@ let generate_loggers_and_parsers ~loc:_ ~path ty_ext msg_opt = let stris = [ [%stri let ([%p pvar (event_name ^ "_structured_events_id")] : - Structured_log_events.id) = + Structured_log_events.id ) = Structured_log_events.id_of_string [%e estring (digest event_path)]] ; [%stri let ([%p pvar (event_name ^ "_structured_events_repr")] : - Structured_log_events.repr) = + Structured_log_events.repr ) = { id = [%e evar (event_name ^ "_structured_events_id")] ; event_name = [%e estring event_path] ; arguments = @@ -170,9 +170,9 @@ let generate_loggers_and_parsers ~loc:_ ~path ty_ext msg_opt = @@ Conv_to_ppx_deriving.copy_expression @@ [%expr [%e estring name] - , [%e to_yojson pld_type] [%e evar name]])] ) + , [%e to_yojson pld_type] [%e evar name]] )] ) | _ -> - None) + None ) ; parse = (fun args -> let result = @@ -181,8 +181,7 @@ let generate_loggers_and_parsers ~loc:_ ~path ty_ext msg_opt = ignore args_list ; [%e List.fold_right label_decls - ~f: - (fun { pld_name = { txt = name; _ }; pld_type; _ } acc -> + ~f:(fun { pld_name = { txt = name; _ }; pld_type; _ } acc -> Conv_from_ppx_deriving.copy_expression @@ Ppx_deriving_yojson.wrap_runtime @@ Conv_to_ppx_deriving.copy_expression @@ -196,17 +195,17 @@ let generate_loggers_and_parsers ~loc:_ ~path ty_ext msg_opt = of_yojson ~path:(split_path @ [ ctor; name ]) pld_type] - [%e evar name]) + [%e evar name] ) ~f:(fun [%p pvar name] -> [%e acc]) | None -> Core_kernel.Result.fail [%e estring (sprintf "%s, parse: missing argument %s" - event_path name)]]) + event_path name )]] ) ~init:[%expr Core_kernel.Result.return [%e record_expr]]] in - match result with Ok ev -> Some ev | Error _ -> None) + match result with Ok ev -> Some ev | Error _ -> None ) }] ; [%stri let () = @@ -222,7 +221,7 @@ let generate_loggers_and_parsers ~loc:_ ~path ty_ext msg_opt = (sprintf "File \"%s\", line %d, characters %d-%d:" msg_loc.loc_start.pos_fname msg_loc.loc_start.pos_lnum (msg_loc.loc_start.pos_cnum - msg_loc.loc_start.pos_bol) - (msg_loc.loc_end.pos_cnum - msg_loc.loc_start.pos_bol)) + (msg_loc.loc_end.pos_cnum - msg_loc.loc_start.pos_bol) ) in [%stri let () = @@ -239,12 +238,12 @@ let generate_signature_items ~loc ~path:_ ty_ext = [ psig_value (value_description ~name:(Located.mk (event_name ^ "_structured_events_id")) - ~type_:[%type: Structured_log_events.id] ~prim:[]) + ~type_:[%type: Structured_log_events.id] ~prim:[] ) ; psig_value (value_description ~name:(Located.mk (event_name ^ "_structured_events_repr")) - ~type_:[%type: Structured_log_events.repr] ~prim:[]) - ]) + ~type_:[%type: Structured_log_events.repr] ~prim:[] ) + ] ) let str_type_ext = let args = diff --git a/src/lib/precomputed_values/gen_values/dune b/src/lib/precomputed_values/gen_values/dune index 2a065849dae..852b3802a7f 100644 --- a/src/lib/precomputed_values/gen_values/dune +++ b/src/lib/precomputed_values/gen_values/dune @@ -1,5 +1,6 @@ (executable (name gen_values) + (flags -w -32) (libraries ;; opam libraries stdio diff --git a/src/lib/precomputed_values/gen_values/gen_values.ml b/src/lib/precomputed_values/gen_values/gen_values.ml index e878e6341d9..54c6ab5e63c 100644 --- a/src/lib/precomputed_values/gen_values/gen_values.ml +++ b/src/lib/precomputed_values/gen_values/gen_values.ml @@ -38,7 +38,7 @@ let hashes = Blockchain_snark.Blockchain_snark_state.constraint_system_digests ~proof_level ~constraint_constants () in - ts @ bs) + ts @ bs ) let hashes_to_expr ~loc hashes = let open Ppxlib.Ast_builder.Default in @@ -46,7 +46,7 @@ let hashes_to_expr ~loc hashes = @@ List.map hashes ~f:(fun (x, y) -> [%expr [%e estring ~loc x] - , Core.Md5.of_hex_exn [%e estring ~loc (Core.Md5.to_hex y)]]) + , Core.Md5.of_hex_exn [%e estring ~loc (Core.Md5.to_hex y)]] ) let vk_id_to_expr ~loc vk_id = let open Ppxlib.Ast_builder.Default in @@ -57,8 +57,8 @@ let vk_id_to_expr ~loc vk_id = [%e estring ~loc (Core.Sexp.to_string - (Pickles.Verification_key.Id.sexp_of_t vk_id))] - Pickles.Verification_key.Id.t_of_sexp) + (Pickles.Verification_key.Id.sexp_of_t vk_id) )] + Pickles.Verification_key.Id.t_of_sexp ) in fun () -> Lazy.force t] @@ -103,7 +103,7 @@ module Dummy = struct ; protocol_state_with_hashes ; constraint_system_digests = hashes ; proof_data = None - }) + } ) else None end @@ -137,7 +137,7 @@ module Make_real () = struct ; blockchain_proof_system_id = None } in - values) + values ) else None end @@ -185,7 +185,7 @@ let main () = ; constraint_system_digests = lazy [%e hashes_to_expr ~loc (Lazy.force hashes)] ; proof_data = None - }) + } ) let compiled_inputs = lazy @@ -228,7 +228,7 @@ let main () = [%expr Some [%e vk_id_to_expr ~loc id]] | _ -> [%expr None]] - }) + } ) let compiled = [%e @@ -267,11 +267,11 @@ let main () = (Binable.to_string ( module Mina_base.Proof.Stable .Latest ) - proof_data.genesis_proof)] + proof_data.genesis_proof )] }] | None -> [%expr None]] - }) )] + } ) )] | None -> [%expr None]]] in diff --git a/src/lib/protocol_version/protocol_version.ml b/src/lib/protocol_version/protocol_version.ml index df70e1c3cae..66f20ce2517 100644 --- a/src/lib/protocol_version/protocol_version.ml +++ b/src/lib/protocol_version/protocol_version.ml @@ -22,7 +22,7 @@ let set_proposed_opt t_opt = proposed_protocol_version_opt := t_opt (* we set current protocol version on daemon startup, so we should not see errors due to current_protocol_version = None in get_current and create_exn - *) +*) let get_current () = Option.value_exn !current_protocol_version let get_proposed_opt () = !proposed_protocol_version_opt diff --git a/src/lib/prover/prover.ml b/src/lib/prover/prover.ml index dedb3d648db..3aefbe4c5f4 100644 --- a/src/lib/prover/prover.ml +++ b/src/lib/prover/prover.ml @@ -120,7 +120,7 @@ module Worker_state = struct ~handler: (Consensus.Data.Prover_state.handler ~constraint_constants state_for_handler - ~pending_coinbase) + ~pending_coinbase ) { transition = block ; prev_state = Blockchain_snark.Blockchain.state chain @@ -132,12 +132,12 @@ module Worker_state = struct next_state in Blockchain_snark.Blockchain.create ~state:next_state - ~proof) + ~proof ) in Or_error.iter_error res ~f:(fun e -> [%log error] ~metadata:[ ("error", Error_json.error_to_yojson e) ] - "Prover threw an error while extending block: $error") ; + "Prover threw an error while extending block: $error" ) ; res let verify state proof = B.Proof.verify [ (state, proof) ] @@ -159,16 +159,16 @@ module Worker_state = struct } ~handler: (Consensus.Data.Prover_state.handler state_for_handler - ~constraint_constants ~pending_coinbase) + ~constraint_constants ~pending_coinbase ) t (Protocol_state.hashes next_state).state_hash |> Or_error.map ~f:(fun () -> Blockchain_snark.Blockchain.create ~state:next_state - ~proof:Mina_base.Proof.blockchain_dummy) + ~proof:Mina_base.Proof.blockchain_dummy ) in Or_error.iter_error res ~f:(fun e -> [%log error] ~metadata:[ ("error", Error_json.error_to_yojson e) ] - "Prover threw an error while extending block: $error") ; + "Prover threw an error while extending block: $error" ) ; Async.Deferred.return res let verify _state _proof = Deferred.return true @@ -183,13 +183,13 @@ module Worker_state = struct @@ Ok (Blockchain_snark.Blockchain.create ~proof:Mina_base.Proof.blockchain_dummy - ~state:next_state) + ~state:next_state ) let verify _ _ = Deferred.return true end : S ) in Memory_stats.log_memory_stats logger ~process:"prover" ; - m) + m ) let get = Fn.id end @@ -205,7 +205,7 @@ module Functions = struct let initialized = create bin_unit [%bin_type_class: [ `Initialized ]] (fun w () -> let (module W) = Worker_state.get w in - Deferred.return `Initialized) + Deferred.return `Initialized ) let extend_blockchain = create Extend_blockchain_input.Stable.Latest.bin_t @@ -222,14 +222,14 @@ module Functions = struct -> let (module W) = Worker_state.get w in W.extend_blockchain chain next_state block ledger_proof prover_state - pending_coinbase) + pending_coinbase ) let verify_blockchain = create Blockchain.Stable.Latest.bin_t bin_bool (fun w chain -> let (module W) = Worker_state.get w in W.verify (Blockchain_snark.Blockchain.state chain) - (Blockchain_snark.Blockchain.proof chain)) + (Blockchain_snark.Blockchain.proof chain) ) end module Worker = struct @@ -277,7 +277,7 @@ module Worker = struct ~processor:(Logger.Processor.raw ()) ~transport: (Logger_file_system.dumb_logrotate ~directory:conf_dir - ~log_filename:"mina-prover.log" ~max_size ~num_rotate) ; + ~log_filename:"mina-prover.log" ~max_size ~num_rotate ) ; [%log info] "Prover started" ; Worker_state.create { conf_dir; logger; proof_level; constraint_constants } @@ -344,14 +344,14 @@ let create ~logger ~pids ~conf_dir ~proof_level ~constraint_constants = ~f:(fun stdout -> return @@ [%log debug] "Prover stdout: $stdout" - ~metadata:[ ("stdout", `String stdout) ]) ; + ~metadata:[ ("stdout", `String stdout) ] ) ; don't_wait_for @@ Pipe.iter (Process.stderr process |> Reader.pipe) ~f:(fun stderr -> return @@ [%log error] "Prover stderr: $stderr" - ~metadata:[ ("stderr", `String stderr) ]) ; + ~metadata:[ ("stderr", `String stderr) ] ) ; { connection; process; logger } let initialized { connection; _ } = @@ -401,7 +401,7 @@ let extend_blockchain { connection; logger; _ } chain next_state block (Base64.encode_exn (Binable.to_string (module Extend_blockchain_input.Stable.Latest) - input)) ) + input ) ) ) ; ("error", Error_json.error_to_yojson e) ] "Prover failed: $error" ; diff --git a/src/lib/quickcheck_lib/quickcheck_lib.ml b/src/lib/quickcheck_lib/quickcheck_lib.ml index 5e1761802aa..1006da382cf 100644 --- a/src/lib/quickcheck_lib/quickcheck_lib.ml +++ b/src/lib/quickcheck_lib/quickcheck_lib.ml @@ -62,7 +62,7 @@ let gen_symm_dirichlet : int -> float list Quickcheck.Generator.t = (* technically this should be (0, 1] and not (0, 1) but I expect it doesn't matter for our purposes. *) let%map uniform = Float.gen_uniform_excl 0. 1. in - Float.log uniform) + Float.log uniform ) in let sum = List.fold gammas ~init:0. ~f:(fun x y -> x +. y) in List.map gammas ~f:(fun gamma -> gamma /. sum) @@ -151,11 +151,11 @@ let gen_imperative_rose_tree ?(p = 0.75) (root_gen : 'a t) in let%map forks = map_gens positive_fork_sizes ~f:(fun s -> - tuple2 node_gen (with_size ~size:(s - 1) self)) + tuple2 node_gen (with_size ~size:(s - 1) self) ) in fun parent -> Rose_tree.T - (parent, List.map forks ~f:(fun (this, f) -> f (this parent)))) + (parent, List.map forks ~f:(fun (this, f) -> f (this parent))) ) let gen_imperative_ktree ?(p = 0.75) (root_gen : 'a t) (node_gen : ('a -> 'a) t) = @@ -177,7 +177,7 @@ let gen_imperative_ktree ?(p = 0.75) (root_gen : 'a t) (node_gen : ('a -> 'a) t) in fun parent -> let x = this parent in - x :: List.bind forks ~f:(fun f -> f x)) + x :: List.bind forks ~f:(fun f -> f x) ) let gen_imperative_list (root_gen : 'a t) (node_gen : ('a -> 'a) t) = let%bind root = root_gen in @@ -188,7 +188,7 @@ let gen_imperative_list (root_gen : 'a t) (node_gen : ('a -> 'a) t) = | n -> let%bind this = node_gen in let%map f = with_size ~size:(n - 1) self in - fun parent -> parent :: f (this parent)) + fun parent -> parent :: f (this parent) ) let%test_module "Quickcheck lib tests" = ( module struct @@ -214,7 +214,7 @@ let%test_module "Quickcheck lib tests" = else Or_error.errorf !"elements do not add up correctly %d %d" - elem next_elem) + elem next_elem ) in - assert (Result.is_ok result)) + assert (Result.is_ok result) ) end ) diff --git a/src/lib/random_oracle_input/random_oracle_input.ml b/src/lib/random_oracle_input/random_oracle_input.ml index 1c4ec6d57b6..9ecd2083eb2 100644 --- a/src/lib/random_oracle_input/random_oracle_input.ml +++ b/src/lib/random_oracle_input/random_oracle_input.ml @@ -66,7 +66,7 @@ module Chunked = struct ~f:(fun (xs, acc, acc_n) (x, n) -> let n' = Int.(n + acc_n) in if Int.(n' < size_in_bits) then (xs, shift_left acc n + x, n') - else (acc :: xs, zero, 0)) + else (acc :: xs, zero, 0) ) in let xs = if acc_n > 0 then acc :: xs else xs in Array.of_list_rev xs @@ -105,7 +105,7 @@ module Legacy = struct let n = n + List.length bitstring in let bits = bits @ bitstring in let acc, bits, n = pack_full_fields acc bits n in - (acc, bits, n)) + (acc, bits, n) ) in if remaining_length = 0 then packed_field_elements else pack remaining_bits :: packed_field_elements @@ -162,7 +162,7 @@ module Legacy = struct in let combined = bs @ pad in assert (List.length combined = 8) ; - go 0 0 combined) + go 0 0 combined ) |> List.map ~f:Char.of_int_exn |> List.rev |> String.of_char_list in @@ -193,7 +193,7 @@ module Legacy = struct let run p cs = p cs |> M.bind ~f:(fun (a, cs') -> - match cs' with [] -> M.return a | _ -> M.fail `Expected_eof) + match cs' with [] -> M.return a | _ -> M.fail `Expected_eof ) let fail why _ = M.fail why @@ -236,7 +236,7 @@ module Legacy = struct | Error _ -> (acc, xs) in - M.return @@ go cs []) + M.return @@ go cs [] ) |> map ~f:List.rev let%test_unit "many" = @@ -255,7 +255,7 @@ module Legacy = struct let%bind a, xs = p xs in go xs (a :: acc) (i - 1) in - go cs [] n) + go cs [] n ) |> map ~f:List.rev let%test_unit "exactly" = @@ -323,7 +323,7 @@ module Legacy = struct let pad = List.init (8 - List.length xs) ~f:(Fn.const false) in let combined = xs @ pad in assert (List.length combined = 8) ; - go 0 0 combined) + go 0 0 combined ) |> List.map ~f:Char.of_int_exn |> String.of_char_list @@ -411,7 +411,7 @@ module Legacy = struct Coding2.serialize' input ~pack:Fn.id in let actual = Array.(concat [ prefix; middle; suffix ]) in - [%test_eq: bool list array] expected actual) + [%test_eq: bool list array] expected actual ) let%test_unit "field/string partial isomorphism bitstrings" = Quickcheck.test ~trials:300 @@ -422,7 +422,7 @@ module Legacy = struct Coding.field_of_string serialized ~size_in_bits:255 in [%test_eq: (bool list, unit) Result.t] (input |> Result.return) - deserialized) + deserialized ) let%test_unit "serialize/deserialize partial isomorphism 32byte fields" = let size_in_bits = 255 in @@ -448,17 +448,17 @@ module Legacy = struct in assert ( Array.for_all input.field_elements ~f:(fun el -> - List.length el = size_in_bits) ) ; + List.length el = size_in_bits ) ) ; Result.iter deserialized ~f:(fun x -> assert ( Array.for_all x.field_elements ~f:(fun el -> - List.length el = size_in_bits) )) ; + List.length el = size_in_bits ) ) ) ; [%test_eq: ( (bool list, bool) t , [ `Expected_eof | `Unexpected_eof ] ) Result.t] (normalized input |> Result.return) - (deserialized |> Result.map ~f:normalized)) + (deserialized |> Result.map ~f:normalized) ) let%test_unit "data is preserved by to_bits" = Quickcheck.test ~trials:300 (gen_input ()) @@ -473,7 +473,7 @@ module Legacy = struct *) let field_bits, rest = List.split_n bits size_in_bits in assert (bools_equal field_bits field) ; - rest) + rest ) in (* Bits come after. *) let remaining_bits = @@ -484,10 +484,10 @@ module Legacy = struct List.split_n bits (List.length bitstring) in assert (bools_equal bitstring_bits bitstring) ; - rest) + rest ) in (* All bits should have been consumed. *) - assert (List.is_empty remaining_bits)) + assert (List.is_empty remaining_bits) ) let%test_unit "data is preserved by pack_to_fields" = Quickcheck.test ~trials:300 (gen_input ()) @@ -506,7 +506,7 @@ module Legacy = struct failwith "Too few field elements" | field :: rest -> assert ([%equal: bool list] field input_field) ; - rest) + rest ) in (* Check that the remaining fields have the correct size. *) let final_field_idx = List.length bitstring_fields - 1 in @@ -523,7 +523,7 @@ module Legacy = struct maximum of [size_in_bits - 1]. It should not be empty. *) assert (not (List.is_empty field_bits)) ; - assert (List.length field_bits < size_in_bits) )) ; + assert (List.length field_bits < size_in_bits) ) ) ; let rec go input_bitstrings packed_fields = match (input_bitstrings, packed_fields) with | [], [] -> @@ -556,6 +556,6 @@ module Legacy = struct (* Check that the bits match between the input bitstring and the remaining fields. *) - go (Array.to_list input.bitstrings) bitstring_fields) + go (Array.to_list input.bitstrings) bitstring_fields ) end ) end diff --git a/src/lib/rc_pool/rc_pool.ml b/src/lib/rc_pool/rc_pool.ml index 18e30bb13fa..35f68466e41 100644 --- a/src/lib/rc_pool/rc_pool.ml +++ b/src/lib/rc_pool/rc_pool.ml @@ -40,7 +40,7 @@ module Make (Key : Hashable.S) (Data : Data_intf with type key := Key.t) : | None -> Some (Data.copy data, 1) | Some (d, n) -> - Some (d, n)) + Some (d, n) ) let free t key = Key.Table.change t key ~f:(function @@ -49,7 +49,7 @@ module Make (Key : Hashable.S) (Data : Data_intf with type key := Key.t) : | Some (_, 1) -> None | Some (d, n) -> - Some (d, n - 1)) + Some (d, n - 1) ) let find t key = Key.Table.find t key |> Option.map ~f:fst end diff --git a/src/lib/rocksdb/database.ml b/src/lib/rocksdb/database.ml index 45cf968f824..ea454b28a48 100644 --- a/src/lib/rocksdb/database.ml +++ b/src/lib/rocksdb/database.ml @@ -38,7 +38,7 @@ let set_batch t ?(remove_keys = []) let batch = Rocks.WriteBatch.create () in (* write to batch *) List.iter key_data_pairs ~f:(fun (key, data) -> - Rocks.WriteBatch.put batch key data) ; + Rocks.WriteBatch.put batch key data ) ; (* Delete any key pairs *) List.iter remove_keys ~f:(fun key -> Rocks.WriteBatch.delete batch key) ; (* commit batch *) @@ -100,7 +100,7 @@ let%test_unit "get_batch" = assert ([%equal: Bigstring.t option] res1 (Some data)) ; assert ([%equal: Bigstring.t option] res2 None) ; assert ([%equal: Bigstring.t option] res3 (Some data)) ; - Async.Deferred.unit)) + Async.Deferred.unit ) ) let%test_unit "to_alist (of_alist l) = l" = Async.Thread_safe.block_on_async_exn @@ -127,7 +127,7 @@ let%test_unit "to_alist (of_alist l) = l" = [%test_result: (Bigstring.t * Bigstring.t) list] ~expect:sorted alist ; close db ; - Async.Deferred.unit)) + Async.Deferred.unit ) ) let%test_unit "checkpoint read" = let open Async in @@ -149,7 +149,7 @@ let%test_unit "checkpoint read" = in let db = create db_dir in Hashtbl.iteri db_hashtbl ~f:(fun ~key ~data -> - set db ~key:(to_bigstring key) ~data:(to_bigstring data)) ; + set db ~key:(to_bigstring key) ~data:(to_bigstring data) ) ; let cp = create_checkpoint db cp_dir in match ( Hashtbl.add db_hashtbl ~key:"db_key" ~data:"db_data" @@ -186,4 +186,4 @@ let%test_unit "checkpoint read" = close cp ; Deferred.unit | _ -> - Deferred.unit )) + Deferred.unit ) ) diff --git a/src/lib/rocksdb/serializable.ml b/src/lib/rocksdb/serializable.ml index 155697dae14..d6ef26bac92 100644 --- a/src/lib/rocksdb/serializable.ml +++ b/src/lib/rocksdb/serializable.ml @@ -33,7 +33,7 @@ module Make (Key : Binable.S) (Value : Binable.S) : let key_data_pairs = List.map update_pairs ~f:(fun (key, data) -> ( Binable.to_bigstring (module Key) key - , Binable.to_bigstring (module Value) data )) + , Binable.to_bigstring (module Value) data ) ) in let remove_keys = List.map remove_keys ~f:(Binable.to_bigstring (module Key)) @@ -46,7 +46,7 @@ module Make (Key : Binable.S) (Value : Binable.S) : let to_alist t = List.map (Database.to_alist t) ~f:(fun (key, value) -> ( Binable.of_bigstring (module Key) key - , Binable.of_bigstring (module Value) value )) + , Binable.of_bigstring (module Value) value ) ) end (** Database Interface for storing heterogeneous key-value pairs. Similar to diff --git a/src/lib/rose_tree/rose_tree.ml b/src/lib/rose_tree/rose_tree.ml index c545f06012b..4b55de8d952 100644 --- a/src/lib/rose_tree/rose_tree.ml +++ b/src/lib/rose_tree/rose_tree.ml @@ -26,7 +26,8 @@ let rec of_list_exn ?(subtrees = []) = function | [] -> raise (Invalid_argument - "Rose_tree.of_list_exn: cannot construct rose tree from empty list") + "Rose_tree.of_list_exn: cannot construct rose tree from empty list" + ) | [ h ] -> T (h, subtrees) | h :: t -> @@ -36,7 +37,7 @@ let of_non_empty_list ?(subtrees = []) = Fn.compose (Non_empty_list.fold ~init:(fun x -> T (x, subtrees)) - ~f:(fun acc x -> T (x, [ acc ]))) + ~f:(fun acc x -> T (x, [ acc ])) ) Non_empty_list.rev let rec equal ~f (T (value1, children1)) (T (value2, children2)) = @@ -151,14 +152,14 @@ module Or_error = Make_ops (struct let iter ls ~f = List.fold_left ls ~init:(return ()) ~f:(fun or_error x -> let%bind () = or_error in - f x) + f x ) let map ls ~f = let%map ls' = List.fold_left ls ~init:(return []) ~f:(fun or_error x -> let%bind t = or_error in let%map x' = f x in - x' :: t) + x' :: t ) in List.rev ls' end diff --git a/src/lib/rosetta_coding/coding.ml b/src/lib/rosetta_coding/coding.ml index 88eb9810a21..b6346877ada 100644 --- a/src/lib/rosetta_coding/coding.ml +++ b/src/lib/rosetta_coding/coding.ml @@ -183,4 +183,4 @@ let unit_tests = let run_unit_tests () = List.iter unit_tests ~f:(fun (name, test) -> printf "Running %s test\n%!" name ; - assert (test ())) + assert (test ()) ) diff --git a/src/lib/rosetta_lib/amount_of.ml b/src/lib/rosetta_lib/amount_of.ml index 389c651b8a6..48b4a36b84f 100644 --- a/src/lib/rosetta_lib/amount_of.ml +++ b/src/lib/rosetta_lib/amount_of.ml @@ -27,8 +27,8 @@ module Token_id = struct "When metadata is provided for account identifiers, \ acceptable format is exactly { \"token_id\": \ }. You provided %s" - (Yojson.Safe.pretty_to_string bad)) - (`Json_parse None)) + (Yojson.Safe.pretty_to_string bad) ) + (`Json_parse None) ) | None -> M.return None end diff --git a/src/lib/rosetta_lib/errors.ml b/src/lib/rosetta_lib/errors.ml index f12e8281325..f8d92d6b26b 100644 --- a/src/lib/rosetta_lib/errors.ml +++ b/src/lib/rosetta_lib/errors.ml @@ -146,7 +146,7 @@ end = struct (sprintf !"You are requesting the status for the network %s, but you are \ connected to the network %s\n" - req conn) + req conn ) | `Chain_info_missing -> Some "Could not get chain information. This probably means you are \ @@ -158,7 +158,7 @@ end = struct (sprintf !"You attempted to lookup %s, but we couldn't find it in the \ ledger." - addr) + addr ) | `Invariant_violation -> None | `Transaction_not_found hash -> @@ -168,13 +168,13 @@ end = struct This may be due to its inclusion in a block -- try looking for \ this transaction in a recent block. It also could be due to the \ transaction being evicted from the mempool." - hash) + hash ) | `Block_missing s -> Some (sprintf "We couldn't find the block in the archive node, specified by %s. \ Ask a friend for the missing data." - s) + s ) | `Malformed_public_key -> None | `Operations_not_valid reasons -> @@ -182,7 +182,7 @@ end = struct (sprintf !"Cannot recover transaction for the following reasons: %{sexp: \ Partial_reason.t list}" - reasons) + reasons ) | `Public_key_format_not_valid -> None | `Unsupported_operation_for_construction -> @@ -330,7 +330,7 @@ end = struct "The minimum fee on transactions is %s . Please increase your fee to \ at least this amount." (Currency.Fee.to_formatted_string - Mina_compile_config.minimum_user_command_fee) + Mina_compile_config.minimum_user_command_fee ) | `Transaction_submit_invalid_signature -> "An invalid signature is attached to this transaction" | `Transaction_submit_insufficient_balance -> @@ -355,14 +355,14 @@ end = struct (`Assoc [ ("body", Variant.to_yojson t.kind) ; ("error", `String context) - ]) + ] ) | Some context1, Some context2 -> Some (`Assoc [ ("body", Variant.to_yojson t.kind) ; ("error", `String context1) ; ("extra", `String context2) - ]) ) + ] ) ) ; description = Some (description t.kind) } @@ -383,17 +383,17 @@ end = struct |> Lazy.map ~f:(fun vs -> List.map vs ~f:(Fn.compose erase create)) |> Lazy.map ~f:(fun es -> List.map es ~f:(fun e -> - { e with Rosetta_models.Error.details = None }) + { e with Rosetta_models.Error.details = None } ) |> uniq ~eq:(fun { Rosetta_models.Error.code; _ } { code = code2; _ } -> - Int32.equal code code2)) + Int32.equal code code2 ) ) module Lift = struct let parse ?context res = Deferred.return (Result.map_error ~f:(fun s -> create ?context (`Json_parse (Some s))) - res) + res ) let sql ?context res = Deferred.Result.map_error diff --git a/src/lib/rosetta_lib/transaction.ml b/src/lib/rosetta_lib/transaction.ml index d3f361e959b..3456e24fb66 100644 --- a/src/lib/rosetta_lib/transaction.ml +++ b/src/lib/rosetta_lib/transaction.ml @@ -73,7 +73,7 @@ module Unsigned = struct ~error: (Errors.create (`Operations_not_valid - [ Errors.Partial_reason.Amount_not_some ])) + [ Errors.Partial_reason.Amount_not_some ] ) ) in let payment = { Rendered.Payment.to_ = un_pk command.receiver @@ -159,7 +159,7 @@ module Unsigned = struct Random_oracle_input.Legacy.Coding.deserialize ~field_of_string ~of_bool:Fn.id (String.to_list - (Option.value_exn (Hex.Safe.of_hex r.random_oracle_input))) + (Option.value_exn (Hex.Safe.of_hex r.random_oracle_input)) ) |> Result.map_error ~f:(fun e -> let parse_context = match e with @@ -171,8 +171,8 @@ module Unsigned = struct Errors.create ~context: (sprintf "Random oracle input deserialization: %s" - parse_context) - (`Json_parse None)) + parse_context ) + (`Json_parse None) ) in match (r.payment, r.stake_delegation) with | Some payment, None -> @@ -190,7 +190,7 @@ module Unsigned = struct | _ -> Result.fail (Errors.create ~context:"Unsigned transaction un-rendering" - `Unsupported_operation_for_construction) + `Unsupported_operation_for_construction ) end module Signature = struct @@ -199,7 +199,7 @@ module Signature = struct |> Result.of_option ~error: (Errors.create ~context:"Signed transaction un-rendering" - `Unsupported_operation_for_construction) + `Unsupported_operation_for_construction ) let encode = Mina_base.Signature.Raw.encode end @@ -252,7 +252,7 @@ module Signed = struct | _ -> Result.fail (Errors.create ~context:"Signed transaction un-rendering" - `Unsupported_operation_for_construction) + `Unsupported_operation_for_construction ) let to_mina_signed t = Or_error.try_with_join (fun () -> @@ -272,7 +272,7 @@ module Signed = struct ; payload } in - command) + command ) end let to_mina_signed transaction_json = @@ -286,4 +286,4 @@ let to_mina_signed transaction_json = Signed.of_rendered rendered |> Result.map_error ~f:(fun err -> Error.of_string (Errors.show err)) in - Signed.to_mina_signed t) + Signed.to_mina_signed t ) diff --git a/src/lib/rosetta_lib/user_command_info.ml b/src/lib/rosetta_lib/user_command_info.ml index 4566b2765c6..e6625d6b2fe 100644 --- a/src/lib/rosetta_lib/user_command_info.ml +++ b/src/lib/rosetta_lib/user_command_info.ml @@ -12,7 +12,7 @@ module Stake_delegation = Mina_base.Stake_delegation let pk_to_public_key ~context (`Pk pk) = Public_key.Compressed.of_base58_check pk |> Result.map_error ~f:(fun _ -> - Errors.create ~context `Public_key_format_not_valid) + Errors.create ~context `Public_key_format_not_valid ) let account_id (`Pk pk) (`Token_id token_id) = { Account_identifier.address = pk @@ -46,14 +46,14 @@ module Op = struct let related_operations = op.related_to |> Option.bind ~f:(fun relate -> - List.findi plan ~f:(fun _ a -> a_eq relate a.label)) + List.findi plan ~f:(fun _ a -> a_eq relate a.label) ) |> Option.map ~f:(fun (i, _) -> [ operation_identifier i ]) in let%map a = f ~related_operations ~operation_identifier:(operation_identifier i) op in - (i + 1, a :: acc)) + (i + 1, a :: acc) ) in List.rev rev_data end @@ -153,7 +153,7 @@ module Partial = struct ~error: (Errors.create (`Operations_not_valid - [ Errors.Partial_reason.Amount_not_some ])) + [ Errors.Partial_reason.Amount_not_some ] ) ) in let payload = { Payment_payload.Poly.source_pk @@ -272,7 +272,7 @@ let of_operations ?memo ?valid_until (ops : Operation.t list) : if List.for_all ops ~f:(fun op -> let p = Option.equal String.equal op.status in - p None || p (Some "")) + p None || p (Some "") ) then V.return () else V.fail Status_not_pending and payment_amount_x = @@ -350,7 +350,7 @@ let of_operations ?memo ?valid_until (ops : Operation.t list) : if List.for_all ops ~f:(fun op -> let p = Option.equal String.equal op.status in - p None || p (Some "")) + p None || p (Some "") ) then V.return () else V.fail Status_not_pending and payment_amount_y = @@ -537,9 +537,9 @@ let to_operations ~failure_status (t : Partial.t) : Operation.t list = [ ( "delegate_change_target" , `String (let (`Pk r) = t.receiver in - r) ) - ])) - }) + r ) ) + ] ) ) + } ) let to_operations' (t : t) : Operation.t list = to_operations ~failure_status:t.failure_status (forget t) @@ -624,7 +624,7 @@ let dummies = Some (`Applied (Account_creation_fees_paid.By_receiver - (Unsigned.UInt64.of_int 1_000_000))) + (Unsigned.UInt64.of_int 1_000_000) ) ) ; hash = "TXN_1new_HASH" ; valid_until = None ; memo = Some "hello" diff --git a/src/lib/rosetta_models/coin_change.ml b/src/lib/rosetta_models/coin_change.ml index 423fab472fd..d4c7f68fd47 100644 --- a/src/lib/rosetta_models/coin_change.ml +++ b/src/lib/rosetta_models/coin_change.ml @@ -10,6 +10,6 @@ type t = { coin_identifier : Coin_identifier.t; coin_action : Enums.coinaction } [@@deriving yojson { strict = false }, show, eq] (** CoinChange is used to represent a change in state of a some coin identified by a coin_identifier. This object is part of the Operation model and must be populated for UTXO-based blockchains. Coincidentally, this abstraction of UTXOs allows for supporting both account-based transfers and UTXO-based transfers on the same blockchain (when a transfer is account-based, don't populate this model). *) -let create (coin_identifier : Coin_identifier.t) - (coin_action : Enums.coinaction) : t = +let create (coin_identifier : Coin_identifier.t) (coin_action : Enums.coinaction) + : t = { coin_identifier; coin_action } diff --git a/src/lib/runtime_config/runtime_config.ml b/src/lib/runtime_config/runtime_config.ml index be354f9e8fa..0b9fd5b3efd 100644 --- a/src/lib/runtime_config/runtime_config.ml +++ b/src/lib/runtime_config/runtime_config.ml @@ -13,7 +13,7 @@ let yojson_strip_fields ~keep_fields = function | `Assoc l -> `Assoc (List.filter l ~f:(fun (fld, _) -> - Array.mem ~equal:String.equal keep_fields fld)) + Array.mem ~equal:String.equal keep_fields fld ) ) | json -> json @@ -24,9 +24,9 @@ let yojson_rename_fields ~alternates = function let fld = Option.value ~default:fld (Array.find_map alternates ~f:(fun (alt, orig) -> - if String.equal fld alt then Some orig else None)) + if String.equal fld alt then Some orig else None ) ) in - (fld, json))) + (fld, json) ) ) | json -> json @@ -42,7 +42,7 @@ let result_opt ~f x = let dump_on_error yojson x = Result.map_error x ~f:(fun str -> - str ^ "\n\nCould not parse JSON:\n" ^ Yojson.Safe.pretty_to_string yojson) + str ^ "\n\nCould not parse JSON:\n" ^ Yojson.Safe.pretty_to_string yojson ) let of_yojson_generic ~fields of_yojson json = dump_on_error json @@ of_yojson @@ -549,7 +549,7 @@ module Accounts = struct | Ok x -> x | Error err -> - raise (Stop err)) + raise (Stop err) ) with Stop err -> Error err let to_yojson x = Json_layout.Accounts.to_yojson (to_json_layout x) @@ -580,7 +580,7 @@ module Ledger = struct Json_layout.Ledger.t = let balances = List.map balances ~f:(fun (number, balance) -> - { Json_layout.Ledger.Balance_spec.number; balance }) + { Json_layout.Ledger.Balance_spec.number; balance } ) in let without_base : Json_layout.Ledger.t = { accounts = None @@ -601,7 +601,7 @@ module Ledger = struct let of_json_layout ({ accounts; num_accounts; balances; hash; name; add_genesis_winner } : - Json_layout.Ledger.t) : (t, string) Result.t = + Json_layout.Ledger.t ) : (t, string) Result.t = let open Result.Let_syntax in let%map base = match accounts with @@ -624,7 +624,7 @@ module Ledger = struct let balances = List.map balances ~f:(fun { Json_layout.Ledger.Balance_spec.number; balance } -> - (number, balance)) + (number, balance) ) in { base; num_accounts; balances; hash; name; add_genesis_winner } @@ -662,7 +662,7 @@ module Proof_keys = struct let of_json_layout str = Result.map_error (of_string str) ~f:(fun err -> "Runtime_config.Proof_keys.Level.of_json_layout: Could not decode \ - field 'level'. " ^ err) + field 'level'. " ^ err ) let to_yojson x = `String (to_json_layout x) @@ -890,7 +890,7 @@ module Epoch_data = struct Option.map next ~f:(fun n -> { Json_layout.Epoch_data.Data.accounts = accounts n.ledger ; seed = n.seed - }) + } ) in { Json_layout.Epoch_data.staking; next } diff --git a/src/lib/secrets/hardware_wallets.ml b/src/lib/secrets/hardware_wallets.ml index 678ac4fc0b9..dabee27a756 100644 --- a/src/lib/secrets/hardware_wallets.ml +++ b/src/lib/secrets/hardware_wallets.ml @@ -32,7 +32,7 @@ let decode_field (type field) (module Tick : Tick_intf with type field = field) |> B58.decode Base58_check.mina_alphabet |> Bytes.to_list |> List.rev |> Bytes.of_char_list |> Bytes.to_string |> String.foldi ~init:Bigint.zero ~f:(fun i acc byte -> - Bigint.(acc lor (of_int (Char.to_int byte) lsl Int.( * ) 8 i))) + Bigint.(acc lor (of_int (Char.to_int byte) lsl Int.( * ) 8 i)) ) |> Tick.Bigint.of_bignum_bigint |> Tick.Bigint.to_field type public_key = { status : string; x : string; y : string } @@ -66,7 +66,7 @@ let decode_public_key : string -> (Public_key.t, string) Result.t = |> Result.bind ~f:(fun { status; x; y } -> decode_status_code status ~f:(fun () -> ( decode_field (module Snark_params.Tick) x - , decode_field (module Snark_params.Tick) y ))) + , decode_field (module Snark_params.Tick) y ) ) ) type signature = { status : string; field : string; scalar : string } [@@deriving yojson] @@ -79,7 +79,7 @@ let decode_signature : string -> (Signature.t, string) Result.t = |> Result.bind ~f:(fun { status; field; scalar } -> decode_status_code status ~f:(fun () -> ( decode_field (module Snark_params.Tick) field - , decode_field (module Snark_params.Tock) scalar ))) + , decode_field (module Snark_params.Tock) scalar ) ) ) let compute_public_key ~hd_index = let prog, args = diff --git a/src/lib/secrets/keypair_common.ml b/src/lib/secrets/keypair_common.ml index 1736bcd0d4b..26df7bd2efa 100644 --- a/src/lib/secrets/keypair_common.ml +++ b/src/lib/secrets/keypair_common.ml @@ -46,7 +46,7 @@ struct read_privkey ( lazy (Password.read_hidden_line ~error_help_message:"" - "Private-key password: ") ) + "Private-key password: " ) ) in let rec read_until_correct () = match%bind read_file () with diff --git a/src/lib/secrets/keypair_read_write.ml b/src/lib/secrets/keypair_read_write.ml index 7eac9985972..d82dfa4d387 100644 --- a/src/lib/secrets/keypair_read_write.ml +++ b/src/lib/secrets/keypair_read_write.ml @@ -57,7 +57,7 @@ struct with exn -> Privkey_error.corrupted_privkey (Error.createf "Error parsing decrypted private key file: %s" - (Exn.to_string exn)) + (Exn.to_string exn) ) in try return (Keypair.of_private_key_exn sk) with exn -> @@ -65,7 +65,7 @@ struct (Error.createf "Error computing public key from private, is your keyfile \ corrupt? %s" - (Exn.to_string exn)) + (Exn.to_string exn) ) (** Reads a private key from [privkey_path] using [Secret_file], throws on failure *) let read_exn ~(privkey_path : string) ~(password : Secret_file.password) : @@ -88,7 +88,7 @@ struct in lazy (Password.read_hidden_line ~error_help_message - "Secret key password: ") + "Secret key password: " ) in read_exn ~privkey_path:path ~password end diff --git a/src/lib/secrets/secret_box.ml b/src/lib/secrets/secret_box.ml index 201507f2a44..1d0ba889f30 100644 --- a/src/lib/secrets/secret_box.ml +++ b/src/lib/secrets/secret_box.ml @@ -18,7 +18,7 @@ module BytesWr = struct | Error e -> Error (sprintf "Bytes.of_yojson, bad Base58Check: %s" - (Error.to_string_hum e)) + (Error.to_string_hum e) ) | Ok x -> Ok (Bytes.of_string x) ) | _ -> @@ -110,13 +110,13 @@ let decrypt ~(password : Bytes.t) (`Corrupted_privkey (Error.createf !"don't know how to handle a %s secret_box" - box_primitive)) + box_primitive ) ) else if not (String.equal pw_primitive Password_hash.primitive) then Error (`Corrupted_privkey (Error.createf !"don't know how to handle a %s password_hash" - pw_primitive)) + pw_primitive ) ) else let nonce = Secret_box.Bytes.to_nonce nonce in let salt = Password_hash.Bytes.to_salt pwsalt in @@ -136,7 +136,7 @@ let%test_unit "successful roundtrip" = ~f:(fun (password, plaintext) -> let enc = encrypt ~password:(Bytes.copy password) ~plaintext in let dec = Option.value_exn (decrypt enc ~password |> Result.ok) in - [%test_eq: Bytes.t] dec plaintext) + [%test_eq: Bytes.t] dec plaintext ) let%test "bad password fails" = let enc = diff --git a/src/lib/secrets/secret_file.ml b/src/lib/secrets/secret_file.ml index 17756f3c68d..a94f70b70d0 100644 --- a/src/lib/secrets/secret_file.ml +++ b/src/lib/secrets/secret_file.ml @@ -20,7 +20,7 @@ let handle_open ~mkdir ~(f : string -> 'a Deferred.t) path = corrupted_privkey (Error.createf "%s exists and it is not a directory, can't store files there" - dn)) + dn ) ) with | Ok x -> return x @@ -44,7 +44,7 @@ let handle_open ~mkdir ~(f : string -> 'a Deferred.t) path = Deferred.Result.return () else if not parent_exists then Deferred.return (Error (`Parent_directory_does_not_exist dn)) - else Deferred.Result.return ()) + else Deferred.Result.return () ) with | Ok x -> Deferred.return x @@ -57,7 +57,7 @@ let handle_open ~mkdir ~(f : string -> 'a Deferred.t) path = let open Deferred.Let_syntax in match%bind Deferred.Or_error.try_with ~here:[%here] ~extract_exn:true (fun () -> - f path) + f path ) with | Ok x -> Deferred.Result.return x @@ -102,7 +102,7 @@ let read ~path ~(password : Bytes.t Deferred.t Lazy.t) = (sprintf "insecure permissions on `%s`. They should be 0600, they are %o\n\ Hint: chmod 600 %s\n" - path (st.perm land 0o777) path) + path (st.perm land 0o777) path ) else None in let dn = Filename.dirname path in @@ -113,7 +113,7 @@ let read ~path ~(password : Bytes.t Deferred.t Lazy.t) = (sprintf "insecure permissions on `%s`. They should be 0700, they are %o\n\ Hint: chmod 700 %s\n" - dn (st.perm land 0o777) dn) + dn (st.perm land 0o777) dn ) else None in let%bind () = @@ -133,7 +133,7 @@ let read ~path ~(password : Bytes.t Deferred.t Lazy.t) = | Error e -> Deferred.return (Privkey_error.corrupted_privkey - (Error.createf "couldn't parse %s: %s" path e)) + (Error.createf "couldn't parse %s: %s" path e) ) in let%bind password = lift (Lazy.force password) in Deferred.return (Secret_box.decrypt ~password sb) diff --git a/src/lib/secrets/wallets.ml b/src/lib/secrets/wallets.ml index e9054d747f5..5f2d079c378 100644 --- a/src/lib/secrets/wallets.ml +++ b/src/lib/secrets/wallets.ml @@ -24,7 +24,7 @@ let get_path { path; cache } public_key = Option.return file | Hd_account _ -> Option.return - (Public_key.Compressed.to_base58_check public_key ^ ".index")) + (Public_key.Compressed.to_base58_check public_key ^ ".index") ) |> Option.value ~default:(get_privkey_filename public_key) in path ^/ filename @@ -62,7 +62,7 @@ let reload ~logger { cache; path } : unit Deferred.t = |> Option.iter ~f:(fun pk -> ignore @@ Public_key.Compressed.Table.add cache ~key:pk - ~data:(Locked sk_filename)) + ~data:(Locked sk_filename) ) | _ -> () ) | None -> ( @@ -77,11 +77,12 @@ let reload ~logger { cache; path } : unit Deferred.t = @@ Public_key.Compressed.Table.add cache ~key:pk ~data: (Hd_account - (Mina_numbers.Hd_index.of_string hd_index))) + (Mina_numbers.Hd_index.of_string hd_index) + ) ) | _ -> () ) | None -> - return () )) + return () ) ) in Unix.chmod path ~perm:0o700 @@ -107,11 +108,11 @@ let import_keypair_helper t keypair write_keypair = let import_keypair t keypair ~password = import_keypair_helper t keypair (fun privkey_path -> - Secret_keypair.write_exn keypair ~privkey_path ~password) + Secret_keypair.write_exn keypair ~privkey_path ~password ) let import_keypair_terminal_stdin t keypair = import_keypair_helper t keypair (fun privkey_path -> - Secret_keypair.Terminal_stdin.write_exn keypair ~privkey_path) + Secret_keypair.Terminal_stdin.write_exn keypair ~privkey_path ) (** Generates a new private key file and a keypair *) let generate_new t ~password : Public_key.Compressed.t Deferred.t = @@ -143,7 +144,7 @@ let delete ({ cache; _ } as t : t) (pk : Public_key.Compressed.t) : (unit, [ `Not_found ]) Deferred.Result.t = Hashtbl.remove cache pk ; Deferred.Or_error.try_with ~here:[%here] (fun () -> - Unix.remove (get_path t pk)) + Unix.remove (get_path t pk) ) |> Deferred.Result.map_error ~f:(fun _ -> `Not_found) let pks ({ cache; _ } : t) = Public_key.Compressed.Table.keys cache @@ -156,7 +157,7 @@ let find_unlocked ({ cache; _ } : t) ~needle = | Unlocked (_, kp) -> Some kp | Hd_account _ -> - None) + None ) let find_identity ({ cache; _ } : t) ~needle = Public_key.Compressed.Table.find cache needle @@ -166,7 +167,7 @@ let find_identity ({ cache; _ } : t) ~needle = | Unlocked (_, kp) -> Some (`Keypair kp) | Hd_account index -> - Some (`Hd_index index)) + Some (`Hd_index index) ) let check_locked { cache; _ } ~needle = Public_key.Compressed.Table.find cache needle @@ -176,7 +177,7 @@ let check_locked { cache; _ } ~needle = | Unlocked _ -> false | Hd_account _ -> - true) + true ) let unlock { cache; path } ~needle ~password = let unlock_keypair = function @@ -185,7 +186,7 @@ let unlock { cache; path } ~needle ~password = |> Deferred.Result.map_error ~f:(fun e -> `Key_read_error e) |> Deferred.Result.map ~f:(fun kp -> Public_key.Compressed.Table.set cache ~key:needle - ~data:(Unlocked (file, kp))) + ~data:(Unlocked (file, kp)) ) |> Deferred.Result.ignore_m | Unlocked _ -> Deferred.Result.return () @@ -202,7 +203,7 @@ let lock { cache; _ } ~needle = | Some (Unlocked (file, _)) -> Some (Locked file) | k -> - k) + k ) let get_tracked_keypair ~logger ~which ~read_from_env_exn ~conf_dir pk = let%bind wallets = load ~logger ~disk_location:(conf_dir ^/ "wallets") in @@ -224,7 +225,7 @@ let%test_module "wallets" = let%map pk = generate_new wallets ~password in let keys = Set.of_list (pks wallets) in assert (Set.mem keys pk) ; - assert (find_unlocked wallets ~needle:pk |> Option.is_some))) + assert (find_unlocked wallets ~needle:pk |> Option.is_some) ) ) let%test_unit "get from existing file system not-scratch" = Backtrace.elide := false ; @@ -238,7 +239,7 @@ let%test_module "wallets" = (* Get wallets again from scratch *) let%map wallets = load ~logger ~disk_location:path in let keys = Set.of_list (pks wallets) in - assert (Set.mem keys pk1 && Set.mem keys pk2))) + assert (Set.mem keys pk1 && Set.mem keys pk2) ) ) let%test_unit "create wallet then delete it" = Async.Thread_safe.block_on_async_exn (fun () -> @@ -253,7 +254,7 @@ let%test_module "wallets" = Option.is_none @@ Public_key.Compressed.Table.find wallets.cache pk ) | Error _ -> - failwith "unexpected")) + failwith "unexpected" ) ) let%test_unit "Unable to find wallet" = Async.Thread_safe.block_on_async_exn (fun () -> @@ -263,5 +264,5 @@ let%test_module "wallets" = let%map result = delete wallets (Public_key.compress @@ keypair.public_key) in - assert (Result.is_error result))) + assert (Result.is_error result) ) ) end ) diff --git a/src/lib/sgn/sgn.ml b/src/lib/sgn/sgn.ml index 59a35006a22..d20591730b1 100644 --- a/src/lib/sgn/sgn.ml +++ b/src/lib/sgn/sgn.ml @@ -15,7 +15,7 @@ end] let gen = Quickcheck.Generator.map Bool.quickcheck_generator ~f:(fun b -> - if b then Pos else Neg) + if b then Pos else Neg ) let negate = function Pos -> Neg | Neg -> Pos diff --git a/src/lib/signature_lib/find_address/find_address.ml b/src/lib/signature_lib/find_address/find_address.ml index a43648651aa..9470b486655 100644 --- a/src/lib/signature_lib/find_address/find_address.ml +++ b/src/lib/signature_lib/find_address/find_address.ml @@ -202,7 +202,7 @@ let changed_prefixes = *) let true_prefixes = List.map changed_prefixes ~f:(fun c -> - fixed_prefix ^ String.of_char (Char.of_int_exn c) ^ desired_prefix) + fixed_prefix ^ String.of_char (Char.of_int_exn c) ^ desired_prefix ) (** Compute the list of powers of 2 that fit inside the Pallas base field. @@ -246,7 +246,7 @@ let field_elements = in -String.compare (Public_key.Compressed.to_base58_check pk1) - (Public_key.Compressed.to_base58_check pk2)) + (Public_key.Compressed.to_base58_check pk2) ) (** Find a 'base' public key to start searching from. @@ -304,7 +304,7 @@ let find_base_pk prefix = Stop searching, and return the previous best, along with the count of field elements that we have already considered. *) - Stop (Some (pk, i))) + Stop (Some (pk, i)) ) (** Compute the next bitstring, reverse-lexicographically. Equivalent to adding 1 bitwise. @@ -368,7 +368,7 @@ let print_values prefix = List.fold2_exn ~init:base_pk.x field_elements field_selectors ~f:(fun field selected_field selected -> if selected then Snark_params.Tick.Field.add field selected_field - else field) + else field ) in (* Test both odd and even versions of the public key. *) let pk_odd = { base_pk with x = field } in @@ -386,6 +386,6 @@ let print_values prefix = () in if debug then Format.eprintf "Keys for %s:@." prefix ; - go field_selectors) + go field_selectors ) let () = List.iter ~f:print_values true_prefixes diff --git a/src/lib/signature_lib/private_key.ml b/src/lib/signature_lib/private_key.ml index 4bd67f05b9f..0812de02d70 100644 --- a/src/lib/signature_lib/private_key.ml +++ b/src/lib/signature_lib/private_key.ml @@ -102,7 +102,8 @@ let create () : t = Snarkette.Pasta.Fq.of_bigint (Snarkette.Nat.of_bytes (String.init 32 ~f:(fun i -> - Char.of_int_exn (Js.Optdef.get (Js.array_get x i) byte_undefined)))) + Char.of_int_exn (Js.Optdef.get (Js.array_get x i) byte_undefined) ) + ) ) [%%endif] diff --git a/src/lib/signature_lib/schnorr.ml b/src/lib/signature_lib/schnorr.ml index 1f8e5e311f2..2d9c6baf97c 100644 --- a/src/lib/signature_lib/schnorr.ml +++ b/src/lib/signature_lib/schnorr.ml @@ -300,7 +300,7 @@ module Make let%snarkydef verifier (type s) ~equal ~final_check ((module Shifted) as shifted : - (module Curve.Checked.Shifted.S with type t = s)) + (module Curve.Checked.Shifted.S with type t = s) ) ((r, s) : Signature.var) (public_key : Public_key.var) (m : Message.var) = let%bind e = Message.hash_checked m ~public_key ~r in @@ -335,7 +335,7 @@ end (* nonconsensus version of the functor; yes, there's some repeated code, but seems difficult to abstract over the functors and signatures - *) +*) module type S = sig open Snark_params.Tick @@ -563,7 +563,7 @@ module Message = struct let open Random_oracle.Legacy.Checked in hash ~init:Hash_prefix_states.signature_legacy (pack_input input) |> Digest.to_bits ~length:Field.size_in_bits - |> Bitstring_lib.Bitstring.Lsb_first.of_list) + |> Bitstring_lib.Bitstring.Lsb_first.of_list ) [%%endif] end @@ -631,7 +631,7 @@ module Message = struct let open Random_oracle.Checked in hash ~init:Hash_prefix_states.signature (pack_input input) |> Digest.to_bits ~length:Field.size_in_bits - |> Bitstring_lib.Bitstring.Lsb_first.of_list) + |> Bitstring_lib.Bitstring.Lsb_first.of_list ) [%%endif] end @@ -681,8 +681,7 @@ let chunked_message_typ () : (Message.Chunked.var, Message.Chunked.t) Tick.Typ.t ; value_of_fields = (fun (_, t) -> t) ; size_in_field_elements = 0 ; constraint_system_auxiliary = - (fun () -> - failwith "Cannot create constant in constraint-system mode") + (fun () -> failwith "Cannot create constant in constraint-system mode") } in let to_hlist { Random_oracle.Input.Chunked.field_elements; packeds } = @@ -713,9 +712,9 @@ let%test_unit "schnorr checked + unchecked" = let%bind (module Shifted) = Tick.Inner_curve.Checked.Shifted.create () in - Legacy.Checked.verifies (module Shifted) s public_key msg) - (fun _ -> true)) - (pubkey, msg, s)) + Legacy.Checked.verifies (module Shifted) s public_key msg ) + (fun _ -> true) ) + (pubkey, msg, s) ) let%test_unit "schnorr checked + unchecked" = Quickcheck.test ~trials:5 gen_chunked ~f:(fun (pk, msg) -> @@ -732,8 +731,8 @@ let%test_unit "schnorr checked + unchecked" = let%bind (module Shifted) = Tick.Inner_curve.Checked.Shifted.create () in - Chunked.Checked.verifies (module Shifted) s public_key msg) - (fun _ -> true)) - (pubkey, msg, s)) + Chunked.Checked.verifies (module Shifted) s public_key msg ) + (fun _ -> true) ) + (pubkey, msg, s) ) [%%endif] diff --git a/src/lib/signature_lib/test/signature_lib_tests.ml b/src/lib/signature_lib/test/signature_lib_tests.ml index 8a7fce6b7eb..4f366aac6f0 100644 --- a/src/lib/signature_lib/test/signature_lib_tests.ml +++ b/src/lib/signature_lib/test/signature_lib_tests.ml @@ -26,7 +26,7 @@ let%test_module "Signatures are unchanged test" = let signature_got = Schnorr.Legacy.sign privkey (Random_oracle_input.Legacy.field_elements - [| fst signature_expected |]) + [| fst signature_expected |] ) in let signature_expected = ( Snark_params.Tick.Field.of_string diff --git a/src/lib/snark_bits/bits.ml b/src/lib/snark_bits/bits.ml index a7f20870c39..8a9630ad3b5 100644 --- a/src/lib/snark_bits/bits.ml +++ b/src/lib/snark_bits/bits.ml @@ -7,7 +7,7 @@ open Fold_lib open Bitstring_lib (* Someday: Make more efficient by giving Field.unpack a length argument in -camlsnark *) + camlsnark *) let unpack_field unpack ~bit_length x = List.take (unpack x) bit_length let bits_per_char = 8 @@ -72,7 +72,7 @@ module Vector = struct let rec go acc i = if i = V.length then acc else go (f acc (V.get t i)) (i + 1) in - go init 0) + go init 0 ) } let iter t ~f = @@ -120,7 +120,7 @@ module Make_field0 if i = bit_length then acc else go (f acc (Bigint.test_bit n i)) (i + 1) in - go init 0) + go init 0 ) } let iter t ~f = @@ -213,10 +213,10 @@ module Snarkable = struct in go (Field.add two_to_the_i two_to_the_i) (i + 1) acc in - go Field.one 0 Field.zero) + go Field.one 0 Field.zero ) ~back:(fun t -> let n = Bigint.of_field t in - init ~f:(fun i -> Bigint.test_bit n i)) + init ~f:(fun i -> Bigint.test_bit n i) ) let size_in_bits = size_in_bits end @@ -226,7 +226,7 @@ module Snarkable = struct let v_of_list vs = List.foldi vs ~init:V.empty ~f:(fun i acc b -> - if i < V.length then V.set acc i b else acc) + if i < V.length then V.set acc i b else acc ) let pack_var = Field.Var.project @@ -288,7 +288,7 @@ module Snarkable = struct : Unpacked.var Checked.t = match List.map2 then_ else_ ~f:(fun then_ else_ -> - Boolean.if_ cond ~then_ ~else_) + Boolean.if_ cond ~then_ ~else_ ) with | Ok result -> Checked.List.all result diff --git a/src/lib/snark_keys/gen_keys/gen_keys.ml b/src/lib/snark_keys/gen_keys/gen_keys.ml index 3b7f0b62d35..3310829005c 100644 --- a/src/lib/snark_keys/gen_keys/gen_keys.ml +++ b/src/lib/snark_keys/gen_keys/gen_keys.ml @@ -33,7 +33,7 @@ let from_disk_expr ~loc id = (Sexp.of_string_conv_exn [%e estring (Pickles.Verification_key.Id.sexp_of_t id |> Sexp.to_string)] - Pickles.Verification_key.Id.t_of_sexp) + Pickles.Verification_key.Id.t_of_sexp ) >>| Or_error.ok_exn in t] @@ -160,7 +160,7 @@ let str ~proof_level ~constraint_constants ~loc = ( Pickles.Verification_key.Id.sexp_of_t (Lazy.force B.Proof.id) |> Sexp.to_string )] - Pickles.Verification_key.Id.t_of_sexp) + Pickles.Verification_key.Id.t_of_sexp ) in fun () -> Lazy.force t] ~transaction_snark:(from_disk_expr ~loc (Lazy.force T.id)) @@ -173,7 +173,7 @@ let str ~proof_level ~constraint_constants ~loc = (str ~loc ~constraint_constants ~blockchain_verification_key_id: [%expr Pickles.Verification_key.Id.dummy] ~transaction_snark:e - ~blockchain_snark:e) + ~blockchain_snark:e ) let main () = (* Wrap any junk we print to stdout in a comment.. *) diff --git a/src/lib/snark_keys_header/snark_keys_header.ml b/src/lib/snark_keys_header/snark_keys_header.ml index 642ff1deda1..e34b387c773 100644 --- a/src/lib/snark_keys_header/snark_keys_header.ml +++ b/src/lib/snark_keys_header/snark_keys_header.ml @@ -22,7 +22,7 @@ module UInt64 = struct sprintf "Snark_keys_header.UInt64.of_yojson: Could not parse string \ as UInt64: %s" - (Error.to_string_hum err)) + (Error.to_string_hum err) ) | _ -> Error "Snark_keys_header.UInt64.of_yojson: Expected a string" @@ -118,7 +118,7 @@ module Constraint_constants = struct ; fork : (Fork_config.t option [@to_yojson Fork_config.opt_to_yojson] - [@of_yojson Fork_config.opt_of_yojson]) + [@of_yojson Fork_config.opt_of_yojson] ) } [@@deriving yojson, sexp, ord, equal] end @@ -152,7 +152,7 @@ let parse_prefix (lexbuf : Lexing.lexbuf) = let open Or_error.Let_syntax in Result.map_error ~f:(fun err -> Error.tag_arg err "Could not read prefix" ("prefix", prefix) - [%sexp_of: string * string]) + [%sexp_of: string * string] ) @@ Or_error.try_with_join (fun () -> (* This roughly mirrors the behavior of [Yojson.Safe.read_ident], except that we have a known fixed length to parse, and that it is a @@ -202,7 +202,7 @@ let parse_prefix (lexbuf : Lexing.lexbuf) = ; pos_cnum = lexbuf.lex_curr_p.pos_cnum + prefix_len } ; (* This matches the action given by [Yojson.Safe.read_ident]. *) - lexbuf.lex_last_action <- 1) + lexbuf.lex_last_action <- 1 ) let parse_lexbuf (lexbuf : Lexing.lexbuf) = let open Or_error.Let_syntax in @@ -214,7 +214,7 @@ let parse_lexbuf (lexbuf : Lexing.lexbuf) = 'greedy' parsing that will attempt to continue and read the file's contents beyond the header. *) - Yojson.Safe.read_t yojson_parsebuffer lexbuf) + Yojson.Safe.read_t yojson_parsebuffer lexbuf ) let%test_module "Check parsing of header" = ( module struct @@ -334,7 +334,7 @@ let%test_module "Check parsing of header" = Bytes.From_string.blit ~src:str ~src_pos:!offset ~dst:buffer ~dst_pos:0 ~len ; offset := !offset + len ; - len )) + len ) ) in (* Load the initial content into the buffer *) lexbuf.refill_buff lexbuf ; @@ -391,7 +391,7 @@ let write_with_header ~expected_max_size_log2 ~append_data header filename = (* Newline, to allow [head -n 2 path/to/file | tail -n 1] to easily extract the header. *) - Out_channel.output_char out_channel '\n') ; + Out_channel.output_char out_channel '\n' ) ; append_data filename ; (* Core doesn't let us open a file without appending or truncating, so we use stdlib instead. @@ -455,4 +455,4 @@ let read_with_header ~read_data filename = [%sexp_of: (string * int) * (string * int)] in let%map data = Or_error.try_with (fun () -> read_data ~offset filename) in - (header, data)) + (header, data) ) diff --git a/src/lib/snark_params/snark_params.ml b/src/lib/snark_params/snark_params.ml index 628361a2b27..16b8ea2889b 100644 --- a/src/lib/snark_params/snark_params.ml +++ b/src/lib/snark_params/snark_params.ml @@ -57,7 +57,7 @@ let%test_unit "group-map test" = (module M) ~params (M.Field.constant t) in - fun () -> M.As_prover.(read_var x, read_var y)) + fun () -> M.As_prover.(read_var x, read_var y) ) |> Or_error.ok_exn in let ((x, y) as actual) = @@ -69,7 +69,7 @@ let%test_unit "group-map test" = + (Tick0.Inner_curve.Params.a * x) + Tick0.Inner_curve.Params.b) Tick0.Field.(y * y) ; - [%test_eq: Tick0.Field.t * Tick0.Field.t] checked_output actual) + [%test_eq: Tick0.Field.t * Tick0.Field.t] checked_output actual ) module Make_inner_curve_scalar (Impl : Snark_intf.S) (Other_impl : Snark_intf.S) = struct @@ -91,13 +91,13 @@ struct Typ.transport_var (Typ.transport (Typ.list ~length:size_in_bits Boolean.typ) - ~there:unpack ~back:project) + ~there:unpack ~back:project ) ~there:Bitstring.Lsb_first.to_list ~back:Bitstring.Lsb_first.of_list let gen : t Quickcheck.Generator.t = Quickcheck.Generator.map (Bignum_bigint.gen_incl Bignum_bigint.one - Bignum_bigint.(Other_impl.Field.size - one)) + Bignum_bigint.(Other_impl.Field.size - one) ) ~f:(fun x -> Other_impl.Bigint.(to_field (of_bignum_bigint x))) let test_bit x i = Other_impl.Bigint.(test_bit (of_field x) i) @@ -138,29 +138,31 @@ module Tock = struct module Inner_curve = struct include Tock0.Inner_curve - include Sexpable.Of_sexpable - (struct - type t = Field.t * Field.t [@@deriving sexp] - end) - (struct - type nonrec t = t + include + Sexpable.Of_sexpable + (struct + type t = Field.t * Field.t [@@deriving sexp] + end) + (struct + type nonrec t = t - let to_sexpable = to_affine_exn + let to_sexpable = to_affine_exn - let of_sexpable = of_affine - end) + let of_sexpable = of_affine + end) include Make_inner_curve_aux (Tock0) (Tick0) module Checked = struct - include Snarky_curves.Make_weierstrass_checked (Fq) (Scalar) - (struct - include Tock0.Inner_curve - end) - (Params) - (struct - let add = None - end) + include + Snarky_curves.Make_weierstrass_checked (Fq) (Scalar) + (struct + include Tock0.Inner_curve + end) + (Params) + (struct + let add = None + end) let add_known_unsafe t x = add_unsafe t (constant x) end @@ -189,31 +191,33 @@ module Tick = struct module Inner_curve = struct include Crypto_params.Tick.Inner_curve - include Sexpable.Of_sexpable - (struct - type t = Field.t * Field.t [@@deriving sexp] - end) - (struct - type nonrec t = t + include + Sexpable.Of_sexpable + (struct + type t = Field.t * Field.t [@@deriving sexp] + end) + (struct + type nonrec t = t - let to_sexpable = to_affine_exn + let to_sexpable = to_affine_exn - let of_sexpable = of_affine - end) + let of_sexpable = of_affine + end) include Make_inner_curve_aux (Tick0) (Tock0) module Checked = struct - include Snarky_curves.Make_weierstrass_checked (Fq) (Scalar) - (Crypto_params.Tick.Inner_curve) - (Params) - (struct - let add = - Some - (fun p1 p2 -> - Run.make_checked (fun () -> - Pickles.Step_main_inputs.Ops.add_fast p1 p2)) - end) + include + Snarky_curves.Make_weierstrass_checked (Fq) (Scalar) + (Crypto_params.Tick.Inner_curve) + (Params) + (struct + let add = + Some + (fun p1 p2 -> + Run.make_checked (fun () -> + Pickles.Step_main_inputs.Ops.add_fast p1 p2 ) ) + end) let add_known_unsafe t x = add_unsafe t (constant x) end diff --git a/src/lib/snark_params/snark_util.ml b/src/lib/snark_params/snark_util.ml index fbc7b9be038..638abe80427 100644 --- a/src/lib/snark_params/snark_util.ml +++ b/src/lib/snark_params/snark_util.ml @@ -67,7 +67,7 @@ module Make (Impl : Snarky_backendless.Snark_intf.S) = struct map (read_var n) ~f:(fun n -> List.init total_length ~f:(fun i -> Bigint.( - compare (of_field (Field.of_int i)) (of_field n) < 0)))) + compare (of_field (Field.of_int i)) (of_field n) < 0) ) )) in let%map () = Field.Checked.Assert.equal @@ -152,7 +152,7 @@ module Make (Impl : Snarky_backendless.Snark_intf.S) = struct As_prover.( map2 (read Boolean.typ less) (read Boolean.typ less_or_equal) - ~f:Tuple2.create)) + ~f:Tuple2.create) ) |> Or_error.ok_exn in let r = Bigint.(compare (of_field x) (of_field y)) in @@ -170,7 +170,7 @@ module Make (Impl : Snarky_backendless.Snark_intf.S) = struct [ boolean_assert_lte Boolean.false_ Boolean.false_ ; boolean_assert_lte Boolean.false_ Boolean.true_ ; boolean_assert_lte Boolean.true_ Boolean.true_ - ])) ; + ] ) ) ; assert ( Or_error.is_error (check (boolean_assert_lte Boolean.true_ Boolean.false_)) ) @@ -193,7 +193,7 @@ module Make (Impl : Snarky_backendless.Snark_intf.S) = struct | N_ones -> respond (Provide resp) | _ -> - unhandled) + unhandled ) in let correct = Int.pow 2 n - 1 in let to_bits k = diff --git a/src/lib/snark_worker/functor.ml b/src/lib/snark_worker/functor.ml index 1202143e2d5..ed46c001401 100644 --- a/src/lib/snark_worker/functor.ml +++ b/src/lib/snark_worker/functor.ml @@ -11,7 +11,7 @@ type Structured_log_events.t += | `String time -> Ok (Time.Span.of_string time) | _ -> - Error "Snark_worker.Functor: Could not parse timespan"]) + Error "Snark_worker.Functor: Could not parse timespan"] ) } [@@deriving register_event { msg = "Merge SNARK generated in $time" }] @@ -25,7 +25,7 @@ type Structured_log_events.t += | `String time -> Ok (Time.Span.of_string time) | _ -> - Error "Snark_worker.Functor: Could not parse timespan"]) + Error "Snark_worker.Functor: Could not parse timespan"] ) } [@@deriving register_event { msg = "Base SNARK generated in $time" }] @@ -68,7 +68,7 @@ module Make (Inputs : Intf.Inputs_intf) : in ( proof , (time, match w with Transition _ -> `Transition | Merge _ -> `Merge) - )) + ) ) |> Deferred.Or_error.map ~f:(function | `One (proof1, metrics1) -> { Snark_work_lib.Work.Result.proofs = `One proof1 @@ -81,7 +81,7 @@ module Make (Inputs : Intf.Inputs_intf) : ; metrics = `Two (metrics1, metrics2) ; spec ; prover = public_key - }) + } ) let dispatch rpc shutdown_on_disconnect query address = let%map res = @@ -92,11 +92,11 @@ module Make (Inputs : Intf.Inputs_intf) : (Rpc.Connection.Heartbeat_config.create ~timeout: (Time_ns.Span.of_sec - Mina_compile_config.rpc_heartbeat_timeout_sec) + Mina_compile_config.rpc_heartbeat_timeout_sec ) ~send_every: (Time_ns.Span.of_sec - Mina_compile_config.rpc_heartbeat_send_every_sec) - ()) + Mina_compile_config.rpc_heartbeat_send_every_sec ) + () ) (Tcp.Where_to_connect.of_host_and_port address) (fun conn -> Rpc.Rpc.dispatch rpc conn query) in @@ -127,11 +127,11 @@ module Make (Inputs : Intf.Inputs_intf) : Mina_metrics.( Cryptography.Snark_work_histogram.observe Cryptography.snark_work_base_time_sec (Time.Span.to_sec time)) ; - [%str_log info] (Base_snark_generated { time })) + [%str_log info] (Base_snark_generated { time }) ) let main (module Rpcs_versioned : Intf.Rpcs_versioned_S - with type Work.ledger_proof = Inputs.Ledger_proof.t) ~logger + with type Work.ledger_proof = Inputs.Ledger_proof.t ) ~logger ~proof_level daemon_address shutdown_on_disconnect = let constraint_constants = (* TODO: Make this configurable. *) @@ -202,7 +202,7 @@ module Make (Inputs : Intf.Inputs_intf) : ; ( "work_ids" , Transaction_snark_work.Statement.compact_json (One_or_two.map (Work.Spec.instances work) - ~f:Work.Single.Spec.statement) ) + ~f:Work.Single.Spec.statement ) ) ] ; let%bind () = wait () in (* Pause to wait for stdout to flush *) @@ -217,7 +217,7 @@ module Make (Inputs : Intf.Inputs_intf) : ; ( "work_ids" , Transaction_snark_work.Statement.compact_json (One_or_two.map (Work.Spec.instances work) - ~f:Work.Single.Spec.statement) ) + ~f:Work.Single.Spec.statement ) ) ] ; let rec submit_work () = match%bind @@ -236,7 +236,7 @@ module Make (Inputs : Intf.Inputs_intf) : let command_from_rpcs (module Rpcs_versioned : Intf.Rpcs_versioned_S - with type Work.ledger_proof = Inputs.Ledger_proof.t) = + with type Work.ledger_proof = Inputs.Ledger_proof.t ) = Command.async ~summary:"Snark worker" (let open Command.Let_syntax in let%map_open daemon_port = @@ -266,12 +266,11 @@ module Make (Inputs : Intf.Inputs_intf) : ~transport: (Logger_file_system.dumb_logrotate ~directory:conf_dir ~log_filename:"mina-snark-worker.log" - ~max_size:logrotate_max_size - ~num_rotate:logrotate_num_rotate)) ; + ~max_size:logrotate_max_size ~num_rotate:logrotate_num_rotate ) ) ; Signal.handle [ Signal.term ] ~f:(fun _signal -> [%log info] !"Received signal to terminate. Aborting snark worker process" ; - Core.exit 0) ; + Core.exit 0 ) ; let proof_level = Option.value ~default:Genesis_constants.Proof_level.compiled proof_level diff --git a/src/lib/snark_worker/intf.ml b/src/lib/snark_worker/intf.ml index ffcd4b1c240..f6a2527a5e0 100644 --- a/src/lib/snark_worker/intf.ml +++ b/src/lib/snark_worker/intf.ml @@ -120,7 +120,7 @@ module type S0 = sig Rpc_master with type Master.T.query = unit and type Master.T.response = - (Work.Spec.t * Signature_lib.Public_key.Compressed.t) option + (Work.Spec.t * Signature_lib.Public_key.Compressed.t) option module Submit_work : Rpc_master diff --git a/src/lib/snark_worker/prod.ml b/src/lib/snark_worker/prod.ml index 1383320f048..26f0b856e03 100644 --- a/src/lib/snark_worker/prod.ml +++ b/src/lib/snark_worker/prod.ml @@ -121,20 +121,20 @@ module Inputs = struct } , parties ) ] - |> fst |> List.rev) + |> fst |> List.rev ) |> Result.map_error ~f:(fun e -> Error.createf !"Failed to generate inputs for parties : \ %s: %s" ( Parties.to_yojson parties |> Yojson.Safe.to_string ) - (Error.to_string_hum e)) + (Error.to_string_hum e) ) |> Deferred.return in let log_base_snark f ~statement ~spec ~all_inputs = match%map.Deferred Deferred.Or_error.try_with (fun () -> - f ~statement ~spec) + f ~statement ~spec ) with | Ok p -> Ok p @@ -191,7 +191,7 @@ module Inputs = struct ~statement:{ stmt with sok_digest } ~spec ~all_inputs:inputs (M.of_parties_segment_exn ~snapp_statement - ~witness) + ~witness ) in let%map (p : Ledger_proof.t) = @@ -208,10 +208,10 @@ module Inputs = struct ~statement:{ stmt with sok_digest } ~spec ~all_inputs:inputs (M.of_parties_segment_exn - ~snapp_statement ~witness) + ~snapp_statement ~witness ) in log_merge_snark ~sok_digest prev curr - ~all_inputs:inputs) + ~all_inputs:inputs ) in if Transaction_snark.Statement.equal @@ -264,7 +264,7 @@ module Inputs = struct } ~init_stack:w.init_stack (unstage - (Mina_ledger.Sparse_ledger.handler w.ledger)))) + (Mina_ledger.Sparse_ledger.handler w.ledger) ) ) ) | Merge (_, proof1, proof2) -> process (fun () -> M.merge ~sok_digest proof1 proof2) ) ) | Check | None -> diff --git a/src/lib/snark_worker/rpcs.ml b/src/lib/snark_worker/rpcs.ml index 01ce2c6f1ec..ec8f37412e6 100644 --- a/src/lib/snark_worker/rpcs.ml +++ b/src/lib/snark_worker/rpcs.ml @@ -6,7 +6,6 @@ open Signature_lib RFC 0012, and https://ocaml.janestreet.com/ocaml-core/latest/doc/async_rpc_kernel/Async_rpc_kernel/Versioned_rpc/ - *) (* for each RPC, return the Master module only, and not the versioned modules, because the functor should not diff --git a/src/lib/snark_worker/standalone/run_snark_worker.ml b/src/lib/snark_worker/standalone/run_snark_worker.ml index 14c812b537d..88503c9ad40 100644 --- a/src/lib/snark_worker/standalone/run_snark_worker.ml +++ b/src/lib/snark_worker/standalone/run_snark_worker.ml @@ -15,7 +15,7 @@ let command = [ ("Full", Genesis_constants.Proof_level.Full) ; ("Check", Check) ; ("None", None) - ])) + ] ) ) in fun () -> let open Async in @@ -34,6 +34,6 @@ let command = Caml.Format.printf !"Proving failed with error:@.%s" (Error.to_string_hum err) ; - exit 1) + exit 1 ) let () = Command.run command diff --git a/src/lib/snarky_blake2/snarky_blake2.ml b/src/lib/snarky_blake2/snarky_blake2.ml index aba5863ea00..917dcc940bb 100644 --- a/src/lib/snarky_blake2/snarky_blake2.ml +++ b/src/lib/snarky_blake2/snarky_blake2.ml @@ -114,12 +114,12 @@ module Make (Impl : Snarky_backendless.Snark_intf.S) : let%bind () = mix 1 6 11 12 10 11 in let%bind () = mix 2 7 8 13 12 13 in let%bind () = mix 3 4 9 14 14 15 in - return ()) + return () ) in let%bind () = for_ 8 ~f:(fun i -> let%bind () = (h, i) := xor h.(i) v.(i) in - (h, i) := xor h.(i) v.(Int.(i + 8))) + (h, i) := xor h.(i) v.(Int.(i + 8)) ) in return () @@ -134,12 +134,12 @@ module Make (Impl : Snarky_backendless.Snark_intf.S) : Array.append bs (Array.create ~len:(block_size_in_bits - (n mod block_size_in_bits)) - Boolean.false_) + Boolean.false_ ) let concat_int32s (ts : UInt32.t array) = let n = Array.length ts in Array.init (n * UInt32.length_in_bits) ~f:(fun i -> - ts.(i / UInt32.length_in_bits).(i mod UInt32.length_in_bits)) + ts.(i / UInt32.length_in_bits).(i mod UInt32.length_in_bits) ) let default_personalization = String.init 8 ~f:(fun _ -> '\000') @@ -183,7 +183,7 @@ module Make (Impl : Snarky_backendless.Snark_intf.S) : Array.init UInt32.length_in_bits ~f:(fun k -> padded.((block_size_in_bits * i) + (UInt32.length_in_bits * j) - + k)))) + + k) ) ) ) in let%bind () = for_ @@ -191,7 +191,7 @@ module Make (Impl : Snarky_backendless.Snark_intf.S) : ~f:(fun i -> compression h blocks.(i) Unsigned.UInt64.(Infix.((of_int i + one) * of_int 64)) - false) + false ) in let input_length_in_bytes = (Array.length input + 7) / 8 in let%bind () = diff --git a/src/lib/snarky_blake2/test/test.ml b/src/lib/snarky_blake2/test/test.ml index 4e6e3cc3b64..1c3737cd2e5 100644 --- a/src/lib/snarky_blake2/test/test.ml +++ b/src/lib/snarky_blake2/test/test.ml @@ -13,7 +13,7 @@ let%test_module "blake2-equality test" = run_and_check (let%bind input = exists typ1 ~compute:(As_prover.return input) in let%map result = checked input in - As_prover.read typ2 result) + As_prover.read typ2 result ) |> Or_error.ok_exn in checked_result @@ -32,7 +32,7 @@ let%test_module "blake2-equality test" = let to_bitstring bits = String.init (Array.length bits) ~f:(fun i -> - if bits.(i) then '1' else '0') + if bits.(i) then '1' else '0' ) let%test_unit "constraint count" = assert ( @@ -62,5 +62,5 @@ let%test_module "blake2-equality test" = ~sexp_of_t:(Fn.compose [%sexp_of: string] to_bitstring) input_typ output_typ (blake2s ?personalization:None) - blake2_unchecked input) + blake2_unchecked input ) end ) diff --git a/src/lib/snarky_blake2/uint32.ml b/src/lib/snarky_blake2/uint32.ml index a558e3ee547..d8c72efeb59 100644 --- a/src/lib/snarky_blake2/uint32.ml +++ b/src/lib/snarky_blake2/uint32.ml @@ -53,7 +53,7 @@ module Make (Impl : Snarky_backendless.Snark_intf.S) : ~there:(fun x -> Array.init length ~f:(get_bit x)) ~back:(fun arr -> Array.foldi arr ~init:zero ~f:(fun i acc b -> - if b then acc lor (one lsl i) else acc)) + if b then acc lor (one lsl i) else acc ) ) let xor t1 t2 = let res = Array.create ~len:length Boolean.false_ in @@ -79,7 +79,7 @@ module Make (Impl : Snarky_backendless.Snark_intf.S) : (Option.value_exn (Field.Var.to_constant (b :> Field.Var.t))) Field.one in - if b then acc lor (one lsl i) else acc)) + if b then acc lor (one lsl i) else acc ) ) with _ -> None let pack (t : t) = @@ -87,7 +87,7 @@ module Make (Impl : Snarky_backendless.Snark_intf.S) : Array.fold t ~init:(Field.one, Field.Var.constant Field.zero) ~f:(fun (x, acc) b -> - (Field.(x + x), Field.Checked.(acc + (x * (b :> Field.Var.t))))) + (Field.(x + x), Field.Checked.(acc + (x * (b :> Field.Var.t)))) ) in acc @@ -99,7 +99,7 @@ module Make (Impl : Snarky_backendless.Snark_intf.S) : | Some x -> (Unchecked.to_int x + c, vs) | None -> - (c, t :: vs)) + (c, t :: vs) ) in match vars with | [] -> @@ -113,7 +113,7 @@ module Make (Impl : Snarky_backendless.Snark_intf.S) : let%map bits = Field.Checked.choose_preimage_var ~length:max_length (Field.Var.sum - (Field.Var.constant (Field.of_int c) :: List.map vars ~f:pack)) + (Field.Var.constant (Field.of_int c) :: List.map vars ~f:pack) ) in Array.of_list ( List.take bits 32 diff --git a/src/lib/snarky_curves/snarky_curves.ml b/src/lib/snarky_curves/snarky_curves.ml index 6272ea49f5f..7f5919bd290 100644 --- a/src/lib/snarky_curves/snarky_curves.ml +++ b/src/lib/snarky_curves/snarky_curves.ml @@ -283,7 +283,7 @@ module Make_weierstrass_checked As_prover.( map2 (read typ x_squared) (read typ ay) ~f:(fun x_squared ay -> let open F.Unchecked in - (x_squared + x_squared + x_squared + Params.a) * inv (ay + ay))) + (x_squared + x_squared + x_squared + Params.a) * inv (ay + ay) )) in let%bind bx = exists typ @@ -291,7 +291,7 @@ module Make_weierstrass_checked As_prover.( map2 (read typ lambda) (read typ ax) ~f:(fun lambda ax -> let open F.Unchecked in - square lambda - (ax + ax))) + square lambda - (ax + ax) )) in let%bind by = exists typ @@ -319,7 +319,7 @@ module Make_weierstrass_checked let choose a1 a2 = let open Field.Checked in F.map2_ a1 a2 ~f:(fun a1 a2 -> - (a1 * cond) + (a2 * (Field.Var.constant Field.one - cond))) + (a1 * cond) + (a2 * (Field.Var.constant Field.one - cond)) ) in (choose x1 x2, choose y1 y2) @@ -338,7 +338,7 @@ module Make_weierstrass_checked with_label (sprintf "acc_%d" i) (let%bind add_pt = Shifted.add acc pt in let don't_add_pt = acc in - Shifted.if_ b ~then_:add_pt ~else_:don't_add_pt) + Shifted.if_ b ~then_:add_pt ~else_:don't_add_pt ) and pt' = double pt in go (i + 1) bs acc' pt' in diff --git a/src/lib/snarky_field_extensions/field_extensions.ml b/src/lib/snarky_field_extensions/field_extensions.ml index 6ca6edb1fc2..64715a9b6d5 100644 --- a/src/lib/snarky_field_extensions/field_extensions.ml +++ b/src/lib/snarky_field_extensions/field_extensions.ml @@ -22,7 +22,7 @@ module Make_test (F : Intf.Basic) = struct !"%s test failure: %{sexp:arg} -> %{sexp:F.Unchecked.t} vs \ %{sexp:F.Unchecked.t}" label x r1 r2 () - else ()) + else () ) let test1 l f g = test F.typ F.Unchecked.gen F.Unchecked.sexp_of_t l f g @@ -56,7 +56,7 @@ module Make (F : Intf.Basic) = struct assert_all (List.map2_exn ~f:(fun x y -> Constraint.equal x y) - (F.to_list x) (F.to_list y)) + (F.to_list x) (F.to_list y) ) let ( + ) = F.( + ) @@ -170,7 +170,8 @@ struct try Some (A.map t ~f:(fun x -> - match F.to_constant x with Some x -> x | None -> raise None_exn)) + match F.to_constant x with Some x -> x | None -> raise None_exn ) + ) with None_exn -> None let if_ b ~then_ ~else_ = @@ -743,13 +744,14 @@ module F6 val frobenius_coeffs_c1 : Fq.Unchecked.t array end) = struct - include E2 - (Fq3) - (struct - let non_residue : Fq3.Unchecked.t = Fq.Unchecked.(zero, one, zero) + include + E2 + (Fq3) + (struct + let non_residue : Fq3.Unchecked.t = Fq.Unchecked.(zero, one, zero) - let mul_by_non_residue = Fq3.mul_by_primitive_element - end) + let mul_by_non_residue = Fq3.mul_by_primitive_element + end) let fq_mul_by_non_residue x = Fq.scale x Fq3.Params.non_residue @@ -786,7 +788,7 @@ struct Fq.assert_r1cs a01 (Fq.scale b02 Fq3.Params.non_residue) (Field.Var.linear_combination - [ (Field.one, c00); (Field.negate Fq3.Params.non_residue, v12) ]) + [ (Field.one, c00); (Field.negate Fq3.Params.non_residue, v12) ] ) and () = Fq.assert_r1cs a02 (Fq.scale b02 Fq3.Params.non_residue) Fq.(c01 - v10) and () = Fq.assert_r1cs a00 b02 Fq.(c02 - v11) in @@ -807,11 +809,12 @@ struct (* TODO: Make sure this is ok *) let special_div = special_div_unsafe - include Cyclotomic_square.Make_F6 - (Fq2) - (struct - let cubic_non_residue = Fq3.Params.non_residue - end) + include + Cyclotomic_square.Make_F6 + (Fq2) + (struct + let cubic_non_residue = Fq3.Params.non_residue + end) let frobenius ((c00, c01, c02), (c10, c11, c12)) power = let module Field = Impl.Field in @@ -840,13 +843,14 @@ module F4 val frobenius_coeffs_c1 : Fq2.Impl.Field.t array end) = struct - include E2 - (Fq2) - (struct - let non_residue = Fq2.Impl.Field.(zero, one) + include + E2 + (Fq2) + (struct + let non_residue = Fq2.Impl.Field.(zero, one) - let mul_by_non_residue = Fq2.mul_by_primitive_element - end) + let mul_by_non_residue = Fq2.mul_by_primitive_element + end) let special_mul = ( * ) diff --git a/src/lib/snarky_group_map/checked_map.ml b/src/lib/snarky_group_map/checked_map.ml index 6fdcf852871..8ab47d0be33 100644 --- a/src/lib/snarky_group_map/checked_map.ml +++ b/src/lib/snarky_group_map/checked_map.ml @@ -11,7 +11,7 @@ module Aux (Impl : Snarky_backendless.Snark_intf.Run) = struct let sqrt_exn x = let y = exists Field.typ ~compute:(fun () -> - Field.Constant.sqrt (As_prover.read_var x)) + Field.Constant.sqrt (As_prover.read_var x) ) in assert_square y x ; y @@ -31,7 +31,7 @@ module Aux (Impl : Snarky_backendless.Snark_intf.Run) = struct *) let is_square = exists Boolean.typ ~compute:(fun () -> - Field.Constant.is_square (As_prover.read_var x)) + Field.Constant.is_square (As_prover.read_var x) ) in let m = Lazy.force non_residue in (sqrt_exn (Field.if_ is_square ~then_:x ~else_:(Field.scale x m)), is_square) @@ -52,7 +52,7 @@ let wrap (type f) ((module Impl) : f Snarky_backendless.Snark0.m) ~potential_xs and x2_is_first = (Boolean.((not b1) && b2) :> Field.t) and x3_is_first = (Boolean.((not b1) && (not b2) && b3) :> Field.t) in ( Field.((x1_is_first * x1) + (x2_is_first * x2) + (x3_is_first * x3)) - , Field.((x1_is_first * y1) + (x2_is_first * y2) + (x3_is_first * y3)) )) + , Field.((x1_is_first * y1) + (x2_is_first * y2) + (x3_is_first * y3)) ) ) module Make (M : Snarky_backendless.Snark_intf.Run) (P : sig @@ -69,5 +69,5 @@ struct (wrap (module M) ~potential_xs - ~y_squared:Field.(fun ~x -> (x * x * x) + scale x a + constant b)) + ~y_squared:Field.(fun ~x -> (x * x * x) + scale x a + constant b) ) end diff --git a/src/lib/snarky_js_bindings/lib/snarky_js_bindings_lib.ml b/src/lib/snarky_js_bindings/lib/snarky_js_bindings_lib.ml index dcdcd4aca66..4c64ee9d7cf 100644 --- a/src/lib/snarky_js_bindings/lib/snarky_js_bindings_lib.ml +++ b/src/lib/snarky_js_bindings/lib/snarky_js_bindings_lib.ml @@ -89,7 +89,7 @@ module As_field = struct | s -> raise_error (Core_kernel.sprintf - "Type \"%s\" cannot be converted to a field element" s) + "Type \"%s\" cannot be converted to a field element" s ) let field_class : < .. > Js.t = let f = @@ -202,7 +202,7 @@ let handle_constants2 f f_constant (x : Field.t) (y : Field.t) = let array_get_exn xs i = Js.Optdef.get (Js.array_get xs i) (fun () -> - raise_error (sprintf "array_get_exn: index=%d, length=%d" i xs##.length)) + raise_error (sprintf "array_get_exn: index=%d, length=%d" i xs##.length) ) let array_check_length xs n = if xs##.length <> n then raise_error (sprintf "Expected array of length %d" n) @@ -252,19 +252,19 @@ let () = in let add_op2 name (f : Field.t -> Field.t -> Field.t) = method_ name (fun this (y : As_field.t) : field_class Js.t -> - mk (f this##.value (As_field.value y))) + mk (f this##.value (As_field.value y)) ) in let sub = handle_constants2 Field.sub (fun x y -> - Field.constant (Field.Constant.sub x y)) + Field.constant (Field.Constant.sub x y) ) in let div = handle_constants2 Field.div (fun x y -> - Field.constant (Field.Constant.( / ) x y)) + Field.constant (Field.Constant.( / ) x y) ) in let sqrt = handle_constants Field.sqrt (fun x -> - Field.constant (Field.Constant.sqrt x)) + Field.constant (Field.Constant.sqrt x) ) in add_op2 "add" Field.add ; add_op2 "sub" sub ; @@ -277,18 +277,18 @@ let () = method_ "toString" (fun this : Js.js_string Js.t -> to_string this##.value) ; method_ "sizeInFields" (fun _this : int -> 1) ; method_ "toFields" (fun this : field_class Js.t Js.js_array Js.t -> - singleton_array this) ; + singleton_array this ) ; ((* TODO: Make this work with arbitrary bit length *) let bit_length = Field.size_in_bits - 2 in let cmp_method (name, f) = method_ name (fun this (y : As_field.t) : unit -> - f ~bit_length this##.value (As_field.value y)) + f ~bit_length this##.value (As_field.value y) ) in let bool_cmp_method (name, f) = method_ name (fun this (y : As_field.t) : bool_class Js.t -> new%js bool_constr (As_bool.of_boolean - (f (Field.compare ~bit_length this##.value (As_field.value y))))) + (f (Field.compare ~bit_length this##.value (As_field.value y))) ) ) in (List.iter ~f:bool_cmp_method) [ ("lt", fun { less; _ } -> less) @@ -301,14 +301,14 @@ let () = ; ("assertLte", Field.Assert.lte) ; ("assertGt", Field.Assert.gt) ; ("assertGte", Field.Assert.gte) - ]) ; + ] ) ; method_ "assertEquals" (fun this (y : As_field.t) : unit -> try Field.Assert.equal this##.value (As_field.value y) with _ -> console_log this ; console_log (As_field.to_field_obj y) ; let () = raise_error "assertEquals: not equal" in - ()) ; + () ) ; (* TODO: bring back better error msg when .toString works in circuits *) (* sprintf "assertEquals: %s != %s" @@ -317,17 +317,17 @@ let () = in Js.raise_js_error (new%js Js.error_constr (Js.string s))) ; *) method_ "assertBoolean" (fun this : unit -> - Impl.assert_ (Constraint.boolean this##.value)) ; + Impl.assert_ (Constraint.boolean this##.value) ) ; method_ "isZero" (fun this : bool_class Js.t -> new%js bool_constr - (As_bool.of_boolean (Field.equal this##.value Field.zero))) ; + (As_bool.of_boolean (Field.equal this##.value Field.zero)) ) ; optdef_arg_method field_class "toBits" (fun this (length : int Js.Optdef.t) : bool_class Js.t Js.js_array Js.t -> let length = Js.Optdef.get length (fun () -> Field.size_in_bits) in let k f bits = let arr = new%js Js.array_empty in List.iter bits ~f:(fun x -> - arr##push (new%js bool_constr (As_bool.of_boolean (f x))) |> ignore) ; + arr##push (new%js bool_constr (As_bool.of_boolean (f x))) |> ignore ) ; arr in handle_constants @@ -339,28 +339,28 @@ let () = raise_error (sprintf "Value %s did not fit in %d bits" (Field.Constant.to_string x) - length) ; - k Boolean.var_of_value bits) - this##.value) ; + length ) ; + k Boolean.var_of_value bits ) + this##.value ) ; method_ "equals" (fun this (y : As_field.t) : bool_class Js.t -> new%js bool_constr - (As_bool.of_boolean (Field.equal this##.value (As_field.value y)))) ; + (As_bool.of_boolean (Field.equal this##.value (As_field.value y))) ) ; let static_op1 name (f : Field.t -> Field.t) = Js.Unsafe.set field_class (Js.string name) (Js.wrap_callback (fun (x : As_field.t) : field_class Js.t -> - mk (f (As_field.value x)))) + mk (f (As_field.value x)) ) ) in let static_op2 name (f : Field.t -> Field.t -> Field.t) = Js.Unsafe.set field_class (Js.string name) (Js.wrap_callback (fun (x : As_field.t) (y : As_field.t) : field_class Js.t -> - mk (f (As_field.value x) (As_field.value y)))) + mk (f (As_field.value x) (As_field.value y)) ) ) in field_class##.one := mk Field.one ; field_class##.zero := mk Field.zero ; field_class##.random := Js.wrap_callback (fun () : field_class Js.t -> - mk (Field.constant (Field.Constant.random ()))) ; + mk (Field.constant (Field.Constant.random ())) ) ; static_op2 "add" Field.add ; static_op2 "sub" sub ; static_op2 "mul" Field.mul ; @@ -371,26 +371,26 @@ let () = static_op1 "sqrt" sqrt ; field_class##.toString := Js.wrap_callback (fun (x : As_field.t) : Js.js_string Js.t -> - to_string (As_field.value x)) ; + to_string (As_field.value x) ) ; field_class##.sizeInFields := Js.wrap_callback (fun () : int -> 1) ; field_class##.toFields := Js.wrap_callback (fun (x : As_field.t) : field_class Js.t Js.js_array Js.t -> - (As_field.to_field_obj x)##toFields) ; + (As_field.to_field_obj x)##toFields ) ; field_class##.ofFields := Js.wrap_callback (fun (xs : field_class Js.t Js.js_array Js.t) : field_class Js.t -> - array_check_length xs 1 ; array_get_exn xs 0) ; + array_check_length xs 1 ; array_get_exn xs 0 ) ; field_class##.assertEqual := Js.wrap_callback (fun (x : As_field.t) (y : As_field.t) : unit -> - Field.Assert.equal (As_field.value x) (As_field.value y)) ; + Field.Assert.equal (As_field.value x) (As_field.value y) ) ; field_class##.assertBoolean := Js.wrap_callback (fun (x : As_field.t) : unit -> - Impl.assert_ (Constraint.boolean (As_field.value x))) ; + Impl.assert_ (Constraint.boolean (As_field.value x)) ) ; field_class##.isZero := Js.wrap_callback (fun (x : As_field.t) : bool_class Js.t -> new%js bool_constr - (As_bool.of_boolean (Field.equal (As_field.value x) Field.zero))) ; + (As_bool.of_boolean (Field.equal (As_field.value x) Field.zero)) ) ; field_class##.ofBits := Js.wrap_callback (fun (bs : As_bool.t Js.js_array Js.t) : field_class Js.t -> @@ -400,7 +400,7 @@ let () = | Constant b -> Impl.Field.Constant.(equal one b) | _ -> - failwith "non-constant") + failwith "non-constant" ) |> Array.to_list |> Field.Constant.project |> Field.constant |> mk with _ -> mk @@ -408,7 +408,7 @@ let () = (List.init bs##.length ~f:(fun i -> Js.Optdef.case (Js.array_get bs i) (fun () -> assert false) - As_bool.value)))) ; + As_bool.value ) ) ) ) ; (field_class##.toBits := let wrapper = Js.Unsafe.eval_string @@ -420,18 +420,20 @@ let () = })|js} in Js.Unsafe.( - fun_call wrapper [| inject (Js.wrap_callback As_field.to_field_obj) |])) ; + fun_call wrapper [| inject (Js.wrap_callback As_field.to_field_obj) |]) + ) ; field_class##.equal := Js.wrap_callback (fun (x : As_field.t) (y : As_field.t) : bool_class Js.t -> new%js bool_constr (As_bool.of_boolean - (Field.equal (As_field.value x) (As_field.value y)))) ; + (Field.equal (As_field.value x) (As_field.value y)) ) ) ; let static_method name f = Js.Unsafe.set field_class (Js.string name) (Js.wrap_callback f) in method_ "seal" (let seal = Pickles.Util.seal (module Impl) in - fun (this : field_class Js.t) : field_class Js.t -> mk (seal this##.value)) ; + fun (this : field_class Js.t) : field_class Js.t -> mk (seal this##.value) + ) ; method_ "rangeCheckHelper" (fun (this : field_class Js.t) (num_bits : int) : field_class Js.t -> match this##.value with @@ -443,7 +445,7 @@ let () = (sprintf !"rangeCheckHelper: Expected %{sexp:Field.Constant.t} to \ fit in %d bits" - v num_bits) + v num_bits ) done ; this | v -> @@ -452,18 +454,18 @@ let () = (module Impl) { inner = v } in - mk n) ; + mk n ) ; method_ "isConstant" (fun (this : field_class Js.t) : bool Js.t -> - match this##.value with Constant _ -> Js._true | _ -> Js._false) ; + match this##.value with Constant _ -> Js._true | _ -> Js._false ) ; method_ "toConstant" (fun (this : field_class Js.t) : field_class Js.t -> let x = match this##.value with Constant x -> x | x -> As_prover.read_var x in - mk (Field.constant x)) ; + mk (Field.constant x) ) ; method_ "toJSON" (fun (this : field_class Js.t) : < .. > Js.t -> - this##toString) ; + this##toString ) ; static_method "toJSON" (fun (this : field_class Js.t) : < .. > Js.t -> - this##toJSON) ; + this##toJSON ) ; static_method "fromJSON" (fun (value : Js.Unsafe.any) : field_class Js.t Js.Opt.t -> let return x = @@ -489,10 +491,10 @@ let () = && Char.equal s.[0] '0' && Char.equal (Char.lowercase s.[1]) 'x' then Kimchi_pasta.Pasta.Fp.(of_bigint (Bigint.of_hex_string s)) - else Field.Constant.of_string s )) + else Field.Constant.of_string s ) ) with Failure _ -> Js.Opt.empty ) | _ -> - Js.Opt.empty) + Js.Opt.empty ) let () = let handle_constants2 f f_constant (x : Boolean.var) (y : Boolean.var) = @@ -504,7 +506,7 @@ let () = in let equal = handle_constants2 Boolean.equal (fun x y -> - Boolean.var_of_value (Field.Constant.equal x y)) + Boolean.var_of_value (Field.Constant.equal x y) ) in let mk x : bool_class Js.t = new%js bool_constr (As_bool.of_boolean x) in let method_ name (f : bool_class Js.t -> _) = method_ bool_class name f in @@ -513,15 +515,15 @@ let () = in let add_op2 name (f : Boolean.var -> Boolean.var -> Boolean.var) = method_ name (fun this (y : As_bool.t) : bool_class Js.t -> - mk (f this##.value (As_bool.value y))) + mk (f this##.value (As_bool.value y)) ) in method_ "toField" (fun this : field_class Js.t -> - new%js field_constr (As_field.of_field (this##.value :> Field.t))) ; + new%js field_constr (As_field.of_field (this##.value :> Field.t)) ) ; add_op1 "not" Boolean.not ; add_op2 "and" Boolean.( &&& ) ; add_op2 "or" Boolean.( ||| ) ; method_ "assertEquals" (fun this (y : As_bool.t) : unit -> - Boolean.Assert.( = ) this##.value (As_bool.value y)) ; + Boolean.Assert.( = ) this##.value (As_bool.value y) ) ; add_op2 "equals" equal ; method_ "toBoolean" (fun this : bool Js.t -> match (this##.value :> Field.t) with @@ -531,7 +533,7 @@ let () = try Js.bool (As_prover.read Boolean.typ this##.value) with _ -> raise_error - "Bool.toBoolean can only be called on non-witness values." )) ; + "Bool.toBoolean can only be called on non-witness values." ) ) ; method_ "sizeInFields" (fun _this : int -> 1) ; method_ "toString" (fun this -> let x = @@ -541,35 +543,35 @@ let () = | x -> As_prover.read_var x in - if Field.Constant.(equal one) x then "true" else "false") ; + if Field.Constant.(equal one) x then "true" else "false" ) ; method_ "toFields" (fun this : field_class Js.t Js.js_array Js.t -> let arr = new%js Js.array_empty in arr##push this##toField |> ignore ; - arr) ; + arr ) ; let static_method name f = Js.Unsafe.set bool_class (Js.string name) (Js.wrap_callback f) in let static_op1 name (f : Boolean.var -> Boolean.var) = static_method name (fun (x : As_bool.t) : bool_class Js.t -> - mk (f (As_bool.value x))) + mk (f (As_bool.value x)) ) in let static_op2 name (f : Boolean.var -> Boolean.var -> Boolean.var) = static_method name (fun (x : As_bool.t) (y : As_bool.t) : bool_class Js.t -> - mk (f (As_bool.value x) (As_bool.value y))) + mk (f (As_bool.value x) (As_bool.value y)) ) in static_method "toField" (fun (x : As_bool.t) -> - new%js field_constr (As_field.of_field (As_bool.value x :> Field.t))) ; + new%js field_constr (As_field.of_field (As_bool.value x :> Field.t)) ) ; Js.Unsafe.set bool_class (Js.string "Unsafe") (object%js method ofField (x : As_field.t) : bool_class Js.t = new%js bool_constr (As_bool.of_boolean (Boolean.Unsafe.of_cvar (As_field.value x))) - end) ; + end ) ; static_op1 "not" Boolean.not ; static_op2 "and" Boolean.( &&& ) ; static_op2 "or" Boolean.( ||| ) ; static_method "assertEqual" (fun (x : As_bool.t) (y : As_bool.t) : unit -> - Boolean.Assert.( = ) (As_bool.value x) (As_bool.value y)) ; + Boolean.Assert.( = ) (As_bool.value x) (As_bool.value y) ) ; static_op2 "equal" equal ; static_method "count" (fun (bs : As_bool.t Js.js_array Js.t) : field_class Js.t -> @@ -580,25 +582,25 @@ let () = ( Js.Optdef.case (Js.array_get bs i) (fun () -> assert false) As_bool.value - :> Field.t )))))) ; + :> Field.t ) ) ) ) ) ) ; static_method "sizeInFields" (fun () : int -> 1) ; static_method "toFields" (fun (x : As_bool.t) : field_class Js.t Js.js_array Js.t -> singleton_array - (new%js field_constr (As_field.of_field (As_bool.value x :> Field.t)))) ; + (new%js field_constr (As_field.of_field (As_bool.value x :> Field.t))) ) ; static_method "ofFields" (fun (xs : field_class Js.t Js.js_array Js.t) : bool_class Js.t -> if xs##.length = 1 then Js.Optdef.case (Js.array_get xs 0) (fun () -> assert false) (fun x -> mk (Boolean.Unsafe.of_cvar x##.value)) - else raise_error "Expected array of length 1") ; + else raise_error "Expected array of length 1" ) ; static_method "check" (fun (x : bool_class Js.t) : unit -> - Impl.assert_ (Constraint.boolean (x##.value :> Field.t))) ; + Impl.assert_ (Constraint.boolean (x##.value :> Field.t)) ) ; method_ "toJSON" (fun (this : bool_class Js.t) : < .. > Js.t -> - Js.Unsafe.coerce this##toBoolean) ; + Js.Unsafe.coerce this##toBoolean ) ; static_method "toJSON" (fun (this : bool_class Js.t) : < .. > Js.t -> - this##toJSON) ; + this##toJSON ) ; static_method "fromJSON" (fun (value : Js.Unsafe.any) : bool_class Js.t Js.Opt.t -> match Js.to_string (Js.typeof (Js.Unsafe.coerce value)) with @@ -606,7 +608,7 @@ let () = Js.Opt.return (new%js bool_constr (As_bool.of_js_bool (Js.Unsafe.coerce value))) | _ -> - Js.Opt.empty) + Js.Opt.empty ) type coords = < x : As_field.t Js.prop ; y : As_field.t Js.prop > Js.t @@ -723,13 +725,13 @@ let to_constant_scalar (bs : Boolean.var array) : | Constant b -> Impl.Field.Constant.(equal one b) | _ -> - return Js.Optdef.empty) + return Js.Optdef.empty ) in Js.Optdef.return (Pickles_types.Shifted_value.Type1.to_field (module Other_backend.Field) ~shift:scalar_shift - (Shifted_value (Other_backend.Field.of_bits (Array.to_list bs))))) + (Shifted_value (Other_backend.Field.of_bits (Array.to_list bs))) ) ) let scalar_class : < .. > Js.t = let f = @@ -780,22 +782,22 @@ let () = let ( ! ) name x = Js.Optdef.get x (fun () -> raise_error - (sprintf "Scalar.%s can only be called on non-witness values." name)) + (sprintf "Scalar.%s can only be called on non-witness values." name) ) in let bits = scalar_to_bits in let constant_op1 name (f : Other_backend.Field.t -> Other_backend.Field.t) = method_ name (fun x : scalar_class Js.t -> let z = f (!name x##.constantValue) in - new%js scalar_constr_const (bits z) z) + new%js scalar_constr_const (bits z) z ) in let constant_op2 name (f : - Other_backend.Field.t -> Other_backend.Field.t -> Other_backend.Field.t) - = + Other_backend.Field.t -> Other_backend.Field.t -> Other_backend.Field.t + ) = let ( ! ) = !name in method_ name (fun x (y : scalar_class Js.t) : scalar_class Js.t -> let z = f !(x##.constantValue) !(y##.constantValue) in - new%js scalar_constr_const (bits z) z) + new%js scalar_constr_const (bits z) z ) in (* It is not necessary to boolean constrain the bits of a scalar for the following @@ -818,37 +820,38 @@ let () = constant_op2 "div" Other_backend.Field.div ; method_ "toFields" (fun x : field_class Js.t Js.js_array Js.t -> Array.map x##.value ~f:(fun b -> - new%js field_constr (As_field.of_field (b :> Field.t))) - |> Js.array) ; + new%js field_constr (As_field.of_field (b :> Field.t)) ) + |> Js.array ) ; static_method "toFields" (fun (x : scalar_class Js.t) : field_class Js.t Js.js_array Js.t -> - (Js.Unsafe.coerce x)##toFields) ; + (Js.Unsafe.coerce x)##toFields ) ; static_method "sizeInFields" (fun () : int -> num_bits) ; static_method "ofFields" (fun (xs : field_class Js.t Js.js_array Js.t) : scalar_class Js.t -> new%js scalar_constr (Array.map (Js.to_array xs) ~f:(fun x -> - Boolean.Unsafe.of_cvar x##.value))) ; + Boolean.Unsafe.of_cvar x##.value ) ) ) ; static_method "random" (fun () : scalar_class Js.t -> let x = Other_backend.Field.random () in - new%js scalar_constr_const (bits x) x) ; + new%js scalar_constr_const (bits x) x ) ; static_method "ofBits" (fun (bits : bool_class Js.t Js.js_array Js.t) : scalar_class Js.t -> new%js scalar_constr (Array.map (Js.to_array bits) ~f:(fun b -> - As_bool.(value (of_bool_obj b))))) ; + As_bool.(value (of_bool_obj b)) ) ) ) ; method_ "toJSON" (fun (s : scalar_class Js.t) : < .. > Js.t -> let s = Js.Optdef.case s##.constantValue (fun () -> Js.Optdef.get (to_constant_scalar s##.value) - (fun () -> raise_error "Cannot convert in-circuit value to JSON")) + (fun () -> raise_error "Cannot convert in-circuit value to JSON") + ) Fn.id in - Js.string (Other_impl.Field.Constant.to_string s)) ; + Js.string (Other_impl.Field.Constant.to_string s) ) ; static_method "toJSON" (fun (s : scalar_class Js.t) : < .. > Js.t -> - s##toJSON) ; + s##toJSON ) ; static_method "fromJSON" (fun (value : Js.Unsafe.any) : scalar_class Js.t Js.Opt.t -> let return x = Js.Opt.return (new%js scalar_constr_const (bits x) x) in @@ -871,7 +874,7 @@ let () = else Other_impl.Field.Constant.of_string s ) with Failure _ -> Js.Opt.empty ) | _ -> - Js.Opt.empty) + Js.Opt.empty ) let () = let mk (x, y) : group_class Js.t = @@ -890,16 +893,16 @@ let () = | (Constant x1, Constant y1), (Constant x2, Constant y2) -> constant (Pickles.Step_main_inputs.Inner_curve.Constant.( + ) (x1, y1) - (x2, y2)) + (x2, y2) ) | _ -> - Pickles.Step_main_inputs.Ops.add_fast p1 p2 |> mk) ; + Pickles.Step_main_inputs.Ops.add_fast p1 p2 |> mk ) ; method_ "neg" (fun (p1 : group_class Js.t) : group_class Js.t -> Pickles.Step_main_inputs.Inner_curve.negate (As_group.value (As_group.of_group_obj p1)) - |> mk) ; + |> mk ) ; method_ "sub" (fun (p1 : group_class Js.t) (p2 : As_group.t) : group_class Js.t -> - p1##add (As_group.to_group_obj p2)##neg) ; + p1##add (As_group.to_group_obj p2)##neg ) ; method_ "scale" (fun (p1 : group_class Js.t) (s : scalar_class Js.t) : group_class Js.t -> match @@ -916,7 +919,7 @@ let () = Pickles.Step_main_inputs.Ops.scale_fast_msb_bits (As_group.value (As_group.of_group_obj p1)) (Shifted_value bits) - |> mk) ; + |> mk ) ; (* TODO method_ "endoScale" (fun (p1 : group_class Js.t) (s : endo_scalar_class Js.t) : group_class Js.t @@ -929,56 +932,56 @@ let () = (fun (p1 : group_class Js.t) (p2 : As_group.t) : unit -> let x1, y1 = As_group.value (As_group.of_group_obj p1) in let x2, y2 = As_group.value p2 in - Field.Assert.equal x1 x2 ; Field.Assert.equal y1 y2) ; + Field.Assert.equal x1 x2 ; Field.Assert.equal y1 y2 ) ; method_ "equals" (fun (p1 : group_class Js.t) (p2 : As_group.t) : bool_class Js.t -> let x1, y1 = As_group.value (As_group.of_group_obj p1) in let x2, y2 = As_group.value p2 in new%js bool_constr (As_bool.of_boolean - (Boolean.all [ Field.equal x1 x2; Field.equal y1 y2 ]))) ; + (Boolean.all [ Field.equal x1 x2; Field.equal y1 y2 ]) ) ) ; static "generator" (mk Pickles.Step_main_inputs.Inner_curve.one : group_class Js.t) ; static_method "add" (fun (p1 : As_group.t) (p2 : As_group.t) : group_class Js.t -> - (As_group.to_group_obj p1)##add_ p2) ; + (As_group.to_group_obj p1)##add_ p2 ) ; static_method "sub" (fun (p1 : As_group.t) (p2 : As_group.t) : group_class Js.t -> - (As_group.to_group_obj p1)##sub_ p2) ; + (As_group.to_group_obj p1)##sub_ p2 ) ; static_method "sub" (fun (p1 : As_group.t) (p2 : As_group.t) : group_class Js.t -> - (As_group.to_group_obj p1)##sub_ p2) ; + (As_group.to_group_obj p1)##sub_ p2 ) ; static_method "neg" (fun (p1 : As_group.t) : group_class Js.t -> - (As_group.to_group_obj p1)##neg) ; + (As_group.to_group_obj p1)##neg ) ; static_method "scale" (fun (p1 : As_group.t) (s : scalar_class Js.t) : group_class Js.t -> - (As_group.to_group_obj p1)##scale s) ; + (As_group.to_group_obj p1)##scale s ) ; static_method "assertEqual" (fun (p1 : As_group.t) (p2 : As_group.t) : unit -> - (As_group.to_group_obj p1)##assertEquals p2) ; + (As_group.to_group_obj p1)##assertEquals p2 ) ; static_method "equal" (fun (p1 : As_group.t) (p2 : As_group.t) : bool_class Js.t -> - (As_group.to_group_obj p1)##equals p2) ; + (As_group.to_group_obj p1)##equals p2 ) ; method_ "toFields" (fun (p1 : group_class Js.t) : field_class Js.t Js.js_array Js.t -> let arr = singleton_array p1##.x in arr##push p1##.y |> ignore ; - arr) ; + arr ) ; static_method "toFields" (fun (p1 : group_class Js.t) -> p1##toFields) ; static_method "ofFields" (fun (xs : field_class Js.t Js.js_array Js.t) -> array_check_length xs 2 ; new%js group_constr (As_field.of_field_obj (array_get_exn xs 0)) - (As_field.of_field_obj (array_get_exn xs 1))) ; + (As_field.of_field_obj (array_get_exn xs 1)) ) ; static_method "sizeInFields" (fun () : int -> 2) ; static_method "check" (fun (p : group_class Js.t) : unit -> Pickles.Step_main_inputs.Inner_curve.assert_on_curve - Field.((p##.x##.value :> t), (p##.y##.value :> t))) ; + Field.((p##.x##.value :> t), (p##.y##.value :> t)) ) ; method_ "toJSON" (fun (p : group_class Js.t) : < .. > Js.t -> object%js val x = (Obj.magic field_class)##toJSON p##.x val y = (Obj.magic field_class)##toJSON p##.y - end) ; + end ) ; static_method "toJSON" (fun (p : group_class Js.t) : < .. > Js.t -> p##toJSON) ; static_method "fromJSON" (fun (value : Js.Unsafe.any) : group_class Js.t Js.Opt.t -> @@ -991,7 +994,7 @@ let () = Js.Opt.bind (get "x") (fun x -> Js.Opt.map (get "y") (fun y -> new%js group_constr - (As_field.of_field_obj x) (As_field.of_field_obj y)))) + (As_field.of_field_obj x) (As_field.of_field_obj y) ) ) ) class type ['a] as_field_elements = object @@ -1116,7 +1119,7 @@ module Circuit = struct if t1##.length <> t2##.length then raise_error (sprintf "%s: Got mismatched lengths, %d != %d" s t1##.length - t2##.length) + t2##.length ) else () let wrap name ~pre_args ~post_args ~explicit ~implicit = @@ -1164,7 +1167,7 @@ module Circuit = struct check_lengths "if" t1 t2 ; array_map2 t1 t2 ~f:(fun x1 x2 -> new%js field_constr - (As_field.of_field (Field.if_ b ~then_:x1##.value ~else_:x2##.value))) + (As_field.of_field (Field.if_ b ~then_:x1##.value ~else_:x2##.value)) ) let js_equal (type b) (x : b) (y : b) : bool = let f = Js.Unsafe.eval_string "(function(x, y) { return x === y; })" in @@ -1236,13 +1239,13 @@ module Circuit = struct in let implicit (t1 : - < toFields : field_class Js.t Js.js_array Js.t Js.meth > Js.t as 'a) + < toFields : field_class Js.t Js.js_array Js.t Js.meth > Js.t as 'a ) (t2 : 'a) : unit = f (to_field_elts_magic t1) (to_field_elts_magic t2) in let explicit (ctor : - < toFields : 'a -> field_class Js.t Js.js_array Js.t Js.meth > Js.t) + < toFields : 'a -> field_class Js.t Js.js_array Js.t Js.meth > Js.t ) (t1 : 'a) (t2 : 'a) : unit = f (ctor##toFields t1) (ctor##toFields t2) in @@ -1258,19 +1261,19 @@ module Circuit = struct (Array.init t1##.length ~f:(fun i -> Field.equal (array_get_exn t1 i)##.value - (array_get_exn t2 i)##.value)) + (array_get_exn t2 i)##.value ) ) |> As_bool.of_boolean ) in let _implicit (t1 : - < toFields : field_class Js.t Js.js_array Js.t Js.meth > Js.t as 'a) + < toFields : field_class Js.t Js.js_array Js.t Js.meth > Js.t as 'a ) (t2 : 'a) : bool_class Js.t = f t1##toFields t2##toFields in let implicit t1 t2 = f (to_field_elts_magic t1) (to_field_elts_magic t2) in let explicit (ctor : - < toFields : 'a -> field_class Js.t Js.js_array Js.t Js.meth > Js.t) + < toFields : 'a -> field_class Js.t Js.js_array Js.t Js.meth > Js.t ) (t1 : 'a) (t2 : 'a) : bool_class Js.t = f (ctor##toFields t1) (ctor##toFields t2) in @@ -1299,7 +1302,7 @@ module Circuit = struct raise_error "if: Mismatched argument types" | true, true -> array_map2 (Obj.magic t1) (Obj.magic t2) ~f:(fun x1 x2 -> - if_magic b x1 x2) + if_magic b x1 x2 ) |> Obj.magic | false, false -> ( let ctor1 : _ Js.Optdef.t = (Obj.magic t1)##.constructor in @@ -1320,15 +1323,15 @@ module Circuit = struct check_lengths (sprintf "if (%s vs %s)" (Js.to_string (ks1##join (Js.string ", "))) - (Js.to_string (ks2##join (Js.string ", ")))) + (Js.to_string (ks2##join (Js.string ", "))) ) ks1 ks2 ; array_iter2 ks1 ks2 ~f:(fun k1 k2 -> if not (js_equal k1 k2) then - raise_error "if: Arguments had mismatched types") ; + raise_error "if: Arguments had mismatched types" ) ; let result = new%js ctor1 in array_iter ks1 ~f:(fun k -> Js.Unsafe.set result k - (if_magic b (Js.Unsafe.get t1 k) (Js.Unsafe.get t2 k))) ; + (if_magic b (Js.Unsafe.get t1 k) (Js.Unsafe.get t2 k)) ) ; Obj.magic result | Some _, None | None, Some _ -> assert false @@ -1346,7 +1349,7 @@ module Circuit = struct typ##ofFields (Js.array (Array.map xs ~f:(fun x -> - new%js field_constr (As_field.of_field (conv x))))) + new%js field_constr (As_field.of_field (conv x)) ) ) ) in Typ.transport (Typ.array ~length:typ##sizeInFields Field.typ) @@ -1399,7 +1402,7 @@ module Circuit = struct Impl.generate_witness_conv ~return_typ:Snark_params.Tick.Typ.unit ~f:(fun { Impl.Proof_inputs.auxiliary_inputs; public_inputs } () -> Backend.Proof.create pk ~auxiliary:auxiliary_inputs - ~primary:public_inputs) + ~primary:public_inputs ) spec (main ~w:priv) pub in new%js proof_constr p @@ -1440,26 +1443,26 @@ module Circuit = struct circuit##.runAndCheck := Js.wrap_callback (fun (f : unit -> 'a) -> - Impl.run_and_check (fun () -> f) |> Or_error.ok_exn) ; + Impl.run_and_check (fun () -> f) |> Or_error.ok_exn ) ; circuit##.asProver := Js.wrap_callback (fun (f : (unit -> unit) Js.callback) : unit -> - Impl.as_prover (fun () -> Js.Unsafe.fun_call f [||])) ; + Impl.as_prover (fun () -> Js.Unsafe.fun_call f [||]) ) ; circuit##.witness := Js.wrap_callback witness ; circuit##.array := Js.wrap_callback array ; circuit##.generateKeypair := Js.wrap_meth_callback (fun (this : _ Circuit_main.t) : keypair_class Js.t -> - generate_keypair this) ; + generate_keypair this ) ; circuit##.prove := Js.wrap_meth_callback (fun (this : _ Circuit_main.t) w p (kp : keypair_class Js.t) -> - prove this w p kp##.value) ; + prove this w p kp##.value ) ; (circuit##.verify := fun (pub : Js.Unsafe.any Js.js_array Js.t) (vk : verification_key_class Js.t) (pi : proof_class Js.t) : bool Js.t -> - vk##verify pub pi) ; + vk##verify pub pi ) ; circuit##.assertEqual := assert_equal ; circuit##.equal := equal ; circuit##.toFields := Js.wrap_callback to_field_elts_magic ; @@ -1467,7 +1470,7 @@ module Circuit = struct Js.wrap_callback (fun () : bool Js.t -> Js.bool (Impl.in_prover ())) ; circuit##.inCheckedComputation := Js.wrap_callback (fun () : bool Js.t -> - Js.bool (Impl.in_checked_computation ())) ; + Js.bool (Impl.in_checked_computation ()) ) ; Js.Unsafe.set circuit (Js.string "if") if_ ; circuit##.getVerificationKey := fun (vk : Verification_key.t) -> new%js verification_key_constr vk @@ -1479,7 +1482,7 @@ let () = in method_ "verificationKey" (fun (this : keypair_class Js.t) : verification_key_class Js.t -> - new%js verification_key_constr (Keypair.vk this##.value)) + new%js verification_key_constr (Keypair.vk this##.value) ) (* TODO: add verificationKey.toString / fromString *) let () = @@ -1505,7 +1508,7 @@ let () = proof_class##.ofString := Js.wrap_callback (fun (s : Js.js_string Js.t) : proof_class Js.t -> new%js proof_constr - (Js.to_string s |> Binable.of_string (module Backend.Proof))) ; + (Js.to_string s |> Binable.of_string (module Backend.Proof)) ) ; method_ "verify" (fun (this : verification_key_class Js.t) @@ -1520,17 +1523,17 @@ let () = | Constant x -> Backend.Field.Vector.emplace_back v x | _ -> - raise_error "verify: Expected non-circuit values for input") ; - Backend.Proof.verify pi##.value this##.value v |> Js.bool) + raise_error "verify: Expected non-circuit values for input" ) ; + Backend.Proof.verify pi##.value this##.value v |> Js.bool ) let () = let method_ name (f : proof_class Js.t -> _) = method_ proof_class name f in method_ "toString" (fun this : Js.js_string Js.t -> - Binable.to_string (module Backend.Proof) this##.value |> Js.string) ; + Binable.to_string (module Backend.Proof) this##.value |> Js.string ) ; proof_class##.ofString := Js.wrap_callback (fun (s : Js.js_string Js.t) : proof_class Js.t -> new%js proof_constr - (Js.to_string s |> Binable.of_string (module Backend.Proof))) ; + (Js.to_string s |> Binable.of_string (module Backend.Proof)) ) ; method_ "verify" (fun (this : proof_class Js.t) @@ -1538,7 +1541,7 @@ let () = (pub : Js.Unsafe.any Js.js_array Js.t) : bool Js.t - -> vk##verify pub this) + -> vk##verify pub this ) (* helpers for pickles_compile *) @@ -1635,7 +1638,7 @@ let create_pickles_rule ((identifier, main) : pickles_rule_js) = (fun _ statement -> dummy_constraints () ; main (Zkapp_statement.to_js statement) ; - []) + [] ) ; main_value = (fun _ _ -> []) } @@ -1651,7 +1654,7 @@ let dummy_rule self = Impl.exists Field.typ ~compute:(fun () -> Field.Constant.zero) in Field.(Assert.equal x (x + one)) ; - Boolean.[ true_; true_ ]) + Boolean.[ true_; true_ ] ) } let other_verification_key_constr : @@ -1705,8 +1708,7 @@ let pickles_compile (choices : pickles_rule_js Js.js_array Js.t) = (module Zkapp_statement.Constant) ~typ:zkapp_statement_typ ~branches:(module Branches) - ~max_proofs_verified: - (module Pickles_types.Nat.N2) + ~max_proofs_verified:(module Pickles_types.Nat.N2) (* ^ TODO make max_branching configurable -- needs refactor in party types *) ~name:"smart-contract" ~constraint_constants: @@ -2148,7 +2150,7 @@ module Ledger = struct Check (closed_interval (Currency.Amount.of_uint64 ^ uint64) - e##.ledger##.totalCurrency) + e##.ledger##.totalCurrency ) } ; seed = or_ignore field e##.seed ; start_checkpoint = or_ignore field e##.startCheckpoint @@ -2157,7 +2159,7 @@ module Ledger = struct Check (closed_interval (Mina_numbers.Length.of_uint32 ^ uint32) - e##.epochLength) + e##.epochLength ) } let predicate (t : Account_precondition.t) : Party.Account_precondition.t = @@ -2167,7 +2169,7 @@ module Ledger = struct | "nonce" -> Nonce (Mina_numbers.Account_nonce.of_uint32 - (uint32 (Obj.magic t##.value : js_uint32))) + (uint32 (Obj.magic t##.value : js_uint32)) ) | "full" -> let p : full_account_precondition = Obj.magic t##.value in Full @@ -2175,12 +2177,12 @@ module Ledger = struct Check (closed_interval (Fn.compose Currency.Balance.of_uint64 uint64) - p##.balance) + p##.balance ) ; nonce = Check (closed_interval (Fn.compose Mina_numbers.Account_nonce.of_uint32 uint32) - p##.nonce) + p##.nonce ) ; receipt_chain_hash = or_ignore field p##.receiptChainHash ; delegate = or_ignore public_key p##.delegate ; state = @@ -2204,28 +2206,28 @@ module Ledger = struct Check (closed_interval (Mina_numbers.Length.of_uint32 ^ uint32) - p##.blockchainLength) + p##.blockchainLength ) ; min_window_density = Check (closed_interval (Mina_numbers.Length.of_uint32 ^ uint32) - p##.minWindowDensity) + p##.minWindowDensity ) ; last_vrf_output = () ; total_currency = Check (closed_interval (Currency.Amount.of_uint64 ^ uint64) - p##.totalCurrency) + p##.totalCurrency ) ; global_slot_since_hard_fork = Check (closed_interval (Mina_numbers.Global_slot.of_uint32 ^ uint32) - p##.globalSlotSinceHardFork) + p##.globalSlotSinceHardFork ) ; global_slot_since_genesis = Check (closed_interval (Mina_numbers.Global_slot.of_uint32 ^ uint32) - p##.globalSlotSinceGenesis) + p##.globalSlotSinceGenesis ) ; staking_epoch_data = epoch_data p##.stakingEpochData ; next_epoch_data = epoch_data p##.nextEpochData } @@ -2281,7 +2283,7 @@ module Ledger = struct let update (u : party_update) : Party.Update.t = { app_state = Pickles_types.Vector.init Zkapp_state.Max_state_size.n ~f:(fun i -> - set_or_keep field (array_get_exn u##.appState i)) + set_or_keep field (array_get_exn u##.appState i) ) ; delegate = set_or_keep public_key u##.delegate ; verification_key = set_or_keep verification_key_with_hash u##.verificationKey @@ -2343,7 +2345,7 @@ module Ledger = struct | "nonce" -> Nonce (Mina_numbers.Account_nonce.of_uint32 - (uint32 (Obj.magic t##.value : js_uint32))) + (uint32 (Obj.magic t##.value : js_uint32)) ) | "full" -> let p : full_account_precondition = Obj.magic t##.value in Full @@ -2351,12 +2353,12 @@ module Ledger = struct Check (closed_interval (Fn.compose Currency.Balance.of_uint64 uint64) - p##.balance) + p##.balance ) ; nonce = Check (closed_interval (Fn.compose Mina_numbers.Account_nonce.of_uint32 uint32) - p##.nonce) + p##.nonce ) ; receipt_chain_hash = or_ignore field p##.receiptChainHash ; delegate = or_ignore public_key p##.delegate ; state = @@ -2418,7 +2420,7 @@ module Ledger = struct |> Array.map ~f:(fun p : Party.t -> { body = body p##.body ; authorization = authorization p##.authorization - }) + } ) |> Array.to_list |> Parties.Call_forest.of_parties_list ~party_depth:(fun (p : Party.t) -> p.body.call_depth) @@ -2577,7 +2579,7 @@ module Ledger = struct ; delegate = ignore pk_dummy ; state = Pickles_types.Vector.init Zkapp_state.Max_state_size.n ~f:(fun _ -> - ignore Field.zero) + ignore Field.zero ) ; sequence_state = ignore Field.zero ; proved_state = ignore Boolean.false_ } @@ -2637,7 +2639,7 @@ module Ledger = struct let u = b##.update in { app_state = Pickles_types.Vector.init Zkapp_state.Max_state_size.n ~f:(fun i -> - set_or_keep field (array_get_exn u##.appState i)) + set_or_keep field (array_get_exn u##.appState i) ) ; delegate = set_or_keep public_key u##.delegate ; (* TODO *) verification_key = keep @@ -2646,13 +2648,14 @@ module Ledger = struct Mina_base.Data_as_hash.make_unsafe (Field.constant @@ Mina_base.Zkapp_account.dummy_vk_hash ()) (As_prover.Ref.create (fun () -> - { With_hash.data = None; hash = Field.Constant.zero })) + { With_hash.data = None; hash = Field.Constant.zero } ) + ) } ; permissions = keep Mina_base.Permissions.(Checked.constant empty) ; zkapp_uri = keep (Mina_base.Data_as_hash.make_unsafe Field.zero - (As_prover.Ref.create (fun () -> ""))) + (As_prover.Ref.create (fun () -> "")) ) ; token_symbol = keep Field.zero ; timing = keep (timing_info_dummy ()) ; voting_for = @@ -2686,7 +2689,7 @@ module Ledger = struct let u = b##.update in { app_state = Pickles_types.Vector.init Zkapp_state.Max_state_size.n ~f:(fun i -> - set_or_keep field (array_get_exn u##.appState i)) + set_or_keep field (array_get_exn u##.appState i) ) ; delegate = set_or_keep public_key u##.delegate ; (* TODO *) verification_key = keep @@ -2695,13 +2698,14 @@ module Ledger = struct Mina_base.Data_as_hash.make_unsafe (Field.constant @@ Mina_base.Zkapp_account.dummy_vk_hash ()) (As_prover.Ref.create (fun () -> - { With_hash.data = None; hash = Field.Constant.zero })) + { With_hash.data = None; hash = Field.Constant.zero } ) + ) } ; permissions = keep Mina_base.Permissions.(Checked.constant empty) ; zkapp_uri = keep (Mina_base.Data_as_hash.make_unsafe Field.zero - (As_prover.Ref.create (fun () -> ""))) + (As_prover.Ref.create (fun () -> "")) ) ; token_symbol = keep Field.zero ; timing = keep (timing_info_dummy ()) ; voting_for = @@ -2753,7 +2757,7 @@ module Ledger = struct ( match a.zkapp with | Some s -> Pickles_types.Vector.iter s.app_state ~f:(fun x -> - ignore (xs##push (field x))) + ignore (xs##push (field x)) ) | None -> for _ = 0 to max_state_size - 1 do xs##push (field Field.Constant.zero) |> ignore @@ -2901,7 +2905,7 @@ module Ledger = struct let signature = Signature_lib.Schnorr.Chunked.sign (private_key key) (Random_oracle.Input.Chunked.field - (transaction_commitment tx party_index)) + (transaction_commitment tx party_index) ) in ( match party_index with | Fee_payer -> @@ -2912,7 +2916,7 @@ module Ledger = struct Parties.Call_forest.mapi tx.other_parties ~f:(fun i' (p : Party.t) -> if i' = i then { p with authorization = Signature signature } - else p) + else p ) } ) |> Parties.to_json |> Yojson.Safe.to_string |> Js.string @@ -2935,17 +2939,17 @@ module Ledger = struct | None -> failwith (sprintf "Check signature: Invalid key on %s: %s" who - (key_to_string pk)) + (key_to_string pk) ) | Some pk_ -> if not (Signature_lib.Schnorr.Chunked.verify s (Kimchi_pasta.Pasta.Pallas.of_affine pk_) - (Random_oracle_input.Chunked.field msg)) + (Random_oracle_input.Chunked.field msg) ) then failwith (sprintf "Check signature: Invalid signature on %s for key %s" who - (key_to_string pk)) + (key_to_string pk) ) else () in @@ -2962,7 +2966,7 @@ module Ledger = struct check_signature (sprintf "party %d" i) s p.body.public_key commitment | Proof _ | None_given -> - ()) + () ) let public_key_to_string (pk : public_key) : Js.js_string Js.t = pk |> public_key |> Signature_lib.Public_key.Compressed.to_base58_check @@ -2997,10 +3001,10 @@ module Ledger = struct < publicKey : public_key Js.prop ; balance : Js.js_string Js.t Js.prop > Js.t Js.js_array - Js.t) : ledger_class Js.t = + Js.t ) : ledger_class Js.t = let l = L.empty ~depth:20 () in array_iter genesis_accounts ~f:(fun a -> - add_account_exn l a##.publicKey (Js.to_string a##.balance)) ; + add_account_exn l a##.publicKey (Js.to_string a##.balance) ) ; new%js ledger_constr l let get_account l (pk : public_key) : account Js.optdef = diff --git a/src/lib/snarky_js_bindings/tests/tests.ml b/src/lib/snarky_js_bindings/tests/tests.ml index 23e0d8dd9f0..de99a56cff5 100644 --- a/src/lib/snarky_js_bindings/tests/tests.ml +++ b/src/lib/snarky_js_bindings/tests/tests.ml @@ -15,7 +15,7 @@ let keygen_prove_verify (main : ?w:'a -> 'b -> unit -> unit) spec ?priv pub = Impl.generate_witness_conv ~f:(fun { Impl.Proof_inputs.auxiliary_inputs; public_inputs } _ -> Backend.Proof.create pk ~auxiliary:auxiliary_inputs - ~primary:public_inputs) + ~primary:public_inputs ) spec ~return_typ:(Snarky_backendless.Typ.unit ()) (main ?w:priv) pub diff --git a/src/lib/snarky_log/examples/election/election.ml b/src/lib/snarky_log/examples/election/election.ml index 27af9894a1a..83c8503449d 100644 --- a/src/lib/snarky_log/examples/election/election.ml +++ b/src/lib/snarky_log/examples/election/election.ml @@ -76,7 +76,7 @@ let open_ballot i (commitment : Ballot.Closed.var) = let%map _, vote = request Ballot.Opened.typ (Open_ballot i) ~such_that:(fun opened -> let%bind implied = close_ballot_var opened in - Ballot.Closed.assert_equal commitment implied) + Ballot.Closed.assert_equal commitment implied ) in vote @@ -88,7 +88,7 @@ let count_pepperoni_votes vs = let%bind pepperoni_vote = Vote.(v = var Pepperoni) in Number.if_ pepperoni_vote ~then_:(acc + constant Field.one) - ~else_:(acc + constant Field.zero)) + ~else_:(acc + constant Field.zero) ) (* Aside for experts: This function could be much more efficient since a Candidate is just a bool which can be coerced to a cvar (thus requiring literally no constraints @@ -125,7 +125,7 @@ let winner (ballots : Ballot.Opened.t array) = | _, Pepperoni -> true | _, Mushroom -> - false) + false ) in if pepperoni_votes > Array.length ballots / 2 then Vote.Pepperoni else Mushroom @@ -139,12 +139,12 @@ let handled_check (ballots : Ballot.Opened.t array) commitments claimed_winner = | Open_ballot i -> respond (Provide ballots.(i)) | _ -> - unhandled) + unhandled ) let tally_and_prove (ballots : Ballot.Opened.t array) = let commitments = List.init number_of_voters ~f:(fun i -> - Hash.hash (Ballot.Opened.to_bits ballots.(i))) + Hash.hash (Ballot.Opened.to_bits ballots.(i)) ) in let winner = winner ballots in ( commitments diff --git a/src/lib/snarky_log/examples/election/election_main.ml b/src/lib/snarky_log/examples/election/election_main.ml index 4a795cfa797..a22c47001e2 100644 --- a/src/lib/snarky_log/examples/election/election_main.ml +++ b/src/lib/snarky_log/examples/election/election_main.ml @@ -38,7 +38,7 @@ let () = (* Mock data *) let received_ballots = Array.init number_of_voters ~f:(fun _ -> - Ballot.Opened.create (if Random.bool () then Pepperoni else Mushroom)) + Ballot.Opened.create (if Random.bool () then Pepperoni else Mushroom) ) in let commitments, winner, proof = tally_and_prove received_ballots in let log_events = diff --git a/src/lib/snarky_log/examples/election/knapsack_hash.ml b/src/lib/snarky_log/examples/election/knapsack_hash.ml index 475d776e033..7ed23bb2167 100644 --- a/src/lib/snarky_log/examples/election/knapsack_hash.ml +++ b/src/lib/snarky_log/examples/election/knapsack_hash.ml @@ -16,7 +16,7 @@ let var_to_bits xs = Checked.map ~f:List.concat (Checked.all (List.map xs - ~f:(Field.Checked.choose_preimage_var ~length:Field.size_in_bits))) + ~f:(Field.Checked.choose_preimage_var ~length:Field.size_in_bits) ) ) let knapsack = M.create ~dimension ~max_input_length:1000 diff --git a/src/lib/snarky_log/snarky_log.ml b/src/lib/snarky_log/snarky_log.ml index c40ec7b8ed6..1c993f6d173 100644 --- a/src/lib/snarky_log/snarky_log.ml +++ b/src/lib/snarky_log/snarky_log.ml @@ -30,7 +30,7 @@ module Constraints (Snarky_backendless : Snark_intf.Basic) = struct create_event label ~phase:(if start then Measure_start else Measure_end) ~timestamp:count - :: !rev_events) + :: !rev_events ) in List.rev !rev_events diff --git a/src/lib/snarky_pairing/g2_precomputation.ml b/src/lib/snarky_pairing/g2_precomputation.ml index 1037a76afb5..b90da193712 100644 --- a/src/lib/snarky_pairing/g2_precomputation.ml +++ b/src/lib/snarky_pairing/g2_precomputation.ml @@ -194,7 +194,7 @@ struct let%map () = assert_r1cs c.gamma (s.rx - rx) (res + s.ry) in res in - { rx; ry }) + { rx; ry } ) in (s, c)) @@ -279,5 +279,5 @@ struct (let%map coeffs = go (Array.length naf - 1) false { rx = qx; ry = qy } [] in - { q; coeffs }) + { q; coeffs } ) end diff --git a/src/lib/snarky_pairing/miller_loop.ml b/src/lib/snarky_pairing/miller_loop.ml index 3cc8929ae76..ae5a576cdf2 100644 --- a/src/lib/snarky_pairing/miller_loop.ml +++ b/src/lib/snarky_pairing/miller_loop.ml @@ -64,7 +64,7 @@ module Make (Inputs : Inputs_intf) = struct let%map t = Fqe.mul_field gamma_twist px in Fqe.(c.gamma_x - c.ry - t) in - (p.py_twist_squared, c1)) + (p.py_twist_squared, c1) ) (* result = c.gamma_x + qy * (invert_q ? -1 : 1) - gamma_twist * px *) let add_line_eval ~invert_q (p : G1_precomputation.t) @@ -78,7 +78,7 @@ module Make (Inputs : Inputs_intf) = struct let%map t = mul_field gamma_twist px in c.gamma_x + (if invert_q then qy else Fqe.negate qy) - t in - (p.py_twist_squared, c1)) + (p.py_twist_squared, c1) ) let uncons_exn = function [] -> failwith "uncons_exn" | x :: xs -> (x, xs) @@ -123,7 +123,7 @@ module Make (Inputs : Inputs_intf) = struct times a constant. *) in - (acc, (sgn, p, { q with G2_precomputation.coeffs }))) + (acc, (sgn, p, { q with G2_precomputation.coeffs })) ) in let rec go i found_nonzero pairs f = if i < 0 then return f diff --git a/src/lib/snarky_taylor/snarky_taylor.ml b/src/lib/snarky_taylor/snarky_taylor.ml index afdbc6829a4..4b3ecaff34d 100644 --- a/src/lib/snarky_taylor/snarky_taylor.ml +++ b/src/lib/snarky_taylor/snarky_taylor.ml @@ -45,7 +45,7 @@ let log ~terms x = let open Sequence in unfold ~init:(a, 1) ~f:(fun (ai, i) -> let t = ai / of_int i in - Some ((if Int.(i mod 2 = 0) then neg t else t), (ai * a, Int.(i + 1)))) + Some ((if Int.(i mod 2 = 0) then neg t else t), (ai * a, Int.(i + 1))) ) |> Fn.flip take terms |> fold ~init:zero ~f:( + ) (* This computes the number of terms of a taylor series one needs to compute @@ -62,7 +62,7 @@ let terms_needed ~derivative_magnitude_upper_bound ~bits_of_precision:k = least ~such_that:(fun n -> let nn = B.of_int n in let d = derivative_magnitude_upper_bound Int.(n + 1) in - Bignum.(of_bigint (factorial nn) / d > lower_bound)) + Bignum.(of_bigint (factorial nn) / d > lower_bound) ) let ceil_log2 n = least ~such_that:(fun i -> B.(pow (of_int 2) (of_int i) >= n)) @@ -74,7 +74,7 @@ let binary_expansion x = ~f:(fun (rem, pt) -> let b = Bignum.(rem >= pt) in let rem = if b then Bignum.(rem - pt) else rem in - Some (b, Bignum.(rem, pt / two))) + Some (b, Bignum.(rem, pt / two)) ) module Coeff_integer_part = struct type t = [ `Zero | `One ] [@@deriving sexp] @@ -142,7 +142,7 @@ module Exp = struct let per_term_precision = ceil_log2 (B.of_int n) + k in if (n * per_term_precision) + per_term_precision < field_size_in_bits then Some { per_term_precision; terms_needed = n; total_precision = k } - else None) + else None ) let params ~field_size_in_bits ~base = let abs_log_base = @@ -181,7 +181,7 @@ module Exp = struct c ) in ( (if i mod 2 = 0 then `Neg else `Pos) - , c_frac |> bignum_as_fixed_point per_term_precision )) + , c_frac |> bignum_as_fixed_point per_term_precision ) ) in (coefficients, !linear_term_integer_part) in @@ -202,7 +202,7 @@ module Exp = struct let x_i = Bignum.(x_i * x) in let c = Bignum.(of_bigint c / denom) in let c = match sgn with `Pos -> c | `Neg -> Bignum.neg c in - (Bignum.(acc + (x_i * c)), x_i)) + (Bignum.(acc + (x_i * c)), x_i) ) |> fst |> fun acc -> Bignum.( @@ -222,7 +222,7 @@ module Exp = struct assert ([%equal: [ `Pos | `Neg ]] sgn `Pos) ; Some term | Some s -> - Some (Floating_point.add_signed ~m s (sgn, term))) + Some (Floating_point.add_signed ~m s (sgn, term)) ) |> Option.value_exn in match linear_term_integer_part with @@ -242,7 +242,7 @@ module Exp = struct let coefficients = Array.map coefficients ~f:(fun (sgn, c) -> ( sgn - , Floating_point.constant ~m ~value:c ~precision:per_term_precision )) + , Floating_point.constant ~m ~value:c ~precision:per_term_precision ) ) in taylor_sum ~m powers coefficients linear_term_integer_part end diff --git a/src/lib/snarky_taylor/tests/floating_point_test.ml b/src/lib/snarky_taylor/tests/floating_point_test.ml index 73b931e957b..ccf449ad1ff 100644 --- a/src/lib/snarky_taylor/tests/floating_point_test.ml +++ b/src/lib/snarky_taylor/tests/floating_point_test.ml @@ -25,7 +25,7 @@ let%test_unit "of-quotient" = of_quotient ~m ~precision ~top:(Integer.constant ~m a) ~bottom:(Integer.constant ~m b) ~top_is_less_than_bottom:() in - to_bignum ~m t) + to_bignum ~m t ) |> Or_error.ok_exn in let actual = Bignum.(of_bigint a / of_bigint b) in @@ -35,4 +35,4 @@ let%test_unit "of-quotient" = if not good then failwithf "got %s, expected %s\n" (Bignum.to_string_hum res) (Bignum.to_string_hum actual) - ()) + () ) diff --git a/src/lib/snarky_taylor/tests/snarky_taylor_test.ml b/src/lib/snarky_taylor/tests/snarky_taylor_test.ml index f14c75fe4b6..221bc61e1e8 100644 --- a/src/lib/snarky_taylor/tests/snarky_taylor_test.ml +++ b/src/lib/snarky_taylor/tests/snarky_taylor_test.ml @@ -20,7 +20,7 @@ let%test_unit "instantiate" = (Integer.of_bits ~m (Bitstring.Lsb_first.of_list Boolean.[ true_ ])) ~bottom: (Integer.of_bits ~m - (Bitstring.Lsb_first.of_list Boolean.[ false_; true_ ])) + (Bitstring.Lsb_first.of_list Boolean.[ false_; true_ ]) ) ~top_is_less_than_bottom:() ~precision:2 in Floating_point.to_bignum ~m (Exp.one_minus_exp ~m params arg) diff --git a/src/lib/snarky_verifier/bowe_gabizon.ml b/src/lib/snarky_verifier/bowe_gabizon.ml index 87c899f80a1..16197cda5b3 100644 --- a/src/lib/snarky_verifier/bowe_gabizon.ml +++ b/src/lib/snarky_verifier/bowe_gabizon.ml @@ -64,7 +64,7 @@ module Make (Inputs : Inputs_intf) = struct let if_list if_ b ~then_ ~else_ = Checked.List.map (List.zip_exn then_ else_) ~f:(fun (t, e) -> - if_ b ~then_:t ~else_:e) + if_ b ~then_:t ~else_:e ) let if_ b ~then_ ~else_ = let c if_ p = if_ b ~then_:(p then_) ~else_:(p else_) in diff --git a/src/lib/snarky_verifier/groth.ml b/src/lib/snarky_verifier/groth.ml index cc07e069fe6..e5d00401879 100644 --- a/src/lib/snarky_verifier/groth.ml +++ b/src/lib/snarky_verifier/groth.ml @@ -35,7 +35,7 @@ module Make (Inputs : Inputs.S) = struct let if_list if_ b ~then_ ~else_ = Checked.List.map (List.zip_exn then_ else_) ~f:(fun (t, e) -> - if_ b ~then_:t ~else_:e) + if_ b ~then_:t ~else_:e ) let if_ b ~then_ ~else_ = let c if_ p = if_ b ~then_:(p then_) ~else_:(p else_) in diff --git a/src/lib/snarky_verifier/groth_maller.ml b/src/lib/snarky_verifier/groth_maller.ml index b43c7b65468..9d182d4a1f1 100644 --- a/src/lib/snarky_verifier/groth_maller.ml +++ b/src/lib/snarky_verifier/groth_maller.ml @@ -93,7 +93,7 @@ module Make (Inputs : Inputs.S) = struct let%bind init = G1_shifted.(add zero vk.query_base) in Checked.List.fold (List.zip_exn vk.query inputs) ~init ~f:(fun acc (g, input) -> - G1.scale (module G1_shifted) g input ~init:acc) + G1.scale (module G1_shifted) g input ~init:acc ) >>= G1_shifted.unshift_nonzero in let%bind test1 = diff --git a/src/lib/snarky_verifier/summary.ml b/src/lib/snarky_verifier/summary.ml index 38a3d1ffd3c..25179ca09ad 100644 --- a/src/lib/snarky_verifier/summary.ml +++ b/src/lib/snarky_verifier/summary.ml @@ -37,7 +37,7 @@ module Make (Inputs : Inputs_intf) = struct @ List.concat_map g2s ~f:(fun (x, _) -> Fqe.to_list x) @ List.concat_map gts ~f:(fun (a, _) -> Fqe.to_list a) |> Checked.List.map ~f:(fun x -> - Field.Checked.choose_preimage_var x ~length:Field.size_in_bits) + Field.Checked.choose_preimage_var x ~length:Field.size_in_bits ) >>| List.concat and signs = let parity x = diff --git a/src/lib/sparse_ledger_lib/sparse_ledger.ml b/src/lib/sparse_ledger_lib/sparse_ledger.ml index 99cfefb0e51..641472170f4 100644 --- a/src/lib/sparse_ledger_lib/sparse_ledger.ml +++ b/src/lib/sparse_ledger_lib/sparse_ledger.ml @@ -166,7 +166,7 @@ end = struct let add_path (t : t) path account_id account = let index = List.foldi path ~init:0 ~f:(fun i acc x -> - match x with `Right _ -> acc + (1 lsl i) | `Left _ -> acc) + match x with `Right _ -> acc + (1 lsl i) | `Left _ -> acc ) in { t with tree = add_path t.depth t.tree path account @@ -374,7 +374,7 @@ let%test_module "sparse-ledger-test" = ~message: "Iteri index should be contained in the indexes auxillary \ structure" - ~expect:true (Int.Set.mem indexes i))) + ~expect:true (Int.Set.mem indexes i) ) ) let%test_unit "path_test" = Quickcheck.test gen ~f:(fun t -> @@ -382,7 +382,7 @@ let%test_module "sparse-ledger-test" = let t' = List.fold t.indexes ~init:root ~f:(fun acc (_, index) -> let account = get_exn t index in - add_path acc (path_exn t index) (Account.key account) account) + add_path acc (path_exn t index) (Account.key account) account ) in - assert (Tree.equal Hash.equal Account.equal t'.tree t.tree)) + assert (Tree.equal Hash.equal Account.equal t'.tree t.tree) ) end ) diff --git a/src/lib/staged_ledger/pre_diff_info.ml b/src/lib/staged_ledger/pre_diff_info.ml index fce0e35bd19..fe722b41d41 100644 --- a/src/lib/staged_ledger/pre_diff_info.ml +++ b/src/lib/staged_ledger/pre_diff_info.ml @@ -91,7 +91,7 @@ type 't t = the first prediff may have no slots left after adding transactions (for example, when there are three slots and maximum number of provers), in which case, we simply add one coinbase as part of the second prediff. - *) +*) let create_coinbase ~(constraint_constants : Genesis_constants.Constraint_constants.t) coinbase_parts ~(receiver : Public_key.Compressed.t) ~coinbase_amount = @@ -110,7 +110,7 @@ let create_coinbase (sprintf !"underflow when splitting coinbase: Minuend: %{sexp: \ Currency.Amount.t} Subtrahend: %{sexp: Currency.Amount.t} \n" - a1 a2))) + a1 a2 ) ) ) (Currency.Amount.sub a1 a2) ~f:(fun x -> Ok x) in @@ -119,7 +119,7 @@ let create_coinbase let%bind _ = underflow_err rem_coinbase (Option.value_map ~default:Currency.Amount.zero ft2 - ~f:(fun { fee; _ } -> Currency.Amount.of_fee fee)) + ~f:(fun { fee; _ } -> Currency.Amount.of_fee fee) ) in let%bind cb1 = coinbase_or_error @@ -156,7 +156,7 @@ let create_coinbase !"Overflow when trying to add account_creation_fee \ %{sexp: Currency.Fee.t} to a fee transfer %{sexp: \ Currency.Fee.t}" - constraint_constants.account_creation_fee fee))) + constraint_constants.account_creation_fee fee ) ) ) ~f:(fun v -> Ok v) in Currency.Amount.of_fee fee @@ -171,7 +171,7 @@ let sum_fees xs ~f = | None -> return (Or_error.error_string "Fee overflow") | Some res -> - res))) + res ) ) ) let to_staged_ledger_or_error = Result.map_error ~f:(fun error -> Error.Unexpected error) @@ -203,12 +203,12 @@ let create_fee_transfers completed_works delta public_key coinbase_fts = @ List.filter_map completed_works ~f:(fun { Transaction_snark_work.fee; prover; _ } -> if Currency.Fee.equal fee Currency.Fee.zero then None - else Some (prover, fee)) + else Some (prover, fee) ) in let%bind singles_map = Or_error.try_with (fun () -> Public_key.Compressed.Map.of_alist_reduce singles ~f:(fun f1 f2 -> - Option.value_exn (Currency.Fee.add f1 f2))) + Option.value_exn (Currency.Fee.add f1 f2) ) ) |> to_staged_ledger_or_error in (* deduct the coinbase work fee from the singles_map. It is already part of the coinbase *) @@ -222,16 +222,16 @@ let create_fee_transfers completed_works delta public_key coinbase_fts = let new_fee = Option.value_exn (Currency.Fee.sub fee cb_fee) in if Currency.Fee.(new_fee > Currency.Fee.zero) then Public_key.Compressed.Map.update accum receiver_pk ~f:(fun _ -> - new_fee) - else Public_key.Compressed.Map.remove accum receiver_pk) + new_fee ) + else Public_key.Compressed.Map.remove accum receiver_pk ) (* TODO: This creates a weird incentive to have a small public_key *) |> Map.to_alist ~key_order:`Increasing |> List.map ~f:(fun (receiver_pk, fee) -> Fee_transfer.Single.create ~receiver_pk ~fee - ~fee_token:Token_id.default) + ~fee_token:Token_id.default ) |> One_or_two.group_list |> List.map ~f:Fee_transfer.of_singles - |> Or_error.all) + |> Or_error.all ) |> Or_error.join |> to_staged_ledger_or_error module Transaction_data = struct @@ -248,7 +248,7 @@ let get_transaction_data (type c) ~constraint_constants coinbase_parts ~receiver let%bind coinbases = O1trace.sync_thread "create_coinbase" (fun () -> create_coinbase ~constraint_constants coinbase_parts ~receiver - ~coinbase_amount) + ~coinbase_amount ) in let coinbase_fts = List.concat_map coinbases ~f:(fun cb -> Option.to_list cb.fee_transfer) @@ -258,7 +258,7 @@ let get_transaction_data (type c) ~constraint_constants coinbase_parts ~receiver in let txn_works_others = List.filter completed_works ~f:(fun { Transaction_snark_work.prover; _ } -> - not (Public_key.Compressed.equal receiver prover)) + not (Public_key.Compressed.equal receiver prover) ) in let%bind delta = fee_remainder commands txn_works_others coinbase_work_fees ~forget @@ -290,7 +290,7 @@ let get_individual_info (type c) ~constraint_constants coinbase_parts ~receiver { With_status.data = cmd; status = Applied } | _ -> (* Caught by [try_with] above, it doesn't matter what we throw. *) - assert false)) + assert false ) ) |> Result.map_error ~f:(fun _ -> Error.Internal_command_status_mismatch) in let transactions = @@ -319,7 +319,7 @@ let generate_statuses (type c) ~constraint_constants coinbase_parts ~receiver ; status = Or_error.ok_exn (generate_status (Transaction.Command (forget cmd.data))) - })) + } ) ) |> Result.map_error ~f:(fun err -> Error.Unexpected err) in transactions @@ -330,7 +330,7 @@ let check_coinbase (diff : _ Pre_diff_two.t * _ Pre_diff_one.t option) = match ( (fst diff).coinbase , Option.value_map ~default:At_most_one.Zero (snd diff) ~f:(fun d -> - d.coinbase) ) + d.coinbase ) ) with | Zero, Zero | Zero, One _ | One _, Zero | Two _, Zero -> Ok () @@ -341,7 +341,7 @@ let check_coinbase (diff : _ Pre_diff_two.t * _ Pre_diff_one.t option) = !"Invalid coinbase value in staged ledger prediffs \ %{sexp:Coinbase.Fee_transfer.t At_most_two.t} and \ %{sexp:Coinbase.Fee_transfer.t At_most_one.t}" - x y)) + x y ) ) let compute_statuses (type c) ~(constraint_constants : Genesis_constants.Constraint_constants.t) ~diff @@ -398,7 +398,7 @@ let get' (type c) coinbase factor (%d) x coinbase amount (%{sexp: \ Currency.Amount.t})" constraint_constants.supercharged_coinbase_factor - constraint_constants.coinbase_amount))) + constraint_constants.coinbase_amount ) ) ) ~f:(fun x -> Ok x) in let apply_pre_diff_with_at_most_two (t1 : (_, c With_status.t) Pre_diff_two.t) @@ -447,7 +447,7 @@ let get ~check ~constraint_constants ~coinbase_receiver ~supercharge_coinbase t ~diff:diff.diff ~coinbase_receiver ~coinbase_amount: (Staged_ledger_diff.With_valid_signatures.coinbase - ~constraint_constants ~supercharge_coinbase diff) + ~constraint_constants ~supercharge_coinbase diff ) let get_unchecked ~constraint_constants ~coinbase_receiver ~supercharge_coinbase (t : With_valid_signatures_and_proofs.t) = @@ -456,7 +456,7 @@ let get_unchecked ~constraint_constants ~coinbase_receiver ~supercharge_coinbase ~forget:User_command.forget_check ~coinbase_amount: (Staged_ledger_diff.With_valid_signatures.coinbase ~constraint_constants - ~supercharge_coinbase t) + ~supercharge_coinbase t ) let get_transactions ~constraint_constants ~coinbase_receiver ~supercharge_coinbase (sl_diff : t) = @@ -466,6 +466,6 @@ let get_transactions ~constraint_constants ~coinbase_receiver ~forget:Fn.id ~coinbase_amount: (Staged_ledger_diff.coinbase ~constraint_constants ~supercharge_coinbase - sl_diff) + sl_diff ) in transactions diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index 3f98497206d..73f3770a60d 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -62,7 +62,7 @@ module T = struct ( s , Transaction_snark.Statement.hash s , Yojson.Safe.to_string - @@ Public_key.Compressed.to_yojson m.prover ))) + @@ Public_key.Compressed.to_yojson m.prover ) ) ) | Insufficient_work str -> str | Mismatched_statuses (transaction, status) -> @@ -93,7 +93,7 @@ module T = struct let statements () = `List (List.map proofs ~f:(fun (_, s, _) -> - Transaction_snark.Statement.to_yojson s)) + Transaction_snark.Statement.to_yojson s ) ) in let log_error err_str ~metadata = [%log warn] @@ -114,7 +114,7 @@ module T = struct not (Transaction_snark.Statement.equal (Ledger_proof.statement proof) - statement)) + statement ) ) then log_error "Statement and proof do not match" ~metadata: @@ -122,7 +122,7 @@ module T = struct , `List (List.map proofs ~f:(fun (p, _, _) -> Transaction_snark.Statement.to_yojson - (Ledger_proof.statement p))) ) + (Ledger_proof.statement p) ) ) ) ] else let start = Time.now () in @@ -137,7 +137,7 @@ module T = struct [ ( "work_id" , `List (List.map proofs ~f:(fun (_, s, _) -> - `Int (Transaction_snark.Statement.hash s))) ) + `Int (Transaction_snark.Statement.hash s) ) ) ) ; ("time", `Float time_ms) ] "Verification in apply_diff for work $work_id took $time ms" ; @@ -148,7 +148,7 @@ module T = struct [ ( "statement" , `List (List.map proofs ~f:(fun (_, s, _) -> - Transaction_snark.Statement.to_yojson s)) ) + Transaction_snark.Statement.to_yojson s ) ) ) ; ("error", Error_json.error_to_yojson e) ] "Verifier error when checking transaction snark for statement \ @@ -159,14 +159,14 @@ module T = struct with_return (fun { return } -> Some (List.map xs ~f:(fun x -> - match f x with Some y -> y | None -> return None))) + match f x with Some y -> y | None -> return None ) ) ) let verify ~logger ~verifier job_msg_proofs = let open Deferred.Let_syntax in match map_opt job_msg_proofs ~f:(fun (job, msg, proof) -> Option.map (Scan_state.statement_of_job job) ~f:(fun s -> - (proof, s, msg))) + (proof, s, msg) ) ) with | None -> Deferred.return @@ -208,7 +208,7 @@ module T = struct ((* Invariant: this is the ledger after having applied all the transactions in the above state. *) Ledger.attached_mask - [@sexp.opaque]) + [@sexp.opaque] ) ; constraint_constants : Genesis_constants.Constraint_constants.t ; pending_coinbase_collection : Pending_coinbase.t } @@ -345,7 +345,7 @@ module T = struct Or_error.errorf !"Mismatched user command status. Expected: %{sexp: \ Transaction_status.t} Got: %{sexp: Transaction_status.t}" - tx.status computed_status) + tx.status computed_status ) in let%bind () = let staged_ledger_hash = Ledger.merkle_root snarked_ledger in @@ -356,7 +356,7 @@ module T = struct (Error.createf !"Mismatching merkle root Expected:%{sexp:Ledger_hash.t} \ Got:%{sexp:Ledger_hash.t}" - expected_merkle_root staged_ledger_hash) + expected_merkle_root staged_ledger_hash ) in let pending_coinbase_stack = match Scan_state.latest_ledger_proof scan_state with @@ -451,7 +451,7 @@ module T = struct | None -> return (Or_error.error_string "Fee overflow") | Some res -> - res))) + res ) ) ) let working_stack pending_coinbase_collection ~is_new_stack = to_staged_ledger_or_error @@ -493,7 +493,7 @@ module T = struct coinbase factor (%d) x coinbase amount (%{sexp: \ Currency.Amount.t})" constraint_constants.supercharged_coinbase_factor - constraint_constants.coinbase_amount))) + constraint_constants.coinbase_amount ) ) ) (coinbase_amount ~supercharge_coinbase ~constraint_constants) ~f:(fun x -> Ok x) else Ok constraint_constants.coinbase_amount @@ -562,13 +562,13 @@ module T = struct in let ledger_witness = O1trace.sync_thread "create_ledger_witness" (fun () -> - Sparse_ledger.of_ledger_subset_exn ledger (account_ids s)) + Sparse_ledger.of_ledger_subset_exn ledger (account_ids s) ) in let%bind () = yield_result () in let%bind applied_txn, statement, updated_pending_coinbase_stack_state = O1trace.sync_thread "apply_transaction_to_scan_state" (fun () -> apply_transaction_and_get_statement ~constraint_constants ledger - pending_coinbase_stack_state s txn_state_view) + pending_coinbase_stack_state s txn_state_view ) |> Deferred.return in let%bind () = yield_result () in @@ -585,7 +585,7 @@ module T = struct else Deferred.Result.fail (Staged_ledger_error.Mismatched_statuses - ({ With_status.data = s; status }, got_status)) + ({ With_status.data = s; status }, got_status) ) in ( { Scan_state.Transaction_with_witness.transaction_with_info = applied_txn ; state_hash = state_and_body_hash @@ -615,7 +615,7 @@ module T = struct ( match List.find (Transaction.public_keys t.With_status.data) ~f:(fun pk -> - Option.is_none (Signature_lib.Public_key.decompress pk)) + Option.is_none (Signature_lib.Public_key.decompress pk) ) with | None -> () @@ -629,12 +629,12 @@ module T = struct | Ok (res, updated_pending_coinbase_stack_state) -> (res :: acc, updated_pending_coinbase_stack_state) | Error err -> - raise (Exit err))) + raise (Exit err) ) ) |> Deferred.Result.map_error ~f:(function | Exit err -> err | exn -> - raise exn) + raise exn ) in (List.rev res_rev, pending_coinbase_stack_state.pc.target) @@ -651,7 +651,7 @@ module T = struct One_or_two.( to_list (map (zip_exn jobs work.proofs) ~f:(fun (job, proof) -> - (job, message, proof))))) + (job, message, proof) ) )) ) in verify jmps ~logger ~verifier @@ -668,7 +668,7 @@ module T = struct let t = d.transaction_with_info |> Ledger.Transaction_applied.transaction in - t :: acc) + t :: acc ) in let total_fee_excess txns = List.fold_until txns ~init:Fee_excess.empty ~finish:Or_error.return @@ -681,7 +681,7 @@ module T = struct | Ok fee_excess -> Continue fee_excess | Error _ as err -> - Stop err) + Stop err ) |> to_staged_ledger_or_error in let open Result.Let_syntax in @@ -707,7 +707,7 @@ module T = struct | Transaction.Coinbase _ -> Stop true | _ -> - Continue acc) + Continue acc ) ~finish:Fn.id in let { Scan_state.Space_partition.first = slots, _; second } = @@ -786,7 +786,8 @@ module T = struct (false, data1 @ data2, pending_coinbase_action, stack_update) else Deferred.return - (Ok (false, [], Pending_coinbase.Update.Action.Update_none, `Update_none)) + (Ok (false, [], Pending_coinbase.Update.Action.Update_none, `Update_none) + ) (*update the pending_coinbase tree with the updated/new stack and delete the oldest stack if a proof was emitted*) let update_pending_coinbase_collection ~depth pending_coinbase_collection @@ -812,7 +813,8 @@ module T = struct (Staged_ledger_error.Unexpected (Error.of_string "Pending coinbase stack of the ledger proof did not \ - match the oldest stack in the pending coinbase tree.")) + match the oldest stack in the pending coinbase tree." ) + ) in pending_coinbase_collection_updated1 | None -> @@ -847,7 +849,8 @@ module T = struct | _ -> Error (Staged_ledger_error.Pre_diff - (Pre_diff_info.Error.Coinbase_error "More than two coinbase parts")) + (Pre_diff_info.Error.Coinbase_error "More than two coinbase parts") + ) let apply_diff ?(skip_verification = false) ~logger ~constraint_constants t pre_diff_info ~current_state_view ~state_and_body_hash ~log_prefix = @@ -867,7 +870,7 @@ module T = struct O1trace.thread "update_coinbase_stack_start_time" (fun () -> update_coinbase_stack_and_get_data ~constraint_constants t.scan_state new_ledger t.pending_coinbase_collection transactions - current_state_view state_and_body_hash) + current_state_view state_and_body_hash ) in let slots = List.length data in let work_count = List.length works in @@ -885,8 +888,8 @@ module T = struct (sprintf !"Insufficient number of transaction snark work (slots \ occupying: %d) required %d, got %d" - slots required work_count)) - else Deferred.Result.return ()) + slots required work_count ) ) + else Deferred.Result.return () ) in let%bind () = Deferred.return (check_zero_fee_excess t.scan_state data) in let%bind res_opt, scan_state' = @@ -901,7 +904,7 @@ module T = struct (List.map data ~f:(fun { Scan_state.Transaction_with_witness.statement; _ } - -> Transaction_snark.Statement.to_yojson statement)) + -> Transaction_snark.Statement.to_yojson statement ) ) in [%log error] ~metadata: @@ -912,8 +915,8 @@ module T = struct ; ("prefix", `String log_prefix) ] !"$prefix: Unexpected error when applying diff data $data to \ - the scan_state $scan_state: $error") ; - Deferred.return (to_staged_ledger_or_error r)) + the scan_state $scan_state: $error" ) ; + Deferred.return (to_staged_ledger_or_error r) ) in let%bind () = yield_result () in let%bind updated_pending_coinbase_collection' = @@ -922,7 +925,7 @@ module T = struct ~depth:t.constraint_constants.pending_coinbase_depth t.pending_coinbase_collection stack_update ~is_new_stack ~ledger_proof:res_opt - |> Deferred.return) + |> Deferred.return ) in let%bind () = yield_result () in let%bind coinbase_amount = @@ -941,10 +944,10 @@ module T = struct Deferred.( verify_scan_state_after_apply ~constraint_constants (Frozen_ledger_hash.of_ledger_hash - (Ledger.merkle_root new_ledger)) + (Ledger.merkle_root new_ledger) ) ~pending_coinbase_stack:latest_pending_coinbase_stack scan_state' - >>| to_staged_ledger_or_error)) + >>| to_staged_ledger_or_error) ) in [%log debug] ~metadata: @@ -995,7 +998,7 @@ module T = struct (Float.of_int @@ List.length work) ; Gauge.set Scan_state_metrics.snark_work_required (Float.of_int - (List.length (Scan_state.all_work_statements_exn t.scan_state)))) + (List.length (Scan_state.all_work_statements_exn t.scan_state)) ) ) let forget_prediff_info ((a : Transaction.Valid.t With_status.t list), b, c, d) = @@ -1024,11 +1027,11 @@ module T = struct (Verifier.Failure.Verification_failed (Error.of_string (sprintf "verification failed on command, %s" - (Verifier.invalid_to_string invalid)))) + (Verifier.invalid_to_string invalid) ) ) ) | `Valid_assuming _ -> Error (Verifier.Failure.Verification_failed - (Error.of_string "batch verification failed")))) + (Error.of_string "batch verification failed") ) ) ) [%%else] @@ -1046,7 +1049,7 @@ module T = struct | Parties _ -> Error (Verifier.Failure.Verification_failed - (Error.of_string "check_commands: snapp commands disabled")) + (Error.of_string "check_commands: snapp commands disabled") ) | Signed_command c -> ( match Signed_command.check c with | Some c -> @@ -1054,7 +1057,7 @@ module T = struct | None -> Error (Verifier.Failure.Verification_failed - (Error.of_string "signature failed to verify")) ))) + (Error.of_string "signature failed to verify") ) ) ) ) |> Deferred.Or_error.return [%%endif] @@ -1070,7 +1073,7 @@ module T = struct | Some `All | Some `Proofs -> return () | None -> - check_completed_works ~logger ~verifier t.scan_state work) + check_completed_works ~logger ~verifier t.scan_state work ) in let%bind prediff = Pre_diff_info.get witness ~constraint_constants ~coinbase_receiver @@ -1079,7 +1082,7 @@ module T = struct |> Deferred.map ~f: (Result.map_error ~f:(fun error -> - Staged_ledger_error.Pre_diff error)) + Staged_ledger_error.Pre_diff error ) ) in let apply_diff_start_time = Core.Time.now () in let%map ((_, _, `Staged_ledger new_staged_ledger, _) as res) = @@ -1103,7 +1106,7 @@ module T = struct ~f:(fun e -> [%log error] ~metadata:[ ("error", Error_json.error_to_yojson e) ] - !"Error updating metrics after applying staged_ledger diff: $error") + !"Error updating metrics after applying staged_ledger diff: $error" ) in res @@ -1181,7 +1184,7 @@ module T = struct | Some x, Some y -> if Currency.Fee.compare w.fee x.fee < 0 then (Some w, w1) else if Currency.Fee.compare w.fee y.fee < 0 then (w1, Some w) - else (w1, w2)) + else (w1, w2) ) let coinbase_work ~(constraint_constants : Genesis_constants.Constraint_constants.t) @@ -1194,7 +1197,7 @@ module T = struct Sequence.mem ws' (Transaction_snark_work.statement w) ~equal:Transaction_snark_work.Statement.equal - |> not) + |> not ) in let%bind coinbase_amount = coinbase_amount ~supercharge_coinbase ~constraint_constants @@ -1228,7 +1231,7 @@ module T = struct let cb = Staged_ledger_diff.At_most_two.Two (Option.map (coinbase_ft w1) ~f:(fun ft -> - (ft, coinbase_ft w2))) + (ft, coinbase_ft w2) ) ) (*Why add work without checking if work constraints are satisfied? If we reach here then it means that we are trying to fill the last two slots of the tree with coinbase trnasactions @@ -1254,7 +1257,7 @@ module T = struct (cb, diff works (Sequence.of_list [ stmt w ])) else let cb = Staged_ledger_diff.At_most_two.One None in - (cb, works)) + (cb, works) ) let init_coinbase_and_fee_transfers ~constraint_constants cw_seq ~add_coinbase ~job_count ~slots ~is_coinbase_receiver_new @@ -1283,7 +1286,7 @@ module T = struct let singles = Sequence.filter_map rem_cw ~f:(fun { Transaction_snark_work.fee; prover; _ } -> - if Fee.equal fee Fee.zero then None else Some (prover, fee)) + if Fee.equal fee Fee.zero then None else Some (prover, fee) ) |> Sequence.to_list_rev in (coinbase, singles) @@ -1310,18 +1313,18 @@ module T = struct in let fee_transfers = Public_key.Compressed.Map.of_alist_reduce singles ~f:(fun f1 f2 -> - Option.value_exn (Fee.add f1 f2)) + Option.value_exn (Fee.add f1 f2) ) in let budget = Or_error.map2 (sum_fees (Sequence.to_list uc_seq) ~f:(fun t -> - User_command.fee (t.data :> User_command.t))) + User_command.fee (t.data :> User_command.t) ) ) (sum_fees (List.filter ~f:(fun (k, _) -> - not (Public_key.Compressed.equal k receiver_pk)) - singles) - ~f:snd) + not (Public_key.Compressed.equal k receiver_pk) ) + singles ) + ~f:snd ) ~f:(fun r c -> option "budget did not suffice" (Fee.sub r c)) |> Or_error.join in @@ -1382,12 +1385,12 @@ module T = struct let singles = Sequence.filter_map rem_cw ~f:(fun { Transaction_snark_work.fee; prover; _ } -> - if Fee.equal fee Fee.zero then None else Some (prover, fee)) + if Fee.equal fee Fee.zero then None else Some (prover, fee) ) |> Sequence.to_list_rev in let fee_transfers = Public_key.Compressed.Map.of_alist_reduce singles ~f:(fun f1 f2 -> - Option.value_exn (Fee.add f1 f2)) + Option.value_exn (Fee.add f1 f2) ) in { t with coinbase; fee_transfers } @@ -1396,19 +1399,19 @@ module T = struct let open Or_error.Let_syntax in let payment_fees = sum_fees (Sequence.to_list t.commands_rev) ~f:(fun t -> - User_command.fee (t.data :> User_command.t)) + User_command.fee (t.data :> User_command.t) ) in let prover_fee_others = Public_key.Compressed.Map.fold t.fee_transfers ~init:(Ok Fee.zero) ~f:(fun ~key ~data fees -> let%bind others = fees in if Public_key.Compressed.equal t.receiver_pk key then Ok others - else option "Fee overflow" (Fee.add others data)) + else option "Fee overflow" (Fee.add others data) ) in let revenue = payment_fees in let cost = prover_fee_others in Or_error.map2 revenue cost ~f:(fun r c -> - option "budget did not suffice" (Fee.sub r c)) + option "budget did not suffice" (Fee.sub r c) ) |> Or_error.join let budget_sufficient t = @@ -1608,7 +1611,8 @@ module T = struct in check_constraints_and_update ~constraint_constants resources' (Option.value_map work_opt ~default:log ~f:(fun work -> - Diff_creation_log.discard_completed_work `Extra_work work log)) + Diff_creation_log.discard_completed_work `Extra_work work log ) + ) else (*Well, there's no space; discard a user command *) let resources', uc_opt = Resources.discard_user_command resources in @@ -1616,7 +1620,7 @@ module T = struct (Option.value_map uc_opt ~default:log ~f:(fun uc -> Diff_creation_log.discard_command `No_space (uc.data :> User_command.t) - log)) + log ) ) else (* insufficient budget; reduce the cost*) let resources', work_opt = @@ -1625,7 +1629,7 @@ module T = struct check_constraints_and_update ~constraint_constants resources' (Option.value_map work_opt ~default:log ~f:(fun work -> Diff_creation_log.discard_completed_work `Insufficient_fees work - log)) + log ) ) else (* There isn't enough work for the transactions. Discard a transaction and check again *) let resources', uc_opt = Resources.discard_user_command resources in @@ -1633,7 +1637,7 @@ module T = struct (Option.value_map uc_opt ~default:log ~f:(fun uc -> Diff_creation_log.discard_command `No_work (uc.data :> User_command.t) - log)) + log ) ) let one_prediff ~constraint_constants cw_seq ts_seq ~receiver ~add_coinbase slot_job_count logger ~is_coinbase_receiver_new partition @@ -1652,7 +1656,7 @@ module T = struct ~available_slots:(fst slot_job_count) ~required_work_count:(snd slot_job_count) in - check_constraints_and_update ~constraint_constants init_resources log) + check_constraints_and_update ~constraint_constants init_resources log ) let generate ~constraint_constants logger cw_seq ts_seq ~receiver ~is_coinbase_receiver_new ~supercharge_coinbase @@ -1677,7 +1681,7 @@ module T = struct Sequence.to_list_rev res.commands_rev ; completed_works = Sequence.to_list_rev res.completed_work_rev ; coinbase = to_at_most_one res.coinbase - }) + } ) in let pre_diff_with_two (res : Resources.t) : Staged_ledger_diff.With_valid_signatures_and_proofs @@ -1801,7 +1805,7 @@ module T = struct ~(transactions_by_fee : User_command.Valid.t Sequence.t) ~(get_completed_work : Transaction_snark_work.Statement.t - -> Transaction_snark_work.Checked.t option) ~supercharge_coinbase = + -> Transaction_snark_work.Checked.t option ) ~supercharge_coinbase = O1trace.sync_thread "create_staged_ledger_diff" (fun () -> let open Result.Let_syntax in let module Transaction_validator = @@ -1868,7 +1872,7 @@ module T = struct ] !"Staged_ledger_diff creation: No snark work found for \ $statement" ; - Stop (seq, count)) + Stop (seq, count) ) ~finish:Fn.id in (*Transactions in reverse order for faster removal if there is no space when creating the diff*) @@ -1881,7 +1885,7 @@ module T = struct Transaction_validator.apply_transaction ~constraint_constants validating_ledger ~txn_state_view:current_state_view - (Command (txn :> User_command.t))) + (Command (txn :> User_command.t)) ) with | Error e -> [%log error] @@ -1899,14 +1903,14 @@ module T = struct in let count' = count + 1 in if count' >= Scan_state.free_space t.scan_state then Stop seq' - else Continue (seq', count')) + else Continue (seq', count') ) ~finish:fst in let diff, log = O1trace.sync_thread "generate_staged_ledger_diff" (fun () -> generate ~constraint_constants logger completed_works_seq valid_on_this_ledger ~receiver:coinbase_receiver - ~is_coinbase_receiver_new ~supercharge_coinbase partitions) + ~is_coinbase_receiver_new ~supercharge_coinbase partitions ) in let%map diff = (* Fill in the statuses for commands. *) @@ -1915,12 +1919,12 @@ module T = struct fun txn -> O1trace.sync_thread "get_transaction__status" (fun () -> Transaction_validator.apply_transaction ~constraint_constants - status_ledger ~txn_state_view:current_state_view txn) + status_ledger ~txn_state_view:current_state_view txn ) in Pre_diff_info.compute_statuses ~constraint_constants ~diff ~coinbase_amount: (Option.value_exn - (coinbase_amount ~constraint_constants ~supercharge_coinbase)) + (coinbase_amount ~constraint_constants ~supercharge_coinbase) ) ~coinbase_receiver ~generate_status ~forget:User_command.forget_check in @@ -1941,7 +1945,7 @@ module T = struct , Diff_creation_log.detail_list_to_yojson (List.map ~f:List.rev detailed) ) ] ; - { Staged_ledger_diff.With_valid_signatures_and_proofs.diff }) + { Staged_ledger_diff.With_valid_signatures_and_proofs.diff } ) let latest_block_accounts_created t ~previous_block_state_hash = let scan_state = scan_state t in @@ -1949,7 +1953,7 @@ module T = struct let block_transactions_applied = let f ({ state_hash = leaf_block_hash, _; transaction_with_info; _ } : - Scan_state.Transaction_with_witness.t) = + Scan_state.Transaction_with_witness.t ) = if State_hash.equal leaf_block_hash previous_block_state_hash then Some transaction_with_info.varying else None @@ -1973,7 +1977,7 @@ module T = struct | Fee_transfer { previous_empty_accounts; _ } -> previous_empty_accounts | Coinbase { previous_empty_accounts; _ } -> - previous_empty_accounts) + previous_empty_accounts ) |> List.concat end @@ -2002,14 +2006,14 @@ let%test_module "staged ledger tests" = Async.Thread_safe.block_on_async_exn (fun () -> Verifier.create ~logger ~proof_level ~constraint_constants ~conf_dir:None - ~pids:(Child_processes.Termination.create_pid_table ())) + ~pids:(Child_processes.Termination.create_pid_table ()) ) let supercharge_coinbase ~ledger ~winner ~global_slot = (*using staged ledger to confirm coinbase amount is correctly generated*) let epoch_ledger = Sparse_ledger.of_ledger_subset_exn ledger (List.map [ winner ] ~f:(fun k -> - Account_id.create k Token_id.default)) + Account_id.create k Token_id.default ) ) in Sl.can_apply_supercharged_coinbase_exn ~winner ~global_slot ~epoch_ledger @@ -2108,7 +2112,7 @@ let%test_module "staged ledger tests" = Ledger.with_ephemeral_ledger ~depth:constraint_constants.ledger_depth ~f:(fun ledger -> Ledger.apply_initial_ledger_state ledger ledger_init_state ; - async_with_given_ledger ledger f) + async_with_given_ledger ledger f ) (* Assert the given staged ledger is in the correct state after applying the first n user commands passed to the given base ledger. Checks the @@ -2155,7 +2159,7 @@ let%test_module "staged ledger tests" = Option.value_exn (Option.bind (Ledger.location_of_account ledger pk) - ~f:(Ledger.get ledger)) + ~f:(Ledger.get ledger) ) in (* Check the user accounts in the updated staged ledger are as expected. @@ -2163,7 +2167,7 @@ let%test_module "staged ledger tests" = List.iter pks_to_check ~f:(fun pk -> let expect = get_account_exn test_ledger pk in let actual = get_account_exn (Sl.ledger staged_ledger) pk in - [%test_result: Account.t] ~expect actual) ; + [%test_result: Account.t] ~expect actual ) ; (* We only test that the block producer got the coinbase reward here, since calculating the exact correct amount depends on the snark fees and tx fees. *) let producer_balance_with_coinbase = (let open Option.Let_syntax in @@ -2195,7 +2199,7 @@ let%test_module "staged ledger tests" = fun stmts -> let prover_seed = One_or_two.fold stmts ~init:"P" ~f:(fun p stmt -> - p ^ Frozen_ledger_hash.to_bytes stmt.target.ledger) + p ^ Frozen_ledger_hash.to_bytes stmt.target.ledger ) in Quickcheck.random_value ~seed:(`Deterministic prover_seed) Public_key.Compressed.gen @@ -2204,7 +2208,7 @@ let%test_module "staged ledger tests" = let sok_digest = Sok_message.Digest.default in One_or_two.map stmts ~f:(fun statement -> Ledger_proof.create ~statement ~sok_digest - ~proof:Proof.transaction_dummy) + ~proof:Proof.transaction_dummy ) let stmt_to_work_random_prover (stmts : Transaction_snark_work.Statement.t) : Transaction_snark_work.Checked.t option = @@ -2258,16 +2262,16 @@ let%test_module "staged ledger tests" = let coinbase_count (sl_diff : Staged_ledger_diff.t) = (coinbase_first_prediff (fst sl_diff.diff).coinbase |> fst) + Option.value_map ~default:0 (snd sl_diff.diff) ~f:(fun d -> - coinbase_second_prediff d.coinbase |> fst) + coinbase_second_prediff d.coinbase |> fst ) let coinbase_cost (sl_diff : Staged_ledger_diff.t) = let coinbase_fts = (coinbase_first_prediff (fst sl_diff.diff).coinbase |> snd) @ Option.value_map ~default:[] (snd sl_diff.diff) ~f:(fun d -> - coinbase_second_prediff d.coinbase |> snd) + coinbase_second_prediff d.coinbase |> snd ) in List.fold coinbase_fts ~init:Currency.Fee.zero ~f:(fun total ft -> - Currency.Fee.add total ft.fee |> Option.value_exn) + Currency.Fee.add total ft.fee |> Option.value_exn ) let () = Async.Scheduler.set_record_backtraces true ; @@ -2284,7 +2288,7 @@ let%test_module "staged ledger tests" = |> Sequence.map ~f:(fun (kp, _, _, _) -> Account_id.create (Public_key.compress kp.public_key) - Token_id.default) + Token_id.default ) |> Sequence.to_list (* Fee excess at top level ledger proofs should always be zero *) @@ -2314,7 +2318,7 @@ let%test_module "staged ledger tests" = -> User_command.Valid.t Sequence.t (* Sequence of commands to apply. *) -> 'acc - -> (Staged_ledger_diff.t * 'acc) Deferred.t) + -> (Staged_ledger_diff.t * 'acc) Deferred.t ) -> 'acc Deferred.t = fun cmds cmd_iters acc f -> match cmd_iters with @@ -2347,7 +2351,7 @@ let%test_module "staged ledger tests" = -> Ledger.Mask.Attached.t -> [ `One_prover | `Many_provers ] -> ( Transaction_snark_work.Statement.t - -> Transaction_snark_work.Checked.t option) + -> Transaction_snark_work.Checked.t option ) -> unit Deferred.t = fun account_ids_to_check cmds cmd_iters sl ?(expected_proof_count = None) test_mask provers stmt_to_work -> @@ -2377,7 +2381,7 @@ let%test_module "staged ledger tests" = assert (cmds_applied_this_iter <= Sequence.length cmds_this_iter) ; [%test_eq: User_command.t list] (List.map (Staged_ledger_diff.commands diff) - ~f:(fun { With_status.data; _ } -> data)) + ~f:(fun { With_status.data; _ } -> data) ) ( Sequence.take cmds_this_iter cmds_applied_this_iter |> Sequence.to_list :> User_command.t list ) @@ -2386,7 +2390,7 @@ let%test_module "staged ledger tests" = let coinbase_cost = coinbase_cost diff in assert_ledger test_mask ~coinbase_cost !sl cmds_left cmds_applied_this_iter account_ids_to_check ; - return (diff, proof_count')) + return (diff, proof_count') ) in (*Should have enough blocks to generate at least expected_proof_count proofs*) @@ -2442,7 +2446,7 @@ let%test_module "staged ledger tests" = (Random_oracle.Input.Chunked.field ( Parties.commitment parties |> Parties.Transaction_commitment.create_complete - ~memo_hash ~fee_payer_hash )) + ~memo_hash ~fee_payer_hash ) ) in (* replace fee payer signature, because new protocol state invalidates the old *) let fee_payer_with_valid_signature = @@ -2485,7 +2489,7 @@ let%test_module "staged ledger tests" = "gen_from: Could not find secret key for \ public key %s in keymap" (Signature_lib.Public_key.Compressed - .to_base58_check pk) + .to_base58_check pk ) () in let use_full_commitment = body.use_full_commitment in @@ -2499,7 +2503,7 @@ let%test_module "staged ledger tests" = ( { body ; authorization = authorization_with_valid_signature } - : Party.t )) + : Party.t ) ) in let parties' = { parties with @@ -2509,7 +2513,7 @@ let%test_module "staged ledger tests" = in User_command.Parties parties' | Signed_command _, _, _ -> - failwith "Expected a Parties, got a Signed command") + failwith "Expected a Parties, got a Signed command" ) in assert (List.length zkapps = num_zkapps) ; return (ledger, zkapps, List.init iters ~f:(Fn.const None)) @@ -2592,7 +2596,7 @@ let%test_module "staged ledger tests" = test_simple (init_pks ledger_init_state) cmds iters sl ~expected_proof_count:(Some expected_proof_count) - test_mask `Many_provers stmt_to_work_random_prover)) + test_mask `Many_provers stmt_to_work_random_prover ) ) let%test_unit "Max throughput" = Quickcheck.test gen_at_capacity @@ -2605,7 +2609,7 @@ let%test_module "staged ledger tests" = async_with_ledgers ledger_init_state (fun sl test_mask -> test_simple (init_pks ledger_init_state) - cmds iters sl test_mask `Many_provers stmt_to_work_random_prover)) + cmds iters sl test_mask `Many_provers stmt_to_work_random_prover ) ) let%test_unit "Max_throughput (zkapps)" = (* limit trials to prevent too-many-open-files failure *) @@ -2616,7 +2620,7 @@ let%test_module "staged ledger tests" = Ledger.accounts ledger |> Account_id.Set.to_list in test_simple account_ids zkapps iters sl test_mask `Many_provers - stmt_to_work_random_prover)) + stmt_to_work_random_prover ) ) let%test_unit "Be able to include random number of commands" = Quickcheck.test (gen_below_capacity ()) ~trials:20 @@ -2624,7 +2628,7 @@ let%test_module "staged ledger tests" = async_with_ledgers ledger_init_state (fun sl test_mask -> test_simple (init_pks ledger_init_state) - cmds iters sl test_mask `Many_provers stmt_to_work_random_prover)) + cmds iters sl test_mask `Many_provers stmt_to_work_random_prover ) ) let%test_unit "Be able to include random number of commands (zkapps)" = Quickcheck.test (gen_zkapps_below_capacity ()) ~trials:4 @@ -2634,7 +2638,7 @@ let%test_module "staged ledger tests" = Ledger.accounts ledger |> Account_id.Set.to_list in test_simple account_ids zkapps iters sl test_mask `Many_provers - stmt_to_work_random_prover)) + stmt_to_work_random_prover ) ) let%test_unit "Be able to include random number of commands (One prover)" = Quickcheck.test (gen_below_capacity ()) ~trials:20 @@ -2642,7 +2646,7 @@ let%test_module "staged ledger tests" = async_with_ledgers ledger_init_state (fun sl test_mask -> test_simple (init_pks ledger_init_state) - cmds iters sl test_mask `One_prover stmt_to_work_one_prover)) + cmds iters sl test_mask `One_prover stmt_to_work_one_prover ) ) let%test_unit "Be able to include random number of commands (One prover, \ zkapps)" = @@ -2653,7 +2657,7 @@ let%test_module "staged ledger tests" = Ledger.accounts ledger |> Account_id.Set.to_list in test_simple account_ids zkapps iters sl test_mask `One_prover - stmt_to_work_one_prover)) + stmt_to_work_one_prover ) ) let%test_unit "Zero proof-fee should not create a fee transfer" = let stmt_to_work_zero_fee stmts = @@ -2675,7 +2679,7 @@ let%test_module "staged ledger tests" = assert ( Option.is_none (Ledger.location_of_account test_mask - (Account_id.create snark_worker_pk Token_id.default)) ))) + (Account_id.create snark_worker_pk Token_id.default) ) ) ) ) let compute_statuses ~ledger ~coinbase_amount diff = let generate_status = @@ -2686,7 +2690,7 @@ let%test_module "staged ledger tests" = fun txn -> O1trace.sync_thread "get_transactin_status" (fun () -> Transaction_validator.apply_transaction ~constraint_constants - status_ledger ~txn_state_view:(dummy_state_view ()) txn) + status_ledger ~txn_state_view:(dummy_state_view ()) txn ) in Pre_diff_info.compute_statuses ~constraint_constants ~diff ~coinbase_amount ~coinbase_receiver ~generate_status ~forget:Fn.id @@ -2757,7 +2761,7 @@ let%test_module "staged ledger tests" = { Transaction_snark_work.Checked.fee = Fee.zero ; proofs = proofs stmts ; prover = snark_worker_pk - }) + } ) work in let cmds_this_iter = @@ -2765,7 +2769,7 @@ let%test_module "staged ledger tests" = |> List.map ~f:(fun cmd -> { With_status.data = (cmd :> User_command.t) ; status = Applied - }) + } ) in let diff = create_diff_with_non_zero_fee_excess @@ -2798,10 +2802,10 @@ let%test_module "staged ledger tests" = sl := sl' ; (false, diff) in - return (diff', checked || checked')) + return (diff', checked || checked') ) in (*Note: if this fails, try increasing the number of trials to get a diff that does fail*) - assert checked)) + assert checked ) ) let%test_unit "Provers can't pay the account creation fee" = let no_work_included (diff : Staged_ledger_diff.t) = @@ -2827,7 +2831,7 @@ let%test_module "staged ledger tests" = ( init_state , List.take cmds (List.length cmds - transaction_capacity) , [ None ] ) - else Sequence.empty)) + else Sequence.empty ) ) ~trials:1 ~f:(fun (ledger_init_state, cmds, iters) -> async_with_ledgers ledger_init_state (fun sl _test_mask -> @@ -2849,7 +2853,7 @@ let%test_module "staged ledger tests" = in (*No proofs were purchased since the fee for the proofs are not sufficient to pay for account creation*) assert (no_work_included diff) ; - Deferred.return (diff, ())))) + Deferred.return (diff, ()) ) ) ) let stmt_to_work_restricted work_list provers (stmts : Transaction_snark_work.Statement.t) : @@ -2864,7 +2868,7 @@ let%test_module "staged ledger tests" = if Option.is_some (List.find work_list ~f:(fun s -> - Transaction_snark_work.Statement.compare s stmts = 0)) + Transaction_snark_work.Statement.compare s stmts = 0 ) ) then Some { Transaction_snark_work.Checked.fee = work_fee @@ -2900,7 +2904,7 @@ let%test_module "staged ledger tests" = create_and_apply sl cmds_this_iter (stmt_to_work_restricted (List.take work_list proofs_available_this_iter) - provers) + provers ) in assert_fee_excess proof ; let cmds_applied_this_iter = @@ -2916,7 +2920,7 @@ let%test_module "staged ledger tests" = let coinbase_cost = coinbase_cost diff in assert_ledger test_mask ~coinbase_cost !sl cmds_left cmds_applied_this_iter (init_pks init_state) ; - (diff, List.tl_exn proofs_available_left)) + (diff, List.tl_exn proofs_available_left) ) in assert (List.is_empty proofs_available_left) @@ -2935,7 +2939,7 @@ let%test_module "staged ledger tests" = number of commands) works. I make it twice as many for simplicity and to cover coinbases. *) Quickcheck_lib.map_gens iters ~f:(fun _ -> - Int.gen_incl 0 (transaction_capacity * 2)) + Int.gen_incl 0 (transaction_capacity * 2) ) in return (ledger_init_state, cmds, iters, proofs_available) in @@ -2943,7 +2947,7 @@ let%test_module "staged ledger tests" = ~f:(fun (ledger_init_state, cmds, iters, proofs_available) -> async_with_ledgers ledger_init_state (fun sl test_mask -> test_random_number_of_proofs ledger_init_state cmds iters - proofs_available sl test_mask `Many_provers)) + proofs_available sl test_mask `Many_provers ) ) let%test_unit "random no of transactions-random number of proofs-worst \ case provers" = @@ -2954,7 +2958,7 @@ let%test_module "staged ledger tests" = in let%bind proofs_available = Quickcheck_lib.map_gens iters ~f:(fun cmds_opt -> - Int.gen_incl 0 (3 * Option.value_exn cmds_opt)) + Int.gen_incl 0 (3 * Option.value_exn cmds_opt) ) in return (ledger_init_state, cmds, iters, proofs_available) in @@ -2980,7 +2984,7 @@ let%test_module "staged ledger tests" = else None in List.filter_map [ half_iters; one_less_iters ] ~f:Fn.id - |> Sequence.of_list) + |> Sequence.of_list ) in Quickcheck.test g ~shrinker ~shrink_attempts:`Exhaustive ~sexp_of: @@ -2992,7 +2996,7 @@ let%test_module "staged ledger tests" = ~f:(fun (ledger_init_state, cmds, iters, proofs_available) -> async_with_ledgers ledger_init_state (fun sl test_mask -> test_random_number_of_proofs ledger_init_state cmds iters - proofs_available sl test_mask `Many_provers)) + proofs_available sl test_mask `Many_provers ) ) let%test_unit "Random number of commands-random number of proofs-one \ prover)" = @@ -3003,7 +3007,7 @@ let%test_module "staged ledger tests" = in let%bind proofs_available = Quickcheck_lib.map_gens iters ~f:(fun cmds_opt -> - Int.gen_incl 0 (3 * Option.value_exn cmds_opt)) + Int.gen_incl 0 (3 * Option.value_exn cmds_opt) ) in return (ledger_init_state, cmds, iters, proofs_available) in @@ -3011,7 +3015,7 @@ let%test_module "staged ledger tests" = ~f:(fun (ledger_init_state, cmds, iters, proofs_available) -> async_with_ledgers ledger_init_state (fun sl test_mask -> test_random_number_of_proofs ledger_init_state cmds iters - proofs_available sl test_mask `One_prover)) + proofs_available sl test_mask `One_prover ) ) let stmt_to_work_random_fee work_list provers (stmts : Transaction_snark_work.Statement.t) : @@ -3025,9 +3029,10 @@ let%test_module "staged ledger tests" = in Option.map (List.find work_list ~f:(fun (s, _) -> - Transaction_snark_work.Statement.compare s stmts = 0)) + Transaction_snark_work.Statement.compare s stmts = 0 ) ) ~f:(fun (_, fee) -> - { Transaction_snark_work.Checked.fee; proofs = proofs stmts; prover }) + { Transaction_snark_work.Checked.fee; proofs = proofs stmts; prover } + ) (** Like test_random_number_of_proofs but with random proof fees. *) @@ -3060,17 +3065,17 @@ let%test_module "staged ledger tests" = in let sorted_work_from_diff1 (pre_diff : - Staged_ledger_diff.Pre_diff_with_at_most_two_coinbase.t) = + Staged_ledger_diff.Pre_diff_with_at_most_two_coinbase.t ) = List.sort pre_diff.completed_works ~compare:(fun w w' -> - Fee.compare w.fee w'.fee) + Fee.compare w.fee w'.fee ) in let sorted_work_from_diff2 (pre_diff : - Staged_ledger_diff.Pre_diff_with_at_most_one_coinbase.t option) - = + Staged_ledger_diff.Pre_diff_with_at_most_one_coinbase.t option + ) = Option.value_map pre_diff ~default:[] ~f:(fun p -> List.sort p.completed_works ~compare:(fun w w' -> - Fee.compare w.fee w'.fee)) + Fee.compare w.fee w'.fee ) ) in let () = let assert_same_fee { Coinbase.Fee_transfer.fee; _ } fee' = @@ -3081,7 +3086,7 @@ let%test_module "staged ledger tests" = ( first_pre_diff.coinbase , Option.value_map second_pre_diff_opt ~default:Staged_ledger_diff.At_most_one.Zero ~f:(fun d -> - d.coinbase) ) + d.coinbase ) ) with | ( Staged_ledger_diff.At_most_two.Zero , Staged_ledger_diff.At_most_one.Zero ) @@ -3093,14 +3098,14 @@ let%test_module "staged ledger tests" = List.hd_exn (sorted_work_from_diff1 first_pre_diff) |> Transaction_snark_work.forget in - assert_same_fee single work.fee) + assert_same_fee single work.fee ) | Zero, One ft_opt -> Option.value_map ft_opt ~default:() ~f:(fun single -> let work = List.hd_exn (sorted_work_from_diff2 second_pre_diff_opt) |> Transaction_snark_work.forget in - assert_same_fee single work.fee) + assert_same_fee single work.fee ) | Two (Some (ft, ft_opt)), Zero -> let work_done = sorted_work_from_diff1 first_pre_diff in let work = @@ -3112,15 +3117,15 @@ let%test_module "staged ledger tests" = List.hd_exn (List.drop work_done 1) |> Transaction_snark_work.forget in - assert_same_fee single work.fee) + assert_same_fee single work.fee ) | _ -> failwith (sprintf !"Incorrect coinbase in the diff %{sexp: \ Staged_ledger_diff.t}" - diff) + diff ) in - (diff, List.tl_exn proofs_available_left)) + (diff, List.tl_exn proofs_available_left) ) in assert (List.is_empty proofs_available_left) @@ -3140,7 +3145,7 @@ let%test_module "staged ledger tests" = Quickcheck.Generator.list_with_length number_of_proofs Fee.(gen_incl (of_int 1) (of_int 20)) in - (number_of_proofs, fees)) + (number_of_proofs, fees) ) in return (ledger_init_state, cmds, iters, proofs_available) in @@ -3148,7 +3153,7 @@ let%test_module "staged ledger tests" = ~f:(fun (ledger_init_state, cmds, iters, proofs_available) -> async_with_ledgers ledger_init_state (fun sl test_mask -> test_random_proof_fee ledger_init_state cmds iters - proofs_available sl test_mask `Many_provers)) + proofs_available sl test_mask `Many_provers ) ) let%test_unit "Max throughput-random fee" = let g = @@ -3164,7 +3169,7 @@ let%test_module "staged ledger tests" = Quickcheck.Generator.list_with_length number_of_proofs Fee.(gen_incl (of_int 1) (of_int 20)) in - (number_of_proofs, fees)) + (number_of_proofs, fees) ) in return (ledger_init_state, cmds, iters, proofs_available) in @@ -3178,7 +3183,7 @@ let%test_module "staged ledger tests" = ~f:(fun (ledger_init_state, cmds, iters, proofs_available) -> async_with_ledgers ledger_init_state (fun sl test_mask -> test_random_proof_fee ledger_init_state cmds iters - proofs_available sl test_mask `Many_provers)) + proofs_available sl test_mask `Many_provers ) ) let check_pending_coinbase ~supercharge_coinbase proof ~sl_before ~sl_after (_state_hash, state_body_hash) pc_update ~is_new_stack = @@ -3216,7 +3221,7 @@ let%test_module "staged ledger tests" = handle f_pop_and_add (unstage (handler ~depth:constraint_constants.pending_coinbase_depth - pending_coinbase_before ~is_new_stack)) + pending_coinbase_before ~is_new_stack ) ) in As_prover.read Hash.typ result in @@ -3260,7 +3265,7 @@ let%test_module "staged ledger tests" = ~state_and_body_hash:state_body_hash sl cmds_this_iter (stmt_to_work_restricted (List.take work_list proofs_available_this_iter) - provers) + provers ) in check_pending_coinbase proof ~supercharge_coinbase ~sl_before ~sl_after:!sl state_body_hash pc_update ~is_new_stack ; @@ -3280,7 +3285,7 @@ let%test_module "staged ledger tests" = cmds_applied_this_iter (init_pks init_state) ; ( diff , (List.tl_exn proofs_available_left, List.tl_exn state_body_hashes) - )) + ) ) in assert (List.is_empty proofs_available_left) @@ -3292,11 +3297,11 @@ let%test_module "staged ledger tests" = in let%bind state_body_hashes = Quickcheck_lib.map_gens iters ~f:(fun _ -> - Quickcheck.Generator.tuple2 State_hash.gen State_body_hash.gen) + Quickcheck.Generator.tuple2 State_hash.gen State_body_hash.gen ) in let%bind proofs_available = Quickcheck_lib.map_gens iters ~f:(fun cmds_opt -> - Int.gen_incl 0 (3 * Option.value_exn cmds_opt)) + Int.gen_incl 0 (3 * Option.value_exn cmds_opt) ) in return (ledger_init_state, cmds, iters, proofs_available, state_body_hashes) @@ -3313,7 +3318,7 @@ let%test_module "staged ledger tests" = async_with_ledgers ledger_init_state (fun sl test_mask -> test_pending_coinbase ledger_init_state cmds iters proofs_available state_body_hashes current_state_view sl - test_mask prover)) + test_mask prover ) ) let%test_unit "Validate pending coinbase for random number of \ commands-random number of proofs-one prover)" = @@ -3386,13 +3391,13 @@ let%test_module "staged ledger tests" = (dummy_state_view ~global_slot_since_genesis: (Mina_numbers.Global_slot.of_int block_count) - ()) + () ) ~state_and_body_hash:(State_hash.dummy, State_body_hash.dummy) Sequence.empty (stmt_to_work_zero_fee ~prover:self.public_key) in check_receiver_account !sl block_count ; - return ()) + return () ) let normal_coinbase = constraint_constants.coinbase_amount @@ -3424,7 +3429,7 @@ let%test_module "staged ledger tests" = (scale_exn normal_coinbase slots_with_locked_tokens) |> Option.value_exn ) (scale_exn supercharged_coinbase - (block_no - slots_with_locked_tokens)) + (block_no - slots_with_locked_tokens) ) |> Option.value_exn in Quickcheck.test g ~trials:1 ~f:(fun ledger_init_state -> @@ -3439,7 +3444,7 @@ let%test_module "staged ledger tests" = in async_with_ledgers ledger_init_state (fun sl _test_mask -> supercharge_coinbase_test ~self ~delegator:self ~block_count - f_expected_balance sl)) + f_expected_balance sl ) ) let%test_unit "Supercharged coinbase - unlocked account delegating to \ locked account" = @@ -3471,7 +3476,7 @@ let%test_module "staged ledger tests" = in async_with_ledgers ledger_init_state (fun sl _test_mask -> supercharge_coinbase_test ~self:locked_self - ~delegator:unlocked_delegator ~block_count f_expected_balance sl)) + ~delegator:unlocked_delegator ~block_count f_expected_balance sl ) ) let%test_unit "Supercharged coinbase - locked account delegating to \ unlocked account" = @@ -3495,7 +3500,7 @@ let%test_module "staged ledger tests" = (scale_exn normal_coinbase slots_with_locked_tokens) |> Option.value_exn ) (scale_exn supercharged_coinbase - (block_no - slots_with_locked_tokens)) + (block_no - slots_with_locked_tokens) ) |> Option.value_exn in Quickcheck.test g ~trials:1 ~f:(fun ledger_init_state -> @@ -3514,7 +3519,7 @@ let%test_module "staged ledger tests" = in async_with_ledgers ledger_init_state (fun sl _test_mask -> supercharge_coinbase_test ~self:unlocked_self - ~delegator:locked_delegator ~block_count f_expected_balance sl)) + ~delegator:locked_delegator ~block_count f_expected_balance sl ) ) let%test_unit "Supercharged coinbase - locked account delegating to locked \ account" = @@ -3546,7 +3551,7 @@ let%test_module "staged ledger tests" = in async_with_ledgers ledger_init_state (fun sl _test_mask -> supercharge_coinbase_test ~self:locked_self - ~delegator:locked_delegator ~block_count f_expected_balance sl)) + ~delegator:locked_delegator ~block_count f_expected_balance sl ) ) let command_insufficient_funds = let open Quickcheck.Generator.Let_syntax in @@ -3596,10 +3601,10 @@ let%test_module "staged ledger tests" = assert ( List.is_empty (Staged_ledger_diff.With_valid_signatures_and_proofs - .commands x) ) + .commands x ) ) | Error e -> Error.raise (Pre_diff_info.Error.to_error e) ) ; - Deferred.unit)) + Deferred.unit ) ) let%test_unit "Blocks having commands with insufficient funds are rejected" = @@ -3670,7 +3675,7 @@ let%test_module "staged ledger tests" = assert ( List.length (Staged_ledger_diff.With_valid_signatures_and_proofs - .commands x) + .commands x ) = 1 ) ; let f, s = x.diff in [%log info] "Diff %s" @@ -3710,5 +3715,5 @@ let%test_module "staged ledger tests" = [%log info] "Error %s" (Staged_ledger_error.to_string e) ; assert true | Error _ -> - assert false ))) + assert false ) ) ) end ) diff --git a/src/lib/staged_ledger/staged_ledger.mli b/src/lib/staged_ledger/staged_ledger.mli index 253789cbc2d..07f1767bacb 100644 --- a/src/lib/staged_ledger/staged_ledger.mli +++ b/src/lib/staged_ledger/staged_ledger.mli @@ -170,7 +170,7 @@ val create_diff : -> transactions_by_fee:User_command.Valid.t Sequence.t -> get_completed_work: ( Transaction_snark_work.Statement.t - -> Transaction_snark_work.Checked.t option) + -> Transaction_snark_work.Checked.t option ) -> supercharge_coinbase:bool -> ( Staged_ledger_diff.With_valid_signatures_and_proofs.t , Pre_diff_info.Error.t ) diff --git a/src/lib/staged_ledger_diff/staged_ledger_diff.ml b/src/lib/staged_ledger_diff/staged_ledger_diff.ml index 8b3c5976d50..1685804d91c 100644 --- a/src/lib/staged_ledger_diff/staged_ledger_diff.ml +++ b/src/lib/staged_ledger_diff/staged_ledger_diff.ml @@ -299,7 +299,7 @@ end let validate_commands (t : t) ~(check : User_command.t list - -> (User_command.Valid.t list, 'e) Result.t Async.Deferred.Or_error.t) : + -> (User_command.Valid.t list, 'e) Result.t Async.Deferred.Or_error.t ) : (With_valid_signatures.t, 'e) Result.t Async.Deferred.Or_error.t = let map t ~f = Async.Deferred.Or_error.map t ~f:(Result.map ~f) in let validate cs = @@ -307,12 +307,12 @@ let validate_commands (t : t) (check (List.map cs ~f:With_status.data)) ~f: (List.map2_exn cs ~f:(fun c data -> - { With_status.data; status = c.status })) + { With_status.data; status = c.status } ) ) in let d1, d2 = t.diff in map (validate - (d1.commands @ Option.value_map d2 ~default:[] ~f:(fun d2 -> d2.commands))) + (d1.commands @ Option.value_map d2 ~default:[] ~f:(fun d2 -> d2.commands)) ) ~f:(fun commands_all -> let commands1, commands2 = List.split_n commands_all (List.length d1.commands) @@ -329,9 +329,9 @@ let validate_commands (t : t) { Pre_diff_one.completed_works = d2.completed_works ; commands = commands2 ; coinbase = d2.coinbase - }) + } ) in - ({ diff = (p1, p2) } : With_valid_signatures.t)) + ({ diff = (p1, p2) } : With_valid_signatures.t) ) let forget_proof_checks (d : With_valid_signatures_and_proofs.t) : With_valid_signatures.t = @@ -348,13 +348,13 @@ let forget_proof_checks (d : With_valid_signatures_and_proofs.t) : { completed_works = forget_cw d2.completed_works ; commands = d2.commands ; coinbase = d2.coinbase - }) + } ) in { diff = (p1, p2) } let forget_pre_diff_with_at_most_two (pre_diff : - With_valid_signatures_and_proofs.pre_diff_with_at_most_two_coinbase) : + With_valid_signatures_and_proofs.pre_diff_with_at_most_two_coinbase ) : Pre_diff_with_at_most_two_coinbase.t = { completed_works = forget_cw pre_diff.completed_works ; commands = (pre_diff.commands :> User_command.t With_status.t list) @@ -363,7 +363,7 @@ let forget_pre_diff_with_at_most_two let forget_pre_diff_with_at_most_one (pre_diff : - With_valid_signatures_and_proofs.pre_diff_with_at_most_one_coinbase) = + With_valid_signatures_and_proofs.pre_diff_with_at_most_one_coinbase ) = { Pre_diff_one.completed_works = forget_cw pre_diff.completed_works ; commands = (pre_diff.commands :> User_command.t With_status.t list) ; coinbase = pre_diff.coinbase @@ -395,12 +395,12 @@ let net_return (commands t) ~f:(fun sum cmd -> let%bind sum = sum in - Fee.( + ) sum (User_command.fee (With_status.data cmd))) + Fee.( + ) sum (User_command.fee (With_status.data cmd)) ) in let%bind completed_works_fees = List.fold ~init:(Some Fee.zero) (completed_works t) ~f:(fun sum work -> let%bind sum = sum in - Fee.( + ) sum work.Transaction_snark_work.fee) + Fee.( + ) sum work.Transaction_snark_work.fee ) in Amount.(of_fee total_reward - of_fee completed_works_fees) diff --git a/src/lib/staged_ledger_diff/staged_ledger_diff.mli b/src/lib/staged_ledger_diff/staged_ledger_diff.mli index 763e620a9dc..c6f48faff4f 100644 --- a/src/lib/staged_ledger_diff/staged_ledger_diff.mli +++ b/src/lib/staged_ledger_diff/staged_ledger_diff.mli @@ -173,7 +173,7 @@ val validate_commands : t -> check: ( User_command.t list - -> (User_command.Valid.t list, 'e) Result.t Async.Deferred.Or_error.t) + -> (User_command.Valid.t list, 'e) Result.t Async.Deferred.Or_error.t ) -> (With_valid_signatures.t, 'e) Result.t Async.Deferred.Or_error.t val forget : With_valid_signatures_and_proofs.t -> t diff --git a/src/lib/storage/list.ml b/src/lib/storage/list.ml index 4a09a86bfaf..59d2cc640f6 100644 --- a/src/lib/storage/list.ml +++ b/src/lib/storage/list.ml @@ -16,7 +16,7 @@ module Make (M : Storage_intf.With_checksum_intf) : | `IO_error e -> e | `No_exist -> - Error.of_string "No_exist") + Error.of_string "No_exist" ) |> Error.of_list let first_success ~f = diff --git a/src/lib/structured_log_events/structured_log_events.ml b/src/lib/structured_log_events/structured_log_events.ml index 7423b3484dd..117a323c14e 100644 --- a/src/lib/structured_log_events/structured_log_events.ml +++ b/src/lib/structured_log_events/structured_log_events.ml @@ -31,7 +31,7 @@ let parse_exn id json_pairs = message. *) List.filter json_pairs ~f:(fun (field_name, _) -> - Set.mem repr.arguments field_name) + Set.mem repr.arguments field_name ) in match repr.parse json_pairs with | Some t -> @@ -42,10 +42,10 @@ let parse_exn id json_pairs = arguments: %s" id ( List.map json_pairs ~f:(fun (name, json) -> - sprintf "%s = %s" name (Yojson.Safe.to_string json)) + sprintf "%s = %s" name (Yojson.Safe.to_string json) ) |> String.concat ~sep:"," ) () - else None) + else None ) in match result with | Some data -> @@ -56,7 +56,7 @@ let parse_exn id json_pairs = let log t = let result = List.find_map !Registry.reprs ~f:(fun repr -> - Option.map (repr.log t) ~f:(fun (msg, fields) -> (msg, repr.id, fields))) + Option.map (repr.log t) ~f:(fun (msg, fields) -> (msg, repr.id, fields)) ) in match result with | Some data -> @@ -71,7 +71,7 @@ let register_constructor = Registry.register_constructor let dump_registered_events () = List.map !Registry.reprs ~f:(fun { event_name; id; arguments; _ } -> - (event_name, id, Set.to_list arguments)) + (event_name, id, Set.to_list arguments) ) let check_interpolations_exn ~msg_loc msg label_names = (* don't use Logproc_lib, which depends on C++ code @@ -93,4 +93,4 @@ let check_interpolations_exn ~msg_loc msg label_names = which is not a field in the record" msg_loc interp () | _ -> - ()) + () ) diff --git a/src/lib/sync_handler/sync_handler.ml b/src/lib/sync_handler/sync_handler.ml index c03de95509e..f162d48ec41 100644 --- a/src/lib/sync_handler/sync_handler.ml +++ b/src/lib/sync_handler/sync_handler.ml @@ -54,7 +54,7 @@ module Make (Inputs : Inputs_intf) : else if Ledger_hash.equal ledger_hash (Consensus.Data.Local_state.Snapshot.Ledger_snapshot.merkle_root - staking_epoch_ledger) + staking_epoch_ledger ) then match staking_epoch_ledger with | Consensus.Data.Local_state.Snapshot.Ledger_snapshot.Genesis_epoch_ledger @@ -65,7 +65,7 @@ module Make (Inputs : Inputs_intf) : else if Ledger_hash.equal ledger_hash (Consensus.Data.Local_state.Snapshot.Ledger_snapshot.merkle_root - next_epoch_ledger) + next_epoch_ledger ) then match next_epoch_ledger with | Consensus.Data.Local_state.Snapshot.Ledger_snapshot.Genesis_epoch_ledger @@ -108,7 +108,7 @@ module Make (Inputs : Inputs_intf) : | None -> Stop None | Some acc' -> - Continue (Some acc')) + Continue (Some acc') ) ~finish:Fn.id in match @@ -191,11 +191,11 @@ module Make (Inputs : Inputs_intf) : (Consensus.Hooks.select ~constants:consensus_constants ~logger: (Logger.extend logger - [ ("selection_context", `String "Root.prove") ]) + [ ("selection_context", `String "Root.prove") ] ) ~existing: (With_hash.map ~f:Mina_block.consensus_state - best_tip_with_witness.data) - ~candidate:seen_consensus_state) + best_tip_with_witness.data ) + ~candidate:seen_consensus_state ) `Keep in let%map () = Option.some_if is_tip_better () in @@ -216,10 +216,10 @@ module Make (Inputs : Inputs_intf) : (Consensus.Hooks.select ~constants:consensus_constants ~logger: (Logger.extend logger - [ ("selection_context", `String "Root.verify") ]) + [ ("selection_context", `String "Root.verify") ] ) ~existing: (With_hash.map ~f:Mina_block.consensus_state best_tip_transition) - ~candidate) + ~candidate ) `Keep in let%map () = @@ -229,7 +229,7 @@ module Make (Inputs : Inputs_intf) : ~error: (Error.createf !"Peer lied about it's best tip %{sexp:State_hash.t}" - (State_hash.With_state_hashes.state_hash best_tip_transition))) + (State_hash.With_state_hashes.state_hash best_tip_transition) ) ) in verified_witness end diff --git a/src/lib/sync_status/sync_status.ml b/src/lib/sync_status/sync_status.ml index cafe0399d98..fdb5d923994 100644 --- a/src/lib/sync_status/sync_status.ml +++ b/src/lib/sync_status/sync_status.ml @@ -79,7 +79,7 @@ let check_conv to_repr of_repr ok_or_fail = List.for_all [ `Offline; `Bootstrap; `Synced; `Connecting; `Listening; `Catchup ] ~f:(fun sync_status -> - equal sync_status (of_repr (to_repr sync_status) |> ok_or_fail)) + equal sync_status (of_repr (to_repr sync_status) |> ok_or_fail) ) let%test "of_string (to_string x) == x" = check_conv to_string of_string Or_error.ok_exn diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index 521ee76310e..be5452754ae 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -255,7 +255,7 @@ end = struct Or_error.try_with (fun () -> Answer.Child_hashes_are ( MT.get_inner_hash_at_addr_exn mt lchild - , MT.get_inner_hash_at_addr_exn mt rchild )) + , MT.get_inner_hash_at_addr_exn mt rchild ) ) with | Ok answer -> Either.First answer @@ -280,7 +280,7 @@ end = struct else let addresses_and_accounts = List.sort ~compare:(fun (addr1, _) (addr2, _) -> - Addr.compare addr1 addr2) + Addr.compare addr1 addr2 ) @@ MT.get_all_accounts_rooted_at_exn mt a (* can't actually throw *) in @@ -306,7 +306,7 @@ end = struct && [%equal: Addr.t option] expected_address (Some actual_address) then (Addr.next actual_address, true) - else (expected_address, false)) + else (expected_address, false) ) in if not is_compact then ( (* indicates our ledger is invalid somehow. *) @@ -321,7 +321,7 @@ end = struct `Tuple [ Addr.to_yojson addr ; Account.to_yojson account - ])) ) + ] ) ) ) ] "Missing an account at address: $missing_address inside \ the list: $addresses_and_accounts" ; @@ -339,7 +339,7 @@ end = struct in Either.First (Num_accounts - (len, MT.get_inner_hash_at_addr_exn mt content_root_addr)) + (len, MT.get_inner_hash_at_addr_exn mt content_root_addr) ) in match response_or_punish with | Either.First answer -> @@ -600,7 +600,7 @@ end = struct | `Good children_to_verify -> (* TODO #312: Make sure we don't write too much *) List.iter children_to_verify ~f:(fun (addr, hash) -> - handle_node t addr hash) ; + handle_node t addr hash ) ; credit_fulfilled_request () ) | Query.What_contents addr, Answer.Contents_are leaves -> ( match add_content t addr leaves with @@ -681,7 +681,7 @@ end = struct [ ("old_root_hash", Root_hash.to_yojson root_hash) ; ("new_root_hash", Root_hash.to_yojson h) ] - "New_goal: changing target from $old_root_hash to $new_root_hash") ; + "New_goal: changing target from $old_root_hash to $new_root_hash" ) ; Ivar.fill_if_empty t.validity_listener (`Target_changed (t.desired_root, h)) ; t.validity_listener <- Ivar.create () ; @@ -691,7 +691,7 @@ end = struct `New ) else if Option.fold t.auxiliary_data ~init:false ~f:(fun _ saved_data -> - equal data saved_data) + equal data saved_data ) then ( [%log' debug t.logger] "New_goal to same hash, not doing anything" ; `Repeat ) @@ -711,7 +711,7 @@ end = struct | `Ok -> Some t.tree | `Target_changed _ -> - None) + None ) let wait_until_valid t h = if not (Root_hash.equal h (desired_root_exn t)) then @@ -721,7 +721,7 @@ end = struct | `Target_changed payload -> `Target_changed payload | `Ok -> - `Ok t.tree) + `Ok t.tree ) let fetch t rh ~data ~equal = ignore (new_goal t rh ~data ~equal : [ `New | `Repeat | `Update_data ]) ; diff --git a/src/lib/syncable_ledger/test.ml b/src/lib/syncable_ledger/test.ml index f897559be12..07094d850a9 100644 --- a/src/lib/syncable_ledger/test.ml +++ b/src/lib/syncable_ledger/test.ml @@ -82,14 +82,15 @@ struct if match query with What_contents _ -> true | _ -> false then Clock_ns.after (Time_ns.Span.randomize (Time_ns.Span.of_ms 0.2) - ~percent:(Percent.of_percentage 20.)) + ~percent:(Percent.of_percentage 20.) ) else Deferred.unit in - Linear_pipe.write aw (root_hash, query, Envelope.Incoming.local answ))) ; + Linear_pipe.write aw (root_hash, query, Envelope.Incoming.local answ) ) + ) ; match Async.Thread_safe.block_on_async_exn (fun () -> Sync_ledger.fetch lsync desired_root ~data:() ~equal:(fun () () -> - true)) + true ) ) with | `Ok mt -> total_queries := Some (List.length !seen_queries) ; @@ -141,18 +142,18 @@ struct (!desired_root, query, Envelope.Incoming.local answ) in ctr := !ctr + 1 ; - res)) ; + res ) ) ; match Async.Thread_safe.block_on_async_exn (fun () -> Sync_ledger.fetch lsync !desired_root ~data:() ~equal:(fun () () -> - true)) + true ) ) with | `Ok _ -> failwith "shouldn't happen" | `Target_changed _ -> ( match Async.Thread_safe.block_on_async_exn (fun () -> - Sync_ledger.wait_until_valid lsync !desired_root) + Sync_ledger.wait_until_valid lsync !desired_root ) with | `Ok mt -> [%test_result: Root_hash.t] ~expect:(Ledger.merkle_root l3) @@ -232,7 +233,7 @@ module Db = struct let account = Account.create aid currency_balance in ignore ( get_or_create_account ledger aid account |> Or_error.ok_exn - : [ `Added | `Existed ] * Location.t )) ; + : [ `Added | `Existed ] * Location.t ) ) ; (ledger, account_ids) end @@ -338,7 +339,7 @@ module Mask = struct Maskable.get_or_create_account maskable account_id account |> Or_error.ok_exn in - assert ([%equal: [ `Added | `Existed ]] action `Added)) ; + assert ([%equal: [ `Added | `Existed ]] action `Added) ) ; let mask = Mask.create ~depth:Input.depth () in let attached_mask = Maskable.register_mask maskable mask in (* On the mask, all the children will have different values *) @@ -366,7 +367,7 @@ module Mask = struct | `Existed -> Mask.Attached.set attached_mask location account | `Added -> - failwith "Expected to re-use an existing account") ; + failwith "Expected to re-use an existing account" ) ; construct_layered_masks (iter - 1) (child_balance / 2) attached_mask in ( construct_layered_masks Input.mask_layers initial_balance_multiplier diff --git a/src/lib/test_util/test_util.ml b/src/lib/test_util/test_util.ml index 2871192c3f8..aca6304062e 100644 --- a/src/lib/test_util/test_util.ml +++ b/src/lib/test_util/test_util.ml @@ -6,7 +6,7 @@ module Make (Impl : Snarky_backendless.Snark_intf.S) = struct let to_string b = if b then "1" else "0" in String.concat ~sep:" " (List.map trips ~f:(fun (b1, b2, b3) -> - to_string b1 ^ to_string b2 ^ to_string b3)) + to_string b1 ^ to_string b2 ^ to_string b3 ) ) let checked_to_unchecked typ1 typ2 checked input = let open Impl in @@ -14,7 +14,7 @@ module Make (Impl : Snarky_backendless.Snark_intf.S) = struct run_and_check (let%bind input = exists typ1 ~compute:(As_prover.return input) in let%map result = checked input in - As_prover.read typ2 result) + As_prover.read typ2 result ) |> Or_error.ok_exn in checked_result @@ -29,7 +29,7 @@ module Make (Impl : Snarky_backendless.Snark_intf.S) = struct (List.map result ~f: (As_prover.read - (Typ.tuple3 Boolean.typ Boolean.typ Boolean.typ)))) + (Typ.tuple3 Boolean.typ Boolean.typ Boolean.typ) ) ) ) |> Or_error.ok_exn in let unchecked = Fold.to_list (fold input) in @@ -45,7 +45,7 @@ module Make (Impl : Snarky_backendless.Snark_intf.S) = struct let arbitrary_string ~len = String.init (Random.int len) ~f:(fun _ -> - Char.of_int_exn (Random.int_incl 0 255)) + Char.of_int_exn (Random.int_incl 0 255) ) let with_randomness r f = let s = Caml.Random.get_state () in diff --git a/src/lib/timeout_lib/timeout_lib.ml b/src/lib/timeout_lib/timeout_lib.ml index 900174e3730..ad97111b3ab 100644 --- a/src/lib/timeout_lib/timeout_lib.ml +++ b/src/lib/timeout_lib/timeout_lib.ml @@ -87,8 +87,8 @@ module Make (Time : Time_intf) : Timeout_intf(Time).S = struct ( create time_controller timeout_duration ~f:(fun x -> if Ivar.is_full ivar then [%log' error (Logger.create ())] "Ivar.fill bug is here!" ; - Ivar.fill_if_empty ivar x) - : unit t )) + Ivar.fill_if_empty ivar x ) + : unit t ) ) in Deferred.( choose diff --git a/src/lib/transaction/transaction_hash.ml b/src/lib/transaction/transaction_hash.ml index 2097eb54f85..25764868c79 100644 --- a/src/lib/transaction/transaction_hash.ml +++ b/src/lib/transaction/transaction_hash.ml @@ -26,7 +26,7 @@ let of_yojson = function | `String str -> Result.map_error (of_base58_check str) ~f:(fun _ -> "Transaction_hash.of_yojson: Error decoding string from base58_check \ - format") + format" ) | _ -> Error "Transaction_hash.of_yojson: Expected a string" @@ -53,10 +53,8 @@ module User_command_with_valid_signature = struct module Stable = struct module V2 = struct type t = - ( (User_command.Valid.Stable.V2.t - [@hash.ignore]) - , (T.Stable.V1.t - [@to_yojson hash_to_yojson]) ) + ( (User_command.Valid.Stable.V2.t[@hash.ignore]) + , (T.Stable.V1.t[@to_yojson hash_to_yojson]) ) With_hash.Stable.V1.t [@@deriving sexp, hash, to_yojson] @@ -97,10 +95,8 @@ module User_command = struct module Stable = struct module V2 = struct type t = - ( (User_command.Stable.V2.t - [@hash.ignore]) - , (T.Stable.V1.t - [@to_yojson hash_to_yojson]) ) + ( (User_command.Stable.V2.t[@hash.ignore]) + , (T.Stable.V1.t[@to_yojson hash_to_yojson]) ) With_hash.Stable.V1.t [@@deriving sexp, hash, to_yojson] diff --git a/src/lib/transaction_consistency_tests/transaction_consistency_tests.ml b/src/lib/transaction_consistency_tests/transaction_consistency_tests.ml index 0d8e61dd164..089f8c9eaf3 100644 --- a/src/lib/transaction_consistency_tests/transaction_consistency_tests.ml +++ b/src/lib/transaction_consistency_tests/transaction_consistency_tests.ml @@ -68,7 +68,7 @@ let%test_module "transaction logic consistency" = let count = ref 0 in List.iter account_ids ~f:(fun account_id -> let (_ : _ * _) = Ledger.create_empty_exn base_ledger account_id in - incr count) ; + incr count ) ; Sparse_ledger.of_ledger_subset_exn base_ledger account_ids (* Helpers for applying transactions *) @@ -78,7 +78,7 @@ let%test_module "transaction logic consistency" = let sparse_ledger ledger t = Or_error.try_with ~backtrace:true (fun () -> Sparse_ledger.apply_transaction_exn ~constraint_constants - ~txn_state_view ledger (Transaction.forget t)) + ~txn_state_view ledger (Transaction.forget t) ) let transaction_logic ledger t = let ledger = ref ledger in @@ -111,7 +111,7 @@ let%test_module "transaction logic consistency" = (Sparse_ledger.next_available_token target) ~zkapp_account1:None ~zkapp_account2:None { transaction; block_data } - (unstage (Sparse_ledger.handler source))) + (unstage (Sparse_ledger.handler source)) ) let check_consistent source transaction = let res_sparse = @@ -146,7 +146,7 @@ let%test_module "transaction logic consistency" = ; Atom ( Sparse_ledger.merkle_root target2 |> Snark_params.Tick.Field.to_string ) - ])) ) + ] ) ) ) | Ok target, _ | _, Ok target -> (target, None) in @@ -175,7 +175,7 @@ let%test_module "transaction logic consistency" = Some (Account.create (Account_id.create public_key Token_id.default) - balance) + balance ) in let timed cliff_time vesting_period = let%bind balance = Balance.gen in @@ -201,8 +201,7 @@ let%test_module "transaction logic consistency" = ; timed 5 1 (* vesting, already hit cliff *) ; timed 5 16 (* not yet vesting, already hit cliff *) ; timed 15 1 (* not yet vesting, just hit cliff *) - ; timed 30 1 - (* not yet vesting, hasn't hit cliff *) + ; timed 30 1 (* not yet vesting, hasn't hit cliff *) ] let gen_account pk = @@ -289,7 +288,7 @@ let%test_module "transaction logic consistency" = return (Transaction.Coinbase ( Coinbase.create ~amount ~receiver:sender ~fee_transfer:None - |> Or_error.ok_exn )) + |> Or_error.ok_exn ) ) in let fee_transfer = let single_ft pk = @@ -342,7 +341,7 @@ let%test_module "transaction logic consistency" = Sparse_ledger.L.get_or_create_account ledger (Account_id.create pk Token_id.default) account - |> Or_error.ok_exn |> ignore) + |> Or_error.ok_exn |> ignore ) in add_to_ledger pk1 account1 ; add_to_ledger pk2 account2 ; @@ -368,9 +367,9 @@ let%test_module "transaction logic consistency" = "The following transaction was inconsistently \ applied:@.%s@.%s@.%s@." (Yojson.Safe.pretty_to_string - (Transaction.Valid.to_yojson transaction)) + (Transaction.Valid.to_yojson transaction) ) (Yojson.Safe.to_string (Sparse_ledger.to_yojson ledger)) - (Yojson.Safe.pretty_to_string (Error_json.error_to_yojson error))) ; + (Yojson.Safe.pretty_to_string (Error_json.error_to_yojson error)) ) ; !passed let txn_jsons = @@ -594,8 +593,8 @@ let%test_module "transaction logic consistency" = "The following transaction was inconsistently \ applied:@.%s@.%s@.%s@." (Yojson.Safe.pretty_to_string - (Transaction.Valid.to_yojson transaction)) + (Transaction.Valid.to_yojson transaction) ) (Yojson.Safe.to_string (Sparse_ledger.to_yojson ledger)) - (Yojson.Safe.pretty_to_string (Error_json.error_to_yojson error))) ; + (Yojson.Safe.pretty_to_string (Error_json.error_to_yojson error)) ) ; !passed end ) diff --git a/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml b/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml index 26f4aec8288..4499c59459b 100644 --- a/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml +++ b/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml @@ -31,7 +31,7 @@ let get_status ~frontier_broadcast_pipe ~transaction_pool cmd = Result.of_option (User_command.check cmd) ~error:(Error.of_string "Invalid signature") |> Result.map ~f:(fun x -> - Transaction_hash.User_command_with_valid_signature.create x) + Transaction_hash.User_command_with_valid_signature.create x ) in let resource_pool = Transaction_pool.resource_pool transaction_pool in match Broadcast_pipe.Reader.peek frontier_broadcast_pipe with @@ -46,7 +46,7 @@ let get_status ~frontier_broadcast_pipe ~transaction_pool cmd = breadcrumb |> Transition_frontier.Breadcrumb.validated_transition |> Mina_block.Validated.valid_commands |> List.exists ~f:(fun { data = cmd'; _ } -> - User_command.equal cmd (User_command.forget_check cmd')) + User_command.equal cmd (User_command.forget_check cmd') ) in if List.exists ~f:in_breadcrumb best_tip_path then return State.Included ; @@ -56,7 +56,7 @@ let get_status ~frontier_broadcast_pipe ~transaction_pool cmd = then return State.Pending ; if Transaction_pool.Resource_pool.member resource_pool check_cmd then return State.Pending ; - State.Unknown) + State.Unknown ) let%test_module "transaction_status" = ( module struct @@ -87,7 +87,7 @@ let%test_module "transaction_status" = Async.Thread_safe.block_on_async_exn (fun () -> Verifier.create ~logger ~proof_level ~constraint_constants ~conf_dir:None - ~pids:(Child_processes.Termination.create_pid_table ())) + ~pids:(Child_processes.Termination.create_pid_table ()) ) let key_gen = let open Quickcheck.Generator in @@ -120,7 +120,7 @@ let%test_module "transaction_status" = ~expiry_ns: (Time_ns.Span.of_hr (Float.of_int - precomputed_values.genesis_constants.transaction_expiry_hr)) + precomputed_values.genesis_constants.transaction_expiry_hr ) ) ~log_gossip_heard:false ~on_remote_push:(Fn.const Deferred.unit) in don't_wait_for @@ -134,7 +134,7 @@ let%test_module "transaction_status" = , Transaction_pool.Resource_pool.Diff.to_yojson transactions ) ] ; - Deferred.unit) ; + Deferred.unit ) ; (* Need to wait for transaction_pool to see the transition_frontier *) let%map () = Async.Scheduler.yield_until_no_jobs_remain () in (transaction_pool, local_sink) @@ -157,7 +157,7 @@ let%test_module "transaction_status" = [%test_eq: State.t] ~equal:State.equal State.Unknown ( Or_error.ok_exn @@ get_status ~frontier_broadcast_pipe ~transaction_pool - (Signed_command user_command) ))) + (Signed_command user_command) ) ) ) let%test_unit "A pending transaction is either in the transition frontier \ or transaction pool, but not in the best path of the \ @@ -183,7 +183,7 @@ let%test_module "transaction_status" = (Signed_command user_command) in [%log info] "Computing status" ; - [%test_eq: State.t] ~equal:State.equal State.Pending status)) + [%test_eq: State.t] ~equal:State.equal State.Pending status ) ) let%test_unit "An unknown transaction does not appear in the transition \ frontier or transaction pool " = @@ -212,7 +212,7 @@ let%test_module "transaction_status" = let%bind () = Transaction_pool.Local_sink.push local_diffs_writer ( List.map pool_user_commands ~f:(fun x -> - User_command.Signed_command x) + User_command.Signed_command x ) , Fn.const () ) in let%map () = Async.Scheduler.yield_until_no_jobs_remain () in @@ -220,5 +220,5 @@ let%test_module "transaction_status" = [%test_eq: State.t] ~equal:State.equal State.Unknown ( Or_error.ok_exn @@ get_status ~frontier_broadcast_pipe ~transaction_pool - (Signed_command unknown_user_command) ))) + (Signed_command unknown_user_command) ) ) ) end ) diff --git a/src/lib/transaction_logic/mina_transaction_logic.ml b/src/lib/transaction_logic/mina_transaction_logic.ml index ded19c13325..4075758aa0e 100644 --- a/src/lib/transaction_logic/mina_transaction_logic.ml +++ b/src/lib/transaction_logic/mina_transaction_logic.ml @@ -151,10 +151,10 @@ module Transaction_applied = struct match varying with | Command (Signed_command uc) -> With_status.map uc.common.user_command ~f:(fun cmd -> - Transaction.Command (User_command.Signed_command cmd)) + Transaction.Command (User_command.Signed_command cmd) ) | Command (Parties s) -> With_status.map s.command ~f:(fun c -> - Transaction.Command (User_command.Parties c)) + Transaction.Command (User_command.Parties c) ) | Fee_transfer f -> { data = Fee_transfer f.fee_transfer; status = Applied } | Coinbase c -> @@ -324,7 +324,7 @@ module type S = sig , unit , Transaction_status.Failure.Collection.t ) Parties_logic.Local_state.t - -> 'acc) + -> 'acc ) -> ?fee_excess:Amount.Signed.t -> ledger -> Parties.t @@ -557,7 +557,7 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct (sprintf !"Error subtracting account creation fee %{sexp: Currency.Fee.t}; \ transaction amount %{sexp: Currency.Amount.t} insufficient" - fee amount) + fee amount ) Amount.(sub amount (of_fee fee)) else Ok amount @@ -585,10 +585,10 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct match varying with | Command (Signed_command uc) -> With_status.map uc.common.user_command ~f:(fun cmd -> - Transaction.Command (User_command.Signed_command cmd)) + Transaction.Command (User_command.Signed_command cmd) ) | Command (Parties s) -> With_status.map s.command ~f:(fun c -> - Transaction.Command (User_command.Parties c)) + Transaction.Command (User_command.Parties c) ) | Fee_transfer f -> { data = Fee_transfer f.fee_transfer; status = Applied } | Coinbase c -> @@ -831,7 +831,7 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct let%map balance = Result.map_error (sub_amount account.balance amount) ~f:(fun _ -> - Transaction_status.Failure.Source_insufficient_balance) + Transaction_status.Failure.Source_insufficient_balance ) in (location, source_timing, { account with timing; balance }) in @@ -846,7 +846,7 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct raise (Reject (Error.createf "%s" - (Transaction_status.Failure.describe failure))) + (Transaction_status.Failure.describe failure) ) ) else ret in (* Charge the account creation fee. *) @@ -859,7 +859,7 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct sub_account_creation_fee ~constraint_constants `Added amount |> Result.map_error ~f:(fun _ -> Transaction_status.Failure - .Amount_insufficient_to_create_account) + .Amount_insufficient_to_create_account ) in let%map receiver_account = incr_balance receiver_account receiver_amount @@ -885,7 +885,7 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct List.fold located_accounts ~init:(Ok ()) ~f:(fun acc (location, account) -> let%bind () = acc in - set_with_location ledger location account) + set_with_location ledger location account ) in let applied_common = { applied_common with @@ -905,7 +905,7 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct ; status = Failed (Transaction_status.Failure.Collection.of_single_failure - failure) + failure ) } } in @@ -1574,7 +1574,7 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct , Option.Let_syntax.( let%bind loc = L.location_of_account ledger id in let%map a = L.get ledger loc in - (loc, a)) )) + (loc, a)) ) ) in let perform eff = Env.perform ~constraint_constants eff in let rec step_all user_acc @@ -1586,7 +1586,7 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct else let%bind states = Or_error.try_with (fun () -> - M.step ~constraint_constants { perform } (g_state, l_state)) + M.step ~constraint_constants { perform } (g_state, l_state) ) in step_all (f user_acc states) states in @@ -1613,7 +1613,7 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct Or_error.try_with (fun () -> M.start ~constraint_constants { parties; memo_hash = Signed_command_memo.hash c.memo } - { perform } initial_state) + { perform } initial_state ) in let accounts () = List.map original_account_states @@ -1626,14 +1626,14 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct let account_ids_originally_not_in_ledger = List.filter_map original_account_states ~f:(fun (acct_id, loc_and_acct) -> - if Option.is_none loc_and_acct then Some acct_id else None) + if Option.is_none loc_and_acct then Some acct_id else None ) in (* accounts not originally in ledger, now present in ledger *) let previous_empty_accounts = List.filter_map account_ids_originally_not_in_ledger ~f:(fun acct_id -> Option.map (L.location_of_account ledger acct_id) ~f:(fun _ -> - acct_id)) + acct_id ) ) in Ok ( { Transaction_applied.Parties_applied.accounts = accounts () @@ -1654,9 +1654,9 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct let apply_parties_unchecked ~constraint_constants ~state_view ledger c = apply_parties_unchecked_aux ~constraint_constants ~state_view ledger c ~init:None ~f:(fun _acc (global_state, local_state) -> - Some (local_state, global_state.fee_excess)) + Some (local_state, global_state.fee_excess) ) |> Result.map ~f:(fun (party_applied, state_res) -> - (party_applied, Option.value_exn state_res)) + (party_applied, Option.value_exn state_res) ) let update_timing_when_no_deduction ~txn_global_slot account = validate_timing ~txn_amount:Amount.zero ~txn_global_slot ~account @@ -1729,16 +1729,16 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct let amount = Amount.of_fee f in sub_account_creation_fee ~constraint_constants action amount in - add_amount b amount) + add_amount b amount ) ~modify_timing:(fun acc -> - update_timing_when_no_deduction ~txn_global_slot acc) + update_timing_when_no_deduction ~txn_global_slot acc ) in Transaction_applied.Fee_transfer_applied. { fee_transfer = transfer; previous_empty_accounts; receiver_timing } let undo_fee_transfer ~constraint_constants t ({ previous_empty_accounts; fee_transfer; receiver_timing } : - Transaction_applied.Fee_transfer_applied.t) = + Transaction_applied.Fee_transfer_applied.t ) = let open Or_error.Let_syntax in let%map _ = process_fee_transfer t fee_transfer @@ -1752,15 +1752,15 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct sub_account_creation_fee ~constraint_constants action (Amount.of_fee f) in - sub_amount b amount) + sub_amount b amount ) ~modify_timing:(fun _ -> Ok receiver_timing) in remove_accounts_exn t previous_empty_accounts let apply_coinbase ~constraint_constants ~txn_global_slot t (* TODO: Better system needed for making atomic changes. Could use a monad. *) - ({ receiver; fee_transfer; amount = coinbase_amount } as cb : - Coinbase.t) = + ({ receiver; fee_transfer; amount = coinbase_amount } as cb : Coinbase.t) + = let open Or_error.Let_syntax in let%bind receiver_reward, emptys1, transferee_update, transferee_timing_prev = @@ -2006,7 +2006,7 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct { Transaction_applied.Parties_applied.accounts; _ } = let to_update, to_delete = List.partition_map accounts ~f:(fun (id, a) -> - match a with Some a -> `Fst (id, a) | None -> `Snd id) + match a with Some a -> `Fst (id, a) | None -> `Snd id ) in let to_update = List.dedup_and_sort @@ -2019,12 +2019,12 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct let%map loc = location_of_account' ledger (sprintf !"%{sexp:Account_id.t}" id) id in - (`Existing loc, a)) + (`Existing loc, a) ) |> Or_error.all in remove_accounts_exn ledger to_delete ; List.iter to_update ~f:(fun (location, account) -> - ignore @@ set_with_location ledger location account) + ignore @@ set_with_location ledger location account ) let undo : constraint_constants:Genesis_constants.Constraint_constants.t @@ -2046,7 +2046,7 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct Ok () in Debug_assert.debug_assert (fun () -> - [%test_eq: Ledger_hash.t] applied.previous_hash (merkle_root ledger)) ; + [%test_eq: Ledger_hash.t] applied.previous_hash (merkle_root ledger) ) ; res let apply_transaction ~constraint_constants @@ -2059,13 +2059,13 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct | Command (Signed_command txn) -> Or_error.map (apply_user_command_unchecked ~constraint_constants ~txn_global_slot - ledger txn) ~f:(fun applied -> - Transaction_applied.Varying.Command (Signed_command applied)) + ledger txn ) ~f:(fun applied -> + Transaction_applied.Varying.Command (Signed_command applied) ) | Command (Parties txn) -> Or_error.map (apply_parties_unchecked ~state_view:txn_state_view - ~constraint_constants ledger txn) ~f:(fun (applied, _) -> - Transaction_applied.Varying.Command (Parties applied)) + ~constraint_constants ledger txn ) ~f:(fun (applied, _) -> + Transaction_applied.Varying.Command (Parties applied) ) | Fee_transfer t -> Or_error.map (apply_fee_transfer ~constraint_constants ~txn_global_slot ledger t) @@ -2081,7 +2081,7 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct let applied, _ = Or_error.ok_exn (apply_parties_unchecked ~constraint_constants - ~state_view:txn_state_view ledger payment) + ~state_view:txn_state_view ledger payment ) in let root = merkle_root ledger in Or_error.ok_exn (undo_parties ~constraint_constants ledger applied) ; @@ -2092,7 +2092,7 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct let applied = Or_error.ok_exn (apply_user_command ~constraint_constants ~txn_global_slot ledger - payment) + payment ) in let root = merkle_root ledger in Or_error.ok_exn (undo_user_command ledger applied) ; @@ -2148,14 +2148,14 @@ module For_tests = struct L.get_or_create l (Account_id.create (Public_key.compress kp.public_key) - Token_id.default) + Token_id.default ) |> Or_error.ok_exn in L.set l loc { account with balance = Currency.Balance.of_uint64 (Unsigned.UInt64.of_int64 amount) - }) + } ) let gen () : t Quickcheck.Generator.t = let tbl = Public_key.Compressed.Hash_set.create () in @@ -2166,7 +2166,7 @@ module For_tests = struct else let%bind kp = filter Keypair.gen ~f:(fun kp -> - not (Hash_set.mem tbl (Public_key.compress kp.public_key))) + not (Hash_set.mem tbl (Public_key.compress kp.public_key)) ) and amount = Int64.gen_incl min_init_balance max_init_balance in Hash_set.add tbl (Public_key.compress kp.public_key) ; go ((kp, amount) :: acc) (n - 1) @@ -2244,7 +2244,7 @@ module For_tests = struct go [] num_transactions (Keypair.Map.of_alist_exn (List.map (Array.to_list init_ledger) ~f:(fun (pk, _) -> - (pk, Account_nonce.zero)))) + (pk, Account_nonce.zero) ) ) ) in return { init_ledger; specs } @@ -2338,7 +2338,7 @@ module For_tests = struct Option.value_exn (Amount.sub amount (Amount.of_fee - constraint_constants.account_creation_fee)) + constraint_constants.account_creation_fee ) ) else amount ) ; increment_nonce = false ; events = [] @@ -2378,7 +2378,7 @@ module For_tests = struct authorization = Control.Signature other_parties_signature } | _ -> - party) + party ) in let signature = Schnorr.Chunked.sign sender.private_key @@ -2415,7 +2415,7 @@ module For_tests = struct mismatch () | Some a1, Some a2 -> [%test_eq: Account_without_receipt_chain_hash.t] - (hide_rc a1) (hide_rc a2) ))) + (hide_rc a1) (hide_rc a2) ) ) ) let txn_global_slot = Global_slot.zero @@ -2424,7 +2424,7 @@ module For_tests = struct ~finish:(fun () -> Ok ()) ~init:() ~f:(fun () t -> - match f t with Error e -> Stop (Error e) | Ok _ -> Continue ()) + match f t with Error e -> Stop (Error e) | Ok _ -> Continue () ) let view : Zkapp_precondition.Protocol_state.View.t = let h = Frozen_ledger_hash.empty_hash in diff --git a/src/lib/transaction_logic/parties_logic.ml b/src/lib/transaction_logic/parties_logic.ml index 4146c983046..d6eefbd2a77 100644 --- a/src/lib/transaction_logic/parties_logic.ml +++ b/src/lib/transaction_logic/parties_logic.ml @@ -830,7 +830,7 @@ module Make (Inputs : Inputs_intf) = struct (Stack_frame.caller_caller current_forest) in (* Check that party has a valid caller. *) - assert_ Bool.(is_normal_call ||| is_delegate_call)) + assert_ Bool.(is_normal_call ||| is_delegate_call) ) in (* Cases: - [party_forest] is empty, [remainder_of_current_forest] is empty. @@ -860,18 +860,18 @@ module Make (Inputs : Inputs_intf) = struct (Call_stack.if_ remainder_of_current_forest_empty ~then_: (* Don't actually need the or_default used in this case. *) - popped_call_stack ~else_:call_stack) + popped_call_stack ~else_:call_stack ) ~else_: (Call_stack.if_ remainder_of_current_forest_empty ~then_:call_stack ~else_: (Call_stack.push remainder_of_current_forest_frame - ~onto:call_stack)) + ~onto:call_stack ) ) in let new_frame = Stack_frame.if_ party_forest_empty ~then_: (Stack_frame.if_ remainder_of_current_forest_empty - ~then_:newly_popped_frame ~else_:remainder_of_current_forest_frame) + ~then_:newly_popped_frame ~else_:remainder_of_current_forest_frame ) ~else_: (let caller = Token_id.if_ is_normal_call @@ -879,13 +879,12 @@ module Make (Inputs : Inputs_intf) = struct (Account_id.derive_token_id ~owner:(Party.account_id party)) ~else_:(Stack_frame.caller current_forest) and caller_caller = party_caller in - Stack_frame.make ~calls:party_forest ~caller ~caller_caller) + Stack_frame.make ~calls:party_forest ~caller ~caller_caller ) in { party; new_frame; new_call_stack } let apply ~(constraint_constants : Genesis_constants.Constraint_constants.t) - ~(is_start : - [ `Yes of _ Start_data.t | `No | `Compute of _ Start_data.t ]) + ~(is_start : [ `Yes of _ Start_data.t | `No | `Compute of _ Start_data.t ]) (h : (< global_state : Global_state.t ; transaction_commitment : Transaction_commitment.t @@ -895,9 +894,9 @@ module Make (Inputs : Inputs_intf) = struct ; failure : Bool.failure_status ; .. > as - 'env) - handler) ((global_state : Global_state.t), (local_state : Local_state.t)) - = + 'env ) + handler ) + ((global_state : Global_state.t), (local_state : Local_state.t)) = let open Inputs in let is_start' = let is_start' = Ps.is_empty (Stack_frame.calls local_state.stack_frame) in @@ -934,7 +933,7 @@ module Make (Inputs : Inputs_intf) = struct ( Stack_frame.if_ is_start' ~then_: (Stack_frame.make ~calls:start_data.parties - ~caller:default_caller ~caller_caller:default_caller) + ~caller:default_caller ~caller_caller:default_caller ) ~else_:local_state.stack_frame , Call_stack.if_ is_start' ~then_:(Call_stack.empty ()) ~else_:local_state.call_stack ) @@ -948,7 +947,7 @@ module Make (Inputs : Inputs_intf) = struct let { party; new_frame = remaining; new_call_stack = call_stack } = with_label ~label:"get next party" (fun () -> (* TODO: Make the stack frame hashed inside of the local state *) - get_next_party to_pop call_stack) + get_next_party to_pop call_stack ) in let local_state = with_label ~label:"token owner not caller" (fun () -> @@ -961,11 +960,11 @@ module Make (Inputs : Inputs_intf) = struct (Token_id.equal party_token_id (Party.caller party)) in Local_state.add_check local_state Token_owner_not_caller - default_token_or_token_owner_was_caller) + default_token_or_token_owner_was_caller ) in let ((a, inclusion_proof) as acct) = with_label ~label:"get account" (fun () -> - Inputs.Ledger.get_account party local_state.ledger) + Inputs.Ledger.get_account party local_state.ledger ) in Inputs.Ledger.check_inclusion local_state.ledger (a, inclusion_proof) ; let transaction_commitment, full_transaction_commitment = @@ -1024,7 +1023,7 @@ module Make (Inputs : Inputs_intf) = struct let protocol_state_predicate_satisfied = h.perform (Check_protocol_state_precondition - (Party.protocol_state_precondition party, global_state)) + (Party.protocol_state_precondition party, global_state) ) in let local_state = Local_state.add_check local_state Protocol_state_precondition_unsatisfied @@ -1171,12 +1170,12 @@ module Make (Inputs : Inputs_intf) = struct let keeping_app_state = Bool.all (List.map ~f:Set_or_keep.is_keep - (Pickles_types.Vector.to_list app_state)) + (Pickles_types.Vector.to_list app_state) ) in let changing_entire_app_state = Bool.all (List.map ~f:Set_or_keep.is_set - (Pickles_types.Vector.to_list app_state)) + (Pickles_types.Vector.to_list app_state) ) in let proved_state = (* The [proved_state] tracks whether the app state has been entirely @@ -1200,8 +1199,8 @@ module Make (Inputs : Inputs_intf) = struct (Bool.if_ proof_verifies ~then_: (Bool.if_ changing_entire_app_state ~then_:Bool.true_ - ~else_:(Account.proved_state a)) - ~else_:Bool.false_) + ~else_:(Account.proved_state a) ) + ~else_:Bool.false_ ) in let a = Account.set_proved_state proved_state a in let has_permission = diff --git a/src/lib/transaction_snark/test/account_timing/account_timing.ml b/src/lib/transaction_snark/test/account_timing/account_timing.ml index 12b99bcf932..4df6c84a1d9 100644 --- a/src/lib/transaction_snark/test/account_timing/account_timing.ml +++ b/src/lib/transaction_snark/test/account_timing/account_timing.ml @@ -309,7 +309,7 @@ let%test_module "account timing check" = (* keypair pair (for payment sender/receiver) *) let keypairss = List.init length ~f:(fun _ -> - (Signature_lib.Keypair.create (), Signature_lib.Keypair.create ())) + (Signature_lib.Keypair.create (), Signature_lib.Keypair.create ()) ) in (* list of keypairs *) let keypairs = @@ -429,14 +429,14 @@ let%test_module "account timing check" = | Failed failuress -> failwithf "Transaction failed: %s" ( List.map (List.concat failuress) ~f:(fun failure -> - Transaction_status.Failure.to_string failure) + Transaction_status.Failure.to_string failure ) |> String.concat ~sep:"," ) () ) ; check_transaction_snark ~txn_global_slot:slot sparse_ledger_before txn | Error err -> failwithf "Error when applying transaction: %s" - (Error.to_string_hum err) ()) + (Error.to_string_hum err) () ) : unit list ) (* for tests where we expect payments to succeed, use real signature, fake otherwise *) @@ -459,7 +459,7 @@ let%test_module "account timing check" = } in let balance_as_amount = Currency.Balance.to_amount balance in - (keypair, balance_as_amount, nonce, timing)) + (keypair, balance_as_amount, nonce, timing) ) |> Array.of_list in (* small payment amount, relative to balances *) @@ -473,7 +473,7 @@ let%test_module "account timing check" = ~min_amount:amount ~max_amount:amount ~fee_range:0 () in ( Mina_transaction.Transaction.Command (Signed_command payment) - : Mina_transaction.Transaction.t )) + : Mina_transaction.Transaction.t ) ) in (ledger_init_state, user_commands) in @@ -489,7 +489,7 @@ let%test_module "account timing check" = ledger_init_state ; apply_user_commands_at_slot ledger Mina_numbers.Global_slot.(succ zero) - user_commands)) + user_commands ) ) let%test_unit "user command, before cliff time, min balance violation" = let gen = @@ -510,7 +510,7 @@ let%test_module "account timing check" = } in let balance_as_amount = Currency.Balance.to_amount balance in - (keypair, balance_as_amount, nonce, timing)) + (keypair, balance_as_amount, nonce, timing) ) |> Array.of_list in let amount = 100_000_000_000 in @@ -552,8 +552,8 @@ let%test_module "account timing check" = not (String.equal err_str Transaction_status.Failure.( - describe Source_minimum_balance_violation)) - then failwithf "Unexpected transaction error: %s" err_str ())) + describe Source_minimum_balance_violation) ) + then failwithf "Unexpected transaction error: %s" err_str () ) ) let%test_unit "user command, just before cliff time, insufficient balance" = let gen = @@ -573,7 +573,7 @@ let%test_module "account timing check" = } in let balance_as_amount = Currency.Balance.to_amount balance in - (keypair, balance_as_amount, nonce, timing)) + (keypair, balance_as_amount, nonce, timing) ) |> Array.of_list in let amount = 100_000_000_000 in @@ -606,8 +606,8 @@ let%test_module "account timing check" = not (String.equal err_str Transaction_status.Failure.( - describe Source_minimum_balance_violation)) - then failwithf "Unexpected transaction error: %s" err_str ())) + describe Source_minimum_balance_violation) ) + then failwithf "Unexpected transaction error: %s" err_str () ) ) let%test_unit "user command, at cliff time, sufficient balance" = let gen = @@ -627,7 +627,7 @@ let%test_module "account timing check" = } in let balance_as_amount = Currency.Balance.to_amount balance in - (keypair, balance_as_amount, nonce, timing)) + (keypair, balance_as_amount, nonce, timing) ) |> Array.of_list in let amount = 100_000_000_000 in @@ -653,7 +653,7 @@ let%test_module "account timing check" = ledger_init_state ; apply_user_commands_at_slot ledger (Mina_numbers.Global_slot.of_int 10000) - [ user_command ])) + [ user_command ] ) ) let%test_unit "user command, while vesting, sufficient balance" = let gen = @@ -675,7 +675,7 @@ let%test_module "account timing check" = } in let balance_as_amount = Currency.Balance.to_amount balance in - (keypair, balance_as_amount, nonce, timing)) + (keypair, balance_as_amount, nonce, timing) ) |> Array.of_list in (* initial min balance - 100 slots * increment *) @@ -712,7 +712,7 @@ let%test_module "account timing check" = (* 100 vesting periods after cliff *) apply_user_commands_at_slot ledger (Mina_numbers.Global_slot.of_int 10100) - [ user_command ])) + [ user_command ] ) ) let%test_unit "user command, after vesting, sufficient balance" = let gen = @@ -732,7 +732,7 @@ let%test_module "account timing check" = } in let balance_as_amount = Currency.Balance.to_amount balance in - (keypair, balance_as_amount, nonce, timing)) + (keypair, balance_as_amount, nonce, timing) ) |> Array.of_list in let amount = 9_000_000_000_000 in @@ -759,7 +759,7 @@ let%test_module "account timing check" = ledger_init_state ; apply_user_commands_at_slot ledger Mina_numbers.Global_slot.(of_int 20_000) - [ user_command ])) + [ user_command ] ) ) let%test_unit "user command, after vesting, insufficient balance" = let gen = @@ -779,7 +779,7 @@ let%test_module "account timing check" = } in let balance_as_amount = Currency.Balance.to_amount balance in - (keypair, balance_as_amount, nonce, timing)) + (keypair, balance_as_amount, nonce, timing) ) |> Array.of_list in let amount = 100_000_000_000_000 in @@ -811,23 +811,23 @@ let%test_module "account timing check" = not (String.equal err_str Transaction_status.Failure.( - describe Source_insufficient_balance)) - then failwithf "Unexpected transaction error: %s" err_str ())) + describe Source_insufficient_balance) ) + then failwithf "Unexpected transaction error: %s" err_str () ) ) (* zkApps with timings *) let apply_zkapp_commands_at_slot ledger slot (partiess : Parties.t list) = let state_body, _state_view = state_body_and_view_at_slot slot in Async.Deferred.List.iter partiess ~f:(fun parties -> Transaction_snark_tests.Util.check_parties_with_merges_exn ~state_body - ledger [ parties ]) + ledger [ parties ] ) |> Fn.flip Async.upon (fun () -> ()) let check_zkapp_failure expected_failure = function | Ok ( (parties_undo : - Mina_transaction_logic.Transaction_applied.Parties_applied.t) + Mina_transaction_logic.Transaction_applied.Parties_applied.t ) , ( (local_state : - _ Mina_transaction_logic.Parties_logic.Local_state.t) + _ Mina_transaction_logic.Parties_logic.Local_state.t ) , _amount ) ) -> ( (* we expect a Failed status, and the failure to appear in the failure status table @@ -845,7 +845,7 @@ let%test_module "account timing check" = if not (List.equal Transaction_status.Failure.equal failures - [ expected_failure ]) + [ expected_failure ] ) then failwithf "Got unxpected transaction failure(s): %s, expected failure: \ @@ -879,7 +879,7 @@ let%test_module "account timing check" = } in let balance_as_amount = Currency.Balance.to_amount balance in - (keypair, balance_as_amount, nonce, timing)) + (keypair, balance_as_amount, nonce, timing) ) |> Array.of_list in let parties = @@ -928,7 +928,7 @@ let%test_module "account timing check" = ledger_init_state ; apply_zkapp_commands_at_slot ledger Mina_numbers.Global_slot.(succ zero) - [ txn ])) + [ txn ] ) ) let%test_unit "zkApp command, before cliff time, min balance violation" = let gen = @@ -949,7 +949,7 @@ let%test_module "account timing check" = } in let balance_as_amount = Currency.Balance.to_amount balance in - (keypair, balance_as_amount, nonce, timing)) + (keypair, balance_as_amount, nonce, timing) ) |> Array.of_list in let parties_command = @@ -1005,7 +1005,7 @@ let%test_module "account timing check" = in check_zkapp_failure Transaction_status.Failure.Source_minimum_balance_violation - result)) + result ) ) let%test_unit "zkApp command, before cliff time, fee payer fails" = let gen = @@ -1029,7 +1029,7 @@ let%test_module "account timing check" = } in let balance_as_amount = Currency.Balance.to_amount balance in - (keypair, balance_as_amount, nonce, timing)) + (keypair, balance_as_amount, nonce, timing) ) |> Array.of_list in let parties_command = @@ -1093,8 +1093,8 @@ let%test_module "account timing check" = (String.is_substring err_str ~substring: (Transaction_status.Failure.to_string - Source_minimum_balance_violation)) - then failwithf "Unexpected transaction error: %s" err_str ())) + Source_minimum_balance_violation ) ) + then failwithf "Unexpected transaction error: %s" err_str () ) ) let%test_unit "zkApp command, just before cliff time, insufficient balance" = @@ -1115,7 +1115,7 @@ let%test_module "account timing check" = } in let balance_as_amount = Currency.Balance.to_amount balance in - (keypair, balance_as_amount, nonce, timing)) + (keypair, balance_as_amount, nonce, timing) ) |> Array.of_list in (* min balance = balance, spending anything before cliff should trigger min balance violation *) @@ -1178,8 +1178,8 @@ let%test_module "account timing check" = if not (String.is_substring err_str - ~substring:"Source_minimum_balance_violation") - then failwithf "Unexpected transaction error: %s" err_str ())) + ~substring:"Source_minimum_balance_violation" ) + then failwithf "Unexpected transaction error: %s" err_str () ) ) (* this test is same as last one, except it's exactly at the cliff, and we expect it to succeed because the cliff amount makes the whole balance liquid @@ -1202,7 +1202,7 @@ let%test_module "account timing check" = } in let balance_as_amount = Currency.Balance.to_amount balance in - (keypair, balance_as_amount, nonce, timing)) + (keypair, balance_as_amount, nonce, timing) ) |> Array.of_list in let parties = @@ -1250,7 +1250,7 @@ let%test_module "account timing check" = ledger_init_state ; apply_zkapp_commands_at_slot ledger Mina_numbers.Global_slot.(of_int 10000) - [ parties ])) + [ parties ] ) ) let%test_unit "zkApp command, while vesting, sufficient balance" = let gen = @@ -1272,7 +1272,7 @@ let%test_module "account timing check" = } in let balance_as_amount = Currency.Balance.to_amount balance in - (keypair, balance_as_amount, nonce, timing)) + (keypair, balance_as_amount, nonce, timing) ) |> Array.of_list in let liquid_balance = @@ -1325,7 +1325,7 @@ let%test_module "account timing check" = ledger_init_state ; apply_zkapp_commands_at_slot ledger Mina_numbers.Global_slot.(of_int 10_100) - [ parties ])) + [ parties ] ) ) let%test_unit "zkApp command, while vesting, insufficient balance" = let gen = @@ -1347,7 +1347,7 @@ let%test_module "account timing check" = } in let balance_as_amount = Currency.Balance.to_amount balance in - (keypair, balance_as_amount, nonce, timing)) + (keypair, balance_as_amount, nonce, timing) ) |> Array.of_list in let liquid_balance = @@ -1409,7 +1409,7 @@ let%test_module "account timing check" = in check_zkapp_failure Transaction_status.Failure.Source_minimum_balance_violation - result)) + result ) ) let%test_unit "zkApp command, after vesting, sufficient balance" = let gen = @@ -1431,7 +1431,7 @@ let%test_module "account timing check" = } in let balance_as_amount = Currency.Balance.to_amount balance in - (keypair, balance_as_amount, nonce, timing)) + (keypair, balance_as_amount, nonce, timing) ) |> Array.of_list in let fee_int = 1_000_000 in @@ -1481,7 +1481,7 @@ let%test_module "account timing check" = ledger_init_state ; apply_zkapp_commands_at_slot ledger Mina_numbers.Global_slot.(of_int (100_000 + 10_000)) - [ parties ])) + [ parties ] ) ) (* same as previous test, amount is incremented by 1 *) let%test_unit "zkApp command, after vesting, insufficient balance" = @@ -1504,7 +1504,7 @@ let%test_module "account timing check" = } in let balance_as_amount = Currency.Balance.to_amount balance in - (keypair, balance_as_amount, nonce, timing)) + (keypair, balance_as_amount, nonce, timing) ) |> Array.of_list in let fee_int = 1_000_000 in @@ -1562,5 +1562,5 @@ let%test_module "account timing check" = Mina_ledger.Ledger.apply_parties_unchecked ~constraint_constants ~state_view ledger parties in - check_zkapp_failure Transaction_status.Failure.Overflow result)) + check_zkapp_failure Transaction_status.Failure.Overflow result ) ) end ) diff --git a/src/lib/transaction_snark/test/app_state/app_state.ml b/src/lib/transaction_snark/test/app_state/app_state.ml index ecd3ed1e9cd..2a5fd1726b7 100644 --- a/src/lib/transaction_snark/test/app_state/app_state.ml +++ b/src/lib/transaction_snark/test/app_state/app_state.ml @@ -12,7 +12,7 @@ struct { Party.Update.dummy with app_state = Vector.init Zkapp_state.Max_state_size.n ~f:(fun i -> - Zkapp_basic.Set_or_keep.Set (Snark_params.Tick.Field.of_int i)) + Zkapp_basic.Set_or_keep.Set (Snark_params.Tick.Field.of_int i) ) } end diff --git a/src/lib/transaction_snark/test/fee_payer/fee_payer.ml b/src/lib/transaction_snark/test/fee_payer/fee_payer.ml index 32b9fe38c6d..924f247b58c 100644 --- a/src/lib/transaction_snark/test/fee_payer/fee_payer.ml +++ b/src/lib/transaction_snark/test/fee_payer/fee_payer.ml @@ -19,7 +19,7 @@ let%test_module "Fee payer tests" = { Party.Update.dummy with app_state = Pickles_types.Vector.init Zkapp_state.Max_state_size.n ~f:(fun i -> - Zkapp_basic.Set_or_keep.Set (Pickles.Backend.Tick.Field.of_int i)) + Zkapp_basic.Set_or_keep.Set (Pickles.Backend.Tick.Field.of_int i) ) } let%test_unit "update a snapp account with signature and fee paid by the \ @@ -47,7 +47,7 @@ let%test_module "Fee payer tests" = } in U.test_snapp_update test_spec ~init_ledger ~vk ~snapp_prover - ~snapp_pk:(Public_key.compress new_kp.public_key)) + ~snapp_pk:(Public_key.compress new_kp.public_key) ) let%test_unit "update a snapp account with signature and fee paid by a \ non-snapp account" = @@ -75,7 +75,7 @@ let%test_module "Fee payer tests" = } in U.test_snapp_update test_spec ~init_ledger ~vk ~snapp_prover - ~snapp_pk:(Public_key.compress new_kp.public_key)) + ~snapp_pk:(Public_key.compress new_kp.public_key) ) let%test_unit "update a snapp account with proof and fee paid by the snapp \ account" = @@ -105,7 +105,7 @@ let%test_module "Fee payer tests" = ~snapp_permissions: (U.permissions_from_update snapp_update ~auth:Proof) test_spec ~init_ledger ~vk ~snapp_prover - ~snapp_pk:(Public_key.compress new_kp.public_key)) + ~snapp_pk:(Public_key.compress new_kp.public_key) ) let%test_unit "update a snapp account with proof and fee paid by a \ non-snapp account" = @@ -136,7 +136,7 @@ let%test_module "Fee payer tests" = ~snapp_permissions: (U.permissions_from_update snapp_update ~auth:Proof) test_spec ~init_ledger ~vk ~snapp_prover - ~snapp_pk:(Public_key.compress new_kp.public_key)) + ~snapp_pk:(Public_key.compress new_kp.public_key) ) let%test_unit "snapp transaction with non-existent fee payer account" = let open Mina_transaction_logic.For_tests in @@ -191,12 +191,12 @@ let%test_module "Fee payer tests" = [ ( `Pending_coinbase_init_stack U.init_stack , `Pending_coinbase_of_statement (U.pending_coinbase_state_stack - ~state_body_hash:U.genesis_state_body_hash) + ~state_body_hash:U.genesis_state_body_hash ) , parties ) - ]) + ] ) with | Ok _a -> failwith "Expected sparse ledger application to fail" | Error _e -> - ())) + () ) ) end ) diff --git a/src/lib/transaction_snark/test/multisig_account/multisig_account.ml b/src/lib/transaction_snark/test/multisig_account/multisig_account.ml index a8f859b4a0c..78d8137a0af 100644 --- a/src/lib/transaction_snark/test/multisig_account/multisig_account.ml +++ b/src/lib/transaction_snark/test/multisig_account/multisig_account.ml @@ -57,7 +57,7 @@ let%test_module "multisig_account" = let verify_sig (sigma, pk) : Boolean.var Checked.t = Checked.List.exists pubkeys ~f:(fun pk' -> [ eq_pk pk pk'; check_sig pk' commitment sigma ] - |> Checked.List.all >>= Boolean.all) + |> Checked.List.all >>= Boolean.all ) in Checked.List.map witness ~f:verify_sig >>= fun bs -> [%with_label __LOC__] (Boolean.Assert.all bs) @@ -94,9 +94,9 @@ let%test_module "multisig_account" = ~compute:(As_prover.return msg) in let witness = [ (sigma_var, pk_var) ] in - check_witness 1 [ pk ] msg_var witness) + check_witness 1 [ pk ] msg_var witness ) |> Checked.map ~f:As_prover.return - |> run_and_check |> Or_error.ok_exn) + |> run_and_check |> Or_error.ok_exn ) let%test_unit "2-of-2" = let gen = @@ -131,9 +131,9 @@ let%test_module "multisig_account" = ~compute:(As_prover.return msg) in let witness = [ (sigma0_var, pk0_var); (sigma1_var, pk1_var) ] in - check_witness 2 [ pk0; pk1 ] msg_var witness) + check_witness 2 [ pk0; pk1 ] msg_var witness ) |> Checked.map ~f:As_prover.return - |> run_and_check |> Or_error.ok_exn) + |> run_and_check |> Or_error.ok_exn ) end type _ Snarky_backendless.Request.t += @@ -212,7 +212,7 @@ let%test_module "multisig_account" = (Pickles_types.Hlist.E01 (Pickles.Inductive_rule.B)) .t -> - []) + [] ) ; main_value = (fun [] _ -> []) } in @@ -221,12 +221,12 @@ let%test_module "multisig_account" = (module Zkapp_statement) ~typ:Zkapp_statement.typ ~branches:(module Nat.N2) - ~max_proofs_verified: - (module Nat.N2) (* You have to put 2 here... *) + ~max_proofs_verified:(module Nat.N2) + (* You have to put 2 here... *) ~name:"multisig" ~constraint_constants: (Genesis_constants.Constraint_constants.to_snark_keys_header - constraint_constants) + constraint_constants ) ~choices:(fun ~self -> [ multisig_rule ; { identifier = "dummy" @@ -239,7 +239,7 @@ let%test_module "multisig_account" = |> fun () -> (* Unsatisfiable. *) Run.exists Field.typ ~compute:(fun () -> - Run.Field.Constant.zero) + Run.Field.Constant.zero ) |> fun s -> Run.Field.(Assert.equal s (s + one)) |> fun () : @@ -249,9 +249,9 @@ let%test_module "multisig_account" = (Pickles_types.Hlist.E01 (Pickles.Inductive_rule.B)) .t -> - [ Boolean.true_; Boolean.true_ ]) + [ Boolean.true_; Boolean.true_ ] ) } - ]) + ] ) in let vk = Pickles.Side_loaded.Verification_key.of_compiled tag in let { Mina_transaction_logic.For_tests.Transaction_spec.fee @@ -274,7 +274,7 @@ let%test_module "multisig_account" = Ledger.get_or_create_account ledger id (Account.create id Currency.Balance.( - Option.value_exn (add_amount zero total))) + Option.value_exn (add_amount zero total)) ) |> Or_error.ok_exn in let _is_new, loc = @@ -295,7 +295,7 @@ let%test_module "multisig_account" = { (Option.value ~default:Zkapp_account.default a.zkapp) with verification_key = Some vk } - }) ; + } ) ; let update_empty_permissions = let permissions = Zkapp_basic.Set_or_keep.Set Permissions.empty @@ -414,7 +414,7 @@ let%test_module "multisig_account" = ~memo_hash:(Signed_command_memo.hash memo) ~fee_payer_hash: (Parties.Digest.Party.create - (Party.of_fee_payer fee_payer)) + (Party.of_fee_payer fee_payer) ) in { fee_payer with authorization = @@ -427,7 +427,7 @@ let%test_module "multisig_account" = ; authorization = Signature (Signature_lib.Schnorr.Chunked.sign sender.private_key - (Random_oracle.Input.Chunked.field transaction)) + (Random_oracle.Input.Chunked.field transaction) ) } in let parties : Parties.t = @@ -443,5 +443,5 @@ let%test_module "multisig_account" = } in Init_ledger.init (module Ledger.Ledger_inner) init_ledger ledger ; - ignore (U.apply_parties ledger [ parties ] : Sparse_ledger.t))) + ignore (U.apply_parties ledger [ parties ] : Sparse_ledger.t) ) ) end ) diff --git a/src/lib/transaction_snark/test/party_preconditions/party_preconditions.ml b/src/lib/transaction_snark/test/party_preconditions/party_preconditions.ml index 8a127d2776e..71b00284770 100644 --- a/src/lib/transaction_snark/test/party_preconditions/party_preconditions.ml +++ b/src/lib/transaction_snark/test/party_preconditions/party_preconditions.ml @@ -18,7 +18,7 @@ let%test_module "Protocol state precondition tests" = { Party.Update.dummy with app_state = Pickles_types.Vector.init Zkapp_state.Max_state_size.n ~f:(fun i -> - Zkapp_basic.Set_or_keep.Set (Pickles.Backend.Tick.Field.of_int i)) + Zkapp_basic.Set_or_keep.Set (Pickles.Backend.Tick.Field.of_int i) ) } let precondition_exact @@ -80,13 +80,13 @@ let%test_module "Protocol state precondition tests" = ; protocol_state_precondition = Some (precondition_exact - (Mina_state.Protocol_state.Body.view state_body)) + (Mina_state.Protocol_state.Body.view state_body) ) ; account_precondition = None } in U.test_snapp_update test_spec ~state_body ~init_ledger ~vk ~snapp_prover - ~snapp_pk:(Public_key.compress new_kp.public_key)) + ~snapp_pk:(Public_key.compress new_kp.public_key) ) let%test_unit "generated protocol state predicate" = let state_body = U.genesis_state_body in @@ -125,7 +125,7 @@ let%test_module "Protocol state precondition tests" = in U.test_snapp_update test_spec ~state_body ~init_ledger ~vk ~snapp_prover - ~snapp_pk:(Public_key.compress new_kp.public_key)) + ~snapp_pk:(Public_key.compress new_kp.public_key) ) let%test_unit "invalid protocol state predicate in fee payer" = let state_body = U.genesis_state_body in @@ -196,12 +196,12 @@ let%test_module "Protocol state precondition tests" = (sprintf {|.*\(%s\).*|} Transaction_status.Failure.( to_string - Protocol_state_precondition_unsatisfied))) + Protocol_state_precondition_unsatisfied) ) ) (Error.to_string_hum e) 0 ) | Ok _ -> failwith "Expected transaction to fail due to invalid protocol \ - state precondition in the fee payer"))) + state precondition in the fee payer" ) ) ) let%test_unit "invalid protocol state predicate in other parties" = let state_body = U.genesis_state_body in @@ -290,7 +290,7 @@ let%test_module "Protocol state precondition tests" = (sub amount (of_fee constraint_constants - .account_creation_fee)))) + .account_creation_fee ) ) )) ; increment_nonce = false ; events = [] ; sequence_events = [] @@ -312,7 +312,7 @@ let%test_module "Protocol state precondition tests" = Parties.Call_forest.With_hashes.of_parties_list (List.map ~f:(fun p -> (p, ())) - [ sender_party; snapp_party ]) + [ sender_party; snapp_party ] ) in let other_parties_hash = Parties.Call_forest.hash ps in let commitment = @@ -366,7 +366,7 @@ let%test_module "Protocol state precondition tests" = Transaction_status.Failure .Protocol_state_precondition_unsatisfied ~state_body ledger - [ parties_with_valid_fee_payer ]))) + [ parties_with_valid_fee_payer ] ) ) ) end ) let%test_module "Account precondition tests" = @@ -381,7 +381,7 @@ let%test_module "Account precondition tests" = { Party.Update.dummy with app_state = Pickles_types.Vector.init Zkapp_state.Max_state_size.n ~f:(fun i -> - Zkapp_basic.Set_or_keep.Set (Pickles.Backend.Tick.Field.of_int i)) + Zkapp_basic.Set_or_keep.Set (Pickles.Backend.Tick.Field.of_int i) ) } let precondition_exact (account : Account.t) = @@ -425,7 +425,7 @@ let%test_module "Account precondition tests" = | Some { app_state; sequence_state; proved_state; _ } -> let state = Zkapp_state.V.map app_state ~f:(fun field -> - Or_ignore.Check field) + Or_ignore.Check field ) in let sequence_state = (* choose a value from account sequence state *) @@ -494,7 +494,7 @@ let%test_module "Account precondition tests" = Transaction_snark.For_tests.update_states ~snapp_prover ~constraint_constants test_spec in - U.check_parties_with_merges_exn ~state_body ledger [ parties ]))) + U.check_parties_with_merges_exn ~state_body ledger [ parties ] ) ) ) let%test_unit "generated account precondition" = let gen = @@ -550,7 +550,7 @@ let%test_module "Account precondition tests" = Transaction_snark.For_tests.update_states ~snapp_prover ~constraint_constants test_spec in - U.check_parties_with_merges_exn ~state_body ledger [ parties ]))) + U.check_parties_with_merges_exn ~state_body ledger [ parties ] ) ) ) let%test_unit "invalid account predicate in other parties" = let state_body = U.genesis_state_body in @@ -610,7 +610,7 @@ let%test_module "Account precondition tests" = ~expected_failure: Transaction_status.Failure .Account_precondition_unsatisfied ~state_body ledger - [ parties ]))) + [ parties ] ) ) ) let%test_unit "invalid account predicate in fee payer" = let state_body = U.genesis_state_body in @@ -675,7 +675,7 @@ let%test_module "Account precondition tests" = Option.value_exn (Currency.Amount.sub amount (Amount.of_fee - constraint_constants.account_creation_fee)) + constraint_constants.account_creation_fee ) ) |> Amount.Signed.of_unsigned ; increment_nonce = false ; events = [] @@ -753,10 +753,10 @@ let%test_module "Account precondition tests" = (Str.regexp (sprintf {|.*\(%s\).*|} Transaction_status.Failure.( - to_string Account_precondition_unsatisfied))) + to_string Account_precondition_unsatisfied) ) ) (Error.to_string_hum e) 0 ) | Ok _ -> failwith "Expected transaction to fail due to invalid account \ - precondition in the fee payer")) + precondition in the fee payer" ) ) end ) diff --git a/src/lib/transaction_snark/test/ring_sig.ml b/src/lib/transaction_snark/test/ring_sig.ml index 702f6c0c322..b2dba048679 100644 --- a/src/lib/transaction_snark/test/ring_sig.ml +++ b/src/lib/transaction_snark/test/ring_sig.ml @@ -57,7 +57,7 @@ let ring_sig_rule (ring_member_pks : Schnorr.Chunked.Public_key.t list) : Pickles_types.Hlist0.H1 (Pickles_types.Hlist.E01(Pickles.Inductive_rule.B)) .t -> - []) + [] ) ; main_value = (fun [] _ -> []) } @@ -75,9 +75,9 @@ let%test_unit "1-of-1" = Typ.(Schnorr.Chunked.Signature.typ * Schnorr.chunked_message_typ ()) ~compute:As_prover.(return (sigma, msg)) in - check_witness [ pk ] msg_var sigma_var) + check_witness [ pk ] msg_var sigma_var ) |> Checked.map ~f:As_prover.return - |> run_and_check |> Or_error.ok_exn) + |> run_and_check |> Or_error.ok_exn ) let%test_unit "1-of-2" = let gen = @@ -96,9 +96,9 @@ let%test_unit "1-of-2" = and msg_var = exists (Schnorr.chunked_message_typ ()) ~compute:(As_prover.return msg) in - check_witness [ pk0; pk1 ] msg_var sigma1_var) + check_witness [ pk0; pk1 ] msg_var sigma1_var ) |> Checked.map ~f:As_prover.return - |> run_and_check |> Or_error.ok_exn) + |> run_and_check |> Or_error.ok_exn ) (* test a snapp tx with a 3-party ring *) let%test_unit "ring-signature snapp tx with 3 parties" = @@ -129,14 +129,14 @@ let%test_unit "ring-signature snapp tx with 3 parties" = (module Zkapp_statement) ~typ:Zkapp_statement.typ ~branches:(module Nat.N2) - ~max_proofs_verified: - (module Nat.N2) (* You have to put 2 here... *) + ~max_proofs_verified:(module Nat.N2) + (* You have to put 2 here... *) ~name:"ringsig" ~constraint_constants: (Genesis_constants.Constraint_constants.to_snark_keys_header - constraint_constants) + constraint_constants ) ~choices:(fun ~self -> - [ ring_sig_rule ring_member_pks; dummy_rule self ]) + [ ring_sig_rule ring_member_pks; dummy_rule self ] ) in let vk = Pickles.Side_loaded.Verification_key.of_compiled tag in ( if debug_mode then @@ -160,7 +160,7 @@ let%test_unit "ring-signature snapp tx with 3 parties" = let id = Account_id.create pk Token_id.default in Ledger.get_or_create_account ledger id (Account.create id - Balance.(Option.value_exn (add_amount zero total))) + Balance.(Option.value_exn (add_amount zero total)) ) |> Or_error.ok_exn in let _is_new, loc = @@ -177,7 +177,7 @@ let%test_unit "ring-signature snapp tx with 3 parties" = { (Option.value ~default:Zkapp_account.default a.zkapp) with verification_key = Some vk } - }) ; + } ) ; let sender_pk = sender.public_key |> Public_key.compress in let fee_payer : Party.Fee_payer.t = { Party.Fee_payer.body = @@ -309,7 +309,7 @@ let%test_unit "ring-signature snapp tx with 3 parties" = ~f:(fun idx (p : Party.t) -> Party.Body.to_yojson p.body |> Yojson.Safe.pretty_to_string - |> printf "other_party #%d body:\n%s\n\n" idx) + |> printf "other_party #%d body:\n%s\n\n" idx ) |> fun () -> (* print other_party proof *) Pickles.Side_loaded.Proof.Stable.V2.sexp_of_t pi @@ -321,4 +321,4 @@ let%test_unit "ring-signature snapp tx with 3 parties" = |> Yojson.Safe.pretty_to_string |> printf "protocol_state:\n%s\n\n" ) |> fun () -> - ignore (apply_parties ledger [ parties ] : Sparse_ledger.t))) + ignore (apply_parties ledger [ parties ] : Sparse_ledger.t) ) ) diff --git a/src/lib/transaction_snark/test/test_zkapp_update.ml b/src/lib/transaction_snark/test/test_zkapp_update.ml index b4f482f84e3..87217a97c61 100644 --- a/src/lib/transaction_snark/test/test_zkapp_update.ml +++ b/src/lib/transaction_snark/test/test_zkapp_update.ml @@ -48,7 +48,7 @@ module Make (Input : Input_intf) = struct } in U.test_snapp_update test_spec ~init_ledger ~vk ~snapp_prover - ~snapp_pk:(Public_key.compress new_kp.public_key)) + ~snapp_pk:(Public_key.compress new_kp.public_key) ) let%test_unit "update a snapp account with proof" = Quickcheck.test ~trials:1 U.gen_snapp_ledger @@ -77,7 +77,7 @@ module Make (Input : Input_intf) = struct ~snapp_permissions: (U.permissions_from_update snapp_update ~auth:Proof) test_spec ~init_ledger ~vk ~snapp_prover - ~snapp_pk:(Public_key.compress new_kp.public_key)) + ~snapp_pk:(Public_key.compress new_kp.public_key) ) let%test_unit "update a snapp account with None permission" = Quickcheck.test ~trials:1 U.gen_snapp_ledger @@ -106,7 +106,7 @@ module Make (Input : Input_intf) = struct U.test_snapp_update ~snapp_permissions:(U.permissions_from_update snapp_update ~auth:None) test_spec ~init_ledger ~vk ~snapp_prover - ~snapp_pk:(Public_key.compress new_kp.public_key)) + ~snapp_pk:(Public_key.compress new_kp.public_key) ) let%test_unit "update a snapp account with None permission and Signature auth" = @@ -136,7 +136,7 @@ module Make (Input : Input_intf) = struct U.test_snapp_update ~snapp_permissions:(U.permissions_from_update snapp_update ~auth:None) test_spec ~init_ledger ~vk ~snapp_prover - ~snapp_pk:(Public_key.compress new_kp.public_key)) + ~snapp_pk:(Public_key.compress new_kp.public_key) ) let%test_unit "update a snapp account with None permission and Proof auth" = Quickcheck.test ~trials:1 U.gen_snapp_ledger @@ -165,7 +165,7 @@ module Make (Input : Input_intf) = struct U.test_snapp_update ~snapp_permissions:(U.permissions_from_update snapp_update ~auth:None) test_spec ~init_ledger ~vk ~snapp_prover - ~snapp_pk:(Public_key.compress new_kp.public_key)) + ~snapp_pk:(Public_key.compress new_kp.public_key) ) let%test_unit "update a snapp account with Either permission and Signature \ auth" = @@ -196,7 +196,7 @@ module Make (Input : Input_intf) = struct ~snapp_permissions: (U.permissions_from_update snapp_update ~auth:Either) test_spec ~init_ledger ~vk ~snapp_prover - ~snapp_pk:(Public_key.compress new_kp.public_key)) + ~snapp_pk:(Public_key.compress new_kp.public_key) ) let%test_unit "update a snapp account with Either permission and Proof auth" = Quickcheck.test ~trials:1 U.gen_snapp_ledger @@ -226,7 +226,7 @@ module Make (Input : Input_intf) = struct ~snapp_permissions: (U.permissions_from_update snapp_update ~auth:Either) test_spec ~init_ledger ~vk ~snapp_prover - ~snapp_pk:(Public_key.compress new_kp.public_key)) + ~snapp_pk:(Public_key.compress new_kp.public_key) ) let%test_unit "update a snapp account with Either permission and None auth" = Quickcheck.test ~trials:1 U.gen_snapp_ledger @@ -256,7 +256,7 @@ module Make (Input : Input_intf) = struct ~snapp_permissions: (U.permissions_from_update snapp_update ~auth:Either) test_spec ~init_ledger ~vk ~snapp_prover - ~snapp_pk:(Public_key.compress new_kp.public_key)) + ~snapp_pk:(Public_key.compress new_kp.public_key) ) let%test_unit "Update when not permitted but transaction is applied" = let open Mina_transaction_logic.For_tests in @@ -295,5 +295,5 @@ module Make (Input : Input_intf) = struct U.test_snapp_update ~expected_failure:failure_expected ~snapp_permissions: (U.permissions_from_update snapp_update ~auth:Proof) - ~vk ~snapp_prover test_spec ~init_ledger ~snapp_pk)) + ~vk ~snapp_prover test_spec ~init_ledger ~snapp_pk ) ) end diff --git a/src/lib/transaction_snark/test/transaction_union/transaction_union.ml b/src/lib/transaction_snark/test/transaction_union/transaction_union.ml index 6f7b1cb9ce5..9510653a7e2 100644 --- a/src/lib/transaction_snark/test/transaction_union/transaction_union.ml +++ b/src/lib/transaction_snark/test/transaction_union/transaction_union.ml @@ -74,7 +74,7 @@ let%test_module "Transaction union tests" = let txn = Transaction.Command (User_command.Signed_command - (Signed_command.forget_check user_command)) + (Signed_command.forget_check user_command) ) in Transaction_snark.Statement.Poly.with_empty_local_state ~source ~target ~sok_digest @@ -84,7 +84,7 @@ let%test_module "Transaction union tests" = ~pending_coinbase_stack_state in U.T.of_user_command ~init_stack ~statement user_command_in_block - handler) + handler ) let coinbase_test state_body ~carryforward = let mk_pubkey () = @@ -105,7 +105,7 @@ let%test_module "Transaction union tests" = ~fee_transfer: (Some (Coinbase.Fee_transfer.create ~receiver_pk:other - ~fee:U.constraint_constants.account_creation_fee)) + ~fee:U.constraint_constants.account_creation_fee ) ) |> Or_error.ok_exn in let transaction = Mina_transaction.Transaction.Coinbase cb in @@ -142,21 +142,21 @@ let%test_module "Transaction union tests" = ~constraint_constants:U.constraint_constants ~sok_message: (Mina_base.Sok_message.create ~fee:Currency.Fee.zero - ~prover:Public_key.Compressed.empty) + ~prover:Public_key.Compressed.empty ) ~source:(Sparse_ledger.merkle_root sparse_ledger) ~target:(Sparse_ledger.merkle_root sparse_ledger_after) ~init_stack:pending_coinbase_init ~pending_coinbase_stack_state: { source = source_stack; target = pending_coinbase_stack_target } - ~zkapp_account1:None ~zkapp_account2:None) + ~zkapp_account1:None ~zkapp_account2:None ) let%test_unit "coinbase with new state body hash" = Test_util.with_randomness 123456789 (fun () -> - coinbase_test state_body ~carryforward:false) + coinbase_test state_body ~carryforward:false ) let%test_unit "coinbase with carry-forward state body hash" = Test_util.with_randomness 123456789 (fun () -> - coinbase_test state_body ~carryforward:true) + coinbase_test state_body ~carryforward:true ) let%test_unit "new_account" = Test_util.with_randomness 123456789 (fun () -> @@ -167,7 +167,7 @@ let%test_module "Transaction union tests" = ~f:(fun { account; private_key = _ } -> Ledger.create_new_account_exn ledger (Account.identifier account) - account) ; + account ) ; let t1 = U.Wallet.user_command_with_wallet wallets ~sender:1 ~receiver:0 8_000_000_000 @@ -175,7 +175,7 @@ let%test_module "Transaction union tests" = Account.Nonce.zero (Signed_command_memo.create_by_digesting_string_exn (Test_util.arbitrary_string - ~len:Signed_command_memo.max_digestible_string_length)) + ~len:Signed_command_memo.max_digestible_string_length ) ) in let current_global_slot = Mina_state.Protocol_state.Body.consensus_state state_body @@ -213,7 +213,7 @@ let%test_module "Transaction union tests" = ~target ~init_stack:pending_coinbase_stack ~pending_coinbase_stack_state { transaction = t1; block_data = state_body } - (unstage @@ Sparse_ledger.handler sparse_ledger))) + (unstage @@ Sparse_ledger.handler sparse_ledger) ) ) let account_fee = Fee.to_int constraint_constants.account_creation_fee @@ -245,7 +245,7 @@ let%test_module "Transaction union tests" = ~consensus_state:consensus_state_at_slot ~constants: (Protocol_constants_checked.value_of_t - Genesis_constants.compiled.protocol)) + Genesis_constants.compiled.protocol )) .body in let state_body_hash = @@ -312,7 +312,7 @@ let%test_module "Transaction union tests" = let memo = Signed_command_memo.create_by_digesting_string_exn (Test_util.arbitrary_string - ~len:Signed_command_memo.max_digestible_string_length) + ~len:Signed_command_memo.max_digestible_string_length ) in Ledger.with_ledger ~depth:ledger_depth ~f:(fun ledger -> let _, ucs = @@ -329,7 +329,7 @@ let%test_module "Transaction union tests" = ~receiver_pk:(Account.public_key receiver.account) amount (Fee.of_int txn_fee) nonce memo in - (Account.Nonce.succ nonce, txns @ [ uc ])) + (Account.Nonce.succ nonce, txns @ [ uc ]) ) in Ledger.create_new_account_exn ledger (Account.identifier sender.account) @@ -337,19 +337,19 @@ let%test_module "Transaction union tests" = let () = List.iter ucs ~f:(fun uc -> test_transaction ~constraint_constants ledger - (Transaction.Command (Signed_command uc))) + (Transaction.Command (Signed_command uc)) ) in List.iter receivers ~f:(fun receiver -> U.check_balance (Account.identifier receiver.account) ((amount * txns_per_receiver) - account_fee) - ledger) ; + ledger ) ; U.check_balance (Account.identifier sender.account) ( Balance.to_int sender.account.balance - (amount + txn_fee) * txns_per_receiver * List.length receivers ) - ledger)) + ledger ) ) let%test_unit "account creation fee - fee transfers" = Test_util.with_randomness 123456789 (fun () -> @@ -371,20 +371,20 @@ let%test_module "Transaction union tests" = Fee_transfer.Single.create ~receiver_pk:receiver.account.public_key ~fee:(Currency.Fee.of_int fee) - ~fee_token:receiver.account.token_id) + ~fee_token:receiver.account.token_id ) in - txns @ [ ft ]) + txns @ [ ft ] ) in let () = List.iter fts ~f:(fun ft -> let txn = Mina_transaction.Transaction.Fee_transfer ft in - test_transaction ~constraint_constants ledger txn) + test_transaction ~constraint_constants ledger txn ) in List.iter receivers ~f:(fun receiver -> U.check_balance (Account.identifier receiver.account) ((fee * txns_per_receiver) - account_fee) - ledger))) + ledger ) ) ) let%test_unit "account creation fee - coinbase" = Test_util.with_randomness 123456789 (fun () -> @@ -402,7 +402,7 @@ let%test_module "Transaction union tests" = List.map (List.init ft_count ~f:Fn.id) ~f:(fun _ -> Coinbase.Fee_transfer.create ~receiver_pk:other.account.public_key - ~fee:constraint_constants.account_creation_fee) + ~fee:constraint_constants.account_creation_fee ) in List.fold ~init:(fts, []) (List.init coinbase_count ~f:Fn.id) ~f:(fun (fts, cbs) _ -> @@ -413,7 +413,7 @@ let%test_module "Transaction union tests" = ~fee_transfer:(List.hd fts) |> Or_error.ok_exn in - (Option.value ~default:[] (List.tl fts), cb :: cbs)) + (Option.value ~default:[] (List.tl fts), cb :: cbs) ) in Ledger.create_new_account_exn ledger (Account.identifier dummy_account.account) @@ -421,7 +421,7 @@ let%test_module "Transaction union tests" = let () = List.iter cbs ~f:(fun cb -> let txn = Mina_transaction.Transaction.Coinbase cb in - test_transaction ~constraint_constants ledger txn) + test_transaction ~constraint_constants ledger txn ) in let fees = fee * ft_count in U.check_balance @@ -430,7 +430,7 @@ let%test_module "Transaction union tests" = ledger ; U.check_balance (Account.identifier other.account) - (fees - account_fee) ledger)) + (fees - account_fee) ledger ) ) module Pc_with_init_stack = struct type t = @@ -451,11 +451,11 @@ let%test_module "Transaction union tests" = Array.iter wallets ~f:(fun { account; private_key = _ } -> Ledger.create_new_account_exn ledger (Account.identifier account) - account) ; + account ) ; let memo = Signed_command_memo.create_by_digesting_string_exn (Test_util.arbitrary_string - ~len:Signed_command_memo.max_digestible_string_length) + ~len:Signed_command_memo.max_digestible_string_length ) in let t1 = U.Wallet.user_command_with_wallet wallets ~sender:0 ~receiver:1 @@ -483,8 +483,8 @@ let%test_module "Transaction union tests" = that these are payments in this test. *) Signed_command.accounts_accessed - (Signed_command.forget_check t)) - [ t1; t2 ]) + (Signed_command.forget_check t) ) + [ t1; t2 ] ) in let init_stack1 = Pending_coinbase.Stack.empty in let pending_coinbase_stack_state1 = @@ -588,12 +588,12 @@ let%test_module "Transaction union tests" = (Sparse_ledger.merkle_root sparse_ledger) ; let proof13 = Async.Thread_safe.block_on_async_exn (fun () -> - U.T.merge ~sok_digest proof12 proof23) + U.T.merge ~sok_digest proof12 proof23 ) |> Or_error.ok_exn in Async.Thread_safe.block_on_async (fun () -> - U.T.verify_against_digest proof13) - |> Result.ok_exn)) + U.T.verify_against_digest proof13 ) + |> Result.ok_exn ) ) let%test "base_and_merge: transactions in one block (t1,t2 in b1), \ carryforward the state from a previous transaction t0 in b1" = @@ -665,12 +665,12 @@ let%test_module "Transaction union tests" = | None -> Signed_command_memo.create_by_digesting_string_exn (Test_util.arbitrary_string - ~len:Signed_command_memo.max_digestible_string_length) + ~len:Signed_command_memo.max_digestible_string_length ) in Array.iter accounts ~f:(fun account -> Ledger.create_new_account_exn ledger (Account.identifier account) - account) ; + account ) ; let get_account aid = Option.bind (Ledger.location_of_account ledger aid) @@ -929,7 +929,8 @@ let%test_module "Transaction union tests" = ~accounts ~signer ~fee ~fee_payer_pk ~fee_token (Stake_delegation (Set_delegate - { delegator = source_pk; new_delegate = receiver_pk })) + { delegator = source_pk; new_delegate = receiver_pk } ) + ) in let fee_payer_account = Option.value_exn fee_payer_account in let source_account = Option.value_exn source_account in @@ -943,7 +944,7 @@ let%test_module "Transaction union tests" = Public_key.Compressed.equal (Option.value_exn source_account.delegate) source_pk ) ; - assert (Option.is_none receiver_account))) + assert (Option.is_none receiver_account) ) ) let%test_unit "delegation delegator does not exist" = Test_util.with_randomness 123456789 (fun () -> @@ -968,7 +969,8 @@ let%test_module "Transaction union tests" = ~accounts ~signer ~fee ~fee_payer_pk ~fee_token (Stake_delegation (Set_delegate - { delegator = source_pk; new_delegate = receiver_pk })) + { delegator = source_pk; new_delegate = receiver_pk } ) + ) in let fee_payer_account = Option.value_exn fee_payer_account in let expected_fee_payer_balance = @@ -978,7 +980,7 @@ let%test_module "Transaction union tests" = Balance.equal fee_payer_account.balance expected_fee_payer_balance ) ; assert (Option.is_none source_account) ; - assert (Option.is_some receiver_account))) + assert (Option.is_some receiver_account) ) ) let%test_unit "timed account - transactions" = Test_util.with_randomness 123456789 (fun () -> @@ -991,7 +993,7 @@ let%test_module "Transaction union tests" = let memo = Signed_command_memo.create_by_digesting_string_exn (Test_util.arbitrary_string - ~len:Signed_command_memo.max_digestible_string_length) + ~len:Signed_command_memo.max_digestible_string_length ) in let balance = Balance.of_int 100_000_000_000_000 in let initial_minimum_balance = Balance.of_int 80_000_000_000_000 in @@ -1026,7 +1028,7 @@ let%test_module "Transaction union tests" = U.Wallet.user_command_with_wallet wallets ~sender:0 ~receiver amount (Fee.of_int txn_fee) nonce memo in - (Account.Nonce.succ nonce, txns @ [ uc ])) + (Account.Nonce.succ nonce, txns @ [ uc ]) ) in Ledger.create_new_account_exn ledger (Account.identifier sender.account) @@ -1034,19 +1036,19 @@ let%test_module "Transaction union tests" = let () = List.iter ucs ~f:(fun uc -> test_transaction ~constraint_constants ~txn_global_slot - ledger (Transaction.Command (Signed_command uc))) + ledger (Transaction.Command (Signed_command uc)) ) in List.iter receivers ~f:(fun receiver -> U.check_balance (Account.identifier receiver.account) ((amount * txns_per_receiver) - account_fee) - ledger) ; + ledger ) ; U.check_balance (Account.identifier sender.account) ( Balance.to_int sender.account.balance - (amount + txn_fee) * txns_per_receiver * List.length receivers ) - ledger)) + ledger ) ) (*TODO: use zkApp transactions for tokens*) (*let%test_unit "create own new token" = @@ -1930,7 +1932,7 @@ let%test_module "Transaction union tests" = let receivers = Array.init 2 ~f:(fun _ -> Public_key.of_private_key_exn (Private_key.create ()) - |> Public_key.compress) + |> Public_key.compress ) in let timed_account pk = let account_id = Account_id.create pk Token_id.default in @@ -1983,12 +1985,12 @@ let%test_module "Transaction union tests" = Ledger.with_ledger ~depth:ledger_depth ~f:(fun ledger -> List.iter [ timed_account1; timed_account2 ] ~f:(fun acc -> Ledger.create_new_account_exn ledger (Account.identifier acc) - acc) ; + acc ) ; (* well over the vesting period, the timing field shouldn't change*) let txn_global_slot = Mina_numbers.Global_slot.of_int 100 in List.iter transactions ~f:(fun txn -> test_transaction ~txn_global_slot ~constraint_constants ledger - txn))) + txn ) ) ) end ) let%test_module "transaction_undos" = @@ -2022,11 +2024,11 @@ let%test_module "transaction_undos" = let account_id = Account_id.create sender_pk Token_id.default in if List.find cmds ~f:(fun cmd -> - Account_id.equal (User_command.fee_payer cmd) account_id) + Account_id.equal (User_command.fee_payer cmd) account_id ) |> Option.is_some then None else if Currency.Amount.(balance >= amount) then Some s - else None) + else None ) in let new_cmds = let source_accounts = @@ -2035,7 +2037,7 @@ let%test_module "transaction_undos" = assert (not (List.is_empty source_accounts)) ; let new_keys = List.init (List.length source_accounts) ~f:(fun _ -> - Signature_lib.Keypair.create ()) + Signature_lib.Keypair.create () ) in List.map (List.zip_exn source_accounts new_keys) ~f:(fun ((s, _, nonce, _), r) -> @@ -2048,7 +2050,7 @@ let%test_module "transaction_undos" = ~body:(Payment { source_pk = sender_pk; receiver_pk; amount }) in let c = Signed_command.sign s payload in - User_command.Signed_command (Signed_command.forget_check c)) + User_command.Signed_command (Signed_command.forget_check c) ) in List.map ~f:(fun c -> Mina_transaction.Transaction.Command c) @@ -2074,7 +2076,7 @@ let%test_module "transaction_undos" = Quickcheck.Generator.list_with_length count (Fee_transfer.Single.Gen.with_random_receivers ~keys:accounts ~max_fee ~min_fee - ~token:(Quickcheck.Generator.return Token_id.default)) + ~token:(Quickcheck.Generator.return Token_id.default) ) in One_or_two.group_list singles |> List.map ~f:(Fn.compose Or_error.ok_exn Fee_transfer.of_singles) @@ -2089,7 +2091,7 @@ let%test_module "transaction_undos" = let keypair, _, _, _ = Array.random_element_exn ledger_init_state in - keypair)) + keypair ) ) remaining in List.map @@ -2102,7 +2104,7 @@ let%test_module "transaction_undos" = let%bind coinbase_new_accounts = Quickcheck.Generator.list_with_length count (Quickcheck.Generator.map ~f:fst - (Coinbase.Gen.gen ~constraint_constants)) + (Coinbase.Gen.gen ~constraint_constants) ) in let%map coinbase_existing_accounts = let remaining = max count (length - count) in @@ -2111,7 +2113,7 @@ let%test_module "transaction_undos" = let keypair, _, _, _ = Array.random_element_exn ledger_init_state in - keypair) + keypair ) in let min_amount = Option.value_exn @@ -2125,7 +2127,7 @@ let%test_module "transaction_undos" = (Coinbase.Gen.with_random_receivers ~keys ~min_amount ~max_amount ~fee_transfer: (Coinbase.Fee_transfer.Gen.with_random_receivers ~keys - ~min_fee:constraint_constants.account_creation_fee)) + ~min_fee:constraint_constants.account_creation_fee ) ) in List.map ~f:(fun c -> Mina_transaction.Transaction.Coinbase c) @@ -2151,13 +2153,13 @@ let%test_module "transaction_undos" = let test_undos ledger transactions = let res = List.fold ~init:[] transactions ~f:(fun acc t -> - test_undo ledger t :: acc) + test_undo ledger t :: acc ) in List.iter res ~f:(fun (root_before, u) -> let () = Ledger.undo ~constraint_constants ledger u |> Or_error.ok_exn in - assert (Ledger_hash.equal (Ledger.merkle_root ledger) root_before)) + assert (Ledger_hash.equal (Ledger.merkle_root ledger) root_before) ) let%test_unit "undo_coinbase" = let gen = @@ -2172,7 +2174,7 @@ let%test_module "transaction_undos" = Ledger.with_ephemeral_ledger ~depth:constraint_constants.ledger_depth ~f:(fun ledger -> Ledger.apply_initial_ledger_state ledger ledger_init_state ; - test_undos ledger coinbase_list)) + test_undos ledger coinbase_list ) ) let%test_unit "undo_fee_transfers" = let gen = @@ -2187,7 +2189,7 @@ let%test_module "transaction_undos" = Ledger.with_ephemeral_ledger ~depth:constraint_constants.ledger_depth ~f:(fun ledger -> Ledger.apply_initial_ledger_state ledger ledger_init_state ; - test_undos ledger ft_list)) + test_undos ledger ft_list ) ) let%test_unit "undo_user_commands" = let gen = @@ -2202,7 +2204,7 @@ let%test_module "transaction_undos" = Ledger.with_ephemeral_ledger ~depth:constraint_constants.ledger_depth ~f:(fun ledger -> Ledger.apply_initial_ledger_state ledger ledger_init_state ; - test_undos ledger cmd_list)) + test_undos ledger cmd_list ) ) let%test_unit "undo_all_txns" = let gen = @@ -2226,5 +2228,5 @@ let%test_module "transaction_undos" = Ledger.with_ephemeral_ledger ~depth:constraint_constants.ledger_depth ~f:(fun ledger -> Ledger.apply_initial_ledger_state ledger ledger_init_state ; - test_undos ledger txn_list)) + test_undos ledger txn_list ) ) end ) diff --git a/src/lib/transaction_snark/test/util.ml b/src/lib/transaction_snark/test/util.ml index f70d17bfee3..18c29b2c16b 100644 --- a/src/lib/transaction_snark/test/util.ml +++ b/src/lib/transaction_snark/test/util.ml @@ -68,7 +68,7 @@ let apply_parties ledger parties = [ ( `Pending_coinbase_init_stack init_stack , `Pending_coinbase_of_statement (pending_coinbase_state_stack - ~state_body_hash:genesis_state_body_hash) + ~state_body_hash:genesis_state_body_hash ) , ps ) ] | ps1 :: ps2 :: rest -> @@ -76,7 +76,7 @@ let apply_parties ledger parties = ( `Pending_coinbase_init_stack init_stack , `Pending_coinbase_of_statement (pending_coinbase_state_stack - ~state_body_hash:genesis_state_body_hash) + ~state_body_hash:genesis_state_body_hash ) , ps1 ) in let pending_coinbase_state_stack = @@ -107,13 +107,13 @@ let apply_parties ledger parties = in let snapp_stmt = Option.value_map ~default:[] snapp_stmt ~f:(fun (i, stmt) -> - [ (i, exists Zkapp_statement.typ ~compute:(fun () -> stmt)) ]) + [ (i, exists Zkapp_statement.typ ~compute:(fun () -> stmt)) ] ) in Transaction_snark.Base.Parties_snark.main ~constraint_constants (Parties_segment.Basic.to_single_list spec) snapp_stmt s ~witness ; - fun () -> ()) - |> Or_error.ok_exn) ; + fun () -> () ) + |> Or_error.ok_exn ) ; final_ledger let trivial_snapp = @@ -135,14 +135,14 @@ let check_parties_with_merges_exn ?expected_failure , `Pending_coinbase_of_statement (pending_coinbase_state_stack ~state_body_hash) , parties ) - ]) + ] ) with | Ok a -> a | Error e -> failwith (sprintf "parties_witnesses_exn failed with %s" - (Error.to_string_hum e)) + (Error.to_string_hum e) ) in let open Async.Deferred.Let_syntax in let%map p = @@ -154,7 +154,7 @@ let check_parties_with_merges_exn ?expected_failure let%bind p1 = Async.Deferred.Or_error.try_with (fun () -> T.of_parties_segment_exn ~statement:stmt ~witness ~spec - ~snapp_statement) + ~snapp_statement ) in Async.Deferred.List.fold ~init:(Ok p1) rest ~f:(fun acc (witness, spec, stmt, snapp_statement) -> @@ -162,14 +162,14 @@ let check_parties_with_merges_exn ?expected_failure let%bind curr = Async.Deferred.Or_error.try_with (fun () -> T.of_parties_segment_exn ~statement:stmt ~witness ~spec - ~snapp_statement) + ~snapp_statement ) in let sok_digest = Sok_message.create ~fee:Fee.zero ~prover:(Quickcheck.random_value Public_key.Compressed.gen) |> Sok_message.digest in - T.merge ~sok_digest prev curr) + T.merge ~sok_digest prev curr ) in let p = Or_error.ok_exn p in let target_ledger_root_snark = @@ -192,7 +192,7 @@ let check_parties_with_merges_exn ?expected_failure !"Application did not fail as expected. Expected \ failure: \ %{sexp:Mina_base.Transaction_status.Failure.t}" - failure) + failure ) | None -> () ) | Failed failure_tbl -> ( @@ -202,7 +202,7 @@ let check_parties_with_merges_exn ?expected_failure (sprintf !"Application failed. Failure statuses: %{sexp: \ Mina_base.Transaction_status.Failure.Collection.t}" - failure_tbl) + failure_tbl ) | Some failure -> let failures = List.concat failure_tbl in assert (not (List.is_empty failures)) ; @@ -211,7 +211,7 @@ let check_parties_with_merges_exn ?expected_failure List.fold failures ~init:false ~f:(fun acc f -> acc || Mina_base.Transaction_status.Failure.( - equal failure f)) + equal failure f) ) in if not failed_as_expected then failwith @@ -221,11 +221,11 @@ let check_parties_with_merges_exn ?expected_failure %{sexp:Mina_base.Transaction_status.Failure.t} \ Failure statuses: %{sexp: \ Mina_base.Transaction_status.Failure.Collection.t}" - failure failure_tbl) ) ) + failure failure_tbl ) ) ) | _ -> failwith "parties expected" ) ; let target_ledger_root = Ledger.merkle_root ledger in - [%test_eq: Ledger_hash.t] target_ledger_root target_ledger_root_snark) + [%test_eq: Ledger_hash.t] target_ledger_root target_ledger_root_snark ) let dummy_rule self : _ Pickles.Inductive_rule.t = let open Tick in @@ -246,7 +246,7 @@ let dummy_rule self : _ Pickles.Inductive_rule.t = Pickles_types.Hlist0.H1 (Pickles_types.Hlist.E01(Pickles.Inductive_rule.B)) .t -> - [ Boolean.true_; Boolean.true_ ]) + [ Boolean.true_; Boolean.true_ ] ) } let gen_snapp_ledger = @@ -256,13 +256,13 @@ let gen_snapp_ledger = let pks = Public_key.Compressed.Set.of_list (List.map (Array.to_list test_spec.init_ledger) ~f:(fun s -> - Public_key.compress (fst s).public_key)) + Public_key.compress (fst s).public_key ) ) in let%map kp = Quickcheck.Generator.filter Keypair.gen ~f:(fun kp -> not (Public_key.Compressed.Set.mem pks - (Public_key.compress kp.public_key))) + (Public_key.compress kp.public_key) ) ) in (test_spec, kp) @@ -281,7 +281,7 @@ let test_snapp_update ?expected_failure ?state_body ?snapp_permissions ~vk ~constraint_constants test_spec in check_parties_with_merges_exn ?expected_failure ?state_body ledger - [ parties ])) + [ parties ] ) ) let permissions_from_update (update : Party.Update.t) ~auth = let default = Permissions.user_default in diff --git a/src/lib/transaction_snark/test/zkapp_deploy/zkapp_deploy.ml b/src/lib/transaction_snark/test/zkapp_deploy/zkapp_deploy.ml index 7925e87fc9c..b900068091e 100644 --- a/src/lib/transaction_snark/test/zkapp_deploy/zkapp_deploy.ml +++ b/src/lib/transaction_snark/test/zkapp_deploy/zkapp_deploy.ml @@ -44,7 +44,7 @@ let%test_module "Snapp deploy tests" = Init_ledger.init (module Ledger.Ledger_inner) init_ledger ledger ; - U.check_parties_with_merges_exn ledger [ parties ]))) + U.check_parties_with_merges_exn ledger [ parties ] ) ) ) let%test_unit "deploy multiple ZkApps" = let open Mina_transaction_logic.For_tests in @@ -87,7 +87,7 @@ let%test_module "Snapp deploy tests" = Init_ledger.init (module Ledger.Ledger_inner) init_ledger ledger ; - U.check_parties_with_merges_exn ledger [ parties ]))) + U.check_parties_with_merges_exn ledger [ parties ] ) ) ) let%test_unit "change a non-snapp account to snapp account/deploy a smart \ contract" = @@ -124,7 +124,7 @@ let%test_module "Snapp deploy tests" = Init_ledger.init (module Ledger.Ledger_inner) init_ledger ledger ; - U.check_parties_with_merges_exn ledger [ parties ]))) + U.check_parties_with_merges_exn ledger [ parties ] ) ) ) let%test_unit "change a non-snapp account to snapp account/deploy a smart \ contract- different fee payer" = @@ -162,7 +162,7 @@ let%test_module "Snapp deploy tests" = Init_ledger.init (module Ledger.Ledger_inner) init_ledger ledger ; - U.check_parties_with_merges_exn ledger [ parties ]))) + U.check_parties_with_merges_exn ledger [ parties ] ) ) ) let%test_unit "Fails to deploy if the account is not present and amount is \ insufficient" = @@ -201,5 +201,5 @@ let%test_module "Snapp deploy tests" = (module Ledger.Ledger_inner) init_ledger ledger ; U.check_parties_with_merges_exn ledger - ~expected_failure:Invalid_fee_excess [ parties ]))) + ~expected_failure:Invalid_fee_excess [ parties ] ) ) ) end ) diff --git a/src/lib/transaction_snark/test/zkapp_payments/zkapp_payments.ml b/src/lib/transaction_snark/test/zkapp_payments/zkapp_payments.ml index 1d8836bee44..49f166439a8 100644 --- a/src/lib/transaction_snark/test/zkapp_payments/zkapp_payments.ml +++ b/src/lib/transaction_snark/test/zkapp_payments/zkapp_payments.ml @@ -39,7 +39,7 @@ let%test_module "Zkapp payments tests" = ; update = { app_state = Pickles_types.Vector.map new_state ~f:(fun x -> - Zkapp_basic.Set_or_keep.Set x) + Zkapp_basic.Set_or_keep.Set x ) ; delegate = Keep ; verification_key = Keep ; permissions = Keep @@ -108,7 +108,7 @@ let%test_module "Zkapp payments tests" = ~f:(fun { account; private_key = _ } -> Ledger.create_new_account_exn ledger (Account.identifier account) - account) ; + account ) ; let t1 = let i, j = (1, 2) in signed_signed ~wallets i j @@ -121,7 +121,7 @@ let%test_module "Zkapp payments tests" = merkle_root_after_parties_exn ledger ~txn_state_view t1 in let hash_post = Ledger.merkle_root ledger in - [%test_eq: Field.t] hash_pre hash_post)) + [%test_eq: Field.t] hash_pre hash_post ) ) let%test_unit "zkapps-based payment" = let open Mina_transaction_logic.For_tests in @@ -131,8 +131,8 @@ let%test_module "Zkapp payments tests" = party_send ~constraint_constants (List.hd_exn specs) in Init_ledger.init (module Ledger.Ledger_inner) init_ledger ledger ; - U.apply_parties ledger [ parties ]) - |> fun _ -> ()) + U.apply_parties ledger [ parties ] ) + |> fun _ -> () ) let%test_unit "Consecutive zkapps-based payments" = let open Mina_transaction_logic.For_tests in @@ -144,11 +144,11 @@ let%test_module "Zkapp payments tests" = let use_full_commitment = Quickcheck.random_value Bool.quickcheck_generator in - party_send ~constraint_constants ~use_full_commitment s) + party_send ~constraint_constants ~use_full_commitment s ) specs in Init_ledger.init (module Ledger.Ledger_inner) init_ledger ledger ; - U.apply_parties ledger partiess |> fun _ -> ())) + U.apply_parties ledger partiess |> fun _ -> () ) ) let%test_unit "multiple transfers from one account" = let open Mina_transaction_logic.For_tests in @@ -170,7 +170,7 @@ let%test_module "Zkapp payments tests" = Option.value_exn (Amount.sub amount (Amount.of_fee - constraint_constants.account_creation_fee)) + constraint_constants.account_creation_fee ) ) in let test_spec : Spec.t = { sender = spec.sender @@ -199,7 +199,7 @@ let%test_module "Zkapp payments tests" = Init_ledger.init (module Ledger.Ledger_inner) init_ledger ledger ; - U.check_parties_with_merges_exn ledger [ parties ]))) + U.check_parties_with_merges_exn ledger [ parties ] ) ) ) let%test_unit "zkapps payments failed due to insufficient funds" = let open Mina_transaction_logic.For_tests in @@ -266,5 +266,5 @@ let%test_module "Zkapp payments tests" = in U.check_parties_with_merges_exn ~expected_failure:Transaction_status.Failure.Overflow ledger - [ parties ]))) + [ parties ] ) ) ) end ) diff --git a/src/lib/transaction_snark/test/zkapps_examples/empty_update/empty_update.ml b/src/lib/transaction_snark/test/zkapps_examples/empty_update/empty_update.ml index b5ee36d9e94..636e9b19280 100644 --- a/src/lib/transaction_snark/test/zkapps_examples/empty_update/empty_update.ml +++ b/src/lib/transaction_snark/test/zkapps_examples/empty_update/empty_update.ml @@ -27,9 +27,9 @@ let tag, _, p_module, Pickles.Provers.[ prover; _ ] = ~name:"empty_update" ~constraint_constants: (Genesis_constants.Constraint_constants.to_snark_keys_header - constraint_constants) + constraint_constants ) ~choices:(fun ~self -> - [ Zkapps_empty_update.rule pk_compressed; dummy_rule self ]) + [ Zkapps_empty_update.rule pk_compressed; dummy_rule self ] ) module P = (val p_module) @@ -43,7 +43,7 @@ let party_proof = prover [] { transaction = Party.Body.digest party_body ; at_party = Parties.Call_forest.empty - }) + } ) let party : Party.t = { body = party_body; authorization = Proof party_proof } @@ -124,7 +124,7 @@ let sign_all ({ fee_payer; other_parties; memo } : Parties.t) : Parties.t = | ({ body = { public_key; use_full_commitment; _ } ; authorization = Signature _ } as party : - Party.t) + Party.t ) when Public_key.Compressed.equal public_key pk_compressed -> let commitment = if use_full_commitment then full_commitment @@ -134,10 +134,10 @@ let sign_all ({ fee_payer; other_parties; memo } : Parties.t) : Parties.t = authorization = Control.Signature (Schnorr.Chunked.sign sk - (Random_oracle.Input.Chunked.field commitment)) + (Random_oracle.Input.Chunked.field commitment) ) } | party -> - party) + party ) in { fee_payer; other_parties; memo } @@ -157,6 +157,6 @@ let () = Ledger.get_or_create_account ledger account_id (Account.create account_id Currency.Balance.( - Option.value_exn (add_amount zero (Currency.Amount.of_int 500)))) + Option.value_exn (add_amount zero (Currency.Amount.of_int 500))) ) in - ignore (apply_parties ledger [ parties ] : Sparse_ledger.t)) + ignore (apply_parties ledger [ parties ] : Sparse_ledger.t) ) diff --git a/src/lib/transaction_snark/test/zkapps_examples/initialize_state/initialize_state.ml b/src/lib/transaction_snark/test/zkapps_examples/initialize_state/initialize_state.ml index f100ada0884..db52b1338fe 100644 --- a/src/lib/transaction_snark/test/zkapps_examples/initialize_state/initialize_state.ml +++ b/src/lib/transaction_snark/test/zkapps_examples/initialize_state/initialize_state.ml @@ -34,12 +34,12 @@ let%test_module "Initialize state test" = ~name:"empty_update" ~constraint_constants: (Genesis_constants.Constraint_constants.to_snark_keys_header - constraint_constants) + constraint_constants ) ~choices:(fun ~self -> [ Zkapps_initialize_state.initialize_rule pk_compressed ; Zkapps_initialize_state.update_state_rule pk_compressed ; dummy_rule self - ]) + ] ) module P = (val p_module) @@ -93,7 +93,7 @@ let%test_module "Initialize state test" = initialize_prover [] { transaction = Party.Body.digest party_body ; at_party = Parties.Call_forest.empty - }) + } ) let party : Party.t = { body = party_body; authorization = Proof party_proof } @@ -113,7 +113,7 @@ let%test_module "Initialize state test" = [] { transaction = Party.Body.digest party_body ; at_party = Parties.Call_forest.empty - }) + } ) let party : Party.t = { body = party_body; authorization = Proof party_proof } @@ -151,7 +151,7 @@ let%test_module "Initialize state test" = ~memo_hash ~fee_payer_hash: (Parties.Call_forest.Digest.Party.create - (Party.of_fee_payer fee_payer)) + (Party.of_fee_payer fee_payer) ) in let sign_all ({ fee_payer; other_parties; memo } : Parties.t) : Parties.t = @@ -172,7 +172,7 @@ let%test_module "Initialize state test" = | ({ body = { public_key; use_full_commitment; _ } ; authorization = Signature _ } as party : - Party.t) + Party.t ) when Public_key.Compressed.equal public_key pk_compressed -> let commitment = if use_full_commitment then full_commitment @@ -182,10 +182,10 @@ let%test_module "Initialize state test" = authorization = Signature (Schnorr.Chunked.sign sk - (Random_oracle.Input.Chunked.field commitment)) + (Random_oracle.Input.Chunked.field commitment) ) } | party -> - party) + party ) in { fee_payer; other_parties; memo } in @@ -203,8 +203,8 @@ let%test_module "Initialize state test" = |> Or_error.ok_exn in Async.Thread_safe.block_on_async_exn (fun () -> - check_parties_with_merges_exn ?expected_failure ledger [ parties ]) ; - Ledger.get ledger loc) + check_parties_with_merges_exn ?expected_failure ledger [ parties ] ) ; + Ledger.get ledger loc ) let%test_unit "Initialize" = let account = @@ -279,7 +279,7 @@ let%test_module "Initialize state test" = (* Raises an exception due to verifying a proof without a valid vk in the account. *) - test_parties [ Initialize_party.party; Update_state_party.party ]) + test_parties [ Initialize_party.party; Update_state_party.party ] ) in assert (Or_error.is_error account) end ) diff --git a/src/lib/transaction_snark/transaction_snark.ml b/src/lib/transaction_snark/transaction_snark.ml index a7bd2e3d6e8..3b3a0b45ad0 100644 --- a/src/lib/transaction_snark/transaction_snark.ml +++ b/src/lib/transaction_snark/transaction_snark.ml @@ -328,7 +328,7 @@ module Statement = struct Or_error.errorf !"%s is inconsistent between transitions (%{sexp: t} vs \ %{sexp: t})" - (Field.name f) x1 x2) + (Field.name f) x1 x2 ) f in let module PC = struct @@ -726,7 +726,7 @@ module Base = struct let open Mina_base in Transaction_status.Failure.equal (Mina_transaction_logic - .timing_error_to_user_command_status err) + .timing_error_to_user_command_status err ) Transaction_status.Failure .Source_minimum_balance_violation in @@ -908,7 +908,7 @@ module Base = struct ~max_proofs_verified: (module Pickles.Side_loaded.Verification_key.Max_width) ~value_to_field_elements:to_field_elements - ~var_to_field_elements:Checked.to_field_elements) + ~var_to_field_elements:Checked.to_field_elements ) let signature_verifies ~shifted ~payload_digest signature pk = let%bind pk = @@ -943,7 +943,7 @@ module Base = struct let if_ b ~then_ ~else_ = create (fun () -> - get (if Impl.As_prover.read Boolean.typ b then then_ else else_)) + get (if Impl.As_prover.read Boolean.typ b then then_ else else_) ) let map t ~f = create (fun () -> f (get t)) end @@ -964,7 +964,7 @@ module Base = struct let l = Field.if_ b ~then_:h ~else_:acc and r = Field.if_ b ~then_:acc ~else_:h in let acc' = Ledger_hash.merge_var ~height l r in - acc') + acc' ) module type Single_inputs = sig val constraint_constants : Genesis_constants.Constraint_constants.t @@ -1166,7 +1166,7 @@ module Base = struct , As_prover.Ref.create (fun () -> None) ) } in - run_checked (Account.Checked.digest a))) + run_checked (Account.Checked.digest a) ) ) type timing = Account_timing.var @@ -1194,7 +1194,7 @@ module Base = struct run_checked @@ [%with_label "Check zkapp timing"] (check_timing ~balance_check ~timed_balance_check ~account - ~txn_amount:None ~txn_global_slot) + ~txn_amount:None ~txn_global_slot ) in (`Invalid_timing (Option.value_exn !invalid_timing), timing) @@ -1282,7 +1282,7 @@ module Base = struct let or_exn x = with_label "or_exn is_some" (fun () -> - Bool.Assert.is_true (is_some x)) ; + Bool.Assert.is_true (is_some x) ) ; Flagged_option.data x end @@ -1314,13 +1314,13 @@ module Base = struct with_label "Parties.pop_exn" (fun () -> let hd_r = V.create (fun () -> - V.get r |> List.hd_exn |> With_stack_hash.elt) + V.get r |> List.hd_exn |> With_stack_hash.elt ) in let party = V.create (fun () -> (V.get hd_r).party |> fst) in let auth = V.(create (fun () -> (V.get party).authorization)) in let party = exists (Party.Body.typ ()) ~compute:(fun () -> - (V.get party).body) + (V.get party).body ) in let party = With_hash.of_data party @@ -1330,13 +1330,13 @@ module Base = struct let subforest = V.create (fun () -> (V.get hd_r).calls) in let subforest_hash = exists Parties.Digest.Forest.typ ~compute:(fun () -> - Parties.Call_forest.hash (V.get subforest)) + Parties.Call_forest.hash (V.get subforest) ) in { hash = subforest_hash; data = subforest } in let tl_hash = exists Parties.Digest.Forest.typ ~compute:(fun () -> - V.get r |> List.tl_exn |> Parties.Call_forest.hash) + V.get r |> List.tl_exn |> Parties.Call_forest.hash ) in let tree_hash = Parties.Digest.Tree.Checked.create ~party:party.hash @@ -1350,7 +1350,7 @@ module Base = struct , { hash = tl_hash ; data = V.(create (fun () -> List.tl_exn (get r))) } ) - : (party * t) * t )) + : (party * t) * t ) ) end module Stack_frame = struct @@ -1362,7 +1362,7 @@ module Base = struct { With_hash.hash = lazy (Stack_frame.Digest.Checked.if_ b ~then_:(Lazy.force t1.hash) - ~else_:(Lazy.force t2.hash)) + ~else_:(Lazy.force t2.hash) ) ; data = Stack_frame.Checked.if_ Parties.if_ b ~then_:t1.data ~else_:t2.data @@ -1380,7 +1380,7 @@ module Base = struct lazy (Stack_frame.Digest.Checked.create ~hash_parties:(fun (calls : Parties.t) -> calls.hash) - frame) + frame ) } let make ~caller ~caller_caller ~calls : t = @@ -1393,28 +1393,28 @@ module Base = struct ( Mina_base.Token_id.Stable.V1.t , unit Mina_base.Parties.Call_forest.With_hashes.Stable.V1.t ) Stack_frame.Stable.V1.t - V.t) : t = + V.t ) : t = with_label "unhash" (fun () -> let frame : frame = { caller = exists Token_id.typ ~compute:(fun () -> - (V.get frame).caller) + (V.get frame).caller ) ; caller_caller = exists Token_id.typ ~compute:(fun () -> - (V.get frame).caller_caller) + (V.get frame).caller_caller ) ; calls = { hash = exists Mina_base.Parties.Digest.Forest.typ ~compute:(fun () -> (V.get frame).calls - |> Mina_base.Parties.Call_forest.hash) + |> Mina_base.Parties.Call_forest.hash ) ; data = V.map frame ~f:(fun frame -> frame.calls) } } in let t = of_frame frame in Stack_frame.Digest.Checked.Assert.equal (hash (of_frame frame)) h ; - t) + t ) end module Call_stack = struct @@ -1444,7 +1444,7 @@ module Base = struct ; caller_caller = Mina_base.Token_id.default ; calls = [] } - : Value.frame )) + : Value.frame ) ) end let hash (type a) (xs : (a, Call_stack_digest.t) With_stack_hash.t list) @@ -1475,15 +1475,15 @@ module Base = struct { hash = exists Mina_base.Parties.Digest.Forest.typ ~compute:(fun () -> (V.get elt_ref).data.calls - |> Mina_base.Parties.Call_forest.hash) + |> Mina_base.Parties.Call_forest.hash ) ; data = V.map elt_ref ~f:(fun frame -> frame.data.calls) } and caller = exists Mina_base.Token_id.typ ~compute:(fun () -> - (V.get elt_ref).data.caller) + (V.get elt_ref).data.caller ) and caller_caller = exists Mina_base.Token_id.typ ~compute:(fun () -> - (V.get elt_ref).data.caller_caller) + (V.get elt_ref).data.caller_caller ) in { caller; caller_caller; calls } in @@ -1500,7 +1500,7 @@ module Base = struct Call_stack_digest.Checked.cons (Stack_frame.hash elt) stack in with_label __LOC__ (fun () -> - Call_stack_digest.Checked.Assert.equal h h') ; + Call_stack_digest.Checked.Assert.equal h h' ) ; (elt, { hash = stack; data = tl_r }) let pop ({ hash = h; data = r } as t : t) : (elt * t) Opt.t = @@ -1511,7 +1511,7 @@ module Base = struct | None -> Elt.default () | Some x -> - x.elt) + x.elt ) in let tl_r = V.create (fun () -> V.get r |> List.tl |> Option.value ~default:[]) @@ -1524,7 +1524,7 @@ module Base = struct let h' = Call_stack_digest.Checked.cons stack_frame_hash stack in with_label __LOC__ (fun () -> Boolean.Assert.any - [ input_is_empty; Call_stack_digest.Checked.equal h h' ]) ; + [ input_is_empty; Call_stack_digest.Checked.equal h h' ] ) ; { is_some = Boolean.not input_is_empty ; data = (elt, { hash = stack; data = tl_r }) } @@ -1552,7 +1552,7 @@ module Base = struct As_prover.read Call_stack_digest.typ h ; elt = hd } - :: tl) + :: tl ) in { hash = h; data = r } end @@ -1664,15 +1664,15 @@ module Base = struct exists Side_loaded_verification_key.typ ~compute:(fun () -> Option.value_exn (As_prover.Ref.get - (Data_as_hash.ref a.zkapp.verification_key.data)) - .data) + (Data_as_hash.ref a.zkapp.verification_key.data) ) + .data ) in let expected_hash = Data_as_hash.hash a.zkapp.verification_key.data in let actual_hash = Zkapp_account.Checked.digest_vk vk in Field.Assert.equal expected_hash actual_hash ; - Pickles.Side_loaded.in_circuit (side_loaded tag) vk) + Pickles.Side_loaded.in_circuit (side_loaded tag) vk ) end module Controller = struct @@ -1717,7 +1717,7 @@ module Base = struct let idx = V.map ledger ~f:(fun l -> idx l (body_id party.data)) in let account = exists Mina_base.Account.Checked.Unhashed.typ ~compute:(fun () -> - Sparse_ledger.get_exn (V.get ledger) (V.get idx)) + Sparse_ledger.get_exn (V.get ledger) (V.get idx) ) in let account = Account.account_with_hash account in let incl = @@ -1733,7 +1733,7 @@ module Base = struct | `Left h -> (false, h) | `Right h -> - (true, h))) + (true, h) ) ) in (account, incl) @@ -1754,7 +1754,7 @@ module Base = struct with_label __LOC__ (fun () -> Field.Assert.equal (implied_root account incl) - (Ledger_hash.var_to_hash_packed root)) + (Ledger_hash.var_to_hash_packed root) ) let check_account public_key token_id (({ data = account; _ }, _) : Account.t * _) = @@ -1762,18 +1762,18 @@ module Base = struct run_checked (Signature_lib.Public_key.Compressed.Checked.equal account.public_key - Signature_lib.Public_key.Compressed.(var_of_t empty)) + Signature_lib.Public_key.Compressed.(var_of_t empty) ) in with_label __LOC__ (fun () -> Boolean.Assert.any [ is_new ; run_checked (Signature_lib.Public_key.Compressed.Checked.equal - public_key account.public_key) - ]) ; + public_key account.public_key ) + ] ) ; with_label __LOC__ (fun () -> Boolean.Assert.any - [ is_new; Token_id.equal token_id account.token_id ]) ; + [ is_new; Token_id.equal token_id account.token_id ] ) ; `Is_new is_new end @@ -1814,7 +1814,7 @@ module Base = struct { transaction = commitment ; at_party = (at_party :> Field.t) } - s) ; + s ) ; Boolean.true_ | (Signature | None_given), None -> Boolean.false_ @@ -1835,7 +1835,7 @@ module Base = struct | None_given -> Signature.dummy | Proof _ -> - assert false) + assert false ) in run_checked (let%bind (module S) = @@ -1844,7 +1844,7 @@ module Base = struct signature_verifies ~shifted:(module S) ~payload_digest:commitment signature - party.data.public_key) + party.data.public_key ) in ( `Proof_verifies proof_verifies , `Signature_verifies signature_verifies ) @@ -2002,7 +2002,7 @@ module Base = struct Boolean.(equal_source ||| equal_source_with_state) in Boolean.Assert.all - [ correct_coinbase_target_stack; valid_init_state ])) + [ correct_coinbase_target_stack; valid_init_state ] ) ) let main ?(witness : Witness.t option) (spec : Spec.t) ~constraint_constants snapp_statements (statement : Statement.With_sok.Checked.t) = @@ -2015,7 +2015,7 @@ module Base = struct in let pending_coinbase_stack_init = exists Pending_coinbase.Stack.typ ~compute:(fun () -> - !witness.init_stack) + !witness.init_stack ) in let module V = Prover_value in run_checked @@ -2023,7 +2023,7 @@ module Base = struct ~pending_coinbase_stack_before: statement.source.pending_coinbase_stack ~pending_coinbase_stack_after:statement.target.pending_coinbase_stack - state_body) ; + state_body ) ; let init : Global_state.t * _ Mina_transaction_logic.Parties_logic.Local_state.t = @@ -2091,11 +2091,11 @@ module Base = struct [] | `Start p -> Parties.parties p.parties - |> Parties.Call_forest.map ~f:(fun party -> (party, ()))) + |> Parties.Call_forest.map ~f:(fun party -> (party, ())) ) in let h = exists Parties.Digest.Forest.typ ~compute:(fun () -> - Parties.Call_forest.hash (V.get ps)) + Parties.Call_forest.hash (V.get ps) ) in let start_data = { Mina_transaction_logic.Parties_logic.Start_data.parties = @@ -2106,7 +2106,7 @@ module Base = struct | `Skip -> Field.Constant.zero | `Start p -> - p.memo_hash) + p.memo_hash ) } in let global_state, local_state = @@ -2121,7 +2121,7 @@ module Base = struct | `Compute_in_circuit -> `Compute start_data ) S.{ perform } - acc) + acc ) in (* replace any transaction failure with unit value *) (global_state, { local_state with failure_status_tbl = () }) @@ -2149,23 +2149,23 @@ module Base = struct if should_pop then ( As_prover.Ref.set start_parties ps ; `Start p ) - else `Skip) + else `Skip ) |> finish | `Yes -> as_prover (fun () -> assert ( Mina_base.Parties.Call_forest.is_empty - (V.get local.stack_frame.data.calls.data) )) ; + (V.get local.stack_frame.data.calls.data) ) ) ; V.create (fun () -> match As_prover.Ref.get start_parties with | [] -> assert false | p :: ps -> As_prover.Ref.set start_parties ps ; - `Start p) + `Start p ) |> finish in - (acc', statements)) + (acc', statements) ) in with_label __LOC__ (fun () -> assert (List.is_empty snapp_statements)) ; let local_state_ledger = @@ -2185,15 +2185,15 @@ module Base = struct stack_frame = local_state_ledger ; call_stack = local.call_stack.hash ; ledger = fst local.ledger - }) ; + } ) ; with_label __LOC__ (fun () -> run_checked (Frozen_ledger_hash.assert_equal (fst global.ledger) - statement.target.ledger)) ; + statement.target.ledger ) ) ; with_label __LOC__ (fun () -> run_checked (Amount.Checked.assert_equal statement.supply_increase - Amount.(var_of_t zero))) ; + Amount.(var_of_t zero) ) ) ; with_label __LOC__ (fun () -> run_checked (let expected = statement.fee_excess in @@ -2205,7 +2205,7 @@ module Base = struct Amount.Signed.Checked.to_fee (fst init).fee_excess } in - Fee_excess.assert_equal_checked expected got)) ; + Fee_excess.assert_equal_checked expected got ) ) ; let `Needs_some_work_for_zkapps_on_mainnet = Mina_base.Util.todo_zkapps in (* TODO: Check various consistency equalities between local and global and the statement *) () @@ -2244,7 +2244,7 @@ module Base = struct main ?witness:!witness s ~constraint_constants (List.mapi [ snapp_statement ] ~f:(fun i x -> (i, x))) stmt ; - [ b ]) + [ b ] ) } | Opt_signed_opt_signed -> { identifier = "opt_signed-opt_signed" @@ -2253,7 +2253,7 @@ module Base = struct ; main = (fun [] stmt -> main ?witness:!witness s ~constraint_constants [] stmt ; - []) + [] ) } | Opt_signed -> { identifier = "opt_signed" @@ -2262,7 +2262,7 @@ module Base = struct ; main = (fun [] stmt -> main ?witness:!witness s ~constraint_constants [] stmt ; - []) + [] ) } end @@ -2290,7 +2290,7 @@ module Base = struct [%with_label "Fee-payer must sign the transaction"] ((* TODO: Enable multi-sig. *) Public_key.Compressed.Checked.Assert.equal signer_pk - payload.common.fee_payer_pk) + payload.common.fee_payer_pk ) in (* Compute transaction kind. *) let is_payment = Transaction_union.Tag.Unpacked.is_payment tag in @@ -2306,24 +2306,24 @@ module Base = struct let fee_token = payload.common.fee_token in let%bind fee_token_default = make_checked (fun () -> - Token_id.(Checked.equal fee_token (Checked.constant default))) + Token_id.(Checked.equal fee_token (Checked.constant default)) ) in let token = payload.body.token_id in let%bind token_default = make_checked (fun () -> - Token_id.(Checked.equal token (Checked.constant default))) + Token_id.(Checked.equal token (Checked.constant default)) ) in let%bind () = Checked.all_unit [ [%with_label "Token_locked value is compatible with the transaction kind"] (Boolean.Assert.any - [ Boolean.not payload.body.token_locked; is_create_account ]) + [ Boolean.not payload.body.token_locked; is_create_account ] ) ; [%with_label "Token_locked cannot be used with the default token"] (Boolean.Assert.any [ Boolean.not payload.body.token_locked ; Boolean.not token_default - ]) + ] ) ] in let%bind () = Boolean.Assert.is_true token_default in @@ -2337,7 +2337,7 @@ module Base = struct ; is_payment ; is_stake_delegation ; is_fee_transfer - ]) + ] ) ; (* TODO: Remove this check and update the transaction snark once we have an exchange rate mechanism. See issue #4447. *) @@ -2352,7 +2352,7 @@ module Base = struct ; is_fee_transfer ; is_coinbase ]) - ]) + ] ) in let current_global_slot = Mina_state.Protocol_state.Body.consensus_state state_body @@ -2448,7 +2448,7 @@ module Base = struct in [%with_label "target stack and valid init state"] (Boolean.Assert.all - [ correct_coinbase_target_stack; valid_init_state ]))) + [ correct_coinbase_target_stack; valid_init_state ] ) ) ) in (* Interrogate failure cases. This value is created without constraints; the failures should be checked against potential failures to ensure @@ -2481,7 +2481,7 @@ module Base = struct assert_r1cs (predicate_failed :> Field.Var.t) (is_user_command :> Field.Var.t) - (user_command_failure.predicate_failed :> Field.Var.t)) + (user_command_failure.predicate_failed :> Field.Var.t) ) in let account_creation_amount = Amount.Checked.of_fee @@ -2524,7 +2524,7 @@ module Base = struct Account.Nonce.Checked.equal nonce account.nonce in Boolean.Assert.any - [ Boolean.not is_user_command; nonce_matches ]) + [ Boolean.not is_user_command; nonce_matches ] ) in let%bind receipt_chain_hash = let current = account.receipt_chain_hash in @@ -2569,7 +2569,7 @@ module Base = struct Amount.Signed.create_var ~magnitude ~sgn:Sgn.Checked.neg in Amount.Signed.Checked.( - add fee_payer_amount account_creation_fee)) + add fee_payer_amount account_creation_fee) ) in let txn_global_slot = current_global_slot in let%bind `Min_balance _, timing = @@ -2591,7 +2591,7 @@ module Base = struct (Boolean.Assert.is_true ok) in check_timing ~balance_check ~timed_balance_check ~account - ~txn_amount:(Some txn_amount) ~txn_global_slot) + ~txn_amount:(Some txn_amount) ~txn_global_slot ) in let%bind balance = [%with_label "Check payer balance"] @@ -2605,7 +2605,7 @@ module Base = struct make_checked (fun () -> Token_id.Checked.if_ is_empty_and_writeable ~then_:(Account_id.Checked.token_id fee_payer) - ~else_:account.token_id) + ~else_:account.token_id ) and delegate = Public_key.Compressed.Checked.if_ is_empty_and_writeable ~then_:(Account_id.Checked.public_key fee_payer) @@ -2624,7 +2624,7 @@ module Base = struct ; permissions = account.permissions ; zkapp = account.zkapp ; zkapp_uri = account.zkapp_uri - })) + } ) ) in let%bind receiver_increase = (* - payments: payload.body.amount @@ -2649,7 +2649,7 @@ module Base = struct ~then_:(Amount.Checked.of_fee fee) ~else_:(Amount.var_of_t Amount.zero) in - Amount.Checked.sub base_amount coinbase_receiver_fee) + Amount.Checked.sub base_amount coinbase_receiver_fee ) in let receiver_overflow = ref Boolean.false_ in let%bind root_after_receiver_update = @@ -2674,7 +2674,7 @@ module Base = struct let%bind () = [%with_label "Receiver existence failure matches predicted"] (Boolean.Assert.( = ) is_empty_failure - user_command_failure.receiver_not_present) + user_command_failure.receiver_not_present ) in let is_empty_and_writeable = (* is_empty_and_writable && not is_empty_failure *) @@ -2708,11 +2708,11 @@ module Base = struct transfers. *) Boolean.Assert.( = ) token_should_not_create - token_cannot_create) + token_cannot_create ) in [%with_label "equal token_cannot_create"] (Boolean.Assert.( = ) token_cannot_create - user_command_failure.token_cannot_create)) + user_command_failure.token_cannot_create ) ) in let%bind balance = (* [receiver_increase] will be zero in the stake delegation @@ -2732,7 +2732,7 @@ module Base = struct [%with_label "Receiver creation fee failure matches predicted"] (Boolean.Assert.( = ) underflow - user_command_failure.amount_insufficient_to_create) + user_command_failure.amount_insufficient_to_create ) in Currency.Amount.Checked.if_ user_command_fails ~then_:Amount.(var_of_t zero) @@ -2787,7 +2787,7 @@ module Base = struct and token_id = make_checked (fun () -> Token_id.Checked.if_ is_empty_and_writeable ~then_:token - ~else_:account.token_id) + ~else_:account.token_id ) and token_owner = (* TODO: Delete token permissions *) Boolean.if_ is_empty_and_writeable ~then_:Boolean.false_ @@ -2811,7 +2811,7 @@ module Base = struct ; permissions = account.permissions ; zkapp = account.zkapp ; zkapp_uri = account.zkapp_uri - })) + } ) ) in let%bind user_command_fails = Boolean.(!receiver_overflow ||| user_command_fails) @@ -2836,7 +2836,7 @@ module Base = struct let%bind () = [%with_label "Check source presence failure matches predicted"] (Boolean.Assert.( = ) is_empty_and_writeable - user_command_failure.source_not_present) + user_command_failure.source_not_present ) in let%bind () = [%with_label @@ -2859,7 +2859,7 @@ module Base = struct *) [%with_label "Check num_failures"] (assert_r1cs not_fee_payer_is_source num_failures - num_failures)) + num_failures ) ) in let%bind amount = (* Only payments should affect the balance at this stage. *) @@ -2874,7 +2874,7 @@ module Base = struct "Check source balance failure matches predicted"] (Boolean.Assert.( = ) ok (Boolean.not - user_command_failure.source_insufficient_balance)) + user_command_failure.source_insufficient_balance ) ) in let timed_balance_check ok = [%with_label @@ -2887,10 +2887,10 @@ module Base = struct .source_insufficient_balance) in Boolean.Assert.( = ) not_ok - user_command_failure.source_bad_timing) + user_command_failure.source_bad_timing ) in check_timing ~balance_check ~timed_balance_check ~account - ~txn_amount:(Some amount) ~txn_global_slot) + ~txn_amount:(Some amount) ~txn_global_slot ) in let%bind balance, `Underflow underflow = Balance.Checked.sub_amount_flagged account.balance amount @@ -2901,7 +2901,7 @@ module Base = struct *) [%with_label "Check source balance failure matches predicted"] (Boolean.Assert.( = ) underflow - user_command_failure.source_insufficient_balance) + user_command_failure.source_insufficient_balance ) in let%map delegate = Public_key.Compressed.Checked.if_ is_stake_delegation @@ -2925,7 +2925,7 @@ module Base = struct ; permissions = account.permissions ; zkapp = account.zkapp ; zkapp_uri = account.zkapp_uri - })) + } ) ) in let%bind fee_excess = (* - payments: payload.common.fee @@ -2957,7 +2957,7 @@ module Base = struct [ not is_fee_transfer; not fee_transfer_excess_overflowed ]) in Signed.Checked.if_ is_fee_transfer ~then_:fee_transfer_excess - ~else_:user_command_excess) + ~else_:user_command_excess ) in let%bind supply_increase = Amount.Checked.if_ is_coinbase ~then_:payload.body.amount @@ -3031,7 +3031,7 @@ module Base = struct make_checked (fun () -> Token_id.Checked.if_ fee_excess_zero ~then_:Token_id.(Checked.constant default) - ~else_:t.payload.common.fee_token) + ~else_:t.payload.common.fee_token ) in { Fee_excess.fee_token_l ; fee_excess_l = Amount.Signed.Checked.to_fee fee_excess @@ -3043,14 +3043,14 @@ module Base = struct [%with_label "local state check"] (make_checked (fun () -> Local_state.Checked.assert_equal statement.source.local_state - statement.target.local_state)) + statement.target.local_state ) ) in Checked.all_unit [ [%with_label "equal roots"] (Frozen_ledger_hash.assert_equal root_after statement.target.ledger) ; [%with_label "equal supply_increases"] (Currency.Amount.Checked.assert_equal supply_increase - statement.supply_increase) + statement.supply_increase ) ; [%with_label "equal fee excesses"] (Fee_excess.assert_equal_checked fee_excess statement.fee_excess) ] @@ -3061,7 +3061,7 @@ module Base = struct ; main = (fun [] x -> Run.run_checked (main ~constraint_constants x) ; - []) + [] ) ; main_value = (fun [] _ -> []) } @@ -3105,7 +3105,7 @@ module Merge = struct let%snarkydef main ([ s1; s2 ] : (Statement.With_sok.var * (Statement.With_sok.var * _)) - Pickles_types.Hlist.HlistId.t) (s : Statement.With_sok.Checked.t) = + Pickles_types.Hlist.HlistId.t ) (s : Statement.With_sok.Checked.t) = let%bind fee_excess = Fee_excess.combine_checked s1.Statement.fee_excess s2.Statement.fee_excess in @@ -3120,7 +3120,7 @@ module Merge = struct ( s2.source.pending_coinbase_stack , s2.target.pending_coinbase_stack ) in - Boolean.Assert.is_true valid_pending_coinbase_stack_transition) + Boolean.Assert.is_true valid_pending_coinbase_stack_transition ) in let%bind supply_increase = Amount.Checked.add s1.supply_increase s2.supply_increase @@ -3130,7 +3130,7 @@ module Merge = struct Local_state.Checked.assert_equal s.source.local_state s1.source.local_state ; Local_state.Checked.assert_equal s.target.local_state - s2.target.local_state) + s2.target.local_state ) in Checked.all_unit [ [%with_label "equal fee excesses"] @@ -3159,7 +3159,7 @@ module Merge = struct ; main = (fun ps x -> Run.run_checked (main ps x) ; - [ b; b ]) + [ b; b ] ) ; main_value = (fun _ _ -> [ prev_should_verify; prev_should_verify ]) } end @@ -3191,7 +3191,7 @@ let system ~proof_level ~constraint_constants = ~name:"transaction-snark" ~constraint_constants: (Genesis_constants.Constraint_constants.to_snark_keys_header - constraint_constants) + constraint_constants ) ~choices:(fun ~self -> let parties x = Base.Parties_snark.rule ~constraint_constants ~proof_level x @@ -3201,7 +3201,7 @@ let system ~proof_level ~constraint_constants = ; parties Opt_signed_opt_signed ; parties Opt_signed ; parties Proved - ])) + ] ) ) module Verification = struct module type S = sig @@ -3282,8 +3282,8 @@ let check_transaction_union ?(preeval = false) ~constraint_constants sok_message (let open Checked in exists Statement.With_sok.typ ~compute:(As_prover.return statement) - >>= Base.main ~constraint_constants)) - handler)) + >>= Base.main ~constraint_constants) ) + handler ) ) : unit ) let check_transaction ?preeval ~constraint_constants ~sok_message ~source @@ -3363,7 +3363,7 @@ let verify (ts : (t * _) list) ~key = List.for_all ts ~f:(fun ({ statement; _ }, message) -> Sok_message.Digest.equal (Sok_message.digest message) - statement.sok_digest) + statement.sok_digest ) then Pickles.verify (module Nat.N2) @@ -3382,7 +3382,7 @@ let constraint_system_digests ~constraint_constants () = let open Tick in let%bind x1 = exists Statement.With_sok.typ in let%bind x2 = exists Statement.With_sok.typ in - main [ x1; x2 ] x)) ) + main [ x1; x2 ] x )) ) ; ( "transaction-base" , digest Base.( @@ -3497,7 +3497,7 @@ let group_by_parties_rev (partiess : Party.t list list) ~before ~after :: acc ) | ( (({ authorization = a1; _ } as p) - :: ({ authorization = Proof _; _ } :: _ as parties)) + :: ({ authorization = Proof _; _ } :: _ as parties) ) :: partiess , (before :: (after :: _ as stmts)) :: stmtss ) -> (* The next party contains a proof, don't pair it with this party. *) @@ -3518,7 +3518,7 @@ let group_by_parties_rev (partiess : Party.t list list) ~before ~after :: acc ) | ( (({ authorization = (Signature _ | None_given) as a1; _ } as p) - :: { authorization = (Signature _ | None_given) as a2; _ } :: parties) + :: { authorization = (Signature _ | None_given) as a2; _ } :: parties ) :: partiess , (before :: _ :: (after :: _ as stmts)) :: stmtss ) -> (* The next two parties do not contain proofs, and are within the same @@ -3533,7 +3533,7 @@ let group_by_parties_rev (partiess : Party.t list list) :: acc ) | ( [] :: (({ authorization = a1; _ } as p) - :: ({ authorization = Proof _; _ } :: _ as parties)) + :: ({ authorization = Proof _; _ } :: _ as parties) ) :: partiess , [ _ ] :: (before :: (after :: _ as stmts)) :: stmtss ) -> (* This party is in the next transaction, and the next party contains a @@ -3546,7 +3546,8 @@ let group_by_parties_rev (partiess : Party.t list list) :: acc ) | ( [] :: (({ authorization = (Signature _ | None_given) as a1; _ } as p) - :: { authorization = (Signature _ | None_given) as a2; _ } :: parties) + :: { authorization = (Signature _ | None_given) as a2; _ } :: parties + ) :: partiess , [ _ ] :: (before :: _ :: (after :: _ as stmts)) :: stmtss ) -> (* The next two parties do not contain proofs, and are within the same @@ -3589,7 +3590,7 @@ let group_by_parties_rev (partiess : Party.t list list) | ( [] :: [ ({ authorization = (Signature _ | None_given) as a1; _ } as p) ] :: ({ authorization = (Signature _ | None_given) as a2; _ } - :: parties) + :: parties ) :: partiess , [ _ ] :: [ before; _after1 ] :: (_before2 :: (after :: _ as stmts)) :: stmtss @@ -3658,7 +3659,7 @@ let group_by_parties_rev (partiess : Party.t list list) | ([] | [ _ ]) :: (_ :: _) :: _, [ _ ] -> failwith "group_by_parties_rev: No statements given for the next transaction" - | [] :: [ _ ] :: (_ :: _) :: _, [ _; (_ :: _ :: _) ] -> + | [] :: [ _ ] :: (_ :: _) :: _, [ _; _ :: _ :: _ ] -> failwith "group_by_parties_rev: No statements given for transaction after next" in @@ -3683,14 +3684,14 @@ let parties_witnesses_exn ~constraint_constants ~state_body ~fee_excess ledger ( [ `Pending_coinbase_init_stack of Pending_coinbase.Stack.t ] * [ `Pending_coinbase_of_statement of Pending_coinbase_stack_state.t ] * Parties.t ) - list) = + list ) = let sparse_ledger = match ledger with | `Ledger ledger -> Sparse_ledger.of_ledger_subset_exn ledger (List.concat_map ~f:(fun (_, _, parties) -> Parties.accounts_accessed parties) - partiess) + partiess ) | `Sparse_ledger sparse_ledger -> sparse_ledger in @@ -3704,7 +3705,7 @@ let parties_witnesses_exn ~constraint_constants ~state_body ~fee_excess ledger |> Or_error.ok_exn in let final_state = fst (List.last_exn states) in - (final_state.fee_excess, final_state.ledger, states :: statess_rev)) + (final_state.fee_excess, final_state.ledger, states :: statess_rev) ) in let states = List.rev states_rev in let states_rev = @@ -3744,7 +3745,7 @@ let parties_witnesses_exn ~constraint_constants ~state_body ~fee_excess ledger , pending_coinbase_stack_state , { Mina_transaction_logic.Parties_logic.Start_data.parties ; memo_hash = Signed_command_memo.hash parties.memo - } )) + } ) ) in ref partiess in @@ -3820,13 +3821,13 @@ let parties_witnesses_exn ~constraint_constants ~state_body ~fee_excess ledger Parties.Transaction_commitment.create_complete next_commitment ~memo_hash ~fee_payer_hash in - (next_commitment, next_full_commitment)) + (next_commitment, next_full_commitment) ) in match kind with | `Same -> let next_commitment, next_full_commitment = empty_if_last (fun () -> - (current_commitment, current_full_commitment)) + (current_commitment, current_full_commitment) ) in ( [] , next_commitment @@ -3896,7 +3897,7 @@ let parties_witnesses_exn ~constraint_constants ~state_body ~fee_excess ledger , _ , _ , _ ) - Mina_transaction_logic.Parties_logic.Local_state.t) = + Mina_transaction_logic.Parties_logic.Local_state.t ) = let stack_frame (stack_frame : Stack_frame.value) = { stack_frame with calls = @@ -3908,9 +3909,9 @@ let parties_witnesses_exn ~constraint_constants ~state_body ~fee_excess ledger ; call_stack = List.map local.call_stack ~f:(fun f -> With_hash.of_data (stack_frame f) - ~hash_data:Stack_frame.Digest.create) + ~hash_data:Stack_frame.Digest.create ) |> accumulate_call_stack_hashes ~hash_frame:(fun x -> - x.With_hash.hash) + x.With_hash.hash ) } in let source_local = @@ -3945,7 +3946,7 @@ let parties_witnesses_exn ~constraint_constants ~state_body ~fee_excess ledger (sprintf !"unexpected fee excess. source %{sexp: Amount.Signed.t} \ target %{sexp: Amount.Signed.t}" - target_global.fee_excess source_global.fee_excess) + target_global.fee_excess source_global.fee_excess ) | Some balance_change -> balance_change in @@ -3996,7 +3997,7 @@ let parties_witnesses_exn ~constraint_constants ~state_body ~fee_excess ledger ; sok_digest = Sok_message.Digest.default } in - (w, spec, statement, snapp_stmt) :: witnesses) + (w, spec, statement, snapp_stmt) :: witnesses ) , final_ledger ) module Make (Inputs : sig @@ -4028,7 +4029,7 @@ struct let verify ts = if List.for_all ts ~f:(fun (p, m) -> - Sok_message.Digest.equal (Sok_message.digest m) p.statement.sok_digest) + Sok_message.Digest.equal (Sok_message.digest m) p.statement.sok_digest ) then Proof.verify (List.map ts ~f:(fun ({ statement; proof }, _) -> (statement, proof))) @@ -4041,8 +4042,8 @@ struct List.iter witness.start_parties ~f:(fun s -> Parties.Call_forest.iteri ~f:(fun _i x -> return (Some x)) - s.parties.other_parties) ; - None) + s.parties.other_parties ) ; + None ) | xs -> Parties.Call_forest.hd_party xs |> Option.map ~f:fst @@ -4068,7 +4069,7 @@ struct in match Option.value_map ~default:None account.zkapp ~f:(fun s -> - s.verification_key) + s.verification_key ) with | None -> failwith "No verification key found in the account" @@ -4109,7 +4110,7 @@ struct base [] ~handler: (Base.transaction_union_handler handler transaction state_body - init_stack) + init_stack ) statement in { statement; proof } @@ -4137,7 +4138,7 @@ struct transaction = Command (Signed_command - (Transaction_protocol_state.transaction user_command_in_block)) + (Transaction_protocol_state.transaction user_command_in_block) ) } handler @@ -4209,7 +4210,7 @@ module For_tests = struct Pickles_types.Hlist0.H1 (Pickles_types.Hlist.E01(Pickles.Inductive_rule.B)) .t -> - []) + [] ) ; main_value = (fun [] _ -> []) } in @@ -4222,7 +4223,7 @@ module For_tests = struct ~name:"trivial" ~constraint_constants: (Genesis_constants.Constraint_constants.to_snark_keys_header - constraint_constants) + constraint_constants ) ~choices:(fun ~self -> [ trivial_rule ; { identifier = "dummy" @@ -4234,7 +4235,7 @@ module For_tests = struct |> fun () -> (* Unsatisfiable. *) Run.exists Field.typ ~compute:(fun () -> - Run.Field.Constant.zero) + Run.Field.Constant.zero ) |> fun s -> Run.Field.(Assert.equal s (s + one)) |> fun () : @@ -4243,9 +4244,9 @@ module For_tests = struct Pickles_types.Hlist0.H1 (Pickles_types.Hlist.E01(Pickles.Inductive_rule.B)) .t -> - [ Boolean.true_; Boolean.true_ ]) + [ Boolean.true_; Boolean.true_ ] ) } - ]) + ] ) in let vk = Pickles.Side_loaded.Verification_key.of_compiled tag in ( `VK (With_hash.of_data ~hash_data:Zkapp_account.digest_vk vk) @@ -4380,7 +4381,7 @@ module For_tests = struct ; authorization = Control.Signature Signature.dummy (*To be updated later*) } - : Party.Wire.t )) + : Party.Wire.t ) ) in let other_receivers = List.map receivers ~f:(fun (receiver, amt) : Party.Wire.t -> @@ -4400,7 +4401,7 @@ module For_tests = struct ; caller = Call } ; authorization = Control.None_given - }) + } ) in let other_parties_data = Option.value_map ~default:[] sender_party ~f:(fun p -> [ p ]) @@ -4441,7 +4442,7 @@ module For_tests = struct Signature_lib.Schnorr.Chunked.sign sender.private_key (Random_oracle.Input.Chunked.field commitment) in - { body = s.body; authorization = Signature sender_signature_auth }) + { body = s.body; authorization = Signature sender_signature_auth } ) in ( `Parties (Parties.of_wire { fee_payer; other_parties = other_receivers; memo }) @@ -4459,8 +4460,7 @@ module For_tests = struct *) assert ( Zkapp_basic.Set_or_keep.is_keep spec.snapp_update.timing - || (spec.new_zkapp_account && List.length spec.zkapp_account_keypairs = 1) - ) ; + || (spec.new_zkapp_account && List.length spec.zkapp_account_keypairs = 1) ) ; let update_vk = let update = spec.snapp_update in { update with @@ -4496,7 +4496,7 @@ module For_tests = struct (Random_oracle.Input.Chunked.field commitment) in ( { body = snapp_party.body; authorization = Signature signature } - : Party.Wire.t )) + : Party.Wire.t ) ) in let other_parties = Option.to_list sender_party @ snapp_parties in let parties : Parties.t = @@ -4528,7 +4528,7 @@ module For_tests = struct Parties.Call_forest.With_hashes.of_parties_list (List.map ~f:(fun p -> (p, ())) - (List.drop snapp_parties ndx)) + (List.drop snapp_parties ndx) ) in Parties.Call_forest.hash ps in @@ -4580,7 +4580,7 @@ module For_tests = struct : Party.Wire.t ) | _ -> failwith - "Current authorization not Proof or Signature or None_given") + "Current authorization not Proof or Signature or None_given" ) in let other_parties = snapp_parties in let parties : Parties.t = diff --git a/src/lib/transaction_snark/transaction_validator.ml b/src/lib/transaction_snark/transaction_validator.ml index fd5815d0901..1a030940b0b 100644 --- a/src/lib/transaction_snark/transaction_validator.ml +++ b/src/lib/transaction_snark/transaction_validator.ml @@ -85,7 +85,7 @@ module Hashless_ledger = struct let with_ledger ~depth ~f = Ledger.with_ledger ~depth ~f:(fun l -> let t = create l in - f t) + f t ) (** Create a new ledger mask 'on top of' the given ledger. @@ -123,12 +123,12 @@ let apply_user_command ~constraint_constants ~txn_global_slot l uc = Result.map ~f:(fun applied_txn -> applied_txn.Transaction_applied.Signed_command_applied.common.user_command - .status) + .status ) (apply_user_command l ~constraint_constants ~txn_global_slot uc) let apply_transaction' ~constraint_constants ~txn_state_view l t = O1trace.sync_thread "apply_transaction" (fun () -> - apply_transaction ~constraint_constants ~txn_state_view l t) + apply_transaction ~constraint_constants ~txn_state_view l t ) let apply_transaction ~constraint_constants ~txn_state_view l txn = Result.map ~f:Transaction_applied.user_command_status diff --git a/src/lib/transaction_snark_scan_state/transaction_snark_scan_state.ml b/src/lib/transaction_snark_scan_state/transaction_snark_scan_state.ml index c908281f4ec..f218c91645a 100644 --- a/src/lib/transaction_snark_scan_state/transaction_snark_scan_state.ml +++ b/src/lib/transaction_snark_scan_state/transaction_snark_scan_state.ml @@ -195,7 +195,7 @@ let create_expected_statement ~constraint_constants let%bind after, _ = Or_error.try_with (fun () -> Sparse_ledger.apply_transaction ~constraint_constants - ~txn_state_view:state_view ledger_witness transaction) + ~txn_state_view:state_view ledger_witness transaction ) |> Or_error.join in let target_merkle_root = @@ -336,7 +336,7 @@ struct | None -> Info.singleton elapsed | Some acc -> - Info.update acc elapsed) ; + Info.update acc elapsed ) ; x let log label (t : t) = @@ -344,7 +344,7 @@ struct [%log debug] ~metadata: (List.map (Hashtbl.to_alist t) ~f:(fun (k, info) -> - (k, Info.to_yojson info))) + (k, Info.to_yojson info) ) ) "%s timing" label end @@ -371,7 +371,7 @@ struct let with_error ~f message = let result = f () in Deferred.Result.map_error result ~f:(fun e -> - Error.createf !"%s: %{sexp:Error.t}" (write_error message) e) + Error.createf !"%s: %{sexp:Error.t}" (write_error message) e ) in let merge_acc ~proofs (acc : Acc.t) s2 : Acc.t Deferred.Or_error.t = Timer.time timer (sprintf "merge_acc:%s" __LOC__) (fun () -> @@ -384,7 +384,7 @@ struct Deferred.return (Transaction_snark.Statement.merge s1 s2) in let%map () = yield_occasionally () in - Some (merged_statement, proofs @ ps))) + Some (merged_statement, proofs @ ps) ) ) in let merge_pc (acc : Transaction_snark.Statement.t option) s2 : Transaction_snark.Statement.t option Or_error.t = @@ -424,7 +424,7 @@ struct let stmt2 = Ledger_proof.statement proof_2 in let%bind merged_statement = Timer.time timer (sprintf "merge:%s" __LOC__) (fun () -> - Deferred.return (Transaction_snark.Statement.merge stmt1 stmt2)) + Deferred.return (Transaction_snark.Statement.merge stmt1 stmt2) ) in let%map acc_stmt = merge_acc acc_statement merged_statement @@ -456,7 +456,7 @@ struct (fun () -> Deferred.return (create_expected_statement ~constraint_constants - ~get_state transaction)) + ~get_state transaction ) ) in let%map () = yield_always () in result @@ -481,7 +481,7 @@ struct !"Bad base statement expected: \ %{sexp:Transaction_snark.Statement.t} got: \ %{sexp:Transaction_snark.Statement.t}" - transaction.statement expected_statement)) + transaction.statement expected_statement ) ) in let%bind.Deferred res = Fold.fold_chronological_until tree ~init:(None, None) @@ -491,14 +491,14 @@ struct | Ok next -> Continue next | e -> - Stop e) + Stop e ) ~f_base:(fun acc (_weight, job) -> let open Container.Continue_or_stop in match%map.Deferred fold_step_d acc job with | Ok next -> Continue next | e -> - Stop e) + Stop e ) ~finish:return in Timer.log "scan_statement" timer ; @@ -523,12 +523,12 @@ struct , Pending_coinbase.Stack.t , Mina_state.Local_state.t ) Mina_state.Registers.t - option) + option ) ~(registers_end : ( Frozen_ledger_hash.t , Pending_coinbase.Stack.t , Mina_state.Local_state.t ) - Mina_state.Registers.t) = + Mina_state.Registers.t ) = let clarify_error cond err = if not cond then Or_error.errorf "%s : %s" error_prefix err else Ok () in @@ -542,26 +542,26 @@ struct and () = clarify_error (Pending_coinbase.Stack.connected ~first:reg1.pending_coinbase_stack - ~second:reg2.pending_coinbase_stack ()) + ~second:reg2.pending_coinbase_stack () ) "did not connect with pending-coinbase stack" and () = clarify_error (Mina_transaction_logic.Parties_logic.Local_state.Value.equal - reg1.local_state reg2.local_state) + reg1.local_state reg2.local_state ) "did not connect with local state" in () in match%map O1trace.sync_thread "validate_transaction_snark_scan_state" (fun () -> - scan_statement t ~constraint_constants ~statement_check ~verifier) + scan_statement t ~constraint_constants ~statement_check ~verifier ) with | Error (`Error e) -> Error e | Error `Empty -> Option.value_map ~default:(Ok ()) registers_begin ~f:(fun registers_begin -> - check_registers registers_begin registers_end) + check_registers registers_begin registers_end ) | Ok { fee_excess = { fee_token_l; fee_excess_l; fee_token_r; fee_excess_r } ; source @@ -603,7 +603,7 @@ module Staged_undos = struct List.fold_left t ~init:(Ok ()) ~f:(fun acc t -> Or_error.bind (Or_error.map acc ~f:(fun _ -> t)) - ~f:(fun u -> Ledger.undo ~constraint_constants ledger u)) + ~f:(fun u -> Ledger.undo ~constraint_constants ledger u) ) end let statement_of_job : job -> Transaction_snark.Statement.t option = function @@ -633,7 +633,7 @@ let extract_txns txns_with_witnesses = txn_with_witness.transaction_with_info in let state_hash = fst txn_with_witness.state_hash in - (txn, state_hash)) + (txn, state_hash) ) let latest_ledger_proof t = let open Option.Let_syntax in @@ -654,7 +654,7 @@ let base_jobs_on_earlier_tree = Parallel_scan.base_jobs_on_earlier_tree (*All the transactions in the order in which they were applied*) let staged_transactions t = List.map ~f:(fun (t : Transaction_with_witness.t) -> - t.transaction_with_info |> Ledger.Transaction_applied.transaction) + t.transaction_with_info |> Ledger.Transaction_applied.transaction ) @@ Parallel_scan.pending_data t let staged_transactions_with_protocol_states t @@ -665,7 +665,7 @@ let staged_transactions_with_protocol_states t t.transaction_with_info |> Ledger.Transaction_applied.transaction in let%map protocol_state = get_state (fst t.state_hash) in - (txn, protocol_state)) + (txn, protocol_state) ) @@ Parallel_scan.pending_data t |> Or_error.all @@ -683,7 +683,7 @@ let partition_if_overflowing t = { Space_partition.first = (slots, bundle_count job_count) ; second = Option.map second ~f:(fun (slots, job_count) -> - (slots, bundle_count job_count)) + (slots, bundle_count job_count) ) } let extract_from_job (job : job) = @@ -709,7 +709,7 @@ let snark_job_list_json t = Yojson.Safe.to_string (`List (List.map all_jobs ~f:(fun tree -> - `List (List.map tree ~f:Job_view.to_yojson)))) + `List (List.map tree ~f:Job_view.to_yojson) ) ) ) (*Always the same pairing of jobs*) let all_work_statements_exn t : Transaction_snark_work.Statement.t list = @@ -721,7 +721,7 @@ let all_work_statements_exn t : Transaction_snark_work.Statement.t list = | None -> assert false | Some stmt -> - stmt))) + stmt ) ) ) let required_work_pairs t ~slots = let work_list = Parallel_scan.jobs_for_slots t ~slots in @@ -742,7 +742,7 @@ let work_statements_for_new_diff t : Transaction_snark_work.Statement.t list = | None -> assert false | Some stmt -> - stmt))) + stmt ) ) ) let all_work_pairs t ~(get_state : State_hash.t -> Mina_state.Protocol_state.value Or_error.t) : @@ -801,13 +801,13 @@ let all_work_pairs t ~f:(fun acc' pair -> let%bind acc' = acc' in let%map spec = One_or_two.Or_error.map ~f:single_spec pair in - spec :: acc') + spec :: acc' ) in match specs_list with | Ok list -> Continue (acc @ List.rev list) | Error e -> - Stop (Error e)) + Stop (Error e) ) let update_metrics = Parallel_scan.update_metrics @@ -825,7 +825,7 @@ let fill_work_and_enqueue_transactions t transactions work = (List.concat_map works ~f:(fun { Transaction_snark_work.fee; proofs; prover } -> One_or_two.map proofs ~f:(fun proof -> (fee, proof, prover)) - |> One_or_two.to_list)) + |> One_or_two.to_list ) ) ~f:completed_work_to_scanable_work in let old_proof = Parallel_scan.last_emitted_value t in @@ -846,14 +846,14 @@ let fill_work_and_enqueue_transactions t transactions work = important here*) if Mina_state.Registers.Value.connected prev_target curr_source then Ok (Some (proof, extract_txns txns_with_witnesses)) - else Or_error.error_string "Unexpected ledger proof emitted") + else Or_error.error_string "Unexpected ledger proof emitted" ) in (result_opt, updated_scan_state) let required_state_hashes t = List.fold ~init:State_hash.Set.empty ~f:(fun acc (t : Transaction_with_witness.t) -> - Set.add acc (fst t.state_hash)) + Set.add acc (fst t.state_hash) ) (Parallel_scan.pending_data t) let check_required_protocol_states t ~protocol_states = @@ -875,7 +875,7 @@ let check_required_protocol_states t ~protocol_states = ~f:(fun m ps -> State_hash.Map.set m ~key:(State_hash.With_state_hashes.state_hash ps) - ~data:ps) + ~data:ps ) in let protocol_states_assoc = List.filter_map diff --git a/src/lib/transaction_snark_work/transaction_snark_work.mli b/src/lib/transaction_snark_work/transaction_snark_work.mli index 364b1eb4436..d941b781ccf 100644 --- a/src/lib/transaction_snark_work/transaction_snark_work.mli +++ b/src/lib/transaction_snark_work/transaction_snark_work.mli @@ -45,7 +45,7 @@ end be in this particular bundle. The easiest way would be to SOK with H(all_statements_in_bundle || fee || public_key) - *) +*) type t = { fee : Fee.t diff --git a/src/lib/transition_chain_verifier/transition_chain_verifier.ml b/src/lib/transition_chain_verifier/transition_chain_verifier.ml index bc5f92af791..cd70f668277 100644 --- a/src/lib/transition_chain_verifier/transition_chain_verifier.ml +++ b/src/lib/transition_chain_verifier/transition_chain_verifier.ml @@ -9,7 +9,7 @@ module Merkle_list_verifier = Merkle_list_verifier.Make (struct let hash previous_state_hash state_body_hash = (Protocol_state.hashes_abstract ~hash_body:Fn.id - { previous_state_hash; body = state_body_hash }) + { previous_state_hash; body = state_body_hash } ) .state_hash end) diff --git a/src/lib/transition_frontier/catchup_hash_tree.ml b/src/lib/transition_frontier/catchup_hash_tree.ml index 98b5ea8d524..dc0c869e593 100644 --- a/src/lib/transition_frontier/catchup_hash_tree.ml +++ b/src/lib/transition_frontier/catchup_hash_tree.ml @@ -14,7 +14,7 @@ module Node = struct let to_yojson (t : t) = `List (List.map (Hash_set.to_list t) ~f:(fun x -> - `String (Catchup_job_id.to_string x))) + `String (Catchup_job_id.to_string x) ) ) end type t = Have_breadcrumb | Part_of_catchups of Ids.t @@ -42,7 +42,7 @@ module State_hash_table = struct let to_yojson f t : Yojson.Safe.t = `Assoc (List.map (State_hash.Table.to_alist t) ~f:(fun (h, x) -> - (State_hash.to_base58_check h, f x))) + (State_hash.to_base58_check h, f x) ) ) end module State_hash_hash_set = struct @@ -82,7 +82,7 @@ let max_catchup_chain_length t = missing_length (acc + 1) parent ) in Hash_set.fold t.tips ~init:0 ~f:(fun acc tip -> - Int.max acc (missing_length 0 (Hashtbl.find_exn t.nodes tip))) + Int.max acc (missing_length 0 (Hashtbl.find_exn t.nodes tip)) ) let create ~root = let root_hash = Breadcrumb.state_hash root in @@ -128,7 +128,7 @@ let add_child t h ~parent = | None -> State_hash.Set.singleton h | Some s -> - Set.add s h) + Set.add s h ) let add t h ~parent ~job = if Hashtbl.mem t.nodes h then @@ -157,7 +157,7 @@ let breadcrumb_added (t : t) b = add_child t h ~parent ; { parent; state = Have_breadcrumb } | Some x -> - { x with state = Have_breadcrumb }) ; + { x with state = Have_breadcrumb } ) ; Hash_set.remove t.tips h let remove_node t h = @@ -171,7 +171,7 @@ let remove_node t h = None | Some s -> let s' = Set.remove s h in - if Set.is_empty s' then None else Some s') + if Set.is_empty s' then None else Some s' ) (* Remove everything not reachable from the root *) let prune t = @@ -193,7 +193,7 @@ let prune t = in go [ t.root ] ; List.iter (Hashtbl.keys t.nodes) ~f:(fun h -> - if not (Hash_set.mem keep h) then remove_node t h) + if not (Hash_set.mem keep h) then remove_node t h ) let catchup_failed t job = let to_remove = @@ -203,7 +203,7 @@ let catchup_failed t job = acc | Part_of_catchups s -> Hash_set.remove s job ; - if Hash_set.is_empty s then key :: acc else acc) + if Hash_set.is_empty s then key :: acc else acc ) in List.iter to_remove ~f:(remove_node t) @@ -224,7 +224,7 @@ let apply_diffs t (ds : Diff.Full.E.t list) = None | Some x -> t.root <- h ; - Some { x with state = Have_breadcrumb }) ; + Some { x with state = Have_breadcrumb } ) ; prune t | E (Best_tip_changed _) -> - ()) + () ) diff --git a/src/lib/transition_frontier/catchup_tree.ml b/src/lib/transition_frontier/catchup_tree.ml index a57b08e624e..02a292c9b71 100644 --- a/src/lib/transition_frontier/catchup_tree.ml +++ b/src/lib/transition_frontier/catchup_tree.ml @@ -1,11 +1,11 @@ (* This is temporary until we decide to switch over fully to "super catchup". - Normal catchup does not maintain enough state on its own to decide whether a long catchup job is in progress. + Normal catchup does not maintain enough state on its own to decide whether a long catchup job is in progress. Thus, we have the frontier hold onto a "catchup hash tree" which contains information about which nodes are involved in catchup jobs. Super catchup maintains an explicit tree of blocks that are involved in catchup, which contains enough information - to decide whether a long catchup job is in progress, and so we do not need a separate tree of hashes. + to decide whether a long catchup job is in progress, and so we do not need a separate tree of hashes. *) type t = Hash of Catchup_hash_tree.t | Full of Full_catchup_tree.t diff --git a/src/lib/transition_frontier/extensions/best_tip_diff.ml b/src/lib/transition_frontier/extensions/best_tip_diff.ml index 7f7e04bd347..9414959512c 100644 --- a/src/lib/transition_frontier/extensions/best_tip_diff.ml +++ b/src/lib/transition_frontier/extensions/best_tip_diff.ml @@ -75,62 +75,64 @@ module T = struct ~f: (fun ( ({ new_commands; removed_commands; reorg_best_tip = _ } as acc) , should_broadcast ) -> function - | E (Best_tip_changed new_best_tip, old_best_tip_hash) -> - let new_best_tip_breadcrumb = - Full_frontier.find_exn frontier new_best_tip - in - let old_best_tip = - (*FIXME #4404*) - Full_frontier.find_exn frontier old_best_tip_hash - in - let added_to_best_tip_path, removed_from_best_tip_path = - get_path_diff t frontier new_best_tip_breadcrumb old_best_tip - in - let new_commands = - List.bind added_to_best_tip_path ~f:breadcrumb_commands - @ new_commands - in - let removed_commands = - List.bind removed_from_best_tip_path ~f:breadcrumb_commands - @ removed_commands - in - let reorg_best_tip = - not (List.is_empty removed_from_best_tip_path) - in - let added_transitions = - List.map - ~f:(fun b -> - { Log_event.protocol_state = Breadcrumb.protocol_state b - ; state_hash = Breadcrumb.state_hash b - ; just_emitted_a_proof = Breadcrumb.just_emitted_a_proof b - }) - added_to_best_tip_path - in - let removed_transitions = - List.map - ~f:(fun b -> - { Log_event.protocol_state = Breadcrumb.protocol_state b - ; state_hash = Breadcrumb.state_hash b - ; just_emitted_a_proof = Breadcrumb.just_emitted_a_proof b - }) - removed_from_best_tip_path - in - let event = - Log_event.New_best_tip_event - { added_transitions; removed_transitions; reorg_best_tip } - in - [%str_log' debug t.logger] - ~metadata: - [ ( "no_of_added_breadcrumbs" - , `Int (List.length added_to_best_tip_path) ) - ; ( "no_of_removed_breadcrumbs" - , `Int (List.length removed_from_best_tip_path) ) - ] - event ; - [%str_log' best_tip_diff t.best_tip_diff_logger] event ; - ({ new_commands; removed_commands; reorg_best_tip }, true) - | E (New_node (Full _), _) -> (acc, should_broadcast) - | E (Root_transitioned _, _) -> (acc, should_broadcast)) + | E (Best_tip_changed new_best_tip, old_best_tip_hash) -> + let new_best_tip_breadcrumb = + Full_frontier.find_exn frontier new_best_tip + in + let old_best_tip = + (*FIXME #4404*) + Full_frontier.find_exn frontier old_best_tip_hash + in + let added_to_best_tip_path, removed_from_best_tip_path = + get_path_diff t frontier new_best_tip_breadcrumb old_best_tip + in + let new_commands = + List.bind added_to_best_tip_path ~f:breadcrumb_commands + @ new_commands + in + let removed_commands = + List.bind removed_from_best_tip_path ~f:breadcrumb_commands + @ removed_commands + in + let reorg_best_tip = + not (List.is_empty removed_from_best_tip_path) + in + let added_transitions = + List.map + ~f:(fun b -> + { Log_event.protocol_state = Breadcrumb.protocol_state b + ; state_hash = Breadcrumb.state_hash b + ; just_emitted_a_proof = Breadcrumb.just_emitted_a_proof b + } ) + added_to_best_tip_path + in + let removed_transitions = + List.map + ~f:(fun b -> + { Log_event.protocol_state = Breadcrumb.protocol_state b + ; state_hash = Breadcrumb.state_hash b + ; just_emitted_a_proof = Breadcrumb.just_emitted_a_proof b + } ) + removed_from_best_tip_path + in + let event = + Log_event.New_best_tip_event + { added_transitions; removed_transitions; reorg_best_tip } + in + [%str_log' debug t.logger] + ~metadata: + [ ( "no_of_added_breadcrumbs" + , `Int (List.length added_to_best_tip_path) ) + ; ( "no_of_removed_breadcrumbs" + , `Int (List.length removed_from_best_tip_path) ) + ] + event ; + [%str_log' best_tip_diff t.best_tip_diff_logger] event ; + ({ new_commands; removed_commands; reorg_best_tip }, true) + | E (New_node (Full _), _) -> + (acc, should_broadcast) + | E (Root_transitioned _, _) -> + (acc, should_broadcast) ) in Option.some_if should_broadcast view end diff --git a/src/lib/transition_frontier/extensions/extensions.ml b/src/lib/transition_frontier/extensions/extensions.ml index 65ae4bec1a6..dec5ba3fdb0 100644 --- a/src/lib/transition_frontier/extensions/extensions.ml +++ b/src/lib/transition_frontier/extensions/extensions.ml @@ -81,7 +81,7 @@ let notify (t : t) ~frontier ~diffs_with_mutants = ~transition_registry:(update (module Transition_registry.Broadcasted)) ~ledger_table:(update (module Ledger_table.Broadcasted)) ~new_breadcrumbs:(update (module New_breadcrumbs.Broadcasted)) - ~identity:(update (module Identity.Broadcasted))) + ~identity:(update (module Identity.Broadcasted)) ) type ('ext, 'view) access = | Root_history : (Root_history.t, Root_history.view) access @@ -99,7 +99,7 @@ type ('ext, 'view) broadcasted_extension = (module Intf.Broadcasted_extension_intf with type t = 't and type extension = 'ext - and type view = 'view) + and type view = 'view ) * 't -> ('ext, 'view) broadcasted_extension diff --git a/src/lib/transition_frontier/extensions/ledger_table.ml b/src/lib/transition_frontier/extensions/ledger_table.ml index 83b8ed2f756..1b4d8373a7a 100644 --- a/src/lib/transition_frontier/extensions/ledger_table.ml +++ b/src/lib/transition_frontier/extensions/ledger_table.ml @@ -4,7 +4,7 @@ open Frontier_base (* WARNING: don't use this code until @nholland has landed a PR that synchronize the read/write of transition frontier - *) +*) module T = struct (* a pair of hash tables @@ -42,7 +42,7 @@ module T = struct List.iter breadcrumbs ~f:(fun bc -> let ledger = Staged_ledger.ledger @@ Breadcrumb.staged_ledger bc in let ledger_hash = Mina_ledger.Ledger.merkle_root ledger in - add_entry t ~ledger_hash ~ledger) ; + add_entry t ~ledger_hash ~ledger ) ; (t, ()) let lookup t ledger_hash = Ledger_hash.Table.find t.ledgers ledger_hash @@ -75,9 +75,9 @@ module T = struct let ledger_hash = Staged_ledger_hash.ledger_hash staged_ledger in - remove_entry t ~ledger_hash) ) + remove_entry t ~ledger_hash ) ) | E (Best_tip_changed _, _) -> - ()) ; + () ) ; None end diff --git a/src/lib/transition_frontier/extensions/new_breadcrumbs.ml b/src/lib/transition_frontier/extensions/new_breadcrumbs.ml index 47e5238535d..138cd28e576 100644 --- a/src/lib/transition_frontier/extensions/new_breadcrumbs.ml +++ b/src/lib/transition_frontier/extensions/new_breadcrumbs.ml @@ -15,7 +15,7 @@ module T = struct | E (New_node (Full breadcrumb), _) -> Some breadcrumb | _ -> - None) + None ) in Option.some_if (not @@ List.is_empty new_nodes) new_nodes end diff --git a/src/lib/transition_frontier/extensions/root_history.ml b/src/lib/transition_frontier/extensions/root_history.ml index 83f9452ef34..498a926c780 100644 --- a/src/lib/transition_frontier/extensions/root_history.ml +++ b/src/lib/transition_frontier/extensions/root_history.ml @@ -49,7 +49,7 @@ module T = struct |> Mina_block.Validated.forget |> With_hash.map ~f:(fun block -> block |> Mina_block.header - |> Mina_block.Header.protocol_state) ) + |> Mina_block.Header.protocol_state ) ) |> List.map ~f:(fun s -> State_hash.With_state_hashes.(state_hash s, s)) |> State_hash.Map.of_alist_exn in @@ -60,7 +60,7 @@ module T = struct ( Mina_block.Validated.state_hash @@ External_transition.Validated.lower @@ transition t.current_root ) - t.current_root) ) ; + t.current_root ) ) ; t.current_root <- new_root let handle_diffs root_history frontier diffs_with_mutants = @@ -74,7 +74,7 @@ module T = struct |> Root_data.Historical.of_breadcrumb |> enqueue root_history ; true | E _ -> - false) + false ) in Option.some_if should_produce_view root_history end @@ -113,7 +113,8 @@ let protocol_states_for_scan_state in With_hash.data state_with_hash in - match res with None -> Stop None | Some state -> Continue (state :: acc)) + match res with None -> Stop None | Some state -> Continue (state :: acc) + ) let most_recent { history; _ } = (* unfortunately, there is not function to inspect the last element in the queue, diff --git a/src/lib/transition_frontier/extensions/snark_pool_refcount.ml b/src/lib/transition_frontier/extensions/snark_pool_refcount.ml index 3b1344e35ee..e2d12c4f302 100644 --- a/src/lib/transition_frontier/extensions/snark_pool_refcount.ml +++ b/src/lib/transition_frontier/extensions/snark_pool_refcount.ml @@ -41,7 +41,7 @@ module T = struct count + 1 | None -> res := true ; - 1)) ; + 1 ) ) ; !res (** Returns true if this update changed which elements are in the table @@ -56,7 +56,7 @@ module T = struct | Some count -> Some (count - 1) | None -> - failwith "Removed a breadcrumb we didn't know about")) ; + failwith "Removed a breadcrumb we didn't know about" ) ) ; !res let add_scan_state_to_ref_table table scan_state : bool = @@ -112,7 +112,7 @@ module T = struct then 1 else 0 in - acc + delta) + acc + delta ) in { num_removed = num_removed + extra_num_removed; is_added } | E (Best_tip_changed new_best_tip_hash, _) -> @@ -135,7 +135,7 @@ module T = struct let num_blocks_to_include = 3 in Hash_set.clear t.best_tip_table ; update_best_tip_table num_blocks_to_include new_best_tip_hash ; - { num_removed; is_added = true }) + { num_removed; is_added = true } ) in if num_removed > 0 || is_added then Some diff --git a/src/lib/transition_frontier/extensions/transition_registry.ml b/src/lib/transition_frontier/extensions/transition_registry.ml index 61e23f7244c..44609beba46 100644 --- a/src/lib/transition_frontier/extensions/transition_registry.ml +++ b/src/lib/transition_frontier/extensions/transition_registry.ml @@ -16,10 +16,10 @@ module T = struct List.iter ls ~f:(fun ivar -> if Ivar.is_full ivar then [%log' error (Logger.create ())] "Ivar.fill bug is here!" ; - Ivar.fill ivar ()) ; + Ivar.fill ivar () ) ; None | None -> - None) + None ) let register t state_hash = Deferred.create (fun ivar -> @@ -27,14 +27,14 @@ module T = struct | Some ls -> ivar :: ls | None -> - [ ivar ])) + [ ivar ] ) ) let handle_diffs transition_registry _ diffs_with_mutants = List.iter diffs_with_mutants ~f:(function | Diff.Full.With_mutant.E (New_node (Full breadcrumb), _) -> notify transition_registry (Breadcrumb.state_hash breadcrumb) | _ -> - ()) ; + () ) ; None end diff --git a/src/lib/transition_frontier/frontier_base/.ocamlformat b/src/lib/transition_frontier/frontier_base/.ocamlformat index 9a9f9a6031c..1b2264a8390 100644 --- a/src/lib/transition_frontier/frontier_base/.ocamlformat +++ b/src/lib/transition_frontier/frontier_base/.ocamlformat @@ -4,9 +4,7 @@ max-iters=10 comment-check=true wrap-fun-args=true wrap-comments=false -type-decl-indent=2 type-decl=compact -stritem-extension-indent=0 space-around-variants=true space-around-records=true space-around-lists=true @@ -15,52 +13,34 @@ single-case=compact sequence-style=separator sequence-blank-line=preserve-one parse-docstrings=false -parens-tuple-patterns=multi-line-only parens-tuple=always parens-ite=false ocp-indent-compat=false -nested-match=wrap module-item-spacing=sparse max-indent=68 -match-indent-nested=never -match-indent=0 margin=80 -let-open=preserve let-module=compact let-binding-spacing=compact -let-binding-indent=2 let-and=compact leading-nested-match-parens=false infix-precedence=indent indicate-nested-or-patterns=space indicate-multiline-delimiters=space -indent-after-in=0 if-then-else=compact -function-indent-nested=never -function-indent=2 field-space=loose -extension-indent=2 exp-grouping=parens dock-collection-brackets=false doc-comments-tag-only=default doc-comments-padding=2 doc-comments=before -disambiguate-non-breaking-match=false disable=false cases-matching-exp-indent=normal cases-exp-indent=4 -break-struct=force -break-string-literals=auto break-sequences=false break-separators=before break-infix-before-func=true break-infix=wrap break-fun-sig=wrap break-fun-decl=wrap -break-collection-expressions=fit-or-vertical break-cases=nested -break-before-in=fit-or-vertical assignment-operator=end-line -align-variants-decl=false -align-constructors-decl=false -align-cases=false diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.ml b/src/lib/transition_frontier/frontier_base/breadcrumb.ml index 0fce9c2f2d3..3f8e888ebdf 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.ml +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.ml @@ -27,7 +27,7 @@ module T = struct ~just_emitted_a_proof ~transition_receipt_time = f (creator ~validated_transition ~staged_ledger ~just_emitted_a_proof - ~transition_receipt_time) + ~transition_receipt_time ) let create ~validated_transition ~staged_ledger ~just_emitted_a_proof ~transition_receipt_time = @@ -51,7 +51,7 @@ module T = struct ; ( "transition_receipt_time" , `String (Option.value_map transition_receipt_time ~default:"" - ~f:(Time.to_string_iso8601_basic ~zone:Time.Zone.utc)) ) + ~f:(Time.to_string_iso8601_basic ~zone:Time.Zone.utc) ) ) ] end @@ -89,7 +89,7 @@ let build ?skip_staged_ledger_verification ~logger ~precomputed_values ~verifier ~validated_transition: (Mina_block.Validated.lift fully_valid_block) ~staged_ledger:transitioned_staged_ledger ~just_emitted_a_proof - ~transition_receipt_time) + ~transition_receipt_time ) | Error (`Invalid_staged_ledger_diff errors) -> let reasons = String.concat ~sep:" && " @@ -97,7 +97,7 @@ let build ?skip_staged_ledger_verification ~logger ~precomputed_values ~verifier | `Incorrect_target_staged_ledger_hash -> "staged ledger hash" | `Incorrect_target_snarked_ledger_hash -> - "snarked ledger hash")) + "snarked ledger hash" ) ) in let message = "invalid staged ledger diff: incorrect " ^ reasons in let%map () = @@ -146,11 +146,12 @@ let build ?skip_staged_ledger_verification ~logger ~precomputed_values ~verifier | Unexpected _ -> make_actions Gossiped_invalid_transition in - Trust_system.record trust_system logger peer action) + Trust_system.record trust_system logger peer action ) in Error (`Invalid_staged_ledger_diff - (Staged_ledger.Staged_ledger_error.to_error staged_ledger_error))) + (Staged_ledger.Staged_ledger_error.to_error staged_ledger_error) + ) ) let block_with_hash = Fn.compose Mina_block.Validated.forget validated_transition @@ -172,7 +173,7 @@ let consensus_state_with_hashes breadcrumb = breadcrumb |> block_with_hash |> With_hash.map ~f:(fun block -> block |> Mina_block.header |> Mina_block.Header.protocol_state - |> Protocol_state.consensus_state) + |> Protocol_state.consensus_state ) let parent_hash b = b |> protocol_state |> Protocol_state.previous_state_hash @@ -227,7 +228,7 @@ module For_tests = struct Signed_command.With_valid_signature.t Sequence.t = let account_ids = List.map accounts_with_secret_keys ~f:(fun (_, account) -> - Account.identifier account) + Account.identifier account ) in Sequence.filter_map (accounts_with_secret_keys |> Sequence.of_list) ~f:(fun (sender_sk, sender_account) -> @@ -265,9 +266,9 @@ module For_tests = struct ~nonce ~valid_until:None ~memo:Signed_command_memo.dummy ~body: (Payment - { source_pk = sender_pk; receiver_pk; amount = send_amount }) + { source_pk = sender_pk; receiver_pk; amount = send_amount } ) in - Signed_command.sign sender_keypair payload) + Signed_command.sign sender_keypair payload ) let gen ?(logger = Logger.null ()) ~(precomputed_values : Precomputed_values.t) ~verifier @@ -305,7 +306,7 @@ module For_tests = struct One_or_two.map stmts ~f:(fun statement -> Ledger_proof.create ~statement ~sok_digest:Sok_message.Digest.default - ~proof:Proof.transaction_dummy) + ~proof:Proof.transaction_dummy ) ; prover } in @@ -359,7 +360,7 @@ module For_tests = struct ~f:(fun (proof, _) -> { (Ledger_proof.statement proof |> Ledger_proof.statement_target) with pending_coinbase_stack = () - }) + } ) ~default:previous_registers in let genesis_ledger_hash = @@ -455,7 +456,7 @@ module For_tests = struct let gen_list = List.gen_with_length n (gen ?logger ~precomputed_values ~verifier ?trust_system - ~accounts_with_secret_keys) + ~accounts_with_secret_keys ) in let%map breadcrumbs_constructors = gen_list in fun root -> @@ -464,7 +465,7 @@ module For_tests = struct Deferred.List.fold breadcrumbs_constructors ~init:(root, []) ~f:(fun (previous, acc) make_breadcrumb -> let%map breadcrumb = make_breadcrumb previous in - (breadcrumb, breadcrumb :: acc)) + (breadcrumb, breadcrumb :: acc) ) in List.rev ls diff --git a/src/lib/transition_frontier/frontier_base/diff.ml b/src/lib/transition_frontier/frontier_base/diff.ml index 970fb39a098..7ced4b3499f 100644 --- a/src/lib/transition_frontier/frontier_base/diff.ml +++ b/src/lib/transition_frontier/frontier_base/diff.ml @@ -67,7 +67,7 @@ module Node_list = struct let to_lite = List.map ~f:(fun { transition; _ } -> - Mina_block.Validated.state_hash transition) + Mina_block.Validated.state_hash transition ) module Lite = struct module Binable_arg = struct @@ -158,7 +158,7 @@ module Root_transition = struct let of_binable ({ new_root; garbage; just_emitted_a_proof } : - Binable_arg.Stable.V4.t) : t = + Binable_arg.Stable.V4.t ) : t = { new_root; garbage; just_emitted_a_proof } end diff --git a/src/lib/transition_frontier/frontier_base/root_data.ml b/src/lib/transition_frontier/frontier_base/root_data.ml index 085f0a78b22..75806f3e344 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.ml +++ b/src/lib/transition_frontier/frontier_base/root_data.ml @@ -151,7 +151,7 @@ module Minimal = struct { Mina_base.State_hash.State_hashes.state_hash ; state_body_hash = None } - }) + } ) in ignore ( Staged_ledger.Scan_state.check_required_protocol_states diff --git a/src/lib/transition_frontier/full_catchup_tree.ml b/src/lib/transition_frontier/full_catchup_tree.ml index d789d7dee93..ecb39349d6e 100644 --- a/src/lib/transition_frontier/full_catchup_tree.ml +++ b/src/lib/transition_frontier/full_catchup_tree.ml @@ -18,7 +18,7 @@ module Attempt_history = struct let to_yojson (t : t) = `Assoc (List.map (Map.to_alist t) ~f:(fun (peer, a) -> - (Peer.to_multiaddr_string peer, Attempt.to_yojson a))) + (Peer.to_multiaddr_string peer, Attempt.to_yojson a) ) ) let empty : t = Peer.Map.empty end @@ -118,14 +118,14 @@ let add_state states (node : Node.t) = | None -> State_hash.Set.singleton node.state_hash | Some hashes -> - State_hash.Set.add hashes node.state_hash) + State_hash.Set.add hashes node.state_hash ) let remove_state states (node : Node.t) = Hashtbl.update states (Node.State.enum node.state) ~f:(function | None -> State_hash.Set.empty | Some hashes -> - State_hash.Set.remove hashes node.state_hash) + State_hash.Set.remove hashes node.state_hash ) (* Invariant: The length of the path from each best tip to its oldest ancestor is at most k *) @@ -148,7 +148,7 @@ let tear_down { nodes; states; _ } = | To_initial_validate _ | To_verify _ | To_build_breadcrumb _ -> - Ivar.fill_if_empty x.result (Error x.attempts)) ; + Ivar.fill_if_empty x.result (Error x.attempts) ) ; Hashtbl.clear nodes ; Hashtbl.clear states @@ -173,7 +173,7 @@ let to_yojson = fun (t : t) -> T.to_yojson @@ List.map (Hashtbl.to_alist t.states) ~f:(fun (state, hashes) -> - (state, (State_hash.Set.length hashes, State_hash.Set.to_list hashes))) + (state, (State_hash.Set.length hashes, State_hash.Set.to_list hashes)) ) type job_states = { finished : int @@ -215,7 +215,7 @@ let to_node_status_report (t : t) = | To_build_breadcrumb -> { acc with to_build_breadcrumb = n } | Root -> - acc) + acc ) let max_catchup_chain_length (t : t) = (* Find the longest directed path *) @@ -245,7 +245,7 @@ let max_catchup_chain_length (t : t) = n in Hashtbl.fold t.nodes ~init:0 ~f:(fun ~key:_ ~data acc -> - Int.max acc (longest_starting_at data)) + Int.max acc (longest_starting_at data) ) let create_node_full t b : unit = let h = Breadcrumb.state_hash b in @@ -322,11 +322,11 @@ let prune t ~root_hash = | None -> false | Some parent -> - reachable_from_root parent) + reachable_from_root parent ) in let to_remove = Hashtbl.fold t.nodes ~init:[] ~f:(fun ~key:_ ~data acc -> - if reachable_from_root data then acc else data :: acc) + if reachable_from_root data then acc else data :: acc ) in List.iter to_remove ~f:(remove_node' t) @@ -347,7 +347,7 @@ let apply_diffs (t : t) (ds : Diff.Full.E.t list) = leak" ; () ) | E (Best_tip_changed _) -> - ()) + () ) let create ~root = let t = diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.ml b/src/lib/transition_frontier/full_frontier/full_frontier.ml index 43ea1877288..c0e94c35724 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.ml +++ b/src/lib/transition_frontier/full_frontier/full_frontier.ml @@ -143,7 +143,7 @@ let create ~logger ~root_data ~root_ledger ~consensus_local_state ~max_length assert ( Frozen_ledger_hash.equal (Frozen_ledger_hash.of_ledger_hash - (Ledger.Any_ledger.M.merkle_root root_ledger)) + (Ledger.Any_ledger.M.merkle_root root_ledger) ) root_blockchain_state_ledger_hash ) ; let root_breadcrumb = Breadcrumb.create ~validated_transition @@ -187,7 +187,7 @@ let successor_hashes t hash = let rec successor_hashes_rec t hash = List.bind (successor_hashes t hash) ~f:(fun succ_hash -> - succ_hash :: successor_hashes_rec t succ_hash) + succ_hash :: successor_hashes_rec t succ_hash ) let successors t breadcrumb = List.map @@ -196,7 +196,7 @@ let successors t breadcrumb = let rec successors_rec t breadcrumb = List.bind (successors t breadcrumb) ~f:(fun succ -> - succ :: successors_rec t succ) + succ :: successors_rec t succ ) let path_map ?max_length t breadcrumb ~f = let rec find_path b count_opt acc = @@ -276,13 +276,13 @@ module Visualizor = struct ; ("error", `String "missing from frontier") ] "Could not visualize state $state_hash: $error" ; - acc_graph)) + acc_graph ) ) end let visualize ~filename (t : t) = Out_channel.with_file filename ~f:(fun output_channel -> let graph = Visualizor.to_graph t in - Visualizor.output_graph output_channel graph) + Visualizor.output_graph output_channel graph ) let visualize_to_string t = let graph = Visualizor.to_graph t in @@ -302,11 +302,11 @@ let calculate_root_transition_diff t heir = let heir_staged_ledger = Breadcrumb.staged_ledger heir in let heir_siblings = List.filter (successors t root) ~f:(fun breadcrumb -> - not (State_hash.equal heir_hash (Breadcrumb.state_hash breadcrumb))) + not (State_hash.equal heir_hash (Breadcrumb.state_hash breadcrumb)) ) in let garbage_breadcrumbs = List.bind heir_siblings ~f:(fun sibling -> - sibling :: successors_rec t sibling) + sibling :: successors_rec t sibling ) |> List.rev in let garbage_nodes = @@ -316,7 +316,7 @@ let calculate_root_transition_diff t heir = let scan_state = Staged_ledger.scan_state (Breadcrumb.staged_ledger breadcrumb) in - { transition; scan_state }) + { transition; scan_state } ) in let protocol_states = Protocol_states_for_root_scan_state.protocol_states_for_next_root_scan_state @@ -337,7 +337,7 @@ let calculate_root_transition_diff t heir = { new_root = new_root_data ; garbage = Full garbage_nodes ; just_emitted_a_proof - }) + } ) let move_root t ~new_root_hash ~new_root_protocol_states ~garbage ~enable_epoch_ledger_sync = @@ -395,7 +395,7 @@ let move_root t ~new_root_hash ~new_root_protocol_states ~garbage (Breadcrumb.consensus_state old_root_node.breadcrumb) (Breadcrumb.consensus_state new_root_node.breadcrumb) ~local_state:t.consensus_local_state ~snarked_ledger - ~genesis_ledger_hash) + ~genesis_ledger_hash ) | `Disabled -> () in @@ -413,12 +413,12 @@ let move_root t ~new_root_hash ~new_root_protocol_states ~garbage ignore ( Ledger.Maskable.unregister_mask_exn ~loc:__LOC__ mask : Ledger.unattached_mask ) ; - Hashtbl.remove t.table hash) ; + Hashtbl.remove t.table hash ) ; (* STEP 2 *) (* go ahead and remove the old root from the frontier *) Hashtbl.remove t.table t.root ; O1trace.sync_thread "commit_frontier_root_snarked_ledger" (fun () -> - Ledger.commit m1) ; + Ledger.commit m1 ) ; [%test_result: Ledger_hash.t] ~message: "Merkle root of new root's staged ledger mask is the same after \ @@ -469,7 +469,7 @@ let move_root t ~new_root_hash ~new_root_protocol_states ~garbage Non_empty_list.iter (Option.value_exn (Staged_ledger.proof_txns_with_state_hashes - (Breadcrumb.staged_ledger new_root_node.breadcrumb))) + (Breadcrumb.staged_ledger new_root_node.breadcrumb) ) ) ~f:(fun (txn, state_hash) -> (*Validate transactions against the protocol state associated with the transaction*) let txn_state_view = @@ -482,8 +482,8 @@ let move_root t ~new_root_hash ~new_root_protocol_states ~garbage (Ledger.apply_transaction ~constraint_constants: t.precomputed_values.constraint_constants ~txn_state_view - mt txn.data) - : Ledger.Transaction_applied.t )) ; + mt txn.data ) + : Ledger.Transaction_applied.t ) ) ; (* STEP 6 *) Ledger.commit mt ; (* STEP 7 *) @@ -551,13 +551,13 @@ let calculate_diffs t breadcrumb = (Logger.extend t.logger [ ( "selection_context" , `String "comparing new breadcrumb to best tip" ) - ])) + ] ) ) `Take then Full.E.E (Best_tip_changed breadcrumb_hash) :: diffs else diffs in (* reverse diffs so that they are applied in the correct order *) - List.rev diffs) + List.rev diffs ) (* TODO: refactor metrics tracking outside of apply_diff (could maybe even be an extension?) *) let apply_diff (type mutant) t (diff : (Diff.full, mutant) Diff.t) @@ -609,20 +609,20 @@ module Metrics = struct let tbl = State_hash.Table.create () in Hashtbl.iter t.table ~f:(fun node -> let b = node.breadcrumb in - Hashtbl.add_multi tbl ~key:(Breadcrumb.parent_hash b) ~data:b) ; + Hashtbl.add_multi tbl ~key:(Breadcrumb.parent_hash b) ~data:b ) ; fun b -> Hashtbl.find_multi tbl (Breadcrumb.state_hash b) in let on_best_tip_path : Breadcrumb.t -> bool = let s = State_hash.Hash_set.create () in List.iter (best_tip_path t) ~f:(fun b -> - Hash_set.add s (Breadcrumb.state_hash b)) ; + Hash_set.add s (Breadcrumb.state_hash b) ) ; fun b -> Hash_set.mem s (Breadcrumb.state_hash b) in let rec longest_fork subtree_root = (* TODO: Make tail recursive *) List.map (children subtree_root) ~f:(fun child -> if on_best_tip_path child then longest_fork child - else 1 + longest_fork child) + else 1 + longest_fork child ) |> List.max_elt ~compare:Int.compare |> Option.value ~default:0 in @@ -636,7 +636,7 @@ module Metrics = struct not (List.is_empty ( Breadcrumb.validated_transition b - |> Mina_block.Validated.valid_commands )) + |> Mina_block.Validated.valid_commands ) ) then acc else match parent t b with None -> acc | Some b -> go (acc + 1) b in @@ -724,7 +724,7 @@ let update_metrics_with_diff (type mutant) t (diff : (Diff.full, mutant) Diff.t) Int.to_float (List.length ( Breadcrumb.validated_transition new_root_breadcrumb - |> Mina_block.Validated.valid_commands )) + |> Mina_block.Validated.valid_commands ) ) in Gauge.dec Transition_frontier.active_breadcrumbs num_breadcrumbs_removed ; Gauge.set Transition_frontier.recently_finalized_staged_txns @@ -772,7 +772,7 @@ let update_metrics_with_diff (type mutant) t (diff : (Diff.full, mutant) Diff.t) (Int.to_float (List.length ( Breadcrumb.validated_transition best_tip - |> Mina_block.Validated.valid_commands ))) ; + |> Mina_block.Validated.valid_commands ) ) ) ; if is_recent_block then Gauge.set Transition_frontier.best_tip_coinbase (if has_coinbase best_tip then 1. else 0.) ; @@ -811,13 +811,13 @@ let apply_diffs t diffs ~enable_epoch_ledger_sync ~has_long_catchup_job = | Some state_hash -> Some { state_hash } in - (new_root, Diff.Full.With_mutant.E (diff, mutant) :: diffs_with_mutants)) + (new_root, Diff.Full.With_mutant.E (diff, mutant) :: diffs_with_mutants) ) in [%log' trace t.logger] "after applying diffs to full frontier" ; if (not ([%equal: [ `Enabled of _ | `Disabled ]] enable_epoch_ledger_sync - `Disabled)) + `Disabled ) ) && not has_long_catchup_job then Debug_assert.debug_assert (fun () -> @@ -826,7 +826,7 @@ let apply_diffs t diffs ~enable_epoch_ledger_sync ~has_long_catchup_job = ~constants:consensus_constants ~consensus_state: (Breadcrumb.consensus_state - (Hashtbl.find_exn t.table t.best_tip).breadcrumb) + (Hashtbl.find_exn t.table t.best_tip).breadcrumb ) ~local_state:t.consensus_local_state with | Some jobs -> @@ -847,7 +847,7 @@ let apply_diffs t diffs ~enable_epoch_ledger_sync ~has_long_catchup_job = failwith "local state desynced after applying diffs to full frontier" ) | None -> - ()) ; + () ) ; `New_root_and_diffs_with_mutants (new_root, diffs_with_mutants) module For_tests = struct @@ -859,7 +859,7 @@ module For_tests = struct failwith (sprintf !"Protocol state with hash %s not found" - (State_body_hash.to_yojson hash |> Yojson.Safe.to_string)) + (State_body_hash.to_yojson hash |> Yojson.Safe.to_string) ) let equal t1 t2 = let sort_breadcrumbs = List.sort ~compare:Breadcrumb.compare in @@ -876,7 +876,7 @@ module For_tests = struct let%map successors2 = get_successor_nodes t2 breadcrumb2 in List.equal State_hash.equal (successors1 |> List.sort ~compare:State_hash.compare) - (successors2 |> List.sort ~compare:State_hash.compare)) + (successors2 |> List.sort ~compare:State_hash.compare) ) |> Option.value_map ~default:false ~f:Fn.id in List.equal equal_breadcrumb diff --git a/src/lib/transition_frontier/persistent_frontier/.ocamlformat b/src/lib/transition_frontier/persistent_frontier/.ocamlformat index 9a9f9a6031c..1b2264a8390 100644 --- a/src/lib/transition_frontier/persistent_frontier/.ocamlformat +++ b/src/lib/transition_frontier/persistent_frontier/.ocamlformat @@ -4,9 +4,7 @@ max-iters=10 comment-check=true wrap-fun-args=true wrap-comments=false -type-decl-indent=2 type-decl=compact -stritem-extension-indent=0 space-around-variants=true space-around-records=true space-around-lists=true @@ -15,52 +13,34 @@ single-case=compact sequence-style=separator sequence-blank-line=preserve-one parse-docstrings=false -parens-tuple-patterns=multi-line-only parens-tuple=always parens-ite=false ocp-indent-compat=false -nested-match=wrap module-item-spacing=sparse max-indent=68 -match-indent-nested=never -match-indent=0 margin=80 -let-open=preserve let-module=compact let-binding-spacing=compact -let-binding-indent=2 let-and=compact leading-nested-match-parens=false infix-precedence=indent indicate-nested-or-patterns=space indicate-multiline-delimiters=space -indent-after-in=0 if-then-else=compact -function-indent-nested=never -function-indent=2 field-space=loose -extension-indent=2 exp-grouping=parens dock-collection-brackets=false doc-comments-tag-only=default doc-comments-padding=2 doc-comments=before -disambiguate-non-breaking-match=false disable=false cases-matching-exp-indent=normal cases-exp-indent=4 -break-struct=force -break-string-literals=auto break-sequences=false break-separators=before break-infix-before-func=true break-infix=wrap break-fun-sig=wrap break-fun-decl=wrap -break-collection-expressions=fit-or-vertical break-cases=nested -break-before-in=fit-or-vertical assignment-operator=end-line -align-variants-decl=false -align-constructors-decl=false -align-cases=false diff --git a/src/lib/transition_frontier/persistent_frontier/database.ml b/src/lib/transition_frontier/persistent_frontier/database.ml index d444cb2cfa8..0e6c9b53c24 100644 --- a/src/lib/transition_frontier/persistent_frontier/database.ml +++ b/src/lib/transition_frontier/persistent_frontier/database.ml @@ -91,7 +91,7 @@ module Schema = struct -> a t Bin_prot.Type_class.t = fun (module M) ~to_gadt ~of_gadt -> let ({ shape; writer = { size; write }; reader = { read; vtag_read } } - : data Bin_prot.Type_class.t) = + : data Bin_prot.Type_class.t ) = [%bin_type_class: M.t] in { shape @@ -103,7 +103,7 @@ module Schema = struct { read = (fun buffer ~pos_ref -> to_gadt (read buffer ~pos_ref)) ; vtag_read = (fun buffer ~pos_ref number -> - to_gadt (vtag_read buffer ~pos_ref number)) + to_gadt (vtag_read buffer ~pos_ref number) ) } } @@ -142,7 +142,7 @@ module Schema = struct (module Keys.String) ~to_gadt:(fun _ -> Protocol_states_for_root_scan_state) ~of_gadt:(fun Protocol_states_for_root_scan_state -> - "protocol_states_in_root_scan_state") + "protocol_states_in_root_scan_state" ) end module Error = struct @@ -193,7 +193,7 @@ module Error = struct in let additional_context = Option.map member_id ~f:(fun id -> - Printf.sprintf " (hash = %s)" (State_hash.raw_hash_bytes id)) + Printf.sprintf " (hash = %s)" (State_hash.raw_hash_bytes id) ) |> Option.value ~default:"" in Printf.sprintf "%s not found%s" member_name additional_context @@ -276,7 +276,7 @@ let check t ~genesis_state_hash = get t.db ~key:(Transition succ_hash) ~error:(`Corrupt (`Not_found (`Transition succ_hash))) in - check_arcs succ_hash) + check_arcs succ_hash ) in let%bind () = check_version () in let%bind root_hash, root_transition = check_base () in @@ -295,7 +295,7 @@ let check t ~genesis_state_hash = let%map () = check_arcs root_hash in root_block |> Mina_block.header |> Header.protocol_state |> Mina_state.Protocol_state.blockchain_state - |> Mina_state.Blockchain_state.snarked_ledger_hash) + |> Mina_state.Blockchain_state.snarked_ledger_hash ) |> Result.map_error ~f:(fun err -> `Corrupt (`Raised err)) |> Result.join @@ -320,7 +320,7 @@ let initialize t ~root_data = Batch.set batch ~key:Root ~data:(Root_data.Minimal.of_limited root_data) ; Batch.set batch ~key:Best_tip ~data:root_state_hash ; Batch.set batch ~key:Protocol_states_for_root_scan_state - ~data:(protocol_states root_data |> List.map ~f:With_hash.data)) + ~data:(protocol_states root_data |> List.map ~f:With_hash.data) ) let add t ~transition:(transition, _validation) = let hash = State_hash.With_state_hashes.state_hash transition in @@ -342,7 +342,7 @@ let add t ~transition:(transition, _validation) = Batch.with_batch t.db ~f:(fun batch -> Batch.set batch ~key:(Transition hash) ~data:raw_transition ; Batch.set batch ~key:(Arcs hash) ~data:[] ; - Batch.set batch ~key:(Arcs parent_hash) ~data:(hash :: parent_arcs)) + Batch.set batch ~key:(Arcs parent_hash) ~data:(hash :: parent_arcs) ) let move_root t ~new_root ~garbage = let open Root_data.Limited in @@ -367,7 +367,7 @@ let move_root t ~new_root ~garbage = * parents as well *) Batch.remove batch ~key:(Transition node_hash) ; - Batch.remove batch ~key:(Arcs node_hash))) ; + Batch.remove batch ~key:(Arcs node_hash) ) ) ; old_root_hash let get_transition t hash = @@ -420,4 +420,4 @@ let rec crawl_successors t hash ~init ~f = Deferred.map (f init transition) ~f:(Result.map_error ~f:(fun err -> `Crawl_error err)) in - crawl_successors t succ_hash ~init:init' ~f) + crawl_successors t succ_hash ~init:init' ~f ) diff --git a/src/lib/transition_frontier/persistent_frontier/diff_buffer.ml b/src/lib/transition_frontier/persistent_frontier/diff_buffer.ml index 865eafc160e..c9ee48b049e 100644 --- a/src/lib/transition_frontier/persistent_frontier/diff_buffer.ml +++ b/src/lib/transition_frontier/persistent_frontier/diff_buffer.ml @@ -35,13 +35,13 @@ module Timer = struct t.timeout <- Some (Timeout.create t.time_controller t.span ~f:(fun _ -> - t.f () ; run_timeout t)) + t.f () ; run_timeout t ) ) in run_timeout t let stop t = Option.iter t.timeout ~f:(fun timeout -> - Timeout.cancel t.time_controller timeout ()) ; + Timeout.cancel t.time_controller timeout () ) ; t.timeout <- None let reset t = stop t ; start t diff --git a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml index c7d19cdcd71..f3729c4a94d 100644 --- a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml +++ b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml @@ -23,7 +23,7 @@ let construct_staged_ledger_at_root ~(precomputed_values : Precomputed_values.t) List.fold protocol_states ~init:State_hash.Map.empty ~f:(fun acc protocol_state -> Map.add_exn acc ~key:(Protocol_state.hashes protocol_state).state_hash - ~data:protocol_state) + ~data:protocol_state ) in let get_state hash = match Map.find protocol_states_map hash with @@ -72,7 +72,7 @@ let construct_staged_ledger_at_root ~(precomputed_values : Precomputed_values.t) !"Constructed staged ledger %{sexp: Staged_ledger_hash.t} did not \ match the staged ledger hash in the protocol state %{sexp: \ Staged_ledger_hash.t}" - constructed_staged_ledger_hash staged_ledger_hash) + constructed_staged_ledger_hash staged_ledger_hash ) module rec Instance_type : sig type t = @@ -120,18 +120,18 @@ module Instance = struct Some (Sync.create ~constraint_constants ~logger:t.factory.logger ~time_controller:t.factory.time_controller ~db:t.db - ~persistent_root_instance) + ~persistent_root_instance ) let stop_sync t = let open Deferred.Let_syntax in assert_sync t ~f:(fun sync -> let%map () = Sync.close sync in t.sync <- None ; - Ok ()) + Ok () ) let notify_sync t ~diffs = assert_sync t ~f:(fun sync -> - Sync.notify sync ~diffs ; Deferred.Result.return ()) + Sync.notify sync ~diffs ; Deferred.Result.return () ) let destroy t = let open Deferred.Let_syntax in @@ -207,7 +207,7 @@ module Instance = struct in (root, root_transition, best_tip, protocol_states, root_hash)) |> Result.map_error ~f:(fun err -> - `Failure (Database.Error.not_found_message err)) + `Failure (Database.Error.not_found_message err) ) |> Deferred.return in let root_genesis_state_hash = @@ -241,7 +241,7 @@ module Instance = struct ~root_ledger: (Mina_ledger.Ledger.Any_ledger.cast (module Mina_ledger.Ledger.Db) - root_ledger) + root_ledger ) ~consensus_local_state ~max_length ~precomputed_values ~persistent_root_instance in @@ -287,7 +287,7 @@ module Instance = struct ~sender:None ~transition_receipt_time () in let%map () = apply_diff Diff.(E (New_node (Full breadcrumb))) in - breadcrumb)) + breadcrumb ) ) ~f: (Result.map_error ~f:(function | `Crawl_error err -> @@ -304,7 +304,7 @@ module Instance = struct ( "error rebuilding transition frontier from persistence: " ^ msg ) | `Not_found _ as err -> - `Failure (Database.Error.not_found_message err))) + `Failure (Database.Error.not_found_message err) ) ) in let%map () = apply_diff Diff.(E (Best_tip_changed best_tip)) in (frontier, extensions) @@ -358,6 +358,6 @@ let reset_database_exn t ~root_data ~genesis_state_hash = | `Genesis_state_mismatch _ -> "genesis state mismatch" | `Corrupt err -> - Database.Error.message err) + Database.Error.message err ) |> Result.ok_or_failwith - : Frozen_ledger_hash.t ))) + : Frozen_ledger_hash.t ) ) ) diff --git a/src/lib/transition_frontier/persistent_frontier/worker.ml b/src/lib/transition_frontier/persistent_frontier/worker.ml index a174dbed1ee..e2f09fdb794 100644 --- a/src/lib/transition_frontier/persistent_frontier/worker.ml +++ b/src/lib/transition_frontier/persistent_frontier/worker.ml @@ -67,7 +67,7 @@ module Worker = struct Result.map_error result ~f:(fun err -> [%log' error t.logger] "error applying %s diff: %s" diff_type_name (apply_diff_error_internal_to_string err) ; - `Apply_diff diff_type) + `Apply_diff diff_type ) in match diff with | New_node (Lite transition) -> ( @@ -87,7 +87,7 @@ module Worker = struct [ ( "hash" , `String (State_hash.to_base58_check - (Mina_block.Validated.state_hash transition)) ) + (Mina_block.Validated.state_hash transition) ) ) ; ("parent", `String (State_hash.to_base58_check h)) ] ; Ok () @@ -135,7 +135,7 @@ module Worker = struct * applied during the same scheduler cycle. *) deferred_result_list_fold input ~init:() ~f:(fun () diff -> - Deferred.return (handle_diff t diff)) + Deferred.return (handle_diff t diff) ) with | Ok () -> () diff --git a/src/lib/transition_frontier/persistent_root/persistent_root.ml b/src/lib/transition_frontier/persistent_root/persistent_root.ml index 9540fed44db..e577884e04e 100644 --- a/src/lib/transition_frontier/persistent_root/persistent_root.ml +++ b/src/lib/transition_frontier/persistent_root/persistent_root.ml @@ -183,12 +183,12 @@ module Instance = struct Stop None ) else ( Ledger.Db.close potential_snarked_ledger ; - Continue None )) + Continue None ) ) ~finish:(fun _ -> List.iter potential_snarked_ledgers ~f:File_system.rmrf ; File_system.rmrf (Locations.potential_snarked_ledgers factory.directory) ; - None) + None ) in match snarked_ledger with | None -> @@ -234,7 +234,7 @@ module Instance = struct ignore ( Root_identifier.Stable.Latest.bin_write_t buf ~pos:0 new_root_identifier - : int )) + : int ) ) (* defaults to genesis *) let load_root_identifier t = @@ -252,7 +252,7 @@ module Instance = struct [ ("root_identifier", Root_identifier.to_yojson root_identifier) ] "Loaded persistent root identifier" ; - Some root_identifier) + Some root_identifier ) let set_root_state_hash t state_hash = set_root_identifier t { state_hash } end @@ -288,11 +288,11 @@ let reset_to_genesis_exn t ~precomputed_values = ( Ledger_transfer.transfer_accounts ~src: (Lazy.force - (Precomputed_values.genesis_ledger precomputed_values)) + (Precomputed_values.genesis_ledger precomputed_values) ) ~dest:(Instance.snarked_ledger instance) : Ledger.Db.t Or_error.t ) ; Instance.set_root_identifier instance (genesis_root_identifier ~genesis_state_hash: (Precomputed_values.genesis_state_hashes precomputed_values) - .state_hash)) + .state_hash ) ) diff --git a/src/lib/transition_frontier/tests/full_frontier_tests.ml b/src/lib/transition_frontier/tests/full_frontier_tests.ml index 227d1e1d41d..8ac9e4ab0da 100644 --- a/src/lib/transition_frontier/tests/full_frontier_tests.ml +++ b/src/lib/transition_frontier/tests/full_frontier_tests.ml @@ -28,7 +28,7 @@ let%test_module "Full_frontier tests" = Async.Thread_safe.block_on_async_exn (fun () -> Verifier.create ~logger ~proof_level ~constraint_constants ~conf_dir:None - ~pids:(Child_processes.Termination.create_pid_table ())) + ~pids:(Child_processes.Termination.create_pid_table ()) ) module Genesis_ledger = (val precomputed_values.genesis_ledger) @@ -70,13 +70,13 @@ let%test_module "Full_frontier tests" = ~epoch_ledger_location ~ledger_depth:constraint_constants.ledger_depth ~genesis_state_hash: (State_hash.With_state_hashes.state_hash - precomputed_values.protocol_state_with_hashes) + precomputed_values.protocol_state_with_hashes ) in let root_ledger = Or_error.ok_exn (Transfer.transfer_accounts ~src:(Lazy.force Genesis_ledger.t) - ~dest:(Mina_ledger.Ledger.create ~depth:ledger_depth ())) + ~dest:(Mina_ledger.Ledger.create ~depth:ledger_depth ()) ) in Protocol_version.(set_current zero) ; let root_data = @@ -102,7 +102,7 @@ let%test_module "Full_frontier tests" = ~root_ledger: (Mina_ledger.Ledger.Any_ledger.cast (module Mina_ledger.Ledger) - root_ledger) + root_ledger ) ~consensus_local_state ~max_length ~precomputed_values ~time_controller:(Block_time.Controller.basic ~logger) ~persistent_root_instance @@ -125,7 +125,7 @@ let%test_module "Full_frontier tests" = (Breadcrumb.state_hash breadcrumb) in [%test_eq: Breadcrumb.t] breadcrumb queried_breadcrumb ; - clean_up_persistent_root ~frontier)) + clean_up_persistent_root ~frontier ) ) let%test_unit "Constructing a better branch should change the best tip" = let gen_branches = @@ -161,7 +161,7 @@ let%test_module "Full_frontier tests" = test_best_tip (List.last_exn long_branch) ~message:"best tip should change when all of best tip is added" ; - clean_up_persistent_root ~frontier)) + clean_up_persistent_root ~frontier ) ) let%test_unit "The root should be updated after (> max_length) nodes are \ added in sequence" = @@ -169,7 +169,7 @@ let%test_module "Full_frontier tests" = let test_not_eq ?message = let message = Option.map message ~f:(fun m -> "not " ^ m) in [%test_eq: Breadcrumb.t] ?message ~equal:(fun a b -> - not (Breadcrumb.equal a b)) + not (Breadcrumb.equal a b) ) in Quickcheck.test (gen_breadcrumb_seq (max_length * 2)) @@ -194,8 +194,8 @@ let%test_module "Full_frontier tests" = ~message: "roots should be the same before max_length \ breadcrumbs" ; - i + 1) ; - clean_up_persistent_root ~frontier)) + i + 1 ) ; + clean_up_persistent_root ~frontier ) ) let%test_unit "Protocol states are available for every transaction in the \ frontier" = @@ -219,8 +219,8 @@ let%test_module "Full_frontier tests" = ignore ( Full_frontier.For_tests.find_protocol_state_exn frontier hash - : Mina_state.Protocol_state.value ))) ; - clean_up_persistent_root ~frontier)) + : Mina_state.Protocol_state.value ) ) ) ; + clean_up_persistent_root ~frontier ) ) let%test_unit "The length of the longest branch should never be greater \ than max_length" = @@ -238,8 +238,8 @@ let%test_module "Full_frontier tests" = [%test_pred: int] (( >= ) max_length) (List.length Full_frontier.( - path_map frontier (best_tip frontier) ~f:Fn.id))) ; - clean_up_persistent_root ~frontier)) + path_map frontier (best_tip frontier) ~f:Fn.id) ) ) ; + clean_up_persistent_root ~frontier ) ) let%test_unit "Common ancestor can be reliably found" = let ancestor_length = (max_length / 2) - 1 in @@ -271,5 +271,5 @@ let%test_module "Full_frontier tests" = [%test_eq: State_hash.t] (Full_frontier.common_ancestor frontier tip_a tip_b) (Breadcrumb.state_hash youngest_ancestor) ; - clean_up_persistent_root ~frontier)) + clean_up_persistent_root ~frontier ) ) end ) diff --git a/src/lib/transition_frontier/transition_frontier.ml b/src/lib/transition_frontier/transition_frontier.ml index de371794e90..9450e9138fc 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -63,7 +63,7 @@ let genesis_root_data ~precomputed_values = let pending_coinbase = Or_error.ok_exn (Pending_coinbase.create - ~depth:constraint_constants.pending_coinbase_depth ()) + ~depth:constraint_constants.pending_coinbase_depth () ) in Root_data.Limited.create ~transition ~scan_state ~pending_coinbase ~protocol_states @@ -111,13 +111,13 @@ let load_from_persistence_and_start ~logger ~verifier ~consensus_local_state ~root_ledger: (Persistent_root.Instance.snarked_ledger persistent_root_instance) ~consensus_local_state ~ignore_consensus_local_state - ~precomputed_values ~persistent_root_instance) + ~precomputed_values ~persistent_root_instance ) ~f: (Result.map_error ~f:(function | `Sync_cannot_be_running -> `Failure "sync job is already running on persistent frontier" | `Failure _ as err -> - err)) + err ) ) in [%log info] "Loaded full frontier and extensions" ; let%map () = @@ -130,7 +130,7 @@ let load_from_persistence_and_start ~logger ~verifier ~consensus_local_state `Failure "sync job is already running on persistent frontier" | `Not_found _ as err -> `Failure - (Persistent_frontier.Database.Error.not_found_message err)) ) + (Persistent_frontier.Database.Error.not_found_message err) ) ) in { logger ; catchup_tree = @@ -211,7 +211,7 @@ let rec load_with_max_length : ~root_data:(genesis_root_data ~precomputed_values) ~genesis_state_hash: (State_hash.With_state_hashes.state_hash - precomputed_values.protocol_state_with_hashes) + precomputed_values.protocol_state_with_hashes ) in Persistent_root.reset_to_genesis_exn persistent_root ~precomputed_values ; let genesis_ledger_hash = @@ -227,7 +227,7 @@ let rec load_with_max_length : Persistent_frontier.Instance.check_database ~genesis_state_hash: (State_hash.With_state_hashes.state_hash - precomputed_values.protocol_state_with_hashes) + precomputed_values.protocol_state_with_hashes ) persistent_frontier_instance with | Error `Not_initialized -> @@ -249,7 +249,7 @@ let rec load_with_max_length : ; ( "precomputed_state_hash" , State_hash.to_yojson (State_hash.With_state_hashes.state_hash - precomputed_values.protocol_state_with_hashes) ) + precomputed_values.protocol_state_with_hashes ) ) ] ; reset_and_continue () | Error (`Corrupt err) -> @@ -273,7 +273,7 @@ let rec load_with_max_length : "failed to destroy and create new persistent frontier \ database" | err -> - err) ) + err ) ) else return (Error `Persistent_frontier_malformed) | Ok snarked_ledger_hash -> ( match%bind @@ -355,7 +355,7 @@ let add_breadcrumb_exn t breadcrumb = (Applying_diffs { diffs = List.map ~f:Diff.Full.E.to_yojson diffs }) ; Catchup_tree.apply_diffs t.catchup_tree diffs ; let (`New_root_and_diffs_with_mutants - (new_root_identifier, diffs_with_mutants)) = + (new_root_identifier, diffs_with_mutants) ) = (* Root DB moves here *) Full_frontier.apply_diffs t.full_frontier diffs ~has_long_catchup_job: @@ -385,7 +385,7 @@ let add_breadcrumb_exn t breadcrumb = [ ( "user_commands" , `List (List.map user_cmds - ~f:(With_status.to_yojson User_command.Valid.to_yojson)) ) + ~f:(With_status.to_yojson User_command.Valid.to_yojson) ) ) ; ("state_hash", State_hash.to_yojson (Breadcrumb.state_hash breadcrumb)) ] ; let lite_diffs = @@ -401,7 +401,7 @@ let add_breadcrumb_exn t breadcrumb = Failure "Cannot add breadcrumb because persistent frontier sync job is not \ running, which indicates that transition frontier initialization \ - has not been performed correctly") + has not been performed correctly" ) |> Result.ok_exn ; Extensions.notify t.extensions ~frontier:t.full_frontier ~diffs_with_mutants @@ -542,11 +542,12 @@ module For_tests = struct ) ~snarked_ledger:genesis_ledger ~snarked_local_state:(Mina_state.Local_state.empty ()) - ~expected_merkle_root:(Ledger.merkle_root genesis_ledger))) + ~expected_merkle_root:(Ledger.merkle_root genesis_ledger) ) + ) in Breadcrumb.create ~validated_transition:genesis_transition ~staged_ledger:genesis_staged_ledger ~just_emitted_a_proof:false - ~transition_receipt_time) + ~transition_receipt_time ) let gen_persistence ?(logger = Logger.null ()) ~verifier ~(precomputed_values : Precomputed_values.t) () = @@ -568,7 +569,7 @@ module For_tests = struct | `Exit_non_zero n -> Printf.sprintf "error (exit code %d)" n | `Signal _ -> - "error (received unexpected signal)") + "error (received unexpected signal)" ) |> Result.ok_or_failwith ; cleaned := true ) in @@ -589,11 +590,11 @@ module For_tests = struct Option.iter persistent_frontier.Persistent_frontier.Factory_type.instance ~f:(fun instance -> - Persistent_frontier.Database.close instance.db) ; + Persistent_frontier.Database.close instance.db ) ; Option.iter persistent_root.Persistent_root.Factory_type.instance ~f:(fun instance -> Ledger.Db.close instance.snarked_ledger) ; - clean_temp_dirs x) ; - (persistent_root, persistent_frontier)) + clean_temp_dirs x ) ; + (persistent_root, persistent_frontier) ) let gen_genesis_breadcrumb_with_protocol_states ~logger ~verifier ~precomputed_values () = @@ -633,7 +634,7 @@ module For_tests = struct ~ledger_depth:precomputed_values.constraint_constants.ledger_depth ~genesis_state_hash: (State_hash.With_state_hashes.state_hash - precomputed_values.protocol_state_with_hashes)) + precomputed_values.protocol_state_with_hashes ) ) in let root_snarked_ledger, root_ledger_accounts = root_ledger_and_accounts in (* TODO: ensure that rose_tree cannot be longer than k *) @@ -645,7 +646,7 @@ module For_tests = struct (Quickcheck.Generator.return root) (Breadcrumb.For_tests.gen_non_deferred ~logger ~precomputed_values ~verifier ~trust_system - ~accounts_with_secret_keys:root_ledger_accounts)) + ~accounts_with_secret_keys:root_ledger_accounts ) ) in (root, branches, protocol_states) in @@ -667,7 +668,7 @@ module For_tests = struct Persistent_frontier.reset_database_exn persistent_frontier ~root_data ~genesis_state_hash: (State_hash.With_state_hashes.state_hash - precomputed_values.protocol_state_with_hashes)) ; + precomputed_values.protocol_state_with_hashes ) ) ; Persistent_root.with_instance_exn persistent_root ~f:(fun instance -> let transition = Root_data.Limited.transition root_data in Persistent_root.Instance.set_root_state_hash instance @@ -675,7 +676,7 @@ module For_tests = struct @@ External_transition.Validated.lower transition ) ; ignore @@ Ledger_transfer.transfer_accounts ~src:root_snarked_ledger - ~dest:(Persistent_root.Instance.snarked_ledger instance)) ; + ~dest:(Persistent_root.Instance.snarked_ledger instance) ) ; let frontier_result = Async.Thread_safe.block_on_async_exn (fun () -> load_with_max_length ~max_length ~retry_with_fresh_db:false ~logger @@ -688,7 +689,7 @@ module For_tests = struct `Normal | None -> `Normal ) - ~persistent_frontier ~precomputed_values ()) + ~persistent_frontier ~precomputed_values () ) in let frontier = let fail msg = failwith ("failed to load transition frontier: " ^ msg) in @@ -706,7 +707,7 @@ module For_tests = struct in Async.Thread_safe.block_on_async_exn (fun () -> Deferred.List.iter ~how:`Sequential branches - ~f:(deferred_rose_tree_iter ~f:(add_breadcrumb_exn frontier))) ; + ~f:(deferred_rose_tree_iter ~f:(add_breadcrumb_exn frontier)) ) ; Core.Gc.Expert.add_finalizer_exn consensus_local_state (fun consensus_local_state -> Consensus.Data.Local_state.( @@ -714,7 +715,7 @@ module For_tests = struct @@ staking_epoch_ledger consensus_local_state) ; Consensus.Data.Local_state.( Snapshot.Ledger_snapshot.close - @@ next_epoch_ledger consensus_local_state)) ; + @@ next_epoch_ledger consensus_local_state) ) ; frontier let gen_with_branch ?logger ~verifier ?trust_system ?consensus_local_state @@ -738,7 +739,7 @@ module For_tests = struct in let branch = Async.Thread_safe.block_on_async_exn (fun () -> - make_branch (get_branch_root frontier)) + make_branch (get_branch_root frontier) ) in (frontier, branch) end diff --git a/src/lib/transition_frontier_controller/transition_frontier_controller.ml b/src/lib/transition_frontier_controller/transition_frontier_controller.ml index 9364708adc8..15c647b1ab2 100644 --- a/src/lib/transition_frontier_controller/transition_frontier_controller.ml +++ b/src/lib/transition_frontier_controller/transition_frontier_controller.ml @@ -28,7 +28,7 @@ let run ~logger ~trust_system ~verifier ~network ~time_controller Counter.inc_one Pipe.Drop_on_overflow .transition_frontier_valid_transitions) ; - f_drop_head name head vc)) )) + f_drop_head name head vc ) ) ) ) in let primary_transition_pipe_capacity = valid_transition_pipe_capacity + List.length collected_transitions @@ -46,7 +46,7 @@ let run ~logger ~trust_system ~verifier ~network ~time_controller Counter.inc_one Pipe.Drop_on_overflow .transition_frontier_primary_transitions) ; - f_drop_head name head vc)) )) + f_drop_head name head vc ) ) ) ) in let processed_transition_reader, processed_transition_writer = Strict_pipe.create ~name:"processed transitions" @@ -72,12 +72,12 @@ let run ~logger ~trust_system ~verifier ~network ~time_controller unprocessed_transition_cache t in Strict_pipe.Writer.write primary_transition_writer - (`Block block_cached, `Valid_cb None)) ; + (`Block block_cached, `Valid_cb None) ) ; let initial_state_hashes = List.map collected_transitions ~f:(fun envelope -> Network_peer.Envelope.Incoming.data envelope |> Validation.block_with_hash - |> Mina_base.State_hash.With_state_hashes.state_hash) + |> Mina_base.State_hash.With_state_hashes.state_hash ) |> Mina_base.State_hash.Set.of_list in let extensions = Transition_frontier.extensions frontier in @@ -96,7 +96,7 @@ let run ~logger ~trust_system ~verifier ~network ~time_controller Mina_metrics.( Gauge.set Catchup.initial_catchup_time Time.(Span.to_min @@ diff (now ()) start_time)) ; - Deferred.return true )) ; + Deferred.return true ) ) ; Transition_handler.Validator.run ~consensus_constants: (Precomputed_values.consensus_constants precomputed_values) @@ -105,7 +105,7 @@ let run ~logger ~trust_system ~verifier ~network ~time_controller ~unprocessed_transition_cache ; Strict_pipe.Reader.iter_without_pushback valid_transition_reader ~f:(fun (`Block b, `Valid_cb vc) -> - Strict_pipe.Writer.write primary_transition_writer (`Block b, `Valid_cb vc)) + Strict_pipe.Writer.write primary_transition_writer (`Block b, `Valid_cb vc) ) |> don't_wait_for ; let clean_up_catchup_scheduler = Ivar.create () in Transition_handler.Processor.run ~logger ~precomputed_values ~time_controller @@ -125,6 +125,6 @@ let run ~logger ~trust_system ~verifier ~network ~time_controller kill catchup_breadcrumbs_writer ; if Ivar.is_full clean_up_catchup_scheduler then [%log error] "Ivar.fill bug is here!" ; - Ivar.fill clean_up_catchup_scheduler ()) + Ivar.fill clean_up_catchup_scheduler () ) |> don't_wait_for ; processed_transition_reader diff --git a/src/lib/transition_handler/block_sink.ml b/src/lib/transition_handler/block_sink.ml index fa2da3d820f..97efa8a17f2 100644 --- a/src/lib/transition_handler/block_sink.ml +++ b/src/lib/transition_handler/block_sink.ml @@ -72,7 +72,7 @@ let push sink (`Transition e, `Time_received tm, `Valid_cb cb) = Mina_block.( header state |> Header.protocol_state |> Protocol_state.blockchain_state |> Blockchain_state.timestamp - |> Block_time.to_time)) ; + |> Block_time.to_time) ) ; Mina_metrics.(Gauge.inc_one Network.new_state_received) ; if log_gossip_heard then [%str_log info] @@ -84,7 +84,7 @@ let push sink (`Transition e, `Time_received tm, `Valid_cb cb) = |> Protocol_state.hashes) .state_hash ; sender = Envelope.Incoming.sender e - }) ; + } ) ; Mina_net2.Validation_callback.set_message_type cb `Block ; Mina_metrics.(Counter.inc_one Network.Block.received) ; let sender = Envelope.Incoming.sender e in @@ -121,7 +121,7 @@ let push sink (`Transition e, `Time_received tm, `Valid_cb cb) = let tm_slot = lift_consensus_time (Consensus.Data.Consensus_time.of_time_exn - ~constants:consensus_constants tm) + ~constants:consensus_constants tm ) in Mina_metrics.Block_latency.Gossip_slots.update (Float.of_int (tm_slot - tn_production_slot)) ; @@ -134,7 +134,7 @@ let log_rate_limiter_occasionally rl ~logger ~label = every t (fun () -> [%log' debug logger] ~metadata:[ ("rate_limiter", Network_pool.Rate_limiter.summary rl) ] - !"%s $rate_limiter" label) + !"%s $rate_limiter" label ) let create { logger diff --git a/src/lib/transition_handler/block_sink.mli b/src/lib/transition_handler/block_sink.mli index 4483ace2482..7bf7f4f4308 100644 --- a/src/lib/transition_handler/block_sink.mli +++ b/src/lib/transition_handler/block_sink.mli @@ -8,9 +8,9 @@ type Structured_log_events.t += include Mina_net2.Sink.S_with_void with type msg := - [ `Transition of Mina_block.t Envelope.Incoming.t ] - * [ `Time_received of Block_time.t ] - * [ `Valid_cb of Mina_net2.Validation_callback.t ] + [ `Transition of Mina_block.t Envelope.Incoming.t ] + * [ `Time_received of Block_time.t ] + * [ `Valid_cb of Mina_net2.Validation_callback.t ] type block_sink_config = { logger : Logger.t diff --git a/src/lib/transition_handler/breadcrumb_builder.ml b/src/lib/transition_handler/breadcrumb_builder.ml index c070441ed30..41aa1d4336b 100644 --- a/src/lib/transition_handler/breadcrumb_builder.ml +++ b/src/lib/transition_handler/breadcrumb_builder.ml @@ -32,8 +32,9 @@ let build_subtrees_of_breadcrumbs ~logger ~precomputed_values ~verifier |> Envelope.Incoming.data in Mina_base.State_hash.( - to_yojson (With_state_hashes.state_hash transition))) - subtree)) ) + to_yojson (With_state_hashes.state_hash transition)) + ) + subtree ) ) ) ] "Transition frontier already garbage-collected the parent of \ $state_hash" ; @@ -47,7 +48,7 @@ let build_subtrees_of_breadcrumbs ~logger ~precomputed_values ~verifier let%bind init_breadcrumb = breadcrumb_if_present (Logger.extend logger - [ ("Check", `String "Before creating breadcrumb") ]) + [ ("Check", `String "Before creating breadcrumb") ] ) |> Deferred.return in Rose_tree.Deferred.Or_error.fold_map_over_subtrees @@ -89,12 +90,11 @@ let build_subtrees_of_breadcrumbs ~logger ~precomputed_values ~verifier let%bind () = Deferred.return (Result.ok_if_true - (State_hash.equal actual_parent_hash - expected_parent_hash) + (State_hash.equal actual_parent_hash expected_parent_hash) ~error: (Error.of_string "Previous external transition hash does not equal \ - to current external transition's parent hash")) + to current external transition's parent hash" ) ) in let open Deferred.Let_syntax in match%bind @@ -102,7 +102,7 @@ let build_subtrees_of_breadcrumbs ~logger ~precomputed_values ~verifier Transition_frontier.Breadcrumb.build ~logger ~precomputed_values ~verifier ~trust_system ~parent ~transition:mostly_validated_transition - ~sender:(Some sender) ~transition_receipt_time ()) + ~sender:(Some sender) ~transition_receipt_time () ) with | Error _ -> Deferred.return @@ Or_error.error_string missing_parent_msg @@ -120,9 +120,9 @@ let build_subtrees_of_breadcrumbs ~logger ~precomputed_values ~verifier (Logger.extend logger [ ( "Check" , `String "After creating breadcrumb" ) - ]) + ] ) in - new_breadcrumb) + new_breadcrumb ) | Error err -> ( (* propagate bans through subtree *) let subtree_nodes = Rose_tree.flatten subtree in @@ -139,7 +139,7 @@ let build_subtrees_of_breadcrumbs ~logger ~precomputed_values ~verifier "build_subtrees_of_breadcrumbs: sender of \ external transition should not be Local" | Remote peer -> - Set.add inet_addrs peer) + Set.add inet_addrs peer ) in let ip_addresses = Set.to_list ip_address_set in let trust_system_record_invalid msg error = @@ -148,7 +148,7 @@ let build_subtrees_of_breadcrumbs ~logger ~precomputed_values ~verifier Trust_system.record trust_system logger ip_addr ( Trust_system.Actions .Gossiped_invalid_transition - , Some (msg, []) )) + , Some (msg, []) ) ) in Error error in @@ -160,7 +160,7 @@ let build_subtrees_of_breadcrumbs ~logger ~precomputed_values ~verifier trust_system_record_invalid "invalid staged ledger diff" error | `Fatal_error exn -> - Deferred.return (Or_error.of_exn exn) ) )) + Deferred.return (Or_error.of_exn exn) ) ) ) |> Cached.sequence_deferred in - Cached.sequence_result cached_result)) + Cached.sequence_result cached_result ) ) diff --git a/src/lib/transition_handler/catchup_scheduler.ml b/src/lib/transition_handler/catchup_scheduler.ml index b2a4e89e7f8..703f2904389 100644 --- a/src/lib/transition_handler/catchup_scheduler.ml +++ b/src/lib/transition_handler/catchup_scheduler.ml @@ -70,22 +70,22 @@ let create ~logger ~precomputed_values ~verifier ~trust_system ~frontier list , crash buffered , unit ) - Writer.t) + Writer.t ) ~(catchup_breadcrumbs_writer : ( (Transition_frontier.Breadcrumb.t, State_hash.t) Cached.t Rose_tree.t list * [ `Ledger_catchup of unit Ivar.t | `Catchup_scheduler ] , crash buffered , unit ) - Writer.t) ~clean_up_signal = + Writer.t ) ~clean_up_signal = let collected_transitions = State_hash.Table.create () in let parent_root_timeouts = State_hash.Table.create () in upon (Ivar.read clean_up_signal) (fun () -> Hashtbl.iter collected_transitions ~f:(fun cached_transitions -> List.iter cached_transitions - ~f:(Fn.compose ignore Cached.invalidate_with_failure)) ; + ~f:(Fn.compose ignore Cached.invalidate_with_failure) ) ; Hashtbl.iter parent_root_timeouts ~f:(fun timeout -> - Block_time.Timeout.cancel time_controller timeout ())) ; + Block_time.Timeout.cancel time_controller timeout () ) ) ; let breadcrumb_builder_supervisor = Capped_supervisor.create ~job_capacity:30 (fun (initial_hash, transition_branches) -> @@ -94,7 +94,7 @@ let create ~logger ~precomputed_values ~verifier ~trust_system ~frontier ~logger: (Logger.extend logger [ ("catchup_scheduler", `String "Called from catchup scheduler") - ]) + ] ) ~precomputed_values ~verifier ~trust_system ~frontier ~initial_hash transition_branches with @@ -110,7 +110,7 @@ let create ~logger ~precomputed_values ~verifier ~trust_system ~frontier Rose_tree.iter subtree ~f:(fun cached_transition -> ignore ( Cached.invalidate_with_failure cached_transition - : Mina_block.initial_valid_block Envelope.Incoming.t )))) + : Mina_block.initial_valid_block Envelope.Incoming.t ) ) ) ) in { logger ; collected_transitions @@ -177,7 +177,7 @@ let rec remove_tree t parent_hash = Transition_frontier_controller.transitions_in_catchup_scheduler) ; List.iter children ~f:(fun child -> let transition, _ = Envelope.Incoming.data (Cached.peek child) in - remove_tree t (State_hash.With_state_hashes.state_hash transition)) + remove_tree t (State_hash.With_state_hashes.state_hash transition) ) let watch t ~timeout_duration ~cached_transition = let transition_with_hash, _ = @@ -211,7 +211,7 @@ let watch t ~timeout_duration ~cached_transition = if Writer.is_closed t.catchup_job_writer then [%log' trace t.logger] "catchup job pipe was closed; attempt to write to closed pipe" - else Writer.write t.catchup_job_writer forest) + else Writer.write t.catchup_job_writer forest ) in match Hashtbl.find t.collected_transitions parent_hash with | None -> @@ -225,7 +225,7 @@ let watch t ~timeout_duration ~cached_transition = (make_timeout (Option.fold remaining_time ~init:timeout_duration ~f:(fun _ remaining_time -> - Block_time.Span.min remaining_time timeout_duration))) + Block_time.Span.min remaining_time timeout_duration ) ) ) : [ `Duplicate | `Ok ] ) ; Mina_metrics.( Gauge.inc_one @@ -238,7 +238,7 @@ let watch t ~timeout_duration ~cached_transition = Envelope.Incoming.data (Cached.peek cached_sibling_transition) in State_hash.equal hash - (State_hash.With_state_hashes.state_hash sibling)) + (State_hash.With_state_hashes.state_hash sibling) ) then [%log' debug t.logger] ~metadata:[ ("state_hash", State_hash.to_yojson hash) ] @@ -271,7 +271,7 @@ let notify t ~hash = List.map collected_transitions ~f:(extract_subtree t) in Capped_supervisor.dispatch t.breadcrumb_builder_supervisor - (hash, transition_subtrees)) ; + (hash, transition_subtrees) ) ; remove_tree t hash ; Or_error.return () @@ -304,7 +304,7 @@ let%test_module "Transition_handler.Catchup_scheduler tests" = let verifier = Async.Thread_safe.block_on_async_exn (fun () -> Verifier.create ~logger ~proof_level ~constraint_constants - ~conf_dir:None ~pids) + ~conf_dir:None ~pids ) (* cast a breadcrumb into a cached, enveloped, partially validated transition *) let downcast_breadcrumb breadcrumb = @@ -321,7 +321,7 @@ let%test_module "Transition_handler.Catchup_scheduler tests" = let test_delta = Block_time.Span.of_ms 100L in Quickcheck.test ~trials:3 (Transition_frontier.For_tests.gen_with_branch ~precomputed_values - ~verifier ~max_length ~frontier_size:1 ~branch_size:2 ()) + ~verifier ~max_length ~frontier_size:1 ~branch_size:2 () ) ~f:(fun (frontier, branch) -> let catchup_job_reader, catchup_job_writer = Strict_pipe.create ~name:(__MODULE__ ^ __LOC__) @@ -354,7 +354,7 @@ let%test_module "Transition_handler.Catchup_scheduler tests" = | `Ok (`Ok (job_state_hash, _)) -> [%test_eq: State_hash.t] (Transition_frontier.Breadcrumb.parent_hash - disjoint_breadcrumb) + disjoint_breadcrumb ) job_state_hash ~message: "the job emitted from the catchup scheduler should be \ @@ -363,7 +363,7 @@ let%test_module "Transition_handler.Catchup_scheduler tests" = failwith "catchup scheduler should be empty after job is emitted" ; Strict_pipe.Writer.close catchup_breadcrumbs_writer ; - Strict_pipe.Writer.close catchup_job_writer)) + Strict_pipe.Writer.close catchup_job_writer ) ) let%test_unit "catchup jobs do not fire after timeout if they are \ invalidated" = @@ -371,7 +371,7 @@ let%test_module "Transition_handler.Catchup_scheduler tests" = let test_delta = Block_time.Span.of_ms 400L in Quickcheck.test ~trials:3 (Transition_frontier.For_tests.gen_with_branch ~precomputed_values - ~verifier ~max_length ~frontier_size:1 ~branch_size:2 ()) + ~verifier ~max_length ~frontier_size:1 ~branch_size:2 () ) ~f:(fun (frontier, branch) -> let cache = Unprocessed_transition_cache.create ~logger in let register_breadcrumb breadcrumb = @@ -399,12 +399,12 @@ let%test_module "Transition_handler.Catchup_scheduler tests" = (Cached.transform ~f:downcast_breadcrumb breadcrumb_2) ; Async.Thread_safe.block_on_async_exn (fun () -> Transition_frontier.add_breadcrumb_exn frontier - (Cached.peek breadcrumb_1)) ; + (Cached.peek breadcrumb_1) ) ; Or_error.ok_exn (notify scheduler ~hash: (Transition_frontier.Breadcrumb.state_hash - (Cached.peek breadcrumb_1))) ; + (Cached.peek breadcrumb_1) ) ) ; Async.Thread_safe.block_on_async_exn (fun () -> match%map Block_time.Timeout.await @@ -420,7 +420,7 @@ let%test_module "Transition_handler.Catchup_scheduler tests" = | `Ok (`Ok _) -> failwith "job was emitted from the catchup scheduler even though \ - the job was invalidated") ; + the job was invalidated" ) ; Async.Thread_safe.block_on_async_exn (fun () -> match%map Block_time.Timeout.await ~timeout_duration:test_delta @@ -434,14 +434,14 @@ let%test_module "Transition_handler.Catchup_scheduler tests" = | `Ok (`Ok ( [ Rose_tree.T (received_breadcrumb, []) ] - , `Catchup_scheduler )) -> + , `Catchup_scheduler ) ) -> [%test_eq: State_hash.t] (Transition_frontier.Breadcrumb.state_hash - (Cached.peek received_breadcrumb)) + (Cached.peek received_breadcrumb) ) (Transition_frontier.Breadcrumb.state_hash - (Cached.peek breadcrumb_2)) + (Cached.peek breadcrumb_2) ) | `Ok (`Ok _) -> - failwith "invalid breadcrumb builder response") ; + failwith "invalid breadcrumb builder response" ) ; ignore ( Cached.invalidate_with_success breadcrumb_1 : Transition_frontier.Breadcrumb.t ) ; @@ -449,14 +449,14 @@ let%test_module "Transition_handler.Catchup_scheduler tests" = ( Cached.invalidate_with_success breadcrumb_2 : Transition_frontier.Breadcrumb.t ) ; Strict_pipe.Writer.close catchup_breadcrumbs_writer ; - Strict_pipe.Writer.close catchup_job_writer) + Strict_pipe.Writer.close catchup_job_writer ) let%test_unit "catchup scheduler should not create duplicate jobs when a \ sequence of transitions is added in reverse order" = let timeout_duration = Block_time.Span.of_ms 400L in Quickcheck.test ~trials:3 (Transition_frontier.For_tests.gen_with_branch ~precomputed_values - ~verifier ~max_length ~frontier_size:1 ~branch_size:5 ()) + ~verifier ~max_length ~frontier_size:1 ~branch_size:5 () ) ~f:(fun (frontier, branch) -> let catchup_job_reader, catchup_job_writer = Strict_pipe.create ~name:(__MODULE__ ^ __LOC__) @@ -489,12 +489,12 @@ let%test_module "Transition_handler.Catchup_scheduler tests" = not @@ has_timeout_parent_hash scheduler (Transition_frontier.Breadcrumb.parent_hash - prev_breadcrumb) ) ; + prev_breadcrumb ) ) ; assert ( has_timeout_parent_hash scheduler (Transition_frontier.Breadcrumb.parent_hash - curr_breadcrumb) ) ; - curr_breadcrumb) + curr_breadcrumb ) ) ; + curr_breadcrumb ) : Frontier_base.Breadcrumb.t ) ; Async.Thread_safe.block_on_async_exn (fun () -> match%map Strict_pipe.Reader.read catchup_job_reader with @@ -503,5 +503,5 @@ let%test_module "Transition_handler.Catchup_scheduler tests" = | `Ok (job_hash, _) -> [%test_eq: State_hash.t] job_hash ( Transition_frontier.Breadcrumb.parent_hash - @@ List.hd_exn branch ))) + @@ List.hd_exn branch ) ) ) end ) diff --git a/src/lib/transition_handler/core_extended_cache.ml b/src/lib/transition_handler/core_extended_cache.ml index 229dab45dde..e73d635a896 100644 --- a/src/lib/transition_handler/core_extended_cache.ml +++ b/src/lib/transition_handler/core_extended_cache.ml @@ -97,7 +97,7 @@ struct let touch_key cache key = List.iter (Strat.touch cache.strat key) ~f:(fun k -> - clear_from_store cache k) + clear_from_store cache k ) let find cache k = let res = Store.find cache.store k in @@ -112,17 +112,17 @@ struct Option.iter (Store.find cache.store key) ~f:(fun v -> Strat.remove cache.strat key ; Option.call ~f:cache.destruct v ; - Store.remove cache.store key) + Store.remove cache.store key ) let clear cache = Option.iter cache.destruct ~f:(fun destruct -> - List.iter (Store.data cache.store) ~f:destruct) ; + List.iter (Store.data cache.store) ~f:destruct ) ; Strat.clear cache.strat ; Store.clear cache.store let create ~destruct = Strat.cps_create ~f:(fun strat -> - Store.cps_create ~f:(fun store -> { strat; destruct; store })) + Store.cps_create ~f:(fun store -> { strat; destruct; store }) ) let call_with_cache ~cache f arg = match find cache arg with @@ -140,7 +140,7 @@ struct let destruct = Option.map destruct ~f:(fun f -> Result.iter ~f) in let cache = { strat; destruct; store } in let memd_f arg = call_with_cache ~cache f arg in - (cache, memd_f))) + (cache, memd_f) ) ) end module Strategy = struct @@ -183,7 +183,7 @@ module Strategy = struct let remove lru x = Option.iter (Hashtbl.find lru.table x) ~f:(fun el -> Doubly_linked.remove lru.list el ; - Hashtbl.remove lru.table x) + Hashtbl.remove lru.table x ) let create maxsize = { list = Doubly_linked.create () diff --git a/src/lib/transition_handler/processor.ml b/src/lib/transition_handler/processor.ml index 3f8479d2926..a6fcdb2b962 100644 --- a/src/lib/transition_handler/processor.ml +++ b/src/lib/transition_handler/processor.ml @@ -70,7 +70,7 @@ let add_and_finalize ~logger ~frontier ~catchup_scheduler Block_time.diff (Block_time.now time_controller) (Consensus.Data.Consensus_time.to_time ~constants:consensus_constants - transition_time) + transition_time ) in Mina_metrics.Block_latency.Inclusion_time.update (Block_time.Span.to_time_span time_elapsed) ) ; @@ -156,7 +156,7 @@ let process_transition ~logger ~trust_system ~verifier ~frontier let timeout_duration = Option.fold (Transition_frontier.find frontier - (Non_empty_list.head delta_state_hashes)) + (Non_empty_list.head delta_state_hashes) ) ~init:(Block_time.Span.of_ms 0L) ~f:(fun _ _ -> catchup_timeout_duration precomputed_values) in @@ -177,7 +177,7 @@ let process_transition ~logger ~trust_system ~verifier ~frontier ~verifier ~trust_system ~transition_receipt_time ~sender:(Some sender) ~parent:parent_breadcrumb ~transition:mostly_validated_transition - (* TODO: Can we skip here? *) ()) + (* TODO: Can we skip here? *) () ) ~transform_result:(function | Error (`Invalid_staged_ledger_hash error) | Error (`Invalid_staged_ledger_diff error) -> @@ -190,7 +190,7 @@ let process_transition ~logger ~trust_system ~verifier ~frontier | Error (`Fatal_error exn) -> raise exn | Ok breadcrumb -> - Deferred.return (Ok breadcrumb)) + Deferred.return (Ok breadcrumb) ) in Mina_metrics.( Counter.inc_one @@ -198,7 +198,7 @@ let process_transition ~logger ~trust_system ~verifier ~frontier Deferred.map ~f:Result.return (add_and_finalize ~logger ~frontier ~catchup_scheduler ~processed_transition_writer ~only_if_present:false ~time_controller - ~source:`Gossip breadcrumb ~precomputed_values ~valid_cb)) + ~source:`Gossip breadcrumb ~precomputed_values ~valid_cb )) let run ~logger ~(precomputed_values : Precomputed_values.t) ~verifier ~trust_system ~time_controller ~frontier @@ -208,7 +208,7 @@ let run ~logger ~(precomputed_values : Precomputed_values.t) ~verifier , State_hash.t ) Cached.t ] * [ `Valid_cb of Mina_net2.Validation_callback.t option ] ) - Reader.t) + Reader.t ) ~(producer_transition_reader : Transition_frontier.Breadcrumb.t Reader.t) ~(clean_up_catchup_scheduler : unit Ivar.t) ~(catchup_job_writer : @@ -220,19 +220,19 @@ let run ~logger ~(precomputed_values : Precomputed_values.t) ~verifier list , crash buffered , unit ) - Writer.t) + Writer.t ) ~(catchup_breadcrumbs_reader : ( (Transition_frontier.Breadcrumb.t, State_hash.t) Cached.t Rose_tree.t list * [ `Ledger_catchup of unit Ivar.t | `Catchup_scheduler ] ) - Reader.t) + Reader.t ) ~(catchup_breadcrumbs_writer : ( (Transition_frontier.Breadcrumb.t, State_hash.t) Cached.t Rose_tree.t list * [ `Ledger_catchup of unit Ivar.t | `Catchup_scheduler ] , crash buffered , unit ) - Writer.t) ~processed_transition_writer = + Writer.t ) ~processed_transition_writer = let catchup_scheduler = Catchup_scheduler.create ~logger ~precomputed_values ~verifier ~trust_system ~frontier ~time_controller ~catchup_job_writer ~catchup_breadcrumbs_writer @@ -259,12 +259,12 @@ let run ~logger ~(precomputed_values : Precomputed_values.t) ~verifier Mina_metrics.( Gauge.inc_one Transition_frontier_controller.transitions_being_processed) ; - `Local_breadcrumb (Cached.pure breadcrumb)) + `Local_breadcrumb (Cached.pure breadcrumb) ) ; Reader.map catchup_breadcrumbs_reader ~f:(fun (cb, catchup_breadcrumbs_callback) -> - `Catchup_breadcrumbs (cb, catchup_breadcrumbs_callback)) + `Catchup_breadcrumbs (cb, catchup_breadcrumbs_callback) ) ; Reader.map primary_transition_reader ~f:(fun vt -> - `Partially_valid_transition vt) + `Partially_valid_transition vt ) ] ~f:(fun msg -> let open Deferred.Let_syntax in @@ -282,7 +282,7 @@ let run ~logger ~(precomputed_values : Precomputed_values.t) ~verifier * we're catching up *) ~f: (add_and_finalize ~logger ~only_if_present:true - ~source:`Catchup ~valid_cb:None)) + ~source:`Catchup ~valid_cb:None ) ) with | Ok () -> () @@ -292,7 +292,7 @@ let run ~logger ~(precomputed_values : Precomputed_values.t) ~verifier let (_ : Transition_frontier.Breadcrumb.t) = Cached.invalidate_with_failure cached_breadcrumb in - ())) ; + () ) ) ; [%log error] "Error, failed to attach all catchup breadcrumbs to \ transition frontier: $error" @@ -319,7 +319,7 @@ let run ~logger ~(precomputed_values : Precomputed_values.t) ~verifier ~name:"accepted_transition_local_latency" (Core_kernel.Time.diff Block_time.(now time_controller |> to_time) - transition_time) ; + transition_time ) ; let%map () = match%map add_and_finalize ~logger ~only_if_present:false @@ -343,7 +343,7 @@ let run ~logger ~(precomputed_values : Precomputed_values.t) ~verifier Transition_frontier_controller.transitions_being_processed) | `Partially_valid_transition (`Block transition, `Valid_cb valid_cb) -> - process_transition ~transition ~valid_cb))) + process_transition ~transition ~valid_cb ) ) ) let%test_module "Transition_handler.Processor tests" = ( module struct @@ -371,7 +371,7 @@ let%test_module "Transition_handler.Processor tests" = Async.Thread_safe.block_on_async_exn (fun () -> Verifier.create ~logger ~proof_level ~constraint_constants ~conf_dir:None - ~pids:(Child_processes.Termination.create_pid_table ())) + ~pids:(Child_processes.Termination.create_pid_table ()) ) let downcast_breadcrumb breadcrumb = let transition = @@ -388,19 +388,19 @@ let%test_module "Transition_handler.Processor tests" = let max_length = frontier_size + branch_size in Quickcheck.test ~trials:4 (Transition_frontier.For_tests.gen_with_branch ~precomputed_values - ~verifier ~max_length ~frontier_size ~branch_size ()) + ~verifier ~max_length ~frontier_size ~branch_size () ) ~f:(fun (frontier, branch) -> assert ( Thread_safe.block_on_async_exn (fun () -> let valid_transition_reader, valid_transition_writer = Strict_pipe.create (Buffered - (`Capacity branch_size, `Overflow (Drop_head ignore))) + (`Capacity branch_size, `Overflow (Drop_head ignore)) ) in let producer_transition_reader, _ = Strict_pipe.create (Buffered - (`Capacity branch_size, `Overflow (Drop_head ignore))) + (`Capacity branch_size, `Overflow (Drop_head ignore)) ) in let _, catchup_job_writer = Strict_pipe.create (Buffered (`Capacity 1, `Overflow Crash)) @@ -411,7 +411,7 @@ let%test_module "Transition_handler.Processor tests" = let processed_transition_reader, processed_transition_writer = Strict_pipe.create (Buffered - (`Capacity branch_size, `Overflow (Drop_head ignore))) + (`Capacity branch_size, `Overflow (Drop_head ignore)) ) in let clean_up_catchup_scheduler = Ivar.create () in let cache = Unprocessed_transition_cache.create ~logger in @@ -427,7 +427,7 @@ let%test_module "Transition_handler.Processor tests" = |> Unprocessed_transition_cache.register_exn cache in Strict_pipe.Writer.write valid_transition_writer - (`Block b, `Valid_cb None)) ; + (`Block b, `Valid_cb None) ) ; match%map Block_time.Timeout.await ~timeout_duration:(Block_time.Span.of_ms 30000L) @@ -443,9 +443,9 @@ let%test_module "Transition_handler.Processor tests" = | next_expected_breadcrumb :: tail -> [%test_eq: State_hash.t] (Transition_frontier.Breadcrumb.state_hash - next_expected_breadcrumb) + next_expected_breadcrumb ) (Mina_block.Validated.state_hash - newly_added_transition) ; + newly_added_transition ) ; [%log info] ~metadata: [ ( "height" @@ -464,12 +464,12 @@ let%test_module "Transition_handler.Processor tests" = if List.is_empty tail then `Stop true else `Continue tail | [] -> - `Stop false ))) + `Stop false ) ) ) with | `Timeout -> failwith "test timed out" | `Ok (`Eof _) -> failwith "pipe closed unexpectedly" | `Ok (`Terminated x) -> - x) )) + x ) ) ) end ) diff --git a/src/lib/transition_handler/validator.ml b/src/lib/transition_handler/validator.ml index 581b8e0d5a0..6cd8dbceb3d 100644 --- a/src/lib/transition_handler/validator.ml +++ b/src/lib/transition_handler/validator.ml @@ -25,7 +25,7 @@ let validate_transition ~consensus_constants ~logger ~frontier let%bind () = Option.fold (Unprocessed_transition_cache.final_state unprocessed_transition_cache - enveloped_transition) + enveloped_transition ) ~init:Result.(Ok ()) ~f:(fun _ final_state -> Result.Error (`In_process final_state)) in @@ -36,11 +36,11 @@ let validate_transition ~consensus_constants ~logger ~frontier ~logger: (Logger.extend logger [ ("selection_context", `String "Transition_handler.Validator") - ]) + ] ) ~existing: (Transition_frontier.Breadcrumb.consensus_state_with_hashes - root_breadcrumb) - ~candidate:(With_hash.map ~f:Mina_block.consensus_state transition))) + root_breadcrumb ) + ~candidate:(With_hash.map ~f:Mina_block.consensus_state transition) ) ) ~error:`Disconnected in (* we expect this to be Ok since we just checked the cache *) @@ -57,7 +57,7 @@ let run ~logger ~consensus_constants ~trust_system ~time_controller ~frontier * [ `Valid_cb of Mina_net2.Validation_callback.t option ] , drop_head buffered , unit ) - Writer.t) ~unprocessed_transition_cache = + Writer.t ) ~unprocessed_transition_cache = let module Lru = Core_extended_cache.Lru in O1trace.background_thread "validate_blocks_against_frontier" (fun () -> Reader.iter transition_reader @@ -91,7 +91,7 @@ let run ~logger ~consensus_constants ~trust_system ~time_controller ~frontier ~name:"accepted_transition_remote_latency" (Core_kernel.Time.diff Block_time.(now time_controller |> to_time) - transition_time) ; + transition_time ) ; Writer.write valid_transition_writer (`Block cached_transition, `Valid_cb vc) | Error (`In_frontier _) | Error (`In_process _) -> @@ -123,4 +123,4 @@ let run ~logger ~consensus_constants ~trust_system ~time_controller ~frontier , Envelope.Sender.to_yojson (Envelope.Incoming.sender transition_env) ) ; ("transition", Mina_block.to_yojson transition) - ] ) ))) + ] ) ) ) ) diff --git a/src/lib/transition_router/initial_validator.ml b/src/lib/transition_router/initial_validator.ml index f5b3874b777..cebae858957 100644 --- a/src/lib/transition_router/initial_validator.ml +++ b/src/lib/transition_router/initial_validator.ml @@ -17,8 +17,8 @@ type validation_error = | `Invalid_protocol_version ] let handle_validation_error ~logger ~rejected_blocks_logger ~time_received - ~trust_system ~sender ~transition_with_hash ~delta - (error : validation_error) = + ~trust_system ~sender ~transition_with_hash ~delta (error : validation_error) + = let open Trust_system.Actions in let state_hash = State_hash.With_state_hashes.state_hash transition_with_hash @@ -28,7 +28,7 @@ let handle_validation_error ~logger ~rejected_blocks_logger ~time_received let message' = "external transition with state hash $state_hash" ^ Option.value_map message ~default:"" ~f:(fun (txt, _) -> - sprintf ", %s" txt) + sprintf ", %s" txt ) in let metadata = ("state_hash", State_hash.to_yojson state_hash) @@ -76,7 +76,7 @@ let handle_validation_error ~logger ~rejected_blocks_logger ~time_received , `String (Time.to_string_abs (Block_time.to_time time_received) - ~zone:Time.Zone.utc) ) + ~zone:Time.Zone.utc ) ) ] @ metadata in @@ -128,7 +128,7 @@ let handle_validation_error ~logger ~rejected_blocks_logger ~time_received (Gossiped_old_transition (slot_diff, delta)) (Some ( "off by $slot_diff slots" - , [ ("slot_diff", `String (Int64.to_string slot_diff)) ] )) + , [ ("slot_diff", `String (Int64.to_string slot_diff)) ] ) ) | `Invalid_protocol_version -> Queue.enqueue Transition_frontier.rejected_blocks (state_hash, sender, time_received, `Invalid_protocol_version) ; @@ -219,7 +219,7 @@ module Duplicate_block_detector = struct , `String (Time.to_string_abs (Block_time.to_time time_received) - ~zone:Time.Zone.utc) ) + ~zone:Time.Zone.utc ) ) ] in let msg : (_, unit, string, unit) format4 = @@ -264,7 +264,7 @@ let run ~logger ~trust_system ~verifier ~transition_reader |> With_hash.of_data ~hash_data: (Fn.compose Protocol_state.hashes - (Fn.compose Header.protocol_state Mina_block.header)) + (Fn.compose Header.protocol_state Mina_block.header) ) in Duplicate_block_detector.check ~precomputed_values ~rejected_blocks_logger ~time_received duplicate_checker logger @@ -285,14 +285,13 @@ let run ~logger ~trust_system ~verifier ~transition_reader wrap transition_with_hash |> defer (validate_time_received ~precomputed_values - ~time_received) + ~time_received ) >>= defer (validate_genesis_protocol_state ~genesis_state_hash) >>= (fun x -> Interruptible.uninterruptible - (validate_proofs ~verifier ~genesis_state_hash - [ x ]) - >>| List.hd_exn) + (validate_proofs ~verifier ~genesis_state_hash [ x ]) + >>| List.hd_exn ) >>= defer validate_delta_block_chain >>= defer validate_protocol_versions) with @@ -300,7 +299,7 @@ let run ~logger ~trust_system ~verifier ~transition_reader Writer.write valid_transition_writer ( `Block (Envelope.Incoming.wrap ~data:verified_transition - ~sender) + ~sender ) , `Valid_cb valid_cb ) ; Mina_metrics.Transition_frontier .update_max_blocklength_observed blockchain_length ; @@ -337,9 +336,9 @@ let run ~logger ~trust_system ~verifier ~transition_reader , `String (Time.to_string_abs (Block_time.to_time time_received) - ~zone:Time.Zone.utc) ) + ~zone:Time.Zone.utc ) ) ] in [%log error] ~metadata "Dropping blocks because libp2p validation expired" ) - else Deferred.unit)) + else Deferred.unit ) ) diff --git a/src/lib/transition_router/transition_router.ml b/src/lib/transition_router/transition_router.ml index 6572263dea8..6d11d7b7657 100644 --- a/src/lib/transition_router/transition_router.ml +++ b/src/lib/transition_router/transition_router.ml @@ -42,7 +42,7 @@ let is_transition_for_bootstrap ~logger + 290 + slack < Length.to_int (Consensus.Data.Consensus_state.blockchain_length - new_consensus_state.data) + new_consensus_state.data ) then (* Then our entire frontier is useless. *) true else @@ -52,7 +52,7 @@ let is_transition_for_bootstrap ~logger (Logger.extend logger [ ( "selection_context" , `String "Transition_router.is_transition_for_bootstrap" ) - ]) + ] ) let start_transition_frontier_controller ~logger ~trust_system ~verifier ~network ~time_controller ~producer_transition_reader_ref @@ -71,7 +71,7 @@ let start_transition_frontier_controller ~logger ~trust_system ~verifier Mina_block.handle_dropped_transition ( With_hash.hash @@ Validation.block_with_hash @@ Network_peer.Envelope.Incoming.data block ) - ?valid_cb ~pipe_name:name ~logger) + ?valid_cb ~pipe_name:name ~logger ) () in transition_reader_ref := transition_frontier_controller_reader ; @@ -92,7 +92,7 @@ let start_transition_frontier_controller ~logger ~trust_system ~verifier Strict_pipe.Reader.iter new_verified_transition_reader ~f: (Fn.compose Deferred.return - (Strict_pipe.Writer.write verified_transition_writer)) + (Strict_pipe.Writer.write verified_transition_writer) ) |> don't_wait_for let start_bootstrap_controller ~logger ~trust_system ~verifier ~network @@ -112,7 +112,7 @@ let start_bootstrap_controller ~logger ~trust_system ~verifier ~network Mina_block.handle_dropped_transition ( With_hash.hash @@ Validation.block_with_hash @@ Network_peer.Envelope.Incoming.data head ) - ~pipe_name:name ~logger ?valid_cb) + ~pipe_name:name ~logger ?valid_cb ) () in transition_reader_ref := bootstrap_controller_reader ; @@ -125,20 +125,20 @@ let start_bootstrap_controller ~logger ~trust_system ~verifier ~network producer_transition_writer_ref := producer_transition_writer ; Option.iter best_seen_transition ~f:(fun block -> Strict_pipe.Writer.write bootstrap_controller_writer - (`Block block, `Valid_cb None)) ; + (`Block block, `Valid_cb None) ) ; don't_wait_for (Broadcast_pipe.Writer.write frontier_w None) ; upon (Bootstrap_controller.run ~logger ~trust_system ~verifier ~network ~consensus_local_state ~transition_reader:!transition_reader_ref ~persistent_frontier ~persistent_root ~initial_root_transition - ~best_seen_transition ~precomputed_values ~catchup_mode) + ~best_seen_transition ~precomputed_values ~catchup_mode ) (fun (new_frontier, collected_transitions) -> Strict_pipe.Writer.kill !transition_writer_ref ; start_transition_frontier_controller ~logger ~trust_system ~verifier ~network ~time_controller ~producer_transition_reader_ref ~producer_transition_writer_ref ~verified_transition_writer ~clear_reader ~collected_transitions ~transition_reader_ref - ~transition_writer_ref ~frontier_w ~precomputed_values new_frontier) + ~transition_writer_ref ~frontier_w ~precomputed_values new_frontier ) let download_best_tip ~notify_online ~logger ~network ~verifier ~trust_system ~most_recent_valid_block_writer ~genesis_constants ~precomputed_values = @@ -199,7 +199,7 @@ let download_best_tip ~notify_online ~logger ~network ~verifier ~trust_system (Some (Envelope.Incoming.wrap_peer ~data:{ peer_best_tip with data = candidate_best_tip } - ~sender:peer)) )) + ~sender:peer ) ) ) ) in [%log debug] ~metadata: @@ -224,7 +224,7 @@ let download_best_tip ~notify_online ~logger ~network ~verifier ~trust_system | `Keep -> enveloped_existing_best_tip | `Take -> - enveloped_candidate_best_tip)) + enveloped_candidate_best_tip ) ) in Option.iter res ~f:(fun best -> let best_tip_length = @@ -235,12 +235,12 @@ let download_best_tip ~notify_online ~logger ~network ~verifier ~trust_system best_tip_length ; don't_wait_for @@ Broadcast_pipe.Writer.write most_recent_valid_block_writer - best.data.data) ; + best.data.data ) ; Option.map res ~f: (Envelope.Incoming.map ~f:(fun (x : _ Proof_carrying_data.t) -> Ledger_catchup.Best_tip_lru.add x ; - x.data)) + x.data ) ) let load_frontier ~logger ~verifier ~persistent_frontier ~persistent_root ~consensus_local_state ~precomputed_values ~catchup_mode = @@ -318,9 +318,9 @@ let initialize ~logger ~network ~is_seed ~is_demo_mode ~verifier ~trust_system match%bind Deferred.both (download_best_tip ~notify_online ~logger ~network ~verifier ~trust_system - ~most_recent_valid_block_writer ~genesis_constants ~precomputed_values) + ~most_recent_valid_block_writer ~genesis_constants ~precomputed_values ) (load_frontier ~logger ~verifier ~persistent_frontier ~persistent_root - ~consensus_local_state ~precomputed_values ~catchup_mode) + ~consensus_local_state ~precomputed_values ~catchup_mode ) with | best_tip, None -> [%log info] "Unable to load frontier; starting bootstrap" ; @@ -348,7 +348,7 @@ let initialize ~logger ~network ~is_seed ~is_demo_mode ~verifier ~trust_system , `Int (Unsigned.UInt32.to_int ( Mina_block.blockchain_length - @@ Validation.block best_tip.data )) ) + @@ Validation.block best_tip.data ) ) ) ] "Network best tip is too new to catchup to (best_tip with \ $length); starting bootstrap" ; @@ -372,7 +372,7 @@ let initialize ~logger ~network ~is_seed ~is_demo_mode ~verifier ~trust_system , `Int (Unsigned.UInt32.to_int ( Mina_block.blockchain_length - @@ Validation.block (Option.value_exn best_tip).data )) + @@ Validation.block (Option.value_exn best_tip).data ) ) ) ] "Network best tip is recent enough to catchup to (best_tip with \ @@ -404,7 +404,7 @@ let initialize ~logger ~network ~is_seed ~is_demo_mode ~verifier ~trust_system (fun peer rpc query -> Mina_networking.( query_peer network peer.peer_id - (Rpcs.Consensus_rpc rpc) query)) + (Rpcs.Consensus_rpc rpc) query) ) } ~ledger_depth: precomputed_values.constraint_constants.ledger_depth @@ -476,14 +476,14 @@ let run ~logger ~trust_system ~verifier ~network ~is_seed ~is_demo_mode let verified_transition_reader, verified_transition_writer = let name = "verified transitions" in create_bufferred_pipe ~name - ~f: - (fun (`Transition (head : Mina_block.Validated.t), _, `Valid_cb valid_cb) - -> + ~f:(fun ( `Transition (head : Mina_block.Validated.t) + , _ + , `Valid_cb valid_cb ) -> Mina_metrics.( Counter.inc_one Pipe.Drop_on_overflow.router_verified_transitions) ; Mina_block.handle_dropped_transition (Mina_block.Validated.forget head |> With_hash.hash) - ~pipe_name:name ~logger ?valid_cb) + ~pipe_name:name ~logger ?valid_cb ) () in let transition_reader, transition_writer = @@ -494,7 +494,7 @@ let run ~logger ~trust_system ~verifier ~network ~is_seed ~is_demo_mode Mina_block.handle_dropped_transition ( Network_peer.Envelope.Incoming.data block |> Validation.block_with_hash |> With_hash.hash ) - ?valid_cb ~pipe_name:name ~logger) + ?valid_cb ~pipe_name:name ~logger ) () in let transition_reader_ref = ref transition_reader in @@ -508,7 +508,7 @@ let run ~logger ~trust_system ~verifier ~network ~is_seed ~is_demo_mode O1trace.background_thread "transition_router" (fun () -> don't_wait_for @@ Strict_pipe.Reader.iter producer_transition_reader ~f:(fun x -> - Strict_pipe.Writer.write !producer_transition_writer_ref x) ; + Strict_pipe.Writer.write !producer_transition_writer_ref x ) ; let%bind () = wait_till_genesis ~logger ~time_controller ~precomputed_values in @@ -522,7 +522,7 @@ let run ~logger ~trust_system ~verifier ~network ~is_seed ~is_demo_mode Mina_block.handle_dropped_transition ( Network_peer.Envelope.Incoming.data block |> Validation.block_with_hash |> With_hash.hash ) - ~valid_cb ~pipe_name:name ~logger) + ~valid_cb ~pipe_name:name ~logger ) () in Initial_validator.run ~logger ~trust_system ~verifier @@ -569,12 +569,12 @@ let run ~logger ~trust_system ~verifier ~network ~is_seed ~is_demo_mode ~candidate: ( Validation.block_with_hash incoming_transition |> With_hash.map ~f:Mina_block.consensus_state ) - ~logger) + ~logger ) then (* TODO: do we need to push valid_cb? *) Broadcast_pipe.Writer.write most_recent_valid_block_writer incoming_transition - else Deferred.unit) ; + else Deferred.unit ) ; don't_wait_for @@ Strict_pipe.Reader.iter_without_pushback valid_transition_reader2 ~f:(fun (`Block enveloped_transition, `Valid_cb vc) -> @@ -616,5 +616,5 @@ let run ~logger ~trust_system ~verifier ~network ~is_seed ~is_demo_mode Deferred.unit in Strict_pipe.Writer.write !transition_writer_ref - (`Block enveloped_transition, `Valid_cb (Some vc)))) ; + (`Block enveloped_transition, `Valid_cb (Some vc)) ) ) ; (verified_transition_reader, initialization_finish_signal) diff --git a/src/lib/transition_router/transition_router.mli b/src/lib/transition_router/transition_router.mli index 873caec5cd3..316c88fdb29 100644 --- a/src/lib/transition_router/transition_router.mli +++ b/src/lib/transition_router/transition_router.mli @@ -8,8 +8,8 @@ include Mina_intf.Transition_router_intf with type transition_frontier := Transition_frontier.t and type transition_frontier_persistent_root := - Transition_frontier.Persistent_root.t + Transition_frontier.Persistent_root.t and type transition_frontier_persistent_frontier := - Transition_frontier.Persistent_frontier.t + Transition_frontier.Persistent_frontier.t and type breadcrumb := Transition_frontier.Breadcrumb.t and type network := Mina_networking.t diff --git a/src/lib/trust_system/peer_trust.ml b/src/lib/trust_system/peer_trust.ml index 3c38d0fd199..9c67c51df2d 100644 --- a/src/lib/trust_system/peer_trust.ml +++ b/src/lib/trust_system/peer_trust.ml @@ -60,8 +60,7 @@ module Time_with_json = struct let of_yojson = function | `String time -> Ok - (Time.of_string_gen ~if_no_timezone:(`Use_this_one Time.Zone.utc) - time) + (Time.of_string_gen ~if_no_timezone:(`Use_this_one Time.Zone.utc) time) | _ -> Error "Trust_system.Peer_trust: Could not parse time" end @@ -126,18 +125,18 @@ module Make0 (Inputs : Input_intf) = struct Option.value_map db ~default:[] ~f:(fun db' -> Db.to_alist db' |> List.map ~f:(fun (peer, record) -> - (peer, Record_inst.to_peer_status record))) + (peer, Record_inst.to_peer_status record) ) ) let lookup_ip t ip = List.filter (peer_statuses t) ~f:(fun (p, _status) -> - Unix.Inet_addr.equal (Peer_id.ip p) ip) + Unix.Inet_addr.equal (Peer_id.ip p) ip ) let reset_ip ({ db; _ } as t) ip = Option.value_map db ~default:() ~f:(fun db' -> List.map ~f:(fun (id, _status) -> Db.remove db' ~key:id) (lookup_ip t ip) - |> ignore) ; + |> ignore ) ; lookup_ip t ip let close { db; bans_writer; _ } = @@ -278,7 +277,7 @@ let%test_module "peer_trust" = let res = Peer_trust_test.create () in don't_wait_for @@ Strict_pipe.Reader.iter_without_pushback res.bans_reader ~f:(fun v -> - ban_pipe_out := v :: !ban_pipe_out) ; + ban_pipe_out := v :: !ban_pipe_out ) ; res let nolog = Logger.null () @@ -309,7 +308,7 @@ let%test_module "peer_trust" = assert_ban_pipe [ 0 ] ; true | _ -> - false) + false ) let%test "trust decays by half in 24 hours" = Run_in_thread.block_on_async_exn (fun () -> @@ -328,7 +327,7 @@ let%test_module "peer_trust" = | _ -> false ) | _ -> - false) + false ) let do_constant_rate rate f = (* Simulate running the function at the specified rate, in actions/sec, @@ -357,7 +356,7 @@ let%test_module "peer_trust" = | [ (_, { banned = Unbanned; _ }) ] -> assert_ban_pipe [] ; true | _ -> - false) + false ) let%test "peers do get banned for acting faster than the maximum rate" = if tmp_bans_are_disabled then true @@ -372,7 +371,7 @@ let%test_module "peer_trust" = | [ (_, { banned = Unbanned; _ }) ] -> false | _ -> - false) + false ) let%test "good cancels bad" = Run_in_thread.block_on_async_exn (fun () -> @@ -382,7 +381,7 @@ let%test_module "peer_trust" = let%bind () = Peer_trust_test.record db nolog 0 Action.Slow_punish in - Peer_trust_test.record db nolog 0 Action.Slow_credit) + Peer_trust_test.record db nolog 0 Action.Slow_credit ) in match Peer_trust_test.lookup_ip db peer0 with | [ (_, { banned = Banned_until _; _ }) ] -> @@ -390,7 +389,7 @@ let%test_module "peer_trust" = | [ (_, { banned = Unbanned; _ }) ] -> assert_ban_pipe [] ; true | _ -> - false) + false ) let%test "insta-bans ignore positive trust" = if tmp_bans_are_disabled then true @@ -416,7 +415,7 @@ let%test_module "peer_trust" = | [ (_, { banned = Unbanned; _ }) ] -> failwith "Peer not banned" | _ -> - false) + false ) let%test "multiple peers getting banned causes multiple ban events" = if tmp_bans_are_disabled then true @@ -426,7 +425,7 @@ let%test_module "peer_trust" = let%bind () = Peer_trust_test.record db nolog 0 Action.Insta_ban in let%map () = Peer_trust_test.record db nolog 1 Action.Insta_ban in assert_ban_pipe [ 1; 0 ] (* Reverse order since it's a snoc list. *) ; - true) + true ) let%test_unit "actions are written to the pipe" = Run_in_thread.block_on_async_exn (fun () -> @@ -447,7 +446,7 @@ let%test_module "peer_trust" = assert (List.is_empty db.actions_writers) ; Deferred.unit | _ -> - failwith "wrong number of actions written to pipe") + failwith "wrong number of actions written to pipe" ) end ) module Make (Action : Action_intf) = Make0 (struct diff --git a/src/lib/unsigned_extended/unsigned_extended.ml b/src/lib/unsigned_extended/unsigned_extended.ml index 814bc7bdce3..443769db34c 100644 --- a/src/lib/unsigned_extended/unsigned_extended.ml +++ b/src/lib/unsigned_extended/unsigned_extended.ml @@ -11,7 +11,6 @@ module Extend (Unsigned : Unsigned.S) (M : sig val length : int end) : S with type t = Unsigned.t = struct - ;; assert (M.length < Field.size_in_bits - 3) let length_in_bits = M.length diff --git a/src/lib/uptime_service/uptime_service.ml b/src/lib/uptime_service/uptime_service.ml index fa546fe9fbf..411937ae7ca 100644 --- a/src/lib/uptime_service/uptime_service.ml +++ b/src/lib/uptime_service/uptime_service.ml @@ -86,7 +86,7 @@ let send_uptime_data ~logger ~interruptor ~(submitter_keypair : Keypair.t) ~url Cohttp_async.Client.post ~headers ~body: (Yojson.Safe.to_string json |> Cohttp_async.Body.of_string) - url)) + url ) ) with | Ok ({ status; _ }, body) -> let status_code = Cohttp.Code.code_of_status status in @@ -212,7 +212,7 @@ let send_produced_block_at ~logger ~interruptor ~url ~peer_id make_interruptible (with_timeout (Time.Span.of_min timeout_min) - (Bvar.wait block_produced_bvar)) + (Bvar.wait block_produced_bvar) ) with | `Timeout -> [%log error] @@ -257,7 +257,7 @@ let send_block_and_transaction_snark ~logger ~interruptor ~url ~snark_worker List.is_empty (Mina_block.transactions ~constraint_constants: - Genesis_constants.Constraint_constants.compiled best_tip_block) + Genesis_constants.Constraint_constants.compiled best_tip_block ) then ( [%log info] "No transactions in block, sending block without SNARK work to \ @@ -285,9 +285,9 @@ let send_block_and_transaction_snark ~logger ~interruptor ~url ~snark_worker (Error.createf "Could not find state_hash %s in transition frontier \ for uptime service" - (State_hash.to_base58_check state_hash)) + (State_hash.to_base58_check state_hash) ) | Some protocol_state -> - Ok protocol_state) + Ok protocol_state ) with | Error e -> [%log error] @@ -318,7 +318,7 @@ let send_block_and_transaction_snark ~logger ~interruptor ~url ~snark_worker | Snark_work_lib.Work.Single.Spec.Transition _ -> true | Merge _ -> - false) + false ) in let staged_ledger_hash = Mina_block.header best_tip_block @@ -335,7 +335,7 @@ let send_block_and_transaction_snark ~logger ~interruptor ~url ~snark_worker (Staged_ledger_hash.ledger_hash staged_ledger_hash) | Merge _ -> (* unreachable *) - failwith "Expected Transition work, not Merge") + failwith "Expected Transition work, not Merge" ) with | None -> [%log info] @@ -357,7 +357,7 @@ let send_block_and_transaction_snark ~logger ~interruptor ~url ~snark_worker match%bind make_interruptible (Uptime_snark_worker.perform_single snark_worker - (message, single_spec)) + (message, single_spec) ) with | Error e -> (* error in submitting to process *) diff --git a/src/lib/uptime_service/uptime_snark_worker.ml b/src/lib/uptime_service/uptime_snark_worker.ml index 2b28c1a16a5..ce3495c86f3 100644 --- a/src/lib/uptime_service/uptime_snark_worker.ml +++ b/src/lib/uptime_service/uptime_snark_worker.ml @@ -30,7 +30,7 @@ module Worker_state = struct in Prod.perform_single worker_state ~message single_spec end in - (module M : S)) + (module M : S) ) let get = Fn.id end @@ -131,14 +131,14 @@ let create ~logger ~pids : t Deferred.t = ~f:(fun stdout -> return @@ [%log debug] "Uptime SNARK worker stdout: $stdout" - ~metadata:[ ("stdout", `String stdout) ]) ; + ~metadata:[ ("stdout", `String stdout) ] ) ; don't_wait_for @@ Pipe.iter (Process.stderr process |> Reader.pipe) ~f:(fun stderr -> return @@ [%log error] "Uptime SNARK worker stderr: $stderr" - ~metadata:[ ("stderr", `String stderr) ]) ; + ~metadata:[ ("stderr", `String stderr) ] ) ; { connection; process; logger } let perform_single { connection; _ } ((_message, _single_spec) as arg) = diff --git a/src/lib/user_command_input/user_command_input.ml b/src/lib/user_command_input/user_command_input.ml index 67180e62a87..cd25de6223b 100644 --- a/src/lib/user_command_input/user_command_input.ml +++ b/src/lib/user_command_input/user_command_input.ml @@ -48,7 +48,7 @@ module Payload = struct below minimum_nonce %s" (Account_nonce.to_string nonce) (Account_nonce.to_string inferred_nonce) - (Account_nonce.to_string minimum_nonce)) + (Account_nonce.to_string minimum_nonce) ) in { Signed_command_payload.Common.Poly.fee = t.fee ; fee_payer_pk = t.fee_payer_pk @@ -136,7 +136,7 @@ let sign ~signer ~(user_command_payload : Signed_command_payload.t) = function Option.value_map ~default:(Deferred.return (Error "Invalid_signature")) (Signed_command.create_with_signature_checked signature signer - user_command_payload) + user_command_payload ) ~f:Deferred.Result.return | Keypair signer_kp -> Deferred.Result.return @@ -200,7 +200,7 @@ let to_user_command ?(nonce_map = Account_id.Map.empty) ~get_current_nonce (Result.map_error ~f:(fun str -> Error.createf "Error creating user command: %s Error: %s" (Yojson.Safe.to_string (to_yojson client_input)) - str)) + str ) ) @@ let open Deferred.Result.Let_syntax in let fee_payer = fee_payer client_input in @@ -237,6 +237,6 @@ let to_user_commands ?(nonce_map = Account_id.Map.empty) ~get_current_nonce to_user_command ~nonce_map ~get_current_nonce ~get_account ~constraint_constants ~logger uc_input in - (res :: valid_user_commands, updated_nonce_map)) + (res :: valid_user_commands, updated_nonce_map) ) in List.rev user_commands diff --git a/src/lib/user_command_input/user_command_input.mli b/src/lib/user_command_input/user_command_input.mli index dfe7021b84b..ddf076c9b85 100644 --- a/src/lib/user_command_input/user_command_input.mli +++ b/src/lib/user_command_input/user_command_input.mli @@ -70,7 +70,7 @@ val to_user_command : ?nonce_map:(Account.Nonce.t * Account.Nonce.t) Account_id.Map.t -> get_current_nonce: ( Account_id.t - -> ([ `Min of Account_nonce.t ] * Account_nonce.t, string) Result.t) + -> ([ `Min of Account_nonce.t ] * Account_nonce.t, string) Result.t ) -> get_account:(Account_id.t -> Account.t option Participating_state.T.t) -> constraint_constants:Genesis_constants.Constraint_constants.t -> logger:Logger.t @@ -82,7 +82,7 @@ val to_user_commands : ?nonce_map:(Account.Nonce.t * Account.Nonce.t) Account_id.Map.t -> get_current_nonce: ( Account_id.t - -> ([ `Min of Account_nonce.t ] * Account_nonce.t, string) Result.t) + -> ([ `Min of Account_nonce.t ] * Account_nonce.t, string) Result.t ) -> get_account:(Account_id.t -> Account.t option Participating_state.T.t) -> constraint_constants:Genesis_constants.Constraint_constants.t -> logger:Logger.t diff --git a/src/lib/verifier/common.ml b/src/lib/verifier/common.ml index fee9bdf4b27..8e2ea3689e3 100644 --- a/src/lib/verifier/common.ml +++ b/src/lib/verifier/common.ml @@ -13,7 +13,7 @@ type invalid = let invalid_to_string (invalid : invalid) = let keys_to_string keys = List.map keys ~f:(fun key -> - Signature_lib.Public_key.Compressed.to_base58_check key) + Signature_lib.Public_key.Compressed.to_base58_check key ) |> String.concat ~sep:";" in match invalid with @@ -61,11 +61,10 @@ let check : not (Signature_lib.Schnorr.Chunked.verify s (Backend.Tick.Inner_curve.of_affine pk) - (Random_oracle_input.Chunked.field msg)) + (Random_oracle_input.Chunked.field msg) ) then return - (`Invalid_signature - [ Signature_lib.Public_key.compress pk ]) + (`Invalid_signature [ Signature_lib.Public_key.compress pk ]) else () in check_signature fee_payer.authorization fee_payer.body.public_key @@ -92,14 +91,14 @@ let check : | None -> return (`Missing_verification_key - [ Account_id.public_key @@ Party.account_id p ]) + [ Account_id.public_key @@ Party.account_id p ] ) | Some vk -> let stmt = { Zkapp_statement.Poly.transaction = commitment ; at_party = (at_party :> Snark_params.Tick.Field.t) } in - Some (vk, stmt, pi) )) + Some (vk, stmt, pi) ) ) in let v : User_command.Valid.t = User_command.Poly.Parties @@ -113,4 +112,4 @@ let check : | [] -> `Valid v | _ :: _ -> - `Valid_assuming (v, valid_assuming)) + `Valid_assuming (v, valid_assuming) ) diff --git a/src/lib/verifier/dummy.ml b/src/lib/verifier/dummy.ml index 262e568b61a..bcea032dd2e 100644 --- a/src/lib/verifier/dummy.ml +++ b/src/lib/verifier/dummy.ml @@ -48,7 +48,7 @@ let verify_commands _ (cs : User_command.Verifiable.t list) : | `Invalid_proof -> `Invalid_proof | `Missing_verification_key keys -> - `Missing_verification_key keys) + `Missing_verification_key keys ) |> Deferred.Or_error.return let verify_transaction_snarks _ ts = @@ -62,7 +62,7 @@ let verify_transaction_snarks _ ts = let msg_digest = Sok_message.digest message in let sok_digest = Transaction_snark.sok_digest proof in Sok_message.Digest.(equal sok_digest default) - || Mina_base.Sok_message.Digest.equal sok_digest msg_digest) + || Mina_base.Sok_message.Digest.equal sok_digest msg_digest ) |> Deferred.Or_error.return let get_blockchain_verification_key { proof_level; constraint_constants } = @@ -79,4 +79,4 @@ let get_blockchain_verification_key { proof_level; constraint_constants } = let proof_level = proof_level end) in - Deferred.return @@ Lazy.force B.Proof.verification_key) + Deferred.return @@ Lazy.force B.Proof.verification_key ) diff --git a/src/lib/verifier/prod.ml b/src/lib/verifier/prod.ml index 806dd97e465..1274508bf59 100644 --- a/src/lib/verifier/prod.ml +++ b/src/lib/verifier/prod.ml @@ -79,7 +79,7 @@ module Worker_state = struct | `Invalid_signature _ | `Invalid_proof | `Missing_verification_key _ -> - []) + [] ) in let%map all_verified = Pickles.Side_loaded.verify @@ -98,7 +98,7 @@ module Worker_state = struct | `Invalid_proof -> `Invalid_proof | `Missing_verification_key keys -> - `Missing_verification_key keys) + `Missing_verification_key keys ) let verify_blockchain_snarks = B.Proof.verify @@ -116,7 +116,7 @@ module Worker_state = struct let get_blockchain_verification_key () = Lazy.force B.Proof.verification_key end in - (module M : S)) + (module M : S) ) | Check | None -> Deferred.return @@ ( module struct @@ -134,7 +134,7 @@ module Worker_state = struct | `Invalid_proof -> `Invalid_proof | `Missing_verification_key keys -> - `Missing_verification_key keys) + `Missing_verification_key keys ) |> Deferred.return let verify_blockchain_snarks _ = Deferred.return true @@ -155,7 +155,7 @@ module Worker_state = struct let proof_level = proof_level end) in - Lazy.force B.Proof.verification_key) + Lazy.force B.Proof.verification_key ) let get_blockchain_verification_key () = Lazy.force vk end : S ) @@ -206,7 +206,7 @@ module Worker = struct M.verify_blockchain_snarks (List.map chains ~f:(fun snark -> ( Blockchain_snark.Blockchain.state snark - , Blockchain_snark.Blockchain.proof snark ))) + , Blockchain_snark.Blockchain.proof snark ) ) ) let verify_transaction_snarks (w : Worker_state.t) ts = let (module M) = Worker_state.get w in @@ -269,7 +269,7 @@ module Worker = struct ~transport: (Logger_file_system.dumb_logrotate ~directory:(Option.value_exn conf_dir) - ~log_filename:"mina-verifier.log" ~max_size ~num_rotate) ) ; + ~log_filename:"mina-verifier.log" ~max_size ~num_rotate ) ) ; [%log info] "Verifier started" ; Worker_state.create { conf_dir; logger; proof_level; constraint_constants } @@ -318,12 +318,12 @@ let create ~logger ~proof_level ~constraint_constants ~pids ~conf_dir : (fun exn -> let err = Error.of_exn ~backtrace:`Get exn in [%log error] "Error from verifier worker $err" - ~metadata:[ ("err", Error_json.error_to_yojson err) ])) + ~metadata:[ ("err", Error_json.error_to_yojson err) ] ) ) (fun () -> Worker.spawn_in_foreground_exn ~connection_timeout:(Time.Span.of_min 1.) ~on_failure ~shutdown_on:Disconnect ~connection_state_init_arg:() - { conf_dir; logger; proof_level; constraint_constants }) + { conf_dir; logger; proof_level; constraint_constants } ) |> Deferred.Result.map_error ~f:Error.of_exn in Child_processes.Termination.wait_for_process_log_errors ~logger process @@ -350,14 +350,14 @@ let create ~logger ~proof_level ~constraint_constants ~pids ~conf_dir : ~f:(fun stdout -> return @@ [%log debug] "Verifier stdout: $stdout" - ~metadata:[ ("stdout", `String stdout) ]) ; + ~metadata:[ ("stdout", `String stdout) ] ) ; don't_wait_for @@ Pipe.iter (Process.stderr process |> Reader.pipe) ~f:(fun stderr -> return @@ [%log error] "Verifier stderr: $stderr" - ~metadata:[ ("stderr", `String stderr) ]) ; + ~metadata:[ ("stderr", `String stderr) ] ) ; { connection; process; exit_or_signal } in let%map worker = create_worker () |> Deferred.Or_error.ok_exn in @@ -383,7 +383,7 @@ let create ~logger ~proof_level ~constraint_constants ~pids ~conf_dir : begin creating a new process anyway. *) (let%map () = after (Time.Span.of_sec 10.) in - Ivar.fill_if_empty create_worker_trigger ()) ; + Ivar.fill_if_empty create_worker_trigger () ) ; let () = match e with | `Unexpected_termination -> @@ -427,7 +427,7 @@ let create ~logger ~proof_level ~constraint_constants ~pids ~conf_dir : ( ("verifier_pid", `Int (Process.pid process |> Pid.to_int)) :: exit_metadata ) ; Child_processes.Termination.remove pids pid ; - Ivar.fill_if_empty create_worker_trigger ()) ; + Ivar.fill_if_empty create_worker_trigger () ) ; don't_wait_for (let%bind () = Ivar.read create_worker_trigger in let rec try_create_worker () = @@ -444,7 +444,7 @@ let create ~logger ~proof_level ~constraint_constants ~pids ~conf_dir : let%bind () = after Time.Span.(of_sec 5.) in try_create_worker () in - try_create_worker ())) + try_create_worker () ) ) in on_worker worker ; { worker = worker_ref; logger } @@ -489,7 +489,7 @@ let verify_blockchain_snarks { worker; logger } chains = ; Worker.Connection.run connection ~f:Worker.functions.verify_blockchains ~arg:chains |> Deferred.Or_error.map ~f:(fun x -> `Continue x) - ])) + ] ) ) let verify_transaction_snarks { worker; logger } ts = O1trace.thread "dispatch_transaction_snark_verification" (fun () -> @@ -501,14 +501,14 @@ let verify_transaction_snarks { worker; logger } ts = let%bind { connection; _ } = Ivar.read !worker in Worker.Connection.run connection ~f:Worker.functions.verify_transaction_snarks ~arg:ts - |> Deferred.Or_error.map ~f:(fun x -> `Continue x)) + |> Deferred.Or_error.map ~f:(fun x -> `Continue x) ) in [%log trace] "verify $n transaction_snarks (after)!" ~metadata: ( ( "result" , `String (Sexp.to_string ([%sexp_of: bool Or_error.t] res)) ) :: metadata ) ; - res) + res ) let verify_commands { worker; logger } ts = O1trace.thread "dispatch_user_command_verification" (fun () -> @@ -516,7 +516,7 @@ let verify_commands { worker; logger } ts = let%bind { connection; _ } = Ivar.read !worker in Worker.Connection.run connection ~f:Worker.functions.verify_commands ~arg:ts - |> Deferred.Or_error.map ~f:(fun x -> `Continue x))) + |> Deferred.Or_error.map ~f:(fun x -> `Continue x) ) ) let get_blockchain_verification_key { worker; logger } = O1trace.thread "dispatch_blockchain_verification_key" (fun () -> @@ -524,4 +524,4 @@ let get_blockchain_verification_key { worker; logger } = let%bind { connection; _ } = Ivar.read !worker in Worker.Connection.run connection ~f:Worker.functions.get_blockchain_verification_key ~arg:() - |> Deferred.Or_error.map ~f:(fun x -> `Continue x))) + |> Deferred.Or_error.map ~f:(fun x -> `Continue x) ) ) diff --git a/src/lib/visualization/visualization.ml b/src/lib/visualization/visualization.ml index 47e3e3ceaa7..6f5865def71 100644 --- a/src/lib/visualization/visualization.ml +++ b/src/lib/visualization/visualization.ml @@ -22,7 +22,7 @@ let rec to_dot (json : Yojson.Safe.t) = | `Assoc subvalues -> sprintf !"{%s|{%s}}" key @@ to_dot (`Assoc subvalues) | subvalue -> - sprintf !"%s:%s" key (to_dot subvalue)) + sprintf !"%s:%s" key (to_dot subvalue) ) |> String.concat ~sep:"|" | `List values | `Tuple values -> List.map values ~f:(fun value -> to_dot value) |> String.concat ~sep:"|" @@ -32,7 +32,7 @@ let rec to_dot (json : Yojson.Safe.t) = Bool.to_string value | `Variant (key, value) -> Option.value_map value ~default:key ~f:(fun some_value -> - sprintf !"%s:%s" key (to_dot some_value)) + sprintf !"%s:%s" key (to_dot some_value) ) | `Null -> "null" diff --git a/src/lib/vrf_evaluator/vrf_evaluator.ml b/src/lib/vrf_evaluator/vrf_evaluator.ml index 62f53b391db..6ccadbacdb4 100644 --- a/src/lib/vrf_evaluator/vrf_evaluator.ml +++ b/src/lib/vrf_evaluator/vrf_evaluator.ml @@ -89,7 +89,7 @@ module Worker_state = struct let last_checked_slot_and_epoch = Table.create () in List.iter new_keys ~f:(fun (_, pk) -> let data = Option.value (Table.find old_table pk) ~default in - Table.add_exn last_checked_slot_and_epoch ~key:pk ~data) ; + Table.add_exn last_checked_slot_and_epoch ~key:pk ~data ) ; last_checked_slot_and_epoch let seen_slot last_checked_slot_and_epoch epoch slot = @@ -107,7 +107,7 @@ module Worker_state = struct Some pk else ( Table.set last_checked_slot_and_epoch ~key:pk ~data:(epoch, slot) ; - Some pk )) + Some pk ) ) in match unseens with | [] -> @@ -289,7 +289,7 @@ module Functions = struct [%log info] "Received epoch data for current epoch $epoch. Skipping " ~metadata:[ ("epoch", Epoch.to_yojson e.epoch) ] ; - Deferred.unit )) + Deferred.unit ) ) let slots_won_so_far = create Unit.bin_t Vrf_evaluation_result.Stable.Latest.bin_t (fun w () -> @@ -305,7 +305,7 @@ module Functions = struct | None -> Completed in - return Vrf_evaluation_result.{ slots_won; evaluator_status }) + return Vrf_evaluation_result.{ slots_won; evaluator_status } ) let update_block_producer_keys = create Block_producer_keys.Stable.Latest.bin_t Unit.bin_t (fun w e -> @@ -313,7 +313,7 @@ module Functions = struct [%log info] "Updating block producer keys" ; w.block_producer_keys <- e ; (*TODO: Interrupt the evaluation here when we handle key updated*) - Deferred.unit) + Deferred.unit ) end module Worker = struct @@ -363,7 +363,7 @@ module Worker = struct ~processor:(Logger.Processor.raw ()) ~transport: (Logger_file_system.dumb_logrotate ~directory:init_arg.conf_dir - ~log_filename:"mina-vrf-evaluator.log" ~max_size ~num_rotate) ; + ~log_filename:"mina-vrf-evaluator.log" ~max_size ~num_rotate ) ; [%log info] "Vrf_evaluator started" ; return (Worker_state.create init_arg) @@ -410,14 +410,14 @@ let create ~constraint_constants ~pids ~consensus_constants ~conf_dir ~logger ~f:(fun stdout -> return @@ [%log debug] "Vrf_evaluator stdout: $stdout" - ~metadata:[ ("stdout", `String stdout) ]) ; + ~metadata:[ ("stdout", `String stdout) ] ) ; don't_wait_for @@ Pipe.iter (Process.stderr process |> Reader.pipe) ~f:(fun stderr -> return @@ [%log error] "Vrf_evaluator stderr: $stderr" - ~metadata:[ ("stderr", `String stderr) ]) ; + ~metadata:[ ("stderr", `String stderr) ] ) ; let t = { connection; process } in let%map _ = update_block_producer_keys ~keypairs t in t diff --git a/src/lib/vrf_lib/integrated.ml b/src/lib/vrf_lib/integrated.ml index 3c97b677ed5..97caa9fcc20 100644 --- a/src/lib/vrf_lib/integrated.ml +++ b/src/lib/vrf_lib/integrated.ml @@ -115,7 +115,7 @@ end = struct Group.Checked.scale_generator (module Shifted) private_key ~init:Shifted.zero - >>= Shifted.Assert.equal public_key_shifted) + >>= Shifted.Assert.equal public_key_shifted ) in eval (module Shifted) ~private_key message end diff --git a/src/lib/vrf_lib/standalone.ml b/src/lib/vrf_lib/standalone.ml index c2c372c8ea6..b84b26d4980 100644 --- a/src/lib/vrf_lib/standalone.ml +++ b/src/lib/vrf_lib/standalone.ml @@ -208,13 +208,13 @@ end = struct Impl.Typ.of_hlistable [ Discrete_log_equality.typ; Group.typ ] ~var_to_hlist:(fun { discrete_log_equality; scaled_message_hash } -> - [ discrete_log_equality; scaled_message_hash ]) + [ discrete_log_equality; scaled_message_hash ] ) ~value_to_hlist:(fun { discrete_log_equality; scaled_message_hash } -> - [ discrete_log_equality; scaled_message_hash ]) + [ discrete_log_equality; scaled_message_hash ] ) ~value_of_hlist:(fun [ discrete_log_equality; scaled_message_hash ] -> - { discrete_log_equality; scaled_message_hash }) + { discrete_log_equality; scaled_message_hash } ) ~var_of_hlist:(fun [ discrete_log_equality; scaled_message_hash ] -> - { discrete_log_equality; scaled_message_hash }) + { discrete_log_equality; scaled_message_hash } ) let create (k : Private_key.t) message : t = let public_key = Group.scale Group.generator k in @@ -243,14 +243,14 @@ end = struct Scalar.equal c (Hash.hash_for_proof message public_key ((s * g) + (c * Group.negate public_key)) - ((s * message_hash) + (c * Group.negate scaled_message_hash))) + ((s * message_hash) + (c * Group.negate scaled_message_hash)) ) in if dleq then Some (Output_hash.hash message scaled_message_hash) else None module Checked = struct let verified_output (type shifted) ((module Shifted) as shifted : - (module Group.Checked.Shifted.S with type t = shifted)) + (module Group.Checked.Shifted.S with type t = shifted) ) ({ scaled_message_hash; discrete_log_equality = { c; s } } : var) ({ message; public_key } : Context.var) = let open Impl.Checked in @@ -301,7 +301,7 @@ struct let pack_char bs = Char.of_int_exn (List.foldi bs ~init:0 ~f:(fun i acc b -> - if b then acc lor (1 lsl i) else acc)) + if b then acc lor (1 lsl i) else acc ) ) in String.of_char_list (List.map ~f:pack_char (List.chunks_of ~length:8 bs)) |> Z.of_bits |> Bigint.of_zarith_bigint @@ -319,7 +319,7 @@ struct let%test_unit "add is correct" = Quickcheck.test (Quickcheck.Generator.tuple2 gen gen) ~f:(fun (x, y) -> - assert (equal (add x y) ((x + y) % modulus))) + assert (equal (add x y) ((x + y) % modulus)) ) let mul x y = x * y % modulus @@ -329,7 +329,7 @@ struct let of_bits bs = List.fold_left bs ~init:(zero, one) ~f:(fun (acc, pt) b -> - ((if b then add acc pt else acc), add pt pt)) + ((if b then add acc pt else acc), add pt pt) ) |> fst let%test_unit "of_bits . to_bits = identity" = @@ -344,7 +344,7 @@ struct transport (list ~length:length_in_bits Boolean.typ) ~there:(fun n -> - List.init length_in_bits ~f:(Z.testbit (to_zarith_bigint n))) + List.init length_in_bits ~f:(Z.testbit (to_zarith_bigint n)) ) ~back:pack module Checked = struct diff --git a/src/lib/vrf_lib/tests/integrated_test.ml b/src/lib/vrf_lib/tests/integrated_test.ml index 7f60a75b637..aceb1a808d7 100644 --- a/src/lib/vrf_lib/tests/integrated_test.ml +++ b/src/lib/vrf_lib/tests/integrated_test.ml @@ -44,7 +44,7 @@ module Message = struct let hash_to_group ~constraint_constants:_ msg = Group_map.to_group (Random_oracle.hash ~init:Mina_base.Hash_prefix.vrf_message - [| msg.state_hash |]) + [| msg.state_hash |] ) |> Tick.Inner_curve.of_affine module Checked = struct @@ -53,7 +53,7 @@ module Message = struct Group_map.Checked.to_group (Random_oracle.Checked.hash ~init:Mina_base.Hash_prefix.vrf_message (Random_oracle.Checked.pack_input - (Mina_base.State_hash.var_to_input msg.state_hash)))) + (Mina_base.State_hash.var_to_input msg.state_hash) ) ) ) end end @@ -75,7 +75,7 @@ module Output_hash = struct Snark_params.Tick.make_checked (fun () -> let x, y = g in Random_oracle.Checked.hash - [| Mina_base.State_hash.var_to_hash_packed state_hash; x; y |]) + [| Mina_base.State_hash.var_to_hash_packed state_hash; x; y |] ) end end @@ -100,9 +100,9 @@ let%test_unit "eval unchecked vs. checked equality" = (fun (private_key, msg) -> let open Tick.Checked in let%bind (module Shifted) = Group.Checked.Shifted.create () in - Vrf.Checked.eval (module Shifted) ~private_key msg) + Vrf.Checked.eval (module Shifted) ~private_key msg ) (fun (private_key, msg) -> - Vrf.eval ~constraint_constants ~private_key msg)) + Vrf.eval ~constraint_constants ~private_key msg ) ) let%bench_module "vrf bench module" = ( module struct @@ -127,6 +127,6 @@ let%bench_module "vrf bench module" = (fun (private_key, msg) -> let open Tick.Checked in let%bind (module Shifted) = Group.Checked.Shifted.create () in - Vrf.Checked.eval (module Shifted) ~private_key msg) + Vrf.Checked.eval (module Shifted) ~private_key msg ) (private_key, msg) end ) diff --git a/src/lib/vrf_lib/tests/standalone_test.ml b/src/lib/vrf_lib/tests/standalone_test.ml index f0a4b08a72a..1ca87a12bfa 100644 --- a/src/lib/vrf_lib/tests/standalone_test.ml +++ b/src/lib/vrf_lib/tests/standalone_test.ml @@ -69,13 +69,14 @@ let%test_module "vrf-test" = (to_affine_or_infinity y)) module Checked = struct - include Snarky_curves.Make_weierstrass_checked - (Snarky_field_extensions.Field_extensions.F (Impl)) (Scalar) - (Snark_params.Tick.Inner_curve) - (Snark_params.Tick.Inner_curve.Params) - (struct - let add = None - end) + include + Snarky_curves.Make_weierstrass_checked + (Snarky_field_extensions.Field_extensions.F (Impl)) (Scalar) + (Snark_params.Tick.Inner_curve) + (Snark_params.Tick.Inner_curve.Params) + (struct + let add = None + end) let add_known_unsafe t x = add_unsafe t (constant x) end @@ -89,17 +90,18 @@ let%test_module "vrf-test" = module T = struct type t = Curve.t - include Sexpable.Of_sexpable - (struct - type t = Field.t * Field.t [@@deriving sexp] - end) - (struct - type t = Curve.t + include + Sexpable.Of_sexpable + (struct + type t = Field.t * Field.t [@@deriving sexp] + end) + (struct + type t = Curve.t - let to_sexpable = Curve.to_affine_exn + let to_sexpable = Curve.to_affine_exn - let of_sexpable = Curve.of_affine - end) + let of_sexpable = Curve.of_affine + end) end include T @@ -137,7 +139,7 @@ let%test_module "vrf-test" = failwithf !"inv failured, x = %{sexp:t}, x + inv x = %{sexp:t}, expected \ %{sexp:t}" - x res zero ()) + x res zero () ) let%test_unit "scaling associates" = let open Quickcheck in @@ -146,7 +148,7 @@ let%test_module "vrf-test" = assert ( equal (scale generator (Scalar.mul a b)) - (scale (scale generator a) b) )) + (scale (scale generator a) b) ) ) module Checked = struct include Curve.Checked @@ -165,7 +167,7 @@ let%test_module "vrf-test" = Array.init (5 * Impl.Field.size_in_bits) ~f:(fun _ -> let t = Curve.random () in let tt = Curve.double t in - (t, tt, Curve.add t tt, Curve.double tt)) + (t, tt, Curve.add t tt, Curve.double tt) ) module Pedersen = Snarky.Pedersen.Make (Impl) (Curve) @@ -179,17 +181,18 @@ let%test_module "vrf-test" = type t = Curve.t - include Sexpable.Of_sexpable - (struct - type t = Field.t * Field.t [@@deriving sexp] - end) - (struct - type t = Curve.t + include + Sexpable.Of_sexpable + (struct + type t = Field.t * Field.t [@@deriving sexp] + end) + (struct + type t = Curve.t - let to_sexpable = Curve.to_affine_exn + let to_sexpable = Curve.to_affine_exn - let of_sexpable = Curve.of_affine - end) + let of_sexpable = Curve.of_affine + end) type value = t [@@deriving sexp] @@ -219,7 +222,7 @@ let%test_module "vrf-test" = ~f:(fun i acc triple -> Curve.add acc (Snarky.Pedersen.local_function ~negate:Curve.negate params.(i) - triple)) + triple ) ) |> Curve.to_affine_exn |> fst let hash_bits_checked bits = @@ -282,5 +285,5 @@ let%test_module "vrf-test" = if not (Option.is_some (Vrf.Evaluation.verified_output eval ctx)) then failwithf !"%{sexp:Vrf.Context.t}, %{sexp:Vrf.Evaluation.t}" - ctx eval ()) + ctx eval () ) end ) diff --git a/src/lib/web_client_pipe/web_client_pipe.ml b/src/lib/web_client_pipe/web_client_pipe.ml index 41e5ef0f675..8a13ef807c3 100644 --- a/src/lib/web_client_pipe/web_client_pipe.ml +++ b/src/lib/web_client_pipe/web_client_pipe.ml @@ -48,7 +48,8 @@ end) () | Error e -> [%log error] "Error writing Web client pipe data: $error" - ~metadata:[ ("error", Error_json.error_to_yojson e) ])) + ~metadata:[ ("error", Error_json.error_to_yojson e) ] ) + ) | Error e -> [%log error] "Unable to create request: $error" ~metadata:[ ("error", Error_json.error_to_yojson e) ] diff --git a/src/lib/work_selector/inputs.ml b/src/lib/work_selector/inputs.ml index 94edcb2f283..4ce1fa513d4 100644 --- a/src/lib/work_selector/inputs.ml +++ b/src/lib/work_selector/inputs.ml @@ -52,7 +52,7 @@ module Test_inputs = struct | None -> fee | Some fee' -> - Currency.Fee.min fee fee') + Currency.Fee.min fee fee' ) end module Staged_ledger = struct diff --git a/src/lib/work_selector/intf.ml b/src/lib/work_selector/intf.ml index cd1a7f23f46..1edde1752c0 100644 --- a/src/lib/work_selector/intf.ml +++ b/src/lib/work_selector/intf.ml @@ -51,8 +51,7 @@ module type Inputs_intf = sig val all_work_pairs : t -> get_state: - ( Mina_base.State_hash.t - -> Mina_state.Protocol_state.value Or_error.t) + (Mina_base.State_hash.t -> Mina_state.Protocol_state.value Or_error.t) -> ( Transaction_witness.t , Ledger_proof.t ) Snark_work_lib.Work.Single.Spec.t @@ -185,9 +184,9 @@ module type Make_selection_method_intf = functor Selection_method_intf with type staged_ledger := Inputs.Staged_ledger.t and type work := - ( Inputs.Transaction_witness.t - , Inputs.Ledger_proof.t ) - Snark_work_lib.Work.Single.Spec.t + ( Inputs.Transaction_witness.t + , Inputs.Ledger_proof.t ) + Snark_work_lib.Work.Single.Spec.t and type snark_pool := Inputs.Snark_pool.t and type transition_frontier := Inputs.Transition_frontier.t and module State := Lib.State diff --git a/src/lib/work_selector/test.ml b/src/lib/work_selector/test.ml index 5ab68744cad..afb29451ea5 100644 --- a/src/lib/work_selector/test.ml +++ b/src/lib/work_selector/test.ml @@ -47,7 +47,7 @@ struct in match stuff with None -> return () | _ -> go (i + 1) in - go 0)) + go 0 ) ) let%test_unit "Reassign work after the wait time" = Backtrace.elide := false ; @@ -75,7 +75,7 @@ struct Async.after (Time.Span.of_ms (Float.of_int reassignment_wait)) in let work_sent_again = send_work work_state in - assert (List.length work_sent = List.length work_sent_again))) + assert (List.length work_sent = List.length work_sent_again) ) ) let gen_snark_pool (works : ('a, 'b) Lib.Work_spec.t One_or_two.t list) fee = let open Quickcheck.Generator.Let_syntax in @@ -110,7 +110,7 @@ struct ( T.Staged_ledger.all_work_pairs sl ~get_state:(fun _ -> Ok (Lazy.force precomputed_values).protocol_state_with_hashes - .data) + .data ) |> Or_error.ok_exn ) (Currency.Fee.of_int 2) in @@ -139,8 +139,8 @@ struct ~message:"Should not get any cheap jobs" ~expect:true (Lib.For_tests.does_not_have_better_fee ~snark_pool ~fee:my_fee - (One_or_two.map job ~f:Lib.Work_spec.statement)) ; + (One_or_two.map job ~f:Lib.Work_spec.statement) ) ; go (i + 1) in - go 0)) + go 0 ) ) end diff --git a/src/lib/work_selector/work_lib.ml b/src/lib/work_selector/work_lib.ml index 43074cde3c5..6079808f93c 100644 --- a/src/lib/work_selector/work_lib.ml +++ b/src/lib/work_selector/work_lib.ml @@ -65,7 +65,7 @@ module Make (Inputs : Intf.Inputs_intf) = struct Inputs.Staged_ledger.all_work_pairs best_tip_staged_ledger ~get_state: (Inputs.Transition_frontier.get_protocol_state - frontier) + frontier ) with | Error e -> [%log fatal] @@ -81,16 +81,16 @@ module Make (Inputs : Intf.Inputs_intf) = struct |> Time.Span.to_ms ) ) ] ; t.available_jobs <- new_available_jobs ) ; - Deferred.unit) + Deferred.unit ) |> Deferred.don't_wait_for ) ; - Deferred.unit) + Deferred.unit ) |> Deferred.don't_wait_for ; t let all_unseen_works t = List.filter t.available_jobs ~f:(fun js -> not - @@ Hashtbl.mem t.jobs_seen (One_or_two.map ~f:Work_spec.statement js)) + @@ Hashtbl.mem t.jobs_seen (One_or_two.map ~f:Work_spec.statement js) ) let remove_old_assignments t ~logger = let now = Time.now () in @@ -103,7 +103,7 @@ module Make (Inputs : Intf.Inputs_intf) = struct "Waited too long to get work for $work. Ready to be reassigned" ; Mina_metrics.(Counter.inc_one Snark_work.snark_work_timed_out_rpc) ; false ) - else true) + else true ) let remove t x = Hashtbl.remove t.jobs_seen (One_or_two.map ~f:Work_spec.statement x) @@ -120,7 +120,7 @@ module Make (Inputs : Intf.Inputs_intf) = struct (Inputs.Snark_pool.get_completed_work snark_pool statements) ~f:(fun priced_proof -> let competing_fee = Inputs.Transaction_snark_work.fee priced_proof in - Fee.compare fee competing_fee < 0) + Fee.compare fee competing_fee < 0 ) module For_tests = struct let does_not_have_better_fee = does_not_have_better_fee @@ -131,11 +131,11 @@ module Make (Inputs : Intf.Inputs_intf) = struct ('a, 'b) Work_spec.t One_or_two.t list = List.filter jobs ~f:(fun job -> does_not_have_better_fee ~snark_pool ~fee - (One_or_two.map job ~f:Work_spec.statement)) + (One_or_two.map job ~f:Work_spec.statement) ) let all_pending_work ~snark_pool statements = List.filter statements ~f:(fun st -> - Option.is_none (Inputs.Snark_pool.get_completed_work snark_pool st)) + Option.is_none (Inputs.Snark_pool.get_completed_work snark_pool st) ) (*Seen/Unseen jobs that are not in the snark pool yet*) let pending_work_statements ~snark_pool ~fee_opt (state : State.t) = diff --git a/src/lib/work_selector/work_selector.ml b/src/lib/work_selector/work_selector.ml index 1c9b44b15e7..0236aafc7f1 100644 --- a/src/lib/work_selector/work_selector.ml +++ b/src/lib/work_selector/work_selector.ml @@ -6,9 +6,7 @@ module type Selection_method_intf = with type snark_pool := Network_pool.Snark_pool.t and type staged_ledger := Staged_ledger.t and type work := - ( Transaction_witness.t - , Ledger_proof.t ) - Snark_work_lib.Work.Single.Spec.t + (Transaction_witness.t, Ledger_proof.t) Snark_work_lib.Work.Single.Spec.t and type transition_frontier := Transition_frontier.t and module State := State diff --git a/src/lib/work_selector/work_selector.mli b/src/lib/work_selector/work_selector.mli index daef903fa1d..3e20e8c9ee8 100644 --- a/src/lib/work_selector/work_selector.mli +++ b/src/lib/work_selector/work_selector.mli @@ -6,9 +6,7 @@ module type Selection_method_intf = with type snark_pool := Network_pool.Snark_pool.t and type staged_ledger := Staged_ledger.t and type work := - ( Transaction_witness.t - , Ledger_proof.t ) - Snark_work_lib.Work.Single.Spec.t + (Transaction_witness.t, Ledger_proof.t) Snark_work_lib.Work.Single.Spec.t and type transition_frontier := Transition_frontier.t and module State := State diff --git a/src/lib/zkapps_examples/empty_update/zkapps_empty_update.ml b/src/lib/zkapps_examples/empty_update/zkapps_empty_update.ml index 454752c9432..876ef689ad3 100644 --- a/src/lib/zkapps_examples/empty_update/zkapps_empty_update.ml +++ b/src/lib/zkapps_examples/empty_update/zkapps_empty_update.ml @@ -11,7 +11,7 @@ let main public_key = Party_under_construction.In_circuit.create ~public_key:(Public_key.Compressed.var_of_t public_key) ~token_id:Token_id.(Checked.constant default) - ()) + () ) (* TODO: This shouldn't exist, the circuit should just return the requisite values. diff --git a/src/lib/zkapps_examples/initialize_state/zkapps_initialize_state.ml b/src/lib/zkapps_examples/initialize_state/zkapps_initialize_state.ml index ab0bb63df56..4abfc1ab607 100644 --- a/src/lib/zkapps_examples/initialize_state/zkapps_initialize_state.ml +++ b/src/lib/zkapps_examples/initialize_state/zkapps_initialize_state.ml @@ -29,7 +29,7 @@ let initialize public_key = List.map ~f:Field.constant (Lazy.force initial_state) in party |> Party_under_construction.In_circuit.assert_state_unproved - |> Party_under_construction.In_circuit.set_full_state initial_state) + |> Party_under_construction.In_circuit.set_full_state initial_state ) type _ Snarky_backendless.Request.t += | New_state : Field.Constant.t list Snarky_backendless.Request.t @@ -54,7 +54,7 @@ let update_state public_key = exists (Typ.list ~length:8 Field.typ) ~request:(fun () -> New_state) in party |> Party_under_construction.In_circuit.assert_state_proved - |> Party_under_construction.In_circuit.set_full_state new_state) + |> Party_under_construction.In_circuit.set_full_state new_state ) let main_value ([] : _ H1.T(Id).t) (_ : Zkapp_statement.t) : _ H1.T(E01(Core_kernel.Bool)).t = diff --git a/src/lib/zkapps_examples/zkapps_examples.ml b/src/lib/zkapps_examples/zkapps_examples.ml index 1bfb4f94800..f5771b673d8 100644 --- a/src/lib/zkapps_examples/zkapps_examples.ml +++ b/src/lib/zkapps_examples/zkapps_examples.ml @@ -199,7 +199,7 @@ module Party_under_construction = struct ] ; sequence_state = Ignore ; proved_state = Ignore - }) + } ) in let proved_state = (* TODO: This is not great. *) @@ -265,7 +265,7 @@ module Party_under_construction = struct *) Zkapp_basic.Set_or_keep.Checked.keep ~dummy:Field.zero | Some x -> - Zkapp_basic.Set_or_keep.Checked.set x) + Zkapp_basic.Set_or_keep.Checked.set x ) in { default with app_state } diff --git a/src/libp2p_ipc/incremental_parsing.ml b/src/libp2p_ipc/incremental_parsing.ml index 2f7d64538be..aacc10ae06b 100644 --- a/src/libp2p_ipc/incremental_parsing.ml +++ b/src/libp2p_ipc/incremental_parsing.ml @@ -109,7 +109,7 @@ module Decoders = struct in Bytes.unsafe_blit ~src:buf ~src_pos:start ~dst:result ~dst_pos:i ~len ; - i + len) + i + len ) = size ) ; result in @@ -167,7 +167,7 @@ module Decoders = struct { size = elt_size ; initial_state = elt_initial_state ; read = read_elt - }) = + } ) = element in let open struct @@ -229,7 +229,7 @@ module Decoders = struct ; current_elt_state ; remaining_elements ; accumulator - }) + } ) in match advance elements [] with | None -> @@ -333,7 +333,7 @@ let%test_module "decoder tests" = |> Stdlib.Bytes.unsafe_of_string in let result = unsafe_decode (bytes size) view in - [%test_eq: bytes] result expected) + [%test_eq: bytes] result expected ) let%test_unit "uint32 decoder" = let gen_serialized_uint32 = @@ -359,7 +359,7 @@ let%test_module "decoder tests" = |> Stdlib.Bytes.unsafe_of_string in let result = unsafe_decode (bytes size) view in - [%test_eq: bytes] result expected) + [%test_eq: bytes] result expected ) end ) module Fragment_stream = struct @@ -386,7 +386,7 @@ module Fragment_stream = struct if remaining' <= 0 then ( t.outstanding_read_request <- None ; Ivar.fill signal () ) - else t.outstanding_read_request <- Some (remaining', signal)) + else t.outstanding_read_request <- Some (remaining', signal) ) let read_now_exn t amount_to_read = (* IMPORTANT: maintain tail recursion *) diff --git a/src/libp2p_ipc/libp2p_ipc.ml b/src/libp2p_ipc/libp2p_ipc.ml index 3027b2763c3..3e7534974de 100644 --- a/src/libp2p_ipc/libp2p_ipc.ml +++ b/src/libp2p_ipc/libp2p_ipc.ml @@ -89,10 +89,9 @@ let () = | Received_undefined_union (ctx, n) -> Some (Printf.sprintf - "Received an undefined union for %s over the libp2p IPC: %n " ctx - n) + "Received an undefined union for %s over the libp2p IPC: %n " ctx n ) | _ -> - None) + None ) let compression = `None @@ -275,7 +274,7 @@ let create_push_message ~validation_id ~validation_result = (module Builder.Libp2pHelperInterface.Validation) Builder.Libp2pHelperInterface.Validation.( reader_op validation_id_set_reader validation_id - *> op result_set validation_result))) + *> op result_set validation_result) )) let read_and_decode_message = let open Incremental_parsing in @@ -288,7 +287,7 @@ let read_and_decode_message = let%map segments = parse (polymorphic_list - (List.map segment_sizes ~f:(fun n -> bytes (Uint32.to_int n * 8)))) + (List.map segment_sizes ~f:(fun n -> bytes (Uint32.to_int n * 8))) ) in Capnp.BytesMessage.Message.of_storage segments @@ -304,11 +303,11 @@ let read_incoming_messages reader = let r, w = Strict_pipe.create Strict_pipe.Synchronous in let fragment_stream = Incremental_parsing.Fragment_stream.create () in O1trace.background_thread "stream_libp2p_ipc_messages" (fun () -> - stream_messages fragment_stream w) ; + stream_messages fragment_stream w ) ; O1trace.background_thread "accumulate_libp2p_ipc_message_fragments" (fun () -> Strict_pipe.Reader.iter_without_pushback reader ~f:(fun fragment -> Incremental_parsing.Fragment_stream.add_fragment fragment_stream - (Stdlib.Bytes.unsafe_of_string fragment))) ; + (Stdlib.Bytes.unsafe_of_string fragment) ) ) ; r let write_outgoing_message writer msg = diff --git a/src/libp2p_ipc/rpcs.ml b/src/libp2p_ipc/rpcs.ml index 01eb31c358b..2bc2e2264f2 100644 --- a/src/libp2p_ipc/rpcs.ml +++ b/src/libp2p_ipc/rpcs.ml @@ -489,7 +489,7 @@ module SendStream = struct (build (module StreamMessage) ( reader_op StreamMessage.stream_id_set_reader stream_id - *> op StreamMessage.data_set data ))) + *> op StreamMessage.data_set data ) )) end module SetNodeStatus = struct @@ -576,12 +576,12 @@ module TestDecodeBitswapBlocks = struct (module Builder.BlockWithId) ( op Builder.BlockWithId.blake2b_hash_set (Blake2.to_raw_string hash) - *> op Builder.BlockWithId.block_set block ))) + *> op Builder.BlockWithId.block_set block ) ) ) *> builder_op Request.root_block_id_set_builder (build' (module Builder.RootBlockId) (op Builder.RootBlockId.blake2b_hash_set - (Blake2.to_raw_string root_block_hash))) ) + (Blake2.to_raw_string root_block_hash) ) ) ) end module TestEncodeBitswapBlocks = struct diff --git a/src/libp2p_ipc/rpcs.mli b/src/libp2p_ipc/rpcs.mli index f32e4a2d788..828ba996640 100644 --- a/src/libp2p_ipc/rpcs.mli +++ b/src/libp2p_ipc/rpcs.mli @@ -32,9 +32,9 @@ module SetGatingConfig : sig include Rpc_intf with type Request.t = - Builder.Libp2pHelperInterface.SetGatingConfig.Request.t + Builder.Libp2pHelperInterface.SetGatingConfig.Request.t and type Response.t = - Reader.Libp2pHelperInterface.SetGatingConfig.Response.t + Reader.Libp2pHelperInterface.SetGatingConfig.Response.t val create_request : gating_config:gating_config -> Request.t end @@ -52,9 +52,9 @@ module GetListeningAddrs : sig include Rpc_intf with type Request.t = - Builder.Libp2pHelperInterface.GetListeningAddrs.Request.t + Builder.Libp2pHelperInterface.GetListeningAddrs.Request.t and type Response.t = - Reader.Libp2pHelperInterface.GetListeningAddrs.Response.t + Reader.Libp2pHelperInterface.GetListeningAddrs.Response.t val create_request : unit -> Request.t end @@ -63,9 +63,9 @@ module BeginAdvertising : sig include Rpc_intf with type Request.t = - Builder.Libp2pHelperInterface.BeginAdvertising.Request.t + Builder.Libp2pHelperInterface.BeginAdvertising.Request.t and type Response.t = - Reader.Libp2pHelperInterface.BeginAdvertising.Response.t + Reader.Libp2pHelperInterface.BeginAdvertising.Response.t val create_request : unit -> Request.t end @@ -92,9 +92,9 @@ module BandwidthInfo : sig include Rpc_intf with type Request.t = - Builder.Libp2pHelperInterface.BandwidthInfo.Request.t + Builder.Libp2pHelperInterface.BandwidthInfo.Request.t and type Response.t = - Reader.Libp2pHelperInterface.BandwidthInfo.Response.t + Reader.Libp2pHelperInterface.BandwidthInfo.Response.t val create_request : unit -> Request.t end @@ -103,9 +103,9 @@ module GenerateKeypair : sig include Rpc_intf with type Request.t = - Builder.Libp2pHelperInterface.GenerateKeypair.Request.t + Builder.Libp2pHelperInterface.GenerateKeypair.Request.t and type Response.t = - Reader.Libp2pHelperInterface.GenerateKeypair.Response.t + Reader.Libp2pHelperInterface.GenerateKeypair.Response.t val create_request : unit -> Request.t end @@ -142,9 +142,9 @@ module AddStreamHandler : sig include Rpc_intf with type Request.t = - Builder.Libp2pHelperInterface.AddStreamHandler.Request.t + Builder.Libp2pHelperInterface.AddStreamHandler.Request.t and type Response.t = - Reader.Libp2pHelperInterface.AddStreamHandler.Response.t + Reader.Libp2pHelperInterface.AddStreamHandler.Response.t val create_request : protocol:string -> Request.t end @@ -153,9 +153,9 @@ module RemoveStreamHandler : sig include Rpc_intf with type Request.t = - Builder.Libp2pHelperInterface.RemoveStreamHandler.Request.t + Builder.Libp2pHelperInterface.RemoveStreamHandler.Request.t and type Response.t = - Reader.Libp2pHelperInterface.RemoveStreamHandler.Response.t + Reader.Libp2pHelperInterface.RemoveStreamHandler.Response.t val create_request : protocol:string -> Request.t end @@ -200,9 +200,9 @@ module SetNodeStatus : sig include Rpc_intf with type Request.t = - Builder.Libp2pHelperInterface.SetNodeStatus.Request.t + Builder.Libp2pHelperInterface.SetNodeStatus.Request.t and type Response.t = - Reader.Libp2pHelperInterface.SetNodeStatus.Response.t + Reader.Libp2pHelperInterface.SetNodeStatus.Response.t val create_request : data:string -> Request.t end @@ -211,9 +211,9 @@ module GetPeerNodeStatus : sig include Rpc_intf with type Request.t = - Builder.Libp2pHelperInterface.GetPeerNodeStatus.Request.t + Builder.Libp2pHelperInterface.GetPeerNodeStatus.Request.t and type Response.t = - Reader.Libp2pHelperInterface.GetPeerNodeStatus.Response.t + Reader.Libp2pHelperInterface.GetPeerNodeStatus.Response.t val create_request : peer_multiaddr:multiaddr -> Request.t end @@ -222,9 +222,9 @@ module TestDecodeBitswapBlocks : sig include Rpc_intf with type Request.t = - Builder.Libp2pHelperInterface.TestDecodeBitswapBlocks.Request.t + Builder.Libp2pHelperInterface.TestDecodeBitswapBlocks.Request.t and type Response.t = - Reader.Libp2pHelperInterface.TestDecodeBitswapBlocks.Response.t + Reader.Libp2pHelperInterface.TestDecodeBitswapBlocks.Response.t val create_request : blocks:(Blake2.t * string) list -> root_block_hash:Blake2.t -> Request.t @@ -234,9 +234,9 @@ module TestEncodeBitswapBlocks : sig include Rpc_intf with type Request.t = - Builder.Libp2pHelperInterface.TestEncodeBitswapBlocks.Request.t + Builder.Libp2pHelperInterface.TestEncodeBitswapBlocks.Request.t and type Response.t = - Reader.Libp2pHelperInterface.TestEncodeBitswapBlocks.Response.t + Reader.Libp2pHelperInterface.TestEncodeBitswapBlocks.Response.t val create_request : max_block_size:int -> data:string -> Request.t end diff --git a/src/opam.export b/src/opam.export index 61d9f78655d..e515b9533e4 100644 --- a/src/opam.export +++ b/src/opam.export @@ -1,12 +1,5 @@ opam-version: "2.0" -compiler: [ - "base-bigarray.base" - "base-threads.base" - "base-unix.base" - "ocaml.4.11.2" - "ocaml-base-compiler.4.11.2" - "ocaml-config.1" -] +compiler: ["ocaml-base-compiler.4.11.2"] roots: [ "angstrom.0.15.0" "async_ssl.v0.13.0" @@ -17,7 +10,6 @@ roots: [ "capnp.3.4.0" "cohttp-async.2.5.2-1" "core_extended.v0.13.0" - "depext.transition" "graphql-async.0.9.0" "graphql-cohttp.0.12.1" "js_of_ocaml.3.7.1" @@ -26,12 +18,13 @@ roots: [ "menhir.20210419" "merlin.4.2-411" "ocaml-base-compiler.4.11.2" - "ocamlformat.0.15.0" + "ocamlformat.0.20.1" "ocamlgraph.1.8.8" + "ocp-browser.1.3.3" "ocp-indent.1.7.0" - "ppx_deriving.4.5" + "ppx_deriving.4.5-1" "ppx_deriving_yojson.3.5.3" - "prometheus.0.5" + "prometheus.1.1" "re2.v0.13.0" "rpc_parallel.v0.13.0" "sexp_diff_kernel.v0.13.0" @@ -95,14 +88,15 @@ installed: [ "csexp.1.5.1" "ctypes.0.17.1" "ctypes-foreign.0.4.0" - "depext.transition" "digestif.0.9.0" "domain-name.0.3.0" "dot-merlin-reader.4.1" - "dune.2.8.2" + "dune.3.1.1" + "dune-build-info.3.1.1" "dune-configurator.2.8.2" "dune-private-libs.2.6.2" "easy-format.1.3.2" + "either.1.0.0" "eqaf.0.2" "fieldslib.v0.13.0" "fix.20201120" @@ -146,15 +140,18 @@ installed: [ "ocaml-config.1" "ocaml-migrate-parsetree.1.8.0" "ocaml-syntax-shims.1.0.0" + "ocaml-version.3.4.0" "ocamlbuild.0.14.0" "ocamlfind.1.8.1" - "ocamlformat.0.15.0" + "ocamlformat.0.20.1" "ocamlgraph.1.8.8" + "ocp-browser.1.3.3" "ocp-indent.1.7.0" + "ocp-index.1.3.3" "ocplib-endian.1.0" "octavius.1.2.2" - "odoc.1.5.3" - "opam-depext.1.1.2" + "odoc-parser.1.0.0" + "opam-depext.1.2.1" "parsexp.v0.13.0" "postgresql.5.0.0" "ppx_assert.v0.13.0" @@ -165,7 +162,7 @@ installed: [ "ppx_compare.v0.13.0" "ppx_custom_printf.v0.13.0" "ppx_derivers.1.2.1" - "ppx_deriving.4.5" + "ppx_deriving.4.5-1" "ppx_deriving_yojson.3.5.3" "ppx_enumerate.v0.13.0" "ppx_expect.v0.13.1"