hphp/hack/src/server/testClientProvider.ml

   1 (**
   2  * Copyright (c) 2016, Facebook, Inc.
   3  * All rights reserved.
   4  *
   5  * This source code is licensed under the MIT license found in the
   6  * LICENSE file in the "hack" directory of this source tree.
   7  *
   8  *)
   9
  10 open Core_kernel
  11 open ServerCommandTypes
  12
  13 module type RefsType = sig
  14
  15   val clear: unit -> unit
  16
  17   val set_new_client_type: connection_type option -> unit
  18
  19   val set_client_request: 'a ServerCommandTypes.t option -> unit
  20   val set_client_response: 'a option -> unit
  21   val set_unclean_disconnect: bool -> unit
  22
  23   val set_persistent_client_request: 'a ServerCommandTypes.t option -> unit
  24   val set_persistent_client_response: 'a option  -> unit
  25   val set_push_message: ServerCommandTypes.push option -> unit
  26
  27   val get_new_client_type: unit -> connection_type option
  28
  29   val get_client_request: unit -> 'a ServerCommandTypes.t option
  30   val get_client_response: unit -> 'a option
  31   val get_unclean_disconnect: unit -> bool
  32
  33   val get_persistent_client_request: unit -> 'b
  34   val get_persistent_client_response: unit -> 'a option
  35   val get_push_message: unit -> ServerCommandTypes.push option
  36 end
  37
  38 module Refs : RefsType = struct
  39
  40   let new_client_type = ref None
  41
  42   (* Those references are used for mocking the results of Marshal.from_channel
  43    * function, which is untypeable. Hence, Obj.magic *)
  44   let client_request = Obj.magic (ref None)
  45   let client_response = Obj.magic (ref None)
  46   let unclean_disconnect = ref false
  47   let persistent_client_request = Obj.magic (ref None)
  48   let persistent_client_response = Obj.magic (ref None)
  49
  50   let push_message = ref None
  51
  52   let set_new_client_type x = new_client_type := x
  53   let set_client_request x = client_request := x
  54   let set_client_response x = client_response := x
  55   let set_unclean_disconnect x = unclean_disconnect := x
  56   let set_persistent_client_request x = persistent_client_request := x
  57   let set_persistent_client_response x = persistent_client_response := x
  58   let set_push_message x = push_message := x
  59
  60   let get_new_client_type () = !new_client_type
  61   let get_client_response () = !client_response
  62   let get_unclean_disconnect () = !unclean_disconnect
  63   let get_client_request () = !client_request
  64   let get_persistent_client_request () = !persistent_client_request
  65   let get_persistent_client_response () = !persistent_client_response
  66   let get_push_message () = !push_message
  67
  68   let clear () =
  69     set_new_client_type None;
  70     set_client_request None;
  71     set_client_response None;
  72     set_unclean_disconnect false;
  73     set_persistent_client_request None;
  74     set_persistent_client_response None;
  75     set_persistent_client_response None;
  76     set_push_message None;
  77 end
  78
  79 let clear = Refs.clear
  80
  81 let mock_new_client_type x = Refs.set_new_client_type (Some x)
  82
  83 let mock_client_request x = Refs.set_client_request (Some x)
  84
  85 let mock_unclean_disconnect () = Refs.set_unclean_disconnect true
  86
  87 let mock_persistent_client_request x =
  88   Refs.set_persistent_client_request (Some x)
  89
  90 let get_mocked_new_client_type () = Refs.get_new_client_type ()
  91
  92 let get_mocked_client_request = function
  93   | Non_persistent ->
  94       Refs.get_client_request ()
  95   | Persistent ->
  96       Refs.get_persistent_client_request ()
  97
  98 let get_mocked_unclean_disconnect = function
  99   | Non_persistent ->
 100     false
 101   | Persistent ->
 102     Refs.get_unclean_disconnect ()
 103
 104 let record_client_response x = function
 105   | Non_persistent ->
 106       Refs.set_client_response (Some x)
 107   | Persistent ->
 108       Refs.set_persistent_client_response (Some x)
 109
 110 let get_client_response = function
 111   | Non_persistent ->
 112       Refs.get_client_response ()
 113   | Persistent ->
 114       Refs.get_persistent_client_response ()
 115
 116 let record_push_message x = Refs.set_push_message (Some x)
 117
 118 let get_push_message = Refs.get_push_message
 119
 120 type t = unit
 121 type client = connection_type
 122
 123 exception Client_went_away
 124
 125 let provider_from_file_descriptors _ = ()
 126 let provider_for_test _ = ()
 127
 128 let sleep_and_check _ _ ~ide_idle:_ ~idle_gc_slice:_ _ =
 129   get_mocked_new_client_type (),
 130   Option.is_some (get_mocked_client_request Persistent)
 131
 132 let has_persistent_connection_request _ =
 133   Option.is_some (get_mocked_client_request Persistent)
 134
 135 let priority_fd _ = None
 136
 137 let not_implemented () = failwith "not implemented"
 138
 139 let get_client_fd _ = not_implemented ()
 140
 141 let accept_client _ = Non_persistent
 142
 143 let read_connection_type _ = Utils.unsafe_opt (get_mocked_new_client_type ())
 144
 145 let send_response_to_client c x _t =
 146   if get_mocked_unclean_disconnect c then raise Client_went_away else
 147   record_client_response x c
 148
 149 let send_push_message_to_client _ x = record_push_message x
 150
 151 let client_has_message _ = Option.is_some
 152   (get_mocked_client_request Persistent)
 153
 154 let read_client_msg c = Rpc (Utils.unsafe_opt (get_mocked_client_request c))
 155
 156 let get_channels _ = not_implemented ()
 157
 158 let is_persistent = function
 159   | Persistent -> true
 160   | Non_persistent -> false
 161
 162 let make_persistent _ = ServerCommandTypes.Persistent
 163
 164 let shutdown_client _ = ()
 165
 166 let ping _ = ()