1-- |
2-- Module      : Network.TLS.Parameters
3-- License     : BSD-style
4-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
5-- Stability   : experimental
6-- Portability : unknown
7--
8module Network.TLS.Parameters
9    (
10      ClientParams(..)
11    , ServerParams(..)
12    , CommonParams
13    , DebugParams(..)
14    , ClientHooks(..)
15    , OnCertificateRequest
16    , OnServerCertificate
17    , ServerHooks(..)
18    , Supported(..)
19    , Shared(..)
20    -- * special default
21    , defaultParamsClient
22    -- * Parameters
23    , MaxFragmentEnum(..)
24    , EMSMode(..)
25    , GroupUsage(..)
26    , CertificateUsage(..)
27    , CertificateRejectReason(..)
28    ) where
29
30import Network.TLS.Extension
31import Network.TLS.Struct
32import qualified Network.TLS.Struct as Struct
33import Network.TLS.Session
34import Network.TLS.Cipher
35import Network.TLS.Measurement
36import Network.TLS.Compression
37import Network.TLS.Crypto
38import Network.TLS.Credentials
39import Network.TLS.X509
40import Network.TLS.RNG (Seed)
41import Network.TLS.Imports
42import Network.TLS.Types (HostName)
43import Data.Default.Class
44import qualified Data.ByteString as B
45
46
47type CommonParams = (Supported, Shared, DebugParams)
48
49-- | All settings should not be used in production
50data DebugParams = DebugParams
51    {
52      -- | Disable the true randomness in favor of deterministic seed that will produce
53      -- a deterministic random from. This is useful for tests and debugging purpose.
54      -- Do not use in production
55      --
56      -- Default: 'Nothing'
57      debugSeed :: Maybe Seed
58      -- | Add a way to print the seed that was randomly generated. re-using the same seed
59      -- will reproduce the same randomness with 'debugSeed'
60      --
61      -- Default: no printing
62    , debugPrintSeed :: Seed -> IO ()
63      -- | Force to choose this version in the server side.
64      --
65      -- Default: 'Nothing'
66    , debugVersionForced :: Maybe Version
67      -- | Printing master keys.
68      --
69      -- Default: no printing
70    , debugKeyLogger     :: String -> IO ()
71    }
72
73defaultDebugParams :: DebugParams
74defaultDebugParams = DebugParams
75    { debugSeed = Nothing
76    , debugPrintSeed = const (return ())
77    , debugVersionForced = Nothing
78    , debugKeyLogger = \_ -> return ()
79    }
80
81instance Show DebugParams where
82    show _ = "DebugParams"
83instance Default DebugParams where
84    def = defaultDebugParams
85
86data ClientParams = ClientParams
87    { -- |
88      --
89      -- Default: 'Nothing'
90      clientUseMaxFragmentLength    :: Maybe MaxFragmentEnum
91      -- | Define the name of the server, along with an extra service identification blob.
92      -- this is important that the hostname part is properly filled for security reason,
93      -- as it allow to properly associate the remote side with the given certificate
94      -- during a handshake.
95      --
96      -- The extra blob is useful to differentiate services running on the same host, but that
97      -- might have different certificates given. It's only used as part of the X509 validation
98      -- infrastructure.
99      --
100      -- This value is typically set by 'defaultParamsClient'.
101    , clientServerIdentification      :: (HostName, ByteString)
102      -- | Allow the use of the Server Name Indication TLS extension during handshake, which allow
103      -- the client to specify which host name, it's trying to access. This is useful to distinguish
104      -- CNAME aliasing (e.g. web virtual host).
105      --
106      -- Default: 'True'
107    , clientUseServerNameIndication   :: Bool
108      -- | try to establish a connection using this session.
109      --
110      -- Default: 'Nothing'
111    , clientWantSessionResume         :: Maybe (SessionID, SessionData)
112      -- | See the default value of 'Shared'.
113    , clientShared                    :: Shared
114      -- | See the default value of 'ClientHooks'.
115    , clientHooks                     :: ClientHooks
116      -- | In this element, you'll  need to override the default empty value of
117      -- of 'supportedCiphers' with a suitable cipherlist.
118      --
119      -- See the default value of 'Supported'.
120    , clientSupported                 :: Supported
121      -- | See the default value of 'DebugParams'.
122    , clientDebug                     :: DebugParams
123      -- | Client tries to send this early data in TLS 1.3 if possible.
124      -- If not accepted by the server, it is application's responsibility
125      -- to re-sent it.
126      --
127      -- Default: 'Nothing'
128    , clientEarlyData                 :: Maybe ByteString
129    } deriving (Show)
130
131defaultParamsClient :: HostName -> ByteString -> ClientParams
132defaultParamsClient serverName serverId = ClientParams
133    { clientUseMaxFragmentLength    = Nothing
134    , clientServerIdentification    = (serverName, serverId)
135    , clientUseServerNameIndication = True
136    , clientWantSessionResume       = Nothing
137    , clientShared                  = def
138    , clientHooks                   = def
139    , clientSupported               = def
140    , clientDebug                   = defaultDebugParams
141    , clientEarlyData               = Nothing
142    }
143
144data ServerParams = ServerParams
145    { -- | Request a certificate from client.
146      --
147      -- Default: 'False'
148      serverWantClientCert    :: Bool
149
150      -- | This is a list of certificates from which the
151      -- disinguished names are sent in certificate request
152      -- messages.  For TLS1.0, it should not be empty.
153      --
154      -- Default: '[]'
155    , serverCACertificates :: [SignedCertificate]
156
157      -- | Server Optional Diffie Hellman parameters.  Setting parameters is
158      -- necessary for FFDHE key exchange when clients are not compatible
159      -- with RFC 7919.
160      --
161      -- Value can be one of the standardized groups from module
162      -- "Network.TLS.Extra.FFDHE" or custom parameters generated with
163      -- 'Crypto.PubKey.DH.generateParams'.
164      --
165      -- Default: 'Nothing'
166    , serverDHEParams         :: Maybe DHParams
167      -- | See the default value of 'ServerHooks'.
168    , serverHooks             :: ServerHooks
169      -- | See the default value of 'Shared'.
170    , serverShared            :: Shared
171      -- | See the default value of 'Supported'.
172    , serverSupported         :: Supported
173      -- | See the default value of 'DebugParams'.
174    , serverDebug             :: DebugParams
175      -- | Server accepts this size of early data in TLS 1.3.
176      -- 0 (or lower) means that the server does not accept early data.
177      --
178      -- Default: 0
179    , serverEarlyDataSize     :: Int
180      -- | Lifetime in seconds for session tickets generated by the server.
181      -- Acceptable value range is 0 to 604800 (7 days).  The default lifetime
182      -- is 86400 seconds (1 day).
183      --
184      -- Default: 86400 (one day)
185    , serverTicketLifetime    :: Int
186    } deriving (Show)
187
188defaultParamsServer :: ServerParams
189defaultParamsServer = ServerParams
190    { serverWantClientCert   = False
191    , serverCACertificates   = []
192    , serverDHEParams        = Nothing
193    , serverHooks            = def
194    , serverShared           = def
195    , serverSupported        = def
196    , serverDebug            = defaultDebugParams
197    , serverEarlyDataSize    = 0
198    , serverTicketLifetime   = 86400
199    }
200
201instance Default ServerParams where
202    def = defaultParamsServer
203
204-- | List all the supported algorithms, versions, ciphers, etc supported.
205data Supported = Supported
206    {
207      -- | Supported versions by this context.  On the client side, the highest
208      -- version will be used to establish the connection.  On the server side,
209      -- the highest version that is less or equal than the client version will
210      -- be chosen.
211      --
212      -- Versions should be listed in preference order, i.e. higher versions
213      -- first.
214      --
215      -- Default: @[TLS13,TLS12,TLS11,TLS10]@
216      supportedVersions       :: [Version]
217      -- | Supported cipher methods.  The default is empty, specify a suitable
218      -- cipher list.  'Network.TLS.Extra.Cipher.ciphersuite_default' is often
219      -- a good choice.
220      --
221      -- Default: @[]@
222    , supportedCiphers        :: [Cipher]
223      -- | Supported compressions methods.  By default only the "null"
224      -- compression is supported, which means no compression will be performed.
225      -- Allowing other compression method is not advised as it causes a
226      -- connection failure when TLS 1.3 is negotiated.
227      --
228      -- Default: @[nullCompression]@
229    , supportedCompressions   :: [Compression]
230      -- | All supported hash/signature algorithms pair for client
231      -- certificate verification and server signature in (EC)DHE,
232      -- ordered by decreasing priority.
233      --
234      -- This list is sent to the peer as part of the "signature_algorithms"
235      -- extension.  It is used to restrict accepted signatures received from
236      -- the peer at TLS level (not in X.509 certificates), but only when the
237      -- TLS version is 1.2 or above.  In order to disable SHA-1 one must then
238      -- also disable earlier protocol versions in 'supportedVersions'.
239      --
240      -- The list also impacts the selection of possible algorithms when
241      -- generating signatures.
242      --
243      -- Note: with TLS 1.3 some algorithms have been deprecated and will not be
244      -- used even when listed in the parameter: MD5, SHA-1, SHA-224, RSA
245      -- PKCS#1, DSS.
246      --
247      -- Default:
248      --
249      -- @
250      --   [ (HashIntrinsic,     SignatureEd448)
251      --   , (HashIntrinsic,     SignatureEd25519)
252      --   , (Struct.HashSHA256, SignatureECDSA)
253      --   , (Struct.HashSHA384, SignatureECDSA)
254      --   , (Struct.HashSHA512, SignatureECDSA)
255      --   , (HashIntrinsic,     SignatureRSApssRSAeSHA512)
256      --   , (HashIntrinsic,     SignatureRSApssRSAeSHA384)
257      --   , (HashIntrinsic,     SignatureRSApssRSAeSHA256)
258      --   , (Struct.HashSHA512, SignatureRSA)
259      --   , (Struct.HashSHA384, SignatureRSA)
260      --   , (Struct.HashSHA256, SignatureRSA)
261      --   , (Struct.HashSHA1,   SignatureRSA)
262      --   , (Struct.HashSHA1,   SignatureDSS)
263      --   ]
264      -- @
265    , supportedHashSignatures :: [HashAndSignatureAlgorithm]
266      -- | Secure renegotiation defined in RFC5746.
267      --   If 'True', clients send the renegotiation_info extension.
268      --   If 'True', servers handle the extension or the renegotiation SCSV
269      --   then send the renegotiation_info extension.
270      --
271      --   Default: 'True'
272    , supportedSecureRenegotiation :: Bool
273      -- | If 'True', renegotiation is allowed from the client side.
274      --   This is vulnerable to DOS attacks.
275      --   If 'False', renegotiation is allowed only from the server side
276      --   via HelloRequest.
277      --
278      --   Default: 'False'
279    , supportedClientInitiatedRenegotiation :: Bool
280      -- | The mode regarding extended master secret.  Enabling this extension
281      -- provides better security for TLS versions 1.0 to 1.2.  TLS 1.3 provides
282      -- the security properties natively and does not need the extension.
283      --
284      -- By default the extension is enabled but not required.  If mode is set
285      -- to 'RequireEMS', the handshake will fail when the peer does not support
286      -- the extension.  It is also advised to disable SSLv3 which does not have
287      -- this mechanism.
288      --
289      -- Default: 'AllowEMS'
290    , supportedExtendedMasterSec   :: EMSMode
291      -- | Set if we support session.
292      --
293      --   Default: 'True'
294    , supportedSession             :: Bool
295      -- | Support for fallback SCSV defined in RFC7507.
296      --   If 'True', servers reject handshakes which suggest
297      --   a lower protocol than the highest protocol supported.
298      --
299      --   Default: 'True'
300    , supportedFallbackScsv        :: Bool
301      -- | In ver <= TLS1.0, block ciphers using CBC are using CBC residue as IV, which can be guessed
302      -- by an attacker. Hence, an empty packet is normally sent before a normal data packet, to
303      -- prevent guessability. Some Microsoft TLS-based protocol implementations, however,
304      -- consider these empty packets as a protocol violation and disconnect. If this parameter is
305      -- 'False', empty packets will never be added, which is less secure, but might help in rare
306      -- cases.
307      --
308      --   Default: 'True'
309    , supportedEmptyPacket         :: Bool
310      -- | A list of supported elliptic curves and finite-field groups in the
311      --   preferred order.
312      --
313      --   The list is sent to the server as part of the "supported_groups"
314      --   extension.  It is used in both clients and servers to restrict
315      --   accepted groups in DH key exchange.  Up until TLS v1.2, it is also
316      --   used by a client to restrict accepted elliptic curves in ECDSA
317      --   signatures.
318      --
319      --   The default value includes all groups with security strength of 128
320      --   bits or more.
321      --
322      --   Default: @[X25519,X448,P256,FFDHE3072,FFDHE4096,P384,FFDHE6144,FFDHE8192,P521]@
323    , supportedGroups              :: [Group]
324    } deriving (Show,Eq)
325
326-- | Client or server policy regarding Extended Master Secret
327data EMSMode
328    = NoEMS       -- ^ Extended Master Secret is not used
329    | AllowEMS    -- ^ Extended Master Secret is allowed
330    | RequireEMS  -- ^ Extended Master Secret is required
331    deriving (Show,Eq)
332
333defaultSupported :: Supported
334defaultSupported = Supported
335    { supportedVersions       = [TLS13,TLS12,TLS11,TLS10]
336    , supportedCiphers        = []
337    , supportedCompressions   = [nullCompression]
338    , supportedHashSignatures = [ (HashIntrinsic,     SignatureEd448)
339                                , (HashIntrinsic,     SignatureEd25519)
340                                , (Struct.HashSHA256, SignatureECDSA)
341                                , (Struct.HashSHA384, SignatureECDSA)
342                                , (Struct.HashSHA512, SignatureECDSA)
343                                , (HashIntrinsic,     SignatureRSApssRSAeSHA512)
344                                , (HashIntrinsic,     SignatureRSApssRSAeSHA384)
345                                , (HashIntrinsic,     SignatureRSApssRSAeSHA256)
346                                , (Struct.HashSHA512, SignatureRSA)
347                                , (Struct.HashSHA384, SignatureRSA)
348                                , (Struct.HashSHA256, SignatureRSA)
349                                , (Struct.HashSHA1,   SignatureRSA)
350                                , (Struct.HashSHA1,   SignatureDSS)
351                                ]
352    , supportedSecureRenegotiation = True
353    , supportedClientInitiatedRenegotiation = False
354    , supportedExtendedMasterSec   = AllowEMS
355    , supportedSession             = True
356    , supportedFallbackScsv        = True
357    , supportedEmptyPacket         = True
358    , supportedGroups              = [X25519,X448,P256,FFDHE3072,FFDHE4096,P384,FFDHE6144,FFDHE8192,P521]
359    }
360
361instance Default Supported where
362    def = defaultSupported
363
364-- | Parameters that are common to clients and servers.
365data Shared = Shared
366    { -- | The list of certificates and private keys that a server will use as
367      -- part of authentication to clients.  Actual credentials that are used
368      -- are selected dynamically from this list based on client capabilities.
369      -- Additional credentials returned by 'onServerNameIndication' are also
370      -- considered.
371      --
372      -- When credential list is left empty (the default value), no key
373      -- exchange can take place.
374      --
375      -- Default: 'mempty'
376      sharedCredentials     :: Credentials
377      -- | Callbacks used by clients and servers in order to resume TLS
378      -- sessions.  The default implementation never resumes sessions.  Package
379      -- <https://hackage.haskell.org/package/tls-session-manager tls-session-manager>
380      -- provides an in-memory implementation.
381      --
382      -- Default: 'noSessionManager'
383    , sharedSessionManager  :: SessionManager
384      -- | A collection of trust anchors to be used by a client as
385      -- part of validation of server certificates.  This is set as
386      -- first argument to function 'onServerCertificate'.  Package
387      -- <https://hackage.haskell.org/package/x509-system x509-system>
388      -- gives access to a default certificate store configured in the
389      -- system.
390      --
391      -- Default: 'mempty'
392    , sharedCAStore         :: CertificateStore
393      -- | Callbacks that may be used by a client to cache certificate
394      -- validation results (positive or negative) and avoid expensive
395      -- signature check.  The default implementation does not have
396      -- any caching.
397      --
398      -- See the default value of 'ValidationCache'.
399    , sharedValidationCache :: ValidationCache
400      -- | Additional extensions to be sent during the Hello sequence.
401      --
402      -- For a client this is always included in message ClientHello.  For a
403      -- server, this is sent in messages ServerHello or EncryptedExtensions
404      -- based on the TLS version.
405      --
406      -- Default: @[]@
407    , sharedHelloExtensions :: [ExtensionRaw]
408    }
409
410instance Show Shared where
411    show _ = "Shared"
412instance Default Shared where
413    def = Shared
414            { sharedCredentials     = mempty
415            , sharedSessionManager  = noSessionManager
416            , sharedCAStore         = mempty
417            , sharedValidationCache = def
418            , sharedHelloExtensions = []
419            }
420
421-- | Group usage callback possible return values.
422data GroupUsage =
423          GroupUsageValid                 -- ^ usage of group accepted
424        | GroupUsageInsecure              -- ^ usage of group provides insufficient security
425        | GroupUsageUnsupported String    -- ^ usage of group rejected for other reason (specified as string)
426        | GroupUsageInvalidPublic         -- ^ usage of group with an invalid public value
427        deriving (Show,Eq)
428
429defaultGroupUsage :: Int -> DHParams -> DHPublic -> IO GroupUsage
430defaultGroupUsage minBits params public
431    | even $ dhParamsGetP params                   = return $ GroupUsageUnsupported "invalid odd prime"
432    | not $ dhValid params (dhParamsGetG params)   = return $ GroupUsageUnsupported "invalid generator"
433    | not $ dhValid params (dhUnwrapPublic public) = return   GroupUsageInvalidPublic
434    -- To prevent Logjam attack
435    | dhParamsGetBits params < minBits             = return   GroupUsageInsecure
436    | otherwise                                    = return   GroupUsageValid
437
438-- | Type for 'onCertificateRequest'. This type synonym is to make
439--   document readable.
440type OnCertificateRequest = ([CertificateType],
441                             Maybe [HashAndSignatureAlgorithm],
442                             [DistinguishedName])
443                           -> IO (Maybe (CertificateChain, PrivKey))
444
445-- | Type for 'onServerCertificate'. This type synonym is to make
446--   document readable.
447type OnServerCertificate = CertificateStore -> ValidationCache -> ServiceID -> CertificateChain -> IO [FailedReason]
448
449-- | A set of callbacks run by the clients for various corners of TLS establishment
450data ClientHooks = ClientHooks
451    { -- | This action is called when the a certificate request is
452      -- received from the server. The callback argument is the
453      -- information from the request.  The server, at its
454      -- discretion, may be willing to continue the handshake
455      -- without a client certificate.  Therefore, the callback is
456      -- free to return 'Nothing' to indicate that no client
457      -- certificate should be sent, despite the server's request.
458      -- In some cases it may be appropriate to get user consent
459      -- before sending the certificate; the content of the user's
460      -- certificate may be sensitive and intended only for
461      -- specific servers.
462      --
463      -- The action should select a certificate chain of one of
464      -- the given certificate types and one of the certificates
465      -- in the chain should (if possible) be signed by one of the
466      -- given distinguished names.  Some servers, that don't have
467      -- a narrow set of preferred issuer CAs, will send an empty
468      -- 'DistinguishedName' list, rather than send all the names
469      -- from their trusted CA bundle.  If the client does not
470      -- have a certificate chaining to a matching CA, it may
471      -- choose a default certificate instead.
472      --
473      -- Each certificate except the last should be signed by the
474      -- following one.  The returned private key must be for the
475      -- first certificates in the chain.  This key will be used
476      -- to signing the certificate verify message.
477      --
478      -- The public key in the first certificate, and the matching
479      -- returned private key must be compatible with one of the
480      -- list of 'HashAndSignatureAlgorithm' value when provided.
481      -- TLS 1.3 changes the meaning of the list elements, adding
482      -- explicit code points for each supported pair of hash and
483      -- signature (public key) algorithms, rather than combining
484      -- separate codes for the hash and key.  For details see
485      -- <https://tools.ietf.org/html/rfc8446#section-4.2.3 RFC 8446>
486      -- section 4.2.3.  When no compatible certificate chain is
487      -- available, return 'Nothing' if it is OK to continue
488      -- without a client certificate.  Returning a non-matching
489      -- certificate should result in a handshake failure.
490      --
491      -- While the TLS version is not provided to the callback,
492      -- the content of the @signature_algorithms@ list provides
493      -- a strong hint, since TLS 1.3 servers will generally list
494      -- RSA pairs with a hash component of 'Intrinsic' (@0x08@).
495      --
496      -- Note that is is the responsibility of this action to
497      -- select a certificate matching one of the requested
498      -- certificate types (public key algorithms).  Returning
499      -- a non-matching one will lead to handshake failure later.
500      --
501      -- Default: returns 'Nothing' anyway.
502      onCertificateRequest :: OnCertificateRequest
503      -- | Used by the client to validate the server certificate.  The default
504      -- implementation calls 'validateDefault' which validates according to the
505      -- default hooks and checks provided by "Data.X509.Validation".  This can
506      -- be replaced with a custom validation function using different settings.
507      --
508      -- The function is not expected to verify the key-usage extension of the
509      -- end-entity certificate, as this depends on the dynamically-selected
510      -- cipher and this part should not be cached.  Key-usage verification
511      -- is performed by the library internally.
512      --
513      -- Default: 'validateDefault'
514    , onServerCertificate  :: OnServerCertificate
515      -- | This action is called when the client sends ClientHello
516      --   to determine ALPN values such as '["h2", "http/1.1"]'.
517      --
518      -- Default: returns 'Nothing'
519    , onSuggestALPN :: IO (Maybe [B.ByteString])
520      -- | This action is called to validate DHE parameters when the server
521      --   selected a finite-field group not part of the "Supported Groups
522      --   Registry" or not part of 'supportedGroups' list.
523      --
524      --   With TLS 1.3 custom groups have been removed from the protocol, so
525      --   this callback is only used when the version negotiated is 1.2 or
526      --   below.
527      --
528      --   The default behavior with (dh_p, dh_g, dh_size) and pub as follows:
529      --
530      --   (1) rejecting if dh_p is even
531      --   (2) rejecting unless 1 < dh_g && dh_g < dh_p - 1
532      --   (3) rejecting unless 1 < dh_p && pub < dh_p - 1
533      --   (4) rejecting if dh_size < 1024 (to prevent Logjam attack)
534      --
535      --   See RFC 7919 section 3.1 for recommandations.
536    , onCustomFFDHEGroup :: DHParams -> DHPublic -> IO GroupUsage
537    }
538
539defaultClientHooks :: ClientHooks
540defaultClientHooks = ClientHooks
541    { onCertificateRequest = \ _ -> return Nothing
542    , onServerCertificate  = validateDefault
543    , onSuggestALPN        = return Nothing
544    , onCustomFFDHEGroup   = defaultGroupUsage 1024
545    }
546
547instance Show ClientHooks where
548    show _ = "ClientHooks"
549instance Default ClientHooks where
550    def = defaultClientHooks
551
552-- | A set of callbacks run by the server for various corners of the TLS establishment
553data ServerHooks = ServerHooks
554    {
555      -- | This action is called when a client certificate chain
556      -- is received from the client.  When it returns a
557      -- CertificateUsageReject value, the handshake is aborted.
558      --
559      -- The function is not expected to verify the key-usage
560      -- extension of the certificate.  This verification is
561      -- performed by the library internally.
562      --
563      -- Default: returns the followings:
564      --
565      -- @
566      -- CertificateUsageReject (CertificateRejectOther "no client certificates expected")
567      -- @
568      onClientCertificate :: CertificateChain -> IO CertificateUsage
569
570      -- | This action is called when the client certificate
571      -- cannot be verified. Return 'True' to accept the certificate
572      -- anyway, or 'False' to fail verification.
573      --
574      -- Default: returns 'False'
575    , onUnverifiedClientCert :: IO Bool
576
577      -- | Allow the server to choose the cipher relative to the
578      -- the client version and the client list of ciphers.
579      --
580      -- This could be useful with old clients and as a workaround
581      -- to the BEAST (where RC4 is sometimes prefered with TLS < 1.1)
582      --
583      -- The client cipher list cannot be empty.
584      --
585      -- Default: taking the head of ciphers.
586    , onCipherChoosing        :: Version -> [Cipher] -> Cipher
587
588      -- | Allow the server to indicate additional credentials
589      -- to be used depending on the host name indicated by the
590      -- client.
591      --
592      -- This is most useful for transparent proxies where
593      -- credentials must be generated on the fly according to
594      -- the host the client is trying to connect to.
595      --
596      -- Returned credentials may be ignored if a client does not support
597      -- the signature algorithms used in the certificate chain.
598      --
599      -- Default: returns 'mempty'
600    , onServerNameIndication  :: Maybe HostName -> IO Credentials
601
602      -- | At each new handshake, we call this hook to see if we allow handshake to happens.
603      --
604      -- Default: returns 'True'
605    , onNewHandshake          :: Measurement -> IO Bool
606
607      -- | Allow the server to choose an application layer protocol
608      --   suggested from the client through the ALPN
609      --   (Application Layer Protocol Negotiation) extensions.
610      --   If the server supports no protocols that the client advertises
611      --   an empty 'ByteString' should be returned.
612      --
613      -- Default: 'Nothing'
614    , onALPNClientSuggest     :: Maybe ([B.ByteString] -> IO B.ByteString)
615    }
616
617defaultServerHooks :: ServerHooks
618defaultServerHooks = ServerHooks
619    { onClientCertificate    = \_ -> return $ CertificateUsageReject $ CertificateRejectOther "no client certificates expected"
620    , onUnverifiedClientCert = return False
621    , onCipherChoosing       = \_ -> head
622    , onServerNameIndication = \_ -> return mempty
623    , onNewHandshake         = \_ -> return True
624    , onALPNClientSuggest    = Nothing
625    }
626
627instance Show ServerHooks where
628    show _ = "ServerHooks"
629instance Default ServerHooks where
630    def = defaultServerHooks
631