{-# LANGUAGE OverloadedStrings #-}

module Network.TLS.Handshake.Signature (
    createCertificateVerify,
    checkCertificateVerify,
    digitallySignDHParams,
    digitallySignECDHParams,
    digitallySignDHParamsVerify,
    digitallySignECDHParamsVerify,
    checkSupportedHashSignature,
    certificateCompatible,
    signatureCompatible,
    signatureCompatible13,
    hashSigToCertType,
    signatureParams,
    decryptError,
) where

import Control.Monad.State.Strict

import Network.TLS.Context.Internal
import Network.TLS.Crypto
import Network.TLS.Handshake.Key
import Network.TLS.Handshake.State
import Network.TLS.Imports
import Network.TLS.Packet (
    encodeSignedDHParams,
    encodeSignedECDHParams,
 )
import Network.TLS.Parameters
import Network.TLS.State
import Network.TLS.Struct
import Network.TLS.X509

decryptError :: MonadIO m => String -> m a
decryptError :: forall (m :: * -> *) a. MonadIO m => [Char] -> m a
decryptError [Char]
msg = TLSError -> m a
forall (m :: * -> *) a. MonadIO m => TLSError -> m a
throwCore (TLSError -> m a) -> TLSError -> m a
forall a b. (a -> b) -> a -> b
$ [Char] -> AlertDescription -> TLSError
Error_Protocol [Char]
msg AlertDescription
DecryptError

-- | Check that the key is compatible with a list of 'CertificateType' values.
-- Ed25519 and Ed448 have no assigned code point and are checked with extension
-- "signature_algorithms" only.
certificateCompatible :: PubKey -> [CertificateType] -> Bool
certificateCompatible :: PubKey -> [CertificateType] -> Bool
certificateCompatible (PubKeyRSA PublicKey
_) [CertificateType]
cTypes = CertificateType
CertificateType_RSA_Sign CertificateType -> [CertificateType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CertificateType]
cTypes
certificateCompatible (PubKeyDSA PublicKey
_) [CertificateType]
cTypes = CertificateType
CertificateType_DSA_Sign CertificateType -> [CertificateType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CertificateType]
cTypes
certificateCompatible (PubKeyEC PubKeyEC
_) [CertificateType]
cTypes = CertificateType
CertificateType_ECDSA_Sign CertificateType -> [CertificateType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CertificateType]
cTypes
certificateCompatible (PubKeyEd25519 PublicKey
_) [CertificateType]
_ = Bool
True
certificateCompatible (PubKeyEd448 PublicKey
_) [CertificateType]
_ = Bool
True
certificateCompatible PubKey
_ [CertificateType]
_ = Bool
False

signatureCompatible :: PubKey -> HashAndSignatureAlgorithm -> Bool
signatureCompatible :: PubKey -> HashAndSignatureAlgorithm -> Bool
signatureCompatible (PubKeyRSA PublicKey
pk) (HashAlgorithm
HashSHA1, SignatureAlgorithm
SignatureRSA) = PublicKey -> Hash -> Bool
kxCanUseRSApkcs1 PublicKey
pk Hash
SHA1
signatureCompatible (PubKeyRSA PublicKey
pk) (HashAlgorithm
HashSHA256, SignatureAlgorithm
SignatureRSA) = PublicKey -> Hash -> Bool
kxCanUseRSApkcs1 PublicKey
pk Hash
SHA256
signatureCompatible (PubKeyRSA PublicKey
pk) (HashAlgorithm
HashSHA384, SignatureAlgorithm
SignatureRSA) = PublicKey -> Hash -> Bool
kxCanUseRSApkcs1 PublicKey
pk Hash
SHA384
signatureCompatible (PubKeyRSA PublicKey
pk) (HashAlgorithm
HashSHA512, SignatureAlgorithm
SignatureRSA) = PublicKey -> Hash -> Bool
kxCanUseRSApkcs1 PublicKey
pk Hash
SHA512
signatureCompatible (PubKeyRSA PublicKey
pk) (HashAlgorithm
_, SignatureAlgorithm
SignatureRSApssRSAeSHA256) = PublicKey -> Hash -> Bool
kxCanUseRSApss PublicKey
pk Hash
SHA256
signatureCompatible (PubKeyRSA PublicKey
pk) (HashAlgorithm
_, SignatureAlgorithm
SignatureRSApssRSAeSHA384) = PublicKey -> Hash -> Bool
kxCanUseRSApss PublicKey
pk Hash
SHA384
signatureCompatible (PubKeyRSA PublicKey
pk) (HashAlgorithm
_, SignatureAlgorithm
SignatureRSApssRSAeSHA512) = PublicKey -> Hash -> Bool
kxCanUseRSApss PublicKey
pk Hash
SHA512
signatureCompatible (PubKeyDSA PublicKey
_) (HashAlgorithm
_, SignatureAlgorithm
SignatureDSA) = Bool
True
signatureCompatible (PubKeyEC PubKeyEC
_) (HashAlgorithm
_, SignatureAlgorithm
SignatureECDSA) = Bool
True
signatureCompatible (PubKeyEd25519 PublicKey
_) (HashAlgorithm
_, SignatureAlgorithm
SignatureEd25519) = Bool
True
signatureCompatible (PubKeyEd448 PublicKey
_) (HashAlgorithm
_, SignatureAlgorithm
SignatureEd448) = Bool
True
signatureCompatible PubKey
_ (HashAlgorithm
_, SignatureAlgorithm
_) = Bool
False

-- Same as 'signatureCompatible' but for TLS13: for ECDSA this also checks the
-- relation between hash in the HashAndSignatureAlgorithm and elliptic curve
signatureCompatible13 :: PubKey -> HashAndSignatureAlgorithm -> Bool
signatureCompatible13 :: PubKey -> HashAndSignatureAlgorithm -> Bool
signatureCompatible13 (PubKeyEC PubKeyEC
ecPub) (HashAlgorithm
h, SignatureAlgorithm
SignatureECDSA) =
    Bool -> (Group -> Bool) -> Maybe Group -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\Group
g -> PubKeyEC -> Maybe Group
findEllipticCurveGroup PubKeyEC
ecPub Maybe Group -> Maybe Group -> Bool
forall a. Eq a => a -> a -> Bool
== Group -> Maybe Group
forall a. a -> Maybe a
Just Group
g) (HashAlgorithm -> Maybe Group
hashCurve HashAlgorithm
h)
  where
    hashCurve :: HashAlgorithm -> Maybe Group
