1-- |
2-- Module      : Network.TLS.Sending13
3-- License     : BSD-style
4-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
5-- Stability   : experimental
6-- Portability : unknown
7--
8-- the Sending module contains calls related to marshalling packets according
9-- to the TLS state
10--
11module Network.TLS.Sending13
12       ( encodePacket13
13       , updateHandshake13
14       ) where
15
16import Network.TLS.Context.Internal
17import Network.TLS.Handshake.Random
18import Network.TLS.Handshake.State
19import Network.TLS.Handshake.State13
20import Network.TLS.Imports
21import Network.TLS.Packet
22import Network.TLS.Packet13
23import Network.TLS.Record
24import Network.TLS.Sending
25import Network.TLS.Struct
26import Network.TLS.Struct13
27import Network.TLS.Util
28
29import qualified Data.ByteString as B
30
31encodePacket13 :: Context -> Packet13 -> IO (Either TLSError ByteString)
32encodePacket13 ctx pkt = do
33    let pt = contentType pkt
34        mkRecord bs = Record pt TLS12 (fragmentPlaintext bs)
35    records <- map mkRecord <$> packetToFragments ctx 16384 pkt
36    fmap B.concat <$> forEitherM records (encodeRecord ctx)
37
38prepareRecord :: Context -> RecordM a -> IO (Either TLSError a)
39prepareRecord = runTxState
40
41encodeRecord :: Context -> Record Plaintext -> IO (Either TLSError ByteString)
42encodeRecord ctx = prepareRecord ctx . encodeRecordM
43
44packetToFragments :: Context -> Int -> Packet13 -> IO [ByteString]
45packetToFragments ctx len (Handshake13 hss)  =
46    getChunks len . B.concat <$> mapM (updateHandshake13 ctx) hss
47packetToFragments _   _   (Alert13 a)        = return [encodeAlerts a]
48packetToFragments _   _   (AppData13 x)      = return [x]
49packetToFragments _   _   ChangeCipherSpec13 = return [encodeChangeCipherSpec]
50
51updateHandshake13 :: Context -> Handshake13 -> IO ByteString
52updateHandshake13 ctx hs
53    | isIgnored hs = return encoded
54    | otherwise    = usingHState ctx $ do
55        when (isHRR hs) wrapAsMessageHash13
56        updateHandshakeDigest encoded
57        addHandshakeMessage encoded
58        return encoded
59  where
60    encoded = encodeHandshake13 hs
61
62    isHRR (ServerHello13 srand _ _ _) = isHelloRetryRequest srand
63    isHRR _                           = False
64
65    isIgnored NewSessionTicket13{} = True
66    isIgnored KeyUpdate13{}        = True
67    isIgnored _                    = False
68