{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- |
-- Module      : Network.Connection
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- 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 operations
    , connectionSetSecure
    , connectionIsSecure
    , connectionSessionManager
    ) where

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 (defaultSocksConf, socksConnectWithSocket, SocksAddress(..), SocksHostAddress(..))
import Network.Socket
import qualified Network.Socket.ByteString as N

import Data.Tuple (swap)
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 (Int -> LineTooLong -> ShowS
[LineTooLong] -> ShowS
LineTooLong -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineTooLong] -> ShowS
$cshowList :: [LineTooLong] -> ShowS
show :: LineTooLong -> String
$cshow :: LineTooLong -> String
showsPrec :: Int -> LineTooLong -> ShowS
$cshowsPrec :: Int -> LineTooLong -> ShowS
Show,Typeable)

-- | Exception raised when there's no resolution for a specific host
data HostNotResolved = HostNotResolved String deriving (Int -> HostNotResolved -> ShowS
[HostNotResolved] -> ShowS
HostNotResolved -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HostNotResolved] -> ShowS
$cshowList :: [HostNotResolved] -> ShowS
show :: HostNotResolved -> String
$cshow :: HostNotResolved -> String
showsPrec :: Int -> HostNotResolved -> ShowS
$cshowsPrec :: Int -> HostNotResolved -> ShowS
Show,Typeable)

-- | Exception raised when the connect failed
data HostCannotConnect = HostCannotConnect String [E.IOException] deriving (Int -> HostCannotConnect -> ShowS
[HostCannotConnect] -> ShowS
HostCannotConnect -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HostCannotConnect] -> ShowS
$cshowList :: [HostCannotConnect] -> ShowS
show :: HostCannotConnect -> String
$cshow :: HostCannotConnect -> String
showsPrec :: Int -> HostCannotConnect -> ShowS
$cshowsPrec :: Int -> HostCannotConnect -> ShowS
Show,Typeable)

instance E.Exception LineTooLong
instance E.Exception HostNotResolved
instance E.Exception HostCannotConnect

connectionSessionManager :: Manager -> TLS.SessionManager
connectionSessionManager :: Manager -> SessionManager
connectionSessionManager Manager
mvar = TLS.SessionManager
    { sessionResume :: SessionID -> IO (Maybe SessionData)
TLS.sessionResume     = \SessionID
sessionID -> forall a b. MVar a -> (a -> IO b) -> IO b
withMVar Manager
mvar (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SessionID
sessionID)
    , sessionEstablish :: SessionID -> SessionData -> IO ()
TLS.sessionEstablish  = \SessionID
sessionID SessionData
sessionData ->
                               forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ Manager
mvar (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert SessionID
sessionID SessionData
sessionData)
    , sessionInvalidate :: SessionID -> IO ()
TLS.sessionInvalidate = \SessionID
sessionID -> forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ Manager
mvar (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Map k a
M.delete SessionID
sessionID)
#if MIN_VERSION_tls(1,5,0)
    , sessionResumeOnlyOnce :: SessionID -> IO (Maybe SessionData)
TLS.sessionResumeOnlyOnce = \SessionID
sessionID ->
         forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar Manager
mvar (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> (b, a)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
M.updateLookupWithKey (\SessionID
_ SessionData
_ -> forall a. Maybe a
Nothing) SessionID
sessionID)
#endif
    }

-- | Initialize the library with shared parameters between connection.
initConnectionContext :: IO ConnectionContext
initConnectionContext :: IO ConnectionContext
initConnectionContext = CertificateStore -> ConnectionContext
ConnectionContext forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CertificateStore
getSystemCertificateStore