hashCurve HashAlgorithm
HashSHA256 = Group -> Maybe Group
forall a. a -> Maybe a
Just Group
P256
    hashCurve HashAlgorithm
HashSHA384 = Group -> Maybe Group
forall a. a -> Maybe a
Just Group
P384
    hashCurve HashAlgorithm
HashSHA512 = Group -> Maybe Group
forall a. a -> Maybe a
Just Group
P521
    hashCurve HashAlgorithm
_ = Maybe Group
forall a. Maybe a
Nothing
signatureCompatible13 PubKey
pub HashAndSignatureAlgorithm
hs = PubKey -> HashAndSignatureAlgorithm -> Bool
signatureCompatible PubKey
pub HashAndSignatureAlgorithm
hs

-- | Translate a 'HashAndSignatureAlgorithm' to an acceptable 'CertificateType'.
-- Perhaps this needs to take supported groups into account, so that, for
-- example, if we don't support any shared ECDSA groups with the server, we
-- return 'Nothing' rather than 'CertificateType_ECDSA_Sign'.
--
-- Therefore, this interface is preliminary.  It gets us moving in the right
-- direction.  The interplay between all the various TLS extensions and
-- certificate selection is rather complex.
--
-- The goal is to ensure that the client certificate request callback only sees
-- 'CertificateType' values that are supported by the library and also
-- compatible with the server signature algorithms extension.
--
-- Since we don't yet support ECDSA private keys, the caller will use
-- 'lastSupportedCertificateType' to filter those out for now, leaving just
-- @RSA@ as the only supported client certificate algorithm for TLS 1.3.
--
-- FIXME: Add RSA_PSS_PSS signatures when supported.
hashSigToCertType :: HashAndSignatureAlgorithm -> Maybe CertificateType
--
hashSigToCertType :: HashAndSignatureAlgorithm -> Maybe CertificateType
hashSigToCertType (HashAlgorithm
_, SignatureAlgorithm
SignatureRSA) = CertificateType -> Maybe CertificateType
forall a. a -> Maybe a
Just CertificateType
CertificateType_RSA_Sign
--
hashSigToCertType (HashAlgorithm
_, SignatureAlgorithm
SignatureDSA) = CertificateType -> Maybe CertificateType
forall a. a -> Maybe a
Just CertificateType
CertificateType_DSA_Sign
--
hashSigToCertType (HashAlgorithm
_, SignatureAlgorithm
SignatureECDSA) = CertificateType -> Maybe CertificateType
forall a. a -> Maybe a
Just CertificateType
CertificateType_ECDSA_Sign
--
hashSigToCertType (HashAlgorithm
HashIntrinsic, SignatureAlgorithm
SignatureRSApssRSAeSHA256) =
    CertificateType -> Maybe CertificateType
