ocaml-protoc service generation example

file_server.ml

[@@@ocaml.warning "-27-30-39"]

type file_chunk = {
  path : string;
  data : bytes;
  crc : int32;
}

type file_path = {
  path : string;
}

type file_crc = {
  crc : int32;
}

type empty = unit

type ping = unit

type pong = unit

let rec default_file_chunk 
  ?path:((path:string) = "")
  ?data:((data:bytes) = Bytes.create 0)
  ?crc:((crc:int32) = 0l)
  () : file_chunk  = {
  path;
  data;
  crc;
}

let rec default_file_path 
  ?path:((path:string) = "")
  () : file_path  = {
  path;
}

let rec default_file_crc 
  ?crc:((crc:int32) = 0l)
  () : file_crc  = {
  crc;
}

let rec default_empty = ()

let rec default_ping = ()

let rec default_pong = ()

type file_chunk_mutable = {
  mutable path : string;
  mutable data : bytes;
  mutable crc : int32;
}

let default_file_chunk_mutable () : file_chunk_mutable = {
  path = "";
  data = Bytes.create 0;
  crc = 0l;
}

type file_path_mutable = {
  mutable path : string;
}

let default_file_path_mutable () : file_path_mutable = {
  path = "";
}

type file_crc_mutable = {
  mutable crc : int32;
}

let default_file_crc_mutable () : file_crc_mutable = {
  crc = 0l;
}

[@@@ocaml.warning "-27-30-39"]

(** {2 Formatters} *)

let rec pp_file_chunk fmt (v:file_chunk) = 
  let pp_i fmt () =
    Pbrt.Pp.pp_record_field ~first:true "path" Pbrt.Pp.pp_string fmt v.path;
    Pbrt.Pp.pp_record_field ~first:false "data" Pbrt.Pp.pp_bytes fmt v.data;
    Pbrt.Pp.pp_record_field ~first:false "crc" Pbrt.Pp.pp_int32 fmt v.crc;
  in
  Pbrt.Pp.pp_brk pp_i fmt ()

let rec pp_file_path fmt (v:file_path) = 
  let pp_i fmt () =
    Pbrt.Pp.pp_record_field ~first:true "path" Pbrt.Pp.pp_string fmt v.path;
  in
  Pbrt.Pp.pp_brk pp_i fmt ()

let rec pp_file_crc fmt (v:file_crc) = 
  let pp_i fmt () =
    Pbrt.Pp.pp_record_field ~first:true "crc" Pbrt.Pp.pp_int32 fmt v.crc;
  in
  Pbrt.Pp.pp_brk pp_i fmt ()

let rec pp_empty fmt (v:empty) = 
  let pp_i fmt () =
    Pbrt.Pp.pp_unit fmt ()
  in
  Pbrt.Pp.pp_brk pp_i fmt ()

let rec pp_ping fmt (v:ping) = 
  let pp_i fmt () =
    Pbrt.Pp.pp_unit fmt ()
  in
  Pbrt.Pp.pp_brk pp_i fmt ()

let rec pp_pong fmt (v:pong) = 
  let pp_i fmt () =
    Pbrt.Pp.pp_unit fmt ()
  in
  Pbrt.Pp.pp_brk pp_i fmt ()

[@@@ocaml.warning "-27-30-39"]

(** {2 Protobuf Encoding} *)

let rec encode_pb_file_chunk (v:file_chunk) encoder = 
  Pbrt.Encoder.string v.path encoder;
  Pbrt.Encoder.key 1 Pbrt.Bytes encoder; 
  Pbrt.Encoder.bytes v.data encoder;
  Pbrt.Encoder.key 2 Pbrt.Bytes encoder; 
  Pbrt.Encoder.int32_as_varint v.crc encoder;
  Pbrt.Encoder.key 3 Pbrt.Varint encoder; 
  ()

let rec encode_pb_file_path (v:file_path) encoder = 
  Pbrt.Encoder.string v.path encoder;
  Pbrt.Encoder.key 1 Pbrt.Bytes encoder; 
  ()

let rec encode_pb_file_crc (v:file_crc) encoder = 
  Pbrt.Encoder.int32_as_varint v.crc encoder;
  Pbrt.Encoder.key 1 Pbrt.Varint encoder; 
  ()

let rec encode_pb_empty (v:empty) encoder = 
()

let rec encode_pb_ping (v:ping) encoder = 
()

let rec encode_pb_pong (v:pong) encoder = 
()

[@@@ocaml.warning "-27-30-39"]

(** {2 Protobuf Decoding} *)

