An example of a shifumi game contract in CameLIGO

sessionId

roundId

player_key

player_secret

revealPlay

action

play

stopSession

total_rounds

players

createSession

metadata

next_session

sessions

board

#import "errors.mligo" "Errors"
#import "session.mligo" "Session"

[@inline]
let check_player_authorized (player : Session.player) (allowed_players: Session.player set) (error_message : string) : unit =
    assert_with_error (Set.mem player allowed_players) error_message

[@inline]
let check_session_end(result : Session.result) (expected : Session.result) : unit =
    assert_with_error (result = expected) Errors.session_finished

[@inline]
let check_asleep (current_session : Session.t) : unit = 
    assert_with_error ((Tezos.get_now ()) > current_session.asleep) Errors.must_wait_10_min


let must_wait_10_min : string = "Must wait at least 600 seconds before claiming Victory (in case opponent is not playing)"
let unknown_session : string = "Unknown session"
let user_not_allowed_to_stop_session : string = "Not allowed to stop this session"
let user_not_allowed_to_play_in_session : string = "Not allowed to play this session"
let user_not_allowed_to_reveal_in_session : string = "Not allowed to reveal this session"
let session_finished : string = "this session is finished"
let wrong_current_round : string = "Wrong current round parameter"
let user_already_played : string = "You already have played for this round"
let missing_player_bytes : string = "a player has not played"
let missing_all_bytes : string = "no actions registered"
let missing_all_decoded_bytes : string = "no decoded actions registered"
let missing_sender_bytes : string = "user has not played"
let failed_to_open_bytes : string = "Failed to check bytes"
let user_already_revealed : string = "You already have revealed your play for this round"
let failed_to_unpack_payload : string = "Failed to unpack the payload"
let no_winner : string = "No players have played in the current round, thus cannot deduce troller"

#import "storage.mligo" "Storage"
#import "parameter.mligo" "Parameter"
#import "views.mligo" "Views"
#import "errors.mligo" "Errors"
#import "session.mligo" "Session"
#import "conditions.mligo" "Conditions"

type storage = Storage.t
type parameter = Parameter.t
type return = operation list * storage

// Anyone can create a session (must specify players and number of rounds)
[@entry] let createSession(param : Parameter.createsession_param) (store : Storage.t) : operation list * Storage.t =
    let new_session : Session.t = Session.new param.total_rounds param.players in
    let new_storage : Storage.t = {store with next_session=store.next_session + 1n; sessions=Map.add store.next_session new_session store.sessions} in
    (([]: operation list), new_storage)

// search for a non troller in the session
let find_me_a_name(sessionId, missing_players, current_session, store :nat * Session.player set * Session.t * Storage.t) : operation list * Storage.t =
    let rem_player(acc, elt : address set * address ) : address set = Set.remove elt acc in
    let winners_set : address set = Set.fold rem_player missing_players current_session.players in
    let _check_has_winner : unit = assert_with_error (Set.cardinal winners_set > 0n) Errors.no_winner in
    let add_player(acc, elt : address list * address) : address list = elt :: acc in
    let winners_list : address list = Set.fold add_player winners_set ([] : address list) in
    let winner : address = Option.unopt (List.head_opt winners_list) in
    let new_current_session : Session.t = { current_session with result=Winner(winner) } in
    let new_storage : Storage.t = Storage.update_sessions store sessionId new_current_session in
    (([]: operation list), new_storage )

// allow players to claim victory if opponent is a troller (refuse to play)
[@entry] let stopSession(param : Parameter.stopsession_param) (store : Storage.t) : operation list * Storage.t =
    let current_session : Session.t = Storage.getSession(param.sessionId, store) in
    let _check_players : unit = Conditions.check_player_authorized (Tezos.get_sender ()) current_session.players Errors.user_not_allowed_to_stop_session in
    let _check_session_end : unit = Conditions.check_session_end current_session.result Inplay in
    let _check_asleep : unit = Conditions.check_asleep(current_session) in
    let current_round = match Map.find_opt current_session.current_round current_session.rounds with
    | None -> ([] : Session.player_actions)
    | Some rnd -> rnd
    in
    let missing_players = Session.find_missing(current_round, current_session.players) in
    if Set.cardinal missing_players > 0n then
        find_me_a_name (param.sessionId, missing_players, current_session, store)
    else
        let current_decoded_round = match Map.find_opt current_session.current_round current_session.decoded_rounds with
        | None -> (failwith("SHOULD NOT BE HERE SESSION IS BROKEN") : Session.decoded_player_actions)
        | Some rnd -> rnd
        in
        let missing_players_for_reveal = Session.find_missing(current_decoded_round, current_session.players) in
        if Set.cardinal missing_players_for_reveal > 0n then
            find_me_a_name (param.sessionId, missing_players_for_reveal, current_session, store)
        else
            (([]: operation list), store )


