package octez-libs

  1. Overview
  2. Docs
package octez-libs
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file requester_impl.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
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** This module contains various helpers to obtain
 *  instances of {!Requester} *)

(** Wrapper for the types being used, to avoid repetitions. *)
module type PARAMETERS = sig
  type key

  type value
end

(** A disk table, that is in fact entirely in memory. *)
module Disk_memory_table (P : PARAMETERS) = struct
  include Hashtbl.Make (struct
    type t = P.key

    let hash = Hashtbl.hash

    let equal = ( = )
  end)

  type store = P.value t

  type value = P.value

  let known (st : store) (k : P.key) = Lwt.return @@ mem st k

  let read st k =
    let open Lwt_result_syntax in
    match find st k with Some v -> return v | None -> fail_with_exn Not_found

  let read_opt st k = Lwt.return @@ find st k
end

(** A simple memory table backed by [Hashtbl] *)
module Memory_table (P : PARAMETERS) :
  Requester.MEMORY_TABLE with type key = P.key = struct
  module Htbl = Hashtbl.MakeSeeded (struct
    type t = P.key

    (* See [src/lib_base/tzPervasives.ml] for an explanation *)
    [@@@ocaml.warning "-32"]

    let hash = Hashtbl.seeded_hash

    let seeded_hash = Hashtbl.seeded_hash

    [@@@ocaml.warning "+32"]

    let equal = ( = )
  end)

  type key = Htbl.key

  type 'a t = 'a Htbl.t

  let create ~entry_type:_ ?random s = Htbl.create ?random s

  let find = Htbl.find

  let add = Htbl.add

  let replace = Htbl.replace

  let remove = Htbl.remove

  let length = Htbl.length

  let fold = Htbl.fold
end

(** An instance of [PROBE] that uses a [bool] parameter
 *  to decide whether the check goes through or not *)
module Simple_probe (P : PARAMETERS) :
  Requester.PROBE
    with type key = P.key
     and type param = bool
     and type notified_value = P.value
     and type value = P.value = struct
  type key = P.key

  type param = bool

  type notified_value = P.value

  type value = P.value

  let probe (_ : key) (p : param) (nv : notified_value) =
    if p then Some nv else None
end

(** An instance of [REQUEST] that solely registers incoming requests *)
module Simple_request (P : PARAMETERS) : sig
  include Requester.REQUEST with type key = P.key and type param = unit

  val registered_requests : (param * P2p_peer.Set.elt * key list) list ref

  val clear_registered_requests : unit -> unit
end = struct
  type key = P.key

  type param = unit

  let initial_delay = Time.System.Span.of_seconds_exn 0.01

  let active (_ : param) = P2p_peer.Set.of_list [P2p_peer.Id.zero]

  let registered_requests : (param * P2p_peer.Id.t * key list) list ref = ref []

  let send (requester : param) (id : P2p_peer.Id.t) (kl : key list) =
    registered_requests := (requester, id, kl) :: !registered_requests ;
    ()

  let clear_registered_requests () = registered_requests := []
end

(** A helper to avoid having to use the full-fledged [Requester.Make]
 *  functor. We take the [Requester.REQUEST] module as parameter (instead
 *  of hardcoding the use of [Simple_request]), because
 *  callers that use [Simple_request] likely want to observe
 *  the underlying effects (see the [ref] in [Simple_request]) and hence
 *  want to pass their own instance.
 *
 *  Like {!Requester.Make}, this returns an instance of [FULL_REQUESTER].
 *  Note that, contrary to a production requester, the instance returned
 *  by this functor does not use the disk, it runs entirely in memory. *)
module Make_memory_full_requester
    (H : Requester.HASH)
    (P : PARAMETERS with type key = H.t)
    (R : Requester.REQUEST with type param = unit and type key = H.t) :
  Requester.FULL_REQUESTER
    with type key = H.t
     and type value = P.value
     and type param = bool
     and type request_param = unit
     and type notified_value = P.value
     and type store = Disk_memory_table(P).store =
  Requester.Make (H) (Disk_memory_table (P)) (Memory_table (P)) (R)
    (Simple_probe (P))
OCaml

Innovation. Community. Security.

GitHub Discord Twitter Peertube RSS
About
Changelog Releases Industrial Users Academic Users Why OCaml
Ecosystem
Packages Community Events OCaml Planet Jobs
Resources
Install OCaml Get Started Platform Tools Language Manual Standard Library API Books Exercises Papers OCaml Playground Logo
Policies
Carbon Footprint Governance Privacy Code of Conduct