    -- |
    -- Module      : Network.TLS.Record.Engage
    -- License     : BSD-style
    -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
    -- Stability   : experimental
    -- Portability : unknown
    --
    -- Engage a record into the Record layer.
    -- The record is compressed, added some integrity field, then encrypted.
    --
    -- Starting with TLS v1.3, only the "null" compression method is negotiated in
    -- the handshake, so the compression step will be a no-op.  Integrity and
    -- encryption are performed using an AEAD cipher only.
    --
    {-# LANGUAGE BangPatterns #-}
    module Network.TLS.Record.Engage
            ( engageRecord
            ) where

    import Control.Monad.State.Strict
    import Crypto.Cipher.Types (AuthTag(..))

    import Network.TLS.Cap
    import Network.TLS.Record.State
    import Network.TLS.Record.Types
    import Network.TLS.Cipher
    import Network.TLS.Compression
    import Network.TLS.Wire
    import Network.TLS.Packet
    import Network.TLS.Struct
    import Network.TLS.Imports
    import qualified Data.ByteString as B
    import qualified Data.ByteArray as B (convert, xor)

    engageRecord :: Record Plaintext -> RecordM (Record Ciphertext)
    engageRecord :: Record Plaintext -> RecordM (Record Ciphertext)
    engageRecord = Record Plaintext -> RecordM (Record Compressed)
    compressRecord (Record Plaintext -> RecordM (Record Compressed))
    -> (Record Compressed -> RecordM (Record Ciphertext))
    -> Record Plaintext
    -> RecordM (Record Ciphertext)
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> Record Compressed -> RecordM (Record Ciphertext)
    encryptRecord

    compressRecord :: Record Plaintext -> RecordM (Record Compressed)
    compressRecord :: Record Plaintext -> RecordM (Record Compressed)
    compressRecord record :: Record Plaintext
    record =
        Record Plaintext
    -> (Fragment Plaintext -> RecordM (Fragment Compressed))
    -> RecordM (Record Compressed)
    forall a b.
    Record a
    -> (Fragment a -> RecordM (Fragment b)) -> RecordM (Record b)
    onRecordFragment Record Plaintext
    record ((Fragment Plaintext -> RecordM (Fragment Compressed))
     -> RecordM (Record Compressed))
    -> (Fragment Plaintext -> RecordM (Fragment Compressed))
    -> RecordM (Record Compressed)
    forall a b. (a -> b) -> a -> b
    $ (ByteString -> RecordM ByteString)
    -> Fragment Plaintext -> RecordM (Fragment Compressed)
    fragmentCompress ((ByteString -> RecordM ByteString)
     -> Fragment Plaintext -> RecordM (Fragment Compressed))
    -> (ByteString -> RecordM ByteString)
    -> Fragment Plaintext
    -> RecordM (Fragment Compressed)
    forall a b. (a -> b) -> a -> b
    $ \bytes :: ByteString
    bytes -> do
            (Compression -> (Compression, ByteString)) -> RecordM ByteString
    forall a. (Compression -> (Compression, a)) -> RecordM a
    withCompression ((Compression -> (Compression, ByteString)) -> RecordM ByteString)
    -> (Compression -> (Compression, ByteString)) -> RecordM ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Compression -> (Compression, ByteString)
    compressionDeflate ByteString
    bytes

    -- when Tx Encrypted is set, we pass the data through encryptContent, otherwise
    -- we just return the compress payload directly as the ciphered one
    --
    encryptRecord :: Record Compressed -> RecordM (Record Ciphertext)
    encryptRecord :: Record Compressed -> RecordM (Record Ciphertext)
    encryptRecord record :: Record Compressed
    record@(Record ct :: ProtocolType
    ct ver :: Version
    ver fragment :: Fragment Compressed
    fragment) = do
        RecordState
    st <- RecordM RecordState
    forall s (m :: * -> *). MonadState s m => m s
    get
        case RecordState -> Maybe Cipher
    stCipher RecordState
    st of
            Nothing -> RecordM (Record Ciphertext)
    noEncryption
            _ -> do
                RecordOptions
    recOpts <- RecordM RecordOptions
    getRecordOptions
                if RecordOptions -> Bool
    recordTLS13 RecordOptions
    recOpts
                    then RecordM (Record Ciphertext)
    encryptContent13
                    else Record Compressed
    -> (Fragment Compressed -> RecordM (Fragment Ciphertext))
    -> RecordM (Record Ciphertext)
    forall a b.
    Record a
    -> (Fragment a -> RecordM (Fragment b)) -> RecordM (Record b)
    onRecordFragment Record Compressed
    record ((Fragment Compressed -> RecordM (Fragment Ciphertext))
     -> RecordM (Record Ciphertext))
    -> (Fragment Compressed -> RecordM (Fragment Ciphertext))
    -> RecordM (Record Ciphertext)
    forall a b. (a -> b) -> a -> b
    $ (ByteString -> RecordM ByteString)
    -> Fragment Compressed -> RecordM (Fragment Ciphertext)
    fragmentCipher (Bool -> Record Compressed -> ByteString -> RecordM ByteString
    encryptContent Bool
    False Record Compressed
    record)
      where
        noEncryption :: RecordM (Record Ciphertext)
    noEncryption = Record Compressed
    -> (Fragment Compressed -> RecordM (Fragment Ciphertext))
    -> RecordM (Record Ciphertext)
    forall a b.
    Record a
    -> (Fragment a -> RecordM (Fragment b)) -> RecordM (Record b)
    onRecordFragment Record Compressed
    record ((Fragment Compressed -> RecordM (Fragment Ciphertext))
     -> RecordM (Record Ciphertext))
    -> (Fragment Compressed -> RecordM (Fragment Ciphertext))
    -> RecordM (Record Ciphertext)
    forall a b. (a -> b) -> a -> b
    $ (ByteString -> RecordM ByteString)
    -> Fragment Compressed -> RecordM (Fragment Ciphertext)
    fragmentCipher ByteString -> RecordM ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return
        encryptContent13 :: RecordM (Record Ciphertext)
    encryptContent13
            | ProtocolType
    ct ProtocolType -> ProtocolType -> Bool
    forall a. Eq a => a -> a -> Bool
    == ProtocolType
    ProtocolType_ChangeCipherSpec = RecordM (Record Ciphertext)
    noEncryption
            | Bool
    otherwise = do
                let bytes :: ByteString
    bytes     = Fragment Compressed -> ByteString
    forall a. Fragment a -> ByteString
    fragmentGetBytes Fragment Compressed
    fragment
                    fragment' :: Fragment Compressed
    fragment' = ByteString -> Fragment Compressed
    fragmentCompressed (ByteString -> Fragment Compressed)
    -> ByteString -> Fragment Compressed
    forall a b. (a -> b) -> a -> b
    $ ProtocolType -> ByteString -> ByteString
    innerPlaintext ProtocolType
    ct ByteString
    bytes
                    record' :: Record Compressed
    record'   = ProtocolType -> Version -> Fragment Compressed -> Record Compressed
    forall a. ProtocolType -> Version -> Fragment a -> Record a
    Record ProtocolType
    ProtocolType_AppData Version
    ver Fragment Compressed
    fragment'
                Record Compressed
    -> (Fragment Compressed -> RecordM (Fragment Ciphertext))
    -> RecordM (Record Ciphertext)
    forall a b.
    Record a
    -> (Fragment a -> RecordM (Fragment b)) -> RecordM (Record b)
    onRecordFragment Record Compressed
    record' ((Fragment Compressed -> RecordM (Fragment Ciphertext))
     -> RecordM (Record Ciphertext))
    -> (Fragment Compressed -> RecordM (Fragment Ciphertext))
    -> RecordM (Record Ciphertext)
    forall a b. (a -> b) -> a -> b
    $ (ByteString -> RecordM ByteString)
    -> Fragment Compressed -> RecordM (Fragment Ciphertext)
    fragmentCipher (Bool -> Record Compressed -> ByteString -> RecordM ByteString
    encryptContent Bool
    True Record Compressed
    record')

    innerPlaintext :: ProtocolType -> ByteString -> ByteString
    innerPlaintext :: ProtocolType -> ByteString -> ByteString
    innerPlaintext ct :: ProtocolType
    ct bytes :: ByteString
    bytes = Put -> ByteString
    runPut (Put -> ByteString) -> Put -> ByteString
    forall a b. (a -> b) -> a -> b
    $ do
        ByteString -> Put
    putBytes ByteString
    bytes
        Putter Word8
    putWord8 Putter Word8 -> Putter Word8
    forall a b. (a -> b) -> a -> b
    $ ProtocolType -> Word8
    forall a. TypeValuable a => a -> Word8
    valOfType ProtocolType
    ct -- non zero!
        -- fixme: zeros padding

    encryptContent :: Bool -> Record Compressed -> ByteString -> RecordM ByteString
    encryptContent :: Bool -> Record Compressed -> ByteString -> RecordM ByteString
    encryptContent tls13 :: Bool
    tls13 record :: Record Compressed
    record content :: ByteString
    content = do
        CryptState
    cst  <- RecordM CryptState
    getCryptState
        Bulk
    bulk <- RecordM Bulk
    getBulk
        case CryptState -> BulkState
    cstKey CryptState
    cst of
            BulkStateBlock encryptF :: BulkBlock
    encryptF -> do
                ByteString
    digest <- Header -> ByteString -> RecordM ByteString
    makeDigest (Record Compressed -> Header
    forall a. Record a -> Header
    recordToHeader Record Compressed
    record) ByteString
    content
                let content' :: ByteString
    content' =  [ByteString] -> ByteString
    B.concat [ByteString
    content, ByteString
    digest]
                BulkBlock -> ByteString -> Bulk -> RecordM ByteString
    encryptBlock BulkBlock
    encryptF ByteString
    content' Bulk
    bulk
            BulkStateStream encryptF :: BulkStream
    encryptF -> do
                ByteString
    digest <- Header -> ByteString -> RecordM ByteString
    makeDigest (Record Compressed -> Header
    forall a. Record a -> Header
    recordToHeader Record Compressed
    record) ByteString
    content
                let content' :: ByteString
    content' =  [ByteString] -> ByteString
    B.concat [ByteString
    content, ByteString
    digest]
                BulkStream -> ByteString -> RecordM ByteString
    encryptStream BulkStream
    encryptF ByteString
    content'
            BulkStateAEAD encryptF :: BulkAEAD
    encryptF ->
                Bool
    -> Bulk
    -> BulkAEAD
    -> ByteString
    -> Record Compressed
    -> RecordM ByteString
    encryptAead Bool
    tls13 Bulk
    bulk BulkAEAD
    encryptF ByteString
    content Record Compressed
    record
            BulkStateUninitialized ->
                ByteString -> RecordM ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    content

    encryptBlock :: BulkBlock -> ByteString -> Bulk -> RecordM ByteString
    encryptBlock :: BulkBlock -> ByteString -> Bulk -> RecordM ByteString
    encryptBlock encryptF :: BulkBlock
    encryptF content :: ByteString
    content bulk :: Bulk
    bulk = do
        CryptState
    cst <- RecordM CryptState
    getCryptState
        Version
    ver <- RecordM Version
    getRecordVersion
        let blockSize :: Int
    blockSize = Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Bulk -> Int
    bulkBlockSize Bulk
    bulk
        let msg_len :: Int
    msg_len = ByteString -> Int
    B.length ByteString
    content
        let padding :: ByteString
    padding = if Int
    blockSize Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0
                      then
                          let padbyte :: Int
    padbyte = Int
    blockSize Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (Int
    msg_len Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    blockSize) in
                          let padbyte' :: Int
    padbyte' = if Int
    padbyte Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 then Int
    blockSize else Int
    padbyte in Int -> Word8 -> ByteString
    B.replicate Int
    padbyte' (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int
    padbyte' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1))
                      else
                          ByteString
    B.empty

        let (e :: ByteString
    e, iv' :: ByteString
    iv') = BulkBlock
    encryptF (CryptState -> ByteString
    cstIV CryptState
    cst) (ByteString -> (ByteString, ByteString))
    -> ByteString -> (ByteString, ByteString)
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> ByteString
    B.concat [ ByteString
    content, ByteString
    padding ]

        if Version -> Bool
    hasExplicitBlockIV Version
    ver
            then ByteString -> RecordM ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> RecordM ByteString)
    -> ByteString -> RecordM ByteString
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> ByteString
    B.concat [CryptState -> ByteString
    cstIV CryptState
    cst,ByteString
    e]
            else do
                (RecordState -> RecordState) -> RecordM ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((RecordState -> RecordState) -> RecordM ())
    -> (RecordState -> RecordState) -> RecordM ()
    forall a b. (a -> b) -> a -> b
    $ \tstate :: RecordState
    tstate -> RecordState
    tstate { stCryptState :: CryptState
    stCryptState = CryptState
    cst { cstIV :: ByteString
    cstIV = ByteString
    iv' } }
                ByteString -> RecordM ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    e

    encryptStream :: BulkStream -> ByteString -> RecordM ByteString
    encryptStream :: BulkStream -> ByteString -> RecordM ByteString
    encryptStream (BulkStream encryptF :: ByteString -> (ByteString, BulkStream)
    encryptF) content :: ByteString
    content = do
        CryptState
    cst <- RecordM CryptState
    getCryptState
        let (!ByteString
    e, !BulkStream
    newBulkStream) = ByteString -> (ByteString, BulkStream)
    encryptF ByteString
    content
        (RecordState -> RecordState) -> RecordM ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((RecordState -> RecordState) -> RecordM ())
    -> (RecordState -> RecordState) -> RecordM ()
    forall a b. (a -> b) -> a -> b
    $ \tstate :: RecordState
    tstate -> RecordState
    tstate { stCryptState :: CryptState
    stCryptState = CryptState
    cst { cstKey :: BulkState
    cstKey = BulkStream -> BulkState
    BulkStateStream BulkStream
    newBulkStream } }
        ByteString -> RecordM ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    e

    encryptAead :: Bool
                -> Bulk
                -> BulkAEAD
                -> ByteString -> Record Compressed
                -> RecordM ByteString
    encryptAead :: Bool
    -> Bulk
    -> BulkAEAD
    -> ByteString
    -> Record Compressed
    -> RecordM ByteString
    encryptAead tls13 :: Bool
    tls13 bulk :: Bulk
    bulk encryptF :: BulkAEAD
    encryptF content :: ByteString
    content record :: Record Compressed
    record = do
        let authTagLen :: Int
    authTagLen  = Bulk -> Int
    bulkAuthTagLen Bulk
    bulk
            nonceExpLen :: Int
    nonceExpLen = Bulk -> Int
    bulkExplicitIV Bulk
    bulk
        CryptState
    cst        <- RecordM CryptState
    getCryptState
        ByteString
    encodedSeq <- Word64 -> ByteString
    encodeWord64 (Word64 -> ByteString) -> RecordM Word64 -> RecordM ByteString
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> RecordM Word64
    getMacSequence

        let iv :: ByteString
    iv    = CryptState -> ByteString
    cstIV CryptState
    cst
            ivlen :: Int
    ivlen = ByteString -> Int
    B.length ByteString
    iv
            Header typ :: ProtocolType
    typ v :: Version
    v plainLen :: Word16
    plainLen = Record Compressed -> Header
    forall a. Record a -> Header
    recordToHeader Record Compressed
    record
            hdrLen :: Word16
    hdrLen = if Bool
    tls13 then Word16
    plainLen Word16 -> Word16 -> Word16
    forall a. Num a => a -> a -> a
    + Int -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    authTagLen else Word16
    plainLen
            hdr :: Header
    hdr = ProtocolType -> Version -> Word16 -> Header
    Header ProtocolType
    typ Version
    v Word16
    hdrLen
            ad :: ByteString
    ad | Bool
    tls13     = Header -> ByteString
    encodeHeader Header
    hdr
               | Bool
    otherwise = [ByteString] -> ByteString
    B.concat [ ByteString
    encodedSeq, Header -> ByteString
    encodeHeader Header
    hdr ]
            sqnc :: ByteString
    sqnc  = Int -> Word8 -> ByteString
    B.replicate (Int
    ivlen Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 8) 0 ByteString -> ByteString -> ByteString
    `B.append` ByteString
    encodedSeq
            nonce :: ByteString
    nonce | Int
    nonceExpLen Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 = ByteString -> ByteString -> ByteString
    forall a b c.
    (ByteArrayAccess a, ByteArrayAccess b, ByteArray c) =>
    a -> b -> c
    B.xor ByteString
    iv ByteString
    sqnc
                  | Bool
    otherwise = [ByteString] -> ByteString
    B.concat [ByteString
    iv, ByteString
    encodedSeq]
            (e :: ByteString
    e, AuthTag authtag :: Bytes
    authtag) = BulkAEAD
    encryptF ByteString
    nonce ByteString
    content ByteString
    ad
            econtent :: ByteString
    econtent | Int
    nonceExpLen Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 = ByteString
    e ByteString -> ByteString -> ByteString
    `B.append` Bytes -> ByteString
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    bin -> bout
    B.convert Bytes
    authtag
                     | Bool
    otherwise = [ByteString] -> ByteString
    B.concat [ByteString
    encodedSeq, ByteString
    e, Bytes -> ByteString
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    bin -> bout
    B.convert Bytes
    authtag]
        (RecordState -> RecordState) -> RecordM ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify RecordState -> RecordState
    incrRecordState
        ByteString -> RecordM ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    econtent

    getCryptState :: RecordM CryptState
    getCryptState :: RecordM CryptState
    getCryptState = RecordState -> CryptState
    stCryptState (RecordState -> CryptState)
    -> RecordM RecordState -> RecordM CryptState
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> RecordM RecordState
    forall s (m :: * -> *). MonadState s m => m s
    get