connection-0.2.8/Network/0000755000000000000000000000000013064055304013477 5ustar0000000000000000connection-0.2.8/Network/Connection/0000755000000000000000000000000012712437501015600 5ustar0000000000000000connection-0.2.8/Network/Connection.hs0000644000000000000000000004160213064055304016135 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ScopedTypeVariables #-} -- | -- Module : Network.Connection -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : portable -- -- Simple connection abstraction -- module Network.Connection ( -- * Type for a connection Connection , connectionID , ConnectionParams(..) , TLSSettings(..) , ProxySettings(..) , SockSettings -- * Exceptions , LineTooLong(..) , HostNotResolved(..) , HostCannotConnect(..) -- * Library initialization , initConnectionContext , ConnectionContext -- * Connection operation , connectFromHandle , connectFromSocket , connectTo , connectionClose -- * Sending and receiving data , connectionGet , connectionGetExact , connectionGetChunk , connectionGetChunk' , connectionGetLine , connectionWaitForInput , connectionPut -- * TLS related operation , connectionSetSecure , connectionIsSecure ) where import Control.Applicative import Control.Concurrent.MVar import Control.Monad (join) import qualified Control.Exception as E import qualified System.IO.Error as E (mkIOError, eofErrorType) import qualified Network.TLS as TLS import qualified Network.TLS.Extra as TLS import System.X509 (getSystemCertificateStore) import Network.Socks5 import qualified Network as N import Network.Socket import Network.BSD (getProtocolNumber) import qualified Network.Socket as N (close) import qualified Network.Socket.ByteString 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 System.Environment import System.Timeout import System.IO import qualified Data.Map as M import Network.Connection.Types type Manager = MVar (M.Map TLS.SessionID TLS.SessionData) -- | This is the exception raised if we reached the user specified limit for -- the line in ConnectionGetLine. data LineTooLong = LineTooLong deriving (Show,Typeable) -- | Exception raised when there's no resolution for a specific host data HostNotResolved = HostNotResolved String deriving (Show,Typeable) -- | Exception raised when the connect failed data HostCannotConnect = HostCannotConnect String [E.IOException] deriving (Show,Typeable) instance E.Exception LineTooLong instance E.Exception HostNotResolved instance E.Exception HostCannotConnect 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 -- | Create a final TLS 'ClientParams' according to the destination and the -- TLSSettings. 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 } } where validationCache | settingDisableCertificateValidation ts = TLS.ValidationCache (\_ _ _ -> return TLS.ValidationCachePass) (\_ _ _ -> return ()) | otherwise = def portString = BC.pack $ show $ snd cid makeTLSParams _ cid (TLSSettings p) = p { TLS.clientServerIdentification = (fst cid, portString) } where portString = BC.pack $ show $ snd cid withBackend :: (ConnectionBackend -> IO a) -> Connection -> IO a withBackend f conn = readMVar (connectionBackend conn) >>= f connectionNew :: ConnectionID -> ConnectionBackend -> IO Connection connectionNew cid backend = Connection <$> newMVar backend <*> newMVar (Just B.empty) <*> pure cid -- | Use an already established handle to create a connection object. -- -- if the TLS Settings is set, it will do the handshake with the server. -- The SOCKS settings have no impact here, as the handle is already established connectFromHandle :: ConnectionContext -> Handle -> ConnectionParams -> IO Connection connectFromHandle cg h p = withSecurity (connectionUseSecure p) where withSecurity Nothing = connectionNew cid $ ConnectionStream h withSecurity (Just tlsSettings) = tlsEstablish h (makeTLSParams cg cid tlsSettings) >>= connectionNew cid . ConnectionTLS cid = (connectionHostname p, connectionPort p) -- | Use an already established handle to create a connection object. -- -- if the TLS Settings is set, it will do the handshake with the server. -- The SOCKS settings have no impact here, as the handle is already established connectFromSocket :: ConnectionContext -> Socket -> ConnectionParams -> IO Connection connectFromSocket cg sock p = withSecurity (connectionUseSecure p) where withSecurity Nothing = connectionNew cid $ ConnectionSocket sock withSecurity (Just tlsSettings) = tlsEstablish sock (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. -> ConnectionParams -- ^ The parameters for this connection (where to connect, and such). -> IO Connection -- ^ The new established connection on success. connectTo cg cParams = do conFct <- getConFct (connectionUseSocks cParams) let doConnect = conFct (connectionHostname cParams) (N.PortNumber $ connectionPort cParams) E.bracketOnError doConnect N.close $ \h-> connectFromSocket cg h cParams where getConFct Nothing = return resolve' getConFct (Just (OtherProxy h p)) = return $ \_ _ -> resolve' h (N.PortNumber p) getConFct (Just (SockSettingsSimple h p)) = return $ socksConnectTo' h (N.PortNumber p) getConFct (Just (SockSettingsEnvironment v)) = do -- if we can't get the environment variable or that the variable cannot be parsed -- we connect directly. let name = maybe "SOCKS_SERVER" id v evar <- E.try (getEnv name) case evar of Left (_ :: E.IOException) -> return resolve' Right var -> case parseSocks var of Nothing -> return resolve' Just (sHost, sPort) -> return $ socksConnectTo' sHost (N.PortNumber $ fromIntegral (sPort :: Int)) -- Try to parse "host:port" or "host" parseSocks s = case break (== ':') s of (sHost, "") -> Just (sHost, 1080) (sHost, ':':portS) -> case reads portS of [(sPort,"")] -> Just (sHost, sPort) _ -> Nothing _ -> Nothing resolve' host portid = do let serv = case portid of N.Service serv -> serv N.PortNumber n -> show n _ -> error "cannot resolve service" proto <- getProtocolNumber "tcp" let hints = defaultHints { addrFlags = [AI_ADDRCONFIG] , addrProtocol = proto , addrSocketType = Stream } addrs <- getAddrInfo (Just hints) (Just host) (Just serv) firstSuccessful $ map tryToConnect addrs where tryToConnect addr = E.bracketOnError (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)) (N.close) (\sock -> connect sock (addrAddress addr) >> return sock) firstSuccessful = go [] where go :: [E.IOException] -> [IO a] -> IO a go [] [] = E.throwIO $ HostNotResolved host go l@(_:_) [] = E.throwIO $ HostCannotConnect host l go acc (act:followingActs) = do er <- E.try act case er of Left err -> go (err:acc) followingActs Right r -> return r -- | Put a block of data in the connection. connectionPut :: Connection -> ByteString -> IO () connectionPut connection content = withBackend doWrite connection where doWrite (ConnectionStream h) = B.hPut h content >> hFlush h doWrite (ConnectionSocket s) = N.sendAll s content doWrite (ConnectionTLS ctx) = TLS.sendData ctx $ L.fromChunks [content] -- | Get exact count of bytes from a connection. -- -- The size argument is the exact amount that must be returned to the user. -- The call will wait until all data is available. Hence, it behaves like -- 'B.hGet'. -- -- On end of input, 'connectionGetExact' will throw an 'E.isEOFError' -- exception. connectionGetExact :: Connection -> Int -> IO ByteString connectionGetExact conn x = loop B.empty 0 where loop bs y | y == x = return bs | otherwise = do next <- connectionGet conn (x - y) loop (B.append bs next) (y + (B.length next)) -- | Get some bytes from a connection. -- -- The size argument is just the maximum that could be returned to the user. -- The call will return as soon as there's data, even if there's less -- than requested. Hence, it behaves like 'B.hGetSome'. -- -- On end of input, 'connectionGet' returns 0, but subsequent calls will throw -- an 'E.isEOFError' exception. connectionGet :: Connection -> Int -> IO ByteString connectionGet conn size | size < 0 = fail "Network.Connection.connectionGet: size < 0" | size == 0 = return B.empty | otherwise = connectionGetChunkBase "connectionGet" conn $ B.splitAt size -- | Get the next block of data from the connection. connectionGetChunk :: Connection -> IO ByteString connectionGetChunk conn = connectionGetChunkBase "connectionGetChunk" conn $ \s -> (s, B.empty) -- | Like 'connectionGetChunk', but return the unused portion to the buffer, -- where it will be the next chunk read. connectionGetChunk' :: Connection -> (ByteString -> (a, ByteString)) -> IO a connectionGetChunk' = connectionGetChunkBase "connectionGetChunk'" -- | Wait for input to become available on a connection. -- -- As with 'hWaitForInput', the timeout value is given in milliseconds. If the -- timeout value is less than zero, then 'connectionWaitForInput' waits -- indefinitely. -- -- Unlike 'hWaitForInput', this function does not do any decoding, so it -- returns true when there is /any/ available input, not just full characters. connectionWaitForInput :: Connection -> Int -> IO Bool connectionWaitForInput conn timeout_ms = maybe False (const True) <$> timeout timeout_ns tryGetChunk where tryGetChunk = connectionGetChunkBase "connectionWaitForInput" conn $ \buf -> ((), buf) timeout_ns = timeout_ms * 1000 connectionGetChunkBase :: String -> Connection -> (ByteString -> (a, ByteString)) -> IO a connectionGetChunkBase loc conn f = modifyMVar (connectionBuffer conn) $ \m -> case m of Nothing -> throwEOF conn loc Just buf | B.null buf -> do chunk <- withBackend getMoreData conn if B.null chunk then closeBuf chunk else updateBuf chunk | otherwise -> updateBuf buf where getMoreData (ConnectionTLS tlsctx) = TLS.recvData tlsctx getMoreData (ConnectionSocket sock) = N.recv sock 1500 getMoreData (ConnectionStream h) = B.hGetSome h (16 * 1024) updateBuf buf = case f buf of (a, !buf') -> return (Just buf', a) closeBuf buf = case f buf of (a, _buf') -> return (Nothing, a) -- | Get the next line, using ASCII LF as the line terminator. -- -- This throws an 'isEOFError' exception on end of input, and LineTooLong when -- the number of bytes gathered is over the limit without a line terminator. -- -- The actual line returned can be bigger than the limit specified, provided -- that the last chunk returned by the underlaying backend contains a LF. -- In another world only when we need more input and limit is reached that the -- LineTooLong exception will be raised. -- -- An end of file will be considered as a line terminator too, if line is -- not empty. connectionGetLine :: Int -- ^ Maximum number of bytes before raising a LineTooLong exception -> Connection -- ^ Connection -> IO ByteString -- ^ The received line with the LF trimmed connectionGetLine limit conn = more (throwEOF conn loc) 0 id where loc = "connectionGetLine" lineTooLong = E.throwIO LineTooLong -- Accumulate chunks using a difference list, and concatenate them -- when an end-of-line indicator is reached. more eofK !currentSz !dl = getChunk (\s -> let len = B.length s in if currentSz + len > limit then lineTooLong else more eofK (currentSz + len) (dl . (s:))) (\s -> done (dl . (s:))) (done dl) done :: ([ByteString] -> [ByteString]) -> IO ByteString done dl = return $! B.concat $ dl [] -- Get another chunk, and call one of the continuations getChunk :: (ByteString -> IO r) -- moreK: need more input -> (ByteString -> IO r) -- doneK: end of line (line terminator found) -> IO r -- eofK: end of file -> IO r getChunk moreK doneK eofK = join $ connectionGetChunkBase loc conn $ \s -> if B.null s then (eofK, B.empty) else case B.break (== 10) s of (a, b) | B.null b -> (moreK a, B.empty) | otherwise -> (doneK a, B.tail b) throwEOF :: Connection -> String -> IO a throwEOF conn loc = E.throwIO $ E.mkIOError E.eofErrorType loc' Nothing (Just path) where loc' = "Network.Connection." ++ loc path = let (host, port) = connectionID conn in host ++ ":" ++ show port -- | Close a connection. connectionClose :: Connection -> IO () connectionClose = withBackend backendClose where backendClose (ConnectionTLS ctx) = ignoreIOExc (TLS.bye ctx) `E.finally` TLS.contextClose ctx backendClose (ConnectionSocket sock) = N.close sock backendClose (ConnectionStream h) = hClose h ignoreIOExc action = action `E.catch` \(_ :: E.IOException) -> return () -- | Activate secure layer using the parameters specified. -- -- This is typically used to negociate a TLS channel on an already -- establish channel, e.g. supporting a STARTTLS command. it also -- flush the received buffer to prevent application confusing -- received data before and after the setSecure call. -- -- If the connection is already using TLS, nothing else happens. connectionSetSecure :: ConnectionContext -> Connection -> TLSSettings -> IO () connectionSetSecure cg connection params = modifyMVar_ (connectionBuffer connection) $ \b -> modifyMVar (connectionBackend connection) $ \backend -> case backend of (ConnectionStream h) -> do ctx <- tlsEstablish h (makeTLSParams cg (connectionID connection) params) return (ConnectionTLS ctx, Just B.empty) (ConnectionSocket s) -> do ctx <- tlsEstablish s (makeTLSParams cg (connectionID connection) params) return (ConnectionTLS ctx, Just B.empty) (ConnectionTLS _) -> return (backend, b) -- | Returns if the connection is establish securely or not. connectionIsSecure :: Connection -> IO Bool connectionIsSecure conn = withBackend isSecure conn where isSecure (ConnectionStream _) = return False isSecure (ConnectionSocket _) = return False isSecure (ConnectionTLS _) = return True tlsEstablish :: TLS.HasBackend backend => backend -> TLS.ClientParams -> IO TLS.Context tlsEstablish handle tlsParams = do ctx <- TLS.contextNew handle tlsParams TLS.handshake ctx return ctx connection-0.2.8/Network/Connection/Types.hs0000644000000000000000000000763112712437501017247 0ustar0000000000000000-- | -- Module : Network.Connection.Types -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : portable -- -- connection types -- module Network.Connection.Types where import Control.Concurrent.MVar (MVar) import Data.Default.Class import Data.X509.CertificateStore import Data.ByteString (ByteString) import Network.BSD (HostName) import Network.Socket (PortNumber, Socket) import qualified Network.TLS as TLS import System.IO (Handle) -- | Simple backend enumeration, either using a raw connection or a tls connection. data ConnectionBackend = ConnectionStream Handle | ConnectionSocket Socket | ConnectionTLS TLS.Context -- | Connection Parameters to establish a Connection. -- -- The strict minimum is an hostname and the port. -- -- If you need to establish a TLS connection, you should make sure -- connectionUseSecure is correctly set. -- -- If you need to connect through a SOCKS, you should make sure -- connectionUseSocks is correctly set. data ConnectionParams = ConnectionParams { connectionHostname :: HostName -- ^ host name to connect to. , connectionPort :: PortNumber -- ^ port number to connect to. , connectionUseSecure :: Maybe TLSSettings -- ^ optional TLS parameters. , connectionUseSocks :: Maybe ProxySettings -- ^ optional Proxy/Socks configuration. } -- | Proxy settings for the connection. -- -- OtherProxy handles specific application-level proxies like HTTP proxies. -- -- The simple SOCKS settings is just the hostname and portnumber of the SOCKS proxy server. -- -- That's for now the only settings in the SOCKS package, -- socks password, or any sort of other authentications is not yet implemented. data ProxySettings = SockSettingsSimple HostName PortNumber | SockSettingsEnvironment (Maybe String) | OtherProxy HostName PortNumber type SockSettings = ProxySettings -- | TLS Settings that can be either expressed as simple settings, -- or as full blown TLS.Params settings. -- -- Unless you need access to parameters that are not accessible through the -- simple settings, you should use TLSSettingsSimple. data TLSSettings = TLSSettingsSimple { settingDisableCertificateValidation :: Bool -- ^ Disable certificate verification completely, -- this make TLS/SSL vulnerable to a MITM attack. -- not recommended to use, but for testing. , settingDisableSession :: Bool -- ^ Disable session management. TLS/SSL connections -- will always re-established their context. -- Not Implemented Yet. , settingUseServerName :: Bool -- ^ Use server name extension. Not Implemented Yet. } -- ^ Simple TLS settings. recommended to use. | 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 :: ConnectionID -- ^ return a simple tuple of the port and hostname that we're connected to. } -- | Shared values (certificate store, sessions, ..) between connections -- -- At the moment, this is only strictly needed to shared sessions and certificates -- when using a TLS enabled connection. data ConnectionContext = ConnectionContext { globalCertificateStore :: !CertificateStore } connection-0.2.8/LICENSE0000644000000000000000000000272412422172526013063 0ustar0000000000000000Copyright (c) 2012 Vincent Hanquez All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. connection-0.2.8/Setup.hs0000644000000000000000000000005612422172526013506 0ustar0000000000000000import Distribution.Simple main = defaultMain connection-0.2.8/connection.cabal0000644000000000000000000000272513064055333015201 0ustar0000000000000000Name: connection Version: 0.2.8 Description: Simple network library for all your connection need. . Features: Really simple to use, SSL/TLS, SOCKS. . This library provides a very simple api to create sockets to a destination with the choice of SSL/TLS, and SOCKS. License: BSD3 License-file: LICENSE Copyright: Vincent Hanquez Author: Vincent Hanquez Maintainer: Vincent Hanquez Synopsis: Simple and easy network connections API Build-Type: Simple Category: Network stability: experimental Cabal-Version: >=1.6 Homepage: http://github.com/vincenthz/hs-connection extra-source-files: README.md CHANGELOG.md Library Build-Depends: base >= 3 && < 5 , bytestring , byteable , containers , data-default-class , network >= 2.3 , tls >= 1.3 , socks >= 0.5.5 , x509 >= 1.5 , x509-store >= 1.5 , x509-system >= 1.5 , x509-validation >= 1.5 Exposed-modules: Network.Connection Other-modules: Network.Connection.Types ghc-options: -Wall source-repository head type: git location: https://github.com/vincenthz/hs-connection connection-0.2.8/README.md0000644000000000000000000000564212422172526013337 0ustar0000000000000000haskell Connection library ========================== Simple network library for all your connection need. Features: - Really simple to use - SSL/TLS - SOCKS Usage ----- Connect to www.example.com on port 4567 (without socks or tls), then send a byte, receive a single byte, print it, and close the connection: import qualified Data.ByteString as B import Network.Connection import Data.Default main = do ctx <- initConnectionContext con <- connectTo ctx $ ConnectionParams { connectionHostname = "www.example.com" , connectionPort = 4567 , connectionUseSecure = Nothing , connectionUseSocks = Nothing } connectionPut con (B.singleton 0xa) r <- connectionGet con 1 putStrLn $ show r connectionClose con Using a socks proxy is easy, we just need replacing the connectionSocks parameter, for example connecting to the same host, but using a socks proxy at localhost:1080: con <- connectTo ctx $ ConnectionParams { connectionHostname = "www.example.com" , connectionPort = 4567 , connectionUseSecure = Nothing , connectionUseSocks = Just $ SockSettingsSimple "localhost" 1080 } Connecting to a SSL style socket is equally easy, and need to set the UseSecure fields in ConnectionParams: con <- connectTo ctx $ ConnectionParams { connectionHostname = "www.example.com" , connectionPort = 4567 , connectionUseSecure = Just def , connectionUseSocks = Nothing } And finally, you can start TLS in the middle of an insecure connection. This is great for protocol using STARTTLS (e.g. IMAP, SMTP): {-# LANGUAGE OverloadedStrings #-} import qualified Data.ByteString as B import Data.ByteString.Char8 () import Network.Connection import Data.Default main = do ctx <- initConnectionContext con <- connectTo ctx $ ConnectionParams { connectionHostname = "www.example.com" , connectionPort = 4567 , connectionUseSecure = Nothing , connectionUseSocks = Nothing } -- talk to the other side with no TLS: says hello and starttls connectionPut con "HELLO\n" connectionPut con "STARTTLS\n" -- switch to TLS connectionSetSecure ctx con def -- the connection is from now on using TLS, we can send secret for example connectionPut con "PASSWORD 123\n" connectionClose con connection-0.2.8/CHANGELOG.md0000644000000000000000000000053512422172526013665 0ustar0000000000000000## Version 0.2.1 (16 April 2014) - Fix a difference between TLSSettings and TLSSettingsSimple, where connection would override the connection hostname and port in the simple case, but leave the field as is with TLSSettings. TLSSettings can now be used properly as template, and will be correctly overriden at the identification level only.