// the player create a bytes with the chosen action (Stone | Paper | Cisor) in backend
// once the bytes is created, the player send its bytes to the smart contract
[@entry] let play(param : Parameter.play_param) (store : Storage.t) : operation list * Storage.t =
    let current_session : Session.t = Storage.getSession(param.sessionId, store) in
    let sender = Tezos.get_sender () in
    let _check_players : unit = Conditions.check_player_authorized sender current_session.players Errors.user_not_allowed_to_play_in_session in
    let _check_session_end : unit = Conditions.check_session_end current_session.result Inplay in
    let _check_round : unit = assert_with_error (current_session.current_round = param.roundId) Errors.wrong_current_round in
    // register action
    let new_rounds = Session.add_in_rounds current_session.current_round current_session sender param.action in

    let new_session : Session.t = Session.update_rounds current_session new_rounds in
    let new_storage : Storage.t = Storage.update_sessions store param.sessionId new_session in
    (([]: operation list), new_storage)


// Once all players have committed their bytes, they must reveal the content of their bytes
[@entry] let revealPlay (param : Parameter.reveal_param) (store : Storage.t) : operation list * Storage.t =
    // players can reveal only if all players have sent their bytes
    let current_session : Session.t = Storage.getSession(param.sessionId, store) in
    let sender = Tezos.get_sender () in
    let _check_players : unit = Conditions.check_player_authorized sender current_session.players Errors.user_not_allowed_to_reveal_in_session in
    let _check_session_end : unit = Conditions.check_session_end current_session.result Inplay in
    let _check_round : unit = assert_with_error (current_session.current_round = param.roundId) Errors.wrong_current_round in

    let current_round_actions : Session.player_actions = Session.get_round_actions current_session.current_round current_session in

    let numberOfPlayers : nat = Set.cardinal current_session.players in
    let listsize (acc, _elt: nat * Session.player_action) : nat = acc + 1n in
    let numberOfActions : nat = List.fold listsize current_round_actions 0n in
    let _check_all_players_have_played : unit = assert_with_error (numberOfPlayers = numberOfActions) Errors.missing_player_bytes in
    // retrieve user bytes (fails if not found)
    let user_bytes : bytes = Session.get_bytes_exn sender (Some(current_round_actions)) in
    // decode action
    let decoded_action : Session.action = Session.decode_bytes_exn param.player_key user_bytes param.player_secret in
    let new_decoded_rounds = Session.add_in_decoded_rounds current_session.current_round current_session sender decoded_action in
    let new_current_session : Session.t = Session.update_decoded_rounds current_session new_decoded_rounds in

    // compute board if all players have revealed
    let modified_new_current_session : Session.t = Session.finalize_current_round new_current_session in

    // if session is finished, we can compute the result winner
    let final_current_session = Session.finalize_session modified_new_current_session in

    let new_storage : Storage.t = Storage.update_sessions store param.sessionId final_current_session in
    (([]: operation list), new_storage)


[@view] let board(sessionId: nat) (store: storage): Views.sessionBoard =
    match Map.find_opt sessionId store.sessions with
    | Some (sess) -> Views.retrieve_board(sess)
    | None -> (failwith("Unknown session") : Views.sessionBoard)


#import "session.mligo" "Session"

type action = Session.action

type createsession_param = {
    total_rounds : nat;
    players : address set;
}

type stopsession_param = {
    sessionId : nat;
}

type play_param = {
    sessionId : nat;
    roundId : nat;
    action : bytes
}

type reveal_param = {
    sessionId : nat;
    roundId : nat;
    player_key : bytes;
    player_secret : nat
}

type t = CreateSession of createsession_param | Play of play_param | RevealPlay of reveal_param | StopSession of stopsession_param


#import "errors.mligo" "Errors"

type player = address
type round = nat
type action = Stone | Paper | Cisor
type result = Inplay | Draw | Winner of address

type 'a an_action = {
    player : player;
    action : 'a 
}

type player_action = bytes an_action
type decoded_player_action = action an_action

type player_actions = player_action list
type decoded_player_actions = decoded_player_action list

type 'a rounds = (round, 'a an_action list) map 

type board = (round, player option) map

type t = {
    total_rounds : nat;
    players : player set;
    current_round : nat;
    rounds : bytes rounds;
    decoded_rounds : action rounds;
    board : board;
    result : result;
    asleep : timestamp
}


[@inline]
let new (total_rounds: nat) (players: player set): t =
    { 
      asleep=(Tezos.get_now ()) + 600; 
      total_rounds=total_rounds; 
      players=players; 
      current_round=1n; 
      rounds=(Map.empty : bytes rounds);
      decoded_rounds=(Map.empty : action rounds); 
      board=(Map.empty : board); 
      result=Inplay 
    }  

