Add comprehensive HTTP header support based on IANA registry · jon.recoil.org/monopam-myspace@663e941

+2 -1

ocaml-requests/lib/dune

··· 28 28 decompress.zl 29 29 decompress.gz 30 30 bigstringaf 31 - magic-mime)) 31 + magic-mime 32 + digestif))

+590 -64

ocaml-requests/lib/header_name.ml

··· 7 7 8 8 This module provides type-safe HTTP header names using polymorphic variants. 9 9 All standard headers have dedicated variants, with [`Other] for non-standard 10 - or unknown headers. Header names are case-insensitive per RFC 9110 Section 5.1. *) 10 + or unknown headers. Header names are case-insensitive per RFC 9110 Section 5.1. 11 + 12 + Header definitions are based on the IANA HTTP Field Name Registry: 13 + {{:https://www.iana.org/assignments/http-fields/http-fields.xhtml} IANA HTTP Field Name Registry} 14 + 15 + @see <https://www.rfc-editor.org/rfc/rfc9110> RFC 9110: HTTP Semantics 16 + @see <https://www.rfc-editor.org/rfc/rfc9111> RFC 9111: HTTP Caching 17 + @see <https://www.rfc-editor.org/rfc/rfc9112> RFC 9112: HTTP/1.1 *) 11 18 12 - (** Standard HTTP header names. 19 + (** {1 Standard HTTP Headers} 13 20 14 - These cover all headers defined in RFC 9110, RFC 9111, RFC 9112, and 15 - common authentication headers from RFC 7235, RFC 7617, RFC 6750. *) 21 + These cover headers defined in: 22 + - RFC 9110 (HTTP Semantics) 23 + - RFC 9111 (HTTP Caching) 24 + - RFC 9112 (HTTP/1.1) 25 + - RFC 6455 (WebSocket Protocol) 26 + - RFC 9421 (HTTP Message Signatures) 27 + - RFC 9530 (Digest Fields) 28 + - Fetch Standard (CORS and Security) 29 + - Various other RFCs as noted *) 16 30 type standard = [ 31 + (* {2 RFC 9110: HTTP Semantics - Content Headers} *) 32 + 17 33 | `Accept 34 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-12.5.1> RFC 9110 Section 12.5.1 *) 18 35 | `Accept_encoding 36 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-12.5.3> RFC 9110 Section 12.5.3 *) 19 37 | `Accept_language 20 - | `Age 21 - | `Authorization 22 - | `Cache_control 23 - | `Connection 38 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-12.5.4> RFC 9110 Section 12.5.4 *) 39 + | `Accept_ranges 40 + (** Indicates whether server supports range requests. 41 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-14.3> RFC 9110 Section 14.3 *) 42 + | `Allow 43 + (** Lists HTTP methods supported by target resource. 44 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-10.2.1> RFC 9110 Section 10.2.1 *) 24 45 | `Content_encoding 46 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-8.4> RFC 9110 Section 8.4 *) 47 + | `Content_language 48 + (** Natural language(s) of the intended audience. 49 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-8.5> RFC 9110 Section 8.5 *) 25 50 | `Content_length 51 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-8.6> RFC 9110 Section 8.6 *) 52 + | `Content_location 53 + (** URI reference for the representation. 54 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-8.7> RFC 9110 Section 8.7 *) 55 + | `Content_range 56 + (** Indicates which part of representation is enclosed (206 responses). 57 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-14.4> RFC 9110 Section 14.4 *) 26 58 | `Content_type 27 - | `Cookie 28 - | `Date 29 - | `Etag 59 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-8.3> RFC 9110 Section 8.3 *) 60 + 61 + (* {2 RFC 9110: HTTP Semantics - Request Context} *) 62 + 30 63 | `Expect 31 - | `Expires 64 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-10.1.1> RFC 9110 Section 10.1.1 *) 65 + | `From 66 + (** Email address of the human user controlling the user agent. 67 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-10.1.2> RFC 9110 Section 10.1.2 *) 32 68 | `Host 69 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-7.2> RFC 9110 Section 7.2 *) 70 + | `Max_forwards 71 + (** Limits forwarding of TRACE/OPTIONS requests. 72 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-7.6.2> RFC 9110 Section 7.6.2 *) 73 + | `Range 74 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-14.2> RFC 9110 Section 14.2 *) 75 + | `Referer 76 + (** URI of the resource from which request URI was obtained. 77 + Note: Header name is intentionally misspelled (historical). 78 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-10.1.3> RFC 9110 Section 10.1.3 *) 79 + | `Te 80 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-10.1.4> RFC 9110 Section 10.1.4 *) 81 + | `User_agent 82 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-10.1.5> RFC 9110 Section 10.1.5 *) 83 + 84 + (* {2 RFC 9110: HTTP Semantics - Response Context} *) 85 + 86 + | `Location 87 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-10.2.2> RFC 9110 Section 10.2.2 *) 88 + | `Retry_after 89 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-10.2.3> RFC 9110 Section 10.2.3 *) 90 + | `Server 91 + (** Information about the origin server software. 92 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-10.2.4> RFC 9110 Section 10.2.4 *) 93 + 94 + (* {2 RFC 9110: HTTP Semantics - Validators} *) 95 + 96 + | `Etag 97 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-8.8.3> RFC 9110 Section 8.8.3 *) 98 + | `Last_modified 99 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-8.8.2> RFC 9110 Section 8.8.2 *) 100 + | `Vary 101 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-12.5.5> RFC 9110 Section 12.5.5 *) 102 + 103 + (* {2 RFC 9110: HTTP Semantics - Conditional Requests} *) 104 + 33 105 | `If_match 106 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-13.1.1> RFC 9110 Section 13.1.1 *) 34 107 | `If_modified_since 108 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-13.1.3> RFC 9110 Section 13.1.3 *) 35 109 | `If_none_match 110 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-13.1.2> RFC 9110 Section 13.1.2 *) 111 + | `If_range 112 + (** Makes Range request conditional on representation unchanged. 113 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-13.1.5> RFC 9110 Section 13.1.5 *) 36 114 | `If_unmodified_since 37 - | `Keep_alive 38 - | `Last_modified 39 - | `Link 40 - | `Location 115 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-13.1.4> RFC 9110 Section 13.1.4 *) 116 + 117 + (* {2 RFC 9110: HTTP Semantics - Authentication} *) 118 + 119 + | `Authorization 120 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-11.6.2> RFC 9110 Section 11.6.2 *) 121 + | `Authentication_info 122 + (** Server sends after successful auth (e.g., nextnonce for Digest). 123 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-11.6.3> RFC 9110 Section 11.6.3 *) 41 124 | `Proxy_authenticate 125 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-11.7.1> RFC 9110 Section 11.7.1 *) 126 + | `Proxy_authentication_info 127 + (** Proxy sends after successful auth. 128 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-11.7.3> RFC 9110 Section 11.7.3 *) 42 129 | `Proxy_authorization 43 - | `Range 44 - | `Retry_after 45 - | `Set_cookie 46 - | `Te 130 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-11.7.2> RFC 9110 Section 11.7.2 *) 131 + | `Www_authenticate 132 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-11.6.1> RFC 9110 Section 11.6.1 *) 133 + 134 + (* {2 RFC 9110: HTTP Semantics - Connection Management} *) 135 + 136 + | `Connection 137 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-7.6.1> RFC 9110 Section 7.6.1 *) 138 + | `Upgrade 139 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-7.8> RFC 9110 Section 7.8 *) 140 + | `Via 141 + (** Records intermediate protocols and recipients (proxies/gateways). 142 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-7.6.3> RFC 9110 Section 7.6.3 *) 143 + 144 + (* {2 RFC 9110: HTTP Semantics - Date} *) 145 + 146 + | `Date 147 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-6.6.1> RFC 9110 Section 6.6.1 *) 148 + 149 + (* {2 RFC 9111: HTTP Caching} *) 150 + 151 + | `Age 152 + (** @see <https://www.rfc-editor.org/rfc/rfc9111#section-5.1> RFC 9111 Section 5.1 *) 153 + | `Cache_control 154 + (** @see <https://www.rfc-editor.org/rfc/rfc9111#section-5.2> RFC 9111 Section 5.2 *) 155 + | `Expires 156 + (** @see <https://www.rfc-editor.org/rfc/rfc9111#section-5.3> RFC 9111 Section 5.3 *) 157 + | `Pragma 158 + (** Deprecated but widely used for HTTP/1.0 compatibility. 159 + @see <https://www.rfc-editor.org/rfc/rfc9111#section-5.4> RFC 9111 Section 5.4 160 + @deprecated Use Cache-Control instead *) 161 + | `Cache_status 162 + (** Structured field indicating cache handling (hit/miss/etc). 163 + @see <https://www.rfc-editor.org/rfc/rfc9211> RFC 9211 *) 164 + 165 + (* {2 RFC 9112: HTTP/1.1} *) 166 + 167 + | `Keep_alive 168 + (** @see <https://www.rfc-editor.org/rfc/rfc2068#section-19.7.1> RFC 2068 Section 19.7.1 *) 47 169 | `Trailer 170 + (** @see <https://www.rfc-editor.org/rfc/rfc9110#section-6.6.2> RFC 9110 Section 6.6.2 *) 48 171 | `Transfer_encoding 49 - | `Upgrade 50 - | `User_agent 51 - | `Vary 52 - | `Www_authenticate 172 + (** @see <https://www.rfc-editor.org/rfc/rfc9112#section-6.1> RFC 9112 Section 6.1 *) 173 + 174 + (* {2 Cookies - RFC 6265bis} *) 175 + 176 + | `Cookie 177 + (** @see <https://www.rfc-editor.org/rfc/rfc6265> RFC 6265 *) 178 + | `Set_cookie 179 + (** @see <https://www.rfc-editor.org/rfc/rfc6265> RFC 6265 *) 180 + 181 + (* {2 Link Relations - RFC 8288} *) 182 + 183 + | `Link 184 + (** @see <https://www.rfc-editor.org/rfc/rfc8288> RFC 8288 *) 185 + 186 + (* {2 CORS Headers - Fetch Standard} 187 + 188 + Cross-Origin Resource Sharing headers for controlling cross-origin requests. 189 + @see <https://fetch.spec.whatwg.org/> Fetch Standard *) 190 + 191 + | `Access_control_allow_credentials 192 + (** Whether response can be shared when credentials mode is "include". 193 + @see <https://fetch.spec.whatwg.org/#http-access-control-allow-credentials> Fetch *) 194 + | `Access_control_allow_headers 195 + (** Headers allowed in actual request. 196 + @see <https://fetch.spec.whatwg.org/#http-access-control-allow-headers> Fetch *) 197 + | `Access_control_allow_methods 198 + (** HTTP methods allowed for actual request. 199 + @see <https://fetch.spec.whatwg.org/#http-access-control-allow-methods> Fetch *) 200 + | `Access_control_allow_origin 201 + (** Whether response can be shared, by origin. 202 + @see <https://fetch.spec.whatwg.org/#http-access-control-allow-origin> Fetch *) 203 + | `Access_control_expose_headers 204 + (** Headers that can be exposed to the requesting script. 205 + @see <https://fetch.spec.whatwg.org/#http-access-control-expose-headers> Fetch *) 206 + | `Access_control_max_age 207 + (** How long preflight results can be cached. 208 + @see <https://fetch.spec.whatwg.org/#http-access-control-max-age> Fetch *) 209 + | `Access_control_request_headers 210 + (** Headers to be used in actual request (preflight). 211 + @see <https://fetch.spec.whatwg.org/#http-access-control-request-headers> Fetch *) 212 + | `Access_control_request_method 213 + (** Method to be used in actual request (preflight). 214 + @see <https://fetch.spec.whatwg.org/#http-access-control-request-method> Fetch *) 215 + | `Origin 216 + (** Origin of the request. 217 + @see <https://www.rfc-editor.org/rfc/rfc6454> RFC 6454 *) 218 + 219 + (* {2 Cross-Origin Policy Headers - HTML Standard} *) 220 + 221 + | `Cross_origin_embedder_policy 222 + (** Controls cross-origin embedding. 223 + @see <https://html.spec.whatwg.org/multipage/origin.html#coep> HTML *) 224 + | `Cross_origin_embedder_policy_report_only 225 + (** Report-only mode for COEP. 226 + @see <https://html.spec.whatwg.org/multipage/origin.html#coep> HTML *) 227 + | `Cross_origin_opener_policy 228 + (** Controls browsing context group sharing. 229 + @see <https://html.spec.whatwg.org/multipage/origin.html#cross-origin-opener-policies> HTML *) 230 + | `Cross_origin_opener_policy_report_only 231 + (** Report-only mode for COOP. 232 + @see <https://html.spec.whatwg.org/multipage/origin.html#cross-origin-opener-policies> HTML *) 233 + | `Cross_origin_resource_policy 234 + (** Controls no-cors cross-origin requests. 235 + @see <https://fetch.spec.whatwg.org/#cross-origin-resource-policy-header> Fetch *) 236 + 237 + (* {2 Fetch Metadata Headers - W3C} 238 + 239 + Request headers providing context about the request initiator. 240 + @see <https://www.w3.org/TR/fetch-metadata/> Fetch Metadata Request Headers *) 241 + 242 + | `Sec_fetch_dest 243 + (** Request destination (document, image, script, etc.). 244 + @see <https://www.w3.org/TR/fetch-metadata/#sec-fetch-dest-header> Fetch Metadata *) 245 + | `Sec_fetch_mode 246 + (** Request mode (cors, navigate, no-cors, same-origin, websocket). 247 + @see <https://www.w3.org/TR/fetch-metadata/#sec-fetch-mode-header> Fetch Metadata *) 248 + | `Sec_fetch_site 249 + (** Relationship between initiator and target (cross-site, same-origin, etc.). 250 + @see <https://www.w3.org/TR/fetch-metadata/#sec-fetch-site-header> Fetch Metadata *) 251 + | `Sec_fetch_user 252 + (** Whether navigation was user-activated. 253 + @see <https://www.w3.org/TR/fetch-metadata/#sec-fetch-user-header> Fetch Metadata *) 254 + 255 + (* {2 Security Headers} *) 256 + 257 + | `Content_security_policy 258 + (** Controls resources user agent is allowed to load. 259 + @see <https://www.w3.org/TR/CSP3/> Content Security Policy Level 3 *) 260 + | `Content_security_policy_report_only 261 + (** Report-only mode for CSP. 262 + @see <https://www.w3.org/TR/CSP3/> Content Security Policy Level 3 *) 263 + | `Strict_transport_security 264 + (** Instructs browser to only use HTTPS (HSTS). 265 + @see <https://www.rfc-editor.org/rfc/rfc6797> RFC 6797 *) 266 + | `X_content_type_options 267 + (** Prevents MIME type sniffing. Value: "nosniff". 268 + @see <https://fetch.spec.whatwg.org/#x-content-type-options-header> Fetch *) 269 + | `X_frame_options 270 + (** Controls whether page can be displayed in frame/iframe. 271 + @see <https://html.spec.whatwg.org/multipage/browsing-the-web.html#the-x-frame-options-header> HTML *) 272 + | `Referrer_policy 273 + (** Controls how much referrer info is included. 274 + @see <https://www.w3.org/TR/referrer-policy/> Referrer Policy *) 275 + 276 + (* {2 RFC 8053: Interactive Authentication} *) 277 + 278 + | `Optional_www_authenticate 279 + (** Offers authentication without requiring it (HTTP 200 with auth option). 280 + @see <https://www.rfc-editor.org/rfc/rfc8053#section-3> RFC 8053 Section 3 *) 281 + | `Authentication_control 282 + (** Controls authentication UI behavior. 283 + @see <https://www.rfc-editor.org/rfc/rfc8053#section-4> RFC 8053 Section 4 *) 284 + 285 + (* {2 RFC 9449: OAuth 2.0 DPoP} *) 286 + 287 + | `Dpop 288 + (** Demonstrating Proof of Possession token. 289 + @see <https://www.rfc-editor.org/rfc/rfc9449> RFC 9449 *) 290 + | `Dpop_nonce 291 + (** Server-provided nonce for DPoP. 292 + @see <https://www.rfc-editor.org/rfc/rfc9449> RFC 9449 *) 293 + 294 + (* {2 RFC 9530: Digest Fields} *) 295 + 296 + | `Content_digest 297 + (** Digest of message content (after content-coding). 298 + @see <https://www.rfc-editor.org/rfc/rfc9530#section-2> RFC 9530 Section 2 *) 299 + | `Repr_digest 300 + (** Digest of representation (before content-coding). 301 + @see <https://www.rfc-editor.org/rfc/rfc9530#section-3> RFC 9530 Section 3 *) 302 + | `Want_content_digest 303 + (** Request for Content-Digest in response. 304 + @see <https://www.rfc-editor.org/rfc/rfc9530#section-4> RFC 9530 Section 4 *) 305 + | `Want_repr_digest 306 + (** Request for Repr-Digest in response. 307 + @see <https://www.rfc-editor.org/rfc/rfc9530#section-4> RFC 9530 Section 4 *) 308 + 309 + (* {2 RFC 9421: HTTP Message Signatures} *) 310 + 311 + | `Signature 312 + (** Cryptographic signature over message components. 313 + @see <https://www.rfc-editor.org/rfc/rfc9421#section-4.2> RFC 9421 Section 4.2 *) 314 + | `Signature_input 315 + (** Metadata for signatures (components, algorithm, key ID, etc.). 316 + @see <https://www.rfc-editor.org/rfc/rfc9421#section-4.1> RFC 9421 Section 4.1 *) 317 + | `Accept_signature 318 + (** Indicates client can process signatures. 319 + @see <https://www.rfc-editor.org/rfc/rfc9421#section-5.1> RFC 9421 Section 5.1 *) 320 + 321 + (* {2 RFC 6455: WebSocket Protocol} 322 + 323 + Headers used during WebSocket HTTP Upgrade handshake. 324 + @see <https://www.rfc-editor.org/rfc/rfc6455> RFC 6455 *) 325 + 326 + | `Sec_websocket_key 327 + (** Client's base64-encoded 16-byte random nonce. 328 + @see <https://www.rfc-editor.org/rfc/rfc6455#section-4.1> RFC 6455 Section 4.1 *) 329 + | `Sec_websocket_accept 330 + (** Server's proof of handshake (SHA-1 of key + GUID, base64). 331 + @see <https://www.rfc-editor.org/rfc/rfc6455#section-4.2.2> RFC 6455 Section 4.2.2 *) 332 + | `Sec_websocket_protocol 333 + (** Subprotocol negotiation. 334 + @see <https://www.rfc-editor.org/rfc/rfc6455#section-11.3.4> RFC 6455 Section 11.3.4 *) 335 + | `Sec_websocket_version 336 + (** WebSocket protocol version (must be "13"). 337 + @see <https://www.rfc-editor.org/rfc/rfc6455#section-4.1> RFC 6455 Section 4.1 *) 338 + | `Sec_websocket_extensions 339 + (** Extension negotiation (e.g., permessage-deflate). 340 + @see <https://www.rfc-editor.org/rfc/rfc6455#section-9> RFC 6455 Section 9 *) 53 341 ] 54 342 55 343 (** Complete header name type including non-standard headers. ··· 63 351 Standard headers are converted to their canonical capitalization. 64 352 [`Other] headers are returned as-is. *) 65 353 let to_string : t -> string = function 354 + (* RFC 9110: Content *) 66 355 | `Accept -> "Accept" 67 356 | `Accept_encoding -> "Accept-Encoding" 68 357 | `Accept_language -> "Accept-Language" 69 - | `Age -> "Age" 70 - | `Authorization -> "Authorization" 71 - | `Cache_control -> "Cache-Control" 72 - | `Connection -> "Connection" 358 + | `Accept_ranges -> "Accept-Ranges" 359 + | `Allow -> "Allow" 73 360 | `Content_encoding -> "Content-Encoding" 361 + | `Content_language -> "Content-Language" 74 362 | `Content_length -> "Content-Length" 363 + | `Content_location -> "Content-Location" 364 + | `Content_range -> "Content-Range" 75 365 | `Content_type -> "Content-Type" 76 - | `Cookie -> "Cookie" 77 - | `Date -> "Date" 78 - | `Etag -> "ETag" 366 + (* RFC 9110: Request Context *) 79 367 | `Expect -> "Expect" 80 - | `Expires -> "Expires" 368 + | `From -> "From" 81 369 | `Host -> "Host" 370 + | `Max_forwards -> "Max-Forwards" 371 + | `Range -> "Range" 372 + | `Referer -> "Referer" 373 + | `Te -> "TE" 374 + | `User_agent -> "User-Agent" 375 + (* RFC 9110: Response Context *) 376 + | `Location -> "Location" 377 + | `Retry_after -> "Retry-After" 378 + | `Server -> "Server" 379 + (* RFC 9110: Validators *) 380 + | `Etag -> "ETag" 381 + | `Last_modified -> "Last-Modified" 382 + | `Vary -> "Vary" 383 + (* RFC 9110: Conditional *) 82 384 | `If_match -> "If-Match" 83 385 | `If_modified_since -> "If-Modified-Since" 84 386 | `If_none_match -> "If-None-Match" 387 + | `If_range -> "If-Range" 85 388 | `If_unmodified_since -> "If-Unmodified-Since" 86 - | `Keep_alive -> "Keep-Alive" 87 - | `Last_modified -> "Last-Modified" 88 - | `Link -> "Link" 89 - | `Location -> "Location" 389 + (* RFC 9110: Authentication *) 390 + | `Authorization -> "Authorization" 391 + | `Authentication_info -> "Authentication-Info" 90 392 | `Proxy_authenticate -> "Proxy-Authenticate" 393 + | `Proxy_authentication_info -> "Proxy-Authentication-Info" 91 394 | `Proxy_authorization -> "Proxy-Authorization" 92 - | `Range -> "Range" 93 - | `Retry_after -> "Retry-After" 94 - | `Set_cookie -> "Set-Cookie" 95 - | `Te -> "TE" 395 + | `Www_authenticate -> "WWW-Authenticate" 396 + (* RFC 9110: Connection *) 397 + | `Connection -> "Connection" 398 + | `Upgrade -> "Upgrade" 399 + | `Via -> "Via" 400 + (* RFC 9110: Date *) 401 + | `Date -> "Date" 402 + (* RFC 9111: Caching *) 403 + | `Age -> "Age" 404 + | `Cache_control -> "Cache-Control" 405 + | `Expires -> "Expires" 406 + | `Pragma -> "Pragma" 407 + | `Cache_status -> "Cache-Status" 408 + (* RFC 9112: HTTP/1.1 *) 409 + | `Keep_alive -> "Keep-Alive" 96 410 | `Trailer -> "Trailer" 97 411 | `Transfer_encoding -> "Transfer-Encoding" 98 - | `Upgrade -> "Upgrade" 99 - | `User_agent -> "User-Agent" 100 - | `Vary -> "Vary" 101 - | `Www_authenticate -> "WWW-Authenticate" 412 + (* Cookies *) 413 + | `Cookie -> "Cookie" 414 + | `Set_cookie -> "Set-Cookie" 415 + (* Link *) 416 + | `Link -> "Link" 417 + (* CORS *) 418 + | `Access_control_allow_credentials -> "Access-Control-Allow-Credentials" 419 + | `Access_control_allow_headers -> "Access-Control-Allow-Headers" 420 + | `Access_control_allow_methods -> "Access-Control-Allow-Methods" 421 + | `Access_control_allow_origin -> "Access-Control-Allow-Origin" 422 + | `Access_control_expose_headers -> "Access-Control-Expose-Headers" 423 + | `Access_control_max_age -> "Access-Control-Max-Age" 424 + | `Access_control_request_headers -> "Access-Control-Request-Headers" 425 + | `Access_control_request_method -> "Access-Control-Request-Method" 426 + | `Origin -> "Origin" 427 + (* Cross-Origin Policy *) 428 + | `Cross_origin_embedder_policy -> "Cross-Origin-Embedder-Policy" 429 + | `Cross_origin_embedder_policy_report_only -> "Cross-Origin-Embedder-Policy-Report-Only" 430 + | `Cross_origin_opener_policy -> "Cross-Origin-Opener-Policy" 431 + | `Cross_origin_opener_policy_report_only -> "Cross-Origin-Opener-Policy-Report-Only" 432 + | `Cross_origin_resource_policy -> "Cross-Origin-Resource-Policy" 433 + (* Sec-Fetch *) 434 + | `Sec_fetch_dest -> "Sec-Fetch-Dest" 435 + | `Sec_fetch_mode -> "Sec-Fetch-Mode" 436 + | `Sec_fetch_site -> "Sec-Fetch-Site" 437 + | `Sec_fetch_user -> "Sec-Fetch-User" 438 + (* Security *) 439 + | `Content_security_policy -> "Content-Security-Policy" 440 + | `Content_security_policy_report_only -> "Content-Security-Policy-Report-Only" 441 + | `Strict_transport_security -> "Strict-Transport-Security" 442 + | `X_content_type_options -> "X-Content-Type-Options" 443 + | `X_frame_options -> "X-Frame-Options" 444 + | `Referrer_policy -> "Referrer-Policy" 445 + (* RFC 8053: Interactive Auth *) 446 + | `Optional_www_authenticate -> "Optional-WWW-Authenticate" 447 + | `Authentication_control -> "Authentication-Control" 448 + (* RFC 9449: DPoP *) 449 + | `Dpop -> "DPoP" 450 + | `Dpop_nonce -> "DPoP-Nonce" 451 + (* RFC 9530: Digest Fields *) 452 + | `Content_digest -> "Content-Digest" 453 + | `Repr_digest -> "Repr-Digest" 454 + | `Want_content_digest -> "Want-Content-Digest" 455 + | `Want_repr_digest -> "Want-Repr-Digest" 456 + (* RFC 9421: Signatures *) 457 + | `Signature -> "Signature" 458 + | `Signature_input -> "Signature-Input" 459 + | `Accept_signature -> "Accept-Signature" 460 + (* RFC 6455: WebSocket *) 461 + | `Sec_websocket_key -> "Sec-WebSocket-Key" 462 + | `Sec_websocket_accept -> "Sec-WebSocket-Accept" 463 + | `Sec_websocket_protocol -> "Sec-WebSocket-Protocol" 464 + | `Sec_websocket_version -> "Sec-WebSocket-Version" 465 + | `Sec_websocket_extensions -> "Sec-WebSocket-Extensions" 466 + (* Other *) 102 467 | `Other s -> s 103 468 104 469 (** Convert a string to a header name. ··· 107 472 Unknown headers are wrapped in [`Other]. *) 108 473 let of_string s : t = 109 474 match String.lowercase_ascii s with 475 + (* RFC 9110: Content *) 110 476 | "accept" -> `Accept 111 477 | "accept-encoding" -> `Accept_encoding 112 478 | "accept-language" -> `Accept_language 113 - | "age" -> `Age 114 - | "authorization" -> `Authorization 115 - | "cache-control" -> `Cache_control 116 - | "connection" -> `Connection 479 + | "accept-ranges" -> `Accept_ranges 480 + | "allow" -> `Allow 117 481 | "content-encoding" -> `Content_encoding 482 + | "content-language" -> `Content_language 118 483 | "content-length" -> `Content_length 484 + | "content-location" -> `Content_location 485 + | "content-range" -> `Content_range 119 486 | "content-type" -> `Content_type 120 - | "cookie" -> `Cookie 121 - | "date" -> `Date 122 - | "etag" -> `Etag 487 + (* RFC 9110: Request Context *) 123 488 | "expect" -> `Expect 124 - | "expires" -> `Expires 489 + | "from" -> `From 125 490 | "host" -> `Host 491 + | "max-forwards" -> `Max_forwards 492 + | "range" -> `Range 493 + | "referer" -> `Referer 494 + | "te" -> `Te 495 + | "user-agent" -> `User_agent 496 + (* RFC 9110: Response Context *) 497 + | "location" -> `Location 498 + | "retry-after" -> `Retry_after 499 + | "server" -> `Server 500 + (* RFC 9110: Validators *) 501 + | "etag" -> `Etag 502 + | "last-modified" -> `Last_modified 503 + | "vary" -> `Vary 504 + (* RFC 9110: Conditional *) 126 505 | "if-match" -> `If_match 127 506 | "if-modified-since" -> `If_modified_since 128 507 | "if-none-match" -> `If_none_match 508 + | "if-range" -> `If_range 129 509 | "if-unmodified-since" -> `If_unmodified_since 130 - | "keep-alive" -> `Keep_alive 131 - | "last-modified" -> `Last_modified 132 - | "link" -> `Link 133 - | "location" -> `Location 510 + (* RFC 9110: Authentication *) 511 + | "authorization" -> `Authorization 512 + | "authentication-info" -> `Authentication_info 134 513 | "proxy-authenticate" -> `Proxy_authenticate 514 + | "proxy-authentication-info" -> `Proxy_authentication_info 135 515 | "proxy-authorization" -> `Proxy_authorization 136 - | "range" -> `Range 137 - | "retry-after" -> `Retry_after 138 - | "set-cookie" -> `Set_cookie 139 - | "te" -> `Te 516 + | "www-authenticate" -> `Www_authenticate 517 + (* RFC 9110: Connection *) 518 + | "connection" -> `Connection 519 + | "upgrade" -> `Upgrade 520 + | "via" -> `Via 521 + (* RFC 9110: Date *) 522 + | "date" -> `Date 523 + (* RFC 9111: Caching *) 524 + | "age" -> `Age 525 + | "cache-control" -> `Cache_control 526 + | "expires" -> `Expires 527 + | "pragma" -> `Pragma 528 + | "cache-status" -> `Cache_status 529 + (* RFC 9112: HTTP/1.1 *) 530 + | "keep-alive" -> `Keep_alive 140 531 | "trailer" -> `Trailer 141 532 | "transfer-encoding" -> `Transfer_encoding 142 - | "upgrade" -> `Upgrade 143 - | "user-agent" -> `User_agent 144 - | "vary" -> `Vary 145 - | "www-authenticate" -> `Www_authenticate 533 + (* Cookies *) 534 + | "cookie" -> `Cookie 535 + | "set-cookie" -> `Set_cookie 536 + (* Link *) 537 + | "link" -> `Link 538 + (* CORS *) 539 + | "access-control-allow-credentials" -> `Access_control_allow_credentials 540 + | "access-control-allow-headers" -> `Access_control_allow_headers 541 + | "access-control-allow-methods" -> `Access_control_allow_methods 542 + | "access-control-allow-origin" -> `Access_control_allow_origin 543 + | "access-control-expose-headers" -> `Access_control_expose_headers 544 + | "access-control-max-age" -> `Access_control_max_age 545 + | "access-control-request-headers" -> `Access_control_request_headers 546 + | "access-control-request-method" -> `Access_control_request_method 547 + | "origin" -> `Origin 548 + (* Cross-Origin Policy *) 549 + | "cross-origin-embedder-policy" -> `Cross_origin_embedder_policy 550 + | "cross-origin-embedder-policy-report-only" -> `Cross_origin_embedder_policy_report_only 551 + | "cross-origin-opener-policy" -> `Cross_origin_opener_policy 552 + | "cross-origin-opener-policy-report-only" -> `Cross_origin_opener_policy_report_only 553 + | "cross-origin-resource-policy" -> `Cross_origin_resource_policy 554 + (* Sec-Fetch *) 555 + | "sec-fetch-dest" -> `Sec_fetch_dest 556 + | "sec-fetch-mode" -> `Sec_fetch_mode 557 + | "sec-fetch-site" -> `Sec_fetch_site 558 + | "sec-fetch-user" -> `Sec_fetch_user 559 + (* Security *) 560 + | "content-security-policy" -> `Content_security_policy 561 + | "content-security-policy-report-only" -> `Content_security_policy_report_only 562 + | "strict-transport-security" -> `Strict_transport_security 563 + | "x-content-type-options" -> `X_content_type_options 564 + | "x-frame-options" -> `X_frame_options 565 + | "referrer-policy" -> `Referrer_policy 566 + (* RFC 8053: Interactive Auth *) 567 + | "optional-www-authenticate" -> `Optional_www_authenticate 568 + | "authentication-control" -> `Authentication_control 569 + (* RFC 9449: DPoP *) 570 + | "dpop" -> `Dpop 571 + | "dpop-nonce" -> `Dpop_nonce 572 + (* RFC 9530: Digest Fields *) 573 + | "content-digest" -> `Content_digest 574 + | "repr-digest" -> `Repr_digest 575 + | "want-content-digest" -> `Want_content_digest 576 + | "want-repr-digest" -> `Want_repr_digest 577 + (* RFC 9421: Signatures *) 578 + | "signature" -> `Signature 579 + | "signature-input" -> `Signature_input 580 + | "accept-signature" -> `Accept_signature 581 + (* RFC 6455: WebSocket *) 582 + | "sec-websocket-key" -> `Sec_websocket_key 583 + | "sec-websocket-accept" -> `Sec_websocket_accept 584 + | "sec-websocket-protocol" -> `Sec_websocket_protocol 585 + | "sec-websocket-version" -> `Sec_websocket_version 586 + | "sec-websocket-extensions" -> `Sec_websocket_extensions 587 + (* Other *) 146 588 | _ -> `Other s 147 589 148 590 (** Convert to lowercase string for internal map keys. *) ··· 179 621 `Trailer; 180 622 `Transfer_encoding; 181 623 `Upgrade; 624 + `Via; 182 625 ] 183 626 184 627 (** Headers that MUST NOT appear in trailers per RFC 9110 Section 6.5.1. *) ··· 191 634 `Trailer; 192 635 ] 193 636 637 + (** CORS response headers. 638 + 639 + These headers control cross-origin access. 640 + @see <https://fetch.spec.whatwg.org/#http-responses> Fetch Standard *) 641 + let cors_response_headers : t list = [ 642 + `Access_control_allow_credentials; 643 + `Access_control_allow_headers; 644 + `Access_control_allow_methods; 645 + `Access_control_allow_origin; 646 + `Access_control_expose_headers; 647 + `Access_control_max_age; 648 + ] 649 + 650 + (** CORS request headers. 651 + 652 + These headers are used in CORS preflight requests. 653 + @see <https://fetch.spec.whatwg.org/#http-requests> Fetch Standard *) 654 + let cors_request_headers : t list = [ 655 + `Access_control_request_headers; 656 + `Access_control_request_method; 657 + `Origin; 658 + ] 659 + 660 + (** Security headers. 661 + 662 + Headers related to web security policies. *) 663 + let security_headers : t list = [ 664 + `Content_security_policy; 665 + `Content_security_policy_report_only; 666 + `Strict_transport_security; 667 + `X_content_type_options; 668 + `X_frame_options; 669 + `Referrer_policy; 670 + `Cross_origin_embedder_policy; 671 + `Cross_origin_embedder_policy_report_only; 672 + `Cross_origin_opener_policy; 673 + `Cross_origin_opener_policy_report_only; 674 + `Cross_origin_resource_policy; 675 + ] 676 + 677 + (** Fetch metadata headers. 678 + 679 + Browser-set headers providing request context. 680 + @see <https://www.w3.org/TR/fetch-metadata/> Fetch Metadata *) 681 + let fetch_metadata_headers : t list = [ 682 + `Sec_fetch_dest; 683 + `Sec_fetch_mode; 684 + `Sec_fetch_site; 685 + `Sec_fetch_user; 686 + ] 687 + 688 + (** WebSocket handshake headers. 689 + 690 + Headers used during WebSocket upgrade. 691 + @see <https://www.rfc-editor.org/rfc/rfc6455> RFC 6455 *) 692 + let websocket_headers : t list = [ 693 + `Sec_websocket_key; 694 + `Sec_websocket_accept; 695 + `Sec_websocket_protocol; 696 + `Sec_websocket_version; 697 + `Sec_websocket_extensions; 698 + ] 699 + 194 700 (** Check if a header is a hop-by-hop header. *) 195 701 let is_hop_by_hop (name : t) : bool = 196 702 List.exists (equal name) hop_by_hop_headers ··· 198 704 (** Check if a header is forbidden in trailers. *) 199 705 let is_forbidden_trailer (name : t) : bool = 200 706 List.exists (equal name) forbidden_trailer_headers 707 + 708 + (** Check if a header is a CORS response header. *) 709 + let is_cors_response (name : t) : bool = 710 + List.exists (equal name) cors_response_headers 711 + 712 + (** Check if a header is a CORS request header. *) 713 + let is_cors_request (name : t) : bool = 714 + List.exists (equal name) cors_request_headers 715 + 716 + (** Check if a header is a security header. *) 717 + let is_security (name : t) : bool = 718 + List.exists (equal name) security_headers 719 + 720 + (** Check if a header is a fetch metadata header. *) 721 + let is_fetch_metadata (name : t) : bool = 722 + List.exists (equal name) fetch_metadata_headers 723 + 724 + (** Check if a header is a WebSocket header. *) 725 + let is_websocket (name : t) : bool = 726 + List.exists (equal name) websocket_headers

+160 -24

ocaml-requests/lib/header_name.mli

··· 28 28 ]} 29 29 30 30 Header names are case-insensitive per 31 - {{:https://datatracker.ietf.org/doc/html/rfc9110#section-5.1}RFC 9110 Section 5.1}. *) 31 + {{:https://datatracker.ietf.org/doc/html/rfc9110#section-5.1}RFC 9110 Section 5.1}. 32 + 33 + Header definitions are based on the IANA HTTP Field Name Registry: 34 + {{:https://www.iana.org/assignments/http-fields/http-fields.xhtml}IANA HTTP Field Name Registry} *) 32 35 33 36 (** {1 Types} *) 34 37 ··· 38 41 - {{:https://datatracker.ietf.org/doc/html/rfc9110}RFC 9110} (HTTP Semantics) 39 42 - {{:https://datatracker.ietf.org/doc/html/rfc9111}RFC 9111} (HTTP Caching) 40 43 - {{:https://datatracker.ietf.org/doc/html/rfc9112}RFC 9112} (HTTP/1.1) 41 - - {{:https://datatracker.ietf.org/doc/html/rfc7235}RFC 7235} (HTTP Authentication) 42 - - {{:https://datatracker.ietf.org/doc/html/rfc6265}RFC 6265} (HTTP Cookies) *) 44 + - {{:https://datatracker.ietf.org/doc/html/rfc6455}RFC 6455} (WebSocket Protocol) 45 + - {{:https://datatracker.ietf.org/doc/html/rfc9421}RFC 9421} (HTTP Message Signatures) 46 + - {{:https://datatracker.ietf.org/doc/html/rfc9530}RFC 9530} (Digest Fields) 47 + - {{:https://fetch.spec.whatwg.org/}Fetch Standard} (CORS and Security) 48 + - Various other RFCs as noted *) 43 49 type standard = [ 50 + (* RFC 9110: HTTP Semantics - Content Headers *) 44 51 | `Accept 45 52 | `Accept_encoding 46 53 | `Accept_language 47 - | `Age 48 - | `Authorization 49 - | `Cache_control 50 - | `Connection 54 + | `Accept_ranges 55 + | `Allow 51 56 | `Content_encoding 57 + | `Content_language 52 58 | `Content_length 59 + | `Content_location 60 + | `Content_range 53 61 | `Content_type 54 - | `Cookie 55 - | `Date 56 - | `Etag 62 + 63 + (* RFC 9110: HTTP Semantics - Request Context *) 57 64 | `Expect 58 - | `Expires 65 + | `From 59 66 | `Host 67 + | `Max_forwards 68 + | `Range 69 + | `Referer 70 + | `Te 71 + | `User_agent 72 + 73 + (* RFC 9110: HTTP Semantics - Response Context *) 74 + | `Location 75 + | `Retry_after 76 + | `Server 77 + 78 + (* RFC 9110: HTTP Semantics - Validators *) 79 + | `Etag 80 + | `Last_modified 81 + | `Vary 82 + 83 + (* RFC 9110: HTTP Semantics - Conditional Requests *) 60 84 | `If_match 61 85 | `If_modified_since 62 86 | `If_none_match 87 + | `If_range 63 88 | `If_unmodified_since 64 - | `Keep_alive 65 - | `Last_modified 66 - | `Link 67 - | `Location 89 + 90 + (* RFC 9110: HTTP Semantics - Authentication *) 91 + | `Authorization 92 + | `Authentication_info 68 93 | `Proxy_authenticate 94 + | `Proxy_authentication_info 69 95 | `Proxy_authorization 70 - | `Range 71 - | `Retry_after 72 - | `Set_cookie 73 - | `Te 96 + | `Www_authenticate 97 + 98 + (* RFC 9110: HTTP Semantics - Connection Management *) 99 + | `Connection 100 + | `Upgrade 101 + | `Via 102 + 103 + (* RFC 9110: HTTP Semantics - Date *) 104 + | `Date 105 + 106 + (* RFC 9111: HTTP Caching *) 107 + | `Age 108 + | `Cache_control 109 + | `Expires 110 + | `Pragma 111 + | `Cache_status 112 + 113 + (* RFC 9112: HTTP/1.1 *) 114 + | `Keep_alive 74 115 | `Trailer 75 116 | `Transfer_encoding 76 - | `Upgrade 77 - | `User_agent 78 - | `Vary 79 - | `Www_authenticate 117 + 118 + (* Cookies - RFC 6265bis *) 119 + | `Cookie 120 + | `Set_cookie 121 + 122 + (* Link Relations - RFC 8288 *) 123 + | `Link 124 + 125 + (* CORS Headers - Fetch Standard *) 126 + | `Access_control_allow_credentials 127 + | `Access_control_allow_headers 128 + | `Access_control_allow_methods 129 + | `Access_control_allow_origin 130 + | `Access_control_expose_headers 131 + | `Access_control_max_age 132 + | `Access_control_request_headers 133 + | `Access_control_request_method 134 + | `Origin 135 + 136 + (* Cross-Origin Policy Headers - HTML Standard *) 137 + | `Cross_origin_embedder_policy 138 + | `Cross_origin_embedder_policy_report_only 139 + | `Cross_origin_opener_policy 140 + | `Cross_origin_opener_policy_report_only 141 + | `Cross_origin_resource_policy 142 + 143 + (* Fetch Metadata Headers - W3C *) 144 + | `Sec_fetch_dest 145 + | `Sec_fetch_mode 146 + | `Sec_fetch_site 147 + | `Sec_fetch_user 148 + 149 + (* Security Headers *) 150 + | `Content_security_policy 151 + | `Content_security_policy_report_only 152 + | `Strict_transport_security 153 + | `X_content_type_options 154 + | `X_frame_options 155 + | `Referrer_policy 156 + 157 + (* RFC 8053: Interactive Authentication *) 158 + | `Optional_www_authenticate 159 + | `Authentication_control 160 + 161 + (* RFC 9449: OAuth 2.0 DPoP *) 162 + | `Dpop 163 + | `Dpop_nonce 164 + 165 + (* RFC 9530: Digest Fields *) 166 + | `Content_digest 167 + | `Repr_digest 168 + | `Want_content_digest 169 + | `Want_repr_digest 170 + 171 + (* RFC 9421: HTTP Message Signatures *) 172 + | `Signature 173 + | `Signature_input 174 + | `Accept_signature 175 + 176 + (* RFC 6455: WebSocket Protocol *) 177 + | `Sec_websocket_key 178 + | `Sec_websocket_accept 179 + | `Sec_websocket_protocol 180 + | `Sec_websocket_version 181 + | `Sec_websocket_extensions 80 182 ] 81 183 82 184 (** Complete header name type including non-standard headers. ··· 123 225 124 226 These headers MUST be removed before forwarding a message: 125 227 Connection, Keep-Alive, Proxy-Authenticate, Proxy-Authorization, 126 - TE, Trailer, Transfer-Encoding, Upgrade. *) 228 + TE, Trailer, Transfer-Encoding, Upgrade, Via. *) 127 229 128 230 val forbidden_trailer_headers : t list 129 231 (** Headers that MUST NOT appear in trailers per ··· 132 234 Includes: Transfer-Encoding, Content-Length, Host, Content-Encoding, 133 235 Content-Type, Trailer. *) 134 236 237 + val cors_response_headers : t list 238 + (** CORS response headers that control cross-origin access. 239 + @see <https://fetch.spec.whatwg.org/#http-responses> Fetch Standard *) 240 + 241 + val cors_request_headers : t list 242 + (** CORS request headers used in preflight requests. 243 + @see <https://fetch.spec.whatwg.org/#http-requests> Fetch Standard *) 244 + 245 + val security_headers : t list 246 + (** Headers related to web security policies. *) 247 + 248 + val fetch_metadata_headers : t list 249 + (** Browser-set headers providing request context. 250 + @see <https://www.w3.org/TR/fetch-metadata/> Fetch Metadata *) 251 + 252 + val websocket_headers : t list 253 + (** Headers used during WebSocket upgrade. 254 + @see <https://www.rfc-editor.org/rfc/rfc6455> RFC 6455 *) 255 + 135 256 val is_hop_by_hop : t -> bool 136 257 (** [is_hop_by_hop name] returns [true] if [name] is a hop-by-hop header. *) 137 258 138 259 val is_forbidden_trailer : t -> bool 139 260 (** [is_forbidden_trailer name] returns [true] if [name] is forbidden in trailers. *) 261 + 262 + val is_cors_response : t -> bool 263 + (** [is_cors_response name] returns [true] if [name] is a CORS response header. *) 264 + 265 + val is_cors_request : t -> bool 266 + (** [is_cors_request name] returns [true] if [name] is a CORS request header. *) 267 + 268 + val is_security : t -> bool 269 + (** [is_security name] returns [true] if [name] is a security header. *) 270 + 271 + val is_fetch_metadata : t -> bool 272 + (** [is_fetch_metadata name] returns [true] if [name] is a fetch metadata header. *) 273 + 274 + val is_websocket : t -> bool 275 + (** [is_websocket name] returns [true] if [name] is a WebSocket header. *)

+345

ocaml-requests/lib/header_parsing.ml

··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** HTTP Header Value Parsing 7 + 8 + This module provides parsing and generation functions for complex HTTP header 9 + values that go beyond simple strings. 10 + 11 + @see <https://www.rfc-editor.org/rfc/rfc9110> RFC 9110: HTTP Semantics *) 12 + 13 + let src = Logs.Src.create "requests.header_parsing" ~doc:"HTTP Header Parsing" 14 + module Log = (val Logs.src_log src : Logs.LOG) 15 + 16 + (** {1 Content-Range (RFC 9110 Section 14.4)} 17 + 18 + The Content-Range header indicates which part of a representation is 19 + enclosed when a 206 (Partial Content) response is returned. 20 + 21 + Format: [bytes start-end/complete-length] or [bytes */complete-length] 22 + 23 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-14.4> RFC 9110 Section 14.4 *) 24 + 25 + type content_range = { 26 + unit : string; 27 + (** The range unit, typically "bytes" *) 28 + range : (int64 * int64) option; 29 + (** The byte range (start, end) inclusive, or None for unsatisfied range *) 30 + complete_length : int64 option; 31 + (** The complete representation length, or None if unknown *) 32 + } 33 + 34 + let content_range_to_string cr = 35 + let range_part = match cr.range with 36 + | Some (start, end_) -> Printf.sprintf "%Ld-%Ld" start end_ 37 + | None -> "*" 38 + in 39 + let length_part = match cr.complete_length with 40 + | Some len -> Int64.to_string len 41 + | None -> "*" 42 + in 43 + Printf.sprintf "%s %s/%s" cr.unit range_part length_part 44 + 45 + let parse_content_range s = 46 + let s = String.trim s in 47 + (* Parse unit (e.g., "bytes") *) 48 + match String.index_opt s ' ' with 49 + | None -> 50 + Log.debug (fun m -> m "Content-Range missing unit separator: %s" s); 51 + None 52 + | Some space_idx -> 53 + let unit = String.sub s 0 space_idx in 54 + let rest = String.sub s (space_idx + 1) (String.length s - space_idx - 1) in 55 + (* Parse range/length *) 56 + match String.index_opt rest '/' with 57 + | None -> 58 + Log.debug (fun m -> m "Content-Range missing range/length separator: %s" s); 59 + None 60 + | Some slash_idx -> 61 + let range_part = String.sub rest 0 slash_idx in 62 + let length_part = String.sub rest (slash_idx + 1) (String.length rest - slash_idx - 1) in 63 + (* Parse range *) 64 + let range = 65 + if range_part = "*" then None 66 + else match String.index_opt range_part '-' with 67 + | None -> None 68 + | Some dash_idx -> 69 + let start_s = String.sub range_part 0 dash_idx in 70 + let end_s = String.sub range_part (dash_idx + 1) (String.length range_part - dash_idx - 1) in 71 + match Int64.of_string_opt start_s, Int64.of_string_opt end_s with 72 + | Some start, Some end_ -> Some (start, end_) 73 + | _ -> 74 + Log.debug (fun m -> m "Content-Range invalid range numbers: %s" range_part); 75 + None 76 + in 77 + (* Parse complete length *) 78 + let complete_length = 79 + if length_part = "*" then None 80 + else Int64.of_string_opt length_part 81 + in 82 + Some { unit; range; complete_length } 83 + 84 + (** Create a Content-Range value for a byte range response. 85 + 86 + @param start The first byte position (0-indexed) 87 + @param end_ The last byte position (inclusive) 88 + @param complete_length The total size of the representation *) 89 + let make_content_range ~start ~end_ ~complete_length = 90 + { unit = "bytes"; range = Some (start, end_); complete_length = Some complete_length } 91 + 92 + (** Create a Content-Range value for an unsatisfied range (416 response). 93 + 94 + @param complete_length The total size of the representation *) 95 + let make_unsatisfied_range ~complete_length = 96 + { unit = "bytes"; range = None; complete_length = Some complete_length } 97 + 98 + (** {1 If-Range (RFC 9110 Section 13.1.5)} 99 + 100 + The If-Range header makes a Range request conditional. It can contain 101 + either an ETag or a Last-Modified date. 102 + 103 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-13.1.5> RFC 9110 Section 13.1.5 *) 104 + 105 + type if_range = 106 + | If_range_etag of string 107 + (** An entity tag (strong or weak) *) 108 + | If_range_date of string 109 + (** A Last-Modified date in HTTP-date format *) 110 + 111 + let if_range_to_string = function 112 + | If_range_etag etag -> etag 113 + | If_range_date date -> date 114 + 115 + (** Parse an If-Range header value. 116 + 117 + Distinguishes between ETags (contain quotes or start with W/) and 118 + HTTP-date values (start with a weekday abbreviation). 119 + 120 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-8.8.3> RFC 9110 Section 8.8.3 (ETag) 121 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-5.6.7> RFC 9110 Section 5.6.7 (HTTP-date) *) 122 + let parse_if_range s = 123 + let s = String.trim s in 124 + if String.length s = 0 then None 125 + else 126 + (* ETags are quoted strings or start with W/ for weak ETags *) 127 + let is_etag = 128 + (* Strong ETag: starts with quote *) 129 + (String.length s >= 2 && s.[0] = '"') || 130 + (* Weak ETag: starts with W/ followed by quote *) 131 + (String.length s >= 3 && s.[0] = 'W' && s.[1] = '/' && s.[2] = '"') 132 + in 133 + if is_etag then 134 + Some (If_range_etag s) 135 + else 136 + (* HTTP-date starts with a weekday: Mon, Tue, Wed, Thu, Fri, Sat, Sun 137 + or in obsolete formats: Monday, Tuesday, etc. *) 138 + let weekdays = ["Mon"; "Tue"; "Wed"; "Thu"; "Fri"; "Sat"; "Sun"; 139 + "Monday"; "Tuesday"; "Wednesday"; "Thursday"; "Friday"; "Saturday"; "Sunday"] in 140 + let starts_with_weekday = 141 + List.exists (fun day -> 142 + String.length s >= String.length day && 143 + String.sub s 0 (String.length day) = day 144 + ) weekdays 145 + in 146 + if starts_with_weekday then 147 + Some (If_range_date s) 148 + else 149 + (* Ambiguous - treat as date if it contains digits typical of dates *) 150 + if String.exists (fun c -> c >= '0' && c <= '9') s then 151 + Some (If_range_date s) 152 + else 153 + (* Default to ETag for other values *) 154 + Some (If_range_etag s) 155 + 156 + (** Create an If-Range value from an ETag. *) 157 + let if_range_of_etag etag = If_range_etag etag 158 + 159 + (** Create an If-Range value from a Last-Modified date string. *) 160 + let if_range_of_date date = If_range_date date 161 + 162 + (** Check if an If-Range value is an ETag. *) 163 + let if_range_is_etag = function 164 + | If_range_etag _ -> true 165 + | If_range_date _ -> false 166 + 167 + (** Check if an If-Range value is a date. *) 168 + let if_range_is_date = function 169 + | If_range_date _ -> true 170 + | If_range_etag _ -> false 171 + 172 + (** {1 Allow (RFC 9110 Section 10.2.1)} 173 + 174 + The Allow header lists the set of methods supported by the target resource. 175 + 176 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-10.2.1> RFC 9110 Section 10.2.1 *) 177 + 178 + (** Parse an Allow header value into a list of methods. 179 + 180 + The Allow header is a comma-separated list of HTTP method names. 181 + Example: "GET, HEAD, PUT" *) 182 + let parse_allow s = 183 + String.split_on_char ',' s 184 + |> List.map String.trim 185 + |> List.filter (fun s -> String.length s > 0) 186 + |> List.map Method.of_string 187 + 188 + (** Format a list of methods as an Allow header value. *) 189 + let allow_to_string methods = 190 + methods 191 + |> List.map Method.to_string 192 + |> String.concat ", " 193 + 194 + (** Check if a method is in an Allow header value. *) 195 + let allow_contains method_ allow_value = 196 + let methods = parse_allow allow_value in 197 + List.exists (Method.equal method_) methods 198 + 199 + (** {1 Authentication-Info (RFC 9110 Section 11.6.3)} 200 + 201 + The Authentication-Info header is sent by the server after successful 202 + authentication. For Digest authentication, it provides a new nonce for 203 + subsequent requests (avoiding 401 round-trips) and response authentication. 204 + 205 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-11.6.3> RFC 9110 Section 11.6.3 *) 206 + 207 + type authentication_info = { 208 + nextnonce : string option; 209 + (** Next nonce to use for subsequent requests *) 210 + qop : string option; 211 + (** Quality of protection that was used *) 212 + rspauth : string option; 213 + (** Response authentication (server proves it knows the password) *) 214 + cnonce : string option; 215 + (** Client nonce echoed back *) 216 + nc : string option; 217 + (** Nonce count echoed back *) 218 + } 219 + 220 + (** Parse an Authentication-Info header value. 221 + 222 + Format is comma-separated key=value or key="value" pairs. 223 + Example: [nextnonce="abc123", qop=auth, rspauth="xyz789"] *) 224 + let parse_authentication_info s = 225 + let pairs = 226 + let rec parse_pairs acc str = 227 + let str = String.trim str in 228 + if str = "" then List.rev acc 229 + else 230 + match String.index_opt str '=' with 231 + | None -> List.rev acc 232 + | Some eq_idx -> 233 + let key = String.trim (String.sub str 0 eq_idx) in 234 + let rest = String.sub str (eq_idx + 1) (String.length str - eq_idx - 1) in 235 + let rest = String.trim rest in 236 + let value, remaining = 237 + if String.length rest > 0 && rest.[0] = '"' then 238 + (* Quoted value *) 239 + match String.index_from_opt rest 1 '"' with 240 + | Some end_quote -> 241 + let v = String.sub rest 1 (end_quote - 1) in 242 + let rem = String.sub rest (end_quote + 1) (String.length rest - end_quote - 1) in 243 + let rem = String.trim rem in 244 + let rem = if String.length rem > 0 && rem.[0] = ',' then 245 + String.sub rem 1 (String.length rem - 1) 246 + else rem in 247 + (v, rem) 248 + | None -> (rest, "") 249 + else 250 + (* Unquoted value *) 251 + match String.index_opt rest ',' with 252 + | Some comma -> 253 + let v = String.trim (String.sub rest 0 comma) in 254 + let rem = String.sub rest (comma + 1) (String.length rest - comma - 1) in 255 + (v, rem) 256 + | None -> (String.trim rest, "") 257 + in 258 + parse_pairs ((String.lowercase_ascii key, value) :: acc) remaining 259 + in 260 + parse_pairs [] s 261 + in 262 + { 263 + nextnonce = List.assoc_opt "nextnonce" pairs; 264 + qop = List.assoc_opt "qop" pairs; 265 + rspauth = List.assoc_opt "rspauth" pairs; 266 + cnonce = List.assoc_opt "cnonce" pairs; 267 + nc = List.assoc_opt "nc" pairs; 268 + } 269 + 270 + (** Check if the Authentication-Info contains a new nonce. 271 + 272 + If present, the client should use this nonce for subsequent requests 273 + instead of waiting for a 401 response with a new challenge. *) 274 + let has_nextnonce info = Option.is_some info.nextnonce 275 + 276 + (** Get the next nonce from Authentication-Info, if present. *) 277 + let get_nextnonce info = info.nextnonce 278 + 279 + (** {1 Retry-After (RFC 9110 Section 10.2.3)} 280 + 281 + The Retry-After header indicates how long to wait before retrying. 282 + It can be either a date or a number of seconds. 283 + 284 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-10.2.3> RFC 9110 Section 10.2.3 *) 285 + 286 + type retry_after = 287 + | Retry_after_date of string 288 + (** An HTTP-date when the resource will be available *) 289 + | Retry_after_seconds of int 290 + (** Number of seconds to wait before retrying *) 291 + 292 + (** Parse a Retry-After header value. *) 293 + let parse_retry_after s = 294 + let s = String.trim s in 295 + match int_of_string_opt s with 296 + | Some seconds -> Some (Retry_after_seconds seconds) 297 + | None -> 298 + (* Not a number, must be a date *) 299 + if String.length s > 0 then 300 + Some (Retry_after_date s) 301 + else 302 + None 303 + 304 + (** Convert a Retry-After value to a delay in seconds. 305 + 306 + For date values, this requires the current time to compute the difference. 307 + Returns None if the date is in the past or cannot be parsed. 308 + 309 + @param now The current time as a Unix timestamp *) 310 + let retry_after_to_seconds ?now retry_after = 311 + match retry_after with 312 + | Retry_after_seconds s -> Some s 313 + | Retry_after_date _date_str -> 314 + (* Date parsing would require http_date module *) 315 + match now with 316 + | None -> None 317 + | Some _now_ts -> 318 + (* TODO: Parse HTTP-date and compute difference *) 319 + None 320 + 321 + (** {1 Accept-Ranges (RFC 9110 Section 14.3)} 322 + 323 + The Accept-Ranges header indicates whether the server supports range requests. 324 + 325 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-14.3> RFC 9110 Section 14.3 *) 326 + 327 + type accept_ranges = 328 + | Accept_ranges_bytes 329 + (** Server supports byte range requests *) 330 + | Accept_ranges_none 331 + (** Server does not support range requests *) 332 + | Accept_ranges_other of string 333 + (** Server supports some other range unit *) 334 + 335 + (** Parse an Accept-Ranges header value. *) 336 + let parse_accept_ranges s = 337 + match String.lowercase_ascii (String.trim s) with 338 + | "bytes" -> Accept_ranges_bytes 339 + | "none" -> Accept_ranges_none 340 + | other -> Accept_ranges_other other 341 + 342 + (** Check if the server supports byte range requests. *) 343 + let supports_byte_ranges = function 344 + | Accept_ranges_bytes -> true 345 + | Accept_ranges_none | Accept_ranges_other _ -> false

+204

ocaml-requests/lib/header_parsing.mli

··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** HTTP Header Value Parsing 7 + 8 + This module provides parsing and generation functions for complex HTTP header 9 + values that go beyond simple strings. 10 + 11 + {2 Supported Headers} 12 + 13 + - {!Content-Range} - Partial content range specification (RFC 9110 Section 14.4) 14 + - {!If-Range} - Conditional range request (RFC 9110 Section 13.1.5) 15 + - {!Allow} - Supported HTTP methods (RFC 9110 Section 10.2.1) 16 + - {!Authentication-Info} - Post-authentication info (RFC 9110 Section 11.6.3) 17 + - {!Retry-After} - Retry delay specification (RFC 9110 Section 10.2.3) 18 + - {!Accept-Ranges} - Range support indication (RFC 9110 Section 14.3) 19 + 20 + @see <https://www.rfc-editor.org/rfc/rfc9110> RFC 9110: HTTP Semantics *) 21 + 22 + (** {1 Content-Range (RFC 9110 Section 14.4)} 23 + 24 + The Content-Range header indicates which part of a representation is 25 + enclosed when a 206 (Partial Content) response is returned. 26 + 27 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-14.4> RFC 9110 Section 14.4 *) 28 + 29 + type content_range = { 30 + unit : string; 31 + (** The range unit, typically "bytes" *) 32 + range : (int64 * int64) option; 33 + (** The byte range (start, end) inclusive, or None for unsatisfied range *) 34 + complete_length : int64 option; 35 + (** The complete representation length, or None if unknown *) 36 + } 37 + 38 + val content_range_to_string : content_range -> string 39 + (** [content_range_to_string cr] formats a content range as a header value. 40 + 41 + Example: ["bytes 0-499/1234"] *) 42 + 43 + val parse_content_range : string -> content_range option 44 + (** [parse_content_range s] parses a Content-Range header value. 45 + 46 + Returns [None] if the value cannot be parsed. 47 + 48 + Examples: 49 + - ["bytes 0-499/1234"] -> Some {unit="bytes"; range=Some(0,499); complete_length=Some 1234} 50 + - ["bytes */1234"] -> Some {unit="bytes"; range=None; complete_length=Some 1234} *) 51 + 52 + val make_content_range : start:int64 -> end_:int64 -> complete_length:int64 -> content_range 53 + (** [make_content_range ~start ~end_ ~complete_length] creates a Content-Range 54 + value for a byte range response. 55 + 56 + @param start The first byte position (0-indexed) 57 + @param end_ The last byte position (inclusive) 58 + @param complete_length The total size of the representation *) 59 + 60 + val make_unsatisfied_range : complete_length:int64 -> content_range 61 + (** [make_unsatisfied_range ~complete_length] creates a Content-Range value for 62 + an unsatisfied range (416 response). *) 63 + 64 + (** {1 If-Range (RFC 9110 Section 13.1.5)} 65 + 66 + The If-Range header makes a Range request conditional. It can contain 67 + either an ETag or a Last-Modified date. 68 + 69 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-13.1.5> RFC 9110 Section 13.1.5 *) 70 + 71 + type if_range = 72 + | If_range_etag of string 73 + (** An entity tag (strong or weak) *) 74 + | If_range_date of string 75 + (** A Last-Modified date in HTTP-date format *) 76 + 77 + val if_range_to_string : if_range -> string 78 + (** [if_range_to_string ir] converts an If-Range value to a string. *) 79 + 80 + val parse_if_range : string -> if_range option 81 + (** [parse_if_range s] parses an If-Range header value. 82 + 83 + Distinguishes between ETags (contain quotes or start with W/) and 84 + HTTP-date values (start with a weekday abbreviation). *) 85 + 86 + val if_range_of_etag : string -> if_range 87 + (** [if_range_of_etag etag] creates an If-Range value from an ETag. *) 88 + 89 + val if_range_of_date : string -> if_range 90 + (** [if_range_of_date date] creates an If-Range value from a date string. *) 91 + 92 + val if_range_is_etag : if_range -> bool 93 + (** [if_range_is_etag ir] returns [true] if [ir] is an ETag. *) 94 + 95 + val if_range_is_date : if_range -> bool 96 + (** [if_range_is_date ir] returns [true] if [ir] is a date. *) 97 + 98 + (** {1 Allow (RFC 9110 Section 10.2.1)} 99 + 100 + The Allow header lists the set of methods supported by the target resource. 101 + 102 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-10.2.1> RFC 9110 Section 10.2.1 *) 103 + 104 + val parse_allow : string -> Method.t list 105 + (** [parse_allow s] parses an Allow header value into a list of methods. 106 + 107 + Example: ["GET, HEAD, PUT"] -> [\`GET; \`HEAD; \`PUT] *) 108 + 109 + val allow_to_string : Method.t list -> string 110 + (** [allow_to_string methods] formats a list of methods as an Allow header value. 111 + 112 + Example: [\`GET; \`HEAD] -> ["GET, HEAD"] *) 113 + 114 + val allow_contains : Method.t -> string -> bool 115 + (** [allow_contains method_ allow_value] checks if a method is in an Allow header value. *) 116 + 117 + (** {1 Authentication-Info (RFC 9110 Section 11.6.3)} 118 + 119 + The Authentication-Info header is sent by the server after successful 120 + authentication. For Digest authentication, it provides: 121 + 122 + - A new nonce for subsequent requests (avoiding 401 round-trips) 123 + - Response authentication (server proves it knows the password) 124 + - Echo of client nonce and nonce count for verification 125 + 126 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-11.6.3> RFC 9110 Section 11.6.3 *) 127 + 128 + type authentication_info = { 129 + nextnonce : string option; 130 + (** Next nonce to use for subsequent requests *) 131 + qop : string option; 132 + (** Quality of protection that was used *) 133 + rspauth : string option; 134 + (** Response authentication (server proves it knows the password) *) 135 + cnonce : string option; 136 + (** Client nonce echoed back *) 137 + nc : string option; 138 + (** Nonce count echoed back *) 139 + } 140 + 141 + val parse_authentication_info : string -> authentication_info 142 + (** [parse_authentication_info s] parses an Authentication-Info header value. 143 + 144 + Example: ["nextnonce=\"abc123\", qop=auth, rspauth=\"xyz789\""] *) 145 + 146 + val has_nextnonce : authentication_info -> bool 147 + (** [has_nextnonce info] returns [true] if a new nonce is provided. 148 + 149 + If present, the client should use this nonce for subsequent requests 150 + instead of waiting for a 401 response with a new challenge. *) 151 + 152 + val get_nextnonce : authentication_info -> string option 153 + (** [get_nextnonce info] returns the next nonce, if present. *) 154 + 155 + (** {1 Retry-After (RFC 9110 Section 10.2.3)} 156 + 157 + The Retry-After header indicates how long to wait before retrying. 158 + 159 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-10.2.3> RFC 9110 Section 10.2.3 *) 160 + 161 + type retry_after = 162 + | Retry_after_date of string 163 + (** An HTTP-date when the resource will be available *) 164 + | Retry_after_seconds of int 165 + (** Number of seconds to wait before retrying *) 166 + 167 + val parse_retry_after : string -> retry_after option 168 + (** [parse_retry_after s] parses a Retry-After header value. 169 + 170 + Examples: 171 + - ["120"] -> Some (Retry_after_seconds 120) 172 + - ["Fri, 31 Dec 1999 23:59:59 GMT"] -> Some (Retry_after_date "...") *) 173 + 174 + val retry_after_to_seconds : ?now:float -> retry_after -> int option 175 + (** [retry_after_to_seconds ?now retry_after] converts to seconds. 176 + 177 + For [Retry_after_seconds], returns the value directly. 178 + For [Retry_after_date], returns [None] (date parsing not yet implemented). 179 + 180 + @param now The current time as a Unix timestamp (for date calculation) *) 181 + 182 + (** {1 Accept-Ranges (RFC 9110 Section 14.3)} 183 + 184 + The Accept-Ranges header indicates whether the server supports range requests. 185 + 186 + @see <https://www.rfc-editor.org/rfc/rfc9110#section-14.3> RFC 9110 Section 14.3 *) 187 + 188 + type accept_ranges = 189 + | Accept_ranges_bytes 190 + (** Server supports byte range requests *) 191 + | Accept_ranges_none 192 + (** Server does not support range requests *) 193 + | Accept_ranges_other of string 194 + (** Server supports some other range unit *) 195 + 196 + val parse_accept_ranges : string -> accept_ranges 197 + (** [parse_accept_ranges s] parses an Accept-Ranges header value. 198 + 199 + Examples: 200 + - ["bytes"] -> Accept_ranges_bytes 201 + - ["none"] -> Accept_ranges_none *) 202 + 203 + val supports_byte_ranges : accept_ranges -> bool 204 + (** [supports_byte_ranges ar] returns [true] if byte range requests are supported. *)

+3

ocaml-requests/lib/requests.ml

··· 29 29 module Version = Version 30 30 module Link = Link 31 31 module Timing = Timing 32 + module Header_name = Header_name 33 + module Header_parsing = Header_parsing 34 + module Websocket = Websocket 32 35 33 36 (** Minimum TLS version configuration - re-exported from Tls_config. *) 34 37 type tls_version = Tls_config.tls_version =

+11

ocaml-requests/lib/requests.mli

··· 917 917 (** HTTP request timing metrics for performance analysis *) 918 918 module Timing = Timing 919 919 920 + (** HTTP header name types and utilities *) 921 + module Header_name = Header_name 922 + 923 + (** HTTP header value parsing for complex headers (RFC 9110) 924 + @see <https://www.rfc-editor.org/rfc/rfc9110> *) 925 + module Header_parsing = Header_parsing 926 + 927 + (** WebSocket handshake support (RFC 6455) 928 + @see <https://www.rfc-editor.org/rfc/rfc6455> *) 929 + module Websocket = Websocket 930 + 920 931 (** {2 Logging} *) 921 932 922 933 (** Log source for the requests library.

+260

ocaml-requests/lib/websocket.ml

··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** WebSocket Protocol Support (RFC 6455) 7 + 8 + This module provides functions for the WebSocket HTTP upgrade handshake. 9 + WebSocket connections are established by upgrading an HTTP/1.1 connection 10 + using the Upgrade mechanism. 11 + 12 + @see <https://www.rfc-editor.org/rfc/rfc6455> RFC 6455: The WebSocket Protocol *) 13 + 14 + let src = Logs.Src.create "requests.websocket" ~doc:"WebSocket Support" 15 + module Log = (val Logs.src_log src : Logs.LOG) 16 + 17 + (** {1 Constants} *) 18 + 19 + (** The WebSocket protocol version per RFC 6455. 20 + This is the only version defined by the RFC. *) 21 + let protocol_version = "13" 22 + 23 + (** The magic GUID used in Sec-WebSocket-Accept computation. 24 + @see <https://www.rfc-editor.org/rfc/rfc6455#section-1.3> RFC 6455 Section 1.3 *) 25 + let magic_guid = "258EAFA5-E914-47DA-95CA-C5AB0DC85B11" 26 + 27 + (** {1 Sec-WebSocket-Key Generation} 28 + 29 + The client generates a random 16-byte value, base64-encodes it, and sends 30 + it in the Sec-WebSocket-Key header. This proves the server understands 31 + the WebSocket protocol. 32 + 33 + @see <https://www.rfc-editor.org/rfc/rfc6455#section-4.1> RFC 6455 Section 4.1 *) 34 + 35 + (** Generate a random Sec-WebSocket-Key value. 36 + 37 + Creates a cryptographically random 16-byte nonce and base64-encodes it. 38 + The result is suitable for use in the Sec-WebSocket-Key header. *) 39 + let generate_key () = 40 + let random_bytes = Mirage_crypto_rng.generate 16 in 41 + let key = Base64.encode_exn random_bytes in 42 + Log.debug (fun m -> m "Generated WebSocket key: %s" key); 43 + key 44 + 45 + (** {1 Sec-WebSocket-Accept Computation} 46 + 47 + The server computes Sec-WebSocket-Accept as: 48 + [base64(SHA-1(Sec-WebSocket-Key + magic_guid))] 49 + 50 + This proves the server received the client's handshake and understands 51 + the WebSocket protocol. 52 + 53 + @see <https://www.rfc-editor.org/rfc/rfc6455#section-4.2.2> RFC 6455 Section 4.2.2 *) 54 + 55 + (** Compute the expected Sec-WebSocket-Accept value for a given key. 56 + 57 + @param key The Sec-WebSocket-Key sent by the client 58 + @return The expected Sec-WebSocket-Accept value *) 59 + let compute_accept ~key = 60 + let combined = key ^ magic_guid in 61 + let hash = Digestif.SHA1.(digest_string combined |> to_raw_string) in 62 + let accept = Base64.encode_exn hash in 63 + Log.debug (fun m -> m "Computed WebSocket accept for key %s: %s" key accept); 64 + accept 65 + 66 + (** Validate a server's Sec-WebSocket-Accept value. 67 + 68 + @param key The Sec-WebSocket-Key that was sent 69 + @param accept The Sec-WebSocket-Accept received from the server 70 + @return [true] if the accept value is correct *) 71 + let validate_accept ~key ~accept = 72 + let expected = compute_accept ~key in 73 + let valid = String.equal expected accept in 74 + if not valid then 75 + Log.warn (fun m -> m "WebSocket accept validation failed: expected %s, got %s" 76 + expected accept); 77 + valid 78 + 79 + (** {1 Sec-WebSocket-Protocol Negotiation} 80 + 81 + The client sends a list of desired subprotocols; the server selects one. 82 + Common subprotocols include "graphql-ws", "graphql-transport-ws", "wamp.2.json". 83 + 84 + @see <https://www.rfc-editor.org/rfc/rfc6455#section-11.3.4> RFC 6455 Section 11.3.4 *) 85 + 86 + (** Parse a Sec-WebSocket-Protocol header value into a list of protocols. 87 + 88 + The header value is a comma-separated list of protocol identifiers. *) 89 + let parse_protocols s = 90 + String.split_on_char ',' s 91 + |> List.map String.trim 92 + |> List.filter (fun s -> String.length s > 0) 93 + 94 + (** Format a list of protocols as a Sec-WebSocket-Protocol header value. *) 95 + let protocols_to_string protocols = 96 + String.concat ", " protocols 97 + 98 + (** Select a protocol from the offered list that matches one we support. 99 + 100 + @param offered The protocols offered by the client 101 + @param supported The protocols we support (in preference order) 102 + @return The selected protocol, or [None] if no match *) 103 + let select_protocol ~offered ~supported = 104 + List.find_opt (fun s -> List.mem s offered) supported 105 + 106 + (** {1 Sec-WebSocket-Extensions Parsing} 107 + 108 + Extensions provide additional capabilities like compression. 109 + The most common extension is "permessage-deflate" (RFC 7692). 110 + 111 + @see <https://www.rfc-editor.org/rfc/rfc6455#section-9> RFC 6455 Section 9 112 + @see <https://www.rfc-editor.org/rfc/rfc7692> RFC 7692: Compression Extensions *) 113 + 114 + (** An extension with optional parameters. 115 + 116 + Example: [("permessage-deflate", [("client_max_window_bits", None)])] *) 117 + type extension = { 118 + name : string; 119 + params : (string * string option) list; 120 + } 121 + 122 + (** Parse a single extension (name with optional parameters). 123 + 124 + Format: [name; param1; param2=value; ...] *) 125 + let parse_single_extension s = 126 + let parts = String.split_on_char ';' s |> List.map String.trim in 127 + match parts with 128 + | [] -> None 129 + | name :: params -> 130 + let parse_param p = 131 + match String.index_opt p '=' with 132 + | None -> (String.trim p, None) 133 + | Some eq_idx -> 134 + let key = String.trim (String.sub p 0 eq_idx) in 135 + let value = String.trim (String.sub p (eq_idx + 1) (String.length p - eq_idx - 1)) in 136 + (* Remove quotes if present *) 137 + let value = if String.length value >= 2 && value.[0] = '"' then 138 + String.sub value 1 (String.length value - 2) 139 + else value 140 + in 141 + (key, Some value) 142 + in 143 + Some { 144 + name = String.trim name; 145 + params = List.map parse_param params; 146 + } 147 + 148 + (** Parse a Sec-WebSocket-Extensions header value. 149 + 150 + Format is comma-separated extensions, each with semicolon-separated parameters: 151 + [permessage-deflate; client_max_window_bits, another-ext] *) 152 + let parse_extensions s = 153 + (* Split on commas, but be careful of quoted values *) 154 + let extensions = String.split_on_char ',' s in 155 + List.filter_map parse_single_extension extensions 156 + 157 + (** Format extensions as a Sec-WebSocket-Extensions header value. *) 158 + let extensions_to_string extensions = 159 + let ext_to_string ext = 160 + let params_str = List.map (fun (k, v) -> 161 + match v with 162 + | None -> k 163 + | Some v -> Printf.sprintf "%s=%s" k v 164 + ) ext.params in 165 + String.concat "; " (ext.name :: params_str) 166 + in 167 + String.concat ", " (List.map ext_to_string extensions) 168 + 169 + (** Check if an extension is present in a list. *) 170 + let has_extension ~name extensions = 171 + List.exists (fun ext -> String.equal ext.name name) extensions 172 + 173 + (** Get parameters for a specific extension. *) 174 + let get_extension_params ~name extensions = 175 + match List.find_opt (fun ext -> String.equal ext.name name) extensions with 176 + | Some ext -> Some ext.params 177 + | None -> None 178 + 179 + (** {1 Handshake Header Helpers} *) 180 + 181 + (** Build the headers for a WebSocket upgrade request. 182 + 183 + @param key The Sec-WebSocket-Key (use {!generate_key} to create) 184 + @param protocols Optional list of subprotocols to request 185 + @param extensions Optional list of extensions to request 186 + @param origin Optional Origin header value *) 187 + let make_upgrade_headers ~key ?protocols ?extensions ?origin () = 188 + let headers = Headers.empty 189 + |> Headers.set `Upgrade "websocket" 190 + |> Headers.set `Connection "Upgrade" 191 + |> Headers.set `Sec_websocket_key key 192 + |> Headers.set `Sec_websocket_version protocol_version 193 + in 194 + let headers = match protocols with 195 + | Some ps when ps <> [] -> 196 + Headers.set `Sec_websocket_protocol (protocols_to_string ps) headers 197 + | _ -> headers 198 + in 199 + let headers = match extensions with 200 + | Some exts when exts <> [] -> 201 + Headers.set `Sec_websocket_extensions (extensions_to_string exts) headers 202 + | _ -> headers 203 + in 204 + let headers = match origin with 205 + | Some o -> Headers.set `Origin o headers 206 + | None -> headers 207 + in 208 + headers 209 + 210 + (** Helper to check if a string contains a substring. *) 211 + let string_contains ~needle haystack = 212 + let nlen = String.length needle in 213 + let hlen = String.length haystack in 214 + if nlen > hlen then false 215 + else 216 + let rec check i = 217 + if i + nlen > hlen then false 218 + else if String.sub haystack i nlen = needle then true 219 + else check (i + 1) 220 + in 221 + check 0 222 + 223 + (** Validate a WebSocket upgrade response. 224 + 225 + Checks that: 226 + - Status code is 101 (Switching Protocols) 227 + - Upgrade header is "websocket" 228 + - Connection header includes "Upgrade" 229 + - Sec-WebSocket-Accept is correct for the given key 230 + 231 + @param key The Sec-WebSocket-Key that was sent 232 + @param status The HTTP status code 233 + @param headers The response headers 234 + @return [Ok ()] if valid, [Error reason] if invalid *) 235 + let validate_upgrade_response ~key ~status ~headers = 236 + (* Check status code *) 237 + if status <> 101 then 238 + Error (Printf.sprintf "Expected status 101, got %d" status) 239 + (* Check Upgrade header *) 240 + else match Headers.get `Upgrade headers with 241 + | None -> Error "Missing Upgrade header" 242 + | Some upgrade when String.lowercase_ascii upgrade <> "websocket" -> 243 + Error (Printf.sprintf "Upgrade header is '%s', expected 'websocket'" upgrade) 244 + | Some _ -> 245 + (* Check Connection header *) 246 + match Headers.get `Connection headers with 247 + | None -> Error "Missing Connection header" 248 + | Some conn -> 249 + let conn_lower = String.lowercase_ascii conn in 250 + if not (string_contains ~needle:"upgrade" conn_lower) then 251 + Error (Printf.sprintf "Connection header is '%s', expected 'Upgrade'" conn) 252 + else 253 + (* Check Sec-WebSocket-Accept *) 254 + match Headers.get `Sec_websocket_accept headers with 255 + | None -> Error "Missing Sec-WebSocket-Accept header" 256 + | Some accept -> 257 + if validate_accept ~key ~accept then 258 + Ok () 259 + else 260 + Error "Sec-WebSocket-Accept validation failed"

+156

ocaml-requests/lib/websocket.mli

··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** WebSocket Protocol Support (RFC 6455) 7 + 8 + This module provides functions for the WebSocket HTTP upgrade handshake. 9 + WebSocket connections are established by upgrading an HTTP/1.1 connection 10 + using the Upgrade mechanism. 11 + 12 + {2 Basic Usage} 13 + 14 + {[ 15 + (* Client: initiate WebSocket upgrade *) 16 + let key = Websocket.generate_key () in 17 + let headers = Websocket.make_upgrade_headers ~key () in 18 + (* ... send request with these headers ... *) 19 + 20 + (* Client: validate server response *) 21 + match Websocket.validate_upgrade_response ~key ~status ~headers with 22 + | Ok () -> (* Connection upgraded successfully *) 23 + | Error reason -> (* Handshake failed *) 24 + ]} 25 + 26 + @see <https://www.rfc-editor.org/rfc/rfc6455> RFC 6455: The WebSocket Protocol *) 27 + 28 + (** {1 Constants} *) 29 + 30 + val protocol_version : string 31 + (** The WebSocket protocol version per RFC 6455. 32 + This is always ["13"]. *) 33 + 34 + val magic_guid : string 35 + (** The magic GUID used in Sec-WebSocket-Accept computation. 36 + @see <https://www.rfc-editor.org/rfc/rfc6455#section-1.3> RFC 6455 Section 1.3 *) 37 + 38 + (** {1 Sec-WebSocket-Key} 39 + 40 + @see <https://www.rfc-editor.org/rfc/rfc6455#section-4.1> RFC 6455 Section 4.1 *) 41 + 42 + val generate_key : unit -> string 43 + (** [generate_key ()] creates a random Sec-WebSocket-Key value. 44 + 45 + Generates a cryptographically random 16-byte nonce and base64-encodes it. 46 + The result is suitable for use in the Sec-WebSocket-Key header. *) 47 + 48 + (** {1 Sec-WebSocket-Accept} 49 + 50 + @see <https://www.rfc-editor.org/rfc/rfc6455#section-4.2.2> RFC 6455 Section 4.2.2 *) 51 + 52 + val compute_accept : key:string -> string 53 + (** [compute_accept ~key] computes the expected Sec-WebSocket-Accept value. 54 + 55 + The computation is: [base64(SHA-1(key + magic_guid))] 56 + 57 + @param key The Sec-WebSocket-Key sent by the client 58 + @return The expected Sec-WebSocket-Accept value *) 59 + 60 + val validate_accept : key:string -> accept:string -> bool 61 + (** [validate_accept ~key ~accept] validates a server's Sec-WebSocket-Accept. 62 + 63 + @param key The Sec-WebSocket-Key that was sent 64 + @param accept The Sec-WebSocket-Accept received from the server 65 + @return [true] if the accept value is correct *) 66 + 67 + (** {1 Sec-WebSocket-Protocol} 68 + 69 + @see <https://www.rfc-editor.org/rfc/rfc6455#section-11.3.4> RFC 6455 Section 11.3.4 *) 70 + 71 + val parse_protocols : string -> string list 72 + (** [parse_protocols s] parses a Sec-WebSocket-Protocol header value. 73 + 74 + Example: ["graphql-ws, graphql-transport-ws"] -> [["graphql-ws"; "graphql-transport-ws"]] *) 75 + 76 + val protocols_to_string : string list -> string 77 + (** [protocols_to_string protocols] formats protocols as a header value. *) 78 + 79 + val select_protocol : offered:string list -> supported:string list -> string option 80 + (** [select_protocol ~offered ~supported] selects a mutually acceptable protocol. 81 + 82 + @param offered The protocols offered by the client 83 + @param supported The protocols we support (in preference order) 84 + @return The selected protocol, or [None] if no match *) 85 + 86 + (** {1 Sec-WebSocket-Extensions} 87 + 88 + @see <https://www.rfc-editor.org/rfc/rfc6455#section-9> RFC 6455 Section 9 89 + @see <https://www.rfc-editor.org/rfc/rfc7692> RFC 7692: Compression Extensions *) 90 + 91 + (** An extension with optional parameters. 92 + 93 + Example: [permessage-deflate; client_max_window_bits] *) 94 + type extension = { 95 + name : string; 96 + params : (string * string option) list; 97 + } 98 + 99 + val parse_extensions : string -> extension list 100 + (** [parse_extensions s] parses a Sec-WebSocket-Extensions header value. 101 + 102 + Example: ["permessage-deflate; client_max_window_bits"] *) 103 + 104 + val extensions_to_string : extension list -> string 105 + (** [extensions_to_string extensions] formats extensions as a header value. *) 106 + 107 + val has_extension : name:string -> extension list -> bool 108 + (** [has_extension ~name extensions] checks if an extension is present. *) 109 + 110 + val get_extension_params : name:string -> extension list -> (string * string option) list option 111 + (** [get_extension_params ~name extensions] gets parameters for an extension. *) 112 + 113 + (** {1 Handshake Helpers} *) 114 + 115 + val make_upgrade_headers : 116 + key:string -> 117 + ?protocols:string list -> 118 + ?extensions:extension list -> 119 + ?origin:string -> 120 + unit -> 121 + Headers.t 122 + (** [make_upgrade_headers ~key ?protocols ?extensions ?origin ()] builds 123 + headers for a WebSocket upgrade request. 124 + 125 + Sets the following headers: 126 + - [Upgrade: websocket] 127 + - [Connection: Upgrade] 128 + - [Sec-WebSocket-Key: {key}] 129 + - [Sec-WebSocket-Version: 13] 130 + - [Sec-WebSocket-Protocol: ...] (if protocols provided) 131 + - [Sec-WebSocket-Extensions: ...] (if extensions provided) 132 + - [Origin: ...] (if origin provided) 133 + 134 + @param key The Sec-WebSocket-Key (use {!generate_key} to create) 135 + @param protocols Optional list of subprotocols to request 136 + @param extensions Optional list of extensions to request 137 + @param origin Optional Origin header value *) 138 + 139 + val validate_upgrade_response : 140 + key:string -> 141 + status:int -> 142 + headers:Headers.t -> 143 + (unit, string) result 144 + (** [validate_upgrade_response ~key ~status ~headers] validates a WebSocket 145 + upgrade response. 146 + 147 + Checks that: 148 + - Status code is 101 (Switching Protocols) 149 + - Upgrade header is "websocket" 150 + - Connection header includes "Upgrade" 151 + - Sec-WebSocket-Accept is correct for the given key 152 + 153 + @param key The Sec-WebSocket-Key that was sent 154 + @param status The HTTP status code 155 + @param headers The response headers 156 + @return [Ok ()] if valid, [Error reason] if invalid *)

+256

ocaml-requests/specs/http-fields.csv

··· 1 + Field Name,Status,Structured Type,Reference,Comments 2 + A-IM,permanent,,[RFC 3229: Delta encoding in HTTP], 3 + Accept,permanent,,"[RFC 9110, Section 12.5.1: HTTP Semantics]", 4 + Accept-Additions,permanent,,[RFC 2324: Hyper Text Coffee Pot Control Protocol (HTCPCP/1.0)], 5 + Accept-CH,permanent,List,"[RFC 8942, Section 3.1: HTTP Client Hints]", 6 + Accept-Charset,deprecated,,"[RFC 9110, Section 12.5.2: HTTP Semantics]", 7 + Accept-Datetime,permanent,,[RFC 7089: HTTP Framework for Time-Based Access to Resource States -- Memento], 8 + Accept-Encoding,permanent,,"[RFC 9110, Section 12.5.3: HTTP Semantics]", 9 + Accept-Features,permanent,,[RFC 2295: Transparent Content Negotiation in HTTP], 10 + Accept-Language,permanent,,"[RFC 9110, Section 12.5.4: HTTP Semantics]", 11 + Accept-Patch,permanent,,[RFC 5789: PATCH Method for HTTP], 12 + Accept-Post,permanent,,[Linked Data Platform 1.0], 13 + Accept-Query,permanent,List,"[RFC-ietf-httpbis-safe-method-w-body-14, Section 3: The HTTP QUERY Method]", 14 + Accept-Ranges,permanent,,"[RFC 9110, Section 14.3: HTTP Semantics]", 15 + Accept-Signature,permanent,,"[RFC 9421, Section 5.1: HTTP Message Signatures]", 16 + Access-Control,obsoleted,,[Access Control for Cross-site Requests], 17 + Access-Control-Allow-Credentials,permanent,,[Fetch], 18 + Access-Control-Allow-Headers,permanent,,[Fetch], 19 + Access-Control-Allow-Methods,permanent,,[Fetch], 20 + Access-Control-Allow-Origin,permanent,,[Fetch], 21 + Access-Control-Expose-Headers,permanent,,[Fetch], 22 + Access-Control-Max-Age,permanent,,[Fetch], 23 + Access-Control-Request-Headers,permanent,,[Fetch], 24 + Access-Control-Request-Method,permanent,,[Fetch], 25 + Activate-Storage-Access,provisional,Item,[https://privacycg.github.io/storage-access-headers], 26 + Age,permanent,,"[RFC 9111, Section 5.1: HTTP Caching]", 27 + Allow,permanent,,"[RFC 9110, Section 10.2.1: HTTP Semantics]", 28 + ALPN,permanent,,"[RFC 7639, Section 2: The ALPN HTTP Header Field]", 29 + Alt-Svc,permanent,,[RFC 7838: HTTP Alternative Services], 30 + Alt-Used,permanent,,[RFC 7838: HTTP Alternative Services], 31 + Alternates,permanent,,[RFC 2295: Transparent Content Negotiation in HTTP], 32 + AMP-Cache-Transform,provisional,,[AMP-Cache-Transform HTTP request header], 33 + Apply-To-Redirect-Ref,permanent,,[RFC 4437: Web Distributed Authoring and Versioning (WebDAV) Redirect Reference Resources], 34 + Authentication-Control,permanent,,"[RFC 8053, Section 4: HTTP Authentication Extensions for Interactive Clients]", 35 + Authentication-Info,permanent,,"[RFC 9110, Section 11.6.3: HTTP Semantics]", 36 + Authorization,permanent,,"[RFC 9110, Section 11.6.2: HTTP Semantics]", 37 + Available-Dictionary,permanent,,"[RFC 9842, Section 2.2: Compression Dictionary Transport]", 38 + C-Ext,obsoleted,,[RFC 2774: An HTTP Extension Framework],[Status change of HTTP experiments to Historic] 39 + C-Man,obsoleted,,[RFC 2774: An HTTP Extension Framework],[Status change of HTTP experiments to Historic] 40 + C-Opt,obsoleted,,[RFC 2774: An HTTP Extension Framework],[Status change of HTTP experiments to Historic] 41 + C-PEP,obsoleted,,[PEP - an Extension Mechanism for HTTP],[Status change of HTTP experiments to Historic] 42 + C-PEP-Info,deprecated,,[PEP - an Extension Mechanism for HTTP],[Status change of HTTP experiments to Historic] 43 + Cache-Control,permanent,,"[RFC 9111, Section 5.2: HTTP Caching]", 44 + Cache-Group-Invalidation,permanent,,[RFC9875: HTTP Cache Groups], 45 + Cache-Groups,permanent,,[RFC9875: HTTP Cache Groups], 46 + Cache-Status,permanent,List,[RFC 9211: The Cache-Status HTTP Response Header Field], 47 + Cal-Managed-ID,permanent,,"[RFC 8607, Section 5.1: Calendaring Extensions to WebDAV (CalDAV): Managed Attachments]", 48 + CalDAV-Timezones,permanent,,"[RFC 7809, Section 7.1: Calendaring Extensions to WebDAV (CalDAV): Time Zones by Reference]", 49 + Capsule-Protocol,permanent,,[RFC 9297: HTTP Datagrams and the Capsule Protocol], 50 + CDN-Cache-Control,permanent,Dictionary,[RFC 9213: Targeted HTTP Cache Control],Cache directives targeted at content delivery networks 51 + CDN-Loop,permanent,,[RFC 8586: Loop Detection in Content Delivery Networks (CDNs)], 52 + Cert-Not-After,permanent,,"[RFC 8739, Section 3.3: Support for Short-Term, Automatically Renewed (STAR) Certificates in the Automated Certificate Management Environment (ACME)]", 53 + Cert-Not-Before,permanent,,"[RFC 8739, Section 3.3: Support for Short-Term, Automatically Renewed (STAR) Certificates in the Automated Certificate Management Environment (ACME)]", 54 + Clear-Site-Data,permanent,,[Clear Site Data], 55 + Client-Cert,permanent,Item,"[RFC 9440, Section 2: Client-Cert HTTP Header Field]", 56 + Client-Cert-Chain,permanent,List,"[RFC 9440, Section 2: Client-Cert HTTP Header Field]", 57 + Close,permanent,,"[RFC 9112, Section 9.6: HTTP/1.1]",(reserved) 58 + CMCD-Object,provisional,,[CTA][CTA-5004 Common Media Client Data], 59 + CMCD-Request,provisional,,[CTA][CTA-5004 Common Media Client Data], 60 + CMCD-Session,provisional,,[CTA][CTA-5004 Common Media Client Data], 61 + CMCD-Status,provisional,,[CTA][CTA-5004 Common Media Client Data], 62 + CMSD-Dynamic,provisional,,[CTA][CTA-5006 Common Media Server Data (CMSD)], 63 + CMSD-Static,provisional,,[CTA][CTA-5006 Common Media Server Data (CMSD)], 64 + Concealed-Auth-Export,permanent,Item,[RFC 9729: The Concealed HTTP Authentication Scheme], 65 + Configuration-Context,provisional,,[OSLC Configuration Management Version 1.0. Part 3: Configuration Specification], 66 + Connection,permanent,,"[RFC 9110, Section 7.6.1: HTTP Semantics]", 67 + Content-Base,obsoleted,,[RFC 2068: Hypertext Transfer Protocol -- HTTP/1.1],Obsoleted by [RFC 2616: Hypertext Transfer Protocol -- HTTP/1.1] 68 + Content-Digest,permanent,,"[RFC 9530, Section 2: Digest Fields]", 69 + Content-Disposition,permanent,,[RFC 6266: Use of the Content-Disposition Header Field in the Hypertext Transfer Protocol (HTTP)], 70 + Content-Encoding,permanent,,"[RFC 9110, Section 8.4: HTTP Semantics]", 71 + Content-ID,deprecated,,[The HTTP Distribution and Replication Protocol], 72 + Content-Language,permanent,,"[RFC 9110, Section 8.5: HTTP Semantics]", 73 + Content-Length,permanent,,"[RFC 9110, Section 8.6: HTTP Semantics]", 74 + Content-Location,permanent,,"[RFC 9110, Section 8.7: HTTP Semantics]", 75 + Content-MD5,obsoleted,,"[RFC 2616, Section 14.15: Hypertext Transfer Protocol -- HTTP/1.1]","Obsoleted by [RFC 7231, Appendix B: Hypertext Transfer Protocol (HTTP/1.1): Semantics and Content]" 76 + Content-Range,permanent,,"[RFC 9110, Section 14.4: HTTP Semantics]", 77 + Content-Script-Type,obsoleted,,[HTML 4.01 Specification], 78 + Content-Security-Policy,permanent,,[Content Security Policy Level 3], 79 + Content-Security-Policy-Report-Only,permanent,,[Content Security Policy Level 3], 80 + Content-Style-Type,obsoleted,,[HTML 4.01 Specification], 81 + Content-Type,permanent,,"[RFC 9110, Section 8.3: HTTP Semantics]", 82 + Content-Version,obsoleted,,[RFC 2068: Hypertext Transfer Protocol -- HTTP/1.1], 83 + Cookie,permanent,,"[RFC-ietf-httpbis-rfc6265bis-22, Section 5.8.1: Cookies: HTTP State Management Mechanism]", 84 + Cookie2,obsoleted,,[RFC 2965: HTTP State Management Mechanism],Obsoleted by [RFC 6265: HTTP State Management Mechanism] 85 + Cross-Origin-Embedder-Policy,permanent,Item,[HTML], 86 + Cross-Origin-Embedder-Policy-Report-Only,permanent,Item,[HTML], 87 + Cross-Origin-Opener-Policy,permanent,Item,[HTML], 88 + Cross-Origin-Opener-Policy-Report-Only,permanent,Item,[HTML], 89 + Cross-Origin-Resource-Policy,permanent,,[Fetch], 90 + CTA-Common-Access-Token,provisional,,[CTA][Chris_Lemmons], 91 + DASL,permanent,,[RFC 5323: Web Distributed Authoring and Versioning (WebDAV) SEARCH], 92 + Date,permanent,,"[RFC 9110, Section 6.6.1: HTTP Semantics]", 93 + DAV,permanent,,[RFC 4918: HTTP Extensions for Web Distributed Authoring and Versioning (WebDAV)], 94 + Default-Style,obsoleted,,[HTML 4.01 Specification], 95 + Delta-Base,permanent,,[RFC 3229: Delta encoding in HTTP], 96 + Deprecation,permanent,Item,"[RFC 9745, Section 2: The Deprecation HTTP Response Header Field]", 97 + Depth,permanent,,[RFC 4918: HTTP Extensions for Web Distributed Authoring and Versioning (WebDAV)], 98 + Derived-From,obsoleted,,[RFC 2068: Hypertext Transfer Protocol -- HTTP/1.1], 99 + Destination,permanent,,[RFC 4918: HTTP Extensions for Web Distributed Authoring and Versioning (WebDAV)], 100 + Detached-JWS,permanent,,[RFC 9635: Grant Negotiation and Authorization Protocol (GNAP)], 101 + Differential-ID,deprecated,,[The HTTP Distribution and Replication Protocol], 102 + Dictionary-ID,permanent,,"[RFC 9842, Section 2.3: Compression Dictionary Transport]", 103 + Digest,obsoleted,,[RFC 3230: Instance Digests in HTTP],"Obsoleted by [RFC 9530, Section 1.3: Digest Fields]" 104 + DPoP,permanent,,[RFC 9449: OAuth 2.0 Demonstrating Proof of Possession (DPoP)], 105 + DPoP-Nonce,permanent,,[RFC 9449: OAuth 2.0 Demonstrating Proof of Possession (DPoP)], 106 + Early-Data,permanent,,[RFC 8470: Using Early Data in HTTP], 107 + EDIINT-Features,provisional,,[RFC 6017: Electronic Data Interchange - Internet Integration (EDIINT) Features Header Field], 108 + ETag,permanent,,"[RFC 9110, Section 8.8.3: HTTP Semantics]", 109 + Expect,permanent,,"[RFC 9110, Section 10.1.1: HTTP Semantics]", 110 + Expect-CT,deprecated,,[RFC 9163: Expect-CT Extension for HTTP],"Obsoleted by [IESG] 111 + [HTTPBIS]" 112 + Expires,permanent,,"[RFC 9111, Section 5.3: HTTP Caching]", 113 + Ext,obsoleted,,[RFC 2774: An HTTP Extension Framework],[Status change of HTTP experiments to Historic] 114 + Forwarded,permanent,,[RFC 7239: Forwarded HTTP Extension], 115 + From,permanent,,"[RFC 9110, Section 10.1.2: HTTP Semantics]", 116 + GetProfile,obsoleted,,[Implementation of OPS Over HTTP], 117 + Hobareg,permanent,,"[RFC 7486, Section 6.1.1: HTTP Origin-Bound Authentication (HOBA)]", 118 + Host,permanent,,"[RFC 9110, Section 7.2: HTTP Semantics]", 119 + HTTP2-Settings,obsoleted,,"[RFC 7540, Section 3.2.1: Hypertext Transfer Protocol Version 2 (HTTP/2)]",Obsolete; see Section 11.1 of [RFC9113] 120 + If,permanent,,[RFC 4918: HTTP Extensions for Web Distributed Authoring and Versioning (WebDAV)], 121 + If-Match,permanent,,"[RFC 9110, Section 13.1.1: HTTP Semantics]", 122 + If-Modified-Since,permanent,,"[RFC 9110, Section 13.1.3: HTTP Semantics]", 123 + If-None-Match,permanent,,"[RFC 9110, Section 13.1.2: HTTP Semantics]", 124 + If-Range,permanent,,"[RFC 9110, Section 13.1.5: HTTP Semantics]", 125 + If-Schedule-Tag-Match,permanent,,[ RFC 6338: Scheduling Extensions to CalDAV], 126 + If-Unmodified-Since,permanent,,"[RFC 9110, Section 13.1.4: HTTP Semantics]", 127 + IM,permanent,,[RFC 3229: Delta encoding in HTTP], 128 + Include-Referred-Token-Binding-ID,permanent,,[RFC 8473: Token Binding over HTTP], 129 + Isolation,provisional,,[OData Version 4.01 Part 1: Protocol][OASIS][Chet_Ensign], 130 + Keep-Alive,permanent,,[RFC 2068: Hypertext Transfer Protocol -- HTTP/1.1], 131 + Label,permanent,,[RFC 3253: Versioning Extensions to WebDAV: (Web Distributed Authoring and Versioning)], 132 + Last-Event-ID,permanent,,[HTML], 133 + Last-Modified,permanent,,"[RFC 9110, Section 8.8.2: HTTP Semantics]", 134 + Link,permanent,,[RFC 8288: Web Linking], 135 + Link-Template,permanent,,[RFC 9652: The Link-Template HTTP Header Field], 136 + Location,permanent,,"[RFC 9110, Section 10.2.2: HTTP Semantics]", 137 + Lock-Token,permanent,,[RFC 4918: HTTP Extensions for Web Distributed Authoring and Versioning (WebDAV)], 138 + Man,obsoleted,,[RFC 2774: An HTTP Extension Framework],[Status change of HTTP experiments to Historic] 139 + Max-Forwards,permanent,,"[RFC 9110, Section 7.6.2: HTTP Semantics]", 140 + Memento-Datetime,permanent,,[RFC 7089: HTTP Framework for Time-Based Access to Resource States -- Memento], 141 + Meter,permanent,,[RFC 2227: Simple Hit-Metering and Usage-Limiting for HTTP], 142 + Method-Check,obsoleted,,[Access Control for Cross-site Requests], 143 + Method-Check-Expires,obsoleted,,[Access Control for Cross-site Requests], 144 + MIME-Version,permanent,,"[RFC 9112, Appendix B.1: HTTP/1.1]", 145 + Negotiate,permanent,,[RFC 2295: Transparent Content Negotiation in HTTP], 146 + NEL,permanent,,[Network Error Logging], 147 + OData-EntityId,permanent,,[OData Version 4.01 Part 1: Protocol][OASIS][Chet_Ensign], 148 + OData-Isolation,permanent,,[OData Version 4.01 Part 1: Protocol][OASIS][Chet_Ensign], 149 + OData-MaxVersion,permanent,,[OData Version 4.01 Part 1: Protocol][OASIS][Chet_Ensign], 150 + OData-Version,permanent,,[OData Version 4.01 Part 1: Protocol][OASIS][Chet_Ensign], 151 + Opt,obsoleted,,[RFC 2774: An HTTP Extension Framework],[Status change of HTTP experiments to Historic] 152 + Optional-WWW-Authenticate,permanent,,"[RFC 8053, Section 3: HTTP Authentication Extensions for Interactive Clients]", 153 + Ordering-Type,permanent,,[RFC 3648: Web Distributed Authoring and Versioning (WebDAV) Ordered Collections Protocol], 154 + Origin,permanent,,[RFC 6454: The Web Origin Concept], 155 + Origin-Agent-Cluster,permanent,Item,[HTML], 156 + OSCORE,permanent,,"[RFC 8613, Section 11.1: Object Security for Constrained RESTful Environments (OSCORE)]", 157 + OSLC-Core-Version,permanent,,[OASIS Project Specification 01][OASIS][Chet_Ensign], 158 + Overwrite,permanent,,[RFC 4918: HTTP Extensions for Web Distributed Authoring and Versioning (WebDAV)], 159 + P3P,obsoleted,,[The Platform for Privacy Preferences 1.0 (P3P1.0) Specification], 160 + PEP,obsoleted,,[PEP - an Extension Mechanism for HTTP], 161 + PEP-Info,obsoleted,,[PEP - an Extension Mechanism for HTTP], 162 + Permissions-Policy,provisional,,[Permissions Policy], 163 + PICS-Label,obsoleted,,[PICS Label Distribution Label Syntax and Communication Protocols], 164 + Ping-From,permanent,,[HTML], 165 + Ping-To,permanent,,[HTML], 166 + Position,permanent,,[RFC 3648: Web Distributed Authoring and Versioning (WebDAV) Ordered Collections Protocol], 167 + Pragma,deprecated,,"[RFC 9111, Section 5.4: HTTP Caching]", 168 + Prefer,permanent,,[RFC 7240: Prefer Header for HTTP], 169 + Preference-Applied,permanent,,[RFC 7240: Prefer Header for HTTP], 170 + Priority,permanent,Dictionary,[RFC 9218: Extensible Prioritization Scheme for HTTP], 171 + ProfileObject,obsoleted,,[Implementation of OPS Over HTTP], 172 + Protocol,obsoleted,,[PICS Label Distribution Label Syntax and Communication Protocols], 173 + Protocol-Info,deprecated,,[White Paper: Joint Electronic Payment Initiative], 174 + Protocol-Query,deprecated,,[White Paper: Joint Electronic Payment Initiative], 175 + Protocol-Request,obsoleted,,[PICS Label Distribution Label Syntax and Communication Protocols], 176 + Proxy-Authenticate,permanent,,"[RFC 9110, Section 11.7.1: HTTP Semantics]", 177 + Proxy-Authentication-Info,permanent,,"[RFC 9110, Section 11.7.3: HTTP Semantics]", 178 + Proxy-Authorization,permanent,,"[RFC 9110, Section 11.7.2: HTTP Semantics]", 179 + Proxy-Features,obsoleted,,[Notification for Proxy Caches], 180 + Proxy-Instruction,obsoleted,,[Notification for Proxy Caches], 181 + Proxy-Status,permanent,List,[RFC 9209: The Proxy-Status HTTP Response Header Field], 182 + Public,obsoleted,,[RFC 2068: Hypertext Transfer Protocol -- HTTP/1.1], 183 + Public-Key-Pins,permanent,,[RFC 7469: Public Key Pinning Extension for HTTP], 184 + Public-Key-Pins-Report-Only,permanent,,[RFC 7469: Public Key Pinning Extension for HTTP], 185 + Range,permanent,,"[RFC 9110, Section 14.2: HTTP Semantics]", 186 + Redirect-Ref,permanent,,[RFC 4437: Web Distributed Authoring and Versioning (WebDAV) Redirect Reference Resources], 187 + Referer,permanent,,"[RFC 9110, Section 10.1.3: HTTP Semantics]", 188 + Referer-Root,obsoleted,,[Access Control for Cross-site Requests], 189 + Referrer-Policy,permanent,,[Referrer Policy],The header name does not share the HTTP Referer header's misspelling. 190 + Refresh,permanent,,[HTML], 191 + Repeatability-Client-ID,provisional,,[Repeatable Requests Version 1.0][OASIS][Chet_Ensign], 192 + Repeatability-First-Sent,provisional,,[Repeatable Requests Version 1.0][OASIS][Chet_Ensign], 193 + Repeatability-Request-ID,provisional,,[Repeatable Requests Version 1.0][OASIS][Chet_Ensign], 194 + Repeatability-Result,provisional,,[Repeatable Requests Version 1.0][OASIS][Chet_Ensign], 195 + Replay-Nonce,permanent,,"[RFC 8555, Section 6.5.1: Automatic Certificate Management Environment (ACME)]", 196 + Reporting-Endpoints,provisional,,[Reporting API], 197 + Repr-Digest,permanent,,"[RFC 9530, Section 3: Digest Fields]", 198 + Retry-After,permanent,,"[RFC 9110, Section 10.2.3: HTTP Semantics]", 199 + Safe,obsoleted,,[RFC 2310: The Safe Response Header Field],[Status change of HTTP experiments to Historic] 200 + Schedule-Reply,permanent,,[RFC 6638: Scheduling Extensions to CalDAV], 201 + Schedule-Tag,permanent,,[RFC 6338: Scheduling Extensions to CalDAV], 202 + Sec-Fetch-Dest,Permanent,Item,[https://www.w3.org/TR/fetch-metadata/#sec-fetch-dest-header], 203 + Sec-Fetch-Mode,Permanent,Item,[https://www.w3.org/TR/fetch-metadata/#sec-fetch-mode-header], 204 + Sec-Fetch-Site,Permanent,Item,[https://www.w3.org/TR/fetch-metadata/#sec-fetch-site-header], 205 + Sec-Fetch-Storage-Access,provisional,Token,[https://privacycg.github.io/storage-access-headers], 206 + Sec-Fetch-User,Permanent,Item,[https://www.w3.org/TR/fetch-metadata/#sec-fetch-user-header], 207 + Sec-GPC,provisional,,[Global Privacy Control (GPC)], 208 + Sec-Purpose,permanent,,[Fetch],Intended to replace the (not registered) Purpose and x-moz headers. 209 + Sec-Token-Binding,permanent,,[RFC 8473: Token Binding over HTTP], 210 + Sec-WebSocket-Accept,permanent,,[RFC 6455: The WebSocket Protocol], 211 + Sec-WebSocket-Extensions,permanent,,[RFC 6455: The WebSocket Protocol], 212 + Sec-WebSocket-Key,permanent,,[RFC 6455: The WebSocket Protocol], 213 + Sec-WebSocket-Protocol,permanent,,[RFC 6455: The WebSocket Protocol], 214 + Sec-WebSocket-Version,permanent,,[RFC 6455: The WebSocket Protocol], 215 + Security-Scheme,obsoleted,,[RFC 2660: The Secure HyperText Transfer Protocol],[Status change of HTTP experiments to Historic] 216 + Server,permanent,,"[RFC 9110, Section 10.2.4: HTTP Semantics]", 217 + Server-Timing,permanent,,[Server Timing], 218 + Set-Cookie,permanent,,"[RFC-ietf-httpbis-rfc6265bis-22, Section 5.8.1: Cookies: HTTP State Management Mechanism]", 219 + Set-Cookie2,obsoleted,,[RFC 2965: HTTP State Management Mechanism],Obsoleted by [RFC 6265: HTTP State Management Mechanism] 220 + Set-Txn,permanent,,"[RFC-ietf-scim-events-15, Section 3: SCIM Profile for Security Event Tokens]", 221 + SetProfile,obsoleted,,[Implementation of OPS Over HTTP], 222 + Signature,permanent,,"[RFC 9421, Section 4.2: HTTP Message Signatures]", 223 + Signature-Input,permanent,,"[RFC 9421, Section 4.1: HTTP Message Signatures]", 224 + SLUG,permanent,,[RFC 5023: The Atom Publishing Protocol], 225 + SoapAction,permanent,,[Simple Object Access Protocol (SOAP) 1.1], 226 + Status-URI,permanent,,[RFC 2518: HTTP Extensions for Distributed Authoring -- WEBDAV], 227 + Strict-Transport-Security,permanent,,[RFC 6797: HTTP Strict Transport Security (HSTS)], 228 + Sunset,permanent,,[RFC 8594: The Sunset HTTP Header Field], 229 + Surrogate-Capability,provisional,,[Edge Architecture Specification], 230 + Surrogate-Control,provisional,,[Edge Architecture Specification], 231 + TCN,permanent,,[RFC 2295: Transparent Content Negotiation in HTTP], 232 + TE,permanent,,"[RFC 9110, Section 10.1.4: HTTP Semantics]", 233 + Timeout,permanent,,[RFC 4918: HTTP Extensions for Web Distributed Authoring and Versioning (WebDAV)], 234 + Timing-Allow-Origin,provisional,,[Resource Timing Level 1], 235 + Topic,permanent,,"[RFC 8030, Section 5.4: Generic Event Delivery Using HTTP Push]", 236 + Traceparent,permanent,,[Trace Context], 237 + Tracestate,permanent,,[Trace Context], 238 + Trailer,permanent,,"[RFC 9110, Section 6.6.2: HTTP Semantics]", 239 + Transfer-Encoding,permanent,,"[RFC 9112, Section 6.1: HTTP Semantics]", 240 + TTL,permanent,,"[RFC 8030, Section 5.2: Generic Event Delivery Using HTTP Push]", 241 + Upgrade,permanent,,"[RFC 9110, Section 7.8: HTTP Semantics]", 242 + Urgency,permanent,,"[RFC 8030, Section 5.3: Generic Event Delivery Using HTTP Push]", 243 + URI,obsoleted,,[RFC 2068: Hypertext Transfer Protocol -- HTTP/1.1], 244 + Use-As-Dictionary,permanent,,"[RFC 9842, Section 2.1: Compression Dictionary Transport]", 245 + User-Agent,permanent,,"[RFC 9110, Section 10.1.5: HTTP Semantics]", 246 + Variant-Vary,permanent,,[RFC 2295: Transparent Content Negotiation in HTTP], 247 + Vary,permanent,,"[RFC 9110, Section 12.5.5: HTTP Semantics]", 248 + Via,permanent,,"[RFC 9110, Section 7.6.3: HTTP Semantics]", 249 + Want-Content-Digest,permanent,,"[RFC 9530, Section 4: Digest Fields]", 250 + Want-Digest,obsoleted,,[RFC 3230: Instance Digests in HTTP],"Obsoleted by [RFC 9530, Section 1.3: Digest Fields]" 251 + Want-Repr-Digest,permanent,,"[RFC 9530, Section 4: Digest Fields]", 252 + Warning,obsoleted,,"[RFC 9111, Section 5.5: HTTP Caching]", 253 + WWW-Authenticate,permanent,,"[RFC 9110, Section 11.6.1: HTTP Semantics]", 254 + X-Content-Type-Options,permanent,,[Fetch], 255 + X-Frame-Options,permanent,,[HTML], 256 + *,permanent,,"[RFC 9110, Section 12.5.5: HTTP Semantics]",(reserved)

+8

ocaml-requests/test/dune

··· 18 18 (name test_http_date) 19 19 (libraries requests eio eio_main alcotest fmt fmt.tty logs logs.fmt ptime)) 20 20 21 + (executable 22 + (name test_header_parsing) 23 + (libraries requests alcotest fmt fmt.tty logs logs.fmt)) 24 + 25 + (executable 26 + (name test_websocket) 27 + (libraries requests alcotest base64 fmt fmt.tty logs logs.fmt mirage-crypto-rng.unix)) 28 + 21 29 (cram 22 30 (deps %{bin:ocurl}))

+243

ocaml-requests/test/test_header_parsing.ml

··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Tests for Header_parsing module *) 7 + 8 + module Header_parsing = Requests.Header_parsing 9 + module Headers = Requests.Headers 10 + module Method = Requests.Method 11 + 12 + (** {1 Content-Range Tests (RFC 9110 Section 14.4)} *) 13 + 14 + let test_content_range_basic () = 15 + let result = Header_parsing.parse_content_range "bytes 0-499/1234" in 16 + match result with 17 + | Some cr -> 18 + Alcotest.(check string) "unit" "bytes" cr.unit; 19 + Alcotest.(check (option (pair int64 int64))) "range" 20 + (Some (0L, 499L)) cr.range; 21 + Alcotest.(check (option int64)) "complete_length" 22 + (Some 1234L) cr.complete_length 23 + | None -> 24 + Alcotest.fail "Expected Some content_range" 25 + 26 + let test_content_range_unsatisfied () = 27 + let result = Header_parsing.parse_content_range "bytes */1234" in 28 + match result with 29 + | Some cr -> 30 + Alcotest.(check string) "unit" "bytes" cr.unit; 31 + Alcotest.(check (option (pair int64 int64))) "range" None cr.range; 32 + Alcotest.(check (option int64)) "complete_length" 33 + (Some 1234L) cr.complete_length 34 + | None -> 35 + Alcotest.fail "Expected Some content_range for unsatisfied" 36 + 37 + let test_content_range_unknown_length () = 38 + let result = Header_parsing.parse_content_range "bytes 0-499/*" in 39 + match result with 40 + | Some cr -> 41 + Alcotest.(check string) "unit" "bytes" cr.unit; 42 + Alcotest.(check (option (pair int64 int64))) "range" 43 + (Some (0L, 499L)) cr.range; 44 + Alcotest.(check (option int64)) "complete_length" None cr.complete_length 45 + | None -> 46 + Alcotest.fail "Expected Some content_range for unknown length" 47 + 48 + let test_content_range_to_string () = 49 + let cr = Header_parsing.make_content_range ~start:0L ~end_:499L ~complete_length:1234L in 50 + let s = Header_parsing.content_range_to_string cr in 51 + Alcotest.(check string) "to_string" "bytes 0-499/1234" s 52 + 53 + let test_content_range_unsatisfied_to_string () = 54 + let cr = Header_parsing.make_unsatisfied_range ~complete_length:1234L in 55 + let s = Header_parsing.content_range_to_string cr in 56 + Alcotest.(check string) "unsatisfied to_string" "bytes */1234" s 57 + 58 + let test_content_range_invalid () = 59 + let invalid_inputs = [ 60 + ""; 61 + "invalid"; 62 + "0-499/1234"; (* missing unit *) 63 + "bytes 0-499"; (* missing length *) 64 + ] in 65 + List.iter (fun input -> 66 + let result = Header_parsing.parse_content_range input in 67 + Alcotest.(check bool) (Printf.sprintf "Invalid: %S" input) 68 + true (Option.is_none result) 69 + ) invalid_inputs 70 + 71 + (** {1 If-Range Tests (RFC 9110 Section 13.1.5)} *) 72 + 73 + let test_if_range_etag_strong () = 74 + let result = Header_parsing.parse_if_range "\"abc123\"" in 75 + match result with 76 + | Some (If_range_etag etag) -> 77 + Alcotest.(check string) "strong etag" "\"abc123\"" etag 78 + | _ -> 79 + Alcotest.fail "Expected If_range_etag for strong etag" 80 + 81 + let test_if_range_etag_weak () = 82 + let result = Header_parsing.parse_if_range "W/\"abc123\"" in 83 + match result with 84 + | Some (If_range_etag etag) -> 85 + Alcotest.(check string) "weak etag" "W/\"abc123\"" etag 86 + | _ -> 87 + Alcotest.fail "Expected If_range_etag for weak etag" 88 + 89 + let test_if_range_date () = 90 + let result = Header_parsing.parse_if_range "Sun, 06 Nov 1994 08:49:37 GMT" in 91 + match result with 92 + | Some (If_range_date date) -> 93 + Alcotest.(check string) "date" "Sun, 06 Nov 1994 08:49:37 GMT" date 94 + | _ -> 95 + Alcotest.fail "Expected If_range_date" 96 + 97 + let test_if_range_is_etag () = 98 + let etag = Header_parsing.if_range_of_etag "\"test\"" in 99 + let date = Header_parsing.if_range_of_date "Sun, 06 Nov 1994 08:49:37 GMT" in 100 + Alcotest.(check bool) "etag is_etag" true (Header_parsing.if_range_is_etag etag); 101 + Alcotest.(check bool) "date is_etag" false (Header_parsing.if_range_is_etag date); 102 + Alcotest.(check bool) "etag is_date" false (Header_parsing.if_range_is_date etag); 103 + Alcotest.(check bool) "date is_date" true (Header_parsing.if_range_is_date date) 104 + 105 + (** {1 Allow Tests (RFC 9110 Section 10.2.1)} *) 106 + 107 + let test_allow_parse_basic () = 108 + let methods = Header_parsing.parse_allow "GET, HEAD, PUT" in 109 + Alcotest.(check int) "count" 3 (List.length methods); 110 + Alcotest.(check bool) "has GET" true (List.mem `GET methods); 111 + Alcotest.(check bool) "has HEAD" true (List.mem `HEAD methods); 112 + Alcotest.(check bool) "has PUT" true (List.mem `PUT methods) 113 + 114 + let test_allow_parse_single () = 115 + let methods = Header_parsing.parse_allow "OPTIONS" in 116 + Alcotest.(check int) "count" 1 (List.length methods); 117 + Alcotest.(check bool) "has OPTIONS" true (List.mem `OPTIONS methods) 118 + 119 + let test_allow_parse_with_spaces () = 120 + let methods = Header_parsing.parse_allow "GET, HEAD, POST" in 121 + Alcotest.(check int) "count" 3 (List.length methods); 122 + Alcotest.(check bool) "has GET" true (List.mem `GET methods); 123 + Alcotest.(check bool) "has HEAD" true (List.mem `HEAD methods); 124 + Alcotest.(check bool) "has POST" true (List.mem `POST methods) 125 + 126 + let test_allow_to_string () = 127 + let methods = [`GET; `HEAD; `PUT] in 128 + let s = Header_parsing.allow_to_string methods in 129 + Alcotest.(check string) "to_string" "GET, HEAD, PUT" s 130 + 131 + let test_allow_contains () = 132 + let allow = "GET, HEAD, PUT" in 133 + Alcotest.(check bool) "contains GET" true 134 + (Header_parsing.allow_contains `GET allow); 135 + Alcotest.(check bool) "contains POST" false 136 + (Header_parsing.allow_contains `POST allow) 137 + 138 + (** {1 Authentication-Info Tests (RFC 9110 Section 11.6.3)} *) 139 + 140 + let test_auth_info_full () = 141 + let info = Header_parsing.parse_authentication_info 142 + "nextnonce=\"abc123\", qop=auth, rspauth=\"xyz789\", cnonce=\"client\", nc=00000001" in 143 + Alcotest.(check (option string)) "nextnonce" (Some "abc123") info.nextnonce; 144 + Alcotest.(check (option string)) "qop" (Some "auth") info.qop; 145 + Alcotest.(check (option string)) "rspauth" (Some "xyz789") info.rspauth; 146 + Alcotest.(check (option string)) "cnonce" (Some "client") info.cnonce; 147 + Alcotest.(check (option string)) "nc" (Some "00000001") info.nc 148 + 149 + let test_auth_info_nextnonce_only () = 150 + let info = Header_parsing.parse_authentication_info "nextnonce=\"newone\"" in 151 + Alcotest.(check (option string)) "nextnonce" (Some "newone") info.nextnonce; 152 + Alcotest.(check bool) "has_nextnonce" true (Header_parsing.has_nextnonce info); 153 + Alcotest.(check (option string)) "qop" None info.qop 154 + 155 + let test_auth_info_empty () = 156 + let info = Header_parsing.parse_authentication_info "" in 157 + Alcotest.(check (option string)) "nextnonce" None info.nextnonce; 158 + Alcotest.(check bool) "has_nextnonce" false (Header_parsing.has_nextnonce info) 159 + 160 + (** {1 Retry-After Tests (RFC 9110 Section 10.2.3)} *) 161 + 162 + let test_retry_after_seconds () = 163 + let result = Header_parsing.parse_retry_after "120" in 164 + match result with 165 + | Some (Retry_after_seconds s) -> 166 + Alcotest.(check int) "seconds" 120 s 167 + | _ -> 168 + Alcotest.fail "Expected Retry_after_seconds" 169 + 170 + let test_retry_after_date () = 171 + let result = Header_parsing.parse_retry_after "Fri, 31 Dec 1999 23:59:59 GMT" in 172 + match result with 173 + | Some (Retry_after_date d) -> 174 + Alcotest.(check string) "date" "Fri, 31 Dec 1999 23:59:59 GMT" d 175 + | _ -> 176 + Alcotest.fail "Expected Retry_after_date" 177 + 178 + let test_retry_after_to_seconds () = 179 + let ra = Header_parsing.Retry_after_seconds 60 in 180 + Alcotest.(check (option int)) "to_seconds" (Some 60) 181 + (Header_parsing.retry_after_to_seconds ra) 182 + 183 + (** {1 Accept-Ranges Tests (RFC 9110 Section 14.3)} *) 184 + 185 + let test_accept_ranges_bytes () = 186 + let ar = Header_parsing.parse_accept_ranges "bytes" in 187 + Alcotest.(check bool) "supports bytes" true 188 + (Header_parsing.supports_byte_ranges ar) 189 + 190 + let test_accept_ranges_none () = 191 + let ar = Header_parsing.parse_accept_ranges "none" in 192 + Alcotest.(check bool) "supports none" false 193 + (Header_parsing.supports_byte_ranges ar) 194 + 195 + let test_accept_ranges_case_insensitive () = 196 + let ar1 = Header_parsing.parse_accept_ranges "BYTES" in 197 + let ar2 = Header_parsing.parse_accept_ranges "Bytes" in 198 + Alcotest.(check bool) "BYTES supports" true 199 + (Header_parsing.supports_byte_ranges ar1); 200 + Alcotest.(check bool) "Bytes supports" true 201 + (Header_parsing.supports_byte_ranges ar2) 202 + 203 + (** {1 Test Suite} *) 204 + 205 + let () = 206 + Alcotest.run "Header Parsing" [ 207 + ("Content-Range", [ 208 + Alcotest.test_case "Basic parsing" `Quick test_content_range_basic; 209 + Alcotest.test_case "Unsatisfied range" `Quick test_content_range_unsatisfied; 210 + Alcotest.test_case "Unknown length" `Quick test_content_range_unknown_length; 211 + Alcotest.test_case "To string" `Quick test_content_range_to_string; 212 + Alcotest.test_case "Unsatisfied to string" `Quick test_content_range_unsatisfied_to_string; 213 + Alcotest.test_case "Invalid inputs" `Quick test_content_range_invalid; 214 + ]); 215 + ("If-Range", [ 216 + Alcotest.test_case "Strong ETag" `Quick test_if_range_etag_strong; 217 + Alcotest.test_case "Weak ETag" `Quick test_if_range_etag_weak; 218 + Alcotest.test_case "Date" `Quick test_if_range_date; 219 + Alcotest.test_case "Type predicates" `Quick test_if_range_is_etag; 220 + ]); 221 + ("Allow", [ 222 + Alcotest.test_case "Basic parsing" `Quick test_allow_parse_basic; 223 + Alcotest.test_case "Single method" `Quick test_allow_parse_single; 224 + Alcotest.test_case "With extra spaces" `Quick test_allow_parse_with_spaces; 225 + Alcotest.test_case "To string" `Quick test_allow_to_string; 226 + Alcotest.test_case "Contains" `Quick test_allow_contains; 227 + ]); 228 + ("Authentication-Info", [ 229 + Alcotest.test_case "Full parsing" `Quick test_auth_info_full; 230 + Alcotest.test_case "Nextnonce only" `Quick test_auth_info_nextnonce_only; 231 + Alcotest.test_case "Empty" `Quick test_auth_info_empty; 232 + ]); 233 + ("Retry-After", [ 234 + Alcotest.test_case "Seconds" `Quick test_retry_after_seconds; 235 + Alcotest.test_case "Date" `Quick test_retry_after_date; 236 + Alcotest.test_case "To seconds" `Quick test_retry_after_to_seconds; 237 + ]); 238 + ("Accept-Ranges", [ 239 + Alcotest.test_case "Bytes" `Quick test_accept_ranges_bytes; 240 + Alcotest.test_case "None" `Quick test_accept_ranges_none; 241 + Alcotest.test_case "Case insensitive" `Quick test_accept_ranges_case_insensitive; 242 + ]); 243 + ]

+291

ocaml-requests/test/test_websocket.ml

··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Tests for WebSocket module (RFC 6455) *) 7 + 8 + module Websocket = Requests.Websocket 9 + module Headers = Requests.Headers 10 + 11 + (** Helper for string contains *) 12 + let string_contains ~affix s = 13 + let alen = String.length affix in 14 + let slen = String.length s in 15 + if alen > slen then false 16 + else 17 + let rec check i = 18 + if i + alen > slen then false 19 + else if String.sub s i alen = affix then true 20 + else check (i + 1) 21 + in 22 + check 0 23 + 24 + (** {1 Key Generation Tests} *) 25 + 26 + let test_generate_key_length () = 27 + let key = Websocket.generate_key () in 28 + (* Base64 of 16 bytes = 24 characters (with padding) *) 29 + (* Actually 16 bytes -> ceil(16/3)*4 = 24 chars with padding, 30 + but base64 library might not pad. Let's check it decodes to 16 bytes *) 31 + let decoded = Base64.decode_exn key in 32 + Alcotest.(check int) "decoded length" 16 (String.length decoded) 33 + 34 + let test_generate_key_unique () = 35 + let key1 = Websocket.generate_key () in 36 + let key2 = Websocket.generate_key () in 37 + Alcotest.(check bool) "keys are different" true (key1 <> key2) 38 + 39 + let test_generate_key_valid_base64 () = 40 + let key = Websocket.generate_key () in 41 + (* Should not raise *) 42 + let _ = Base64.decode_exn key in 43 + Alcotest.(check pass) "valid base64" () () 44 + 45 + (** {1 Accept Computation Tests (RFC 6455 Section 4.2.2)} *) 46 + 47 + let test_compute_accept_rfc_example () = 48 + (* RFC 6455 Section 1.3 example: 49 + Key: "dGhlIHNhbXBsZSBub25jZQ==" 50 + Accept: "s3pPLMBiTxaQ9kYGzzhZRbK+xOo=" *) 51 + let key = "dGhlIHNhbXBsZSBub25jZQ==" in 52 + let expected = "s3pPLMBiTxaQ9kYGzzhZRbK+xOo=" in 53 + let accept = Websocket.compute_accept ~key in 54 + Alcotest.(check string) "RFC example accept" expected accept 55 + 56 + let test_validate_accept_correct () = 57 + let key = "dGhlIHNhbXBsZSBub25jZQ==" in 58 + let accept = "s3pPLMBiTxaQ9kYGzzhZRbK+xOo=" in 59 + Alcotest.(check bool) "valid accept" true 60 + (Websocket.validate_accept ~key ~accept) 61 + 62 + let test_validate_accept_incorrect () = 63 + let key = "dGhlIHNhbXBsZSBub25jZQ==" in 64 + let accept = "wrongvalue" in 65 + Alcotest.(check bool) "invalid accept" false 66 + (Websocket.validate_accept ~key ~accept) 67 + 68 + let test_compute_validate_roundtrip () = 69 + let key = Websocket.generate_key () in 70 + let accept = Websocket.compute_accept ~key in 71 + Alcotest.(check bool) "roundtrip validation" true 72 + (Websocket.validate_accept ~key ~accept) 73 + 74 + (** {1 Protocol Negotiation Tests} *) 75 + 76 + let test_parse_protocols_basic () = 77 + let protos = Websocket.parse_protocols "graphql-ws, graphql-transport-ws" in 78 + Alcotest.(check int) "count" 2 (List.length protos); 79 + Alcotest.(check bool) "has graphql-ws" true (List.mem "graphql-ws" protos); 80 + Alcotest.(check bool) "has graphql-transport-ws" true 81 + (List.mem "graphql-transport-ws" protos) 82 + 83 + let test_parse_protocols_single () = 84 + let protos = Websocket.parse_protocols "chat" in 85 + Alcotest.(check (list string)) "single" ["chat"] protos 86 + 87 + let test_parse_protocols_empty () = 88 + let protos = Websocket.parse_protocols "" in 89 + Alcotest.(check (list string)) "empty" [] protos 90 + 91 + let test_protocols_to_string () = 92 + let protos = ["graphql-ws"; "graphql-transport-ws"] in 93 + let s = Websocket.protocols_to_string protos in 94 + Alcotest.(check string) "to_string" "graphql-ws, graphql-transport-ws" s 95 + 96 + let test_select_protocol_match () = 97 + let offered = ["chat"; "superchat"] in 98 + let supported = ["superchat"; "chat"] in 99 + let selected = Websocket.select_protocol ~offered ~supported in 100 + (* Should select first from supported that is in offered *) 101 + Alcotest.(check (option string)) "selected" (Some "superchat") selected 102 + 103 + let test_select_protocol_no_match () = 104 + let offered = ["chat"] in 105 + let supported = ["other"] in 106 + let selected = Websocket.select_protocol ~offered ~supported in 107 + Alcotest.(check (option string)) "no match" None selected 108 + 109 + (** {1 Extension Parsing Tests} *) 110 + 111 + let test_parse_extensions_basic () = 112 + let exts = Websocket.parse_extensions "permessage-deflate" in 113 + Alcotest.(check int) "count" 1 (List.length exts); 114 + Alcotest.(check string) "name" "permessage-deflate" (List.hd exts).name; 115 + Alcotest.(check int) "params count" 0 (List.length (List.hd exts).params) 116 + 117 + let test_parse_extensions_with_params () = 118 + let exts = Websocket.parse_extensions 119 + "permessage-deflate; client_max_window_bits; server_no_context_takeover" in 120 + Alcotest.(check int) "count" 1 (List.length exts); 121 + let ext = List.hd exts in 122 + Alcotest.(check string) "name" "permessage-deflate" ext.name; 123 + Alcotest.(check int) "params count" 2 (List.length ext.params) 124 + 125 + let test_parse_extensions_with_values () = 126 + let exts = Websocket.parse_extensions 127 + "permessage-deflate; client_max_window_bits=15" in 128 + let ext = List.hd exts in 129 + Alcotest.(check string) "name" "permessage-deflate" ext.name; 130 + match ext.params with 131 + | [(key, Some value)] -> 132 + Alcotest.(check string) "param key" "client_max_window_bits" key; 133 + Alcotest.(check string) "param value" "15" value 134 + | _ -> 135 + Alcotest.fail "Expected one param with value" 136 + 137 + let test_parse_extensions_multiple () = 138 + let exts = Websocket.parse_extensions "permessage-deflate, x-custom" in 139 + Alcotest.(check int) "count" 2 (List.length exts); 140 + Alcotest.(check bool) "has permessage-deflate" true 141 + (Websocket.has_extension ~name:"permessage-deflate" exts); 142 + Alcotest.(check bool) "has x-custom" true 143 + (Websocket.has_extension ~name:"x-custom" exts) 144 + 145 + let test_extensions_to_string () = 146 + let exts = [ 147 + { Websocket.name = "permessage-deflate"; 148 + params = [("client_max_window_bits", None)] } 149 + ] in 150 + let s = Websocket.extensions_to_string exts in 151 + Alcotest.(check string) "to_string" 152 + "permessage-deflate; client_max_window_bits" s 153 + 154 + let test_get_extension_params () = 155 + let exts = Websocket.parse_extensions 156 + "permessage-deflate; client_max_window_bits=15" in 157 + match Websocket.get_extension_params ~name:"permessage-deflate" exts with 158 + | Some params -> 159 + Alcotest.(check int) "params count" 1 (List.length params) 160 + | None -> 161 + Alcotest.fail "Expected Some params" 162 + 163 + (** {1 Upgrade Headers Tests} *) 164 + 165 + let test_make_upgrade_headers_basic () = 166 + let key = "dGhlIHNhbXBsZSBub25jZQ==" in 167 + let headers = Websocket.make_upgrade_headers ~key () in 168 + Alcotest.(check (option string)) "Upgrade" (Some "websocket") 169 + (Headers.get `Upgrade headers); 170 + Alcotest.(check (option string)) "Connection" (Some "Upgrade") 171 + (Headers.get `Connection headers); 172 + Alcotest.(check (option string)) "Sec-WebSocket-Key" (Some key) 173 + (Headers.get `Sec_websocket_key headers); 174 + Alcotest.(check (option string)) "Sec-WebSocket-Version" (Some "13") 175 + (Headers.get `Sec_websocket_version headers) 176 + 177 + let test_make_upgrade_headers_with_protocols () = 178 + let key = Websocket.generate_key () in 179 + let headers = Websocket.make_upgrade_headers ~key 180 + ~protocols:["graphql-ws"; "graphql-transport-ws"] () in 181 + match Headers.get `Sec_websocket_protocol headers with 182 + | Some proto -> 183 + Alcotest.(check bool) "contains graphql-ws" true 184 + (string_contains ~affix:"graphql-ws" proto) 185 + | None -> 186 + Alcotest.fail "Expected Sec-WebSocket-Protocol header" 187 + 188 + let test_make_upgrade_headers_with_origin () = 189 + let key = Websocket.generate_key () in 190 + let headers = Websocket.make_upgrade_headers ~key 191 + ~origin:"https://example.com" () in 192 + Alcotest.(check (option string)) "Origin" (Some "https://example.com") 193 + (Headers.get `Origin headers) 194 + 195 + (** {1 Upgrade Response Validation Tests} *) 196 + 197 + let test_validate_response_success () = 198 + let key = "dGhlIHNhbXBsZSBub25jZQ==" in 199 + let accept = "s3pPLMBiTxaQ9kYGzzhZRbK+xOo=" in 200 + let headers = Headers.empty 201 + |> Headers.set `Upgrade "websocket" 202 + |> Headers.set `Connection "Upgrade" 203 + |> Headers.set `Sec_websocket_accept accept in 204 + let result = Websocket.validate_upgrade_response ~key ~status:101 ~headers in 205 + match result with 206 + | Ok () -> Alcotest.(check pass) "valid response" () () 207 + | Error msg -> Alcotest.fail msg 208 + 209 + let test_validate_response_wrong_status () = 210 + let key = Websocket.generate_key () in 211 + let headers = Headers.empty in 212 + let result = Websocket.validate_upgrade_response ~key ~status:200 ~headers in 213 + match result with 214 + | Error msg -> 215 + Alcotest.(check bool) "mentions 101" true 216 + (string_contains ~affix:"101" msg) 217 + | Ok () -> 218 + Alcotest.fail "Expected error for wrong status" 219 + 220 + let test_validate_response_missing_upgrade () = 221 + let key = Websocket.generate_key () in 222 + let headers = Headers.empty 223 + |> Headers.set `Connection "Upgrade" in 224 + let result = Websocket.validate_upgrade_response ~key ~status:101 ~headers in 225 + match result with 226 + | Error msg -> 227 + Alcotest.(check bool) "mentions Upgrade" true 228 + (string_contains ~affix:"Upgrade" msg) 229 + | Ok () -> 230 + Alcotest.fail "Expected error for missing Upgrade" 231 + 232 + let test_validate_response_wrong_accept () = 233 + let key = "dGhlIHNhbXBsZSBub25jZQ==" in 234 + let headers = Headers.empty 235 + |> Headers.set `Upgrade "websocket" 236 + |> Headers.set `Connection "Upgrade" 237 + |> Headers.set `Sec_websocket_accept "wrongvalue" in 238 + let result = Websocket.validate_upgrade_response ~key ~status:101 ~headers in 239 + match result with 240 + | Error msg -> 241 + Alcotest.(check bool) "mentions accept" true 242 + (string_contains ~affix:"Accept" msg || 243 + string_contains ~affix:"accept" msg) 244 + | Ok () -> 245 + Alcotest.fail "Expected error for wrong accept" 246 + 247 + (** {1 Test Suite} *) 248 + 249 + let () = 250 + (* Initialize RNG for key generation *) 251 + Mirage_crypto_rng_unix.use_default (); 252 + Alcotest.run "WebSocket (RFC 6455)" [ 253 + ("Key Generation", [ 254 + Alcotest.test_case "Key length" `Quick test_generate_key_length; 255 + Alcotest.test_case "Keys unique" `Quick test_generate_key_unique; 256 + Alcotest.test_case "Valid base64" `Quick test_generate_key_valid_base64; 257 + ]); 258 + ("Accept Computation", [ 259 + Alcotest.test_case "RFC example" `Quick test_compute_accept_rfc_example; 260 + Alcotest.test_case "Validate correct" `Quick test_validate_accept_correct; 261 + Alcotest.test_case "Validate incorrect" `Quick test_validate_accept_incorrect; 262 + Alcotest.test_case "Roundtrip" `Quick test_compute_validate_roundtrip; 263 + ]); 264 + ("Protocol Negotiation", [ 265 + Alcotest.test_case "Parse basic" `Quick test_parse_protocols_basic; 266 + Alcotest.test_case "Parse single" `Quick test_parse_protocols_single; 267 + Alcotest.test_case "Parse empty" `Quick test_parse_protocols_empty; 268 + Alcotest.test_case "To string" `Quick test_protocols_to_string; 269 + Alcotest.test_case "Select match" `Quick test_select_protocol_match; 270 + Alcotest.test_case "Select no match" `Quick test_select_protocol_no_match; 271 + ]); 272 + ("Extension Parsing", [ 273 + Alcotest.test_case "Basic" `Quick test_parse_extensions_basic; 274 + Alcotest.test_case "With params" `Quick test_parse_extensions_with_params; 275 + Alcotest.test_case "With values" `Quick test_parse_extensions_with_values; 276 + Alcotest.test_case "Multiple" `Quick test_parse_extensions_multiple; 277 + Alcotest.test_case "To string" `Quick test_extensions_to_string; 278 + Alcotest.test_case "Get params" `Quick test_get_extension_params; 279 + ]); 280 + ("Upgrade Headers", [ 281 + Alcotest.test_case "Basic headers" `Quick test_make_upgrade_headers_basic; 282 + Alcotest.test_case "With protocols" `Quick test_make_upgrade_headers_with_protocols; 283 + Alcotest.test_case "With origin" `Quick test_make_upgrade_headers_with_origin; 284 + ]); 285 + ("Response Validation", [ 286 + Alcotest.test_case "Success" `Quick test_validate_response_success; 287 + Alcotest.test_case "Wrong status" `Quick test_validate_response_wrong_status; 288 + Alcotest.test_case "Missing Upgrade" `Quick test_validate_response_missing_upgrade; 289 + Alcotest.test_case "Wrong accept" `Quick test_validate_response_wrong_accept; 290 + ]); 291 + ]