gui: Bind the settings to scheme

11 files changed, 502 insertions, 11 deletions

diff --git a/man/Makefile.am b/man/Makefile.am
index b523b26..5e428ed 100644
--- a/man/Makefile.am
+++ b/man/Makefile.am
@@ -21,6 +21,7 @@ EXTRA_DIST = ./reset-env project
 CLEANFILES = disfluid-for-man
 
 disfluid.man: ../src/scm/webid-oidc/program.scm ../configure.ac
+	$(MAKE) $(AM_MAKEFLAGS) -C .. xdg-extra-data-dir/glib-2.0/schemas/gschemas.compiled
 	@sed "s|/usr/local/bin/guile|$(GUILE)|g" $(srcdir)/../src/disfluid > disfluid-for-man
 	@chmod u+x disfluid-for-man
 	$(AM_V_GEN) ../pre-inst-env ./reset-env $(HELP2MAN) ./disfluid-for-man > $@-t
@@ -31,5 +32,6 @@ install-html-local: project
 
 
 project: ../src/scm/webid-oidc/program.scm ../configure
+	$(MAKE) $(AM_MAKEFLAGS) -C .. xdg-extra-data-dir/glib-2.0/schemas/gschemas.compiled
 	$(AM_V_GEN) ../pre-inst-env $(GUILE) $(srcdir)/../src/disfluid --describe-project > $@-t
 	mv $@-t $(srcdir)/$@
diff --git a/po/POTFILES.in b/po/POTFILES.in
index a1bbceb..51cac89 100644
--- a/po/POTFILES.in
+++ b/po/POTFILES.in
@@ -38,6 +38,7 @@ src/scm/webid-oidc/client/accounts.scm
 src/scm/webid-oidc/client/application.scm
 src/scm/webid-oidc/client/client.scm
 src/scm/webid-oidc/client/gui.scm
+src/scm/webid-oidc/client/gui/settings.scm
 src/scm/webid-oidc/dpop-proof.scm
 src/scm/webid-oidc/errors.scm
 src/scm/webid-oidc/example-app.scm
diff --git a/po/disfluid.pot b/po/disfluid.pot
index c624063..08e4e4d 100644
--- a/po/disfluid.pot
+++ b/po/disfluid.pot
@@ -8,7 +8,7 @@ msgid ""
 msgstr ""
 "Project-Id-Version: disfluid SNAPSHOT\n"
 "Report-Msgid-Bugs-To: vivien@planete-kraus.eu\n"
-"POT-Creation-Date: 2021-09-23 17:43+0200\n"
+"POT-Creation-Date: 2021-09-29 12:33+0200\n"
 "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n"
 "Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"
 "Language-Team: LANGUAGE <LL@li.org>\n"
@@ -17,6 +17,106 @@ msgstr ""
 "Content-Type: text/plain; charset=UTF-8\n"
 "Content-Transfer-Encoding: 8bit\n"
 
