{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module      : Network.TLS.Handshake.Signature
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
module Network.TLS.Handshake.Signature
    (
      createCertificateVerify
    , checkCertificateVerify
    , digitallySignDHParams
    , digitallySignECDHParams
    , digitallySignDHParamsVerify
    , digitallySignECDHParamsVerify
    , checkSupportedHashSignature
    , certificateCompatible
    , signatureCompatible
    , signatureCompatible13
    , hashSigToCertType
    , signatureParams
    , decryptError
    ) where

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

import Control.Monad.State.Strict

decryptError :: MonadIO m => String -> m a
decryptError :: String -> m a
decryptError String
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
$ (String, Bool, AlertDescription) -> TLSError
Error_Protocol (String
msg, Bool
True, 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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CertificateType]
cTypes
certificateCompatible (PubKeyDSA PublicKey
_)      [CertificateType]
cTypes = CertificateType
CertificateType_DSS_Sign CertificateType -> [CertificateType] -> 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 (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
SignatureDSS)              = 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
SignatureDSS)   = CertificateType -> Maybe CertificateType
forall a. a -> Maybe a
Just CertificateType
CertificateType_DSS_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 Maybe HashAndSignatureAlgorithm
hashSigAlg ByteString
_) =
    case (Version
usedVersion, Maybe HashAndSignatureAlgorithm
hashSigAlg) of
        (Version
TLS12, Maybe HashAndSignatureAlgorithm
Nothing)    -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        (Version
TLS12, Just HashAndSignatureAlgorithm
hs) | PubKey
pubKey PubKey -> HashAndSignatureAlgorithm -> Bool
`signatureCompatible` HashAndSignatureAlgorithm
hs -> IO Bool
doVerify
                         | Bool
otherwise                       -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        (Version
_,     Maybe HashAndSignatureAlgorithm
Nothing)    -> IO Bool
doVerify
        (Version
_,     Just HashAndSignatureAlgorithm
_)     -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  where
    doVerify :: IO Bool
doVerify =
        Context
-> Version
-> PubKey
-> Maybe HashAndSignatureAlgorithm
-> ByteString
-> IO CertVerifyData
prepareCertificateVerifySignatureData Context
ctx Version
usedVersion PubKey
pubKey Maybe HashAndSignatureAlgorithm
hashSigAlg ByteString
msgs IO CertVerifyData -> (CertVerifyData -> IO Bool) -> IO Bool
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
                        -> Maybe HashAndSignatureAlgorithm -- TLS12 only
                        -> ByteString
                        -> IO DigitallySigned
createCertificateVerify :: Context
-> Version
-> PubKey
-> Maybe HashAndSignatureAlgorithm
-> ByteString
-> IO DigitallySigned
createCertificateVerify Context
ctx Version
usedVersion PubKey
pubKey Maybe HashAndSignatureAlgorithm
hashSigAlg ByteString
msgs =
    Context
-> Version
-> PubKey
-> Maybe HashAndSignatureAlgorithm
-> ByteString
-> IO CertVerifyData
prepareCertificateVerifySignatureData Context
ctx Version
usedVersion PubKey
pubKey Maybe HashAndSignatureAlgorithm
hashSigAlg ByteString
msgs IO CertVerifyData
-> (CertVerifyData -> IO DigitallySigned) -> IO DigitallySigned
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    Context
-> Maybe HashAndSignatureAlgorithm
-> CertVerifyData
-> IO DigitallySigned
signatureCreateWithCertVerifyData Context
ctx Maybe 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
                                      -> Maybe HashAndSignatureAlgorithm -- TLS12 only
                                      -> ByteString
                                      -> IO CertVerifyData
prepareCertificateVerifySignatureData :: Context
-> Version
-> PubKey
-> Maybe HashAndSignatureAlgorithm
-> ByteString
-> IO CertVerifyData
prepareCertificateVerifySignatureData Context
ctx Version
usedVersion PubKey
pubKey Maybe HashAndSignatureAlgorithm
hashSigAlg ByteString
msgs
    | Version
usedVersion Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
SSL3 = do
        (HashCtx
hashCtx, SignatureParams
params, ByteString -> HashCtx -> ByteString
generateCV_SSL) <-
            case PubKey
pubKey of
                PubKeyRSA PublicKey
