(** Sliding Sync (MSC3575) - Efficient sync protocol.

    Sliding sync is a more efficient alternative to the traditional /sync
    endpoint, designed for clients with many rooms. *)

(** Room subscription mode *)
type room_subscription = {
  required_state : (string * string) list;  (* event_type, state_key pairs *)
  timeline_limit : int option;
  include_old_rooms : bool option;
}

let state_pair_list_jsont =
  (* Decode array of [event_type, state_key] pairs *)
  Jsont.list (Jsont.list Jsont.string)
  |> Jsont.map
       ~dec:(fun pairs ->
         List.filter_map (function
           | [et; sk] -> Some (et, sk)
           | _ -> None) pairs)
       ~enc:(fun pairs ->
         List.map (fun (et, sk) -> [et; sk]) pairs)

let room_subscription_jsont =
  Jsont.Object.(
    map (fun required_state timeline_limit include_old_rooms ->
      { required_state; timeline_limit; include_old_rooms })
    |> mem "required_state" state_pair_list_jsont ~dec_absent:[]
         ~enc:(fun t -> t.required_state)
    |> opt_mem "timeline_limit" Jsont.int ~enc:(fun t -> t.timeline_limit)
    |> opt_mem "include_old_rooms" Jsont.bool ~enc:(fun t -> t.include_old_rooms)
    |> finish)

(** List operation for sliding window *)
type list_op =
  | Sync of int * int  (* start, end - request this range *)
  | Insert of int * string  (* index, room_id *)
  | Delete of int  (* index *)
  | Invalidate of int * int  (* start, end *)

(** Sliding sync list configuration *)
type list_config = {
  ranges : (int * int) list;
  sort : string list option;
  required_state : (string * string) list;
  timeline_limit : int option;
  filters : list_filters option;
  bump_event_types : string list option;
}

and list_filters = {
  is_dm : bool option;
  spaces : string list option;
  is_encrypted : bool option;
  is_invite : bool option;
  room_types : string list option;
  not_room_types : string list option;
  room_name_like : string option;
  tags : string list option;
  not_tags : string list option;
}

let list_filters_jsont =
  Jsont.Object.(
    map (fun is_dm spaces is_encrypted is_invite room_types not_room_types
             room_name_like tags not_tags ->
      { is_dm; spaces; is_encrypted; is_invite; room_types; not_room_types;
        room_name_like; tags; not_tags })
    |> opt_mem "is_dm" Jsont.bool ~enc:(fun t -> t.is_dm)
    |> opt_mem "spaces" (Jsont.list Jsont.string) ~enc:(fun t -> t.spaces)
    |> opt_mem "is_encrypted" Jsont.bool ~enc:(fun t -> t.is_encrypted)
    |> opt_mem "is_invite" Jsont.bool ~enc:(fun t -> t.is_invite)
    |> opt_mem "room_types" (Jsont.list Jsont.string) ~enc:(fun t -> t.room_types)
    |> opt_mem "not_room_types" (Jsont.list Jsont.string) ~enc:(fun t -> t.not_room_types)
    |> opt_mem "room_name_like" Jsont.string ~enc:(fun t -> t.room_name_like)
    |> opt_mem "tags" (Jsont.list Jsont.string) ~enc:(fun t -> t.tags)
    |> opt_mem "not_tags" (Jsont.list Jsont.string) ~enc:(fun t -> t.not_tags)
    |> finish)

let range_jsont =
  (* Decode [start, end] pair as (int * int) *)
  Jsont.list Jsont.int
  |> Jsont.map
       ~dec:(function
         | [a; b] -> (a, b)
         | _ -> (0, 0))
       ~enc:(fun (a, b) -> [a; b])

let ranges_jsont =
  (* List of ranges *)
  Jsont.list range_jsont

let state_pair_jsont =
  (* Decode [event_type, state_key] as (string * string) *)
  Jsont.list Jsont.string
  |> Jsont.map
       ~dec:(function
         | [et; sk] -> (et, sk)
         | _ -> ("", ""))
       ~enc:(fun (et, sk) -> [et; sk])

