diff --git a/debug/graph/debug_graph.ml b/debug/graph/debug_graph.ml index 66964ca429b9963f03afae55e812ea8b6a19800c..020118bafadb88b7ea737d28d97ab8204a578a2d 100644 --- a/debug/graph/debug_graph.ml +++ b/debug/graph/debug_graph.ml @@ -88,33 +88,16 @@ let rec string_of_strategy strategy = | `arbitrage -> string_of_strategy `chaining | `cycle -> string_of_strategy `chaining -let string_of_single_value value address = +let string_of_token_amount value address = match value with | Tv_complex (V_erc1155 v) -> Common.string_of_erc1155 v | _ -> - normalize_token_value value address ^ " " ^ extract_string_address address - -let string_of_value value asset = - let add_assets = - match asset with - | M_Single s -> [s] - | M_Multiple ss -> List.fold_left (fun acc add -> acc @ [add]) [] ss in - let str_value = - match value with - | V_Single z -> "\n" ^ string_of_single_value z (List.hd add_assets) - | V_None -> "None" - | V_Multiple zs -> - if List.length zs = List.length add_assets then - List.fold_left2 - (fun acc z add_asset -> - acc ^ "\n" ^ string_of_single_value z add_asset) - "" zs add_assets - else - let asset = List.hd add_assets in - List.fold_left - (fun acc z -> acc ^ "\n" ^ string_of_single_value z asset) - "" zs in - str_value + normalize_token_value value address ^ " " ^ symbol_of_eth_address address + +let string_of_tokens_amount tokens_amount = + List.fold_left + (fun acc x -> acc ^ "\n" ^ string_of_token_amount x.tka_amount x.tka_asset) + "" tokens_amount let string_list_tokens (tkns : (string * token_amount) List.t) = List.fold_left @@ -129,6 +112,11 @@ let string_delta_new (delta_new : delta_map) = acc ^ "\naddress: " ^ addr ^ "\n" ^ string_list_tokens lst) "" delta_new +let string_of_addresses (addresses : Common.Types.Ethereum_analysis.addresses) = + List.fold_left + (fun acc (_, address) -> acc ^ "\n" ^ symbol_of_eth_address address) + "" addresses + let string_of_contract_type c_type = match c_type with | ErcStandard ERC1155 -> "ERC-1155" @@ -140,11 +128,11 @@ let extract_transaction_string tx = let _from = match tx.ttxn_from with | None -> "Unknown" - | Some a -> extract_string_address (Ca_address a) in + | Some a -> symbol_of_eth_address (Ca_address a) in let _to = match tx.ttxn_to with | None -> "Unknown" - | Some a -> extract_string_address (Ca_address a) in + | Some a -> symbol_of_eth_address (Ca_address a) in let _typ = tx.ttxn_typ in Format.sprintf "from: %s\nto: %s\ntype: %s" _from _to _typ @@ -208,22 +196,23 @@ module Dot = Graphviz.Dot (struct | Some (Cftn_transfer_chain tc) -> ( match tc with | Cftt_transfer tsfr -> - let _from = extract_string_address tsfr.ttn_from in - let _to = extract_string_address tsfr.ttn_to in + let _from = symbol_of_eth_address tsfr.ttn_from in + let _to = symbol_of_eth_address tsfr.ttn_to in let _operator = match tsfr.ttn_sender with | None -> "Unknown" - | Some a -> extract_string_address a in + | Some a -> symbol_of_eth_address a in let _origin = match tsfr.ttn_origin with | None -> "Unknown" - | Some a -> extract_string_address a in + | Some a -> symbol_of_eth_address a in let _erc = match tsfr.ttn_contract_type with | None -> "Unknown" | Some typ -> string_of_contract_type typ in let _amount = - string_of_value (V_Single tsfr.ttn_amount) (M_Single tsfr.ttn_asset) + string_of_tokens_amount + [Eth_analysis.Eth_graph.cft_transfer_node_of_token_amount tsfr] in let _description = tsfr.ttn_description in Format.sprintf @@ -240,28 +229,22 @@ module Dot = Graphviz.Dot (struct | Some s -> s) _erc | Cftt_chain chain -> - let _from = extract_string_address chain.resume.tc_origin in - let _middleman = - match chain.resume.tc_middleman with - | M_Single s -> extract_string_address s - | M_Multiple ss -> - List.fold_left - (fun acc s -> acc ^ " " ^ extract_string_address s) - "" ss in - let _to = extract_string_address chain.resume.tc_destination in + let _from = symbol_of_eth_address chain.resume.tc_origin in + let _middleman = string_of_addresses chain.resume.tc_middleman in + let _to = symbol_of_eth_address chain.resume.tc_destination in let _ft_amount = - string_of_value chain.resume.tc_first_transfer.ta_amount - chain.resume.tc_first_transfer.ta_asset in + string_of_token_amount chain.resume.tc_first_transfer.tka_amount + chain.resume.tc_first_transfer.tka_asset in let _amount0 = - string_of_value chain.resume.tc_amount0.ta_amount - chain.resume.tc_amount0.ta_asset in + string_of_tokens_amount + @@ List.map (fun (_, x) -> x) chain.resume.tc_amount0 in let _amount1 = - string_of_value chain.resume.tc_amount1.ta_amount - chain.resume.tc_amount1.ta_asset in + string_of_tokens_amount + @@ List.map (fun (_, x) -> x) chain.resume.tc_amount1 in let s_from = Format.sprintf "from:\n%s\n" _from in let s_middleman = Format.sprintf "middleman:\n%s\n" _middleman in let s_to = Format.sprintf "to:\n%s\n" _to in - let s_ft_amount = Format.sprintf "1st transfer: %s\n" _ft_amount in + let s_ft_amount = Format.sprintf "1st transfer: \n%s\n" _ft_amount in let s_amount0 = Format.sprintf "amount0: %s\n" _amount0 in let s_amount1 = Format.sprintf "amount1: %s\n" _amount1 in let s_strategy = @@ -656,7 +639,7 @@ let print_arbitrage_output arbi_out = acc ^ "\n" ^ normalize_token_value x.tka_amount x.tka_asset ^ " " - ^ extract_string_address x.tka_asset) + ^ symbol_of_eth_address x.tka_asset) "" arbi_out.cftao_final_balance in Format.printf "result = %s\nreason = %s\nfinal_balance = \n%s\n" s_arbitrage s_reason s_final_balance @@ -716,11 +699,11 @@ let draw tx out_dir = \ttransfer_bb = %s %s\n\ \tburn_eth = %s %s\n\ \tcost_gas_used = %s %s@." address_str transfer_bb_str - (extract_string_address eth_address_eth_null) + (symbol_of_eth_address eth_address_eth_null) burn_eth_str - (extract_string_address eth_address_eth_null) + (symbol_of_eth_address eth_address_eth_null) cost_gas_str - (extract_string_address eth_address_eth_null) ; + (symbol_of_eth_address eth_address_eth_null) ; let res_arbi = detect_arbitrage annotate_reduced cft_input in Format.printf "\n\n\n Analysis arbitrage \n\n\n" ; print_arbitrage_output res_arbi ; diff --git a/src/common/types.ml b/src/common/types.ml index f527dd2225afa7061a6865afc4a0963191bbaf07..5cdfcf438fe17ace82444d0482337f19a99505cc 100644 --- a/src/common/types.ml +++ b/src/common/types.ml @@ -594,23 +594,6 @@ module Ethereum_analysis = struct } [@@deriving encoding { remove_prefix = "ttxn_"; camel }] - type addresses = - | M_Single of eth_address [@key "Single"] [@wrap "value"] - | M_Multiple of eth_address List.t [@key "Multiple"] [@wrap "value"] - [@@deriving encoding { remove_prefix = "M_"; camel; kind = "type" }] - - type transfer_values = - | V_None [@key "Single"] - | V_Single of transfer_value [@key "Single"] [@wrap "value"] - | V_Multiple of transfer_value List.t [@key "Multiple"] [@wrap "value"] - [@@deriving encoding { remove_prefix = "V_"; camel; kind = "type" }] - - type transfer_amount = { - ta_amount : transfer_values; - ta_asset : addresses; - } - [@@deriving encoding { remove_prefix = "ft_"; camel }] - type delta_map = (string * (string * token_amount) List.t) List.t [@@deriving encoding] @@ -623,14 +606,18 @@ module Ethereum_analysis = struct | `cycle ] [@@deriving encoding { camel }] + type addresses = (string * eth_address) List.t [@@deriving encoding] + + type tokens_amount = (string * token_amount) List.t [@@deriving encoding] + type cft_transfer_chain_resume = { tc_origin : eth_address; tc_middleman : addresses; tc_destination : eth_address; - tc_amount0 : transfer_amount; - tc_amount1 : transfer_amount; + tc_amount0 : tokens_amount; + tc_amount1 : tokens_amount; tc_construction : cft_strategy; - tc_first_transfer : transfer_amount; + tc_first_transfer : token_amount; tc_delta : delta_map; } [@@deriving encoding { remove_prefix = "tc_"; camel }] diff --git a/src/ethereum_analysis/eth_graph.ml b/src/ethereum_analysis/eth_graph.ml index e403c7374a9cd901a9a4a8848c8b065e76fe5c51..1702130f6ec1de1eb70fc5bbf9f6e373615ffc75 100644 --- a/src/ethereum_analysis/eth_graph.ml +++ b/src/ethereum_analysis/eth_graph.ml @@ -5,15 +5,20 @@ open Olympus.Types open Eth module SMap = Map.Make (String) +let eth_address_of_known_address_or_address (address : known_address_or_address) + = + Ca_address address + let eth_address_eth_null = Ca_native Common.null_address let eth_address_eth_burn = Ca_native Common.burn_address let weth_address = Eth.a "c02aaa39b223fe8d0a0e5c4f27ead9083c756cc2" -let eth_address_weth = Ca_address (Coadr_address weth_address) +let eth_address_weth = + eth_address_of_known_address_or_address (Coadr_address weth_address) -let extract_contract_from_address address = +let contract_of_known_address_or_address address = match address with | Ca_native _ -> None | Ca_address address -> ( @@ -21,25 +26,10 @@ let extract_contract_from_address address = | Coadr_address _ -> None | Coadr_known_address address -> address.ai_is_contract) -let accumulate_values v1 v2 = - match (v1, v2) with - | V_Single v1, V_Single v2 -> V_Multiple (v1 :: [v2]) - | V_Multiple l1, V_Single v2 -> V_Multiple (l1 @ [v2]) - | V_Multiple l1, V_Multiple l2 -> V_Multiple (l1 @ l2) - | V_Single v1, V_Multiple l2 -> V_Multiple (v1 :: l2) - | v, V_None | V_None, v -> v - -let accumulate_addresses a1 a2 = - match (a1, a2) with - | M_Single a1, M_Single a2 -> M_Multiple (a1 :: [a2]) - | M_Multiple l1, M_Single a2 -> M_Multiple (l1 @ [a2]) - | M_Multiple l1, M_Multiple l2 -> M_Multiple (l1 @ l2) - | M_Single v1, M_Multiple l2 -> M_Multiple (v1 :: l2) - -let value_to_contract_value wad exp = +let amount_of_contract wad exp = Z.to_float wad *. Float.pow 10. (-1. *. Z.to_float exp) -let extract_decimal_from_address address = +let decimal_of_eth_address address = match address with | Ca_native _ -> Z.of_int 18 | Ca_address address -> ( @@ -57,10 +47,10 @@ let normalize_token_value v asset = match v with | Tv_value wad -> Format.sprintf "%.20f" - (value_to_contract_value wad (extract_decimal_from_address asset)) + (amount_of_contract wad (decimal_of_eth_address asset)) | Tv_complex (V_erc1155 v') -> Common.string_of_erc1155 v' -let event_is_a_transfer description = +let transfer_type_of_event_description description = if String.starts_with ~prefix:"transfer(" @@ String.lowercase_ascii description then @@ -98,7 +88,7 @@ let is_null_address addr = (Common.null_address :> string) = (address :> string) || (Common.burn_address :> string) = (address :> string) -let is_erc_contract contract typ_q = +let is_compatible_contract_type contract typ_q = match contract with | Ca_native _ -> false | Ca_address address -> ( @@ -112,7 +102,7 @@ let is_erc_contract contract typ_q = | None -> false | Some typ -> typ = typ_q))) -let extract_erc contract = +let contract_type_of_eth_address contract = match contract with | Ca_native _ -> None | Ca_address address -> ( @@ -123,7 +113,8 @@ let extract_erc contract = | None -> None | Some contract -> contract.ci_type)) -let extract_transfer_from_inputs inputs contract transfer_type erc = +let normalize_transfer_from_param_decode_abi_list inputs contract transfer_type + erc = try let inputs = List.sort (fun arg1 arg2 -> compare arg1.pda_index arg2.pda_index) inputs @@ -177,7 +168,7 @@ let extract_transfer_from_inputs inputs contract transfer_type erc = let erc = match erc with | Some _ -> erc - | None -> extract_erc contract in + | None -> contract_type_of_eth_address contract in match is_null_address dst with | true -> `inputs (src, contract, operator, amount, contract, `burn_transfer, erc) @@ -196,7 +187,9 @@ let extract_transfer_from_inputs inputs contract transfer_type erc = | `transfer -> ( match erc with | None -> ( - match is_erc_contract contract (ErcStandard ERC721) with + match + is_compatible_contract_type contract (ErcStandard ERC721) + with | true -> `transfer_nft | false -> `transfer) | Some erc -> ( @@ -210,26 +203,27 @@ let extract_transfer_from_inputs inputs contract transfer_type erc = erc )) with _ -> `none -let wrap_address (address : known_address_or_address) = Ca_address address - -let extract_address address = +let address_of_known_address_or_address address = match address with | Coadr_known_address known_address -> known_address.ai_address | Coadr_address address -> address -let extract_transfer_from_decode decode +let normalize_transfer_from_event_decode_info decode (kind : bottom Common.Types.Ethereum_analysis.transfer) = match decode.evdi_decode with | Event_unknown_contract_abi _ -> `none | Event_known_contract_abi evt -> if (kind = `withdrawal || kind = `deposit) - && equal_address (extract_address decode.evdi_contract) weth_address + && equal_address + (address_of_known_address_or_address decode.evdi_contract) + weth_address || kind = `transfer || kind = `transfer_single || kind = `transfer_batch then let res = - extract_transfer_from_inputs evt.evdka_inputs.evdai_inputs - (wrap_address decode.evdi_contract) + normalize_transfer_from_param_decode_abi_list + evt.evdka_inputs.evdai_inputs + (eth_address_of_known_address_or_address decode.evdi_contract) kind (match evt.evdka_contract_type with | Unknown_contract_type -> None @@ -240,28 +234,31 @@ let extract_transfer_from_decode decode | Event_like_contract_abi evt -> if (kind = `withdrawal || kind = `deposit) - && equal_address (extract_address decode.evdi_contract) weth_address + && equal_address + (address_of_known_address_or_address decode.evdi_contract) + weth_address || kind = `transfer || kind = `transfer_single || kind = `transfer_batch then let res = - extract_transfer_from_inputs evt.evdla_inputs.evdai_inputs - (wrap_address decode.evdi_contract) + normalize_transfer_from_param_decode_abi_list + evt.evdla_inputs.evdai_inputs + (eth_address_of_known_address_or_address decode.evdi_contract) kind (Some evt.evdla_contract_type) in res else `none -let extract_transfer_from_evt evt_node = +let cft_transfer_from_of_cft_event_node evt_node = match evt_node.tevtn_decode with | None -> Cft_leaf { node = Cftn_event evt_node } | Some decode -> ( match decode.evdi_description with | None -> Cft_leaf { node = Cftn_event evt_node } | Some description -> ( - match event_is_a_transfer description with + match transfer_type_of_event_description description with | (`transfer | `withdrawal | `deposit | `transfer_single | `transfer_batch) as kind -> ( - match extract_transfer_from_decode decode kind with + match normalize_transfer_from_event_decode_info decode kind with | `none -> ( match String.starts_with ~prefix:"withdrawal(" @@ -303,7 +300,7 @@ let extract_transfer_from_evt evt_node = }) | `none -> Cft_leaf { node = Cftn_event evt_node })) -let build_events evt = +let cft_event_node_of_debug_trace_result_log evt = let evt = { tevtn_index = evt.dtrl_index; @@ -312,37 +309,36 @@ let build_events evt = } in evt -let build_native_transfer node = +let native_cft_transfer_in_cft_transaction_node node = match node.ttxn_amount with - | None -> [] + | None -> None | Some v -> ( match Z.zero = v with - | true -> [] + | true -> None | false -> - [ - Cft_leaf - { - node = - Cftn_transfer_chain - (Cftt_transfer - { - ttn_from = - Option.value ~default:eth_address_eth_null - @@ Option.map (fun x -> Ca_address x) node.ttxn_from; - ttn_to = - Option.value ~default:eth_address_eth_null - @@ Option.map (fun x -> Ca_address x) node.ttxn_to; - ttn_sender = None; - ttn_origin = None; - ttn_contract_type = None; - ttn_amount = Tv_value v; - ttn_asset = eth_address_eth_null; - ttn_description = Some "NativeTransfer()"; - }); - }; - ]) - -let build_transaction_node debug_trace_result kind = + Some + (Cft_leaf + { + node = + Cftn_transfer_chain + (Cftt_transfer + { + ttn_from = + Option.value ~default:eth_address_eth_null + @@ Option.map (fun x -> Ca_address x) node.ttxn_from; + ttn_to = + Option.value ~default:eth_address_eth_null + @@ Option.map (fun x -> Ca_address x) node.ttxn_to; + ttn_sender = None; + ttn_origin = None; + ttn_contract_type = None; + ttn_amount = Tv_value v; + ttn_asset = eth_address_eth_null; + ttn_description = Some "NativeTransfer()"; + }); + })) + +let cft_transaction_node_of_debug_trace_result debug_trace_result kind = { ttxn_kind = kind; ttxn_typ = debug_trace_result.dtr_typ; @@ -352,16 +348,22 @@ let build_transaction_node debug_trace_result kind = ttxn_operation = debug_trace_result.dtr_decode_operation; } -let rec build_tx_tree debug_trace kind : cft = - let node = build_transaction_node debug_trace kind in - let native_transfer = build_native_transfer node in +let rec cft_of_debug_trace_result debug_trace kind : cft = + let node = cft_transaction_node_of_debug_trace_result debug_trace kind in + let native_transfer = + Option.to_list @@ native_cft_transfer_in_cft_transaction_node node in let internal_calls = List.fold_left - (fun acc x -> acc @ [build_tx_tree x Internal]) + (fun acc x -> acc @ [cft_of_debug_trace_result x Internal]) [] debug_trace.dtr_calls in let internal_events = List.fold_left - (fun acc x -> acc @ [extract_transfer_from_evt @@ build_events x]) + (fun acc x -> + acc + @ [ + cft_transfer_from_of_cft_event_node + @@ cft_event_node_of_debug_trace_result_log x; + ]) [] debug_trace.dtr_logs in match List.length internal_calls @@ -376,12 +378,12 @@ let rec build_tx_tree debug_trace kind : cft = children = native_transfer @ internal_calls @ internal_events; } -let is_external_transaction tx = +let is_external_cft_transaction_node tx = match tx.ttxn_kind with | Internal -> false | _ -> true -let rec annotate_operator origin operator cft = +let rec add_operator_info_in_cft origin operator cft = match cft with | Cft_leaf leaf -> ( match leaf.node with @@ -408,8 +410,8 @@ let rec annotate_operator origin operator cft = children = List.map (fun child -> - annotate_operator - (match is_external_transaction tx with + add_operator_info_in_cft + (match is_external_cft_transaction_node tx with | true -> Option.map (fun x -> Ca_address x) tx.ttxn_from | false -> origin) operator child) @@ -422,8 +424,8 @@ let rec annotate_operator origin operator cft = children = List.map (fun child -> - annotate_operator - (match is_external_transaction tx with + add_operator_info_in_cft + (match is_external_cft_transaction_node tx with | true -> Option.map (fun x -> Ca_address x) tx.ttxn_from | false -> origin) (Option.map (fun add -> Ca_address add) tx.ttxn_from) @@ -432,18 +434,19 @@ let rec annotate_operator origin operator cft = }) | _ -> cft) -let entry_point debug_trace = +let cft_of_debug_trace debug_trace = let r = - build_tx_tree debug_trace.dt_result (External debug_trace.dt_tx_hash) in - annotate_operator None None r + cft_of_debug_trace_result debug_trace.dt_result + (External debug_trace.dt_tx_hash) in + add_operator_info_in_cft None None r -let is_child_leaf child = +let cft_is_leaf child = match child with | Cft_leaf _ -> true | Cft_tree _ -> false -let extract_string_address a = - match extract_contract_from_address a with +let symbol_of_eth_address a = + match contract_of_known_address_or_address a with | None -> ( match a with | Ca_native _ -> "ETH" @@ -454,8 +457,8 @@ let extract_string_address a = | None -> (contract.ci_address :> string) | Some s -> (s :> string)) -let extract_string_real_address a = - match extract_contract_from_address a with +let string_address_of_eth_address a = + match contract_of_known_address_or_address a with | None -> ( match a with | Ca_native _ -> "ETH" @@ -466,7 +469,7 @@ let extract_string_real_address a = | None -> (contract.ci_address :> string) | Some _ -> (contract.ci_address :> string)) -let extract_address_from_contract_address ca = +let address_of_eth_address ca = match ca with | Ca_address address -> ( match address with @@ -474,40 +477,113 @@ let extract_address_from_contract_address ca = | Coadr_address address -> address) | Ca_native address -> address -let extract_address_from_addresses a = - match a with - | M_Single ca -> [extract_address_from_contract_address ca] - | M_Multiple cas -> - List.sort - (fun (x : Eth.address) y -> String.compare (x :> string) (y :> string)) - (List.map extract_address_from_contract_address cas) +let address_compare (a : Eth.address) (b : Eth.address) = + String.compare (a :> string) (b :> string) + +let address_list_of_addresses (a : addresses) = + List.sort address_compare + @@ List.map (fun (_, a) -> address_of_eth_address a) a + +let address_of_token_amount (tka : token_amount) = + address_of_eth_address tka.tka_asset -let is_liquidation_pool add = - match extract_contract_from_address add with +let address_list_of_token_amount_list (tal : (string * token_amount) List.t) = + List.sort address_compare + (address_list_of_addresses + @@ List.map (fun (a, tka) -> (a, tka.tka_asset)) tal) + +let cft_transfer_node_of_token_amount t = + { tka_amount = t.ttn_amount; tka_asset = t.ttn_asset } + +let tokens_amount_of_transfer t = + [(symbol_of_eth_address t.ttn_asset, cft_transfer_node_of_token_amount t)] + +let addresses_of_eth_address address addresses = + match List.assoc_opt (symbol_of_eth_address address) addresses with | None -> - extract_address_from_contract_address add + List.sort (fun (a, _) (b, _) -> address_compare (Eth.a a) (Eth.a b)) + @@ ((symbol_of_eth_address address, address) :: addresses) + | Some _ -> addresses + +let add_token_amount tk1 tk2 = + match (tk1.tka_amount, tk2.tka_amount) with + | Tv_value z1, Tv_value z2 -> { tk1 with tka_amount = Tv_value (Z.add z1 z2) } + | _ -> + Common.Log.log_error_fail ~here:[%here] + "Cannot add different types of tokens" + +let is_eth_address_a_liquidation_pool add = + match contract_of_known_address_or_address add with + | None -> + address_of_eth_address add = Eth.a @@ String.lowercase_ascii "000000000004444c5dc75cB358380D2e3dE08A90" + || address_of_eth_address add + = Eth.a + @@ String.lowercase_ascii "0x332A24318d56f9Cca677a242aFF668314492bF80" | Some contract -> ( match contract.ci_pool_contracts with | None -> false | Some _ -> true) -let rec is_compatible to_ tree1 tree2 = +let rec cft_trees_compatible_for_merge to_ tree1 tree2 = let to_' = - Option.map extract_address_from_contract_address - @@ Option.map wrap_address to_ in + Option.map address_of_eth_address + @@ Option.map eth_address_of_known_address_or_address to_ in match (tree1, tree2) with | Cft_leaf l1, Cft_leaf l2 -> ( match (l1.node, l2.node) with | ( Cftn_transfer_chain (Cftt_transfer t1), Cftn_transfer_chain (Cftt_transfer t2) ) -> ( match - ( Some (extract_address_from_contract_address t1.ttn_from) = to_', - Some (extract_address_from_contract_address t2.ttn_from) = to_' ) + ( Some (address_of_eth_address t1.ttn_from) = to_', + Some (address_of_eth_address t2.ttn_from) = to_' ) with | true, true -> None | true, false -> if + (String.starts_with ~prefix:"burn" + @@ String.lowercase_ascii + (match t1.ttn_description with + | None -> "" + | Some s -> s) + || String.starts_with ~prefix:"mint" + @@ String.lowercase_ascii + (match t1.ttn_description with + | None -> "" + | Some s -> s) + || String.starts_with ~prefix:"deposit" + @@ String.lowercase_ascii + (match t1.ttn_description with + | None -> "" + | Some s -> s) + || String.starts_with ~prefix:"withdrawal" + @@ String.lowercase_ascii + (match t1.ttn_description with + | None -> "" + | Some s -> s)) + && (String.starts_with ~prefix:"burn" + @@ String.lowercase_ascii + (match t2.ttn_description with + | None -> "" + | Some s -> s) + || String.starts_with ~prefix:"mint" + @@ String.lowercase_ascii + (match t2.ttn_description with + | None -> "" + | Some s -> s) + || String.starts_with ~prefix:"deposit" + @@ String.lowercase_ascii + (match t2.ttn_description with + | None -> "" + | Some s -> s) + || String.starts_with ~prefix:"withdrawal" + @@ String.lowercase_ascii + (match t2.ttn_description with + | None -> "" + | Some s -> s)) + then + None + else if String.starts_with ~prefix:"burn" @@ String.lowercase_ascii (match t1.ttn_description with @@ -520,8 +596,8 @@ let rec is_compatible to_ tree1 tree2 = | Some s -> s) then if - extract_address_from_contract_address t1.ttn_to - = extract_address_from_contract_address t2.ttn_from + address_of_eth_address t1.ttn_to + = address_of_eth_address t2.ttn_from then Some (Cftt_transfer t1, Cftt_transfer t2, `liquidationBurn) else @@ -539,8 +615,8 @@ let rec is_compatible to_ tree1 tree2 = | Some s -> s) then if - extract_address_from_contract_address t2.ttn_to - = extract_address_from_contract_address t1.ttn_from + address_of_eth_address t2.ttn_to + = address_of_eth_address t1.ttn_from then Some (Cftt_transfer t2, Cftt_transfer t1, `liquidationBurn) else @@ -558,8 +634,8 @@ let rec is_compatible to_ tree1 tree2 = | Some s -> s) then if - extract_address_from_contract_address t2.ttn_to - = extract_address_from_contract_address t1.ttn_from + address_of_eth_address t2.ttn_to + = address_of_eth_address t1.ttn_from then Some (Cftt_transfer t2, Cftt_transfer t1, `liquidationMint) else @@ -577,8 +653,8 @@ let rec is_compatible to_ tree1 tree2 = | Some s -> s) then if - extract_address_from_contract_address t1.ttn_to - = extract_address_from_contract_address t2.ttn_from + address_of_eth_address t1.ttn_to + = address_of_eth_address t2.ttn_from then Some (Cftt_transfer t1, Cftt_transfer t2, `liquidationMint) else @@ -596,8 +672,8 @@ let rec is_compatible to_ tree1 tree2 = | Some s -> s) then if - extract_address_from_contract_address t1.ttn_to - = extract_address_from_contract_address t2.ttn_from + address_of_eth_address t1.ttn_to + = address_of_eth_address t2.ttn_from then Some (Cftt_transfer t1, Cftt_transfer t2, `liquidationBurn) else @@ -615,8 +691,8 @@ let rec is_compatible to_ tree1 tree2 = | Some s -> s) then if - extract_address_from_contract_address t2.ttn_to - = extract_address_from_contract_address t1.ttn_from + address_of_eth_address t2.ttn_to + = address_of_eth_address t1.ttn_from then Some (Cftt_transfer t2, Cftt_transfer t1, `liquidationBurn) else @@ -634,8 +710,8 @@ let rec is_compatible to_ tree1 tree2 = | Some s -> s) then if - extract_address_from_contract_address t2.ttn_to - = extract_address_from_contract_address t1.ttn_from + address_of_eth_address t2.ttn_to + = address_of_eth_address t1.ttn_from then Some (Cftt_transfer t2, Cftt_transfer t1, `liquidationMint) else @@ -653,24 +729,66 @@ let rec is_compatible to_ tree1 tree2 = | Some s -> s) then if - extract_address_from_contract_address t1.ttn_to - = extract_address_from_contract_address t2.ttn_from + address_of_eth_address t1.ttn_to + = address_of_eth_address t2.ttn_from then Some (Cftt_transfer t1, Cftt_transfer t2, `liquidationMint) else None else if - extract_address_from_contract_address t1.ttn_to - = extract_address_from_contract_address t2.ttn_from + address_of_eth_address t1.ttn_to = address_of_eth_address t2.ttn_from && not - (extract_address_from_contract_address t1.ttn_asset - = extract_address_from_contract_address t2.ttn_asset) + (address_of_eth_address t1.ttn_asset + = address_of_eth_address t2.ttn_asset) then Some (Cftt_transfer t1, Cftt_transfer t2, `chain) else None | false, true -> if + (String.starts_with ~prefix:"burn" + @@ String.lowercase_ascii + (match t1.ttn_description with + | None -> "" + | Some s -> s) + || String.starts_with ~prefix:"mint" + @@ String.lowercase_ascii + (match t1.ttn_description with + | None -> "" + | Some s -> s) + || String.starts_with ~prefix:"deposit" + @@ String.lowercase_ascii + (match t1.ttn_description with + | None -> "" + | Some s -> s) + || String.starts_with ~prefix:"withdrawal" + @@ String.lowercase_ascii + (match t1.ttn_description with + | None -> "" + | Some s -> s)) + && (String.starts_with ~prefix:"burn" + @@ String.lowercase_ascii + (match t2.ttn_description with + | None -> "" + | Some s -> s) + || String.starts_with ~prefix:"mint" + @@ String.lowercase_ascii + (match t2.ttn_description with + | None -> "" + | Some s -> s) + || String.starts_with ~prefix:"deposit" + @@ String.lowercase_ascii + (match t2.ttn_description with + | None -> "" + | Some s -> s) + || String.starts_with ~prefix:"withdrawal" + @@ String.lowercase_ascii + (match t2.ttn_description with + | None -> "" + | Some s -> s)) + then + None + else if String.starts_with ~prefix:"burn" @@ String.lowercase_ascii (match t1.ttn_description with @@ -683,8 +801,8 @@ let rec is_compatible to_ tree1 tree2 = | Some s -> s) then if - extract_address_from_contract_address t1.ttn_to - = extract_address_from_contract_address t2.ttn_from + address_of_eth_address t1.ttn_to + = address_of_eth_address t2.ttn_from then Some (Cftt_transfer t1, Cftt_transfer t2, `liquidationBurn) else @@ -702,8 +820,8 @@ let rec is_compatible to_ tree1 tree2 = | Some s -> s) then if - extract_address_from_contract_address t2.ttn_to - = extract_address_from_contract_address t1.ttn_from + address_of_eth_address t2.ttn_to + = address_of_eth_address t1.ttn_from then Some (Cftt_transfer t2, Cftt_transfer t1, `liquidationBurn) else @@ -721,8 +839,8 @@ let rec is_compatible to_ tree1 tree2 = | Some s -> s) then if - extract_address_from_contract_address t2.ttn_to - = extract_address_from_contract_address t1.ttn_from + address_of_eth_address t2.ttn_to + = address_of_eth_address t1.ttn_from then Some (Cftt_transfer t2, Cftt_transfer t1, `liquidationMint) else @@ -740,8 +858,8 @@ let rec is_compatible to_ tree1 tree2 = | Some s -> s) then if - extract_address_from_contract_address t1.ttn_to - = extract_address_from_contract_address t2.ttn_from + address_of_eth_address t1.ttn_to + = address_of_eth_address t2.ttn_from then Some (Cftt_transfer t1, Cftt_transfer t2, `liquidationMint) else @@ -759,8 +877,8 @@ let rec is_compatible to_ tree1 tree2 = | Some s -> s) then if - extract_address_from_contract_address t1.ttn_to - = extract_address_from_contract_address t2.ttn_from + address_of_eth_address t1.ttn_to + = address_of_eth_address t2.ttn_from then Some (Cftt_transfer t1, Cftt_transfer t2, `liquidationBurn) else @@ -778,8 +896,8 @@ let rec is_compatible to_ tree1 tree2 = | Some s -> s) then if - extract_address_from_contract_address t2.ttn_to - = extract_address_from_contract_address t1.ttn_from + address_of_eth_address t2.ttn_to + = address_of_eth_address t1.ttn_from then Some (Cftt_transfer t2, Cftt_transfer t1, `liquidationBurn) else @@ -797,24 +915,66 @@ let rec is_compatible to_ tree1 tree2 = | Some s -> s) then if - extract_address_from_contract_address t2.ttn_to - = extract_address_from_contract_address t1.ttn_from + address_of_eth_address t2.ttn_to + = address_of_eth_address t1.ttn_from then Some (Cftt_transfer t2, Cftt_transfer t1, `liquidationMint) else None else if - extract_address_from_contract_address t2.ttn_to - = extract_address_from_contract_address t1.ttn_from + address_of_eth_address t2.ttn_to = address_of_eth_address t1.ttn_from && not - (extract_address_from_contract_address t2.ttn_asset - = extract_address_from_contract_address t1.ttn_asset) + (address_of_eth_address t2.ttn_asset + = address_of_eth_address t1.ttn_asset) then Some (Cftt_transfer t2, Cftt_transfer t1, `chain) else None | false, false -> if + (String.starts_with ~prefix:"burn" + @@ String.lowercase_ascii + (match t1.ttn_description with + | None -> "" + | Some s -> s) + || String.starts_with ~prefix:"mint" + @@ String.lowercase_ascii + (match t1.ttn_description with + | None -> "" + | Some s -> s) + || String.starts_with ~prefix:"deposit" + @@ String.lowercase_ascii + (match t1.ttn_description with + | None -> "" + | Some s -> s) + || String.starts_with ~prefix:"withdrawal" + @@ String.lowercase_ascii + (match t1.ttn_description with + | None -> "" + | Some s -> s)) + && (String.starts_with ~prefix:"burn" + @@ String.lowercase_ascii + (match t2.ttn_description with + | None -> "" + | Some s -> s) + || String.starts_with ~prefix:"mint" + @@ String.lowercase_ascii + (match t2.ttn_description with + | None -> "" + | Some s -> s) + || String.starts_with ~prefix:"deposit" + @@ String.lowercase_ascii + (match t2.ttn_description with + | None -> "" + | Some s -> s) + || String.starts_with ~prefix:"withdrawal" + @@ String.lowercase_ascii + (match t2.ttn_description with + | None -> "" + | Some s -> s)) + then + None + else if String.starts_with ~prefix:"burn" @@ String.lowercase_ascii (match t1.ttn_description with @@ -827,8 +987,8 @@ let rec is_compatible to_ tree1 tree2 = | Some s -> s) then if - extract_address_from_contract_address t1.ttn_to - = extract_address_from_contract_address t2.ttn_from + address_of_eth_address t1.ttn_to + = address_of_eth_address t2.ttn_from then Some (Cftt_transfer t1, Cftt_transfer t2, `liquidationBurn) else @@ -846,10 +1006,15 @@ let rec is_compatible to_ tree1 tree2 = | Some s -> s) then if - extract_address_from_contract_address t2.ttn_to - = extract_address_from_contract_address t1.ttn_from + address_of_eth_address t2.ttn_to + = address_of_eth_address t1.ttn_from then Some (Cftt_transfer t2, Cftt_transfer t1, `liquidationBurn) + else if + address_of_eth_address t1.ttn_to + = address_of_eth_address t2.ttn_from + then + Some (Cftt_transfer t1, Cftt_transfer t2, `liquidationBurn) else None else if @@ -865,10 +1030,13 @@ let rec is_compatible to_ tree1 tree2 = | Some s -> s) then if - extract_address_from_contract_address t2.ttn_to - = extract_address_from_contract_address t1.ttn_from + address_of_eth_address t2.ttn_to + = address_of_eth_address t1.ttn_from then Some (Cftt_transfer t2, Cftt_transfer t1, `liquidationMint) + (* else if address_of_eth_address t1.ttn_to = address_of_eth_address + t2.ttn_from then Some (Cftt_transfer t1, Cftt_transfer t2, + `liquidationMint) *) else None else if @@ -884,10 +1052,13 @@ let rec is_compatible to_ tree1 tree2 = | Some s -> s) then if - extract_address_from_contract_address t1.ttn_to - = extract_address_from_contract_address t2.ttn_from + address_of_eth_address t1.ttn_to + = address_of_eth_address t2.ttn_from then Some (Cftt_transfer t1, Cftt_transfer t2, `liquidationMint) + (* else if address_of_eth_address t2.ttn_to = address_of_eth_address + t1.ttn_from then Some (Cftt_transfer t2, Cftt_transfer t1, + `liquidationMint) *) else None else if @@ -903,8 +1074,8 @@ let rec is_compatible to_ tree1 tree2 = | Some s -> s) then if - extract_address_from_contract_address t1.ttn_to - = extract_address_from_contract_address t2.ttn_from + address_of_eth_address t1.ttn_to + = address_of_eth_address t2.ttn_from then Some (Cftt_transfer t1, Cftt_transfer t2, `liquidationBurn) else @@ -922,8 +1093,8 @@ let rec is_compatible to_ tree1 tree2 = | Some s -> s) then if - extract_address_from_contract_address t2.ttn_to - = extract_address_from_contract_address t1.ttn_from + address_of_eth_address t2.ttn_to + = address_of_eth_address t1.ttn_from then Some (Cftt_transfer t2, Cftt_transfer t1, `liquidationBurn) else @@ -941,8 +1112,8 @@ let rec is_compatible to_ tree1 tree2 = | Some s -> s) then if - extract_address_from_contract_address t1.ttn_to - = extract_address_from_contract_address t2.ttn_from + address_of_eth_address t1.ttn_to + = address_of_eth_address t2.ttn_from then Some (Cftt_transfer t1, Cftt_transfer t2, `liquidationMint) else @@ -960,41 +1131,37 @@ let rec is_compatible to_ tree1 tree2 = | Some s -> s) then if - extract_address_from_contract_address t2.ttn_to - = extract_address_from_contract_address t1.ttn_from + address_of_eth_address t2.ttn_to + = address_of_eth_address t1.ttn_from then Some (Cftt_transfer t2, Cftt_transfer t1, `liquidationMint) else None else if - extract_address_from_contract_address t1.ttn_to - = extract_address_from_contract_address t2.ttn_from - && extract_address_from_contract_address t2.ttn_to - = extract_address_from_contract_address t1.ttn_from - && is_liquidation_pool t1.ttn_to + address_of_eth_address t1.ttn_to = address_of_eth_address t2.ttn_from + && address_of_eth_address t2.ttn_to + = address_of_eth_address t1.ttn_from + && is_eth_address_a_liquidation_pool t1.ttn_to then Some (Cftt_transfer t1, Cftt_transfer t2, `chain) else if - extract_address_from_contract_address t2.ttn_to - = extract_address_from_contract_address t1.ttn_from - && extract_address_from_contract_address t1.ttn_to - = extract_address_from_contract_address t2.ttn_from - && is_liquidation_pool t2.ttn_to + address_of_eth_address t2.ttn_to = address_of_eth_address t1.ttn_from + && address_of_eth_address t1.ttn_to + = address_of_eth_address t2.ttn_from + && is_eth_address_a_liquidation_pool t2.ttn_to then Some (Cftt_transfer t2, Cftt_transfer t1, `chain) else if - extract_address_from_contract_address t1.ttn_to - = extract_address_from_contract_address t2.ttn_from + address_of_eth_address t1.ttn_to = address_of_eth_address t2.ttn_from && not - (extract_address_from_contract_address t1.ttn_asset - = extract_address_from_contract_address t2.ttn_asset) + (address_of_eth_address t1.ttn_asset + = address_of_eth_address t2.ttn_asset) then Some (Cftt_transfer t1, Cftt_transfer t2, `chain) else if - extract_address_from_contract_address t2.ttn_to - = extract_address_from_contract_address t1.ttn_from - && extract_address_from_contract_address t2.ttn_asset - != extract_address_from_contract_address t1.ttn_asset + address_of_eth_address t2.ttn_to = address_of_eth_address t1.ttn_from + && address_of_eth_address t2.ttn_asset + != address_of_eth_address t1.ttn_asset then Some (Cftt_transfer t2, Cftt_transfer t1, `chain) else @@ -1002,134 +1169,139 @@ let rec is_compatible to_ tree1 tree2 = | ( Cftn_transfer_chain (Cftt_chain c1), Cftn_transfer_chain (Cftt_transfer t2) ) -> ( match - ( Some (extract_address_from_contract_address c1.resume.tc_origin) = to_', - Some (extract_address_from_contract_address t2.ttn_from) = to_' ) + ( Some (address_of_eth_address c1.resume.tc_origin) = to_', + Some (address_of_eth_address t2.ttn_from) = to_' ) with | true, true -> None | true, false -> if - extract_address_from_contract_address c1.resume.tc_destination - = extract_address_from_contract_address t2.ttn_from + address_of_eth_address c1.resume.tc_destination + = address_of_eth_address t2.ttn_from + (* && address_list_of_token_amount_list c1.resume.tc_amount1 = + address_list_of_token_amount_list @@ tokens_amount_of_transfer + t2 *) then Some (Cftt_chain c1, Cftt_transfer t2, `chain) else None | false, true -> if - extract_address_from_contract_address t2.ttn_to - = extract_address_from_contract_address c1.resume.tc_origin + address_of_eth_address t2.ttn_to + = address_of_eth_address c1.resume.tc_origin + (* && [address_of_token_amount c1.resume.tc_first_transfer] = + address_list_of_token_amount_list @@ tokens_amount_of_transfer + t2 *) then Some (Cftt_transfer t2, Cftt_chain c1, `chain) else None | false, false -> if - extract_address_from_contract_address c1.resume.tc_destination - = extract_address_from_contract_address t2.ttn_from + address_of_eth_address c1.resume.tc_destination + = address_of_eth_address t2.ttn_from + && address_list_of_token_amount_list c1.resume.tc_amount1 + = address_list_of_token_amount_list @@ tokens_amount_of_transfer t2 then Some (Cftt_chain c1, Cftt_transfer t2, `chain) else if - extract_address_from_contract_address t2.ttn_to - = extract_address_from_contract_address c1.resume.tc_origin + address_of_eth_address t2.ttn_to + = address_of_eth_address c1.resume.tc_origin + && [address_of_token_amount c1.resume.tc_first_transfer] + = address_list_of_token_amount_list @@ tokens_amount_of_transfer t2 + (* && not @@ is_eth_address_a_liquidation_pool t2.ttn_from *) then Some (Cftt_transfer t2, Cftt_chain c1, `chain) else None) | Cftn_transfer_chain (Cftt_transfer _), Cftn_transfer_chain (Cftt_chain _) - -> is_compatible to_ tree2 tree1 + -> cft_trees_compatible_for_merge to_ tree2 tree1 | Cftn_transfer_chain (Cftt_chain c1), Cftn_transfer_chain (Cftt_chain c2) -> ( match - ( Some (extract_address_from_contract_address c1.resume.tc_origin) = to_', - Some (extract_address_from_contract_address c2.resume.tc_origin) - = to_' ) + ( Some (address_of_eth_address c1.resume.tc_origin) = to_', + Some (address_of_eth_address c2.resume.tc_origin) = to_' ) with | true, true -> if - extract_address_from_contract_address c1.resume.tc_origin - = extract_address_from_contract_address c2.resume.tc_origin - && extract_address_from_contract_address c1.resume.tc_destination - = extract_address_from_contract_address c2.resume.tc_destination + address_of_eth_address c1.resume.tc_origin + = address_of_eth_address c2.resume.tc_origin + && address_of_eth_address c1.resume.tc_destination + = address_of_eth_address c2.resume.tc_destination && (not - (extract_address_from_contract_address c1.resume.tc_origin - = extract_address_from_contract_address c1.resume.tc_destination - )) - && extract_address_from_addresses c1.resume.tc_amount1.ta_asset - = extract_address_from_addresses c2.resume.tc_amount1.ta_asset + (address_of_eth_address c1.resume.tc_origin + = address_of_eth_address c1.resume.tc_destination)) + && address_list_of_token_amount_list c1.resume.tc_amount1 + = address_list_of_token_amount_list c2.resume.tc_amount1 && not - (extract_address_from_addresses c1.resume.tc_amount0.ta_asset - = extract_address_from_addresses c2.resume.tc_amount0.ta_asset) + (address_list_of_token_amount_list c1.resume.tc_amount0 + = address_list_of_token_amount_list c2.resume.tc_amount0) then Some (Cftt_chain c1, Cftt_chain c2, `merge) else None | true, false -> if - extract_address_from_contract_address c1.resume.tc_destination - = extract_address_from_contract_address c2.resume.tc_origin - && extract_address_from_addresses c1.resume.tc_amount1.ta_asset - = extract_address_from_addresses - c2.resume.tc_first_transfer.ta_asset + address_of_eth_address c1.resume.tc_destination + = address_of_eth_address c2.resume.tc_origin + && not + (address_list_of_token_amount_list c1.resume.tc_amount1 + = [address_of_token_amount c2.resume.tc_first_transfer]) then Some (Cftt_chain c1, Cftt_chain c2, `chain) else None | false, true -> if - extract_address_from_contract_address c2.resume.tc_destination - = extract_address_from_contract_address c1.resume.tc_origin + address_of_eth_address c2.resume.tc_destination + = address_of_eth_address c1.resume.tc_origin && not - (extract_address_from_addresses c2.resume.tc_amount1.ta_asset - = extract_address_from_addresses - c1.resume.tc_first_transfer.ta_asset) + (address_list_of_token_amount_list c2.resume.tc_amount1 + = [address_of_token_amount c1.resume.tc_first_transfer]) then Some (Cftt_chain c2, Cftt_chain c1, `chain) else None | false, false -> if - extract_address_from_contract_address c1.resume.tc_destination - = extract_address_from_contract_address c2.resume.tc_origin - && extract_address_from_addresses c1.resume.tc_amount1.ta_asset - = extract_address_from_addresses - c2.resume.tc_first_transfer.ta_asset + address_of_eth_address c1.resume.tc_destination + = address_of_eth_address c2.resume.tc_origin + && address_list_of_token_amount_list c1.resume.tc_amount1 + = [address_of_token_amount c2.resume.tc_first_transfer] then Some (Cftt_chain c1, Cftt_chain c2, `chain) else if - extract_address_from_contract_address c2.resume.tc_destination - = extract_address_from_contract_address c1.resume.tc_origin - && extract_address_from_addresses c2.resume.tc_amount1.ta_asset - = extract_address_from_addresses - c1.resume.tc_first_transfer.ta_asset + address_of_eth_address c2.resume.tc_destination + = address_of_eth_address c1.resume.tc_origin + && address_list_of_token_amount_list c2.resume.tc_amount1 + = [address_of_token_amount c1.resume.tc_first_transfer] then Some (Cftt_chain c2, Cftt_chain c1, `chain) else if - extract_address_from_contract_address c1.resume.tc_origin - = extract_address_from_contract_address c2.resume.tc_origin - && extract_address_from_contract_address c1.resume.tc_destination - = extract_address_from_contract_address c2.resume.tc_destination - && extract_address_from_contract_address c1.resume.tc_origin - = extract_address_from_contract_address c1.resume.tc_destination - && extract_address_from_addresses c1.resume.tc_amount1.ta_asset - = extract_address_from_addresses c2.resume.tc_amount1.ta_asset - && extract_address_from_addresses c1.resume.tc_amount0.ta_asset - = extract_address_from_addresses c2.resume.tc_amount0.ta_asset + address_of_eth_address c1.resume.tc_origin + = address_of_eth_address c2.resume.tc_origin + && address_of_eth_address c1.resume.tc_destination + = address_of_eth_address c2.resume.tc_destination + && address_of_eth_address c1.resume.tc_origin + = address_of_eth_address c1.resume.tc_destination + && address_list_of_token_amount_list c1.resume.tc_amount1 + = address_list_of_token_amount_list c2.resume.tc_amount1 + && address_list_of_token_amount_list c1.resume.tc_amount0 + = address_list_of_token_amount_list c2.resume.tc_amount0 then Some (Cftt_chain c1, Cftt_chain c2, `merge_add) else if - extract_address_from_contract_address c1.resume.tc_origin - = extract_address_from_contract_address c2.resume.tc_origin - && extract_address_from_contract_address c1.resume.tc_destination - = extract_address_from_contract_address c2.resume.tc_destination + address_of_eth_address c1.resume.tc_origin + = address_of_eth_address c2.resume.tc_origin + && address_of_eth_address c1.resume.tc_destination + = address_of_eth_address c2.resume.tc_destination && (not - (extract_address_from_contract_address c1.resume.tc_origin - = extract_address_from_contract_address c1.resume.tc_destination - )) - && extract_address_from_addresses c1.resume.tc_amount1.ta_asset - = extract_address_from_addresses c2.resume.tc_amount1.ta_asset + (address_of_eth_address c1.resume.tc_origin + = address_of_eth_address c1.resume.tc_destination)) + && address_list_of_token_amount_list c1.resume.tc_amount1 + = address_list_of_token_amount_list c2.resume.tc_amount1 && not - (extract_address_from_addresses c1.resume.tc_amount0.ta_asset - = extract_address_from_addresses c2.resume.tc_amount0.ta_asset) + (address_list_of_token_amount_list c1.resume.tc_amount0 + = address_list_of_token_amount_list c2.resume.tc_amount0) then Some (Cftt_chain c1, Cftt_chain c2, `merge) else @@ -1137,25 +1309,6 @@ let rec is_compatible to_ tree1 tree2 = | _ -> None) | _ -> None -let add_value v1 v2 = - match (v1, v2) with - | V_Single (Tv_value v1), V_Single (Tv_value v2) -> - V_Single (Tv_value (Z.add v1 v2)) - | _ -> Common.Log.log_error_fail ~here:[%here] "I don't add multiple values" - -let op_transfer_amount f th1 th2 = - match - extract_address_from_addresses th1.ta_asset - = extract_address_from_addresses th2.ta_asset - with - | true -> - { ta_asset = th1.ta_asset; ta_amount = f th1.ta_amount th2.ta_amount } - | false -> - { - ta_asset = accumulate_addresses th1.ta_asset th2.ta_asset; - ta_amount = accumulate_values th1.ta_amount th2.ta_amount; - } - let transfer_value_neg tv = match tv with | Tv_value z -> Tv_value (Z.mul z Z.minus_one) @@ -1170,37 +1323,37 @@ let add_transfer_value tv1 tv2 = let make_delta_transfer t = [ - ( extract_string_address t.ttn_from, + ( symbol_of_eth_address t.ttn_from, [ - ( extract_string_address t.ttn_asset, + ( symbol_of_eth_address t.ttn_asset, { tka_amount = transfer_value_neg t.ttn_amount; tka_asset = t.ttn_asset; } ); ] ); - ( extract_string_address t.ttn_to, + ( symbol_of_eth_address t.ttn_to, [ - ( extract_string_address t.ttn_asset, + ( symbol_of_eth_address t.ttn_asset, { tka_amount = t.ttn_amount; tka_asset = t.ttn_asset } ); ] ); ] let update_delta_transfer_from t delta = let delta' = - match List.assoc_opt (extract_string_address t.ttn_from) delta with + match List.assoc_opt (symbol_of_eth_address t.ttn_from) delta with | None -> [] | Some delta_t -> delta_t in let token_amount_t_from = - List.assoc_opt (extract_string_address t.ttn_asset) delta' in + List.assoc_opt (symbol_of_eth_address t.ttn_asset) delta' in let delta_t = match token_amount_t_from with | None -> - List.remove_assoc (extract_string_address t.ttn_from) delta + List.remove_assoc (symbol_of_eth_address t.ttn_from) delta @ [ - ( extract_string_address t.ttn_from, + ( symbol_of_eth_address t.ttn_from, delta' @ [ - ( extract_string_address t.ttn_asset, + ( symbol_of_eth_address t.ttn_asset, { tka_amount = transfer_value_neg t.ttn_amount; tka_asset = t.ttn_asset; @@ -1209,10 +1362,10 @@ let update_delta_transfer_from t delta = ] | Some tka -> let delta_t' = - List.remove_assoc (extract_string_address t.ttn_asset) delta' in - List.remove_assoc (extract_string_address t.ttn_from) delta + List.remove_assoc (symbol_of_eth_address t.ttn_asset) delta' in + List.remove_assoc (symbol_of_eth_address t.ttn_from) delta @ [ - ( extract_string_address t.ttn_from, + ( symbol_of_eth_address t.ttn_from, let add_tkns = add_transfer_value tka.tka_amount @@ transfer_value_neg t.ttn_amount in @@ -1223,13 +1376,13 @@ let update_delta_transfer_from t delta = else delta_t' @ [ - ( extract_string_address t.ttn_asset, + ( symbol_of_eth_address t.ttn_asset, { tka with tka_amount = add_tkns } ); ] | _ -> delta_t' @ [ - ( extract_string_address t.ttn_asset, + ( symbol_of_eth_address t.ttn_asset, { tka with tka_amount = add_tkns } ); ] ); ] in @@ -1237,29 +1390,29 @@ let update_delta_transfer_from t delta = let update_delta_transfer_to t delta = let delta_t = - match List.assoc_opt (extract_string_address t.ttn_to) delta with + match List.assoc_opt (symbol_of_eth_address t.ttn_to) delta with | None -> [] | Some delta_t -> delta_t in let token_amount_t_to = - List.assoc_opt (extract_string_address t.ttn_asset) delta_t in + List.assoc_opt (symbol_of_eth_address t.ttn_asset) delta_t in let delta_t = match token_amount_t_to with | None -> - List.remove_assoc (extract_string_address t.ttn_to) delta + List.remove_assoc (symbol_of_eth_address t.ttn_to) delta @ [ - ( extract_string_address t.ttn_to, + ( symbol_of_eth_address t.ttn_to, delta_t @ [ - ( extract_string_address t.ttn_asset, + ( symbol_of_eth_address t.ttn_asset, { tka_amount = t.ttn_amount; tka_asset = t.ttn_asset } ); ] ); ] | Some tka -> let delta_t' = - List.remove_assoc (extract_string_address t.ttn_asset) delta_t in - List.remove_assoc (extract_string_address t.ttn_to) delta + List.remove_assoc (symbol_of_eth_address t.ttn_asset) delta_t in + List.remove_assoc (symbol_of_eth_address t.ttn_to) delta @ [ - ( extract_string_address t.ttn_to, + ( symbol_of_eth_address t.ttn_to, let add_tkns = add_transfer_value tka.tka_amount t.ttn_amount in match add_tkns with | Tv_value z -> @@ -1268,13 +1421,13 @@ let update_delta_transfer_to t delta = else delta_t' @ [ - ( extract_string_address t.ttn_asset, + ( symbol_of_eth_address t.ttn_asset, { tka with tka_amount = add_tkns } ); ] | _ -> delta_t' @ [ - ( extract_string_address t.ttn_asset, + ( symbol_of_eth_address t.ttn_asset, { tka with tka_amount = add_tkns } ); ] ); ] in @@ -1327,24 +1480,12 @@ let merge_children t1 t2 signal = let resume = { tc_origin = t1.ttn_from; - tc_middleman = M_Single t1.ttn_to; + tc_middleman = addresses_of_eth_address t1.ttn_to []; tc_destination = t2.ttn_to; - tc_amount0 = - { - ta_amount = V_Single t1.ttn_amount; - ta_asset = M_Single t1.ttn_asset; - }; - tc_amount1 = - { - ta_amount = V_Single t2.ttn_amount; - ta_asset = M_Single t2.ttn_asset; - }; + tc_amount0 = tokens_amount_of_transfer t1; + tc_amount1 = tokens_amount_of_transfer t2; tc_construction = `chaining; - tc_first_transfer = - { - ta_amount = V_Single t1.ttn_amount; - ta_asset = M_Single t1.ttn_asset; - }; + tc_first_transfer = cft_transfer_node_of_token_amount t1; tc_delta = update_delta_transfer_to t2 @@ update_delta_transfer_from t2 @@ -1363,24 +1504,12 @@ let merge_children t1 t2 signal = let resume = { tc_origin = t1.ttn_from; - tc_middleman = M_Single t1.ttn_to; + tc_middleman = addresses_of_eth_address t1.ttn_to []; tc_destination = t2.ttn_to; - tc_amount0 = - { - ta_amount = V_Single t1.ttn_amount; - ta_asset = M_Single t1.ttn_asset; - }; - tc_amount1 = - { - ta_amount = V_Single t2.ttn_amount; - ta_asset = M_Single t2.ttn_asset; - }; + tc_amount0 = tokens_amount_of_transfer t1; + tc_amount1 = tokens_amount_of_transfer t2; tc_construction = `liquidation_burn; - tc_first_transfer = - { - ta_amount = V_Single t1.ttn_amount; - ta_asset = M_Single t1.ttn_asset; - }; + tc_first_transfer = cft_transfer_node_of_token_amount t1; tc_delta = update_delta_transfer_to t2 @@ update_delta_transfer_from t2 @@ -1399,24 +1528,12 @@ let merge_children t1 t2 signal = let resume = { tc_origin = t1.ttn_from; - tc_middleman = M_Single t1.ttn_to; + tc_middleman = addresses_of_eth_address t1.ttn_to []; tc_destination = t2.ttn_to; - tc_amount0 = - { - ta_amount = V_Single t1.ttn_amount; - ta_asset = M_Single t1.ttn_asset; - }; - tc_amount1 = - { - ta_amount = V_Single t2.ttn_amount; - ta_asset = M_Single t2.ttn_asset; - }; + tc_amount0 = tokens_amount_of_transfer t1; + tc_amount1 = tokens_amount_of_transfer t2; tc_construction = `liquidation_mint; - tc_first_transfer = - { - ta_amount = V_Single t1.ttn_amount; - ta_asset = M_Single t1.ttn_asset; - }; + tc_first_transfer = cft_transfer_node_of_token_amount t1; tc_delta = update_delta_transfer_to t2 @@ update_delta_transfer_from t2 @@ -1440,11 +1557,7 @@ let merge_children t1 t2 signal = tc_amount0 = c2.resume.tc_amount0; tc_amount1 = c2.resume.tc_amount1; tc_construction = `chaining; - tc_first_transfer = - { - ta_amount = V_Single t1.ttn_amount; - ta_asset = M_Single t1.ttn_asset; - }; + tc_first_transfer = cft_transfer_node_of_token_amount t1; tc_delta = update_delta_transfer_to t1 @@ update_delta_transfer_from t1 c2.resume.tc_delta; @@ -1462,14 +1575,10 @@ let merge_children t1 t2 signal = let resume = { tc_origin = c1.resume.tc_origin; - tc_middleman = M_Single t2.ttn_from; + tc_middleman = addresses_of_eth_address t2.ttn_from []; tc_destination = t2.ttn_to; tc_amount0 = c1.resume.tc_amount1; - tc_amount1 = - { - ta_amount = V_Single t2.ttn_amount; - ta_asset = M_Single t2.ttn_asset; - }; + tc_amount1 = tokens_amount_of_transfer t2; tc_construction = `chaining; tc_first_transfer = c1.resume.tc_first_transfer; tc_delta = @@ -1511,15 +1620,15 @@ let merge_children t1 t2 signal = { tc_origin = c1.resume.tc_origin; tc_middleman = - accumulate_addresses c1.resume.tc_middleman c2.resume.tc_middleman; + List.fold_left + (fun acc (_, ac2) -> addresses_of_eth_address ac2 acc) + c1.resume.tc_middleman c2.resume.tc_middleman; tc_destination = c2.resume.tc_destination; - tc_amount0 = - op_transfer_amount add_value c1.resume.tc_amount0 c2.resume.tc_amount0; - tc_amount1 = - op_transfer_amount add_value c1.resume.tc_amount1 c2.resume.tc_amount1; + tc_amount0 = merge_token_list c1.resume.tc_amount0 c2.resume.tc_amount0; + tc_amount1 = merge_token_list c1.resume.tc_amount1 c2.resume.tc_amount1; tc_construction = `merging; tc_first_transfer = - op_transfer_amount add_value c1.resume.tc_first_transfer + add_token_amount c1.resume.tc_first_transfer c2.resume.tc_first_transfer; tc_delta = merge_delta c1.resume.tc_delta c2.resume.tc_delta; } in @@ -1537,15 +1646,15 @@ let merge_children t1 t2 signal = { tc_origin = c1.resume.tc_origin; tc_middleman = - accumulate_addresses c1.resume.tc_middleman c2.resume.tc_middleman; + List.fold_left + (fun acc (_, ac2) -> addresses_of_eth_address ac2 acc) + c1.resume.tc_middleman c2.resume.tc_middleman; tc_destination = c2.resume.tc_destination; - tc_amount0 = - op_transfer_amount add_value c1.resume.tc_amount0 c2.resume.tc_amount0; - tc_amount1 = - op_transfer_amount add_value c1.resume.tc_amount1 c2.resume.tc_amount1; + tc_amount0 = merge_token_list c1.resume.tc_amount0 c2.resume.tc_amount0; + tc_amount1 = merge_token_list c1.resume.tc_amount1 c2.resume.tc_amount1; tc_construction = `merging; tc_first_transfer = - op_transfer_amount add_value c1.resume.tc_first_transfer + add_token_amount c1.resume.tc_first_transfer c2.resume.tc_first_transfer; tc_delta = merge_delta c1.resume.tc_delta c2.resume.tc_delta; } in @@ -1565,7 +1674,7 @@ let rec find_compatible to_ child children' acc = match children' with | [] -> (None, acc) | child' :: rest -> ( - match is_compatible to_ child child' with + match cft_trees_compatible_for_merge to_ child child' with | None -> let acc' = acc @ [child'] in find_compatible to_ child rest acc' @@ -1592,7 +1701,7 @@ let lift_tree tt = | Internal -> if List.fold_left - (fun acc child -> acc && is_child_leaf child) + (fun acc child -> acc && cft_is_leaf child) true tree.children then tree.children @@ -1607,7 +1716,7 @@ let rec one_merge_step to_ tt = | Cft_tree tree -> ( match List.fold_left - (fun acc child -> acc && is_child_leaf child) + (fun acc child -> acc && cft_is_leaf child) true tree.children with | false -> @@ -1684,7 +1793,7 @@ let extract_to tree = let flow_graph_small_step tx = try - let tree = entry_point tx in + let tree = cft_of_debug_trace tx in let to_ = extract_to tree in step_reduction to_ tree [tree] true with e -> @@ -1697,24 +1806,12 @@ let merge_debries c1 c2 _signal = let resume = { tc_origin = t1.ttn_from; - tc_middleman = M_Single t1.ttn_to; + tc_middleman = addresses_of_eth_address t1.ttn_to []; tc_destination = t2.ttn_to; - tc_amount0 = - { - ta_amount = V_Single t1.ttn_amount; - ta_asset = M_Single t1.ttn_asset; - }; - tc_amount1 = - { - ta_amount = V_Single t2.ttn_amount; - ta_asset = M_Single t2.ttn_asset; - }; + tc_amount0 = tokens_amount_of_transfer t1; + tc_amount1 = tokens_amount_of_transfer t2; tc_construction = `chaining; - tc_first_transfer = - { - ta_amount = V_Single t1.ttn_amount; - ta_asset = M_Single t1.ttn_asset; - }; + tc_first_transfer = cft_transfer_node_of_token_amount t1; tc_delta = update_delta_transfer_to t2 @@ update_delta_transfer_from t2 @@ -1738,11 +1835,7 @@ let merge_debries c1 c2 _signal = tc_amount0 = c2'.resume.tc_amount0; tc_amount1 = c2'.resume.tc_amount1; tc_construction = `chaining; - tc_first_transfer = - { - ta_amount = V_Single t1.ttn_amount; - ta_asset = M_Single t1.ttn_asset; - }; + tc_first_transfer = cft_transfer_node_of_token_amount t1; tc_delta = update_delta_transfer_to t1 @@ update_delta_transfer_from t1 c2'.resume.tc_delta; @@ -1755,14 +1848,10 @@ let merge_debries c1 c2 _signal = let resume = { tc_origin = c1'.resume.tc_origin; - tc_middleman = M_Single t2.ttn_from; + tc_middleman = addresses_of_eth_address t2.ttn_from []; tc_destination = t2.ttn_to; tc_amount0 = c1'.resume.tc_amount1; - tc_amount1 = - { - ta_amount = V_Single t2.ttn_amount; - ta_asset = M_Single t2.ttn_asset; - }; + tc_amount1 = tokens_amount_of_transfer t2; tc_construction = `chaining; tc_first_transfer = c1'.resume.tc_first_transfer; tc_delta = @@ -1778,17 +1867,17 @@ let merge_debries c1 c2 _signal = { tc_origin = c1'.resume.tc_origin; tc_middleman = - accumulate_addresses c1'.resume.tc_middleman c2'.resume.tc_middleman; + List.fold_left + (fun acc (_, ac2) -> addresses_of_eth_address ac2 acc) + c1'.resume.tc_middleman c2'.resume.tc_middleman; tc_destination = c1'.resume.tc_destination; tc_amount0 = - op_transfer_amount add_value c1'.resume.tc_amount0 - c2'.resume.tc_amount0; + merge_token_list c1'.resume.tc_amount0 c2'.resume.tc_amount0; tc_amount1 = - op_transfer_amount add_value c1'.resume.tc_amount1 - c2'.resume.tc_amount1; + merge_token_list c1'.resume.tc_amount1 c2'.resume.tc_amount1; tc_construction = `merging; tc_first_transfer = - op_transfer_amount add_value c1'.resume.tc_first_transfer + add_token_amount c1'.resume.tc_first_transfer c2'.resume.tc_first_transfer; tc_delta = merge_delta c1'.resume.tc_delta c2'.resume.tc_delta; } in @@ -1813,12 +1902,14 @@ let is_compatible_debrie _to cft1 cft2 = Cftn_transfer_chain (Cftt_transfer t2) ) -> if c1.resume.tc_destination = t2.ttn_from - && c1.resume.tc_amount1.ta_asset = M_Single t2.ttn_asset + && address_list_of_token_amount_list c1.resume.tc_amount1 + = [address_of_eth_address t2.ttn_asset] then Some (Cftt_chain c1, Cftt_transfer t2, `chain) else if t2.ttn_to = c1.resume.tc_origin - && M_Single t2.ttn_asset = c1.resume.tc_amount0.ta_asset + && [address_of_eth_address t2.ttn_asset] + = address_list_of_token_amount_list c1.resume.tc_amount0 then Some (Cftt_transfer t2, Cftt_chain c1, `chain) else @@ -1827,12 +1918,14 @@ let is_compatible_debrie _to cft1 cft2 = Cftn_transfer_chain (Cftt_chain c2) ) -> if t1.ttn_to = c2.resume.tc_origin - && M_Single t1.ttn_asset = c2.resume.tc_amount0.ta_asset + && [address_of_eth_address t1.ttn_asset] + = address_list_of_token_amount_list c2.resume.tc_amount0 then Some (Cftt_transfer t1, Cftt_chain c2, `chain) else if c2.resume.tc_destination = t1.ttn_from - && c2.resume.tc_amount1.ta_asset = M_Single t1.ttn_asset + && address_list_of_token_amount_list c2.resume.tc_amount1 + = [address_of_eth_address t1.ttn_asset] then Some (Cftt_chain c2, Cftt_transfer t1, `chain) else @@ -1842,9 +1935,12 @@ let is_compatible_debrie _to cft1 cft2 = if c1.resume.tc_origin = c2.resume.tc_origin && c1.resume.tc_destination = c2.resume.tc_destination - && c1.resume.tc_amount0.ta_asset = c2.resume.tc_amount0.ta_asset - && c1.resume.tc_amount1.ta_asset = c2.resume.tc_amount1.ta_asset - && c1.resume.tc_amount0.ta_asset = c2.resume.tc_amount1.ta_asset + && address_list_of_token_amount_list c1.resume.tc_amount0 + = address_list_of_token_amount_list c2.resume.tc_amount0 + && address_list_of_token_amount_list c1.resume.tc_amount1 + = address_list_of_token_amount_list c2.resume.tc_amount1 + && address_list_of_token_amount_list c1.resume.tc_amount0 + = address_list_of_token_amount_list c2.resume.tc_amount1 then Some (Cftt_chain c1, Cftt_chain c2, `merge) else @@ -1893,22 +1989,13 @@ let is_a_cycle chain = | Cftt_transfer _ -> false | Cftt_chain chain -> if - extract_address_from_contract_address chain.resume.tc_origin - = extract_address_from_contract_address chain.resume.tc_destination + address_of_eth_address chain.resume.tc_origin + = address_of_eth_address chain.resume.tc_destination then true else false -let rec remove_duplicates = function - | [] -> [] - | x :: xs -> - let xs' = remove_duplicates xs in - if List.mem x xs' then - xs' - else - x :: xs' - let rec remove_one f x = function | [] -> [] | y :: ys -> @@ -1925,36 +2012,20 @@ let rec same_elements lst1 lst2 = | true -> same_elements xs (remove_one equal_address x lst2) | false -> false) -let rec same_tokens assets1 assets2 = +let same_tokens (assets1 : address list) (assets2 : address list) = match (assets1, assets2) with - | M_Single asset1', M_Single asset2' -> - same_elements - [extract_address_from_contract_address asset1'] - [extract_address_from_contract_address asset2'] - | M_Multiple assets1', M_Single asset2' -> - let assets1' = - remove_duplicates - @@ List.map extract_address_from_contract_address assets1' in - same_elements assets1' [extract_address_from_contract_address asset2'] - | M_Single _, M_Multiple _ -> same_tokens assets2 assets1 - | M_Multiple assets1', M_Multiple assets2' -> - let assets1' = - remove_duplicates - @@ List.map extract_address_from_contract_address assets1' in - let assets2' = - remove_duplicates - @@ List.map extract_address_from_contract_address assets2' in - same_elements assets1' assets2' + | [], [] -> true + | asset1', asset2' -> same_elements asset1' asset2' let rec address_in_cycle from_ chain = match chain with | Cftt_transfer t -> - Eth.equal_address (extract_address from_) - @@ extract_address_from_contract_address t.ttn_from + Eth.equal_address (address_of_known_address_or_address from_) + @@ address_of_eth_address t.ttn_from | Cftt_chain chain -> ( match - List.mem (extract_address from_) - @@ extract_address_from_addresses chain.resume.tc_middleman + List.mem (address_of_known_address_or_address from_) + @@ address_list_of_addresses chain.resume.tc_middleman with | false -> address_in_cycle from_ chain.left_component @@ -1970,12 +2041,13 @@ let rec annotate_cycle from_ chain = match (chain'.left_component, chain'.right_component) with | Cftt_chain chain1, Cftt_chain chain2 -> if - extract_string_address chain1.resume.tc_destination - != extract_string_address chain2.resume.tc_origin + symbol_of_eth_address chain1.resume.tc_destination + != symbol_of_eth_address chain2.resume.tc_origin then if - same_tokens chain'.resume.tc_first_transfer.ta_asset - chain'.resume.tc_amount1.ta_asset + same_tokens + [address_of_token_amount chain'.resume.tc_first_transfer] + @@ address_list_of_token_amount_list chain'.resume.tc_amount1 && (not @@ address_in_cycle from_ chain) then { chain'.resume with tc_construction = `arbitrage } @@ -1985,8 +2057,9 @@ let rec annotate_cycle from_ chain = chain'.resume | _ -> if - same_tokens chain'.resume.tc_first_transfer.ta_asset - chain'.resume.tc_amount1.ta_asset + same_tokens + [address_of_token_amount chain'.resume.tc_first_transfer] + @@ address_list_of_token_amount_list chain'.resume.tc_amount1 && (not @@ address_in_cycle from_ chain) then { chain'.resume with tc_construction = `arbitrage } @@ -2146,7 +2219,7 @@ let calculate_transaction_fees block_number block_builder base_fee } let extract_transfers_from_cft trace costs = - let tree = entry_point trace in + let tree = cft_of_debug_trace trace in let lst_transfers = extract_transfers tree in let costs = extract_bb_costs costs trace.dt_result.dtr_from_decode in let _, res = @@ -2185,11 +2258,11 @@ let rec calculate_profits from_ to_ bb cft profits = @@ Option.map (fun to_ -> List.assoc_opt - (extract_string_address (Ca_address to_)) + (symbol_of_eth_address (Ca_address to_)) chain.resume.tc_delta) to_ in match delta with - | None -> (SMap.empty, [], []) + | None -> (profits, [], []) | Some delta -> if (chain.resume.tc_construction = `cycle @@ -2198,10 +2271,18 @@ let rec calculate_profits from_ to_ bb cft profits = || chain.resume.tc_construction = `liquidation_mint) && Some chain.resume.tc_origin = Option.map (fun x -> Ca_address x) to_ - then + then ( + Format.printf "here %s@." + (match chain.resume.tc_construction with + | `chaining -> "chaining" + | `liquidation_burn -> "LiqBurn" + | `liquidation_mint -> "liqMint" + | `cycle -> "cycle" + | `arbitrage -> "arbitrage" + | `merging -> "merging") ; let profits' = add_deltas_to_profits delta profits in (profits', [extract_transfer_from_chain (Cftt_chain chain)], []) - else + ) else let profits', transfer_in_cycles', leftovers' = calculate_profits from_ to_ bb (Cft_leaf { node = Cftn_transfer_chain chain.left_component }) @@ -2215,14 +2296,14 @@ let rec calculate_profits from_ to_ bb cft profits = leftovers' @ leftovers'' )) | Cftn_transfer_chain (Cftt_transfer transfer) -> if - Some (extract_string_address transfer.ttn_to) - = Option.map (fun x -> extract_string_address (Ca_address x)) to_ - && extract_string_address transfer.ttn_from - = extract_string_address (Ca_address from_) + Some (symbol_of_eth_address transfer.ttn_to) + = Option.map (fun x -> symbol_of_eth_address (Ca_address x)) to_ + && symbol_of_eth_address transfer.ttn_from + = symbol_of_eth_address (Ca_address from_) then ( add_deltas_to_profits [ - ( extract_string_address transfer.ttn_asset, + ( symbol_of_eth_address transfer.ttn_asset, { tka_amount = transfer.ttn_amount; tka_asset = transfer.ttn_asset; @@ -2232,14 +2313,14 @@ let rec calculate_profits from_ to_ bb cft profits = [], [] ) else if - Some (extract_string_address transfer.ttn_from) - = Option.map (fun x -> extract_string_address (Ca_address x)) to_ - && Some (extract_string_address transfer.ttn_to) - = Option.map (fun x -> extract_string_address x) bb + Some (symbol_of_eth_address transfer.ttn_from) + = Option.map (fun x -> symbol_of_eth_address (Ca_address x)) to_ + && Some (symbol_of_eth_address transfer.ttn_to) + = Option.map (fun x -> symbol_of_eth_address x) bb then ( add_deltas_to_profits [ - ( extract_string_address transfer.ttn_asset, + ( symbol_of_eth_address transfer.ttn_asset, { tka_amount = (match transfer.ttn_amount with @@ -2252,13 +2333,13 @@ let rec calculate_profits from_ to_ bb cft profits = [], [] ) else if - (Some (extract_string_address transfer.ttn_from) - = Option.map (fun x -> extract_string_address (Ca_address x)) to_ - || Some (extract_string_address transfer.ttn_to) - = Option.map (fun x -> extract_string_address (Ca_address x)) to_) + (Some (symbol_of_eth_address transfer.ttn_from) + = Option.map (fun x -> symbol_of_eth_address (Ca_address x)) to_ + || Some (symbol_of_eth_address transfer.ttn_to) + = Option.map (fun x -> symbol_of_eth_address (Ca_address x)) to_) && not - (extract_string_address transfer.ttn_to - = extract_string_address (Ca_address from_)) + (symbol_of_eth_address transfer.ttn_to + = symbol_of_eth_address (Ca_address from_)) then (profits, [], [transfer]) else @@ -2279,8 +2360,8 @@ let rec cft_address_has_arbitrage cft address = | Cftn_transfer_chain (Cftt_chain chain) -> if chain.resume.tc_construction = `arbitrage - && extract_string_address chain.resume.tc_origin - = extract_string_address (Ca_address address) + && symbol_of_eth_address chain.resume.tc_origin + = symbol_of_eth_address (Ca_address address) then true else @@ -2312,9 +2393,8 @@ let merge_cycles from_ cycle1 cycle2 = tc_first_transfer = chain1.resume.tc_first_transfer; tc_construction = (if - extract_address_from_addresses chain2.resume.tc_amount1.ta_asset - = extract_address_from_addresses - chain1.resume.tc_first_transfer.ta_asset + address_list_of_token_amount_list chain2.resume.tc_amount1 + = [address_of_token_amount chain1.resume.tc_first_transfer] && (not @@ address_in_cycle from_ (Cftt_chain chain1)) && (not @@ address_in_cycle from_ (Cftt_chain chain2)) then @@ -2358,27 +2438,25 @@ let rec find_compatible_cycle from_ to_ child children = | true -> if not - (extract_address_from_addresses chain1.resume.tc_middleman - = [extract_address from_] - || extract_address_from_addresses chain2.resume.tc_middleman - = [extract_address from_]) + (address_list_of_addresses chain1.resume.tc_middleman + = [address_of_known_address_or_address from_] + || address_list_of_addresses chain2.resume.tc_middleman + = [address_of_known_address_or_address from_]) then if - extract_string_address chain1.resume.tc_origin - = extract_string_address chain2.resume.tc_origin - && Option.map (fun x -> extract_string_address (Ca_address x)) to_ - = Some (extract_string_address chain1.resume.tc_origin) + symbol_of_eth_address chain1.resume.tc_origin + = symbol_of_eth_address chain2.resume.tc_origin + && Option.map (fun x -> symbol_of_eth_address (Ca_address x)) to_ + = Some (symbol_of_eth_address chain1.resume.tc_origin) then if - extract_address_from_addresses chain1.resume.tc_amount1.ta_asset - = extract_address_from_addresses - chain2.resume.tc_first_transfer.ta_asset + address_list_of_token_amount_list chain1.resume.tc_amount1 + = [address_of_token_amount chain2.resume.tc_first_transfer] then Some (child, child') else if - extract_address_from_addresses chain2.resume.tc_amount1.ta_asset - = extract_address_from_addresses - chain1.resume.tc_first_transfer.ta_asset + address_list_of_token_amount_list chain2.resume.tc_amount1 + = [address_of_token_amount chain1.resume.tc_first_transfer] then Some (child', child) else @@ -2495,8 +2573,8 @@ let squash_token_into_token deltas token1 token2 = match List.filter (fun x -> - extract_string_real_address x.tka_asset - = extract_string_real_address token1) + string_address_of_eth_address x.tka_asset + = string_address_of_eth_address token1) deltas with | [] -> { tka_amount = Tv_value Z.zero; tka_asset = token1 } @@ -2513,8 +2591,8 @@ let squash_token_into_token deltas token1 token2 = match List.filter (fun x -> - extract_string_real_address x.tka_asset - = extract_string_real_address token2) + string_address_of_eth_address x.tka_asset + = string_address_of_eth_address token2) deltas with | [] -> { tka_amount = Tv_value Z.zero; tka_asset = eth_address_eth_null } @@ -2538,11 +2616,11 @@ let squash_token_into_token deltas token1 token2 = List.filter (fun x -> (not - (extract_string_real_address x.tka_asset - = extract_string_real_address token1)) + (string_address_of_eth_address x.tka_asset + = string_address_of_eth_address token1)) && not - (extract_string_real_address x.tka_asset - = extract_string_real_address token2)) + (string_address_of_eth_address x.tka_asset + = string_address_of_eth_address token2)) deltas in (extract_balance_token2', deltas') diff --git a/src/ethereum_analysis/eth_graph.mli b/src/ethereum_analysis/eth_graph.mli index a58fc8dc73d1e18caa9b38835ef55ee28b8812d1..c5339cc4ef689dbd2a5e89490830b83f4d40b516 100644 --- a/src/ethereum_analysis/eth_graph.mli +++ b/src/ethereum_analysis/eth_graph.mli @@ -31,12 +31,12 @@ module SMap : Map.S with type key = string @return {!Some} contract info when the address is recognized/decoded, {!None} otherwise. *) -val extract_contract_from_address : +val contract_of_known_address_or_address : Common.Types.Ethereum_analysis.eth_address -> Common.Types.Ethereum_decode.contract_information Option.t (** Render an address as a hex string. 0x is not a part of the string. *) -val extract_string_address : +val symbol_of_eth_address : Common.Types.Ethereum_analysis.eth_address -> String.t (** {1 Token values} *) @@ -162,3 +162,7 @@ val arbitrage_cft : Olympus.Types.debug_trace -> Common.Types.Ethereum_analysis.cft_input -> Common.Types.Ethereum_analysis.cft_arbitrage_output + +val cft_transfer_node_of_token_amount : + Common.Types.Ethereum_analysis.cft_transfer_node -> + Common.Types.Ethereum_analysis.token_amount