module Network.TLS.Core
(
sendPacket
, recvPacket
, bye
, handshake
, HandshakeFailed(..)
, ConnectionNotEstablished(..)
, getNegotiatedProtocol
, sendData
, recvData
, recvData'
) where
import Network.TLS.Context
import Network.TLS.Struct
import Network.TLS.IO
import Network.TLS.Handshake
import qualified Network.TLS.State as S
import qualified Data.ByteString as B
import Data.ByteString.Char8 ()
import qualified Data.ByteString.Lazy as L
import Control.Monad.State
bye :: MonadIO m => Context -> m ()
bye ctx = sendPacket ctx $ Alert [(AlertLevel_Warning, CloseNotify)]
getNegotiatedProtocol :: MonadIO m => Context -> m (Maybe B.ByteString)
getNegotiatedProtocol ctx = usingState_ ctx S.getNegotiatedProtocol
sendData :: MonadIO m => Context -> L.ByteString -> m ()
sendData ctx dataToSend = checkValid ctx >> mapM_ sendDataChunk (L.toChunks dataToSend)
where sendDataChunk d
| B.length d > 16384 = do
let (sending, remain) = B.splitAt 16384 d
sendPacket ctx $ AppData sending
sendDataChunk remain
| otherwise = sendPacket ctx $ AppData d
recvData :: MonadIO m => Context -> m B.ByteString
recvData ctx = do
checkValid ctx
pkt <- recvPacket ctx
case pkt of
Right (Handshake [ch@(ClientHello {})]) ->
case roleParams $ ctxParams ctx of
Server sparams -> handshakeServerWith sparams ctx ch >> recvData ctx
Client {} -> error "assert, unexpected client hello in client context"
Right (Handshake [HelloRequest]) ->
case roleParams $ ctxParams ctx of
Server {} -> error "assert, unexpected hello request in server context"
Client cparams -> handshakeClient cparams ctx >> recvData ctx
Right (Alert [(AlertLevel_Fatal, _)]) -> do
setEOF ctx
return B.empty
Right (Alert [(AlertLevel_Warning, CloseNotify)]) -> do
setEOF ctx
return B.empty
Right (AppData x) -> return x
Right p -> error ("error unexpected packet: " ++ show p)
Left err -> error ("error received: " ++ show err)
recvData' :: MonadIO m => Context -> m L.ByteString
recvData' ctx = recvData ctx >>= return . L.fromChunks . (:[])