module Network.TLS.Core
(
sendPacket
, recvPacket
, bye
, handshake
, getNegotiatedProtocol
, getClientSNI
, sendData
, recvData
, recvData'
) where
import Network.TLS.Context
import Network.TLS.Struct
import Network.TLS.State (getSession)
import Network.TLS.Parameters
import Network.TLS.IO
import Network.TLS.Session
import Network.TLS.Handshake
import Network.TLS.Util (catchException)
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 qualified Control.Exception as E
import Control.Monad.State.Strict
bye :: MonadIO m => Context -> m ()
bye ctx = sendPacket ctx $ Alert [(AlertLevel_Warning, CloseNotify)]
getNegotiatedProtocol :: MonadIO m => Context -> m (Maybe B.ByteString)
getNegotiatedProtocol ctx = liftIO $ usingState_ ctx S.getNegotiatedProtocol
type HostName = String
getClientSNI :: MonadIO m => Context -> m (Maybe HostName)
getClientSNI ctx = liftIO $ usingState_ ctx S.getClientSNI
sendData :: MonadIO m => Context -> L.ByteString -> m ()
sendData ctx dataToSend = liftIO (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 = liftIO $ do
checkValid ctx
pkt <- withReadLock ctx $ recvPacket ctx
either onError process pkt
where onError Error_EOF =
return B.empty
onError err@(Error_Protocol (reason,fatal,desc)) =
terminate err (if fatal then AlertLevel_Fatal else AlertLevel_Warning) desc reason
onError err =
terminate err AlertLevel_Fatal InternalError (show err)
process (Handshake [ch@(ClientHello {})]) =
handshakeWith ctx ch >> recvData ctx
process (Handshake [hr@HelloRequest]) =
handshakeWith ctx hr >> recvData ctx
process (Alert [(AlertLevel_Warning, CloseNotify)]) = tryBye >> setEOF ctx >> return B.empty
process (Alert [(AlertLevel_Fatal, desc)]) = do
setEOF ctx
E.throwIO (Terminated True ("received fatal error: " ++ show desc) (Error_Protocol ("remote side fatal error", True, desc)))
process (AppData "") = recvData ctx
process (AppData x) = return x
process p = let reason = "unexpected message " ++ show p in
terminate (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason
terminate :: TLSError -> AlertLevel -> AlertDescription -> String -> IO a
terminate err level desc reason = do
session <- usingState_ ctx getSession
case session of
Session Nothing -> return ()
Session (Just sid) -> sessionInvalidate (sharedSessionManager $ ctxShared ctx) sid
catchException (sendPacket ctx $ Alert [(level, desc)]) (\_ -> return ())
setEOF ctx
E.throwIO (Terminated False reason err)
tryBye = catchException (bye ctx) (\_ -> return ())
recvData' :: MonadIO m => Context -> m L.ByteString
recvData' ctx = recvData ctx >>= return . L.fromChunks . (:[])