    -- |
    -- 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 ctx :: Context
    ctx pkt :: Packet13
    pkt = do
        let pt :: ProtocolType
    pt = Packet13 -> ProtocolType
    contentType Packet13
    pkt
            mkRecord :: ByteString -> Record Plaintext
    mkRecord bs :: 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 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 ctx :: 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 ctx :: Context
    ctx len :: Int
    len (Handshake13 hss :: [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 _   _   (Alert13 a :: [(AlertLevel, AlertDescription)]
    a)        = [ByteString] -> IO [ByteString]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [[(AlertLevel, AlertDescription)] -> ByteString
    encodeAlerts [(AlertLevel, AlertDescription)]
    a]
    packetToFragments _   _   (AppData13 x :: ByteString
    x)      = [ByteString] -> IO [ByteString]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ByteString
    x]
    packetToFragments _   _   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 ctx :: Context
    ctx hs :: 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 srand :: ServerRandom
    srand _ _ _) = ServerRandom -> Bool
    isHelloRetryRequest ServerRandom
    srand
        isHRR _                           = Bool
    False

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