[@inline]
let get_round_actions (roundId : nat) (session : t) : player_actions =
    match Map.find_opt roundId session.rounds with 
    | None -> failwith(Errors.missing_all_bytes)
    | Some (round_actions) -> round_actions 

[@inline]
let get_decoded_round_actions (roundId : nat) (session : t) : decoded_player_actions =
    match Map.find_opt roundId session.decoded_rounds with 
    | None -> failwith(Errors.missing_all_decoded_bytes)
    | Some (decoded_round_actions) -> decoded_round_actions 

[@inline]
let update_rounds (session: t) (rounds: (round, player_actions) map): t =
    { session with asleep=(Tezos.get_now ()) + 600; rounds=rounds }    

[@inline]
let update_decoded_rounds (session: t) (decoded_rounds: (round, decoded_player_actions) map): t =
    { session with asleep=(Tezos.get_now ()) + 600; decoded_rounds=decoded_rounds }    

[@inline]
let find_missing (type a) (pactions, all_players : a an_action list * player set) =
    let discard_player(acc, elt : address set * a an_action) : address set = Set.remove elt.player acc in
    List.fold discard_player pactions all_players 

[@inline]
let has_played (type a) (pactions: a an_action list) (player : player) : bool =
    let check_contains(acc, elt : bool * a an_action) : bool = if acc then acc else (elt.player = player) in
    List.fold check_contains pactions false 

[@inline]
let has_played_round (type a) (rounds: a rounds) (roundId: round) (player: player) : bool =
    match Map.find_opt roundId rounds with
    | Some (acts) -> has_played acts player
    | None -> false 

[@inline]
let add_in_decoded_rounds (roundId : nat) (session : t) (user : address) (decoded_action: action) : action rounds =
    match Map.find_opt roundId session.decoded_rounds with 
    | None -> Map.add roundId [{player=user; action=decoded_action}] session.decoded_rounds
    | Some (decodedPlayerActions) ->
        let _check_player_has_revealed_this_round = assert_with_error (has_played_round session.decoded_rounds roundId user = false) Errors.user_already_revealed in
        Map.update roundId (Some({player=user; action=decoded_action} :: decodedPlayerActions)) session.decoded_rounds

[@inline]
let add_in_rounds (roundId : nat) (session : t) (user : address) (action: bytes) : bytes rounds =
    match Map.find_opt roundId session.rounds with 
    | None -> Map.add roundId [{player=user; action=action}] session.rounds
    | Some (playerActions) ->
        let _check_player_has_played_this_round = assert_with_error (has_played_round session.rounds roundId user = false) Errors.user_already_played in
        Map.update roundId (Some({player=user; action=action} :: playerActions)) session.rounds

[@inline]
let get_bytes_exn (user : address) (actions_opt : player_actions option) : bytes =
    let rec find_bytes(addr, lst_opt : address * player_actions option) : bytes option =
        match lst_opt with
        | None -> (None : bytes option)
        | Some lst -> (match List.head_opt lst with
            | None -> (None : bytes option) 
            | Some elt -> if (elt.player = addr) then
                    (Some(elt.action) : bytes option)
                else
                    find_bytes(addr, (List.tail_opt lst)))
    in
    match find_bytes(user, actions_opt) with
    | None -> (failwith(Errors.missing_sender_bytes) : bytes)
    | Some ch -> ch

[@inline]
let decode_bytes_exn (player_action: bytes) (user_bytes: bytes) (player_secret: nat): action = 
    let hashed = Crypto.sha512 (Bytes.pack (player_action, player_secret)) in
    if hashed = user_bytes
    then ( match (Bytes.unpack player_action : action option) with
           | None -> failwith(Errors.failed_to_unpack_payload)
           | Some x -> x )
    else failwith(Errors.failed_to_open_bytes)

[@inline]
let resolve(first, second : decoded_player_action * decoded_player_action) : player option = 
    let result : player option = match first.action, second.action with
    | Stone, Stone -> None
    | Stone, Paper -> Some(second.player)
    | Stone, Cisor -> Some(first.player)
    | Paper, Stone -> Some(first.player)
    | Paper, Paper -> None
    | Paper, Cisor -> Some(second.player)
    | Cisor, Stone -> Some(second.player)
    | Cisor, Paper -> Some(first.player)
    | Cisor, Cisor -> None
    in
    result

