2 * Copyright (c) 2016, Facebook, Inc.
5 * This source code is licensed under the MIT license found in the
6 * LICENSE file in the "hack" directory of this source tree.
11 open ServerCommandTypes
13 module type RefsType
= sig
15 val clear
: unit -> unit
17 val set_new_client_type
: connection_type
option -> unit
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
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
27 val get_new_client_type
: unit -> connection_type
option
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
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
38 module Refs
: RefsType
= struct
40 let new_client_type = ref None
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
)
50 let push_message = ref None
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
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
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
;
79 let clear = Refs.clear
81 let mock_new_client_type x
= Refs.set_new_client_type (Some x
)
83 let mock_client_request x
= Refs.set_client_request (Some x
)
85 let mock_unclean_disconnect () = Refs.set_unclean_disconnect true
87 let mock_persistent_client_request x
=
88 Refs.set_persistent_client_request (Some x
)
90 let get_mocked_new_client_type () = Refs.get_new_client_type ()
92 let get_mocked_client_request = function
94 Refs.get_client_request ()
96 Refs.get_persistent_client_request ()
98 let get_mocked_unclean_disconnect = function
102 Refs.get_unclean_disconnect ()
104 let record_client_response x
= function
106 Refs.set_client_response (Some x
)
108 Refs.set_persistent_client_response (Some x
)
110 let get_client_response = function
112 Refs.get_client_response ()
114 Refs.get_persistent_client_response ()
116 let record_push_message x
= Refs.set_push_message (Some x
)
118 let get_push_message = Refs.get_push_message
121 type client
= connection_type
123 exception Client_went_away
125 let provider_from_file_descriptors _
= ()
126 let provider_for_test _
= ()
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
)
132 let has_persistent_connection_request _
=
133 Option.is_some
(get_mocked_client_request Persistent
)
135 let priority_fd _
= None
137 let not_implemented () = failwith
"not implemented"
139 let get_client_fd _
= not_implemented ()
141 let accept_client _
= Non_persistent
143 let read_connection_type _
= Utils.unsafe_opt
(get_mocked_new_client_type ())
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
149 let send_push_message_to_client _ x
= record_push_message x
151 let client_has_message _
= Option.is_some
152 (get_mocked_client_request Persistent
)
154 let read_client_msg c
= Rpc
(Utils.unsafe_opt
(get_mocked_client_request c
))
156 let get_channels _
= not_implemented ()
158 let is_persistent = function
160 | Non_persistent
-> false
162 let make_persistent _
= ServerCommandTypes.Persistent
164 let shutdown_client _
= ()