add a contextNewWithSocket
This commit is contained in:
parent
e1d8e026f5
commit
0870189689
2 changed files with 19 additions and 0 deletions
|
@ -48,6 +48,7 @@ module Network.TLS
|
||||||
-- * Creating a context
|
-- * Creating a context
|
||||||
, contextNew
|
, contextNew
|
||||||
, contextNewOnHandle
|
, contextNewOnHandle
|
||||||
|
, contextNewOnSocket
|
||||||
, contextFlush
|
, contextFlush
|
||||||
, contextClose
|
, contextClose
|
||||||
, contextHookSetHandshakeRecv
|
, contextHookSetHandshakeRecv
|
||||||
|
|
|
@ -73,6 +73,7 @@ module Network.TLS.Context
|
||||||
-- * New contexts
|
-- * New contexts
|
||||||
, contextNew
|
, contextNew
|
||||||
, contextNewOnHandle
|
, contextNewOnHandle
|
||||||
|
, contextNewOnSocket
|
||||||
|
|
||||||
-- * Context hooks
|
-- * Context hooks
|
||||||
, contextHookSetHandshakeRecv
|
, contextHookSetHandshakeRecv
|
||||||
|
@ -89,6 +90,9 @@ module Network.TLS.Context
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Network.BSD (HostName)
|
import Network.BSD (HostName)
|
||||||
|
import Network.Socket (Socket, sClose)
|
||||||
|
import qualified Network.Socket.ByteString as Socket
|
||||||
|
|
||||||
import Network.TLS.Extension
|
import Network.TLS.Extension
|
||||||
import Network.TLS.Struct
|
import Network.TLS.Struct
|
||||||
import qualified Network.TLS.Struct as Struct
|
import qualified Network.TLS.Struct as Struct
|
||||||
|
@ -439,6 +443,20 @@ contextNewOnHandle handle params st =
|
||||||
liftIO (hSetBuffering handle NoBuffering) >> contextNew backend params st
|
liftIO (hSetBuffering handle NoBuffering) >> contextNew backend params st
|
||||||
where backend = Backend (hFlush handle) (hClose handle) (B.hPut handle) (B.hGet handle)
|
where backend = Backend (hFlush handle) (hClose handle) (B.hPut handle) (B.hGet handle)
|
||||||
|
|
||||||
|
-- | create a new context on a socket.
|
||||||
|
contextNewOnSocket :: (MonadIO m, CPRG rng)
|
||||||
|
=> Socket -- ^ Socket of the connection.
|
||||||
|
-> 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))
|
||||||
|
|
||||||
contextHookSetHandshakeRecv :: Context -> (Handshake -> IO Handshake) -> IO ()
|
contextHookSetHandshakeRecv :: Context -> (Handshake -> IO Handshake) -> IO ()
|
||||||
contextHookSetHandshakeRecv context f =
|
contextHookSetHandshakeRecv context f =
|
||||||
liftIO $ modifyIORef (ctxHooks context) (\hooks -> hooks { hookRecvHandshake = f })
|
liftIO $ modifyIORef (ctxHooks context) (\hooks -> hooks { hookRecvHandshake = f })
|
||||||
|
|
Loading…
Reference in a new issue