    module Network.TLS.IO.Encode (
        encodePacket12,
        encodePacket13,
        updateHandshake12,
        updateHandshake13,
    ) where

    import Control.Concurrent.MVar
    import Control.Monad.State.Strict
    import qualified Data.ByteString as B
    import Data.IORef

    import Network.TLS.Cipher
    import Network.TLS.Context.Internal
    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.Parameters
    import Network.TLS.Record
    import Network.TLS.State
    import Network.TLS.Struct
    import Network.TLS.Struct13
    import Network.TLS.Types (Role (..))
    import Network.TLS.Util

    -- | encodePacket transform a packet into marshalled data related to current state
    -- and updating state on the go
    encodePacket12
        :: Monoid bytes
        => Context
        -> RecordLayer bytes
        -> Packet
        -> IO (Either TLSError bytes)
    encodePacket12 :: forall bytes.
    Monoid bytes =>
    Context
    -> RecordLayer bytes -> Packet -> IO (Either TLSError bytes)
    encodePacket12 Context
    ctx RecordLayer bytes
    recordLayer Packet
    pkt = do
        (ver, _) <- Context -> IO (Version, Bool)
    decideRecordVersion Context
    ctx
        let pt = Packet -> ProtocolType
    packetType Packet
    pkt
            mkRecord ByteString
    bs = ProtocolType -> Version -> Fragment Plaintext -> Record Plaintext
    forall a. ProtocolType -> Version -> Fragment a -> Record a
    Record ProtocolType
    pt Version
    ver (ByteString -> Fragment Plaintext
    fragmentPlaintext ByteString
    bs)
        mlen <- getPeerRecordLimit ctx
        records <- map mkRecord <$> packetToFragments12 ctx mlen pkt
        bs <- fmap mconcat <$> forEitherM records (recordEncode12 recordLayer ctx)
        when (pkt == ChangeCipherSpec) $ switchTxEncryption ctx
        return bs

    -- Decompose handshake packets into fragments of the specified length.  AppData
    -- packets are not fragmented here but by callers of sendPacket, so that the
    -- empty-packet countermeasure may be applied to each fragment independently.
    packetToFragments12 :: Context -> Maybe Int -> Packet -> IO [ByteString]
    packetToFragments12 :: Context -> Maybe Int -> Packet -> IO [ByteString]
    packetToFragments12 Context
    ctx Maybe Int
    mlen (Handshake [Handshake]
    hss) =
        Maybe Int -> ByteString -> [ByteString]
    getChunks Maybe Int
    mlen (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
    <$> (Handshake -> IO ByteString) -> [Handshake] -> IO [ByteString]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Context -> Handshake -> IO ByteString
    updateHandshake12 Context
    ctx) [Handshake]
    hss
    packetToFragments12 Context
    _ Maybe Int
    _ (Alert [(AlertLevel, AlertDescription)]
    a) = [ByteString] -> IO [ByteString]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [[(AlertLevel, AlertDescription)] -> ByteString
    encodeAlerts [(AlertLevel, AlertDescription)]
    a]
    packetToFragments12 Context
    _ Maybe Int
    _ Packet
    ChangeCipherSpec = [ByteString] -> IO [ByteString]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ByteString
    encodeChangeCipherSpec]
    packetToFragments12 Context
    _ Maybe Int
    _ (AppData ByteString
    x) = [ByteString] -> IO [ByteString]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ByteString
    x]

    switchTxEncryption :: Context -> IO ()
    switchTxEncryption :: Context -> IO ()
    switchTxEncryption Context
    ctx = do
        tx <- Context -> HandshakeM RecordState -> IO RecordState
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx (Maybe RecordState -> RecordState
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe RecordState -> RecordState)
    -> HandshakeM (Maybe RecordState) -> HandshakeM RecordState
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (HandshakeState -> Maybe RecordState)
    -> HandshakeM (Maybe RecordState)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets HandshakeState -> Maybe RecordState
    hstPendingTxState)
        (ver, role) <- usingState_ ctx $ do
            v <- getVersion
            r <- getRole
            return (v, r)
        liftIO $ modifyMVar_ (ctxTxRecordState ctx) (\RecordState
    _ -> RecordState -> IO RecordState
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return RecordState
    tx)
        -- set empty packet counter measure if condition are met
        when
            ( ver <= TLS10
                && role == ClientRole
                && isCBC tx
                && supportedEmptyPacket (ctxSupported ctx)
            )
            $ liftIO
            $ writeIORef (ctxNeedEmptyPacket ctx) True
      where
        isCBC :: RecordState -> Bool
    isCBC RecordState
    tx = Bool -> (Cipher -> Bool) -> Maybe Cipher -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False (\Cipher
    c -> Bulk -> Int
    bulkBlockSize (Cipher -> Bulk
    cipherBulk Cipher
    c) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0) (RecordState -> Maybe Cipher
    stCipher RecordState
    tx)

    updateHandshake12 :: Context -> Handshake -> IO ByteString
    updateHandshake12 :: Context -> Handshake -> IO ByteString
    updateHandshake12 Context
    ctx Handshake
    hs = do
        Context -> HandshakeM () -> IO ()
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx (HandshakeM () -> IO ()) -> HandshakeM () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            Bool -> HandshakeM () -> HandshakeM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Handshake -> Bool
    certVerifyHandshakeMaterial Handshake
    hs) (HandshakeM () -> HandshakeM ()) -> HandshakeM () -> HandshakeM ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> HandshakeM ()
    addHandshakeMessage ByteString
    encoded
            Bool -> HandshakeM () -> HandshakeM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Handshake -> Bool
    finishedHandshakeMaterial Handshake
    hs) (HandshakeM () -> HandshakeM ()) -> HandshakeM () -> HandshakeM ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> HandshakeM ()
    updateHandshakeDigest ByteString
    encoded
        ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    encoded
      where
        encoded :: ByteString
    encoded = Handshake -> ByteString
    encodeHandshake Handshake
    hs

    ----------------------------------------------------------------

    encodePacket13
        :: Monoid bytes
        => Context
        -> RecordLayer bytes
        -> Packet13
        -> IO (Either TLSError bytes)
    encodePacket13 :: forall bytes.
    Monoid bytes =>
    Context
    -> RecordLayer bytes -> Packet13 -> IO (Either TLSError bytes)
    encodePacket13 Context
    ctx RecordLayer bytes
    recordLayer 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)
        mlen <- Context -> IO (Maybe Int)
    getPeerRecordLimit Context
    ctx
        records <- map mkRecord <$> packetToFragments13 ctx mlen pkt
        fmap mconcat <$> forEitherM records (recordEncode13 recordLayer ctx)

    packetToFragments13 :: Context -> Maybe Int -> Packet13 -> IO [ByteString]
    packetToFragments13 :: Context -> Maybe Int -> Packet13 -> IO [ByteString]
    packetToFragments13 Context
    ctx Maybe Int
    mlen (Handshake13 [Handshake13]
    hss) =
        Maybe Int -> ByteString -> [ByteString]
    getChunks Maybe Int
    mlen (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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Context -> Handshake13 -> IO ByteString
    updateHandshake13 Context
    ctx) [Handshake13]
    hss
    packetToFragments13 Context
    _ Maybe Int
    _ (Alert13 [(AlertLevel, AlertDescription)]
    a) = [ByteString] -> IO [ByteString]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [[(AlertLevel, AlertDescription)] -> ByteString
    encodeAlerts [(AlertLevel, AlertDescription)]
    a]
    packetToFragments13 Context
    _ Maybe Int
    _ (AppData13 ByteString
    x) = [ByteString] -> IO [ByteString]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ByteString
    x]
    packetToFragments13 Context
    _ Maybe Int
    _ Packet13
    ChangeCipherSpec13 = [ByteString] -> IO [ByteString]
    forall a. a -> IO a
    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 a. a -> IO a
    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 a. a -> HandshakeM a
    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