module Network.TLS.Sending (writePacket, encryptRSA) where
import Control.Applicative ((<$>))
import Control.Monad.State
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Network.TLS.Util
import Network.TLS.Struct
import Network.TLS.Record
import Network.TLS.Packet
import Network.TLS.State
import Network.TLS.Crypto
makeRecord :: Packet -> TLSSt (Record Plaintext)
makeRecord pkt = do
ver <- stVersion <$> get
content <- writePacketContent pkt
return $ Record (packetType pkt) ver (fragmentPlaintext content)
processRecord :: Record Plaintext -> TLSSt (Record Plaintext)
processRecord record@(Record ty _ fragment) = do
when (ty == ProtocolType_Handshake) (updateHandshakeDigest $ fragmentGetBytes fragment)
return record
postprocessRecord :: Record Ciphertext -> TLSSt (Record Ciphertext)
postprocessRecord record@(Record ProtocolType_ChangeCipherSpec _ _) =
switchTxEncryption >> return record
postprocessRecord record = return record
encodeRecord :: Record Ciphertext -> TLSSt ByteString
encodeRecord record = return $ B.concat [ encodeHeader hdr, content ]
where (hdr, content) = recordToRaw record
preProcessPacket :: Packet -> TLSSt ()
preProcessPacket (Alert _) = return ()
preProcessPacket (AppData _) = return ()
preProcessPacket (ChangeCipherSpec) = return ()
preProcessPacket (Handshake hss) = forM_ hss $ \hs -> do
case hs of
Finished fdata -> updateVerifiedData True fdata
_ -> return ()
writePacket :: Packet -> TLSSt ByteString
writePacket pkt = do
preProcessPacket pkt
makeRecord pkt >>= processRecord >>= engageRecord >>= postprocessRecord >>= encodeRecord
encryptRSA :: ByteString -> TLSSt ByteString
encryptRSA content = do
st <- get
let rsakey = fromJust "rsa public key" $ hstRSAPublicKey $ fromJust "handshake" $ stHandshake st
case withTLSRNG (stRandomGen st) (\g -> kxEncrypt g rsakey content) of
Left err -> fail ("rsa encrypt failed: " ++ show err)
Right (econtent, rng') -> put (st { stRandomGen = rng' }) >> return econtent
writePacketContent :: Packet -> TLSSt ByteString
writePacketContent (Handshake hss) = return $ encodeHandshakes hss
writePacketContent (Alert a) = return $ encodeAlerts a
writePacketContent (ChangeCipherSpec) = return $ encodeChangeCipherSpec
writePacketContent (AppData x) = return x