let rec decode_pb_file_chunk d =
  let v = default_file_chunk_mutable () in
  let continue__= ref true in
  while !continue__ do
    match Pbrt.Decoder.key d with
    | None -> (
    ); continue__ := false
    | Some (1, Pbrt.Bytes) -> begin
      v.path <- Pbrt.Decoder.string d;
    end
    | Some (1, pk) -> 
      Pbrt.Decoder.unexpected_payload "Message(file_chunk), field(1)" pk
    | Some (2, Pbrt.Bytes) -> begin
      v.data <- Pbrt.Decoder.bytes d;
    end
    | Some (2, pk) -> 
      Pbrt.Decoder.unexpected_payload "Message(file_chunk), field(2)" pk
    | Some (3, Pbrt.Varint) -> begin
      v.crc <- Pbrt.Decoder.int32_as_varint d;
    end
    | Some (3, pk) -> 
      Pbrt.Decoder.unexpected_payload "Message(file_chunk), field(3)" pk
    | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind
  done;
  ({
    path = v.path;
    data = v.data;
    crc = v.crc;
  } : file_chunk)

let rec decode_pb_file_path d =
  let v = default_file_path_mutable () in
  let continue__= ref true in
  while !continue__ do
    match Pbrt.Decoder.key d with
    | None -> (
    ); continue__ := false
    | Some (1, Pbrt.Bytes) -> begin
      v.path <- Pbrt.Decoder.string d;
    end
    | Some (1, pk) -> 
      Pbrt.Decoder.unexpected_payload "Message(file_path), field(1)" pk
    | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind
  done;
  ({
    path = v.path;
  } : file_path)

let rec decode_pb_file_crc d =
  let v = default_file_crc_mutable () in
  let continue__= ref true in
  while !continue__ do
    match Pbrt.Decoder.key d with
    | None -> (
    ); continue__ := false
    | Some (1, Pbrt.Varint) -> begin
      v.crc <- Pbrt.Decoder.int32_as_varint d;
    end
    | Some (1, pk) -> 
      Pbrt.Decoder.unexpected_payload "Message(file_crc), field(1)" pk
    | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind
  done;
  ({
    crc = v.crc;
  } : file_crc)

let rec decode_pb_empty d =
  match Pbrt.Decoder.key d with
  | None -> ();
  | Some (_, pk) -> 
    Pbrt.Decoder.unexpected_payload "Unexpected fields in empty message(empty)" pk

let rec decode_pb_ping d =
  match Pbrt.Decoder.key d with
  | None -> ();
  | Some (_, pk) -> 
    Pbrt.Decoder.unexpected_payload "Unexpected fields in empty message(ping)" pk

let rec decode_pb_pong d =
  match Pbrt.Decoder.key d with
  | None -> ();
  | Some (_, pk) -> 
    Pbrt.Decoder.unexpected_payload "Unexpected fields in empty message(pong)" pk

[@@@ocaml.warning "-27-30-39"]

(** {2 Protobuf YoJson Encoding} *)

let rec encode_json_file_chunk (v:file_chunk) = 
  let assoc = [] in 
  let assoc = ("path", Pbrt_yojson.make_string v.path) :: assoc in
  let assoc = ("data", Pbrt_yojson.make_bytes v.data) :: assoc in
  let assoc = ("crc", Pbrt_yojson.make_int (Int32.to_int v.crc)) :: assoc in
  `Assoc assoc

let rec encode_json_file_path (v:file_path) = 
  let assoc = [] in 
  let assoc = ("path", Pbrt_yojson.make_string v.path) :: assoc in
  `Assoc assoc

let rec encode_json_file_crc (v:file_crc) = 
  let assoc = [] in 
  let assoc = ("crc", Pbrt_yojson.make_int (Int32.to_int v.crc)) :: assoc in
  `Assoc assoc

let rec encode_json_empty (v:empty) = 
Pbrt_yojson.make_unit v

let rec encode_json_ping (v:ping) = 
Pbrt_yojson.make_unit v

let rec encode_json_pong (v:pong) = 
Pbrt_yojson.make_unit v

[@@@ocaml.warning "-27-30-39"]

(** {2 JSON Decoding} *)

let rec decode_json_file_chunk d =
  let v = default_file_chunk_mutable () in
  let assoc = match d with
    | `Assoc assoc -> assoc
    | _ -> assert(false)
  in
  List.iter (function 
    | ("path", json_value) -> 
      v.path <- Pbrt_yojson.string json_value "file_chunk" "path"
    | ("data", json_value) -> 
      v.data <- Pbrt_yojson.bytes json_value "file_chunk" "data"
    | ("crc", json_value) -> 
      v.crc <- Pbrt_yojson.int32 json_value "file_chunk" "crc"
    
    | (_, _) -> () (*Unknown fields are ignored*)
  ) assoc;
  ({
    path = v.path;
    data = v.data;
    crc = v.crc;
  } : file_chunk)

