Source file `rpc_shapes.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
module Stable = struct
  open! Core.Core_stable

  (* We can't make [Bin_prot.Shape.t] binable directly because that would introduce a
     circular dependency, so we make it [Binable.Of_sexpable_with_uuid] here instead. This
     allows us to send the shape over the wire as part of the
     [Versioned_rpc.Shape_menu.t]. [Bin_prot.Shape.Canonical.t], though exposed and
     therefore binable, is not a suitable alternative because it has an exponential
     expansion. *)
  module Shape = struct
    module V1 = struct
      module T = struct
        include Bin_prot.Shape.Stable.V1

        let caller_identity =
          Bin_prot.Shape.Uuid.of_string "0aa53549-ad88-4b4f-abc7-1f8453e7aa11"
        ;;
      end

      include T
      include Binable.Of_sexpable.V2 (T)
    end
  end

  module V1 = struct
    type t =
      | Rpc of
          { query : Shape.V1.t
          ; response : Shape.V1.t
          }
      | One_way of { msg : Shape.V1.t }
      | Streaming_rpc of
          { query : Shape.V1.t
          ; initial_response : Shape.V1.t
          ; update_response : Shape.V1.t
          ; error : Shape.V1.t
          }
      | Unknown
    [@@deriving bin_io, sexp]
  end

  module Just_digests = struct
    module Digest = struct
      module V1 = struct
        type t = Bin_shape.Digest.t [@@deriving sexp, compare]

        let equal t1 t2 = [%compare.equal: t] t1 t2
        let hash_fold_t s t = Core.Md5.hash_fold_t s (Bin_shape.Digest.to_md5 t)

        include
          Binable.Of_binable.V2
            (Bin_prot.Md5.Stable.V1)
            (struct
              type nonrec t = t

              let to_binable = Bin_shape.Digest.to_md5
              let of_binable = Bin_shape.Digest.of_md5

              let caller_identity =
                Bin_prot.Shape.Uuid.of_string "d8669bfc-1cdf-11ee-9283-aa42dc4c5cc4"
              ;;
            end)
      end
    end

    module V1 = struct
      type t =
        | Rpc of
            { query : Digest.V1.t
            ; response : Digest.V1.t
            }
        | One_way of { msg : Digest.V1.t }
        | Streaming_rpc of
            { query : Digest.V1.t
            ; initial_response : Digest.V1.t
            ; update_response : Digest.V1.t
            ; error : Digest.V1.t
            }
        | Unknown
      [@@deriving bin_io, equal, compare, hash, sexp]
    end
  end
end

open! Core

module Shape = struct
  type t = Bin_prot.Shape.t

  (* An unstable sexper that's useful for expect tests, printing out the shape digests
     instead of the shapes themselves. *)
  let sexp_of_t t = [%sexp (Bin_prot.Shape.eval_to_digest_string t : string)]
end

type t = Stable.V1.t =
  | Rpc of
      { query : Shape.t
      ; response : Shape.t
      }
  | One_way of { msg : Shape.t }
  | Streaming_rpc of
      { query : Shape.t
      ; initial_response : Shape.t
      ; update_response : Shape.t
      ; error : Shape.t
      }
  | Unknown
[@@deriving sexp_of]

module Just_digests = struct
  type t = Stable.Just_digests.V1.t =
    | Rpc of
        { query : Bin_shape.Digest.t
        ; response : Bin_shape.Digest.t
        }
    | One_way of { msg : Bin_shape.Digest.t }
    | Streaming_rpc of
        { query : Bin_shape.Digest.t
        ; initial_response : Bin_shape.Digest.t
        ; update_response : Bin_shape.Digest.t
        ; error : Bin_shape.Digest.t
        }
    | Unknown
  [@@deriving sexp_of, compare, variants]

  module Strict_comparison = struct
    type nonrec t = t [@@deriving compare]
  end

  let same_kind = Comparable.lift [%equal: int] ~f:Variants.to_rank
end

let eval_to_digest (t : t) : Just_digests.t =
  let digest shape = Bin_prot.Shape.eval_to_digest shape in
  match t with
  | Rpc { query; response } -> Rpc { query = digest query; response = digest response }
  | One_way { msg } -> One_way { msg = digest msg }
  | Streaming_rpc { query; initial_response; update_response; error } ->
    Streaming_rpc
      { query = digest query
      ; initial_response = digest initial_response
      ; update_response = digest update_response
      ; error = digest error
      }
  | Unknown -> Unknown
;;