{-# 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 msg :: String
msg = TLSError -> m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> 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 _)      cTypes :: [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 _)      cTypes :: [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 _)       cTypes :: [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 _)  _      = Bool
True
certificateCompatible (PubKeyEd448 _)    _      = Bool
True
certificateCompatible _                  _      = Bool
False

signatureCompatible :: PubKey -> HashAndSignatureAlgorithm -> Bool
signatureCompatible :: PubKey -> HashAndSignatureAlgorithm -> Bool
signatureCompatible (PubKeyRSA pk :: PublicKey
pk)      (HashSHA1,   SignatureRSA)     = PublicKey -> Hash -> Bool
kxCanUseRSApkcs1 PublicKey
pk Hash
SHA1
signatureCompatible (PubKeyRSA pk :: PublicKey
pk)      (HashSHA256, SignatureRSA)     = PublicKey -> Hash -> Bool
kxCanUseRSApkcs1 PublicKey
pk Hash
SHA256
signatureCompatible (PubKeyRSA pk :: PublicKey
pk)      (HashSHA384, SignatureRSA)     = PublicKey -> Hash -> Bool
kxCanUseRSApkcs1 PublicKey
pk Hash
SHA384
signatureCompatible (PubKeyRSA pk :: PublicKey
pk)      (HashSHA512, SignatureRSA)     = PublicKey -> Hash -> Bool
kxCanUseRSApkcs1 PublicKey
pk Hash
SHA512
signatureCompatible (PubKeyRSA pk :: PublicKey
pk)      (_, SignatureRSApssRSAeSHA256) = PublicKey -> Hash -> Bool
kxCanUseRSApss PublicKey
pk Hash
SHA256
signatureCompatible (PubKeyRSA pk :: PublicKey
pk)      (_, SignatureRSApssRSAeSHA384) = PublicKey -> Hash -> Bool
kxCanUseRSApss PublicKey
pk Hash
SHA384
signatureCompatible (PubKeyRSA pk :: PublicKey
pk)      (_, SignatureRSApssRSAeSHA512) = PublicKey -> Hash -> Bool
kxCanUseRSApss PublicKey
pk Hash
SHA512
signatureCompatible (PubKeyDSA _)       (_, SignatureDSS)              = Bool
True
signatureCompatible (PubKeyEC _)        (_, SignatureECDSA)            = Bool
True
signatureCompatible (PubKeyEd25519 _)   (_, SignatureEd25519)          = Bool
True
signatureCompatible (PubKeyEd448 _)     (_, SignatureEd448)            = Bool
True
signatureCompatible _                   (_, _)                         = 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 ecPub :: PubKeyEC
ecPub) (h :: HashAlgorithm
h, SignatureECDSA) =
    Bool -> (Group -> Bool) -> Maybe Group -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\g :: 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 HashSHA256 = Group -> Maybe Group
forall a. a -> Maybe a
Just Group
P256
    hashCurve HashSHA384 = Group -> Maybe Group
forall a. a -> Maybe a
Just Group
P384
    hashCurve HashSHA512 = Group -> Maybe Group
forall a. a -> Maybe a
Just Group
P521
    hashCurve _          = Maybe Group
forall a. Maybe a
Nothing
signatureCompatible13 pub :: PubKey
pub hs :: 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 (_, SignatureRSA)   = CertificateType -> Maybe CertificateType
forall a. a -> Maybe a
Just CertificateType
CertificateType_RSA_Sign
--
hashSigToCertType (_, SignatureDSS)   = CertificateType -> Maybe CertificateType
forall a. a -> Maybe a
Just CertificateType
CertificateType_DSS_Sign
--
hashSigToCertType (_, SignatureECDSA) = CertificateType -> Maybe CertificateType
forall a. a -> Maybe a
Just CertificateType
CertificateType_ECDSA_Sign
--
hashSigToCertType (HashIntrinsic, SignatureRSApssRSAeSHA256)
    = CertificateType -> Maybe CertificateType
forall a. a -> Maybe a
Just CertificateType
CertificateType_RSA_Sign
hashSigToCertType (HashIntrinsic, SignatureRSApssRSAeSHA384)
    = CertificateType -> Maybe CertificateType
forall a. a -> Maybe a
Just CertificateType
CertificateType_RSA_Sign
hashSigToCertType (HashIntrinsic, SignatureRSApssRSAeSHA512)
    = CertificateType -> Maybe CertificateType
forall a. a -> Maybe a
Just CertificateType
CertificateType_RSA_Sign
hashSigToCertType (HashIntrinsic, SignatureEd25519)
    = CertificateType -> Maybe CertificateType
forall a. a -> Maybe a
Just CertificateType
CertificateType_Ed25519_Sign
hashSigToCertType (HashIntrinsic, SignatureEd448)
    = CertificateType -> Maybe CertificateType
forall a. a -> Maybe a
Just CertificateType
CertificateType_Ed448_Sign
--
hashSigToCertType _ = Maybe CertificateType
forall a. Maybe a
Nothing

checkCertificateVerify :: Context
                       -> Version
                       -> PubKey
                       -> ByteString
                       -> DigitallySigned
                       -> IO Bool
