open Ppx_yojson_conv_lib.Yojson_conv.Primitives open Printf open Lwt.Infix type api_status = { code : int; description : string; typ : string; [@key "type"] } [@@deriving yojson, show] type api_country = { alpha2 : string; alpha3 : string; name : string; slug : string; } [@@yojson.allow_extra_fields] [@@deriving yojson, show] type api_team_colors = { primary : string; secondary : string; text : string } [@@deriving yojson, show] type api_team = { id : int; name : string; 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.shortName with Some x -> x | None -> x.name 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] } [@@yojson.allow_extra_fields] [@@deriving yojson, show] type api_time = { injuryTime1 : int option; [@yojson.option] injuryTime2 : int option; [@yojson.option] currentPeriodStartTimestamp : int option; [@yojson.option] } [@@yojson.allow_extra_fields] [@@deriving yojson, show] type api_match = { tournament : api_tournament; homeTeam : api_team; awayTeam : api_team; homeScore : api_score; awayScore : api_score; status : api_status; time : api_time; id : int; startTimestamp : int; } [@@yojson.allow_extra_fields] [@@deriving yojson, show] type api_events = { events : api_match list } [@@yojson.allow_extra_fields] [@@deriving yojson, show] type half = | 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 api_short_match = { winnerCode : int } [@@deriving yojson] (* type api_team_events_table = (string * api_short_match list) Hashtbl.t *) (* [@@deriving yojson] *) (**) (* type api_team_events_total = { *) (* tournamentTeamEvents : (string, api_team_events_table) Hashtbl.t *) (* } *) (* [@@deriving yojson] *) type match_info = { tournament : string } [@@deriving yojson] (* type inner_map = (string, match_info list) Hashtbl.t *) (* [@@deriving yojson] *) (**) (* type outer_map = (string, inner_map) Hashtbl.t *) (* [@@deriving yojson] *) 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 = | NotStarted of { start_timestamp : int } | Suspended of { start_timestamp : int } | Postponed | Canceled | Delayed | InProgress of { score : score; start_timestamp : int; half : half } | Completed of { score : score; start_timestamp : int } [@@deriving show] (* TODO: round info *) type match' = { status : status; home_team : api_team; away_team : api_team; api_id : int; } [@@deriving show] type tournament_scrape_context = { id : int; season : int; name : string; emoji : string; filter_foreigners : bool; timezone_offset : int option (* assumes UTC-3 if None *); } [@@deriving show] let mmod a b = ((a mod b) + b) mod b let is_conmebol (x : api_team) = match x.country.alpha2 with | "AR" | "BO" | "BR" | "CL" | "CO" | "EC" | "PY" | "PE" | "UY" | "VE" -> true | _ -> false module Tournament = struct type t = { context : tournament_scrape_context; matches : match' list } let make context matches = { context; matches } let matches { matches; _ } = matches let pp (day : Unix.tm) (tournament : t) = let format_timestamp x = let is_today start = let t = start |> float_of_int |> Unix.localtime in t.tm_mday = day.tm_mday && t.tm_mon = day.tm_mon in let important_match = is_conmebol x.home_team || is_conmebol x.away_team in if tournament.context.filter_foreigners && not important_match then None else let timestamp = match x.status with | Postponed | Completed _ | Canceled -> None | Delayed -> Some "delayed... " | Suspended t -> if is_today t.start_timestamp then Some "SUS! " else None | InProgress t -> if is_today t.start_timestamp then Some "NOW! " else None | NotStarted t -> ( if not (is_today t.start_timestamp) then None else let ts1 = t.start_timestamp |> float_of_int |> Unix.localtime in match tournament.context.timezone_offset with | None -> Some (sprintf "%02d:%02d" ts1.tm_hour ts1.tm_min) | Some off -> let ts2 = t.start_timestamp |> float_of_int |> Unix.gmtime in Some (sprintf "%02d:%02d/%02d:%02d" ts1.tm_hour ts1.tm_min (mmod (ts2.tm_hour + off) 24) ts2.tm_min)) in match timestamp with | None -> None | Some timestamp -> Some (sprintf "%s | %s x %s" timestamp (team_name x.home_team) (team_name x.away_team)) in let m = tournament.matches |> List.filter_map format_timestamp |> String.concat "\n" in if m = "" then "" else match tournament.context.timezone_offset with | None -> sprintf ">%s\n%s" tournament.context.name m | Some off -> sprintf ">%s (UTC%d)\n%s" tournament.context.name off m end let ( let* ) = Lwt.bind exception Status_Not_found (* TODO: handle "resolution failed: name resolution failed" *) let get url = let http_get url = Stdlib.flush Stdlib.stdout; let req_headers = Cohttp.Header.( add (init ()) "X-Captcha" "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJleHAiOjE3NTQzMTc2MTJ9.sMoqrrTQMoq1JJRJqn-pbOtPIOlOfh5gjrniyUKX_04") in let* resp, body = Cohttp_lwt_unix.Client.get ~headers:req_headers @@ Uri.of_string url in let code = resp |> Cohttp.Response.status |> Cohttp.Code.code_of_status in if code = 404 then raise Status_Not_found else if Cohttp.Code.is_success code then let* b = Cohttp_lwt.Body.to_string body in Lwt.return (Ok b) 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 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 |> List.map (fun (m : api_match) -> let period_start_timestamp = match m.time with | { currentPeriodStartTimestamp = Some x; injuryTime1 = _; injuryTime2 = _; } -> x | { currentPeriodStartTimestamp = None; injuryTime1 = _; injuryTime2 = _; } -> m.startTimestamp in { api_id = m.id; home_team = m.homeTeam; away_team = m.awayTeam; status = (match (m.status.description, m.status.typ, m.time) with | ( "Halftime", "inprogress", { injuryTime1 = x; injuryTime2 = _; currentPeriodStartTimestamp = _; } ) -> InProgress { start_timestamp = m.startTimestamp; half = Half_Time { injury_time1 = x }; score = { home_score = m.homeScore.current; away_score = m.awayScore.current; }; } | ( "1st half", "inprogress", { injuryTime1 = x; injuryTime2 = None; currentPeriodStartTimestamp = _; } ) -> InProgress { start_timestamp = m.startTimestamp; half = First_Half { injury_time1 = x; period_start_timestamp }; score = { home_score = m.homeScore.current; away_score = m.awayScore.current; }; } | ( "2nd half", "inprogress", { injuryTime1 = x; injuryTime2 = y; currentPeriodStartTimestamp = _; } ) -> InProgress { start_timestamp = m.startTimestamp; half = Second_Half { injury_time1 = x; injury_time2 = y; period_start_timestamp; }; score = { home_score = m.homeScore.current; away_score = m.awayScore.current; }; } | ( "1st extra", "inprogress", { injuryTime1 = x; injuryTime2 = y; currentPeriodStartTimestamp = _; } ) -> InProgress { start_timestamp = m.startTimestamp; half = First_Extra { injury_time1 = x; injury_time2 = y; period_start_timestamp; }; 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 = _; } ) -> InProgress { start_timestamp = m.startTimestamp; half = Second_Extra { injury_time1 = x; injury_time2 = y; period_start_timestamp; }; score = { home_score = m.homeScore.current; away_score = m.awayScore.current; }; } | ( "Awaiting penalties", "inprogress", { injuryTime1 = _; injuryTime2 = _; currentPeriodStartTimestamp = _; } ) -> InProgress { start_timestamp = m.startTimestamp; half = Penalties; 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", _ -> Completed { start_timestamp = m.startTimestamp; score = { home_score = m.homeScore.current; away_score = m.awayScore.current; }; } | _, "notstarted", _ -> NotStarted { start_timestamp = m.startTimestamp } | _, "canceled", _ -> Canceled | _, "postponed", _ -> Postponed | _, "suspended", _ -> Suspended { start_timestamp = m.startTimestamp } | _, "delayed", _ -> Delayed | a, b, _ -> failwith @@ Printf.sprintf "impossible: %s %s %s" a b (show_api_time m.time)); }) (* https://www.sofascore.com/api/v1/unique-tournament/480/season/70070/rounds *) (* https://www.sofascore.com/api/v1/unique-tournament/480/season/70070/events/round/636/slug/playoff-round *) 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 (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 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 = tournaments |> List.map fetch_all_matches |> Lwt.all let fetch_match_details id = let url = sprintf "https://www.sofascore.com/api/v1/event/%d" id in get url >|= Yojson.Safe.from_string 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 (* let last_five_matches context = *) (* let url = *) (* sprintf "https://www.sofascore.com/api/v1/unique-tournament/%d/season/%d/team-events/total" *) (* context.id context.season *) (* in *) (* (* get url >|= Yojson.Safe.from_string >|= *) *) (* ;; *)