-- | Create a final TLS 'ClientParams' according to the destination and the
-- TLSSettings.
makeTLSParams :: ConnectionContext -> ConnectionID -> TLSSettings -> TLS.ClientParams
makeTLSParams :: ConnectionContext -> ConnectionID -> TLSSettings -> ClientParams
makeTLSParams ConnectionContext
cg ConnectionID
cid ts :: TLSSettings
ts@(TLSSettingsSimple {}) =
    (String -> SessionID -> ClientParams
TLS.defaultParamsClient (forall a b. (a, b) -> a
fst ConnectionID
cid) SessionID
portString)
        { clientSupported :: Supported
TLS.clientSupported = forall a. Default a => a
def { supportedCiphers :: [Cipher]
TLS.supportedCiphers = [Cipher]
TLS.ciphersuite_default }
        , clientShared :: Shared
TLS.clientShared    = forall a. Default a => a
def
            { sharedCAStore :: CertificateStore
TLS.sharedCAStore         = ConnectionContext -> CertificateStore
globalCertificateStore ConnectionContext
cg
            , sharedValidationCache :: ValidationCache
TLS.sharedValidationCache = ValidationCache
validationCache
            -- , TLS.sharedSessionManager  = connectionSessionManager
            }
        }
  where validationCache :: ValidationCache
validationCache
            | TLSSettings -> Bool
settingDisableCertificateValidation TLSSettings
ts =
                ValidationCacheQueryCallback
-> ValidationCacheAddCallback -> ValidationCache
TLS.ValidationCache (\ServiceID
_ Fingerprint
_ Certificate
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ValidationCacheResult
TLS.ValidationCachePass)
                                    (\ServiceID
_ Fingerprint
_ Certificate
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ())
            | Bool
otherwise = forall a. Default a => a
def
        portString :: SessionID
portString = String -> SessionID
BC.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd ConnectionID
cid
makeTLSParams ConnectionContext
_ ConnectionID
cid (TLSSettings ClientParams
p) =
    ClientParams
p { clientServerIdentification :: ServiceID
TLS.clientServerIdentification = (forall a b. (a, b) -> a
fst ConnectionID
cid, SessionID
portString) }
 where portString :: SessionID
portString = String -> SessionID
BC.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd ConnectionID
cid

withBackend :: (ConnectionBackend -> IO a) -> Connection -> IO a
withBackend :: forall a. (ConnectionBackend -> IO a) -> Connection -> IO a
withBackend ConnectionBackend -> IO a
f Connection
conn = forall a. MVar a -> IO a
readMVar (Connection -> MVar ConnectionBackend
connectionBackend Connection
conn) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConnectionBackend -> IO a
f

connectionNew :: ConnectionID -> ConnectionBackend -> IO Connection
connectionNew :: ConnectionID -> ConnectionBackend -> IO Connection
connectionNew ConnectionID
cid ConnectionBackend
backend =
    MVar ConnectionBackend
-> MVar (Maybe SessionID) -> ConnectionID -> Connection
Connection forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (MVar a)
newMVar ConnectionBackend
backend
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (MVar a)
newMVar (forall a. a -> Maybe a
Just SessionID
B.empty)
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure ConnectionID
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 :: ConnectionContext -> Handle -> ConnectionParams -> IO Connection
connectFromHandle ConnectionContext
cg Handle
h ConnectionParams
p = Maybe TLSSettings -> IO Connection
withSecurity (ConnectionParams -> Maybe TLSSettings
connectionUseSecure ConnectionParams
p)
    where withSecurity :: Maybe TLSSettings -> IO Connection
withSecurity Maybe TLSSettings
Nothing            = ConnectionID -> ConnectionBackend -> IO Connection
connectionNew ConnectionID
cid forall a b. (a -> b) -> a -> b
$ Handle -> ConnectionBackend
ConnectionStream Handle
h
          withSecurity (Just TLSSettings
tlsSettings) = forall backend.
HasBackend backend =>
backend -> ClientParams -> IO Context
tlsEstablish Handle
h (ConnectionContext -> ConnectionID -> TLSSettings -> ClientParams
makeTLSParams ConnectionContext
cg ConnectionID
cid TLSSettings
tlsSettings) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConnectionID -> ConnectionBackend -> IO Connection
connectionNew ConnectionID
cid forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> ConnectionBackend
ConnectionTLS
          cid :: ConnectionID
