diff options
Diffstat (limited to 'src/scm/webid-oidc/stubs.scm')
-rw-r--r-- | src/scm/webid-oidc/stubs.scm | 56 |
1 files changed, 55 insertions, 1 deletions
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)) |