_ -> (HashCtx, SignatureParams, ByteString -> HashCtx -> ByteString)
-> IO
     (HashCtx, SignatureParams, ByteString -> HashCtx -> ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Hash -> HashCtx
hashInit Hash
SHA1_MD5, Hash -> RSAEncoding -> SignatureParams
RSAParams Hash
SHA1_MD5 RSAEncoding
RSApkcs1, ByteString -> HashCtx -> ByteString
generateCertificateVerify_SSL)
                PubKeyDSA PublicKey
_ -> (HashCtx, SignatureParams, ByteString -> HashCtx -> ByteString)
-> IO
     (HashCtx, SignatureParams, ByteString -> HashCtx -> ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Hash -> HashCtx
hashInit Hash
SHA1, SignatureParams
DSSParams, ByteString -> HashCtx -> ByteString
generateCertificateVerify_SSL_DSS)
                PubKey
_           -> TLSError
-> IO
     (HashCtx, SignatureParams, ByteString -> HashCtx -> ByteString)
forall (m :: * -> *) a. MonadIO m => TLSError -> m a
throwCore (TLSError
 -> IO
      (HashCtx, SignatureParams, ByteString -> HashCtx -> ByteString))
-> TLSError
-> IO
     (HashCtx, SignatureParams, ByteString -> HashCtx -> ByteString)
forall a b. (a -> b) -> a -> b
$ String -> TLSError
Error_Misc (String
"unsupported CertificateVerify signature for SSL3: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PubKey -> String
pubkeyType PubKey
pubKey)
        Just ByteString
masterSecret <- Context -> HandshakeM (Maybe ByteString) -> IO (Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx (HandshakeM (Maybe ByteString) -> IO (Maybe ByteString))
-> HandshakeM (Maybe ByteString) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ (HandshakeState -> Maybe ByteString)
-> HandshakeM (Maybe ByteString)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> Maybe ByteString
hstMasterSecret
        CertVerifyData -> IO CertVerifyData
forall (m :: * -> *) a. Monad m => a -> m a
return (SignatureParams
params, ByteString -> HashCtx -> ByteString
generateCV_SSL ByteString
masterSecret (HashCtx -> ByteString) -> HashCtx -> ByteString
forall a b. (a -> b) -> a -> b
$ HashCtx -> ByteString -> HashCtx
hashUpdate HashCtx
hashCtx ByteString
msgs)
    | Version
usedVersion Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
TLS10 Bool -> Bool -> Bool
|| Version
usedVersion Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
TLS11 =
            CertVerifyData -> IO CertVerifyData
forall (m :: * -> *) a. Monad m => a -> m a
return (CertVerifyData -> IO CertVerifyData)
-> CertVerifyData -> IO CertVerifyData
forall a b. (a -> b) -> a -> b
$ SignatureParams -> ByteString -> CertVerifyData
buildVerifyData (PubKey -> Maybe HashAndSignatureAlgorithm -> SignatureParams
signatureParams PubKey
pubKey Maybe HashAndSignatureAlgorithm
forall a. Maybe a
Nothing) ByteString
msgs
    | Bool
otherwise = CertVerifyData -> IO CertVerifyData
forall (m :: * -> *) a. Monad m => a -> m a
return (PubKey -> Maybe HashAndSignatureAlgorithm -> SignatureParams
signatureParams PubKey
pubKey Maybe HashAndSignatureAlgorithm
hashSigAlg, ByteString
msgs)

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

signatureCreateWithCertVerifyData :: Context
                                  -> Maybe HashAndSignatureAlgorithm
                                  -> CertVerifyData
                                  -> IO DigitallySigned
signatureCreateWithCertVerifyData :: Context
-> Maybe HashAndSignatureAlgorithm
-> CertVerifyData
-> IO DigitallySigned
signatureCreateWithCertVerifyData Context
ctx Maybe HashAndSignatureAlgorithm
malg (SignatureParams
sigParam, ByteString
toSign) = do
    Role
cc <- Context -> TLSSt Role -> IO Role
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt Role
isClientContext
    Maybe HashAndSignatureAlgorithm -> ByteString -> DigitallySigned
DigitallySigned Maybe 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
cc 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 Maybe 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, Maybe HashAndSignatureAlgorithm
hashSigAlg) of
                (Version
TLS12, Maybe HashAndSignatureAlgorithm
Nothing)    -> String -> CertVerifyData
forall a. HasCallStack => String -> a
error String
"expecting hash and signature algorithm in a TLS12 digitally signed structure"
                (Version
TLS12, Just HashAndSignatureAlgorithm
hs) | PubKey
pubKey PubKey -> HashAndSignatureAlgorithm -> Bool
`signatureCompatible` HashAndSignatureAlgorithm
hs -> (PubKey -> Maybe HashAndSignatureAlgorithm -> SignatureParams
signatureParams PubKey
pubKey Maybe HashAndSignatureAlgorithm
hashSigAlg, ByteString
toVerifyData)
                                 | Bool
