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
connectViaTcp :: T.Text
-> Int
-> 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
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
openStreamFile :: FilePath -> IO Handle
openStreamFile :: HostName -> IO Handle
openStreamFile HostName
fname = HostName -> IOMode -> IO Handle
openFile HostName
fname IOMode
ReadMode