module Network.TLS.Parameters
(
ClientParams(..)
, ServerParams(..)
, CommonParams
, DebugParams(..)
, ClientHooks(..)
, OnCertificateRequest
, OnServerCertificate
, ServerHooks(..)
, Supported(..)
, Shared(..)
, defaultParamsClient
, MaxFragmentEnum(..)
, EMSMode(..)
, GroupUsage(..)
, CertificateUsage(..)
, CertificateRejectReason(..)
) where
import Network.TLS.Extension
import Network.TLS.Struct
import qualified Network.TLS.Struct as Struct
import Network.TLS.Session
import Network.TLS.Cipher
import Network.TLS.Measurement
import Network.TLS.Compression
import Network.TLS.Crypto
import Network.TLS.Credentials
import Network.TLS.X509
import Network.TLS.RNG (Seed)
import Network.TLS.Imports
import Network.TLS.Types (HostName)
import Data.Default.Class
import qualified Data.ByteString as B
type CommonParams = (Supported, Shared, DebugParams)
data DebugParams = DebugParams
{
DebugParams -> Maybe Seed
debugSeed :: Maybe Seed
, DebugParams -> Seed -> IO ()
debugPrintSeed :: Seed -> IO ()
, DebugParams -> Maybe Version
debugVersionForced :: Maybe Version
, DebugParams -> String -> IO ()
debugKeyLogger :: String -> IO ()
}
defaultDebugParams :: DebugParams
defaultDebugParams :: DebugParams
defaultDebugParams = DebugParams
{ debugSeed :: Maybe Seed
debugSeed = forall a. Maybe a
Nothing
, debugPrintSeed :: Seed -> IO ()
debugPrintSeed = forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return ())
, debugVersionForced :: Maybe Version
debugVersionForced = forall a. Maybe a
Nothing
, debugKeyLogger :: String -> IO ()
debugKeyLogger = \String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
}
instance Show DebugParams where
show :: DebugParams -> String
show DebugParams
_ = String
"DebugParams"
instance Default DebugParams where
def :: DebugParams
def = DebugParams
defaultDebugParams
data ClientParams = ClientParams
{
ClientParams -> Maybe MaxFragmentEnum
clientUseMaxFragmentLength :: Maybe MaxFragmentEnum
, ClientParams -> (String, ByteString)
clientServerIdentification :: (HostName, ByteString)
, ClientParams -> Bool
clientUseServerNameIndication :: Bool
, ClientParams -> Maybe (ByteString, SessionData)
clientWantSessionResume :: Maybe (SessionID, SessionData)
, ClientParams -> Shared
clientShared :: Shared
, ClientParams -> ClientHooks
clientHooks :: ClientHooks
, ClientParams -> Supported
clientSupported :: Supported
, ClientParams -> DebugParams
clientDebug :: DebugParams
, ClientParams -> Maybe ByteString
clientEarlyData :: Maybe ByteString
} deriving (Int -> ClientParams -> ShowS
[ClientParams] -> ShowS
ClientParams -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientParams] -> ShowS
$cshowList :: [ClientParams] -> ShowS
show :: ClientParams -> String
$cshow :: ClientParams -> String
showsPrec :: Int -> ClientParams -> ShowS
$cshowsPrec :: Int -> ClientParams -> ShowS
Show)
defaultParamsClient :: HostName -> ByteString -> ClientParams
defaultParamsClient :: String -> ByteString -> ClientParams
defaultParamsClient String
serverName ByteString
serverId = ClientParams
{ clientUseMaxFragmentLength :: Maybe MaxFragmentEnum
clientUseMaxFragmentLength = forall a. Maybe a
Nothing
, clientServerIdentification :: (String, ByteString)
clientServerIdentification = (String
serverName, ByteString
serverId)
, clientUseServerNameIndication :: Bool
clientUseServerNameIndication = Bool
True
, clientWantSessionResume :: Maybe (ByteString, SessionData)
clientWantSessionResume = forall a. Maybe a
Nothing
, clientShared :: Shared
clientShared = forall a. Default a => a
def
, clientHooks :: ClientHooks
clientHooks = forall a. Default a => a
def
, clientSupported :: Supported
clientSupported = forall a. Default a => a
def
, clientDebug :: DebugParams
clientDebug = DebugParams
defaultDebugParams
, clientEarlyData :: Maybe ByteString
clientEarlyData = forall a. Maybe a
Nothing
}
data ServerParams = ServerParams
{
ServerParams -> Bool
serverWantClientCert :: Bool
, ServerParams -> [SignedCertificate]
serverCACertificates :: [SignedCertificate]
, ServerParams -> Maybe DHParams
serverDHEParams :: Maybe DHParams
, ServerParams -> ServerHooks
serverHooks :: ServerHooks
, ServerParams -> Shared
serverShared :: Shared
, ServerParams -> Supported
serverSupported :: Supported
, ServerParams -> DebugParams
serverDebug :: DebugParams
, ServerParams -> Int
serverEarlyDataSize :: Int
, ServerParams -> Int
serverTicketLifetime :: Int
} deriving (Int -> ServerParams -> ShowS
[ServerParams] -> ShowS
ServerParams -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServerParams] -> ShowS
$cshowList :: [ServerParams] -> ShowS
show :: ServerParams -> String
$cshow :: ServerParams -> String
showsPrec :: Int -> ServerParams -> ShowS
$cshowsPrec :: Int -> ServerParams -> ShowS
Show)
defaultParamsServer :: ServerParams
defaultParamsServer :: ServerParams
defaultParamsServer = ServerParams
{ serverWantClientCert :: Bool
serverWantClientCert = Bool
False
, serverCACertificates :: [SignedCertificate]
serverCACertificates = []
, serverDHEParams :: Maybe DHParams
serverDHEParams = forall a. Maybe a
Nothing
, serverHooks :: ServerHooks
serverHooks = forall a. Default a => a
def
, serverShared :: Shared
serverShared = forall a. Default a => a
def
, serverSupported :: Supported
serverSupported = forall a. Default a => a
def
, serverDebug :: DebugParams
serverDebug = DebugParams
defaultDebugParams
, serverEarlyDataSize :: Int
serverEarlyDataSize = Int
0
, serverTicketLifetime :: Int
serverTicketLifetime = Int
86400
}
instance Default ServerParams where
def :: ServerParams
def = ServerParams
defaultParamsServer
data Supported = Supported
{
Supported -> [Version]
supportedVersions :: [Version]
, Supported -> [Cipher]
supportedCiphers :: [Cipher]
, Supported -> [Compression]
supportedCompressions :: [Compression]
, Supported -> [HashAndSignatureAlgorithm]
supportedHashSignatures :: [HashAndSignatureAlgorithm]
, Supported -> Bool
supportedSecureRenegotiation :: Bool
, Supported -> Bool
supportedClientInitiatedRenegotiation :: Bool
, Supported -> EMSMode
supportedExtendedMasterSec :: EMSMode
, Supported -> Bool
supportedSession :: Bool
, Supported -> Bool
supportedFallbackScsv :: Bool
, Supported -> Bool
supportedEmptyPacket :: Bool
, Supported -> [Group]
supportedGroups :: [Group]
} deriving (Int -> Supported -> ShowS
[Supported] -> ShowS
Supported -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Supported] -> ShowS
$cshowList :: [Supported] -> ShowS
show :: Supported -> String
$cshow :: Supported -> String
showsPrec :: Int -> Supported -> ShowS
$cshowsPrec :: Int -> Supported -> ShowS
Show,Supported -> Supported -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Supported -> Supported -> Bool
$c/= :: Supported -> Supported -> Bool
== :: Supported -> Supported -> Bool
$c== :: Supported -> Supported -> Bool
Eq)
data EMSMode
= NoEMS
| AllowEMS
| RequireEMS
deriving (Int -> EMSMode -> ShowS
[EMSMode] -> ShowS
EMSMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EMSMode] -> ShowS
$cshowList :: [EMSMode] -> ShowS
show :: EMSMode -> String
$cshow :: EMSMode -> String
showsPrec :: Int -> EMSMode -> ShowS
$cshowsPrec :: Int -> EMSMode -> ShowS
Show,EMSMode -> EMSMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EMSMode -> EMSMode -> Bool
$c/= :: EMSMode -> EMSMode -> Bool
== :: EMSMode -> EMSMode -> Bool
$c== :: EMSMode -> EMSMode -> Bool
Eq)
defaultSupported :: Supported
defaultSupported :: Supported
defaultSupported = Supported
{ supportedVersions :: [Version]
supportedVersions = [Version
TLS13,Version
TLS12,Version
TLS11,Version
TLS10]
, supportedCiphers :: [Cipher]
supportedCiphers = []
, supportedCompressions :: [Compression]
supportedCompressions = [Compression
nullCompression]
, supportedHashSignatures :: [HashAndSignatureAlgorithm]
supportedHashSignatures = [ (HashAlgorithm
HashIntrinsic, SignatureAlgorithm
SignatureEd448)
, (HashAlgorithm
HashIntrinsic, SignatureAlgorithm
SignatureEd25519)
, (HashAlgorithm
Struct.HashSHA256, SignatureAlgorithm
SignatureECDSA)
, (HashAlgorithm
Struct.HashSHA384, SignatureAlgorithm
SignatureECDSA)
, (HashAlgorithm
Struct.HashSHA512, SignatureAlgorithm
SignatureECDSA)
, (HashAlgorithm
HashIntrinsic, SignatureAlgorithm
SignatureRSApssRSAeSHA512)
, (HashAlgorithm
HashIntrinsic, SignatureAlgorithm
SignatureRSApssRSAeSHA384)
, (HashAlgorithm
HashIntrinsic, SignatureAlgorithm
SignatureRSApssRSAeSHA256)
, (HashAlgorithm
Struct.HashSHA512, SignatureAlgorithm
SignatureRSA)
, (HashAlgorithm
Struct.HashSHA384, SignatureAlgorithm
SignatureRSA)
, (HashAlgorithm
Struct.HashSHA256, SignatureAlgorithm
SignatureRSA)
, (HashAlgorithm
Struct.HashSHA1, SignatureAlgorithm
SignatureRSA)
, (HashAlgorithm
Struct.HashSHA1, SignatureAlgorithm
SignatureDSS)
]
, supportedSecureRenegotiation :: Bool
supportedSecureRenegotiation = Bool
True
, supportedClientInitiatedRenegotiation :: Bool
supportedClientInitiatedRenegotiation = Bool
False
, supportedExtendedMasterSec :: EMSMode
supportedExtendedMasterSec = EMSMode
AllowEMS
, supportedSession :: Bool
supportedSession = Bool
True
, supportedFallbackScsv :: Bool
supportedFallbackScsv = Bool
True
, supportedEmptyPacket :: Bool
supportedEmptyPacket = Bool
True
, supportedGroups :: [Group]
supportedGroups = [Group
X25519,Group
X448,Group
P256,Group
FFDHE3072,Group
FFDHE4096,Group
P384,Group
FFDHE6144,Group
FFDHE8192,Group
P521]
}
instance Default Supported where
def :: Supported
def = Supported
defaultSupported
data Shared = Shared
{
Shared -> Credentials
sharedCredentials :: Credentials
, Shared -> SessionManager
sharedSessionManager :: SessionManager
, Shared -> CertificateStore
sharedCAStore :: CertificateStore
, Shared -> ValidationCache
sharedValidationCache :: ValidationCache
, Shared -> [ExtensionRaw]
sharedHelloExtensions :: [ExtensionRaw]
}
instance Show Shared where
show :: Shared -> String
show Shared
_ = String
"Shared"
instance Default Shared where
def :: Shared
def = Shared
{ sharedCredentials :: Credentials
sharedCredentials = forall a. Monoid a => a
mempty
, sharedSessionManager :: SessionManager
sharedSessionManager = SessionManager
noSessionManager
, sharedCAStore :: CertificateStore
sharedCAStore = forall a. Monoid a => a
mempty
, sharedValidationCache :: ValidationCache
sharedValidationCache = forall a. Default a => a
def
, sharedHelloExtensions :: [ExtensionRaw]
sharedHelloExtensions = []
}
data GroupUsage =
GroupUsageValid
| GroupUsageInsecure
| GroupUsageUnsupported String
| GroupUsageInvalidPublic
deriving (Int -> GroupUsage -> ShowS
[GroupUsage] -> ShowS
GroupUsage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupUsage] -> ShowS
$cshowList :: [GroupUsage] -> ShowS
show :: GroupUsage -> String
$cshow :: GroupUsage -> String
showsPrec :: Int -> GroupUsage -> ShowS
$cshowsPrec :: Int -> GroupUsage -> ShowS
Show,GroupUsage -> GroupUsage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupUsage -> GroupUsage -> Bool
$c/= :: GroupUsage -> GroupUsage -> Bool
== :: GroupUsage -> GroupUsage -> Bool
$c== :: GroupUsage -> GroupUsage -> Bool
Eq)
defaultGroupUsage :: Int -> DHParams -> DHPublic -> IO GroupUsage
defaultGroupUsage :: Int -> DHParams -> DHPublic -> IO GroupUsage
defaultGroupUsage Int
minBits DHParams
params DHPublic
public
| forall a. Integral a => a -> Bool
even forall a b. (a -> b) -> a -> b
$ DHParams -> Integer
dhParamsGetP DHParams
params = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> GroupUsage
GroupUsageUnsupported String
"invalid odd prime"
| Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ DHParams -> Integer -> Bool
dhValid DHParams
params (DHParams -> Integer
dhParamsGetG DHParams
params) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> GroupUsage
GroupUsageUnsupported String
"invalid generator"
| Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ DHParams -> Integer -> Bool
dhValid DHParams
params (DHPublic -> Integer
dhUnwrapPublic DHPublic
public) = forall (m :: * -> *) a. Monad m => a -> m a
return GroupUsage
GroupUsageInvalidPublic
| DHParams -> Int
dhParamsGetBits DHParams
params forall a. Ord a => a -> a -> Bool
< Int
minBits = forall (m :: * -> *) a. Monad m => a -> m a
return GroupUsage
GroupUsageInsecure
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return GroupUsage
GroupUsageValid
type OnCertificateRequest = ([CertificateType],
Maybe [HashAndSignatureAlgorithm],
[DistinguishedName])
-> IO (Maybe (CertificateChain, PrivKey))
type OnServerCertificate = CertificateStore -> ValidationCache -> ServiceID -> CertificateChain -> IO [FailedReason]
data ClientHooks = ClientHooks
{
ClientHooks -> OnCertificateRequest
onCertificateRequest :: OnCertificateRequest
, ClientHooks -> OnServerCertificate
onServerCertificate :: OnServerCertificate
, ClientHooks -> IO (Maybe [ByteString])
onSuggestALPN :: IO (Maybe [B.ByteString])
, ClientHooks -> DHParams -> DHPublic -> IO GroupUsage
onCustomFFDHEGroup :: DHParams -> DHPublic -> IO GroupUsage
}
defaultClientHooks :: ClientHooks
defaultClientHooks :: ClientHooks
defaultClientHooks = ClientHooks
{ onCertificateRequest :: OnCertificateRequest
onCertificateRequest = \ ([CertificateType], Maybe [HashAndSignatureAlgorithm],
[DistinguishedName])
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
, onServerCertificate :: OnServerCertificate
onServerCertificate = OnServerCertificate
validateDefault
, onSuggestALPN :: IO (Maybe [ByteString])
onSuggestALPN = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
, onCustomFFDHEGroup :: DHParams -> DHPublic -> IO GroupUsage
onCustomFFDHEGroup = Int -> DHParams -> DHPublic -> IO GroupUsage
defaultGroupUsage Int
1024
}
instance Show ClientHooks where
show :: ClientHooks -> String
show ClientHooks
_ = String
"ClientHooks"
instance Default ClientHooks where
def :: ClientHooks
def = ClientHooks
defaultClientHooks
data ServerHooks = ServerHooks
{
ServerHooks -> CertificateChain -> IO CertificateUsage
onClientCertificate :: CertificateChain -> IO CertificateUsage
, ServerHooks -> IO Bool
onUnverifiedClientCert :: IO Bool
, ServerHooks -> Version -> [Cipher] -> Cipher
onCipherChoosing :: Version -> [Cipher] -> Cipher
, ServerHooks -> Maybe String -> IO Credentials
onServerNameIndication :: Maybe HostName -> IO Credentials
, ServerHooks -> Measurement -> IO Bool
onNewHandshake :: Measurement -> IO Bool
, ServerHooks -> Maybe ([ByteString] -> IO ByteString)
onALPNClientSuggest :: Maybe ([B.ByteString] -> IO B.ByteString)
, ServerHooks -> [ExtensionRaw] -> IO [ExtensionRaw]
onEncryptedExtensionsCreating :: [ExtensionRaw] -> IO [ExtensionRaw]
}
defaultServerHooks :: ServerHooks
defaultServerHooks :: ServerHooks
defaultServerHooks = ServerHooks
{ onClientCertificate :: CertificateChain -> IO CertificateUsage
onClientCertificate = \CertificateChain
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CertificateRejectReason -> CertificateUsage
CertificateUsageReject forall a b. (a -> b) -> a -> b
$ String -> CertificateRejectReason
CertificateRejectOther String
"no client certificates expected"
, onUnverifiedClientCert :: IO Bool
onUnverifiedClientCert = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
, onCipherChoosing :: Version -> [Cipher] -> Cipher
onCipherChoosing = \Version
_ -> forall a. [a] -> a
head
, onServerNameIndication :: Maybe String -> IO Credentials
onServerNameIndication = \Maybe String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
, onNewHandshake :: Measurement -> IO Bool
onNewHandshake = \Measurement
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
, onALPNClientSuggest :: Maybe ([ByteString] -> IO ByteString)
onALPNClientSuggest = forall a. Maybe a
Nothing
, onEncryptedExtensionsCreating :: [ExtensionRaw] -> IO [ExtensionRaw]
onEncryptedExtensionsCreating = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> a
id
}
instance Show ServerHooks where
show :: ServerHooks -> String
show ServerHooks
_ = String
"ServerHooks"
instance Default ServerHooks where
def :: ServerHooks
def = ServerHooks
defaultServerHooks