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
|
{-# LANGUAGE OverloadedStrings #-}
module Network.TLS.Handshake.Client (
handshakeClient,
handshakeClientWith,
postHandshakeAuthClientWith,
) where
import Network.TLS.Context.Internal
import Network.TLS.Crypto
import Network.TLS.Extension
import Network.TLS.Handshake.Client.ClientHello
import Network.TLS.Handshake.Client.Common
import Network.TLS.Handshake.Client.ServerHello
import Network.TLS.Handshake.Client.TLS12
import Network.TLS.Handshake.Client.TLS13
import Network.TLS.Handshake.Common13
import Network.TLS.Handshake.State
import Network.TLS.Handshake.State13
import Network.TLS.IO
import Network.TLS.Imports
import Network.TLS.Measurement
import Network.TLS.Parameters
import Network.TLS.State
import Network.TLS.Struct
----------------------------------------------------------------
handshakeClientWith :: ClientParams -> Context -> Handshake -> IO ()
handshakeClientWith cparams ctx HelloRequest = handshakeClient cparams ctx
handshakeClientWith _ _ _ =
throwCore $
Error_Protocol
"unexpected handshake message received in handshakeClientWith"
HandshakeFailure
-- client part of handshake. send a bunch of handshake of client
-- values intertwined with response from the server.
handshakeClient :: ClientParams -> Context -> IO ()
handshakeClient cparams ctx = do
groups <- case clientSessions cparams of
[] -> return groupsSupported
(_, sdata) : _ -> case sessionGroup sdata of
Nothing -> return [] -- TLS 1.2 or earlier
Just grp
| grp `elem` groupsSupported -> return $ grp : filter (/= grp) groupsSupported
| otherwise -> throwCore $ Error_Misc "groupsSupported is incorrect"
handshake cparams ctx groups Nothing
where
groupsSupported = supportedGroups (ctxSupported ctx)
-- https://tools.ietf.org/html/rfc8446#section-4.1.2 says:
-- "The client will also send a
-- ClientHello when the server has responded to its ClientHello with a
-- HelloRetryRequest. In that case, the client MUST send the same
-- ClientHello without modification, except as follows:"
--
-- So, the ClientRandom in the first client hello is necessary.
handshake
:: ClientParams
-> Context
-> [Group]
-> Maybe (ClientRandom, Session, Version)
-> IO ()
handshake cparams ctx groups mparams = do
--------------------------------
-- Sending ClientHello
pskinfo@(_, _, rtt0) <- getPreSharedKeyInfo cparams ctx
when rtt0 $ modifyTLS13State ctx $ \st -> st{tls13st0RTT = True}
let async = rtt0 && not (ctxQUICMode ctx)
when async $ do
chSentTime <- getCurrentTimeFromBase
asyncServerHello13 cparams ctx groupToSend chSentTime
updateMeasure ctx incrementNbHandshakes
crand <- sendClientHello cparams ctx groups mparams pskinfo
--------------------------------
-- Receiving ServerHello
unless async $ do
(ver, hss, hrr) <- receiveServerHello cparams ctx mparams
--------------------------------
-- Switching to HRR, TLS 1.2 or TLS 1.3
case ver of
TLS13
| hrr ->
helloRetry cparams ctx mparams ver crand $ drop 1 groups
| otherwise -> do
recvServerSecondFlight13 cparams ctx groupToSend
sendClientSecondFlight13 cparams ctx
_
| rtt0 ->
throwCore $
Error_Protocol
"server denied TLS 1.3 when connecting with early data"
HandshakeFailure
| otherwise -> do
recvServerFirstFlight12 cparams ctx hss
sendClientSecondFlight12 cparams ctx
recvServerSecondFlight12 cparams ctx
where
groupToSend = listToMaybe groups
receiveServerHello
:: ClientParams
-> Context
-> Maybe (ClientRandom, Session, Version)
-> IO (Version, [Handshake], Bool)
receiveServerHello cparams ctx mparams = do
chSentTime <- getCurrentTimeFromBase
hss <- recvServerHello cparams ctx
setRTT ctx chSentTime
ver <- usingState_ ctx getVersion
unless (maybe True (\(_, _, v) -> v == ver) mparams) $
throwCore $
Error_Protocol "version changed after hello retry" IllegalParameter
-- recvServerHello sets TLS13HRR according to the server random.
-- For 1st server hello, getTLS13HR returns True if it is HRR and
-- False otherwise. For 2nd server hello, getTLS13HR returns
-- False since it is NOT HRR.
hrr <- usingState_ ctx getTLS13HRR
return (ver, hss, hrr)
----------------------------------------------------------------
helloRetry
:: ClientParams
-> Context
-> Maybe a
-> Version
-> ClientRandom
-> [Group]
-> IO ()
helloRetry cparams ctx mparams ver crand groups = do
when (null groups) $
throwCore $
Error_Protocol "group is exhausted in the client side" IllegalParameter
when (isJust mparams) $
throwCore $
Error_Protocol "server sent too many hello retries" UnexpectedMessage
mks <- usingState_ ctx getTLS13KeyShare
case mks of
Just (KeyShareHRR selectedGroup)
| selectedGroup `elem` groups -> do
usingHState ctx $ setTLS13HandshakeMode HelloRetryRequest
clearTxRecordState ctx
let cparams' = cparams{clientUseEarlyData = False}
runPacketFlight ctx $ sendChangeCipherSpec13 ctx
clientSession <- tls13stSession <$> getTLS13State ctx
handshake cparams' ctx [selectedGroup] (Just (crand, clientSession, ver))
| otherwise ->
throwCore $
Error_Protocol "server-selected group is not supported" IllegalParameter
Just _ -> error "handshake: invalid KeyShare value"
Nothing ->
throwCore $
Error_Protocol
"key exchange not implemented in HRR, expected key_share extension"
HandshakeFailure
|
