This commit is contained in:
silva guimaraes 2025-07-21 17:44:16 -03:00
parent 53a566d37a
commit 116ed0068b
5 changed files with 729 additions and 43 deletions

View file

@ -2,7 +2,6 @@ open Ppx_yojson_conv_lib.Yojson_conv.Primitives
open Printf
open Lwt.Infix
type api_status = {
code : int;
description : string;
@ -10,8 +9,13 @@ type api_status = {
}
[@@deriving yojson, show]
type api_country = { alpha2 : string; alpha3 : string; name : string }
[@@yojson.allow_extra_fields] [@@deriving yojson, show]
type api_country = {
alpha2 : string;
alpha3 : string;
name : string;
slug : string;
}
[@@deriving yojson, show]
type api_team_colors = { primary : string; secondary : string; text : string }
[@@deriving yojson, show]
@ -19,23 +23,27 @@ type api_team_colors = { primary : string; secondary : string; text : string }
type api_team = {
id : int;
name : string;
short_name : string option; [@key "shortName"] [@yojson.option]
shortName : string option; [@yojson.option]
gender : string;
teamColors : api_team_colors;
country : api_country;
}
[@@yojson.allow_extra_fields] [@@deriving yojson, show]
let team_name x = match x.short_name with Some x -> x | None -> x.name
let team_name x = match x.shortName with Some x -> x | None -> x.name
type api_tournament_info = { name : string; slug : string }
type api_tournament = {
name : string;
slug : string;
country : api_country option; [@yojson.option]
}
[@@yojson.allow_extra_fields] [@@deriving yojson, show]
type api_score = {
current : int [@default 0];
period1 : int [@default 0];
period2 : int [@default 0];
normaltime : int [@default 0];
current : int; [@default 0]
period1 : int; [@default 0]
period2 : int; [@default 0]
normaltime : int; [@default 0]
}
[@@yojson.allow_extra_fields] [@@deriving yojson, show]
@ -47,7 +55,7 @@ type api_time = {
[@@yojson.allow_extra_fields] [@@deriving yojson, show]
type api_match = {
tournament : api_tournament_info;
tournament : api_tournament;
homeTeam : api_team;
awayTeam : api_team;
homeScore : api_score;
@ -62,15 +70,88 @@ type api_events = { events : api_match list }
[@@yojson.allow_extra_fields] [@@deriving yojson, show]
type half =
| FirstHalf of { injury_time1 : int option; period_start_timestamp : int }
| HalfTime of { injury_time1 : int option }
| SecondHalf of {
| First_Half of { injury_time1 : int option; period_start_timestamp : int }
| Half_Time of { injury_time1 : int option }
| Second_Half of {
injury_time1 : int option;
injury_time2 : int option;
period_start_timestamp : int;
}
| First_Extra of {
injury_time1 : int option;
injury_time2 : int option;
period_start_timestamp : int;
}
| Extra_Time_Half_Time of {
injury_time1 : int option;
injury_time2 : int option;
}
| Second_Extra of {
injury_time1 : int option;
injury_time2 : int option;
period_start_timestamp : int;
}
| Extra_Time_Await
| Penalties
[@@deriving show]
type api_standing_rows = {
team : api_team;
position : int;
matches : int;
points : int;
wins : int option; [@yojon.option] [@default None]
scoresFor : int option; [@yojon.option] [@default None]
scoresAgainst : int option; [@yojon.option] [@default None]
losses : int option; [@yojon.option] [@default None]
draws : int option; [@yojon.option] [@default None]
pointsPerGame : float option; [@yojon.option] [@default None]
pointsPrevPrevSeason : int option; [@yojon.option] [@default None]
pointsPrevSeason : int option; [@yojon.option] [@default None]
pointsCurrSeason : int option; [@yojon.option] [@default None]
}
[@@yojson.allow_extra_fields] [@@deriving yojson, show]
type api_standing = {
name : string;
rows : api_standing_rows list;
updatedAtTimestamp : int;
}
[@@yojson.allow_extra_fields] [@@deriving yojson, show]
type api_standings_total = { standings : api_standing list }
[@@deriving yojson, show]
type normal_table_row = {
team : api_team;
position : int;
matches : int;
points : int;
wins : int;
scoresFor : int;
scoresAgainst : int;
losses : int;
draws : int;
}
type promedios_table_row = {
team : api_team;
position : int;
matches : int;
points : int;
pointsPerGame : float;
pointsPrevPrevSeason : int;
pointsPrevSeason : int;
pointsCurrSeason : int;
}
type table_rows =
| Normal of normal_table_row list
| Promedios of promedios_table_row list
type table = { name : string; rows : table_rows }
(* TODO penalties *)
type score = { home_score : int; away_score : int } [@@deriving show]
type status =
@ -98,7 +179,7 @@ type tournament_scrape_context = {
let mmod a b = ((a mod b) + b) mod b
let is_conmebol x =
let is_conmebol (x : api_team) =
match x.country.alpha2 with
| "AR" | "BO" | "BR" | "CL" | "CO" | "EC" | "PY" | "PE" | "UY" | "VE" -> true
| _ -> false
@ -173,7 +254,7 @@ let get url =
let req_headers =
Cohttp.Header.(
add (init ()) "X-Captcha"
"eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJleHAiOjE3NTI4MjkzNzd9.TL1wEObA1UEKHuK7X954DHByN7_2_Mm1MW25ywqe-Z8")
"eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJleHAiOjE3NTI4NjM5MjV9.Zv5y-Ba5Kck1JPV2xTBgcfhX0YGhKq-ShTQEGAKG8Uw")
in
let* resp, body =
Cohttp_lwt_unix.Client.get ~headers:req_headers @@ Uri.of_string url
@ -186,9 +267,44 @@ let get url =
else Lwt.return @@ Error (Cohttp.Code.reason_phrase_of_code code)
in
let* result = http_get url in
match result with
| Error str -> failwith str
| Ok r -> Lwt.return r
match result with Error str -> failwith str | Ok r -> Lwt.return r
let tables_of_api_standings_total (s : api_standings_total) : table list =
let must_some = function None -> failwith "impossible" | Some x -> x in
let table_of_api_standing (x : api_standing) =
let row = List.nth x.rows 0 in
match row.wins with
| Some _ ->
let of_normal (x : api_standing_rows) =
{
team = x.team;
position = x.position;
matches = x.matches;
points = x.points;
wins = must_some x.wins;
scoresFor = must_some x.scoresFor;
scoresAgainst = must_some x.scoresAgainst;
losses = must_some x.losses;
draws = must_some x.draws;
}
in
{ name = x.name; rows = Normal (List.map of_normal x.rows) }
| None ->
let of_promedios (x : api_standing_rows) =
{
team = x.team;
position = x.position;
matches = x.matches;
points = x.points;
pointsPerGame = must_some x.pointsPerGame;
pointsPrevPrevSeason = must_some x.pointsPrevPrevSeason;
pointsPrevSeason = must_some x.pointsPrevSeason;
pointsCurrSeason = must_some x.pointsCurrSeason;
}
in
{ name = x.name; rows = Promedios (List.map of_promedios x.rows) }
in
List.map table_of_api_standing s.standings
let matches_of_api_events (e : api_events) =
e.events
@ -208,7 +324,7 @@ let matches_of_api_events (e : api_events) =
InProgress
{
start_timestamp = m.startTimestamp;
half = HalfTime { injury_time1 = x };
half = Half_Time { injury_time1 = x };
score =
{
home_score = m.homeScore.current;
@ -226,7 +342,7 @@ let matches_of_api_events (e : api_events) =
{
start_timestamp = m.startTimestamp;
half =
FirstHalf
First_Half
{ injury_time1 = x; period_start_timestamp = z };
score =
{
@ -245,7 +361,7 @@ let matches_of_api_events (e : api_events) =
{
start_timestamp = m.startTimestamp;
half =
SecondHalf
Second_Half
{
injury_time1 = x;
injury_time2 = y;
@ -257,6 +373,105 @@ let matches_of_api_events (e : api_events) =
away_score = m.awayScore.current;
};
}
| ( "1st extra",
"inprogress",
{
injuryTime1 = x;
injuryTime2 = y;
currentPeriodStartTimestamp = Some z;
} ) ->
InProgress
{
start_timestamp = m.startTimestamp;
half =
First_Extra
{
injury_time1 = x;
injury_time2 = y;
period_start_timestamp = z;
};
score =
{
home_score = m.homeScore.current;
away_score = m.awayScore.current;
};
}
| ( "Extra time halftime",
"inprogress",
{
injuryTime1 = x;
injuryTime2 = y;
currentPeriodStartTimestamp = _;
} ) ->
InProgress
{
start_timestamp = m.startTimestamp;
half =
Extra_Time_Half_Time
{ injury_time1 = x; injury_time2 = y };
score =
{
home_score = m.homeScore.current;
away_score = m.awayScore.current;
};
}
| ( "2nd extra",
"inprogress",
{
injuryTime1 = x;
injuryTime2 = y;
currentPeriodStartTimestamp = Some z;
} ) ->
InProgress
{
start_timestamp = m.startTimestamp;
half =
Second_Extra
{
injury_time1 = x;
injury_time2 = y;
period_start_timestamp = z;
};
score =
{
home_score = m.homeScore.current;
away_score = m.awayScore.current;
};
}
| ( "Penalties",
"inprogress",
{
injuryTime1 = _;
injuryTime2 = _;
currentPeriodStartTimestamp = _;
} ) ->
InProgress
{
start_timestamp = m.startTimestamp;
half = Penalties;
score =
{
home_score = m.homeScore.current;
away_score = m.awayScore.current;
};
}
| ( "Awaiting extra time",
"inprogress",
{
injuryTime1 = _;
injuryTime2 = _;
currentPeriodStartTimestamp = _;
} ) ->
InProgress
{
start_timestamp = m.startTimestamp;
half = Extra_Time_Await;
score =
{
home_score = m.homeScore.normaltime;
away_score = m.awayScore.normaltime;
};
}
| "AP", "finished", _
| "AET", "finished", _
| "Ended", "finished", _ ->
@ -281,30 +496,39 @@ let matches_of_api_events (e : api_events) =
(show_api_time m.time));
})
let fetch_matches ctx =
let g order (* "last" for previous matches "next" for future matches *) =
try%lwt
let url =
sprintf
(* TLS fingerprinting is in place and it's been used to block our requests once
let fetch ctx order (* "last" for previous matches "next" for future matches *)
=
try%lwt
let url =
sprintf
(* TLS fingerprinting is in place and it's been used to block our requests once
their systems detect we've been abusing their private API.
TLS handshakes can only happen with secure connections using
HTTPS, so using plain HTTP makes it impossible for that to happen,
which they do generously accept. *)
"http://www.sofascore.com/api/v1/unique-tournament/%d/season/%d/events/%s/0"
ctx.id ctx.season order
in
"http://www.sofascore.com/api/v1/unique-tournament/%d/season/%d/events/%s/0"
ctx.id ctx.season
(match order with `Last -> "last" | `Next -> "next")
in
get url >|= Yojson.Safe.from_string >|= api_events_of_yojson
>|= matches_of_api_events
with
| Status_Not_found -> Lwt.return []
| Ppx_yojson_conv_lib__Yojson_conv.Of_yojson_error (exn, _) -> raise exn
get url >|= Yojson.Safe.from_string >|= api_events_of_yojson >|= matches_of_api_events
with
| Status_Not_found -> Lwt.return []
| Ppx_yojson_conv_lib__Yojson_conv.Of_yojson_error (exn, _) ->
failwith @@ Printexc.to_string exn
in
let* last = g "last" in
let* next = g "next" in
let fetch_all_matches ctx =
let* last = fetch ctx `Last in
let* next = fetch ctx `Next in
Lwt.return @@ Tournament.make ctx @@ List.append last next
let fetch_all tournaments =
tournaments |> List.map fetch_matches |> Lwt.all
let fetch_all_tournaments tournaments =
tournaments |> List.map fetch_all_matches |> Lwt.all
let standings context =
let url =
sprintf
"https://www.sofascore.com/api/v1/unique-tournament/%d/season/%d/standings/total"
context.id context.season
in
get url >|= Yojson.Safe.from_string >|= api_standings_total_of_yojson
>|= tables_of_api_standings_total