cid = (ConnectionParams -> String
connectionHostname ConnectionParams
p, ConnectionParams -> PortNumber
connectionPort ConnectionParams
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 :: ConnectionContext -> Socket -> ConnectionParams -> IO Connection
connectFromSocket ConnectionContext
cg Socket
sock ConnectionParams
p = Maybe TLSSettings -> IO Connection
withSecurity (ConnectionParams -> Maybe TLSSettings
connectionUseSecure ConnectionParams
p)
    where withSecurity :: Maybe TLSSettings -> IO Connection
withSecurity Maybe TLSSettings
Nothing            = ConnectionID -> ConnectionBackend -> IO Connection
connectionNew ConnectionID
cid forall a b. (a -> b) -> a -> b
$ Socket -> ConnectionBackend
ConnectionSocket Socket
sock
          withSecurity (Just TLSSettings
tlsSettings) = forall backend.
HasBackend backend =>
backend -> ClientParams -> IO Context
tlsEstablish Socket
sock (ConnectionContext -> ConnectionID -> TLSSettings -> ClientParams
makeTLSParams ConnectionContext
cg ConnectionID
cid TLSSettings
tlsSettings) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConnectionID -> ConnectionBackend -> IO Connection
connectionNew ConnectionID
cid forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> ConnectionBackend
ConnectionTLS
          cid :: ConnectionID
cid = (ConnectionParams -> String
connectionHostname ConnectionParams
p, ConnectionParams -> PortNumber
connectionPort ConnectionParams
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 :: ConnectionContext -> ConnectionParams -> IO Connection
connectTo ConnectionContext
cg ConnectionParams
cParams = do
    let conFct :: IO (Socket, SockAddr)
conFct = Maybe ProxySettings
-> String -> PortNumber -> IO (Socket, SockAddr)
doConnect (ConnectionParams -> Maybe ProxySettings
connectionUseSocks ConnectionParams
cParams)
                           (ConnectionParams -> String
connectionHostname ConnectionParams
cParams)
                           (ConnectionParams -> PortNumber
connectionPort ConnectionParams
cParams)
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracketOnError IO (Socket, SockAddr)
conFct (Socket -> IO ()
close forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ \(Socket
h, SockAddr
_) ->
        ConnectionContext -> Socket -> ConnectionParams -> IO Connection
connectFromSocket ConnectionContext
cg Socket
h ConnectionParams
cParams
  where
    sockConnect :: String
-> PortNumber -> String -> PortNumber -> IO (Socket, SockAddr)
sockConnect String
sockHost PortNumber
sockPort String
h PortNumber
p = do
        (Socket
sockServ, SockAddr
servAddr) <- String -> PortNumber -> IO (Socket, SockAddr)
resolve' String
sockHost PortNumber
sockPort
        let sockConf :: SocksConf
sockConf = SockAddr -> SocksConf
defaultSocksConf SockAddr
servAddr
        let destAddr :: SocksAddress
destAddr = SocksHostAddress -> PortNumber -> SocksAddress
SocksAddress (SessionID -> SocksHostAddress
SocksAddrDomainName forall a b. (a -> b) -> a -> b
$ String -> SessionID
BC.pack String
h) PortNumber
p
        (SocksHostAddress
dest, PortNumber
_) <- Socket
-> SocksConf -> SocksAddress -> IO (SocksHostAddress, PortNumber)
socksConnectWithSocket Socket
sockServ SocksConf
sockConf SocksAddress
destAddr
        case SocksHostAddress
dest of
            SocksAddrIPV4 FlowInfo
h4 -> forall (m :: * -> *) a. Monad m => a -> m a
return (Socket
sockServ, PortNumber -> FlowInfo -> SockAddr
SockAddrInet PortNumber
p FlowInfo
h4)
            SocksAddrIPV6 HostAddress6
h6 -> forall (m :: * -> *) a. Monad m => a -> m a
return (Socket
sockServ, PortNumber -> FlowInfo -> HostAddress6 -> FlowInfo -> SockAddr
SockAddrInet6 PortNumber
p FlowInfo
0 HostAddress6
h6 FlowInfo
0)
            SocksAddrDomainName SessionID
_ -> forall a. HasCallStack => String -> a
error String
"internal error: socks connect return a resolved address as domain name"


    doConnect :: Maybe ProxySettings
-> String -> PortNumber -> IO (Socket, SockAddr)
doConnect Maybe ProxySettings
proxy String
h PortNumber
p =
        case Maybe ProxySettings
proxy of
            Maybe ProxySettings
Nothing                 -> String -> PortNumber -> IO (Socket, SockAddr)
resolve' String
h PortNumber
p
            Just (OtherProxy String
proxyHost PortNumber
proxyPort) -> String -> PortNumber -> IO (Socket, SockAddr)
resolve' String
proxyHost PortNumber
proxyPort
            Just (SockSettingsSimple String
sockHost PortNumber
sockPort) ->
                String
-> PortNumber -> String -> PortNumber -> IO (Socket, SockAddr)
sockConnect String
sockHost PortNumber
sockPort String
h PortNumber
p
            Just (SockSettingsEnvironment Maybe String
envName) -> do
                -- if we can't get the environment variable or that the string cannot be parsed
                -- we connect directly.
                let name :: String
name = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"SOCKS_SERVER" forall a. a -> a
id Maybe String
envName
                Either IOException String
evar <- forall e a. Exception e => IO a -> IO (Either e a)
E.try (String -> IO String
getEnv String
name)
                case Either IOException String
evar of
                    Left (IOException
_ :: E.IOException) -> String -> PortNumber -> IO (Socket, SockAddr)
resolve' String
h PortNumber
p
                    Right String
var                 ->
                        case String -> Maybe ConnectionID
parseSocks String
var of
                            Maybe ConnectionID
Nothing                   -> String -> PortNumber -> IO (Socket, SockAddr)
resolve' String
h PortNumber
p
                            Just (String
sockHost, PortNumber
sockPort) -> String
-> PortNumber -> String -> PortNumber -> IO (Socket, SockAddr)
sockConnect String
sockHost PortNumber
sockPort String
h PortNumber
p

    -- Try to parse "host:port" or "host"
    -- if port is omitted then the default SOCKS port (1080) is assumed
    parseSocks :: String -> Maybe (String, PortNumber)
    parseSocks :: String -> Maybe ConnectionID
parseSocks String
s =
        case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
':') String
s of
            (String
sHost, String
"")        -> forall a. a -> Maybe a
Just (String
sHost, PortNumber
1080)
            (String
sHost, Char
':':String
portS) ->
                case forall a. Read a => ReadS a
reads String
portS of
                    [(PortNumber
sPort,String
"")] -> forall a. a -> Maybe a
Just (String
sHost, PortNumber
sPort)
                    [(PortNumber, String)]
_            -> forall a. Maybe a
Nothing
            (String, String)
_                  -> forall a. Maybe a
Nothing

    -- Try to resolve the host/port to an address (zero to many of them), then
    -- try to connect from the first address to the last, returning the first one that
    -- succeeds
    resolve' :: String -> PortNumber -> IO (Socket, SockAddr)
    resolve' :: String -> PortNumber -> IO (Socket, SockAddr)
resolve' String
host PortNumber
port = do
        let hints :: AddrInfo
hints = AddrInfo
defaultHints { addrFlags :: [AddrInfoFlag]
addrFlags = [AddrInfoFlag
AI_ADDRCONFIG], addrSocketType :: SocketType
addrSocketType = SocketType
Stream }
        [AddrInfo]
addrs <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
getAddrInfo (forall a. a -> Maybe a
Just AddrInfo
hints) (forall a. a -> Maybe a
Just String
host) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show PortNumber
port)
        forall {a}. [IO a] -> IO a
firstSuccessful forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map AddrInfo -> IO (Socket, SockAddr)
tryToConnect [AddrInfo]
addrs
      where
        tryToConnect :: AddrInfo -> IO (Socket, SockAddr)
tryToConnect AddrInfo
addr =
            forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracketOnError
                (Family -> SocketType -> ProtocolNumber -> IO Socket
socket (AddrInfo -> Family
addrFamily AddrInfo
addr) (AddrInfo -> SocketType
addrSocketType AddrInfo
addr) (AddrInfo -> ProtocolNumber
addrProtocol AddrInfo
addr))
                (Socket -> IO ()
close)
                (\Socket
sock -> Socket -> SockAddr -> IO ()
connect Socket
sock (AddrInfo -> SockAddr
addrAddress AddrInfo
addr) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Socket
sock, AddrInfo -> SockAddr
addrAddress AddrInfo
addr))
        firstSuccessful :: [IO a] -> IO a
