-- | -- Module : Network.TLS.Handshake.Certificate -- License : BSD-style -- Maintainer : Vincent Hanquez <vincent@snarc.org> -- Stability : experimental -- Portability : unknown -- module Network.TLS.Handshake.Certificate ( certificateRejected , rejectOnException ) where import Network.TLS.Context.Internal import Network.TLS.Struct import Network.TLS.X509 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 CertificateUsage rejectOnException e = return $ CertificateUsageReject $ CertificateRejectOther $ show e