4e5c2e8c1d
at the moment it's mostly a stub, but will host all handling of client&server certificates.
23 lines
1 KiB
Haskell
23 lines
1 KiB
Haskell
module Network.TLS.Handshake.Certificate
|
|
( certificateRejected
|
|
, rejectOnException
|
|
) where
|
|
|
|
import Network.TLS.Context
|
|
import Network.TLS.Struct
|
|
import Control.Monad.State
|
|
import Control.Exception (SomeException)
|
|
|
|
-- on certificate reject, throw an exception with the proper protocol alert error.
|
|
certificateRejected :: MonadIO m => CertificateRejectReason -> m a
|
|
certificateRejected CertificateRejectRevoked =
|
|
throwCore $ Error_Protocol ("certificate is revoked", True, CertificateRevoked)
|
|
certificateRejected CertificateRejectExpired =
|
|
throwCore $ Error_Protocol ("certificate has expired", True, CertificateExpired)
|
|
certificateRejected CertificateRejectUnknownCA =
|
|
throwCore $ Error_Protocol ("certificate has unknown CA", True, UnknownCa)
|
|
certificateRejected (CertificateRejectOther s) =
|
|
throwCore $ Error_Protocol ("certificate rejected: " ++ s, True, CertificateUnknown)
|
|
|
|
rejectOnException :: SomeException -> IO TLSCertificateUsage
|
|
rejectOnException e = return $ CertificateUsageReject $ CertificateRejectOther $ show e
|