let list_config_jsont =
  Jsont.Object.(
    map (fun ranges sort required_state timeline_limit filters bump_event_types ->
      { ranges; sort; required_state; timeline_limit; filters; bump_event_types })
    |> mem "ranges" ranges_jsont ~dec_absent:[] ~enc:(fun t -> t.ranges)
    |> opt_mem "sort" (Jsont.list Jsont.string) ~enc:(fun t -> t.sort)
    |> mem "required_state" (Jsont.list state_pair_jsont) ~dec_absent:[]
         ~enc:(fun t -> t.required_state)
    |> opt_mem "timeline_limit" Jsont.int ~enc:(fun t -> t.timeline_limit)
    |> opt_mem "filters" list_filters_jsont ~enc:(fun t -> t.filters)
    |> opt_mem "bump_event_types" (Jsont.list Jsont.string)
         ~enc:(fun t -> t.bump_event_types)
    |> finish)

(** Sliding sync request *)
type request = {
  lists : (string * list_config) list;
  room_subscriptions : (string * room_subscription) list;
  unsubscribe_rooms : string list;
  extensions : extensions option;
  pos : string option;
  timeout : int option;
}

and extensions = {
  to_device : to_device_ext option;
  e2ee : e2ee_ext option;
  account_data : account_data_ext option;
  typing : typing_ext option;
  receipts : receipts_ext option;
}

and to_device_ext = {
  enabled : bool;
  since : string option;
  limit : int option;
}

and e2ee_ext = {
  enabled : bool;
}

and account_data_ext = {
  enabled : bool;
  lists : string list option;
  rooms : string list option;
}

and typing_ext = {
  enabled : bool;
  lists : string list option;
  rooms : string list option;
}

and receipts_ext = {
  enabled : bool;
  lists : string list option;
  rooms : string list option;
}

let to_device_ext_jsont =
  Jsont.Object.(
    map (fun enabled since limit -> { enabled; since; limit })
    |> mem "enabled" Jsont.bool ~enc:(fun t -> t.enabled)
    |> opt_mem "since" Jsont.string ~enc:(fun t -> t.since)
    |> opt_mem "limit" Jsont.int ~enc:(fun t -> t.limit)
    |> finish)

let e2ee_ext_jsont =
  Jsont.Object.(
    map (fun enabled -> ({ enabled } : e2ee_ext))
    |> mem "enabled" Jsont.bool ~enc:(fun (t : e2ee_ext) -> t.enabled)
    |> finish)

let account_data_ext_jsont =
  Jsont.Object.(
    map (fun enabled lists rooms -> ({ enabled; lists; rooms } : account_data_ext))
    |> mem "enabled" Jsont.bool ~enc:(fun (t : account_data_ext) -> t.enabled)
    |> opt_mem "lists" (Jsont.list Jsont.string) ~enc:(fun (t : account_data_ext) -> t.lists)
    |> opt_mem "rooms" (Jsont.list Jsont.string) ~enc:(fun (t : account_data_ext) -> t.rooms)
    |> finish)

let typing_ext_jsont =
  Jsont.Object.(
    map (fun enabled lists rooms -> ({ enabled; lists; rooms } : typing_ext))
    |> mem "enabled" Jsont.bool ~enc:(fun (t : typing_ext) -> t.enabled)
    |> opt_mem "lists" (Jsont.list Jsont.string) ~enc:(fun (t : typing_ext) -> t.lists)
    |> opt_mem "rooms" (Jsont.list Jsont.string) ~enc:(fun (t : typing_ext) -> t.rooms)
    |> finish)

let receipts_ext_jsont =
  Jsont.Object.(
    map (fun enabled lists rooms -> ({ enabled; lists; rooms } : receipts_ext))
    |> mem "enabled" Jsont.bool ~enc:(fun (t : receipts_ext) -> t.enabled)
    |> opt_mem "lists" (Jsont.list Jsont.string) ~enc:(fun (t : receipts_ext) -> t.lists)
    |> opt_mem "rooms" (Jsont.list Jsont.string) ~enc:(fun (t : receipts_ext) -> t.rooms)
    |> finish)

let extensions_jsont =
  Jsont.Object.(
    map (fun to_device e2ee account_data typing receipts ->
      { to_device; e2ee; account_data; typing; receipts })
    |> opt_mem "to_device" to_device_ext_jsont ~enc:(fun t -> t.to_device)
    |> opt_mem "e2ee" e2ee_ext_jsont ~enc:(fun t -> t.e2ee)
    |> opt_mem "account_data" account_data_ext_jsont ~enc:(fun t -> t.account_data)
    |> opt_mem "typing" typing_ext_jsont ~enc:(fun t -> t.typing)
    |> opt_mem "receipts" receipts_ext_jsont ~enc:(fun t -> t.receipts)
    |> finish)