+#: eu.planete_kraus.Disfluid.gschema.xml.in:4
+msgid "Client ID"
+msgstr ""
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:5
+msgid ""
+"The client application needs a public presence on the world-wide web so that "
+"the identity provider can check it is not spoofed; this is the public URI "
+"where to obtain machine-readable information about the application"
+msgstr ""
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:14
+msgid "Client key pair"
+msgstr ""
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:15
+msgid ""
+"When creating new accounts, use this key pair to certify them (in the JWK "
+"format); an empty value will generate a new key pair"
+msgstr ""
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:23
+msgid "Client redirect URI"
+msgstr ""
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:24
+msgid ""
+"When receiving an authorization, the user’s browser is redirected to this "
+"URI, where the user should be presented with a code to paste into the "
+"application"
+msgstr ""
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:34
+msgid "Account webid"
+msgstr ""
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:35
+msgid "The accounts are tied to a particular user, through a webid"
+msgstr ""
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:41
+msgid "Identity provider"
+msgstr ""
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:42
+msgid "The account is certified by the server running at this URI"
+msgstr ""
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:48
+msgid "JWK key pair"
+msgstr ""
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:49
+msgid ""
+"Our account is certified to be used with a key pair that the application "
+"owns; the key is in the JWK format"
+msgstr ""
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:56
+msgid "Header of the identity token"
+msgstr ""
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:57
+msgid ""
+"How we verified the signature of the ID token; if the account needs to be "
+"refreshed then it may be empty"
+msgstr ""
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:64
+msgid "Identity token"
+msgstr ""
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:65
+msgid ""
+"The identity provider sent an ID token to remind us who you are; if the "
+"account needs to be refreshed it may be empty"
+msgstr ""
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:72
+msgid "Access token"
+msgstr ""
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:73
+msgid ""
+"This token is presented to the resource server when we authentify; it is "
+"bound to a key whose possession we need to prove at the same time; if the "
+"account needs to be refreshed it may be empty"
+msgstr ""
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:82
+msgid "Refresh token"
+msgstr ""
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:83
+msgid ""
+"When the account expires, we present this token to the identity provider to "
+"refresh it; it is also bound to the key pair; if the user did not give us "
+"refresh permission it may be empty"
+msgstr ""
+
 #: src/jwk/generate-key.c:52
 #, c-format
 msgid "Usage: generate-key [NUMBER OF BITS | CURVE]\n"
@@ -457,14 +557,18 @@ msgid ""
 "pair.."
 msgstr ""
 
-#: src/scm/webid-oidc/client/gui.scm:57
+#: src/scm/webid-oidc/client/gui.scm:58
 msgid "Hello, world!\n"
 msgstr ""
 
-#: src/scm/webid-oidc/client/gui.scm:62
+#: src/scm/webid-oidc/client/gui.scm:63
 msgid "Hello, world!"
 msgstr ""
 
+#: src/scm/webid-oidc/client/gui/settings.scm:202
+msgid "can only store 10 accounts"
+msgstr ""
+
 #: src/scm/webid-oidc/dpop-proof.scm:111
 #, scheme-format
 msgid "the DPoP proof is signed for ~s, but it is issued to ~s"
diff --git a/po/fr.po b/po/fr.po
index d880b91..6f68824 100644
--- a/po/fr.po
+++ b/po/fr.po
@@ -2,8 +2,8 @@ msgid ""
 msgstr ""
 "Project-Id-Version: webid-oidc 0.0.0\n"
 "Report-Msgid-Bugs-To: vivien@planete-kraus.eu\n"
-"POT-Creation-Date: 2021-09-23 17:43+0200\n"
-"PO-Revision-Date: 2021-09-23 17:44+0200\n"
+"POT-Creation-Date: 2021-09-29 12:33+0200\n"
+"PO-Revision-Date: 2021-09-27 10:25+0200\n"
 "Last-Translator: Vivien Kraus <vivien@planete-kraus.eu>\n"
 "Language-Team: French <vivien@planete-kraus.eu>\n"
 "Language: fr\n"
@@ -12,6 +12,128 @@ msgstr ""
 "Content-Transfer-Encoding: 8bit\n"
 "Plural-Forms: nplurals=2; plural=(n > 1);\n"
 
