connection 0.1.3.1 → 0.2.0
raw patch · 3 files changed
+52/−42 lines, 3 filesdep +data-default-classdep +x509dep +x509-storedep −certificatedep −data-defaultdep −tls-extradep ~tls
Dependencies added: data-default-class, x509, x509-store, x509-system, x509-validation
Dependencies removed: certificate, data-default, tls-extra
Dependency ranges changed: tls
Files
- Network/Connection.hs +39/−29
- Network/Connection/Types.hs +6/−4
- connection.cabal +7/−9
Network/Connection.hs view
@@ -51,14 +51,16 @@ import qualified Network.TLS as TLS import qualified Network.TLS.Extra as TLS -import System.Certificate.X509 (getSystemCertificateStore)+import System.X509 (getSystemCertificateStore) import Network.Socks5 import qualified Network as N +import Data.Default.Class import Data.Data import Data.ByteString (ByteString) import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as L import qualified Crypto.Random.AESCtr as RNG@@ -69,7 +71,6 @@ import Network.Connection.Types type Manager = MVar (M.Map TLS.SessionID TLS.SessionData)-data ConnectionSessionManager = ConnectionSessionManager Manager -- | This is the exception raised if we reached the user specified limit for -- the line in ConnectionGetLine.@@ -77,39 +78,47 @@ instance E.Exception LineTooLong -instance TLS.SessionManager ConnectionSessionManager where- sessionResume (ConnectionSessionManager mvar) sessionID =- withMVar mvar (return . M.lookup sessionID)- sessionEstablish (ConnectionSessionManager mvar) sessionID sessionData =- modifyMVar_ mvar (return . M.insert sessionID sessionData)- sessionInvalidate (ConnectionSessionManager mvar) sessionID =- modifyMVar_ mvar (return . M.delete sessionID)+connectionSessionManager :: Manager -> TLS.SessionManager+connectionSessionManager mvar = TLS.SessionManager+ { TLS.sessionResume = \sessionID -> withMVar mvar (return . M.lookup sessionID)+ , TLS.sessionEstablish = \sessionID sessionData ->+ modifyMVar_ mvar (return . M.insert sessionID sessionData)+ , TLS.sessionInvalidate = \sessionID -> modifyMVar_ mvar (return . M.delete sessionID)+ } -- | Initialize the library with shared parameters between connection. initConnectionContext :: IO ConnectionContext initConnectionContext = ConnectionContext <$> getSystemCertificateStore -makeTLSParams :: ConnectionContext -> TLSSettings -> TLS.Params-makeTLSParams cg ts@(TLSSettingsSimple {}) =- TLS.defaultParamsClient- { TLS.pConnectVersion = TLS.TLS10- , TLS.pAllowedVersions = [TLS.TLS10]- , TLS.pCiphers = TLS.ciphersuite_all- , TLS.pCertificates = []- , TLS.onCertificatesRecv = if settingDisableCertificateValidation ts- then const $ return TLS.CertificateUsageAccept- else TLS.certificateVerifyChain (globalCertificateStore cg)+makeTLSParams :: ConnectionContext -> ConnectionID -> TLSSettings -> TLS.ClientParams+makeTLSParams cg cid ts@(TLSSettingsSimple {}) =+ (TLS.defaultParamsClient (fst cid) portString)+ { TLS.clientSupported = def { TLS.supportedCiphers = TLS.ciphersuite_all }+ , TLS.clientShared = def+ { TLS.sharedCAStore = globalCertificateStore cg+ , TLS.sharedValidationCache = validationCache+ -- , TLS.sharedSessionManager = connectionSessionManager+ } }-makeTLSParams _ (TLSSettings p) = p+ where validationCache+ | settingDisableCertificateValidation ts =+ TLS.ValidationCache (\_ _ _ -> return TLS.ValidationCachePass)+ (\_ _ _ -> return ())+ | otherwise = def+ portString = BC.pack $ show $ snd cid+makeTLSParams _ cid (TLSSettings p)+ | fst cid /= fst (TLS.clientServerIdentification p) =+ error "mismatch between given server identification and connection hostname"+ | otherwise = p withBackend :: (ConnectionBackend -> IO a) -> Connection -> IO a-withBackend f conn = modifyMVar (connectionBackend conn) (\b -> f b >>= \a -> return (b,a))+withBackend f conn = readMVar (connectionBackend conn) >>= f -connectionNew :: ConnectionParams -> ConnectionBackend -> IO Connection-connectionNew p backend =+connectionNew :: ConnectionID -> ConnectionBackend -> IO Connection+connectionNew cid backend = Connection <$> newMVar backend <*> newMVar (Just B.empty)- <*> pure (connectionHostname p, connectionPort p)+ <*> pure cid -- | Use an already established handle to create a connection object. --@@ -120,8 +129,9 @@ -> ConnectionParams -> IO Connection connectFromHandle cg h p = withSecurity (connectionUseSecure p)- where withSecurity Nothing = connectionNew p $ ConnectionStream h- withSecurity (Just tlsSettings) = tlsEstablish h (makeTLSParams cg tlsSettings) >>= connectionNew p . ConnectionTLS+ where withSecurity Nothing = connectionNew cid $ ConnectionStream h+ withSecurity (Just tlsSettings) = tlsEstablish h (makeTLSParams cg cid tlsSettings) >>= connectionNew cid . ConnectionTLS+ cid = (connectionHostname p, connectionPort p) -- | connect to a destination using the parameter connectTo :: ConnectionContext -- ^ The global context of this connection.@@ -262,7 +272,7 @@ modifyMVar_ (connectionBuffer connection) $ \b -> modifyMVar (connectionBackend connection) $ \backend -> case backend of- (ConnectionStream h) -> do ctx <- tlsEstablish h (makeTLSParams cg params)+ (ConnectionStream h) -> do ctx <- tlsEstablish h (makeTLSParams cg (connectionID connection) params) return (ConnectionTLS ctx, Just B.empty) (ConnectionTLS _) -> return (backend, b) @@ -272,9 +282,9 @@ where isSecure (ConnectionStream _) = return False isSecure (ConnectionTLS _) = return True -tlsEstablish :: Handle -> TLS.TLSParams -> IO TLS.Context+tlsEstablish :: Handle -> TLS.ClientParams -> IO TLS.Context tlsEstablish handle tlsParams = do rng <- RNG.makeSystem- ctx <- TLS.contextNewOnHandle handle tlsParams rng+ ctx <- TLS.contextNew handle tlsParams rng TLS.handshake ctx return ctx
Network/Connection/Types.hs view
@@ -12,8 +12,8 @@ import Control.Concurrent.MVar (MVar) -import Data.Default-import Data.CertificateStore+import Data.Default.Class+import Data.X509.CertificateStore import Data.ByteString (ByteString) import Network.BSD (HostName)@@ -65,17 +65,19 @@ -- Not Implemented Yet. , settingUseServerName :: Bool -- ^ Use server name extension. Not Implemented Yet. } -- ^ Simple TLS settings. recommended to use.- | TLSSettings TLS.Params -- ^ full blown TLS Settings directly using TLS.Params. for power users.+ | TLSSettings TLS.ClientParams -- ^ full blown TLS Settings directly using TLS.Params. for power users. deriving (Show) instance Default TLSSettings where def = TLSSettingsSimple False False False +type ConnectionID = (HostName, PortNumber)+ -- | This opaque type represent a connection to a destination. data Connection = Connection { connectionBackend :: MVar ConnectionBackend , connectionBuffer :: MVar (Maybe ByteString) -- ^ this is set to 'Nothing' on EOF- , connectionID :: (HostName, PortNumber) -- ^ return a simple tuple of the port and hostname that we're connected to.+ , connectionID :: ConnectionID -- ^ return a simple tuple of the port and hostname that we're connected to. } -- | Shared values (certificate store, sessions, ..) between connections
connection.cabal view
@@ -1,5 +1,5 @@ Name: connection-Version: 0.1.3.1+Version: 0.2.0 Description: Simple network library for all your connection need. .@@ -20,21 +20,19 @@ Homepage: http://github.com/vincenthz/hs-connection data-files: README.md -Flag test- Description: Build unit test- Default: False- Library Build-Depends: base >= 3 && < 5 , bytestring , containers- , data-default+ , data-default-class , network >= 2.3- , tls >= 1.0 && < 1.2- , tls-extra >= 0.5 && < 0.7+ , tls >= 1.2 , cprng-aes , socks >= 0.4- , certificate >= 1.3.0 && < 1.4.0+ , x509 >= 1.4+ , x509-store >= 1.4+ , x509-system >= 1.4+ , x509-validation >= 1.5 Exposed-modules: Network.Connection Other-modules: Network.Connection.Types ghc-options: -Wall