From 439ea6ba857ccb347ff88c741a5aa0cd8031b10a Mon Sep 17 00:00:00 2001
From: Vincent Hanquez <vincent@snarc.org>
Date: Fri, 17 Jan 2014 06:55:33 +0000
Subject: [PATCH] use the backend class completely and mark contextNewOnX
 symbols as deprecated

---
 core/Network/TLS/Backend.hs |  6 +++++-
 core/Network/TLS/Context.hs | 23 +++++++++--------------
 2 files changed, 14 insertions(+), 15 deletions(-)

diff --git a/core/Network/TLS/Backend.hs b/core/Network/TLS/Backend.hs
index de29a57..287cba7 100644
--- a/core/Network/TLS/Backend.hs
+++ b/core/Network/TLS/Backend.hs
@@ -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)
diff --git a/core/Network/TLS/Context.hs b/core/Network/TLS/Context.hs
index d6f6a67..c59ad31 100644
--- a/core/Network/TLS/Context.hs
+++ b/core/Network/TLS/Context.hs
@@ -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 =