use the backend class completely and mark contextNewOnX symbols as deprecated

This commit is contained in:
Vincent Hanquez 2014-01-17 06:55:33 +00:00
parent eb90d5be00
commit 439ea6ba85
2 changed files with 14 additions and 15 deletions

View file

@ -25,7 +25,7 @@ import Network.Socket (Socket, sClose)
import qualified Network.Socket.ByteString as Socket
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import System.IO
import System.IO (Handle, hSetBuffering, BufferMode(..), hFlush, hClose)
-- | Connection IO backend
data Backend = Backend
@ -36,12 +36,15 @@ data Backend = Backend
}
class HasBackend a where
initializeBackend :: a -> IO ()
getBackend :: a -> Backend
instance HasBackend Backend where
initializeBackend _ = return ()
getBackend = id
instance HasBackend Socket where
initializeBackend _ = return ()
getBackend sock = Backend (return ()) (sClose sock) (Socket.sendAll sock) recvAll
where recvAll n = B.concat `fmap` loop n
where loop 0 = return []
@ -50,4 +53,5 @@ instance HasBackend Socket where
liftM (r:) (loop (left - B.length r))
instance HasBackend Handle where
initializeBackend handle = hSetBuffering handle NoBuffering
getBackend handle = Backend (hFlush handle) (hClose handle) (B.hPut handle) (B.hGet handle)

View file

@ -68,6 +68,7 @@ module Network.TLS.Context
-- * New contexts
, contextNew
-- * Deprecated new contexts methods
, contextNewOnHandle
, contextNewOnSocket
@ -85,9 +86,6 @@ module Network.TLS.Context
, getStateRNG
) where
import Network.Socket (Socket, sClose)
import qualified Network.Socket.ByteString as Socket
import Network.TLS.Backend
import Network.TLS.Extension
import Network.TLS.Struct
@ -110,8 +108,10 @@ import Control.Monad.State
import Control.Exception (throwIO, Exception())
import Data.IORef
import Data.Tuple
import System.IO (Handle, hSetBuffering, BufferMode(..), hFlush, hClose)
-- deprecated imports
import Network.Socket (Socket)
import System.IO (Handle)
-- | A TLS Context keep tls specific state, parameters and backend information.
data Context = Context
@ -194,6 +194,7 @@ contextNew :: (MonadIO m, CPRG rng, HasBackend backend)
-> rng -- ^ Random number generator associated with this context.
-> m Context
contextNew backend params rng = liftIO $ do
initializeBackend backend
let role = case roleParams params of
Client {} -> ClientRole
Server {} -> ServerRole
@ -269,9 +270,8 @@ contextNewOnHandle :: (MonadIO m, CPRG rng)
-> Params -- ^ Parameters of the context.
-> rng -- ^ Random number generator associated with this context.
-> m Context
contextNewOnHandle handle params st =
liftIO (hSetBuffering handle NoBuffering) >> contextNew backend params st
where backend = Backend (hFlush handle) (hClose handle) (B.hPut handle) (B.hGet handle)
contextNewOnHandle handle params st = contextNew handle params st
{-# DEPRECATED contextNewOnHandle "use contextNew" #-}
-- | create a new context on a socket.
contextNewOnSocket :: (MonadIO m, CPRG rng)
@ -279,13 +279,8 @@ contextNewOnSocket :: (MonadIO m, CPRG rng)
-> Params -- ^ Parameters of the context.
-> rng -- ^ Random number generator associated with this context.
-> m Context
contextNewOnSocket sock params st = contextNew backend params st
where backend = Backend (return ()) (sClose sock) (Socket.sendAll sock) recvAll
recvAll n = B.concat `fmap` loop n
where loop 0 = return []
loop left = do
r <- Socket.recv sock left
liftM (r:) (loop (left - B.length r))
contextNewOnSocket sock params st = contextNew sock params st
{-# DEPRECATED contextNewOnSocket "use contextNew" #-}
contextHookSetHandshakeRecv :: Context -> (Handshake -> IO Handshake) -> IO ()
contextHookSetHandshakeRecv context f =