forall a. a -> Maybe a
Just CertificateType
CertificateType_RSA_Sign
hashSigToCertType (HashAlgorithm
HashIntrinsic, SignatureAlgorithm
SignatureRSApssRSAeSHA384) =
    CertificateType -> Maybe CertificateType
forall a. a -> Maybe a
Just CertificateType
CertificateType_RSA_Sign
hashSigToCertType (HashAlgorithm
HashIntrinsic, SignatureAlgorithm
SignatureRSApssRSAeSHA512) =
    CertificateType -> Maybe CertificateType
forall a. a -> Maybe a
Just CertificateType
CertificateType_RSA_Sign
hashSigToCertType (HashAlgorithm
HashIntrinsic, SignatureAlgorithm
SignatureEd25519) =
    CertificateType -> Maybe CertificateType
forall a. a -> Maybe a
Just CertificateType
CertificateType_Ed25519_Sign
hashSigToCertType (HashAlgorithm
HashIntrinsic, SignatureAlgorithm
SignatureEd448) =
    CertificateType -> Maybe CertificateType
forall a. a -> Maybe a
Just CertificateType
CertificateType_Ed448_Sign
--
hashSigToCertType HashAndSignatureAlgorithm
_ = Maybe CertificateType
forall a. Maybe a
Nothing

checkCertificateVerify
    :: Context
    -> Version
    -> PubKey
    -> ByteString
    -> DigitallySigned
    -> IO Bool
checkCertificateVerify :: Context
-> Version -> PubKey -> ByteString -> DigitallySigned -> IO Bool
checkCertificateVerify Context
ctx Version
usedVersion PubKey
pubKey ByteString
msgs digSig :: DigitallySigned
digSig@(DigitallySigned HashAndSignatureAlgorithm
hashSigAlg ByteString
_)
    | PubKey
pubKey PubKey -> HashAndSignatureAlgorithm -> Bool
`signatureCompatible` HashAndSignatureAlgorithm
hashSigAlg = IO Bool
doVerify
    | Bool
otherwise = Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  where
    doVerify :: IO Bool
doVerify =
        Context
-> Version
-> PubKey
-> HashAndSignatureAlgorithm
-> ByteString
-> IO CertVerifyData
prepareCertificateVerifySignatureData Context
ctx Version
usedVersion PubKey
pubKey HashAndSignatureAlgorithm
hashSigAlg ByteString
msgs
            IO CertVerifyData -> (CertVerifyData -> IO Bool) -> IO Bool
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Context -> DigitallySigned -> CertVerifyData -> IO Bool
signatureVerifyWithCertVerifyData Context
ctx DigitallySigned
digSig

createCertificateVerify
    :: Context
    -> Version
    -> PubKey
    -> HashAndSignatureAlgorithm -- TLS12 only
    -> ByteString
    -> IO DigitallySigned
createCertificateVerify :: Context
-> Version
-> PubKey
-> HashAndSignatureAlgorithm
-> ByteString
-> IO DigitallySigned
createCertificateVerify Context
ctx Version
usedVersion PubKey
pubKey HashAndSignatureAlgorithm
hashSigAlg ByteString
msgs =
    Context
-> Version
-> PubKey
-> HashAndSignatureAlgorithm
-> ByteString
-> IO CertVerifyData
prepareCertificateVerifySignatureData Context
ctx Version
usedVersion PubKey
pubKey HashAndSignatureAlgorithm
hashSigAlg ByteString
msgs
        IO CertVerifyData
-> (CertVerifyData -> IO DigitallySigned) -> IO DigitallySigned
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Context
-> HashAndSignatureAlgorithm
-> CertVerifyData
-> IO DigitallySigned
signatureCreateWithCertVerifyData Context
ctx HashAndSignatureAlgorithm
hashSigAlg

