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, 55 insertions, 56 deletions

diff --git a/src/scm/webid-oidc/example-app.scm b/src/scm/webid-oidc/example-app.scm
index c0162de..16e19ae 100644
--- a/src/scm/webid-oidc/example-app.scm
+++ b/src/scm/webid-oidc/example-app.scm
@@ -43,16 +43,17 @@
   #:use-module (rnrs bytevectors)
   #:declarative? #t)
 
+(define example-app
+  (client:make-client
+   (string->uri
+    "https://webid-oidc-demo.planete-kraus.eu/example-application#id")
+   (jwk:generate-key #:n-size 2048)
+   (string->uri
+    "https://webid-oidc-demo.planete-kraus.eu/authorized")))
+
 (define (main)
   (define (do-the-trick subject issuer)
-    (client:request
-     (client:make-client
-      (string->uri
-       "https://webid-oidc-demo.planete-kraus.eu/example-application#id")
-      (jwk:generate-key #:n-size 2048)
-      (string->uri
-       "https://webid-oidc-demo.planete-kraus.eu/authorized"))
-     subject issuer))
+    (client:request example-app subject issuer))
   (let ((accounts (list->vector (client:read-accounts))))
     (format #t (G_ "Main menu:\n"))
     (let enumerate-accounts ((i 0))
@@ -64,34 +65,32 @@
                       (and subject (uri->string subject)))
                     (format #f (G_ "a new user")))
                 (uri->string (client:account-issuer (vector-ref accounts i)))
-                (if (client:account-subject (vector-ref accounts i))
-                    (if (client:account-id-token (vector-ref accounts i))
-                        (format #f (G_ "status|currently logged in"))
-                        (if (client:account-refresh-token (vector-ref accounts i))
-                            (format #f (G_ "status|offline (but accessible)"))
-                            (format #f (G_ "status|offline (inaccessible)"))))
-                    (format #f (G_ "status|not initialized yet"))))
+                (if (client:account-id-token (vector-ref accounts i))
+                    (format #f (G_ "status|currently logged in"))
+                    (if (client:account-refresh-token (vector-ref accounts i))
+                        (format #f (G_ "status|offline (but accessible)"))
+                        (format #f (G_ "status|offline (inaccessible)")))))
         (enumerate-accounts (1+ i))))
     (format #t (G_ "Type a number to log in, prefix it with '-' to delete the account, or type + to create a new account.
 "))
-    (match (read-line (current-input-port) 'trim)
-      ((? string?
-          (= string->number
-             (and (? integer? _)
-                  (? (cute >= <> 1) _)
-                  (? (cute <= <> (vector-length accounts)))
-                  (= (cute - <> 1) choice))))
-       (let ((account (vector-ref accounts choice)))
-         (parameterize
-             ((client:authorization-process
-               ;; There’s a problem with guile continuable
-               ;; exceptions: we can’t handle errors in a handler for
-               ;; continuable exceptions. Until this is clarified, we
-               ;; avoid continuable exceptions.
-               (lambda* (uri #:key issuer)
-                 (format (current-error-port) (G_ "Please visit: ~a\n") (uri->string uri))
-                 (format (current-error-port) (G_ "Then, paste the authorization code you get:\n"))
-                 (read-line (current-input-port) 'trim))))
+    (parameterize
+        ((client:authorization-process
+          ;; There’s a problem with guile continuable
+          ;; exceptions: we can’t handle errors in a handler for
+          ;; continuable exceptions. Until this is clarified, we
+          ;; avoid continuable exceptions.
+          (lambda* (uri #:key issuer)
+            (format (current-error-port) (G_ "Please visit: ~a\n") (uri->string uri))
+            (format (current-error-port) (G_ "Then, paste the authorization code you get:\n"))
+            (read-line (current-input-port) 'trim))))
+      (match (read-line (current-input-port) 'trim)
+        ((? string?
+            (= string->number
+               (and (? integer? _)
+                    (? (cute >= <> 1) _)
+                    (? (cute <= <> (vector-length accounts)))
+                    (= (cute - <> 1) choice))))
+         (let ((account (vector-ref accounts choice)))
            (with-exception-handler
                (lambda (error)
                  (cond
@@ -117,28 +116,28 @@
                          (set! response-body (string->utf8 response-body)))
                        (write-response-body ad-hoc-port response-body)))))
                (format #t "\n")
-               (main))))))
-      ((? string?
-          (= string->number
-             (and (? integer? _)
-                  (= (cute - <>)
-                     (and (? (cute >= <> 1) _)
-                          (? (cute <= <> (vector-length accounts)) _)
-                          (= (cute - <> 1) choice))))))
-       ;; Delete
-       (client:delete-account (vector-ref accounts choice))
-       (main))
-      ("+"
-       ;; Create an account
-       (format #t (G_ "Please type your identity provider:\n"))
-       (let ((issuer (read-line (current-input-port) 'trim)))
-         (when (and (string? issuer) (string->uri issuer))
-           (client:save-account
-            (client:make-account #f (string->uri issuer) #f #f #f #f))))
-       (main))
-      ((? eof-object? _)
-       (exit 0))
-      (else
-       (main)))))
+               (main)))))
+        ((? string?
+            (= string->number
+               (and (? integer? _)
+                    (= (cute - <>)
+                       (and (? (cute >= <> 1) _)
+                            (? (cute <= <> (vector-length accounts)) _)
+                            (= (cute - <> 1) choice))))))
+         ;; Delete
+         (client:delete-account (vector-ref accounts choice))
+         (main))
+        ("+"
+         ;; Create an account
+         (format #t (G_ "Please type your identity provider:\n"))
+         (let ((issuer (read-line (current-input-port) 'trim)))
+           (when (and (string? issuer) (string->uri issuer))
+             (client:save-account
+              (client:initial-login example-app (string->uri issuer)))))
+         (main))
+        ((? eof-object? _)
+         (exit 0))
+        (else
+         (main))))))
 
 (main)