checkCertificateVerify :: Context
-> Version -> PubKey -> ByteString -> DigitallySigned -> IO Bool
checkCertificateVerify ctx :: Context
ctx usedVersion :: Version
usedVersion pubKey :: PubKey
pubKey msgs :: ByteString
msgs digSig :: DigitallySigned
digSig@(DigitallySigned hashSigAlg :: Maybe HashAndSignatureAlgorithm
hashSigAlg _) =
    case (Version
usedVersion, Maybe HashAndSignatureAlgorithm
hashSigAlg) of
        (TLS12, Nothing)    -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        (TLS12, Just hs :: 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
        (_,     Nothing)    -> IO Bool
doVerify
        (_,     Just _)     -> 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 ctx :: Context
ctx usedVersion :: Version
usedVersion pubKey :: PubKey
pubKey hashSigAlg :: Maybe HashAndSignatureAlgorithm
hashSigAlg msgs :: 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 SHA1_MD5 enc :: RSAEncoding
enc) bs :: 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 sigParam :: SignatureParams
sigParam             bs :: 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 ctx :: Context
ctx usedVersion :: Version
usedVersion pubKey :: PubKey
pubKey hashSigAlg :: Maybe HashAndSignatureAlgorithm
hashSigAlg msgs :: ByteString
msgs
    | Version
usedVersion Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
SSL3 = do
        (hashCtx :: HashCtx
hashCtx, params :: SignatureParams
params, generateCV_SSL :: ByteString -> HashCtx -> ByteString
generateCV_SSL) <-
            case PubKey
pubKey of
                PubKeyRSA _ -> (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 _ -> (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)
                _           -> TLSError
-> IO
     (HashCtx, SignatureParams, ByteString -> HashCtx -> ByteString)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> 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 ("unsupported CertificateVerify signature for SSL3: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PubKey -> String
pubkeyType PubKey
pubKey)
        Just masterSecret :: 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 _) hashSigAlg :: Maybe HashAndSignatureAlgorithm
hashSigAlg =
    case Maybe HashAndSignatureAlgorithm
hashSigAlg of
        Just (HashSHA512, SignatureRSA) -> Hash -> RSAEncoding -> SignatureParams
RSAParams Hash
SHA512   RSAEncoding
RSApkcs1
        Just (HashSHA384, SignatureRSA) -> Hash -> RSAEncoding -> SignatureParams
RSAParams Hash
SHA384   RSAEncoding
RSApkcs1
        Just (HashSHA256, SignatureRSA) -> Hash -> RSAEncoding -> SignatureParams
RSAParams Hash
SHA256   RSAEncoding
RSApkcs1
        Just (HashSHA1  , SignatureRSA) -> Hash -> RSAEncoding -> SignatureParams
RSAParams Hash
SHA1     RSAEncoding
RSApkcs1
        Just (HashIntrinsic , SignatureRSApssRSAeSHA512) -> Hash -> RSAEncoding -> SignatureParams
RSAParams Hash
SHA512 RSAEncoding
RSApss
        Just (HashIntrinsic , SignatureRSApssRSAeSHA384) -> Hash -> RSAEncoding -> SignatureParams
RSAParams Hash
SHA384 RSAEncoding
RSApss
        Just (HashIntrinsic , SignatureRSApssRSAeSHA256) -> Hash -> RSAEncoding -> SignatureParams
RSAParams Hash
SHA256 RSAEncoding
RSApss
        Nothing                         -> Hash -> RSAEncoding -> SignatureParams
