network-simple-tls 0.1.1.0 → 0.2.0

raw patch · 4 files changed

+196/−144 lines, 4 filesdep +cprng-aesdep +exceptionsdep +transformersdep −crypto-random-apidep ~network-simpledep ~tlsdep ~tls-extraPVP ok

version bump matches the API change (PVP)

Dependencies added: cprng-aes, exceptions, transformers

Dependencies removed: crypto-random-api

Dependency ranges changed: network-simple, tls, tls-extra

API changes (from Hackage documentation)

Files

• PEOPLE +1/−0
• README.md +2/−0
• network-simple-tls.cabal +9/−6
• src/Network/Simple/TCP/TLS.hs +184/−138

@@ -6,3 +6,4 @@ Vincent Hanquez Joseph Abrahamson Gabriel Gonzalez+Nickolay Kudasov

@@ -1,5 +1,7 @@ # network-simple-tls +[![Build Status](https://secure.travis-ci.org/k0001/network-simple-tls.png)](http://travis-ci.org/k0001/network-simple-tls)+ Haskell library simplifying the useage of TLS secured network connections. Currently, only TCP sockets are supported. This package aims to be similar and compatible with the `network-simple` package.

@@ -1,5 +1,5 @@ name:                network-simple-tls-version:             0.1.1.0+version:             0.2.0 synopsis:            Simple interface to TLS secured network sockets. description:         Simple interface to TLS secured network sockets. homepage:            https://github.com/k0001/network-simple-tls@@ -23,12 +23,15 @@   exposed-modules:   Network.Simple.TCP.TLS   build-depends:     base              (>=4.5     && <5.0)                    , bytestring        (>=0.9.2.1 && <0.11)-                   , certificate       (>=1.3     && <1.4)-                   , crypto-random-api (>=0.2     && <0.3)                    , network           (>=2.3     && <2.5)-                   , network-simple    (>=0.2     && <0.3)-                   , tls               (>=1.1     && <1.2)-                   , tls-extra         (>=0.6     && <0.7)+                   -- Packages not in The Haskell Platform+                   , certificate       (>=1.3     && <1.4)+                   , cprng-aes         (>=0.3     && <0.6)+                   , exceptions        (>=0.3     && <0.4)+                   , network-simple    (>=0.3     && <0.4)+                   , tls               (>=1.1.4   && <1.2)+                   , tls-extra         (>=0.6.5   && <0.7)+                   , transformers      (>=0.2     && <0.4)    ghc-options:      -Wall -O2   ghc-prof-options: -prof -fprof-auto-top

