{-# 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
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

-- | Create a new 'Connection' which will be closed when the continuation
-- finishes.
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