type CertVerifyData = (SignatureParams, ByteString)

-- in the case of TLS < 1.2, RSA signing, then the data need to be hashed first, as
-- the SHA1_MD5 algorithm expect an already digested data
buildVerifyData :: SignatureParams -> ByteString -> CertVerifyData
buildVerifyData :: SignatureParams -> ByteString -> CertVerifyData
buildVerifyData (RSAParams Hash
SHA1_MD5 RSAEncoding
enc) ByteString
bs = (Hash -> RSAEncoding -> SignatureParams
RSAParams Hash
SHA1_MD5 RSAEncoding
enc, HashCtx -> ByteString
hashFinal (HashCtx -> ByteString) -> HashCtx -> ByteString
forall a b. (a -> b) -> a -> b
$ HashCtx -> ByteString -> HashCtx
hashUpdate (Hash -> HashCtx
hashInit Hash
SHA1_MD5) ByteString
bs)
buildVerifyData SignatureParams
sigParam ByteString
bs = (SignatureParams
sigParam, ByteString
bs)

prepareCertificateVerifySignatureData
    :: Context
    -> Version
    -> PubKey
    -> HashAndSignatureAlgorithm -- TLS12 only
    -> ByteString
    -> IO CertVerifyData
prepareCertificateVerifySignatureData :: Context
-> Version
-> PubKey
-> HashAndSignatureAlgorithm
-> ByteString
-> IO CertVerifyData
prepareCertificateVerifySignatureData Context
_ctx Version
_usedVersion PubKey
pubKey HashAndSignatureAlgorithm
hashSigAlg ByteString
msgs =
    CertVerifyData -> IO CertVerifyData
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PubKey -> HashAndSignatureAlgorithm -> SignatureParams
signatureParams PubKey
pubKey HashAndSignatureAlgorithm
hashSigAlg, ByteString
msgs)

signatureParams :: PubKey -> HashAndSignatureAlgorithm -> SignatureParams
signatureParams :: PubKey -> HashAndSignatureAlgorithm -> SignatureParams
signatureParams (PubKeyRSA PublicKey
_) HashAndSignatureAlgorithm
hashSigAlg =
    case HashAndSignatureAlgorithm
hashSigAlg of
        (HashAlgorithm
HashSHA512, SignatureAlgorithm
SignatureRSA) -> Hash -> RSAEncoding -> SignatureParams
RSAParams Hash
SHA512 RSAEncoding
RSApkcs1
        (HashAlgorithm
HashSHA384, SignatureAlgorithm
SignatureRSA) -> Hash -> RSAEncoding -> SignatureParams
RSAParams Hash
SHA384 RSAEncoding
RSApkcs1
        (HashAlgorithm
HashSHA256, SignatureAlgorithm
SignatureRSA) -> Hash -> RSAEncoding -> SignatureParams
RSAParams Hash
SHA256 RSAEncoding
RSApkcs1
        (HashAlgorithm
HashSHA1, SignatureAlgorithm
SignatureRSA) -> Hash -> RSAEncoding -> SignatureParams
RSAParams Hash
SHA1 RSAEncoding
RSApkcs1
        (HashAlgorithm
HashIntrinsic, SignatureAlgorithm
SignatureRSApssRSAeSHA512) -> Hash -> RSAEncoding -> SignatureParams
RSAParams Hash
SHA512 RSAEncoding
RSApss
        (HashAlgorithm
HashIntrinsic, SignatureAlgorithm
SignatureRSApssRSAeSHA384) -> Hash -> RSAEncoding -> SignatureParams
RSAParams Hash
SHA384 RSAEncoding
RSApss
        (HashAlgorithm
HashIntrinsic, SignatureAlgorithm
SignatureRSApssRSAeSHA256) -> Hash -> RSAEncoding -> SignatureParams
RSAParams Hash
SHA256 RSAEncoding
RSApss
        (HashAlgorithm
hsh, SignatureAlgorithm
SignatureRSA) -> [Char] -> SignatureParams
forall a. HasCallStack => [Char] -> a
error ([Char]
"unimplemented RSA signature hash type: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ HashAlgorithm -> [Char]
forall a. Show a => a -> [Char]
show HashAlgorithm
hsh)
        (HashAlgorithm
_, SignatureAlgorithm
sigAlg) ->
            [Char] -> SignatureParams