module StringMap = Map.Make(String)

let string_map_jsont value_jsont =
  Jsont.Object.as_string_map value_jsont
  |> Jsont.map
       ~dec:(fun m -> StringMap.bindings m)
       ~enc:(fun l -> List.to_seq l |> StringMap.of_seq)

let request_jsont =
  Jsont.Object.(
    map (fun lists room_subscriptions unsubscribe_rooms extensions pos timeout ->
      { lists; room_subscriptions; unsubscribe_rooms; extensions; pos; timeout })
    |> mem "lists" (string_map_jsont list_config_jsont) ~dec_absent:[]
         ~enc:(fun t -> t.lists)
    |> mem "room_subscriptions" (string_map_jsont room_subscription_jsont) ~dec_absent:[]
         ~enc:(fun t -> t.room_subscriptions)
    |> mem "unsubscribe_rooms" (Jsont.list Jsont.string) ~dec_absent:[]
         ~enc:(fun t -> t.unsubscribe_rooms)
    |> opt_mem "extensions" extensions_jsont ~enc:(fun t -> t.extensions)
    |> opt_mem "pos" Jsont.string ~enc:(fun t -> t.pos)
    |> opt_mem "timeout" Jsont.int ~enc:(fun t -> t.timeout)
    |> finish)

(** Sliding sync response room data *)
type room_response = {
  name : string option;
  avatar : string option;
  heroes : hero list option;
  is_dm : bool option;
  initial : bool option;
  required_state : Jsont.json list;
  timeline : Jsont.json list;
  prev_batch : string option;
  limited : bool option;
  joined_count : int option;
  invited_count : int option;
  notification_count : int option;
  highlight_count : int option;
  num_live : int option;
  timestamp : int64 option;
}

and hero = {
  user_id : string;
  name : string option;
  avatar : string option;
}

let hero_jsont =
  Jsont.Object.(
    map (fun user_id name avatar -> ({ user_id; name; avatar } : hero))
    |> mem "user_id" Jsont.string ~enc:(fun (t : hero) -> t.user_id)
    |> opt_mem "name" Jsont.string ~enc:(fun (t : hero) -> t.name)
    |> opt_mem "avatar" Jsont.string ~enc:(fun (t : hero) -> t.avatar)
    |> finish)

let room_response_jsont =
  Jsont.Object.(
    map (fun name avatar heroes is_dm initial required_state timeline
             prev_batch limited joined_count invited_count notification_count
             highlight_count num_live timestamp ->
      ({ name; avatar; heroes; is_dm; initial; required_state; timeline;
        prev_batch; limited; joined_count; invited_count; notification_count;
        highlight_count; num_live; timestamp } : room_response))
    |> opt_mem "name" Jsont.string ~enc:(fun (t : room_response) -> t.name)
    |> opt_mem "avatar" Jsont.string ~enc:(fun (t : room_response) -> t.avatar)
    |> opt_mem "heroes" (Jsont.list hero_jsont) ~enc:(fun (t : room_response) -> t.heroes)
    |> opt_mem "is_dm" Jsont.bool ~enc:(fun (t : room_response) -> t.is_dm)
    |> opt_mem "initial" Jsont.bool ~enc:(fun (t : room_response) -> t.initial)
    |> mem "required_state" (Jsont.list Jsont.json) ~dec_absent:[]
         ~enc:(fun (t : room_response) -> t.required_state)
    |> mem "timeline" (Jsont.list Jsont.json) ~dec_absent:[] ~enc:(fun (t : room_response) -> t.timeline)
    |> opt_mem "prev_batch" Jsont.string ~enc:(fun (t : room_response) -> t.prev_batch)
    |> opt_mem "limited" Jsont.bool ~enc:(fun (t : room_response) -> t.limited)
    |> opt_mem "joined_count" Jsont.int ~enc:(fun (t : room_response) -> t.joined_count)
    |> opt_mem "invited_count" Jsont.int ~enc:(fun (t : room_response) -> t.invited_count)
    |> opt_mem "notification_count" Jsont.int ~enc:(fun (t : room_response) -> t.notification_count)
    |> opt_mem "highlight_count" Jsont.int ~enc:(fun (t : room_response) -> t.highlight_count)
    |> opt_mem "num_live" Jsont.int ~enc:(fun (t : room_response) -> t.num_live)
    |> opt_mem "timestamp" Jsont.int64 ~enc:(fun (t : room_response) -> t.timestamp)
    |> finish)