firstSuccessful = forall a. [IOException] -> [IO a] -> IO a
go []
          where
            go :: [E.IOException] -> [IO a] -> IO a
            go :: forall a. [IOException] -> [IO a] -> IO a
go []      [] = forall e a. Exception e => e -> IO a
E.throwIO forall a b. (a -> b) -> a -> b
$ String -> HostNotResolved
HostNotResolved String
host
            go l :: [IOException]
l@(IOException
_:[IOException]
_) [] = forall e a. Exception e => e -> IO a
E.throwIO forall a b. (a -> b) -> a -> b
$ String -> [IOException] -> HostCannotConnect
HostCannotConnect String
host [IOException]
l
            go [IOException]
acc     (IO a
act:[IO a]
followingActs) = do
                Either IOException a
er <- forall e a. Exception e => IO a -> IO (Either e a)
E.try IO a
act
                case Either IOException a
er of
                    Left IOException
err -> forall a. [IOException] -> [IO a] -> IO a
go (IOException
errforall a. a -> [a] -> [a]
:[IOException]
acc) [IO a]
followingActs
                    Right a
r  -> forall (m :: * -> *) a. Monad m => a -> m a
return a
r

-- | Put a block of data in the connection.
connectionPut :: Connection -> ByteString -> IO ()
connectionPut :: Connection -> SessionID -> IO ()
connectionPut Connection
connection SessionID
content = forall a. (ConnectionBackend -> IO a) -> Connection -> IO a
withBackend ConnectionBackend -> IO ()
doWrite Connection
connection
    where doWrite :: ConnectionBackend -> IO ()
