) request request-body)
(raise-exception
(make-exception
(make-web-exception 404 (W_ "reason-phrase|Not Found"))
(make-user-message
(call-with-input-string
(format #f (W_ "Your request cannot be handled by the identity provider.
"))
xml->sxml)))))
(define* (make-identity-provider
issuer
key-file
subject
encrypted-password
jwks-uri
authorization-endpoint-uri
token-endpoint-uri)
(let ((discovery
(make
#:path "/.well-known/openid-configuration"
#:configuration
(make
#:jwks-uri jwks-uri
#:authorization-endpoint authorization-endpoint-uri
#:token-endpoint token-endpoint-uri)))
(authz
(make
#:subject subject
#:encrypted-password encrypted-password
#:key-file key-file
#:path (uri-path authorization-endpoint-uri)))
(token
(make
#:path (uri-path token-endpoint-uri)
#:issuer issuer
#:key-file key-file))
(jwks
(make
#:path (uri-path jwks-uri)
#:key-file key-file)))
(let ((idp (make
#:oidc-discovery discovery
#:authorization-endpoint authz
#:token-endpoint token
#:jwks-endpoint jwks
#:default (make ))))
(lambda (request request-body)
(parameterize ((web-locale request))
(with-exception-handler
(lambda (exn)
(unless (web-exception? exn)
(raise-exception exn))
(values
(build-response
#:code (web-exception-code exn)
#:reason-phrase (web-exception-reason-phrase exn)
#:headers `((content-type application/xhtml+xml)))
(call-with-output-string
(cute sxml->xml
`(*TOP*
(*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
(html (@ (xmlns "http://www.w3.org/1999/xhtml")
(xml:lang ,(W_ "xml-lang|en")))
(body
,(call-with-input-string
(format #f (W_ "The identity provider request failed
"))
xml->sxml)
,(if (user-message? exn)
(user-message-sxml exn)
(call-with-input-string
(format #f (W_ "No more information.
"))
xml->sxml)))))
<>))))
(lambda ()
(receive (response response-body response-meta)
(handle idp request request-body)
(values response response-body)))
#:unwind? #t))))))