+#: eu.planete_kraus.Disfluid.gschema.xml.in:4
+msgid "Client ID"
+msgstr "Identifiant client"
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:5
+msgid ""
+"The client application needs a public presence on the world-wide web so that "
+"the identity provider can check it is not spoofed; this is the public URI "
+"where to obtain machine-readable information about the application"
+msgstr ""
+"L’application client nécessite une présence publique sur le web de façon à "
+"ce que le fournisseur d’identité puisse vérifier qu’il ne s’agit pas d’une "
+"contrefaçon ; c’est l’URI publique où une machine peut obtenir de "
+"l’information à propos de l’application"
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:14
+msgid "Client key pair"
+msgstr "Paire de clés du client"
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:15
+msgid ""
+"When creating new accounts, use this key pair to certify them (in the JWK "
+"format); an empty value will generate a new key pair"
+msgstr ""
+"Cette paire de clés (au format JWK) est utilisée pour certifier les nouveaux "
+"comptes ; une valeur vide génèrera une nouvelle paire de clés"
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:23
+msgid "Client redirect URI"
+msgstr "URI de redirection du client"
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:24
+msgid ""
+"When receiving an authorization, the user’s browser is redirected to this "
+"URI, where the user should be presented with a code to paste into the "
+"application"
+msgstr ""
+"Lorsque vous recevez une autorisation, le navigateur de l’utilisateur est "
+"redirigé vers cette URI, où l’utilisateur devrait voir un code à coller dans "
+"l’application"
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:34
+msgid "Account webid"
+msgstr "Webid du compte"
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:35
+msgid "The accounts are tied to a particular user, through a webid"
+msgstr "Les comptes sont liés à un certain utilisateur, à travers un webid"
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:41
+msgid "Identity provider"
+msgstr "Fournisseur d’identité"
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:42
+msgid "The account is certified by the server running at this URI"
+msgstr "Le compte est certifié par le serveur assigné à cette URI"
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:48
+msgid "JWK key pair"
+msgstr "paire de clés JWK"
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:49
+msgid ""
+"Our account is certified to be used with a key pair that the application "
+"owns; the key is in the JWK format"
+msgstr ""
+"Notre compte est certifié pour être utilisé avec une paire de clés que "
+"l’application contrôle ; cette paire de clés est au format JWK"
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:56
+msgid "Header of the identity token"
+msgstr "En-tête du jeton d’identité"
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:57
+msgid ""
+"How we verified the signature of the ID token; if the account needs to be "
+"refreshed then it may be empty"
+msgstr ""
+"Comment nous avons vérifié la signature du jeton d’identité ; si le compte "
+"doit être rafraîchi alors la valeur peut être vide"
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:64
+msgid "Identity token"
+msgstr "Jeton d’identité"
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:65
+msgid ""
+"The identity provider sent an ID token to remind us who you are; if the "
+"account needs to be refreshed it may be empty"
+msgstr ""
+"Le fournisseur d’identité a envoyé un jeton d’identité pour nous rappeler "
+"qui nous sommes ; si le compte doit être rafraîchi alors il peut être vide"
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:72
+msgid "Access token"
+msgstr "Jeton d’accès"
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:73
+msgid ""
+"This token is presented to the resource server when we authentify; it is "
+"bound to a key whose possession we need to prove at the same time; if the "
+"account needs to be refreshed it may be empty"
+msgstr ""
+"Ce jeton est présenté au serveur de ressource quand nous nous identifions ; "
+"il est lié à une paire de clés dont nous devons prouver la possession au "
+"même moment ; si le compte doit être rafraîchi alors la valeur peut être vide"
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:82
+msgid "Refresh token"
+msgstr "Jeton de rafraîchissement"
+
+#: eu.planete_kraus.Disfluid.gschema.xml.in:83
+msgid ""
+"When the account expires, we present this token to the identity provider to "
+"refresh it; it is also bound to the key pair; if the user did not give us "
+"refresh permission it may be empty"
+msgstr ""
+"Lorsque l’accès au compte expirer, nous présentons ce jeton au fournisseur "
+"d’identité pour le rafraîchir ; il est aussi lié à la paire de clés ; si "
+"l’utilisateur ne nous a pas donné la permission de rafraîchir l’accès au "
+"compte, il peut être vide"
+
 #: src/jwk/generate-key.c:52
 #, c-format
 msgid "Usage: generate-key [NUMBER OF BITS | CURVE]\n"
@@ -484,14 +606,18 @@ msgstr ""
 "L’ID de client et l’URI de redirection doivent être des URIs, et la paire de "
 "clés doit être une paire de clés."
 
