summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--po/fr.po31
-rw-r--r--po/webid-oidc.pot27
-rw-r--r--src/scm/webid-oidc/errors.scm13
-rw-r--r--src/scm/webid-oidc/stubs.scm56
4 files changed, 100 insertions, 27 deletions
diff --git a/po/fr.po b/po/fr.po
index b27cff8..f075033 100644
--- a/po/fr.po
+++ b/po/fr.po
@@ -126,62 +126,63 @@ msgstr "Utilisation : generate-random [NOMBRE D'OCTETS]\n"
msgid "Usage: generate-key [NUMBER OF BITS | CURVE]\n"
msgstr "Utilisation : generate-key [NOMBRE DE BITS | COURBE]\n"
-#: src/scm/webid-oidc/errors.scm:35
+#: src/scm/webid-oidc/errors.scm:45
msgid "that’s how it is"
msgstr "c’est comme ça"
-#: src/scm/webid-oidc/errors.scm:40
+#: src/scm/webid-oidc/errors.scm:50
#, scheme-format
msgid "the value ~s is not a base64 string (because ~a)"
msgstr "la valeur ~s n’est pas une chaîne base64 (parce que ~a)"
-#: src/scm/webid-oidc/errors.scm:45
+#: src/scm/webid-oidc/errors.scm:53
+#, scheme-format
+msgid "the value ~s is not JSON (because ~a)"
+msgstr "la valeur ~s n’est pas du JSON (parce que ~a)"
+
+#: src/scm/webid-oidc/errors.scm:58
msgid "that’s it"
msgstr "c’est tout"
-#: src/scm/webid-oidc/errors.scm:49
+#: src/scm/webid-oidc/errors.scm:62
#, scheme-format
msgid "~a and ~a"
msgstr "~a et ~a"
-#: src/scm/webid-oidc/errors.scm:52
+#: src/scm/webid-oidc/errors.scm:65
#, scheme-format
msgid "~a, ~a"
msgstr "~a, ~a"
-#: src/scm/webid-oidc/errors.scm:56
+#: src/scm/webid-oidc/errors.scm:69
msgid "there is an undefined variable"
msgstr "il y a une variable non définie"
-#: src/scm/webid-oidc/errors.scm:58
+#: src/scm/webid-oidc/errors.scm:71
#, scheme-format
msgid "the origin is ~a"
msgstr "l’origine est ~a"
-#: src/scm/webid-oidc/errors.scm:61
+#: src/scm/webid-oidc/errors.scm:74
#, scheme-format
msgid "a message is attached: ~a"
msgstr "un message est attaché : ~a"
-#: src/scm/webid-oidc/errors.scm:64
+#: src/scm/webid-oidc/errors.scm:77
#, scheme-format
msgid "the values ~s are problematic"
msgstr "les valeurs ~s sont problématiques"
-#: src/scm/webid-oidc/errors.scm:67
+#: src/scm/webid-oidc/errors.scm:80
msgid "there is a kind and args"
msgstr "il y a un type et des arguments"
-#: src/scm/webid-oidc/errors.scm:69
+#: src/scm/webid-oidc/errors.scm:82
#, scheme-format
msgid "Unhandled exception type ~a."
msgstr "Type d’exception non pris en charge ~a."
#, scheme-format
-#~ msgid "the value ~s is not JSON (because ~a)"
-#~ msgstr "la valeur ~s n’est pas du JSON (parce que ~a)"
-
-#, scheme-format
#~ msgid "the value ~s is not Turtle (because ~a)"
#~ msgstr "la valeur ~s n’est pas du Turtle (parce que ~a)"
diff --git a/po/webid-oidc.pot b/po/webid-oidc.pot
index ee78ff7..16dcfab 100644
--- a/po/webid-oidc.pot
+++ b/po/webid-oidc.pot
@@ -122,53 +122,58 @@ msgstr ""
msgid "Usage: generate-key [NUMBER OF BITS | CURVE]\n"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:35
+#: src/scm/webid-oidc/errors.scm:45
msgid "that’s how it is"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:40
+#: src/scm/webid-oidc/errors.scm:50
#, scheme-format
msgid "the value ~s is not a base64 string (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:45
+#: src/scm/webid-oidc/errors.scm:53
+#, scheme-format
+msgid "the value ~s is not JSON (because ~a)"
+msgstr ""
+
+#: src/scm/webid-oidc/errors.scm:58
msgid "that’s it"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:49
+#: src/scm/webid-oidc/errors.scm:62
#, scheme-format
msgid "~a and ~a"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:52
+#: src/scm/webid-oidc/errors.scm:65
#, scheme-format
msgid "~a, ~a"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:56
+#: src/scm/webid-oidc/errors.scm:69
msgid "there is an undefined variable"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:58
+#: src/scm/webid-oidc/errors.scm:71
#, scheme-format
msgid "the origin is ~a"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:61
+#: src/scm/webid-oidc/errors.scm:74
#, scheme-format
msgid "a message is attached: ~a"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:64
+#: src/scm/webid-oidc/errors.scm:77
#, scheme-format
msgid "the values ~s are problematic"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:67
+#: src/scm/webid-oidc/errors.scm:80
msgid "there is a kind and args"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:69
+#: src/scm/webid-oidc/errors.scm:82
#, scheme-format
msgid "Unhandled exception type ~a."
msgstr ""
diff --git a/src/scm/webid-oidc/errors.scm b/src/scm/webid-oidc/errors.scm
index 98859c9..9d08ed5 100644
--- a/src/scm/webid-oidc/errors.scm
+++ b/src/scm/webid-oidc/errors.scm
@@ -24,6 +24,16 @@
(raise-exception
((record-constructor &not-base64) value cause)))
+(define-public &not-json
+ (make-exception-type
+ 'not-json
+ &external-error
+ '(value cause)))
+
+(define-public (raise-not-json value cause)
+ (raise-exception
+ ((record-constructor &not-json) value cause)))
+
(define*-public (error->str err #:key (max-depth #f))
(if (record? err)
(let* ((type (record-type-descriptor err))
@@ -39,6 +49,9 @@
((&not-base64)
(format #f (G_ "the value ~s is not a base64 string (because ~a)")
(get 'value) (recurse (get 'cause))))
+ ((not-json)
+ (format #f (G_ "the value ~s is not JSON (because ~a)")
+ (get 'value) (recurse (get 'cause))))
((&compound-exception)
(let ((components (get 'components)))
(if (null? components)
diff --git a/src/scm/webid-oidc/stubs.scm b/src/scm/webid-oidc/stubs.scm
index 5858986..0ef3fb5 100644
--- a/src/scm/webid-oidc/stubs.scm
+++ b/src/scm/webid-oidc/stubs.scm
@@ -1,6 +1,7 @@
(define-module (webid-oidc stubs)
#:use-module (webid-oidc config)
- #:use-module (webid-oidc errors))
+ #:use-module (webid-oidc errors)
+ #:use-module (json))
(load-extension
(format #f "~a/libwebidoidc" libdir)
@@ -19,3 +20,56 @@
random
random-init!
generate-key)
+
+;; json reader from guile-json will not behave consistently with
+;; SRFI-180 with objects: keys will be mapped to strings, not
+;; symbols. So we fix alist keys to be symbols.
+(define-public (fix-alists data)
+ (define (fix-an-alist rest alist)
+ (if (null? alist)
+ (reverse rest)
+ (let ((k/v (car alist))
+ (tail (cdr alist)))
+ (let ((key (car k/v))
+ (value (cdr k/v)))
+ (fix-an-alist
+ (acons (string->symbol key)
+ (fix-alists value)
+ rest)
+ tail)))))
+ (define (fix-a-vector vec)
+ (list->vector
+ (map fix-alists
+ (vector->list vec))))
+ (cond
+ ((list? data)
+ (fix-an-alist '() data))
+ ((vector? data)
+ (fix-a-vector data))
+ (else data)))
+
+(define (fixed:json-string->scm str)
+ (with-exception-handler
+ (lambda (err)
+ (raise-not-json str err))
+ (lambda ()
+ (fix-alists (json-string->scm str)))))
+
+(export (fixed:json-string->scm . json-string->scm))
+
+(define (fixed:json->scm port)
+ (with-exception-handler
+ (lambda (err)
+ (raise-not-json "(input)" err))
+ (lambda ()
+ (fix-alists (json->scm port)))))
+
+(export (fixed:json->scm . json->scm))
+
+(define fixed:scm->json-string scm->json-string)
+
+(export (fixed:scm->json-string . scm->json-string))
+
+(define fixed:scm->json scm->json)
+
+(export (fixed:scm->json . scm->json))
generated by cgit v1.2.3 (git 2.44.0) at 2024-06-02 11:04:08 +0000