From 6a83b79c4de5986ad61a552c2612b7cce0105cda Mon Sep 17 00:00:00 2001
From: Vivien Kraus <vivien@planete-kraus.eu>
Date: Thu, 9 Sep 2021 23:25:58 +0200
Subject: Client: use http-request instead of http-get and http-post

---
 src/scm/webid-oidc/client/accounts.scm | 51 +++++++++++++++++++---------------
 1 file changed, 29 insertions(+), 22 deletions(-)

(limited to 'src/scm/webid-oidc/client/accounts.scm')

diff --git a/src/scm/webid-oidc/client/accounts.scm b/src/scm/webid-oidc/client/accounts.scm
index d7219e3..cd69c59 100644
--- a/src/scm/webid-oidc/client/accounts.scm
+++ b/src/scm/webid-oidc/client/accounts.scm
@@ -310,12 +310,15 @@
     (($ <account> subject issuer id-token access-token _ keypair)
      (make-account subject issuer id-token access-token #f keypair))))
 
+(define (http-request->http-get http-request)
+  (lambda* (uri . all-args)
+    (apply http-request uri #:method 'GET all-args)))
+
 ;; subject is optional. If the user is unknown, ask for an issuer and
 ;; pass #f as subject.
 (define* (login subject issuer
                 #:key
-                (http-get http-get)
-                (http-post http-post)
+                (http-request http-request)
                 (state #f)
                 client-id
                 client-key
@@ -337,7 +340,7 @@
                      (uri-host issuer)
                      #:userinfo (uri-userinfo issuer)
                      #:port (uri-port issuer)
-                     #:http-get http-get)))
+                     #:http-get (http-request->http-get http-request))))
                (values 
                 (cfg:oidc-configuration-authorization-endpoint configuration)
                 (cfg:oidc-configuration-token-endpoint configuration)))
@@ -379,23 +382,24 @@
                    #:htu token-endpoint)))
              ;; Post the token request with the correct grant:
              (receive (response response-body)
-                 (http-post token-endpoint
-                            #:body
-                            (string-join
-                             (map
-                              (match-lambda
-                                ((key . value)
-                                 (string-append (uri-encode key)
-                                                "="
-                                                (uri-encode value))))
-                              `(("grant_type" . ,grant-type)
-                                (,(if available-refresh-token
-                                      "refresh_token"
-                                      "code") . ,grant)))
-                             "&")
-                            #:headers
-                            `((content-type application/x-www-form-urlencoded)
-                              (dpop . ,dpop-proof)))
+                 (http-request token-endpoint
+                               #:method 'POST
+                               #:body
+                               (string-join
+                                (map
+                                 (match-lambda
+                                   ((key . value)
+                                    (string-append (uri-encode key)
+                                                   "="
+                                                   (uri-encode value))))
+                                 `(("grant_type" . ,grant-type)
+                                   (,(if available-refresh-token
+                                         "refresh_token"
+                                         "code") . ,grant)))
+                                "&")
+                               #:headers
+                               `((content-type application/x-www-form-urlencoded)
+                                 (dpop . ,dpop-proof)))
                ;; Check that the token endpoint responded correctly.
                (when (eqv? (response-code response) 403)
                  (when subject
@@ -440,7 +444,7 @@
                             'application/json)
                  (let ((final-message
                         (format #f (G_ "The token response has content-type ~s, not application/json.")
-                            (response-content-type response))))
+                                (response-content-type response))))
                    (raise-exception
                     (make-exception
                      (make-token-request-failed response response-body)
@@ -490,7 +494,10 @@
                              (make-exception-with-message final-message)
                              decoding-error))))
                      (lambda ()
-                       (set! id-token (id:id-token-decode id-token #:http-get http-get))))
+                       (set! id-token
+                             (id:id-token-decode id-token
+                                                 #:http-get
+                                                 (http-request->http-get http-request)))))
                    ;; We are not interested in the ID token
                    ;; signature anymore, because it won’t be
                    ;; transmitted to other parties and we know that
-- 
cgit v1.2.3