-#: src/scm/webid-oidc/client/gui.scm:57
+#: src/scm/webid-oidc/client/gui.scm:58
 msgid "Hello, world!\n"
 msgstr "Bonjour, le monde !\n"
 
-#: src/scm/webid-oidc/client/gui.scm:62
+#: src/scm/webid-oidc/client/gui.scm:63
 msgid "Hello, world!"
 msgstr "Bonjour, le monde !"
 
+#: src/scm/webid-oidc/client/gui/settings.scm:202
+msgid "can only store 10 accounts"
+msgstr "on ne peut stocker que 10 comptes"
+
 #: src/scm/webid-oidc/dpop-proof.scm:111
 #, scheme-format
 msgid "the DPoP proof is signed for ~s, but it is issued to ~s"
diff --git a/pre-inst-env.in b/pre-inst-env.in
index 14f4625..71e6fdd 100755
--- a/pre-inst-env.in
+++ b/pre-inst-env.in
@@ -23,6 +23,7 @@ export GUILE_LOAD_COMPILED_PATH="$abs_top_builddir${GUILE_LOAD_COMPILED_PATH:+:}
 export GUILE_LOAD_PATH="$abs_top_builddir:$abs_top_srcdir${GUILE_LOAD_PATH:+:}:$GUILE_LOAD_PATH"
 export "XDG_DATA_HOME=$abs_top_builddir/xdg-data-home"
 export "XDG_CACHE_HOME=$abs_top_builddir/xdg-cache-home"
+export "XDG_DATA_DIRS=$abs_top_builddir/xdg-extra-data-dir:$XDG_DATA_DIRS"
 mkdir -p "$XDG_DATA_HOME"
 mkdir -p "$XDG_CACHE_HOME"
 export GUILE_LOAD_COMPILED_PATH="$abs_top_builddir/src/pre-inst:$abs_top_builddir/src/scm:$GUILE_LOAD_COMPILED_PATH"
diff --git a/settings.am b/settings.am
index 06642db..940623a 100644
--- a/settings.am
+++ b/settings.am
@@ -17,4 +17,13 @@
 gsettings_SCHEMAS = %reldir%/eu.planete_kraus.Disfluid.gschema.xml
 EXTRA_DIST += %reldir%/eu.planete_kraus.Disfluid.gschema.xml.in
 
+xdg-extra-data-dir/glib-2.0/schemas/eu.planete_kraus.Disfluid.gschema.xml: %reldir%/eu.planete_kraus.Disfluid.gschema.xml
+	$(MKDIR_P) $$(dirname $@)
+	$(AM_V_GEN) cp $< $@-t
+	@mv $@-t $@
+
+xdg-extra-data-dir/glib-2.0/schemas/gschemas.compiled: xdg-extra-data-dir/glib-2.0/schemas/eu.planete_kraus.Disfluid.gschema.xml
+	$(AM_V_GEN) $(GLIB_COMPILE_SCHEMAS) --strict "$$(dirname $<)" --targetdir=$(abs_top_builddir)
+	@mv gschemas.compiled $@
+
 @GSETTINGS_RULES@
diff --git a/src/Makefile.am b/src/Makefile.am
index 38e458d..eedfe4a 100644
--- a/src/Makefile.am
+++ b/src/Makefile.am
@@ -39,6 +39,9 @@ resourceserverwebidoidcgodir = $(serverwebidoidcgodir)/resource
 clientwebidoidcmoddir = $(webidoidcmoddir)/client
 clientwebidoidcgodir = $(webidoidcgodir)/client
 
+guiclientwebidoidcmoddir = $(clientwebidoidcmoddir)/gui
+guiclientwebidoidcgodir = $(clientwebidoidcgodir)/gui
+
 dist_mod_DATA =
 mod_DATA =
 go_DATA =