doWrite (ConnectionStream Handle
h) = Handle -> SessionID -> IO ()
B.hPut Handle
h SessionID
content forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
h
          doWrite (ConnectionSocket Socket
s) = Socket -> SessionID -> IO ()
N.sendAll Socket
s SessionID
content
          doWrite (ConnectionTLS Context
ctx)  = forall (m :: * -> *). MonadIO m => Context -> ByteString -> m ()
TLS.sendData Context
ctx forall a b. (a -> b) -> a -> b
$ [SessionID] -> ByteString
L.fromChunks [SessionID
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 :: Connection -> Int -> IO SessionID
connectionGetExact Connection
conn Int
x = SessionID -> Int -> IO SessionID
loop SessionID
B.empty Int
0
  where loop :: SessionID -> Int -> IO SessionID
loop SessionID
bs Int
y
          | Int
y forall a. Eq a => a -> a -> Bool
== Int
x = forall (m :: * -> *) a. Monad m => a -> m a
return SessionID
bs
          | Bool
otherwise = do
            SessionID
next <- Connection -> Int -> IO SessionID
connectionGet Connection
conn (Int
x forall a. Num a => a -> a -> a
- Int
y)
            SessionID -> Int -> IO SessionID
loop (SessionID -> SessionID -> SessionID
B.append SessionID
bs SessionID
next) (Int
y forall a. Num a => a -> a -> a
+ (SessionID -> Int
B.length SessionID
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 :: Connection -> Int -> IO SessionID
connectionGet Connection
conn Int
size
  | Int
size forall a. Ord a => a -> a -> Bool
< Int
0  = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Network.Connection.connectionGet: size < 0"
  | Int
size forall a. Eq a => a -> a -> Bool
== Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return SessionID
B.empty
  | Bool
otherwise = forall a.
String -> Connection -> (SessionID -> (a, SessionID)) -> IO a
connectionGetChunkBase String
"connectionGet" Connection
conn forall a b. (a -> b) -> a -> b
$ Int -> SessionID -> (SessionID, SessionID)
B.splitAt Int
size

-- | Get the next block of data from the connection.
connectionGetChunk :: Connection -> IO ByteString
connectionGetChunk :: Connection -> IO SessionID
connectionGetChunk Connection
conn =
    forall a.
String -> Connection -> (SessionID -> (a, SessionID)) -> IO a
connectionGetChunkBase String
"connectionGetChunk" Connection
conn forall a b. (a -> b) -> a -> b
$ \SessionID
s -> (SessionID
s, SessionID
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' :: forall a. Connection -> (SessionID -> (a, SessionID)) -> IO a
connectionGetChunk' = forall a.
String -> Connection -> (SessionID -> (a, SessionID)) -> IO a
connectionGetChunkBase String
"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 :: Connection -> Int -> IO Bool
connectionWaitForInput Connection
conn Int
timeout_ms = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall a b. a -> b -> a
const Bool
True) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> IO a -> IO (Maybe a)
timeout Int
timeout_ns IO ()
tryGetChunk
  where tryGetChunk :: IO ()
tryGetChunk = forall a.
String -> Connection -> (SessionID -> (a, SessionID)) -> IO a
connectionGetChunkBase String
"connectionWaitForInput" Connection
conn forall a b. (a -> b) -> a -> b
$ \SessionID
buf -> ((), SessionID
buf)
        timeout_ns :: Int
timeout_ns  = Int
timeout_ms forall a. Num a => a -> a -> a
* Int
1000

connectionGetChunkBase :: String -> Connection -> (ByteString -> (a, ByteString)) -> IO a
connectionGetChunkBase :: forall a.
String -> Connection -> (SessionID -> (a, SessionID)) -> IO a
connectionGetChunkBase String
loc Connection
conn SessionID -> (a, SessionID)
f =
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (Connection -> MVar (Maybe SessionID)
connectionBuffer Connection
conn) forall a b. (a -> b) -> a -> b
$ \Maybe SessionID
m ->
        case Maybe SessionID
m of
            Maybe SessionID
Nothing -> forall a. Connection -> String -> IO a
throwEOF Connection
conn String
loc
            Just SessionID
buf
              | SessionID -> Bool
B.null SessionID
buf -> do
                  SessionID
chunk <- forall a. (ConnectionBackend -> IO a) -> Connection -> IO a
withBackend ConnectionBackend -> IO SessionID
getMoreData Connection
conn
                  if SessionID -> Bool
B.null SessionID
chunk
                     then forall {m :: * -> *} {a}. Monad m => SessionID -> m (Maybe a, a)
closeBuf SessionID
chunk
                     else forall {m :: * -> *}.
Monad m =>
SessionID -> m (Maybe SessionID, a)
updateBuf SessionID
chunk
              | Bool
otherwise ->
                  forall {m :: * -> *}.
Monad m =>
SessionID -> m (Maybe SessionID, a)
updateBuf SessionID
buf
  where
    getMoreData :: ConnectionBackend -> IO SessionID
getMoreData (ConnectionTLS Context
tlsctx) = forall (m :: * -> *). MonadIO m => Context -> m SessionID
TLS.recvData Context
tlsctx
    getMoreData (ConnectionSocket Socket
sock) = Socket -> Int -> IO SessionID
N.recv Socket
sock Int
1500
    getMoreData (ConnectionStream Handle
h)   = Handle -> Int -> IO SessionID
B.hGetSome Handle
h (Int
16 forall a. Num a => a -> a -> a
* Int
1024)

    updateBuf :: SessionID -> m (Maybe SessionID, a)
updateBuf SessionID
buf = case SessionID -> (a, SessionID)
f SessionID
buf of (a
a, !SessionID
buf') -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just SessionID
buf', a
a)
    closeBuf :: SessionID -> m (Maybe a, a)
closeBuf  SessionID
buf = case SessionID -> (a, SessionID)
f SessionID
buf of (a
a, SessionID
_buf') -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, a
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.
-- Put another way: 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 the 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 :: Int -> Connection -> IO SessionID
connectionGetLine Int
limit Connection
conn = forall {t}.
t -> Int -> ([SessionID] -> [SessionID]) -> IO SessionID
more (forall a. Connection -> String -> IO a
throwEOF Connection
conn String
loc) Int
0 forall a. a -> a
id
  where
    loc :: String
loc = String
"connectionGetLine"
    lineTooLong :: IO a
lineTooLong = forall e a. Exception e => e -> IO a
E.throwIO LineTooLong
LineTooLong

    -- Accumulate chunks using a difference list and concatenate them
    -- when an end-of-line indicator is reached.
    more :: t -> Int -> ([SessionID] -> [SessionID]) -> IO SessionID
more t
eofK !Int
currentSz ![SessionID] -> [SessionID]
dl =
        forall r.
(SessionID -> IO r) -> (SessionID -> IO r) -> IO r -> IO r
getChunk (\SessionID
s -> let len :: Int
len = SessionID -> Int
B.length SessionID
s
                         in if Int
currentSz forall a. Num a => a -> a -> a
+ Int
len forall a. Ord a => a -> a -> Bool
> Int
limit
                               then forall {a}. IO a
lineTooLong
                               else t -> Int -> ([SessionID] -> [SessionID]) -> IO SessionID
more t
eofK (Int
currentSz forall a. Num a => a -> a -> a
+ Int
len) ([SessionID] -> [SessionID]
dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SessionID
sforall a. a -> [a] -> [a]
:)))
                 (\SessionID
s -> ([SessionID] -> [SessionID]) -> IO SessionID
done ([SessionID] -> [SessionID]
dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SessionID
sforall a. a -> [a] -> [a]
:)))
                 (([SessionID] -> [SessionID]) -> IO SessionID
done [SessionID] -> [SessionID]
dl)

    done :: ([ByteString] -> [ByteString]) -> IO ByteString
    done :: ([SessionID] -> [SessionID]) -> IO SessionID
done [SessionID] -> [SessionID]
dl = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! [SessionID] -> SessionID
B.concat forall a b. (a -> b) -> a -> b
$ [SessionID] -> [SessionID]
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 :: forall r.
(SessionID -> IO r) -> (SessionID -> IO r) -> IO r -> IO r
getChunk SessionID -> IO r
moreK SessionID -> IO r
doneK IO r
eofK =
      forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall a.
String -> Connection -> (SessionID -> (a, SessionID)) -> IO a
connectionGetChunkBase String
loc Connection
conn forall a b. (a -> b) -> a -> b
$ \SessionID
s ->
        if SessionID -> Bool
B.null SessionID
s
          then (IO r
eofK, SessionID
B.empty)
          else case (Word8 -> Bool) -> SessionID -> (SessionID, SessionID)
B.break (forall a. Eq a => a -> a -> Bool
== Word8
10) SessionID
s of
                 (SessionID
a, SessionID
b)
                   | SessionID -> Bool
B.null SessionID
b  -> (SessionID -> IO r
moreK SessionID
a, SessionID
B.empty)
                   | Bool
otherwise -> (SessionID -> IO r
doneK SessionID
a, HasCallStack => SessionID -> SessionID
B.tail SessionID
b)

throwEOF :: Connection -> String -> IO a
throwEOF :: forall a. Connection -> String -> IO a
throwEOF Connection
conn String
loc =
    forall e a. Exception e => e -> IO a
E.throwIO forall a b. (a -> b) -> a -> b
$ IOErrorType
-> String -> Maybe Handle -> Maybe String -> IOException
E.mkIOError IOErrorType
E.eofErrorType String
loc' forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just String
path)
  where
    loc' :: String
loc' = String
"Network.Connection." forall a. [a] -> [a] -> [a]
++ String
loc
    path :: String
path = let (String
host, PortNumber
port) = Connection -> ConnectionID
connectionID Connection
conn
            in String
host forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show PortNumber
port

-- | Close a connection.
connectionClose :: Connection -> IO ()
connectionClose :: Connection -> IO ()
connectionClose = forall a. (ConnectionBackend -> IO a) -> Connection -> IO a
withBackend ConnectionBackend -> IO ()
backendClose
    where backendClose :: ConnectionBackend -> IO ()
backendClose (ConnectionTLS Context
ctx)  = IO () -> IO ()
ignoreIOExc (forall (m :: * -> *). MonadIO m => Context -> m ()
TLS.bye Context
ctx) forall a b. IO a -> IO b -> IO a
`E.finally` Context -> IO ()
TLS.contextClose Context
ctx
          backendClose (ConnectionSocket Socket
sock) = Socket -> IO ()
close Socket
sock
          backendClose (ConnectionStream Handle
h) = Handle -> IO ()
hClose Handle
h

          ignoreIOExc :: IO () -> IO ()
ignoreIOExc IO ()
action = IO ()
action forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \(IOException
_ :: E.IOException) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Activate secure layer using the parameters specified.
--
-- This is typically used to negotiate a TLS channel on an already
-- established channel, e.g., supporting a STARTTLS command. It also
-- flushes 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 :: ConnectionContext -> Connection -> TLSSettings -> IO ()
connectionSetSecure ConnectionContext
cg Connection
connection TLSSettings
params =
    forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Connection -> MVar (Maybe SessionID)
connectionBuffer Connection
connection) forall a b. (a -> b) -> a -> b
$ \Maybe SessionID
b ->
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (Connection -> MVar ConnectionBackend
connectionBackend Connection
connection) forall a b. (a -> b) -> a -> b
$ \ConnectionBackend
backend ->
        case ConnectionBackend
