client.hs

--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
module Main
    ( main
    ) where


--------------------------------------------------------------------------------
import           Control.Concurrent  (forkIO)
import           Control.Applicative ((<$>))
import           Control.Monad       (forever, unless)
import           Control.Monad.Trans (liftIO)
import qualified Data.ByteString.Lazy  as B (toStrict)
import           Data.Text           (Text)
import qualified Data.Text           as T
import qualified Data.Text.IO        as T
import qualified Network.WebSockets  as WS
import qualified Network.WebSockets.Stream as WS
import qualified OpenSSL               as SSL
import qualified OpenSSL.Session       as SSL
import qualified System.IO.Streams as Streams
import qualified System.IO.Streams.SSL as Streams
import qualified Network.Socket as S


--------------------------------------------------------------------------------
app :: WS.ClientApp ()
app conn = do
    putStrLn "Connected!"

    -- Fork a thread that writes WS data to stdout
    _ <- forkIO $ forever $ do
        msg <- WS.receiveData conn
        liftIO $ T.putStrLn msg

    -- Read from stdin and write to WS
    let loop = do
            line <- T.getLine
            unless (T.null line) $ WS.sendTextData conn line >> loop

    loop
    WS.sendClose conn ("Bye!" :: Text)


--------------------------------------------------------------------------------
main :: IO ()
main = SSL.withOpenSSL $ do
    ctx <- SSL.context
    is  <- S.getAddrInfo Nothing (Just host) (Just $ show port)
    let a = S.addrAddress $ head is
        f = S.addrFamily $ head is
    s <- S.socket f S.Stream S.defaultProtocol
    S.connect s a
    ssl <- SSL.connection ctx s
    SSL.connect ssl
    (i,o) <- Streams.sslToStreams ssl
    stream <- WS.makeStream (Streams.read i)
                (\b -> Streams.write (B.toStrict <$> b) o)
    WS.runClientWithStream stream host path WS.defaultConnectionOptions [] app
  where
    host = "echo.websocket.org"
    port = 443 :: Int
    path = "/"