tls 0.9.0 → 0.9.1

raw patch · 4 files changed

+22/−23 lines, 4 files

Files

• Network/TLS/Context.hs +10/−11
• Network/TLS/Core.hs +10/−10
• Network/TLS/Receiving.hs +1/−1
• tls.cabal +1/−1

@@ -56,7 +56,7 @@  import Control.Concurrent.MVar import Control.Monad.State-import Control.Exception (throwIO, Exception(), onException)+import Control.Exception (throwIO, Exception()) import Data.IORef import System.IO (Handle, hSetBuffering, BufferMode(..), hFlush) import Prelude hiding (catch)@@ -64,8 +64,8 @@ data TLSLogging = TLSLogging 	{ loggingPacketSent :: String -> IO () 	, loggingPacketRecv :: String -> IO ()-	, loggingIOSent     :: Bytes -> IO ()-	, loggingIORecv     :: Header -> Bytes -> IO ()+	, loggingIOSent     :: B.ByteString -> IO ()+	, loggingIORecv     :: Header -> B.ByteString -> IO () 	}  data TLSParams = TLSParams@@ -152,7 +152,9 @@ 	}  updateMeasure :: MonadIO m => TLSCtx c -> (Measurement -> Measurement) -> m ()-updateMeasure ctx f = liftIO $ modifyIORef (ctxMeasurement ctx) f+updateMeasure ctx f = liftIO $ do+    x <- readIORef (ctxMeasurement ctx)+    writeIORef (ctxMeasurement ctx) $! f x  withMeasure :: MonadIO m => TLSCtx c -> (Measurement -> IO a) -> m a withMeasure ctx f = liftIO (readIORef (ctxMeasurement ctx) >>= f)@@ -209,13 +211,10 @@   usingState :: MonadIO m => TLSCtx c -> TLSSt a -> m (Either TLSError a)-usingState ctx f = liftIO (takeMVar mvar) >>= \st -> liftIO $ onException (execAndStore st) (putMVar mvar st)-	where-		mvar = ctxState ctx-		execAndStore st = do-			let (a, newst) = runTLSState f st-			putMVar mvar newst-			return a+usingState ctx f =+	liftIO $ modifyMVar (ctxState ctx) $ \st ->+		let (a, newst) = runTLSState f st+		 in newst `seq` return (newst, a)  usingState_ :: MonadIO m => TLSCtx c -> TLSSt a -> m a usingState_ ctx f = do

@@ -178,15 +178,15 @@            -> g                 -- ^ Random number generator associated            -> c                 -- ^ An abstract connection type            -> IO ()             -- ^ A method for the connection buffer to be flushed-           -> (Bytes -> IO ())  -- ^ A method for sending bytes through the connection-           -> (Int -> IO Bytes) -- ^ A method for receiving bytes through the connection+           -> (B.ByteString -> IO ())  -- ^ A method for sending bytes through the connection+           -> (Int -> IO B.ByteString) -- ^ A method for receiving bytes through the connection            -> m (TLSCtx c) clientWith params rng connection flushF sendF recvF = 	liftIO $ newCtxWith connection flushF sendF recvF params st 	where st = (newTLSState rng) { stClientContext = True }  -- | Create a new Client context with a configuration, a RNG, and a Handle.--- It reconfigures the handle buffermode to noBuffering+-- It reconfigures the handle's 'System.IO.BufferMode' to @NoBuffering@. client :: (MonadIO m, CryptoRandomGen g)        => TLSParams -- ^ parameters to use for this context        -> g         -- ^ random number generator associated with the context@@ -196,13 +196,13 @@ 	where st = (newTLSState rng) { stClientContext = True }  -- | Create a new Server context with a configuration, a RNG, a generic connection and the connection operation.-serverWith :: (MonadIO m, CryptoRandomGen g) => TLSParams -> g -> c -> IO () -> (Bytes -> IO ()) -> (Int -> IO Bytes) -> m (TLSCtx c)+serverWith :: (MonadIO m, CryptoRandomGen g) => TLSParams -> g -> c -> IO () -> (B.ByteString -> IO ()) -> (Int -> IO B.ByteString) -> m (TLSCtx c) serverWith params rng connection flushF sendF recvF = 	liftIO $ newCtxWith connection flushF sendF recvF params st 	where st = (newTLSState rng) { stClientContext = False }  -- | Create a new Server context with a configuration, a RNG, and a Handle.--- It reconfigures the handle buffermode to noBuffering+-- It reconfigures the handle's 'System.IO.BufferMode' to @NoBuffering@. server :: (MonadIO m, CryptoRandomGen g) => TLSParams -> g -> Handle -> m (TLSCtx Handle) server params rng handle = liftIO $ newCtx handle params st 	where st = (newTLSState rng) { stClientContext = False }@@ -477,7 +477,7 @@ 		_    -> fail ("unexpected handshake received, excepting client hello and received " ++ show hss)  -- | Handshake for a new TLS connection--- This is to be called at the beginning of a connection, and during renegociation+-- This is to be called at the beginning of a connection, and during renegotiation handshake :: MonadIO m => TLSCtx c -> m () handshake ctx = do 	cc <- usingState_ ctx (stClientContext <$> get)@@ -500,17 +500,17 @@ 			sendDataChunk remain 		| otherwise = sendPacket ctx $ AppData d --- | recvData get data out of Data packet, and automatically renegociate if+-- | recvData get data out of Data packet, and automatically renegotiate if -- a Handshake ClientHello is received-recvData :: MonadIO m => TLSCtx c -> m Bytes+recvData :: MonadIO m => TLSCtx c -> m B.ByteString recvData ctx = do 	checkValid ctx 	pkt <- recvPacket ctx 	case pkt of-		-- on server context receiving a client hello == renegociation+		-- on server context receiving a client hello == renegotiation 		Right (Handshake [ch@(ClientHello _ _ _ _ _ _)]) -> 			handshakeServerWith ctx ch >> recvData ctx-		-- on client context, receiving a hello request == renegociation+		-- on client context, receiving a hello request == renegotiation 		Right (Handshake [HelloRequest]) -> 			handshakeClient ctx >> recvData ctx 		Right (Alert [(AlertLevel_Fatal, _)]) -> do

@@ -104,7 +104,7 @@ processServerHello _ = error "processServerHello called on wrong type"  -- process the client key exchange message. the protocol expects the initial--- client version received in ClientHello, not the negociated version.+-- client version received in ClientHello, not the negotiated version. -- in case the version mismatch, generate a random master secret processClientKeyXchg :: ByteString -> TLSSt () processClientKeyXchg encryptedPremaster = do

@@ -1,5 +1,5 @@ Name:                tls-Version:             0.9.0+Version:             0.9.1 Description:    Native Haskell TLS and SSL protocol implementation for server and client.    .