let rec decode_json_file_path d =
  let v = default_file_path_mutable () in
  let assoc = match d with
    | `Assoc assoc -> assoc
    | _ -> assert(false)
  in
  List.iter (function 
    | ("path", json_value) -> 
      v.path <- Pbrt_yojson.string json_value "file_path" "path"
    
    | (_, _) -> () (*Unknown fields are ignored*)
  ) assoc;
  ({
    path = v.path;
  } : file_path)

let rec decode_json_file_crc d =
  let v = default_file_crc_mutable () in
  let assoc = match d with
    | `Assoc assoc -> assoc
    | _ -> assert(false)
  in
  List.iter (function 
    | ("crc", json_value) -> 
      v.crc <- Pbrt_yojson.int32 json_value "file_crc" "crc"
    
    | (_, _) -> () (*Unknown fields are ignored*)
  ) assoc;
  ({
    crc = v.crc;
  } : file_crc)

let rec decode_json_empty d =
Pbrt_yojson.unit d "empty" "empty record"

let rec decode_json_ping d =
Pbrt_yojson.unit d "ping" "empty record"

let rec decode_json_pong d =
Pbrt_yojson.unit d "pong" "empty record"

module FileServer = struct
  open Pbrt_services.Value_mode
  module Client = struct
    open Pbrt_services
    
    let touch_file : (file_path, unary, unit, unary) Client.rpc =
      (Client.mk_rpc 
        ~package:[]
        ~service_name:"FileServer" ~rpc_name:"touch_file"
        ~req_mode:Client.Unary
        ~res_mode:Client.Unary
        ~encode_json_req:encode_json_file_path
        ~encode_pb_req:encode_pb_file_path
        ~decode_json_res:(fun _ -> ())
        ~decode_pb_res:(fun d -> Pbrt.Decoder.empty_nested d)
        () : (file_path, unary, unit, unary) Client.rpc)
    open Pbrt_services
    
    let upload_file : (file_chunk, stream, file_crc, unary) Client.rpc =
      (Client.mk_rpc 
        ~package:[]
        ~service_name:"FileServer" ~rpc_name:"upload_file"
        ~req_mode:Client.Stream
        ~res_mode:Client.Unary
        ~encode_json_req:encode_json_file_chunk
        ~encode_pb_req:encode_pb_file_chunk
        ~decode_json_res:decode_json_file_crc
        ~decode_pb_res:decode_pb_file_crc
        () : (file_chunk, stream, file_crc, unary) Client.rpc)
    open Pbrt_services
    
    let download_file : (file_path, unary, file_chunk, stream) Client.rpc =
      (Client.mk_rpc 
        ~package:[]
        ~service_name:"FileServer" ~rpc_name:"download_file"
        ~req_mode:Client.Unary
        ~res_mode:Client.Stream
        ~encode_json_req:encode_json_file_path
        ~encode_pb_req:encode_pb_file_path
        ~decode_json_res:decode_json_file_chunk
        ~decode_pb_res:decode_pb_file_chunk
        () : (file_path, unary, file_chunk, stream) Client.rpc)
    open Pbrt_services
    
    let ping_pong : (unit, stream, unit, stream) Client.rpc =
      (Client.mk_rpc 
        ~package:[]
        ~service_name:"FileServer" ~rpc_name:"ping_pong"
        ~req_mode:Client.Stream
        ~res_mode:Client.Stream
        ~encode_json_req:(fun () -> `Assoc [])
        ~encode_pb_req:(fun () enc -> Pbrt.Encoder.empty_nested enc)
        ~decode_json_res:(fun _ -> ())
        ~decode_pb_res:(fun d -> Pbrt.Decoder.empty_nested d)
        () : (unit, stream, unit, stream) Client.rpc)
  end
  
  module Server = struct
    open Pbrt_services
    
    let _rpc_touch_file : (file_path,unary,unit,unary) Server.rpc = 
      (Server.mk_rpc ~name:"touch_file"
        ~req_mode:Server.Unary
        ~res_mode:Server.Unary
        ~encode_json_res:(fun () -> `Assoc [])
        ~encode_pb_res:(fun () enc -> Pbrt.Encoder.empty_nested enc)
        ~decode_json_req:decode_json_file_path
        ~decode_pb_req:decode_pb_file_path
        () : _ Server.rpc)
    
    let _rpc_upload_file : (file_chunk,stream,file_crc,unary) Server.rpc = 
      (Server.mk_rpc ~name:"upload_file"
        ~req_mode:Server.Stream
        ~res_mode:Server.Unary
        ~encode_json_res:encode_json_file_crc
        ~encode_pb_res:encode_pb_file_crc
        ~decode_json_req:decode_json_file_chunk
        ~decode_pb_req:decode_pb_file_chunk
        () : _ Server.rpc)
    
    let _rpc_download_file : (file_path,unary,file_chunk,stream) Server.rpc = 
      (Server.mk_rpc ~name:"download_file"
        ~req_mode:Server.Unary
        ~res_mode:Server.Stream
        ~encode_json_res:encode_json_file_chunk
        ~encode_pb_res:encode_pb_file_chunk
        ~decode_json_req:decode_json_file_path
        ~decode_pb_req:decode_pb_file_path
        () : _ Server.rpc)
    
    let _rpc_ping_pong : (unit,stream,unit,stream) Server.rpc = 
      (Server.mk_rpc ~name:"ping_pong"
        ~req_mode:Server.Stream
        ~res_mode:Server.Stream
        ~encode_json_res:(fun () -> `Assoc [])
        ~encode_pb_res:(fun () enc -> Pbrt.Encoder.empty_nested enc)
        ~decode_json_req:(fun _ -> ())
        ~decode_pb_req:(fun d -> Pbrt.Decoder.empty_nested d)
        () : _ Server.rpc)
    
    let make
      ~touch_file
      ~upload_file
      ~download_file
      ~ping_pong
      () : _ Server.t =
      { Server.
        service_name="FileServer";
        package=[];
        handlers=[
           (touch_file _rpc_touch_file);
           (upload_file _rpc_upload_file);
           (download_file _rpc_download_file);
           (ping_pong _rpc_ping_pong);
        ];
      }
  end
  
end

file_server.mli

(** Code for file_server.proto *)

(* generated from "file_server.proto", do not edit *)



(** {2 Types} *)

type file_chunk = {
  path : string;
  data : bytes;
  crc : int32;
}

type file_path = {
  path : string;
}

type file_crc = {
  crc : int32;
}

type empty = unit

type ping = unit

type pong = unit


(** {2 Basic values} *)

val default_file_chunk : 
  ?path:string ->
  ?data:bytes ->
  ?crc:int32 ->
  unit ->
  file_chunk
(** [default_file_chunk ()] is the default value for type [file_chunk] *)

val default_file_path : 
  ?path:string ->
  unit ->
  file_path
(** [default_file_path ()] is the default value for type [file_path] *)

val default_file_crc : 
  ?crc:int32 ->
  unit ->
  file_crc
(** [default_file_crc ()] is the default value for type [file_crc] *)

val default_empty : unit
(** [default_empty ()] is the default value for type [empty] *)

val default_ping : unit
(** [default_ping ()] is the default value for type [ping] *)

val default_pong : unit
(** [default_pong ()] is the default value for type [pong] *)


(** {2 Formatters} *)

val pp_file_chunk : Format.formatter -> file_chunk -> unit 
(** [pp_file_chunk v] formats v *)

val pp_file_path : Format.formatter -> file_path -> unit 
(** [pp_file_path v] formats v *)

val pp_file_crc : Format.formatter -> file_crc -> unit 
(** [pp_file_crc v] formats v *)

val pp_empty : Format.formatter -> empty -> unit 
(** [pp_empty v] formats v *)

val pp_ping : Format.formatter -> ping -> unit 
(** [pp_ping v] formats v *)

val pp_pong : Format.formatter -> pong -> unit 
(** [pp_pong v] formats v *)


(** {2 Protobuf Encoding} *)

val encode_pb_file_chunk : file_chunk -> Pbrt.Encoder.t -> unit
(** [encode_pb_file_chunk v encoder] encodes [v] with the given [encoder] *)

val encode_pb_file_path : file_path -> Pbrt.Encoder.t -> unit
(** [encode_pb_file_path v encoder] encodes [v] with the given [encoder] *)

val encode_pb_file_crc : file_crc -> Pbrt.Encoder.t -> unit
(** [encode_pb_file_crc v encoder] encodes [v] with the given [encoder] *)

val encode_pb_empty : empty -> Pbrt.Encoder.t -> unit
(** [encode_pb_empty v encoder] encodes [v] with the given [encoder] *)

val encode_pb_ping : ping -> Pbrt.Encoder.t -> unit
(** [encode_pb_ping v encoder] encodes [v] with the given [encoder] *)

val encode_pb_pong : pong -> Pbrt.Encoder.t -> unit
(** [encode_pb_pong v encoder] encodes [v] with the given [encoder] *)


(** {2 Protobuf Decoding} *)

val decode_pb_file_chunk : Pbrt.Decoder.t -> file_chunk
(** [decode_pb_file_chunk decoder] decodes a [file_chunk] binary value from [decoder] *)

val decode_pb_file_path : Pbrt.Decoder.t -> file_path
(** [decode_pb_file_path decoder] decodes a [file_path] binary value from [decoder] *)

val decode_pb_file_crc : Pbrt.Decoder.t -> file_crc
(** [decode_pb_file_crc decoder] decodes a [file_crc] binary value from [decoder] *)

val decode_pb_empty : Pbrt.Decoder.t -> empty
(** [decode_pb_empty decoder] decodes a [empty] binary value from [decoder] *)

val decode_pb_ping : Pbrt.Decoder.t -> ping
(** [decode_pb_ping decoder] decodes a [ping] binary value from [decoder] *)

val decode_pb_pong : Pbrt.Decoder.t -> pong
(** [decode_pb_pong decoder] decodes a [pong] binary value from [decoder] *)


(** {2 Protobuf YoJson Encoding} *)

val encode_json_file_chunk : file_chunk -> Yojson.Basic.t
(** [encode_json_file_chunk v encoder] encodes [v] to to json *)

val encode_json_file_path : file_path -> Yojson.Basic.t
(** [encode_json_file_path v encoder] encodes [v] to to json *)

val encode_json_file_crc : file_crc -> Yojson.Basic.t
(** [encode_json_file_crc v encoder] encodes [v] to to json *)

val encode_json_empty : empty -> Yojson.Basic.t
(** [encode_json_empty v encoder] encodes [v] to to json *)

val encode_json_ping : ping -> Yojson.Basic.t
(** [encode_json_ping v encoder] encodes [v] to to json *)

val encode_json_pong : pong -> Yojson.Basic.t
(** [encode_json_pong v encoder] encodes [v] to to json *)


(** {2 JSON Decoding} *)

val decode_json_file_chunk : Yojson.Basic.t -> file_chunk
(** [decode_json_file_chunk decoder] decodes a [file_chunk] value from [decoder] *)

val decode_json_file_path : Yojson.Basic.t -> file_path
(** [decode_json_file_path decoder] decodes a [file_path] value from [decoder] *)

val decode_json_file_crc : Yojson.Basic.t -> file_crc
(** [decode_json_file_crc decoder] decodes a [file_crc] value from [decoder] *)

val decode_json_empty : Yojson.Basic.t -> empty
(** [decode_json_empty decoder] decodes a [empty] value from [decoder] *)

val decode_json_ping : Yojson.Basic.t -> ping
(** [decode_json_ping decoder] decodes a [ping] value from [decoder] *)

val decode_json_pong : Yojson.Basic.t -> pong
(** [decode_json_pong decoder] decodes a [pong] value from [decoder] *)


(** {2 Services} *)

(** FileServer service *)
module FileServer : sig
  open Pbrt_services
  open Pbrt_services.Value_mode
  
  module Client : sig
    
    val touch_file : (file_path, unary, unit, unary) Client.rpc
    
    val upload_file : (file_chunk, stream, file_crc, unary) Client.rpc
    
    val download_file : (file_path, unary, file_chunk, stream) Client.rpc
    
    val ping_pong : (unit, stream, unit, stream) Client.rpc
  end
  
  module Server : sig
    (** Produce a server implementation from handlers *)
    val make : 
      touch_file:((file_path, unary, unit, unary) Server.rpc -> 'handler) ->
      upload_file:((file_chunk, stream, file_crc, unary) Server.rpc -> 'handler) ->
      download_file:((file_path, unary, file_chunk, stream) Server.rpc -> 'handler) ->
      ping_pong:((unit, stream, unit, stream) Server.rpc -> 'handler) ->
      unit -> 'handler Pbrt_services.Server.t
  end
end

file_server.proto

// test that streaming variants all compile

syntax = "proto3";

message FileChunk {
  string path = 1;
  bytes data = 2;
  int32 crc = 3;
}

message FilePath {
  string path = 1;
} 

message FileCrc {
  /// CRC of the entire file
  int32 crc = 1;
}

message Empty {}

message Ping {}

message Pong {}

service FileServer {
  rpc touch_file(FilePath) returns (Empty);

  /// Upload a file
  rpc upload_file(stream FileChunk) returns (FileCrc);

  /// Download a file
  rpc download_file(FilePath) returns (stream FileChunk);

  // keepalive
  rpc ping_pong(stream Ping) returns (stream Pong);
}