(define-module (metalctrl identity)
  #:use-module (json)
  #:use-module (web client)
  #:use-module (web uri)
  #:use-module (ice-9 iconv)
  #:use-module (srfi srfi-11))


(define-public %base-identity-url "https://iam.metalctrl.io/")
(define (token-endpoint) (string-append %base-identity-url "token"))
(define (userinfo-endpoint) (string-append %base-identity-url "userinfo"))
(define (openid-configuration-endpoint) (string-append %base-identity-url "/.well-known/openid-configuration"))


(define token-exchange-headers '((Accept . "application/json")
				 (Content-Type . "application/x-www-form-urlencoded")))

;;curl -XPOST -d "grant_type=urn:ietf:params:oauth:grant-type:token-exchange&subject_token=$AUTH_TOKEN&subject_token_type=urn:ietf:params:oauth:token-type:jwt" http://localhost:8000/token
(define-public (exchange-token token)
  (let-values (((resp port) (send-request
			    'POST (token-endpoint)
			    token-exchange-headers
			    (string->bytevector (encode-token-params token) "utf-8"))))
    (assoc-ref (unpack-json port) "access_token")))

(define-public (userinfo token)
  (let ((headers (list `(Authorization . ,(string-append "Bearer " token)))))
    (let-values (((resp port) (send-request 'GET (userinfo-endpoint)
					    headers
					    #f)))
      (unpack-json port))))

(define (send-request method uri headers body)
  (http-request uri
		  #:method method
		  #:headers headers
		  #:body body
		  #:decode-body? #f
		  #:streaming? #t))


(define (encode-token-params token)
  (let ((grant_type  "urn:ietf:params:oauth:grant-type:token-exchange")
	(subject_token token)
	(subject_token_type "urn:ietf:params:oauth:token-type:jwt"))
    (string-append (symbol->string 'grant_type) "=" grant_type "&"
		   (symbol->string 'subject_token) "=" subject_token "&"
		   (symbol->string 'subject_token_type) "=" subject_token_type)))

(define (unpack-json port)
  (with-input-from-port port
      (lambda ()
	(json->scm))))