Use anonymous-http-request from (webid-oidc parameters) everywhere

1 files changed, 138 insertions, 151 deletions

diff --git a/src/scm/webid-oidc/example-app.scm b/src/scm/webid-oidc/example-app.scm
index 67d959f..fb12431 100644
--- a/src/scm/webid-oidc/example-app.scm
+++ b/src/scm/webid-oidc/example-app.scm
@@ -23,7 +23,6 @@
   #:use-module ((webid-oidc refresh-token) #:prefix refresh:)
   #:use-module ((webid-oidc config) #:prefix cfg:)
   #:use-module (web uri)
-  #:use-module (web client)
   #:use-module (web request)
   #:use-module (web response)
   #:use-module (web server)
@@ -301,23 +300,11 @@
                   (uri->string uri))
           (format (current-error-port) (G_ "Then, paste the authorization code you get:\n"))
           (read-line (current-input-port) 'trim)))
-       (client:authorization-state #f)
-       (client:anonymous-http-request
-        (let ((default-http-get-with-cache (cache:with-cache)))
-          (lambda* (uri . all-args)
-            (let try-get-with-cache ((args all-args)
-                                     (args-for-get '()))
-              (match args
-                (()
-                 (apply default-http-get-with-cache uri (reverse args-for-get)))
-                ((#:headers arg other-args ...)
-                 (try-get-with-cache other-args `(,arg #:headers ,@args-for-get)))
-                ((#:method 'GET other-args ...)
-                 (try-get-with-cache other-args args-for-get))
-                (else
-                 (apply http-request uri all-args))))))))
-    (let menu ((state (make <undoable-app-state>)))
-      (format #t (G_ "Account: ~a
+       (client:authorization-state #f))
+    (cache:use-cache
+     (lambda ()
+       (let menu ((state (make <undoable-app-state>)))
+         (format #t (G_ "Account: ~a
 URI: ~a
 Method: ~a
 Headers: ~a
@@ -333,138 +320,138 @@ Available commands:
   - ~a: perform the request.
 
 ")
-              (let ((acct (app-state-account (current-state state))))
-                (if acct
-                    (account-summary acct)
-                    (G_ "Account:|unset")))
-              (let ((uri (app-state-uri (current-state state))))
-                (if uri
-                    (uri->string uri)
-                    (G_ "URI:|unset")))
-              (let ((method (app-state-method (current-state state))))
-                (if method
-                    (symbol->string method)
-                    (G_ "Method:|unset")))
-              (let ((headers (app-state-headers (current-state state))))
-                (if (null? headers)
-                    (G_ "Headers:|none")
-                    (string-join
-                     (map (match-lambda ((header . _) (symbol->string header)))
-                          headers)
-                     (G_ "list separator|, "))))
-              add-account-command
-              choose-account-command
-              set-uri-command
-              set-method-command
-              view-headers-command
-              clear-headers-command
-              add-header-command
-              ok-command)
-      (when (can-undo? state)
-        (format #t (G_ "You can undo your last command with \"~a\".\n") undo-command))
-      (when (can-redo? state)
-        (format #t (G_ "You can re-apply your last undone command with \"~a\".\n") redo-command))
-      (let ((command (readline (G_ "Readline prompt|Command: "))))
-        (if (eof-object? command)
-            (exit 0)
-            (with-exception-handler
-                (lambda (exn)
-                  (if (exception-with-message? exn)
-                      (begin
-                        (format #t (G_ "An error happened: ~a.\n")
-                                (exception-message exn))
-                        (menu state))
-                      (raise-exception exn)))
-              (lambda ()
-                (cond
-                 ((equal? command add-account-command)
-                  (let ((identity-provider
-                         (with-sigint-handler
-                          (lambda ()
-                            (menu state))
-                          (lambda ()
-                            (readline (G_ "Please enter your identity provider: "))))))
-                    (menu (add-account state (make <account:account> #:issuer identity-provider)))))
-                 ((equal? command choose-account-command)
-                  (let ((accounts (enumerate-accounts state)))
-                    (if (null? accounts)
-                        (begin
-                          (format #t (G_ "You don’t have other accounts available. Please add one with \"add-account\".\n"))
-                          (menu state))
-                        (begin
-                          (let enumerate-accounts ((accounts accounts))
-                            (match accounts
-                              (((i . account) rest ...)
-                               (format #t (G_ "- ~a: ~a\n") i (account-summary account))
-                               (enumerate-accounts rest))
-                              (() #t)))
-                          (with-sigint-handler
-                           (lambda ()
+                 (let ((acct (app-state-account (current-state state))))
+                   (if acct
+                       (account-summary acct)
+                       (G_ "Account:|unset")))
+                 (let ((uri (app-state-uri (current-state state))))
+                   (if uri
+                       (uri->string uri)
+                       (G_ "URI:|unset")))
+                 (let ((method (app-state-method (current-state state))))
+                   (if method
+                       (symbol->string method)
+                       (G_ "Method:|unset")))
+                 (let ((headers (app-state-headers (current-state state))))
+                   (if (null? headers)
+                       (G_ "Headers:|none")
+                       (string-join
+                        (map (match-lambda ((header . _) (symbol->string header)))
+                             headers)
+                        (G_ "list separator|, "))))
+                 add-account-command
+                 choose-account-command
+                 set-uri-command
+                 set-method-command
+                 view-headers-command
+                 clear-headers-command
+                 add-header-command
+                 ok-command)
+         (when (can-undo? state)
+           (format #t (G_ "You can undo your last command with \"~a\".\n") undo-command))
+         (when (can-redo? state)
+           (format #t (G_ "You can re-apply your last undone command with \"~a\".\n") redo-command))
+         (let ((command (readline (G_ "Readline prompt|Command: "))))
+           (if (eof-object? command)
+               (exit 0)
+               (with-exception-handler
+                   (lambda (exn)
+                     (if (exception-with-message? exn)
+                         (begin
+                           (format #t (G_ "An error happened: ~a.\n")
+                                   (exception-message exn))
+                           (menu state))
+                         (raise-exception exn)))
+                 (lambda ()
+                   (cond
+                    ((equal? command add-account-command)
+                     (let ((identity-provider
+                            (with-sigint-handler
+                             (lambda ()
+                               (menu state))
+                             (lambda ()
+                               (readline (G_ "Please enter your identity provider: "))))))
+                       (menu (add-account state (make <account:account> #:issuer identity-provider)))))
+                    ((equal? command choose-account-command)
+                     (let ((accounts (enumerate-accounts state)))
+                       (if (null? accounts)
+                           (begin
+                             (format #t (G_ "You don’t have other accounts available. Please add one with \"add-account\".\n"))
                              (menu state))
-                           (lambda ()
-                             (let ((choice (string->number
-                                            (readline (format #f (G_ "[1-~a] ")
-                                                              (length accounts))))))
-                               (menu (choose-account state choice)))))))))
-                 ((equal? command set-uri-command)
-                  (with-sigint-handler
-                   (lambda ()
-                     (menu state))
-                   (lambda ()
-                     (menu (set-uri state (readline (G_ "Visit this URI: ")))))))
-                 ((equal? command set-method-command)
-                  (with-sigint-handler
-                   (lambda ()
-                     (menu state))
-                   (lambda ()
-                     (let ((method (readline (G_ "Use this HTTP method [GET]: "))))
-                       (when (equal? method "")
-                         (set! method "GET"))
-                       (menu (set-method state method))))))
-                 ((equal? command view-headers-command)
-                  (write-headers (app-state-headers (current-state state))
-                                 (current-output-port))
-                  (newline)
-                  (menu state))
-                 ((equal? command clear-headers-command)
-                  (menu (clear-headers state)))
-                 ((equal? command add-header-command)
-                  (with-sigint-handler
-                   (lambda ()
+                           (begin
+                             (let enumerate-accounts ((accounts accounts))
+                               (match accounts
+                                 (((i . account) rest ...)
+                                  (format #t (G_ "- ~a: ~a\n") i (account-summary account))
+                                  (enumerate-accounts rest))
+                                 (() #t)))
+                             (with-sigint-handler
+                              (lambda ()
+                                (menu state))
+                              (lambda ()
+                                (let ((choice (string->number
+                                               (readline (format #f (G_ "[1-~a] ")
+                                                                 (length accounts))))))
+                                  (menu (choose-account state choice)))))))))
+                    ((equal? command set-uri-command)
+                     (with-sigint-handler
+                      (lambda ()
+                        (menu state))
+                      (lambda ()
+                        (menu (set-uri state (readline (G_ "Visit this URI: ")))))))
+                    ((equal? command set-method-command)
+                     (with-sigint-handler
+                      (lambda ()
+                        (menu state))
+                      (lambda ()
+                        (let ((method (readline (G_ "Use this HTTP method [GET]: "))))
+                          (when (equal? method "")
+                            (set! method "GET"))
+                          (menu (set-method state method))))))
+                    ((equal? command view-headers-command)
+                     (write-headers (app-state-headers (current-state state))
+                                    (current-output-port))
+                     (newline)
                      (menu state))
-                   (lambda ()
-                     (let ((header (string-downcase (readline (G_ "Which header? ")))))
-                       (let ((value
-                              (readline
-                               (format #f (G_ "Which header value for ~a? ")
-                                       header))))
-                         (menu (add-header state header value)))))))
-                 ((equal? command ok-command)
-                  (receive (account uri)
-                      (let ((state (current-state state)))
-                        (values
-                         (app-state-account state)
-                         (app-state-uri state)))
-                    (if (and account uri)
-                        (receive (account response body)
-                            (client:request (app-state-account (current-state state))
-                                            (app-state-uri (current-state state))
-                                            #:method (app-state-method (current-state state))
-                                            #:headers (app-state-headers (current-state state)))
-                          (let ((ready-to-write-body
-                                 (write-response response (current-output-port))))
-                            (unless (response-must-not-include-body? ready-to-write-body)
-                              (write-response-body ready-to-write-body
-                                                   (if (string? body)
-                                                       (string->utf8 body)
-                                                       body)))
-                            (newline)))
-                        (format #t (G_ "Please define an account and the URI.\n")))
-                    (menu state)))
-                 ((equal? command undo-command)
-                  (menu (undo state)))
-                 ((equal? command redo-command)
-                  (menu (redo state)))
-                 (else
-                  (format #t (G_ "I don’t know that command.\n"))
-                  (menu state))))))))))
+                    ((equal? command clear-headers-command)
+                     (menu (clear-headers state)))
+                    ((equal? command add-header-command)
+                     (with-sigint-handler
+                      (lambda ()
+                        (menu state))
+                      (lambda ()
+                        (let ((header (string-downcase (readline (G_ "Which header? ")))))
+                          (let ((value
+                                 (readline
+                                  (format #f (G_ "Which header value for ~a? ")
+                                          header))))
+                            (menu (add-header state header value)))))))
+                    ((equal? command ok-command)
+                     (receive (account uri)
+                         (let ((state (current-state state)))
+                           (values
+                            (app-state-account state)
+                            (app-state-uri state)))
+                       (if (and account uri)
+                           (receive (account response body)
+                               (client:request (app-state-account (current-state state))
+                                               (app-state-uri (current-state state))
+                                               #:method (app-state-method (current-state state))
+                                               #:headers (app-state-headers (current-state state)))
+                             (let ((ready-to-write-body
+                                    (write-response response (current-output-port))))
+                               (unless (response-must-not-include-body? ready-to-write-body)
+                                 (write-response-body ready-to-write-body
+                                                      (if (string? body)
+                                                          (string->utf8 body)
+                                                          body)))
+                               (newline)))
+                           (format #t (G_ "Please define an account and the URI.\n")))
+                       (menu state)))
+                    ((equal? command undo-command)
+                     (menu (undo state)))
+                    ((equal? command redo-command)
+                     (menu (redo state)))
+                    (else
+                     (format #t (G_ "I don’t know that command.\n"))
+                     (menu state))))))))))))