    {-|
    Module      : Hookup
    Description : Network connections generalized over TLS and SOCKS
    Copyright   : (c) Eric Mertens, 2016
    License     : ISC
    Maintainer  : emertens@gmail.com

    This module provides a uniform interface to network connections
    with optional support for TLS and SOCKS.

    This library is careful to support both IPv4 and IPv6. It will attempt to
    all of the addresses that a domain name resolves to until one the first
    successful connection.

    Use 'connect' and 'close' to establish and close network connections.

    Use 'recv', 'recvLine', and 'send' to receive and transmit data on an
    open network connection.

    TLS and SOCKS parameters can be provided. When both are provided a connection
    will first be established to the SOCKS server and then the TLS connection will
    be established through that proxy server. This is most useful when connecting
    through a dynamic port forward of an SSH client via the @-D@ flag.

    -}
    module Hookup
      (
      -- * Connections
      Connection,
      connect,
      connectWithSocket,
      close,

      -- * Reading and writing data
      recv,
      recvLine,
      send,
      putBuf,

      -- * Configuration
      ConnectionParams(..),
      SocksParams(..),
      TlsParams(..),
      PEM.PemPasswordSupply(..),
      defaultTlsParams,

      -- * Errors
      ConnectionFailure(..),
      CommandReply(..)

      -- * SSL Information
      , getClientCertificate
      , getPeerCertificate
      , getPeerCertFingerprintSha1
      , getPeerCertFingerprintSha256
      , getPeerCertFingerprintSha512
      , getPeerPubkeyFingerprintSha1
      , getPeerPubkeyFingerprintSha256
      , getPeerPubkeyFingerprintSha512
      ) where

    import           Control.Concurrent
    import           Control.Exception
    import           Control.Monad
    import           System.IO.Error (isDoesNotExistError, ioeGetErrorString)
    import           Data.ByteString (ByteString)
    import qualified Data.ByteString as B
    import qualified Data.ByteString.Char8 as B8
    import           Data.Foldable
    import           Data.List (intercalate, partition)
    import           Network.Socket (AddrInfo, HostName, PortNumber, SockAddr, Socket, Family)
    import qualified Network.Socket as Socket
    import qualified Network.Socket.ByteString as SocketB
    import           OpenSSL.Session (SSL, SSLContext)
    import qualified OpenSSL as SSL
    import qualified OpenSSL.Session as SSL
    import           OpenSSL.X509.SystemStore
    import           OpenSSL.X509 (X509)
    import qualified OpenSSL.X509 as X509
    import qualified OpenSSL.PEM as PEM
    import qualified OpenSSL.EVP.Digest as Digest
    import           Data.Attoparsec.ByteString (Parser)
    import qualified Data.Attoparsec.ByteString as Parser

    import           Hookup.OpenSSL (installVerification, getPubKeyDer)
    import           Hookup.Socks5

    -- | Parameters for 'connect'.
    --
    -- Common defaults for fields: 'defaultFamily', 'defaultTlsParams'
    --
    -- When a 'SocksParams' is provided the connection will be established
    -- using a SOCKS (version 5) proxy.
    --
    -- When a 'TlsParams' is provided the connection negotiate TLS at connect
    -- time in order to protect the stream.
    --
    -- The binding hostname can be used to force the connect to use a particular
    -- interface or IP protocol version.
    data ConnectionParams = ConnectionParams
      { ConnectionParams -> HostName
    cpHost  :: HostName          -- ^ Destination host
      , ConnectionParams -> PortNumber
    cpPort  :: PortNumber        -- ^ Destination TCP port
      , ConnectionParams -> Maybe SocksParams
    cpSocks :: Maybe SocksParams -- ^ Optional SOCKS parameters
      , ConnectionParams -> Maybe TlsParams
    cpTls   :: Maybe TlsParams   -- ^ Optional TLS parameters
      , ConnectionParams -> Maybe HostName
    cpBind  :: Maybe HostName    -- ^ Source address to bind
      }

    -- | SOCKS connection parameters
    data SocksParams = SocksParams
      { SocksParams -> HostName
    spHost :: HostName   -- ^ SOCKS server host
      , SocksParams -> PortNumber
    spPort :: PortNumber -- ^ SOCKS server port
      }

    -- | TLS connection parameters. These parameters are passed to
    -- OpenSSL when making a secure connection.
    data TlsParams = TlsParams
      { TlsParams -> Maybe HostName
    tpClientCertificate  :: Maybe FilePath -- ^ Path to client certificate
      , TlsParams -> Maybe HostName
    tpClientPrivateKey   :: Maybe FilePath -- ^ Path to client private key
      , TlsParams -> PemPasswordSupply
    tpClientPrivateKeyPassword :: PEM.PemPasswordSupply -- ^ Private key decryption password
      , TlsParams -> Maybe HostName
    tpServerCertificate  :: Maybe FilePath -- ^ Path to CA certificate bundle
      , TlsParams -> HostName
    tpCipherSuite        :: String -- ^ OpenSSL cipher suite name (e.g. @\"HIGH\"@)
      , TlsParams -> Bool
    tpInsecure           :: Bool -- ^ Disables certificate checking when 'True'
      }

    -- | Type for errors that can be thrown by this package.
    data ConnectionFailure
      -- | Failure during 'getAddrInfo' resolving remote host
      = HostnameResolutionFailure HostName String
      -- | Failure during 'connect' to remote host
      | ConnectionFailure [IOError]
      -- | Failure during 'recvLine'
      | LineTooLong
      -- | Incomplete line during 'recvLine'
      | LineTruncated
      -- | Socks command rejected by server by given reply code
      | SocksError CommandReply
      -- | Socks authentication method was not accepted
      | SocksAuthenticationError
      -- | Socks server sent an invalid message or no message.
      | SocksProtocolError
      -- | Domain name was too long for SOCKS protocol
      | SocksBadDomainName
      deriving Int -> ConnectionFailure -> ShowS
    [ConnectionFailure] -> ShowS
    ConnectionFailure -> HostName
    (Int -> ConnectionFailure -> ShowS)
    -> (ConnectionFailure -> HostName)
    -> ([ConnectionFailure] -> ShowS)
    -> Show ConnectionFailure
    forall a.
    (Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
    showList :: [ConnectionFailure] -> ShowS
    $cshowList :: [ConnectionFailure] -> ShowS
    show :: ConnectionFailure -> HostName
    $cshow :: ConnectionFailure -> HostName
    showsPrec :: Int -> ConnectionFailure -> ShowS
    $cshowsPrec :: Int -> ConnectionFailure -> ShowS
    Show

    -- | 'displayException' implemented for prettier messages
    instance Exception ConnectionFailure where
      displayException :: ConnectionFailure -> HostName
    displayException LineTruncated = "connection closed while reading line"
      displayException LineTooLong   = "line length exceeded maximum"
      displayException (ConnectionFailure xs :: [IOError]
    xs) =
        "connection attempt failed due to: " HostName -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
          HostName -> [HostName] -> HostName
    forall a. [a] -> [[a]] -> [a]
    intercalate ", " ((IOError -> HostName) -> [IOError] -> [HostName]
    forall a b. (a -> b) -> [a] -> [b]
    map IOError -> HostName
    forall e. Exception e => e -> HostName
    displayException [IOError]
    xs)
      displayException (HostnameResolutionFailure h :: HostName
    h s :: HostName
    s) =
        "hostname resolution failed (" HostName -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ HostName
    h HostName -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ "): "  HostName -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ HostName
    s
      displayException SocksAuthenticationError =
        "SOCKS authentication method rejected"
      displayException SocksProtocolError =
        "SOCKS server protocol error"
      displayException SocksBadDomainName =
        "SOCKS domain name length limit exceeded"
      displayException (SocksError reply :: CommandReply
    reply) =
        "SOCKS command rejected: " HostName -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
        case CommandReply
    reply of
          Succeeded         -> "succeeded"
          GeneralFailure    -> "general SOCKS server failure"
          NotAllowed        -> "connection not allowed by ruleset"
          NetUnreachable    -> "network unreachable"
          HostUnreachable   -> "host unreachable"
          ConnectionRefused -> "connection refused"
          TTLExpired        -> "TTL expired"
          CmdNotSupported   -> "command not supported"
          AddrNotSupported  -> "address type not supported"
          CommandReply n :: Word8
    n    -> "unknown reply " HostName -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Word8 -> HostName
    forall a. Show a => a -> HostName
    show Word8
    n

    -- | Default values for TLS that use no client certificates, use
    -- system CA root, @\"HIGH\"@ cipher suite, and which validate hostnames.
    defaultTlsParams :: TlsParams
    defaultTlsParams :: TlsParams
    defaultTlsParams = TlsParams :: Maybe HostName
    -> Maybe HostName
    -> PemPasswordSupply
    -> Maybe HostName
    -> HostName
    -> Bool
    -> TlsParams
    TlsParams
      { tpClientCertificate :: Maybe HostName
    tpClientCertificate  = Maybe HostName
    forall a. Maybe a
    Nothing
      , tpClientPrivateKey :: Maybe HostName
    tpClientPrivateKey   = Maybe HostName
    forall a. Maybe a
    Nothing
      , tpClientPrivateKeyPassword :: PemPasswordSupply
    tpClientPrivateKeyPassword = PemPasswordSupply
    PEM.PwNone
      , tpServerCertificate :: Maybe HostName
    tpServerCertificate  = Maybe HostName
    forall a. Maybe a
    Nothing -- use system provided CAs
      , tpCipherSuite :: HostName
    tpCipherSuite        = "HIGH"
      , tpInsecure :: Bool
    tpInsecure           = Bool
    False
      }

    ------------------------------------------------------------------------
    -- Opening sockets
    ------------------------------------------------------------------------

    -- | Open a socket using the given parameters either directly or
    -- via a SOCKS server.
    openSocket :: ConnectionParams -> IO Socket
    openSocket :: ConnectionParams -> IO Socket
    openSocket params :: ConnectionParams
    params =
      case ConnectionParams -> Maybe SocksParams
    cpSocks ConnectionParams
    params of
        Nothing -> HostName -> PortNumber -> Maybe HostName -> IO Socket
    openSocket' (ConnectionParams -> HostName
    cpHost ConnectionParams
    params) (ConnectionParams -> PortNumber
    cpPort ConnectionParams
    params) (ConnectionParams -> Maybe HostName
    cpBind ConnectionParams
    params)
        Just sp :: SocksParams
    sp ->
          do Socket
    sock <- HostName -> PortNumber -> Maybe HostName -> IO Socket
    openSocket' (SocksParams -> HostName
    spHost SocksParams
    sp) (SocksParams -> PortNumber
    spPort SocksParams
    sp) (ConnectionParams -> Maybe HostName
    cpBind ConnectionParams
    params)
             (Socket
    sock Socket -> IO () -> IO Socket
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Socket -> HostName -> PortNumber -> IO ()
    socksConnect Socket
    sock (ConnectionParams -> HostName
    cpHost ConnectionParams
    params) (ConnectionParams -> PortNumber
    cpPort ConnectionParams
    params))
               IO Socket -> IO () -> IO Socket
    forall a b. IO a -> IO b -> IO a
    `onException` Socket -> IO ()
    Socket.close Socket
    sock

    netParse :: Show a => Socket -> Parser a -> IO a
    netParse :: Socket -> Parser a -> IO a
    netParse sock :: Socket
    sock parser :: Parser a
    parser =
      do -- receiving 1 byte at a time is not efficient, but these messages
         -- are very short and we don't want to read any more from the socket
         -- than is necessary
         Result a
    result <- IO ByteString -> Parser a -> ByteString -> IO (Result a)
    forall (m :: * -> *) a.
    Monad m =>
    m ByteString -> Parser a -> ByteString -> m (Result a)
    Parser.parseWith
                     (Socket -> Int -> IO ByteString
    SocketB.recv Socket
    sock 1)
                     Parser a
    parser
                     ByteString
    B.empty
         case Result a
    result of
           Parser.Done i :: ByteString
    i x :: a
    x | ByteString -> Bool
    B.null ByteString
    i -> a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    x
           _ -> ConnectionFailure -> IO a
    forall e a. Exception e => e -> IO a
    throwIO ConnectionFailure
    SocksProtocolError

    socksConnect :: Socket -> HostName -> PortNumber -> IO ()
    socksConnect :: Socket -> HostName -> PortNumber -> IO ()
    socksConnect sock :: Socket
    sock host :: HostName
    host port :: PortNumber
    port =
      do Socket -> ByteString -> IO ()
    SocketB.sendAll Socket
    sock (ByteString -> IO ()) -> ByteString -> IO ()
    forall a b. (a -> b) -> a -> b
    $
           ClientHello -> ByteString
    buildClientHello ClientHello :: [AuthMethod] -> ClientHello
    ClientHello
             { cHelloMethods :: [AuthMethod]
    cHelloMethods = [AuthMethod
    AuthNoAuthenticationRequired] }

         ServerHello -> IO ()
    validateHello (ServerHello -> IO ()) -> IO ServerHello -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Socket -> Parser ServerHello -> IO ServerHello
    forall a. Show a => Socket -> Parser a -> IO a
    netParse Socket
    sock Parser ServerHello
    parseServerHello

         let dnBytes :: ByteString
    dnBytes = HostName -> ByteString
    B8.pack HostName
    host
         Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (ByteString -> Int
    B.length ByteString
    dnBytes Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 256)
           (ConnectionFailure -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO ConnectionFailure
    SocksBadDomainName)

         Socket -> ByteString -> IO ()
    SocketB.sendAll Socket
    sock (ByteString -> IO ()) -> ByteString -> IO ()
    forall a b. (a -> b) -> a -> b
    $
           Request -> ByteString
    buildRequest Request :: Command -> Address -> Request
    Request
             { reqCommand :: Command
    reqCommand  = Command
    Connect
             , reqAddress :: Address
    reqAddress  = Host -> PortNumber -> Address
    Address (ByteString -> Host
    DomainName ByteString
    dnBytes) PortNumber
    port
             }

         Response -> IO ()
    validateResponse (Response -> IO ()) -> IO Response -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Socket -> Parser Response -> IO Response
    forall a. Show a => Socket -> Parser a -> IO a
    netParse Socket
    sock Parser Response
    parseResponse

    validateHello :: ServerHello -> IO ()
    validateHello :: ServerHello -> IO ()
    validateHello hello :: ServerHello
    hello =
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (ServerHello -> AuthMethod
    sHelloMethod ServerHello
    hello AuthMethod -> AuthMethod -> Bool
    forall a. Eq a => a -> a -> Bool
    == AuthMethod
    AuthNoAuthenticationRequired)
        (ConnectionFailure -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO ConnectionFailure
    SocksAuthenticationError)

    validateResponse :: Response -> IO ()
    validateResponse :: Response -> IO ()
    validateResponse response :: Response
    response =
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Response -> CommandReply
    rspReply Response
    response CommandReply -> CommandReply -> Bool
    forall a. Eq a => a -> a -> Bool
    == CommandReply
    Succeeded )
        (ConnectionFailure -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO (CommandReply -> ConnectionFailure
    SocksError (Response -> CommandReply
    rspReply Response
    response)))

    openSocket' ::
      HostName       {- ^ destination      -} ->
      PortNumber     {- ^ destination port -} ->
      Maybe HostName {- ^ source           -} ->
      IO Socket      {- ^ connected socket -}
    openSocket' :: HostName -> PortNumber -> Maybe HostName -> IO Socket
    openSocket' h :: HostName
    h p :: PortNumber
    p mbBind :: Maybe HostName
    mbBind =
      do Maybe [AddrInfo]
    mbSrc <- (HostName -> IO [AddrInfo])
    -> Maybe HostName -> IO (Maybe [AddrInfo])
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse (Maybe PortNumber -> HostName -> IO [AddrInfo]
    resolve Maybe PortNumber
    forall a. Maybe a
    Nothing) Maybe HostName
    mbBind
         [AddrInfo]
    dst   <- Maybe PortNumber -> HostName -> IO [AddrInfo]
    resolve (PortNumber -> Maybe PortNumber
    forall a. a -> Maybe a
    Just PortNumber
    p) HostName
    h
         let pairs :: [(Maybe SockAddr, AddrInfo)]
    pairs = [(Maybe SockAddr, AddrInfo)] -> [(Maybe SockAddr, AddrInfo)]
    interleaveAddressFamilies (Maybe [AddrInfo] -> [AddrInfo] -> [(Maybe SockAddr, AddrInfo)]
    matchBindAddrs Maybe [AddrInfo]
    mbSrc [AddrInfo]
    dst)
         Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([(Maybe SockAddr, AddrInfo)] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(Maybe SockAddr, AddrInfo)]
    pairs)
           (ConnectionFailure -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO (HostName -> HostName -> ConnectionFailure
    HostnameResolutionFailure HostName
    h "No source/destination address family match"))
         [(Maybe SockAddr, AddrInfo)] -> IO Socket
    attempt [(Maybe SockAddr, AddrInfo)]
    pairs

    hints :: AddrInfo
    hints :: AddrInfo
    hints = AddrInfo
    Socket.defaultHints
      { addrSocketType :: SocketType
    Socket.addrSocketType = SocketType
    Socket.Stream
      , addrFlags :: [AddrInfoFlag]
    Socket.addrFlags      = [AddrInfoFlag
    Socket.AI_NUMERICSERV]
      }

    resolve :: Maybe PortNumber -> HostName -> IO [AddrInfo]
    resolve :: Maybe PortNumber -> HostName -> IO [AddrInfo]
    resolve mbPort :: Maybe PortNumber
    mbPort host :: HostName
    host =
      do Either IOError [AddrInfo]
    res <- IO [AddrInfo] -> IO (Either IOError [AddrInfo])
    forall e a. Exception e => IO a -> IO (Either e a)
    try (Maybe AddrInfo -> Maybe HostName -> Maybe HostName -> IO [AddrInfo]
    Socket.getAddrInfo (AddrInfo -> Maybe AddrInfo
    forall a. a -> Maybe a
    Just AddrInfo
    hints) (HostName -> Maybe HostName
    forall a. a -> Maybe a
    Just HostName
    host) (PortNumber -> HostName
    forall a. Show a => a -> HostName
    show(PortNumber -> HostName) -> Maybe PortNumber -> Maybe HostName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>Maybe PortNumber
    mbPort))
         case Either IOError [AddrInfo]
    res of
           Right ais :: [AddrInfo]
    ais -> [AddrInfo] -> IO [AddrInfo]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [AddrInfo]
    ais
           Left ioe :: IOError
    ioe
             | IOError -> Bool
    isDoesNotExistError IOError
    ioe ->
                 ConnectionFailure -> IO [AddrInfo]
    forall e a. Exception e => e -> IO a
    throwIO (HostName -> HostName -> ConnectionFailure
    HostnameResolutionFailure HostName
    host (IOError -> HostName
    ioeGetErrorString IOError
    ioe))
             | Bool
    otherwise -> IOError -> IO [AddrInfo]
    forall e a. Exception e => e -> IO a
    throwIO IOError
    ioe -- unexpected

    -- | When no bind address is specified return the full list of destination
    -- addresses with no bind address specified.
    --
    -- When bind addresses are specified return a subset of the destination list
    -- matched up with the first address from the bind list that has the
    -- correct address family.
    matchBindAddrs :: Maybe [AddrInfo] -> [AddrInfo] -> [(Maybe SockAddr, AddrInfo)]
    matchBindAddrs :: Maybe [AddrInfo] -> [AddrInfo] -> [(Maybe SockAddr, AddrInfo)]
    matchBindAddrs Nothing    dst :: [AddrInfo]
    dst = [ (Maybe SockAddr
    forall a. Maybe a
    Nothing, AddrInfo
    x) | AddrInfo
    x <- [AddrInfo]
    dst ]
    matchBindAddrs (Just src :: [AddrInfo]
    src) dst :: [AddrInfo]
    dst =
      [ (SockAddr -> Maybe SockAddr
    forall a. a -> Maybe a
    Just (AddrInfo -> SockAddr
    Socket.addrAddress AddrInfo
    s), AddrInfo
    d)
      | AddrInfo
    d <- [AddrInfo]
    dst
      , let ss :: [AddrInfo]
    ss = [AddrInfo
    s | AddrInfo
    s <- [AddrInfo]
    src, AddrInfo -> Family
    Socket.addrFamily AddrInfo
    d Family -> Family -> Bool
    forall a. Eq a => a -> a -> Bool
    == AddrInfo -> Family
    Socket.addrFamily AddrInfo
    s]
      , AddrInfo
    s <- Int -> [AddrInfo] -> [AddrInfo]
    forall a. Int -> [a] -> [a]
    take 1 [AddrInfo]
    ss ]

    connAttemptDelay :: Int
    connAttemptDelay :: Int
    connAttemptDelay = 150 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * 1000 -- 150ms

    attempt ::
      [(Maybe SockAddr, AddrInfo)] {- ^ candidate AddrInfos -} ->
      IO Socket         {- ^ connected socket    -}
    attempt :: [(Maybe SockAddr, AddrInfo)] -> IO Socket
    attempt xs :: [(Maybe SockAddr, AddrInfo)]
    xs =
      do MVar (Either IOError Socket)
    comm <- IO (MVar (Either IOError Socket))
    forall a. IO (MVar a)
    newEmptyMVar

         let mkThread :: Int -> (Maybe SockAddr, AddrInfo) -> IO ThreadId
    mkThread i :: Int
    i (mbSrc :: Maybe SockAddr
    mbSrc, ai :: AddrInfo
    ai) =
               ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
    forkIOWithUnmask (((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId)
    -> ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
    forall a b. (a -> b) -> a -> b
    $ \unmask :: forall a. IO a -> IO a
    unmask ->
               IO () -> IO ()
    forall a. IO a -> IO a
    unmask (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
               do Int -> IO ()
    threadDelay (Int
    connAttemptDelay Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    i)
                  MVar (Either IOError Socket) -> Either IOError Socket -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar (Either IOError Socket)
    comm (Either IOError Socket -> IO ())
    -> IO (Either IOError Socket) -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IO Socket -> IO (Either IOError Socket)
    forall e a. Exception e => IO a -> IO (Either e a)
    try (Maybe SockAddr -> AddrInfo -> IO Socket
    connectToAddrInfo Maybe SockAddr
    mbSrc AddrInfo
    ai)

         IO [ThreadId]
    -> ([ThreadId] -> IO ()) -> ([ThreadId] -> IO Socket) -> IO Socket
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket ((Int -> (Maybe SockAddr, AddrInfo) -> IO ThreadId)
    -> [Int] -> [(Maybe SockAddr, AddrInfo)] -> IO [ThreadId]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM Int -> (Maybe SockAddr, AddrInfo) -> IO ThreadId
    mkThread [0..] [(Maybe SockAddr, AddrInfo)]
    xs)
                 ((ThreadId -> IO ()) -> [ThreadId] -> IO ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ ThreadId -> IO ()
    killThread)
                 (\_ -> Int -> [IOError] -> MVar (Either IOError Socket) -> IO Socket
    gather ([(Maybe SockAddr, AddrInfo)] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(Maybe SockAddr, AddrInfo)]
    xs) [] MVar (Either IOError Socket)
    comm)

    -- Either gather all of the errors possible and throw an exception or
    -- return the first successful socket.
    gather ::
      Int {- ^ potential errors remaining -} ->
      [IOError] {- ^ errors gathered so far -} ->
      MVar (Either IOError Socket) ->
      IO Socket
    gather :: Int -> [IOError] -> MVar (Either IOError Socket) -> IO Socket
    gather 0 exs :: [IOError]
    exs _ = ConnectionFailure -> IO Socket
    forall e a. Exception e => e -> IO a
    throwIO ([IOError] -> ConnectionFailure
    ConnectionFailure [IOError]
    exs)
    gather n :: Int
    n exs :: [IOError]
    exs comm :: MVar (Either IOError Socket)
    comm =
      do Either IOError Socket
    res <- MVar (Either IOError Socket) -> IO (Either IOError Socket)
    forall a. MVar a -> IO a
    takeMVar MVar (Either IOError Socket)
    comm
         case Either IOError Socket
    res of
           Right s :: Socket
    s -> Socket -> IO Socket
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Socket
    s
           Left ex :: IOError
    ex -> Int -> [IOError] -> MVar (Either IOError Socket) -> IO Socket
    gather (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -1) (IOError
    exIOError -> [IOError] -> [IOError]
    forall a. a -> [a] -> [a]
    :[IOError]
    exs) MVar (Either IOError Socket)
    comm

    -- | Alternate list of addresses between IPv6 and other (IPv4) addresses.
    interleaveAddressFamilies :: [(Maybe SockAddr, AddrInfo)] -> [(Maybe SockAddr, AddrInfo)]
    interleaveAddressFamilies :: [(Maybe SockAddr, AddrInfo)] -> [(Maybe SockAddr, AddrInfo)]
    interleaveAddressFamilies xs :: [(Maybe SockAddr, AddrInfo)]
    xs = [(Maybe SockAddr, AddrInfo)]
    -> [(Maybe SockAddr, AddrInfo)] -> [(Maybe SockAddr, AddrInfo)]
    forall a. [a] -> [a] -> [a]
    interleave [(Maybe SockAddr, AddrInfo)]
    sixes [(Maybe SockAddr, AddrInfo)]
    others
      where
        (sixes :: [(Maybe SockAddr, AddrInfo)]
    sixes, others :: [(Maybe SockAddr, AddrInfo)]
    others) = ((Maybe SockAddr, AddrInfo) -> Bool)
    -> [(Maybe SockAddr, AddrInfo)]
    -> ([(Maybe SockAddr, AddrInfo)], [(Maybe SockAddr, AddrInfo)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (Maybe SockAddr, AddrInfo) -> Bool
    forall a. (a, AddrInfo) -> Bool
    is6 [(Maybe SockAddr, AddrInfo)]
    xs
        is6 :: (a, AddrInfo) -> Bool
    is6 x :: (a, AddrInfo)
    x = Family
    Socket.AF_INET6 Family -> Family -> Bool
    forall a. Eq a => a -> a -> Bool
    == AddrInfo -> Family
    Socket.addrFamily ((a, AddrInfo) -> AddrInfo
    forall a b. (a, b) -> b
    snd (a, AddrInfo)
    x)

        interleave :: [a] -> [a] -> [a]
    interleave (x :: a
    x:xs :: [a]
    xs) (y :: a
    y:ys :: [a]
    ys) = a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : a
    y a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a] -> [a] -> [a]
    interleave [a]
    xs [a]
    ys
        interleave []     ys :: [a]
    ys     = [a]
    ys
        interleave xs :: [a]
    xs     []     = [a]
    xs

    -- | Create a socket and connect to the service identified
    -- by the given 'AddrInfo' and return the connected socket.
    connectToAddrInfo :: Maybe SockAddr -> AddrInfo -> IO Socket
    connectToAddrInfo :: Maybe SockAddr -> AddrInfo -> IO Socket
    connectToAddrInfo mbSrc :: Maybe SockAddr
    mbSrc info :: AddrInfo
    info
      = IO Socket
    -> (Socket -> IO ()) -> (Socket -> IO Socket) -> IO Socket
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracketOnError (AddrInfo -> IO Socket
    socket' AddrInfo
    info) Socket -> IO ()
    Socket.close ((Socket -> IO Socket) -> IO Socket)
    -> (Socket -> IO Socket) -> IO Socket
    forall a b. (a -> b) -> a -> b
    $ \s :: Socket
    s ->
        do (SockAddr -> IO ()) -> Maybe SockAddr -> IO ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ (Socket -> SockAddr -> IO ()
    bind' Socket
    s) Maybe SockAddr
    mbSrc
           Socket -> SockAddr -> IO ()
    Socket.connect Socket
    s (AddrInfo -> SockAddr
    Socket.addrAddress AddrInfo
    info)
           Socket -> IO Socket
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Socket
    s

    -- | A version of 'Socket.bind' that doesn't bother binding on the wildcard
    -- address. The effect of binding on a wildcard address in this library
    -- is to pick an address family. Because of the matching done earlier this
    -- is unnecessary for client connections and causes a local port to be
    -- unnecessarily fixed early.
    bind' :: Socket -> SockAddr -> IO ()
    bind' :: Socket -> SockAddr -> IO ()
    bind' _ (Socket.SockAddrInet _ 0) = () -> IO ()
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
    bind' _ (Socket.SockAddrInet6 _ _ (0,0,0,0) _) = () -> IO ()
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
    bind' s :: Socket
    s a :: SockAddr
    a = Socket -> SockAddr -> IO ()
    Socket.bind Socket
    s SockAddr
    a

    -- | Open a 'Socket' using the parameters from an 'AddrInfo'
    socket' :: AddrInfo -> IO Socket
    socket' :: AddrInfo -> IO Socket
    socket' ai :: AddrInfo
    ai =
      Family -> SocketType -> ProtocolNumber -> IO Socket
    Socket.socket
        (AddrInfo -> Family
    Socket.addrFamily     AddrInfo
    ai)
        (AddrInfo -> SocketType
    Socket.addrSocketType AddrInfo
    ai)
        (AddrInfo -> ProtocolNumber
    Socket.addrProtocol   AddrInfo
    ai)

    ------------------------------------------------------------------------
    -- Generalization of Socket
    ------------------------------------------------------------------------

    data NetworkHandle = SSL (Maybe X509) SSL | Socket Socket

    openNetworkHandle ::
      ConnectionParams {- ^ parameters             -} ->
      IO Socket        {- ^ socket creation action -} ->
      IO NetworkHandle {- ^ open network handle    -}
    openNetworkHandle :: ConnectionParams -> IO Socket -> IO NetworkHandle
    openNetworkHandle params :: ConnectionParams
    params mkSocket :: IO Socket
    mkSocket =
      case ConnectionParams -> Maybe TlsParams
    cpTls ConnectionParams
    params of
        Nothing  -> Socket -> NetworkHandle
    Socket (Socket -> NetworkHandle) -> IO Socket -> IO NetworkHandle
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO Socket
    mkSocket
        Just tls :: TlsParams
    tls ->
            do (clientCert :: Maybe X509
    clientCert, ssl :: SSL
    ssl) <- TlsParams -> HostName -> IO Socket -> IO (Maybe X509, SSL)
    startTls TlsParams
    tls (ConnectionParams -> HostName
    cpHost ConnectionParams
    params) IO Socket
    mkSocket
               NetworkHandle -> IO NetworkHandle
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe X509 -> SSL -> NetworkHandle
    SSL Maybe X509
    clientCert SSL
    ssl)

    closeNetworkHandle :: NetworkHandle -> IO ()
    closeNetworkHandle :: NetworkHandle -> IO ()
    closeNetworkHandle (Socket s :: Socket
    s) = Socket -> IO ()
    Socket.close Socket
    s
    closeNetworkHandle (SSL _ s :: SSL
    s) =
      do SSL -> ShutdownType -> IO ()
    SSL.shutdown SSL
    s ShutdownType
    SSL.Unidirectional
         (Socket -> IO ()) -> Maybe Socket -> IO ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ Socket -> IO ()
    Socket.close (SSL -> Maybe Socket
    SSL.sslSocket SSL
    s)

    networkSend :: NetworkHandle -> ByteString -> IO ()
    networkSend :: NetworkHandle -> ByteString -> IO ()
    networkSend (Socket s :: Socket
    s) = Socket -> ByteString -> IO ()
    SocketB.sendAll Socket
    s
    networkSend (SSL  _ s :: SSL
    s) = SSL -> ByteString -> IO ()
    SSL.write       SSL
    s

    networkRecv :: NetworkHandle -> Int -> IO ByteString
    networkRecv :: NetworkHandle -> Int -> IO ByteString
    networkRecv (Socket s :: Socket
    s) = Socket -> Int -> IO ByteString
    SocketB.recv Socket
    s
    networkRecv (SSL  _ s :: SSL
    s) = SSL -> Int -> IO ByteString
    SSL.read     SSL
    s

    ------------------------------------------------------------------------
    -- Sockets with a receive buffer
    ------------------------------------------------------------------------

    -- | A connection to a network service along with its read buffer
    -- used for line-oriented protocols. The connection could be a plain
    -- network connection, SOCKS connected, or TLS.
    data Connection = Connection (MVar ByteString) NetworkHandle

    -- | Open network connection to TCP service specified by
    -- the given parameters.
    --
    -- The resulting connection MUST be closed with 'close' to avoid leaking
    -- resources.
    --
    -- Throws 'IOError', 'SocksError', 'SSL.ProtocolError', 'ConnectionFailure'
    connect ::
      ConnectionParams {- ^ parameters      -} ->
      IO Connection    {- ^ open connection -}
    connect :: ConnectionParams -> IO Connection
    connect params :: ConnectionParams
    params =
      do NetworkHandle
    h <- ConnectionParams -> IO Socket -> IO NetworkHandle
    openNetworkHandle ConnectionParams
    params (ConnectionParams -> IO Socket
    openSocket ConnectionParams
    params)
         MVar ByteString
    b <- ByteString -> IO (MVar ByteString)
    forall a. a -> IO (MVar a)
    newMVar ByteString
    B.empty
         Connection -> IO Connection
    forall (m :: * -> *) a. Monad m => a -> m a
    return (MVar ByteString -> NetworkHandle -> Connection
    Connection MVar ByteString
    b NetworkHandle
    h)

    -- | Create a new 'Connection' using an already connected socket.
    -- This will attempt to start TLS if configured but will ignore
    -- any SOCKS server settings as it is assumed that the socket
    -- is already actively connected to the intended service.
    --
    -- Throws 'SSL.ProtocolError'
    connectWithSocket ::
      ConnectionParams {- ^ parameters       -} ->
      Socket           {- ^ connected socket -} ->
      IO Connection    {- ^ open connection  -}
    connectWithSocket :: ConnectionParams -> Socket -> IO Connection
    connectWithSocket params :: ConnectionParams
    params sock :: Socket
    sock =
      do NetworkHandle
    h <- ConnectionParams -> IO Socket -> IO NetworkHandle
    openNetworkHandle ConnectionParams
    params (Socket -> IO Socket
    forall (m :: * -> *) a. Monad m => a -> m a
    return Socket
    sock)
         MVar ByteString
    b <- ByteString -> IO (MVar ByteString)
    forall a. a -> IO (MVar a)
    newMVar ByteString
    B.empty
         Connection -> IO Connection
    forall (m :: * -> *) a. Monad m => a -> m a
    return (MVar ByteString -> NetworkHandle -> Connection
    Connection MVar ByteString
    b NetworkHandle
    h)

    -- | Close network connection.
    close ::
      Connection {- ^ open connection -} ->
      IO ()
    close :: Connection -> IO ()
    close (Connection _ h :: NetworkHandle
    h) = NetworkHandle -> IO ()
    closeNetworkHandle NetworkHandle
    h

    -- | Receive the next chunk from the stream. This operation will first
    -- return the buffer if it contains a non-empty chunk. Otherwise it will
    -- request up to the requested number of bytes from the stream.
    --
    -- Throws: 'IOError', 'SSL.ConnectionAbruptlyTerminated', 'SSL.ProtocolError'
    recv ::
      Connection    {- ^ open connection              -} ->
      Int           {- ^ maximum underlying recv size -} ->
      IO ByteString {- ^ next chunk from stream       -}
    recv :: Connection -> Int -> IO ByteString
    recv (Connection buf :: MVar ByteString
    buf h :: NetworkHandle
    h) n :: Int
    n =
      do ByteString
    bufChunk <- MVar ByteString -> ByteString -> IO ByteString
    forall a. MVar a -> a -> IO a
    swapMVar MVar ByteString
    buf ByteString
    B.empty
         if ByteString -> Bool
    B.null ByteString
    bufChunk
           then NetworkHandle -> Int -> IO ByteString
    networkRecv NetworkHandle
    h Int
    n
           else ByteString -> IO ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    bufChunk

    -- | Receive a line from the network connection. Both
    -- @"\\r\\n"@ and @"\\n"@ are recognized.
    --
    -- Returning 'Nothing' means that the peer has closed its half of
    -- the connection.
    --
    -- Unterminated lines will raise a 'LineTruncated' exception. This
    -- can happen if the peer transmits some data and closes its end
    -- without transmitting a line terminator.
    --
    -- Throws: 'SSL.ConnectionAbruptlyTerminated', 'SSL.ProtocolError', 'ConnectionFailure', 'IOError'
    recvLine ::
      Connection            {- ^ open connection            -} ->
      Int                   {- ^ maximum line length        -} ->
      IO (Maybe ByteString) {- ^ next line or end-of-stream -}
    recvLine :: Connection -> Int -> IO (Maybe ByteString)
    recvLine (Connection buf :: MVar ByteString
    buf h :: NetworkHandle
    h) n :: Int
    n =
      MVar ByteString
    -> (ByteString -> IO (ByteString, Maybe ByteString))
    -> IO (Maybe ByteString)
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar MVar ByteString
    buf ((ByteString -> IO (ByteString, Maybe ByteString))
     -> IO (Maybe ByteString))
    -> (ByteString -> IO (ByteString, Maybe ByteString))
    -> IO (Maybe ByteString)
    forall a b. (a -> b) -> a -> b
    $ \bs :: ByteString
    bs ->
        Int
    -> ByteString -> [ByteString] -> IO (ByteString, Maybe ByteString)
    go (ByteString -> Int
    B.length ByteString
    bs) ByteString
    bs []
      where
        -- bsn: cached length of concatenation of (bs:bss)
        -- bs : most recent chunk
        -- bss: other chunks ordered from most to least recent
        go :: Int
    -> ByteString -> [ByteString] -> IO (ByteString, Maybe ByteString)
    go bsn :: Int
    bsn bs :: ByteString
    bs bss :: [ByteString]
    bss =
          case Char -> ByteString -> Maybe Int
    B8.elemIndex '\n' ByteString
    bs of
            Just i :: Int
    i -> (ByteString, Maybe ByteString) -> IO (ByteString, Maybe ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> ByteString
    B.tail ByteString
    b, -- tail drops newline
                              ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> ByteString
    cleanEnd ([ByteString] -> ByteString
    B.concat ([ByteString] -> [ByteString]
    forall a. [a] -> [a]
    reverse (ByteString
    aByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :[ByteString]
    bss)))))
              where
                (a :: ByteString
    a,b :: ByteString
    b) = Int -> ByteString -> (ByteString, ByteString)
    B.splitAt Int
    i ByteString
    bs
            Nothing ->
              do Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    bsn Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    n) (ConnectionFailure -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO ConnectionFailure
    LineTooLong)
                 ByteString
    more <- NetworkHandle -> Int -> IO ByteString
    networkRecv NetworkHandle
    h Int
    n
                 if ByteString -> Bool
    B.null ByteString
    more -- connection closed
                   then if Int
    bsn Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 then (ByteString, Maybe ByteString) -> IO (ByteString, Maybe ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString
    B.empty, Maybe ByteString
    forall a. Maybe a
    Nothing)
                                    else ConnectionFailure -> IO (ByteString, Maybe ByteString)
    forall e a. Exception e => e -> IO a
    throwIO ConnectionFailure
    LineTruncated
                   else Int
    -> ByteString -> [ByteString] -> IO (ByteString, Maybe ByteString)
    go (Int
    bsn Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + ByteString -> Int
    B.length ByteString
    more) ByteString
    more (ByteString
    bsByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :[ByteString]
    bss)

    -- | Push a 'ByteString' onto the buffer so that it will be the first
    -- bytes to be read on the next receive operation. This could perhaps
    -- be useful for putting the unused portion of a 'recv' back into the
    -- buffer for future 'recvLine' or 'recv' operations.
    putBuf ::
      Connection {- ^ connection         -} ->
      ByteString {- ^ new head of buffer -} ->
      IO ()
    putBuf :: Connection -> ByteString -> IO ()
    putBuf (Connection buf :: MVar ByteString
    buf h :: NetworkHandle
    h) bs :: ByteString
    bs =
      MVar ByteString -> (ByteString -> IO ByteString) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ MVar ByteString
    buf (\old :: ByteString
    old -> ByteString -> IO ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $! ByteString -> ByteString -> ByteString
    B.append ByteString
    bs ByteString
    old)

    -- | Remove the trailing @'\\r'@ if one is found.
    cleanEnd :: ByteString -> ByteString
    cleanEnd :: ByteString -> ByteString
    cleanEnd bs :: ByteString
    bs
      | ByteString -> Bool
    B.null ByteString
    bs Bool -> Bool -> Bool
    || ByteString -> Char
    B8.last ByteString
    bs Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= '\r' = ByteString
    bs
      | Bool
    otherwise                       = ByteString -> ByteString
    B.init ByteString
    bs

    -- | Send bytes on the network connection. This ensures the whole chunk is
    -- transmitted, which might take multiple underlying sends.
    --
    -- Throws: 'IOError', 'SSL.ProtocolError'
    send ::
      Connection {- ^ open connection -} ->
      ByteString {- ^ chunk           -} ->
      IO ()
    send :: Connection -> ByteString -> IO ()
    send (Connection _ h :: NetworkHandle
    h) = NetworkHandle -> ByteString -> IO ()
    networkSend NetworkHandle
    h

    ------------------------------------------------------------------------

    -- | Initiate a TLS session on the given socket destined for
    -- the given hostname. When successful an active TLS connection
    -- is returned with certificate verification successful when
    -- requested. This function requires that the TLSParams component
    -- of 'ConnectionParams' is set.
    startTls ::
      TlsParams {- ^ connection params      -} ->
      String    {- ^ hostname               -} ->
      IO Socket {- ^ socket creation action -} ->
      IO (Maybe X509, SSL) {- ^ (client certificate, connected TLS) -}
    startTls :: TlsParams -> HostName -> IO Socket -> IO (Maybe X509, SSL)
    startTls tp :: TlsParams
    tp hostname :: HostName
    hostname mkSocket :: IO Socket
    mkSocket = IO (Maybe X509, SSL) -> IO (Maybe X509, SSL)
    forall a. IO a -> IO a
    SSL.withOpenSSL (IO (Maybe X509, SSL) -> IO (Maybe X509, SSL))
    -> IO (Maybe X509, SSL) -> IO (Maybe X509, SSL)
    forall a b. (a -> b) -> a -> b
    $
      do SSLContext
    ctx <- IO SSLContext
    SSL.context

         -- configure context
         SSLContext -> HostName -> IO ()
    SSL.contextSetCiphers          SSLContext
    ctx (TlsParams -> HostName
    tpCipherSuite TlsParams
    tp)
         SSLContext -> HostName -> IO ()
    installVerification            SSLContext
    ctx HostName
    hostname
         SSLContext -> VerificationMode -> IO ()
    SSL.contextSetVerificationMode SSLContext
    ctx (Bool -> VerificationMode
    verificationMode (TlsParams -> Bool
    tpInsecure TlsParams
    tp))
         SSLContext -> SSLOption -> IO ()
    SSL.contextAddOption           SSLContext
    ctx SSLOption
    SSL.SSL_OP_ALL
         SSLContext -> SSLOption -> IO ()
    SSL.contextRemoveOption        SSLContext
    ctx SSLOption
    SSL.SSL_OP_DONT_INSERT_EMPTY_FRAGMENTS

         -- configure certificates
         SSLContext -> Maybe HostName -> IO ()
    setupCaCertificates SSLContext
    ctx (TlsParams -> Maybe HostName
    tpServerCertificate TlsParams
    tp)
         Maybe X509
    clientCert <- (HostName -> IO X509) -> Maybe HostName -> IO (Maybe X509)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse (SSLContext -> HostName -> IO X509
    setupCertificate SSLContext
    ctx) (TlsParams -> Maybe HostName
    tpClientCertificate TlsParams
    tp)
         (HostName -> IO ()) -> Maybe HostName -> IO ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ (SSLContext -> PemPasswordSupply -> HostName -> IO ()
    setupPrivateKey SSLContext
    ctx (TlsParams -> PemPasswordSupply
    tpClientPrivateKeyPassword TlsParams
    tp)) (TlsParams -> Maybe HostName
    tpClientPrivateKey TlsParams
    tp)

         -- add socket to context
         -- creation of the socket is delayed until this point to avoid
         -- leaking the file descriptor in the cases of exceptions above.
         SSL
    ssl <- SSLContext -> Socket -> IO SSL
    SSL.connection SSLContext
    ctx (Socket -> IO SSL) -> IO Socket -> IO SSL
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IO Socket
    mkSocket

         -- configure hostname used for certificate validation
         SSL -> HostName -> IO ()
    SSL.setTlsextHostName SSL
    ssl HostName
    hostname

         SSL -> IO ()
    SSL.connect SSL
    ssl

         (Maybe X509, SSL) -> IO (Maybe X509, SSL)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe X509
    clientCert, SSL
    ssl)

    setupCaCertificates :: SSLContext -> Maybe FilePath -> IO ()
    setupCaCertificates :: SSLContext -> Maybe HostName -> IO ()
    setupCaCertificates ctx :: SSLContext
    ctx mbPath :: Maybe HostName
    mbPath =
      case Maybe HostName
    mbPath of
        Nothing   -> SSLContext -> IO ()
    contextLoadSystemCerts SSLContext
    ctx
        Just path :: HostName
    path -> SSLContext -> HostName -> IO ()
    SSL.contextSetCAFile SSLContext
    ctx HostName
    path

    setupCertificate :: SSLContext -> FilePath -> IO X509
    setupCertificate :: SSLContext -> HostName -> IO X509
    setupCertificate ctx :: SSLContext
    ctx path :: HostName
    path =
      do X509
    x509 <- HostName -> IO X509
    PEM.readX509 (HostName -> IO X509) -> IO HostName -> IO X509
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< HostName -> IO HostName
    readFile HostName
    path -- EX
         SSLContext -> X509 -> IO ()
    SSL.contextSetCertificate SSLContext
    ctx X509
    x509
         X509 -> IO X509
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure X509
    x509

    setupPrivateKey :: SSLContext -> PEM.PemPasswordSupply -> FilePath -> IO ()
    setupPrivateKey :: SSLContext -> PemPasswordSupply -> HostName -> IO ()
    setupPrivateKey ctx :: SSLContext
    ctx password :: PemPasswordSupply
    password path :: HostName
    path =
      do HostName
    str <- HostName -> IO HostName
    readFile HostName
    path -- EX
         SomeKeyPair
    key <- HostName -> PemPasswordSupply -> IO SomeKeyPair
    PEM.readPrivateKey HostName
    str PemPasswordSupply
    password
         SSLContext -> SomeKeyPair -> IO ()
    forall k. KeyPair k => SSLContext -> k -> IO ()
    SSL.contextSetPrivateKey SSLContext
    ctx SomeKeyPair
    key

    verificationMode :: Bool {- ^ insecure -} -> SSL.VerificationMode
    verificationMode :: Bool -> VerificationMode
    verificationMode insecure :: Bool
    insecure
      | Bool
    insecure  = VerificationMode
    SSL.VerifyNone
      | Bool
    otherwise = VerifyPeer :: Bool
    -> Bool
    -> Maybe (Bool -> X509StoreCtx -> IO Bool)
    -> VerificationMode
    SSL.VerifyPeer
                      { vpFailIfNoPeerCert :: Bool
    SSL.vpFailIfNoPeerCert = Bool
    True
                      , vpClientOnce :: Bool
    SSL.vpClientOnce       = Bool
    True
                      , vpCallback :: Maybe (Bool -> X509StoreCtx -> IO Bool)
    SSL.vpCallback         = Maybe (Bool -> X509StoreCtx -> IO Bool)
    forall a. Maybe a
    Nothing
                      }

    -- | Get peer certificate if one exists.
    getPeerCertificate :: Connection -> IO (Maybe X509.X509)
    getPeerCertificate :: Connection -> IO (Maybe X509)
    getPeerCertificate (Connection _ h :: NetworkHandle
    h) =
      case NetworkHandle
    h of
        Socket{} -> Maybe X509 -> IO (Maybe X509)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe X509
    forall a. Maybe a
    Nothing
        SSL _ ssl :: SSL
    ssl -> SSL -> IO (Maybe X509)
    SSL.getPeerCertificate SSL
    ssl

    -- | Get peer certificate if one exists.
    getClientCertificate :: Connection -> Maybe X509.X509
    getClientCertificate :: Connection -> Maybe X509
    getClientCertificate (Connection _ h :: NetworkHandle
    h) =
      case NetworkHandle
    h of
        Socket{} -> Maybe X509
    forall a. Maybe a
    Nothing
        SSL c :: Maybe X509
    c _  -> Maybe X509
    c

    getPeerCertFingerprintSha1 :: Connection -> IO (Maybe ByteString)
    getPeerCertFingerprintSha1 :: Connection -> IO (Maybe ByteString)
    getPeerCertFingerprintSha1 = HostName -> Connection -> IO (Maybe ByteString)
    getPeerCertFingerprint "sha1"

    getPeerCertFingerprintSha256 :: Connection -> IO (Maybe ByteString)
    getPeerCertFingerprintSha256 :: Connection -> IO (Maybe ByteString)
    getPeerCertFingerprintSha256 = HostName -> Connection -> IO (Maybe ByteString)
    getPeerCertFingerprint "sha256"

    getPeerCertFingerprintSha512 :: Connection -> IO (Maybe ByteString)
    getPeerCertFingerprintSha512 :: Connection -> IO (Maybe ByteString)
    getPeerCertFingerprintSha512 = HostName -> Connection -> IO (Maybe ByteString)
    getPeerCertFingerprint "sha512"

    getPeerCertFingerprint :: String -> Connection -> IO (Maybe ByteString)
    getPeerCertFingerprint :: HostName -> Connection -> IO (Maybe ByteString)
    getPeerCertFingerprint name :: HostName
    name h :: Connection
    h =
       do Maybe X509
    mb <- Connection -> IO (Maybe X509)
    getPeerCertificate Connection
    h
          case Maybe X509
    mb of
            Nothing -> Maybe ByteString -> IO (Maybe ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ByteString
    forall a. Maybe a
    Nothing
            Just x509 :: X509
    x509 ->
              do ByteString
    der <- X509 -> IO ByteString
    X509.writeDerX509 X509
    x509
                 Maybe Digest
    mbdigest <- HostName -> IO (Maybe Digest)
    Digest.getDigestByName HostName
    name
                 case Maybe Digest
    mbdigest of
                   Nothing -> Maybe ByteString -> IO (Maybe ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ByteString
    forall a. Maybe a
    Nothing
                   Just digest :: Digest
    digest -> Maybe ByteString -> IO (Maybe ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ByteString -> IO (Maybe ByteString))
    -> Maybe ByteString -> IO (Maybe ByteString)
    forall a b. (a -> b) -> a -> b
    $! ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $! Digest -> ByteString -> ByteString
    Digest.digestLBS Digest
    digest ByteString
    der

    getPeerPubkeyFingerprintSha1 :: Connection -> IO (Maybe ByteString)
    getPeerPubkeyFingerprintSha1 :: Connection -> IO (Maybe ByteString)
    getPeerPubkeyFingerprintSha1 = HostName -> Connection -> IO (Maybe ByteString)
    getPeerPubkeyFingerprint "sha1"

    getPeerPubkeyFingerprintSha256 :: Connection -> IO (Maybe ByteString)
    getPeerPubkeyFingerprintSha256 :: Connection -> IO (Maybe ByteString)
    getPeerPubkeyFingerprintSha256 = HostName -> Connection -> IO (Maybe ByteString)
    getPeerPubkeyFingerprint "sha256"

    getPeerPubkeyFingerprintSha512 :: Connection -> IO (Maybe ByteString)
    getPeerPubkeyFingerprintSha512 :: Connection -> IO (Maybe ByteString)
    getPeerPubkeyFingerprintSha512 = HostName -> Connection -> IO (Maybe ByteString)
    getPeerPubkeyFingerprint "sha512"

    getPeerPubkeyFingerprint :: String -> Connection -> IO (Maybe ByteString)
    getPeerPubkeyFingerprint :: HostName -> Connection -> IO (Maybe ByteString)
    getPeerPubkeyFingerprint name :: HostName
    name h :: Connection
    h =
       do Maybe X509
    mb <- Connection -> IO (Maybe X509)
    getPeerCertificate Connection
    h
          case Maybe X509
    mb of
            Nothing -> Maybe ByteString -> IO (Maybe ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ByteString
    forall a. Maybe a
    Nothing
            Just x509 :: X509
    x509 ->
              do ByteString
    der <- X509 -> IO ByteString
    getPubKeyDer X509
    x509
                 Maybe Digest
    mbdigest <- HostName -> IO (Maybe Digest)
    Digest.getDigestByName HostName
    name
                 case Maybe Digest
    mbdigest of
                   Nothing -> Maybe ByteString -> IO (Maybe ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ByteString
    forall a. Maybe a
    Nothing
                   Just digest :: Digest
    digest -> Maybe ByteString -> IO (Maybe ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ByteString -> IO (Maybe ByteString))
    -> Maybe ByteString -> IO (Maybe ByteString)
    forall a b. (a -> b) -> a -> b
    $! ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $! Digest -> ByteString -> ByteString
    Digest.digestBS Digest
    digest ByteString
    der