add a server callbacks when receiving Certificates
This commit is contained in:
parent
3d4c69da9e
commit
cb850131da
2 changed files with 11 additions and 0 deletions
|
@ -12,6 +12,7 @@
|
||||||
|
|
||||||
module Network.TLS.Server
|
module Network.TLS.Server
|
||||||
( TLSServerParams(..)
|
( TLSServerParams(..)
|
||||||
|
, TLSServerCallbacks(..)
|
||||||
, TLSStateServer
|
, TLSStateServer
|
||||||
, runTLSServer
|
, runTLSServer
|
||||||
-- * low level packet sending receiving.
|
-- * low level packet sending receiving.
|
||||||
|
@ -44,12 +45,20 @@ import System.IO (Handle, hFlush)
|
||||||
|
|
||||||
type TLSServerCert = (L.ByteString, Certificate, CertificateKey.PrivateKey)
|
type TLSServerCert = (L.ByteString, Certificate, CertificateKey.PrivateKey)
|
||||||
|
|
||||||
|
data TLSServerCallbacks = TLSServerCallbacks
|
||||||
|
{ cbCertificates :: Maybe ([Certificate] -> IO Bool) -- ^ optional callback to verify certificates
|
||||||
|
}
|
||||||
|
|
||||||
|
instance Show TLSServerCallbacks where
|
||||||
|
show _ = "[callbacks]"
|
||||||
|
|
||||||
data TLSServerParams = TLSServerParams
|
data TLSServerParams = TLSServerParams
|
||||||
{ spAllowedVersions :: [Version] -- ^ allowed versions that we can use
|
{ spAllowedVersions :: [Version] -- ^ allowed versions that we can use
|
||||||
, spSessions :: [[Word8]] -- ^ placeholder for futur known sessions
|
, spSessions :: [[Word8]] -- ^ placeholder for futur known sessions
|
||||||
, spCiphers :: [Cipher] -- ^ all ciphers that the server side support
|
, spCiphers :: [Cipher] -- ^ all ciphers that the server side support
|
||||||
, spCertificate :: Maybe TLSServerCert -- ^ the certificate we serve to the client
|
, spCertificate :: Maybe TLSServerCert -- ^ the certificate we serve to the client
|
||||||
, spWantClientCert :: Bool -- ^ configure if we do a cert request to the client
|
, spWantClientCert :: Bool -- ^ configure if we do a cert request to the client
|
||||||
|
, spCallbacks :: TLSServerCallbacks -- ^ user callbacks
|
||||||
}
|
}
|
||||||
|
|
||||||
data TLSStateServer = TLSStateServer
|
data TLSStateServer = TLSStateServer
|
||||||
|
|
|
@ -99,6 +99,8 @@ clientProcess ((certdata, cert), pk) (handle, src) = do
|
||||||
, S.spCiphers = ciphers
|
, S.spCiphers = ciphers
|
||||||
, S.spCertificate = Just (certdata, cert, pk)
|
, S.spCertificate = Just (certdata, cert, pk)
|
||||||
, S.spWantClientCert = False
|
, S.spWantClientCert = False
|
||||||
|
, S.spCallbacks = S.TLSServerCallbacks
|
||||||
|
{ S.cbCertificates = Nothing }
|
||||||
}
|
}
|
||||||
|
|
||||||
S.runTLSServer (tlsserver handle serverRandom) serverstate (makeSRandomGen seqInit)
|
S.runTLSServer (tlsserver handle serverRandom) serverstate (makeSRandomGen seqInit)
|
||||||
|
|
Loading…
Reference in a new issue