(** Sliding sync list response *)
type list_response = {
  count : int;
  ops : list_op_response list;
}

and list_op_response = {
  op : string;
  range : (int * int) option;
  index : int option;
  room_ids : string list option;
  room_id : string option;
}

let list_op_response_jsont =
  Jsont.Object.(
    map (fun op range index room_ids room_id ->
      { op; range; index; room_ids; room_id })
    |> mem "op" Jsont.string ~enc:(fun t -> t.op)
    |> opt_mem "range" range_jsont ~enc:(fun t -> t.range)
    |> opt_mem "index" Jsont.int ~enc:(fun t -> t.index)
    |> opt_mem "room_ids" (Jsont.list Jsont.string) ~enc:(fun t -> t.room_ids)
    |> opt_mem "room_id" Jsont.string ~enc:(fun t -> t.room_id)
    |> finish)

let list_response_jsont =
  Jsont.Object.(
    map (fun count ops -> { count; ops })
    |> mem "count" Jsont.int ~dec_absent:0 ~enc:(fun t -> t.count)
    |> mem "ops" (Jsont.list list_op_response_jsont) ~dec_absent:[] ~enc:(fun t -> t.ops)
    |> finish)

(** Extensions response *)
type extensions_response = {
  to_device : to_device_response option;
  e2ee : e2ee_response option;
  account_data : account_data_response option;
  typing : typing_response option;
  receipts : receipts_response option;
}

and to_device_response = {
  next_batch : string;
  events : Jsont.json list;
}

and e2ee_response = {
  device_lists : device_lists option;
  device_one_time_keys_count : (string * int) list;
  device_unused_fallback_key_types : string list;
}

and device_lists = {
  changed : string list;
  left : string list;
}

and account_data_response = {
  global : Jsont.json list;
  rooms : (string * Jsont.json list) list;
}

and typing_response = {
  rooms : (string * string list) list;  (* room_id -> typing user_ids *)
}

and receipts_response = {
  rooms : (string * Jsont.json) list;  (* room_id -> receipt content *)
}

let to_device_response_jsont =
  Jsont.Object.(
    map (fun next_batch events -> { next_batch; events })
    |> mem "next_batch" Jsont.string ~enc:(fun t -> t.next_batch)
    |> mem "events" (Jsont.list Jsont.json) ~dec_absent:[] ~enc:(fun t -> t.events)
    |> finish)

let device_lists_jsont =
  Jsont.Object.(
    map (fun changed left -> { changed; left })
    |> mem "changed" (Jsont.list Jsont.string) ~dec_absent:[] ~enc:(fun t -> t.changed)
    |> mem "left" (Jsont.list Jsont.string) ~dec_absent:[] ~enc:(fun t -> t.left)
    |> finish)

let int_map_jsont =
  Jsont.Object.as_string_map Jsont.int
  |> Jsont.map
       ~dec:(fun m -> StringMap.bindings m)
       ~enc:(fun l -> List.to_seq l |> StringMap.of_seq)

let e2ee_response_jsont =
  Jsont.Object.(
    map (fun device_lists device_one_time_keys_count device_unused_fallback_key_types ->
      { device_lists; device_one_time_keys_count; device_unused_fallback_key_types })
    |> opt_mem "device_lists" device_lists_jsont ~enc:(fun t -> t.device_lists)
    |> mem "device_one_time_keys_count" int_map_jsont ~dec_absent:[]
         ~enc:(fun t -> t.device_one_time_keys_count)
    |> mem "device_unused_fallback_key_types" (Jsont.list Jsont.string) ~dec_absent:[]
         ~enc:(fun t -> t.device_unused_fallback_key_types)
    |> finish)

let json_list_map_jsont =
  Jsont.Object.as_string_map (Jsont.list Jsont.json)
  |> Jsont.map
       ~dec:(fun m -> StringMap.bindings m)
       ~enc:(fun l -> List.to_seq l |> StringMap.of_seq)

