1{-# LANGUAGE OverloadedStrings #-} 2-- | 3-- Module : Network.TLS.Handshake.Signature 4-- License : BSD-style 5-- Maintainer : Vincent Hanquez <vincent@snarc.org> 6-- Stability : experimental 7-- Portability : unknown 8-- 9module Network.TLS.Handshake.Signature 10 ( 11 createCertificateVerify 12 , checkCertificateVerify 13 , digitallySignDHParams 14 , digitallySignECDHParams 15 , digitallySignDHParamsVerify 16 , digitallySignECDHParamsVerify 17 , checkSupportedHashSignature 18 , certificateCompatible 19 , signatureCompatible 20 , signatureCompatible13 21 , hashSigToCertType 22 , signatureParams 23 , decryptError 24 ) where 25 26import Network.TLS.Crypto 27import Network.TLS.Context.Internal 28import Network.TLS.Parameters 29import Network.TLS.Struct 30import Network.TLS.Imports 31import Network.TLS.Packet (generateCertificateVerify_SSL, generateCertificateVerify_SSL_DSS, 32 encodeSignedDHParams, encodeSignedECDHParams) 33import Network.TLS.State 34import Network.TLS.Handshake.State 35import Network.TLS.Handshake.Key 36import Network.TLS.Util 37import Network.TLS.X509 38 39import Control.Monad.State.Strict 40 41decryptError :: MonadIO m => String -> m a 42decryptError msg = throwCore $ Error_Protocol (msg, True, DecryptError) 43 44-- | Check that the key is compatible with a list of 'CertificateType' values. 45-- Ed25519 and Ed448 have no assigned code point and are checked with extension 46-- "signature_algorithms" only. 47certificateCompatible :: PubKey -> [CertificateType] -> Bool 48certificateCompatible (PubKeyRSA _) cTypes = CertificateType_RSA_Sign `elem` cTypes 49certificateCompatible (PubKeyDSA _) cTypes = CertificateType_DSS_Sign `elem` cTypes 50certificateCompatible (PubKeyEC _) cTypes = CertificateType_ECDSA_Sign `elem` cTypes 51certificateCompatible (PubKeyEd25519 _) _ = True 52certificateCompatible (PubKeyEd448 _) _ = True 53certificateCompatible _ _ = False 54 55signatureCompatible :: PubKey -> HashAndSignatureAlgorithm -> Bool 56signatureCompatible (PubKeyRSA pk) (HashSHA1, SignatureRSA) = kxCanUseRSApkcs1 pk SHA1 57signatureCompatible (PubKeyRSA pk) (HashSHA256, SignatureRSA) = kxCanUseRSApkcs1 pk SHA256 58signatureCompatible (PubKeyRSA pk) (HashSHA384, SignatureRSA) = kxCanUseRSApkcs1 pk SHA384 59signatureCompatible (PubKeyRSA pk) (HashSHA512, SignatureRSA) = kxCanUseRSApkcs1 pk SHA512 60signatureCompatible (PubKeyRSA pk) (_, SignatureRSApssRSAeSHA256) = kxCanUseRSApss pk SHA256 61signatureCompatible (PubKeyRSA pk) (_, SignatureRSApssRSAeSHA384) = kxCanUseRSApss pk SHA384 62signatureCompatible (PubKeyRSA pk) (_, SignatureRSApssRSAeSHA512) = kxCanUseRSApss pk SHA512 63signatureCompatible (PubKeyDSA _) (_, SignatureDSS) = True 64signatureCompatible (PubKeyEC _) (_, SignatureECDSA) = True 65signatureCompatible (PubKeyEd25519 _) (_, SignatureEd25519) = True 66signatureCompatible (PubKeyEd448 _) (_, SignatureEd448) = True 67signatureCompatible _ (_, _) = False 68 69-- Same as 'signatureCompatible' but for TLS13: for ECDSA this also checks the 70-- relation between hash in the HashAndSignatureAlgorithm and elliptic curve 71signatureCompatible13 :: PubKey -> HashAndSignatureAlgorithm -> Bool 72signatureCompatible13 (PubKeyEC ecPub) (h, SignatureECDSA) = 73 maybe False (\g -> findEllipticCurveGroup ecPub == Just g) (hashCurve h) 74 where 75 hashCurve HashSHA256 = Just P256 76 hashCurve HashSHA384 = Just P384 77 hashCurve HashSHA512 = Just P521 78 hashCurve _ = Nothing 79signatureCompatible13 pub hs = signatureCompatible pub hs 80 81-- | Translate a 'HashAndSignatureAlgorithm' to an acceptable 'CertificateType'. 82-- Perhaps this needs to take supported groups into account, so that, for 83-- example, if we don't support any shared ECDSA groups with the server, we 84-- return 'Nothing' rather than 'CertificateType_ECDSA_Sign'. 85-- 86-- Therefore, this interface is preliminary. It gets us moving in the right 87-- direction. The interplay between all the various TLS extensions and 88-- certificate selection is rather complex. 89-- 90-- The goal is to ensure that the client certificate request callback only sees 91-- 'CertificateType' values that are supported by the library and also 92-- compatible with the server signature algorithms extension. 93-- 94-- Since we don't yet support ECDSA private keys, the caller will use 95-- 'lastSupportedCertificateType' to filter those out for now, leaving just 96-- @RSA@ as the only supported client certificate algorithm for TLS 1.3. 97-- 98-- FIXME: Add RSA_PSS_PSS signatures when supported. 99-- 100hashSigToCertType :: HashAndSignatureAlgorithm -> Maybe CertificateType 101-- 102hashSigToCertType (_, SignatureRSA) = Just CertificateType_RSA_Sign 103-- 104hashSigToCertType (_, SignatureDSS) = Just CertificateType_DSS_Sign 105-- 106hashSigToCertType (_, SignatureECDSA) = Just CertificateType_ECDSA_Sign 107-- 108hashSigToCertType (HashIntrinsic, SignatureRSApssRSAeSHA256) 109 = Just CertificateType_RSA_Sign 110hashSigToCertType (HashIntrinsic, SignatureRSApssRSAeSHA384) 111 = Just CertificateType_RSA_Sign 112hashSigToCertType (HashIntrinsic, SignatureRSApssRSAeSHA512) 113 = Just CertificateType_RSA_Sign 114hashSigToCertType (HashIntrinsic, SignatureEd25519) 115 = Just CertificateType_Ed25519_Sign 116hashSigToCertType (HashIntrinsic, SignatureEd448) 117 = Just CertificateType_Ed448_Sign 118-- 119hashSigToCertType _ = Nothing 120 121checkCertificateVerify :: Context 122 -> Version 123 -> PubKey 124 -> ByteString 125 -> DigitallySigned 126 -> IO Bool 127checkCertificateVerify ctx usedVersion pubKey msgs digSig@(DigitallySigned hashSigAlg _) = 128 case (usedVersion, hashSigAlg) of 129 (TLS12, Nothing) -> return False 130 (TLS12, Just hs) | pubKey `signatureCompatible` hs -> doVerify 131 | otherwise -> return False 132 (_, Nothing) -> doVerify 133 (_, Just _) -> return False 134 where 135 doVerify = 136 prepareCertificateVerifySignatureData ctx usedVersion pubKey hashSigAlg msgs >>= 137 signatureVerifyWithCertVerifyData ctx digSig 138 139createCertificateVerify :: Context 140 -> Version 141 -> PubKey 142 -> Maybe HashAndSignatureAlgorithm -- TLS12 only 143 -> ByteString 144 -> IO DigitallySigned 145createCertificateVerify ctx usedVersion pubKey hashSigAlg msgs = 146 prepareCertificateVerifySignatureData ctx usedVersion pubKey hashSigAlg msgs >>= 147 signatureCreateWithCertVerifyData ctx hashSigAlg 148 149type CertVerifyData = (SignatureParams, ByteString) 150 151-- in the case of TLS < 1.2, RSA signing, then the data need to be hashed first, as 152-- the SHA1_MD5 algorithm expect an already digested data 153buildVerifyData :: SignatureParams -> ByteString -> CertVerifyData 154buildVerifyData (RSAParams SHA1_MD5 enc) bs = (RSAParams SHA1_MD5 enc, hashFinal $ hashUpdate (hashInit SHA1_MD5) bs) 155buildVerifyData sigParam bs = (sigParam, bs) 156 157prepareCertificateVerifySignatureData :: Context 158 -> Version 159 -> PubKey 160 -> Maybe HashAndSignatureAlgorithm -- TLS12 only 161 -> ByteString 162 -> IO CertVerifyData 163prepareCertificateVerifySignatureData ctx usedVersion pubKey hashSigAlg msgs 164 | usedVersion == SSL3 = do 165 (hashCtx, params, generateCV_SSL) <- 166 case pubKey of 167 PubKeyRSA _ -> return (hashInit SHA1_MD5, RSAParams SHA1_MD5 RSApkcs1, generateCertificateVerify_SSL) 168 PubKeyDSA _ -> return (hashInit SHA1, DSSParams, generateCertificateVerify_SSL_DSS) 169 _ -> throwCore $ Error_Misc ("unsupported CertificateVerify signature for SSL3: " ++ pubkeyType pubKey) 170 Just masterSecret <- usingHState ctx $ gets hstMasterSecret 171 return (params, generateCV_SSL masterSecret $ hashUpdate hashCtx msgs) 172 | usedVersion == TLS10 || usedVersion == TLS11 = 173 return $ buildVerifyData (signatureParams pubKey Nothing) msgs 174 | otherwise = return (signatureParams pubKey hashSigAlg, msgs) 175 176signatureParams :: PubKey -> Maybe HashAndSignatureAlgorithm -> SignatureParams 177signatureParams (PubKeyRSA _) hashSigAlg = 178 case hashSigAlg of 179 Just (HashSHA512, SignatureRSA) -> RSAParams SHA512 RSApkcs1 180 Just (HashSHA384, SignatureRSA) -> RSAParams SHA384 RSApkcs1 181 Just (HashSHA256, SignatureRSA) -> RSAParams SHA256 RSApkcs1 182 Just (HashSHA1 , SignatureRSA) -> RSAParams SHA1 RSApkcs1 183 Just (HashIntrinsic , SignatureRSApssRSAeSHA512) -> RSAParams SHA512 RSApss 184 Just (HashIntrinsic , SignatureRSApssRSAeSHA384) -> RSAParams SHA384 RSApss 185 Just (HashIntrinsic , SignatureRSApssRSAeSHA256) -> RSAParams SHA256 RSApss 186 Nothing -> RSAParams SHA1_MD5 RSApkcs1 187 Just (hsh , SignatureRSA) -> error ("unimplemented RSA signature hash type: " ++ show hsh) 188 Just (_ , sigAlg) -> error ("signature algorithm is incompatible with RSA: " ++ show sigAlg) 189signatureParams (PubKeyDSA _) hashSigAlg = 190 case hashSigAlg of 191 Nothing -> DSSParams 192 Just (HashSHA1, SignatureDSS) -> DSSParams 193 Just (_ , SignatureDSS) -> error "invalid DSA hash choice, only SHA1 allowed" 194 Just (_ , sigAlg) -> error ("signature algorithm is incompatible with DSS: " ++ show sigAlg) 195signatureParams (PubKeyEC _) hashSigAlg = 196 case hashSigAlg of 197 Just (HashSHA512, SignatureECDSA) -> ECDSAParams SHA512 198 Just (HashSHA384, SignatureECDSA) -> ECDSAParams SHA384 199 Just (HashSHA256, SignatureECDSA) -> ECDSAParams SHA256 200 Just (HashSHA1 , SignatureECDSA) -> ECDSAParams SHA1 201 Nothing -> ECDSAParams SHA1 202 Just (hsh , SignatureECDSA) -> error ("unimplemented ECDSA signature hash type: " ++ show hsh) 203 Just (_ , sigAlg) -> error ("signature algorithm is incompatible with ECDSA: " ++ show sigAlg) 204signatureParams (PubKeyEd25519 _) hashSigAlg = 205 case hashSigAlg of 206 Nothing -> Ed25519Params 207 Just (HashIntrinsic , SignatureEd25519) -> Ed25519Params 208 Just (hsh , SignatureEd25519) -> error ("unimplemented Ed25519 signature hash type: " ++ show hsh) 209 Just (_ , sigAlg) -> error ("signature algorithm is incompatible with Ed25519: " ++ show sigAlg) 210signatureParams (PubKeyEd448 _) hashSigAlg = 211 case hashSigAlg of 212 Nothing -> Ed448Params 213 Just (HashIntrinsic , SignatureEd448) -> Ed448Params 214 Just (hsh , SignatureEd448) -> error ("unimplemented Ed448 signature hash type: " ++ show hsh) 215 Just (_ , sigAlg) -> error ("signature algorithm is incompatible with Ed448: " ++ show sigAlg) 216signatureParams pk _ = error ("signatureParams: " ++ pubkeyType pk ++ " is not supported") 217 218signatureCreateWithCertVerifyData :: Context 219 -> Maybe HashAndSignatureAlgorithm 220 -> CertVerifyData 221 -> IO DigitallySigned 222signatureCreateWithCertVerifyData ctx malg (sigParam, toSign) = do 223 cc <- usingState_ ctx isClientContext 224 DigitallySigned malg <$> signPrivate ctx cc sigParam toSign 225 226signatureVerify :: Context -> DigitallySigned -> PubKey -> ByteString -> IO Bool 227signatureVerify ctx digSig@(DigitallySigned hashSigAlg _) pubKey toVerifyData = do 228 usedVersion <- usingState_ ctx getVersion 229 let (sigParam, toVerify) = 230 case (usedVersion, hashSigAlg) of 231 (TLS12, Nothing) -> error "expecting hash and signature algorithm in a TLS12 digitally signed structure" 232 (TLS12, Just hs) | pubKey `signatureCompatible` hs -> (signatureParams pubKey hashSigAlg, toVerifyData) 233 | otherwise -> error "expecting different signature algorithm" 234 (_, Nothing) -> buildVerifyData (signatureParams pubKey Nothing) toVerifyData 235 (_, Just _) -> error "not expecting hash and signature algorithm in a < TLS12 digitially signed structure" 236 signatureVerifyWithCertVerifyData ctx digSig (sigParam, toVerify) 237 238signatureVerifyWithCertVerifyData :: Context 239 -> DigitallySigned 240 -> CertVerifyData 241 -> IO Bool 242signatureVerifyWithCertVerifyData ctx (DigitallySigned hs bs) (sigParam, toVerify) = do 243 checkSupportedHashSignature ctx hs 244 verifyPublic ctx sigParam toVerify bs 245 246digitallySignParams :: Context -> ByteString -> PubKey -> Maybe HashAndSignatureAlgorithm -> IO DigitallySigned 247digitallySignParams ctx signatureData pubKey hashSigAlg = 248 let sigParam = signatureParams pubKey hashSigAlg 249 in signatureCreateWithCertVerifyData ctx hashSigAlg (buildVerifyData sigParam signatureData) 250 251digitallySignDHParams :: Context 252 -> ServerDHParams 253 -> PubKey 254 -> Maybe HashAndSignatureAlgorithm -- TLS12 only 255 -> IO DigitallySigned 256digitallySignDHParams ctx serverParams pubKey mhash = do 257 dhParamsData <- withClientAndServerRandom ctx $ encodeSignedDHParams serverParams 258 digitallySignParams ctx dhParamsData pubKey mhash 259 260digitallySignECDHParams :: Context 261 -> ServerECDHParams 262 -> PubKey 263 -> Maybe HashAndSignatureAlgorithm -- TLS12 only 264 -> IO DigitallySigned 265digitallySignECDHParams ctx serverParams pubKey mhash = do 266 ecdhParamsData <- withClientAndServerRandom ctx $ encodeSignedECDHParams serverParams 267 digitallySignParams ctx ecdhParamsData pubKey mhash 268 269digitallySignDHParamsVerify :: Context 270 -> ServerDHParams 271 -> PubKey 272 -> DigitallySigned 273 -> IO Bool 274digitallySignDHParamsVerify ctx dhparams pubKey signature = do 275 expectedData <- withClientAndServerRandom ctx $ encodeSignedDHParams dhparams 276 signatureVerify ctx signature pubKey expectedData 277 278digitallySignECDHParamsVerify :: Context 279 -> ServerECDHParams 280 -> PubKey 281 -> DigitallySigned 282 -> IO Bool 283digitallySignECDHParamsVerify ctx dhparams pubKey signature = do 284 expectedData <- withClientAndServerRandom ctx $ encodeSignedECDHParams dhparams 285 signatureVerify ctx signature pubKey expectedData 286 287withClientAndServerRandom :: Context -> (ClientRandom -> ServerRandom -> b) -> IO b 288withClientAndServerRandom ctx f = do 289 (cran, sran) <- usingHState ctx $ (,) <$> gets hstClientRandom 290 <*> (fromJust "withClientAndServer : server random" <$> gets hstServerRandom) 291 return $ f cran sran 292 293-- verify that the hash and signature selected by the peer is supported in 294-- the local configuration 295checkSupportedHashSignature :: Context -> Maybe HashAndSignatureAlgorithm -> IO () 296checkSupportedHashSignature _ Nothing = return () 297checkSupportedHashSignature ctx (Just hs) = 298 unless (hs `elem` supportedHashSignatures (ctxSupported ctx)) $ 299 let msg = "unsupported hash and signature algorithm: " ++ show hs 300 in throwCore $ Error_Protocol (msg, True, IllegalParameter) 301