otherwise                       -> String -> CertVerifyData
forall a. HasCallStack => String -> a
error String
"expecting different signature algorithm"
                (Version
_,     Maybe HashAndSignatureAlgorithm
Nothing)    -> SignatureParams -> ByteString -> CertVerifyData
buildVerifyData (PubKey -> Maybe HashAndSignatureAlgorithm -> SignatureParams
signatureParams PubKey
pubKey Maybe HashAndSignatureAlgorithm
forall a. Maybe a
Nothing) ByteString
toVerifyData
                (Version
_,     Just HashAndSignatureAlgorithm
_)     -> String -> CertVerifyData
forall a. HasCallStack => String -> a
error String
"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 Maybe HashAndSignatureAlgorithm
hs ByteString
bs) (SignatureParams
sigParam, ByteString
toVerify) = do
    Context -> Maybe HashAndSignatureAlgorithm -> IO ()
checkSupportedHashSignature Context
ctx Maybe HashAndSignatureAlgorithm
hs
    Context -> SignatureParams -> ByteString -> ByteString -> IO Bool
verifyPublic Context
ctx SignatureParams
sigParam ByteString
toVerify ByteString
bs

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

digitallySignDHParams :: Context
                      -> ServerDHParams
                      -> PubKey
                      -> Maybe HashAndSignatureAlgorithm -- TLS12 only
                      -> IO DigitallySigned
digitallySignDHParams :: Context
-> ServerDHParams
-> PubKey
-> Maybe HashAndSignatureAlgorithm
-> IO DigitallySigned
digitallySignDHParams Context
ctx ServerDHParams
serverParams PubKey
pubKey Maybe 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
-> Maybe HashAndSignatureAlgorithm
-> IO DigitallySigned
digitallySignParams Context
ctx ByteString
dhParamsData PubKey
pubKey Maybe HashAndSignatureAlgorithm
mhash

digitallySignECDHParams :: Context
                        -> ServerECDHParams
                        -> PubKey
                        -> Maybe HashAndSignatureAlgorithm -- TLS12 only
                        -> IO DigitallySigned
digitallySignECDHParams :: Context
-> ServerECDHParams
-> PubKey
-> Maybe HashAndSignatureAlgorithm
-> IO DigitallySigned
digitallySignECDHParams Context
ctx ServerECDHParams
serverParams PubKey
pubKey Maybe 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
-> Maybe HashAndSignatureAlgorithm
-> IO DigitallySigned
digitallySignParams Context
ctx ByteString
ecdhParamsData PubKey
pubKey Maybe 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 :: 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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Maybe ServerRandom -> ServerRandom
forall a. String -> Maybe a -> a
fromJust String
"withClientAndServer : server random" (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 (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 -> Maybe HashAndSignatureAlgorithm -> IO ()
checkSupportedHashSignature :: Context -> Maybe HashAndSignatureAlgorithm -> IO ()
checkSupportedHashSignature Context
_   Maybe HashAndSignatureAlgorithm
Nothing   = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkSupportedHashSignature Context
ctx (Just HashAndSignatureAlgorithm
hs) =
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HashAndSignatureAlgorithm
hs HashAndSignatureAlgorithm -> [HashAndSignatureAlgorithm] -> 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 :: String
msg = String
"unsupported hash and signature algorithm: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HashAndSignatureAlgorithm -> String
forall a. Show a => a -> String
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
$ (String, Bool, AlertDescription) -> TLSError
Error_Protocol (String
msg, Bool
True, AlertDescription
IllegalParameter)