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