1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300
|
{-# 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 msg = throwCore $ Error_Protocol (msg, True, 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 (PubKeyRSA _) cTypes = CertificateType_RSA_Sign `elem` cTypes
certificateCompatible (PubKeyDSA _) cTypes = CertificateType_DSS_Sign `elem` cTypes
certificateCompatible (PubKeyEC _) cTypes = CertificateType_ECDSA_Sign `elem` cTypes
certificateCompatible (PubKeyEd25519 _) _ = True
certificateCompatible (PubKeyEd448 _) _ = True
certificateCompatible _ _ = False
signatureCompatible :: PubKey -> HashAndSignatureAlgorithm -> Bool
signatureCompatible (PubKeyRSA pk) (HashSHA1, SignatureRSA) = kxCanUseRSApkcs1 pk SHA1
signatureCompatible (PubKeyRSA pk) (HashSHA256, SignatureRSA) = kxCanUseRSApkcs1 pk SHA256
signatureCompatible (PubKeyRSA pk) (HashSHA384, SignatureRSA) = kxCanUseRSApkcs1 pk SHA384
signatureCompatible (PubKeyRSA pk) (HashSHA512, SignatureRSA) = kxCanUseRSApkcs1 pk SHA512
signatureCompatible (PubKeyRSA pk) (_, SignatureRSApssRSAeSHA256) = kxCanUseRSApss pk SHA256
signatureCompatible (PubKeyRSA pk) (_, SignatureRSApssRSAeSHA384) = kxCanUseRSApss pk SHA384
signatureCompatible (PubKeyRSA pk) (_, SignatureRSApssRSAeSHA512) = kxCanUseRSApss pk SHA512
signatureCompatible (PubKeyDSA _) (_, SignatureDSS) = True
signatureCompatible (PubKeyEC _) (_, SignatureECDSA) = True
signatureCompatible (PubKeyEd25519 _) (_, SignatureEd25519) = True
signatureCompatible (PubKeyEd448 _) (_, SignatureEd448) = True
signatureCompatible _ (_, _) = 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 (PubKeyEC ecPub) (h, SignatureECDSA) =
maybe False (\g -> findEllipticCurveGroup ecPub == Just g) (hashCurve h)
where
hashCurve HashSHA256 = Just P256
hashCurve HashSHA384 = Just P384
hashCurve HashSHA512 = Just P521
hashCurve _ = Nothing
signatureCompatible13 pub hs = signatureCompatible pub 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 (_, SignatureRSA) = Just CertificateType_RSA_Sign
--
hashSigToCertType (_, SignatureDSS) = Just CertificateType_DSS_Sign
--
hashSigToCertType (_, SignatureECDSA) = Just CertificateType_ECDSA_Sign
--
hashSigToCertType (HashIntrinsic, SignatureRSApssRSAeSHA256)
= Just CertificateType_RSA_Sign
hashSigToCertType (HashIntrinsic, SignatureRSApssRSAeSHA384)
= Just CertificateType_RSA_Sign
hashSigToCertType (HashIntrinsic, SignatureRSApssRSAeSHA512)
= Just CertificateType_RSA_Sign
hashSigToCertType (HashIntrinsic, SignatureEd25519)
= Just CertificateType_Ed25519_Sign
hashSigToCertType (HashIntrinsic, SignatureEd448)
= Just CertificateType_Ed448_Sign
--
hashSigToCertType _ = Nothing
checkCertificateVerify :: Context
-> Version
-> PubKey
-> ByteString
-> DigitallySigned
-> IO Bool
checkCertificateVerify ctx usedVersion pubKey msgs digSig@(DigitallySigned hashSigAlg _) =
case (usedVersion, hashSigAlg) of
(TLS12, Nothing) -> return False
(TLS12, Just hs) | pubKey `signatureCompatible` hs -> doVerify
| otherwise -> return False
(_, Nothing) -> doVerify
(_, Just _) -> return False
where
doVerify =
prepareCertificateVerifySignatureData ctx usedVersion pubKey hashSigAlg msgs >>=
signatureVerifyWithCertVerifyData ctx digSig
createCertificateVerify :: Context
-> Version
-> PubKey
-> Maybe HashAndSignatureAlgorithm -- TLS12 only
-> ByteString
-> IO DigitallySigned
createCertificateVerify ctx usedVersion pubKey hashSigAlg msgs =
prepareCertificateVerifySignatureData ctx usedVersion pubKey hashSigAlg msgs >>=
signatureCreateWithCertVerifyData ctx 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 (RSAParams SHA1_MD5 enc) bs = (RSAParams SHA1_MD5 enc, hashFinal $ hashUpdate (hashInit SHA1_MD5) bs)
buildVerifyData sigParam bs = (sigParam, bs)
prepareCertificateVerifySignatureData :: Context
-> Version
-> PubKey
-> Maybe HashAndSignatureAlgorithm -- TLS12 only
-> ByteString
-> IO CertVerifyData
prepareCertificateVerifySignatureData ctx usedVersion pubKey hashSigAlg msgs
| usedVersion == SSL3 = do
(hashCtx, params, generateCV_SSL) <-
case pubKey of
PubKeyRSA _ -> return (hashInit SHA1_MD5, RSAParams SHA1_MD5 RSApkcs1, generateCertificateVerify_SSL)
PubKeyDSA _ -> return (hashInit SHA1, DSSParams, generateCertificateVerify_SSL_DSS)
_ -> throwCore $ Error_Misc ("unsupported CertificateVerify signature for SSL3: " ++ pubkeyType pubKey)
Just masterSecret <- usingHState ctx $ gets hstMasterSecret
return (params, generateCV_SSL masterSecret $ hashUpdate hashCtx msgs)
| usedVersion == TLS10 || usedVersion == TLS11 =
return $ buildVerifyData (signatureParams pubKey Nothing) msgs
| otherwise = return (signatureParams pubKey hashSigAlg, msgs)
signatureParams :: PubKey -> Maybe HashAndSignatureAlgorithm -> SignatureParams
signatureParams (PubKeyRSA _) hashSigAlg =
case hashSigAlg of
Just (HashSHA512, SignatureRSA) -> RSAParams SHA512 RSApkcs1
Just (HashSHA384, SignatureRSA) -> RSAParams SHA384 RSApkcs1
Just (HashSHA256, SignatureRSA) -> RSAParams SHA256 RSApkcs1
Just (HashSHA1 , SignatureRSA) -> RSAParams SHA1 RSApkcs1
Just (HashIntrinsic , SignatureRSApssRSAeSHA512) -> RSAParams SHA512 RSApss
Just (HashIntrinsic , SignatureRSApssRSAeSHA384) -> RSAParams SHA384 RSApss
Just (HashIntrinsic , SignatureRSApssRSAeSHA256) -> RSAParams SHA256 RSApss
Nothing -> RSAParams SHA1_MD5 RSApkcs1
Just (hsh , SignatureRSA) -> error ("unimplemented RSA signature hash type: " ++ show hsh)
Just (_ , sigAlg) -> error ("signature algorithm is incompatible with RSA: " ++ show sigAlg)
signatureParams (PubKeyDSA _) hashSigAlg =
case hashSigAlg of
Nothing -> DSSParams
Just (HashSHA1, SignatureDSS) -> DSSParams
Just (_ , SignatureDSS) -> error "invalid DSA hash choice, only SHA1 allowed"
Just (_ , sigAlg) -> error ("signature algorithm is incompatible with DSS: " ++ show sigAlg)
signatureParams (PubKeyEC _) hashSigAlg =
case hashSigAlg of
Just (HashSHA512, SignatureECDSA) -> ECDSAParams SHA512
Just (HashSHA384, SignatureECDSA) -> ECDSAParams SHA384
Just (HashSHA256, SignatureECDSA) -> ECDSAParams SHA256
Just (HashSHA1 , SignatureECDSA) -> ECDSAParams SHA1
Nothing -> ECDSAParams SHA1
Just (hsh , SignatureECDSA) -> error ("unimplemented ECDSA signature hash type: " ++ show hsh)
Just (_ , sigAlg) -> error ("signature algorithm is incompatible with ECDSA: " ++ show sigAlg)
signatureParams (PubKeyEd25519 _) hashSigAlg =
case hashSigAlg of
Nothing -> Ed25519Params
Just (HashIntrinsic , SignatureEd25519) -> Ed25519Params
Just (hsh , SignatureEd25519) -> error ("unimplemented Ed25519 signature hash type: " ++ show hsh)
Just (_ , sigAlg) -> error ("signature algorithm is incompatible with Ed25519: " ++ show sigAlg)
signatureParams (PubKeyEd448 _) hashSigAlg =
case hashSigAlg of
Nothing -> Ed448Params
Just (HashIntrinsic , SignatureEd448) -> Ed448Params
Just (hsh , SignatureEd448) -> error ("unimplemented Ed448 signature hash type: " ++ show hsh)
Just (_ , sigAlg) -> error ("signature algorithm is incompatible with Ed448: " ++ show sigAlg)
signatureParams pk _ = error ("signatureParams: " ++ pubkeyType pk ++ " is not supported")
signatureCreateWithCertVerifyData :: Context
-> Maybe HashAndSignatureAlgorithm
-> CertVerifyData
-> IO DigitallySigned
signatureCreateWithCertVerifyData ctx malg (sigParam, toSign) = do
cc <- usingState_ ctx isClientContext
DigitallySigned malg <$> signPrivate ctx cc sigParam toSign
signatureVerify :: Context -> DigitallySigned -> PubKey -> ByteString -> IO Bool
signatureVerify ctx digSig@(DigitallySigned hashSigAlg _) pubKey toVerifyData = do
usedVersion <- usingState_ ctx getVersion
let (sigParam, toVerify) =
case (usedVersion, hashSigAlg) of
(TLS12, Nothing) -> error "expecting hash and signature algorithm in a TLS12 digitally signed structure"
(TLS12, Just hs) | pubKey `signatureCompatible` hs -> (signatureParams pubKey hashSigAlg, toVerifyData)
| otherwise -> error "expecting different signature algorithm"
(_, Nothing) -> buildVerifyData (signatureParams pubKey Nothing) toVerifyData
(_, Just _) -> error "not expecting hash and signature algorithm in a < TLS12 digitially signed structure"
signatureVerifyWithCertVerifyData ctx digSig (sigParam, toVerify)
signatureVerifyWithCertVerifyData :: Context
-> DigitallySigned
-> CertVerifyData
-> IO Bool
signatureVerifyWithCertVerifyData ctx (DigitallySigned hs bs) (sigParam, toVerify) = do
checkSupportedHashSignature ctx hs
verifyPublic ctx sigParam toVerify bs
digitallySignParams :: Context -> ByteString -> PubKey -> Maybe HashAndSignatureAlgorithm -> IO DigitallySigned
digitallySignParams ctx signatureData pubKey hashSigAlg =
let sigParam = signatureParams pubKey hashSigAlg
in signatureCreateWithCertVerifyData ctx hashSigAlg (buildVerifyData sigParam signatureData)
digitallySignDHParams :: Context
-> ServerDHParams
-> PubKey
-> Maybe HashAndSignatureAlgorithm -- TLS12 only
-> IO DigitallySigned
digitallySignDHParams ctx serverParams pubKey mhash = do
dhParamsData <- withClientAndServerRandom ctx $ encodeSignedDHParams serverParams
digitallySignParams ctx dhParamsData pubKey mhash
digitallySignECDHParams :: Context
-> ServerECDHParams
-> PubKey
-> Maybe HashAndSignatureAlgorithm -- TLS12 only
-> IO DigitallySigned
digitallySignECDHParams ctx serverParams pubKey mhash = do
ecdhParamsData <- withClientAndServerRandom ctx $ encodeSignedECDHParams serverParams
digitallySignParams ctx ecdhParamsData pubKey mhash
digitallySignDHParamsVerify :: Context
-> ServerDHParams
-> PubKey
-> DigitallySigned
-> IO Bool
digitallySignDHParamsVerify ctx dhparams pubKey signature = do
expectedData <- withClientAndServerRandom ctx $ encodeSignedDHParams dhparams
signatureVerify ctx signature pubKey expectedData
digitallySignECDHParamsVerify :: Context
-> ServerECDHParams
-> PubKey
-> DigitallySigned
-> IO Bool
digitallySignECDHParamsVerify ctx dhparams pubKey signature = do
expectedData <- withClientAndServerRandom ctx $ encodeSignedECDHParams dhparams
signatureVerify ctx signature pubKey expectedData
withClientAndServerRandom :: Context -> (ClientRandom -> ServerRandom -> b) -> IO b
withClientAndServerRandom ctx f = do
(cran, sran) <- usingHState ctx $ (,) <$> gets hstClientRandom
<*> (fromJust "withClientAndServer : server random" <$> gets hstServerRandom)
return $ f cran sran
-- verify that the hash and signature selected by the peer is supported in
-- the local configuration
checkSupportedHashSignature :: Context -> Maybe HashAndSignatureAlgorithm -> IO ()
checkSupportedHashSignature _ Nothing = return ()
checkSupportedHashSignature ctx (Just hs) =
unless (hs `elem` supportedHashSignatures (ctxSupported ctx)) $
let msg = "unsupported hash and signature algorithm: " ++ show hs
in throwCore $ Error_Protocol (msg, True, IllegalParameter)
|