backend of
            (ConnectionStream Handle
h) -> do Context
ctx <- forall backend.
HasBackend backend =>
backend -> ClientParams -> IO Context
tlsEstablish Handle
h (ConnectionContext -> ConnectionID -> TLSSettings -> ClientParams
makeTLSParams ConnectionContext
cg (Connection -> ConnectionID
connectionID Connection
connection) TLSSettings
params)
                                       forall (m :: * -> *) a. Monad m => a -> m a
return (Context -> ConnectionBackend
ConnectionTLS Context
ctx, forall a. a -> Maybe a
Just SessionID
B.empty)
            (ConnectionSocket Socket
s) -> do Context
ctx <- forall backend.
HasBackend backend =>
backend -> ClientParams -> IO Context
tlsEstablish Socket
s (ConnectionContext -> ConnectionID -> TLSSettings -> ClientParams
makeTLSParams ConnectionContext
cg (Connection -> ConnectionID
connectionID Connection
connection) TLSSettings
params)
                                       forall (m :: * -> *) a. Monad m => a -> m a
return (Context -> ConnectionBackend
ConnectionTLS Context
ctx, forall a. a -> Maybe a
Just SessionID
B.empty)
            (ConnectionTLS Context
_)    -> forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionBackend
backend, Maybe SessionID
b)