@@ -56,8 +59,11 @@ clientwebidoidcgo_DATA =
 dist_resourceserverwebidoidcmod_DATA =
 resourceserverwebidoidcgo_DATA =
 
-install_go_targets = install-webidoidcgoDATA install-serverwebidoidcgoDATA install-resourceserverwebidoidcgoDATA
-install_mod_targets = install-webidoidcmodDATA install-dist_webidoidcmodDATA install-dist_serverwebidoidcmodDATA install-dist_resourceserverwebidoidcmodDATA
+dist_guiclientwebidoidcmod_DATA =
+guiclientwebidoidcgo_DATA =
+
+install_go_targets = install-webidoidcgoDATA install-serverwebidoidcgoDATA install-resourceserverwebidoidcgoDATA install-clientwebidoidcgoDATA install-guiclientwebidoidcgoDATA
+install_mod_targets = install-webidoidcmodDATA install-dist_webidoidcmodDATA install-dist_serverwebidoidcmodDATA install-dist_resourceserverwebidoidcmodDATA install-dist_clientwebidoidcmodDATA install-dist_guiclientwebidoidcmodDATA
 
 include %reldir%/base64/Makefile.am
 include %reldir%/random/Makefile.am
@@ -69,14 +75,22 @@ include %reldir%/inst/Makefile.am
 include %reldir%/scm/Makefile.am
 
 CLEANFILES += $(go_DATA) $(webidoidcgo_DATA) $(mod_DATA) $(webidoidcmod_DATA) \
-  $(serverwebidoidcgo_DATA) $(clientwebidoidcgo_DATA) $(resourceserverwebidoidcgo_DATA)
+  $(serverwebidoidcgo_DATA) $(clientwebidoidcgo_DATA) $(resourceserverwebidoidcgo_DATA) \
+  $(guiclientwebidoidcgo_DATA)
+
+.PHONY: clean-xdg-extra-data-dir
+
+clean-local: clean-xdg-extra-data-dir
+
+clean-xdg-extra-data-dir:
+	rm -rf xdg-extra-data-dir
 
 %canon_reldir%_libwebidoidc_la_SOURCES = %reldir%/gettext.h %reldir%/libwebidoidc.c %reldir%/utilities.h
 %canon_reldir%_libwebidoidc_la_LIBADD = $(noinst_LTLIBRARIES) $(GUILE_LIBS) $(NETTLE_LIBS)
 
 INDENTED += $(%canon_reldir%_libwebidoidc_la_SOURCES)
 
-$(go_DATA) $(webidoidcgo_DATA) $(serverwebidoidcgo_DATA) $(clientwebidoidcgo_DATA) $(resourceserverwebidoidcgo_DATA): %reldir%/libwebidoidc.la
+$(go_DATA) $(webidoidcgo_DATA) $(serverwebidoidcgo_DATA) $(clientwebidoidcgo_DATA) $(resourceserverwebidoidcgo_DATA) $(guiclientwebidoidcgo_DATA): %reldir%/libwebidoidc.la xdg-extra-data-dir/glib-2.0/schemas/gschemas.compiled xdg-extra-data-dir/glib-2.0/schemas/eu.planete_kraus.Disfluid.gschema.xml
 
 SUFFIXES += .c .x .scm .go
 .c.x:
diff --git a/src/scm/webid-oidc/client/Makefile.am b/src/scm/webid-oidc/client/Makefile.am
index bf9feb7..8ecf7d5 100644
--- a/src/scm/webid-oidc/client/Makefile.am
+++ b/src/scm/webid-oidc/client/Makefile.am
@@ -25,3 +25,5 @@ clientwebidoidcgo_DATA += \
   %reldir%/client.go \
   %reldir%/application.go \
   %reldir%/gui.go
