{-# LANGUAGE OverloadedStrings #-}
module Client.Network.Connect
( withConnection
, ircPort
, tlsParams
) where
import Client.Configuration.ServerSettings
import Control.Applicative
import Control.Exception (bracket)
import Control.Lens
import qualified Data.Text.Encoding as Text
import Network.Socket (PortNumber)
import Hookup
tlsParams :: ServerSettings -> TlsParams
tlsParams :: ServerSettings -> TlsParams
tlsParams ServerSettings
ss = TlsParams :: Maybe FilePath
-> Maybe FilePath
-> Maybe ByteString
-> Maybe FilePath
-> FilePath
-> Maybe FilePath
-> TlsVerify
-> TlsParams
TlsParams
{ tpClientCertificate :: Maybe FilePath
tpClientCertificate = Getting (Maybe FilePath) ServerSettings (Maybe FilePath)
-> ServerSettings -> Maybe FilePath
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe FilePath) ServerSettings (Maybe FilePath)
Lens' ServerSettings (Maybe FilePath)
ssTlsClientCert ServerSettings
ss
, tpClientPrivateKey :: Maybe FilePath
tpClientPrivateKey = Getting (Maybe FilePath) ServerSettings (Maybe FilePath)
-> ServerSettings -> Maybe FilePath
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe FilePath) ServerSettings (Maybe FilePath)
Lens' ServerSettings (Maybe FilePath)
ssTlsClientKey ServerSettings
ss Maybe FilePath -> Maybe FilePath -> Maybe FilePath
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Getting (Maybe FilePath) ServerSettings (Maybe FilePath)
-> ServerSettings -> Maybe FilePath
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe FilePath) ServerSettings (Maybe FilePath)
Lens' ServerSettings (Maybe FilePath)
ssTlsClientCert ServerSettings
ss
, tpServerCertificate :: Maybe FilePath
tpServerCertificate = Getting (Maybe FilePath) ServerSettings (Maybe FilePath)
-> ServerSettings -> Maybe FilePath
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe FilePath) ServerSettings (Maybe FilePath)
Lens' ServerSettings (Maybe FilePath)
ssTlsServerCert ServerSettings
ss
, tpCipherSuite :: FilePath
tpCipherSuite = Getting FilePath ServerSettings FilePath
-> ServerSettings -> FilePath
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting FilePath ServerSettings FilePath
Lens' ServerSettings FilePath
ssTlsCiphers ServerSettings
ss
, tpCipherSuiteTls13 :: Maybe FilePath
tpCipherSuiteTls13 = Getting (Maybe FilePath) ServerSettings (Maybe FilePath)
-> ServerSettings -> Maybe FilePath
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe FilePath) ServerSettings (Maybe FilePath)
Lens' ServerSettings (Maybe FilePath)
ssTls13Ciphers ServerSettings
ss
, tpVerify :: TlsVerify
tpVerify = Getting TlsVerify ServerSettings TlsVerify
-> ServerSettings -> TlsVerify
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting TlsVerify ServerSettings TlsVerify
Lens' ServerSettings TlsVerify
ssTlsVerify ServerSettings
ss
, tpClientPrivateKeyPassword :: Maybe ByteString
tpClientPrivateKeyPassword =
case Getting (Maybe Secret) ServerSettings (Maybe Secret)
-> ServerSettings -> Maybe Secret
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Secret) ServerSettings (Maybe Secret)
Lens' ServerSettings (Maybe Secret)
ssTlsClientKeyPassword ServerSettings
ss of
Just (SecretText Text
str) -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
Text.encodeUtf8 Text
str)
Maybe Secret
_ -> Maybe ByteString
forall a. Maybe a
Nothing
}
proxyParams :: ServerSettings -> Maybe SocksParams
proxyParams :: ServerSettings -> Maybe SocksParams
proxyParams ServerSettings
ss =
Getting (Maybe FilePath) ServerSettings (Maybe FilePath)
-> ServerSettings -> Maybe FilePath
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe FilePath) ServerSettings (Maybe FilePath)
Lens' ServerSettings (Maybe FilePath)
ssSocksHost ServerSettings
ss Maybe FilePath -> (FilePath -> SocksParams) -> Maybe SocksParams
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \FilePath
host ->
FilePath -> PortNumber -> SocksParams
SocksParams FilePath
host (Getting PortNumber ServerSettings PortNumber
-> ServerSettings -> PortNumber
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting PortNumber ServerSettings PortNumber
Lens' ServerSettings PortNumber
ssSocksPort ServerSettings
ss)
buildConnectionParams :: ServerSettings -> ConnectionParams
buildConnectionParams :: ServerSettings -> ConnectionParams
buildConnectionParams ServerSettings
ss = ConnectionParams :: FilePath
-> PortNumber
-> Maybe SocksParams
-> Maybe TlsParams
-> Maybe FilePath
-> ConnectionParams
ConnectionParams
{ cpHost :: FilePath
cpHost = Getting FilePath ServerSettings FilePath
-> ServerSettings -> FilePath
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting FilePath ServerSettings FilePath
Lens' ServerSettings FilePath
ssHostName ServerSettings
ss
, cpPort :: PortNumber
cpPort = ServerSettings -> PortNumber
ircPort ServerSettings
ss
, cpTls :: Maybe TlsParams
cpTls = case Getting TlsMode ServerSettings TlsMode -> ServerSettings -> TlsMode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting TlsMode ServerSettings TlsMode
Lens' ServerSettings TlsMode
ssTls ServerSettings
ss of
TlsMode
TlsYes -> TlsParams -> Maybe TlsParams
forall a. a -> Maybe a
Just (ServerSettings -> TlsParams
tlsParams ServerSettings
ss)
TlsMode
TlsNo -> Maybe TlsParams
forall a. Maybe a
Nothing
TlsMode
TlsStart -> Maybe TlsParams
forall a. Maybe a
Nothing
, cpSocks :: Maybe SocksParams
cpSocks = ServerSettings -> Maybe SocksParams
proxyParams ServerSettings
ss
, cpBind :: Maybe FilePath
cpBind = Getting (Maybe FilePath) ServerSettings (Maybe FilePath)
-> ServerSettings -> Maybe FilePath
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe FilePath) ServerSettings (Maybe FilePath)
Lens' ServerSettings (Maybe FilePath)
ssBindHostName ServerSettings
ss
}
ircPort :: ServerSettings -> PortNumber
ircPort :: ServerSettings -> PortNumber
ircPort ServerSettings
args =
case Getting (Maybe PortNumber) ServerSettings (Maybe PortNumber)
-> ServerSettings -> Maybe PortNumber
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe PortNumber) ServerSettings (Maybe PortNumber)
Lens' ServerSettings (Maybe PortNumber)
ssPort ServerSettings
args of
Just PortNumber
p -> PortNumber -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral PortNumber
p
Maybe PortNumber
Nothing ->
case Getting TlsMode ServerSettings TlsMode -> ServerSettings -> TlsMode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting TlsMode ServerSettings TlsMode
Lens' ServerSettings TlsMode
ssTls ServerSettings
args of
TlsMode
TlsYes -> PortNumber
6697
TlsMode
TlsNo -> PortNumber
6667
TlsMode
TlsStart -> PortNumber
6667
withConnection :: ServerSettings -> (Connection -> IO a) -> IO a
withConnection :: ServerSettings -> (Connection -> IO a) -> IO a
withConnection ServerSettings
settings Connection -> IO a
k =
IO Connection
-> (Connection -> IO ()) -> (Connection -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (ConnectionParams -> IO Connection
connect (ServerSettings -> ConnectionParams
buildConnectionParams ServerSettings
settings)) Connection -> IO ()
close Connection -> IO a
k