diff options
Diffstat (limited to 'src/scm/webid-oidc')
-rw-r--r-- | src/scm/webid-oidc/client/gui.scm | 21 | ||||
-rw-r--r-- | src/scm/webid-oidc/client/gui/Makefile.am | 10 | ||||
-rw-r--r-- | src/scm/webid-oidc/client/gui/application-hooks.scm | 46 | ||||
-rw-r--r-- | src/scm/webid-oidc/client/gui/application.scm | 72 | ||||
-rw-r--r-- | src/scm/webid-oidc/client/gui/client-widget.scm | 147 | ||||
-rw-r--r-- | src/scm/webid-oidc/client/gui/settings.scm | 9 |
6 files changed, 286 insertions, 19 deletions
diff --git a/src/scm/webid-oidc/client/gui.scm b/src/scm/webid-oidc/client/gui.scm index 45910e3..be557bd 100644 --- a/src/scm/webid-oidc/client/gui.scm +++ b/src/scm/webid-oidc/client/gui.scm @@ -36,6 +36,7 @@ #: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) #:prefix app:) #:use-module (web uri) #:use-module (web response) #:use-module (rnrs bytevectors) @@ -57,27 +58,13 @@ (add-hook! settings:client-changed-hook (lambda (client) - (format #t (G_ "The client changed: it is now ~a.\n") client))) + (format #t (G_ "The client changed: it is now ~a.\n") client) + ((@ (webid-oidc client) client) client))) (add-hook! settings:accounts-changed-hook (lambda (main other) (format #t (G_ "The accounts changed: the main account is ~a, and the others are ~a.\n") main other))) -(define (print-hello button) - (format #t (G_ "Hello, world!\n"))) - -(define (on-activate application) - (let ((window (make <GtkApplicationWindow> - #:application application)) - (button (make <GtkButton> #:label (G_ "Hello, world!")))) - (connect button clicked print-hello) - (add window button) - (show-all window))) - (define (main) - (let ((app (application:new - "eu.planete_kraus.Disfluid" - (list->application-flags '(flags-none))))) - (connect app activate on-activate) - (run app (command-line)))) + (run app:application (command-line))) diff --git a/src/scm/webid-oidc/client/gui/Makefile.am b/src/scm/webid-oidc/client/gui/Makefile.am index 86d6dd3..64b1870 100644 --- a/src/scm/webid-oidc/client/gui/Makefile.am +++ b/src/scm/webid-oidc/client/gui/Makefile.am @@ -15,7 +15,13 @@ # along with this program. If not, see <https://www.gnu.org/licenses/>. dist_guiclientwebidoidcmod_DATA += \ - %reldir%/settings.scm + %reldir%/settings.scm \ + %reldir%/client-widget.scm \ + %reldir%/application-hooks.scm \ + %reldir%/application.scm guiclientwebidoidcgo_DATA += \ - %reldir%/settings.go + %reldir%/settings.go \ + %reldir%/client-widget.go \ + %reldir%/application-hooks.go \ + %reldir%/application.go diff --git a/src/scm/webid-oidc/client/gui/application-hooks.scm b/src/scm/webid-oidc/client/gui/application-hooks.scm new file mode 100644 index 0000000..0d51599 --- /dev/null +++ b/src/scm/webid-oidc/client/gui/application-hooks.scm @@ -0,0 +1,46 @@ +;; 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 <https://www.gnu.org/licenses/>. + +(define-module (webid-oidc client gui application-hooks) + #: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 (srfi srfi-9) + #:use-module (srfi srfi-19) + #:use-module (srfi srfi-26) + #:use-module (webid-oidc errors) + #:use-module ((webid-oidc stubs) #:prefix stubs:) + #:use-module (webid-oidc web-i18n) + #:use-module (webid-oidc client client) + #:use-module (webid-oidc client accounts) + #:use-module (webid-oidc jwk) + #:use-module (webid-oidc oidc-id-token) + #:use-module (web uri) + #:use-module (web response) + #:use-module (rnrs bytevectors) + #:use-module (oop goops) + #:declarative? #t + #:duplicates (merge-generics) + #:export + ( + application-activated-hook + )) + +(define application-activated-hook + (make-hook 1)) diff --git a/src/scm/webid-oidc/client/gui/application.scm b/src/scm/webid-oidc/client/gui/application.scm new file mode 100644 index 0000000..361e12d --- /dev/null +++ b/src/scm/webid-oidc/client/gui/application.scm @@ -0,0 +1,72 @@ +;; 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 <https://www.gnu.org/licenses/>. + +(define-module (webid-oidc client gui application) + #:use-module (gi) + #:use-module (gi types) + #:use-module (gi util) + #: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 (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 dpop-proof) #:prefix dpop:) + #: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 client-widget) #:prefix client:) + #:use-module (webid-oidc client gui application-hooks) + #:use-module (web uri) + #:use-module (web response) + #:use-module (rnrs bytevectors) + #:use-module (oop goops) + #:declarative? #t + #:export + ( + application + )) + +(push-duplicate-handler! 'merge-generics) + +;; This avoids a crash when compiling the module +(use-typelibs ("GdkPixbuf" "2.0")) + +(use-typelibs (("Gio" "2.0") #:renamer (protect 'application:new)) + ("Gtk" "3.0")) + +(define application + (application:new + "eu.planete_kraus.Disfluid" + (list->application-flags '(flags-none)))) + +(define (on-activate application) + (run-hook application-activated-hook application) + (let ((window (make <GtkApplicationWindow> + #:application application)) + (widget client:client-widget)) + (add window widget) + (show-all window))) + +(connect application activate on-activate) 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 <https://www.gnu.org/licenses/>. + +(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> + #: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) diff --git a/src/scm/webid-oidc/client/gui/settings.scm b/src/scm/webid-oidc/client/gui/settings.scm index 57ebbfb..8f97b2e 100644 --- a/src/scm/webid-oidc/client/gui/settings.scm +++ b/src/scm/webid-oidc/client/gui/settings.scm @@ -32,6 +32,7 @@ #:use-module (webid-oidc web-i18n) #:use-module (webid-oidc client client) #:use-module (webid-oidc client accounts) + #:use-module (webid-oidc client gui application-hooks) #:use-module (webid-oidc jwk) #:use-module (webid-oidc oidc-id-token) #:use-module (web uri) @@ -234,3 +235,11 @@ (lambda (settings) (connect settings change-event run-accounts-changed-hook)) other-accounts-settings) + +(add-hook! application-activated-hook + (lambda (app) + (run-hook client-changed-hook (client)) + (run-hook accounts-changed-hook + (main-account) + (other-accounts))) + #t) |