summaryrefslogtreecommitdiff
path: root/src/scm/webid-oidc/stubs.scm
blob: 0ef3fb5354e1de7c19507a288291af61b8816625 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
(define-module (webid-oidc stubs)
  #:use-module (webid-oidc config)
  #:use-module (webid-oidc errors)
  #:use-module (json))

(load-extension
 (format #f "~a/libwebidoidc" libdir)
 "init_webidoidc")

(define (fix-base64-decode data)
  (catch 'base64-decoding-error
    (lambda ()
      (base64-decode data))
    (lambda error
      (raise-not-base64 data error))))

(export
 base64-encode
 (fix-base64-decode . base64-decode)
 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))