-- |
-- Module      : Network.Connection.Types
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : portable
--
-- connection types
module Network.Connection.Types
where

import Control.Concurrent.MVar (MVar)

import Data.ByteString (ByteString)
import Data.Default
import Data.X509.CertificateStore

import Network.Socket (PortNumber, Socket)
import qualified Network.TLS as TLS
import qualified Network.TLS.Extra 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

-- | Hostname This could either be a name string (punycode encoded) or an ipv4/ipv6
type HostName = String

-- | 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
    { ConnectionParams -> HostName
connectionHostname :: HostName
    -- ^ host name to connect to.
    , ConnectionParams -> PortNumber
connectionPort :: PortNumber
    -- ^ port number to connect to.
    , ConnectionParams -> Maybe TLSSettings
connectionUseSecure :: Maybe TLSSettings
    -- ^ optional TLS parameters.
    , ConnectionParams -> Maybe ProxySettings
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
        { TLSSettings -> Bool
settingDisableCertificateValidation :: Bool
        -- ^ Disable certificate verification completely,
        --   this make TLS/SSL vulnerable to a MITM attack.
        --   not recommended to use, but for testing.
        , TLSSettings -> Bool
settingDisableSession :: Bool
        -- ^ Disable session management. TLS/SSL connections
        --   will always re-established their context.
        --   Not Implemented Yet.
        , TLSSettings -> Bool
settingUseServerName :: Bool
        -- ^ Use server name extension. Not Implemented Yet.
        , TLSSettings -> Supported
settingClientSupported :: TLS.Supported
        -- ^ Used for the 'TLS.clientSupported'
        --   member of 'TLS.ClientParams'.
        }
    | -- \^ Simple TLS settings. recommended to use.

      -- | full blown TLS Settings directly using TLS.Params. for power users.
      TLSSettings TLS.ClientParams
    deriving (Int -> TLSSettings -> ShowS
[TLSSettings] -> ShowS
TLSSettings -> HostName
(Int -> TLSSettings -> ShowS)
-> (TLSSettings -> HostName)
-> ([TLSSettings] -> ShowS)
-> Show TLSSettings
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TLSSettings -> ShowS
showsPrec :: Int -> TLSSettings -> ShowS
$cshow :: TLSSettings -> HostName
show :: TLSSettings -> HostName
$cshowList :: [TLSSettings] -> ShowS
showList :: [TLSSettings] -> ShowS
Show)

instance Default TLSSettings where
    def :: TLSSettings
def =
        Bool -> Bool -> Bool -> Supported -> TLSSettings
TLSSettingsSimple
            Bool
False
            Bool
False
            Bool
False
            Supported
forall a. Default a => a
def{TLS.supportedCiphers = TLS.ciphersuite_default}

type ConnectionID = (HostName, PortNumber)

-- | This opaque type represent a connection to a destination.
data Connection = Connection
    { Connection -> MVar ConnectionBackend
connectionBackend :: MVar ConnectionBackend
    , Connection -> MVar (Maybe ByteString)
connectionBuffer :: MVar (Maybe ByteString)
    -- ^ this is set to 'Nothing' on EOF
    , Connection -> ConnectionID
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
    { ConnectionContext -> CertificateStore
globalCertificateStore :: !CertificateStore
    }