Add new field ctxClientCerts to Context

It's stores certificate chain in an IORef. This can be filled in
the onClientCertificate hook.

core/Network/TLS/Context.hs

@@ -157,6 +157,7 @@ contextNew backend params = liftIO $ do
     lockWrite <- newMVar ()
     lockRead  <- newMVar ()
     lockState <- newMVar ()
+    certChain <- newIORef Nothing
 
     return Context
             { ctxConnection   = getBackend backend
@@ -182,6 +183,7 @@ contextNew backend params = liftIO $ do
             , ctxPendingActions   = as
             , ctxCertRequests     = crs
             , ctxKeyLogger        = debugKeyLogger debug
+            , ctxClientCerts      = certChain
             }
 
 -- | create a new context on an handle.

core/Network/TLS/Context/Internal.hs

@@ -86,6 +86,7 @@ import Control.Exception (throwIO, Exception())
 import Data.IORef
 import Data.Tuple
 
+import Data.X509
 
 -- | Information related to a running context, e.g. current cipher
 data Information = Information
@@ -128,6 +129,7 @@ data Context = Context
     , ctxPendingActions   :: IORef [PendingAction]
     , ctxCertRequests     :: IORef [Handshake13]  -- ^ pending PHA requests
     , ctxKeyLogger        :: String -> IO ()
+    , ctxClientCerts      :: IORef (Maybe CertificateChain)
     }
 
 data Established = NotEstablished

core/Network/TLS/Handshake/Server.hs

@@ -1077,7 +1077,8 @@ clientCertificate sparams ctx certs = do
     -- Call application callback to see whether the
     -- certificate chain is acceptable.
     --
-    usage <- liftIO $ catchException (onClientCertificate (serverHooks sparams) certs) rejectOnException
+    let ioref = ctxClientCerts ctx
+    usage <- liftIO $ catchException (onClientCertificate (serverHooks sparams) certs ioref) rejectOnException
     case usage of
         CertificateUsageAccept        -> verifyLeafKeyUsage [KeyUsage_digitalSignature] certs
         CertificateUsageReject reason -> certificateRejected reason

core/Network/TLS/Parameters.hs

@@ -26,6 +26,8 @@ module Network.TLS.Parameters
     , CertificateRejectReason(..)
     ) where
 
+import Data.IORef
+
 import Network.TLS.Extension
 import Network.TLS.Struct
 import qualified Network.TLS.Struct as Struct
@@ -442,7 +444,7 @@ data ServerHooks = ServerHooks
       -- The function is not expected to verify the key-usage
       -- extension of the certificate.  This verification is
       -- performed by the library internally.
-      onClientCertificate :: CertificateChain -> IO CertificateUsage
+      onClientCertificate :: CertificateChain -> IORef (Maybe CertificateChain) -> IO CertificateUsage
 
       -- | This action is called when the client certificate
       -- cannot be verified. Return 'True' to accept the certificate
@@ -482,7 +484,7 @@ data ServerHooks = ServerHooks
 defaultServerHooks :: ServerHooks
 defaultServerHooks = ServerHooks
     { onCipherChoosing       = \_ -> head
-    , onClientCertificate    = \_ -> return $ CertificateUsageReject $ CertificateRejectOther "no client certificates expected"
+    , onClientCertificate    = \_ _ -> return $ CertificateUsageReject $ CertificateRejectOther "no client certificates expected"
     , onUnverifiedClientCert = return False
     , onServerNameIndication = \_ -> return mempty
     , onNewHandshake         = \_ -> return True