@@ -7,6 +7,11 @@ -- This module re-exports some functions from the "Network.Simple.TCP" module -- in the @network-simple@ package. Consider using that module directly if you -- need a similar API without TLS support.+--+-- This module uses 'MonadIO' and 'C.MonadCatch' extensively so that you can+-- reuse these functions in monads other than 'IO'. However, if you don't care+-- about any of that, just pretend you are using the 'IO' monad all the time+-- and everything will work as expected.  module Network.Simple.TCP.TLS (   -- * Server side@@ -40,64 +45,63 @@   , send    -- * Low level support-  , connectTls-  , acceptTls   , useTls+  , useTlsThenClose   , useTlsThenCloseFork+  , connectTls+  , acceptTls+  , makeClientContext+  , makeServerContext    -- * Note to Windows users-  -- $windows-users   , NS.withSocketsDo    -- * Exports-  , S.HostPreference(..)+  -- $exports+  , module Network.Simple.TCP+  , module Network.Socket+  , module Network.TLS   ) where   import           Control.Concurrent              (ThreadId, forkIO) import qualified Control.Exception               as E-import           Control.Monad                   (forever)-import           Crypto.Random.API               (getSystemRandomGen)+import           Control.Monad+import qualified Control.Monad.Catch             as C+import           Control.Monad.IO.Class          (MonadIO(liftIO))+import qualified Crypto.Random.AESCtr            as AESCtr import qualified Data.ByteString                 as B import qualified Data.ByteString.Lazy            as BL import qualified Data.Certificate.X509           as X import qualified Data.CertificateStore           as C import           Data.Maybe                      (listToMaybe) import           Data.List                       (intersect)+import           Foreign.C.Error                 (Errno(Errno), ePIPE) import qualified GHC.IO.Exception                as Eg import qualified Network.Simple.TCP              as S import qualified Network.Socket                  as NS+import qualified Network.Socket.ByteString       as NSB import qualified Network.TLS                     as T import           Network.TLS.Extra               as TE import           System.Certificate.X509         (getSystemCertificateStore)-import           System.IO                       (IOMode(ReadWriteMode)) - ----------------------------------------------------------------------------------- $windows-users------ If you are running Windows, then you /must/ call 'NS.withSocketsDo', just--- once, right at the beginning of your program. That is, change your program's--- 'main' function from:++import Network.Simple.TCP (HostPreference(Host, HostAny, HostIPv4, HostIPv6))+import Network.Socket     (HostName, ServiceName, Socket, SockAddr)+import Network.TLS        (Context)++-- $exports ----- @--- main = do---   print \"Hello world\"---   -- rest of the program...--- @+-- For your convenience, this module module also re-exports the following types+-- from other modules: ----- To:+-- [From "Network.Socket"] 'HostName', 'ServiceName', 'Socket', 'SockAddr'. ----- @--- main = 'NS.withSocketsDo' $ do---   print \"Hello world\"---   -- rest of the program...--- @+-- [From "Network.Simple.TCP"]+--   @'HostPreference'('Host','HostAny','HostIPv4','HostIPv6')@. ----- If you don't do this, your networking code won't work and you will get many--- unexpected errors at runtime. If you use an operating system other than--- Windows then you don't need to do this, but it is harmless to do it, so it's--- recommended that you do for portability reasons.+-- [From "Network.TLS"] 'Context'.  -------------------------------------------------------------------------------- @@ -122,8 +126,8 @@ -- | Get the system default 'ClientSettings'. -- -- See 'makeClientSettings' for the for the default TLS settings used.-getDefaultClientSettings :: IO ClientSettings-getDefaultClientSettings =+getDefaultClientSettings :: MonadIO m => m ClientSettings+getDefaultClientSettings = liftIO $ do     makeClientSettings [] Nothing `fmap` getSystemCertificateStore  -- | Make defaults 'ClientSettings'.@@ -145,7 +149,7 @@   :: [Credential]        -- ^Credentials to provide to the server, if requested.                          -- The first one is used in case we can't choose one                          -- based on information provided by the server.-  -> Maybe NS.HostName   -- ^Explicit Server Name Identification (SNI).+  -> Maybe HostName      -- ^Explicit Server Name Identification (SNI).   -> C.CertificateStore  -- ^CAs used to verify the server certificate.                          -- Use 'getSystemCertificateStore' to obtain                          -- the operating system's defaults.@@ -273,16 +277,17 @@ -- connection when done or in case of exceptions. You don't need to perform any -- of those steps manually. serve-  :: ServerSettings       -- ^TLS settings.+  :: MonadIO m+  => ServerSettings       -- ^TLS settings.   -> S.HostPreference     -- ^Preferred host to bind.-  -> NS.ServiceName       -- ^Service port to bind.-  -> ((T.Context, NS.SockAddr) -> IO ())+  -> ServiceName          -- ^Service port to bind.+  -> ((Context, SockAddr) -> IO ())                           -- ^Computation to run in a different thread                           -- once an incomming connection is accepted and a                           -- TLS-secured communication is established. Takes the                           -- TLS connection context and remote end address.-  -> IO ()-serve ss hp port k =+  -> m ()+serve ss hp port k = liftIO $ do     S.listen hp port $ \(lsock,_) -> do       forever $ acceptFork ss lsock k @@ -291,145 +296,182 @@ -- | Accepts a single incomming TLS-secured TCP connection and use it. -- -- A TLS handshake is performed immediately after establishing the TCP--- connection.------ The connection is properly closed when done or in case of exceptions. If you--- need to manage the lifetime of the connection resources yourself, then use--- 'acceptTls' instead.+-- connection and the TLS and TCP connections are properly closed when done or+-- in case of exceptions. If you need to manage the lifetime of the connection+-- resources yourself, then use 'acceptTls' instead. accept-  :: ServerSettings       -- ^TLS settings.-  -> NS.Socket            -- ^Listening and bound socket.-  -> ((T.Context, NS.SockAddr) -> IO b)+  :: (MonadIO m, C.MonadCatch m)+  => ServerSettings       -- ^TLS settings.+  -> Socket               -- ^Listening and bound socket.+  -> ((Context, SockAddr) -> m r)                           -- ^Computation to run in a different thread                           -- once an incomming connection is accepted and a                           -- TLS-secured communication is established. Takes the                           -- TLS connection context and remote end address.-  -> IO b-accept ss lsock k = E.bracket (acceptTls ss lsock)-                              (contextCloseNoVanish . fst)+  -> m r+accept ss lsock k = C.bracket (acceptTls ss lsock)+                              (liftIO . T.contextClose . fst)                               (useTls k)  -- | Like 'accept', except it uses a different thread to performs the TLS -- handshake and run the given computation. acceptFork-  :: ServerSettings       -- ^TLS settings.-  -> NS.Socket            -- ^Listening and bound socket.-  -> ((T.Context, NS.SockAddr) -> IO ())+  :: MonadIO m+  => ServerSettings       -- ^TLS settings.+  -> Socket               -- ^Listening and bound socket.+  -> ((Context, SockAddr) -> IO ())                           -- ^Computation to run in a different thread                           -- once an incomming connection is accepted and a                           -- TLS-secured communication is established. Takes the                           -- TLS connection context and remote end address.-  -> IO ThreadId-acceptFork ss lsock k = E.bracketOnError (acceptTls ss lsock)-                                         (contextCloseNoVanish . fst)-                                         (useTlsThenCloseFork k)+  -> m ThreadId+acceptFork ss lsock k = liftIO $ do+    E.bracketOnError (acceptTls ss lsock)+                     (T.contextClose . fst)+                     (useTlsThenCloseFork k)  --------------------------------------------------------------------------------  -- | Connect to a TLS-secured TCP server and use the connection -- -- A TLS handshake is performed immediately after establishing the TCP--- connection.------ The connection is properly closed when done or in case of exceptions. If you--- need to manage the lifetime of the connection resources yourself, then use--- 'connectTls' instead.+-- connection and the TLS and TCP connections are properly closed when done or+-- in case of exceptions. If you need to manage the lifetime of the connection+-- resources yourself, then use 'connectTls' instead. connect-  :: ClientSettings       -- ^TLS settings.-  -> NS.HostName          -- ^Server hostname.-  -> NS.ServiceName       -- ^Server service port.-  -> ((T.Context, NS.SockAddr) -> IO r)+  :: (MonadIO m, C.MonadCatch m)+  => ClientSettings       -- ^TLS settings.+  -> HostName             -- ^Server hostname.+  -> ServiceName          -- ^Server service port.+  -> ((Context, SockAddr) -> m r)                           -- ^Computation to run after establishing TLS-secured                           -- TCP connection to the remote server. Takes the TLS                           -- connection context and remote end address.-  -> IO r-connect cs host port k = E.bracket (connectTls cs host port)-                                   (contextCloseNoVanish . fst)+  -> m r+connect cs host port k = C.bracket (connectTls cs host port)+                                   (liftIO . T.contextClose . fst)                                    (useTls k)  --------------------------------------------------------------------------------  -- | Estalbishes a TCP connection to a remote server and returns a TLS--- 'T.Context' configured on top of it using the given 'ClientSettings'.+-- 'Context' configured on top of it using the given 'ClientSettings'. -- The remote end address is also returned. ----- Prefer to use 'connect' if you will be used the obtained 'T.Context' within a+-- Prefer to use 'connect' if you will be using the obtained 'Context' within a -- limited scope. ----- You need to call 'T.handshake' on the resulting 'T.Context' before using it--- for communication purposes, and 'T.bye' afterwards. The 'useTls' or--- 'useTlsThenCloseFork' functions can perform those steps for you.-connectTls :: ClientSettings -> NS.HostName -> NS.ServiceName-           -> IO (T.Context, NS.SockAddr)-connectTls (ClientSettings params) host port = do-    (csock, caddr) <- S.connectSock host port-    (`E.onException` NS.sClose csock) $ do-        h <- NS.socketToHandle csock ReadWriteMode-        ctx <- T.contextNewOnHandle h params' =<< getSystemRandomGen-        return (ctx, caddr)+-- You need to perform a TLS handshake on the resulting 'Context' before using+-- it for communication purposes, and gracefully close the TLS and TCP+-- connections afterwards using. The 'useTls', 'useTlsThenClose' and+-- 'useTlsThenCloseFork' can help you with that.+connectTls+  :: MonadIO m+  => ClientSettings       -- ^TLS settings.+  -> HostName             -- ^Server hostname.+  -> ServiceName          -- ^Service port to bind.+  -> m (Context, SockAddr)+connectTls cs host port = liftIO $ do+    E.bracketOnError+        (S.connectSock host port)+        (S.closeSock . fst)+        (\(sock, addr) -> do+             ctx <- makeClientContext (updateClientParams up cs) sock+             return (ctx, addr))   where-    params' = params { T.onCertificatesRecv = TE.certificateChecks certsCheck }-    certsCheck = [T.onCertificatesRecv params, return . checkHost]-    checkHost =-      let T.Client cparams = T.roleParams params in-      case T.clientUseServerName cparams of-        Nothing  -> TE.certificateVerifyDomain host-        Just sni -> TE.certificateVerifyDomain sni+    up params =+        let certsCheck = [T.onCertificatesRecv params, return . checkHost]+            checkHost  = let T.Client cparams = T.roleParams params in+                         case T.clientUseServerName cparams of+                           Nothing  -> TE.certificateVerifyDomain host+                           Just sni -> TE.certificateVerifyDomain sni+        in  params { T.onCertificatesRecv = TE.certificateChecks certsCheck } --- | Accepts an incoming TCP connection and returns a TLS 'T.Context' configured+-- | Make a client-side TLS 'Context' for the given settings, on top of the+-- given TCP `Socket` connected to the remote end.+makeClientContext :: MonadIO m => ClientSettings -> Socket -> m Context+makeClientContext (ClientSettings params) sock = liftIO $ do+    T.contextNew (socketBackend sock) params =<< AESCtr.makeSystem++--------------------------------------------------------------------------------++-- | Accepts an incoming TCP connection and returns a TLS 'Context' configured -- on top of it using the given 'ServerSettings'. The remote end address is also -- returned. ----- Prefer to use 'accept' if you will be used the obtained 'T.Context' within a+-- Prefer to use 'accept' if you will be using the obtained 'Context' within a -- limited scope. ----- You need to call 'T.handshake' on the resulting 'T.Context' before using it--- for communication purposes, and 'T.bye' afterwards. The 'useTls' or--- 'useTlsThenCloseFork' functions can perform those steps for you.-acceptTls :: ServerSettings -> NS.Socket -> IO (T.Context, NS.SockAddr)-acceptTls (ServerSettings params) lsock = do-    (csock, caddr) <- NS.accept lsock-    (`E.onException` NS.sClose csock) $ do-        h <- NS.socketToHandle csock ReadWriteMode-        ctx <- T.contextNewOnHandle h params =<< getSystemRandomGen-        return (ctx, caddr)+-- You need to perform a TLS handshake on the resulting 'Context' before using+-- it for communication purposes, and gracefully close the TLS and TCP+-- connections afterwards using. The 'useTls', 'useTlsThenClose' and+-- 'useTlsThenCloseFork' can help you with that.+acceptTls+  :: MonadIO m+  => ServerSettings   -- ^TLS settings.+  -> Socket           -- ^Listening and bound socket.+  -> m (Context, SockAddr)+acceptTls sp lsock = liftIO $ do+    E.bracketOnError+        (NS.accept lsock)+        (S.closeSock . fst)+        (\(sock, addr) -> do+             ctx <- makeServerContext sp sock+             return (ctx, addr)) --- | Perform a TLS 'T.handshake' on the given 'T.Context', then perform the--- given action and at last say 'T.bye', even in case of exceptions.+-- | Make a server-side TLS 'Context' for the given settings, on top of the+-- given TCP `Socket` connected to the remote end.+makeServerContext :: MonadIO m => ServerSettings -> Socket -> m Context+makeServerContext (ServerSettings params) sock = liftIO $ do+    T.contextNew (socketBackend sock) params =<< AESCtr.makeSystem++--------------------------------------------------------------------------------++-- | Perform a TLS handshake on the given 'Context', then perform the+-- given action and at last gracefully close the TLS session using `T.bye`. ----- This function discards 'Eg.ResourceVanished' exceptions that will happen when--- trying to say 'T.bye' if the remote end has done it before.-useTls :: ((T.Context, NS.SockAddr) -> IO a) -> (T.Context, NS.SockAddr) -> IO a-useTls k conn@(ctx,_) = E.bracket_ (T.handshake ctx) (byeNoVanish ctx) (k conn)+-- This function does not close the underlying TCP connection when done.+-- Prefer to use `useTlsThenClose` or `useTlsThenCloseFork` if you need that+-- behavior. Otherwise, you must call `T.contextClose` yourself at some point.+useTls+  :: (MonadIO m, C.MonadCatch m)+  => ((Context, SockAddr) -> m a)+  -> ((Context, SockAddr) -> m a)+useTls k conn@(ctx,_) = C.bracket_ (T.handshake ctx)+                                   (liftIO $ silentBye ctx)+                                   (k conn) --- | Similar to 'useTls', except it performs the all the IO actions safely in a--- new thread and closes the connection backend after using it. Use this instead--- of forking `useTls` yourself.+-- | Like 'useTls', except it also fully closes the TCP connection when done.+useTlsThenClose+  :: (MonadIO m, C.MonadCatch m)+  => ((Context, SockAddr) -> m a)+  -> ((Context, SockAddr) -> m a)+useTlsThenClose k conn@(ctx,_) = do+    useTls k conn `C.finally` liftIO (T.contextClose ctx)++-- | Similar to 'useTlsThenClose', except it performs the all the IO actions+-- in a new  thread. ----- This function discards 'Eg.ResourceVanished' exceptions that will happen when--- trying to close the connection backend if the remote end has done it before.-useTlsThenCloseFork :: ((T.Context, NS.SockAddr) -> IO ())-                    -> (T.Context, NS.SockAddr) -> IO ThreadId-useTlsThenCloseFork k conn@(ctx,_) = do-    forkFinally (E.bracket_ (T.handshake ctx) (byeNoVanish ctx) (k conn))-                (\e1 -> do-                    e2 <- E.try $ contextCloseNoVanish ctx-                    -- in case both e1 and e2 hold exceptions, we throw e1.-                    case (e1,e2) of-                      (Left e, _) -> E.throwIO e-                      (_, Left e) -> E.throwIO (e :: E.SomeException)-                      _           -> return ())+-- Use this instead of forking `useTlsThenClose` yourself, as that won't give+-- the right behavior.+useTlsThenCloseFork+  :: MonadIO m+  => ((Context, SockAddr) -> IO ())+  -> ((Context, SockAddr) -> m ThreadId)+useTlsThenCloseFork k conn@(ctx,_) = liftIO $ do+    forkFinally (E.bracket_ (T.handshake ctx) (silentBye ctx) (k conn))+                (\eu -> T.contextClose ctx >> either E.throwIO return eu)  -------------------------------------------------------------------------------- -- Utils --- | Receives decrypted bytes from the given 'T.Context'. Returns 'Nothing'+-- | Receives decrypted bytes from the given 'Context'. Returns 'Nothing' -- on EOF. -- -- Up to @16384@ decrypted bytes will be received at once. The TLS connection is -- automatically renegotiated if a /ClientHello/ message is received.-recv :: T.Context -> IO (Maybe B.ByteString)-recv ctx =+recv :: MonadIO m => Context -> m (Maybe B.ByteString)+recv ctx = liftIO $ do     E.handle (\T.Error_EOF -> return Nothing)              (do bs <- T.recvData ctx                  if B.null bs@@ -438,9 +480,9 @@ {-# INLINABLE recv #-}  -- | Encrypts the given strict 'B.ByteString' and sends it through the--- 'T.Context'.-send :: T.Context -> B.ByteString -> IO ()-send ctx bs = T.sendData ctx (BL.fromChunks [bs])+-- 'Context'.+send :: MonadIO m => Context -> B.ByteString -> m ()+send ctx = \bs -> T.sendData ctx (BL.fromChunks [bs]) {-# INLINABLE send #-}  --------------------------------------------------------------------------------@@ -465,21 +507,25 @@ -------------------------------------------------------------------------------- -- Internal utils --- | Like 'T.bye', except it ignores 'Eg.ResourceVanished' exceptions.-byeNoVanish :: T.Context -> IO ()-byeNoVanish ctx =-    E.handle (\Eg.IOError{Eg.ioe_type=Eg.ResourceVanished} -> return ())-             (T.bye ctx)---- | Like 'T.contextClose', except it ignores 'Eg.ResourceVanished' exceptions.-contextCloseNoVanish :: T.Context -> IO ()-contextCloseNoVanish ctx =-    E.handle (\Eg.IOError{Eg.ioe_type=Eg.ResourceVanished} -> return ())-             (T.contextClose ctx)- -- | 'Control.Concurrent.forkFinally' was introduced in base==4.6.0.0. We'll use -- our own version here for a while, until base==4.6.0.0 is widely establised. forkFinally :: IO a -> (Either E.SomeException a -> IO ()) -> IO ThreadId forkFinally action and_then =     E.mask $ \restore ->         forkIO $ E.try (restore action) >>= and_then++-- | Like 'T.bye' from the "Network.TLS" module, except it ignores 'ePIPE'+-- errors which might happen if the remote peer closes the connection first.+silentBye :: Context -> IO ()+silentBye ctx = do+    E.catch (T.bye ctx) $ \e -> case e of+        Eg.IOError{ Eg.ioe_type  = Eg.ResourceVanished+                  , Eg.ioe_errno = Just ioe+                  } | Errno ioe == ePIPE+          -> return ()+        _ -> E.throwIO e++-- | Makes an TLS context `T.Backend` from a `Socket`.+socketBackend :: Socket -> T.Backend+socketBackend sock = do+    T.Backend (return ()) (S.closeSock sock) (NSB.sendAll sock) (NSB.recv sock)