{-# LANGUAGE OverloadedStrings #-}

{-|
Module      : Client.Network.Connect
Description : Interface to the connection package
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module is responsible for creating 'Connection' values
for a particular server as specified by a 'ServerSettings'.
This involves setting up certificate stores an mapping
network settings from the client configuration into the
network connection library.
-}

module Client.Network.Connect
  ( withConnection
  , ircPort
  , tlsParams
  ) where

import Client.Configuration.ServerSettings
import Control.Applicative ((<|>))
import Control.Exception  (bracket)
import Control.Lens (view, (<&>))
import Data.Text.Encoding qualified as Text
import Hookup
import Network.Socket (PortNumber)

tlsParams :: ServerSettings -> TlsParams
tlsParams :: ServerSettings -> TlsParams
tlsParams ServerSettings
ss = TlsParams
  { tpClientCertificate :: Maybe HostName
tpClientCertificate  = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings (Maybe HostName)
ssTlsClientCert ServerSettings
ss
  , tpClientPrivateKey :: Maybe HostName
tpClientPrivateKey   = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings (Maybe HostName)
ssTlsClientKey ServerSettings
ss forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings (Maybe HostName)
ssTlsClientCert ServerSettings
ss
  , tpServerCertificate :: Maybe HostName
tpServerCertificate  = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings (Maybe HostName)
ssTlsServerCert ServerSettings
ss
  , tpCipherSuite :: HostName
tpCipherSuite        = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings HostName
ssTlsCiphers ServerSettings
ss
  , tpCipherSuiteTls13 :: Maybe HostName
tpCipherSuiteTls13   = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings (Maybe HostName)
ssTls13Ciphers ServerSettings
ss
  , tpVerify :: TlsVerify
tpVerify = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings TlsVerify
ssTlsVerify ServerSettings
ss
  , tpClientPrivateKeyPassword :: Maybe ByteString
tpClientPrivateKeyPassword =
      case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings (Maybe Secret)
ssTlsClientKeyPassword ServerSettings
ss of
        Just (SecretText Text
str) -> forall a. a -> Maybe a
Just (Text -> ByteString
Text.encodeUtf8 Text
str)
        Maybe Secret
_                     -> forall a. Maybe a
Nothing
  }

proxyParams :: ServerSettings -> Maybe SocksParams
proxyParams :: ServerSettings -> Maybe SocksParams
proxyParams ServerSettings
ss =
  forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings (Maybe HostName)
ssSocksHost ServerSettings
ss forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \HostName
host ->
  SocksParams {
    spHost :: HostName
spHost = HostName
host,
    spPort :: PortNumber
spPort = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings PortNumber
ssSocksPort ServerSettings
ss,
    spAuth :: SocksAuthentication
spAuth =
      case (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings (Maybe Text)
ssSocksUsername ServerSettings
ss, forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings (Maybe Secret)
ssSocksPassword ServerSettings
ss) of
        (Just Text
u, Just (SecretText Text
p)) ->
          ByteString -> ByteString -> SocksAuthentication
UsernamePasswordSocksAuthentication (Text -> ByteString
Text.encodeUtf8 Text
u) (Text -> ByteString
Text.encodeUtf8 Text
p)
        (Maybe Text, Maybe Secret)
_ -> SocksAuthentication
NoSocksAuthentication
  }

buildConnectionParams :: ServerSettings -> ConnectionParams
buildConnectionParams :: ServerSettings -> ConnectionParams
buildConnectionParams ServerSettings
ss = ConnectionParams
  { cpHost :: HostName
cpHost  = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings HostName
ssHostName ServerSettings
ss
  , cpPort :: PortNumber
cpPort  = ServerSettings -> PortNumber
ircPort ServerSettings
ss
  , cpTls :: Maybe TlsParams
cpTls   = case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings TlsMode
ssTls ServerSettings
ss of
                TlsMode
TlsYes   -> forall a. a -> Maybe a
Just (ServerSettings -> TlsParams
tlsParams ServerSettings
ss)
                TlsMode
TlsNo    -> forall a. Maybe a
Nothing
                TlsMode
TlsStart -> forall a. Maybe a
Nothing
  , cpSocks :: Maybe SocksParams
cpSocks = ServerSettings -> Maybe SocksParams
proxyParams ServerSettings
ss
  , cpBind :: Maybe HostName
cpBind  = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings (Maybe HostName)
ssBindHostName ServerSettings
ss
  }

ircPort :: ServerSettings -> PortNumber
ircPort :: ServerSettings -> PortNumber
ircPort ServerSettings
args =
  case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings (Maybe PortNumber)
ssPort ServerSettings
args of
    Just PortNumber
p -> forall a b. (Integral a, Num b) => a -> b
fromIntegral PortNumber
p
    Maybe PortNumber
Nothing ->
      case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings TlsMode
ssTls ServerSettings
args of
        TlsMode
TlsYes   -> PortNumber
6697
        TlsMode
TlsNo    -> PortNumber
6667
        TlsMode
TlsStart -> PortNumber
6667

-- | Create a new 'Connection' which will be closed when the continuation
-- finishes.
withConnection :: ServerSettings -> (Connection -> IO a) -> IO a
withConnection :: forall a. ServerSettings -> (Connection -> IO a) -> IO a
withConnection ServerSettings
settings =
  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