let account_data_response_jsont =
  Jsont.Object.(
    map (fun global rooms -> { global; rooms })
    |> mem "global" (Jsont.list Jsont.json) ~dec_absent:[] ~enc:(fun t -> t.global)
    |> mem "rooms" json_list_map_jsont ~dec_absent:[] ~enc:(fun t -> t.rooms)
    |> finish)

let string_list_map_jsont =
  Jsont.Object.as_string_map (Jsont.list Jsont.string)
  |> Jsont.map
       ~dec:(fun m -> StringMap.bindings m)
       ~enc:(fun l -> List.to_seq l |> StringMap.of_seq)

let typing_response_jsont =
  Jsont.Object.(
    map (fun rooms -> ({ rooms } : typing_response))
    |> mem "rooms" string_list_map_jsont ~dec_absent:[] ~enc:(fun (t : typing_response) -> t.rooms)
    |> finish)

let json_map_jsont =
  Jsont.Object.as_string_map Jsont.json
  |> Jsont.map
       ~dec:(fun m -> StringMap.bindings m)
       ~enc:(fun l -> List.to_seq l |> StringMap.of_seq)

let receipts_response_jsont =
  Jsont.Object.(
    map (fun rooms -> ({ rooms } : receipts_response))
    |> mem "rooms" json_map_jsont ~dec_absent:[] ~enc:(fun (t : receipts_response) -> t.rooms)
    |> finish)

let extensions_response_jsont =
  Jsont.Object.(
    map (fun to_device e2ee account_data typing receipts ->
      { to_device; e2ee; account_data; typing; receipts })
    |> opt_mem "to_device" to_device_response_jsont ~enc:(fun t -> t.to_device)
    |> opt_mem "e2ee" e2ee_response_jsont ~enc:(fun t -> t.e2ee)
    |> opt_mem "account_data" account_data_response_jsont ~enc:(fun t -> t.account_data)
    |> opt_mem "typing" typing_response_jsont ~enc:(fun t -> t.typing)
    |> opt_mem "receipts" receipts_response_jsont ~enc:(fun t -> t.receipts)
    |> finish)

(** Full sliding sync response *)
type response = {
  pos : string;
  lists : (string * list_response) list;
  rooms : (string * room_response) list;
  extensions : extensions_response option;
}

let response_jsont =
  Jsont.Object.(
    map (fun pos lists rooms extensions ->
      { pos; lists; rooms; extensions })
    |> mem "pos" Jsont.string ~enc:(fun t -> t.pos)
    |> mem "lists" (string_map_jsont list_response_jsont) ~dec_absent:[]
         ~enc:(fun t -> t.lists)
    |> mem "rooms" (string_map_jsont room_response_jsont) ~dec_absent:[]
         ~enc:(fun t -> t.rooms)
    |> opt_mem "extensions" extensions_response_jsont ~enc:(fun t -> t.extensions)
    |> finish)

(** Perform a sliding sync request.

    This is the main entry point for sliding sync. The client should maintain
    the position token and include it in subsequent requests. *)
let sync client ~request () =
  match Client.encode_body request_jsont request with
  | Error e -> Error e
  | Ok body ->
      (* Note: timeout handling would need to be done at the HTTP client level *)
      let _ = request.timeout in
      match Client.post client ~path:"/sync" ~body () with
      | Error e -> Error e
      | Ok resp_body -> Client.decode_response response_jsont resp_body

(** Create a default request for initial sync. *)
let initial_request ?(timeline_limit = 20) ?(room_limit = 20) () =
  {
    lists = [
      ("all_rooms", {
        ranges = [(0, room_limit - 1)];
        sort = Some ["by_recency"; "by_name"];
        required_state = [("m.room.name", ""); ("m.room.avatar", "")];
        timeline_limit = Some timeline_limit;
        filters = None;
        bump_event_types = Some ["m.room.message"; "m.room.encrypted"];
      })
    ];
    room_subscriptions = [];
    unsubscribe_rooms = [];
    extensions = Some {
      to_device = Some { enabled = true; since = None; limit = Some 100 };
      e2ee = Some { enabled = true };
      account_data = Some { enabled = true; lists = None; rooms = None };
      typing = Some { enabled = true; lists = None; rooms = None };
      receipts = Some { enabled = true; lists = None; rooms = None };
    };
    pos = None;
    timeout = Some 30000;
  }