diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2013, Renzo Carbonara +Copyright (c) 2013-2018, Renzo Carbonara All rights reserved. diff --git a/PEOPLE b/PEOPLE --- a/PEOPLE +++ b/PEOPLE @@ -1,6 +1,7 @@ -The following people have participated in creating this library at some -point, either by directly contributing code or by providing thoughtful -input in discussions about the library design. +The following people have participated in creating this library, either +by directly contributing code or by providing thoughtful input in +discussions about the library design. Please note that if you want to be +part of this list you need to add yourself to it. Renzo Carbonara Vincent Hanquez diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,4 @@ +#! /usr/bin/env nix-shell +#! nix-shell ./shell.nix -i runghc import Distribution.Simple main = defaultMain diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,21 @@ +# Version 0.3 + +* BREAKING CHANGE: Changed type of the following functions: + `getDefaultClientSettings`, `makeClientSettings`, `updateClientParams`, + `clientParams`, `makeServerSettings`, `updateServerParams`, `serverParams`. + +* BREAKING CHANGE: Only TLS 1.1 and TLS 1.2 are supported by default. + +* Server's choice of ciphers are always prefered over client's. + +* Server code will mandate strong cipher requirements, client code will be more + permissive. + +* Compatible with `tls-1.4` + +* Remove upper bounds for all dependencies except `base`. + + # Version 0.2.1 * Ensure that the Socket TLS backend always receive the expected number diff --git a/network-simple-tls.cabal b/network-simple-tls.cabal --- a/network-simple-tls.cabal +++ b/network-simple-tls.cabal @@ -1,5 +1,5 @@ name: network-simple-tls -version: 0.2.1 +version: 0.3 synopsis: Simple interface to TLS secured network sockets. description: Simple interface to TLS secured network sockets. homepage: https://github.com/k0001/network-simple-tls @@ -7,8 +7,8 @@ license: BSD3 license-file: LICENSE author: Renzo Carbonara -maintainer: renzocarbonaraλgmail.com -copyright: Copyright (c) Renzo Carbonara 2013 +maintainer: renλren.zone +copyright: Copyright (c) Renzo Carbonara 2013-2018 category: Network build-type: Simple cabal-version: >=1.8 @@ -22,17 +22,16 @@ hs-source-dirs: src exposed-modules: Network.Simple.TCP.TLS build-depends: base (>=4.5 && <5.0) - , bytestring (>=0.9.2.1 && <0.11) - , network (>=2.3 && <2.5) - -- 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) - + , bytestring + , network + , exceptions + , network-simple + , tls + , transformers + , x509 + , x509-system + , x509-store + , x509-validation + , data-default ghc-options: -Wall -O2 - ghc-prof-options: -prof -fprof-auto-top diff --git a/src/Network/Simple/TCP/TLS.hs b/src/Network/Simple/TCP/TLS.hs --- a/src/Network/Simple/TCP/TLS.hs +++ b/src/Network/Simple/TCP/TLS.hs @@ -1,4 +1,6 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} -- | This module exports simple tools for establishing TLS-secured TCP -- connections, relevant to both the client side and server side of the @@ -8,7 +10,7 @@ -- 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 +-- This module uses 'MonadIO' and 'C.MonadMask' 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. @@ -36,10 +38,6 @@ , updateClientParams , clientParams - -- * Credentials - , Credential(Credential) - , credentialToCertList - -- * Utils , recv , send @@ -56,42 +54,44 @@ -- * Note to Windows users , NS.withSocketsDo - -- * Exports - -- $exports + -- * Re-exports + -- $reexports , module Network.Simple.TCP , module Network.Socket , module Network.TLS + , T.Credentials ) where -import Control.Concurrent (ThreadId, forkIO) -import qualified Control.Exception as E +import Control.Concurrent (ThreadId, forkFinally) +import qualified Control.Exception as E 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 qualified Control.Monad.Catch as C +import Control.Monad.IO.Class (MonadIO, liftIO) +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL +import Data.Default (def) +import Data.List (intersect) +import Data.Maybe (isJust, listToMaybe) +import qualified Data.X509 as X +import qualified Data.X509.CertificateStore as X +import qualified Data.X509.Validation as X +import Foreign.C.Error (Errno(Errno), ePIPE) +import qualified GHC.IO.Exception as Eg +import qualified Network.Simple.TCP as S +import Network.Simple.TCP (HostPreference(Host, HostAny, HostIPv4, HostIPv6)) +import Network.Socket (HostName, ServiceName, Socket, SockAddr) +import qualified Network.Socket as NS +import qualified Network.Socket.ByteString as NSB +import qualified Network.TLS as T +import Network.TLS (Context) +import Network.TLS.Extra as TE +import System.X509 (getSystemCertificateStore) -------------------------------------------------------------------------------- -import Network.Simple.TCP (HostPreference(Host, HostAny, HostIPv4, HostIPv6)) -import Network.Socket (HostName, ServiceName, Socket, SockAddr) -import Network.TLS (Context) --- $exports +-- $reexports -- -- For your convenience, this module module also re-exports the following types -- from other modules: @@ -104,95 +104,107 @@ -- [From "Network.TLS"] 'Context'. -------------------------------------------------------------------------------- - --- | Primary certificate, private key and the rest of the certificate chain. -data Credential = Credential !X.X509 !T.PrivateKey [X.X509] - deriving (Show) - --- | Convert client `Credential` to the format expected by 'T.pCertificates'. -credentialToCertList :: Credential -> [(X.X509, Maybe T.PrivateKey)] -credentialToCertList (Credential c pk xs) = - (c, Just pk) : fmap (\x -> (x, Nothing)) xs - --------------------------------------------------------------------------------- -- Client side TLS settings -- | Abstract type representing the configuration settings for a TLS client. -- --- Use 'makeClientSettings' or 'getDefaultClientSettings' to obtain your +-- Use 'makeClientSettings' or 'getDefaultClientSettings' to obtain a -- 'ClientSettings' value. -data ClientSettings = ClientSettings { unClientSettings :: T.Params } +data ClientSettings = ClientSettings { unClientSettings :: T.ClientParams } --- | Get the system default 'ClientSettings'. +-- | Get the system default 'ClientSettings' for a particular 'X.ServiceID'. -- --- See 'makeClientSettings' for the for the default TLS settings used. -getDefaultClientSettings :: MonadIO m => m ClientSettings -getDefaultClientSettings = liftIO $ do - makeClientSettings [] Nothing `fmap` getSystemCertificateStore +-- Defaults: No client credentials, system certificate store. +-- +-- See 'makeClientSettings' to better understand the default settings used. +getDefaultClientSettings :: MonadIO m => X.ServiceID -> m ClientSettings +getDefaultClientSettings sid = liftIO $ do + makeClientSettings sid (T.Credentials []) <$> getSystemCertificateStore + -- | Make defaults 'ClientSettings'. -- --- The following TLS settings are used by default: +-- Certificate chain validation is done by 'X.validateDefault' from the +-- "Data.X509.Validation" module. -- --- [Supported versions] 'T.TLS10', 'T.TLS11', 'T.TLS12'. +-- The Server Name Indication (SNI) TLS extension is enabled. -- --- [Version reported during /ClientHello/] 'T.TLS10'. +-- The supported cipher suites are those enumerated by 'TE.ciphersuite_default', +-- in decreasing order of preference. -- --- [Supported cipher suites] In decreasing order of preference: --- 'TE.cipher_AES256_SHA256', --- 'TE.cipher_AES256_SHA1', --- 'TE.cipher_AES128_SHA256', --- 'TE.cipher_AES128_SHA1', --- 'TE.cipher_RC4_128_SHA1', --- 'TE.cipher_RC4_128_MD5'. +-- Secure renegotiation is enabled. +-- +-- Only the __TLS 1.1__ and __TLS 1.2__ protocols are supported by default. +-- +-- If you are unsatisfied with any of these settings, use 'updateClientParams' +-- to change them. makeClientSettings - :: [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 HostName -- ^Explicit Server Name Identification (SNI). - -> C.CertificateStore -- ^CAs used to verify the server certificate. - -- Use 'getSystemCertificateStore' to obtain - -- the operating system's defaults. + :: X.ServiceID + -- ^ @ + -- 'X.ServiceID' ~ ('HostName', 'B.ByteString') + -- @ + -- + -- Identification of the connection consisting of the fully qualified host + -- name for the server (e.g. www.example.com) and an optional suffix. + -- + -- It is important that the hostname part is properly filled for security + -- reasons, as it allow to properly associate the remote side with the given + -- certificate during a handshake. + -- + -- The suffix is used to identity a certificate per service on a specific + -- host. For example, a same host might have different certificates on + -- differents ports (443 and 995). For TCP connections, it's recommended + -- to use: @:port@, or @:service@ for the blob (e.g., \@":443"@, @\":https"@). + -> T.Credentials + -- ^ Credentials to provide to the server if requested. Only credentials + -- matching the server's 'X.DistinguishedName' will be submitted. + -- + -- Initial credentials can be loaded with 'T.credentialLoadX509' + -> X.CertificateStore + -- ^ CAs used to verify the server certificate. + -- + -- Use 'getSystemCertificateStore' to obtain the operating system's defaults. -> ClientSettings -makeClientSettings creds msni cStore = - ClientSettings . T.updateClientParams modClientParams - . modParamsCore - $ T.defaultParamsClient +makeClientSettings (hn, sp) (T.Credentials creds) cStore = + ClientSettings $ (T.defaultParamsClient hn sp) + { T.clientUseServerNameIndication = True + , T.clientSupported = def + { T.supportedVersions = [T.TLS12, T.TLS11] + , T.supportedCiphers = TE.ciphersuite_default + , T.supportedSecureRenegotiation = True + , T.supportedClientInitiatedRenegotiation = True } + , T.clientShared = def { T.sharedCAStore = cStore } + , T.clientHooks = def + { T.onServerCertificate = X.validateDefault + , T.onCertificateRequest = pure . findCredential } + } where - modParamsCore p = p - { T.pConnectVersion = T.TLS10 - , T.pAllowedVersions = [T.TLS12, T.TLS11, T.TLS10] - , T.pCiphers = ciphers_AES_CBC ++ ciphers_RC4 - , T.pUseSession = True - , T.pCertificates = [] - , T.onCertificatesRecv = TE.certificateVerifyChain cStore } - modClientParams cp = cp - { T.onCertificateRequest = - return . maybe firstCerts credentialToCertList . findCredential - , T.clientUseServerName = msni } - -- | Find the first Credential that matches the given requirements. -- Currently, the only requirement considered is the subject DN. + findCredential + :: ([T.CertificateType], + Maybe [T.HashAndSignatureAlgorithm], + [X.DistinguishedName]) + -> Maybe (X.CertificateChain, X.PrivKey) findCredential (_, _, dns) = listToMaybe (filter isSubject creds) where - isSubject (Credential c _ _) = X.certSubjectDN (X.x509Cert c) `elem` dns - - firstCerts = - case creds of - (c:_) -> credentialToCertList c - [] -> error "makeClientSettings:\ - \ no Credential given but server requested one" - + isSubject (X.CertificateChain cc, _) = + any (\c -> (X.certSubjectDN . X.getCertificate) c `elem` dns) cc --- | Update advanced TLS client configuration 'T.Params'. +-- | Update advanced TLS client configuration 'T.ClientParams'. +-- -- See the "Network.TLS" module for details. -updateClientParams :: (T.Params -> T.Params) -> ClientSettings -> ClientSettings +updateClientParams + :: (T.ClientParams -> T.ClientParams) -> ClientSettings -> ClientSettings updateClientParams f = ClientSettings . f . unClientSettings --- | A 'Control.Lens.Lens' into the TLS client configuration 'T.Params'. +-- | A 'Control.Lens.Lens' into the TLS client configuration 'T.ClientParams'. +-- -- See the "Network.TLS" and the @lens@ package for details. -clientParams :: Functor f => (T.Params -> f T.Params) - -> (ClientSettings -> f ClientSettings) +clientParams + :: Functor f + => (T.ClientParams -> f T.ClientParams) + -> (ClientSettings -> f ClientSettings) clientParams f = fmap ClientSettings . f . unClientSettings -------------------------------------------------------------------------------- @@ -200,70 +212,78 @@ -- | Abstract type representing the configuration settings for a TLS server. -- --- Use 'makeServerSettings' to obtain your 'ServerSettings' value, and +-- Use 'makeServerSettings' to construct a 'ServerSettings' value, and -- 'updateServerParams' to update it. -data ServerSettings = ServerSettings { unServerSettings :: T.Params } +data ServerSettings = ServerSettings { unServerSettings :: T.ServerParams } -- | Make default 'ServerSettings'. -- --- The following TLS settings are used by default: +-- The supported cipher suites are those enumerated by 'TE.ciphersuite_strong', +-- in decreasing order of preference. The cipher suite preferred by the server +-- is used. -- --- [Supported versions] 'T.TLS10', 'T.TLS11', 'T.TLS12'. +-- Secure renegotiation initiated by the server is enabled, but renegotiation +-- initiated by the client is disabled. -- --- [Supported cipher suites for 'T.TLS10'] --- In decreasing order of preference: --- 'TE.cipher_AES256_SHA256', --- 'TE.cipher_AES256_SHA1', --- 'TE.cipher_AES128_SHA256', --- 'TE.cipher_AES128_SHA1', --- 'TE.cipher_RC4_128_SHA1', --- 'TE.cipher_RC4_128_MD5'. --- The cipher suite preferred by the client is used. +-- Only the __TLS 1.1__ and __TLS 1.2__ protocols are supported by default. -- --- [Supported cipher suites for 'T.TLS11' and 'T.TLS12'] --- In decreasing order of preference: --- 'TE.cipher_AES256_SHA256', --- 'TE.cipher_AES256_SHA1', --- 'TE.cipher_AES128_SHA256', --- 'TE.cipher_AES128_SHA1'. --- The cipher suite preferred by the client is used. +-- If you are unsatisfied with any of these settings, use 'updateServerParams' +-- to change them. makeServerSettings - :: Credential -- ^Server credential. - -> Maybe C.CertificateStore -- ^CAs used to verify the client certificate. If - -- specified, then a valid client certificate will - -- be expected during on handshake. + :: T.Credential + -- ^ Server credential. + -> Maybe X.CertificateStore + -- ^ CAs used to verify the client certificate. + -- + -- If specified, then a valid client certificate will be expected during + -- handshake. + -- + -- Use 'getSystemCertificateStore' to obtain the operating system's defaults. -> ServerSettings -makeServerSettings creds mcStore = - ServerSettings . T.updateServerParams modServerParams - . modParamsCore - $ T.defaultParamsServer +makeServerSettings cred ycStore = + ServerSettings $ def + { T.serverWantClientCert = isJust ycStore + , T.serverShared = def + { T.sharedCredentials = T.Credentials [cred] } + , T.serverCACertificates = [] + , T.serverSupported = def + { T.supportedVersions = [T.TLS12, T.TLS11] + , T.supportedCiphers = TE.ciphersuite_strong + , T.supportedSession = True + , T.supportedSecureRenegotiation = True + , T.supportedClientInitiatedRenegotiation = False } + , T.serverHooks = def + { T.onClientCertificate = clientCertsCheck + , T.onCipherChoosing = chooseCipher } + } where - modParamsCore p = p - { T.pConnectVersion = T.TLS10 - , T.pAllowedVersions = [T.TLS12, T.TLS11, T.TLS10] - , T.pCiphers = ciphers_AES_CBC ++ ciphers_RC4 - , T.pUseSession = True - , T.pCertificates = credentialToCertList creds } - modServerParams sp = sp - { T.serverWantClientCert = maybe False (const True) mcStore - , T.onClientCertificate = clientCertsCheck - , T.onCipherChoosing = chooseCipher - , T.serverCACertificates = maybe [] C.listCertificates mcStore } - clientCertsCheck certs = case mcStore of + clientCertsCheck :: X.CertificateChain -> IO T.CertificateUsage + clientCertsCheck certs = case ycStore of Nothing -> return T.CertificateUsageAccept - Just cs -> TE.certificateVerifyChain cs certs - -- | Ciphers prefered by the client take precedence. - chooseCipher v cCiphs = head (intersect cCiphs (preferredCiphers v)) + Just cs -> do + let checks = X.defaultChecks { X.checkFQHN = False } + es <- X.validate X.HashSHA256 X.defaultHooks checks cs def ("","") certs + case es of + [] -> pure T.CertificateUsageAccept + errs' -> pure (T.CertificateUsageReject (T.CertificateRejectOther + ("Unacceptable client cert: " ++ show errs'))) + -- Ciphers prefered by the server take precedence. + chooseCipher :: T.Version -> [T.Cipher] -> T.Cipher + chooseCipher _ cCiphs = head (intersect TE.ciphersuite_strong cCiphs) -- | Update advanced TLS server configuration 'T.Params'. +-- -- See the "Network.TLS" module for details. -updateServerParams :: (T.Params -> T.Params) -> ServerSettings -> ServerSettings +updateServerParams + :: (T.ServerParams -> T.ServerParams) -> ServerSettings -> ServerSettings updateServerParams f = ServerSettings . f . unServerSettings -- | A 'Control.Lens.Lens' into the TLS server configuration 'T.Params'. -- See the "Network.TLS" and the @lens@ package for details. -serverParams :: Functor f => (T.Params -> f T.Params) - -> (ServerSettings -> f ServerSettings) +serverParams + :: Functor f + => (T.ServerParams -> f T.ServerParams) + -> (ServerSettings -> f ServerSettings) serverParams f = fmap ServerSettings . f . unServerSettings -------------------------------------------------------------------------------- @@ -300,7 +320,7 @@ -- in case of exceptions. If you need to manage the lifetime of the connection -- resources yourself, then use 'acceptTls' instead. accept - :: (MonadIO m, C.MonadCatch m) + :: (MonadIO m, C.MonadMask m) => ServerSettings -- ^TLS settings. -> Socket -- ^Listening and bound socket. -> ((Context, SockAddr) -> m r) @@ -339,7 +359,7 @@ -- in case of exceptions. If you need to manage the lifetime of the connection -- resources yourself, then use 'connectTls' instead. connect - :: (MonadIO m, C.MonadCatch m) + :: (MonadIO m, C.MonadMask m) => ClientSettings -- ^TLS settings. -> HostName -- ^Server hostname. -> ServiceName -- ^Server service port. @@ -376,22 +396,14 @@ (S.connectSock host port) (S.closeSock . fst) (\(sock, addr) -> do - ctx <- makeClientContext (updateClientParams up cs) sock + ctx <- makeClientContext cs sock return (ctx, addr)) - where - 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 } -- | 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 + T.contextNew (socketBackend sock) params -------------------------------------------------------------------------------- @@ -423,7 +435,7 @@ -- 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 + T.contextNew (socketBackend sock) params -------------------------------------------------------------------------------- @@ -434,7 +446,7 @@ -- 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) + :: (MonadIO m, C.MonadMask m) => ((Context, SockAddr) -> m a) -> ((Context, SockAddr) -> m a) useTls k conn@(ctx,_) = C.bracket_ (T.handshake ctx) @@ -443,7 +455,7 @@ -- | Like 'useTls', except it also fully closes the TCP connection when done. useTlsThenClose - :: (MonadIO m, C.MonadCatch m) + :: (MonadIO m, C.MonadMask m) => ((Context, SockAddr) -> m a) -> ((Context, SockAddr) -> m a) useTlsThenClose k conn@(ctx,_) = do @@ -468,8 +480,7 @@ -- | 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. +-- Up to @16384@ decrypted bytes will be received at once. recv :: MonadIO m => Context -> m (Maybe B.ByteString) recv ctx = liftIO $ do E.handle (\T.Error_EOF -> return Nothing) @@ -486,34 +497,8 @@ {-# INLINABLE send #-} -------------------------------------------------------------------------------- --- Internal: Default ciphers - -ciphers_RC4 :: [T.Cipher] -ciphers_RC4 = [ TE.cipher_RC4_128_SHA1 - , TE.cipher_RC4_128_MD5 ] - -ciphers_AES_CBC :: [T.Cipher] -ciphers_AES_CBC = [ TE.cipher_AES256_SHA256 - , TE.cipher_AES256_SHA1 - , TE.cipher_AES128_SHA256 - , TE.cipher_AES128_SHA1 ] - -preferredCiphers :: T.Version -> [T.Cipher] -preferredCiphers T.TLS12 = ciphers_AES_CBC -preferredCiphers T.TLS11 = ciphers_AES_CBC -preferredCiphers T.TLS10 = ciphers_AES_CBC ++ ciphers_RC4 -preferredCiphers v = error ("preferredCiphers: " ++ show v ++ " not supported") - --------------------------------------------------------------------------------- -- Internal utils --- | '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 () @@ -535,3 +520,4 @@ step !acc n = do bs <- NSB.recv sock n step (acc `B.append` bs) (n - B.length bs) +