-- |
-- Module      : Network.TLS.Sending13
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- the Sending module contains calls related to marshalling packets according
-- to the TLS state
--
module Network.TLS.Sending13
       ( encodePacket13
       , updateHandshake13
       ) where

import Network.TLS.Context.Internal
import Network.TLS.Handshake.Random
import Network.TLS.Handshake.State
import Network.TLS.Handshake.State13
import Network.TLS.Imports
import Network.TLS.Packet
import Network.TLS.Packet13
import Network.TLS.Record
import Network.TLS.Sending
import Network.TLS.Struct
import Network.TLS.Struct13
import Network.TLS.Util

import qualified Data.ByteString as B

encodePacket13 :: Context -> Packet13 -> IO (Either TLSError ByteString)
encodePacket13 :: Context -> Packet13 -> IO (Either TLSError ByteString)
encodePacket13 Context
ctx Packet13
pkt = do
    let pt :: ProtocolType
pt = Packet13 -> ProtocolType
contentType Packet13
pkt
        mkRecord :: ByteString -> Record Plaintext
mkRecord ByteString
bs = ProtocolType -> Version -> Fragment Plaintext -> Record Plaintext
forall a. ProtocolType -> Version -> Fragment a -> Record a
Record ProtocolType
pt Version
TLS12 (ByteString -> Fragment Plaintext
fragmentPlaintext ByteString
bs)
    [Record Plaintext]
records <- (ByteString -> Record Plaintext)
-> [ByteString] -> [Record Plaintext]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Record Plaintext
mkRecord ([ByteString] -> [Record Plaintext])
-> IO [ByteString] -> IO [Record Plaintext]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> Int -> Packet13 -> IO [ByteString]
packetToFragments Context
ctx Int
16384 Packet13
pkt
    ([ByteString] -> ByteString)
-> Either TLSError [ByteString] -> Either TLSError ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ByteString] -> ByteString
B.concat (Either TLSError [ByteString] -> Either TLSError ByteString)
-> IO (Either TLSError [ByteString])
-> IO (Either TLSError ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Record Plaintext]
-> (Record Plaintext -> IO (Either TLSError ByteString))
-> IO (Either TLSError [ByteString])
forall (m :: * -> *) a l b.
Monad m =>
[a] -> (a -> m (Either l b)) -> m (Either l [b])
forEitherM [Record Plaintext]
records (Context -> Record Plaintext -> IO (Either TLSError ByteString)
encodeRecord Context
ctx)

prepareRecord :: Context -> RecordM a -> IO (Either TLSError a)
prepareRecord :: Context -> RecordM a -> IO (Either TLSError a)
prepareRecord = Context -> RecordM a -> IO (Either TLSError a)
forall a. Context -> RecordM a -> IO (Either TLSError a)
runTxState

encodeRecord :: Context -> Record Plaintext -> IO (Either TLSError ByteString)
encodeRecord :: Context -> Record Plaintext -> IO (Either TLSError ByteString)
encodeRecord Context
ctx = Context -> RecordM ByteString -> IO (Either TLSError ByteString)
forall a. Context -> RecordM a -> IO (Either TLSError a)
prepareRecord Context
ctx (RecordM ByteString -> IO (Either TLSError ByteString))
-> (Record Plaintext -> RecordM ByteString)
-> Record Plaintext
-> IO (Either TLSError ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record Plaintext -> RecordM ByteString
encodeRecordM

packetToFragments :: Context -> Int -> Packet13 -> IO [ByteString]
packetToFragments :: Context -> Int -> Packet13 -> IO [ByteString]
packetToFragments Context
ctx Int
len (Handshake13 [Handshake13]
hss)  =
    Int -> ByteString -> [ByteString]
getChunks Int
len (ByteString -> [ByteString])
-> ([ByteString] -> ByteString) -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
B.concat ([ByteString] -> [ByteString])
-> IO [ByteString] -> IO [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Handshake13 -> IO ByteString) -> [Handshake13] -> IO [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Context -> Handshake13 -> IO ByteString
updateHandshake13 Context
ctx) [Handshake13]
hss
packetToFragments Context
_   Int
_   (Alert13 [(AlertLevel, AlertDescription)]
a)        = [ByteString] -> IO [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return [[(AlertLevel, AlertDescription)] -> ByteString
encodeAlerts [(AlertLevel, AlertDescription)]
a]
packetToFragments Context
_   Int
_   (AppData13 ByteString
x)      = [ByteString] -> IO [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString
x]
packetToFragments Context
_   Int
_   Packet13
ChangeCipherSpec13 = [ByteString] -> IO [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString
encodeChangeCipherSpec]

updateHandshake13 :: Context -> Handshake13 -> IO ByteString
updateHandshake13 :: Context -> Handshake13 -> IO ByteString
updateHandshake13 Context
ctx Handshake13
hs
    | Handshake13 -> Bool
isIgnored Handshake13
hs = ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
encoded
    | Bool
otherwise    = Context -> HandshakeM ByteString -> IO ByteString
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx (HandshakeM ByteString -> IO ByteString)
-> HandshakeM ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ do
        Bool -> HandshakeM () -> HandshakeM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Handshake13 -> Bool
isHRR Handshake13
hs) HandshakeM ()
wrapAsMessageHash13
        ByteString -> HandshakeM ()
updateHandshakeDigest ByteString
encoded
        ByteString -> HandshakeM ()
addHandshakeMessage ByteString
encoded
        ByteString -> HandshakeM ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
encoded
  where
    encoded :: ByteString
encoded = Handshake13 -> ByteString
encodeHandshake13 Handshake13
hs

    isHRR :: Handshake13 -> Bool
isHRR (ServerHello13 ServerRandom
srand Session
_ CipherID
_ [ExtensionRaw]
_) = ServerRandom -> Bool
isHelloRetryRequest ServerRandom
srand
    isHRR Handshake13
_                           = Bool
False

    isIgnored :: Handshake13 -> Bool
isIgnored NewSessionTicket13{} = Bool
True
    isIgnored KeyUpdate13{}        = Bool
True
    isIgnored Handshake13
_                    = Bool
False