diff options
Diffstat (limited to 'src/scm/webid-oidc/example-app.scm')
| -rw-r--r-- | src/scm/webid-oidc/example-app.scm | 111 |
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) |