forall a. HasCallStack => [Char] -> a
error ([Char]
"signature algorithm is incompatible with RSA: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SignatureAlgorithm -> [Char]
forall a. Show a => a -> [Char]
show SignatureAlgorithm
sigAlg)
signatureParams (PubKeyDSA PublicKey
_) HashAndSignatureAlgorithm
hashSigAlg =
    case HashAndSignatureAlgorithm
hashSigAlg of
        (HashAlgorithm
HashSHA1, SignatureAlgorithm
SignatureDSA) -> SignatureParams
DSAParams
        (HashAlgorithm
_, SignatureAlgorithm
SignatureDSA) -> [Char] -> SignatureParams
forall a. HasCallStack => [Char] -> a
error [Char]
"invalid DSA hash choice, only SHA1 allowed"
        (HashAlgorithm
_, SignatureAlgorithm
sigAlg) ->
            [Char] -> SignatureParams
forall a. HasCallStack => [Char] -> a
error ([Char]
"signature algorithm is incompatible with DSA: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SignatureAlgorithm -> [Char]
forall a. Show a => a -> [Char]
show SignatureAlgorithm
sigAlg)
signatureParams (PubKeyEC PubKeyEC
_) HashAndSignatureAlgorithm
hashSigAlg =
    case HashAndSignatureAlgorithm
hashSigAlg of
        (HashAlgorithm
HashSHA512, SignatureAlgorithm
SignatureECDSA) -> Hash -> SignatureParams
ECDSAParams Hash
SHA512
        (HashAlgorithm
HashSHA384, SignatureAlgorithm
SignatureECDSA) -> Hash -> SignatureParams
ECDSAParams Hash
SHA384
        (HashAlgorithm
HashSHA256, SignatureAlgorithm
SignatureECDSA) -> Hash -> SignatureParams
ECDSAParams Hash
SHA256
        (HashAlgorithm
HashSHA1, SignatureAlgorithm
SignatureECDSA) -> Hash -> SignatureParams
ECDSAParams Hash
SHA1
        (HashAlgorithm
hsh, SignatureAlgorithm
SignatureECDSA) -> [Char] -> SignatureParams
forall a. HasCallStack => [Char] -> a
error ([Char]
"unimplemented ECDSA signature hash type: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ HashAlgorithm -> [Char]
forall a. Show a => a -> [Char]
show HashAlgorithm
hsh)
        (HashAlgorithm
_, SignatureAlgorithm
sigAlg) ->
            [Char] -> SignatureParams
forall a. HasCallStack => [Char] -> a
error ([Char]
"signature algorithm is incompatible with ECDSA: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SignatureAlgorithm -> [Char]
forall a. Show a => a -> [Char]
show SignatureAlgorithm
sigAlg)
signatureParams (PubKeyEd25519 PublicKey
_) HashAndSignatureAlgorithm
hashSigAlg =
    case HashAndSignatureAlgorithm
hashSigAlg of
        (HashAlgorithm
HashIntrinsic, SignatureAlgorithm
SignatureEd25519) -> SignatureParams
Ed25519Params
        (HashAlgorithm
hsh, SignatureAlgorithm
SignatureEd25519) -> [Char] -> SignatureParams
forall a. HasCallStack => [Char] -> a
error ([Char]
"unimplemented Ed25519 signature hash type: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ HashAlgorithm -> [Char]
forall a. Show a => a -> [Char]
show HashAlgorithm
hsh)
        (HashAlgorithm
_, SignatureAlgorithm
sigAlg) ->
            [Char] -> SignatureParams
forall a. HasCallStack => [Char] -> a
error ([Char]
"signature algorithm is incompatible with Ed25519: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SignatureAlgorithm -> [Char]
forall a. Show a => a -> [Char]
show SignatureAlgorithm
sigAlg)
signatureParams (PubKeyEd448 PublicKey
_) HashAndSignatureAlgorithm
hashSigAlg =
    case HashAndSignatureAlgorithm
hashSigAlg of
        (HashAlgorithm
HashIntrinsic, SignatureAlgorithm
SignatureEd448) -> SignatureParams
Ed448Params
        (HashAlgorithm
hsh, SignatureAlgorithm
SignatureEd448) -> [Char] -> SignatureParams
forall a. HasCallStack => [Char] -> a
error ([Char]
"unimplemented Ed448 signature hash type: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ HashAlgorithm -> [Char]
forall a. Show a => a -> [Char]
show HashAlgorithm
hsh)
        (HashAlgorithm
_, SignatureAlgorithm
sigAlg) ->
            [Char] -> SignatureParams
