module Network.TLS.Sending (writePacket, encryptRSA, signRSA) 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)
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 ()
when (certVerifyHandshakeMaterial hs) $ addHandshakeMessage $ encodeHandshake hs
when (finishHandshakeTypeMaterial $ typeOfHandshake hs) (updateHandshakeDigest $ encodeHandshake hs)
writePacket :: Packet -> TLSSt ByteString
writePacket pkt = do
preProcessPacket pkt
makeRecord pkt >>= engageRecord >>= postprocessRecord >>= encodeRecord
encryptRSA :: ByteString -> TLSSt ByteString
encryptRSA content = do
st <- get
let rsakey = fromJust "rsa public key" $ hstRSAPublicKey $ fromJust "handshake" $ stHandshake st
(v,rng') = withTLSRNG (stRandomGen st) (\g -> kxEncrypt g rsakey content)
in do put (st { stRandomGen = rng' })
case v of
Left err -> fail ("rsa encrypt failed: " ++ show err)
Right econtent -> return econtent
signRSA :: HashDescr -> ByteString -> TLSSt ByteString
signRSA hsh content = do
st <- get
let rsakey = fromJust "rsa client private key" $ hstRSAClientPrivateKey $ fromJust "handshake" $ stHandshake st
let (r, rng') = withTLSRNG (stRandomGen st) (\g -> kxSign g rsakey hsh content)
put (st { stRandomGen = rng' })
case r of
Left err -> fail ("rsa sign failed: " ++ show err)
Right econtent -> 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