module Network.TLS.Handshake.Signature
(
createCertificateVerify
, checkCertificateVerify
, digitallySignDHParams
, digitallySignECDHParams
, digitallySignDHParamsVerify
, digitallySignECDHParamsVerify
, signatureCompatible
) where
import Network.TLS.Crypto
import Network.TLS.Context.Internal
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 Control.Monad.State.Strict
signatureCompatible :: DigitalSignatureAlg -> HashAndSignatureAlgorithm -> Bool
signatureCompatible RSA (_, SignatureRSA) = True
signatureCompatible RSA (_, SignatureRSApssSHA256) = True
signatureCompatible RSA (_, SignatureRSApssSHA384) = True
signatureCompatible RSA (_, SignatureRSApssSHA512) = True
signatureCompatible DSS (_, SignatureDSS) = True
signatureCompatible ECDSA (_, SignatureECDSA) = True
signatureCompatible _ (_, _) = False
checkCertificateVerify :: Context
-> Version
-> DigitalSignatureAlg
-> ByteString
-> DigitallySigned
-> IO Bool
checkCertificateVerify ctx usedVersion sigAlgExpected msgs digSig@(DigitallySigned hashSigAlg _) =
case (usedVersion, hashSigAlg) of
(TLS12, Nothing) -> return False
(TLS12, Just hs) | sigAlgExpected `signatureCompatible` hs -> doVerify
| otherwise -> return False
(_, Nothing) -> doVerify
(_, Just _) -> return False
where
doVerify =
prepareCertificateVerifySignatureData ctx usedVersion sigAlgExpected hashSigAlg msgs >>=
signatureVerifyWithCertVerifyData ctx digSig
createCertificateVerify :: Context
-> Version
-> DigitalSignatureAlg
-> Maybe HashAndSignatureAlgorithm
-> ByteString
-> IO DigitallySigned
createCertificateVerify ctx usedVersion sigAlg hashSigAlg msgs =
prepareCertificateVerifySignatureData ctx usedVersion sigAlg hashSigAlg msgs >>=
signatureCreateWithCertVerifyData ctx hashSigAlg
type CertVerifyData = (SignatureParams, ByteString)
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
-> DigitalSignatureAlg
-> Maybe HashAndSignatureAlgorithm
-> ByteString
-> IO CertVerifyData
prepareCertificateVerifySignatureData ctx usedVersion sigAlg hashSigAlg msgs
| usedVersion == SSL3 = do
(hashCtx, params, generateCV_SSL) <-
case sigAlg of
RSA -> return (hashInit SHA1_MD5, RSAParams SHA1_MD5 RSApkcs1, generateCertificateVerify_SSL)
DSS -> return (hashInit SHA1, DSSParams, generateCertificateVerify_SSL_DSS)
_ -> throwCore $ Error_Misc ("unsupported CertificateVerify signature for SSL3: " ++ show sigAlg)
Just masterSecret <- usingHState ctx $ gets hstMasterSecret
return (params, generateCV_SSL masterSecret $ hashUpdate hashCtx msgs)
| usedVersion == TLS10 || usedVersion == TLS11 =
return $ buildVerifyData (signatureParams sigAlg Nothing) msgs
| otherwise = return (signatureParams sigAlg hashSigAlg, msgs)
signatureParams :: DigitalSignatureAlg -> Maybe HashAndSignatureAlgorithm -> SignatureParams
signatureParams RSA 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 , SignatureRSApssSHA512) -> RSAParams SHA512 RSApss
Just (HashIntrinsic , SignatureRSApssSHA384) -> RSAParams SHA384 RSApss
Just (HashIntrinsic , SignatureRSApssSHA256) -> 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 DSS 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 ECDSA 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 sig _ = error ("unimplemented signature type: " ++ show sig)
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 -> DigitalSignatureAlg -> ByteString -> IO Bool
signatureVerify ctx digSig@(DigitallySigned hashSigAlg _) sigAlgExpected 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) | sigAlgExpected `signatureCompatible` hs -> (signatureParams sigAlgExpected hashSigAlg, toVerifyData)
| otherwise -> error "expecting different signature algorithm"
(_, Nothing) -> buildVerifyData (signatureParams sigAlgExpected 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 _ bs) (sigParam, toVerify) = do
cc <- usingState_ ctx $ isClientContext
verifyPublic ctx cc sigParam toVerify bs
digitallySignParams :: Context -> ByteString -> DigitalSignatureAlg -> Maybe HashAndSignatureAlgorithm -> IO DigitallySigned
digitallySignParams ctx signatureData sigAlg hashSigAlg =
let sigParam = signatureParams sigAlg hashSigAlg
in signatureCreateWithCertVerifyData ctx hashSigAlg (buildVerifyData sigParam signatureData)
digitallySignDHParams :: Context
-> ServerDHParams
-> DigitalSignatureAlg
-> Maybe HashAndSignatureAlgorithm
-> IO DigitallySigned
digitallySignDHParams ctx serverParams sigAlg mhash = do
dhParamsData <- withClientAndServerRandom ctx $ encodeSignedDHParams serverParams
digitallySignParams ctx dhParamsData sigAlg mhash
digitallySignECDHParams :: Context
-> ServerECDHParams
-> DigitalSignatureAlg
-> Maybe HashAndSignatureAlgorithm
-> IO DigitallySigned
digitallySignECDHParams ctx serverParams sigAlg mhash = do
ecdhParamsData <- withClientAndServerRandom ctx $ encodeSignedECDHParams serverParams
digitallySignParams ctx ecdhParamsData sigAlg mhash
digitallySignDHParamsVerify :: Context
-> ServerDHParams
-> DigitalSignatureAlg
-> DigitallySigned
-> IO Bool
digitallySignDHParamsVerify ctx dhparams sigAlg signature = do
expectedData <- withClientAndServerRandom ctx $ encodeSignedDHParams dhparams
signatureVerify ctx signature sigAlg expectedData
digitallySignECDHParamsVerify :: Context
-> ServerECDHParams
-> DigitalSignatureAlg
-> DigitallySigned
-> IO Bool
digitallySignECDHParamsVerify ctx dhparams sigAlg signature = do
expectedData <- withClientAndServerRandom ctx $ encodeSignedECDHParams dhparams
signatureVerify ctx signature sigAlg 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