Source

screentime-monitor / protocol.ml

open Core.Std
open Async.Std

let start =
  let module Q = struct
    type t = Username.t * Category.t
    with sexp, bin_io
  end in
  Rpc.Rpc.create
    ~name:"start"
    ~version:1
    ~bin_query:Q.bin_t
    ~bin_response:Unit.bin_t

let stop =
  Rpc.Rpc.create
    ~name:"stop"
    ~version:0
    ~bin_query:Username.bin_t
    ~bin_response:Unit.bin_t

module Status = struct
  type t = { state: [ `Active of Category.t | `Not_running ]
           ; elapsed: Time.Span.t Category.Map.t
           }
  with sexp, bin_io
end

let status =
  Rpc.Rpc.create
    ~name:"status"
    ~version:1
    ~bin_query:Username.bin_t
    ~bin_response:Status.bin_t

let users =
  let module Users = struct
    type t = Username.t list with sexp,bin_io
  end in
  Rpc.Rpc.create
    ~name:"users"
    ~version:0
    ~bin_query:Unit.bin_t
    ~bin_response:Users.bin_t

let shutdown =
  Rpc.Rpc.create
    ~name:"shutdown"
    ~version:0
    ~bin_query:Unit.bin_t
    ~bin_response:Unit.bin_t

let report =
  let module R = struct
    type t = Time.Span.t Category.Map.t Date.Map.t
    with sexp, bin_io
  end in
  Rpc.Rpc.create
    ~name:"report"
    ~version:0
    ~bin_query:Username.bin_t
    ~bin_response:R.bin_t

let full_report =
  let module R = struct
    type t = (Category.t * Time.t * Time.t) list Date.Map.t
    with bin_io
  end in
  Rpc.Rpc.create
    ~name:"full-report"
    ~version:0
    ~bin_query:Username.bin_t
    ~bin_response:R.bin_t

let todays_violations =
  let module R = struct
    type t = (Rule.t * Time.Span.t * Rule_store.Status.t) list with bin_io
  end in
  Rpc.Rpc.create
    ~name:"todays-violations"
    ~version:2
    ~bin_query:Username.bin_t
    ~bin_response:R.bin_t

let get_rules =
  let module R = struct
    type t = Rule.t list With_format.t with bin_io
  end in
  Rpc.Rpc.create
    ~name:"get-rule"
    ~version:1
    ~bin_query:Username.bin_t
    ~bin_response:R.bin_t

let set_rules =
  let module Q = struct
    type t = Username.t * Rule.t list With_format.t with bin_io
  end in
  Rpc.Rpc.create
    ~name:"set-rule"
    ~version:2
    ~bin_query:Q.bin_t
    ~bin_response:Unit.bin_t

let acknowledge =
  let module Q = struct
    type t = Username.t * Rule.Name.t with bin_io
  end in
  Rpc.Rpc.create
    ~name:"acknowledge"
    ~version:1
    ~bin_query:Q.bin_t
    ~bin_response:Unit.bin_t

let unacknowledge =
  let module Q = struct
    type t = Username.t * Rule.Name.t with bin_io
  end in
  Rpc.Rpc.create
    ~name:"unacknowledge"
    ~version:1
    ~bin_query:Q.bin_t
    ~bin_response:Unit.bin_t