+
+include %reldir%/gui/Makefile.am
diff --git a/src/scm/webid-oidc/client/gui.scm b/src/scm/webid-oidc/client/gui.scm
index 97e9d0e..c446fc7 100644
--- a/src/scm/webid-oidc/client/gui.scm
+++ b/src/scm/webid-oidc/client/gui.scm
@@ -34,6 +34,7 @@
   #:use-module ((webid-oidc jwk) #:prefix jwk:)
   #:use-module ((webid-oidc dpop-proof) #:prefix dpop:)
   #:use-module ((webid-oidc client client) #:prefix client:)
+  #:use-module ((webid-oidc client gui settings) #:prefix settings)
   #:use-module (web uri)
   #:use-module (web response)
   #:use-module (rnrs bytevectors)
diff --git a/src/scm/webid-oidc/client/gui/Makefile.am b/src/scm/webid-oidc/client/gui/Makefile.am
new file mode 100644
index 0000000..86d6dd3
--- /dev/null
+++ b/src/scm/webid-oidc/client/gui/Makefile.am
@@ -0,0 +1,21 @@
+# 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/>.
+
+dist_guiclientwebidoidcmod_DATA += \
+  %reldir%/settings.scm
+
+guiclientwebidoidcgo_DATA += \
+  %reldir%/settings.go
diff --git a/src/scm/webid-oidc/client/gui/settings.scm b/src/scm/webid-oidc/client/gui/settings.scm
new file mode 100644
index 0000000..5ce62b0
--- /dev/null
+++ b/src/scm/webid-oidc/client/gui/settings.scm
@@ -0,0 +1,210 @@
+;; 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 settings)
+  #: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 (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
+  (
+   client
+   main-account
+   other-accounts
+   ))
+
+(push-duplicate-handler! 'merge-generics)
+
+(use-typelibs (("Gio" "2.0")))
+
+(define goops:make
+  (@ (oop goops) make))
+
+(define root-settings
+  (settings:new "eu.planete_kraus.Disfluid"))
+
+(define client-settings
+  (settings:get-child root-settings "client"))
+
+(define main-account-settings
+  (settings:get-child root-settings "main-account"))
+
+;; FIXME: when https://gitlab.gnome.org/GNOME/glib/-/issues/993 is
+;; solved, use relocatable schemas
+(define other-accounts-settings
+  (map (lambda (id)
+         (settings:get-child root-settings (format #f "other-account-~a" id)))
+       '(1 2 3 4 5 6 7 8 9 10)))
+
+(define (list-other-accounts-settings)
+  (let filter ((children (vector->list (settings:list-children root-settings)))
+               (settings '()))
+    (match children
+      (()
+       (reverse settingns))
+      (((or "client" "main-account")
+        children ...)
+       (filter children settings))
+      (((? (cute string-prefix? "account-" <>) name) children ...)
+       (filter children `(,(settings:get-child root-settings name) ,@settings))))))
+
+(define (get-client)
+  (let ((client-id (string->uri (settings:get-string client-settings "client-id")))
+        (key-pair-string (settings:get-string client-settings "key-pair"))
+        (redirect-uri (string->uri (settings:get-string client-settings "redirect-uri"))))
+    (let ((key-pair
+           (if (equal? key-pair-string "")
+               (generate-key #:n-size 2048)
+               (jwk->key (stubs:json-string->scm key-pair-string)))))
+      (goops:make <client>
+        #:client-id client-id
+        #:key-pair key-pair
+        #:redirect-uri redirect-uri))))
+
+(define (set-client! client)
+  (let ((saved (get-client)))
+    (unless (equal? client saved)
+      (settings:set-string? client-settings "client-id"
+                           (uri->string (client-id client)))
+      (settings:set-string? client-settings "key-pair"
+                           (stubs:scm->json-string (key->jwk (key-pair client))))
+      (settings:set-string? client-settings "redirect-uri"
+                           (uri->string (redirect-uri client)))
+      (settings:apply client-settings))))
+
+(define client
+  (match-lambda*
+    (() (get-client))
+    ((value) (set-client! value))))
+
+(unless (equal? (get-client) (get-client))
+  ;; The key is generated each time, fix it
+  (set-client! (get-client)))
+
+(define empty-is-false
+  (match-lambda
+    ("" #f)
+    (str str)))
+
+(define (read-account settings)
+  (let ((subject (empty-is-false (settings:get-string main-account-settings "subject")))
+        (issuer (empty-is-false (settings:get-string main-account-settings "issuer")))
+        (key-pair (empty-is-false (settings:get-string main-account-settings "key-pair")))
+        (id-token-header (empty-is-false (settings:get-string main-account-settings "id-token-header")))
+        (id-token (empty-is-false (settings:get-string main-account-settings "id-token")))
+        (access-token (empty-is-false (settings:get-string main-account-settings "access-token")))
+        (refresh-token (empty-is-false (settings:get-string main-account-settings "refresh-token"))))
+    (and subject issuer key-pair
+         (let ((subject (string->uri subject))
+               (issuer (string->uri issuer))
+               (key-pair (jwk->key (stubs:json-string->scm key-pair)))
+               (id-token-header (and id-token-header
+                                     (stubs:json-string->scm id-token-header)))
+               (id-token (and id-token
+                              (stubs:json-string->scm id-token))))
+           (goops:make <account>
+             #:subject subject
+             #:issuer issuer
+             #:key-pair key-pair
+             #:id-token
+             (goops:make <id-token>
+               #:jwt-header id-token-header
+               #:jwt-payload id-token)
+             #:access-token access-token
+             #:refresh-token refresh-token)))))
+
+(define (clear-account settings)
+  (settings:set-string? settings "subject" "")
+  (settings:set-string? settings "issuer" "")
+  (settings:set-string? settings "key-pair" "")
+  (settings:set-string? settings "id-token-header" "")
+  (settings:set-string? settings "id-token" "")
+  (settings:set-string? settings "access-token" "")
+  (settings:set-string? settings "refresh-token" ""))
+
+(define (save-account settings account)
+  (clear-account settings)
+  (when (and account (not (equal? (read-account settings) account)))
+    (settings:set-string? settings "subject" (uri->string (subject account)))
+    (settings:set-string? settings "issuer" (uri->string (issuer account)))
+    (settings:set-string? settings "key-pair"
+                         (stubs:scm->json-string (key->jwk (key-pair account))))
+    (when (id-token account)
+      (receive (id-token-header id-token)
+          (token->jwt (id-token account))
+        (settings:set-string? settings "id-token-header"
+                             (stubs:scm->json-string id-token-header))
+        (settings:set-string? settings "id-token"
+                             (stubs:scm->json-string id-token))))
+    (when (access-token account)
+      (settings:set-string? settings "access-token" (access-token account)))
+    (when (refresh-token account)
+      (settings:set-string? settings "refresh-token" (refresh-token account)))))
+
+(define (get-main-account)
+  (read-account main-account-settings))
+
+(define (set-main-account! account)
+  (save-account main-account-settings account))
+
+(define main-account
+  (match-lambda*
+    (() (get-main-account))
+    ((value) (set-main-account! value))))
+
+(define (get-other-accounts)
+  (filter (lambda (x) x)
+          (map read-account other-accounts-settings)))
+
+(define (set-other-accounts! accounts)
+  (when (not (equal? accounts (get-other-accounts)))
+    (let do-save ((accounts accounts)
+                  (settings other-accounts-settings))
+      (match `(,accounts . ,settings)
+        ((() . ()) #t)
+        ((() . (hd tl ...))
+         (do-save (list #f) tl))
+        ((_ . ())
+         (fail (G_ "can only store 10 accounts")))
+        (((account accounts ...) . (setting settings ...))
+         (save-account setting account)
+         (do-save accounts tl))))))
+
+(define other-accounts
+  (match-lambda*
+    (() (get-other-accounts))
+    ((value) (set-other-accounts! value))))