// TODO , this implementation can handle only 2 players :(
let update_board(sess, current_round: t * round) : board =
    // process actions for current_round
    let pactions : decoded_player_actions = match Map.find_opt current_round sess.decoded_rounds with
    | None -> (failwith("Missing actions for current_round") : decoded_player_actions)
    | Some (pacts) -> pacts
    in
    let first : decoded_player_action = match List.head_opt(pactions) with
    | None -> (failwith("Missing actions for first player") : decoded_player_action)
    | Some (act) -> act
    in
    let next_players_opt : decoded_player_action list option = List.tail_opt pactions in
    let next_players : decoded_player_action list = match next_players_opt with
    | None -> (failwith("Missing actions for second player") : decoded_player_action list)
    | Some (tl) -> tl
    in
    let second : decoded_player_action = match List.head_opt(next_players) with
    | None -> (failwith("Missing actions for second player") : decoded_player_action)
    | Some (act) -> act
    in
    let result : player option = resolve(first, second) in 
    match result with 
    | None -> Map.update current_round (None : player option option) sess.board
    | Some (r) -> Map.update current_round (Some(Some(r))) sess.board


[@inline]
let finalize_current_round (session: t) : t =
    // retrieve decoded_player_actions of given roundId
    let performed_actions : decoded_player_actions = match Map.find_opt session.current_round session.decoded_rounds with
    | None -> ([] : decoded_player_actions)
    | Some (pacts) -> pacts
    in
    // verify all players have revealed
    let all_player_have_revealed((acc, pactions), elt : (bool * decoded_player_actions) * player) : (bool * decoded_player_actions) = (acc && has_played pactions elt, pactions) in
    let (check_all_players_have_revealed, _all_decoded_actions) : (bool * decoded_player_actions) = Set.fold all_player_have_revealed session.players (true, performed_actions) in
    // all players have given their actions, now the board can be updated and session goes to next round
    if (check_all_players_have_revealed = true) then 
        { session with current_round=session.current_round+1n; board=update_board(session, session.current_round) }
    else
        session

        
let compute_result(sess: t) : result =
    // parse board and compute who won
    let compute_points(acc, elt : (address, nat) map * (round * player option)) : (address, nat) map = match elt.1 with
    | None -> acc
    | Some winner_round -> (match Map.find_opt winner_round acc with
        | None -> Map.add winner_round 1n acc
        | Some old_value -> Map.update winner_round (Some(old_value + 1n)) acc)
    in
    let final_scores = Map.fold compute_points sess.board (Map.empty : (address, nat) map) in
    let (winner_addr, winner_points, multiple_winners) : (address option * nat * bool) = ((None : address option), 0n, false) in
    let leader_score((win_addr, win_points, multiple), elt : (address option * nat * bool) * (address * nat)) : (address option * nat * bool) =
        match win_addr with
        | None -> (Some(elt.0), elt.1, false)
        | Some _temp_win_addr -> 
            if elt.1 > win_points then 
                (Some(elt.0), elt.1, false)
            else
                if elt.1 = win_points then
                    (win_addr, win_points, true)
                else
                    (win_addr, win_points, multiple)
    in 
    let (final_winner_addr, _final_winner_points, final_multiple) = Map.fold leader_score final_scores (winner_addr, winner_points, multiple_winners) in
    if final_multiple then
        Draw
    else
        match final_winner_addr with
        | None -> Draw
        | Some x -> Winner(x)



[@inline]
let finalize_session (session: t) : t =
    if session.current_round > session.total_rounds then
        { session with result=compute_result(session) }
    else
        session


#import "errors.mligo" "Errors"
#import "parameter.mligo" "Parameter"
#import "session.mligo" "Session"
#import "conditions.mligo" "Conditions"

type t = {
    metadata: (string, bytes) big_map;
    next_session : nat;
    sessions : (nat, Session.t) map
}

[@inline]
let update_sessions (storage: t) (sessionId: nat) (new_session: Session.t): t =
    { storage with sessions=Map.update sessionId (Some(new_session)) storage.sessions}

[@inline]
let getSession (sessionId, store : nat * t) : Session.t =
    match Map.find_opt sessionId store.sessions with
    | None -> (failwith(Errors.unknown_session) : Session.t)
    | Some (sess) -> sess


#import "session.mligo" "Session"


type sessionBoard = {
    points : (address, nat) map
}

let retrieve_board(sess : Session.t) : sessionBoard =
    let scores : (address, nat) map = (Map.empty : (address, nat) map) in
    let myfunc(acc, elt : (address, nat) map * (Session.round * address option)) : (address, nat) map = match elt.1 with
    | None -> acc
    | Some winner_round -> (match Map.find_opt winner_round acc with
        | None -> Map.add winner_round 1n acc
        | Some old_value -> Map.update winner_round (Some(old_value + 1n)) acc)
    in
    let final_scores = Map.fold myfunc sess.board scores in
    { points=final_scores }


Shifumi-Cameligov1.0

An example of a shifumi game contract in CameLIGO

Use template

Readme

Contract Shifumi

Makefile usage

Compile Shifumi contract

Test Shifumi contract

Deploy Shifumi contract

Contract informations

revealPlay

Arguments

Marigold