From db4505fea6eb2513ea32d9eb8285358d418b97d4 Mon Sep 17 00:00:00 2001 From: "adam.khayam" Date: Fri, 5 Sep 2025 17:00:20 +0200 Subject: [PATCH 1/6] starting refactoring --- debug/graph/debug_graph.ml | 58 ++-- src/common/types.ml | 27 +- src/ethereum_analysis/eth_graph.ml | 510 ++++++++++++++++------------ src/ethereum_analysis/eth_graph.mli | 4 + 4 files changed, 318 insertions(+), 281 deletions(-) diff --git a/debug/graph/debug_graph.ml b/debug/graph/debug_graph.ml index 66964ca4..d1e26ab7 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 +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" ^ extract_string_address address) + "" addresses + let string_of_contract_type c_type = match c_type with | ErcStandard ERC1155 -> "ERC-1155" @@ -223,8 +211,8 @@ module Dot = Graphviz.Dot (struct | 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) - in + string_of_tokens_amount + [Eth_analysis.Eth_graph.token_amount_of_transfer tsfr] in let _description = tsfr.ttn_description in Format.sprintf "from: %s\n\ @@ -241,27 +229,21 @@ module Dot = Graphviz.Dot (struct _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 _middleman = string_of_addresses chain.resume.tc_middleman in let _to = extract_string_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 = diff --git a/src/common/types.ml b/src/common/types.ml index f527dd22..5cdfcf43 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 e403c737..694799eb 100644 --- a/src/ethereum_analysis/eth_graph.ml +++ b/src/ethereum_analysis/eth_graph.ml @@ -21,21 +21,6 @@ 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 = Z.to_float wad *. Float.pow 10. (-1. *. Z.to_float exp) @@ -474,13 +459,40 @@ 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 sort_address (a : Eth.address) (b : Eth.address) = + String.compare (a :> string) (b :> string) + +let address_list_of_addresses (a : addresses) = + List.sort sort_address + @@ List.map (fun (_, a) -> extract_address_from_contract_address a) a + +let address_of_token_amount (tka : token_amount) = + extract_address_from_contract_address tka.tka_asset + +let address_list_of_token_amount_list (tal : (string * token_amount) List.t) = + List.sort sort_address + (address_list_of_addresses + @@ List.map (fun (a, tka) -> (a, tka.tka_asset)) tal) + +let token_amount_of_transfer t = + { tka_amount = t.ttn_amount; tka_asset = t.ttn_asset } + +let tokens_amount_of_transfer t = + [(extract_string_address t.ttn_asset, token_amount_of_transfer t)] + +let addresses_of_address address addresses = + match List.assoc_opt (extract_string_address address) addresses with + | None -> + List.sort (fun (a, _) (b, _) -> sort_address (Eth.a a) (Eth.a b)) + @@ ((extract_string_address address, address) :: addresses) + | Some _ -> addresses + +let token_amount_add 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_liquidation_pool add = match extract_contract_from_address add with @@ -508,6 +520,49 @@ let rec is_compatible to_ tree1 tree2 = | 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 @@ -671,6 +726,49 @@ let rec is_compatible to_ tree1 tree2 = 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 @@ -815,6 +913,49 @@ let rec is_compatible to_ tree1 tree2 = 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 @@ -850,6 +991,11 @@ let rec is_compatible to_ tree1 tree2 = = extract_address_from_contract_address t1.ttn_from then Some (Cftt_transfer t2, Cftt_transfer t1, `liquidationBurn) + else if + extract_address_from_contract_address t1.ttn_to + = extract_address_from_contract_address t2.ttn_from + then + Some (Cftt_transfer t1, Cftt_transfer t2, `liquidationBurn) else None else if @@ -869,6 +1015,9 @@ let rec is_compatible to_ tree1 tree2 = = extract_address_from_contract_address t1.ttn_from then Some (Cftt_transfer t2, Cftt_transfer t1, `liquidationMint) + (* else if extract_address_from_contract_address t1.ttn_to = + extract_address_from_contract_address t2.ttn_from then Some + (Cftt_transfer t1, Cftt_transfer t2, `liquidationMint) *) else None else if @@ -888,6 +1037,9 @@ let rec is_compatible to_ tree1 tree2 = = extract_address_from_contract_address t2.ttn_from then Some (Cftt_transfer t1, Cftt_transfer t2, `liquidationMint) + (* else if extract_address_from_contract_address t2.ttn_to = + extract_address_from_contract_address t1.ttn_from then Some + (Cftt_transfer t2, Cftt_transfer t1, `liquidationMint) *) else None else if @@ -1010,6 +1162,9 @@ let rec is_compatible to_ tree1 tree2 = if extract_address_from_contract_address c1.resume.tc_destination = extract_address_from_contract_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 @@ -1018,6 +1173,9 @@ let rec is_compatible to_ tree1 tree2 = if extract_address_from_contract_address t2.ttn_to = extract_address_from_contract_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 @@ -1026,11 +1184,15 @@ let rec is_compatible to_ tree1 tree2 = if extract_address_from_contract_address c1.resume.tc_destination = extract_address_from_contract_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_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 @@ -1054,11 +1216,11 @@ let rec is_compatible to_ tree1 tree2 = (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_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 @@ -1067,9 +1229,9 @@ let rec is_compatible to_ tree1 tree2 = 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 + && 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 @@ -1079,9 +1241,8 @@ let rec is_compatible to_ tree1 tree2 = extract_address_from_contract_address c2.resume.tc_destination = extract_address_from_contract_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 @@ -1090,17 +1251,15 @@ let rec is_compatible to_ tree1 tree2 = 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_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_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 @@ -1110,10 +1269,10 @@ let rec is_compatible to_ tree1 tree2 = = 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_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 @@ -1125,11 +1284,11 @@ let rec is_compatible to_ tree1 tree2 = (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_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 +1296,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) @@ -1327,24 +1467,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_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 = token_amount_of_transfer t1; tc_delta = update_delta_transfer_to t2 @@ update_delta_transfer_from t2 @@ -1363,24 +1491,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_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 = token_amount_of_transfer t1; tc_delta = update_delta_transfer_to t2 @@ update_delta_transfer_from t2 @@ -1399,24 +1515,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_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 = token_amount_of_transfer t1; tc_delta = update_delta_transfer_to t2 @@ update_delta_transfer_from t2 @@ -1440,11 +1544,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 = token_amount_of_transfer t1; tc_delta = update_delta_transfer_to t1 @@ update_delta_transfer_from t1 c2.resume.tc_delta; @@ -1462,14 +1562,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_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 +1607,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_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 + token_amount_add 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 +1633,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_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 + token_amount_add c1.resume.tc_first_transfer c2.resume.tc_first_transfer; tc_delta = merge_delta c1.resume.tc_delta c2.resume.tc_delta; } in @@ -1697,24 +1793,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_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 = token_amount_of_transfer t1; tc_delta = update_delta_transfer_to t2 @@ update_delta_transfer_from t2 @@ -1738,11 +1822,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 = token_amount_of_transfer t1; tc_delta = update_delta_transfer_to t1 @@ update_delta_transfer_from t1 c2'.resume.tc_delta; @@ -1755,14 +1835,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_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 +1854,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_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 + token_amount_add 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 +1889,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 + = [extract_address_from_contract_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 + && [extract_address_from_contract_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 +1905,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 + && [extract_address_from_contract_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 + = [extract_address_from_contract_address t1.ttn_asset] then Some (Cftt_chain c2, Cftt_transfer t1, `chain) else @@ -1842,9 +1922,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 @@ -1900,15 +1983,6 @@ let is_a_cycle chain = 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,26 +1999,10 @@ 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 @@ -1954,7 +2012,7 @@ let rec address_in_cycle from_ chain = | Cftt_chain chain -> ( match List.mem (extract_address from_) - @@ extract_address_from_addresses chain.resume.tc_middleman + @@ address_list_of_addresses chain.resume.tc_middleman with | false -> address_in_cycle from_ chain.left_component @@ -1974,8 +2032,8 @@ let rec annotate_cycle from_ chain = != extract_string_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 +2043,8 @@ 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 } @@ -2189,7 +2247,7 @@ let rec calculate_profits from_ to_ bb cft profits = chain.resume.tc_delta) to_ in match delta with - | None -> (SMap.empty, [], []) + | None -> (profits, [], []) | Some delta -> if (chain.resume.tc_construction = `cycle @@ -2198,10 +2256,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 }) @@ -2312,9 +2378,9 @@ 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,9 +2424,9 @@ let rec find_compatible_cycle from_ to_ child children = | true -> if not - (extract_address_from_addresses chain1.resume.tc_middleman + (address_list_of_addresses chain1.resume.tc_middleman = [extract_address from_] - || extract_address_from_addresses chain2.resume.tc_middleman + || address_list_of_addresses chain2.resume.tc_middleman = [extract_address from_]) then if @@ -2370,15 +2436,13 @@ let rec find_compatible_cycle from_ to_ child children = = Some (extract_string_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 diff --git a/src/ethereum_analysis/eth_graph.mli b/src/ethereum_analysis/eth_graph.mli index a58fc8dc..eeac1253 100644 --- a/src/ethereum_analysis/eth_graph.mli +++ b/src/ethereum_analysis/eth_graph.mli @@ -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 token_amount_of_transfer : + Common.Types.Ethereum_analysis.cft_transfer_node -> + Common.Types.Ethereum_analysis.token_amount -- GitLab From 3ec8b066b673c31fdaedca7b756e9501169f0203 Mon Sep 17 00:00:00 2001 From: "adam.khayam" Date: Mon, 8 Sep 2025 10:12:43 +0200 Subject: [PATCH 2/6] refactoring --- src/ethereum_analysis/eth_graph.ml | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/src/ethereum_analysis/eth_graph.ml b/src/ethereum_analysis/eth_graph.ml index 694799eb..934f10b9 100644 --- a/src/ethereum_analysis/eth_graph.ml +++ b/src/ethereum_analysis/eth_graph.ml @@ -13,7 +13,7 @@ let weth_address = Eth.a "c02aaa39b223fe8d0a0e5c4f27ead9083c756cc2" let eth_address_weth = Ca_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,7 +21,7 @@ let extract_contract_from_address address = | Coadr_address _ -> None | Coadr_known_address address -> address.ai_is_contract) -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 = @@ -42,7 +42,7 @@ 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 (extract_decimal_from_address asset)) | Tv_complex (V_erc1155 v') -> Common.string_of_erc1155 v' let event_is_a_transfer description = @@ -422,13 +422,24 @@ let entry_point debug_trace = build_tx_tree debug_trace.dt_result (External debug_trace.dt_tx_hash) in annotate_operator None None r +<<<<<<< HEAD +======= +let is_liquidation_pool add = + match contract_of_known_address_or_address add with + | None -> false + | Some contract -> ( + match contract.ci_pool_contracts with + | None -> false + | Some _ -> true) + +>>>>>>> 6c46b4c (refactoring) let is_child_leaf child = match child with | Cft_leaf _ -> true | Cft_tree _ -> false let extract_string_address a = - match extract_contract_from_address a with + match contract_of_known_address_or_address a with | None -> ( match a with | Ca_native _ -> "ETH" @@ -440,7 +451,7 @@ let extract_string_address a = | Some s -> (s :> string)) let extract_string_real_address a = - match extract_contract_from_address a with + match contract_of_known_address_or_address a with | None -> ( match a with | Ca_native _ -> "ETH" -- GitLab From a8692bf5d44f99590eb8bd55c8c04a5c0e0c42a0 Mon Sep 17 00:00:00 2001 From: "adam.khayam" Date: Mon, 8 Sep 2025 14:51:25 +0200 Subject: [PATCH 3/6] renaming functions --- debug/graph/debug_graph.ml | 28 +-- src/ethereum_analysis/eth_graph.ml | 296 +++++++++++++++------------- src/ethereum_analysis/eth_graph.mli | 4 +- 3 files changed, 177 insertions(+), 151 deletions(-) diff --git a/debug/graph/debug_graph.ml b/debug/graph/debug_graph.ml index d1e26ab7..3b254534 100644 --- a/debug/graph/debug_graph.ml +++ b/debug/graph/debug_graph.ml @@ -92,7 +92,7 @@ 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 + normalize_token_value value address ^ " " ^ symbol_of_eth_address address let string_of_tokens_amount tokens_amount = List.fold_left @@ -114,7 +114,7 @@ let string_delta_new (delta_new : delta_map) = let string_of_addresses (addresses : Common.Types.Ethereum_analysis.addresses) = List.fold_left - (fun acc (_, address) -> acc ^ "\n" ^ extract_string_address address) + (fun acc (_, address) -> acc ^ "\n" ^ symbol_of_eth_address address) "" addresses let string_of_contract_type c_type = @@ -128,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 @@ -196,16 +196,16 @@ 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" @@ -228,9 +228,9 @@ module Dot = Graphviz.Dot (struct | Some s -> s) _erc | Cftt_chain chain -> - let _from = extract_string_address chain.resume.tc_origin in + let _from = symbol_of_eth_address chain.resume.tc_origin in let _middleman = string_of_addresses chain.resume.tc_middleman in - let _to = extract_string_address chain.resume.tc_destination in + let _to = symbol_of_eth_address chain.resume.tc_destination in let _ft_amount = string_of_token_amount chain.resume.tc_first_transfer.tka_amount chain.resume.tc_first_transfer.tka_asset in @@ -638,7 +638,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 @@ -698,11 +698,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/ethereum_analysis/eth_graph.ml b/src/ethereum_analysis/eth_graph.ml index 934f10b9..021cc2b2 100644 --- a/src/ethereum_analysis/eth_graph.ml +++ b/src/ethereum_analysis/eth_graph.ml @@ -5,13 +5,18 @@ 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 contract_of_known_address_or_address address = match address with @@ -24,7 +29,7 @@ let contract_of_known_address_or_address address = 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 -> ( @@ -42,10 +47,10 @@ let normalize_token_value v asset = match v with | Tv_value wad -> Format.sprintf "%.20f" - (amount_of_contract 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 @@ -83,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 -> ( @@ -97,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 -> ( @@ -108,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 @@ -162,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) @@ -181,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 -> ( @@ -195,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 @@ -225,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(" @@ -288,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; @@ -297,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; @@ -337,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 @@ -361,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 @@ -393,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) @@ -407,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) @@ -417,14 +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 +<<<<<<< HEAD <<<<<<< HEAD ======= let is_liquidation_pool add = +======= +let is_eth_address_a_liquidation_pool add = +>>>>>>> 85dadec (renaming functions) match contract_of_known_address_or_address add with | None -> false | Some contract -> ( @@ -432,13 +454,17 @@ let is_liquidation_pool add = | None -> false | Some _ -> true) +<<<<<<< HEAD >>>>>>> 6c46b4c (refactoring) let is_child_leaf child = +======= +let cft_is_leaf child = +>>>>>>> 85dadec (renaming functions) match child with | Cft_leaf _ -> true | Cft_tree _ -> false -let extract_string_address a = +let symbol_of_eth_address a = match contract_of_known_address_or_address a with | None -> ( match a with @@ -450,7 +476,7 @@ let extract_string_address a = | None -> (contract.ci_address :> string) | Some s -> (s :> string)) -let extract_string_real_address a = +let string_extract_address_from_contract_address a = match contract_of_known_address_or_address a with | None -> ( match a with @@ -489,13 +515,13 @@ let token_amount_of_transfer t = { tka_amount = t.ttn_amount; tka_asset = t.ttn_asset } let tokens_amount_of_transfer t = - [(extract_string_address t.ttn_asset, token_amount_of_transfer t)] + [(symbol_of_eth_address t.ttn_asset, token_amount_of_transfer t)] let addresses_of_address address addresses = - match List.assoc_opt (extract_string_address address) addresses with + match List.assoc_opt (symbol_of_eth_address address) addresses with | None -> List.sort (fun (a, _) (b, _) -> sort_address (Eth.a a) (Eth.a b)) - @@ ((extract_string_address address, address) :: addresses) + @@ ((symbol_of_eth_address address, address) :: addresses) | Some _ -> addresses let token_amount_add tk1 tk2 = @@ -518,7 +544,7 @@ let is_liquidation_pool add = let rec is_compatible to_ tree1 tree2 = let to_' = Option.map extract_address_from_contract_address - @@ Option.map wrap_address to_ in + @@ 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 @@ -1134,7 +1160,7 @@ let rec is_compatible to_ tree1 tree2 = = 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 + && is_eth_address_a_liquidation_pool t1.ttn_to then Some (Cftt_transfer t1, Cftt_transfer t2, `chain) else if @@ -1142,7 +1168,7 @@ let rec is_compatible to_ tree1 tree2 = = 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 + && is_eth_address_a_liquidation_pool t2.ttn_to then Some (Cftt_transfer t2, Cftt_transfer t1, `chain) else if @@ -1321,37 +1347,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; @@ -1360,10 +1386,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 @@ -1374,13 +1400,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 @@ -1388,29 +1414,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 -> @@ -1419,13 +1445,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 @@ -1699,7 +1725,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 @@ -1714,7 +1740,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 -> @@ -1791,7 +1817,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 -> @@ -2039,8 +2065,8 @@ 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 [address_of_token_amount chain'.resume.tc_first_transfer] @@ -2215,7 +2241,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 = @@ -2254,7 +2280,7 @@ 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 @@ -2292,14 +2318,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; @@ -2309,14 +2335,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 @@ -2329,13 +2355,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 @@ -2356,8 +2382,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 @@ -2436,15 +2462,15 @@ let rec find_compatible_cycle from_ to_ child children = if not (address_list_of_addresses chain1.resume.tc_middleman - = [extract_address from_] + = [address_of_known_address_or_address from_] || address_list_of_addresses chain2.resume.tc_middleman - = [extract_address from_]) + = [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 address_list_of_token_amount_list chain1.resume.tc_amount1 @@ -2570,8 +2596,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_extract_address_from_contract_address x.tka_asset + = string_extract_address_from_contract_address token1) deltas with | [] -> { tka_amount = Tv_value Z.zero; tka_asset = token1 } @@ -2588,8 +2614,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_extract_address_from_contract_address x.tka_asset + = string_extract_address_from_contract_address token2) deltas with | [] -> { tka_amount = Tv_value Z.zero; tka_asset = eth_address_eth_null } @@ -2613,11 +2639,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_extract_address_from_contract_address x.tka_asset + = string_extract_address_from_contract_address token1)) && not - (extract_string_real_address x.tka_asset - = extract_string_real_address token2)) + (string_extract_address_from_contract_address x.tka_asset + = string_extract_address_from_contract_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 eeac1253..83530c1d 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} *) -- GitLab From 2fa989df67f7597c481cd9706a5f1f228b9e4361 Mon Sep 17 00:00:00 2001 From: "adam.khayam" Date: Mon, 8 Sep 2025 15:35:36 +0200 Subject: [PATCH 4/6] renaming functions --- debug/graph/debug_graph.ml | 3 +- src/ethereum_analysis/eth_graph.ml | 363 +++++++++++++--------------- src/ethereum_analysis/eth_graph.mli | 2 +- 3 files changed, 171 insertions(+), 197 deletions(-) diff --git a/debug/graph/debug_graph.ml b/debug/graph/debug_graph.ml index 3b254534..020118ba 100644 --- a/debug/graph/debug_graph.ml +++ b/debug/graph/debug_graph.ml @@ -212,7 +212,8 @@ module Dot = Graphviz.Dot (struct | Some typ -> string_of_contract_type typ in let _amount = string_of_tokens_amount - [Eth_analysis.Eth_graph.token_amount_of_transfer tsfr] in + [Eth_analysis.Eth_graph.cft_transfer_node_of_token_amount tsfr] + in let _description = tsfr.ttn_description in Format.sprintf "from: %s\n\ diff --git a/src/ethereum_analysis/eth_graph.ml b/src/ethereum_analysis/eth_graph.ml index 021cc2b2..840ffd8d 100644 --- a/src/ethereum_analysis/eth_graph.ml +++ b/src/ethereum_analysis/eth_graph.ml @@ -440,26 +440,7 @@ let cft_of_debug_trace debug_trace = (External debug_trace.dt_tx_hash) in add_operator_info_in_cft None None r -<<<<<<< HEAD -<<<<<<< HEAD -======= -let is_liquidation_pool add = -======= -let is_eth_address_a_liquidation_pool add = ->>>>>>> 85dadec (renaming functions) - match contract_of_known_address_or_address add with - | None -> false - | Some contract -> ( - match contract.ci_pool_contracts with - | None -> false - | Some _ -> true) - -<<<<<<< HEAD ->>>>>>> 6c46b4c (refactoring) -let is_child_leaf child = -======= let cft_is_leaf child = ->>>>>>> 85dadec (renaming functions) match child with | Cft_leaf _ -> true | Cft_tree _ -> false @@ -476,7 +457,7 @@ let symbol_of_eth_address a = | None -> (contract.ci_address :> string) | Some s -> (s :> string)) -let string_extract_address_from_contract_address a = +let string_address_of_eth_address a = match contract_of_known_address_or_address a with | None -> ( match a with @@ -488,7 +469,7 @@ let string_extract_address_from_contract_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 @@ -496,54 +477,55 @@ let extract_address_from_contract_address ca = | Coadr_address address -> address) | Ca_native address -> address -let sort_address (a : Eth.address) (b : Eth.address) = +let address_compare (a : Eth.address) (b : Eth.address) = String.compare (a :> string) (b :> string) let address_list_of_addresses (a : addresses) = - List.sort sort_address - @@ List.map (fun (_, a) -> extract_address_from_contract_address a) a + List.sort address_compare + @@ List.map (fun (_, a) -> address_of_eth_address a) a let address_of_token_amount (tka : token_amount) = - extract_address_from_contract_address tka.tka_asset + address_of_eth_address tka.tka_asset let address_list_of_token_amount_list (tal : (string * token_amount) List.t) = - List.sort sort_address + List.sort address_compare (address_list_of_addresses @@ List.map (fun (a, tka) -> (a, tka.tka_asset)) tal) -let token_amount_of_transfer t = +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, token_amount_of_transfer t)] + [(symbol_of_eth_address t.ttn_asset, cft_transfer_node_of_token_amount t)] -let addresses_of_address address addresses = +let addresses_of_eth_address address addresses = match List.assoc_opt (symbol_of_eth_address address) addresses with | None -> - List.sort (fun (a, _) (b, _) -> sort_address (Eth.a a) (Eth.a b)) + List.sort (fun (a, _) (b, _) -> address_compare (Eth.a a) (Eth.a b)) @@ ((symbol_of_eth_address address, address) :: addresses) | Some _ -> addresses -let token_amount_add tk1 tk2 = +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_liquidation_pool add = - match extract_contract_from_address add with - | None -> - extract_address_from_contract_address add + +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" | 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 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 -> ( @@ -551,8 +533,8 @@ let rec is_compatible to_ tree1 tree2 = | ( 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 -> @@ -612,8 +594,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 @@ -631,8 +613,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 @@ -650,8 +632,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 @@ -669,8 +651,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 @@ -688,8 +670,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 @@ -707,8 +689,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 @@ -726,8 +708,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 @@ -745,18 +727,17 @@ 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 @@ -818,8 +799,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 @@ -837,8 +818,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 @@ -856,8 +837,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 @@ -875,8 +856,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 @@ -894,8 +875,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 @@ -913,8 +894,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 @@ -932,18 +913,17 @@ 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 @@ -1005,8 +985,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 @@ -1024,13 +1004,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, `liquidationBurn) 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 then Some (Cftt_transfer t1, Cftt_transfer t2, `liquidationBurn) else @@ -1048,13 +1028,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 extract_address_from_contract_address t1.ttn_to = - extract_address_from_contract_address t2.ttn_from then Some - (Cftt_transfer t1, Cftt_transfer t2, `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 @@ -1070,13 +1050,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 extract_address_from_contract_address t2.ttn_to = - extract_address_from_contract_address t1.ttn_from then Some - (Cftt_transfer t2, Cftt_transfer t1, `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 @@ -1092,8 +1072,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 @@ -1111,8 +1091,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 @@ -1130,8 +1110,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 @@ -1149,41 +1129,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 + 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 + 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 @@ -1191,14 +1167,14 @@ 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 *) @@ -1208,8 +1184,8 @@ let rec is_compatible to_ tree1 tree2 = 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 *) @@ -1219,15 +1195,15 @@ let rec is_compatible to_ tree1 tree2 = 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 then @@ -1235,24 +1211,22 @@ let rec is_compatible to_ tree1 tree2 = 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 - )) + (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 @@ -1264,8 +1238,8 @@ let rec is_compatible to_ tree1 tree2 = None | true, false -> if - extract_address_from_contract_address c1.resume.tc_destination - = extract_address_from_contract_address c2.resume.tc_origin + 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]) @@ -1275,8 +1249,8 @@ let rec is_compatible to_ tree1 tree2 = 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 (address_list_of_token_amount_list c2.resume.tc_amount1 = [address_of_token_amount c1.resume.tc_first_transfer]) @@ -1286,26 +1260,26 @@ let rec is_compatible to_ tree1 tree2 = None | false, false -> if - extract_address_from_contract_address c1.resume.tc_destination - = extract_address_from_contract_address c2.resume.tc_origin + 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 + 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 + 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 @@ -1313,14 +1287,13 @@ let rec is_compatible to_ tree1 tree2 = 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 - )) + (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 @@ -1504,12 +1477,12 @@ let merge_children t1 t2 signal = let resume = { tc_origin = t1.ttn_from; - tc_middleman = addresses_of_address t1.ttn_to []; + tc_middleman = addresses_of_eth_address t1.ttn_to []; tc_destination = t2.ttn_to; tc_amount0 = tokens_amount_of_transfer t1; tc_amount1 = tokens_amount_of_transfer t2; tc_construction = `chaining; - tc_first_transfer = token_amount_of_transfer t1; + tc_first_transfer = cft_transfer_node_of_token_amount t1; tc_delta = update_delta_transfer_to t2 @@ update_delta_transfer_from t2 @@ -1528,12 +1501,12 @@ let merge_children t1 t2 signal = let resume = { tc_origin = t1.ttn_from; - tc_middleman = addresses_of_address t1.ttn_to []; + tc_middleman = addresses_of_eth_address t1.ttn_to []; tc_destination = t2.ttn_to; tc_amount0 = tokens_amount_of_transfer t1; tc_amount1 = tokens_amount_of_transfer t2; tc_construction = `liquidation_burn; - tc_first_transfer = token_amount_of_transfer t1; + tc_first_transfer = cft_transfer_node_of_token_amount t1; tc_delta = update_delta_transfer_to t2 @@ update_delta_transfer_from t2 @@ -1552,12 +1525,12 @@ let merge_children t1 t2 signal = let resume = { tc_origin = t1.ttn_from; - tc_middleman = addresses_of_address t1.ttn_to []; + tc_middleman = addresses_of_eth_address t1.ttn_to []; tc_destination = t2.ttn_to; tc_amount0 = tokens_amount_of_transfer t1; tc_amount1 = tokens_amount_of_transfer t2; tc_construction = `liquidation_mint; - tc_first_transfer = token_amount_of_transfer t1; + tc_first_transfer = cft_transfer_node_of_token_amount t1; tc_delta = update_delta_transfer_to t2 @@ update_delta_transfer_from t2 @@ -1581,7 +1554,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 = token_amount_of_transfer t1; + 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; @@ -1599,7 +1572,7 @@ let merge_children t1 t2 signal = let resume = { tc_origin = c1.resume.tc_origin; - tc_middleman = addresses_of_address 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 = tokens_amount_of_transfer t2; @@ -1645,14 +1618,14 @@ let merge_children t1 t2 signal = tc_origin = c1.resume.tc_origin; tc_middleman = List.fold_left - (fun acc (_, ac2) -> addresses_of_address ac2 acc) + (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 = 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 = - token_amount_add 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 @@ -1671,14 +1644,14 @@ let merge_children t1 t2 signal = tc_origin = c1.resume.tc_origin; tc_middleman = List.fold_left - (fun acc (_, ac2) -> addresses_of_address ac2 acc) + (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 = 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 = - token_amount_add 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 @@ -1698,7 +1671,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' @@ -1830,12 +1803,12 @@ let merge_debries c1 c2 _signal = let resume = { tc_origin = t1.ttn_from; - tc_middleman = addresses_of_address t1.ttn_to []; + tc_middleman = addresses_of_eth_address t1.ttn_to []; tc_destination = t2.ttn_to; tc_amount0 = tokens_amount_of_transfer t1; tc_amount1 = tokens_amount_of_transfer t2; tc_construction = `chaining; - tc_first_transfer = token_amount_of_transfer t1; + tc_first_transfer = cft_transfer_node_of_token_amount t1; tc_delta = update_delta_transfer_to t2 @@ update_delta_transfer_from t2 @@ -1859,7 +1832,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 = token_amount_of_transfer t1; + 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; @@ -1872,7 +1845,7 @@ let merge_debries c1 c2 _signal = let resume = { tc_origin = c1'.resume.tc_origin; - tc_middleman = addresses_of_address 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 = tokens_amount_of_transfer t2; @@ -1892,7 +1865,7 @@ let merge_debries c1 c2 _signal = tc_origin = c1'.resume.tc_origin; tc_middleman = List.fold_left - (fun acc (_, ac2) -> addresses_of_address ac2 acc) + (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 = @@ -1901,7 +1874,7 @@ let merge_debries c1 c2 _signal = merge_token_list c1'.resume.tc_amount1 c2'.resume.tc_amount1; tc_construction = `merging; tc_first_transfer = - token_amount_add 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 @@ -1927,12 +1900,12 @@ let is_compatible_debrie _to cft1 cft2 = if c1.resume.tc_destination = t2.ttn_from && address_list_of_token_amount_list c1.resume.tc_amount1 - = [extract_address_from_contract_address t2.ttn_asset] + = [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 - && [extract_address_from_contract_address t2.ttn_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) @@ -1942,14 +1915,14 @@ let is_compatible_debrie _to cft1 cft2 = Cftn_transfer_chain (Cftt_chain c2) ) -> if t1.ttn_to = c2.resume.tc_origin - && [extract_address_from_contract_address t1.ttn_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 && address_list_of_token_amount_list c2.resume.tc_amount1 - = [extract_address_from_contract_address t1.ttn_asset] + = [address_of_eth_address t1.ttn_asset] then Some (Cftt_chain c2, Cftt_transfer t1, `chain) else @@ -2013,8 +1986,8 @@ 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 @@ -2044,11 +2017,11 @@ let same_tokens (assets1 : address list) (assets2 : address list) = 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_) + List.mem (address_of_known_address_or_address from_) @@ address_list_of_addresses chain.resume.tc_middleman with | false -> @@ -2596,8 +2569,8 @@ let squash_token_into_token deltas token1 token2 = match List.filter (fun x -> - string_extract_address_from_contract_address x.tka_asset - = string_extract_address_from_contract_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 } @@ -2614,8 +2587,8 @@ let squash_token_into_token deltas token1 token2 = match List.filter (fun x -> - string_extract_address_from_contract_address x.tka_asset - = string_extract_address_from_contract_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 } @@ -2639,11 +2612,11 @@ let squash_token_into_token deltas token1 token2 = List.filter (fun x -> (not - (string_extract_address_from_contract_address x.tka_asset - = string_extract_address_from_contract_address token1)) + (string_address_of_eth_address x.tka_asset + = string_address_of_eth_address token1)) && not - (string_extract_address_from_contract_address x.tka_asset - = string_extract_address_from_contract_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 83530c1d..c5339cc4 100644 --- a/src/ethereum_analysis/eth_graph.mli +++ b/src/ethereum_analysis/eth_graph.mli @@ -163,6 +163,6 @@ val arbitrage_cft : Common.Types.Ethereum_analysis.cft_input -> Common.Types.Ethereum_analysis.cft_arbitrage_output -val token_amount_of_transfer : +val cft_transfer_node_of_token_amount : Common.Types.Ethereum_analysis.cft_transfer_node -> Common.Types.Ethereum_analysis.token_amount -- GitLab From 7f847258922fb5013637a172958302ac3cb745e5 Mon Sep 17 00:00:00 2001 From: "adam.khayam" Date: Tue, 9 Sep 2025 15:57:59 +0200 Subject: [PATCH 5/6] lint --- src/ethereum_analysis/eth_graph.ml | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/ethereum_analysis/eth_graph.ml b/src/ethereum_analysis/eth_graph.ml index 840ffd8d..66c6fb51 100644 --- a/src/ethereum_analysis/eth_graph.ml +++ b/src/ethereum_analysis/eth_graph.ml @@ -512,11 +512,10 @@ let add_token_amount tk1 tk2 = 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 + | None -> + address_of_eth_address add = Eth.a @@ String.lowercase_ascii "000000000004444c5dc75cB358380D2e3dE08A90" | Some contract -> ( match contract.ci_pool_contracts with @@ -2042,8 +2041,9 @@ let rec annotate_cycle from_ chain = != symbol_of_eth_address chain2.resume.tc_origin then if - same_tokens [address_of_token_amount chain'.resume.tc_first_transfer] - @@ address_list_of_token_amount_list chain'.resume.tc_amount1 + 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 } @@ -2053,8 +2053,9 @@ let rec annotate_cycle from_ chain = chain'.resume | _ -> if - same_tokens [address_of_token_amount chain'.resume.tc_first_transfer] - @@ address_list_of_token_amount_list chain'.resume.tc_amount1 + 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 } @@ -2389,8 +2390,7 @@ let merge_cycles from_ cycle1 cycle2 = tc_construction = (if address_list_of_token_amount_list chain2.resume.tc_amount1 - = [address_of_token_amount - chain1.resume.tc_first_transfer] + = [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 -- GitLab From a50654090d038611e02ab0ebdab5174cdf17a839 Mon Sep 17 00:00:00 2001 From: "adam.khayam" Date: Thu, 11 Sep 2025 09:59:12 +0200 Subject: [PATCH 6/6] small fix --- src/ethereum_analysis/eth_graph.ml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/ethereum_analysis/eth_graph.ml b/src/ethereum_analysis/eth_graph.ml index 66c6fb51..1702130f 100644 --- a/src/ethereum_analysis/eth_graph.ml +++ b/src/ethereum_analysis/eth_graph.ml @@ -517,6 +517,9 @@ let is_eth_address_a_liquidation_pool add = | 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 @@ -1205,6 +1208,7 @@ let rec cft_trees_compatible_for_merge to_ tree1 tree2 = = 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 -- GitLab