From 668aa5736b2709e15e3ea14381e010c8646a4c38 Mon Sep 17 00:00:00 2001 From: Vivien Kraus Date: Tue, 28 Sep 2021 21:56:46 +0200 Subject: gui: Add a client widget --- src/scm/webid-oidc/client/gui/client-widget.scm | 147 ++++++++++++++++++++++++ 1 file changed, 147 insertions(+) create mode 100644 src/scm/webid-oidc/client/gui/client-widget.scm (limited to 'src/scm/webid-oidc/client/gui/client-widget.scm') diff --git a/src/scm/webid-oidc/client/gui/client-widget.scm b/src/scm/webid-oidc/client/gui/client-widget.scm new file mode 100644 index 0000000..792b8f8 --- /dev/null +++ b/src/scm/webid-oidc/client/gui/client-widget.scm @@ -0,0 +1,147 @@ +;; disfluid, implementation of the Solid specification +;; Copyright (C) 2021 Vivien Kraus + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU Affero General Public License as +;; published by the Free Software Foundation, either version 3 of the +;; License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU Affero General Public License for more details. + +;; You should have received a copy of the GNU Affero General Public License +;; along with this program. If not, see . + +(define-module (webid-oidc client gui client-widget) + #:use-module (gi) + #:use-module (gi types) + #:use-module (gi util) + #:use-module (gi repository) + #:use-module (ice-9 match) + #:use-module (ice-9 exceptions) + #:use-module (ice-9 i18n) + #:use-module (ice-9 receive) + #:use-module (ice-9 optargs) + #:use-module (ice-9 pretty-print) + #:use-module (ice-9 control) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-19) + #:use-module (webid-oidc errors) + #:use-module (webid-oidc web-i18n) + #:use-module ((webid-oidc parameters) #:prefix p:) + #:use-module ((webid-oidc stubs) #:prefix stubs:) + #:use-module ((webid-oidc oidc-id-token) #:prefix id:) + #:use-module ((webid-oidc jwk) #:prefix jwk:) + #:use-module ((webid-oidc config) #:prefix config:) + #:use-module (webid-oidc client) + #:use-module (webid-oidc client accounts) + #:use-module ((webid-oidc client gui settings) #:prefix settings:) + #:use-module (webid-oidc client gui application-hooks) + #:use-module (web uri) + #:use-module (web response) + #:use-module (rnrs bytevectors) + #:use-module (oop goops) + #:duplicates (merge-generics) + #:export + ( + client-widget + )) + +(push-duplicate-handler! 'merge-generics) + +;; This avoids a crash when compiling the module +(use-typelibs ("GdkPixbuf" "2.0") + ("Gtk" "3.0")) + +(define builder #f) +(define client-widget #f) + +(define (build-client-widget app) + (unless client-widget + (set! builder + (builder:new-from-file (string-append config:uidir "/client-widget.glade"))) + (set! client-widget + (builder:get-object builder "client_widget")) + (let ((client-id-entry + (builder:get-object builder "client_id_entry")) + (redirect-uri-entry + (builder:get-object builder "redirect_uri_entry")) + (key-pair-entry + (builder:get-object builder "key_pair_entry")) + (generate-key-pair-button + (builder:get-object builder "generate_key_pair_button")) + (undo-button + (builder:get-object builder "undo_button")) + (update-button + (builder:get-object builder "update_button"))) + (define (current-edition) + ;; Return the client based on the edited fields + (let/ec return + (with-exception-handler + (lambda (exn) + ((@ (ice-9 format) format) + (current-error-port) + (G_ "The client cannot be constructed: ~a\n") + (if (exception-with-message? exn) + (exception-message exn) + exn)) + (return #f)) + (lambda () + ((@ (oop goops) make) + #:client-id (entry:get-text client-id-entry) + #:redirect-uri (entry:get-text redirect-uri-entry) + #:key-pair + (jwk:jwk->key (stubs:json-string->scm (entry:get-text key-pair-entry)))))))) + (define (on-entry-changed . _) + (let ((current-client (settings:client)) + (edited (current-edition))) + (receive (can-undo? can-update?) + (cond + ((and edited (equal? edited current-client)) + ;; The undo button is disabled and the update button too + (values #f #f)) + (edited + ;; We have changed something and it’s valid + (values #t #t)) + (else + ;; We have changed something, but it’s invalid + (values #t #f))) + (widget:set-sensitive undo-button can-undo?) + (widget:set-sensitive update-button can-update?)))) + (define (set-client client) + (entry:set-text client-id-entry (uri->string (client-id client))) + (entry:set-text redirect-uri-entry (uri->string (redirect-uri client))) + (entry:set-text key-pair-entry + (stubs:scm->json-string + (jwk:key->jwk (key-pair client)))) + (on-entry-changed)) + ((@ (gi) connect) client-id-entry activate on-entry-changed) + ((@ (gi) connect) redirect-uri-entry activate on-entry-changed) + ((@ (gi) connect) key-pair-entry activate on-entry-changed) + ((@ (gi) connect) + generate-key-pair-button clicked + (lambda _ + (entry:set-text key-pair-entry + (stubs:scm->json-string + (jwk:key->jwk + (jwk:generate-key #:n-size 2048)))) + (on-entry-changed))) + ((@ (gi) connect) undo-button clicked + (lambda _ + (set-client (settings:client)) + (on-entry-changed))) + ((@ (gi) connect) update-button clicked + (lambda _ + (settings:client (current-edition)) + (widget:set-sensitive undo-button #f) + (widget:set-sensitive update-button #f))) + (set-client (settings:client)) + (add-hook! settings:client-changed-hook + (lambda (c) + (unless (widget:get-sensitive? undo-button) + ;; If we were doing an edition, ignore + (set-client c))))))) + +(add-hook! application-activated-hook build-client-widget) -- cgit v1.2.3