{-# 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 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 Plaintext
record =
forall a b.
Record a
-> (Fragment a -> RecordM (Fragment b)) -> RecordM (Record b)
onRecordFragment Record Plaintext
record forall a b. (a -> b) -> a -> b
$ (ByteString -> RecordM ByteString)
-> Fragment Plaintext -> RecordM (Fragment Compressed)
fragmentCompress forall a b. (a -> b) -> a -> b
$ \ByteString
bytes -> do
forall a. (Compression -> (Compression, a)) -> RecordM a
withCompression forall a b. (a -> b) -> a -> b
$ ByteString -> Compression -> (Compression, ByteString)
compressionDeflate ByteString
bytes
encryptRecord :: Record Compressed -> RecordM (Record Ciphertext)
encryptRecord :: Record Compressed -> RecordM (Record Ciphertext)
encryptRecord record :: Record Compressed
record@(Record ProtocolType
ct Version
ver Fragment Compressed
fragment) = do
RecordState
st <- forall s (m :: * -> *). MonadState s m => m s
get
case RecordState -> Maybe Cipher
stCipher RecordState
st of
Maybe Cipher
Nothing -> RecordM (Record Ciphertext)
noEncryption
Maybe Cipher
_ -> do
RecordOptions
recOpts <- RecordM RecordOptions
getRecordOptions
if RecordOptions -> Bool
recordTLS13 RecordOptions
recOpts
then RecordM (Record Ciphertext)
encryptContent13
else forall a b.
Record a
-> (Fragment a -> RecordM (Fragment b)) -> RecordM (Record b)
onRecordFragment Record Compressed
record 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 = forall a b.
Record a
-> (Fragment a -> RecordM (Fragment b)) -> RecordM (Record b)
onRecordFragment Record Compressed
record forall a b. (a -> b) -> a -> b
$ (ByteString -> RecordM ByteString)
-> Fragment Compressed -> RecordM (Fragment Ciphertext)
fragmentCipher forall (m :: * -> *) a. Monad m => a -> m a
return
encryptContent13 :: RecordM (Record Ciphertext)
encryptContent13
| ProtocolType
ct forall a. Eq a => a -> a -> Bool
== ProtocolType
ProtocolType_ChangeCipherSpec = RecordM (Record Ciphertext)
noEncryption
| Bool
otherwise = do
let bytes :: ByteString
bytes = forall a. Fragment a -> ByteString
fragmentGetBytes Fragment Compressed
fragment
fragment' :: Fragment Compressed
fragment' = ByteString -> Fragment Compressed
fragmentCompressed forall a b. (a -> b) -> a -> b
$ ProtocolType -> ByteString -> ByteString
innerPlaintext ProtocolType
ct ByteString
bytes
record' :: Record Compressed
record' = forall a. ProtocolType -> Version -> Fragment a -> Record a
Record ProtocolType
ProtocolType_AppData Version
ver Fragment Compressed
fragment'
forall a b.
Record a
-> (Fragment a -> RecordM (Fragment b)) -> RecordM (Record b)
onRecordFragment Record Compressed
record' 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 ProtocolType
ct ByteString
bytes = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ do
ByteString -> Put
putBytes ByteString
bytes
Putter Word8
putWord8 forall a b. (a -> b) -> a -> b
$ forall a. TypeValuable a => a -> Word8
valOfType ProtocolType
ct
encryptContent :: Bool -> Record Compressed -> ByteString -> RecordM ByteString
encryptContent :: Bool -> Record Compressed -> ByteString -> RecordM ByteString
encryptContent Bool
tls13 Record Compressed
record ByteString
content = do
CryptState
cst <- RecordM CryptState
getCryptState
Bulk
bulk <- RecordM Bulk
getBulk
case CryptState -> BulkState
cstKey CryptState
cst of
BulkStateBlock BulkBlock
encryptF -> do
ByteString
digest <- Header -> ByteString -> RecordM ByteString
makeDigest (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 BulkStream
encryptF -> do
ByteString
digest <- Header -> ByteString -> RecordM ByteString
makeDigest (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 BulkAEAD
encryptF ->
Bool
-> Bulk
-> BulkAEAD
-> ByteString
-> Record Compressed
-> RecordM ByteString
encryptAead Bool
tls13 Bulk
bulk BulkAEAD
encryptF ByteString
content Record Compressed
record
BulkState
BulkStateUninitialized ->
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
content
encryptBlock :: BulkBlock -> ByteString -> Bulk -> RecordM ByteString
encryptBlock :: BulkBlock -> ByteString -> Bulk -> RecordM ByteString
encryptBlock BulkBlock
encryptF ByteString
content Bulk
bulk = do
CryptState
cst <- RecordM CryptState
getCryptState
Version
ver <- RecordM Version
getRecordVersion
let blockSize :: Int
blockSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 forall a. Ord a => a -> a -> Bool
> Int
0
then
let padbyte :: Int
padbyte = Int
blockSize forall a. Num a => a -> a -> a
- (Int
msg_len forall a. Integral a => a -> a -> a
`mod` Int
blockSize) in
let padbyte' :: Int
padbyte' = if Int
padbyte forall a. Eq a => a -> a -> Bool
== Int
0 then Int
blockSize else Int
padbyte in Int -> Word8 -> ByteString
B.replicate Int
padbyte' (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
padbyte' forall a. Num a => a -> a -> a
- Int
1))
else
ByteString
B.empty
let (ByteString
e, ByteString
iv') = BulkBlock
encryptF (CryptState -> ByteString
cstIV CryptState
cst) forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat [ ByteString
content, ByteString
padding ]
if Version -> Bool
hasExplicitBlockIV Version
ver
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat [CryptState -> ByteString
cstIV CryptState
cst,ByteString
e]
else do
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \RecordState
tstate -> RecordState
tstate { stCryptState :: CryptState
stCryptState = CryptState
cst { cstIV :: ByteString
cstIV = ByteString
iv' } }
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
e
encryptStream :: BulkStream -> ByteString -> RecordM ByteString
encryptStream :: BulkStream -> ByteString -> RecordM ByteString
encryptStream (BulkStream ByteString -> (ByteString, BulkStream)
encryptF) ByteString
content = do
CryptState
cst <- RecordM CryptState
getCryptState
let (!ByteString
e, !BulkStream
newBulkStream) = ByteString -> (ByteString, BulkStream)
encryptF ByteString
content
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \RecordState
tstate -> RecordState
tstate { stCryptState :: CryptState
stCryptState = CryptState
cst { cstKey :: BulkState
cstKey = BulkStream -> BulkState
BulkStateStream BulkStream
newBulkStream } }
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 Bool
tls13 Bulk
bulk BulkAEAD
encryptF ByteString
content 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 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 ProtocolType
typ Version
v Word16
plainLen = forall a. Record a -> Header
recordToHeader Record Compressed
record
hdrLen :: Word16
hdrLen = if Bool
tls13 then Word16
plainLen forall a. Num a => a -> a -> a
+ 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 forall a. Num a => a -> a -> a
- Int
8) Word8
0 ByteString -> ByteString -> ByteString
`B.append` ByteString
encodedSeq
nonce :: ByteString
nonce | Int
nonceExpLen forall a. Eq a => a -> a -> Bool
== Int
0 = 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]
(ByteString
e, AuthTag Bytes
authtag) = BulkAEAD
encryptF ByteString
nonce ByteString
content ByteString
ad
econtent :: ByteString
econtent | Int
nonceExpLen forall a. Eq a => a -> a -> Bool
== Int
0 = ByteString
e ByteString -> ByteString -> ByteString
`B.append` forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert Bytes
authtag
| Bool
otherwise = [ByteString] -> ByteString
B.concat [ByteString
encodedSeq, ByteString
e, forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert Bytes
authtag]
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify RecordState -> RecordState
incrRecordState
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
econtent
getCryptState :: RecordM CryptState
getCryptState :: RecordM CryptState
getCryptState = RecordState -> CryptState
stCryptState forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get