forall a. HasCallStack => [Char] -> a
error ([Char]
"signature algorithm is incompatible with Ed448: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SignatureAlgorithm -> [Char]
forall a. Show a => a -> [Char]
show SignatureAlgorithm
sigAlg)
signatureParams PubKey
pk HashAndSignatureAlgorithm
_ = [Char] -> SignatureParams
forall a. HasCallStack => [Char] -> a
error ([Char]
"signatureParams: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PubKey -> [Char]
pubkeyType PubKey
pk [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" is not supported")

signatureCreateWithCertVerifyData
    :: Context
    -> HashAndSignatureAlgorithm
    -> CertVerifyData
    -> IO DigitallySigned
signatureCreateWithCertVerifyData :: Context
-> HashAndSignatureAlgorithm
-> CertVerifyData
-> IO DigitallySigned
signatureCreateWithCertVerifyData Context
ctx HashAndSignatureAlgorithm
malg (SignatureParams
sigParam, ByteString
toSign) = do
    Role
role <- Context -> TLSSt Role -> IO Role
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt Role
getRole
    HashAndSignatureAlgorithm -> ByteString -> DigitallySigned
DigitallySigned HashAndSignatureAlgorithm
malg (ByteString -> DigitallySigned)
-> IO ByteString -> IO DigitallySigned
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> Role -> SignatureParams -> ByteString -> IO ByteString
signPrivate Context
ctx Role
role SignatureParams
sigParam ByteString
toSign

signatureVerify :: Context -> DigitallySigned -> PubKey -> ByteString -> IO Bool
signatureVerify :: Context -> DigitallySigned -> PubKey -> ByteString -> IO Bool
signatureVerify Context
ctx digSig :: DigitallySigned
digSig@(DigitallySigned HashAndSignatureAlgorithm
hashSigAlg ByteString
_) PubKey
pubKey ByteString
toVerifyData = do
    Version
usedVersion <- Context -> TLSSt Version -> IO Version
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt Version
getVersion
    let (SignatureParams
sigParam, ByteString
toVerify) =
            case (Version
usedVersion, HashAndSignatureAlgorithm
hashSigAlg) of
                (Version
TLS12, HashAndSignatureAlgorithm
hs)
                    | PubKey
pubKey PubKey -> HashAndSignatureAlgorithm -> Bool
`signatureCompatible` HashAndSignatureAlgorithm
hs ->
                        (PubKey -> HashAndSignatureAlgorithm -> SignatureParams
signatureParams PubKey
pubKey HashAndSignatureAlgorithm
hashSigAlg, ByteString
toVerifyData)
                    | Bool
otherwise ->
                        [Char] -> CertVerifyData
forall a. HasCallStack => [Char] -> a
error [Char]
"expecting different signature algorithm"
                (Version, HashAndSignatureAlgorithm)
_ ->
                    [Char] -> CertVerifyData
forall a. HasCallStack => [Char] -> a
error
                        [Char]
"not expecting hash and signature algorithm in a < TLS12 digitially signed structure"
    Context -> DigitallySigned -> CertVerifyData -> IO Bool
signatureVerifyWithCertVerifyData Context
ctx DigitallySigned
digSig (SignatureParams
sigParam, ByteString
toVerify)

signatureVerifyWithCertVerifyData
    :: Context
    -> DigitallySigned
    -> CertVerifyData
    -> IO Bool
signatureVerifyWithCertVerifyData :: Context -> DigitallySigned -> CertVerifyData -> IO Bool
signatureVerifyWithCertVerifyData Context
ctx (DigitallySigned HashAndSignatureAlgorithm
hs ByteString
bs) (SignatureParams
sigParam, ByteString
toVerify) = do
    Context -> HashAndSignatureAlgorithm -> IO ()
checkSupportedHashSignature Context
ctx HashAndSignatureAlgorithm
hs
    Context -> SignatureParams -> ByteString -> ByteString -> IO Bool
verifyPublic Context
ctx SignatureParams
sigParam ByteString
toVerify ByteString
bs

digitallySignParams
    :: Context
    -> ByteString
    -> PubKey
    -> HashAndSignatureAlgorithm
    -> IO DigitallySigned
digitallySignParams :: Context
-> ByteString
-> PubKey
-> HashAndSignatureAlgorithm
-> IO DigitallySigned
digitallySignParams Context
ctx ByteString
signatureData PubKey
pubKey HashAndSignatureAlgorithm
hashSigAlg =
    let sigParam :: SignatureParams
sigParam = PubKey -> HashAndSignatureAlgorithm -> SignatureParams
signatureParams PubKey
pubKey HashAndSignatureAlgorithm
hashSigAlg
     in Context
-> HashAndSignatureAlgorithm
-> CertVerifyData
-> IO DigitallySigned
signatureCreateWithCertVerifyData
            Context
ctx
            HashAndSignatureAlgorithm
hashSigAlg
            (SignatureParams -> ByteString -> CertVerifyData
buildVerifyData SignatureParams
sigParam ByteString
signatureData)

digitallySignDHParams
    :: Context
    -> ServerDHParams
    -> PubKey
    -> HashAndSignatureAlgorithm -- TLS12 only
    -> IO DigitallySigned
digitallySignDHParams :: Context
-> ServerDHParams
-> PubKey
-> HashAndSignatureAlgorithm
-> IO DigitallySigned
digitallySignDHParams Context
ctx ServerDHParams
serverParams PubKey
pubKey HashAndSignatureAlgorithm
mhash = do
    ByteString
dhParamsData <-
        Context
-> (ClientRandom -> ServerRandom -> ByteString) -> IO ByteString
forall b. Context -> (ClientRandom -> ServerRandom -> b) -> IO b
withClientAndServerRandom Context
ctx ((ClientRandom -> ServerRandom -> ByteString) -> IO ByteString)
-> (ClientRandom -> ServerRandom -> ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ServerDHParams -> ClientRandom -> ServerRandom -> ByteString
encodeSignedDHParams ServerDHParams
serverParams
    Context
-> ByteString
-> PubKey
-> HashAndSignatureAlgorithm
-> IO DigitallySigned
digitallySignParams Context
ctx ByteString
dhParamsData PubKey
pubKey HashAndSignatureAlgorithm
mhash

digitallySignECDHParams
    :: Context
    -> ServerECDHParams
    -> PubKey
    -> HashAndSignatureAlgorithm -- TLS12 only
    -> IO DigitallySigned
digitallySignECDHParams :: Context
-> ServerECDHParams
-> PubKey
-> HashAndSignatureAlgorithm
-> IO DigitallySigned
digitallySignECDHParams Context
ctx ServerECDHParams
serverParams PubKey
pubKey HashAndSignatureAlgorithm
mhash = do
    ByteString
ecdhParamsData <-
        Context
-> (ClientRandom -> ServerRandom -> ByteString) -> IO ByteString
forall b. Context -> (ClientRandom -> ServerRandom -> b) -> IO b
withClientAndServerRandom Context
ctx ((ClientRandom -> ServerRandom -> ByteString) -> IO ByteString)
-> (ClientRandom -> ServerRandom -> ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ServerECDHParams -> ClientRandom -> ServerRandom -> ByteString
encodeSignedECDHParams ServerECDHParams
serverParams
    Context
-> ByteString
-> PubKey
-> HashAndSignatureAlgorithm
-> IO DigitallySigned
digitallySignParams Context
ctx ByteString
ecdhParamsData PubKey
pubKey HashAndSignatureAlgorithm
mhash

digitallySignDHParamsVerify
    :: Context
    -> ServerDHParams
    -> PubKey
    -> DigitallySigned
    -> IO Bool
digitallySignDHParamsVerify :: Context -> ServerDHParams -> PubKey -> DigitallySigned -> IO Bool
digitallySignDHParamsVerify Context
ctx ServerDHParams
dhparams PubKey
pubKey DigitallySigned
signature = do
    ByteString
expectedData <- Context
-> (ClientRandom -> ServerRandom -> ByteString) -> IO ByteString
forall b. Context -> (ClientRandom -> ServerRandom -> b) -> IO b
withClientAndServerRandom Context
ctx ((ClientRandom -> ServerRandom -> ByteString) -> IO ByteString)
-> (ClientRandom -> ServerRandom -> ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ServerDHParams -> ClientRandom -> ServerRandom -> ByteString
encodeSignedDHParams ServerDHParams
dhparams
    Context -> DigitallySigned -> PubKey -> ByteString -> IO Bool
signatureVerify Context
ctx DigitallySigned
signature PubKey
pubKey ByteString
expectedData

digitallySignECDHParamsVerify
    :: Context
    -> ServerECDHParams
    -> PubKey
    -> DigitallySigned
    -> IO Bool
digitallySignECDHParamsVerify :: Context -> ServerECDHParams -> PubKey -> DigitallySigned -> IO Bool
digitallySignECDHParamsVerify Context
ctx ServerECDHParams
dhparams PubKey
pubKey DigitallySigned
signature = do
    ByteString
expectedData <- Context
-> (ClientRandom -> ServerRandom -> ByteString) -> IO ByteString
forall b. Context -> (ClientRandom -> ServerRandom -> b) -> IO b
withClientAndServerRandom Context
ctx ((ClientRandom -> ServerRandom -> ByteString) -> IO ByteString)
-> (ClientRandom -> ServerRandom -> ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ServerECDHParams -> ClientRandom -> ServerRandom -> ByteString
encodeSignedECDHParams ServerECDHParams
dhparams
    Context -> DigitallySigned -> PubKey -> ByteString -> IO Bool
signatureVerify Context
ctx DigitallySigned
signature PubKey
pubKey ByteString
expectedData

withClientAndServerRandom
    :: Context -> (ClientRandom -> ServerRandom -> b) -> IO b
withClientAndServerRandom :: forall b. Context -> (ClientRandom -> ServerRandom -> b) -> IO b
withClientAndServerRandom Context
ctx ClientRandom -> ServerRandom -> b
f = do
    (ClientRandom
cran, ServerRandom
sran) <-
        Context
-> HandshakeM (ClientRandom, ServerRandom)
-> IO (ClientRandom, ServerRandom)
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx (HandshakeM (ClientRandom, ServerRandom)
 -> IO (ClientRandom, ServerRandom))
-> HandshakeM (ClientRandom, ServerRandom)
-> IO (ClientRandom, ServerRandom)
forall a b. (a -> b) -> a -> b
$
            (,)
                (ClientRandom -> ServerRandom -> (ClientRandom, ServerRandom))
-> HandshakeM ClientRandom
-> HandshakeM (ServerRandom -> (ClientRandom, ServerRandom))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HandshakeState -> ClientRandom) -> HandshakeM ClientRandom
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> ClientRandom
hstClientRandom
                HandshakeM (ServerRandom -> (ClientRandom, ServerRandom))
-> HandshakeM ServerRandom
-> HandshakeM (ClientRandom, ServerRandom)
forall a b. HandshakeM (a -> b) -> HandshakeM a -> HandshakeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe ServerRandom -> ServerRandom
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ServerRandom -> ServerRandom)
-> HandshakeM (Maybe ServerRandom) -> HandshakeM ServerRandom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HandshakeState -> Maybe ServerRandom)
-> HandshakeM (Maybe ServerRandom)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> Maybe ServerRandom
hstServerRandom)
    b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> IO b) -> b -> IO b
forall a b. (a -> b) -> a -> b
$ ClientRandom -> ServerRandom -> b
f ClientRandom
cran ServerRandom
sran

-- verify that the hash and signature selected by the peer is supported in
-- the local configuration
checkSupportedHashSignature
    :: Context -> HashAndSignatureAlgorithm -> IO ()
checkSupportedHashSignature :: Context -> HashAndSignatureAlgorithm -> IO ()
checkSupportedHashSignature Context
ctx HashAndSignatureAlgorithm
hs =
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HashAndSignatureAlgorithm
hs HashAndSignatureAlgorithm -> [HashAndSignatureAlgorithm] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Supported -> [HashAndSignatureAlgorithm]
supportedHashSignatures (Context -> Supported
ctxSupported Context
ctx)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        let msg :: [Char]
msg = [Char]
"unsupported hash and signature algorithm: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ HashAndSignatureAlgorithm -> [Char]
forall a. Show a => a -> [Char]
show HashAndSignatureAlgorithm
hs
         in TLSError -> IO ()
forall (m :: * -> *) a. MonadIO m => TLSError -> m a
throwCore (TLSError -> IO ()) -> TLSError -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> AlertDescription -> TLSError
Error_Protocol [Char]
msg AlertDescription
IllegalParameter