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
|
{-# LANGUAGE FlexibleInstances #-}
-- |
-- Module : Network.TLS.Handshake.Key
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : unknown
--
-- functions for RSA operations
--
module Network.TLS.Handshake.Key
( encryptRSA
, signPrivate
, decryptRSA
, verifyPublic
, generateDHE
, generateECDHE
, generateECDHEShared
, generateFFDHE
, generateFFDHEShared
, versionCompatible
, isDigitalSignaturePair
, checkDigitalSignatureKey
, getLocalPublicKey
, satisfiesEcPredicate
, logKey
) where
import Control.Monad.State.Strict
import qualified Data.ByteString as B
import Network.TLS.Handshake.State
import Network.TLS.State (withRNG, getVersion)
import Network.TLS.Crypto
import Network.TLS.Types
import Network.TLS.Context.Internal
import Network.TLS.Imports
import Network.TLS.Struct
import Network.TLS.X509
{- if the RSA encryption fails we just return an empty bytestring, and let the protocol
- fail by itself; however it would be probably better to just report it since it's an internal problem.
-}
encryptRSA :: Context -> ByteString -> IO ByteString
encryptRSA ctx content = do
publicKey <- usingHState ctx getRemotePublicKey
usingState_ ctx $ do
v <- withRNG $ kxEncrypt publicKey content
case v of
Left err -> error ("rsa encrypt failed: " ++ show err)
Right econtent -> return econtent
signPrivate :: Context -> Role -> SignatureParams -> ByteString -> IO ByteString
signPrivate ctx _ params content = do
(publicKey, privateKey) <- usingHState ctx getLocalPublicPrivateKeys
usingState_ ctx $ do
r <- withRNG $ kxSign privateKey publicKey params content
case r of
Left err -> error ("sign failed: " ++ show err)
Right econtent -> return econtent
decryptRSA :: Context -> ByteString -> IO (Either KxError ByteString)
decryptRSA ctx econtent = do
(_, privateKey) <- usingHState ctx getLocalPublicPrivateKeys
usingState_ ctx $ do
ver <- getVersion
let cipher = if ver < TLS10 then econtent else B.drop 2 econtent
withRNG $ kxDecrypt privateKey cipher
verifyPublic :: Context -> SignatureParams -> ByteString -> ByteString -> IO Bool
verifyPublic ctx params econtent sign = do
publicKey <- usingHState ctx getRemotePublicKey
return $ kxVerify publicKey params econtent sign
generateDHE :: Context -> DHParams -> IO (DHPrivate, DHPublic)
generateDHE ctx dhp = usingState_ ctx $ withRNG $ dhGenerateKeyPair dhp
generateECDHE :: Context -> Group -> IO (GroupPrivate, GroupPublic)
generateECDHE ctx grp = usingState_ ctx $ withRNG $ groupGenerateKeyPair grp
generateECDHEShared :: Context -> GroupPublic -> IO (Maybe (GroupPublic, GroupKey))
generateECDHEShared ctx pub = usingState_ ctx $ withRNG $ groupGetPubShared pub
generateFFDHE :: Context -> Group -> IO (DHParams, DHPrivate, DHPublic)
generateFFDHE ctx grp = usingState_ ctx $ withRNG $ dhGroupGenerateKeyPair grp
generateFFDHEShared :: Context -> Group -> DHPublic -> IO (Maybe (DHPublic, DHKey))
generateFFDHEShared ctx grp pub = usingState_ ctx $ withRNG $ dhGroupGetPubShared grp pub
isDigitalSignatureKey :: PubKey -> Bool
isDigitalSignatureKey (PubKeyRSA _) = True
isDigitalSignatureKey (PubKeyDSA _) = True
isDigitalSignatureKey (PubKeyEC _) = True
isDigitalSignatureKey (PubKeyEd25519 _) = True
isDigitalSignatureKey (PubKeyEd448 _) = True
isDigitalSignatureKey _ = False
versionCompatible :: PubKey -> Version -> Bool
versionCompatible (PubKeyRSA _) _ = True
versionCompatible (PubKeyDSA _) v = v <= TLS12
versionCompatible (PubKeyEC _) v = v >= TLS10
versionCompatible (PubKeyEd25519 _) v = v >= TLS12
versionCompatible (PubKeyEd448 _) v = v >= TLS12
versionCompatible _ _ = False
-- | Test whether the argument is a public key supported for signature at the
-- specified TLS version. This also accepts a key for RSA encryption. This
-- test is performed by clients or servers before verifying a remote
-- Certificate Verify.
checkDigitalSignatureKey :: MonadIO m => Version -> PubKey -> m ()
checkDigitalSignatureKey usedVersion key = do
unless (isDigitalSignatureKey key) $
throwCore $ Error_Protocol ("unsupported remote public key type", True, HandshakeFailure)
unless (key `versionCompatible` usedVersion) $
throwCore $ Error_Protocol (show usedVersion ++ " has no support for " ++ pubkeyType key, True, IllegalParameter)
-- | Test whether the argument is matching key pair supported for signature.
-- This also accepts material for RSA encryption. This test is performed by
-- servers or clients before using a credential from the local configuration.
isDigitalSignaturePair :: (PubKey, PrivKey) -> Bool
isDigitalSignaturePair keyPair =
case keyPair of
(PubKeyRSA _, PrivKeyRSA _) -> True
(PubKeyDSA _, PrivKeyDSA _) -> True
(PubKeyEC _, PrivKeyEC k) -> kxSupportedPrivKeyEC k
(PubKeyEd25519 _, PrivKeyEd25519 _) -> True
(PubKeyEd448 _, PrivKeyEd448 _) -> True
_ -> False
getLocalPublicKey :: MonadIO m => Context -> m PubKey
getLocalPublicKey ctx =
usingHState ctx (fst <$> getLocalPublicPrivateKeys)
-- | Test whether the public key satisfies a predicate about the elliptic curve.
-- When the public key is not suitable for ECDSA, like RSA for instance, the
-- predicate is not used and the result is 'True'.
satisfiesEcPredicate :: (Group -> Bool) -> PubKey -> Bool
satisfiesEcPredicate p (PubKeyEC ecPub) =
maybe False p $ findEllipticCurveGroup ecPub
satisfiesEcPredicate _ _ = True
----------------------------------------------------------------
class LogLabel a where
labelAndKey :: a -> (String, ByteString)
instance LogLabel MasterSecret where
labelAndKey (MasterSecret key) = ("CLIENT_RANDOM", key)
instance LogLabel (ClientTrafficSecret EarlySecret) where
labelAndKey (ClientTrafficSecret key) = ("CLIENT_EARLY_TRAFFIC_SECRET", key)
instance LogLabel (ServerTrafficSecret HandshakeSecret) where
labelAndKey (ServerTrafficSecret key) = ("SERVER_HANDSHAKE_TRAFFIC_SECRET", key)
instance LogLabel (ClientTrafficSecret HandshakeSecret) where
labelAndKey (ClientTrafficSecret key) = ("CLIENT_HANDSHAKE_TRAFFIC_SECRET", key)
instance LogLabel (ServerTrafficSecret ApplicationSecret) where
labelAndKey (ServerTrafficSecret key) = ("SERVER_TRAFFIC_SECRET_0", key)
instance LogLabel (ClientTrafficSecret ApplicationSecret) where
labelAndKey (ClientTrafficSecret key) = ("CLIENT_TRAFFIC_SECRET_0", key)
-- NSS Key Log Format
-- See https://developer.mozilla.org/en-US/docs/Mozilla/Projects/NSS/Key_Log_Format
logKey :: LogLabel a => Context -> a -> IO ()
logKey ctx logkey = do
mhst <- getHState ctx
case mhst of
Nothing -> return ()
Just hst -> do
let cr = unClientRandom $ hstClientRandom hst
(label,key) = labelAndKey logkey
ctxKeyLogger ctx $ label ++ " " ++ dump cr ++ " " ++ dump key
where
dump = init . tail . showBytesHex
|
