{-# LANGUAGE OverloadedStrings #-}
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 :: forall (m :: * -> *) a. MonadIO m => [Char] -> m a
decryptError [Char]
msg = forall (m :: * -> *) a. MonadIO m => TLSError -> m a
throwCore forall a b. (a -> b) -> a -> b
$ ([Char], Bool, AlertDescription) -> TLSError
Error_Protocol ([Char]
msg, Bool
True, AlertDescription
DecryptError)
certificateCompatible :: PubKey -> [CertificateType] -> Bool
certificateCompatible :: PubKey -> [CertificateType] -> Bool
certificateCompatible (PubKeyRSA PublicKey
_) [CertificateType]
cTypes = CertificateType
CertificateType_RSA_Sign forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CertificateType]
cTypes
certificateCompatible (PubKeyDSA PublicKey
_) [CertificateType]
cTypes = CertificateType
CertificateType_DSS_Sign forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CertificateType]
cTypes
certificateCompatible (PubKeyEC PubKeyEC
_) [CertificateType]
cTypes = CertificateType
CertificateType_ECDSA_Sign 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
signatureCompatible13 :: PubKey -> HashAndSignatureAlgorithm -> Bool
signatureCompatible13 :: PubKey -> HashAndSignatureAlgorithm -> Bool
signatureCompatible13 (PubKeyEC PubKeyEC
ecPub) (HashAlgorithm
h, SignatureAlgorithm
SignatureECDSA) =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\Group
g -> PubKeyEC -> Maybe Group
findEllipticCurveGroup PubKeyEC
ecPub forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Group
g) (HashAlgorithm -> Maybe Group
hashCurve HashAlgorithm
h)
where
hashCurve :: HashAlgorithm -> Maybe Group
hashCurve HashAlgorithm
HashSHA256 = forall a. a -> Maybe a
Just Group
P256
hashCurve HashAlgorithm
HashSHA384 = forall a. a -> Maybe a
Just Group
P384
hashCurve HashAlgorithm
HashSHA512 = forall a. a -> Maybe a
Just Group
P521
hashCurve HashAlgorithm
_ = forall a. Maybe a
Nothing
signatureCompatible13 PubKey
pub HashAndSignatureAlgorithm
hs = PubKey -> HashAndSignatureAlgorithm -> Bool
signatureCompatible PubKey
pub HashAndSignatureAlgorithm
hs
hashSigToCertType :: HashAndSignatureAlgorithm -> Maybe CertificateType
hashSigToCertType :: HashAndSignatureAlgorithm -> Maybe CertificateType
hashSigToCertType (HashAlgorithm
_, SignatureAlgorithm
SignatureRSA) = forall a. a -> Maybe a
Just CertificateType
CertificateType_RSA_Sign
hashSigToCertType (HashAlgorithm
_, SignatureAlgorithm
SignatureDSS) = forall a. a -> Maybe a
Just CertificateType
CertificateType_DSS_Sign
hashSigToCertType (HashAlgorithm
_, SignatureAlgorithm
SignatureECDSA) = forall a. a -> Maybe a
Just CertificateType
CertificateType_ECDSA_Sign
hashSigToCertType (HashAlgorithm
HashIntrinsic, SignatureAlgorithm
SignatureRSApssRSAeSHA256)
= forall a. a -> Maybe a
Just CertificateType
CertificateType_RSA_Sign
hashSigToCertType (HashAlgorithm
HashIntrinsic, SignatureAlgorithm
SignatureRSApssRSAeSHA384)
= forall a. a -> Maybe a
Just CertificateType
CertificateType_RSA_Sign
hashSigToCertType (HashAlgorithm
HashIntrinsic, SignatureAlgorithm
SignatureRSApssRSAeSHA512)
= forall a. a -> Maybe a
Just CertificateType
CertificateType_RSA_Sign
hashSigToCertType (HashAlgorithm
HashIntrinsic, SignatureAlgorithm
SignatureEd25519)
= forall a. a -> Maybe a
Just CertificateType
CertificateType_Ed25519_Sign
hashSigToCertType (HashAlgorithm
HashIntrinsic, SignatureAlgorithm
SignatureEd448)
= forall a. a -> Maybe a
Just CertificateType
CertificateType_Ed448_Sign
hashSigToCertType HashAndSignatureAlgorithm
_ = 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) -> 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
(Version
_, Maybe HashAndSignatureAlgorithm
Nothing) -> IO Bool
doVerify
(Version
_, Just HashAndSignatureAlgorithm
_) -> 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 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
-> 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 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)
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 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
-> 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 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
_ -> 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
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (Hash -> HashCtx
hashInit Hash
SHA1, SignatureParams
DSSParams, ByteString -> HashCtx -> ByteString
generateCertificateVerify_SSL_DSS)
PubKey
_ -> forall (m :: * -> *) a. MonadIO m => TLSError -> m a
throwCore forall a b. (a -> b) -> a -> b
$ [Char] -> TLSError
Error_Misc ([Char]
"unsupported CertificateVerify signature for SSL3: " forall a. [a] -> [a] -> [a]
++ PubKey -> [Char]
pubkeyType PubKey
pubKey)
Just ByteString
masterSecret <- forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> Maybe ByteString
hstMasterSecret
forall (m :: * -> *) a. Monad m => a -> m a
return (SignatureParams
params, ByteString -> HashCtx -> ByteString
generateCV_SSL ByteString
masterSecret forall a b. (a -> b) -> a -> b
$ HashCtx -> ByteString -> HashCtx
hashUpdate HashCtx
hashCtx ByteString
msgs)
| Version
usedVersion forall a. Eq a => a -> a -> Bool
== Version
TLS10 Bool -> Bool -> Bool
|| Version
usedVersion forall a. Eq a => a -> a -> Bool
== Version
TLS11 =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SignatureParams -> ByteString -> CertVerifyData
buildVerifyData (PubKey -> Maybe HashAndSignatureAlgorithm -> SignatureParams
signatureParams PubKey
pubKey forall a. Maybe a
Nothing) ByteString
msgs
| Bool
otherwise = 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) -> forall a. HasCallStack => [Char] -> a
error ([Char]
"unimplemented RSA signature hash type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show HashAlgorithm
hsh)
Just (HashAlgorithm
_ , SignatureAlgorithm
sigAlg) -> forall a. HasCallStack => [Char] -> a
error ([Char]
"signature algorithm is incompatible with RSA: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
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) -> forall a. HasCallStack => [Char] -> a
error [Char]
"invalid DSA hash choice, only SHA1 allowed"
Just (HashAlgorithm
_ , SignatureAlgorithm
sigAlg) -> forall a. HasCallStack => [Char] -> a
error ([Char]
"signature algorithm is incompatible with DSS: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
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) -> forall a. HasCallStack => [Char] -> a
error ([Char]
"unimplemented ECDSA signature hash type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show HashAlgorithm
hsh)
Just (HashAlgorithm
_ , SignatureAlgorithm
sigAlg) -> forall a. HasCallStack => [Char] -> a
error ([Char]
"signature algorithm is incompatible with ECDSA: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
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) -> forall a. HasCallStack => [Char] -> a
error ([Char]
"unimplemented Ed25519 signature hash type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show HashAlgorithm
hsh)
Just (HashAlgorithm
_ , SignatureAlgorithm
sigAlg) -> forall a. HasCallStack => [Char] -> a
error ([Char]
"signature algorithm is incompatible with Ed25519: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
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) -> forall a. HasCallStack => [Char] -> a
error ([Char]
"unimplemented Ed448 signature hash type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show HashAlgorithm
hsh)
Just (HashAlgorithm
_ , SignatureAlgorithm
sigAlg) -> forall a. HasCallStack => [Char] -> a
error ([Char]
"signature algorithm is incompatible with Ed448: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SignatureAlgorithm
sigAlg)
signatureParams PubKey
pk Maybe HashAndSignatureAlgorithm
_ = forall a. HasCallStack => [Char] -> a
error ([Char]
"signatureParams: " forall a. [a] -> [a] -> [a]
++ PubKey -> [Char]
pubkeyType PubKey
pk forall a. [a] -> [a] -> [a]
++ [Char]
" 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 <- forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt Role
isClientContext
Maybe HashAndSignatureAlgorithm -> ByteString -> DigitallySigned
DigitallySigned Maybe HashAndSignatureAlgorithm
malg 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 <- 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) -> forall a. HasCallStack => [Char] -> a
error [Char]
"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 -> forall a. HasCallStack => [Char] -> a
error [Char]
"expecting different signature algorithm"
(Version
_, Maybe HashAndSignatureAlgorithm
Nothing) -> SignatureParams -> ByteString -> CertVerifyData
buildVerifyData (PubKey -> Maybe HashAndSignatureAlgorithm -> SignatureParams
signatureParams PubKey
pubKey forall a. Maybe a
Nothing) ByteString
toVerifyData
(Version
_, Just HashAndSignatureAlgorithm
_) -> forall a. HasCallStack => [Char] -> a
error [Char]
"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
-> IO DigitallySigned
digitallySignDHParams :: Context
-> ServerDHParams
-> PubKey
-> Maybe HashAndSignatureAlgorithm
-> IO DigitallySigned
digitallySignDHParams Context
ctx ServerDHParams
serverParams PubKey
pubKey Maybe HashAndSignatureAlgorithm
mhash = do
ByteString
dhParamsData <- forall b. Context -> (ClientRandom -> ServerRandom -> b) -> IO b
withClientAndServerRandom Context
ctx 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
-> IO DigitallySigned
digitallySignECDHParams :: Context
-> ServerECDHParams
-> PubKey
-> Maybe HashAndSignatureAlgorithm
-> IO DigitallySigned
digitallySignECDHParams Context
ctx ServerECDHParams
serverParams PubKey
pubKey Maybe HashAndSignatureAlgorithm
mhash = do
ByteString
ecdhParamsData <- forall b. Context -> (ClientRandom -> ServerRandom -> b) -> IO b
withClientAndServerRandom Context
ctx 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 <- forall b. Context -> (ClientRandom -> ServerRandom -> b) -> IO b
withClientAndServerRandom Context
ctx 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 <- forall b. Context -> (ClientRandom -> ServerRandom -> b) -> IO b
withClientAndServerRandom Context
ctx 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 :: forall b. Context -> (ClientRandom -> ServerRandom -> b) -> IO b
withClientAndServerRandom Context
ctx ClientRandom -> ServerRandom -> b
f = do
(ClientRandom
cran, ServerRandom
sran) <- forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> ClientRandom
hstClientRandom
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. [Char] -> Maybe a -> a
fromJust [Char]
"withClientAndServer : server random" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> Maybe ServerRandom
hstServerRandom)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ClientRandom -> ServerRandom -> b
f ClientRandom
cran ServerRandom
sran
checkSupportedHashSignature :: Context -> Maybe HashAndSignatureAlgorithm -> IO ()
checkSupportedHashSignature :: Context -> Maybe HashAndSignatureAlgorithm -> IO ()
checkSupportedHashSignature Context
_ Maybe HashAndSignatureAlgorithm
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkSupportedHashSignature Context
ctx (Just HashAndSignatureAlgorithm
hs) =
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HashAndSignatureAlgorithm
hs forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Supported -> [HashAndSignatureAlgorithm]
supportedHashSignatures (Context -> Supported
ctxSupported Context
ctx)) forall a b. (a -> b) -> a -> b
$
let msg :: [Char]
msg = [Char]
"unsupported hash and signature algorithm: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show HashAndSignatureAlgorithm
hs
in forall (m :: * -> *) a. MonadIO m => TLSError -> m a
throwCore forall a b. (a -> b) -> a -> b
$ ([Char], Bool, AlertDescription) -> TLSError
Error_Protocol ([Char]
msg, Bool
True, AlertDescription
IllegalParameter)