--------------------------------------------------------------------------------
-- | This part of the library provides you with utilities to create WebSockets
-- clients (in addition to servers).
module Network.WebSockets.Client
    ( ClientApp
    , runClient
    , runClientWith
    , runClientWithSocket
    , runClientWithStream
    , newClientConnection
    -- * Low level functionality
    , createRequest
    , Protocol(..)
    , defaultProtocol
    , checkServerResponse
    , streamToClientConnection
    ) where


--------------------------------------------------------------------------------
import qualified Data.ByteString.Builder       as Builder
import           Control.Exception             (bracket, finally, throwIO)
import           Control.Concurrent.MVar       (newEmptyMVar)
import           Control.Monad                 (void)
import           Data.IORef                    (newIORef)
import qualified Data.Text                     as T
import qualified Data.Text.Encoding            as T
import qualified Network.Socket                as S
import           System.Timeout                (timeout)


--------------------------------------------------------------------------------
import           Network.WebSockets.Connection
import           Network.WebSockets.Http
import           Network.WebSockets.Protocol
import           Network.WebSockets.Stream     (Stream)
import qualified Network.WebSockets.Stream     as Stream
import           Network.WebSockets.Types


--------------------------------------------------------------------------------
-- | A client application interacting with a single server. Once this 'IO'
-- action finished, the underlying socket is closed automatically.
type ClientApp a = Connection -> IO a


--------------------------------------------------------------------------------
-- TODO: Maybe this should all be strings
runClient :: String       -- ^ Host
          -> Int          -- ^ Port
          -> String       -- ^ Path
          -> ClientApp a  -- ^ Client application
          -> IO a
runClient :: forall a. String -> Int -> String -> ClientApp a -> IO a
runClient String
host Int
port String
path ClientApp a
ws =
    String
-> Int
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
forall a.
String
-> Int
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
runClientWith String
host Int
port String
path ConnectionOptions
defaultConnectionOptions [] ClientApp a
ws


--------------------------------------------------------------------------------
runClientWith :: String             -- ^ Host
              -> Int                -- ^ Port
              -> String             -- ^ Path
              -> ConnectionOptions  -- ^ Options
              -> Headers            -- ^ Custom headers to send
              -> ClientApp a        -- ^ Client application
              -> IO a
runClientWith :: forall a.
String
-> Int
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
runClientWith String
host Int
port String
path0 ConnectionOptions
opts Headers
customHeaders ClientApp a
app = do
    -- Create and connect socket
    let hints :: AddrInfo
hints = AddrInfo
S.defaultHints
                    {S.addrSocketType = S.Stream}

        -- Correct host and path.
        fullHost :: String
fullHost = if Int
port Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
80 then String
host else (String
host String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
port)
        path :: String
path     = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
path0 then String
"/" else String
path0
    addr:_ <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
forall (t :: * -> *).
GetAddrInfo t =>
Maybe AddrInfo -> Maybe String -> Maybe String -> IO (t AddrInfo)
S.getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints) (String -> Maybe String
forall a. a -> Maybe a
Just String
host) (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
port)
    sock      <- S.socket (S.addrFamily addr) S.Stream S.defaultProtocol
    S.setSocketOption sock S.NoDelay 1

    -- Connect WebSocket and run client
    res <- bracket
        (timeout (connectionTimeout opts * 1000 * 1000) $ S.connect sock (S.addrAddress addr))
        (const $ S.close sock) $ \Maybe ()
maybeConnected -> case Maybe ()
maybeConnected of
            Maybe ()
Nothing -> HandshakeException -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (HandshakeException -> IO a) -> HandshakeException -> IO a
forall a b. (a -> b) -> a -> b
$ HandshakeException
ConnectionTimeout
            Just () -> Socket
-> String
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
forall a.
Socket
-> String
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
runClientWithSocket Socket
sock String
fullHost String
path ConnectionOptions
opts Headers
customHeaders ClientApp a
app


    -- Clean up
    return res


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

runClientWithStream
    :: Stream
    -- ^ Stream
    -> String
    -- ^ Host
    -> String
    -- ^ Path
    -> ConnectionOptions
    -- ^ Connection options
    -> Headers
    -- ^ Custom headers to send
    -> ClientApp a
    -- ^ Client application
    -> IO a
runClientWithStream :: forall a.
Stream
-> String
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
runClientWithStream Stream
stream String
host String
path ConnectionOptions
opts Headers
customHeaders ClientApp a
app = do
    Stream
-> String
-> String
-> ConnectionOptions
-> Headers
-> IO Connection
newClientConnection Stream
stream String
host String
path ConnectionOptions
opts Headers
customHeaders IO Connection -> ClientApp a -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ClientApp a
app

