use the backend class completely and mark contextNewOnX symbols as deprecated
This commit is contained in:
parent
eb90d5be00
commit
439ea6ba85
2 changed files with 14 additions and 15 deletions
|
@ -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)
|
||||
|
|
|
@ -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 =
|
||||
|
|
Loading…
Reference in a new issue