-- | Returns if the connection is establish securely or not.
connectionIsSecure :: Connection -> IO Bool
connectionIsSecure :: Connection -> IO Bool
connectionIsSecure Connection
conn = forall a. (ConnectionBackend -> IO a) -> Connection -> IO a
withBackend forall {m :: * -> *}. Monad m => ConnectionBackend -> m Bool
isSecure Connection
conn
    where isSecure :: ConnectionBackend -> m Bool
isSecure (ConnectionStream Handle
_) = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
          isSecure (ConnectionSocket Socket
_) = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
          isSecure (ConnectionTLS Context
_)    = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

tlsEstablish :: TLS.HasBackend backend => backend -> TLS.ClientParams -> IO TLS.Context
tlsEstablish :: forall backend.
HasBackend backend =>
backend -> ClientParams -> IO Context
tlsEstablish backend
handle ClientParams
tlsParams = do
    Context
ctx <- forall (m :: * -> *) backend params.
(MonadIO m, HasBackend backend, TLSParams params) =>
backend -> params -> m Context
TLS.contextNew backend
handle ClientParams
tlsParams
    forall (m :: * -> *). MonadIO m => Context -> m ()
TLS.handshake Context
ctx
    forall (m :: * -> *) a. Monad m => a -> m a
return Context
ctx