(define-module (webid-oidc jwk)
  #:use-module ((webid-oidc stubs) #:prefix stubs:)
  #:use-module (webid-oidc errors)
  #:use-module (json))

(define-public (the-jwk x)
  (with-exception-handler
      (lambda (cause)
        (raise-not-a-jwk x cause))
    (lambda ()
      (let ((kty (stubs:kty x)))
        (unless (or (eq? kty 'EC) (eq? kty 'RSA))
          (throw 'really-not-a-jwk))
        x))))

(define-public (jwk? x)
  (false-if-exception
   (and (the-jwk x) #t)))

(define-public (kty x)
  (stubs:kty (the-jwk x)))

(define-public (the-public-jwk x)
  (with-exception-handler
      (lambda (cause)
        (raise-not-a-public-jwk x cause))
    (lambda ()
      (let ((key (the-jwk x)))
        (let ((crv (assq-ref key 'crv))
              (x (assq-ref key 'x))
              (y (assq-ref key 'y))
              (n (assq-ref key 'n))
              (e (assq-ref key 'e)))
          (let ((ec-part `((crv . ,crv)
                           (x . ,x)
                           (y . ,y)))
                (rsa-part `((n . ,n)
                            (e . ,e))))
            (case (stubs:kty ec-part)
              ((EC) ec-part)
              ((RSA) rsa-part))))))))

(define-public (jwk-public? key)
  (false-if-exception
   (and (the-public-jwk x) #t)))

(define-public (strip key)
  (with-exception-handler
      (lambda (cause)
        (raise-not-a-public-jwk key cause))
    (lambda ()
      (stubs:strip-key key))))

(define-public (jkt x)
  (stubs:jkt (the-public-jwk x)))

(define-public (make-rsa-public-key n e)
  (the-public-jwk
   `((n . ,n)
     (e . ,e))))

(define-public (make-rsa-private-key d p q dp dq qi)
  (the-jwk
   `((d . ,d)
     (p . ,p)
     (q . ,q)
     (dp . ,dp)
     (dq . ,dq)
     (qi . ,qi))))

(define-public (make-ec-point crv x y)
  (if (symbol? crv)
      (make-ec-point (symbol->string crv) x y)
      (the-public-jwk
       `((crv . ,crv)
         (x . ,x)
         (y . ,y)))))

(define-public (make-ec-scalar crv d)
  (if (symbol? crv)
      (make-ec-scalar (symbol->string crv) d)
      (the-jwk
       `((crv . ,crv)
         (d . ,d)))))

(define-public generate-key stubs:generate-key)

(define (the-public-keys keys)
  (map the-public-key keys))

(define-public (the-jwks jwks)
  (let ((keys (vector->list (assoc-ref jwks 'keys))))
    (unless keys
      (raise-not-a-jwks jwks #f))
    (with-exception-handler
        (lambda (cause)
          (raise-not-a-jwks jwks cause))
      (lambda ()
        `((keys . ,(list->vector (the-public-keys keys))))))))

(define-public (jwks? jwks)
  (false-if-exception
   (and (the-jwks jwks) #t)))

(define-public (make-jwks keys)
  (if (vector? keys)
      (make-jwks (vector->list keys))
      (let ((pubs (list->vector (map strip keys))))
        (the-jwks `((keys . ,pubs))))))

(define-public (jwks-keys jwks)
  (vector->list (assq-ref (the-jwks jwks) keys)))