From a6f70c118d1ea46dae438943f474e4c5406c43b3 Mon Sep 17 00:00:00 2001 From: Vivien Kraus Date: Mon, 26 Apr 2021 13:11:11 +0200 Subject: Export a JSON API that is compatible with SRFI-180 SRFI-180 represents JSON objects as alists from symbols to values, while guile-json represents them as alists from strings to values. Since alists are everywhere in the API, we need them to be as standard as possible. So, we need them in SRFI-180 format. --- po/fr.po | 31 ++++++++++++------------ po/webid-oidc.pot | 27 ++++++++++++--------- src/scm/webid-oidc/errors.scm | 13 ++++++++++ src/scm/webid-oidc/stubs.scm | 56 ++++++++++++++++++++++++++++++++++++++++++- 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,61 +126,62 @@ 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 ¬-base64) value cause))) +(define-public ¬-json + (make-exception-type + 'not-json + &external-error + '(value cause))) + +(define-public (raise-not-json value cause) + (raise-exception + ((record-constructor ¬-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 @@ ((¬-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)) -- cgit v1.2.3