Source file game.ml

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2023 Functori, <contact@functori.com>                       *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

module V1 = struct
  type dissection_chunk = {state_hash : State_hash.t option; tick : Z.t}

  type step = Dissection of dissection_chunk list | Proof of string

  type refutation =
    | Start of {
        player_commitment_hash : Commitment.Hash.t;
        opponent_commitment_hash : Commitment.Hash.t;
      }
    | Move of {choice : Z.t; step : step}

  type index = {
    alice : Signature.Public_key_hash.t;
    bob : Signature.Public_key_hash.t;
  }

  let make_index a b =
    let alice, bob =
      if Signature.Public_key_hash.(a > b) then (b, a) else (a, b)
    in
    {alice; bob}

  let equal_dissection_chunk c1 c2 =
    Z.equal c1.tick c2.tick
    && Option.equal State_hash.equal c1.state_hash c2.state_hash

  let index_encoding =
    let open Data_encoding in
    conv
      (fun {alice; bob} -> (alice, bob))
      (fun (alice, bob) -> make_index alice bob)
      (obj2
         (req "alice" Signature.Public_key_hash.encoding)
         (req "bob" Signature.Public_key_hash.encoding))

  let dissection_chunk_encoding =
    let open Data_encoding in
    conv
      (fun {state_hash; tick} -> (state_hash, tick))
      (fun (state_hash, tick) -> {state_hash; tick})
      (obj2 (opt "state" State_hash.encoding) (req "tick" n))

  let dissection_encoding = Data_encoding.list dissection_chunk_encoding

  let step_encoding =
    let open Data_encoding in
    union
      ~tag_size:`Uint8
      [
        case
          ~title:"Dissection"
          (Tag 0)
          dissection_encoding
          (function Dissection d -> Some d | _ -> None)
          (fun d -> Dissection d);
        case
          ~title:"Proof"
          (Tag 1)
          (string' Hex)
          (function Proof p -> Some p | _ -> None)
          (fun p -> Proof p);
      ]

  let refutation_encoding =
    let open Data_encoding in
    union
      ~tag_size:`Uint8
      [
        case
          ~title:"Start"
          (Tag 0)
          (obj3
             (req "refutation_kind" (constant "start"))
             (req "player_commitment_hash" Commitment.Hash.encoding)
             (req "opponent_commitment_hash" Commitment.Hash.encoding))
          (function
            | Start {player_commitment_hash; opponent_commitment_hash} ->
                Some ((), player_commitment_hash, opponent_commitment_hash)
            | _ -> None)
          (fun ((), player_commitment_hash, opponent_commitment_hash) ->
            Start {player_commitment_hash; opponent_commitment_hash});
        case
          ~title:"Move"
          (Tag 1)
          (obj3
             (req "refutation_kind" (constant "move"))
             (req "choice" n)
             (req "step" step_encoding))
          (function
            | Move {choice; step} -> Some ((), choice, step) | _ -> None)
          (fun ((), choice, step) -> Move {choice; step});
      ]

  type conflict = {
    other : Signature.Public_key_hash.t;
    their_commitment : Commitment.t;
    our_commitment : Commitment.t;
    parent_commitment : Commitment.Hash.t;
  }

  let conflict_encoding =
    Data_encoding.(
      conv
        (fun {other; their_commitment; our_commitment; parent_commitment} ->
          (other, their_commitment, our_commitment, parent_commitment))
        (fun (other, their_commitment, our_commitment, parent_commitment) ->
          {other; their_commitment; our_commitment; parent_commitment})
        (obj4
           (req "other" Signature.Public_key_hash.encoding)
           (req "their_commitment" Commitment.encoding)
           (req "our_commitment" Commitment.encoding)
           (req "parent_commitment" Commitment.Hash.encoding)))

  type player = Alice | Bob

  type game_state =
    | Dissecting of {
        dissection : dissection_chunk list;
        default_number_of_sections : int;
      }
    | Final_move of {
        agreed_start_chunk : dissection_chunk;
        refuted_stop_chunk : dissection_chunk;
      }

  type t = {
    turn : player;
    inbox_snapshot : Inbox.V1.history_proof;
    dal_snapshot : Dal.Slot_history.t;
    start_level : int32;
    inbox_level : int32;
    game_state : game_state;
  }

  let game_state_equal gs1 gs2 =
    match (gs1, gs2) with
    | ( Dissecting
          {
            dissection = dissection1;
            default_number_of_sections = default_number_of_sections1;
          },
        Dissecting
          {
            dissection = dissection2;
            default_number_of_sections = default_number_of_sections2;
          } ) ->
        Compare.Int.equal
          default_number_of_sections1
          default_number_of_sections2
        && List.equal equal_dissection_chunk dissection1 dissection2
    | Dissecting _, _ -> false
    | ( Final_move
          {
            agreed_start_chunk = agreed_start_chunk1;
            refuted_stop_chunk = refuted_stop_chunk1;
          },
        Final_move
          {
            agreed_start_chunk = agreed_start_chunk2;
            refuted_stop_chunk = refuted_stop_chunk2;
          } ) ->
        equal_dissection_chunk agreed_start_chunk1 agreed_start_chunk2
        && equal_dissection_chunk refuted_stop_chunk1 refuted_stop_chunk2
    | Final_move _, _ -> false

  let player_encoding =
    let open Data_encoding in
    union
      ~tag_size:`Uint8
      [
        case
          ~title:"Alice"
          (Tag 0)
          (constant "alice")
          (function Alice -> Some () | _ -> None)
          (fun () -> Alice);
        case
          ~title:"Bob"
          (Tag 1)
          (constant "bob")
          (function Bob -> Some () | _ -> None)
          (fun () -> Bob);
      ]

  let game_state_encoding =
    let open Data_encoding in
    union
      ~tag_size:`Uint8
      [
        case
          ~title:"Dissecting"
          (Tag 0)
          (obj3
             (req "kind" (constant "Dissecting"))
             (req "dissection" dissection_encoding)
             (req "default_number_of_sections" uint8))
          (function
            | Dissecting {dissection; default_number_of_sections} ->
                Some ((), dissection, default_number_of_sections)
            | _ -> None)
          (fun ((), dissection, default_number_of_sections) ->
            Dissecting {dissection; default_number_of_sections});
        case
          ~title:"Final_move"
          (Tag 1)
          (obj3
             (req "kind" (constant "Final_move"))
             (req "agreed_start_chunk" dissection_chunk_encoding)
             (req "refuted_stop_chunk" dissection_chunk_encoding))
          (function
            | Final_move {agreed_start_chunk; refuted_stop_chunk} ->
                Some ((), agreed_start_chunk, refuted_stop_chunk)
            | _ -> None)
          (fun ((), agreed_start_chunk, refuted_stop_chunk) ->
            Final_move {agreed_start_chunk; refuted_stop_chunk});
      ]

  let encoding =
    let open Data_encoding in
    conv
      (fun {
             turn;
             inbox_snapshot;
             dal_snapshot;
             start_level;
             inbox_level;
             game_state;
           } ->
        ( turn,
          inbox_snapshot,
          dal_snapshot,
          start_level,
          inbox_level,
          game_state ))
      (fun ( turn,
             inbox_snapshot,
             dal_snapshot,
             start_level,
             inbox_level,
             game_state ) ->
        {
          turn;
          inbox_snapshot;
          dal_snapshot;
          start_level;
          inbox_level;
          game_state;
        })
      (obj6
         (req "turn" player_encoding)
         (req "inbox_snapshot" Inbox.V1.history_proof_encoding)
         (req "dal_snapshot" (dynamic_size Dal.Slot_history.encoding))
         (req "start_level" int32)
         (req "inbox_level" int32)
         (req "game_state" game_state_encoding))
end

type versioned = V1 of V1.t

let versioned_encoding =
  let open Data_encoding.V1 in
  union
    [
      case
        ~title:"smart_rollup_game.V1"
        (Tag 0)
        V1.encoding
        (function V1 game -> Some game)
        (fun game -> V1 game);
    ]

include V1

let of_versioned = function V1 g -> g [@@inline]

let to_versioned g = V1 g [@@inline]