Don’t save an account if it does not have a subject

I added a function to log in for the first time, so that we don’t have
to store an account for which we know we will need to jump through the
authorization endpoint hoops.

1 files changed, 32 insertions, 5 deletions

diff --git a/src/scm/webid-oidc/client.scm b/src/scm/webid-oidc/client.scm
index f469d19..1aad35d 100644
--- a/src/scm/webid-oidc/client.scm
+++ b/src/scm/webid-oidc/client.scm
@@ -51,6 +51,7 @@
    client-key
    client-redirect-uri
 
+   initial-login
    request
 
    serve-application
@@ -67,10 +68,7 @@
   (key client-key)
   (redirect-uri client-redirect-uri))
 
-;; subject is optional, if you don’t know who the user is.
-(define* (request client subject issuer
-                  #:key
-                  (http-request http-request))
+(define (setup-headers!)
   ;; HACK: guile does not support other authentication schemes in
   ;; WWW-Authenticate than Basic, so it will crash when a response
   ;; containing that header will be issued.
@@ -104,7 +102,36 @@
        ((('dpop . dpop) port)
         (format port "DPoP ~a" dpop))
        ((value port)
-        (original-writer value port)))))
+        (original-writer value port))))))
+
+(define* (initial-login client issuer
+                        #:key
+                        (http-request http-request))
+  (setup-headers!)
+  (match client
+    (($ <client> client-id client-key redirect-uri)
+     (let ((my-http-get
+            (lambda* (uri . args)
+              (apply http-request uri
+                     #:method 'GET
+                     args)))
+           (my-http-post
+            (lambda* (uri . args)
+              (apply http-request uri
+                     #:method 'POST
+                     args))))
+       (client:save-account
+        (client:login #f issuer
+                      #:http-get my-http-get
+                      #:http-post my-http-post
+                      #:client-id client-id
+                      #:client-key client-key
+                      #:redirect-uri redirect-uri))))))
+
+(define* (request client subject issuer
+                  #:key
+                  (http-request http-request))
+  (setup-headers!)
   (match client
     (($ <client> client-id client-key redirect-uri)
      (let ((do-login