RSAParams Hash
SHA1_MD5 RSAEncoding
RSApkcs1
        Just (hsh :: HashAlgorithm
hsh       , SignatureRSA) -> String -> SignatureParams
forall a. HasCallStack => String -> a
error ("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 (_         , sigAlg :: SignatureAlgorithm
sigAlg)       -> String -> SignatureParams
forall a. HasCallStack => String -> a
error ("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 _) hashSigAlg :: Maybe HashAndSignatureAlgorithm
hashSigAlg =
    case Maybe HashAndSignatureAlgorithm
hashSigAlg of
        Nothing                       -> SignatureParams
DSSParams
        Just (HashSHA1, SignatureDSS) -> SignatureParams
DSSParams
        Just (_       , SignatureDSS) -> String -> SignatureParams
forall a. HasCallStack => String -> a
error "invalid DSA hash choice, only SHA1 allowed"
        Just (_       , sigAlg :: SignatureAlgorithm
sigAlg)       -> String -> SignatureParams
forall a. HasCallStack => String -> a
error ("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 _) hashSigAlg :: Maybe HashAndSignatureAlgorithm
hashSigAlg =
    case Maybe HashAndSignatureAlgorithm
hashSigAlg of
        Just (HashSHA512, SignatureECDSA) -> Hash -> SignatureParams
ECDSAParams Hash
SHA512
        Just (HashSHA384, SignatureECDSA) -> Hash -> SignatureParams
ECDSAParams Hash
SHA384
        Just (HashSHA256, SignatureECDSA) -> Hash -> SignatureParams
ECDSAParams Hash
SHA256
        Just (HashSHA1  , SignatureECDSA) -> Hash -> SignatureParams
ECDSAParams Hash
SHA1
        Nothing                           -> Hash -> SignatureParams
ECDSAParams Hash
SHA1
        Just (hsh :: HashAlgorithm
hsh       , SignatureECDSA) -> String -> SignatureParams
forall a. HasCallStack => String -> a
error ("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 (_         , sigAlg :: SignatureAlgorithm
sigAlg)         -> String -> SignatureParams
forall a. HasCallStack => String -> a
error ("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 _) hashSigAlg :: Maybe HashAndSignatureAlgorithm
hashSigAlg =
    case Maybe HashAndSignatureAlgorithm
hashSigAlg of
        Nothing                                 -> SignatureParams
Ed25519Params
        Just (HashIntrinsic , SignatureEd25519) -> SignatureParams
Ed25519Params
        Just (hsh :: HashAlgorithm
hsh           , SignatureEd25519) -> String -> SignatureParams
forall a. HasCallStack => String -> a
error ("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 (_             , sigAlg :: SignatureAlgorithm
sigAlg)           -> String -> SignatureParams
forall a. HasCallStack => String -> a
error ("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 _) hashSigAlg :: Maybe HashAndSignatureAlgorithm
hashSigAlg =
    case Maybe HashAndSignatureAlgorithm
hashSigAlg of
        Nothing                               -> SignatureParams
Ed448Params
        Just (HashIntrinsic , SignatureEd448) -> SignatureParams
Ed448Params
        Just (hsh :: HashAlgorithm
hsh           , SignatureEd448) -> String -> SignatureParams
forall a. HasCallStack => String -> a
error ("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 (_             , sigAlg :: SignatureAlgorithm
sigAlg)         -> String -> SignatureParams
forall a. HasCallStack => String -> a
error ("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 pk :: PubKey
pk _ = String -> SignatureParams
forall a. HasCallStack => String -> a
error ("signatureParams: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PubKey -> String
pubkeyType PubKey
pk String -> String -> String
forall a. [a] -> [a] -> [a]
++ " is not supported")

signatureCreateWithCertVerifyData :: Context
                                  -> Maybe HashAndSignatureAlgorithm
                                  -> CertVerifyData
                                  -> IO DigitallySigned
signatureCreateWithCertVerifyData :: Context
-> Maybe HashAndSignatureAlgorithm
-> CertVerifyData
-> IO DigitallySigned
signatureCreateWithCertVerifyData ctx :: Context
ctx malg :: Maybe HashAndSignatureAlgorithm
malg (sigParam :: SignatureParams
sigParam, toSign :: 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 ctx :: Context
ctx digSig :: DigitallySigned
digSig@(DigitallySigned hashSigAlg :: Maybe HashAndSignatureAlgorithm
hashSigAlg _) pubKey :: PubKey
pubKey toVerifyData :: ByteString
toVerifyData = do
    Version
usedVersion <- Context -> TLSSt Version -> IO Version
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt Version
getVersion
    let (sigParam :: SignatureParams
sigParam, toVerify :: ByteString
toVerify) =
            case (Version
usedVersion, Maybe HashAndSignatureAlgorithm
hashSigAlg) of
                (TLS12, Nothing)    -> String -> CertVerifyData
forall a. HasCallStack => String -> a
error "expecting hash and signature algorithm in a TLS12 digitally signed structure"
                (TLS12, Just hs :: 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 "expecting different signature algorithm"
                (_,     Nothing)    -> SignatureParams -> ByteString -> CertVerifyData
buildVerifyData (PubKey -> Maybe HashAndSignatureAlgorithm -> SignatureParams
signatureParams PubKey
pubKey Maybe HashAndSignatureAlgorithm
forall a. Maybe a
Nothing) ByteString
toVerifyData
                (_,     Just _)     -> String -> CertVerifyData
forall a. HasCallStack => String -> a
error "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 ctx :: Context
ctx (DigitallySigned hs :: Maybe HashAndSignatureAlgorithm
hs bs :: ByteString
bs) (sigParam :: SignatureParams
sigParam, toVerify :: 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 ctx :: Context
ctx signatureData :: ByteString
signatureData pubKey :: PubKey
pubKey hashSigAlg :: 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 ctx :: Context
ctx serverParams :: ServerDHParams
serverParams pubKey :: PubKey
pubKey mhash :: 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 ctx :: Context
ctx serverParams :: ServerECDHParams
serverParams pubKey :: PubKey
pubKey mhash :: 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 ctx :: Context
ctx dhparams :: ServerDHParams
dhparams pubKey :: PubKey
pubKey signature :: 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 ctx :: Context
ctx dhparams :: ServerECDHParams
dhparams pubKey :: PubKey
pubKey signature :: 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 ctx :: Context
ctx f :: ClientRandom -> ServerRandom -> b
f = do
    (cran :: ClientRandom
cran, sran :: 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 "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 _   Nothing   = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkSupportedHashSignature ctx :: Context
ctx (Just hs :: 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 = "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 :: * -> *) e a. (MonadIO m, Exception e) => e -> 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)