package async_smtp

  1. Overview
  2. Docs
package async_smtp
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file rpc_server.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
open Core
open Async

let implementations () =
  [ List.map Rpc_impl.Smtp_events.rpcs ~f:(Rpc.Implementation.lift ~f:snd)
  ; List.map Rpc_impl.Gc.rpcs ~f:(Rpc.Implementation.lift ~f:ignore)
  ; List.map (Rpc_impl.Monitor.rpcs ()) ~f:(Rpc.Implementation.lift ~f:ignore)
  ; List.map Rpc_impl.Process.rpcs ~f:(Rpc.Implementation.lift ~f:ignore)
  ]
  |> List.concat
;;

let start (config, server_events) ~log ~plugin_rpcs =
  let initial_connection_state _socket_addr _connection = config, server_events in
  let where_to_listen = Tcp.Where_to_listen.of_port (Server_config.rpc_port config) in
  let implementations =
    implementations () @ List.map plugin_rpcs ~f:(Rpc.Implementation.lift ~f:ignore)
  in
  let implementations =
    Rpc.Implementations.create_exn ~implementations ~on_unknown_rpc:`Raise
  in
  let%bind _tcp_server =
    Rpc.Connection.serve ~implementations ~where_to_listen ~initial_connection_state ()
  in
  Log.info log "RPC server listening on %d" (Server_config.rpc_port config);
  Deferred.unit
;;