-- | Build a new 'Connection' from the client's point of view.
--
-- /WARNING/: Be sure to call 'Stream.close' on the given 'Stream' after you are
-- done using the 'Connection' in order to properly close the communication
-- channel. 'runClientWithStream' handles this for you, prefer to use it when
-- possible.
newClientConnection
    :: Stream
    -- ^ Stream that will be used by the new 'Connection'.
    -> String
    -- ^ Host
    -> String
    -- ^ Path
    -> ConnectionOptions
    -- ^ Connection options
    -> Headers
    -- ^ Custom headers to send
    -> IO Connection
newClientConnection :: Stream
-> String
-> String
-> ConnectionOptions
-> Headers
-> IO Connection
newClientConnection Stream
stream String
host String
path ConnectionOptions
opts Headers
customHeaders = do
    -- Create the request and send it
    request    <- Protocol
-> ByteString -> ByteString -> Bool -> Headers -> IO RequestHead
createRequest Protocol
protocol ByteString
bHost ByteString
bPath Bool
False Headers
customHeaders
    Stream.write stream (Builder.toLazyByteString $ encodeRequestHead request)
    checkServerResponse stream request
    streamToClientConnection stream opts
  where
    protocol :: Protocol
protocol = Protocol
defaultProtocol  -- TODO
    bHost :: ByteString
bHost    = Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
host
    bPath :: ByteString
bPath    = Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
path

-- | Check the response from the server.
-- Throws 'OtherHandshakeException' on failure
checkServerResponse :: Stream -> RequestHead -> IO ()
checkServerResponse :: Stream -> RequestHead -> IO ()
checkServerResponse Stream
stream RequestHead
request = do
    mbResponse <- Stream -> Parser ResponseHead -> IO (Maybe ResponseHead)
forall a. Stream -> Parser a -> IO (Maybe a)
Stream.parse Stream
stream Parser ResponseHead
decodeResponseHead
    response   <- case mbResponse of
        Just ResponseHead
response -> ResponseHead -> IO ResponseHead
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseHead
response
        Maybe ResponseHead
Nothing       -> HandshakeException -> IO ResponseHead
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (HandshakeException -> IO ResponseHead)
-> HandshakeException -> IO ResponseHead
forall a b. (a -> b) -> a -> b
$ String -> HandshakeException
OtherHandshakeException (String -> HandshakeException) -> String -> HandshakeException
forall a b. (a -> b) -> a -> b
$
            String
"Network.WebSockets.Client.newClientConnection: no handshake " String -> String -> String
forall a. [a] -> [a] -> [a]
++
            String
"response from server"
    void $ either throwIO return $ finishResponse protocol request response
  where
    protocol :: Protocol
protocol = Protocol
defaultProtocol -- TODO


-- | Build a 'Connection' from a pre-established stream with already finished
-- handshake.
--
-- /NB/: this will not perform any handshaking.
streamToClientConnection :: Stream -> ConnectionOptions -> IO Connection
streamToClientConnection :: Stream -> ConnectionOptions -> IO Connection
streamToClientConnection Stream
stream ConnectionOptions
opts = do
    parse   <- Protocol
-> SizeLimit -> SizeLimit -> Stream -> IO (IO (Maybe Message))
decodeMessages Protocol
protocol
                (ConnectionOptions -> SizeLimit
connectionFramePayloadSizeLimit ConnectionOptions
opts)
                (ConnectionOptions -> SizeLimit
connectionMessageDataSizeLimit ConnectionOptions
opts) Stream
stream
    write   <- encodeMessages protocol ClientConnection stream
    sentRef <- newIORef False
    heartbeat <- newEmptyMVar
    return $ Connection
        { connectionOptions   = opts
        , connectionType      = ClientConnection
        , connectionProtocol  = protocol
        , connectionParse     = parse
        , connectionWrite     = write
        , connectionHeartbeat = heartbeat
        , connectionSentClose = sentRef
        }
  where
    protocol :: Protocol
protocol = Protocol
defaultProtocol


--------------------------------------------------------------------------------
runClientWithSocket :: S.Socket           -- ^ Socket
                    -> String             -- ^ Host
                    -> String             -- ^ Path
                    -> ConnectionOptions  -- ^ Options
                    -> Headers            -- ^ Custom headers to send
                    -> ClientApp a        -- ^ Client application
                    -> IO a
runClientWithSocket :: forall a.
Socket
-> String
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
runClientWithSocket Socket
sock String
host String
path ConnectionOptions
opts Headers
customHeaders ClientApp a
app = IO Stream -> (Stream -> IO ()) -> (Stream -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
    (Socket -> IO Stream
Stream.makeSocketStream Socket
sock)
    Stream -> IO ()
Stream.close
    (\Stream
stream ->
        Stream
-> String
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
forall a.
Stream
-> String
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
runClientWithStream Stream
stream String
host String
path ConnectionOptions
opts Headers
customHeaders ClientApp a
app)