url: add current-url/literal-query-param-encoder

*sigh*

Author: Bogdanp

http-easy-lib/http-easy.rkt

@@ -36,6 +36,7 @@
  (all-from-out "http-easy/private/session.rkt")
  (all-from-out "http-easy/private/user-agent.rkt")
 
+ current-url/literal-query-param-encoder
  (struct-out url/literal)
  string->url/literal
  url/literal->string

http-easy-lib/http-easy/private/session.rkt

@@ -344,7 +344,9 @@
       (let loop ()
         (with-handlers ([exn:fail?
                          (lambda (e)
-                           (log-http-easy-warning "will execution failed: ~a" (exn-message e)))])
+                           (log-http-easy-warning
+                            "will execution failed: ~a"
+                            (exn-message e)))])
           (will-execute executor))
         (loop))))))
 

http-easy-lib/http-easy/private/url.rkt

@@ -9,6 +9,7 @@
 
 (provide
  (struct-out url/literal)
+ current-url/literal-query-param-encoder
  string->url/literal
  url/literal->string
  is-percent-encoded?
@@ -28,6 +29,10 @@
 ;; xref https://github.com/rmculpepper/racket-http123/issues/6
 (serializable-struct url/literal url ())
 
+;; An escape hatch for services that are super non-compliant.
+(define current-url/literal-query-param-encoder
+  (make-parameter form-urlencoded-encode))
+
 (define (string->url/literal s)
   (match-define (list _ scheme user ipv6host host port path query fragment)
     (regexp-match url-regexp s))
@@ -64,6 +69,8 @@
     (url/literal scheme user host port abs? path query fragment)))
 
 (define (url/literal->string u)
+  (define query-param-encoder
+    (current-url/literal-query-param-encoder))
   (define out (open-output-string))
   (match-define (url scheme user host port abs? path query fragment) u)
   (when scheme
@@ -115,10 +122,10 @@
       (unless (zero? idx)
         (write-char #\& out))
       (match-define (cons (app symbol->string name) value) pair)
-      (write-string (maybe-percent-encode name form-urlencoded-encode) out)
+      (write-string (maybe-percent-encode name query-param-encoder) out)
       (when value
         (write-char #\= out)
-        (write-string (maybe-percent-encode value form-urlencoded-encode) out))))
+        (write-string (maybe-percent-encode value query-param-encoder) out))))
   (when fragment
     (write-char #\# out)
     (write-string (maybe-percent-encode fragment) out))

http-easy-lib/info.rkt

@@ -1,7 +1,7 @@
 #lang info
 
 (define license 'BSD-3-Clause)
-(define version "0.9.2")
+(define version "0.10")
 (define collection "net")
 (define deps
   '(["base" #:version "8.1.0.4"]

http-easy-test/net/http-easy/private/url.rkt

@@ -101,7 +101,20 @@
 
     (test-case "examples"
       (let ([example "https://d12xz7rzfw7xh7.cloudfront.net/v1/download/episodes/original/43796816?a=en&eg=https%3A%2F%2Fapi.spreaker.com%2Fepisode%2F57758598&eu=https%3A%2F%2Fdts.podtrac.com%2Fredirect.mp3%2Fapi.spreaker.com%2Fdownload%2Fepisode%2F57758598%2Ftmp9u92imeh.mp3&p=3&q=9808638&f=559&r=128&t=3&u=11393707&o=2401044&d=2023-11-22&g=57758598&h=5937276&k=https%3A%2F%2Fwww.spreaker.com%2Fshow%2F5937276%2Fepisodes%2Ffeed&i=43796816&n=Petros+And+Money&b=%5B%22IAB6-7%22%2C%22IAB7-39%22%2C%22IAB11-4%22%2C%22IAB26%22%5D&c=%5B%22sports%22%5D&l=%5B%22hosting_plan_ihr%22%5D&m=%5B904294%2C904294%2C904294%2C1436858%2C1436858%2C1436858%2C1436858%2C1436858%2C1937091%2C1937091%2C1937091%5D&rr=4444444444444&fax=0.4&Expires=1732993926&Signature=XDgffPCg91Gd6ThNXoenP4axeBN2zEUK6Bs56F2Pw-LGE9XJuLPghg1f2etV1l6I3%7Ed7Ms12AQbkCp1vfkqleStA30fPDH2PpO1IKkw5k7PlSYyPCeb1DOc1No8s6KHn7C8DZ7swXjWEz5WGzrj6KtSgI%7EWMhQyiLuGxEmT9YBQViowMGeO7p1PNocQmT-SKo8WqMDMdzMmSXP2WQFYSk3AjFM2ukhGLzDkIcrNxy2ZRLGeUykF9ZWgNnGGAOfwsmx6n0IFQZcdDo2QpRKxOUjSBYOTxTo1Y716OYb73P59QurF%7El-jM7WLHgvFxWnJQHj9SwCnjSaCJgzDBlh%7EEDQ__&Key-Pair-Id=K1J2BR3INU6RYD"])
-        (check-equal? (url/literal->string (string->url/literal example)) example))))
+        (check-equal? (url/literal->string (string->url/literal example)) example)))
+
+    (test-case "current-url/literal-query-param-encoder"
+      (check-equal?
+       (url/literal->string
+        (string->url/literal
+         "https://example.com?search=(status:(values:List(DRAFT)))"))
+       "https://example.com?search=%28status%3A%28values%3AList%28DRAFT%29%29%29")
+      (parameterize ([current-url/literal-query-param-encoder values])
+        (check-equal?
+         (url/literal->string
+          (string->url/literal
+           "https://example.com?search=(status:(values:List(DRAFT)))"))
+         "https://example.com?search=(status:(values:List(DRAFT)))"))))
 
    (test-suite
     "is-percent-encoded?"

http-easy/http-easy.scrbl

@@ -7,6 +7,7 @@
                      net/cookies/user-agent
                      net/http-client
                      net/http-easy
+                     net/uri-codec
                      net/url
                      openssl
                      racket/base
@@ -460,6 +461,19 @@ scheme and url-encode the path to the socket as the host.
   @history[#:added "0.7"]
 }
 
+@defparam[
+  current-url/literal-query-param-encoder
+  encoder (-> string? string?)
+  #:value form-urlencoded-encode
+]{
+  Some services are both non-compliant and particularly picky about
+  how their query string parameters are encoded. Use this parameter to
+  precisely control how a @tech{literal URL}'s query params are encoded
+  in such cases.
+
+  @history[#:added "0.10"]
+}
+
 
 @subsection{Responses}