-----------------------------------------------------------------------------
-- |
-- Module      :  Network.XMPP.Helpers
-- Copyright   :  (c) Dmitry Astapov, 2006
-- License     :  BSD-style (see the file LICENSE)
-- Copyright   :  (c) riskbook, 2020
-- SPDX-License-Identifier:  BSD3
--
-- Maintainer  :  Dmitry Astapov <dastapov@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Various "connection helpers" that let user obtain a handle to pass to 'initiateStream'
--
-----------------------------------------------------------------------------

module Network.XMPP.Helpers
  ( connectViaHttpProxy
  , connectViaTcp
  , openStreamFile
  ) where

import System.IO (Handle, hPutStrLn, hPutStr, hGetLine, openFile, IOMode(..))
import Control.Monad (void, when)

import Network.BSD (getHostByName, hostAddresses)
import qualified Data.Text as T

import Network.Socket
import Control.Concurrent (threadDelay, forkIO)
import Control.Monad.Trans (liftIO)
import Network.XMPP.Utils

-- | Connect to XMPP server on specified host \/ port
connectViaTcp :: T.Text -- ^ Server (hostname) to connect to
              -> Int     -- ^ Port to connect to
              -> IO Handle
connectViaTcp :: Text -> Int -> IO Handle
connectViaTcp Text
server Int
port = do
  HostEntry
host <- HostName -> IO HostEntry
getHostByName (HostName -> IO HostEntry) -> HostName -> IO HostEntry
forall a b. (a -> b) -> a -> b
$ Text -> HostName
T.unpack Text
server
  Socket
sock <- Family -> SocketType -> ProtocolNumber -> IO Socket
socket Family
AF_INET SocketType
Stream ProtocolNumber
0
  Socket -> SocketOption -> Int -> IO ()
setSocketOption Socket
sock SocketOption
KeepAlive Int
1
  let sockAddress :: SockAddr
sockAddress = PortNumber -> HostAddress -> SockAddr
SockAddrInet (Int -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
port) (HostAddress -> SockAddr) -> HostAddress -> SockAddr
forall a b. (a -> b) -> a -> b
$ [HostAddress] -> HostAddress
forall a. [a] -> a
head ([HostAddress] -> HostAddress) -> [HostAddress] -> HostAddress
forall a b. (a -> b) -> a -> b
$ HostEntry -> [HostAddress]
hostAddresses HostEntry
host
  Socket -> SockAddr -> IO ()
connect Socket
sock SockAddr
sockAddress
  Socket -> IOMode -> IO Handle
socketToHandle Socket
sock IOMode
ReadWriteMode

-- | Connect to XMPP server on specified host \/ port
--  via HTTP 1.0 proxy
connectViaHttpProxy :: Show a => HostName -> Integer -> T.Text -> a -> IO Handle
connectViaHttpProxy :: HostName -> Integer -> Text -> a -> IO Handle
connectViaHttpProxy HostName
proxyServer Integer
proxyPort Text
server a
port = do
  let hints :: AddrInfo
hints = AddrInfo
defaultHints
        { addrFlags :: [AddrInfoFlag]
addrFlags = [AddrInfoFlag
AI_NUMERICHOST, AddrInfoFlag
AI_NUMERICSERV]
        , addrSocketType :: SocketType
addrSocketType = SocketType
Stream
        }
  AddrInfo
addr:[AddrInfo]
_ <- Maybe AddrInfo -> Maybe HostName -> Maybe HostName -> IO [AddrInfo]
getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints) (HostName -> Maybe HostName
forall a. a -> Maybe a
Just HostName
proxyServer) (HostName -> Maybe HostName
forall a. a -> Maybe a
Just (HostName -> Maybe HostName) -> HostName -> Maybe HostName
forall a b. (a -> b) -> a -> b
$ Integer -> HostName
forall a. Show a => a -> HostName
show Integer
proxyPort)
  Socket
sock <- Family -> SocketType -> ProtocolNumber -> IO Socket
socket (AddrInfo -> Family
addrFamily AddrInfo
addr) (AddrInfo -> SocketType
addrSocketType AddrInfo
addr) (AddrInfo -> ProtocolNumber
addrProtocol AddrInfo
addr)
  Handle
h <- Socket -> IOMode -> IO Handle
socketToHandle Socket
sock IOMode
ReadWriteMode
  Handle -> HostName -> IO ()
hPutStrLn Handle
h (HostName -> IO ()) -> HostName -> IO ()
forall a b. (a -> b) -> a -> b
$ [HostName] -> HostName
unlines
    [ [HostName] -> HostName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [HostName
"CONNECT ", Text -> HostName
T.unpack Text
server, HostName
":", a -> HostName
forall a. Show a => a -> HostName
show a
port, HostName
" HTTP/1.0"]
    , HostName
"Connection: Keep-Alive"
    ]
  Handle -> IO ()
dropHeaders Handle
h
  IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ IO ThreadId -> IO ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId -> IO ThreadId) -> IO ThreadId -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
forall b. Handle -> IO b
pinger Handle
h
  Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
h
 where
  dropHeaders :: Handle -> IO ()
dropHeaders Handle
h = do
    HostName
l <- Handle -> IO HostName
hGetLine Handle
h
    HostName -> IO ()
debugIO (HostName -> IO ()) -> HostName -> IO ()
forall a b. (a -> b) -> a -> b
$ HostName
"Got: " HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
l
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HostName -> [HostName]
words HostName
l [HostName] -> [HostName] -> Bool
forall a. Eq a => a -> a -> Bool
/= []) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
dropHeaders Handle
h
  pinger :: Handle -> IO b
pinger Handle
h = Handle -> HostName -> IO ()
hPutStr Handle
h HostName
" " IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO ()
threadDelay (Int
30 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
10 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
6 :: Int))) IO () -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO b
pinger Handle
h

-- | Open file with pre-captured server-to-client XMPP stream. For debugging
openStreamFile :: FilePath -> IO Handle
openStreamFile :: HostName -> IO Handle
openStreamFile HostName
fname = HostName -> IOMode -> IO Handle
openFile HostName
fname IOMode
ReadMode